summaryrefslogtreecommitdiff
path: root/perl/Wallet/Object/Base.pm
blob: a3c9b3d752219caacaf75e2b531b808d168050b9 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
# Wallet::Object::Base -- Parent class for any object stored in the wallet.
# $Id$
#
# Written by Russ Allbery <rra@stanford.edu>
# Copyright 2007 Board of Trustees, Leland Stanford Jr. University
#
# See README for licensing terms.

##############################################################################
# Modules and declarations
##############################################################################

package Wallet::Object::Base;
require 5.006;

use strict;
use vars qw($VERSION);

use DBI;
use Wallet::ACL;

# This version should be increased on any code change to this module.  Always
# use two digits for the minor version with a leading zero if necessary so
# that it will sort properly.
$VERSION = '0.01';

##############################################################################
# Constructors
##############################################################################

# Initialize an object from the database.  Verifies that the object already
# exists with the given type, and if it does, returns a new blessed object of
# the specified class.  Stores the database handle to use, the name, and the
# type in the object.  If the object doesn't exist, returns undef.  This will
# probably be usable as-is by most object types.
sub new {
    my ($class, $name, $type, $dbh) = shift;
    $dbh->{AutoCommit} = 0;
    $dbh->{RaiseError} = 1;
    $dbh->{PrintError} = 0;
    my $sql = 'select ob_name from objects where ob_name = ? and ob_type = ?';
    my $data = $dbh->selectrow_array ($sql, undef, $name, $type);
    return undef unless ($data and $data eq $name);
    my $self = {
        dbh  => $dbh,
        name => $name,
        type => $type,
    };
    bless ($self, $class);
    return $self;
}

# Create a new object in the database of the specified name and type, setting
# the ob_created_* fields accordingly, and returns a new blessed object of the
# specified class.  Stores the database handle to use, the name, and the type
# in the object.  Subclasses may need to override this to do additional setup.
sub create {
    my ($class, $name, $type, $dbh, $user, $host, $time) = @_;
    $dbh->{AutoCommit} = 0;
    $dbh->{RaiseError} = 1;
    $dbh->{PrintError} = 0;
    $time ||= time;
    eval {
        my $sql = 'insert into objects (ob_name, ob_type, ob_created_by,
            ob_created_from, ob_created_on) values (?, ?, ?, ?, ?)';
        $dbh->do ($sql, undef, $name, $type, $user, $host, $time);
        $sql = "insert into object_history (oh_object, oh_type, oh_action,
            oh_by, oh_from, oh_on) values (?, ?, 'create', ?, ?, ?)";
        $dbh->do ($sql, undef, $name, $type, $user, $host, $time);
        $dbh->commit;
    };
    if ($@) {
        $dbh->rollback;
        return undef;
    }
    my $self = {
        dbh  => $dbh,
        name => $name,
        type => $type,
    };
    bless ($self, $class);
    return $self;
}

##############################################################################
# Utility functions
##############################################################################

# Returns the current error message of the object, if any.
sub error {
    my ($self) = @_;
    return $self->{error};
}

# Record a global object action for this object.  Takes the action (which must
# be one of get or store), and the trace information: user, host, and time.
# Returns true on success and false on failure, setting error appropriately.
#
# This function commits its transaction when complete and should not be called
# inside another transaction.
sub log_action {
    my ($self, $action, $user, $host, $time) = @_;
    unless ($action =~ /^(get|store)\z/) {
        $self->{error} = "invalid history action $action";
        return undef;
    }

    # We have two traces to record, one in the object_history table and one in
    # the object record itself.  Commit both changes as a transaction.  We
    # assume that AutoCommit is turned off.
    eval {
        my $sql = 'insert into object_history (oh_object, oh_type, oh_action,
            oh_by, oh_from, oh_on) values (?, ?, ?, ?, ?, ?)';
        $self->{dbh}->do ($sql, undef, $self->{name}, $self->{type}, $action,
                          $user, $host, $time);
        if ($action eq 'get') {
            $sql = 'update objects set ob_downloaded_by = ?,
                ob_downloaded_from = ?, ob_downloaded_on = ? where
                ob_name = ? and ob_type = ?';
            $self->{dbh}->do ($sql, undef, $user, $host, $time, $self->{name},
                              $self->{type});
        } elsif ($action eq 'store') {
            $sql = 'update objects set ob_stored_by = ?, ob_stored_from = ?,
                ob_stored_on = ? where ob_name = ? and ob_type = ?';
            $self->{dbh}->do ($sql, undef, $user, $host, $time, $self->{name},
                              $self->{type});
        }
        $self->{dbh}->commit;
    };
    if ($@) {
        my $id = $self->{type} . ':' . $self->{name};
        $self->{error} = "cannot update history for $id: $@";
        $self->{dbh}->rollback;
        return undef;
    }
    return 1;
}

