Implement unchanging support in the keytab object backend, which retrieves

keytabs via remctl from the KDC.

6 files changed, 246 insertions, 16 deletions

diff --git a/TODO b/TODO
index 8ce6b96..bb5c926 100644
--- a/TODO
+++ b/TODO
@@ -2,9 +2,6 @@
 
 Required to replace leland_srvtab:
 
-* Implement support for the unchanging flag on keytabs and the backend
-  remctl calls to retrieve the existing keytab.
-
 * Add arbitrary attribute setting and retrieval to objects and include the
   attributes in the object show display.
 
diff --git a/perl/Wallet/Config.pm b/perl/Wallet/Config.pm
index 4bc8e2f..9a1f9db 100644
--- a/perl/Wallet/Config.pm
+++ b/perl/Wallet/Config.pm
@@ -170,6 +170,17 @@ client.
 
 =over 4
 
+=item KEYTAB_CACHE
+
+Specifies the ticket cache to use when retrieving existing keytabs from the
+KDC.  This is only used to implement support for the C<unchanging> flag.
+The ticket cache must be for a principal with access to run C<keytab
+retrieve> via remctl on KEYTAB_REMCTL_HOST.
+
+=cut
+
+our $KEYTAB_CACHE;
+
 =item KEYTAB_FILE
 
 Specifies the keytab to use to authenticate to B<kadmind>.  The principal
@@ -245,6 +256,39 @@ default to the local realm.
 
 our $KEYTAB_REALM;
 
+=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.
+
+=cut
+
+our $KEYTAB_REMCTL_HOST;
+
+=item KEYTAB_REMCTL_PRINCIPAL
+
+The service principal to which to authenticate when retrieving existing
+keytabs.  This is only used to implement support for the C<unchanging> flag.
+If this variable is not set, the default is formed by prepending C<host/> to
+KEYTAB_REMCTL_HOST.  (Note that KEYTAB_REMCTL_HOST is not lowercased first.)
+
+=cut
+
+our $KEYTAB_REMCTL_PRINCIPAL;
+
+=item KEYTAB_REMCTL_PORT
+
+The port on KEYTAB_REMCTL_HOST to which to connect with remctl to retrieve
+existing keytabs.  This is only used to implement support for the
+C<unchanging> flag.  If this variable is not set, the default remctl port
+will be used.
+
+=cut
+
+our $KEYTAB_REMCTL_PORT;
+
 =item KEYTAB_TMP
 
 A directory into which the wallet can write keytabs temporarily while
diff --git a/perl/Wallet/Object/Keytab.pm b/perl/Wallet/Object/Keytab.pm
index 41a679e..582f78c 100644
--- a/perl/Wallet/Object/Keytab.pm
+++ b/perl/Wallet/Object/Keytab.pm
@@ -172,7 +172,50 @@ sub kadmin_delprinc {
 }
 
 ##############################################################################
-# Implementation
+# Keytab retrieval
+##############################################################################
+
+# Retrieve an existing keytab from the KDC via a remctl call.  The KDC needs
+# to be running the keytab-backend script and support the keytab retrieve
+# remctl command.  In addition, the user must have configured us with the path
+# to a ticket cache and the host to which to connect with remctl.  Returns the
+# keytab on success and undef on failure.
+sub keytab_retrieve {
+    my ($self, $keytab) = @_;
+    my $host = $Wallet::Config::KEYTAB_REMCTL_HOST;
+    unless ($host and $Wallet::Config::KEYTAB_CACHE) {
+        $self->error ('keytab unchanging support not configured');
+        return undef;
+    }
+    eval { require Net::Remctl };
+    if ($@) {
+        $self->error ("keytab unchanging support not available: $@");
+        return undef;
+    }
+    if ($Wallet::Config::KEYTAB_REALM) {
+        $keytab .= '@' . $Wallet::Config::KEYTAB_REALM;
+    }
+    local $ENV{KRB5CCNAME} = $Wallet::Config::KEYTAB_CACHE;
+    my $port = $Wallet::Config::KEYTAB_REMCTL_PORT;
+    my $principal = $Wallet::Config::KEYTAB_REMCTL_PRINCIPAL;
+    my @command = ('keytab', 'retrieve', $keytab);
+    my $result = Net::Remctl::remctl ($host, $port, $principal, @command);
+    if ($result->error) {
+        $self->error ("cannot retrieve keytab for $keytab: ", $result->error);
+        return undef;
+    } elsif ($result->status != 0) {
+        my $error = $result->stderr;
+        $error =~ s/\s+$//;
+        $error =~ s/\n/ /g;
+        $self->error ("cannot retrieve keytab for $keytab: $error");
+        return undef;
+    } else {
+        return $result->stdout;
+    }
+}
+
+##############################################################################
+# Core methods
 ##############################################################################
 
 # Override create to start by creating the principal in Kerberos and only
