Add an ACL verifier that checks access against NetDB roles using the

NetDB remctl interface.

9 files changed, 540 insertions, 17 deletions

diff --git a/Makefile.am b/Makefile.am
index e97651d..e04353a 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/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/init.t \
+	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/t/data/netdb.conf perl/t/data/netdb-fake perl/t/init.t \
 	perl/t/keytab.t perl/t/object.t perl/t/pod.t perl/t/schema.t \
 	perl/t/server.t perl/t/verifier.t tests/TESTS tests/data/README \
 	tests/data/allow-extract tests/data/cmd-fake tests/data/fake-data \
diff --git a/NEWS b/NEWS
index 320b23a..d303b01 100644
--- a/NEWS
+++ b/NEWS
@@ -4,6 +4,9 @@ wallet 0.3 (unreleased)
 
     Add support for displaying the history of objects and ACLs.
 
+    Add an ACL verifier that checks access against NetDB roles using the
+    NetDB remctl interface.
+
     The wallet backend script now logs all commands and errors to syslog.
 
     The keytab backend now supports limiting generated keytabs to
diff --git a/TODO b/TODO
index 47b48ef..44b30d4 100644
--- a/TODO
+++ b/TODO
@@ -12,8 +12,6 @@ Minimum required to replace leland_srvtab:
 
 Release 0.3:
 
-* Write the NetDB ACL verifier.
-
 * Write the LDAP entitlement ACL verifier.
 
 * Write the PTS ACL verifier.
@@ -118,6 +116,11 @@ Future work:
   Wallet::Server class.  Find a way to rewrite that so that the dispatch
   doesn't duplicate the same code patterns.
 
+* Refactor the test suite for the wallet backend to try to reduce the
+  duplicated code.
+
+* Pull common test suite code into a Perl library that can be reused.
+
 * Add a function to wallet-admin to purge expired entries.  Possibly also
   check expiration before allowing anyone to get or store objects.
 