# Record a setting change for this object.  Takes the field, the old value,
# the new value, and the trace information (user, host, and time).  The field
# may have the special value "type_data <field>" in which case the value after
# the whitespace is used as the type_field value.
#
# This function does not commit and does not catch exceptions.  It should
# normally be called as part of a larger transaction that implements the
# setting change and should be committed with that change.
sub log_set {
    my ($self, $field, $old, $new, $user, $host, $time) = @_;
    my $type_field;
    if ($field =~ /^type_data\s+/) {
        ($field, $type_field) = split (' ', $field, 2);
    }
    my %fields = map { $_ => 1 }
        qw(owner acl_get acl_store acl_show acl_destroy acl_flags expires
           flags type_data);
    unless ($fields{$field}) {
        die "invalid history field $field";
    }
    my $sql = "insert into object_history (oh_object, oh_type, oh_action,
        oh_field, oh_type_field, oh_from, oh_to, oh_by, oh_from, oh_on)
        values (?, ?, 'set', ?, ?, ?, ?, ?, ?, ?)";
    $self->{dbh}->do ($sql, undef, $self->{name}, $self->{type}, $field,
                      $type_field, $old, $new, $user, $host, $time);
}

##############################################################################
# Get/set values
##############################################################################

# Set a particular attribute.  Takes the attribute to set and its new value.
# Returns undef on failure and the new value on success.
sub _set_internal {
    my ($self, $attr, $value, $user, $host, $time) = @_;
    $time ||= time;
    my $name = $self->{name};
    my $type = $self->{type};
    eval {
        my $sql = "select ob_$attr from objects where ob_name = ? and
            ob_type = ?";
        my $old = $self->{dbh}->selectrow_array ($sql, undef, $name, $type);
        $sql = "update objects set ob_$attr = ? where ob_name = ? and
            ob_type = ?";
        $self->{dbh}->do ($sql, undef, $value, $name, $type);
        $self->log_set ($attr, $old, $value, $user, $host, $time);
        $self->{dbh}->commit;
    };
    if ($@) {
        my $id = $self->{type} . ':' . $self->{name};
        $self->{error} = "cannot set $attr on $id: $@";
        $self->{dbh}->rollback;
        return;
    }
    return $value;
}

# Get a particular attribute.  Returns the attribute value.
sub _get_internal {
    my ($self, $attr) = @_;
    my $name = $self->{name};
    my $type = $self->{type};
    my $sql = "select $attr from objects where ob_name = ? and ob_type = ?";
    my $value = $self->{dbh}->selectrow_array ($sql, undef, $name, $type);
    return $value;
}

# Get or set the owner of an object.  If setting it, trace information must
# also be provided.
sub owner {
    my ($self, $owner, $user, $host, $time) = @_;
    if ($owner) {
        if ($owner !~ /^\d+\z/) {
            $self->{error} = "malformed owner ACL id $owner";
            return;
        }
        return $self->_set_internal ('owner', $owner, $user, $host, $time);
    } else {
        return $self->_get_internal ('owner');
    }
}

# Get or set an ACL on an object.  Takes the type of ACL and, if setting, the
# new ACL identifier.  If setting it, trace information must also be provided.
sub acl {
    my ($self, $type, $id, $user, $host, $time) = @_;
    if ($type !~ /^(get|store|show|destroy|flags)\z/) {
        $self->{error} = "invalid ACL type $type";
        return;
    }
    my $attr = "acl_$type";
    if ($id) {
        my $acl;
        eval { $acl = Wallet::ACL->new ($id) };
        if ($@) {
            $self->{error} = $@;
            return undef;
        }
        return $self->_set_internal ($attr, $acl->id, $user, $host, $time);
    } else {
        return $self->_get_internal ($attr);
    }
}

# Get or set the expires value of an object.  Expects an expiration time in
# seconds since epoch.  If setting the expiration, trace information must also
# be provided.
sub expires {
    my ($self, $expires, $user, $host, $time) = @_;
    if ($expires) {
        if ($expires !~ /^\d+\z/ || $expires == 0) {
            $self->{error} = "malformed expiration time $expires";
            return;
        }
        return $self->_set_internal ('expires', $expires, $user, $host, $time);
    } else {
        return $self->_get_internal ('expires');
    }
}

##############################################################################
# Object manipulation
##############################################################################

# The get methods must always be overridden by the subclass.
sub get { die "Do not instantiate Wallet::Object::Base directly\n"; }

# Provide a default store implementation that returns an immutable object
# error so that auto-generated types don't have to provide their own.
sub store {
    my ($self, $data, $user, $host, $time) = @_;
    my $id = $self->{type} . ':' . $self->{name};
    $self->{error} = "cannot store $id: object type is immutable";
    return;
}

