diff options
Diffstat (limited to 'perl')
| -rw-r--r-- | perl/lib/Wallet/Object/Base.pm | 9 | ||||
| -rw-r--r-- | perl/lib/Wallet/Object/Keytab.pm | 59 | ||||
| -rw-r--r-- | perl/lib/Wallet/Object/Password.pm | 32 | ||||
| -rw-r--r-- | perl/lib/Wallet/Server.pm | 15 | ||||
| -rwxr-xr-x | perl/t/object/base.t | 5 | ||||
| -rw-r--r-- | perl/t/object/password.t | 8 | 
6 files changed, 100 insertions, 28 deletions
| diff --git a/perl/lib/Wallet/Object/Base.pm b/perl/lib/Wallet/Object/Base.pm index bdd61fb..97e6127 100644 --- a/perl/lib/Wallet/Object/Base.pm +++ b/perl/lib/Wallet/Object/Base.pm @@ -609,6 +609,15 @@ sub history {  # The get methods must always be overridden by the subclass.  sub get { die "Do not instantiate Wallet::Object::Base directly\n"; } +# The update method should only work if a subclass supports it as something +# different from get.  That makes it explicit about whether the subclass has +# a meaningful update. +sub update { +    my ($self) = @_; +    $self->error ("update is not supported for this type, use get instead"); +    return; +} +  # 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 { diff --git a/perl/lib/Wallet/Object/Keytab.pm b/perl/lib/Wallet/Object/Keytab.pm index 975179b..c625766 100644 --- a/perl/lib/Wallet/Object/Keytab.pm +++ b/perl/lib/Wallet/Object/Keytab.pm @@ -29,6 +29,37 @@ use Wallet::Kadmin;  $VERSION = '0.09';  ############################################################################## +# Shared methods +############################################################################## + +# Generate a keytab into a temporary file and then return that as the return +# value.  Used by both get and update, as the only difference is how we +# handle the unchanging flag. +sub retrieve { +    my ($self, $operation, $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 ($operation eq 'get' && $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 ($operation, $user, $host, $time); +    } else { +        $self->error ($kadmin->error); +    } +    return $result; +} + +##############################################################################  # Enctype restriction  ############################################################################## @@ -314,25 +345,15 @@ sub destroy {  # 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); -    } +    my $result = $self->retrieve ('get', $user, $host, $time); +    return $result; +} + +# Our update implementation.  Generate a new keytab regardless of the +# unchanging flag. +sub update { +    my ($self, $user, $host, $time) = @_; +    my $result = $self->retrieve ('update', $user, $host, $time);      return $result;  } diff --git a/perl/lib/Wallet/Object/Password.pm b/perl/lib/Wallet/Object/Password.pm index d06c8a6..3fd6ec8 100644 --- a/perl/lib/Wallet/Object/Password.pm +++ b/perl/lib/Wallet/Object/Password.pm @@ -57,12 +57,12 @@ sub file_path {  }  ############################################################################## -# Core methods +# Shared methods  ##############################################################################  # Return the contents of the file. -sub get { -    my ($self, $user, $host, $time) = @_; +sub retrieve { +    my ($self, $operation, $user, $host, $time) = @_;      $time ||= time;      my $id = $self->{type} . ':' . $self->{name};      if ($self->flag_check ('locked')) { @@ -72,13 +72,13 @@ sub get {      my $path = $self->file_path;      return unless $path; -    # If nothing is yet stored, generate a random password and save it to -    # the file. +    # If nothing is yet stored, or we have requested an update, generate a +    # random password and save it to the file.      my $schema = $self->{schema};      my %search = (ob_type => $self->{type},                    ob_name => $self->{name});      my $object = $schema->resultset('Object')->find (\%search); -    unless ($object->ob_stored_on) { +    if (!$object->ob_stored_on || $operation eq 'update') {          unless (open (FILE, '>', $path)) {              $self->error ("cannot store initial settings for $id: $!\n");              return; @@ -103,10 +103,28 @@ sub get {          $self->error ("cannot get $id: $!");          return;      } -    $self->log_action ('get', $user, $host, $time); +    $self->log_action ($operation, $user, $host, $time);      return $data;  } +############################################################################## +# Core methods +############################################################################## + +# Return the contents of the file. +sub get { +    my ($self, $user, $host, $time) = @_; +    my $result = $self->retrieve ('get', $user, $host, $time); +    return $result; +} + +# Return the contents of the file after resetting them to a random string. +sub update { +    my ($self, $user, $host, $time) = @_; +    my $result = $self->retrieve ('update', $user, $host, $time); +    return $result; +} +  1;  __END__ diff --git a/perl/lib/Wallet/Server.pm b/perl/lib/Wallet/Server.pm index 6af0570..3ef5954 100644 --- a/perl/lib/Wallet/Server.pm +++ b/perl/lib/Wallet/Server.pm @@ -516,6 +516,21 @@ sub get {      return $result;  } +# Retrieve the information associated with an object, updating the current +# information if we are of a type that allows autogenerated information. +# Returns undef and sets the internal error if the retrieval fails or if the +# user isn't authorized.  If the object doesn't exist, attempts dynamic +# creation of the object using the default ACL mappings (if any). +sub update { +    my ($self, $type, $name) = @_; +    my $object = $self->retrieve ($type, $name); +    return unless defined $object; +    return unless $self->acl_verify ($object, 'get'); +    my $result = $object->update ($self->{user}, $self->{host}); +    $self->error ($object->error) unless defined $result; +    return $result; +} +  # Store new data in an object, or returns undef and sets the internal error if  # the object can't be found or if the user isn't authorized.  Also don't  # permit storing undef, although storing the empty string is fine.  If the diff --git a/perl/t/object/base.t b/perl/t/object/base.t index ee9ff4b..8fedd64 100755 --- a/perl/t/object/base.t +++ b/perl/t/object/base.t @@ -12,7 +12,7 @@ use strict;  use warnings;  use POSIX qw(strftime); -use Test::More tests => 137; +use Test::More tests => 139;  use Wallet::ACL;  use Wallet::Admin; @@ -208,6 +208,9 @@ is ($object->flag_clear ('locked', @trace), 1, 'Clearing locked succeeds');  eval { $object->get (@trace) };  is ($@, "Do not instantiate Wallet::Object::Base directly\n",      'Get fails with the right error'); +ok (!$object->update (@trace), 'Update fails'); +is ($object->error, 'update is not supported for this type, use get instead', +    ' with the right error');  ok (! $object->store ("Some data", @trace), 'Store fails');  is ($object->error, "cannot store keytab:$princ: object type is immutable",      ' with the right error'); diff --git a/perl/t/object/password.t b/perl/t/object/password.t index c0f2fbc..4fe6b50 100644 --- a/perl/t/object/password.t +++ b/perl/t/object/password.t @@ -13,7 +13,7 @@ use strict;  use warnings;  use POSIX qw(strftime); -use Test::More tests => 31; +use Test::More tests => 33;  use Wallet::Admin;  use Wallet::Config; @@ -111,6 +111,12 @@ ok (-f 'test-files/09/test', ' and the file exists');  is (contents ('test-files/09/test'), 'bar', ' with the right contents');  is ($object->get (@trace), "bar\n\0baz\n", ' and get returns correctly'); +# And check to make sure update changes the contents. +$pwd = $object->update (@trace); +isnt ($pwd, "bar\n\0baz\n", 'Update changes the contents'); +like ($pwd, qr{^.{$Wallet::Config::PWD_LENGTH_MIN}$}, +      ' to a random password string of the right length'); +  # Clean up.  $admin->destroy;  END { | 