diff --git a/perl/Wallet/ACL/NetDB.pm b/perl/Wallet/ACL/NetDB.pm
new file mode 100644
index 0000000..23efa9d
--- /dev/null
+++ b/perl/Wallet/ACL/NetDB.pm
@@ -0,0 +1,252 @@
+# Wallet::ACL::NetDB -- Wallet NetDB role ACL verifier.
+# $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;
+require 5.006;
+
+use strict;
+use vars qw(@ISA $VERSION);
+
+use Wallet::ACL::Base;
+use Wallet::Config;
+
+@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.  Load the Net::Remctl module and open a
+# persistant remctl connection that we'll use for later calls.
+sub new {
+    my $type = shift;
+    my $host = $Wallet::Config::NETDB_REMCTL_HOST;
+    unless ($host and $Wallet::Config::NETDB_REMCTL_CACHE) {
+        die "NetDB ACL support not configured\n";
+    }
+    eval { require Net::Remctl };
+    if ($@) {
+        my $error = $@;
+        chomp $error;
+        1 while ($error =~ s/ at \S+ line \d+\.?\z//);
+        die "NetDB ACL support not available: $error\n";
+    }
+    local $ENV{KRB5CCNAME} = $Wallet::Config::NETDB_REMCTL_CACHE;
+    my $port = $Wallet::Config::NETDB_REMCTL_PORT;
+    my $principal = $Wallet::Config::NETDB_REMCTL_PRINCIPAL;
+    my $remctl = Net::Remctl->new;
+    unless ($remctl->open ($host, $port, $principal)) {
+        die "cannot connect to NetDB remctl interface: ", $remctl->error, "\n";
+    }
+    my $self = { remctl => $remctl };
+    bless ($self, $type);
+    return $self;
+}
+
+# Check whether the given principal has one of the user, administrator, or
+# admin team roles in NetDB for the given host.  Returns 1 if it does, 0 if it
+# doesn't, and undef, setting the error, if there's some failure in making the
+# remctl call.
+sub check {
+    my ($self, $principal, $acl) = @_;
+    unless ($principal) {
+        $self->error ('no principal specified');
+        return undef;
+    }
+    unless ($acl) {
+        $self->error ('malformed netdb ACL');
+        return undef;
+    }
+    my $remctl = $self->{remctl};
+    if ($Wallet::Config::NETDB_REALM) {
+        $principal =~ s/\@\Q$Wallet::Config::NETDB_REALM//;
+    }
+    unless ($remctl->command ('netdb', 'node-roles', $principal, $acl)) {
+        $self->error ('cannot check NetDB ACL: ' . $remctl->error);
+        return undef;
+    }
+    my ($roles, $output, $status, $error);
+    do {
+        $output = $remctl->output;
+        if ($output->type eq 'output') {
+            if ($output->stream == 1) {
+                $roles .= $output->data;
+            } else {
+                $error .= $output->data;
+            }
+        } elsif ($output->type eq 'error') {
+            $self->error ('cannot check NetDB ACL: ' . $output->data);
+            return undef;
+        } elsif ($output->type eq 'status') {
+            $status = $output->status;
+        } else {
+            $self->error ('malformed NetDB remctl token: ' . $output->type);
+            return undef;
+        }
+    } while ($output->type eq 'output');
+    if ($status == 0) {
+        my @roles = split (' ', $roles);
+        for my $role (@roles) {
+            return 1 if $role eq 'admin';
+            return 1 if $role eq 'team';
+            return 1 if $role eq 'user';
+        }
+        return 0;
+    } else {
+        if ($error) {
+            chomp $error;
+            $error =~ s/\n/ /g;
+            $self->error ("error checking NetDB ACL: $error");
+        } else {
+            $self->error ("error checking NetDB ACL");
+        }
+        return undef;
+    }
+}
+
+1;
+__END__
+
+##############################################################################
+# Documentation
+##############################################################################
+
+=head1 NAME
+
+Wallet::ACL::NetDB - Wallet ACL verifier for NetDB roles
+
+=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 checks a principal against the NetDB roles for a given
+host.  It is used to verify ACL lines of type netdb.  The value of such an
+ACL is a node, and the ACL grants access to a given principal if and only
+if that principal has one of the roles user, admin, or team for that node.
+
+To use this object, several configuration parameters must be set.  See
+Wallet::Config(3) for details on those configuration parameters and
+information about how to set wallet configuration.
+
+=head1 METHODS
+
+=over 4
+
+=item new()
+
+Creates a new ACL verifier.  Opens the remctl connection to the NetDB
+server and authenticates.
+
+=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 (with the realm stripped off if
+configured) has the user, admin, or team role for that node.
+
+=item error()
+
+Returns the error if check() returned undef.
+
+=back
+
+=head1 DIAGNOSTICS
+
+The new() method may fail with one of the following exceptions:
+
+=over 4
+
+=item NetDB ACL support not available: %s
+
+The Net::Remctl Perl module, required for NetDB ACL support, could not be
+loaded.
+
+=item NetDB ACL support not configured
+
+The required configuration parameters were not set.  See Wallet::Config(3)
+for the required configuration parameters and how to set them.
+
+=item cannot connect to NetDB remctl interface: %s
+
+Connecting to the NetDB remctl interface failed with the given error
+message.
+
+=back
+
+Verifying a NetDB ACL may fail with the following errors (returned by the
+error() method):
+
+=over 4
+
+=item cannot check NetDB ACL: %s
+
+Issuing the remctl command to get the roles for the given principal failed
+or returned an error.
+
+=item error checking NetDB ACL: %s
+
+The NetDB remctl interface that returns the roles for a user returned an
+error message or otherwise returned failure.
+
+=item malformed netdb ACL
+
+The ACL parameter to check() was malformed.  Currently, this error is only
+given if ACL is undefined or the empty string.
+
+=item malformed NetDBL remctl token: %s
+
+The Net::Remctl Perl library returned a malformed token.  This should
+never happen and indicates a bug in Net::Remctl.
+
+=item no principal specified
+
+The PRINCIPAL parameter to check() was undefined or the empty string.
+
+=back
+
+=head1 CAVEATS
+
+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::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/Config.pm b/perl/Wallet/Config.pm
index 1b36658..3bd2055 100644
--- a/perl/Wallet/Config.pm
+++ b/perl/Wallet/Config.pm
@@ -281,14 +281,15 @@ retrieve> via remctl on KEYTAB_REMCTL_HOST.
 
 =cut
 
-our $KEYTAB_CACHE;
+our $KEYTAB_REMCTL_CACHE;
 
 =item KEYTAB_REMCTL_HOST
 
 The host to which to connect with remctl to retrieve existing keytabs.  This
 is only used to implement support for the C<unchanging> flag.  This host
-must provide the C<keytab retrieve> command and KEYTAB_CACHE must also be
-set to a ticket cache for a principal with access to run that command.
+must provide the C<keytab retrieve> command and KEYTAB_REMCTL_CACHE must
+also be set to a ticket cache for a principal with access to run that
+command.
 
 =cut
 
@@ -397,6 +398,73 @@ our $KEYTAB_AFS_SRVTAB;
 
 =back
 
+=head1 NETDB ACL CONFIGURATION
+
+These configuration variables are only needed if you intend to use the
+C<netdb> ACL type (the Wallet::ACL::NetDB class).  They specify the remctl
+connection information for retrieving user roles from NetDB and the local
+realm to remove from principals (since NetDB normally expects unscoped local
+usernames).
+
+=over 4
+
+=item NETDB_REALM
+
+The wallet uses fully-qualified principal names (including the realm), but
+NetDB normally expects local usernames without the realm.  If this variable
+is set, the given realm will be stripped from any principal names before
+passing them to NetDB.  Principals in other realms will be passed to NetDB
+without modification.
+
+=cut
+
+our $NETDB_REALM;
+
+=item NETDB_REMCTL_CACHE
+
+Specifies the ticket cache to use when querying the NetDB remctl interface
+for user roles.  The ticket cache must be for a principal with access to run
+C<netdb node-roles> via remctl on KEYTAB_REMCTL_HOST.  This variable must be
+set to use NetDB ACLs.
+
+=cut
+
+our $NETDB_REMCTL_CACHE;
+
+=item NETDB_REMCTL_HOST
+
+The host to which to connect with remctl to query NetDB for user roles.
+This host must provide the C<netdb node-roles> command and
+NETDB_REMCTL_CACHE must also be set to a ticket cache for a principal with
+access to run that command.  This variable must be set to use NetDB ACLs.
+
+=cut
+
+our $NETDB_REMCTL_HOST;
+
+=item NETDB_REMCTL_PRINCIPAL
+
+The service principal to which to authenticate when querying NetDB for user
+roles.  If this variable is not set, the default is formed by prepending
+C<host/> to NETDB_REMCTL_HOST.  (Note that NETDB_REMCTL_HOST is not
+lowercased first.)
+
+=cut
+
+our $NETDB_REMCTL_PRINCIPAL;
+
+=item NETDB_REMCTL_PORT
+
+The port on NETDB_REMCTL_HOST to which to connect with remctl to query NetDB
+for user roles.  If this variable is not set, the default remctl port will
+be used.
+
+=cut
+
+our $NETDB_REMCTL_PORT;
+
+=back
+
 =cut
 
 # Now, load the configuration file so that it can override the defaults.
diff --git a/perl/t/data/keytab.conf b/perl/t/data/keytab.conf
index eb105e2..e7908ed 100644
--- a/perl/t/data/keytab.conf
+++ b/perl/t/data/keytab.conf
@@ -1,10 +1,6 @@
 # $Id$
 #
-# This is the remctl configuration used for testing the keytab backend's
-# ability to retrieve existing keytabs through remctl.  Currently the only
-# supported and used command is keytab retrieve.  The ACL is written on
-# the fly by the test program.
-#
-# Compare to config/keytab.
+# This is the remctl configuration used for testing the NetDB ACL verifier.
+# The ACL is written on the fly by the test program.
 
-keytab retrieve t/data/keytab-fake test-acl
+netdb node-roles t/data/netdb-fake test-acl
diff --git a/perl/t/data/netdb-fake b/perl/t/data/netdb-fake
new file mode 100755
index 0000000..56744a7
--- /dev/null
+++ b/perl/t/data/netdb-fake
@@ -0,0 +1,58 @@
+#!/bin/sh
+# $Id$
+#
+# netdb-fake -- 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
+# nodes.
+
+set -e
+
+if [ "$1" != "node-roles" ] ; then
+    echo "Invalid command $1" >&2
+    exit 1
+fi
+
+case "$2" in
+test-user)
+    case "$3" in
+    all)
+        echo 'admin'
+        echo 'team'
+        echo 'user'
+        ;;
+    admin)
+        echo 'admin'
+        ;;
+    team)
+        echo 'team'
+        ;;
+    user)
+        echo 'This is just ignored' >&2
+        echo 'user'
+        ;;
+    unknown)
+        echo 'admin' >&2
+        echo 'unknown'
+        ;;
+    none)
+        ;;
+    esac
+    ;;
+error)
+    case "$3" in
+    normal)
+        echo 'some error' >&2
+        exit 1
+        ;;
+    status)
+        exit 1
+        ;;
+    esac
+    ;;
+*)
+    echo "Unknown principal $2" >&2
+    exit 1
+    ;;
+esac
diff --git a/perl/t/data/netdb.conf b/perl/t/data/netdb.conf
new file mode 100644
index 0000000..eb105e2
--- /dev/null
+++ b/perl/t/data/netdb.conf
@@ -0,0 +1,10 @@
+# $Id$
+#
+# This is the remctl configuration used for testing the keytab backend's
+# ability to retrieve existing keytabs through remctl.  Currently the only
+# supported and used command is keytab retrieve.  The ACL is written on
+# the fly by the test program.
+#
+# Compare to config/keytab.
+
+keytab retrieve t/data/keytab-fake test-acl
diff --git a/perl/t/verifier.t b/perl/t/verifier.t
index 713c495..467115f 100755
--- a/perl/t/verifier.t
+++ b/perl/t/verifier.t
@@ -8,10 +8,67 @@
 #
 # See LICENSE for licensing terms.
 