# The default show function.  This may be adequate for many types; types that
# have additional data should call this method, grab the results, and then add
# their data on to the end.
sub show {
    my ($self) = @_;
    my $name = $self->{name};
    my $type = $self->{type};
    my @attrs = ([ ob_type            => 'Type'            ],
                 [ ob_name            => 'Name'            ],
                 [ ob_owner           => 'Owner'           ],
                 [ ob_acl_get         => 'Get ACL'         ],
                 [ ob_acl_store       => 'Store ACL'       ],
                 [ ob_acl_show        => 'Show ACL'        ],
                 [ ob_acl_destroy     => 'Destroy ACL'     ],
                 [ ob_acl_flags       => 'Flags ACL'       ],
                 [ ob_expires         => 'Expires'         ],
                 [ ob_created_by      => 'Created by'      ],
                 [ ob_created_from    => 'Created from'    ],
                 [ ob_created_on      => 'Created on'      ],
                 [ ob_stored_by       => 'Stored by'       ],
                 [ ob_stored_from     => 'Stored from'     ],
                 [ ob_stored_on       => 'Stored on'       ],
                 [ ob_downloaded_by   => 'Downloaded by'   ],
                 [ ob_downloaded_from => 'Downloaded from' ],
                 [ ob_downloaded_on   => 'Downloaded on'   ]);
    my $fields = join (', ', map { $_->[0] } @attrs);
    my @data;
    eval {
        my $sql = "select $fields from objects where ob_name = ? and
            ob_type = ?";
        @data = $self->{dbh}->selectrow_array ($sql, undef, $name, $type);
    };
    if ($@) {
        $self->{error} = "cannot retrieve data for ${type}:${name}: $@";
        return undef;
    }
    my $output = '';
    for (my $i = 0; $i < @data; $i++) {
        next unless defined $data[$i];
        $output .= sprintf ("%15s: %s\n", $attrs[$i][1], $data[$i]);
    }
    return $output;
}

# The default destroy function only destroys the database metadata.  Generally
# subclasses need to override this to destroy whatever additional information
# is stored about this object.
sub destroy {
    my ($self, $user, $host, $time) = @_;
    $time ||= time;
    my $name = $self->{name};
    my $type = $self->{type};
    eval {
        my $sql = 'delete from flags where fl_object = ? and fl_type = ?';
        $self->{dbh}->do ($sql, undef, $name, $type);
        $sql = 'delete from objects where ob_name = ? and ob_type = ?';
        $self->{dbh}->do ($sql, undef, $name, $type);
        $sql = "insert into object_history (oh_object, oh_type, oh_action,
            oh_by, oh_from, oh_on) values (?, ?, 'destroy', ?, ?, ?)";
        $self->{dbh}->do ($sql, undef, $name, $type, $user, $host, $time);
        $self->{dbh}->commit;
    };
    if ($@) {
        $self->{error} = "cannot destroy ${type}:${name}: $@";
        $self->{dbh}->rollback;
        return undef;
    }
    return 1;
}

1;
__END__

##############################################################################
# Documentation
##############################################################################

=head1 NAME

Wallet::Object::Base - Generic parent class for wallet objects

=head1 SYNOPSIS

    package Wallet::Object::Simple;
    @ISA = qw(Wallet::Object::Base);
    sub get {
        my ($self, $user, $host, $time) = @_;
        $self->log_action ('get', $user, $host, $time) or return undef;
        return "Some secure data";
    }

=head1 DESCRIPTION

Wallet::Object::Base is the generic parent class for wallet objects (data
types that can be stored in the wallet system).  It provides defualt
functions and behavior, including handling generic object settings.  All
handlers for objects stored in the wallet should inherit from it.  It is
not used directly.

=head1 PUBLIC CLASS METHODS

The following methods are called by the rest of the wallet system and should
be implemented by all objects stored in the wallet.  They should be called
with the desired wallet object class as the first argument (generally using
the Wallet::Object::Type->new syntax).

=over 4

=item new(NAME, TYPE, DBH)

Creates a new object with the given object name and type, based on data
already in the database.  This method will only succeed if an object of the
given NAME and TYPE is already present in the wallet database.  If no such
object exits, returns undef.  Otherwise, returns an object blessed into the
class used for the new() call (so subclasses can leave this method alone and
not override it).

Takes a database handle, which is stored in the object and used for any
further operations.  This database handle is taken over by the wallet system
and its settings (such as RaiseError and AutoCommit) will be modified by the
object for its own needs.

=item create(NAME, TYPE, DBH, PRINCIPAL, HOSTNAME [, DATETIME])

