Imported Upstream version 0.11upstream/0.11

17 files changed, 138 insertions, 28 deletions

diff --git a/perl/t/acl.t b/perl/t/acl.t
index 95aa763..f169eb5 100755
--- a/perl/t/acl.t
+++ b/perl/t/acl.t
@@ -1,6 +1,6 @@
 #!/usr/bin/perl -w
 #
-# t/api.t -- Tests for the wallet ACL API.
+# Tests for the wallet ACL API.
 #
 # Written by Russ Allbery <rra@stanford.edu>
 # Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University
diff --git a/perl/t/admin.t b/perl/t/admin.t
index e22088e..074dbc6 100755
--- a/perl/t/admin.t
+++ b/perl/t/admin.t
@@ -1,6 +1,6 @@
 #!/usr/bin/perl -w
 #
-# t/admin.t -- Tests for wallet administrative interface.
+# Tests for wallet administrative interface.
 #
 # Written by Russ Allbery <rra@stanford.edu>
 # Copyright 2008, 2009, 2010 Board of Trustees, Leland Stanford Jr. University
diff --git a/perl/t/config.t b/perl/t/config.t
index 1377cb8..6b9f226 100755
--- a/perl/t/config.t
+++ b/perl/t/config.t
@@ -1,6 +1,6 @@
 #!/usr/bin/perl -w
 #
-# t/config.t -- Tests for the wallet server configuration.
+# Tests for the wallet server configuration.
 #
 # Written by Russ Allbery <rra@stanford.edu>
 # Copyright 2008, 2010 Board of Trustees, Leland Stanford Jr. University
diff --git a/perl/t/data/keytab-fake b/perl/t/data/keytab-fake
index 0ecf264..f4f0fb3 100755
--- a/perl/t/data/keytab-fake
+++ b/perl/t/data/keytab-fake
@@ -1,6 +1,6 @@
 #!/bin/sh
 #
-# keytab-fake -- Fake keytab-backend implementation.
+# Fake keytab-backend implementation.
 #
 # This keytab-fake script is meant to be run by remctld during testing of
 # the keytab object implementation.  It returns a fixed string for
diff --git a/perl/t/data/netdb-fake b/perl/t/data/netdb-fake
index ae5be18..9624102 100755
--- a/perl/t/data/netdb-fake
+++ b/perl/t/data/netdb-fake
@@ -1,6 +1,6 @@
 #!/bin/sh
 #
-# netdb-fake -- Fake NetDB remctl interface.
+# Fake NetDB remctl interface.
 #
 # This netdb-fake script is meant to be run by remctld during testing of
 # the NetDB ACL verifier.  It returns known roles or errors for different
diff --git a/perl/t/file.t b/perl/t/file.t
index 7ab5d75..a821c4f 100755
--- a/perl/t/file.t
+++ b/perl/t/file.t
@@ -1,6 +1,6 @@
 #!/usr/bin/perl -w
 #
-# t/file.t -- Tests for the file object implementation.
+# Tests for the file object implementation.
 #
 # Written by Russ Allbery <rra@stanford.edu>
 # Copyright 2008 Board of Trustees, Leland Stanford Jr. University
diff --git a/perl/t/init.t b/perl/t/init.t
index d0fae9f..213aedf 100755
--- a/perl/t/init.t
+++ b/perl/t/init.t
@@ -1,6 +1,6 @@
 #!/usr/bin/perl -w
 #
-# t/init.t -- Tests for database initialization.
+# Tests for database initialization.
 #
 # Written by Russ Allbery <rra@stanford.edu>
 # Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University
diff --git a/perl/t/kadmin.t b/perl/t/kadmin.t
index 6365ce5..e5fb2fa 100755
--- a/perl/t/kadmin.t
+++ b/perl/t/kadmin.t
@@ -1,6 +1,6 @@
 #!/usr/bin/perl -w
 #