-use Test::More tests => 13;
+use Test::More tests => 37;
 
 use Wallet::ACL::Base;
 use Wallet::ACL::Krb5;
+use Wallet::ACL::NetDB;
+use Wallet::Config;
+
+# Returns the one-line contents of a file as a string, removing the newline.
+sub contents {
+    my ($file) = @_;
+    open (FILE, '<', $file) or die "cannot open $file: $!\n";
+    my $data = <FILE>;
+    close FILE;
+    chomp $data;
+    return $data;
+}
+
+# Given a keytab file, try authenticating with kinit.
+sub getcreds {
+    my ($file, $principal) = @_;
+    my @commands = (
+        "kinit -k -t $file $principal >/dev/null </dev/null",
+        "kinit -t $file $principal >/dev/null </dev/null",
+        "kinit -k -K $file $principal >/dev/null </dev/null",
+    );
+    for my $command (@commands) {
+        if (system ($command) == 0) {
+            return 1;
+        }
+    }
+    return 0;
+}
+
+# Start remctld with the appropriate options to run our fake keytab backend.
+sub spawn_remctld {
+    my ($path, $principal, $keytab) = @_;
+    unlink 'test-pid';
+    my $pid = fork;
+    if (not defined $pid) {
+        die "cannot fork: $!\n";
+    } elsif ($pid == 0) {
+        open (STDERR, '>&STDOUT') or die "cannot redirect stderr: $!\n";
+        exec ($path, '-m', '-p', 14373, '-s', $principal, '-P', 'test-pid',
+              '-f', 't/data/keytab.conf', '-S', '-F', '-k', $keytab) == 0
+            or die "cannot exec $path: $!\n";
+    } else {
+        my $tries = 0;
+        while ($tries < 10 && ! -f 'test-pid') {
+            select (undef, undef, undef, 0.25);
+        }
+    }
+}
+
+# Stop the running remctld process.
+sub stop_remctld {
+    open (PID, '<', 'test-pid') or return;
+    my $pid = <PID>;
+    close PID;
+    chomp $pid;
+    kill 15, $pid;
+}
 
 my $verifier = Wallet::ACL::Base->new;
 ok (defined $verifier, 'Wallet::ACL::Base creation');
