Initial implementation of enctype restriction with a basic test suite.

Still needs a more comprehensive test suite.

Remove all attributes for a keytab object when it is destroyed so that
when the object is recreated, it doesn't inherit attributes from its
previous self.  Add a test case for that for the sync attribute.

3 files changed, 277 insertions, 46 deletions

diff --git a/docs/design-api b/docs/design-api
index 8c5c1d5..cb4bfa6 100644
--- a/docs/design-api
+++ b/docs/design-api
@@ -76,10 +76,12 @@ Object API
 
     Destroys the given object.  Backend implementations should override
     this method if they need to destroy the object in an external system
-    and then call the parent method to do the database cleanup.  For
-    example, the keytab backend overrides this method to destroy the
-    principal in the Kerberos KDC.  Be careful not to require that the
-    object exist in a remote system for destroy() to work, since an
+    or if they have any object-specific attributes to remove.  Overriding
+    methods should then call the parent method to do the database cleanup.
+    For example, the keytab backend overrides this method to destroy the
+    principal in the Kerberos KDC and remove the enctypes and sync
+    attribute data from auxiliary tables.  Be careful not to require that
+    the object exist in a remote system for destroy() to work, since an
     administrator will want to destroy an orphaned wallet database entry
     after something happened to the remote system entry.
 
diff --git a/perl/Wallet/Object/Keytab.pm b/perl/Wallet/Object/Keytab.pm
index 34f580f..4727590 100644
--- a/perl/Wallet/Object/Keytab.pm
+++ b/perl/Wallet/Object/Keytab.pm
@@ -121,10 +121,12 @@ sub kadmin_addprinc {
     return 1;
 }
 
