Imported Upstream version 1.3upstream/1.3

3 files changed, 171 insertions, 45 deletions

diff --git a/perl/t/general/acl.t b/perl/t/general/acl.t
index 1dd5c53..4de7493 100755
--- a/perl/t/general/acl.t
+++ b/perl/t/general/acl.t
@@ -12,11 +12,11 @@ use strict;
 use warnings;
 
 use POSIX qw(strftime);
-use Test::More tests => 101;
+use Test::More tests => 115;
 
 use Wallet::ACL;
 use Wallet::Admin;
-use Wallet::Server;
+use Wallet::Object::Base;
 
 use lib 't/lib';
 use Util;
@@ -46,7 +46,7 @@ $acl = eval { Wallet::ACL->create (3, $schema, @trace) };
 ok (!defined ($acl), 'Creating with a numeric name');
 is ($@, "ACL name may not be all numbers\n", ' with the right error message');
 $acl = eval { Wallet::ACL->create ('test', $schema, @trace) };
-ok (!defined ($acl), 'Creating a duplicate object');
+ok (!defined ($acl), 'Creating a duplicate acl');
 like ($@, qr/^cannot create ACL test: /, ' with the right error message');
 $acl = eval { Wallet::ACL->new ('test2', $schema) };
 ok (!defined ($acl), 'Searching for a non-existent ACL');
@@ -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 2 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 2: 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 2: /,
+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,14 +217,24 @@ $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');
 
 # Test destroy.
+$acl->destroy (@trace);
+is ($acl->error, 'cannot destroy ACL example: ACL is nested in ACL test-nesting',
+    'Destroying a nested ACL fails');
+if ($acl_nest->remove ('nested', 'example', @trace)) {
+    ok (1, ' and removing the nesting succeeds');
+} else {
+    is ($acl_nest->error, '', 'and removing the nesting succeeds');
+}
 if ($acl->destroy (@trace)) {
-    ok (1, 'Destroying the ACL works');
+    ok (1, ' and now destroying the ACL works');
 } else {
-    is ($acl->error, '', 'Destroying the ACL works');
+    is ($acl->error, '', ' and now destroying the ACL works');
 }
 $acl = eval { Wallet::ACL->new ('example', $schema) };
 ok (!defined ($acl), ' and now cannot be found');
@@ -225,11 +242,71 @@ 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
+# acl with the second, so that we can verify that multiple objects are moved,
+# that an object already belonging to the new acl is okay, and that the
+# objects with unrelated ACL are unaffected.
+my ($acl_old, $acl_new, $acl_other, $obj_old_one, $obj_old_two, $obj_new,
+    $obj_unrelated);
+eval {
+    $acl_old   = Wallet::ACL->create ('example-old', $schema, @trace);
+    $acl_new   = Wallet::ACL->create ('example-new', $schema, @trace);
+    $acl_other = Wallet::ACL->create ('example-other', $schema, @trace);
+};
+is ($@, '', 'ACLs needed for testing replace are created');
+eval {
+    $obj_old_one   = Wallet::Object::Base->create ('keytab',
+                                                   'service/test1@EXAMPLE.COM',
+                                                   $schema, @trace);
+    $obj_old_two   = Wallet::Object::Base->create ('keytab',
+                                                   'service/test2@EXAMPLE.COM',
+                                                   $schema, @trace);
+    $obj_new       = Wallet::Object::Base->create ('keytab',
+                                                   'service/test3@EXAMPLE.COM',
+                                                   $schema, @trace);
+    $obj_unrelated = Wallet::Object::Base->create ('keytab',
+                                                   'service/test4@EXAMPLE.COM',
+                                                   $schema, @trace);
+};
+is ($@, '', ' and so were needed objects');
+if ($obj_old_one->owner ('example-old', @trace)
+    && $obj_old_two->owner ('example-old', @trace)
+    && $obj_new->owner ('example-new', @trace)
+    && $obj_unrelated->owner ('example-other', @trace)) {
+
+    ok (1, ' and setting initial ownership on the objects succeeds');
+}
+is ($acl_old->replace('example-new', @trace), 1,
+    ' and replace ran successfully');
+eval {
+    $obj_old_one   = Wallet::Object::Base->new ('keytab',
+                                                'service/test1@EXAMPLE.COM',
+                                                $schema);
+    $obj_old_two   = Wallet::Object::Base->new ('keytab',
+                                                'service/test2@EXAMPLE.COM',
+                                                $schema);
+    $obj_new       = Wallet::Object::Base->new ('keytab',
+                                                'service/test3@EXAMPLE.COM',
+                                                $schema);
+    $obj_unrelated = Wallet::Object::Base->new ('keytab',
+                                                'service/test4@EXAMPLE.COM',
+                                                $schema);
+};
+is ($obj_old_one->owner, 'example-new', ' and first replace is correct');
+is ($obj_old_two->owner, 'example-new', ' and second replace is correct');
+is ($obj_new->owner, 'example-new',
+    ' and object already with new acl is correct');
+is ($obj_unrelated->owner, 'example-other',
+    ' and unrelated object ownership is correct');
 
 # Clean up.
 $setup->destroy;