-# t/kadmin.t -- Tests for the kadmin object implementation.
+# Tests for the kadmin object implementation.
 #
 # Written by Jon Robertson <jonrober@stanford.edu>
 # Copyright 2009, 2010 Board of Trustees, Leland Stanford Jr. University
@@ -81,6 +81,9 @@ SKIP: {
     $Wallet::Config::KEYTAB_KRBTYPE   = contents ('t/data/test.krbtype');
     $Wallet::Config::KEYTAB_TMP       = '.';
 
+    # Don't destroy the user's Kerberos ticket cache.
+    $ENV{KRB5CCNAME} = 'krb5cc_test';
+
     # Create the object and clean up the principal we're going to use.
     $kadmin = eval { Wallet::Kadmin->new };
     ok (defined $kadmin, 'Creating Wallet::Kadmin object succeeds');
diff --git a/perl/t/keytab.t b/perl/t/keytab.t
index 046da9c..b16cea5 100755
--- a/perl/t/keytab.t
+++ b/perl/t/keytab.t
@@ -1,6 +1,6 @@
 #!/usr/bin/perl -w
 #
-# t/keytab.t -- Tests for the keytab object implementation.
+# Tests for the keytab object implementation.
 #
 # Written by Russ Allbery <rra@stanford.edu>
 # Copyright 2007, 2008, 2009, 2010
diff --git a/perl/t/lib/Util.pm b/perl/t/lib/Util.pm
index ab88b39..44a4d21 100644
--- a/perl/t/lib/Util.pm
+++ b/perl/t/lib/Util.pm
@@ -1,4 +1,4 @@
-# Util -- Utility class for wallet tests.
+# Utility class for wallet tests.
 #
 # Written by Russ Allbery <rra@stanford.edu>
 # Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University
@@ -16,7 +16,7 @@ use Wallet::Config;
 # 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';
 
 use Exporter ();
 @ISA    = qw(Exporter);
diff --git a/perl/t/object.t b/perl/t/object.t
index 46e67e5..3949786 100755
--- a/perl/t/object.t
+++ b/perl/t/object.t
@@ -1,6 +1,6 @@
 #!/usr/bin/perl -w
 #
-# t/object.t -- Tests for the basic object implementation.
+# Tests for the basic object implementation.
 #
 # Written by Russ Allbery <rra@stanford.edu>
 # Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University
diff --git a/perl/t/pod-spelling.t b/perl/t/pod-spelling.t
index d3ab858..6d9f7b0 100755
--- a/perl/t/pod-spelling.t
+++ b/perl/t/pod-spelling.t
@@ -9,8 +9,7 @@
 #
 # Copyright 2008, 2009 Russ Allbery <rra@stanford.edu>
 #
-# This program is free software; you may redistribute it and/or modify it
-# under the same terms as Perl itself.
+# See LICENSE for licensing terms.
 
 use strict;
 use Test::More;
diff --git a/perl/t/report.t b/perl/t/report.t
index a18b995..1dc69f7 100755
--- a/perl/t/report.t
+++ b/perl/t/report.t
@@ -1,13 +1,13 @@
 #!/usr/bin/perl -w
 #
-# t/report.t -- Tests for the wallet reporting interface.
+# Tests for the wallet reporting interface.
 #
 # Written by Russ Allbery <rra@stanford.edu>
 # Copyright 2008, 2009, 2010 Board of Trustees, Leland Stanford Jr. University
 #
 # See LICENSE for licensing terms.
 
-use Test::More tests => 83;
+use Test::More tests => 151;
 
 use Wallet::Admin;
 use Wallet::Report;
@@ -166,6 +166,79 @@ is ($server->flag_clear ('base', 'service/admin', 'unchanging'), 1,
 is (scalar (@lines), 0, ' and now there are no objects in the report');
 is ($report->error, undef, ' with no error');
 
+# All of our ACLs should be in use.
+@lines = $report->acls ('unused');
+is (scalar (@lines), 0, 'Searching for unused ACLs returns nothing');
+is ($report->error, undef, ' with no error');
+
+# Create some unused ACLs that should show up in the report.
+is ($server->acl_create ('third'), 1, 'Creating an empty ACL succeeds');
+is ($server->acl_create ('fourth'), 1, ' and creating another succeeds');
+@lines = $report->acls ('unused');
+is (scalar (@lines), 2, ' and now we see two unused ACLs');
+is ($server->error, undef, ' with no error');
+is ($lines[0][0], 4, ' and the first has the right ID');
+is ($lines[0][1], 'third', ' and the right name');
+is ($lines[1][0], 5, ' and the second has the right ID');
+is ($lines[1][1], 'fourth', ' and the right name');
+
+# Use one of those ACLs and ensure it drops out of the report.  Test that we
+# try all of the possible ACL types.
+for my $type (qw/get store show destroy flags/) {
+    is ($server->acl ('base', 'service/admin', $type, 'fourth'), 1,
+        "Setting ACL $type to fourth succeeds");
+    @lines = $report->acls ('unused');
+    is (scalar (@lines), 1, ' and now we see only one unused ACL');
+    is ($lines[0][0], 4, ' with the right ID');
+    is ($lines[0][1], 'third', ' and the right name');
+    is ($server->acl ('base', 'service/admin', $type, ''), 1,
+        ' and clearing the ACL succeeds');
+    @lines = $report->acls ('unused');
+    is (scalar (@lines), 2, ' and now we see two unused ACLs');
+    is ($lines[0][0], 4, ' and the first has the right ID');
+    is ($lines[0][1], 'third', ' and the right name');
+    is ($lines[1][0], 5, ' and the second has the right ID');
+    is ($lines[1][1], 'fourth', ' and the right name');
+}
+
+# The naming audit returns nothing if there's no naming policy.
+@lines = $report->audit ('objects', 'name');
+is (scalar (@lines), 0, 'Searching for naming violations finds none');
+is ($report->error, undef, ' with no error');
+
+# Set a naming policy and then look for objects that fail that policy.  We
+# have to deactivate this policy until now so that it doesn't prevent the
+# creation of that name originally, which is the reason for the variable
+# reference.
+our $naming_active = 1;
+package Wallet::Config;
+sub verify_name {
+    my ($type, $name) = @_;
+    return unless $naming_active;
+    return 'admin not allowed' if $name eq 'service/admin';
+    return;
+}
+package main;
+@lines = $report->audit ('objects', 'name');
+is (scalar (@lines), 1, 'Searching for naming violations 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 an ACL naming policy and then look for objects that fail that policy.
+# Use the same deactivation trick as above.
+package Wallet::Config;
+sub verify_acl_name {
+    my ($name) = @_;
+    return unless $naming_active;
+    return 'second not allowed' if $name eq 'second';
+    return;
+}
+package main;
+@lines = $report->audit ('acls', 'name');
+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');
+
 # Clean up.
 $admin->destroy;
 unlink 'wallet-db';
diff --git a/perl/t/schema.t b/perl/t/schema.t
index 559ece4..7f0aea4 100755
--- a/perl/t/schema.t
+++ b/perl/t/schema.t
@@ -1,6 +1,6 @@
 #!/usr/bin/perl -w
 #
-# t/schema.t -- Tests for the wallet schema class.
+# Tests for the wallet schema class.
 #
 # Written by Russ Allbery <rra@stanford.edu>
 # Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University
diff --git a/perl/t/server.t b/perl/t/server.t
index 090387b..ed92d6e 100755
--- a/perl/t/server.t
+++ b/perl/t/server.t
@@ -1,13 +1,13 @@
 #!/usr/bin/perl -w
 #
-# t/server.t -- Tests for the wallet server API.
+# Tests for the wallet server API.
 #
 # 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 => 341;
+use Test::More tests => 355;
 
 use POSIX qw(strftime);
 use Wallet::Admin;
@@ -923,6 +923,41 @@ is ($server->error, 'base:host/default.stanford.edu rejected: host'
     . ' default.stanford.edu not in .example.edu domain',
     ' with the right error');
 
+# Ensure that we can't destroy an ACL that's in use.
+is ($server->acl_create ('test-destroy'), 1, 'Creating an ACL works');
+is ($server->create ('base', 'service/acl-user'), 1, 'Creating object works');
+is ($server->owner ('base', 'service/acl-user', 'test-destroy'), 1,
+    ' and setting owner');
+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',
+    ' with the right error');
+is ($server->owner ('base', 'service/acl-user', ''), 1,
+    ' but after we clear the owner');
+is ($server->acl_destroy ('test-destroy'), 1, ' now we can destroy the ACL');
+is ($server->destroy ('base', 'service/acl-user'), 1, ' and the object');
+
+# Test ACL naming enforcement.  Require that ACL names not contain a slash.
+package Wallet::Config;
+sub verify_acl_name {
+    my ($name, $user) = @_;
+    return 'ACL names may not contain slash' if $name =~ m,/,;
+    return;
+}
+package main;
+is ($server->acl_create ('test/naming'), undef,
+    'Creating an ACL with a disallowed name fails');
+is ($server->error, 'test/naming rejected: ACL names may not contain slash',
+    ' with the right error message');
+is ($server->acl_create ('test-naming'), 1,
+    'Creating test-naming succeeds');
+is ($server->acl_rename ('test-naming', 'test/naming'), undef,
+    ' but renaming it fails');
+is ($server->error, 'test/naming rejected: ACL names may not contain slash',
+    ' with the right error message');
+is ($server->acl_destroy ('test-naming'), 1, 'Destroying it succeeds');
+
 # Clean up.
 $setup->destroy;
 unlink 'wallet-db';
diff --git a/perl/t/verifier-netdb.t b/perl/t/verifier-netdb.t
index dcbbdd8..6bd4e73 100755
--- a/perl/t/verifier-netdb.t
+++ b/perl/t/verifier-netdb.t
@@ -1,15 +1,15 @@
 #!/usr/bin/perl -w
 #
-# t/verifier-netdb.t -- Tests for the NetDB wallet ACL verifiers.
+# Tests for the NetDB wallet ACL verifiers.
+#
+# This test can only be run by someone local to Stanford with appropriate
+# access to the NetDB role server and will be skipped in all other
+# environments.
 #
 # Written by Russ Allbery <rra@stanford.edu>
 # Copyright 2008 Board of Trustees, Leland Stanford Jr. University
 #
 # See LICENSE for licensing terms.
-#
-# This test can only be run by someone local to Stanford with appropriate
-# access to the NetDB role server and will be skipped in all other
-# environments.
 
 use Test::More tests => 4;
 
diff --git a/perl/t/verifier.t b/perl/t/verifier.t
index 3243d9c..74d7ba8 100755
--- a/perl/t/verifier.t
+++ b/perl/t/verifier.t
@@ -1,6 +1,6 @@
 #!/usr/bin/perl -w
 #
-# t/verifier.t -- Tests for the basic wallet ACL verifiers.
+# Tests for the basic wallet ACL verifiers.
 #
 # Written by Russ Allbery <rra@stanford.edu>
 # Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University
@@ -39,8 +39,8 @@ 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');
 
-# Tests for unchanging support.  Skip these if we don't have a keytab or if we
-# can't find remctld.
+# Tests for the NetDB verifiers.  Skip these if we don't have a keytab or if
+# we can't find remctld.
 SKIP: {
     skip 'no keytab configuration', 34 unless -f 't/data/test.keytab';
     my @path = (split (':', $ENV{PATH}), '/usr/local/sbin', '/usr/sbin');