@@ -207,6 +250,13 @@ sub get {
         $self->error ("cannot get $id: object is locked");
         return;
     }
+    if ($self->flag_check ('unchanging')) {
+        my $result = $self->keytab_retrieve ($self->{name});
+        if (defined $result) {
+            $self->log_action ('get', $user, $host, $time);
+        }
+        return $result;
+    }
     unless (defined ($Wallet::Config::KEYTAB_TMP)) {
         $self->error ('KEYTAB_TMP configuration variable not set');
         return undef;
diff --git a/perl/t/data/keytab-fake b/perl/t/data/keytab-fake
new file mode 100755
index 0000000..df21294
--- /dev/null
+++ b/perl/t/data/keytab-fake
@@ -0,0 +1,29 @@
+#!/bin/sh
+# $Id$
+#
+# keytab-fake -- 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
+# wallet/one and returns an error for wallet/two.
+
+set -e
+
+if [ "$1" != "retrieve" ] ; then
+    echo "Invalid command $1" >&2
+    exit 1
+fi
+
+case "$2" in
+wallet/one@*)
+    printf 'Keytab for wallet/one'
+    ;;
+wallet/two@*)
+    echo 'bite me' >&2
+    exit 1
+    ;;
+*)
+    echo "Unknown principal $2" >&2
+    exit 1
+    ;;
+esac
diff --git a/perl/t/data/keytab.conf b/perl/t/data/keytab.conf
new file mode 100644
index 0000000..eb105e2
--- /dev/null
+++ b/perl/t/data/keytab.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/keytab.t b/perl/t/keytab.t
index 238c6a7..88a40a9 100755
--- a/perl/t/keytab.t
+++ b/perl/t/keytab.t
@@ -3,7 +3,7 @@
 #
 # t/keytab.t -- Tests for the keytab object implementation.
 
-use Test::More tests => 50;
+use Test::More tests => 66;
 
 use Wallet::Config;
 use Wallet::Object::Keytab;
@@ -19,6 +19,9 @@ my $user = 'admin@EXAMPLE.COM';
 my $host = 'localhost';
 my @trace = ($user, $host);
 