diff --git a/perl/t/general/report.t b/perl/t/general/report.t
index 8d348ed..e47cdc6 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 => 197;
+use Test::More tests => 223;
 
 use Wallet::Admin;
 use Wallet::Report;
@@ -41,6 +41,32 @@ is (scalar (@acls), 1, 'One ACL in the database');
 is ($acls[0][0], 1, ' and that is ACL ID 1');
 is ($acls[0][1], 'ADMIN', ' with the right name');
 
+# Check to see that we have all types that we expect.
+my @types = $report->types;
+is (scalar (@types), 10, 'There are ten types created');
+is ($types[0][0], 'base', ' and the first member is correct');
+is ($types[1][0], 'duo', ' and the second member is correct');
+is ($types[2][0], 'duo-ldap', ' and the third member is correct');
+is ($types[3][0], 'duo-pam', ' and the fourth member is correct');
+is ($types[4][0], 'duo-radius', ' and the fifth member is correct');
+is ($types[5][0], 'duo-rdp', ' and the sixth member is correct');
+is ($types[6][0], 'file', ' and the seventh member is correct');
+is ($types[7][0], 'keytab', ' and the eighth member is correct');
+is ($types[8][0], 'password', ' and the nineth member is correct');
+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), 8, '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], 'ldap-attr-root', ' and the fifth member is correct');
+is ($schemes[5][0], 'nested', ' and the sixth member is correct');
+is ($schemes[6][0], 'netdb', ' and the seventh member is correct');
+is ($schemes[7][0], 'netdb-root', ' and the eighth member is correct');
+
 # Create an object.
 my $server = eval { Wallet::Server->new ('admin@EXAMPLE.COM', 'localhost') };
 is ($@, '', 'Creating a server instance did not die');
@@ -257,6 +283,22 @@ is (scalar (@lines), 1, 'Searching for ACL naming violations finds one');
 is ($lines[0][0], 3, ' and the first has the right ID');
 is ($lines[0][1], 'second', ' and the right name');
 
+# Set a host-based object matching script so that we can test the host report.
+# The deactivation trick isn't needed here.
+package Wallet::Config;
+sub is_for_host {
+    my ($type, $name, $host) = @_;
+    my ($service, $principal) = split ('/', $name, 2);
+    return 0 unless $service && $principal;
+    return 1 if $host eq $principal;
+    return 0;
+}
+package main;
+@lines = $report->objects_hostname ('host', 'admin');
+is (scalar (@lines), 1, 'Searching for host-based objects finds one');
+is ($lines[0][0], 'base', ' and the first has the right type');
+is ($lines[0][1], 'service/admin', ' and the right name');
+
 # Set up a file bucket so that we can create an object we can retrieve.
 system ('rm -rf test-files') == 0 or die "cannot remove test-files\n";
 mkdir 'test-files' or die "cannot create test-files: $!\n";
