diff options
Diffstat (limited to 'perl/lib/Wallet/Object')
| -rw-r--r-- | perl/lib/Wallet/Object/Base.pm | 1052 | ||||
| -rw-r--r-- | perl/lib/Wallet/Object/Duo.pm | 332 | ||||
| -rw-r--r-- | perl/lib/Wallet/Object/File.pm | 243 | ||||
| -rw-r--r-- | perl/lib/Wallet/Object/Keytab.pm | 514 | ||||
| -rw-r--r-- | perl/lib/Wallet/Object/WAKeyring.pm | 371 |
5 files changed, 2512 insertions, 0 deletions
diff --git a/perl/lib/Wallet/Object/Base.pm b/perl/lib/Wallet/Object/Base.pm new file mode 100644 index 0000000..a6a78bf --- /dev/null +++ b/perl/lib/Wallet/Object/Base.pm @@ -0,0 +1,1052 @@ +# Wallet::Object::Base -- Parent class for any object stored in the wallet. +# +# Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2007, 2008, 2010, 2011, 2014 +# 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 warnings; +use vars qw($VERSION); + +use DateTime; +use Date::Parse qw(str2time); +use DBI; +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.08'; + +############################################################################## +# 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 $date = DateTime->from_epoch (epoch => $time); + my %record = (ob_type => $type, + ob_name => $name, + ob_created_by => $user, + ob_created_from => $host, + ob_created_on => $date); + $schema->resultset('Object')->create (\%record); + %record = (oh_type => $type, + oh_name => $name, + oh_action => 'create', + oh_by => $user, + oh_from => $host, + oh_on => $date); + $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 $date = DateTime->from_epoch (epoch => $time); + my %record = (oh_type => $self->{type}, + oh_name => $self->{name}, + oh_action => $action, + oh_by => $user, + oh_from => $host, + oh_on => $date); + $self->{schema}->resultset('ObjectHistory')->create (\%record); + + # Add in more timestamps based on the action type. + 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 ($date); + } elsif ($action eq 'store') { + $object->ob_stored_by ($user); + $object->ob_stored_from ($host); + $object->ob_stored_on ($date); + } + $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 $date = DateTime->from_epoch (epoch => $time); + 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 => $date); + $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 $column = "ob_$attr"; + my $old = $object->$column; + my $new = $value; + $object->update ({ $column => $value }); + + if (ref ($old) && $old->isa ('DateTime')) { + $old->set_time_zone ('local'); + $old = $old->ymd . q{ } . $old->hms; + } + if (ref ($new) && $new->isa ('DateTime')) { + $new->set_time_zone ('local'); + $new = $new->ymd . q{ } . $new->hms; + } + $self->log_set ($attr, $old, $new, $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->$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 { + my $id = $self->_get_internal ($attr); + return unless defined $id; + my $acl = eval { Wallet::ACL->new ($id, $self->{schema}) }; + if ($@) { + $self->error ($@); + return; + } + return $acl->name; + } +} + +# 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) { + my $seconds = str2time ($expires); + unless (defined $seconds) { + $self->error ("malformed expiration time $expires"); + return; + } + my $date = DateTime->from_epoch (epoch => $seconds); + return $self->_set_internal ('expires', $date, $user, $host, $time); + } elsif (defined $expires) { + return $self->_set_internal ('expires', undef, $user, $host, $time); + } else { + my $date = $self->_get_internal ('expires'); + if (defined $date) { + $date->set_time_zone ('local'); + return $date->ymd . q{ } . $date->hms; + } else { + return; + } + } +} + +# 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 { + my $id = $self->_get_internal ('owner'); + return unless defined $id; + my $acl = eval { Wallet::ACL->new ($id, $self->{schema}) }; + if ($@) { + $self->error ($@); + return; + } + return $acl->name; + } +} + +############################################################################## +# 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_id'); + my @history = $self->{schema}->resultset('ObjectHistory') + ->search (\%search, \%attrs); + + for my $history_rs (@history) { + my $date = $history_rs->oh_on; + $date->set_time_zone ('local'); + $output .= sprintf ("%s %s ", $date->ymd, $date->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]; + my $value = $object_rs->$field; + next unless defined($value); + + 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}//; + } elsif ($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; + } elsif (ref ($value) && $value->isa ('DateTime')) { + $value->set_time_zone ('local'); + $value = sprintf ("%s %s", $value->ymd, $value->hms); + } elsif ($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 $date = DateTime->from_epoch (epoch => $time); + my %record = (oh_type => $type, + oh_name => $name, + oh_action => 'destroy', + oh_by => $user, + oh_from => $host, + oh_on => $date); + $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/lib/Wallet/Object/Duo.pm b/perl/lib/Wallet/Object/Duo.pm new file mode 100644 index 0000000..e3fe2da --- /dev/null +++ b/perl/lib/Wallet/Object/Duo.pm @@ -0,0 +1,332 @@ +# 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 warnings; +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/lib/Wallet/Object/File.pm b/perl/lib/Wallet/Object/File.pm new file mode 100644 index 0000000..1ff1288 --- /dev/null +++ b/perl/lib/Wallet/Object/File.pm @@ -0,0 +1,243 @@ +# Wallet::Object::File -- File object implementation for the wallet. +# +# Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2008, 2010, 2014 +# 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 warnings; +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/lib/Wallet/Object/Keytab.pm b/perl/lib/Wallet/Object/Keytab.pm new file mode 100644 index 0000000..975179b --- /dev/null +++ b/perl/lib/Wallet/Object/Keytab.pm @@ -0,0 +1,514 @@ +# Wallet::Object::Keytab -- Keytab object implementation for the wallet. +# +# Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2007, 2008, 2009, 2010, 2013, 2014 +# 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 warnings; +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/lib/Wallet/Object/WAKeyring.pm b/perl/lib/Wallet/Object/WAKeyring.pm new file mode 100644 index 0000000..3e80300 --- /dev/null +++ b/perl/lib/Wallet/Object/WAKeyring.pm @@ -0,0 +1,371 @@ +# Wallet::Object::WAKeyring -- WebAuth keyring object implementation. +# +# Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2012, 2013, 2014 +# 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 warnings; +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 |