2 files changed, 95 insertions, 1 deletions

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;