@@ -325,6 +367,13 @@ is ($server->acl_add ('third', 'base', 'baz'), 1,
 is (scalar (@acls), 0, 'There are no duplicate ACLs');
 is ($report->error, undef, ' and no error');
 
+# See if the acl nesting report works correctly.
+is ($server->acl_add ('fourth', 'nested', 'second'), 1,
+    'Adding an ACL as a nested entry for another works');
+@acls = $report->acls ('nesting', 'second');
+is (scalar (@acls), 1, ' and the nested report shows one nesting');
+is ($acls[0][1], 'fourth', ' with the correct ACL nesting it');
+
 # Clean up.
 $admin->destroy;
 system ('rm -r test-files') == 0 or die "cannot remove test-files\n";
diff --git a/perl/t/general/server.t b/perl/t/general/server.t
index 0a527a5..8f4c16c 100755
--- a/perl/t/general/server.t
+++ b/perl/t/general/server.t
@@ -89,7 +89,7 @@ is ($server->acl_rename ('empty', 'test'), undef,
 is ($server->error, 'ACL empty not found', ' and returns the right error');
 is ($server->acl_rename ('test', 'test2'), undef,
     ' and cannot rename to an existing name');
-like ($server->error, qr/^cannot rename ACL 6 to test2: /,
+like ($server->error, qr/^cannot rename ACL test to test2: /,
       ' and returns the right error');
 is ($server->acl_rename ('test', 'empty'), 1, 'Renaming does work');
 is ($server->acl_rename ('test', 'empty'), undef, ' but not twice');
@@ -138,7 +138,7 @@ is ($server->error, 'ACL test not found', ' and returns the right error');
 is ($server->acl_remove ('empty', 'krb5', $user2), undef,
     ' and removing an entry not there fails');
 is ($server->error,
-    "cannot remove krb5:$user2 from 6: entry not found in ACL",
+    "cannot remove krb5:$user2 from empty: entry not found in ACL",
     ' and returns the right error');
 is ($server->acl_show ('empty'),
     "Members of ACL empty (id: 6) are:\n  krb5 $user1\n",
@@ -148,7 +148,7 @@ is ($server->acl_remove ('empty', 'krb5', $user1), 1,
 is ($server->acl_remove ('empty', 'krb5', $user1), undef,
     ' but does not work twice');
 is ($server->error,
-    "cannot remove krb5:$user1 from 6: entry not found in ACL",
+    "cannot remove krb5:$user1 from empty: entry not found in ACL",
     ' and returns the right error');
 is ($server->acl_show ('empty'), "Members of ACL empty (id: 6) are:\n",
     ' and show returns the correct status');
@@ -168,7 +168,7 @@ is ($server->acl_remove ('ADMIN', 'krb5', $user1), 1, ' and then remove it');
 is ($server->acl_remove ('ADMIN', 'krb5', $user1), undef,
     ' and remove a user not on it');
 is ($server->error,
-    "cannot remove krb5:$user1 from 1: entry not found in ACL",
+    "cannot remove krb5:$user1 from ADMIN: entry not found in ACL",
     ' and get the right error');
 
 # Now, create a few objects to use for testing and test the object API while
@@ -994,7 +994,7 @@ is ($server->owner ('base', 'service/acl-user', 'test-destroy'), 1,
 is ($server->acl_destroy ('test-destroy'), undef,
     ' and now we cannot destroy that ACL');
 is ($server->error,
-    'cannot destroy ACL 9: ACL in use by base:service/acl-user',
+    'cannot destroy ACL test-destroy: ACL in use by base:service/acl-user',
     ' with the right error');
 is ($server->owner ('base', 'service/acl-user', ''), 1,
     ' but after we clear the owner');