diff options
Diffstat (limited to 'perl')
| -rw-r--r-- | perl/Wallet/Object/Keytab.pm | 196 | ||||
| -rwxr-xr-x | perl/t/keytab.t | 117 |
2 files changed, 271 insertions, 42 deletions
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. |