From 0e0ccfe8b2497a4b3245dd60a331b4d4f14bd714 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 28 Aug 2007 20:52:10 +0000 Subject: Rename Wallet::Object to Wallet::Object::Base and fix some syntax errors introduced by recent changes. --- perl/Wallet/Object/Base.pm | 533 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 533 insertions(+) create mode 100644 perl/Wallet/Object/Base.pm (limited to 'perl/Wallet/Object/Base.pm') diff --git a/perl/Wallet/Object/Base.pm b/perl/Wallet/Object/Base.pm new file mode 100644 index 0000000..a3c9b3d --- /dev/null +++ b/perl/Wallet/Object/Base.pm @@ -0,0 +1,533 @@ +# Wallet::Object::Base -- Parent class for any object stored in the wallet. +# $Id$ +# +# Written by Russ Allbery +# 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 " 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, C, C, C, or C, 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 or C. 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, C, C, C, +C, C, C, C, or a value starting with +C 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. + +=head1 AUTHOR + +Russ Allbery + +=cut -- cgit v1.2.3