diff options
Diffstat (limited to 'perl')
| -rw-r--r-- | perl/Wallet/Object.pm | 245 |
1 files changed, 245 insertions, 0 deletions
diff --git a/perl/Wallet/Object.pm b/perl/Wallet/Object.pm new file mode 100644 index 0000000..2a2f352 --- /dev/null +++ b/perl/Wallet/Object.pm @@ -0,0 +1,245 @@ +# Wallet::Object -- 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; +require 5.006; + +use strict; +use vars qw($VERSION); + +use DBI; + +# 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. This method should be called by the new method of any +# subclass. +sub _new_internal { + my ($class, $name, $type, $dbh) = shift; + $dbh->{AutoCommit} = 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. This method should be called by the new method of any +# subclass. +sub _create_internal { + my ($class, $name, $type, $dbh, $creator, $host, $time) = @_; + $dbh->{AutoCommit} = 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, $creator, $host, $time); + $dbh->commit; + }; + if ($@) { + $dbh->rollback; + return undef; + } + my $self = { + dbh => $dbh, + name => $name, + type => $type, + }; + bless ($self, $class); + return $self; +} + +# The real create and new methods must be overridden by subclasses. +sub new { die "Do not instantiate Wallet::Object directly\n"; } +sub create { die "Do not instantiate Wallet::Object directly\n"; } + +############################################################################## +# History functions +############################################################################## + +# Record a global object action for this object. Takes the action (which must +# be one of create, delete, 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 =~ /^(create|delete|get|store)\z/) { + my $id = $self->{type} . ':' . $self->{name}; + $self->{error} = "invalid history action $action for $id"; + 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 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_delete 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) = @_; + 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. +sub owner { + my ($self, $owner) = @_; + if ($owner) { + if ($owner !~ /^\d+\z/) { + $self->{error} = "malformed owner ACL id $owner"; + return; + } + return $self->_set_internal ('owner', $owner); + } 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. +sub acl { + my ($self, $type, $acl) = @_; + if ($type !~ /^(get|store|show|delete|flags)\z/) { + $self->{error} = "invalid ACL type $type"; + return; + } + my $attr = "acl_$type"; + if ($acl) { + if ($acl !~ /^\d+\z/) { + $self->{error} = "malformed ACL id $acl"; + return; + } + return $self->_set_internal ($attr, $acl); + } else { + return $self->_get_internal ($attr); + } +} + +# Get or set the expires value of an object. Expects an expiration time in +# seconds since epoch. +sub expires { + my ($self, $expires) = @_; + if ($expires) { + if ($expires !~ /^\d+\z/ || $expires == 0) { + $self->{error} = "malformed expiration time $expires"; + return; + } + return $self->_set_internal ('expires', $expires); + } else { + return $self->_get_internal ('expires'); + } +} |