Merge commit 'upstream/0.12' into debian

5 files changed, 113 insertions, 6 deletions

diff --git a/perl/t/kadmin.t b/perl/t/kadmin.t
index e5fb2fa..a1f2876 100755
--- a/perl/t/kadmin.t
+++ b/perl/t/kadmin.t
@@ -109,4 +109,6 @@ SKIP: {
     like ($kadmin->error, qr%^error creating keytab for wallet/one%,
           ' and the right error message is set');
     is ($kadmin->destroy ('wallet/one'), 1, ' and deleting it again works');
+
+    unlink 'krb5cc_test';
 }
diff --git a/perl/t/keytab.t b/perl/t/keytab.t
index b16cea5..fabdc5b 100755
--- a/perl/t/keytab.t
+++ b/perl/t/keytab.t
@@ -103,8 +103,14 @@ sub enctypes {
     close KEYTAB;
 
     my @enctypes;
-    open (KLIST, '-|', 'klist', '-ke', 'keytab')
-        or die "cannot run klist: $!\n";
+    my $pid = open (KLIST, '-|');
+    if (not defined $pid) {
+        die "cannot fork: $!\n";
+    } elsif ($pid == 0) {
+        open (STDERR, '>', '/dev/null') or die "cannot reopen stderr: $!\n";
+        exec ('klist', '-ke', 'keytab')
+            or die "cannot run klist: $!\n";
+    }
     local $_;
     while (<KLIST>) {
         next unless /^ *\d+ /;
diff --git a/perl/t/report.t b/perl/t/report.t
index 1dc69f7..363db20 100755
--- a/perl/t/report.t
+++ b/perl/t/report.t
@@ -7,7 +7,7 @@
 #
 # See LICENSE for licensing terms.
 
-use Test::More tests => 151;
+use Test::More tests => 197;
 
 use Wallet::Admin;
 use Wallet::Report;
@@ -49,6 +49,12 @@ is (scalar (@objects), 1, ' and now there is one object');
 is ($objects[0][0], 'base', ' with the right type');
 is ($objects[0][1], 'service/admin', ' and the right name');
 
+# That object should be unused.
+@objects = $report->objects ('unused');
+is (scalar (@objects), 1, ' and that object is unused');
+is ($objects[0][0], 'base', ' with the right type');
+is ($objects[0][1], 'service/admin', ' and the right name');
+
 # Create another ACL.
 is ($server->acl_create ('first'), 1, 'ACL creation succeeds');
 @acls = $report->acls;
@@ -97,6 +103,14 @@ is (scalar (@lines), 1, ' and there is still owner in the report');
 is ($lines[0][0], 'krb5', ' with the right scheme');
 is ($lines[0][1], 'admin@EXAMPLE.COM', ' and the right identifier');
 
+# Both objects should now show as unused.
+@objects = $report->objects ('unused');
+is (scalar (@objects), 2, 'There are now two unused objects');
+is ($objects[0][0], 'base', ' and the first has the right type');
+is ($objects[0][1], 'service/admin', ' and the right name');
+is ($objects[1][0], 'base', ' and the second has the right type');
+is ($objects[1][1], 'service/foo', ' and the right name');
+
 # Change the owner of the second object to an empty ACL.
 is ($server->owner ('base', 'service/foo', 'second'), 1,
     ' and changing the owner to an empty ACL works');
@@ -239,6 +253,75 @@ 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 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";
+$Wallet::Config::FILE_BUCKET = 'test-files';
+
+# Create a file object and ensure that it shows up in the unused list.
+is ($server->create ('file', 'test'), 1, 'Creating file:test succeeds');
+is ($server->owner ('file', 'test', 'ADMIN'), 1,
+    ' and setting its owner works');
+@objects = $report->objects ('unused');
+is (scalar (@objects), 4, 'There are now four unused objects');
+is ($objects[0][0], 'base', ' and the first has the right type');
+is ($objects[0][1], 'service/admin', ' and the right name');
+is ($objects[1][0], 'base', ' and the second has the right type');
+is ($objects[1][1], 'service/foo', ' and the right name');
+is ($objects[2][0], 'base', ' and the third has the right type');
+is ($objects[2][1], 'service/null', ' and the right name');
+is ($objects[3][0], 'file', ' and the fourth has the right type');
+is ($objects[3][1], 'test', ' and the right name');
+
+# Store something and retrieve it, and then check that the file object fell
+# off of the list.
+is ($server->store ('file', 'test', 'Some data'), 1,
+    'Storing data in file:test succeeds');
+is ($server->get ('file', 'test'), 'Some data', ' and retrieving it works');
+@objects = $report->objects ('unused');
+is (scalar (@objects), 3, ' and now there are three unused objects');
+is ($objects[0][0], 'base', ' and the first has the right type');
+is ($objects[0][1], 'service/admin', ' and the right name');
+is ($objects[1][0], 'base', ' and the second has the right type');
+is ($objects[1][1], 'service/foo', ' and the right name');
+is ($objects[2][0], 'base', ' and the third has the right type');
+is ($objects[2][1], 'service/null', ' and the right name');
+
+# The third and fourth ACLs are both empty and should show up as duplicate.
+@acls = $report->acls ('duplicate');
+is (scalar (@acls), 1, 'There is one set of duplicate ACLs');
+is (scalar (@{ $acls[0] }), 2, ' with two members');
+is ($acls[0][0], 'fourth', ' and the first member is correct');
+is ($acls[0][1], 'third', ' and the second member is correct');
+
+# Add the same line to both ACLs.  They should still show up as duplicate.
+is ($server->acl_add ('fourth', 'base', 'bar'), 1,
+    'Adding a line to the fourth ACL works');
+is ($server->acl_add ('third', 'base', 'bar'), 1,
+    ' and adding a line to the third ACL works');
+@acls = $report->acls ('duplicate');
+is (scalar (@acls), 1, 'There is one set of duplicate ACLs');
+is (scalar (@{ $acls[0] }), 2, ' with two members');
+is ($acls[0][0], 'fourth', ' and the first member is correct');
+is ($acls[0][1], 'third', ' and the second member is correct');
+
+# Add another line to the third ACL.  Now we match second.
+is ($server->acl_add ('third', 'base', 'foo'), 1,
+    'Adding another line to the third ACL works');
+@acls = $report->acls ('duplicate');
+is (scalar (@acls), 1, 'There is one set of duplicate ACLs');
+is (scalar (@{ $acls[0] }), 2, ' with two members');
+is ($acls[0][0], 'second', ' and the first member is correct');
+is ($acls[0][1], 'third', ' and the second member is correct');
+
+# Add yet another line to the third ACL.  Now all ACLs are distinct.
+is ($server->acl_add ('third', 'base', 'baz'), 1,
+    'Adding another line to the third ACL works');
+@acls = $report->acls ('duplicate');
+is (scalar (@acls), 0, 'There are no duplicate ACLs');
+is ($report->error, undef, ' and no error');
+
 # Clean up.
 $admin->destroy;
 unlink 'wallet-db';
+system ('rm -r test-files') == 0 or die "cannot remove test-files\n";
diff --git a/perl/t/schema.t b/perl/t/schema.t
index 7f0aea4..40759db 100755
--- a/perl/t/schema.t
+++ b/perl/t/schema.t
@@ -21,7 +21,7 @@ ok (defined $schema, 'Wallet::Schema creation');
 ok ($schema->isa ('Wallet::Schema'), ' and class verification');
 my @sql = $schema->sql;
 ok (@sql > 0, 'sql() returns something');
-is (scalar (@sql), 28, ' and returns the right number of statements');
+is (scalar (@sql), 29, ' and returns the right number of statements');
 
 # Connect to a database and test create.
 db_setup;
diff --git a/perl/t/verifier.t b/perl/t/verifier.t
index 74d7ba8..f56f5fa 100755
--- a/perl/t/verifier.t
+++ b/perl/t/verifier.t
@@ -3,14 +3,15 @@
 # Tests for the basic wallet ACL verifiers.
 #
 # Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2007, 2008, 2010 Board of Trustees, Leland Stanford Jr. University
 #
 # See LICENSE for licensing terms.
 
-use Test::More tests => 47;
+use Test::More tests => 57;
 
 use Wallet::ACL::Base;
 use Wallet::ACL::Krb5;
+use Wallet::ACL::Krb5::Regex;
 use Wallet::ACL::NetDB;
 use Wallet::ACL::NetDB::Root;
 use Wallet::Config;
@@ -39,6 +40,21 @@ is ($verifier->error, 'no principal specified', ' and right error');
 is ($verifier->check ('rra@stanford.edu', ''), undef, 'Empty ACL');
 is ($verifier->error, 'malformed krb5 ACL', ' and right error');
 
+$verifier = Wallet::ACL::Krb5::Regex->new;
+isa_ok ($verifier, 'Wallet::ACL::Krb5::Regex', 'krb5-regex verifier');
+is ($verifier->check ('rra@stanford.edu', '.*@stanford\.edu\z'), 1,
+    'Simple check');
+is ($verifier->check ('rra@stanford.edu', '^a.*@stanford\.edu'), 0,
+    'Simple failure');
+is ($verifier->error, undef, 'No error set');
+is ($verifier->check (undef, '^rra@stanford\.edu\z'), undef,
+    'Undefined principal');
+is ($verifier->error, 'no principal specified', ' and right error');
+is ($verifier->check ('rra@stanford.edu', ''), undef, 'Empty ACL');
+is ($verifier->error, 'no ACL specified', ' and right error');
+is ($verifier->check ('rra@stanford.edu', '(rra'), undef, 'Malformed regex');
+is ($verifier->error, 'malformed krb5-regex ACL', ' and right error');
+
 # Tests for the NetDB verifiers.  Skip these if we don't have a keytab or if
 # we can't find remctld.
 SKIP: {