Add support for synchronizing a key with an AFS kaserver in the keytab

object implementation, extracting the DES key with Authen::Krb5 (since
ktutil doesn't work).

Rename the KEYTAB_CACHE variable to KEYTAB_REMCTL_CACHE to match the
rest of the keytab retrieval configuration and reorganize the
Wallet::Config documentation to group related configuration options for
the keytab backend.

Fix a column name in the keytab_enctypes table to be more consistent
with the rest of the schema.

3 files changed, 392 insertions, 26 deletions

diff --git a/perl/Wallet/Config.pm b/perl/Wallet/Config.pm
index 9a1f9db..c52cfd1 100644
--- a/perl/Wallet/Config.pm
+++ b/perl/Wallet/Config.pm
@@ -170,17 +170,6 @@ 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
@@ -256,6 +245,44 @@ default to the local realm.
 
 our $KEYTAB_REALM;
 
+=item KEYTAB_TMP
+
+A directory into which the wallet can write keytabs temporarily while
+processing C<get> commands from clients.  The keytabs are written into this
+directory with predictable names, so this should not be a system temporary
+directory such as F</tmp> or F</var/tmp>.  It's best to create a directory
+solely for this purpose that's owned by the user the wallet server will run
+as.
+
+KEYTAB_TMP must be set to use keytab objects.
+
+=cut
+
+our $KEYTAB_TMP;
+
+=back
+
+=head2 Retrieving Existing Keytabs
+
+The keytab object backend optionally supports retrieving existing keys, and
+hence keytabs, for Kerberos principals by contacting the KDC via remctl and
+talking to B<keytab-backend>.  This is enabled by setting the C<unchanging>
+flag on keytab objects.  To configure that support, set the following
+variables.
+
+=over 4
+
+=item KEYTAB_REMCTL_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_REMCTL_HOST
 
 The host to which to connect with remctl to retrieve existing keytabs.  This
@@ -289,20 +316,60 @@ will be used.
 
 our $KEYTAB_REMCTL_PORT;
 
-=item KEYTAB_TMP
+=back
 
-A directory into which the wallet can write keytabs temporarily while
-processing C<get> commands from clients.  The keytabs are written into this
-directory with predictable names, so this should not be a system temporary
-directory such as F</tmp> or F</var/tmp>.  It's best to create a directory
-solely for this purpose that's owned by the user the wallet server will run
-as.
+=head2 Synchronization with AFS kaserver
 
-KEYTAB_TMP must be set to use keytab objects.
+The keytab backend optionally supports synchronizing keys between the
+Kerberos v5 realm and a Kerberos v4 realm using kaserver.  This
+synchronization is done using B<kasetkey> and is controlled by the C<sync>
+attribute on keytab objects.  To configure that support, set the following
+variables.
+
+=over 4
+
+=item $KEYTAB_AFS_ADMIN
+
+The Kerberos v4 principal to use for authentication to the AFS kaserver.  If
+this principal is not in the default local Kerberos v4 realm, it must be
+fully qualified.  A srvtab for this principal must be stored in the path set
+in $KEYTAB_AFS_SRVTAB.  This principal must have the ADMIN flag set in the
+AFS kaserver so that it can create and remove principals.  This variable
+must be set to use the kaserver synchronization support.
 
 =cut
 
-our $KEYTAB_TMP;
+our $KEYTAB_AFS_ADMIN;
+
+=item $KEYTAB_AFS_KASETKEY
+
+The path to the B<kasetkey> command-line client.  The default value is
+C<kasetkey>, which will cause the wallet to search for B<kasetkey> on its
+default PATH.
+
+=cut
+
+our $KEYTAB_AFS_KASETKEY = 'kasetkey';
+
+=item $KEYTAB_AFS_REALM
+
+The name of the Kerberos v4 realm with which to synchronize keys.  This is a
+realm, not a cell, so it should be in all uppercase.  If this variable is
+not set, the default is the realm determined from the local cell name.
+
+=cut
+
+our $KEYTAB_AFS_REALM;
+
+=item $KEYTAB_AFS_SRVTAB
+
+The path to a srvtab used to authenticate to the AFS kaserver.  This srvtab
+should be for the principal set in $KEYTAB_AFS_ADMIN.  This variable must be
+set to use the kaserver synchronization support.
+
+=cut
+
+our $KEYTAB_AFS_SRVTAB;
 
 =back
 
diff --git a/perl/Wallet/Object/Keytab.pm b/perl/Wallet/Object/Keytab.pm
index 582f78c..64e7ce1 100644
--- a/perl/Wallet/Object/Keytab.pm
+++ b/perl/Wallet/Object/Keytab.pm
@@ -172,6 +172,199 @@ sub kadmin_delprinc {
 }
 
 ##############################################################################
+# AFS kaserver synchronization
+##############################################################################
+
+# Given a Kerberos v5 principal name, convert it to a Kerberos v4 principal
+# name.  Returns undef if it can't convert the name for some reason (right
+# now, only if the principal has more than two parts).  Note that this mapping
+# does not guarantee a unique result; multiple hosts in different domains can
+# be mapped to the same Kerberos v4 principal name using this function.
+sub kaserver_name {
+    my ($self, $k5) = @_;
+    my %host = map { $_ => 1 } qw(host ident imap pop smtp);
+    $k5 =~ s/\@.*//;
+    my @parts = split ('/', $k5);
+    if (@parts == 1) {
+        return $parts[0];
+    } elsif (@parts > 2) {
+        return undef;
+    } elsif ($host{$parts[0]}) {
+        $parts[1] =~ s/\..*//;
+        $parts[0] = 'rcmd' if $parts[0] eq 'host';
+    }
+    my $k4 = join ('.', @parts);
+    if ($Wallet::Config::KEYTAB_AFS_REALM) {
+        $k4 .= '@' . $Wallet::Config::KEYTAB_AFS_REALM;
+    }
+    return $k4;
+}
+
+# Given a keytab file name, the Kerberos v5 principal that's stored in that
+# keytab, a srvtab file name, and the corresponding Kerberos v4 principal,
+# write out a srvtab file containing the DES key in that keytab.  Fails if
+# there is no DES key in the keytab.
+sub kaserver_srvtab {
+    my ($self, $keytab, $k5, $srvtab, $k4) = @_;
+
+    # Gah.  Someday I will write Perl bindings for Kerberos that are less
+    # broken.
+    eval { require Authen::Krb5 };
+    if ($@) {
+        $self->error ("kaserver synchronization support not available: $@");
+        return undef;
+    }
+    eval { Authen::Krb5::init_context() };
+    if ($@ and not $@ =~ /^Authen::Krb5 already initialized/) {
+        $self->error ('Kerberos initialization failed');
+        return undef;
+    }
+    undef $@;
+
+    # Do the interface dance.  We call kt_read_service_key with 0 for the kvno
+    # to get any kvno, which works with MIT Kerberos at least.  Assume a DES
+    # enctype of 1.  This code won't work with any enctype other than
+    # des-cbc-crc.
+    my $princ = Authen::Krb5::parse_name ($k5);
+    unless (defined $princ) {
+        my $error = Authen::Krb5::error();
+        $self->error ("cannot parse $k5: $error");
+        return undef;
+    }
+    my $key = Authen::Krb5::kt_read_service_key ($keytab, $princ, 0, 1);
+    unless (defined $key) {
+        my $error = Authen::Krb5::error();
+        $self->error ("cannot find des-cbc-crc key in $keytab: $error");
+        return undef;
+    }
+    unless (open (SRVTAB, '>', $srvtab)) {
+        $self->error ("cannot create $srvtab: $!");
+        return undef;
+    }
+
+    # srvtab format is nul-terminated name, nul-terminated instance,
+    # nul-terminated realm, single character kvno (which we always set to 0),
+    # and DES keyblock.
+    my ($principal, $realm) = split ('@', $k4);
+    my ($name, $inst) = split (/\./, $principal, 2);
+    my $data = join ("\0", $name, $inst, $realm);
+    $data .= "\0\0" . $key->contents;
+    print SRVTAB $data;
+    unless (close SRVTAB) {
+        unlink $srvtab;
+        $self->error ("cannot write to $srvtab: $!");
+        return undef;
+    }
+    return 1;
+}
+
+# Given a principal name and a path to the keytab, synchronizes the key with a
+# principal in an AFS kaserver.  Returns true on success and false on failure.
+# On failure, sets the internal error.
+sub kaserver_sync {
+    my ($self, $principal, $keytab) = @_;
+    my $admin = $Wallet::Config::KEYTAB_AFS_ADMIN;
+    my $admin_srvtab = $Wallet::Config::KEYTAB_AFS_SRVTAB;
+    my $kasetkey = $Wallet::Config::KEYTAB_AFS_KASETKEY;
+    unless ($kasetkey and $admin and $admin_srvtab) {
+        $self->error ('kaserver synchronization not configured');
+        return undef;
+    }
+    if ($Wallet::Config::KEYTAB_REALM) {
+        $principal .= '@' . $Wallet::Config::KEYTAB_REALM;
+    }
+    my $k4 = $self->kaserver_name ($principal);
+    if (not defined $k4) {
+        $self->error ("cannot convert $principal to Kerberos v4");
+        return undef;
+    }
+    my $srvtab = $Wallet::Config::KEYTAB_TMP . "/srvtab.$$";
+    unless ($self->kaserver_srvtab ($keytab, $principal, $srvtab, $k4)) {
+        return undef;
+    }
+    my $pid = open (KASETKEY, '-|');
+    if (not defined $pid) {
+        $self->error ("cannot fork: $!");
+        unlink $srvtab;
+        return undef;
+    } elsif ($pid == 0) {
+        open (STDERR, '>&STDOUT') or die "cannot redirect stderr: $!\n";
+        exec ($kasetkey, '-k', $admin_srvtab, '-a', $admin, '-c', $srvtab,
+              '-s', $k4)
+            or die "cannot exec $kasetkey: $!\n";
+    } else {
+        local $/;
+        my $output = <KASETKEY>;
+        close KASETKEY;
+        if ($? != 0) {
+            $output =~ s/\s+\z//;
+            $output =~ s/\n/, /g;
+            $output = ': ' . $output if $output;
+            $self->error ("cannot synchronize key with kaserver$output");
+            unlink $srvtab;
+            return undef;
+        }
+    }
+    unlink $srvtab;
+    return 1;
+}
+
+# Set the kaserver sync attribute.  Called by attr().  Returns true on success
+# and false on failure, setting the object error if it fails.
+sub kaserver_set {
+    my ($self, $user, $host, $time) = @_;
+    $time ||= time;
+    my @trace = ($user, $host, $time);
+    my $name = $self->{name};
+    eval {
+        my $sql = "select ks_name from keytab_sync where ks_name = ? and
+            ks_target = 'kaserver'";
+        my $result = $self->{dbh}->selectrow_array ($sql, undef, $name);
+        if ($result) {
+            die "kaserver synchronization already set\n";
+        }
+        $sql = "insert into keytab_sync (ks_name, ks_target)
+            values (?, 'kaserver')";
+        $self->{dbh}->do ($sql, undef, $name);
+        $self->log_set ('type_data sync', undef, 'kaserver', @trace);
+        $self->{dbh}->commit;
+    };
+    if ($@) {
+        $self->error ($@);
+        $self->{dbh}->rollback;
+        return undef;
+    }
+    return 1;
+}
+
+# Clear the kaserver sync attribute.  Called by attr().  Returns true on
+# success and false on failure, setting the object error if it fails.
+sub kaserver_clear {
+    my ($self, $user, $host, $time) = @_;
+    $time ||= time;
+    my @trace = ($user, $host, $time);
+    my $name = $self->{name};
+    eval {
+        my $sql = "select ks_name from keytab_sync where ks_name = ? and
+            ks_target = 'kaserver'";
+        my $result = $self->{dbh}->selectrow_array ($sql, undef, $name);
+        unless ($result) {
+            die "kaserver synchronization not set\n";
+        }
+        $sql = 'delete from keytab_sync where ks_name = ?';
+        $self->{dbh}->do ($sql, undef, $name);
+        $self->log_set ('type_data sync', 'kaserver', undef, @trace);
+        $self->{dbh}->commit;
+    };
+    if ($@) {
+        $self->error ($@);
+        $self->{dbh}->rollback;
+        return undef;
+    }
+    return 1;
+}
+
+##############################################################################
 # Keytab retrieval
 ##############################################################################
 
@@ -183,7 +376,7 @@ sub kadmin_delprinc {
 sub keytab_retrieve {
     my ($self, $keytab) = @_;
     my $host = $Wallet::Config::KEYTAB_REMCTL_HOST;
-    unless ($host and $Wallet::Config::KEYTAB_CACHE) {
+    unless ($host and $Wallet::Config::KEYTAB_REMCTL_CACHE) {
         $self->error ('keytab unchanging support not configured');
         return undef;
     }
@@ -195,7 +388,7 @@ sub keytab_retrieve {
     if ($Wallet::Config::KEYTAB_REALM) {
         $keytab .= '@' . $Wallet::Config::KEYTAB_REALM;
     }
-    local $ENV{KRB5CCNAME} = $Wallet::Config::KEYTAB_CACHE;
+    local $ENV{KRB5CCNAME} = $Wallet::Config::KEYTAB_REMCTL_CACHE;
     my $port = $Wallet::Config::KEYTAB_REMCTL_PORT;
     my $principal = $Wallet::Config::KEYTAB_REMCTL_PRINCIPAL;
     my @command = ('keytab', 'retrieve', $keytab);
@@ -218,6 +411,49 @@ sub keytab_retrieve {
 # Core methods
 ##############################################################################
 
+# Override attr to support setting the sync attribute.
+sub attr {
+    my ($self, $attribute, $values, $user, $host, $time) = @_;
+    undef $self->{error};
+    if ($attribute ne 'sync') {
+        $self->error ("unknown attribute $attribute");
+        return;
+    }
+    if ($values) {
+        if (@$values > 1) {
+            $self->error ('only one synchronization target supported');
+            return;
+        } elsif (@$values and $values->[0] ne 'kaserver') {
+            $self->error ("unsupported synchronization target $values->[0]");
+            return;
+        }
+        $time ||= time;
+        my @trace = ($user, $host, $time);
+        if (@$values) {
+            return $self->kaserver_set ($user, $host, $time);
+        } else {
+            return $self->kaserver_clear ($user, $host, $time);
+        }
+    } else {
+        my @targets;
+        eval {
+            my $sql = 'select ks_target from keytab_sync where ks_name = ?
+                order by ks_target';
+            my $sth = $self->{dbh}->prepare ($sql);
+            $sth->execute ($self->{name});
+            my $target;
+            while (defined ($target = $sth->fetchrow_array)) {
+                push (@targets, $target);
+            }
+        };
+        if ($@) {
+            $self->error ($@);
+            return;
+        }
+        return @targets;
+    }
+}
+
 # Override create to start by creating the principal in Kerberos and only
 # create the entry in the database if that succeeds.  Error handling isn't
 # great here since we don't have a way to communicate the error back to the
@@ -262,6 +498,7 @@ sub get {
         return undef;
     }
     my $file = $Wallet::Config::KEYTAB_TMP . "/keytab.$$";
+    unlink $file;
     return undef if not $self->kadmin_ktadd ($self->{name}, $file);
     local *KEYTAB;
     unless (open (KEYTAB, '<', $file)) {
@@ -275,9 +512,16 @@ sub get {
     if ($!) {
         my $princ = $self->{name};
         $self->error ("error reading keytab for principal $princ: $!");
+        unlink $file;
         return undef;
     }
     close KEYTAB;
+    my @sync = $self->attr ('sync');
+    if (grep { $_ eq 'kaserver' } @sync) {
+        unless ($self->kaserver_sync ($self->{name}, $file)) {
+            return undef;
+        }
+    }
     unlink $file;
     $self->log_action ('get', $user, $host, $time);
     return $data;
@@ -331,6 +575,43 @@ methods that are overridden or behave specially for this implementation.
 
 =over 4
 
+=item attr(ATTRIBUTE [, VALUES, PRINCIPAL, HOSTNAME [, DATETIME]])
+
+Sets or retrieves a given object attribute.  The following attributes are
+supported:
+
+=over 4
+
+=item sync
+
+Sets the external systems to which the key of a given principal is
+synchronized.  The only supported value for this attribute is C<kaserver>,
+which says to synchronize the key with an AFS Kerberos v4 kaserver.
+
+If this attribute is set on a keytab, whenever get() is called for that
+keytab, the new DES key will be extracted from that keytab and set in the
+configured AFS kaserver.  The Kerberos v4 principal name will be the same as
+the Kerberos v5 principal name except that the components are separated by
+C<.> instead of C</>; the second component is truncated after the first C<.>
+if the first component is one of C<host>, C<ident>, C<imap>, C<pop>, or
+C<smtp>; and the first component is C<rcmd> if the Kerberos v5 principal
+component is C<host>.  The principal name must not contain more than two
+components.
+
+=back
+
+If no other arguments besides ATTRIBUTE are given, returns the values of
+that attribute, if any, as a list.  On error, returns the empty list.  To
+distinguish between an error and an empty return, call error() afterwards.
+It is guaranteed to return undef unless there was an error.
+
+If other arguments are given, sets the given ATTRIBUTE values to VALUES,
+which must be a reference to an array (even if only one value is being set).
+Pass a reference to an empty array to clear the attribute values.
+PRINCIPAL, HOSTNAME, and DATETIME are stored as history information.
+PRINCIPAL should be the user who is destroying the object.  If DATETIME
+isn't given, the current time is used.
+
 =item create(TYPE, NAME, DBH, PRINCIPAL, HOSTNAME [, DATETIME])
 
 This is a class method and should be called on the Wallet::Object::Keytab
diff --git a/perl/Wallet/Schema.pm b/perl/Wallet/Schema.pm
index d856433..352f497 100644
--- a/perl/Wallet/Schema.pm
+++ b/perl/Wallet/Schema.pm
@@ -322,7 +322,25 @@ oh_by stores the authenticated identity that made the change, oh_from stores
 the host from which they made the change, and oh_on stores the time the
 change was made.
 
-=head2 Storage Backend Data
+=head2 Keytab Backend Data
+
+The keytab backend supports synchronizing keys with an external system.  The
+permitted external systems are listed in a normalization table:
+
+  create table sync_targets
+     (st_name             varchar(255) primary key);
+  insert into sync_targets (st_name) values ('kaserver');
+
+and then the synchronization targets for a given keytab are stored in this
+table:
+
+  create table keytab_sync
+     (ks_name             varchar(255)
+          not null references objects(ob_name),
+      ks_target           varchar(255)
+          not null references sync_targets(st_name),
+      primary key (ks_name, ks_target));
+  create index ks_name on keytab_sync (ks_name);
 
 The keytab backend supports restricting the allowable enctypes for a given
 keytab.  The permitted enctypes are listed in a normalization table:
@@ -333,12 +351,12 @@ keytab.  The permitted enctypes are listed in a normalization table:
 and then the restrictions for a given keytab are stored in this table:
 
   create table keytab_enctypes
-     (ke_principal        varchar(255)
+     (ke_name             varchar(255)
           not null references objects(ob_name),
       ke_enctype          varchar(255)
           not null references enctypes(en_name),
-      primary key (ke_principal, ke_enctype));
-  create index ke_principal on keytab_enctypes (ke_principal);
+      primary key (ke_name, ke_enctype));
+  create index ke_name on keytab_enctypes (ke_name);
 
 To use this functionality, you will need to populate the enctypes table with
 the enctypes that a keytab may be restricted to.  Currently, there is no