diff options
| -rw-r--r-- | perl/lib/Wallet/ACL.pm | 38 | ||||
| -rw-r--r-- | perl/lib/Wallet/ACL/Base.pm | 13 | ||||
| -rw-r--r-- | perl/lib/Wallet/ACL/Nested.pm | 195 | ||||
| -rw-r--r-- | perl/lib/Wallet/Admin.pm | 1 | ||||
| -rwxr-xr-x | perl/t/general/acl.t | 81 | ||||
| -rwxr-xr-x | perl/t/general/report.t | 9 | ||||
| -rwxr-xr-x | perl/t/policy/stanford.t | 2 | ||||
| -rwxr-xr-x | perl/t/verifier/nested.t | 84 | 
8 files changed, 381 insertions, 42 deletions
| diff --git a/perl/lib/Wallet/ACL.pm b/perl/lib/Wallet/ACL.pm index 260ff22..6d8005d 100644 --- a/perl/lib/Wallet/ACL.pm +++ b/perl/lib/Wallet/ACL.pm @@ -198,6 +198,19 @@ sub rename {          $acls->ac_name ($name);          $acls->update;          $self->log_acl ('rename', undef, undef, $user, $host, $time); + +        # Find any references to this being used as a nested verifier and +        # update the name.  This really breaks out of the normal flow, but +        # it's hard to do otherwise. +        %search = (ae_scheme     => 'nested', +                   ae_identifier => $self->{name}, +                  ); +        my @entries = $self->{schema}->resultset('AclEntry')->search(\%search); +        for my $entry (@entries) { +            $entry->ae_identifier ($name); +            $entry->update; +        } +          $guard->commit;      };      if ($@) { @@ -267,6 +280,17 @@ sub destroy {              $entry->delete;          } +        # Find any references to this being used as a nested verifier and +        # remove them.  This really breaks out of the normal flow, but it's +        # hard to do otherwise. +        %search = (ae_scheme     => 'nested', +                   ae_identifier => $self->{name}, +                  ); +        @entries = $self->{schema}->resultset('AclEntry')->search(\%search); +        for my $entry (@entries) { +            $entry->delete; +        } +          # There should definitely be an ACL record to delete.          %search = (ac_id => $self->{id});          my $entry = $self->{schema}->resultset('Acl')->find(\%search); @@ -302,6 +326,18 @@ sub add {          $self->error ("unknown ACL scheme $scheme");          return;      } + +    # Check to make sure that this entry has a valid name for the scheme. +    my $class = $self->scheme_mapping ($scheme); +    my $object = eval { +        $class->new ($identifier, $self->{schema}); +    }; +    unless ($object && $object->syntax_check ($identifier)) { +        $self->error ("invalid ACL identifier $identifier for $scheme"); +        return; +    }; + +    # Actually create the scheme.      eval {          my $guard = $self->{schema}->txn_scope_guard;          my %record = (ae_id         => $self->{id}, @@ -446,7 +482,7 @@ sub history {                  push (@{ $self->{check_errors} }, "unknown scheme $scheme");                  return;              } -            $verifier{$scheme} = $class->new; +            $verifier{$scheme} = $class->new ($identifier, $self->{schema});              unless (defined $verifier{$scheme}) {                  push (@{ $self->{check_errors} }, "cannot verify $scheme");                  return; diff --git a/perl/lib/Wallet/ACL/Base.pm b/perl/lib/Wallet/ACL/Base.pm index a2b07cc..19ca612 100644 --- a/perl/lib/Wallet/ACL/Base.pm +++ b/perl/lib/Wallet/ACL/Base.pm @@ -20,7 +20,7 @@ use vars qw($VERSION);  # 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.02'; +$VERSION = '0.03';  ##############################################################################  # Interface @@ -37,6 +37,11 @@ sub new {      return $self;  } +# The default name check method allows any name. +sub syntax_check { +    return 1; +} +  # The default check method denies all access.  sub check {      return 0; @@ -92,6 +97,12 @@ inherit from it.  It is not used directly.  Creates a new ACL verifier.  The generic function provided here just  creates and blesses an object. +=item syntax_check(PRINCIPAL, ACL) + +This method should be overridden by any child classes that want to +implement validating the name of an ACL before creation.  The default +implementation allows any name for an ACL. +  =item check(PRINCIPAL, ACL)  This method should always be overridden by child classes.  The default diff --git a/perl/lib/Wallet/ACL/Nested.pm b/perl/lib/Wallet/ACL/Nested.pm new file mode 100644 index 0000000..3be84bd --- /dev/null +++ b/perl/lib/Wallet/ACL/Nested.pm @@ -0,0 +1,195 @@ +# Wallet::ACL::Nested - ACL class for nesting ACLs +# +# Written by Jon Robertson <jonrober@stanford.edu> +# Copyright 2015 +#     The Board of Trustees of the Leland Stanford Junior University +# +# See LICENSE for licensing terms. + +############################################################################## +# Modules and declarations +############################################################################## + +package Wallet::ACL::Nested; +require 5.006; + +use strict; +use warnings; +use vars qw($VERSION @ISA); + +use Wallet::ACL::Base; + +@ISA = qw(Wallet::ACL::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'; + +############################################################################## +# Interface +############################################################################## + +# Creates a new persistant verifier, taking a database handle.  This parent +# class just creates an empty object and ignores the handle.  Child classes +# should override if there are necessary initialization tasks or if the handle +# will be used by the verifier. +sub new { +    my $type = shift; +    my ($name, $schema) = @_; +    my $self = { +        schema   => $schema, +        expanded => {}, +    }; +    bless ($self, $type); +    return $self; +} + +# Name checking requires checking that there's an existing ACL already by +# this name.  Try to create the ACL object and use that to determine. +sub syntax_check { +    my ($self, $group) = @_; + +    my $acl; +    eval { $acl = Wallet::ACL->new ($group, $self->{schema}) }; +    return 0 if $@; +    return 0 unless $acl; +    return 1; +} + +# For checking a nested ACL, we need to expand each entry and then check +# that entry.  We also want to keep track of things already checked in order +# to avoid any loops. +sub check { +    my ($self, $principal, $group) = @_; +    unless ($principal) { +        $self->error ('no principal specified'); +        return; +    } +    unless ($group) { +        $self->error ('malformed nested ACL'); +        return; +    } + +    # Make an ACL object just so that we can use it to drop back into the +    # normal ACL validation after we have expanded the nesting. +    my $acl; +    eval { $acl = Wallet::ACL->new ($group, $self->{schema}) }; + +    # Get the list of all nested acl entries within this entry, and use it +    # to go through each entry and decide if the given acl has access. +    my @members = $self->get_membership ($group); +    for my $entry (@members) { +        my ($type, $name) = @{ $entry }; +        my $result = $acl->check_line ($principal, $type, $name); +        return 1 if $result; +    } +    return 0; +} + +# Get the membership of a group recursively.  The final result will be a list +# of arrayrefs like that from Wallet::ACL->list, but expanded for full +# membership. +sub get_membership { +    my ($self, $group) = @_; + +    # Get the list of members for this nested acl.  Consider any missing acls +    # as empty. +    my $schema = $self->{schema}; +    my @members; +    eval { +        my $acl  = Wallet::ACL->new ($group, $schema); +        @members = $acl->list; +    }; + +    # Now go through and expand any other nested groups into their own +    # memberships. +    my @expanded; +    for my $entry (@members) { +        my ($type, $name) = @{ $entry }; +        if ($type eq 'nested') { + +            # Keep track of things we've already expanded and don't look them +            # up again. +            next if exists $self->{expanded}{$name}; +            $self->{expanded}{$name} = 1; +            push (@expanded, $self->get_membership ($name)); + +        } else { +            push (@expanded, $entry); +        } +    } + +    return @expanded; +} + +1; +__END__ + +############################################################################## +# Documentation +############################################################################## + +=for stopwords +ACL Allbery verifier verifiers + +=head1 NAME + +Wallet::ACL::Base - Generic parent class for wallet ACL verifiers + +=head1 SYNOPSIS + +    package Wallet::ACL::Simple +    @ISA = qw(Wallet::ACL::Base); +    sub check { +        my ($self, $principal, $acl) = @_; +        return ($principal eq $acl) ? 1 : 0; +    } + +=head1 DESCRIPTION + +Wallet::ACL::Base is the generic parent class for wallet ACL verifiers. +It provides default functions and behavior and all ACL verifiers should +inherit from it.  It is not used directly. + +=head1 METHODS + +=over 4 + +=item new() + +Creates a new ACL verifier.  The generic function provided here just +creates and blesses an object. + +=item check(PRINCIPAL, ACL) + +This method should always be overridden by child classes.  The default +implementation just declines all access. + +=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. + +=back + +=head1 SEE ALSO + +Wallet::ACL(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/Admin.pm b/perl/lib/Wallet/Admin.pm index b38cc94..f6f1f90 100644 --- a/perl/lib/Wallet/Admin.pm +++ b/perl/lib/Wallet/Admin.pm @@ -118,6 +118,7 @@ sub default_data {                         [ 'krb5',       'Wallet::ACL::Krb5'            ],                         [ 'krb5-regex', 'Wallet::ACL::Krb5::Regex'     ],                         [ 'ldap-attr',  'Wallet::ACL::LDAP::Attribute' ], +                       [ 'nested',     'Wallet::ACL::Nested'          ],                         [ 'netdb',      'Wallet::ACL::NetDB'           ],                         [ 'netdb-root', 'Wallet::ACL::NetDB::Root'     ],                                                       ]); diff --git a/perl/t/general/acl.t b/perl/t/general/acl.t index 80e8b3c..aad4b6d 100755 --- a/perl/t/general/acl.t +++ b/perl/t/general/acl.t @@ -12,7 +12,7 @@ use strict;  use warnings;  use POSIX qw(strftime); -use Test::More tests => 109; +use Test::More tests => 113;  use Wallet::ACL;  use Wallet::Admin; @@ -62,32 +62,6 @@ is ($@, '', ' with no exceptions');  ok ($acl->isa ('Wallet::ACL'), ' and the right class');  is ($acl->name, 'test', ' and the right name'); -# Test rename. -if ($acl->rename ('example', @trace)) { -    ok (1, 'Renaming the ACL'); -} else { -    is ($acl->error, '', 'Renaming the ACL'); -} -is ($acl->name, 'example', ' and the new name is right'); -is ($acl->id, 2, ' and the ID did not change'); -$acl = eval { Wallet::ACL->new ('test', $schema) }; -ok (!defined ($acl), ' and it cannot be found under the old name'); -is ($@, "ACL test not found\n", ' with the right error message'); -$acl = eval { Wallet::ACL->new ('example', $schema) }; -ok (defined ($acl), ' and it can be found with the new name'); -is ($@, '', ' with no exceptions'); -is ($acl->name, 'example', ' and the right name'); -is ($acl->id, 2, ' and the right ID'); -$acl = eval { Wallet::ACL->new (2, $schema) }; -ok (defined ($acl), ' and it can still found by ID'); -is ($@, '', ' with no exceptions'); -is ($acl->name, 'example', ' and the right name'); -is ($acl->id, 2, ' and the right ID'); -ok (! $acl->rename ('ADMIN', @trace), -    ' but renaming to an existing name fails'); -like ($acl->error, qr/^cannot rename ACL example to ADMIN: /, -      ' with the right error'); -  # Test add, check, remove, list, and show.  my @entries = $acl->list;  is (scalar (@entries), 0, 'ACL starts empty'); @@ -124,14 +98,14 @@ is ($entries[0][1], $user1, ' and the right identifier for 1');  is ($entries[1][0], 'krb5', ' and the right scheme for 2');  is ($entries[1][1], $user2, ' and the right identifier for 2');  my $expected = <<"EOE"; -Members of ACL example (id: 2) are: +Members of ACL test (id: 2) are:    krb5 $user1    krb5 $user2  EOE  is ($acl->show, $expected, ' and show returns correctly');  ok (! $acl->remove ('krb5', $admin, @trace),      'Removing a nonexistent entry fails'); -is ($acl->error, "cannot remove krb5:$admin from example: entry not found in ACL", +is ($acl->error, "cannot remove krb5:$admin from test: entry not found in ACL",      ' with the right error');  if ($acl->remove ('krb5', $user1, @trace)) {      ok (1, ' but removing the first user works'); @@ -145,7 +119,7 @@ is (scalar (@entries), 1, ' and now there is one entry');  is ($entries[0][0], 'krb5', ' with the right scheme');  is ($entries[0][1], $user2, ' and the right identifier');  ok (! $acl->add ('krb5', $user2), 'Adding the same entry again fails'); -like ($acl->error, qr/^cannot add \Qkrb5:$user2\E to example: /, +like ($acl->error, qr/^cannot add \Qkrb5:$user2\E to test: /,        ' with the right error');  if ($acl->add ('krb5', '', @trace)) {      ok (1, 'Adding a bad entry works'); @@ -159,7 +133,7 @@ is ($entries[0][1], '', ' and the right identifier for 1');  is ($entries[1][0], 'krb5', ' and the right scheme for 2');  is ($entries[1][1], $user2, ' and the right identifier for 2');  $expected = <<"EOE"; -Members of ACL example (id: 2) are: +Members of ACL test (id: 2) are:    krb5     krb5 $user2  EOE @@ -187,17 +161,50 @@ if ($acl->remove ('krb5', '', @trace)) {  }  @entries = $acl->list;  is (scalar (@entries), 0, ' and now there are no entries'); -is ($acl->show, "Members of ACL example (id: 2) are:\n", ' and show concurs'); +is ($acl->show, "Members of ACL test (id: 2) are:\n", ' and show concurs');  is ($acl->check ($user2), 0, ' and the second user check fails');  is (scalar ($acl->check_errors), '', ' with no error message'); +# Test rename. +my $acl_nest = eval { Wallet::ACL->create ('test-nesting', $schema, @trace) }; +ok (defined ($acl_nest), 'ACL creation for setting up nested'); +if ($acl_nest->add ('nested', 'test', @trace)) { +    ok (1, ' and adding the nesting'); +} else { +    is ($acl_nest->error, '', ' and adding the nesting'); +} +if ($acl->rename ('example', @trace)) { +    ok (1, 'Renaming the ACL'); +} else { +    is ($acl->error, '', 'Renaming the ACL'); +} +is ($acl->name, 'example', ' and the new name is right'); +is ($acl->id, 2, ' and the ID did not change'); +$acl = eval { Wallet::ACL->new ('test', $schema) }; +ok (!defined ($acl), ' and it cannot be found under the old name'); +is ($@, "ACL test not found\n", ' with the right error message'); +$acl = eval { Wallet::ACL->new ('example', $schema) }; +ok (defined ($acl), ' and it can be found with the new name'); +is ($@, '', ' with no exceptions'); +is ($acl->name, 'example', ' and the right name'); +is ($acl->id, 2, ' and the right ID'); +$acl = eval { Wallet::ACL->new (2, $schema) }; +ok (defined ($acl), ' and it can still found by ID'); +is ($@, '', ' with no exceptions'); +is ($acl->name, 'example', ' and the right name'); +is ($acl->id, 2, ' and the right ID'); +ok (! $acl->rename ('ADMIN', @trace), +    ' but renaming to an existing name fails'); +like ($acl->error, qr/^cannot rename ACL example to ADMIN: /, +      ' with the right error'); +@entries = $acl_nest->list; +is ($entries[0][1], 'example', ' and the name in a nested ACL updated'); +  # Test history.  my $date = strftime ('%Y-%m-%d %H:%M:%S', localtime $trace[2]);  my $history = <<"EOO";  $date  create      by $admin from $host -$date  rename from test -    by $admin from $host  $date  add krb5 $user1      by $admin from $host  $date  add krb5 $user2 @@ -210,6 +217,8 @@ $date  remove krb5 $user2      by $admin from $host  $date  remove krb5       by $admin from $host +$date  rename from test +    by $admin from $host  EOO  is ($acl->history, $history, 'History is correct'); @@ -225,11 +234,13 @@ is ($@, "ACL example not found\n", ' with the right error message');  $acl = eval { Wallet::ACL->new (2, $schema) };  ok (!defined ($acl), ' or by ID');  is ($@, "ACL 2 not found\n", ' with the right error message'); +@entries = $acl_nest->list; +is (scalar (@entries), 0, ' and it is no longer a nested entry');  $acl = eval { Wallet::ACL->create ('example', $schema, @trace) };  ok (defined ($acl), ' and creating another with the same name works');  is ($@, '', ' with no exceptions');  is ($acl->name, 'example', ' and the right name'); -like ($acl->id, qr{\A[23]\z}, ' and an ID of 2 or 3'); +like ($acl->id, qr{\A[34]\z}, ' and an ID of 3 or 4');  # Test replace. by creating three acls, then assigning two objects to the  # first, one to the second, and another to the third.  Then replace the first diff --git a/perl/t/general/report.t b/perl/t/general/report.t index 170fe29..6f6b750 100755 --- a/perl/t/general/report.t +++ b/perl/t/general/report.t @@ -11,7 +11,7 @@  use strict;  use warnings; -use Test::More tests => 218; +use Test::More tests => 219;  use Wallet::Admin;  use Wallet::Report; @@ -57,13 +57,14 @@ is ($types[9][0], 'wa-keyring', ' and the tenth member is correct');  # And that we have all schemes that we expect.  my @schemes = $report->acl_schemes; -is (scalar (@schemes), 6, 'There are six acl schemes created'); +is (scalar (@schemes), 7, 'There are seven acl schemes created');  is ($schemes[0][0], 'base', ' and the first member is correct');  is ($schemes[1][0], 'krb5', ' and the second member is correct');  is ($schemes[2][0], 'krb5-regex', ' and the third member is correct');  is ($schemes[3][0], 'ldap-attr', ' and the fourth member is correct'); -is ($schemes[4][0], 'netdb', ' and the fifth member is correct'); -is ($schemes[5][0], 'netdb-root', ' and the sixth member is correct'); +is ($schemes[4][0], 'nested', ' and the fifth member is correct'); +is ($schemes[5][0], 'netdb', ' and the sixth member is correct'); +is ($schemes[6][0], 'netdb-root', ' and the seventh member is correct');  # Create an object.  my $server = eval { Wallet::Server->new ('admin@EXAMPLE.COM', 'localhost') }; diff --git a/perl/t/policy/stanford.t b/perl/t/policy/stanford.t index 9ed0fa6..c58985b 100755 --- a/perl/t/policy/stanford.t +++ b/perl/t/policy/stanford.t @@ -140,7 +140,7 @@ is(        'example.stanford.edu'),      1,      '...with netdb ACL line' -); +  );  is(      $server->acl_add('host/example.stanford.edu', 'krb5',        'host/example.stanford.edu@stanford.edu'), diff --git a/perl/t/verifier/nested.t b/perl/t/verifier/nested.t new file mode 100755 index 0000000..ec7ce40 --- /dev/null +++ b/perl/t/verifier/nested.t @@ -0,0 +1,84 @@ +#!/usr/bin/perl +# +# Tests for the wallet ACL nested verifier. +# +# Written by Jon Robertson <jonrober@stanford.edu> +# Copyright 2015 +#     The Board of Trustees of the Leland Stanford Junior University +# +# See LICENSE for licensing terms. + +use strict; +use warnings; + +use Test::More tests => 22; + +use Wallet::ACL::Base; +use Wallet::ACL::Nested; +use Wallet::Admin; +use Wallet::Config; + +use lib 't/lib'; +use Util; + +# Some global defaults to use. +my $admin = 'admin@EXAMPLE.COM'; +my $user1 = 'alice@EXAMPLE.COM'; +my $user2 = 'bob@EXAMPLE.COM'; +my $user3 = 'jack@EXAMPLE.COM'; +my $host = 'localhost'; +my @trace = ($admin, $host, time); + +# Use Wallet::Admin to set up the database. +db_setup; +my $setup = eval { Wallet::Admin->new }; +is ($@, '', 'Database connection succeeded'); +is ($setup->reinitialize ($setup), 1, 'Database initialization succeeded'); +my $schema = $setup->schema; + +# Create a few ACLs for later testing. +my $acl = eval { Wallet::ACL->create ('test', $schema, @trace) }; +ok (defined ($acl), 'ACL creation'); +my $acl_nesting = eval { Wallet::ACL->create ('nesting', $schema, @trace) }; +ok (defined ($acl), ' and another'); +my $acl_deep = eval { Wallet::ACL->create ('deepnesting', $schema, @trace) }; +ok (defined ($acl), ' and another'); + +# Create an verifier to make sure that works +my $verifier = Wallet::ACL::Nested->new ('test', $schema); +ok (defined $verifier, 'Wallet::ACL::Nested creation'); +ok ($verifier->isa ('Wallet::ACL::Nested'), ' and class verification'); +is ($verifier->syntax_check ('notcreated'), 0, +    ' and it rejects a nested name that is not already an ACL'); +is ($verifier->syntax_check ('test'), 1, +    ' and accepts one that already exists'); + +# Add a few entries to one ACL and then see if they validate. +ok ($acl->add ('krb5', $user1, @trace), 'Added test scheme'); +ok ($acl->add ('krb5', $user2, @trace), ' and another'); +ok ($acl_nesting->add ('nested', 'test', @trace), ' and then nested it'); +ok ($acl_nesting->add ('krb5', $user3, @trace), +    ' and added a non-nesting user'); +is ($acl_nesting->check ($user1), 1, ' so check of nested succeeds'); +is ($acl_nesting->check ($user3), 1, ' so check of non-nested succeeds'); +is (scalar ($acl_nesting->list), 2, +    ' and the acl has the right number of items'); + +# Add a recursive nesting to make sure it doesn't send us into loop. +ok ($acl_deep->add ('nested', 'test', @trace), +    'Adding deep nesting for one nest succeeds'); +ok ($acl_deep->add ('nested', 'nesting', @trace), ' and another'); +ok ($acl_deep->add ('krb5', $user3, @trace), +    ' and added a non-nesting user'); +is ($acl_deep->check ($user1), 1, ' so check of nested succeeds'); +is ($acl_deep->check ($user3), 1, ' so check of non-nested succeeds'); + +# Test getting an error in adding an invalid group to an ACL object itself. +isnt ($acl->add ('nested', 'doesnotexist', @trace), 1, +      'Adding bad nested acl fails'); + +# Clean up. +$setup->destroy; +END { +    unlink 'wallet-db'; +} | 