+# Flush all output immediately.
+$| = 1;
+
 # Returns the one-line contents of a file as a string, removing the newline.
 sub contents {
     my ($file) = @_;
@@ -78,7 +81,6 @@ sub getcreds {
     );
     for my $command (@commands) {
         if (system ($command) == 0) {
-            unlink ('keytab');
             return 1;
         }
     }
@@ -102,11 +104,50 @@ sub valid {
     print KEYTAB $keytab;
     close KEYTAB;
     $principal .= '@' . $Wallet::Config::KEYTAB_REALM;
-    return getcreds ('keytab', $principal);
+    my $result = getcreds ('keytab', $principal);
+    if ($result) {
+        unlink 'keytab';
+    }
+    return $result;
 }
 
+# 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) {
+        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;
+}
+
+# Use Wallet::Server to set up the database.
+my $server = eval { Wallet::Server->initialize ($user) };
+is ($@, '', 'Database initialization did not die');
+ok ($server->isa ('Wallet::Server'), ' and returned the right class');
+my $dbh = $server->dbh;
+
+# Basic keytab creation and manipulation tests.
 SKIP: {
-    skip 'no keytab configuration', 37 unless -f 't/data/test.keytab';
+    skip 'no keytab configuration', 48 unless -f 't/data/test.keytab';
 
     # Set up our configuration.
     $Wallet::Config::KEYTAB_FILE      = 't/data/test.keytab';
@@ -122,12 +163,6 @@ SKIP: {
     # Don't destroy the user's Kerberos ticket cache.
     $ENV{KRB5CCNAME} = 'krb5cc_test';
 
-    # Use Wallet::Server to set up the database.
-    my $server = eval { Wallet::Server->initialize ($user) };
-    is ($@, '', 'Database initialization did not die');
-    ok ($server->isa ('Wallet::Server'), ' and returned the right class');
-    my $dbh = $server->dbh;
-
     # Okay, now we can test.  First, create.
     $object = eval {
         Wallet::Object::Keytab->create ('keytab', "wallet\nf", $dbh, @trace)
@@ -272,7 +307,72 @@ EOO
     is ($object, undef, 'Cope with a failure to run kadmin');
     like ($@, qr{^cannot run /some/nonexistent/file: },
           ' with the right error');
+    $Wallet::Config::KEYTAB_KADMIN = 'kadmin';
+}
+
+# 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', 16 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', 16 unless $remctld;
 
-    # Clean up.
-    unlink ('wallet-db', 'krb5cc_temp', 'krb5cc_test');
+    # Set up our configuration.
+    $Wallet::Config::KEYTAB_FILE      = 't/data/test.keytab';
+    $Wallet::Config::KEYTAB_PRINCIPAL = contents ('t/data/test.principal');
+    $Wallet::Config::KEYTAB_REALM     = contents ('t/data/test.realm');
+    $Wallet::Config::KEYTAB_TMP       = '.';
+    my $realm = $Wallet::Config::KEYTAB_REALM;
+    my $principal = $Wallet::Config::KEYTAB_PRINCIPAL;
+
+    # Create the objects for testing and set the unchanging flag.
+    my $one = eval {
+        Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace)
+      };
+    ok (defined ($one), 'Creating wallet/one succeeds');
+    is ($one->flag_set ('unchanging', @trace), 1, ' and setting unchanging');
+    my $two = eval {
+        Wallet::Object::Keytab->create ('keytab', 'wallet/two', $dbh, @trace);
+      };
+    ok (defined ($two), 'Creating wallet/two succeeds');
+    is ($two->flag_set ('unchanging', @trace), 1, ' and setting unchanging');
+
+    # Now spawn our remctld server and get a ticket cache.
+    spawn_remctld ($remctld, $principal, 't/data/test.keytab');
+    $ENV{KRB5CCNAME} = 'krb5cc_test';
+    getcreds ('t/data/test.keytab', $principal);
+    $ENV{KRB5CCNAME} = 'krb5cc_good';
+
+    # Finally we can test.
+    is ($one->get (@trace), undef, 'Get without configuration fails');
+    is ($one->error, 'keytab unchanging support not configured',
+        ' with the right error');
+    $Wallet::Config::KEYTAB_CACHE = 'krb5cc_test';
+    is ($one->get (@trace), undef, ' and still fails without host');
+    is ($one->error, 'keytab unchanging support not configured',
+        ' with the right error');
+    $Wallet::Config::KEYTAB_REMCTL_HOST = 'localhost';
+    $Wallet::Config::KEYTAB_REMCTL_PRINCIPAL = $principal;
+    $Wallet::Config::KEYTAB_REMCTL_PORT = 14373;
+    is ($one->get (@trace), undef, ' and still fails without ACL');
+    is ($one->error,
+        "cannot retrieve keytab for wallet/one\@$realm: Access denied",
+        ' with the right error');
+    open (ACL, '>', 'test-acl') or die "cannot create test-acl: $!\n";
+    print ACL "$principal\n";
+    close ACL;
+    is ($one->get (@trace), 'Keytab for wallet/one', 'Now get works');
+    is ($ENV{KRB5CCNAME}, 'krb5cc_good',
+        ' and we did not nuke the cache name');
+    is ($two->get (@trace), undef, ' but get for wallet/two does not');
+    is ($two->error,
+        "cannot retrieve keytab for wallet/two\@$realm: bite me",
+        ' with the right error');
+    is ($one->destroy (@trace), 1, 'Destroying wallet/one works');
+    is ($two->destroy (@trace), 1, ' as does destroying wallet/two');
+    stop_remctld;
 }
+
+# Clean up.
+unlink ('wallet-db', 'krb5cc_temp', 'krb5cc_test', 'test-acl', 'test-pid');