Add a subclass of the NetDB ACL verifier that requires the principal

have an instance of "root" and strips that instance before checking
NetDB roles.

5 files changed, 167 insertions, 9 deletions

diff --git a/Makefile.am b/Makefile.am
index 8fb50ea..c89b2ff 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -12,10 +12,11 @@ EXTRA_DIST = LICENSE autogen client/wallet.pod config/allow-extract \
 	docs/design-acl docs/design-api docs/netdb-role-api docs/notes \
 	docs/setup kasetkey/README kasetkey/kasetkey.pod perl/Wallet/ACL.pm \
 	perl/Wallet/ACL/Base.pm perl/Wallet/ACL/Krb5.pm \
-	perl/Wallet/ACL/NetDB.pm perl/Wallet/Config.pm \
-	perl/Wallet/Object/Base.pm perl/Wallet/Object/Keytab.pm \
-	perl/Wallet/Schema.pm perl/Wallet/Server.pm perl/t/acl.t \
-	perl/t/data/README perl/t/data/keytab-fake perl/t/data/keytab.conf \
+	perl/Wallet/ACL/NetDB.pm perl/Wallet/ACL/NetDB/Root.pm \
+	perl/Wallet/Config.pm perl/Wallet/Object/Base.pm \
+	perl/Wallet/Object/Keytab.pm perl/Wallet/Schema.pm \
+	perl/Wallet/Server.pm perl/t/acl.t perl/t/data/README \
+	perl/t/data/keytab-fake perl/t/data/keytab.conf \
 	perl/t/data/netdb.conf perl/t/data/netdb-fake perl/t/init.t \
 	perl/t/keytab.t perl/t/lib/Util.pm perl/t/object.t perl/t/pod.t \
 	perl/t/schema.t perl/t/server.t perl/t/verifier.t tests/TESTS \
diff --git a/NEWS b/NEWS
index 905739b..8ed6bc3 100644
--- a/NEWS
+++ b/NEWS
@@ -1,5 +1,11 @@
                        User-Visible wallet Changes
 
+wallet 0.4 (unreleased)
+
+    Add a subclass of the NetDB ACL verifier that requires the principal
+    have an instance of "root" and strips that instance before checking
+    NetDB roles.
+
 wallet 0.3 (2007-12-03)
 
     MySQL is now a supported database backend and the full test suite
diff --git a/perl/Wallet/ACL/NetDB/Root.pm b/perl/Wallet/ACL/NetDB/Root.pm
new file mode 100644
index 0000000..5400d99
--- /dev/null
+++ b/perl/Wallet/ACL/NetDB/Root.pm
@@ -0,0 +1,124 @@
+# Wallet::ACL::NetDB::Root -- Wallet NetDB role ACL verifier (root instances).
+# $Id$
+#
+# Written by Russ Allbery <rra@stanford.edu>
+# Copyright 2007 Board of Trustees, Leland Stanford Jr. University
+#
+# See LICENSE for licensing terms.
+
+##############################################################################
+# Modules and declarations
+##############################################################################
+
+package Wallet::ACL::NetDB::Root;
+require 5.006;
+
+use strict;
+use vars qw(@ISA $VERSION);
+
+use Wallet::ACL::NetDB;
+use Wallet::Config;
+
+@ISA = qw(Wallet::ACL::NetDB);
+
+# 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
+##############################################################################
+
+# Override the check method of Wallet::ACL::NetDB to require that the
+# principal be a root instance and to strip /root out of the principal name
+# before checking roles.
+sub check {
+    my ($self, $principal, $acl) = @_;
+    unless ($principal) {
+        $self->error ('no principal specified');
+        return undef;
+    }
+    unless ($principal =~ s%^([^/\@]+)/root(\@|\z)%$1$2%) {
+        return 0;
+    }
+    return $self->SUPER::check ($principal, $acl);
+}
+
+##############################################################################
+# Documentation
+##############################################################################
+
+=head1 NAME
+
+Wallet::ACL::NetDB::Root - Wallet ACL verifier for NetDB roles (root instances)
+
+=head1 SYNOPSIS
+
+    my $verifier = Wallet::ACL::NetDB->new;
+    my $status = $verifier->check ($principal, $node);
+    if (not defined $status) {
+        die "Something failed: ", $verifier->error, "\n";
+    } elsif ($status) {
+        print "Access granted\n";
+    } else {
+        print "Access denied\n";
+    }
+
+=head1 DESCRIPTION
+
+Wallet::ACL::NetDB::Root works identically to Wallet::ACL::NetDB except that
+it requires the principal to be a root instance (in other words, to be in
+the form <principal>/root@<realm>) and strips the C</root> portion from the
+principal before checking against NetDB roles.  As with the base NetDB ACL
+verifier, the value of a netdb-root ACL is a node, and the ACL grants access
+to a given principal if and only if the that principal (with C</root>
+stripped) has one of the roles user, admin, or team for that node.
+
+To use this object, the same configuration parameters must be set as for
+Wallet::ACL::NetDB.  See Wallet::Config(3) for details on those
+configuration parameters and information about how to set wallet
+configuration.
+
+=head1 METHODS
+
+=over 4
+
+=item check(PRINCIPAL, ACL)
+
+Returns true if PRINCIPAL is granted access according to ACL, false if not,
+and undef on an error (see L<"DIAGNOSTICS"> below).  ACL is a node, and
+PRINCIPAL will be granted access if it has an instance of C<root> and if
+(with C</root> stripped off and the realm stripped off if configured) has
+the user, admin, or team role for that node.
+
+=back
+
+=head1 DIAGNOSTICS
+
+Same as for Wallet::ACL::NetDB.
+
+=head1 CAVEATS
+
+The instance to strip is not currently configurable.
+
+The list of possible NetDB roles that should be considered sufficient to
+grant access is not currently configurable.
+
+=head1 SEE ALSO
+
+Net::Remctl(3), Wallet::ACL(3), Wallet::ACL::Base(3), Wallet::ACL::NetDB(3),
+Wallet::Config(3), wallet-backend(8)
+
+NetDB is a free software system for managing DNS, DHCP, and related machine
+information for large organizations.  For more information on NetDB, see
+L<http://www.stanford.edu/group/networking/netdb/>.
+
+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 <rra@stanford.edu>
+
+=cut
diff --git a/perl/Wallet/Schema.pm b/perl/Wallet/Schema.pm
index 5068d03..532c61e 100644
--- a/perl/Wallet/Schema.pm
+++ b/perl/Wallet/Schema.pm
@@ -210,6 +210,10 @@ Holds the supported ACL schemes and their corresponding Perl classes:
       as_class            varchar(64));
   insert into acl_schemes (as_name, as_class)
       values ('krb5', 'Wallet::ACL::Krb5');
