diff options
Diffstat (limited to 'perl/Wallet/Object')
| -rw-r--r-- | perl/Wallet/Object/Base.pm | 1015 | ||||
| -rw-r--r-- | perl/Wallet/Object/Duo.pm | 331 | ||||
| -rw-r--r-- | perl/Wallet/Object/File.pm | 242 | ||||
| -rw-r--r-- | perl/Wallet/Object/Keytab.pm | 513 | ||||
| -rw-r--r-- | perl/Wallet/Object/WAKeyring.pm | 370 |
5 files changed, 0 insertions, 2471 deletions
diff --git a/perl/Wallet/Object/Base.pm b/perl/Wallet/Object/Base.pm deleted file mode 100644 index 8debac9..0000000 --- a/perl/Wallet/Object/Base.pm +++ /dev/null @@ -1,1015 +0,0 @@ -# Wallet::Object::Base -- Parent class for any object stored in the wallet. -# -# Written by Russ Allbery <eagle@eyrie.org> -# Copyright 2007, 2008, 2010, 2011 -# The Board of Trustees of the Leland Stanford Junior University -# -# See LICENSE for licensing terms. - -############################################################################## -# Modules and declarations -############################################################################## - -package Wallet::Object::Base; -require 5.006; - -use strict; -use vars qw($VERSION); - -use DBI; -use POSIX qw(strftime); -use Text::Wrap qw(wrap); -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.06'; - -############################################################################## -# 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, $type, $name, $schema) = @_; - my %search = (ob_type => $type, - ob_name => $name); - my $object = $schema->resultset('Object')->find (\%search); - die "cannot find ${type}:${name}\n" - unless ($object and $object->ob_name eq $name); - my $self = { - schema => $schema, - 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, $type, $name, $schema, $user, $host, $time) = @_; - $time ||= time; - die "invalid object type\n" unless $type; - die "invalid object name\n" unless $name; - my $guard = $schema->txn_scope_guard; - eval { - my %record = (ob_type => $type, - ob_name => $name, - ob_created_by => $user, - ob_created_from => $host, - ob_created_on => strftime ('%Y-%m-%d %T', - localtime $time)); - $schema->resultset('Object')->create (\%record); - - %record = (oh_type => $type, - oh_name => $name, - oh_action => 'create', - oh_by => $user, - oh_from => $host, - oh_on => strftime ('%Y-%m-%d %T', localtime $time)); - $schema->resultset('ObjectHistory')->create (\%record); - - $guard->commit; - }; - if ($@) { - die "cannot create object ${type}:${name}: $@\n"; - } - my $self = { - schema => $schema, - name => $name, - type => $type, - }; - bless ($self, $class); - return $self; -} - -############################################################################## -# Utility functions -############################################################################## - -# Set or return the error stashed in the object. -sub error { - my ($self, @error) = @_; - if (@error) { - my $error = join ('', @error); - chomp $error; - 1 while ($error =~ s/ at \S+ line \d+\.?\z//); - $self->{error} = $error; - } - return $self->{error}; -} - -# Returns the type of the object. -sub type { - my ($self) = @_; - return $self->{type}; -} - -# Returns the name of the object. -sub name { - my ($self) = @_; - return $self->{name}; -} - -# 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; - } - - # 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. - my $guard = $self->{schema}->txn_scope_guard; - eval { - my %record = (oh_type => $self->{type}, - oh_name => $self->{name}, - oh_action => $action, - oh_by => $user, - oh_from => $host, - oh_on => strftime ('%Y-%m-%d %T', localtime $time)); - $self->{schema}->resultset('ObjectHistory')->create (\%record); - - my %search = (ob_type => $self->{type}, - ob_name => $self->{name}); - my $object = $self->{schema}->resultset('Object')->find (\%search); - if ($action eq 'get') { - $object->ob_downloaded_by ($user); - $object->ob_downloaded_from ($host); - $object->ob_downloaded_on (strftime ('%Y-%m-%d %T', - localtime $time)); - } elsif ($action eq 'store') { - $object->ob_stored_by ($user); - $object->ob_stored_from ($host); - $object->ob_stored_on (strftime ('%Y-%m-%d %T', - localtime $time)); - } - $object->update; - $guard->commit; - }; - if ($@) { - my $id = $self->{type} . ':' . $self->{name}; - $self->error ("cannot update history for $id: $@"); - return; - } - 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 - comment flags type_data); - unless ($fields{$field}) { - die "invalid history field $field"; - } - - my %record = (oh_type => $self->{type}, - oh_name => $self->{name}, - oh_action => 'set', - oh_field => $field, - oh_type_field => $type_field, - oh_old => $old, - oh_new => $new, - oh_by => $user, - oh_from => $host, - oh_on => strftime ('%Y-%m-%d %T', localtime $time)); - $self->{schema}->resultset('ObjectHistory')->create (\%record); -} - -############################################################################## -# Get/set values -############################################################################## - -# Set a particular attribute. Takes the attribute to set and its new value. -# Returns undef on failure and true on success. -sub _set_internal { - my ($self, $attr, $value, $user, $host, $time) = @_; - if ($attr !~ /^[a-z_]+\z/) { - $self->error ("invalid attribute $attr"); - return; - } - $time ||= time; - my $name = $self->{name}; - my $type = $self->{type}; - if ($self->flag_check ('locked')) { - $self->error ("cannot modify ${type}:${name}: object is locked"); - return; - } - - my $guard = $self->{schema}->txn_scope_guard; - eval { - my %search = (ob_type => $type, - ob_name => $name); - my $object = $self->{schema}->resultset('Object')->find (\%search); - my $old = $object->get_column ("ob_$attr"); - - $object->update ({ "ob_$attr" => $value }); - $self->log_set ($attr, $old, $value, $user, $host, $time); - $guard->commit; - }; - if ($@) { - my $id = $self->{type} . ':' . $self->{name}; - $self->error ("cannot set $attr on $id: $@"); - return; - } - return 1; -} - -# Get a particular attribute. Returns the attribute value or undef if the -# value isn't set or on a database error. The two cases can be distinguished -# by whether $self->{error} is set. -sub _get_internal { - my ($self, $attr) = @_; - undef $self->{error}; - if ($attr !~ /^[a-z_]+\z/) { - $self->error ("invalid attribute $attr"); - return; - } - $attr = 'ob_' . $attr; - my $name = $self->{name}; - my $type = $self->{type}; - my $value; - eval { - my %search = (ob_type => $type, - ob_name => $name); - my $object = $self->{schema}->resultset('Object')->find (\%search); - $value = $object->get_column ($attr); - }; - if ($@) { - $self->error ($@); - return; - } - return $value; -} - -# 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, $self->{schema}) }; - if ($@) { - $self->error ($@); - return; - } - return $self->_set_internal ($attr, $acl->id, $user, $host, $time); - } elsif (defined $id) { - return $self->_set_internal ($attr, undef, $user, $host, $time); - } else { - return $self->_get_internal ($attr); - } -} - -# Get or set an attribute on an object. Takes the name of the attribute and, -# if setting, the values and trace information. The values must be provided -# as a reference to an array, even if there is only one value. -# -# Attributes are used by backends for backend-specific information (such as -# enctypes for a keytab). The default implementation rejects all attribute -# names as unknown. -sub attr { - my ($self, $attr, $values, $user, $host, $time) = @_; - $self->error ("unknown attribute $attr"); - return; -} - -# Format the object attributes for inclusion in show(). The default -# implementation just returns the empty string. -sub attr_show { - my ($self) = @_; - return ''; -} - -# Get or set the comment value of an object. If setting it, trace information -# must also be provided. -sub comment { - my ($self, $comment, $user, $host, $time) = @_; - if ($comment) { - return $self->_set_internal ('comment', $comment, $user, $host, $time); - } elsif (defined $comment) { - return $self->_set_internal ('comment', undef, $user, $host, $time); - } else { - return $self->_get_internal ('comment'); - } -} - -# 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{4}-\d\d-\d\d( \d\d:\d\d:\d\d)?\z/) { - $self->error ("malformed expiration time $expires"); - return; - } - return $self->_set_internal ('expires', $expires, $user, $host, $time); - } elsif (defined $expires) { - return $self->_set_internal ('expires', undef, $user, $host, $time); - } else { - return $self->_get_internal ('expires'); - } -} - -# 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) { - my $acl; - eval { $acl = Wallet::ACL->new ($owner, $self->{schema}) }; - if ($@) { - $self->error ($@); - return; - } - return $self->_set_internal ('owner', $acl->id, $user, $host, $time); - } elsif (defined $owner) { - return $self->_set_internal ('owner', undef, $user, $host, $time); - } else { - return $self->_get_internal ('owner'); - } -} - -############################################################################## -# Flags -############################################################################## - -# Check whether a flag is set on the object. Returns true if set, 0 if not -# set, and undef on error. -sub flag_check { - my ($self, $flag) = @_; - my $name = $self->{name}; - my $type = $self->{type}; - my $schema = $self->{schema}; - my $value; - eval { - my %search = (fl_type => $type, - fl_name => $name, - fl_flag => $flag); - my $flag = $schema->resultset('Flag')->find (\%search); - if (not defined $flag) { - $value = 0; - } else { - $value = $flag->fl_flag; - } - }; - if ($@) { - $self->error ("cannot check flag $flag for ${type}:${name}: $@"); - return; - } else { - return ($value) ? 1 : 0; - } -} - -# Clear a flag on an object. Takes the flag and trace information. Returns -# true on success and undef on failure. -sub flag_clear { - my ($self, $flag, $user, $host, $time) = @_; - $time ||= time; - my $name = $self->{name}; - my $type = $self->{type}; - my $schema = $self->{schema}; - my $guard = $schema->txn_scope_guard; - eval { - my %search = (fl_type => $type, - fl_name => $name, - fl_flag => $flag); - my $flag = $schema->resultset('Flag')->find (\%search); - unless (defined $flag) { - die "flag not set\n"; - } - $flag->delete; - $self->log_set ('flags', $flag->fl_flag, undef, $user, $host, $time); - $guard->commit; - }; - if ($@) { - $self->error ("cannot clear flag $flag on ${type}:${name}: $@"); - return; - } - return 1; -} - -# List the flags on an object. Returns a list of flag names, which may be -# empty. On error, returns the empty list. The caller should call error() in -# this case to determine if an error occurred. -sub flag_list { - my ($self) = @_; - undef $self->{error}; - my @flags; - eval { - my %search = (fl_type => $self->{type}, - fl_name => $self->{name}); - my %attrs = (order_by => 'fl_flag'); - my @flags_rs = $self->{schema}->resultset('Flag')->search (\%search, - \%attrs); - for my $flag (@flags_rs) { - push (@flags, $flag->fl_flag); - } - }; - if ($@) { - my $id = $self->{type} . ':' . $self->{name}; - $self->error ("cannot retrieve flags for $id: $@"); - return; - } else { - return @flags; - } -} - -# Set a flag on an object. Takes the flag and trace information. Returns -# true on success and undef on failure. -sub flag_set { - my ($self, $flag, $user, $host, $time) = @_; - $time ||= time; - my $name = $self->{name}; - my $type = $self->{type}; - my $schema = $self->{schema}; - my $guard = $schema->txn_scope_guard; - eval { - my %search = (fl_type => $type, - fl_name => $name, - fl_flag => $flag); - my $flag = $schema->resultset('Flag')->find (\%search); - if (defined $flag) { - die "flag already set\n"; - } - $flag = $schema->resultset('Flag')->create (\%search); - $self->log_set ('flags', undef, $flag->fl_flag, $user, $host, $time); - $guard->commit; - }; - if ($@) { - $self->error ("cannot set flag $flag on ${type}:${name}: $@"); - return; - } - return 1; -} - -############################################################################## -# History -############################################################################## - -# Expand a given ACL id to add its name, for readability. Returns the -# original id alone if there was a problem finding the name. -sub format_acl_id { - my ($self, $id) = @_; - my $name = $id; - - my %search = (ac_id => $id); - my $acl_rs = $self->{schema}->resultset('Acl')->find (\%search); - if (defined $acl_rs) { - $name = $acl_rs->ac_name . " ($id)"; - } - - return $name; -} - -# Return the formatted history for a given object or undef on error. -# Currently always returns the complete history, but eventually will need to -# provide some way of showing only recent entries. -sub history { - my ($self) = @_; - my $output = ''; - eval { - my %search = (oh_type => $self->{type}, - oh_name => $self->{name}); - my %attrs = (order_by => 'oh_on'); - my @history = $self->{schema}->resultset('ObjectHistory') - ->search (\%search, \%attrs); - - for my $history_rs (@history) { - $output .= sprintf ("%s %s ", $history_rs->oh_on->ymd, - $history_rs->oh_on->hms); - - my $old = $history_rs->oh_old; - my $new = $history_rs->oh_new; - my $action = $history_rs->oh_action; - my $field = $history_rs->oh_field; - - if ($action eq 'set' and $field eq 'flags') { - if (defined ($new)) { - $output .= "set flag $new"; - } elsif (defined ($old)) { - $output .= "clear flag $old"; - } - } elsif ($action eq 'set' and $field eq 'type_data') { - my $attr = $history_rs->oh_type_field; - if (defined ($old) and defined ($new)) { - $output .= "set attribute $attr to $new (was $old)"; - } elsif (defined ($old)) { - $output .= "remove $old from attribute $attr"; - } elsif (defined ($new)) { - $output .= "add $new to attribute $attr"; - } - } elsif ($action eq 'set' - and ($field eq 'owner' or $field =~ /^acl_/)) { - $old = $self->format_acl_id ($old) if defined ($old); - $new = $self->format_acl_id ($new) if defined ($new); - if (defined ($old) and defined ($new)) { - $output .= "set $field to $new (was $old)"; - } elsif (defined ($new)) { - $output .= "set $field to $new"; - } elsif (defined ($old)) { - $output .= "unset $field (was $old)"; - } - } elsif ($action eq 'set') { - if (defined ($old) and defined ($new)) { - $output .= "set $field to $new (was $old)"; - } elsif (defined ($new)) { - $output .= "set $field to $new"; - } elsif (defined ($old)) { - $output .= "unset $field (was $old)"; - } - } else { - $output .= $action; - } - $output .= sprintf ("\n by %s from %s\n", $history_rs->oh_by, - $history_rs->oh_from); - } - }; - if ($@) { - my $id = $self->{type} . ':' . $self->{name}; - $self->error ("cannot read history for $id: $@"); - return; - } - return $output; -} - -############################################################################## -# 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}; - if ($self->flag_check ('locked')) { - $self->error ("cannot store $id: object is locked"); - return; - } - $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_comment => 'Comment' ], - [ 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; - my $object_rs; - eval { - my %search = (ob_type => $type, - ob_name => $name); - $object_rs = $self->{schema}->resultset('Object')->find (\%search); - }; - if ($@) { - $self->error ("cannot retrieve data for ${type}:${name}: $@"); - return; - } - my $output = ''; - my @acls; - - # Format the results. We use a hack to insert the flags before the first - # trace field since they're not a field in the object in their own right. - # The comment should be word-wrapped at 80 columns. - for my $i (0 .. $#attrs) { - my $field = $attrs[$i][0]; - my $fieldtext = $attrs[$i][1]; - next unless my $value = $object_rs->get_column ($field); - - if ($field eq 'ob_comment' && length ($value) > 79 - 17) { - local $Text::Wrap::columns = 80; - local $Text::Wrap::unexpand = 0; - $value = wrap (' ' x 17, ' ' x 17, $value); - $value =~ s/^ {17}//; - } - if ($field eq 'ob_created_by') { - my @flags = $self->flag_list; - if (not @flags and $self->error) { - return; - } - if (@flags) { - $output .= sprintf ("%15s: %s\n", 'Flags', "@flags"); - } - my $attr_output = $self->attr_show; - if (not defined $attr_output) { - return; - } - $output .= $attr_output; - } - if ($field =~ /^ob_(owner|acl_)/) { - my $acl = eval { Wallet::ACL->new ($value, $self->{schema}) }; - if ($acl and not $@) { - $value = $acl->name || $value; - push (@acls, [ $acl, $value ]); - } - } - $output .= sprintf ("%15s: %s\n", $fieldtext, $value); - } - if (@acls) { - my %seen; - @acls = grep { !$seen{$_->[1]}++ } @acls; - for my $acl (@acls) { - $output .= "\n" . $acl->[0]->show; - } - } - 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}; - if ($self->flag_check ('locked')) { - $self->error ("cannot destroy ${type}:${name}: object is locked"); - return; - } - my $guard = $self->{schema}->txn_scope_guard; - eval { - - # Remove any flags that may exist for the record. - my %search = (fl_type => $type, - fl_name => $name); - $self->{schema}->resultset('Flag')->search (\%search)->delete; - - # Remove any object records - %search = (ob_type => $type, - ob_name => $name); - $self->{schema}->resultset('Object')->search (\%search)->delete; - - # And create a new history object for the destroy action. - my %record = (oh_type => $type, - oh_name => $name, - oh_action => 'destroy', - oh_by => $user, - oh_from => $host, - oh_on => strftime ('%Y-%m-%d %T', localtime $time)); - $self->{schema}->resultset('ObjectHistory')->create (\%record); - $guard->commit; - }; - if ($@) { - $self->error ("cannot destroy ${type}:${name}: $@"); - return; - } - return 1; -} - -1; -__END__ - -############################################################################## -# Documentation -############################################################################## - -=head1 NAME - -Wallet::Object::Base - Generic parent class for wallet objects - -=for stopwords -DBH HOSTNAME DATETIME ACL backend metadata timestamp Allbery wallet-backend -backend-specific subclasses - -=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; - 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 default -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(TYPE, NAME, DBH) - -Creates a new object with the given object type and name, based on data -already in the database. This method will only succeed if an object of -the given TYPE and NAME is already present in the wallet database. If no -such object exits, throws an exception. 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 Wallet::Schema object, which is stored in the object and used -for any further operations. - -=item create(TYPE, NAME, DBH, PRINCIPAL, HOSTNAME [, DATETIME]) - -Similar to new() but instead creates a new entry in the database. This -method will throw an exception if an entry for that type and name already -exists in the database or if creating the database record fails. -Otherwise, a new database entry will be created with that type and name, -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(). - -If the locked flag is set on an object, no actions may be performed on -that object except for the flag methods and show(). All other actions -will be rejected with an error saying the object is locked. - -=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 and return true on -success and false on failure. Pass in the empty string for ACL to clear -the 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 attr(ATTRIBUTE [, VALUES, PRINCIPAL, HOSTNAME [, DATETIME]]) - -Sets or retrieves a given object attribute. Attributes are used to store -backend-specific information for a particular object type and ATTRIBUTE -must be an attribute type known to the underlying object implementation. -The default implementation of this method rejects all attributes as -unknown. - -If no other arguments besides ATTRIBUTE are given, returns the values of -that attribute, if any, as a list. On error, returns the empty list. To -distinguish between an error and an empty return, call error() afterward. -It is guaranteed to return undef unless there was an error. - -If other arguments are given, sets the given ATTRIBUTE values to VALUES, -which must be a reference to an array (even if only one value is being -set). Pass a reference to an empty array to clear the attribute values. -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. Returns true on success and false on failure. - -=item attr_show() - -Returns a formatted text description of the type-specific attributes of -the object, or undef on error. The default implementation of this method -always returns the empty string. If there are any type-specific -attributes set, this method should return that metadata, formatted as key: -value pairs with the keys right-aligned in the first 15 characters, -followed by a space, a colon, and the value. - -=item comment([COMMENT, PRINCIPAL, HOSTNAME [, DATETIME]]) - -Sets or retrieves the comment associated with an object. If no arguments -are given, returns the current comment or undef if no comment is set. If -arguments are given, change the comment to COMMENT and return true on -success and false on failure. Pass in the empty string for COMMENT to -clear the comment. - -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([ERROR ...]) - -Returns the error of 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. - -For the convenience of child classes, this method can also be called with -one or more error strings. If so, those strings are concatenated -together, trailing newlines are removed, any text of the form S<C< at \S+ -line \d+\.?>> at the end of the message is stripped off, and the result is -stored as the error. Only child classes should call this method with an -error string. - -=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 and return true -on success and false on failure. EXPIRES must be in the format -C<YYYY-MM-DD HH:MM:SS>, although the time portion may be omitted. Pass in -the empty string for EXPIRES to clear the expiration date. - -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 flag_check(FLAG) - -Check whether the given flag is set on an object. Returns true if set, -C<0> if not set, and undef on error. - -=item flag_clear(FLAG, PRINCIPAL, HOSTNAME [, DATETIME]) - -Clears FLAG on an object. Returns true on success and false on failure. -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 flag_list() - -List the flags set on an object. If no flags are set, returns the empty -list. On failure, returns an empty list. To distinguish between the -empty response and an error, the caller should call error() after an empty -return. It is guaranteed to return undef if there was no error. - -=item flag_set(FLAG, PRINCIPAL, HOSTNAME [, DATETIME]) - -Sets FLAG on an object. Returns true on success and false on failure. -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 history() - -Returns the formatted history for the object. There will be two lines for -each action on the object. The first line has the timestamp of the action -and the action, and the second line gives the user who performed the -action and the host from which they performed it (based on the trace -information passed into the other object methods). - -=item name() - -Returns the object's name. - -=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 and return true on -success and false on failure. Pass in the empty string for OWNER to clear -the 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. 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. The attr_show() -method of the object is also called and any formatted output it returns -will be included. If any ACLs or an owner are set, after this data there -is a blank line and then the information for each unique ACL, separated by -blank lines. - -=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. - -=item type() - -Returns the object's type. - -=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 - -wallet-backend(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 <eagle@eyrie.org> - -=cut diff --git a/perl/Wallet/Object/Duo.pm b/perl/Wallet/Object/Duo.pm deleted file mode 100644 index e5773c8..0000000 --- a/perl/Wallet/Object/Duo.pm +++ /dev/null @@ -1,331 +0,0 @@ -# Wallet::Object::Duo -- Duo integration object implementation for the wallet. -# -# Written by Russ Allbery <eagle@eyrie.org> -# Copyright 2014 -# The Board of Trustees of the Leland Stanford Junior University -# -# See LICENSE for licensing terms. - -############################################################################## -# Modules and declarations -############################################################################## - -package Wallet::Object::Duo; -require 5.006; - -use strict; -use vars qw(@ISA $VERSION); - -use JSON; -use Net::Duo::Admin; -use Net::Duo::Admin::Integration; -use Perl6::Slurp qw(slurp); -use Wallet::Config (); -use Wallet::Object::Base; - -@ISA = qw(Wallet::Object::Base); - -# 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'; - -############################################################################## -# Core methods -############################################################################## - -# Override attr_show to display the Duo integration key attribute. -sub attr_show { - my ($self) = @_; - my $output = ''; - my $key; - eval { - my %search = (du_name => $self->{name}); - my $row = $self->{schema}->resultset ('Duo')->find (\%search); - $key = $row->get_column ('du_key'); - }; - if ($@) { - $self->error ($@); - return; - } - return sprintf ("%15s: %s\n", 'Duo key', $key); -} - -# Override new to start by creating a Net::Duo::Admin object for subsequent -# calls. -sub new { - my ($class, $type, $name, $schema) = @_; - - # We have to have a Duo integration key file set. - if (not $Wallet::Config::DUO_KEY_FILE) { - die "duo object implementation not configured\n"; - } - my $key_file = $Wallet::Config::DUO_KEY_FILE; - my $agent = $Wallet::Config::DUO_AGENT; - - # Construct the Net::Duo::Admin object. - require Net::Duo::Admin; - my $duo = Net::Duo::Admin->new ( - { - key_file => $key_file, - user_agent => $agent, - } - ); - - # Construct the object. - my $self = $class->SUPER::new ($type, $name, $schema); - $self->{duo} = $duo; - return $self; -} - -# Override create to start by creating a new integration in Duo, and only -# create the entry in the database if that succeeds. Error handling isn't -# great here since we don't have a way to communicate the error back to the -# caller. -sub create { - my ($class, $type, $name, $schema, $creator, $host, $time) = @_; - - # We have to have a Duo integration key file set. - if (not $Wallet::Config::DUO_KEY_FILE) { - die "duo object implementation not configured\n"; - } - my $key_file = $Wallet::Config::DUO_KEY_FILE; - my $agent = $Wallet::Config::DUO_AGENT; - - # Construct the Net::Duo::Admin object. - require Net::Duo::Admin; - my $duo = Net::Duo::Admin->new ( - { - key_file => $key_file, - user_agent => $agent, - } - ); - - # Create the object in Duo. - require Net::Duo::Admin::Integration; - my %data = ( - name => $name, - notes => 'Managed by wallet', - type => $Wallet::Config::DUO_TYPE, - ); - my $integration = Net::Duo::Admin::Integration->create ($duo, \%data); - - # Create the object in wallet. - my @trace = ($creator, $host, $time); - my $self = $class->SUPER::create ($type, $name, $schema, @trace); - $self->{duo} = $duo; - - # Add the integration key to the object metadata. - my $guard = $self->{schema}->txn_scope_guard; - eval { - my %record = ( - du_name => $name, - du_key => $integration->integration_key, - ); - $self->{schema}->resultset ('Duo')->create (\%record); - $guard->commit; - }; - if ($@) { - my $id = $self->{type} . ':' . $self->{name}; - $self->error ("cannot set Duo key for $id: $@"); - return; - } - - # Done. Return the object. - return $self; -} - -# Override destroy to delete the integration out of Duo as well. -sub destroy { - my ($self, $user, $host, $time) = @_; - my $id = $self->{type} . ':' . $self->{name}; - if ($self->flag_check ('locked')) { - $self->error ("cannot destroy $id: object is locked"); - return; - } - my $schema = $self->{schema}; - my $guard = $schema->txn_scope_guard; - eval { - my %search = (du_name => $self->{name}); - my $row = $schema->resultset ('Duo')->find (\%search); - my $key = $row->get_column ('du_key'); - my $int = Net::Duo::Admin::Integration->new ($self->{duo}, $key); - $int->delete; - $row->delete; - $guard->commit; - }; - if ($@) { - $self->error ($@); - return; - } - return $self->SUPER::destroy ($user, $host, $time); -} - -# Our get implementation. Retrieve the integration information from Duo and -# construct the configuration file expected by the Duo PAM module. -sub get { - my ($self, $user, $host, $time) = @_; - $time ||= time; - - # Check that the object isn't locked. - my $id = $self->{type} . ':' . $self->{name}; - if ($self->flag_check ('locked')) { - $self->error ("cannot get $id: object is locked"); - return; - } - - # Retrieve the integration from Duo. - my $key; - eval { - my %search = (du_name => $self->{name}); - my $row = $self->{schema}->resultset ('Duo')->find (\%search); - $key = $row->get_column ('du_key'); - }; - if ($@) { - $self->error ($@); - return; - } - my $integration = Net::Duo::Admin::Integration->new ($self->{duo}, $key); - - # We also need the admin server name, which we can get from the Duo object - # configuration with a bit of JSON decoding. - my $json = JSON->new->utf8 (1); - my $config = $json->decode (scalar slurp $Wallet::Config::DUO_KEY_FILE); - - # Construct the returned file. - my $output = "[duo]\n"; - $output .= "ikey = $key\n"; - $output .= 'skey = ' . $integration->secret_key . "\n"; - $output .= "host = $config->{api_hostname}\n"; - - # Log the action and return. - $self->log_action ('get', $user, $host, $time); - return $output; -} - -1; -__END__ - -############################################################################## -# Documentation -############################################################################## - -=for stopwords -Allbery Duo integration DBH keytab - -=head1 NAME - -Wallet::Object::Duo - Duo integration object implementation for wallet - -=head1 SYNOPSIS - - my @name = qw(duo host.example.com); - my @trace = ($user, $host, time); - my $object = Wallet::Object::Duo->create (@name, $schema, @trace); - my $config = $object->get (@trace); - $object->destroy (@trace); - -=head1 DESCRIPTION - -Wallet::Object::Duo is a representation of Duo integrations the wallet. -It implements the wallet object API and provides the necessary glue to -create a Duo integration, return a configuration file containing the key -and API information for that integration, and delete the integration from -Duo when the wallet object is destroyed. - -Currently, only one configured integration type can be managed by the -wallet, and the integration information is always returned in the -configuration file format expected by the Duo UNIX integration. The -results of retrieving this object will be text, suitable for putting in -the UNIX integration configuration file, containing the integration key, -secret key, and admin hostname for that integration. - -This object can be retrieved repeatedly without changing the secret key, -matching Duo's native behavior with integrations. To change the keys of -the integration, delete it and recreate it. - -To use this object, at least one configuration parameter must be set. See -L<Wallet::Config> for details on supported configuration parameters and -information about how to set wallet configuration. - -=head1 METHODS - -This object mostly inherits from Wallet::Object::Base. See the -documentation for that class for all generic methods. Below are only -those methods that are overridden or behave specially for this -implementation. - -=over 4 - -=item create(TYPE, NAME, DBH, PRINCIPAL, HOSTNAME [, DATETIME]) - -This is a class method and should be called on the Wallet::Object::Duo -class. It creates a new object with the given TYPE and NAME (TYPE is -normally C<duo> and must be for the rest of the wallet system to use the -right class, but this module doesn't check for ease of subclassing), using -DBH as the handle to the wallet metadata database. PRINCIPAL, HOSTNAME, -and DATETIME are stored as history information. PRINCIPAL should be the -user who is creating the object. If DATETIME isn't given, the current -time is used. - -When a new Duo integration object is created, a new integration will be -created in the configured Duo account and the integration key will be -stored in the wallet object. If the integration already exists, create() -will fail. The new integration's type is controlled by the DUO_TYPE -configuration variable, which defaults to C<unix>. See L<Wallet::Config> -for more information. - -If create() fails, it throws an exception. - -=item destroy(PRINCIPAL, HOSTNAME [, DATETIME]) - -Destroys a Duo integration object by removing it from the database and -deleting the integration from Duo. If deleting the Duo integration fails, -destroy() fails. Returns true on success and false on failure. The -caller should call error() to get the error message after a failure. -PRINCIPAL, HOSTNAME, and DATETIME are stored as history information. -PRINCIPAL should be the user who is destroying the object. If DATETIME -isn't given, the current time is used. - -=item get(PRINCIPAL, HOSTNAME [, DATETIME]) - -Retrieves the configuration information for the Duo integration and -returns that information in the format expected by the configuration file -for the Duo UNIX integration. Returns undef on failure. The caller -should call error() to get the error message if get() returns undef. - -The returned configuration look look like: - - [duo] - ikey = <integration-key> - skey = <secret-key> - host = <api-hostname> - -The C<host> parameter will be taken from the configuration file pointed -to by the DUO_KEY_FILE configuration variable. - -PRINCIPAL, HOSTNAME, and DATETIME are stored as history information. -PRINCIPAL should be the user who is downloading the keytab. If DATETIME -isn't given, the current time is used. - -=back - -=head1 LIMITATIONS - -Only one Duo account is supported for a given wallet implementation. -Currently, only one Duo integration type is supported as well. Further -development should expand the available integration types, possibly as -additional wallet object types. - -=head1 SEE ALSO - -Net::Duo(3), Wallet::Config(3), Wallet::Object::Base(3), wallet-backend(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 <eagle@eyrie.org> - -=cut diff --git a/perl/Wallet/Object/File.pm b/perl/Wallet/Object/File.pm deleted file mode 100644 index 4afef04..0000000 --- a/perl/Wallet/Object/File.pm +++ /dev/null @@ -1,242 +0,0 @@ -# Wallet::Object::File -- File object implementation for the wallet. -# -# Written by Russ Allbery <eagle@eyrie.org> -# Copyright 2008, 2010 -# The Board of Trustees of the Leland Stanford Junior University -# -# See LICENSE for licensing terms. - -############################################################################## -# Modules and declarations -############################################################################## - -package Wallet::Object::File; -require 5.006; - -use strict; -use vars qw(@ISA $VERSION); - -use Digest::MD5 qw(md5_hex); -use Wallet::Config (); -use Wallet::Object::Base; - -@ISA = qw(Wallet::Object::Base); - -# 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.03'; - -############################################################################## -# File naming -############################################################################## - -# Returns the path into which that file object will be stored or undef on -# error. On error, sets the internal error. -sub file_path { - my ($self) = @_; - my $name = $self->{name}; - unless ($Wallet::Config::FILE_BUCKET) { - $self->error ('file support not configured'); - return; - } - unless ($name) { - $self->error ('file objects may not have empty names'); - return; - } - my $hash = substr (md5_hex ($name), 0, 2); - $name =~ s/([^\w-])/sprintf ('%%%02X', ord ($1))/ge; - my $parent = "$Wallet::Config::FILE_BUCKET/$hash"; - unless (-d $parent || mkdir ($parent, 0700)) { - $self->error ("cannot create file bucket $hash: $!"); - return; - } - return "$Wallet::Config::FILE_BUCKET/$hash/$name"; -} - -############################################################################## -# Core methods -############################################################################## - -# Override destroy to delete the file as well. -sub destroy { - my ($self, $user, $host, $time) = @_; - my $id = $self->{type} . ':' . $self->{name}; - my $path = $self->file_path; - if (defined ($path) && -f $path && !unlink ($path)) { - $self->error ("cannot delete $id: $!"); - return; - } - return $self->SUPER::destroy ($user, $host, $time); -} - -# Return the contents of the file. -sub get { - my ($self, $user, $host, $time) = @_; - $time ||= time; - my $id = $self->{type} . ':' . $self->{name}; - if ($self->flag_check ('locked')) { - $self->error ("cannot get $id: object is locked"); - return; - } - my $path = $self->file_path; - return unless $path; - unless (open (FILE, '<', $path)) { - $self->error ("cannot get $id: object has not been stored"); - return; - } - local $/; - my $data = <FILE>; - unless (close FILE) { - $self->error ("cannot get $id: $!"); - return; - } - $self->log_action ('get', $user, $host, $time); - return $data; -} - -# Store the file on the wallet server. -sub store { - my ($self, $data, $user, $host, $time) = @_; - $time ||= time; - my $id = $self->{type} . ':' . $self->{name}; - if ($self->flag_check ('locked')) { - $self->error ("cannot store $id: object is locked"); - return; - } - if ($Wallet::Config::FILE_MAX_SIZE) { - my $max = $Wallet::Config::FILE_MAX_SIZE; - if (length ($data) > $max) { - $self->error ("data exceeds maximum of $max bytes"); - return; - } - } - my $path = $self->file_path; - return unless $path; - unless (open (FILE, '>', $path)) { - $self->error ("cannot store $id: $!"); - return; - } - unless (print FILE ($data) and close FILE) { - $self->error ("cannot store $id: $!"); - close FILE; - return; - } - $self->log_action ('store', $user, $host, $time); - return 1; -} - -1; -__END__ - -############################################################################## -# Documentation -############################################################################## - -=head1 NAME - -Wallet::Object::File - File object implementation for wallet - -=for stopwords -API HOSTNAME DATETIME keytab remctld backend nul Allbery wallet-backend - -=head1 SYNOPSIS - - my @name = qw(file mysql-lsdb) - my @trace = ($user, $host, time); - my $object = Wallet::Object::Keytab->create (@name, $schema, @trace); - unless ($object->store ("the-password\n")) { - die $object->error, "\n"; - } - my $password = $object->get (@trace); - $object->destroy (@trace); - -=head1 DESCRIPTION - -Wallet::Object::File is a representation of simple file objects in the -wallet. It implements the wallet object API and provides the necessary -glue to store a file on the wallet server, retrieve it later, and delete -it when the file object is deleted. A file object must be stored before -it can be retrieved with get. - -To use this object, the configuration option specifying where on the -wallet server to store file objects must be set. See L<Wallet::Config> -for details on this configuration parameter and information about how to -set wallet configuration. - -=head1 METHODS - -This object mostly inherits from Wallet::Object::Base. See the -documentation for that class for all generic methods. Below are only -those methods that are overridden or behave specially for this -implementation. - -=over 4 - -=item destroy(PRINCIPAL, HOSTNAME [, DATETIME]) - -Destroys a file object by removing it from the database and deleting the -corresponding file on the wallet server. Returns true on success and -false on failure. The caller should call error() to get the error message -after a failure. PRINCIPAL, HOSTNAME, and DATETIME are stored as history -information. PRINCIPAL should be the user who is destroying the object. -If DATETIME isn't given, the current time is used. - -=item get(PRINCIPAL, HOSTNAME [, DATETIME]) - -Retrieves the current contents of the file object or undef on error. -store() must be called before get() will be successful. The caller should -call error() to get the error message if get() returns undef. PRINCIPAL, -HOSTNAME, and DATETIME are stored as history information. PRINCIPAL -should be the user who is downloading the keytab. If DATETIME isn't -given, the current time is used. - -=item store(DATA, PRINCIPAL, HOSTNAME [, DATETIME]) - -Store DATA as the current contents of the file object. Any existing data -will be overwritten. Returns true on success and false on failure. The -caller should call error() to get the error message after a failure. -PRINCIPAL, HOSTNAME, and DATETIME are stored as history information. -PRINCIPAL should be the user who is destroying the object. If DATETIME -isn't given, the current time is used. - -If FILE_MAX_SIZE is set in the wallet configuration, a store() of DATA -larger than that configuration setting will be rejected. - -=back - -=head1 FILES - -=over 4 - -=item FILE_BUCKET/<hash>/<file> - -Files are stored on the wallet server under the directory FILE_BUCKET as -set in the wallet configuration. <hash> is the first two characters of -the hex-encoded MD5 hash of the wallet file object name, used to not put -too many files in the same directory. <file> is the name of the file -object with all characters other than alphanumerics, underscores, and -dashes replaced by C<%> and the hex code of the character. - -=back - -=head1 LIMITATIONS - -The wallet implementation itself can handle arbitrary file object names. -However, due to limitations in the B<remctld> server usually used to run -B<wallet-backend>, file object names containing nul characters (ASCII 0) -may not be permitted. The file system used for storing file objects may -impose a length limitation on the file object name. - -=head1 SEE ALSO - -remctld(8), Wallet::Config(3), Wallet::Object::Base(3), wallet-backend(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 <eagle@eyrie.org> - -=cut diff --git a/perl/Wallet/Object/Keytab.pm b/perl/Wallet/Object/Keytab.pm deleted file mode 100644 index 24c3302..0000000 --- a/perl/Wallet/Object/Keytab.pm +++ /dev/null @@ -1,513 +0,0 @@ -# Wallet::Object::Keytab -- Keytab object implementation for the wallet. -# -# Written by Russ Allbery <eagle@eyrie.org> -# Copyright 2007, 2008, 2009, 2010, 2013 -# The Board of Trustees of the Leland Stanford Junior University -# -# See LICENSE for licensing terms. - -############################################################################## -# Modules and declarations -############################################################################## - -package Wallet::Object::Keytab; -require 5.006; - -use strict; -use vars qw(@ISA $VERSION); - -use Wallet::Config (); -use Wallet::Object::Base; -use Wallet::Kadmin; - -@ISA = qw(Wallet::Object::Base); - -# 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.09'; - -############################################################################## -# Enctype restriction -############################################################################## - -# Set the enctype restrictions for a keytab. Called by attr() and takes a -# reference to the encryption types to set. Returns true on success and false -# on failure, setting the object error if it fails. -sub enctypes_set { - my ($self, $enctypes, $user, $host, $time) = @_; - $time ||= time; - my @trace = ($user, $host, $time); - my $name = $self->{name}; - my %enctypes = map { $_ => 1 } @$enctypes; - my $guard = $self->{schema}->txn_scope_guard; - eval { - # Find all enctypes for the given keytab. - my %search = (ke_name => $name); - my @enctypes = $self->{schema}->resultset('KeytabEnctype') - ->search (\%search); - my (@current); - for my $enctype_rs (@enctypes) { - push (@current, $enctype_rs->ke_enctype); - } - - # Use the existing enctypes and the enctypes we should have to match - # against ones that need to be removed, and note those that already - # exist. - for my $enctype (@current) { - if ($enctypes{$enctype}) { - delete $enctypes{$enctype}; - } else { - %search = (ke_name => $name, - ke_enctype => $enctype); - $self->{schema}->resultset('KeytabEnctype')->find (\%search) - ->delete; - $self->log_set ('type_data enctypes', $enctype, undef, @trace); - } - } - - # When inserting new enctypes, we unfortunately have to do the - # consistency check against the enctypes table ourselves, since SQLite - # doesn't enforce integrity constraints. We do this in sorted order - # to make it easier to test. - for my $enctype (sort keys %enctypes) { - my %search = (en_name => $enctype); - my $enctype_rs = $self->{schema}->resultset('Enctype') - ->find (\%search); - unless (defined $enctype_rs) { - die "unknown encryption type $enctype\n"; - } - my %record = (ke_name => $name, - ke_enctype => $enctype); - $self->{schema}->resultset('KeytabEnctype')->create (\%record); - $self->log_set ('type_data enctypes', undef, $enctype, @trace); - } - $guard->commit; - }; - if ($@) { - $self->error ($@); - return; - } - return 1; -} - -# Return a list of the encryption types current set for a keytab. Called by -# attr() or get(). Returns the empty list on failure or on an empty list of -# enctype restrictions, but sets the object error on failure so the caller -# should use that to determine success. -sub enctypes_list { - my ($self) = @_; - my @enctypes; - eval { - my %search = (ke_name => $self->{name}); - my %attrs = (order_by => 'ke_enctype'); - my @enctypes_rs = $self->{schema}->resultset('KeytabEnctype') - ->search (\%search, \%attrs); - for my $enctype_rs (@enctypes_rs) { - push (@enctypes, $enctype_rs->ke_enctype); - } - }; - if ($@) { - $self->error ($@); - return; - } - return @enctypes; -} - -############################################################################## -# Synchronization -############################################################################## - -# Set a synchronization target or clear the targets if $targets is an -# empty list. Returns true on success and false on failure. -# -# Currently, no synchronization targets are supported, but we preserve the -# ability to clear synchronization and the basic structure of the code so -# that they can be added later. -sub sync_set { - my ($self, $targets, $user, $host, $time) = @_; - $time ||= time; - my @trace = ($user, $host, $time); - if (@$targets > 1) { - $self->error ('only one synchronization target supported'); - return; - } elsif (@$targets) { - my $target = $targets->[0]; - $self->error ("unsupported synchronization target $target"); - return; - } else { - my $guard = $self->{schema}->txn_scope_guard; - eval { - my $name = $self->{name}; - my %search = (ks_name => $name); - my $sync_rs = $self->{schema}->resultset('KeytabSync') - ->find (\%search); - if (defined $sync_rs) { - my $target = $sync_rs->ks_target; - $sync_rs->delete; - $self->log_set ('type_data sync', $target, undef, @trace); - } - $guard->commit; - }; - if ($@) { - $self->error ($@); - return; - } - } - return 1; -} - -# Return a list of the current synchronization targets. Returns the empty -# list on failure or on an empty list of enctype restrictions, but sets -# the object error on failure so the caller should use that to determine -# success. -sub sync_list { - my ($self) = @_; - my @targets; - eval { - my %search = (ks_name => $self->{name}); - my %attrs = (order_by => 'ks_target'); - my @syncs = $self->{schema}->resultset('KeytabSync')->search (\%search, - \%attrs); - for my $sync_rs (@syncs) { - push (@targets, $sync_rs->ks_target); - } - }; - if ($@) { - $self->error ($@); - return; - } - return @targets; -} - -############################################################################## -# Core methods -############################################################################## - -# Override attr to support setting the enctypes and sync attributes. Note -# that the sync attribute has no supported targets at present and hence will -# always return an error, but the code is still here so that it doesn't have -# to be rewritten once a new sync target is added. -sub attr { - my ($self, $attribute, $values, $user, $host, $time) = @_; - $time ||= time; - my @trace = ($user, $host, $time); - my %known = map { $_ => 1 } qw(enctypes sync); - undef $self->{error}; - unless ($known{$attribute}) { - $self->error ("unknown attribute $attribute"); - return; - } - if ($values) { - if ($attribute eq 'enctypes') { - return $self->enctypes_set ($values, $user, $host, $time); - } elsif ($attribute eq 'sync') { - return $self->sync_set ($values, $user, $host, $time); - } - } else { - if ($attribute eq 'enctypes') { - return $self->enctypes_list; - } elsif ($attribute eq 'sync') { - return $self->sync_list; - } - } -} - -# Override attr_show to display the enctypes and sync attributes. -sub attr_show { - my ($self) = @_; - my $output = ''; - my @targets = $self->attr ('sync'); - if (not @targets and $self->error) { - return; - } elsif (@targets) { - $output .= sprintf ("%15s: %s\n", 'Synced with', "@targets"); - } - my @enctypes = $self->attr ('enctypes'); - if (not @enctypes and $self->error) { - return; - } elsif (@enctypes) { - $output .= sprintf ("%15s: %s\n", 'Enctypes', $enctypes[0]); - shift @enctypes; - for my $enctype (@enctypes) { - $output .= (' ' x 17) . $enctype . "\n"; - } - } - return $output; -} - -# Override new to start by creating a handle for the kadmin module we're -# using. -sub new { - my ($class, $type, $name, $schema) = @_; - my $self = { - schema => $schema, - kadmin => undef, - }; - bless $self, $class; - my $kadmin = Wallet::Kadmin->new (); - $self->{kadmin} = $kadmin; - - $self = $class->SUPER::new ($type, $name, $schema); - $self->{kadmin} = $kadmin; - return $self; -} - -# Override create to start by creating the principal in Kerberos and only -# create the entry in the database if that succeeds. Error handling isn't -# great here since we don't have a way to communicate the error back to the -# caller. -sub create { - my ($class, $type, $name, $schema, $creator, $host, $time) = @_; - my $self = { - schema => $schema, - kadmin => undef, - }; - bless $self, $class; - my $kadmin = Wallet::Kadmin->new (); - $self->{kadmin} = $kadmin; - - if (not $kadmin->create ($name)) { - die $kadmin->error, "\n"; - } - $self = $class->SUPER::create ($type, $name, $schema, $creator, $host, - $time); - $self->{kadmin} = $kadmin; - return $self; -} - -# Override destroy to delete the principal out of Kerberos as well. -sub destroy { - my ($self, $user, $host, $time) = @_; - my $id = $self->{type} . ':' . $self->{name}; - if ($self->flag_check ('locked')) { - $self->error ("cannot destroy $id: object is locked"); - return; - } - my $schema = $self->{schema}; - my $guard = $schema->txn_scope_guard; - eval { - my %search = (ks_name => $self->{name}); - my $sync_rs = $schema->resultset('KeytabSync')->search (\%search); - $sync_rs->delete_all if defined $sync_rs; - - %search = (ke_name => $self->{name}); - my $enctype_rs = $schema->resultset('KeytabEnctype')->search (\%search); - $enctype_rs->delete_all if defined $enctype_rs; - - $guard->commit; - }; - if ($@) { - $self->error ($@); - return; - } - my $kadmin = $self->{kadmin}; - if (not $kadmin->destroy ($self->{name})) { - $self->error ($kadmin->error); - return; - } - return $self->SUPER::destroy ($user, $host, $time); -} - -# Our get implementation. Generate a keytab into a temporary file and then -# return that as the return value. -sub get { - my ($self, $user, $host, $time) = @_; - $time ||= time; - my $id = $self->{type} . ':' . $self->{name}; - if ($self->flag_check ('locked')) { - $self->error ("cannot get $id: object is locked"); - return; - } - my $kadmin = $self->{kadmin}; - my $result; - if ($self->flag_check ('unchanging')) { - $result = $kadmin->keytab ($self->{name}); - } else { - my @enctypes = $self->attr ('enctypes'); - $result = $kadmin->keytab_rekey ($self->{name}, @enctypes); - } - if (defined $result) { - $self->log_action ('get', $user, $host, $time); - } else { - $self->error ($kadmin->error); - } - return $result; -} - -1; -__END__ - -############################################################################## -# Documentation -############################################################################## - -=for stopwords -keytab API KDC keytabs HOSTNAME DATETIME enctypes enctype DBH metadata -unmanaged kadmin Allbery unlinked - -=head1 NAME - -Wallet::Object::Keytab - Keytab object implementation for wallet - -=head1 SYNOPSIS - - my @name = qw(keytab host/shell.example.com); - my @trace = ($user, $host, time); - my $object = Wallet::Object::Keytab->create (@name, $schema, @trace); - my $keytab = $object->get (@trace); - $object->destroy (@trace); - -=head1 DESCRIPTION - -Wallet::Object::Keytab is a representation of Kerberos keytab objects in -the wallet. It implements the wallet object API and provides the -necessary glue to create principals in a Kerberos KDC, create and return -keytabs for those principals, and delete them out of Kerberos when the -wallet object is destroyed. - -A keytab is an on-disk store for the key or keys for a Kerberos principal. -Keytabs are used by services to verify incoming authentication from -clients or by automated processes that need to authenticate to Kerberos. -To create a keytab, the principal has to be created in Kerberos and then a -keytab is generated and stored in a file on disk. - -This implementation generates a new random key (and hence invalidates all -existing keytabs) each time the keytab is retrieved with the get() method. - -To use this object, several configuration parameters must be set. See -L<Wallet::Config> for details on those configuration parameters and -information about how to set wallet configuration. - -=head1 METHODS - -This object mostly inherits from Wallet::Object::Base. See the -documentation for that class for all generic methods. Below are only -those methods that are overridden or behave specially for this -implementation. - -=over 4 - -=item attr(ATTRIBUTE [, VALUES, PRINCIPAL, HOSTNAME [, DATETIME]]) - -Sets or retrieves a given object attribute. The following attribute is -supported: - -=over 4 - -=item enctypes - -Restricts the generated keytab to a specific set of encryption types. The -values of this attribute must be enctype strings recognized by Kerberos -(strings like C<aes256-cts-hmac-sha1-96> or C<des-cbc-crc>). Encryption -types must also be present in the list of supported enctypes stored in the -database database or the attr() method will reject them. Note that the -salt should not be included; since the salt is irrelevant for keytab keys, -it will always be set to the default by the wallet. - -If this attribute is set, the principal will be restricted to that -specific enctype list when get() is called for that keytab. If it is not -set, the default set in the KDC will be used. - -This attribute is ignored if the C<unchanging> flag is set on a keytab. -Keytabs retrieved with C<unchanging> set will contain all keys present in -the KDC for that Kerberos principal and therefore may contain different -enctypes than those requested by this attribute. - -=item sync - -This attribute is intended to set a list of external systems with which -data about this keytab is synchronized, but there are no supported targets -currently. However, there is support for clearing this attribute or -returning its current value. - -=back - -If no other arguments besides ATTRIBUTE are given, returns the values of -that attribute, if any, as a list. On error, returns the empty list. To -distinguish between an error and an empty return, call error() afterward. -It is guaranteed to return undef unless there was an error. - -If other arguments are given, sets the given ATTRIBUTE values to VALUES, -which must be a reference to an array (even if only one value is being -set). Pass a reference to an empty array to clear the attribute values. -PRINCIPAL, HOSTNAME, and DATETIME are stored as history information. -PRINCIPAL should be the user who is destroying the object. If DATETIME -isn't given, the current time is used. - -=item create(TYPE, NAME, DBH, PRINCIPAL, HOSTNAME [, DATETIME]) - -This is a class method and should be called on the Wallet::Object::Keytab -class. It creates a new object with the given TYPE and NAME (TYPE is -normally C<keytab> and must be for the rest of the wallet system to use -the right class, but this module doesn't check for ease of subclassing), -using DBH as the handle to the wallet metadata database. PRINCIPAL, -HOSTNAME, and DATETIME are stored as history information. PRINCIPAL -should be the user who is creating the object. If DATETIME isn't given, -the current time is used. - -When a new keytab object is created, the Kerberos principal designated by -NAME is also created in the Kerberos realm determined from the wallet -configuration. If the principal already exists, create() still succeeds -(so that a previously unmanaged principal can be imported into the -wallet). Otherwise, if the Kerberos principal could not be created, -create() fails. The principal is created with the randomized keys. NAME -must not contain the realm; instead, the KEYTAB_REALM configuration -variable should be set. See L<Wallet::Config> for more information. - -If create() fails, it throws an exception. - -=item destroy(PRINCIPAL, HOSTNAME [, DATETIME]) - -Destroys a keytab object by removing it from the database and deleting the -principal out of Kerberos. If deleting the principal fails, destroy() -fails, but destroy() succeeds if the principal didn't exist when it was -called (so that it can be used to clean up stranded entries). Returns -true on success and false on failure. The caller should call error() to -get the error message after a failure. PRINCIPAL, HOSTNAME, and DATETIME -are stored as history information. PRINCIPAL should be the user who is -destroying the object. If DATETIME isn't given, the current time is used. - -=item get(PRINCIPAL, HOSTNAME [, DATETIME]) - -Retrieves a keytab for this object and returns the keytab data or undef on -error. The caller should call error() to get the error message if get() -returns undef. The keytab is created with new randomized keys, -invalidating any existing keytabs for that principal, unless the -unchanging flag is set on the object. PRINCIPAL, HOSTNAME, and DATETIME -are stored as history information. PRINCIPAL should be the user who is -downloading the keytab. If DATETIME isn't given, the current time is -used. - -=back - -=head1 FILES - -=over 4 - -=item KEYTAB_TMP/keytab.<pid> - -The keytab is created in this file and then read into memory. KEYTAB_TMP -is set in the wallet configuration, and <pid> is the process ID of the -current process. The file is unlinked after being read. - -=back - -=head1 LIMITATIONS - -Only one Kerberos realm is supported for a given wallet implementation and -all keytab objects stored must be in that realm. Keytab names in the -wallet database do not have realm information. - -=head1 SEE ALSO - -kadmin(8), Wallet::Config(3), Wallet::Object::Base(3), wallet-backend(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 <eagle@eyrie.org> - -=cut diff --git a/perl/Wallet/Object/WAKeyring.pm b/perl/Wallet/Object/WAKeyring.pm deleted file mode 100644 index f8bd0f7..0000000 --- a/perl/Wallet/Object/WAKeyring.pm +++ /dev/null @@ -1,370 +0,0 @@ -# Wallet::Object::WAKeyring -- WebAuth keyring object implementation. -# -# Written by Russ Allbery <eagle@eyrie.org> -# Copyright 2012, 2013 -# The Board of Trustees of the Leland Stanford Junior University -# -# See LICENSE for licensing terms. - -############################################################################## -# Modules and declarations -############################################################################## - -package Wallet::Object::WAKeyring; -require 5.006; - -use strict; -use vars qw(@ISA $VERSION); - -use Digest::MD5 qw(md5_hex); -use Fcntl qw(LOCK_EX); -use Wallet::Config (); -use Wallet::Object::Base; -use WebAuth 3.06 qw(WA_KEY_AES WA_AES_128); - -@ISA = qw(Wallet::Object::Base); - -# 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'; - -############################################################################## -# File naming -############################################################################## - -# Returns the path into which that keyring object will be stored or undef on -# error. On error, sets the internal error. -sub file_path { - my ($self) = @_; - my $name = $self->{name}; - unless ($Wallet::Config::WAKEYRING_BUCKET) { - $self->error ('WebAuth keyring support not configured'); - return; - } - unless ($name) { - $self->error ('WebAuth keyring objects may not have empty names'); - return; - } - my $hash = substr (md5_hex ($name), 0, 2); - $name =~ s/([^\w-])/sprintf ('%%%02X', ord ($1))/ge; - my $parent = "$Wallet::Config::WAKEYRING_BUCKET/$hash"; - unless (-d $parent || mkdir ($parent, 0700)) { - $self->error ("cannot create keyring bucket $hash: $!"); - return; - } - return "$Wallet::Config::WAKEYRING_BUCKET/$hash/$name"; -} - -############################################################################## -# Core methods -############################################################################## - -# Override destroy to delete the file as well. -sub destroy { - my ($self, $user, $host, $time) = @_; - my $id = $self->{type} . ':' . $self->{name}; - my $path = $self->file_path; - if (defined ($path) && -f $path && !unlink ($path)) { - $self->error ("cannot delete $id: $!"); - return; - } - return $self->SUPER::destroy ($user, $host, $time); -} - -# Update the keyring if needed, and then return the contents of the current -# keyring. -sub get { - my ($self, $user, $host, $time) = @_; - $time ||= time; - my $id = $self->{type} . ':' . $self->{name}; - if ($self->flag_check ('locked')) { - $self->error ("cannot get $id: object is locked"); - return; - } - my $path = $self->file_path; - return unless defined $path; - - # Create a WebAuth context and ensure we can load the relevant modules. - my $wa = eval { WebAuth->new }; - if ($@) { - $self->error ("cannot initialize WebAuth: $@"); - return; - } - - # Check if the keyring already exists. If not, create a new one with a - # single key that's immediately valid and two more that will become valid - # in the future. - # - # If the keyring does already exist, get a lock on the file. At the end - # of this process, we'll do an atomic update and then drop our lock. - # - # FIXME: There are probably better ways to do this. There are some race - # conditions here, particularly with new keyrings. - unless (open (FILE, '+<', $path)) { - my $data; - eval { - my $key = $wa->key_create (WA_KEY_AES, WA_AES_128); - my $ring = $wa->keyring_new ($key); - $key = $wa->key_create (WA_KEY_AES, WA_AES_128); - my $valid = time + $Wallet::Config::WAKEYRING_REKEY_INTERVAL; - $ring->add (time, $valid, $key); - $key = $wa->key_create (WA_KEY_AES, WA_AES_128); - $valid += $Wallet::Config::WAKEYRING_REKEY_INTERVAL; - $ring->add (time, $valid, $key); - $data = $ring->encode; - $ring->write ($path); - }; - if ($@) { - $self->error ("cannot create new keyring"); - return; - }; - $self->log_action ('get', $user, $host, $time); - return $data; - } - unless (flock (FILE, LOCK_EX)) { - $self->error ("cannot get lock on keyring: $!"); - return; - } - - # Read the keyring. - my $ring = eval { WebAuth::Keyring->read ($wa, $path) }; - if ($@) { - $self->error ("cannot read keyring: $@"); - return; - } - - # If the most recent key has a valid-after older than now + - # WAKEYRING_REKEY_INTERVAL, we generate a new key with a valid_after of - # now + 2 * WAKEYRING_REKEY_INTERVAL. - my ($count, $newest) = (0, 0); - for my $entry ($ring->entries) { - $count++; - if ($entry->valid_after > $newest) { - $newest = $entry->valid_after; - } - } - eval { - if ($newest <= time + $Wallet::Config::WAKEYRING_REKEY_INTERVAL) { - my $valid = time + 2 * $Wallet::Config::WAKEYRING_REKEY_INTERVAL; - my $key = $wa->key_create (WA_KEY_AES, WA_AES_128); - $ring->add (time, $valid, $key); - } - }; - if ($@) { - $self->error ("cannot add new key: $@"); - return; - } - - # If there are any keys older than the purge interval, remove them, but - # only do so if we have more than three keys (the one that's currently - # active, the one that's going to come active in the rekey interval, and - # the one that's going to come active after that. - # - # FIXME: Be sure that we don't remove the last currently-valid key. - my $cutoff = time - $Wallet::Config::WAKEYRING_PURGE_INTERVAL; - my $i = 0; - my @purge; - if ($count > 3) { - for my $entry ($ring->entries) { - if ($entry->creation < $cutoff) { - push (@purge, $i); - } - $i++; - } - } - if (@purge && $count - @purge >= 3) { - eval { - for my $key (reverse @purge) { - $ring->remove ($key); - } - }; - if ($@) { - $self->error ("cannot remove old keys: $@"); - return; - } - } - - # Encode the key. - my $data = eval { $ring->encode }; - if ($@) { - $self->error ("cannot encode keyring: $@"); - return; - } - - # Write the new keyring to the path. - eval { $ring->write ($path) }; - if ($@) { - $self->error ("cannot store new keyring: $@"); - return; - } - close FILE; - $self->log_action ('get', $user, $host, $time); - return $data; -} - -# Store the file on the wallet server. -# -# FIXME: Check the provided keyring for validity. -sub store { - my ($self, $data, $user, $host, $time) = @_; - $time ||= time; - my $id = $self->{type} . ':' . $self->{name}; - if ($self->flag_check ('locked')) { - $self->error ("cannot store $id: object is locked"); - return; - } - if ($Wallet::Config::FILE_MAX_SIZE) { - my $max = $Wallet::Config::FILE_MAX_SIZE; - if (length ($data) > $max) { - $self->error ("data exceeds maximum of $max bytes"); - return; - } - } - my $path = $self->file_path; - return unless $path; - unless (open (FILE, '>', $path)) { - $self->error ("cannot store $id: $!"); - return; - } - unless (print FILE ($data) and close FILE) { - $self->error ("cannot store $id: $!"); - close FILE; - return; - } - $self->log_action ('store', $user, $host, $time); - return 1; -} - -1; -__END__ - -############################################################################## -# Documentation -############################################################################## - -=for stopwords -WebAuth keyring keyrings API HOSTNAME DATETIME keytab AES rekey Allbery - -=head1 NAME - -Wallet::Object::WAKeyring - WebAuth keyring object implementation for wallet - -=head1 SYNOPSIS - - my ($user, $host, $time); - my @name = qw(wa-keyring www.stanford.edu); - my @trace = ($user, $host, $time); - my $object = Wallet::Object::WAKeyring->create (@name, $schema, $trace); - my $keyring = $object->get (@trace); - unless ($object->store ($keyring)) { - die $object->error, "\n"; - } - $object->destroy (@trace); - -=head1 DESCRIPTION - -Wallet::Object::WAKeyring is a representation of a WebAuth keyring in the -wallet. It implements the wallet object API and provides the necessary -glue to store a keyring on the wallet server, retrieve it, update the -keyring with new keys automatically as needed, purge old keys -automatically, and delete the keyring when the object is deleted. - -WebAuth keyrings hold one or more keys. Each key has a creation time and -a validity time. The key cannot be used until its validity time has been -reached. This permits safe key rotation: a new key is added with a -validity time in the future, and then the keyring is updated everywhere it -needs to be before that validity time is reached. This wallet object -automatically handles key rotation by adding keys with validity dates in -the future and removing keys with creation dates substantially in the -past. - -To use this object, various configuration options specifying where to -store the keyrings and how to handle key rotation must be set. See -Wallet::Config for details on these configuration parameters and -information about how to set wallet configuration. - -=head1 METHODS - -This object mostly inherits from Wallet::Object::Base. See the -documentation for that class for all generic methods. Below are only -those methods that are overridden or behave specially for this -implementation. - -=over 4 - -=item destroy(PRINCIPAL, HOSTNAME [, DATETIME]) - -Destroys a WebAuth keyring object by removing it from the database and -deleting the corresponding file on the wallet server. Returns true on -success and false on failure. The caller should call error() to get the -error message after a failure. PRINCIPAL, HOSTNAME, and DATETIME are -stored as history information. PRINCIPAL should be the user who is -destroying the object. If DATETIME isn't given, the current time is used. - -=item get(PRINCIPAL, HOSTNAME [, DATETIME]) - -Either creates a new WebAuth keyring (if this object has not bee stored or -retrieved before) or does any necessary periodic maintenance on the -keyring and then returns its data. The caller should call error() to get -the error message if get() returns undef. PRINCIPAL, HOSTNAME, and -DATETIME are stored as history information. PRINCIPAL should be the user -who is downloading the keytab. If DATETIME isn't given, the current time -is used. - -If this object has never been stored or retrieved before, a new keyring -will be created with three 128-bit AES keys: one that is immediately -valid, one that will become valid after the rekey interval, and one that -will become valid after twice the rekey interval. - -If keyring data for this object already exists, the creation and validity -dates for each key in the keyring will be examined. If the key with the -validity date the farthest into the future has a date that's less than or -equal to the current time plus the rekey interval, a new 128-bit AES key -will be added to the keyring with a validity time of twice the rekey -interval in the future. Finally, all keys with a creation date older than -the configured purge interval will be removed provided that the keyring -has at least three keys - -=item store(DATA, PRINCIPAL, HOSTNAME [, DATETIME]) - -Store DATA as the current contents of the WebAuth keyring object. Note -that this is not checked for validity, just assumed to be a valid keyring. -Any existing data will be overwritten. Returns true on success and false -on failure. The caller should call error() to get the error message after -a failure. PRINCIPAL, HOSTNAME, and DATETIME are stored as history -information. PRINCIPAL should be the user who is destroying the object. -If DATETIME isn't given, the current time is used. - -If FILE_MAX_SIZE is set in the wallet configuration, a store() of DATA -larger than that configuration setting will be rejected. - -=back - -=head1 FILES - -=over 4 - -=item WAKEYRING_BUCKET/<hash>/<file> - -WebAuth keyrings are stored on the wallet server under the directory -WAKEYRING_BUCKET as set in the wallet configuration. <hash> is the first -two characters of the hex-encoded MD5 hash of the wallet file object name, -used to not put too many files in the same directory. <file> is the name -of the file object with all characters other than alphanumerics, -underscores, and dashes replaced by "%" and the hex code of the character. - -=back - -=head1 SEE ALSO - -Wallet::Config(3), Wallet::Object::Base(3), wallet-backend(8), WebAuth(3) - -This module is part of the wallet system. The current version is available -from <http://www.eyrie.org/~eagle/software/wallet/>. - -=head1 AUTHOR - -Russ Allbery <eagle@eyrie.org> - -=cut |