Added nested acl verifier

This verifier will allow embedding one ACL in another for more flexible
ACL handling.  As part of thise we've also added the ability for each
verifier to do a syntax check to see if a given name is valid for that
verifier.  For the moment this returns true for everything but Nested.
Nested will check to make sure the given name is an existing group.

Change-Id: Iacdf146d46ed882d57b7534058d34db6e6ec1de4

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';
+}