@@ -33,3 +90,78 @@ is ($verifier->check (undef, 'rra@stanford.edu'), undef,
 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.
+SKIP: {
+    skip 'no keytab configuration', 24 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;
+    eval { require Net::Remctl };
+    skip 'Net::Remctl not available', 24 if $@;
+
+    # Set up our configuration.
+    $Wallet::Config::NETDB_REALM = 'EXAMPLE.COM';
+    my $principal = contents ('t/data/test.principal');
+
+    # Now spawn our remctld server and get a ticket cache.
+    unlink ('krb5cc_test', 'test-acl', 'test-pid');
+    spawn_remctld ($remctld, $principal, 't/data/test.keytab');
+    $ENV{KRB5CCNAME} = 'krb5cc_test';
+    getcreds ('t/data/test.keytab', $principal);
+
+    # Finally, we can test.
+    my $verifier = eval { Wallet::ACL::NetDB->new };
+    is ($verifier, undef, 'Constructor fails without configuration');
+    is ($@, "NetDB ACL support not configured\n", ' with the right exception');
+    $Wallet::Config::NETDB_REMCTL_CACHE = 'krb5cc_test';
+    $verifier = eval { Wallet::ACL::NetDB->new };
+    is ($verifier, undef, ' and still fails without host');
+    is ($@, "NetDB ACL support not configured\n", ' with the right exception');
+    $Wallet::Config::NETDB_REMCTL_HOST = 'localhost';
+    $Wallet::Config::NETDB_REMCTL_PRINCIPAL = $principal;
+    $Wallet::Config::NETDB_REMCTL_PORT = 14373;
+    $verifier = eval { Wallet::ACL::NetDB->new };
+    ok (defined $verifier, ' and now creation succeeds');
+    ok ($verifier->isa ('Wallet::ACL::NetDB'), ' and returns the right class');
+    is ($verifier->check ('test-user', 'all'), undef,
+        ' but verification fails without an ACL');
+    is ($verifier->error, 'cannot check NetDB ACL: Access denied',
+        ' with the right error');
+
+    # Create an ACL so that tests will start working.
+    open (ACL, '>', 'test-acl') or die "cannot create test-acl: $!\n";
+    print ACL "$principal\n";
+    close ACL;
+    is ($verifier->check ('test-user', 'all'), 1,
+        ' and now verification works');
+
+    # Test the successful verifications.
+    for my $node (qw/admin team user/) {
+        is ($verifier->check ('test-user', $node), 1,
+            "Verification succeeds for $node");
+    }
+
+    # Test various failures.
+    is ($verifier->check ('test-user', 'unknown'), 0,
+        'Verification fails for unknown');
+    is ($verifier->check ('test-user', 'none'), 0, ' and for none');
+    is ($verifier->check (undef, 'all'), undef,
+        'Undefined principal');
+    is ($verifier->error, 'no principal specified', ' and right error');
+    is ($verifier->check ('test-user', ''), undef, 'Empty ACL');
+    is ($verifier->error, 'malformed netdb ACL', ' and right error');
+    is ($verifier->check ('error', 'normal'), undef, 'Regular error');
+    is ($verifier->error, 'error checking NetDB ACL: some error',
+        ' and correct error return');
+    is ($verifier->check ('error', 'status'), undef, 'Status-only error');
+    is ($verifier->error, 'error checking NetDB ACL', ' and correct error');
+    is ($verifier->check ('unknown', 'unknown'), undef, 'Unknown node');
+    is ($verifier->error,
+        'error checking NetDB ACL: Unknown principal unknown',
+        ' and correct error');
+    stop_remctld;
+
+    unlink ('krb5cc_test', 'test-acl', 'test-pid');
+}