Similar to new() but instead creates a new entry in the database.  This
method will fail (returning undef) if an entry for that name and type
already exists in the database or if creating the database record fails.
Otherwise, a new database entry will be created with that name and type, no
owner, no ACLs, no expiration, no flags, and with created by, from, and on
set to the PRINCIPAL, HOSTNAME, and DATETIME parameters.  If DATETIME isn't
given, the current time is used.  The database handle is treated as with
new().

=back

=head1 PUBLIC INSTANCE METHODS

The following methods may be called on instantiated wallet objects.
Normally, the only methods that a subclass will need to override are get(),
store(), show(), and destroy().

=over 4

=item acl(TYPE [, ACL, PRINCIPAL, HOSTNAME [, DATETIME]])

Sets or retrieves a given object ACL as a numeric ACL ID.  TYPE must be one
of C<get>, C<store>, C<show>, C<destroy>, or C<flags>, corresponding to the
ACLs kept on an object.  If no other arguments are given, returns the
current ACL setting as an ACL ID or undef if that ACL isn't set.  If other
arguments are given, change that ACL to ACL.  The other arguments are used
for logging and history and should indicate the user and host from which the
change is made and the time of the change.

=item destroy(PRINCIPAL, HOSTNAME [, DATETIME])

Destroys the object by removing all record of it from the database.  The
Wallet::Object::Base implementation handles the generic database work,
but any subclass should override this method to do any deletion of files
or entries in external databases and any other database entries and then
call the parent method to handle the generic database cleanup.  Returns
true on success and false on failure.  The arguments are used for logging
and history and should indicate the user and host from which the change is
made and the time of the change.

=item error()

Returns the error message from the last failing operation or undef if no
operations have failed.  Callers should call this function to get the error
message after an undef return from any other instance method.

=item expires([EXPIRES, PRINCIPAL, HOSTNAME [, DATETIME]])

Sets or retrieves the expiration date of an object.  If no arguments are
given, returns the current expiration or undef if no expiration is set.  If
arguments are given, change the expiration to EXPIRES, which should be in
seconds since epoch.  The other arguments are used for logging and history
and should indicate the user and host from which the change is made and the
time of the change.

=item get(PRINCIPAL, HOSTNAME [, DATETIME])

An object implementation must override this method with one that returns
either the data of the object or undef on some error, using the provided
arguments to update history information.  The Wallet::Object::Base
implementation just throws an exception.

=item owner([OWNER, PRINCIPAL, HOSTNAME [, DATETIME]])

Sets or retrieves the owner of an object as a numeric ACL ID.  If no
arguments are given, returns the current owner ACL ID or undef if none is
set.  If arguments are given, change the owner to OWNER.  The other
arguments are used for logging and history and should indicate the user and
host from which the change is made and the time of the change.

=item show()

Returns a formatted text description of the object suitable for human
display, or undef on error.  The default implementation shows all of the
base metadata about the object, formatted as key: value pairs with the keys
aligned in the first 15 characters followed by a space, a colon, and the
value.  Object implementations with additional data to display can rely on
that format to add additional settings into the formatted output or at the
end with a matching format.

=item store(DATA, PRINCIPAL, HOSTNAME [, DATETIME])

Store user-supplied data into the given object.  This may not be supported
by all backends (for instance, backends that automatically generate the data
will not support this).  The default implementation rejects all store()
calls with an error message saying that the object is immutable.

=back

=head1 UTILITY METHODS

The following instance methods should not be called externally but are
provided for subclasses to call to implement some generic actions.

=over 4

=item log_action (ACTION, PRINCIPAL, HOSTNAME, DATETIME)

Updates the history tables and trace information appropriately for ACTION,
which should be either C<get> or C<store>.  No other changes are made to the
database, just updates of the history table and trace fields with the
provided data about who performed the action and when.

This function commits its transaction when complete and therefore should not
be called inside another transaction.  Normally it's called as a separate
transaction after the data is successfully stored or retrieved.

=item log_set (FIELD, OLD, NEW, PRINCIPAL, HOSTNAME, DATETIME)

Updates the history tables for the change in a setting value for an object.
FIELD should be one of C<owner>, C<acl_get>, C<acl_store>, C<acl_show>,
C<acl_destroy>, C<acl_flags>, C<expires>, C<flags>, or a value starting with
C<type_data> followed by a space and a type-specific field name.  The last
form is the most common form used by a subclass.  OLD is the previous value
of the field or undef if the field was unset, and NEW is the new value of
the field or undef if the field should be unset.

This function does not commit and does not catch database exceptions.  It
should normally be called as part of a larger transaction that implements
the change in the setting.

=back

=head1 SEE ALSO

walletd(8)

This module is part of the wallet system.  The current version is available
from L<http://www.eyrie.org/~eagle/software/wallet/>.

=head1 AUTHOR

Russ Allbery <rra@stanford.edu>

=cut