-# Create a keytab from a principal.  Return true if successful, false
-# otherwise.  If the keytab creation fails, sets the error.
+# Create a keytab from a principal.  Takes the principal, the file, and
+# optionally a list of encryption types to which to limit the keytab.  Return
+# true if successful, false otherwise.  If the keytab creation fails, sets the
+# error.
 sub kadmin_ktadd {
-    my ($self, $principal, $file) = @_;
+    my ($self, $principal, $file, @enctypes) = @_;
     unless ($self->valid_principal ($principal)) {
         $self->error ("invalid principal name: $principal");
         return undef;
@@ -132,7 +134,12 @@ sub kadmin_ktadd {
     if ($Wallet::Config::KEYTAB_REALM) {
         $principal .= '@' . $Wallet::Config::KEYTAB_REALM;
     }
-    my $output = eval { $self->kadmin ("ktadd -q -k $file $principal") };
+    my $command = "ktadd -q -k $file";
+    if (@enctypes) {
+        @enctypes = map { /:/ ? $_ : "$_:normal" } @enctypes;
+        $command .= ' -e "' . join (' ', @enctypes) . '"';
+    }
+    my $output = eval { $self->kadmin ("$command $principal") };
     if ($@) {
         $self->error ($@);
         return undef;
@@ -388,6 +395,77 @@ sub kaserver_clear {
 }
 
 ##############################################################################
+# Enctype restriction
+##############################################################################
+
+# Set the enctype restrictions for a keytab.  Called by attr() and takes a
+# reference to the encryption types to set.  Returns true on success and false
+# on failure, setting the object error if it fails.
+sub enctypes_set {
+    my ($self, $enctypes, $user, $host, $time) = @_;
+    $time ||= time;
+    my @trace = ($user, $host, $time);
+    my $name = $self->{name};
+    my %enctypes = map { $_ => 1 } @$enctypes;
+    eval {
+        my $sql = 'select ke_enctype from keytab_enctypes where ke_name = ?';
+        my $sth = $self->{dbh}->prepare ($sql);
+        $sth->execute ($name);
+        my (@current, $entry);
+        while (defined ($entry = $sth->fetchrow_arrayref)) {
+            push (@current, @$entry);
+        }
+        for my $enctype (@current) {
+            if ($enctypes{$enctype}) {
+                delete $enctypes{$enctype};
+            } else {
+                $sql = 'delete from keytab_enctypes where ke_name = ? and
+                    ke_enctype = ?';
+                $self->{dbh}->do ($sql, undef, $name, $enctype);
+                $self->log_set ('type_data enctypes', $enctype, undef, @trace);
+            }
+        }
+        for my $enctype (keys %enctypes) {
+            $sql = 'insert into keytab_enctypes (ke_name, ke_enctype) values
+                (?, ?)';
+            $self->{dbh}->do ($sql, undef, $name, $enctype);
+            $self->log_set ('type_data enctypes', undef, $enctype, @trace);
+        }
+        $self->{dbh}->commit;
+    };
+    if ($@) {
+        $self->error ($@);
+        $self->{dbh}->rollback;
+        return undef;
+    }
+    return 1;
+}
+
+# Return a list of the encryption types current set for a keytab.  Called by
+# attr() or get().  Returns the empty list on failure or on an empty list of
+# enctype restrictions, but sets the object error on failure so the caller
+# should use that to determine success.
+sub enctypes_list {
+    my ($self) = @_;
+    my @enctypes;
+    eval {
+        my $sql = 'select ke_enctype from keytab_enctypes where ke_name = ?
+            order by ke_enctype';
+        my $sth = $self->{dbh}->prepare ($sql);
+        $sth->execute ($self->{name});
+        my $entry;
+        while (defined ($entry = $sth->fetchrow_arrayref)) {
+            push (@enctypes, @$entry);
+        }
+    };
+    if ($@) {
+        $self->error ($@);
+        return;
+    }
+    return @enctypes;
+}
+
+##############################################################################
 # Keytab retrieval
 ##############################################################################
 
@@ -434,60 +512,77 @@ sub keytab_retrieve {
 # Core methods
 ##############################################################################
 
-# Override attr to support setting the sync attribute.
+# Override attr to support setting the enctypes and sync attributes.
 sub attr {
     my ($self, $attribute, $values, $user, $host, $time) = @_;
+    my %known = map { $_ => 1 } qw(enctypes sync);
     undef $self->{error};
-    if ($attribute ne 'sync') {
+    unless ($known{$attribute}) {
         $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);
+        if ($attribute eq 'enctypes') {
+            $self->enctypes_set ($values, $user, $host, $time);
+        } elsif ($attribute eq 'sync') {
+            if (@$values > 1) {
+                $self->error ('only one synchronization target supported');
+                return;
+            } elsif (@$values and $values->[0] ne 'kaserver') {
+                my $target = $values->[0];
+                $self->error ("unsupported synchronization target $target");
+                return;
+            } elsif (@$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 ($attribute eq 'enctypes') {
+            return $self->enctypes_list;
+        } elsif ($attribute eq 'sync') {
+            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;
             }
-        };
-        if ($@) {
-            $self->error ($@);
-            return;
+            return @targets;
         }
-        return @targets;
     }
 }
 
-# Override attr_show to display the sync attribute.
+# Override attr_show to display the enctypes and sync attributes.
 sub attr_show {
     my ($self) = @_;
+    my $output = '';
     my @targets = $self->attr ('sync');
     if (not @targets and $self->error) {
         return undef;
     } elsif (@targets) {
-        return sprintf ("%15s: %s\n", 'Synced with', "@targets");
-    } else {
-        return '';
+        $output .= sprintf ("%15s: %s\n", 'Synced with', "@targets");
+    }
+    my @enctypes = $self->attr ('enctypes');
+    if (not @enctypes and $self->error) {
+        return undef;
+    } elsif (@enctypes) {
+        $output .= sprintf ("%15s: %s\n", 'Enctypes', $enctypes[0]);
+        shift @enctypes;
+        for my $enctype (@enctypes) {
+            $output .= (' ' x 17) . $enctype . "\n";
+        }
     }
+    return $output;
 }
 
 # Override create to start by creating the principal in Kerberos and only
@@ -514,6 +609,18 @@ sub destroy {
             return undef;
         }
     }
+    eval {
+        my $sql = 'delete from keytab_sync where ks_name = ?';
+        $self->{dbh}->do ($sql, undef, $self->{name});
+        $sql = 'delete from keytab_enctypes where ke_name = ?';
+        $self->{dbh}->do ($sql, undef, $self->{name});
+        $self->{dbh}->commit;
+    };
+    if ($@) {
+        $self->error ($@);
+        $self->{dbh}->rollback;
+        return undef;
+    }
     return undef if not $self->kadmin_delprinc ($self->{name});
     return $self->SUPER::destroy ($user, $host, $time);
 }
@@ -541,7 +648,8 @@ sub get {
     }
     my $file = $Wallet::Config::KEYTAB_TMP . "/keytab.$$";
     unlink $file;
-    return undef if not $self->kadmin_ktadd ($self->{name}, $file);
+    my @enctypes = $self->attr ('enctypes');
+    return undef if not $self->kadmin_ktadd ($self->{name}, $file, @enctypes);
     local *KEYTAB;
     unless (open (KEYTAB, '<', $file)) {
         my $princ = $self->{name};
@@ -627,6 +735,18 @@ supported:
 
 =over 4
 
+=item enctypes
+
+Restricts the generated keytab to a specific set of encryption types.  The
+values of this attribute must be enctype strings recognized by Kerberos
+(strings like C<aes256-cts> or C<des-cbc-crc>).  Note that the salt should
+not be included; since the salt is irrelevant for keytab keys, it will
+always be set to C<normal> by the wallet.
+
+If this attribute is set, the specified enctype list will be passed to
+ktadd when get() is called for that keytab.  If it is not set, the default
+set in the KDC will be used.
+
 =item sync
 
 Sets the external systems to which the key of a given principal is
diff --git a/perl/t/keytab.t b/perl/t/keytab.t
index abe7bf5..89e1440 100755
--- a/perl/t/keytab.t
+++ b/perl/t/keytab.t
@@ -8,12 +8,22 @@
 #
 # See LICENSE for licensing terms.
 
-use Test::More tests => 160;
+use Test::More tests => 172;
 
 use Wallet::Config;
 use Wallet::Object::Keytab;
 use Wallet::Server;
 
+# Mapping of klist -ke encryption type names to the strings that Kerberos uses
+# internally.  It's very annoying to have to maintain this, and it probably
+# breaks with Heimdal.
+my %enctype =
+    ('triple des cbc mode with hmac/sha1'      => 'des3-cbc-sha1',
+     'des cbc mode with crc-32'                => 'des-cbc-crc',
+     'des cbc mode with rsa-md5'               => 'des-cbc-md5',
+     'aes-256 cts mode with 96-bit sha-1 hmac' => 'aes256-cts',
+     'arcfour with hmac/md5'                   => 'rc4-hmac');
+
 # Use a local SQLite database for testing.
 $Wallet::Config::DB_DRIVER = 'SQLite';
 $Wallet::Config::DB_INFO = 'wallet-db';
@@ -116,6 +126,31 @@ sub valid {
     return $result;
 }
 
+# Given keytab data, write it to a file and try to determine the enctypes of
+# the keys present in that file.  Returns the enctypes as a list, with UNKNOWN
+# for encryption types that weren't recognized.  This is an ugly way of doing
+# this.
+sub enctypes {
+    my ($keytab) = @_;
+    open (KEYTAB, '>', 'keytab') or die "cannot create keytab: $!\n";
+    print KEYTAB $keytab;
+    close KEYTAB;
+    open (KLIST, '-|', 'klist', '-ke', 'keytab')
+        or die "cannot run klist: $!\n";
+    my @enctypes;
+    local $_;
+    while (<KLIST>) {
+        next unless /^ *\d+ /;
+        my ($string) = /\((.*)\)\s*$/;
+        next unless $string;
+        $enctype = $enctype{lc $string} || 'UNKNOWN';
+        push (@enctypes, $enctype);
+    }
+    close KLIST;
+    unlink 'keytab';
+    return @enctypes;
+}
+
 # Given a Wallet::Object::Keytab object, the keytab data, the Kerberos v5
 # principal, and the Kerberos v4 principal, write the keytab to a file,
 # generate a srvtab, and try authenticating using k4start.
@@ -402,7 +437,7 @@ SKIP: {
 
 # Tests for kaserver synchronization support.
 SKIP: {
-    skip 'no keytab configuration', 94 unless -f 't/data/test.keytab';
+    skip 'no keytab configuration', 98 unless -f 't/data/test.keytab';
 
     # Test the principal mapping.  We can do this without having a kaserver
     # configuration.  We only need a basic keytab object configuration.  Do
@@ -492,7 +527,7 @@ EOO
     is ($show, $expected, ' and show now displays the attribute');
 
     # Set up our configuration.
-    skip 'no AFS kaserver configuration', 27 unless -f 't/data/test.srvtab';
+    skip 'no AFS kaserver configuration', 31 unless -f 't/data/test.srvtab';
     $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');
@@ -565,10 +600,84 @@ EOO
     ok (! -f "keytab.$$", ' and the temporary file was cleaned up');
     $Wallet::Config::KEYTAB_AFS_KASETKEY = '../kasetkey/kasetkey';
 
-    # Destroy the principal.
+    # Destroy the principal and recreate it and make sure we cleaned up.
     is ($one->destroy (@trace), 1, 'Destroying wallet/one works');
     ok (! valid_srvtab ($one, $keytab, $k5, $k4),
         ' and the principal is gone');
+    $one = eval {
+        Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace)
+      };
+    ok (defined ($one), ' and recreating it succeeds');
+    @targets = $one->attr ('sync');
+    is (scalar (@targets), 0, ' and now there is no attribute');
+    is ($one->error, undef, ' and no error');
+
+    # Now destroy it for good.
+    is ($one->destroy (@trace), 1, 'Destroying wallet/one works');
+}
+
+# Tests for enctype restriction.
+SKIP: {
+    skip 'no keytab configuration', 8 unless -f 't/data/test.keytab';
+
+    # 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 an object for testing and determine the enctypes we have to work
+    # with.
+    my $one = eval {
+        Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace)
+      };
+    ok (defined ($one), 'Creating wallet/one succeeds');
+    my $keytab = $one->get (@trace);
+    ok (defined ($keytab), ' and retrieving the keytab works');
+    my @enctypes = sort grep { $_ ne 'UNKNOWN' } enctypes ($keytab);
+
+    # No enctypes we recognize?
+    skip 'no recognized enctypes', 6 unless @enctypes;
+
+    # We can test.  Add the enctypes we recognized to the enctypes table so
+    # that we'll be allowed to use them.
+    for (@enctypes) {
+        my $sql = "insert into keytab_enctypes (ke_name, ke_enctype)
+            values ('wallet/one', ?)";
+        $dbh->do ($sql, undef, $_);
+    }
+
+    # Set those encryption types and make sure we get back a limited keytab.
+    is ($one->attr ('enctypes', [ @enctypes ], @trace), 1,
+        'Setting enctypes works');
+    my @values = $one->attr ('enctypes');
+    is ("@values", "@enctypes", ' and we get back the right enctype list');
+    my $eshow = join ("\n" . (' ' x 17), @enctypes);
+    $eshow =~ s/\s+\z/\n/;
+    my $show = $one->show;
+    $show =~ s/^(\s*(Created|Downloaded) on:) \d+$/$1 0/mg;
+    $expected = <<"EOO";
+           Type: keytab
+           Name: wallet/one
+       Enctypes: $eshow
+     Created by: $user
+   Created from: $host
+     Created on: 0
+  Downloaded by: $user
+Downloaded from: $host
+  Downloaded on: 0
+EOO
+    is ($show, $expected, ' and show now displays the enctype list');
+    $keytab = $one->get (@trace);
+    ok (defined ($keytab), ' and retrieving the keytab still works');
+    @values = enctypes ($keytab);
+    @values = sort @values;
+    is ("@values", "@enctypes", ' and the keytab has the right keys');
+
+    # All done.  Clean up.
+    is ($one->destroy (@trace), 1, 'Destroying wallet/one works');
 }
 
 # Clean up.