+  insert into acl_schemes (as_name, as_class)
+      values ('netdb', 'Wallet::ACL::NetDB');
+  insert into acl_schemes (as_name, as_class)
+      values ('netdb-root', 'Wallet::ACL::NetDB::Root');
 
 If you have extended the wallet to support additional object types or
 additional ACL schemes, you will want to add additional rows to these tables
diff --git a/perl/t/verifier.t b/perl/t/verifier.t
index 878c310..65b3923 100755
--- a/perl/t/verifier.t
+++ b/perl/t/verifier.t
@@ -8,11 +8,12 @@
 #
 # See LICENSE for licensing terms.
 
-use Test::More tests => 37;
+use Test::More tests => 47;
 
 use Wallet::ACL::Base;
 use Wallet::ACL::Krb5;
 use Wallet::ACL::NetDB;
+use Wallet::ACL::NetDB::Root;
 use Wallet::Config;
 
 use lib 't/lib';
@@ -87,12 +88,12 @@ 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.
 SKIP: {
-    skip 'no keytab configuration', 24 unless -f 't/data/test.keytab';
+    skip 'no keytab configuration', 34 unless -f 't/data/test.keytab';
     my @path = (split (':', $ENV{PATH}), '/usr/local/sbin', '/usr/sbin');
     my ($remctld) = grep { -x $_ } map { "$_/remctld" } @path;
-    skip 'remctld not found', 24 unless $remctld;
+    skip 'remctld not found', 34 unless $remctld;
     eval { require Net::Remctl };
-    skip 'Net::Remctl not available', 24 if $@;
+    skip 'Net::Remctl not available', 34 if $@;
 
     # Set up our configuration.
     $Wallet::Config::NETDB_REALM = 'EXAMPLE.COM';
@@ -154,7 +155,29 @@ SKIP: {
     is ($verifier->error,
         'error checking NetDB ACL: Unknown principal unknown',
         ' and correct error');
-    stop_remctld;
 
+    # Test the Wallet::ACL::NetDB::Root subclass.  We don't retest shared code
+    # (kind of grey-box of us), just the changed check behavior.
+    $verifier = eval { Wallet::ACL::NetDB::Root->new };
+    if (defined $verifier) {
+        ok (1, 'Wallet::ACL::NetDB::Root creation succeeds');
+    } else {
+        is ($@, '', 'Wallet::ACL::NetDB::Root creation succeeds');
+    }
+    ok ($verifier->isa ('Wallet::ACL::NetDB::Root'),
+        ' and returns the right class');
+    for my $node (qw/admin team user/) {
+        is ($verifier->check ('test-user', $node), 0,
+            "Verification fails for non-root user for $node");
+    }
+    for my $node (qw/admin team user/) {
+        is ($verifier->check ('test-user/root', $node), 1,
+            "Verification succeeds for root user for $node");
+    }
+    is ($verifier->check (undef, 'all'), undef,
+        'Undefined principal');
+    is ($verifier->error, 'no principal specified', ' and right error');
+
+    stop_remctld;
     unlink ('krb5cc_test', 'test-acl', 'test-pid');
 }