From 574a9c0456c182831b3d01a4d7ee0c737b91b107 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 9 Jun 2009 14:39:39 -0700 Subject: Remove Subversion Id strings --- perl/Wallet/Config.pm | 1 - 1 file changed, 1 deletion(-) (limited to 'perl/Wallet/Config.pm') diff --git a/perl/Wallet/Config.pm b/perl/Wallet/Config.pm index 6c72781..3f52cf0 100644 --- a/perl/Wallet/Config.pm +++ b/perl/Wallet/Config.pm @@ -1,5 +1,4 @@ # Wallet::Config -- Configuration handling for the wallet server. -# $Id$ # # Written by Russ Allbery # Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University -- cgit v1.2.3 From 59455fd5e6a47a66a2a84779f42928fd66ec9747 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 9 Feb 2010 13:06:31 -0800 Subject: Remove kaserver synchronization support from the wallet backend Remove kaserver synchronization support. It is no longer tested, and retaining the code was increasing the complexity of wallet, and some specific requirements (such as different realm names between kaserver and Kerberos v5 and the kvno handling) were Stanford-specific. Rather than using this support, AFS sites running kaserver will probably find deploying Heimdal with its internal kaserver compatibility is probably an easier transition approach. --- NEWS | 8 + perl/Wallet/Config.pm | 83 +--------- perl/Wallet/Object/Keytab.pm | 349 +++++++------------------------------------ perl/Wallet/Schema.pm | 10 +- perl/t/config.t | 6 +- perl/t/keytab.t | 217 ++------------------------- perl/t/schema.t | 2 +- 7 files changed, 86 insertions(+), 589 deletions(-) (limited to 'perl/Wallet/Config.pm') diff --git a/NEWS b/NEWS index 04942ea..3185db3 100644 --- a/NEWS +++ b/NEWS @@ -2,6 +2,14 @@ wallet 0.10 (unreleased) + Remove kaserver synchronization support. It is no longer tested, and + retaining the code was increasing the complexity of wallet, and some + specific requirements (such as different realm names between kaserver + and Kerberos v5 and the kvno handling) were Stanford-specific. Rather + than using this support, AFS sites running kaserver will probably find + deploying Heimdal with its internal kaserver compatibility is probably + an easier transition approach. + Correctly handle storing of data that begins with a dash and don't parse it as an argument to wallet-backend. diff --git a/perl/Wallet/Config.pm b/perl/Wallet/Config.pm index 3f52cf0..7198c07 100644 --- a/perl/Wallet/Config.pm +++ b/perl/Wallet/Config.pm @@ -1,7 +1,7 @@ # Wallet::Config -- Configuration handling for the wallet server. # # Written by Russ Allbery -# Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2008, 2010 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -14,7 +14,7 @@ use vars qw($PATH $VERSION); # This version should be increased on any code change to this module. Always # use two digits for the minor version with a leading zero if necessary so # that it will sort properly. -$VERSION = '0.03'; +$VERSION = '0.04'; # Path to the config file to load. $PATH = $ENV{WALLET_CONFIG} || '/etc/wallet/wallet.conf'; @@ -351,85 +351,6 @@ our $KEYTAB_REMCTL_PORT; =back -=head2 Synchronization with AFS kaserver - -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 and is controlled by the C -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_AFS_ADMIN; - -=item KEYTAB_AFS_DESTROY - -If this variable, which is false by default, is set to a true value, each -time a keytab object that is not configured to be synchronized with the AFS -kaserver, the corresponding Kerberos v4 principal will be deleted from the -AFS kaserver. Use this with caution; it will cause the AFS kaserver realm -to be slowly stripped of principals. This is intended for use with -migration from Kerberos v4 to Kerberos v5, where the old principals should -be deleted out of Kerberos v4 whenever not requested from the wallet to aid -in tracking down and removing any systems with lingering Kerberos v4 -dependencies. - -Be aware that multiple Kerberos v5 principals map to the same Kerberos v4 -principal since in Kerberos v4 the domain name is stripped from the -principal for machine principals. If you create a keytab named -host/foo.example.com and mark it synchronized, and then create another -keytab named host/foo.example.net and don't mark it synchronized, -downloading the second will destroy the Kerberos v4 principal of the first -if this variable is set. - -=cut - -our $KEYTAB_AFS_DESTROY; - -=item KEYTAB_AFS_KASETKEY - -The path to the B command-line client. The default value is -C, which will cause the wallet to search for B 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 - =head1 NETDB ACL CONFIGURATION These configuration variables are only needed if you intend to use the diff --git a/perl/Wallet/Object/Keytab.pm b/perl/Wallet/Object/Keytab.pm index 9fece80..b604907 100644 --- a/perl/Wallet/Object/Keytab.pm +++ b/perl/Wallet/Object/Keytab.pm @@ -1,7 +1,8 @@ # Wallet::Object::Keytab -- Keytab object implementation for the wallet. # # Written by Russ Allbery -# Copyright 2007, 2008, 2009 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2008, 2009, 2010 +# Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -24,230 +25,7 @@ use Wallet::Kadmin; # This version should be increased on any code change to this module. Always # use two digits for the minor version with a leading zero if necessary so # that it will sort properly. -$VERSION = '0.07'; - -############################################################################## -# 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 > 2) { - return; - } elsif (@parts == 2 and $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; -} - -# Run kasetkey with the given arguments. Returns true on success and false on -# failure. On failure, sets the internal error to the error from kasetkey. -sub kaserver_kasetkey { - my ($self, @args) = @_; - 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; - } - my $pid = open (KASETKEY, '-|'); - if (not defined $pid) { - $self->error ("cannot fork: $!"); - return; - } elsif ($pid == 0) { - # Don't use die here; it will get trapped as an exception. Also be - # careful about our database handles. (We still lose if there's some - # other database handle open we don't know about.) - $self->{dbh}->{InactiveDestroy} = 1; - unless (open (STDERR, '>&STDOUT')) { - warn "cannot redirect stderr: $!\n"; - exit 1; - } - unless (exec ($kasetkey, '-k', $admin_srvtab, '-a', $admin, @args)) { - warn "cannot exec $kasetkey: $!\n"; - exit 1; - } - } else { - local $/; - my $output = ; - close KASETKEY; - if ($? != 0) { - $output =~ s/\s+\z//; - $output =~ s/\n/, /g; - $output = ': ' . $output if $output; - $self->error ("cannot synchronize key with kaserver$output"); - return; - } - } - return 1; -} - -# 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; - } - eval { Authen::Krb5::init_context() }; - if ($@ and not $@ =~ /^Authen::Krb5 already initialized/) { - $self->error ('Kerberos initialization failed'); - return; - } - 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; - } - 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; - } - unless (open (SRVTAB, '>', $srvtab)) { - $self->error ("cannot create $srvtab: $!"); - return; - } - - # 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); - $realm ||= ''; - my ($name, $inst) = split (/\./, $principal, 2); - $inst ||= ''; - 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; - } - 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) = @_; - 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; - } - my $srvtab = $Wallet::Config::KEYTAB_TMP . "/srvtab.$$"; - unless ($self->kaserver_srvtab ($keytab, $principal, $srvtab, $k4)) { - return; - } - unless ($self->kaserver_kasetkey ('-c', $srvtab, '-s', $k4)) { - unlink $srvtab; - return; - } - unlink $srvtab; - return 1; -} - -# Given a principal name, destroy the corresponding principal in the AFS -# kaserver. Returns true on success and false on failure, setting the object -# error if it fails. -sub kaserver_destroy { - my ($self, $principal) = @_; - my $k4 = $self->kaserver_name ($principal); - if (not defined $k4) { - $self->error ("cannot convert $principal to Kerberos v4"); - return; - } - return $self->kaserver_kasetkey ('-D', $k4); -} - -# 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; - } - 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; - } - return 1; -} +$VERSION = '0.08'; ############################################################################## # Enctype restriction @@ -379,9 +157,14 @@ sub keytab_retrieve { # Core methods ############################################################################## -# Override attr to support setting the enctypes and sync attributes. +# Override attr to support setting the enctypes and sync attributes. Note +# that the sync attribute has no supported targets at present and hence will +# always return an error, but the code is still here so that it doesn't have +# to be rewritten once a new sync target is added. sub attr { my ($self, $attribute, $values, $user, $host, $time) = @_; + $time ||= time; + my @trace = ($user, $host, $time); my %known = map { $_ => 1 } qw(enctypes sync); undef $self->{error}; unless ($known{$attribute}) { @@ -395,14 +178,25 @@ sub attr { if (@$values > 1) { $self->error ('only one synchronization target supported'); return; - } elsif (@$values and $values->[0] ne 'kaserver') { + } elsif (@$values) { 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); + eval { + my $sql = 'select ks_target from keytab_sync where + ks_name = ?'; + my $dbh = $self->{dbh}; + my $name = $self->{name}; + my ($result) = $dbh->selectrow_array ($sql, undef, $name); + if ($result) { + my $sql = 'delete from keytab_sync where ks_name = ?'; + $self->{dbh}->do ($sql, undef, $name); + $self->log_set ('type_data sync', $result, undef, + @trace); + } + $self->{dbh}->commit; + } } } } else { @@ -511,12 +305,6 @@ sub destroy { $self->error ("cannot destroy $id: object is locked"); return; } - my @sync = $self->attr ('sync'); - if (grep { $_ eq 'kaserver' } @sync) { - unless ($self->kaserver_destroy ($self->{name})) { - return; - } - } eval { my $sql = 'delete from keytab_sync where ks_name = ?'; $self->{dbh}->do ($sql, undef, $self->{name}); @@ -582,15 +370,6 @@ sub get { return; } close KEYTAB; - my @sync = $self->attr ('sync'); - if (grep { $_ eq 'kaserver' } @sync) { - unless ($self->kaserver_sync ($self->{name}, $file)) { - unlink $file; - return; - } - } elsif ($Wallet::Config::KEYTAB_AFS_DESTROY) { - $self->kaserver_destroy ($self->{name}); - } unlink $file; $self->log_action ('get', $user, $host, $time); return $data; @@ -646,7 +425,7 @@ methods that are overridden or behave specially for this implementation. =item attr(ATTRIBUTE [, VALUES, PRINCIPAL, HOSTNAME [, DATETIME]]) -Sets or retrieves a given object attribute. The following attributes are +Sets or retrieves a given object attribute. The following attribute is supported: =over 4 @@ -655,40 +434,21 @@ supported: 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 or C). Encryption types must also -be present in the list of supported enctypes stored in the database database -or the attr() method will reject them. Note that the salt should not be -included; since the salt is irrelevant for keytab keys, it will always be -set to C by the wallet. +(strings like C or C). Encryption +types must also be present in the list of supported enctypes stored in the +database database or the attr() method will reject them. Note that the +salt should not be included; since the salt is irrelevant for keytab keys, +it will always be set to the default 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. +If this attribute is set, the principal will be restricted to that +specific enctype list when get() is called for that keytab. If it is not +set, the default set in the KDC will be used. This attribute is ignored if the C flag is set on a keytab. Keytabs retrieved with C set will contain all keys present in the KDC for that Kerberos principal and therefore may contain different enctypes than those requested by this attribute. -=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, -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, C, C, C, or -C; and the first component is C if the Kerberos v5 principal -component is C. The principal name must not contain more than two -components. - -If this attribute is set, calling destroy() will also destroy the principal -from the AFS kaserver, with a principal mapping determined as above. - =back If no other arguments besides ATTRIBUTE are given, returns the values of @@ -716,11 +476,11 @@ used. When a new keytab object is created, the Kerberos principal designated by NAME is also created in the Kerberos realm determined from the wallet -configuration. If the principal already exists, create() still succeeds (so -that a previously unmanaged principal can be imported into the wallet). -Otherwise, if the Kerberos principal could not be created, create() fails. -The principal is created with the C<-randkey> option to randomize its keys. -NAME must not contain the realm; instead, the KEYTAB_REALM configuration +configuration. If the principal already exists, create() still succeeds +(so that a previously unmanaged principal can be imported into the +wallet). Otherwise, if the Kerberos principal could not be created, +create() fails. The principal is created with the randomized keys. NAME +must not contain the realm; instead, the KEYTAB_REALM configuration variable should be set. See Wallet::Config(3) for more information. If create() fails, it throws an exception. @@ -738,18 +498,14 @@ destroying the object. If DATETIME isn't given, the current time is used. =item get(PRINCIPAL, HOSTNAME [, DATETIME]) -Retrieves a keytab for this object and returns the keytab data or undef -on error. The caller should call error() to get the error message if -get() returns undef. The keytab is created with C, invalidating -any existing keytabs for that principal, unless the unchanging flag is set -on the object. PRINCIPAL, HOSTNAME, and DATETIME are stored as history -information. PRINCIPAL should be the user who is downloading the keytab. -If DATETIME isn't given, the current time is used. - -If the configuration variable $KEYTAB_AFS_DESTROY is set and the C -attribute is not set to C, calling get() on a keytab object will -cause the corresponding Kerberos v4 principal to be destroyed. This -variable is not set by default. +Retrieves a keytab for this object and returns the keytab data or undef on +error. The caller should call error() to get the error message if get() +returns undef. The keytab is created with new randomized keys, +invalidating any existing keytabs for that principal, unless the +unchanging flag is set on the object. PRINCIPAL, HOSTNAME, and DATETIME +are stored as history information. PRINCIPAL should be the user who is +downloading the keytab. If DATETIME isn't given, the current time is +used. =back @@ -767,15 +523,14 @@ of the current process. The file is unlinked after being read. =head1 LIMITATIONS -Currently, this implementation only supports MIT Kerberos and needs -modifications to support Heimdal. It calls an external B program -rather than using a native Perl module and therefore requires B be -installed and parses its output. It may miss some error conditions if the -output of B ever changes. +Currently, when used with MIT Kerberos, this implementation calls an +external B program rather than using a native Perl module and +therefore requires B be installed and parses its output. It may +miss some error conditions if the output of B ever changes. Only one Kerberos realm is supported for a given wallet implementation and -all keytab objects stored must be in that realm. Keytab names in the wallet -database do not have realm information. +all keytab objects stored must be in that realm. Keytab names in the +wallet database do not have realm information. =head1 SEE ALSO diff --git a/perl/Wallet/Schema.pm b/perl/Wallet/Schema.pm index 2b256a2..252da03 100644 --- a/perl/Wallet/Schema.pm +++ b/perl/Wallet/Schema.pm @@ -1,7 +1,7 @@ # Wallet::Schema -- Database schema for the wallet system. # # Written by Russ Allbery -# Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2008, 2010 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -20,7 +20,7 @@ use DBI; # This version should be increased on any code change to this module. Always # use two digits for the minor version with a leading zero if necessary so # that it will sort properly. -$VERSION = '0.05'; +$VERSION = '0.06'; ############################################################################## # Data manipulation @@ -372,12 +372,12 @@ change was made. =head2 Keytab Backend Data -The keytab backend supports synchronizing keys with an external system. The -permitted external systems are listed in a normalization table: +The keytab backend has stub support for synchronizing keys with an +external system, although no external systems are currently supported. +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: diff --git a/perl/t/config.t b/perl/t/config.t index d60d7e7..1377cb8 100755 --- a/perl/t/config.t +++ b/perl/t/config.t @@ -3,11 +3,11 @@ # t/config.t -- Tests for the wallet server configuration. # # Written by Russ Allbery -# Copyright 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008, 2010 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. -use Test::More tests => 7; +use Test::More tests => 6; # Silence warnings since we're not using use. package Wallet::Config; @@ -25,8 +25,6 @@ is ($Wallet::Config::KEYTAB_FLAGS, '-clearpolicy', ' and KEYTAB_FLAGS is correct'); is ($Wallet::Config::KEYTAB_KADMIN, 'kadmin', ' and KEYTAB_KADMIN is correct'); -is ($Wallet::Config::KEYTAB_AFS_KASETKEY, 'kasetkey', - ' and KEYTAB_AFS_KASETKEY is correct'); is ($Wallet::Config::DB_DRIVER, undef, ' and DB_DRIVER is unset'); # Create a configuration file with a single setting. diff --git a/perl/t/keytab.t b/perl/t/keytab.t index 93df51c..e5a68be 100755 --- a/perl/t/keytab.t +++ b/perl/t/keytab.t @@ -9,7 +9,7 @@ # See LICENSE for licensing terms. use POSIX qw(strftime); -use Test::More tests => 213; +use Test::More tests => 125; use Wallet::Admin; use Wallet::Config; @@ -147,24 +147,6 @@ sub enctypes { return sort @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. -sub valid_srvtab { - my ($object, $keytab, $k5, $k4) = @_; - open (KEYTAB, '>', 'keytab') or die "cannot create keytab: $!\n"; - print KEYTAB $keytab; - close KEYTAB; - unless ($object->kaserver_srvtab ('keytab', $k5, 'srvtab', $k4)) { - warn "cannot write srvtab: ", $object->error, "\n"; - return 0; - } - $ENV{KRBTKFILE} = 'krb4cc_temp'; - system ("k4start -f srvtab $k4 2>&1 >/dev/null history, $history, 'History is correct to this point'); } -# Tests for kaserver synchronization support. +# Tests for synchronization support. This code is deactivated at present +# since no synchronization targets are supported, but we want to still test +# the basic stub code. SKIP: { skip 'no keytab configuration', 106 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 - # this as white-box testing since we don't want to fill the test realm - # with a bunch of random principals. + # Test setting synchronization attributes, which can also be done without + # configuration. my $one = eval { Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace) }; ok (defined ($one), 'Creating wallet/one succeeds'); - my %princs = - (foo => 'foo', - host => 'host', - rcmd => 'rcmd', - 'rcmd.foo' => 'rcmd.foo', - 'host/foo.example.org' => 'rcmd.foo', - 'ident/foo.example.org' => 'ident.foo', - 'imap/foo.example.org' => 'imap.foo', - 'pop/foo.example.org' => 'pop.foo', - 'smtp/foo.example.org' => 'smtp.foo', - 'service/foo' => 'service.foo', - 'foo/bar' => 'foo.bar'); - for my $princ (sort keys %princs) { - my $result = $princs{$princ}; - is ($one->kaserver_name ($princ), $result, "Name mapping: $princ"); - is ($one->kaserver_name ("$princ\@EXAMPLE.ORG"), $result, - ' with K5 realm'); - $Wallet::Config::KEYTAB_AFS_REALM = 'AFS.EXAMPLE.ORG'; - is ($one->kaserver_name ($princ), "$result\@AFS.EXAMPLE.ORG", - ' with K4 realm'); - is ($one->kaserver_name ("$princ\@EXAMPLE.ORG"), - "$result\@AFS.EXAMPLE.ORG", ' with K5 and K4 realm'); - undef $Wallet::Config::KEYTAB_AFS_REALM; - } - for my $princ (qw{service/foo/bar foo/bar/baz}) { - is ($one->kaserver_name ($princ), undef, "Name mapping: $princ"); - is ($one->kaserver_name ("$princ\@EXAMPLE.ORG"), undef, - ' with K5 realm'); - $Wallet::Config::KEYTAB_AFS_REALM = 'AFS.EXAMPLE.ORG'; - is ($one->kaserver_name ($princ), undef, ' with K4 realm'); - is ($one->kaserver_name ("$princ\@EXAMPLE.ORG"), undef, - ' with K5 and K4 realm'); - undef $Wallet::Config::KEYTAB_AFS_REALM; - } - - # Test setting synchronization attributes, which can also be done without - # configuration. my $expected = <<"EOO"; Type: keytab Name: wallet/one @@ -537,16 +482,20 @@ EOO my @targets = $one->attr ('foo'); is (scalar (@targets), 0, ' and getting an unknown attribute fails'); is ($one->error, 'unknown attribute foo', ' with the right error'); - is ($one->attr ('sync', [ 'foo' ], @trace), undef, + is ($one->attr ('sync', [ 'kaserver' ], @trace), undef, ' and setting an unknown sync target fails'); - is ($one->error, 'unsupported synchronization target foo', + is ($one->error, 'unsupported synchronization target kaserver', ' with the right error'); is ($one->attr ('sync', [ 'kaserver', 'bar' ], @trace), undef, ' and setting two targets fails'); is ($one->error, 'only one synchronization target supported', ' with the right error'); - is ($one->attr ('sync', [ 'kaserver' ], @trace), 1, - ' but setting only kaserver works'); + + # Create a synchronization manually so that we can test the display and + # removal code. + my $sql = "insert into keytab_sync (ks_name, ks_target) values + ('wallet/one', 'kaserver')"; + $dbh->do ($sql); @targets = $one->attr ('sync'); is (scalar (@targets), 1, ' and now one target is set'); is ($targets[0], 'kaserver', ' and it is correct'); @@ -563,15 +512,10 @@ EOO $history .= <<"EOO"; $date create by $user from $host -$date add kaserver to attribute sync - by $user from $host EOO is ($one->history, $history, ' and history is correct for attributes'); - is ($one->destroy (@trace), undef, 'Destroying wallet/one fails'); - is ($one->error, 'kaserver synchronization not configured', - ' because kaserver support is not configured'); is ($one->attr ('sync', [], @trace), 1, - ' but removing the kaserver sync attribute works'); + 'Removing the kaserver sync attribute works'); is ($one->destroy (@trace),1, ' and then destroying wallet/one works'); $history .= <<"EOO"; $date remove kaserver from attribute sync @@ -579,136 +523,7 @@ $date remove kaserver from attribute sync $date destroy by $user from $host EOO - - # Set up our configuration. - skip 'no AFS kaserver configuration', 34 unless -f 't/data/test.srvtab'; - skip 'no kaserver support', 34 unless -x '../kasetkey/kasetkey'; - $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_KRBTYPE = contents ('t/data/test.krbtype'); - $Wallet::Config::KEYTAB_TMP = '.'; - $Wallet::Config::KEYTAB_AFS_KASETKEY = '../kasetkey/kasetkey'; - my $realm = $Wallet::Config::KEYTAB_REALM; - my $k5 = "wallet/one\@$realm"; - - # Recreate and reconfigure the object. - $one = eval { - Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace) - }; - ok (defined ($one), 'Creating wallet/one succeeds'); - is ($one->attr ('sync', [ 'kaserver' ], @trace), 1, - ' and setting the kaserver sync attribute works'); - - # Finally, we can test. - is ($one->get (@trace), undef, 'Get without configuration fails'); - is ($one->error, 'kaserver synchronization not configured', - ' with the right error'); - $Wallet::Config::KEYTAB_AFS_ADMIN = contents ('t/data/test.admin'); - my $k4_realm = $Wallet::Config::KEYTAB_AFS_ADMIN; - $k4_realm =~ s/^[^\@]+\@//; - $Wallet::Config::KEYTAB_AFS_REALM = $k4_realm; - my $k4 = "wallet.one\@$k4_realm"; - is ($one->get (@trace), undef, ' and still fails with just admin'); - is ($one->error, 'kaserver synchronization not configured', - ' with the right error'); - $Wallet::Config::KEYTAB_AFS_SRVTAB = 't/data/test.srvtab'; - my $keytab = $one->get (@trace); - if (defined ($keytab)) { - ok (1, ' and now get works'); - } else { - is ($one->error, '', ' and now get works'); - } - ok (valid_srvtab ($one, $keytab, $k5, $k4), ' and the srvtab is valid'); - ok (! -f "./srvtab.$$", ' and the temporary file was cleaned up'); - - # Now remove the sync attribute and make sure things aren't synced. - is ($one->attr ('sync', [], @trace), 1, 'Clearing sync works'); - @targets = $one->attr ('sync'); - is (scalar (@targets), 0, ' and now there is no attribute'); - is ($one->error, undef, ' and no error'); - my $new_keytab = $one->get (@trace); - ok (defined ($new_keytab), ' and get still works'); - ok (! valid_srvtab ($one, $new_keytab, $k5, $k4), - ' but the srvtab does not'); - ok (valid_srvtab ($one, $keytab, $k5, $k4), ' and the old one does'); - is ($one->destroy (@trace), 1, ' and destroying wallet/one works'); - ok (valid_srvtab ($one, $keytab, $k5, $k4), - ' and the principal is still there'); - - # Test KEYTAB_AFS_DESTROY. - $one = eval { - Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace) - }; - ok (defined ($one), 'Creating wallet/one succeeds'); - $Wallet::Config::KEYTAB_AFS_DESTROY = 1; - $new_keytab = $one->get (@trace); - ok (defined ($new_keytab), ' and get works'); - ok (! valid_srvtab ($one, $new_keytab, $k5, $k4), - ' but the srvtab does not'); - ok (! valid_srvtab ($one, $keytab, $k5, $k4), - ' and now neither does the old one'); - $Wallet::Config::KEYTAB_AFS_DESTROY = 0; - - # Put it back and make sure it works again. - is ($one->attr ('sync', [ 'kaserver' ], @trace), 1, 'Setting sync works'); - $keytab = $one->get (@trace); - ok (defined ($keytab), ' and get works'); - ok (valid_srvtab ($one, $keytab, $k5, $k4), ' and the srvtab is valid'); - $Wallet::Config::KEYTAB_AFS_KASETKEY = '/path/to/nonexistent/file'; - $new_keytab = $one->get (@trace); - ok (! defined ($new_keytab), - ' but it fails if we mess up the kasetkey path'); - like ($one->error, qr{^cannot synchronize key with kaserver: }, - ' with the right error message'); - ok (! -f "keytab.$$", ' and the temporary file was cleaned up'); - $Wallet::Config::KEYTAB_AFS_KASETKEY = '../kasetkey/kasetkey'; - - # 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'); - - # Check that history is still correct. - $history .= <<"EOO"; -$date create - by $user from $host -$date add kaserver to attribute sync - by $user from $host -$date get - by $user from $host -$date remove kaserver from attribute sync - by $user from $host -$date get - by $user from $host -$date destroy - by $user from $host -$date create - by $user from $host -$date get - by $user from $host -$date add kaserver to attribute sync - by $user from $host -$date get - by $user from $host -$date destroy - by $user from $host -$date create - by $user from $host -$date destroy - by $user from $host -EOO - is ($one->history, $history, 'History is correct to this point'); + is ($one->history, $history, ' and history is correct for removal'); } # Tests for enctype restriction. diff --git a/perl/t/schema.t b/perl/t/schema.t index 01d5dac..559ece4 100755 --- a/perl/t/schema.t +++ b/perl/t/schema.t @@ -21,7 +21,7 @@ ok (defined $schema, 'Wallet::Schema creation'); ok ($schema->isa ('Wallet::Schema'), ' and class verification'); my @sql = $schema->sql; ok (@sql > 0, 'sql() returns something'); -is (scalar (@sql), 29, ' and returns the right number of statements'); +is (scalar (@sql), 28, ' and returns the right number of statements'); # Connect to a database and test create. db_setup; -- cgit v1.2.3 From b037770195ef0bd98d6655a65873b25d90e36032 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 9 Feb 2010 13:14:41 -0800 Subject: Document and make case-insensitive KEYTAB_KRBTYPE KEYTAB_KRBTYPE wasn't documented in Wallet::Config. Add it and the variable declaration. Also document the new mandatory setting in NEWS and add the Heimdal::Kadm5 requirement to README. Remove some of the language in README that implies that only MIT Kerberos is supported. Make the setting case-insensitive and improve the error message from Wallet::Kadmin if it isn't set. --- NEWS | 8 ++++++-- README | 18 +++++++----------- perl/Wallet/Config.pm | 9 +++++++++ perl/Wallet/Kadmin.pm | 9 +++++---- 4 files changed, 27 insertions(+), 17 deletions(-) (limited to 'perl/Wallet/Config.pm') diff --git a/NEWS b/NEWS index 3185db3..c6b3a9d 100644 --- a/NEWS +++ b/NEWS @@ -2,6 +2,12 @@ wallet 0.10 (unreleased) + Add support for Heimdal KDCs as well as MIT Kerberos KDCs. There is + now a mandatory new setting in Wallet::Config: $KEYTAB_KRBTYPE. It + should be set to either "MIT" or "Heimdal" depending on the Kerberos + KDC implementation used. The Heimdal support requires the + Heimdal::Kadm5 Perl module. + Remove kaserver synchronization support. It is no longer tested, and retaining the code was increasing the complexity of wallet, and some specific requirements (such as different realm names between kaserver @@ -28,8 +34,6 @@ wallet 0.10 (unreleased) Report ACL names as well as numbers in object history. - Add support for Heimdal KDCs as well as MIT Kerberos KDCs. - wallet 0.9 (2008-04-24) The wallet command-line client now reads the data for store from a diff --git a/README b/README index fa99b18..6e165ec 100644 --- a/README +++ b/README @@ -88,12 +88,13 @@ REQUIREMENTS Perl module, which comes with recent versions of Perl and is available on CPAN for older versions. - The keytab support in the wallet server requires the kadmin client - program be installed and currently assumes that it follows the syntax of - the MIT Kerberos kadmin client. It also requires that the wallet server - have a keytab for a principal with appropriate access to create, modify, - and delete principals from the KDC (as configured in kadm5.acl on an MIT - Kerberos KDC). + The keytab support in the wallet server supports either Heimdal or MIT + Kerberos KDCs. The Heimdal support requires the Heimdal::Kadm5 Perl + module. The MIT Kerberos support requires the MIT Kerberos kadmin + client program be installed. In either case, wallet also requires that + the wallet server have a keytab for a principal with appropriate access + to create, modify, and delete principals from the KDC (as configured in + kadm5.acl on an MIT Kerberos KDC). To support the unchanging flag on keytab objects, the Net::Remctl Perl module (shipped with remctl) must be installed on the server and the @@ -106,11 +107,6 @@ REQUIREMENTS to manage DNS), the Net::Remctl Perl module must be installed on the server. - To support synchronization with an AFS kaserver, the server must have - the Authen::Krb5 Perl module installed. AFS kaserver synchronization - support also requires building kasetkey, which requires AFS and Kerberos - v4 libraries. - To run the test suite, you must have Perl 5.8 or later and the Perl DBI module installed. You will also need a DBD module installed for the database backend you want to use (currently, either DBD::SQLite or diff --git a/perl/Wallet/Config.pm b/perl/Wallet/Config.pm index 7198c07..ae8cf9c 100644 --- a/perl/Wallet/Config.pm +++ b/perl/Wallet/Config.pm @@ -250,6 +250,15 @@ default PATH. our $KEYTAB_KADMIN = 'kadmin'; +=item KEYTAB_KRBTYPE + +The Kerberos KDC implementation type, either C or C +(case-insensitive). KEYTAB_KRBTYPE must be set to use keytab objects. + +=cut + +our $KEYTAB_KRBTYPE; + =item KEYTAB_PRINCIPAL The principal whose key is stored in KEYTAB_FILE. The wallet will diff --git a/perl/Wallet/Kadmin.pm b/perl/Wallet/Kadmin.pm index b3a630e..5c01ee3 100644 --- a/perl/Wallet/Kadmin.pm +++ b/perl/Wallet/Kadmin.pm @@ -1,7 +1,7 @@ # Wallet::Kadmin -- Kadmin module wrapper for the wallet. # # Written by Jon Robertson -# Copyright 2009 Board of Trustees, Leland Stanford Jr. University +# Copyright 2009, 2010 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -34,14 +34,15 @@ sub new { my ($kadmin); if (not $Wallet::Config::KEYTAB_KRBTYPE) { die "keytab object implementation not configured\n"; - } elsif ($Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') { + } elsif (lc ($Wallet::Config::KEYTAB_KRBTYPE) eq 'mit') { require Wallet::Kadmin::MIT; $kadmin = Wallet::Kadmin::MIT->new; - } elsif ($Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal') { + } elsif (lc ($Wallet::Config::KEYTAB_KRBTYPE) eq 'heimdal') { require Wallet::Kadmin::Heimdal; $kadmin = Wallet::Kadmin::Heimdal->new; } else { - die "keytab krb server type not set to a valid value\n"; + my $type = $Wallet::Config::KEYTAB_KRBTYPE; + die "unknown KEYTAB_KRBTYPE setting: $type\n"; } return $kadmin; -- cgit v1.2.3 From ae02de1488068b84371b05842c81a9aecc5f24c4 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 9 Feb 2010 23:19:27 -0800 Subject: Check spelling of server API POD and tweak server docs Also update the POD syntax check to the current version of that check I use elsewhere. Since I'm touching all the POD anyway, also rewrap all of the POD to 74 columns. Fix some references to MIT in the Wallet::Kadmin::Heimdal module documentation. --- perl/Wallet/ACL.pm | 110 +++++++++++----------- perl/Wallet/ACL/Base.pm | 31 ++++--- perl/Wallet/ACL/Krb5.pm | 13 ++- perl/Wallet/ACL/NetDB.pm | 26 +++--- perl/Wallet/ACL/NetDB/Root.pm | 46 +++++----- perl/Wallet/Admin.pm | 39 ++++---- perl/Wallet/Config.pm | 196 ++++++++++++++++++++------------------- perl/Wallet/Database.pm | 17 ++-- perl/Wallet/Kadmin.pm | 31 ++++--- perl/Wallet/Kadmin/Heimdal.pm | 52 +++++------ perl/Wallet/Kadmin/MIT.pm | 45 ++++----- perl/Wallet/Object/Base.pm | 209 ++++++++++++++++++++++-------------------- perl/Wallet/Object/File.pm | 18 ++-- perl/Wallet/Object/Keytab.pm | 55 ++++++----- perl/Wallet/Schema.pm | 129 ++++++++++++++------------ perl/Wallet/Server.pm | 209 ++++++++++++++++++++++-------------------- perl/t/pod-spelling.t | 75 +++++++++++++++ perl/t/pod.t | 14 ++- 18 files changed, 731 insertions(+), 584 deletions(-) create mode 100755 perl/t/pod-spelling.t (limited to 'perl/Wallet/Config.pm') diff --git a/perl/Wallet/ACL.pm b/perl/Wallet/ACL.pm index 9136fc2..76e7354 100644 --- a/perl/Wallet/ACL.pm +++ b/perl/Wallet/ACL.pm @@ -1,7 +1,7 @@ # Wallet::ACL -- Implementation of ACLs in the wallet system. # # Written by Russ Allbery -# Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2008, 2010 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -21,7 +21,7 @@ use POSIX qw(strftime); # This version should be increased on any code change to this module. Always # use two digits for the minor version with a leading zero if necessary so # that it will sort properly. -$VERSION = '0.05'; +$VERSION = '0.06'; ############################################################################## # Constructors @@ -427,6 +427,9 @@ __END__ Wallet::ACL - Implementation of ACLs in the wallet system +=for stopwords +ACL DBH metadata HOSTNAME DATETIME timestamp Allbery + =head1 SYNOPSIS my $acl = Wallet::ACL->create ('group:sysadmin'); @@ -445,22 +448,22 @@ Wallet::ACL - Implementation of ACLs in the wallet system =head1 DESCRIPTION -Wallet::ACL implements the ACL system for the wallet: the methods to create, -find, rename, and destroy ACLs; the methods to add and remove entries from -an ACL; and the methods to list the contents of an ACL and check a principal -against it. +Wallet::ACL implements the ACL system for the wallet: the methods to +create, find, rename, and destroy ACLs; the methods to add and remove +entries from an ACL; and the methods to list the contents of an ACL and +check a principal against it. An ACL is a list of zero or more ACL entries, each of which consists of a -scheme and an identifier. Each scheme is associated with a verifier module -that checks Kerberos principals against identifiers for that scheme and -returns whether the principal should be permitted access by that identifier. -The interpretation of the identifier is entirely left to the scheme. This -module maintains the ACLs and dispatches check operations to the appropriate -verifier module. - -Each ACL is identified by a human-readable name and a persistant unique -numeric identifier. The numeric identifier (ID) should be used to refer to -the ACL so that it can be renamed as needed without breaking external +scheme and an identifier. Each scheme is associated with a verifier +module that checks Kerberos principals against identifiers for that scheme +and returns whether the principal should be permitted access by that +identifier. The interpretation of the identifier is entirely left to the +scheme. This module maintains the ACLs and dispatches check operations to +the appropriate verifier module. + +Each ACL is identified by a human-readable name and a persistent unique +numeric identifier. The numeric identifier (ID) should be used to refer +to the ACL so that it can be renamed as needed without breaking external references. =head1 CLASS METHODS @@ -481,8 +484,8 @@ finding an existing one, creates a new ACL record in the database with the given NAME. NAME must not be all-numeric, since that would conflict with the automatically assigned IDs. Returns the new object on success and throws an exception on failure. PRINCIPAL, HOSTNAME, and DATETIME are -stored as history information. PRINCIPAL should be the user who is creating -the ACL. If DATETIME isn't given, the current time is used. +stored as history information. PRINCIPAL should be the user who is +creating the ACL. If DATETIME isn't given, the current time is used. =back @@ -492,42 +495,43 @@ the ACL. If DATETIME isn't given, the current time is used. =item add(SCHEME, INSTANCE, PRINCIPAL, HOSTNAME [, DATETIME]) -Add the given ACL entry (given by SCHEME and INSTANCE) to this ACL. Returns -true on success and false on failure. On failure, the caller should call -error() to get the error message. PRINCIPAL, HOSTNAME, and DATETIME are -stored as history information. PRINCIPAL should be the user who is adding -the ACL entry. If DATETIME isn't given, the current time is used. +Add the given ACL entry (given by SCHEME and INSTANCE) to this ACL. +Returns true on success and false on failure. On failure, the caller +should call error() to get the error message. PRINCIPAL, HOSTNAME, and +DATETIME are stored as history information. PRINCIPAL should be the user +who is adding the ACL entry. If DATETIME isn't given, the current time is +used. =item check(PRINCIPAL) Checks whether the given PRINCIPAL should be allowed access given ACL. Returns 1 if access was granted, 0 if access is declined, and undef on -error. On error, the caller should call error() to get the error text. Any -errors found by the individual ACL verifiers can be retrieved by calling -check_errors(). Errors from individual ACL verifiers will not result in an -error return from check(); instead, the check will continue with the next -entry in the ACL. +error. On error, the caller should call error() to get the error text. +Any errors found by the individual ACL verifiers can be retrieved by +calling check_errors(). Errors from individual ACL verifiers will not +result in an error return from check(); instead, the check will continue +with the next entry in the ACL. check() returns success as soon as an entry in the ACL grants access to PRINCIPAL. There is no provision for negative ACLs or exceptions. =item check_errors() -Return (as a list in array context and a string with newlines between errors -and at the end of the last error in scalar context) the errors, if any, -returned by ACL verifiers for the last check operation. If there were no -errors from the last check() operation, returns the empty list in array -context and undef in scalar context. +Return (as a list in array context and a string with newlines between +errors and at the end of the last error in scalar context) the errors, if +any, returned by ACL verifiers for the last check operation. If there +were no errors from the last check() operation, returns the empty list in +array context and undef in scalar context. =item destroy(PRINCIPAL, HOSTNAME [, DATETIME]) Destroys this ACL from the database. Note that this will fail due to integrity constraint errors if the ACL is still referenced by any object; -the ACL must be removed from all objects first. Returns true on success and -false on failure. On failure, the caller should call error() to get the -error message. PRINCIPAL, HOSTNAME, and DATETIME are stored as history -information. PRINCIPAL should be the user who is destroying the ACL. If -DATETIME isn't given, the current time is used. +the ACL must be removed from all objects first. Returns true on success +and false on failure. On failure, the caller should call error() to get +the error message. PRINCIPAL, HOSTNAME, and DATETIME are stored as +history information. PRINCIPAL should be the user who is destroying the +ACL. If DATETIME isn't given, the current time is used. =item error() @@ -542,7 +546,8 @@ the ACL (not including changes to the name of the ACL) will be represented by two lines. The first line will have a timestamp of the change followed by a description of the change, and the second line will give the user who made the change and the host from which the change was made. On failure, -returns undef, and the caller should call error() to get the error message. +returns undef, and the caller should call error() to get the error +message. =item id() @@ -569,28 +574,29 @@ Returns the human-readable name of this ACL. =item remove(SCHEME, INSTANCE, PRINCIPAL, HOSTNAME [, DATETIME]) Remove the given ACL line (given by SCHEME and INSTANCE) from this ACL. -Returns true on success and false on failure. On failure, the caller should -call error() to get the error message. PRINCIPAL, HOSTNAME, and DATETIME -are stored as history information. PRINCIPAL should be the user who is -removing the ACL entry. If DATETIME isn't given, the current time is used. +Returns true on success and false on failure. On failure, the caller +should call error() to get the error message. PRINCIPAL, HOSTNAME, and +DATETIME are stored as history information. PRINCIPAL should be the user +who is removing the ACL entry. If DATETIME isn't given, the current time +is used. =item rename(NAME) Rename this ACL. This changes the name used for human convenience but not the system-generated ACL ID that is used to reference this ACL. The new NAME must not be all-numeric, since that would conflict with -system-generated ACL IDs. Returns true on success and false on failure. On -failure, the caller should call error() to get the error message. +system-generated ACL IDs. Returns true on success and false on failure. +On failure, the caller should call error() to get the error message. Note that rename() operations are not logged in the ACL history. =item show() -Returns a human-readable description of this ACL, including its membership. -This method should only be used for display of the ACL to humans. Use the -list(), name(), and id() methods instead to get ACL information for use in -other code. On failure, returns undef, and the caller should call error() -to get the error message. +Returns a human-readable description of this ACL, including its +membership. This method should only be used for display of the ACL to +humans. Use the list(), name(), and id() methods instead to get ACL +information for use in other code. On failure, returns undef, and the +caller should call error() to get the error message. =back @@ -598,8 +604,8 @@ to get the error message. Wallet::ACL::Base(3), wallet-backend(8) -This module is part of the wallet system. The current version is available -from L. +This module is part of the wallet system. The current version is +available from L. =head1 AUTHOR diff --git a/perl/Wallet/ACL/Base.pm b/perl/Wallet/ACL/Base.pm index 004de75..9a8a3cb 100644 --- a/perl/Wallet/ACL/Base.pm +++ b/perl/Wallet/ACL/Base.pm @@ -1,7 +1,7 @@ # Wallet::ACL::Base -- Parent class for wallet ACL verifiers. # # Written by Russ Allbery -# Copyright 2007 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2010 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -18,7 +18,7 @@ use vars qw($VERSION); # This version should be increased on any code change to this module. Always # use two digits for the minor version with a leading zero if necessary so # that it will sort properly. -$VERSION = '0.01'; +$VERSION = '0.02'; ############################################################################## # Interface @@ -59,6 +59,9 @@ __END__ # Documentation ############################################################################## +=for stopwords +ACL Allbery + =head1 NAME Wallet::ACL::Base - Generic parent class for wallet ACL verifiers @@ -74,9 +77,9 @@ Wallet::ACL::Base - Generic parent class for wallet ACL verifiers =head1 DESCRIPTION -Wallet::ACL::Base is the generic parent class for wallet ACL verifiers. It -provides default functions and behavior and all ACL verifiers should inherit -from it. It is not used directly. +Wallet::ACL::Base is the generic parent class for wallet ACL verifiers. +It provides default functions and behavior and all ACL verifiers should +inherit from it. It is not used directly. =head1 METHODS @@ -84,8 +87,8 @@ from it. It is not used directly. =item new() -Creates a new ACL verifier. The generic function provided here just creates -and blesses an object. +Creates a new ACL verifier. The generic function provided here just +creates and blesses an object. =item check(PRINCIPAL, ACL) @@ -99,11 +102,11 @@ have failed. Callers should call this function to get the error message after an undef return from any other instance method. For the convenience of child classes, this method can also be called with -one or more error strings. If so, those strings are concatenated together, -trailing newlines are removed, any text of the form S> at the end of the message is stripped off, and the result is stored -as the error. Only child classes should call this method with an error -string. +one or more error strings. If so, those strings are concatenated +together, trailing newlines are removed, any text of the form S> at the end of the message is stripped off, and the result is +stored as the error. Only child classes should call this method with an +error string. =back @@ -111,8 +114,8 @@ string. Wallet::ACL(3), wallet-backend(8) -This module is part of the wallet system. The current version is available -from L. +This module is part of the wallet system. The current version is +available from L. =head1 AUTHOR diff --git a/perl/Wallet/ACL/Krb5.pm b/perl/Wallet/ACL/Krb5.pm index 1c584c5..496fcf0 100644 --- a/perl/Wallet/ACL/Krb5.pm +++ b/perl/Wallet/ACL/Krb5.pm @@ -1,7 +1,7 @@ # Wallet::ACL::Krb5 -- Wallet Kerberos v5 principal ACL verifier. # # Written by Russ Allbery -# Copyright 2007 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2010 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -22,7 +22,7 @@ use Wallet::ACL::Base; # This version should be increased on any code change to this module. Always # use two digits for the minor version with a leading zero if necessary so # that it will sort properly. -$VERSION = '0.01'; +$VERSION = '0.02'; ############################################################################## # Interface @@ -50,6 +50,9 @@ __END__ # Documentation ############################################################################## +=for stopwords +ACL krb5 Allbery + =head1 NAME Wallet::ACL::Krb5 - Simple wallet ACL verifier for Kerberos principals @@ -69,7 +72,7 @@ Wallet::ACL::Krb5 - Simple wallet ACL verifier for Kerberos principals =head1 DESCRIPTION Wallet::ACL::Krb5 is the simplest wallet ACL verifier, used to verify ACL -lines of type krb5. The value of such an ACL is a simple Kerberos +lines of type C. The value of such an ACL is a simple Kerberos principal in its text display form, and the ACL grants access to a given principal if and only if the principal exactly matches the ACL. @@ -111,8 +114,8 @@ The PRINCIPAL parameter to check() was undefined or the empty string. Wallet::ACL(3), Wallet::ACL::Base(3), wallet-backend(8) -This module is part of the wallet system. The current version is available -from L. +This module is part of the wallet system. The current version is +available from L. =head1 AUTHOR diff --git a/perl/Wallet/ACL/NetDB.pm b/perl/Wallet/ACL/NetDB.pm index 6775c62..2096ba8 100644 --- a/perl/Wallet/ACL/NetDB.pm +++ b/perl/Wallet/ACL/NetDB.pm @@ -1,7 +1,7 @@ # Wallet::ACL::NetDB -- Wallet NetDB role ACL verifier. # # Written by Russ Allbery -# Copyright 2007 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2010 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -23,7 +23,7 @@ use Wallet::Config; # This version should be increased on any code change to this module. Always # use two digits for the minor version with a leading zero if necessary so # that it will sort properly. -$VERSION = '0.03'; +$VERSION = '0.04'; ############################################################################## # Interface @@ -135,6 +135,9 @@ __END__ # Documentation ############################################################################## +=for stopwords +ACL NetDB remctl DNS DHCP Allbery netdb + =head1 NAME Wallet::ACL::NetDB - Wallet ACL verifier for NetDB roles @@ -154,9 +157,10 @@ Wallet::ACL::NetDB - Wallet ACL verifier for NetDB roles =head1 DESCRIPTION Wallet::ACL::NetDB checks a principal against the NetDB roles for a given -host. It is used to verify ACL lines of type netdb. The value of such an -ACL is a node, and the ACL grants access to a given principal if and only -if that principal has one of the roles user, admin, or team for that node. +host. It is used to verify ACL lines of type C. The value of such +an ACL is a node, and the ACL grants access to a given principal if and +only if that principal has one of the roles user, admin, or team for that +node. To use this object, several configuration parameters must be set. See Wallet::Config(3) for details on those configuration parameters and @@ -227,7 +231,7 @@ error message or otherwise returned failure. The ACL parameter to check() was malformed. Currently, this error is only given if ACL is undefined or the empty string. -=item malformed NetDBL remctl token: %s +=item malformed NetDB remctl token: %s The Net::Remctl Perl library returned a malformed token. This should never happen and indicates a bug in Net::Remctl. @@ -248,12 +252,12 @@ grant access is not currently configurable. Net::Remctl(3), Wallet::ACL(3), Wallet::ACL::Base(3), Wallet::Config(3), wallet-backend(8) -NetDB is a free software system for managing DNS, DHCP, and related machine -information for large organizations. For more information on NetDB, see -L. +NetDB is a free software system for managing DNS, DHCP, and related +machine information for large organizations. For more information on +NetDB, see L. -This module is part of the wallet system. The current version is available -from L. +This module is part of the wallet system. The current version is +available from L. =head1 AUTHOR diff --git a/perl/Wallet/ACL/NetDB/Root.pm b/perl/Wallet/ACL/NetDB/Root.pm index cbd1387..3aeebda 100644 --- a/perl/Wallet/ACL/NetDB/Root.pm +++ b/perl/Wallet/ACL/NetDB/Root.pm @@ -1,7 +1,7 @@ # Wallet::ACL::NetDB::Root -- Wallet NetDB role ACL verifier (root instances). # # Written by Russ Allbery -# Copyright 2007 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2010 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -23,7 +23,7 @@ use Wallet::Config; # This version should be increased on any code change to this module. Always # use two digits for the minor version with a leading zero if necessary so # that it will sort properly. -$VERSION = '0.01'; +$VERSION = '0.02'; ############################################################################## # Interface @@ -48,6 +48,9 @@ sub check { # Documentation ############################################################################## +=for stopwords +ACL NetDB DNS DHCP Allbery + =head1 NAME Wallet::ACL::NetDB::Root - Wallet ACL verifier for NetDB roles (root instances) @@ -66,13 +69,14 @@ Wallet::ACL::NetDB::Root - Wallet ACL verifier for NetDB roles (root instances) =head1 DESCRIPTION -Wallet::ACL::NetDB::Root works identically to Wallet::ACL::NetDB except that -it requires the principal to be a root instance (in other words, to be in -the form /root@) and strips the C portion from the -principal before checking against NetDB roles. As with the base NetDB ACL -verifier, the value of a netdb-root ACL is a node, and the ACL grants access -to a given principal if and only if the that principal (with C -stripped) has one of the roles user, admin, or team for that node. +Wallet::ACL::NetDB::Root works identically to Wallet::ACL::NetDB except +that it requires the principal to be a root instance (in other words, to +be in the form /root@) and strips the C portion +from the principal before checking against NetDB roles. As with the base +NetDB ACL verifier, the value of a C ACL is a node, and the +ACL grants access to a given principal if and only if the that principal +(with C stripped) has one of the roles user, admin, or team for +that node. To use this object, the same configuration parameters must be set as for Wallet::ACL::NetDB. See Wallet::Config(3) for details on those @@ -85,11 +89,11 @@ configuration. =item check(PRINCIPAL, ACL) -Returns true if PRINCIPAL is granted access according to ACL, false if not, -and undef on an error (see L<"DIAGNOSTICS"> below). ACL is a node, and -PRINCIPAL will be granted access if it has an instance of C and if -(with C stripped off and the realm stripped off if configured) has -the user, admin, or team role for that node. +Returns true if PRINCIPAL is granted access according to ACL, false if +not, and undef on an error (see L<"DIAGNOSTICS"> below). ACL is a node, +and PRINCIPAL will be granted access if it has an instance of C and +if (with C stripped off and the realm stripped off if configured) +has the user, admin, or team role for that node. =back @@ -106,15 +110,15 @@ grant access is not currently configurable. =head1 SEE ALSO -Net::Remctl(3), Wallet::ACL(3), Wallet::ACL::Base(3), Wallet::ACL::NetDB(3), -Wallet::Config(3), wallet-backend(8) +Net::Remctl(3), Wallet::ACL(3), Wallet::ACL::Base(3), +Wallet::ACL::NetDB(3), Wallet::Config(3), wallet-backend(8) -NetDB is a free software system for managing DNS, DHCP, and related machine -information for large organizations. For more information on NetDB, see -L. +NetDB is a free software system for managing DNS, DHCP, and related +machine information for large organizations. For more information on +NetDB, see L. -This module is part of the wallet system. The current version is available -from L. +This module is part of the wallet system. The current version is +available from L. =head1 AUTHOR diff --git a/perl/Wallet/Admin.pm b/perl/Wallet/Admin.pm index ff87b94..b4b3d86 100644 --- a/perl/Wallet/Admin.pm +++ b/perl/Wallet/Admin.pm @@ -1,7 +1,7 @@ # Wallet::Admin -- Wallet system administrative interface. # # Written by Russ Allbery -# Copyright 2008, 2009 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008, 2009, 2010 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -413,6 +413,9 @@ __DATA__ Wallet::Admin - Wallet system administrative interface +=for stopwords +ACL hostname ACLs SQL wildcard Allbery + =head1 SYNOPSIS use Wallet::Admin; @@ -429,9 +432,9 @@ thin wrapper around this object that provides a command-line interface to its actions. To use this object, several configuration variables must be set (at least -the database configuration). For information on those variables and how to -set them, see Wallet::Config(3). For more information on the normal user -interface to the wallet server, see Wallet::Server(3). +the database configuration). For information on those variables and how +to set them, see Wallet::Config(3). For more information on the normal +user interface to the wallet server, see Wallet::Server(3). =head1 CLASS METHODS @@ -491,11 +494,11 @@ at least one ACL, but an error can be distinguished from the odd case of a database with no ACLs by calling error(). error() is guaranteed to return the error message if there was an error and undef if there was no error. -There are currently two search types. 'empty' takes no arguments, and will -return only those acls that have no entries within them. 'entry' takes two -arguments -- an entry scheme and an entry identifier -- and will return -any ACLs with an entry that matches the given scheme and contains the -given identifier. +There are currently two search types. C takes no arguments and +will return only those ACLs that have no entries within them. C +takes two arguments, an entry scheme and an entry identifier, and will +return any ACLs with an entry that matches the given scheme and contains +the given identifier. =item list_objects(TYPE, SEARCH) @@ -503,7 +506,7 @@ Returns a list of all objects matching a search type and string in the database, or all objects in the database if no search information is given. The return value is a list of references to pairs of type and name. For example, if two objects existed in the database, both of type -"keytab" and with values "host/example.com" and "foo", list_objects() +C and with values C and C, list_objects() with no arguments would return: ([ 'keytab', 'host/example.com' ], [ 'keytab', 'foo' ]) @@ -513,13 +516,13 @@ database containing no objects, the caller should call error(). error() is guaranteed to return the error message if there was an error and undef if there was no error. -There are four types of searches currently. 'type' (with a given type) +There are four types of searches currently. C (with a given type) will return only those entries where the type matches the given type. -'owner', with a given owner, will only return those objects owned by the -given acl name. 'flag', with a given flag name, will only return those -items with a flag set to the given value. 'acl' operates like 'owner', -but will return only those objects that have the given acl name on any -of the possible acl settings, not just owner. +C, with a given owner, will only return those objects owned by the +given ACL name. C, with a given flag name, will only return those +items with a flag set to the given value. C operates like C, +but will return only those objects that have the given ACL name on any of +the possible ACL settings, not just owner. =item register_object (TYPE, CLASS) @@ -559,8 +562,8 @@ the error message if there was an error and undef if there was no error. wallet-admin(8) -This module is part of the wallet system. The current version is available -from L. +This module is part of the wallet system. The current version is +available from L. =head1 AUTHOR diff --git a/perl/Wallet/Config.pm b/perl/Wallet/Config.pm index ae8cf9c..c59d3e3 100644 --- a/perl/Wallet/Config.pm +++ b/perl/Wallet/Config.pm @@ -23,6 +23,11 @@ $PATH = $ENV{WALLET_CONFIG} || '/etc/wallet/wallet.conf'; Wallet::Config - Configuration handling for the wallet server +=for stopwords +DBI DSN SQLite subdirectories KEYTAB keytab kadmind KDC add-ons kadmin DNS +SRV kadmin keytabs remctl backend lowercased NETDB ACL NetDB unscoped +usernames rekey hostnames Allbery wallet-backend keytab-backend + =head1 SYNOPSIS use Wallet::Config; @@ -63,9 +68,9 @@ variable DB_DRIVER to C, use: $DB_DRIVER = 'MySQL'; -Always remember the initial dollar sign (C<$>) and ending semicolon (C<;>). -Those familiar with Perl syntax can of course use the full range of Perl -expressions. +Always remember the initial dollar sign (C<$>) and ending semicolon +(C<;>). Those familiar with Perl syntax can of course use the full range +of Perl expressions. This configuration file should end with the line: @@ -80,11 +85,11 @@ file. =item DB_DRIVER -Sets the Perl database driver to use for the wallet database. Common values -would be C or C. Less common values would be C, -C, or C. The appropriate DBD::* Perl module for the chosen -driver must be installed and will be dynamically loaded by the wallet. For -more information, see DBI(3). +Sets the Perl database driver to use for the wallet database. Common +values would be C or C. Less common values would be +C, C, or C. The appropriate DBD::* Perl module for +the chosen driver must be installed and will be dynamically loaded by the +wallet. For more information, see DBI(3). This variable must be set. @@ -95,8 +100,8 @@ our $DB_DRIVER; =item DB_INFO Sets the remaining contents for the DBI DSN (everything after the driver). -Using this variable provides full control over the connect string passed to -DBI. When using SQLite, set this variable to the path to the SQLite +Using this variable provides full control over the connect string passed +to DBI. When using SQLite, set this variable to the path to the SQLite database. If this variable is set, DB_NAME, DB_HOST, and DB_PORT are ignored. For more information, see DBI(3) and the documentation for the database driver you're using. @@ -111,9 +116,10 @@ our $DB_INFO; =item DB_NAME If DB_INFO is not set, specifies the database name. The third part of the -DBI connect string will be set to C, possibly with a host -and port appended if DB_HOST and DB_PORT are set. For more information, see -DBI(3) and the documentation for the database driver you're using. +DBI connect string will be set to C, possibly with a +host and port appended if DB_HOST and DB_PORT are set. For more +information, see DBI(3) and the documentation for the database driver +you're using. Either DB_INFO or DB_NAME must be set. @@ -124,8 +130,8 @@ our $DB_NAME; =item DB_HOST If DB_INFO is not set, specifies the database host. C<;host=DB_HOST> will -be appended to the DBI connect string. For more information, see DBI(3) and -the documentation for the database driver you're using. +be appended to the DBI connect string. For more information, see DBI(3) +and the documentation for the database driver you're using. =cut @@ -135,8 +141,8 @@ our $DB_HOST; If DB_PORT is not set, specifies the database port. C<;port=DB_PORT> will be appended to the DBI connect string. If this variable is set, DB_HOST -should also be set. For more information, see DBI(3) and the documentation -for the database driver you're using. +should also be set. For more information, see DBI(3) and the +documentation for the database driver you're using. =cut @@ -153,8 +159,8 @@ our $DB_USER; =item DB_PASSWORD -Specifies the password for database authentication. Some database backends, -particularly SQLite, do not need this. +Specifies the password for database authentication. Some database +backends, particularly SQLite, do not need this. =cut @@ -205,9 +211,10 @@ C object type (the Wallet::Object::Keytab class). =item KEYTAB_FILE Specifies the keytab to use to authenticate to B. The principal -whose key is stored in this keytab must have the ability to create, modify, -inspect, and delete any principals that should be managed by the wallet. -(In MIT Kerberos F parlance, this is C privileges.) +whose key is stored in this keytab must have the ability to create, +modify, inspect, and delete any principals that should be managed by the +wallet. (In MIT Kerberos F parlance, this is C +privileges.) KEYTAB_FILE must be set to use keytab objects. @@ -218,12 +225,13 @@ our $KEYTAB_FILE; =item KEYTAB_FLAGS These flags, if any, are passed to the C command when creating a -new principal in the Kerberos KDC. To not pass any flags, set KEYTAB_FLAGS -to the empty string. The default value is C<-clearpolicy>, which clears any -password strength policy from principals created by the wallet. (Since the -wallet randomizes the keys, password strength checking is generally -pointless and may interact poorly with the way C works -when third-party add-ons for password strength checking are used.) +new principal in the Kerberos KDC. To not pass any flags, set +KEYTAB_FLAGS to the empty string. The default value is C<-clearpolicy>, +which clears any password strength policy from principals created by the +wallet. (Since the wallet randomizes the keys, password strength checking +is generally pointless and may interact poorly with the way C works when third-party add-ons for password strength checking +are used.) =cut @@ -264,9 +272,9 @@ our $KEYTAB_KRBTYPE; The principal whose key is stored in KEYTAB_FILE. The wallet will authenticate as this principal to the kadmin service. -KEYTAB_PRINCIPAL must be set to use keytab objects, at least until B -is smart enough to use the first principal found in the keytab it's using -for authentication. +KEYTAB_PRINCIPAL must be set to use keytab objects, at least until +B is smart enough to use the first principal found in the keytab +it's using for authentication. =cut @@ -289,11 +297,11 @@ our $KEYTAB_REALM; =item KEYTAB_TMP A directory into which the wallet can write keytabs temporarily while -processing C 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 or F. It's best to create a directory -solely for this purpose that's owned by the user the wallet server will run -as. +processing C 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 or F. 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. @@ -305,20 +313,20 @@ our $KEYTAB_TMP; =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. This is enabled by setting the C -flag on keytab objects. To configure that support, set the following -variables. +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. This is enabled by setting the +C 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 flag. -The ticket cache must be for a principal with access to run C via remctl on KEYTAB_REMCTL_HOST. +Specifies the ticket cache to use when retrieving existing keytabs from +the KDC. This is only used to implement support for the C +flag. The ticket cache must be for a principal with access to run +C via remctl on KEYTAB_REMCTL_HOST. =cut @@ -326,10 +334,10 @@ our $KEYTAB_REMCTL_CACHE; =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 flag. This host -must provide the C command and KEYTAB_REMCTL_CACHE must -also be set to a ticket cache for a principal with access to run that +The host to which to connect with remctl to retrieve existing keytabs. +This is only used to implement support for the C flag. This +host must provide the C command and KEYTAB_REMCTL_CACHE +must also be set to a ticket cache for a principal with access to run that command. =cut @@ -339,9 +347,10 @@ 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 flag. -If this variable is not set, the default is formed by prepending C to -KEYTAB_REMCTL_HOST. (Note that KEYTAB_REMCTL_HOST is not lowercased first.) +keytabs. This is only used to implement support for the C +flag. If this variable is not set, the default is formed by prepending +C to KEYTAB_REMCTL_HOST. (Note that KEYTAB_REMCTL_HOST is not +lowercased first.) =cut @@ -365,18 +374,18 @@ our $KEYTAB_REMCTL_PORT; These configuration variables are only needed if you intend to use the C ACL type (the Wallet::ACL::NetDB class). They specify the remctl connection information for retrieving user roles from NetDB and the local -realm to remove from principals (since NetDB normally expects unscoped local -usernames). +realm to remove from principals (since NetDB normally expects unscoped +local usernames). =over 4 =item NETDB_REALM The wallet uses fully-qualified principal names (including the realm), but -NetDB normally expects local usernames without the realm. If this variable -is set, the given realm will be stripped from any principal names before -passing them to NetDB. Principals in other realms will be passed to NetDB -without modification. +NetDB normally expects local usernames without the realm. If this +variable is set, the given realm will be stripped from any principal names +before passing them to NetDB. Principals in other realms will be passed +to NetDB without modification. =cut @@ -385,9 +394,9 @@ our $NETDB_REALM; =item NETDB_REMCTL_CACHE Specifies the ticket cache to use when querying the NetDB remctl interface -for user roles. The ticket cache must be for a principal with access to run -C via remctl on KEYTAB_REMCTL_HOST. This variable must be -set to use NetDB ACLs. +for user roles. The ticket cache must be for a principal with access to +run C via remctl on KEYTAB_REMCTL_HOST. This variable +must be set to use NetDB ACLs. =cut @@ -406,10 +415,10 @@ our $NETDB_REMCTL_HOST; =item NETDB_REMCTL_PRINCIPAL -The service principal to which to authenticate when querying NetDB for user -roles. If this variable is not set, the default is formed by prepending -C to NETDB_REMCTL_HOST. (Note that NETDB_REMCTL_HOST is not -lowercased first.) +The service principal to which to authenticate when querying NetDB for +user roles. If this variable is not set, the default is formed by +prepending C to NETDB_REMCTL_HOST. (Note that NETDB_REMCTL_HOST is +not lowercased first.) =cut @@ -417,9 +426,9 @@ our $NETDB_REMCTL_PRINCIPAL; =item NETDB_REMCTL_PORT -The port on NETDB_REMCTL_HOST to which to connect with remctl to query NetDB -for user roles. If this variable is not set, the default remctl port will -be used. +The port on NETDB_REMCTL_HOST to which to connect with remctl to query +NetDB for user roles. If this variable is not set, the default remctl +port will be used. =cut @@ -430,17 +439,18 @@ our $NETDB_REMCTL_PORT; =head1 DEFAULT OWNERS By default, only users in the ADMIN ACL can create new objects in the -wallet. To allow other users to create new objects, define a Perl function -named default_owner. This function will be called whenever a non-ADMIN user -tries to create a new object and will be passed the type and name of the -object. It should return undef if there is no default owner for that -object. If there is, it should return a list containing the name to use for -the ACL and then zero or more anonymous arrays of two elements each giving -the type and identifier for each ACL entry. - -For example, the following simple function says to use a default owner named -C with one entry of type C and identifier C -for the object with type C and name C: +wallet. To allow other users to create new objects, define a Perl +function named default_owner. This function will be called whenever a +non-ADMIN user tries to create a new object and will be passed the type +and name of the object. It should return undef if there is no default +owner for that object. If there is, it should return a list containing +the name to use for the ACL and then zero or more anonymous arrays of two +elements each giving the type and identifier for each ACL entry. + +For example, the following simple function says to use a default owner +named C with one entry of type C and identifier +C for the object with type C and name +C: sub default_owner { my ($type, $name) = @_; @@ -453,8 +463,8 @@ for the object with type C and name C: Of course, normally this function is used for more complex mappings. Here is a more complete example. For objects of type keytab corresponding to -various types of per-machine principals, return a default owner that sets as -owner anyone with a NetDB role for that system and the system's host +various types of per-machine principals, return a default owner that sets +as owner anyone with a NetDB role for that system and the system's host principal. This permits authorization management using NetDB while also allowing the system to bootstrap itself once the host principal has been downloaded and rekey itself using the old host principal. @@ -474,17 +484,19 @@ downloaded and rekey itself using the old host principal. return ($acl_name, @acl); } -The auto-created ACL used for the owner of the new object will, in the above -example, be named C> where I is the fully-qualified -name of the system as derived from the keytab being requested. - -If the name of the ACL returned by the default_owner function matches an ACL -that already exists in the wallet database, the existing ACL will be -compared to the default ACL returned by the default_owner function. If the -existing ACL has the same entries as the one returned by default_owner, -creation continues if the user is authorized by that ACL. If they don't -match, creation of the object is rejected, since the presence of an existing -ACL may indicate that something different is being done with this object. +The auto-created ACL used for the owner of the new object will, in the +above example, be named C> where I is the +fully-qualified name of the system as derived from the keytab being +requested. + +If the name of the ACL returned by the default_owner function matches an +ACL that already exists in the wallet database, the existing ACL will be +compared to the default ACL returned by the default_owner function. If +the existing ACL has the same entries as the one returned by +default_owner, creation continues if the user is authorized by that ACL. +If they don't match, creation of the object is rejected, since the +presence of an existing ACL may indicate that something different is being +done with this object. =head1 NAMING ENFORCEMENT diff --git a/perl/Wallet/Database.pm b/perl/Wallet/Database.pm index 68fb6bb..7b3474a 100644 --- a/perl/Wallet/Database.pm +++ b/perl/Wallet/Database.pm @@ -6,7 +6,7 @@ # like DBI objects in the rest of the code. # # Written by Russ Allbery -# Copyright 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008, 2010 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -39,7 +39,7 @@ use Wallet::Config; # This version should be increased on any code change to this module. Always # use two digits for the minor version with a leading zero if necessary so # that it will sort properly. -$VERSION = '0.01'; +$VERSION = '0.02'; ############################################################################## # Core overrides @@ -84,6 +84,9 @@ __END__ Wallet::Dabase - Wrapper module for wallet database connections +=for stopwords +DBI RaiseError PrintError AutoCommit Allbery + =head1 SYNOPSIS use Wallet::Database; @@ -93,9 +96,9 @@ Wallet::Dabase - Wrapper module for wallet database connections Wallet::Database is a thin wrapper module around DBI that takes care of building a connect string and setting database options based on wallet -configuration. The only overriden method is connect(). All other methods -should work the same as in DBI and Wallet::Database objects should be -usable exactly as if they were DBI objects. +configuration. The only overridden method is connect(). All other +methods should work the same as in DBI and Wallet::Database objects should +be usable exactly as if they were DBI objects. connect() will obtain the database connection information from the wallet configuration; see Wallet::Config(3) for more details. It will also @@ -120,8 +123,8 @@ configuration. DBI(3), Wallet::Config(3) -This module is part of the wallet system. The current version is available -from L. +This module is part of the wallet system. The current version is +available from L. =head1 AUTHOR diff --git a/perl/Wallet/Kadmin.pm b/perl/Wallet/Kadmin.pm index 65ddf4b..b653f87 100644 --- a/perl/Wallet/Kadmin.pm +++ b/perl/Wallet/Kadmin.pm @@ -55,6 +55,9 @@ __END__ # Documentation ############################################################################## +=for stopwords +Kadmin keytabs keytab Heimdal API kadmind kadmin + =head1 NAME Wallet::Kadmin - Kadmin module wrapper for wallet keytabs @@ -69,21 +72,21 @@ Wallet::Kadmin - Kadmin module wrapper for wallet keytabs =head1 DESCRIPTION -Wallet::Kadmin is a wrapper to modules that provide an interface for keytab -integration with the wallet. Each module is meant to interface with a -specific type of Kerberos implementation, such as MIT Kerberos or Heimdal -Kerberos, and provide a standndard set of API calls used to interact with -that implementation's kadmind. +Wallet::Kadmin is a wrapper to modules that provide an interface for +keytab integration with wallet. Each module is meant to interface with a +specific type of Kerberos implementation, such as MIT Kerberos or Heimdal, +and provide a standard set of API calls used to interact with that +implementation's kadmin interface. The class simply uses Wallet::Config to find which type of kadmind we have requested to use, and then returns an object to use for interacting with that kadmind. A keytab is an on-disk store for the key or keys for a Kerberos principal. -Keytabs are used by services to verify incoming authentication from clients -or by automated processes that need to authenticate to Kerberos. To create -a keytab, the principal has to be created in Kerberos and then a keytab is -generated and stored in a file on disk. +Keytabs are used by services to verify incoming authentication from +clients or by automated processes that need to authenticate to Kerberos. +To create a keytab, the principal has to be created in Kerberos and then a +keytab is generated and stored in a file on disk. To use this object, several configuration parameters must be set. See Wallet::Config(3) for details on those configuration parameters and @@ -95,9 +98,9 @@ information about how to set wallet configuration. =item new() -Finds the proper Kerberos implementation and calls the new() constructor for -that implementation's module, returning the result. If the implementation -is not recognized or set, die with an error message. +Finds the proper Kerberos implementation and calls the new() constructor +for that implementation's module, returning the result. If the +implementation is not recognized or set, die with an error message. =back @@ -105,8 +108,8 @@ is not recognized or set, die with an error message. kadmin(8), Wallet::Config(3), Wallet::Object::Keytab(3), wallet-backend(8) -This module is part of the wallet system. The current version is available -from L. +This module is part of the wallet system. The current version is +available from L. =head1 AUTHORS diff --git a/perl/Wallet/Kadmin/Heimdal.pm b/perl/Wallet/Kadmin/Heimdal.pm index 428202b..2ad35e3 100644 --- a/perl/Wallet/Kadmin/Heimdal.pm +++ b/perl/Wallet/Kadmin/Heimdal.pm @@ -230,9 +230,12 @@ __END__ # Documentation ############################################################################## +=for stopwords +keytabs keytab kadmin enctypes API ENCTYPES enctype Allbery Heimdal + =head1 NAME -Wallet::Kadmin::MIT - MIT admin interactions for wallet keytabs +Wallet::Kadmin::Heimdal - Heimdal admin interactions for wallet keytabs =head1 SYNOPSIS @@ -244,18 +247,18 @@ Wallet::Kadmin::MIT - MIT admin interactions for wallet keytabs =head1 DESCRIPTION -Wallet::Kadmin::MIT is an interface for keytab integration with the wallet, -specifically for using kadmin to create, delete, and add enctypes to keytabs. -It implments the wallet kadmin API and provides the necessary glue to MIT -Kerberos installs for each of these functions, while allowing the wallet -to keep the details of what type of Kerberos installation is being used -abstracted. +Wallet::Kadmin::Heimdal is an interface for keytab integration with the +wallet, specifically for using kadmin to create, delete, and add enctypes +to keytabs. It implements the wallet kadmin API and provides the +necessary glue to Heimdal installs for each of these functions, while +allowing the wallet to keep the details of what type of Kerberos +installation is being used abstracted. A keytab is an on-disk store for the key or keys for a Kerberos principal. -Keytabs are used by services to verify incoming authentication from clients -or by automated processes that need to authenticate to Kerberos. To create -a keytab, the principal has to be created in Kerberos and then a keytab is -generated and stored in a file on disk. +Keytabs are used by services to verify incoming authentication from +clients or by automated processes that need to authenticate to Kerberos. +To create a keytab, the principal has to be created in Kerberos and then a +keytab is generated and stored in a file on disk. To use this object, several configuration parameters must be set. See Wallet::Config(3) for details on those configuration parameters and @@ -268,17 +271,17 @@ information about how to set wallet configuration. =item addprinc(PRINCIPAL) Adds a new principal with a given name. The principal is created with a -random password, and any other flags set by Wallet::Config. Returns true on -success, or throws an error if there was a failure in adding the principal. -If the principal already exists, return true as we are bringing our -expectations in line with reality. +random password, and any other flags set by Wallet::Config. Returns true +on success, or throws an error if there was a failure in adding the +principal. If the principal already exists, return true as we are +bringing our expectations in line with reality. =item addprinc(PRINCIPAL) -Removes a principal with the given name. Returns true on success, or throws -an error if there was a failure in removing the principal. If the principal -does not exist, return true as we are bringing our expectations in line with -reality. +Removes a principal with the given name. Returns true on success, or +throws an error if there was a failure in removing the principal. If the +principal does not exist, return true as we are bringing our expectations +in line with reality. =item ktadd(PRINCIPAL, FILE, ENCTYPES) @@ -290,19 +293,12 @@ otherwise true is returned. =back -=head1 LIMITATIONS - -Currently, this implementation calls an external B program rather - than using a native Perl module and therefore requires B be -installed and parses its output. It may miss some error conditions if the -output of B ever changes. - =head1 SEE ALSO kadmin(8), Wallet::Config(3), Wallet::Object::Keytab(3), wallet-backend(8) -This module is part of the wallet system. The current version is available -from L. +This module is part of the wallet system. The current version is +available from L. =head1 AUTHORS diff --git a/perl/Wallet/Kadmin/MIT.pm b/perl/Wallet/Kadmin/MIT.pm index 49691b0..8449868 100644 --- a/perl/Wallet/Kadmin/MIT.pm +++ b/perl/Wallet/Kadmin/MIT.pm @@ -226,6 +226,9 @@ __END__ # Documentation ############################################################################## +=for stopwords +keytabs keytab kadmin enctype enctypes API ENCTYPES Allbery + =head1 NAME Wallet::Kadmin::MIT - MIT admin interactions for wallet keytabs @@ -240,18 +243,18 @@ Wallet::Kadmin::MIT - MIT admin interactions for wallet keytabs =head1 DESCRIPTION -Wallet::Kadmin::MIT is an interface for keytab integration with the wallet, -specifically for using kadmin to create, delete, and add enctypes to keytabs. -It implments the wallet kadmin API and provides the necessary glue to MIT -Kerberos installs for each of these functions, while allowing the wallet -to keep the details of what type of Kerberos installation is being used -abstracted. +Wallet::Kadmin::MIT is an interface for keytab integration with the +wallet, specifically for using kadmin to create, delete, and add enctypes +to keytabs. It implements the wallet kadmin API and provides the +necessary glue to MIT Kerberos installs for each of these functions, while +allowing the wallet to keep the details of what type of Kerberos +installation is being used abstracted. A keytab is an on-disk store for the key or keys for a Kerberos principal. -Keytabs are used by services to verify incoming authentication from clients -or by automated processes that need to authenticate to Kerberos. To create -a keytab, the principal has to be created in Kerberos and then a keytab is -generated and stored in a file on disk. +Keytabs are used by services to verify incoming authentication from +clients or by automated processes that need to authenticate to Kerberos. +To create a keytab, the principal has to be created in Kerberos and then a +keytab is generated and stored in a file on disk. To use this object, several configuration parameters must be set. See Wallet::Config(3) for details on those configuration parameters and @@ -264,17 +267,17 @@ information about how to set wallet configuration. =item addprinc(PRINCIPAL) Adds a new principal with a given name. The principal is created with a -random password, and any other flags set by Wallet::Config. Returns true on -success, or throws an error if there was a failure in adding the principal. -If the principal already exists, return true as we are bringing our -expectations in line with reality. +random password, and any other flags set by Wallet::Config. Returns true +on success, or throws an error if there was a failure in adding the +principal. If the principal already exists, return true as we are +bringing our expectations in line with reality. -=item addprinc(PRINCIPAL) +=item delprinc(PRINCIPAL) -Removes a principal with the given name. Returns true on success, or throws -an error if there was a failure in removing the principal. If the principal -does not exist, return true as we are bringing our expectations in line with -reality. +Removes a principal with the given name. Returns true on success, or +throws an error if there was a failure in removing the principal. If the +principal does not exist, return true as we are bringing our expectations +in line with reality. =item ktadd(PRINCIPAL, FILE, ENCTYPES) @@ -297,8 +300,8 @@ output of B ever changes. kadmin(8), Wallet::Config(3), Wallet::Object::Keytab(3), wallet-backend(8) -This module is part of the wallet system. The current version is available -from L. +This module is part of the wallet system. The current version is +available from L. =head1 AUTHORS diff --git a/perl/Wallet/Object/Base.pm b/perl/Wallet/Object/Base.pm index fea0320..5097729 100644 --- a/perl/Wallet/Object/Base.pm +++ b/perl/Wallet/Object/Base.pm @@ -1,7 +1,7 @@ # Wallet::Object::Base -- Parent class for any object stored in the wallet. # # Written by Russ Allbery -# Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2008, 2010 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -22,7 +22,7 @@ use Wallet::ACL; # This version should be increased on any code change to this module. Always # use two digits for the minor version with a leading zero if necessary so # that it will sort properly. -$VERSION = '0.04'; +$VERSION = '0.05'; ############################################################################## # Constructors @@ -669,6 +669,10 @@ __END__ Wallet::Object::Base - Generic parent class for wallet objects +=for stopwords +DBH HOSTNAME DATETIME ACL backend metadata timestamp Allbery wallet-backend +backend-specific + =head1 SYNOPSIS package Wallet::Object::Simple; @@ -682,104 +686,107 @@ Wallet::Object::Base - Generic parent class for wallet objects =head1 DESCRIPTION Wallet::Object::Base is the generic parent class for wallet objects (data -types that can be stored in the wallet system). It provides defualt +types that can be stored in the wallet system). It provides default functions and behavior, including handling generic object settings. All handlers for objects stored in the wallet should inherit from it. It is not used directly. =head1 PUBLIC CLASS METHODS -The following methods are called by the rest of the wallet system and should -be implemented by all objects stored in the wallet. They should be called -with the desired wallet object class as the first argument (generally using -the Wallet::Object::Type->new syntax). +The following methods are called by the rest of the wallet system and +should be implemented by all objects stored in the wallet. They should be +called with the desired wallet object class as the first argument +(generally using the Wallet::Object::Type->new syntax). =over 4 =item new(TYPE, NAME, DBH) Creates a new object with the given object type and name, based on data -already in the database. This method will only succeed if an object of the -given TYPE and NAME is already present in the wallet database. If no such -object exits, throws an exception. Otherwise, returns an object blessed -into the class used for the new() call (so subclasses can leave this method -alone and not override it). +already in the database. This method will only succeed if an object of +the given TYPE and NAME is already present in the wallet database. If no +such object exits, throws an exception. Otherwise, returns an object +blessed into the class used for the new() call (so subclasses can leave +this method alone and not override it). -Takes a Wallet::Database object, which is stored in the object and used for -any further operations. +Takes a Wallet::Database object, which is stored in the object and used +for any further operations. =item create(TYPE, NAME, DBH, PRINCIPAL, HOSTNAME [, DATETIME]) Similar to new() but instead creates a new entry in the database. This method will throw an exception if an entry for that type and name already -exists in the database or if creating the database record fails. Otherwise, -a new database entry will be created with that type and name, no owner, no -ACLs, no expiration, no flags, and with created by, from, and on set to the -PRINCIPAL, HOSTNAME, and DATETIME parameters. If DATETIME isn't given, the -current time is used. The database handle is treated as with new(). +exists in the database or if creating the database record fails. +Otherwise, a new database entry will be created with that type and name, +no owner, no ACLs, no expiration, no flags, and with created by, from, and +on set to the PRINCIPAL, HOSTNAME, and DATETIME parameters. If DATETIME +isn't given, the current time is used. The database handle is treated as +with new(). =back =head1 PUBLIC INSTANCE METHODS The following methods may be called on instantiated wallet objects. -Normally, the only methods that a subclass will need to override are get(), -store(), show(), and destroy(). +Normally, the only methods that a subclass will need to override are +get(), store(), show(), and destroy(). -If the locked flag is set on an object, no actions may be performed on that -object except for the flag methods and show(). All other actions will be -rejected with an error saying the object is locked. +If the locked flag is set on an object, no actions may be performed on +that object except for the flag methods and show(). All other actions +will be rejected with an error saying the object is locked. =over 4 =item acl(TYPE [, ACL, PRINCIPAL, HOSTNAME [, DATETIME]]) -Sets or retrieves a given object ACL as a numeric ACL ID. TYPE must be one -of C, C, C, C, or C, corresponding to the -ACLs kept on an object. If no other arguments are given, returns the -current ACL setting as an ACL ID or undef if that ACL isn't set. If other -arguments are given, change that ACL to ACL and return true on success and -false on failure. Pass in the empty string for ACL to clear the ACL. The -other arguments are used for logging and history and should indicate the -user and host from which the change is made and the time of the change. +Sets or retrieves a given object ACL as a numeric ACL ID. TYPE must be +one of C, C, C, C, or C, corresponding +to the ACLs kept on an object. If no other arguments are given, returns +the current ACL setting as an ACL ID or undef if that ACL isn't set. If +other arguments are given, change that ACL to ACL and return true on +success and false on failure. Pass in the empty string for ACL to clear +the ACL. The other arguments are used for logging and history and should +indicate the user and host from which the change is made and the time of +the change. =item attr(ATTRIBUTE [, VALUES, PRINCIPAL, HOSTNAME [, DATETIME]]) Sets or retrieves a given object attribute. Attributes are used to store -backend-specific information for a particular object type and ATTRIBUTE must -be an attribute type known to the underlying object implementation. The -default implementation of this method rejects all attributes as unknown. +backend-specific information for a particular object type and ATTRIBUTE +must be an attribute type known to the underlying object implementation. +The default implementation of this method rejects all attributes as +unknown. 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. +distinguish between an error and an empty return, call error() afterward. 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. The other -arguments are used for logging and history and should indicate the user and -host from which the change is made and the time of the change. Returns true -on success and false on failure. +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. +The other arguments are used for logging and history and should indicate +the user and host from which the change is made and the time of the +change. Returns true on success and false on failure. =item attr_show() -Returns a formatted text description of the type-specific attributes of the -object, or undef on error. The default implementation of this method always -returns the empty string. If there are any type-specific attributes set, -this method should return that metadata, formatted as key: value pairs with -the keys right-aligned in the first 15 characters, followed by a space, a -colon, and the value. +Returns a formatted text description of the type-specific attributes of +the object, or undef on error. The default implementation of this method +always returns the empty string. If there are any type-specific +attributes set, this method should return that metadata, formatted as key: +value pairs with the keys right-aligned in the first 15 characters, +followed by a space, a colon, and the value. =item destroy(PRINCIPAL, HOSTNAME [, DATETIME]) Destroys the object by removing all record of it from the database. The -Wallet::Object::Base implementation handles the generic database work, -but any subclass should override this method to do any deletion of files -or entries in external databases and any other database entries and then -call the parent method to handle the generic database cleanup. Returns -true on success and false on failure. The arguments are used for logging -and history and should indicate the user and host from which the change is +Wallet::Object::Base implementation handles the generic database work, but +any subclass should override this method to do any deletion of files or +entries in external databases and any other database entries and then call +the parent method to handle the generic database cleanup. Returns true on +success and false on failure. The arguments are used for logging and +history and should indicate the user and host from which the change is made and the time of the change. =item error([ERROR ...]) @@ -789,47 +796,50 @@ have failed. Callers should call this function to get the error message after an undef return from any other instance method. For the convenience of child classes, this method can also be called with -one or more error strings. If so, those strings are concatenated together, -trailing newlines are removed, any text of the form S> at the end of the message is stripped off, and the result is stored -as the error. Only child classes should call this method with an error -string. +one or more error strings. If so, those strings are concatenated +together, trailing newlines are removed, any text of the form S> at the end of the message is stripped off, and the result is +stored as the error. Only child classes should call this method with an +error string. =item expires([EXPIRES, PRINCIPAL, HOSTNAME [, DATETIME]]) Sets or retrieves the expiration date of an object. If no arguments are -given, returns the current expiration or undef if no expiration is set. If -arguments are given, change the expiration to EXPIRES and return true on -success and false on failure. EXPIRES must be in the format C, although the time portion may be omitted. Pass in the empty -string for EXPIRES to clear the expiration date. - -The other arguments are used for logging and history and should indicate the -user and host from which the change is made and the time of the change. +given, returns the current expiration or undef if no expiration is set. +If arguments are given, change the expiration to EXPIRES and return true +on success and false on failure. EXPIRES must be in the format +C, although the time portion may be omitted. Pass in +the empty string for EXPIRES to clear the expiration date. + +The other arguments are used for logging and history and should indicate +the user and host from which the change is made and the time of the +change. =item flag_check(FLAG) -Check whether the given flag is set on an object. Returns true if set, C<0> -if not set, and undef on error. +Check whether the given flag is set on an object. Returns true if set, +C<0> if not set, and undef on error. =item flag_clear(FLAG, PRINCIPAL, HOSTNAME [, DATETIME]) Clears FLAG on an object. Returns true on success and false on failure. -The other arguments are used for logging and history and should indicate the -user and host from which the change is made and the time of the change. +The other arguments are used for logging and history and should indicate +the user and host from which the change is made and the time of the +change. =item flag_list() List the flags set on an object. If no flags are set, returns the empty -list. On failure, returns an empty list. To distinguish between the empty -response and an error, the caller should call error() after an empty return. -It is guaranteed to return undef if there was no error. +list. On failure, returns an empty list. To distinguish between the +empty response and an error, the caller should call error() after an empty +return. It is guaranteed to return undef if there was no error. =item flag_set(FLAG, PRINCIPAL, HOSTNAME [, DATETIME]) Sets FLAG on an object. Returns true on success and false on failure. -The other arguments are used for logging and history and should indicate the -user and host from which the change is made and the time of the change. +The other arguments are used for logging and history and should indicate +the user and host from which the change is made and the time of the +change. =item get(PRINCIPAL, HOSTNAME [, DATETIME]) @@ -856,9 +866,9 @@ Sets or retrieves the owner of an object as a numeric ACL ID. If no arguments are given, returns the current owner ACL ID or undef if none is set. If arguments are given, change the owner to OWNER and return true on success and false on failure. Pass in the empty string for OWNER to clear -the owner. The other arguments are used for logging and history and should -indicate the user and host from which the change is made and the time of the -change. +the owner. The other arguments are used for logging and history and +should indicate the user and host from which the change is made and the +time of the change. =item show() @@ -866,17 +876,17 @@ Returns a formatted text description of the object suitable for human display, or undef on error. All of the base metadata about the object, formatted as key: value pairs with the keys aligned in the first 15 characters followed by a space, a colon, and the value. The attr_show() -method of the object is also called and any formatted output it returns will -be included. If any ACLs or an owner are set, after this data there is a -blank line and then the information for each unique ACL, separated by blank -lines. +method of the object is also called and any formatted output it returns +will be included. If any ACLs or an owner are set, after this data there +is a blank line and then the information for each unique ACL, separated by +blank lines. =item store(DATA, PRINCIPAL, HOSTNAME [, DATETIME]) Store user-supplied data into the given object. This may not be supported -by all backends (for instance, backends that automatically generate the data -will not support this). The default implementation rejects all store() -calls with an error message saying that the object is immutable. +by all backends (for instance, backends that automatically generate the +data will not support this). The default implementation rejects all +store() calls with an error message saying that the object is immutable. =item type() @@ -894,23 +904,24 @@ provided for subclasses to call to implement some generic actions. =item log_action (ACTION, PRINCIPAL, HOSTNAME, DATETIME) Updates the history tables and trace information appropriately for ACTION, -which should be either C or C. No other changes are made to the -database, just updates of the history table and trace fields with the +which should be either C or C. No other changes are made to +the database, just updates of the history table and trace fields with the provided data about who performed the action and when. -This function commits its transaction when complete and therefore should not -be called inside another transaction. Normally it's called as a separate -transaction after the data is successfully stored or retrieved. +This function commits its transaction when complete and therefore should +not be called inside another transaction. Normally it's called as a +separate transaction after the data is successfully stored or retrieved. =item log_set (FIELD, OLD, NEW, PRINCIPAL, HOSTNAME, DATETIME) -Updates the history tables for the change in a setting value for an object. -FIELD should be one of C, C, C, C, -C, C, C, C, or a value starting with -C followed by a space and a type-specific field name. The last -form is the most common form used by a subclass. OLD is the previous value -of the field or undef if the field was unset, and NEW is the new value of -the field or undef if the field should be unset. +Updates the history tables for the change in a setting value for an +object. FIELD should be one of C, C, C, +C, C, C, C, C, or a +value starting with C followed by a space and a type-specific +field name. The last form is the most common form used by a subclass. +OLD is the previous value of the field or undef if the field was unset, +and NEW is the new value of the field or undef if the field should be +unset. This function does not commit and does not catch database exceptions. It should normally be called as part of a larger transaction that implements @@ -922,8 +933,8 @@ the change in the setting. wallet-backend(8) -This module is part of the wallet system. The current version is available -from L. +This module is part of the wallet system. The current version is +available from L. =head1 AUTHOR diff --git a/perl/Wallet/Object/File.pm b/perl/Wallet/Object/File.pm index be72d7f..69262f6 100644 --- a/perl/Wallet/Object/File.pm +++ b/perl/Wallet/Object/File.pm @@ -1,7 +1,7 @@ # Wallet::Object::File -- File object implementation for the wallet. # # Written by Russ Allbery -# Copyright 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008, 2010 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -24,7 +24,7 @@ use Wallet::Object::Base; # This version should be increased on any code change to this module. Always # use two digits for the minor version with a leading zero if necessary so # that it will sort properly. -$VERSION = '0.01'; +$VERSION = '0.02'; ############################################################################## # File naming @@ -136,6 +136,9 @@ __END__ Wallet::Object::File - File object implementation for wallet +=for stopwords +API HOSTNAME DATETIME keytab remctld backend nul Allbery wallet-backend + =head1 SYNOPSIS my @name = qw(file mysql-lsdb) @@ -163,17 +166,18 @@ set wallet configuration. =head1 METHODS This object mostly inherits from Wallet::Object::Base. See the -documentation for that class for all generic methods. Below are only those -methods that are overridden or behave specially for this implementation. +documentation for that class for all generic methods. Below are only +those methods that are overridden or behave specially for this +implementation. =over 4 =item destroy(PRINCIPAL, HOSTNAME [, DATETIME]) Destroys a file object by removing it from the database and deleting the -corresonding file on the wallet server. Returns true on success and false -on failure. The caller should call error() to get the error message after -a failure. PRINCIPAL, HOSTNAME, and DATETIME are stored as history +corresponding file on the wallet server. Returns true on success and +false on failure. The caller should call error() to get the error message +after a failure. 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. diff --git a/perl/Wallet/Object/Keytab.pm b/perl/Wallet/Object/Keytab.pm index b604907..760280f 100644 --- a/perl/Wallet/Object/Keytab.pm +++ b/perl/Wallet/Object/Keytab.pm @@ -382,6 +382,10 @@ __END__ # Documentation ############################################################################## +=for stopwords +keytab API KDC keytabs HOSTNAME DATETIME enctypes enctype DBH metadata +unmanaged kadmin Allbery + =head1 NAME Wallet::Object::Keytab - Keytab object implementation for wallet @@ -396,17 +400,17 @@ Wallet::Object::Keytab - Keytab object implementation for wallet =head1 DESCRIPTION -Wallet::Object::Keytab is a representation of Kerberos keytab objects in the -wallet. It implements the wallet object API and provides the necessary -glue to create principals in a Kerberos KDC, create and return keytabs for -those principals, and delete them out of Kerberos when the wallet object is -destroyed. +Wallet::Object::Keytab is a representation of Kerberos keytab objects in +the wallet. It implements the wallet object API and provides the +necessary glue to create principals in a Kerberos KDC, create and return +keytabs for those principals, and delete them out of Kerberos when the +wallet object is destroyed. A keytab is an on-disk store for the key or keys for a Kerberos principal. -Keytabs are used by services to verify incoming authentication from clients -or by automated processes that need to authenticate to Kerberos. To create -a keytab, the principal has to be created in Kerberos and then a keytab is -generated and stored in a file on disk. +Keytabs are used by services to verify incoming authentication from +clients or by automated processes that need to authenticate to Kerberos. +To create a keytab, the principal has to be created in Kerberos and then a +keytab is generated and stored in a file on disk. This implementation generates a new random key (and hence invalidates all existing keytabs) each time the keytab is retrieved with the get() method. @@ -418,8 +422,9 @@ information about how to set wallet configuration. =head1 METHODS This object mostly inherits from Wallet::Object::Base. See the -documentation for that class for all generic methods. Below are only those -methods that are overridden or behave specially for this implementation. +documentation for that class for all generic methods. Below are only +those methods that are overridden or behave specially for this +implementation. =over 4 @@ -453,12 +458,12 @@ enctypes than those requested by this attribute. 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. +distinguish between an error and an empty return, call error() afterward. 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. +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. @@ -467,12 +472,12 @@ isn't given, the current time is used. This is a class method and should be called on the Wallet::Object::Keytab class. It creates a new object with the given TYPE and NAME (TYPE is -normally C and must be for the rest of the wallet system to use the -right class, but this module doesn't check for ease of subclassing), using -DBH as the handle to the wallet metadata database. PRINCIPAL, HOSTNAME, and -DATETIME are stored as history information. PRINCIPAL should be the user -who is creating the object. If DATETIME isn't given, the current time is -used. +normally C and must be for the rest of the wallet system to use +the right class, but this module doesn't check for ease of subclassing), +using DBH as the handle to the wallet metadata database. PRINCIPAL, +HOSTNAME, and DATETIME are stored as history information. PRINCIPAL +should be the user who is creating the object. If DATETIME isn't given, +the current time is used. When a new keytab object is created, the Kerberos principal designated by NAME is also created in the Kerberos realm determined from the wallet @@ -515,9 +520,9 @@ used. =item KEYTAB_TMP/keytab. -The keytab is created in this file using C and then read into memory. -KEYTAB_TMP is set in the wallet configuration, and is the process ID -of the current process. The file is unlinked after being read. +The keytab is created in this file using C and then read into +memory. KEYTAB_TMP is set in the wallet configuration, and is the +process ID of the current process. The file is unlinked after being read. =back @@ -536,8 +541,8 @@ wallet database do not have realm information. kadmin(8), Wallet::Config(3), Wallet::Object::Base(3), wallet-backend(8) -This module is part of the wallet system. The current version is available -from L. +This module is part of the wallet system. The current version is +available from L. =head1 AUTHOR diff --git a/perl/Wallet/Schema.pm b/perl/Wallet/Schema.pm index 252da03..589a15d 100644 --- a/perl/Wallet/Schema.pm +++ b/perl/Wallet/Schema.pm @@ -133,6 +133,10 @@ __DATA__ Wallet::Schema - Database schema for the wallet system +=for stopwords +SQL ACL API APIs enums Enums Keytab Backend keytab backend enctypes +enctype Allbery + =head1 SYNOPSIS use Wallet::Schema; @@ -157,30 +161,30 @@ MySQL and may require some modifications for other databases. =item new() -Instantiates a new Wallet::Schema object. This parses the documentation and -extracts the schema, but otherwise doesn't do anything. +Instantiates a new Wallet::Schema object. This parses the documentation +and extracts the schema, but otherwise doesn't do anything. =item create(DBH) -Given a connected database handle, runs the SQL commands necessary to create -the wallet database in an otherwise empty database. This method will not -drop any existing tables and will therefore fail if a wallet database has -already been created. On any error, this method will throw a database -exception. +Given a connected database handle, runs the SQL commands necessary to +create the wallet database in an otherwise empty database. This method +will not drop any existing tables and will therefore fail if a wallet +database has already been created. On any error, this method will throw a +database exception. =item drop(DBH) Given a connected database handle, drop all of the wallet tables from that -database if any of those tables exist. This method will only remove tables -that are part of the current schema or one of the previous known schema and -won't remove other tables. On any error, this method will throw a database -exception. +database if any of those tables exist. This method will only remove +tables that are part of the current schema or one of the previous known +schema and won't remove other tables. On any error, this method will +throw a database exception. =item sql() -Returns the schema and the population of the normalization tables as a list -of SQL commands to run to create the wallet database in an otherwise empty -database. +Returns the schema and the population of the normalization tables as a +list of SQL commands to run to create the wallet database in an otherwise +empty database. =back @@ -188,8 +192,8 @@ database. =head2 Normalization Tables -The following are normalization tables used to constrain the values in other -tables. +The following are normalization tables used to constrain the values in +other tables. Holds the supported flag names: @@ -221,16 +225,16 @@ Holds the supported ACL schemes and their corresponding Perl classes: values ('netdb-root', 'Wallet::ACL::NetDB::Root'); If you have extended the wallet to support additional object types or -additional ACL schemes, you will want to add additional rows to these tables -mapping those types or schemes to Perl classes that implement the object or -ACL verifier APIs. +additional ACL schemes, you will want to add additional rows to these +tables mapping those types or schemes to Perl classes that implement the +object or ACL verifier APIs. =head2 ACL Tables -A wallet ACL consists of zero or more ACL entries, each of which is a scheme -and an identifier. The scheme identifies the check that should be performed -and the identifier is additional scheme-specific information. Each ACL -references entries in the following table: +A wallet ACL consists of zero or more ACL entries, each of which is a +scheme and an identifier. The scheme identifies the check that should be +performed and the identifier is additional scheme-specific information. +Each ACL references entries in the following table: create table acls (ac_id integer auto_increment primary key, @@ -249,8 +253,9 @@ in: create index ae_id on acl_entries (ae_id); ACLs may be referred to in the API via either the numeric ID or the -human-readable name, but internally ACLs are always referenced by numeric ID -so that they can be renamed without requiring complex data modifications. +human-readable name, but internally ACLs are always referenced by numeric +ID so that they can be renamed without requiring complex data +modifications. Currently, the ACL named C (case-sensitive) is special-cased in the Wallet::Server code and granted global access. @@ -269,17 +274,18 @@ table. ah_on datetime not null); create index ah_acl on acl_history (ah_acl); -ah_action must be one of C, C, C, or C (enums -aren't used for compatibility with databases other than MySQL). For a -change of type create or destroy, only the action and the trace records (by, -from, and on) are stored. For a change to the lines of an ACL, the scheme -and identifier of the line that was added or removed is included. Note that -changes to the ACL name are not recorded; ACLs are always tracked by -system-generated ID, so name changes are purely cosmetic. +ah_action must be one of C, C, C, or C +(enums aren't used for compatibility with databases other than MySQL). +For a change of type create or destroy, only the action and the trace +records (by, from, and on) are stored. For a change to the lines of an +ACL, the scheme and identifier of the line that was added or removed is +included. Note that changes to the ACL name are not recorded; ACLs are +always tracked by system-generated ID, so name changes are purely +cosmetic. -ah_by stores the authenticated identity that made the change, ah_from stores -the host from which they made the change, and ah_on stores the time the -change was made. +ah_by stores the authenticated identity that made the change, ah_from +stores the host from which they made the change, and ah_on stores the time +the change was made. =head2 Object Tables @@ -311,13 +317,13 @@ table: create index ob_expires on objects (ob_expires); Object names are not globally unique but only unique within their type, so -the table has a joint primary key. Each object has an owner and then up to -five more specific ACLs. The owner provides permission for get, store, and -show operations if no more specific ACL is set. It does not provide +the table has a joint primary key. Each object has an owner and then up +to five more specific ACLs. The owner provides permission for get, store, +and show operations if no more specific ACL is set. It does not provide permission for destroy or flags. -The ob_acl_flags ACL controls who can set flags on this object. Each object -may have zero or more flags associated with it: +The ob_acl_flags ACL controls who can set flags on this object. Each +object may have zero or more flags associated with it: create table flags (fl_type varchar(16) @@ -348,27 +354,28 @@ this table: oh_on datetime not null); create index oh_object on object_history (oh_type, oh_name); -oh_action must be one of C, C, C, C, or C. -oh_field must be one of C, C, C, C, -C, C, C, C, or C. Enums -aren't used for compatibility with databases other than MySQL. - -For a change of type create, get, store, or destroy, only the action and the -trace records (by, from, and on) are stored. For changes to columns or to -the flags table, oh_field takes what attribute is changed, oh_from takes the -previous value converted to a string and oh_to takes the next value -similarly converted to a string. The special field value "type_data" is -used when type-specific data is changed, and in that case (and only that -case) some type-specific name for the data being changed is stored in -oh_type_field. +oh_action must be one of C, C, C, C, or +C. oh_field must be one of C, C, C, +C, C, C, C, C, or +C. Enums aren't used for compatibility with databases other +than MySQL. + +For a change of type create, get, store, or destroy, only the action and +the trace records (by, from, and on) are stored. For changes to columns +or to the flags table, oh_field takes what attribute is changed, oh_from +takes the previous value converted to a string and oh_to takes the next +value similarly converted to a string. The special field value +"type_data" is used when type-specific data is changed, and in that case +(and only that case) some type-specific name for the data being changed is +stored in oh_type_field. When clearing a flag, oh_old will have the name of the flag and oh_new will be null. When setting a flag, oh_old will be null and oh_new will have the name of the flag. -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. +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 Keytab Backend Data @@ -406,16 +413,16 @@ and then the restrictions for a given keytab are stored in this table: 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 -automated mechanism to do this. +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 automated mechanism to do this. =head1 SEE ALSO wallet-backend(8) -This module is part of the wallet system. The current version is available -from L. +This module is part of the wallet system. The current version is +available from L. =head1 AUTHOR diff --git a/perl/Wallet/Server.pm b/perl/Wallet/Server.pm index 40e48a3..dd596c4 100644 --- a/perl/Wallet/Server.pm +++ b/perl/Wallet/Server.pm @@ -1,7 +1,7 @@ # Wallet::Server -- Wallet system server implementation. # # Written by Russ Allbery -# Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2008, 2010 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -23,7 +23,7 @@ use Wallet::Schema; # This version should be increased on any code change to this module. Always # use two digits for the minor version with a leading zero if necessary so # that it will sort properly. -$VERSION = '0.07'; +$VERSION = '0.08'; ############################################################################## # Utility methods @@ -714,6 +714,10 @@ __END__ Wallet::Server - Wallet system server implementation +=for stopwords +keytabs metadata backend HOSTNAME ACL timestamp ACL's nul Allbery +backend-specific wallet-backend + =head1 SYNOPSIS use Wallet::Server; @@ -725,8 +729,8 @@ Wallet::Server - Wallet system server implementation Wallet::Server is the top-level class that implements the wallet server. The wallet is a system for storing, generating, and retrieving secure information such as Kerberos keytabs. The server maintains metadata about -the objects, checks access against ACLs, and dispatches requests for objects -to backend implementations for that object type. +the objects, checks access against ACLs, and dispatches requests for +objects to backend implementations for that object type. Wallet::Server is normally instantiated and used by B, a thin wrapper around this object that determines the authenticated remote @@ -734,8 +738,8 @@ user and gets user input and then calls the appropriate method of this object. To use this object, several configuration variables must be set (at least -the database configuration). For information on those variables and how to -set them, see Wallet::Config(3). +the database configuration). For information on those variables and how +to set them, see Wallet::Config(3). =head1 CLASS METHODS @@ -765,11 +769,12 @@ failure to get the error message. Gets or sets the ACL type ACL to ID for the object identified by TYPE and NAME. ACL should be one of C, C, C, C, or -C. If ID is not given, returns the current setting of that ACL as a -numeric ACL ID or undef if that ACL isn't set or on failure. To distinguish -between an ACL that isn't set and a failure to retrieve the ACL, the caller -should call error() after an undef return. If error() also returns undef, -that ACL wasn't set; otherwise, error() will return the error message. +C. If ID is not given, returns the current setting of that ACL as +a numeric ACL ID or undef if that ACL isn't set or on failure. To +distinguish between an ACL that isn't set and a failure to retrieve the +ACL, the caller should call error() after an undef return. If error() +also returns undef, that ACL wasn't set; otherwise, error() will return +the error message. If ID is given, sets the specified ACL to ID, which can be either the name of an ACL or a numeric ACL ID. To set an ACL, the current user must be @@ -798,64 +803,65 @@ failure. Destroys the ACL identified by ID, which may be either the ACL name or its numeric ID. This call will fail if the ACL is still referenced by any -object. The ADMIN ACL may not be destroyed. To destroy an ACL, the current -user must be authorized by the ADMIN ACL. Returns true on success and false -on failure. +object. The ADMIN ACL may not be destroyed. To destroy an ACL, the +current user must be authorized by the ADMIN ACL. Returns true on success +and false on failure. =item acl_history(ID) -Returns the history of the ACL identified by ID, which may be either the ACL -name or its numeric ID. To see the history of an ACL, the current user must -be authorized by the ADMIN ACL. Each change that modifies the ACL (not -counting changes in the name of the ACL) will be represented by two lines. -The first line will have a timestamp of the change followed by a description -of the change, and the second line will give the user who made the change -and the host from which the change was made. Returns undef on failure. +Returns the history of the ACL identified by ID, which may be either the +ACL name or its numeric ID. To see the history of an ACL, the current +user must be authorized by the ADMIN ACL. Each change that modifies the +ACL (not counting changes in the name of the ACL) will be represented by +two lines. The first line will have a timestamp of the change followed by +a description of the change, and the second line will give the user who +made the change and the host from which the change was made. Returns +undef on failure. =item acl_remove(ID, SCHEME, IDENTIFIER) Removes from the ACL identified by ID the entry matching SCHEME and IDENTIFIER. ID may be either the name of the ACL or its numeric ID. The last entry in the ADMIN ACL cannot be removed. To remove an entry from an -ACL, the current user must be authorized by the ADMIN ACL. Returns true on -success and false on failure. +ACL, the current user must be authorized by the ADMIN ACL. Returns true +on success and false on failure. =item acl_rename(OLD, NEW) Renames the ACL identified by OLD to NEW. This changes the human-readable -name, not the underlying numeric ID, so the ACL's associations with objects -will be unchanged. The ADMIN ACL may not be renamed. OLD may be either the -current name or the numeric ID. NEW must not be all-numeric. To rename an -ACL, the current user must be authorized by the ADMIN ACL. Returns true on -success and false on failure. +name, not the underlying numeric ID, so the ACL's associations with +objects will be unchanged. The ADMIN ACL may not be renamed. OLD may be +either the current name or the numeric ID. NEW must not be all-numeric. +To rename an ACL, the current user must be authorized by the ADMIN ACL. +Returns true on success and false on failure. =item acl_show(ID) Returns a human-readable description, including membership, of the ACL identified by ID, which may be either the ACL name or its numeric ID. To -show an ACL, the current user must be authorized by the ADMIN ACL (although -be aware that anyone with show access to an object can see the membership of -ACLs associated with that object through the show() method). Returns the -human-readable description on success and undef on failure. +show an ACL, the current user must be authorized by the ADMIN ACL +(although be aware that anyone with show access to an object can see the +membership of ACLs associated with that object through the show() method). +Returns the human-readable description on success and undef on failure. =item attr(TYPE, NAME, ATTRIBUTE [, VALUE ...]) Sets or retrieves a given object attribute. Attributes are used to store -backend-specific information for a particular object type and ATTRIBUTE must -be an attribute type known to the underlying object implementation. +backend-specific information for a particular object type and ATTRIBUTE +must be an attribute type known to the underlying object implementation. If VALUE is not 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. To retrieve an attribute setting, the user -must be authorized by the ADMIN ACL, the show ACL if set, or the owner ACL -if the show ACL is not set. +and an empty return, call error() afterward. It is guaranteed to return +undef unless there was an error. To retrieve an attribute setting, the +user must be authorized by the ADMIN ACL, the show ACL if set, or the +owner ACL if the show ACL is not set. -If VALUE is given, sets the given ATTRIBUTE values to VALUE, which is one or -more attribute values. Pass the empty string as the only VALUE to clear the -attribute values. Returns true on success and false on failure. To set an -attribute value, the user must be authorized by the ADMIN ACL, the store ACL -if set, or the owner ACL if the store ACL is not set. +If VALUE is given, sets the given ATTRIBUTE values to VALUE, which is one +or more attribute values. Pass the empty string as the only VALUE to +clear the attribute values. Returns true on success and false on failure. +To set an attribute value, the user must be authorized by the ADMIN ACL, +the store ACL if set, or the owner ACL if the store ACL is not set. =item autocreate(TYPE, NAME) @@ -877,9 +883,9 @@ for the existence of the object. =item create(TYPE, NAME) -Creates a new object of type TYPE and name NAME. TYPE must be a recognized -type for which the wallet system has a backend implementation. Returns true -on success and false on failure. +Creates a new object of type TYPE and name NAME. TYPE must be a +recognized type for which the wallet system has a backend implementation. +Returns true on success and false on failure. To create an object using this method, the current user must be authorized by the ADMIN ACL. Use autocreate() to create objects based on the default @@ -888,18 +894,18 @@ owner as determined by the wallet configuration. =item destroy(TYPE, NAME) Destroys the object identified by TYPE and NAME. This destroys any data -that the wallet had saved about the object, may remove the underlying object -from other external systems, and destroys the wallet database entry for the -object. To destroy an object, the current user must be authorized by the -ADMIN ACL or the destroy ACL on the object; the owner ACL is not sufficient. -Returns true on success and false on failure. +that the wallet had saved about the object, may remove the underlying +object from other external systems, and destroys the wallet database entry +for the object. To destroy an object, the current user must be authorized +by the ADMIN ACL or the destroy ACL on the object; the owner ACL is not +sufficient. Returns true on success and false on failure. =item dbh() -Returns the database handle of a Wallet::Server object. This is used mostly -for testing; normally, clients should perform all actions through the -Wallet::Server object to ensure that authorization and history logging is -done properly. +Returns the database handle of a Wallet::Server object. This is used +mostly for testing; normally, clients should perform all actions through +the Wallet::Server object to ensure that authorization and history logging +is done properly. =item error() @@ -909,12 +915,12 @@ after an undef return from any other instance method. =item expires(TYPE, NAME [, EXPIRES]) -Gets or sets the expiration for the object identified by TYPE and NAME. If -EXPIRES is not given, returns the current expiration or undef if no -expiration is set or on an error. To distinguish between an expiration that -isn't set and a failure to retrieve the expiration, the caller should call -error() after an undef return. If error() also returns undef, that ACL -wasn't set; otherwise, error() will return the error message. +Gets or sets the expiration for the object identified by TYPE and NAME. +If EXPIRES is not given, returns the current expiration or undef if no +expiration is set or on an error. To distinguish between an expiration +that isn't set and a failure to retrieve the expiration, the caller should +call error() after an undef return. If error() also returns undef, that +ACL wasn't set; otherwise, error() will return the error message. If EXPIRES is given, sets the expiration to EXPIRES. EXPIRES must be in the format C, although the time portion may be @@ -924,23 +930,23 @@ ADMIN ACL. Returns true for success and false for failure. =item flag_clear(TYPE, NAME, FLAG) -Clears the flag FLAG on the object identified by TYPE and NAME. To clear a -flag, the current user must be authorized by the ADMIN ACL or the flags ACL -on the object. +Clears the flag FLAG on the object identified by TYPE and NAME. To clear +a flag, the current user must be authorized by the ADMIN ACL or the flags +ACL on the object. =item flag_set(TYPE, NAME, FLAG) Sets the flag FLAG on the object identified by TYPE and NAME. To set a -flag, the current user must be authorized by the ADMIN ACL or the flags ACL -on the object. +flag, the current user must be authorized by the ADMIN ACL or the flags +ACL on the object. =item get(TYPE, NAME) Returns the data associated with the object identified by TYPE and NAME. -Depending on the object TYPE, this may generate new data and invalidate any -existing data or it may return data previously stored or generated. Note -that this data may be binary and may contain nul characters. To get an -object, the current user must either be authorized by the owner ACL or +Depending on the object TYPE, this may generate new data and invalidate +any existing data or it may return data previously stored or generated. +Note that this data may be binary and may contain nul characters. To get +an object, the current user must either be authorized by the owner ACL or authorized by the get ACL; however, if the get ACL is set, the owner ACL will not be checked. Being a member of the ADMIN ACL does not provide any special privileges to get objects. @@ -950,48 +956,49 @@ between undef and the empty string, which is valid object data. =item history(TYPE, NAME) -Returns (as a string) the human-readable history of the object identified by -TYPE and NAME, or undef on error. To see the object history, the current -user must be a member of the ADMIN ACL, authorized by the show ACL, or -authorized by the owner ACL; however, if the show ACL is set, the owner ACL -will not be checked. +Returns (as a string) the human-readable history of the object identified +by TYPE and NAME, or undef on error. To see the object history, the +current user must be a member of the ADMIN ACL, authorized by the show +ACL, or authorized by the owner ACL; however, if the show ACL is set, the +owner ACL will not be checked. =item owner(TYPE, NAME [, OWNER]) -Gets or sets the owner for the object identified by TYPE and NAME. If OWNER -is not given, returns the current owner as a numeric ACL ID or undef if no -owner is set or on an error. To distinguish between an owner that isn't set -and a failure to retrieve the owner, the caller should call error() after an -undef return. If error() also returns undef, that ACL wasn't set; -otherwise, error() will return the error message. +Gets or sets the owner for the object identified by TYPE and NAME. If +OWNER is not given, returns the current owner as a numeric ACL ID or undef +if no owner is set or on an error. To distinguish between an owner that +isn't set and a failure to retrieve the owner, the caller should call +error() after an undef return. If error() also returns undef, that ACL +wasn't set; otherwise, error() will return the error message. -If OWNER is given, sets the owner to OWNER, which may be either the name of -an ACL or a numeric ACL ID. To set an owner, the current user must be +If OWNER is given, sets the owner to OWNER, which may be either the name +of an ACL or a numeric ACL ID. To set an owner, the current user must be authorized by the ADMIN ACL. Returns true for success and false for failure. -The owner of an object is permitted to get, store, and show that object, but -cannot destroy or set flags on that object without being listed on those -ACLs as well. +The owner of an object is permitted to get, store, and show that object, +but cannot destroy or set flags on that object without being listed on +those ACLs as well. =item show(TYPE, NAME) -Returns (as a string) a human-readable representation of the metadata stored -for the object identified by TYPE and NAME, or undef on error. Included is -the metadata and entries of any ACLs associated with the object. To show an -object, the current user must be a member of the ADMIN ACL, authorized by -the show ACL, or authorized by the owner ACL; however, if the show ACL is -set, the owner ACL will not be checked. +Returns (as a string) a human-readable representation of the metadata +stored for the object identified by TYPE and NAME, or undef on error. +Included is the metadata and entries of any ACLs associated with the +object. To show an object, the current user must be a member of the ADMIN +ACL, authorized by the show ACL, or authorized by the owner ACL; however, +if the show ACL is set, the owner ACL will not be checked. =item store(TYPE, NAME, DATA) -Stores DATA for the object identified with TYPE and NAME for later retrieval -with get. Not all object types support this. Note that DATA may be binary -and may contain nul characters. To store an object, the current user must -either be authorized by the owner ACL or authorized by the store ACL; -however, if the store ACL is set, the owner ACL is not checked. Being a -member of the ADMIN ACL does not provide any special privileges to store -objects. Returns true on success and false on failure. +Stores DATA for the object identified with TYPE and NAME for later +retrieval with get. Not all object types support this. Note that DATA +may be binary and may contain nul characters. To store an object, the +current user must either be authorized by the owner ACL or authorized by +the store ACL; however, if the store ACL is set, the owner ACL is not +checked. Being a member of the ADMIN ACL does not provide any special +privileges to store objects. Returns true on success and false on +failure. =back @@ -999,8 +1006,8 @@ objects. Returns true on success and false on failure. wallet-backend(8) -This module is part of the wallet system. The current version is available -from L. +This module is part of the wallet system. The current version is +available from L. =head1 AUTHOR diff --git a/perl/t/pod-spelling.t b/perl/t/pod-spelling.t new file mode 100755 index 0000000..d3ab858 --- /dev/null +++ b/perl/t/pod-spelling.t @@ -0,0 +1,75 @@ +#!/usr/bin/perl -w +# +# Check for spelling errors in POD documentation +# +# Checks all POD files in the tree for spelling problems using Pod::Spell and +# either aspell or ispell. aspell is preferred. This test is disabled unless +# RRA_MAINTAINER_TESTS is set, since spelling dictionaries vary too much +# between environments. +# +# Copyright 2008, 2009 Russ Allbery +# +# This program is free software; you may redistribute it and/or modify it +# under the same terms as Perl itself. + +use strict; +use Test::More; + +# Skip all spelling tests unless the maintainer environment variable is set. +plan skip_all => 'Spelling tests only run for maintainer' + unless $ENV{RRA_MAINTAINER_TESTS}; + +# Load required Perl modules. +eval 'use Test::Pod 1.00'; +plan skip_all => 'Test::Pod 1.00 required for testing POD' if $@; +eval 'use Pod::Spell'; +plan skip_all => 'Pod::Spell required to test POD spelling' if $@; + +# Locate a spell-checker. hunspell is not currently supported due to its lack +# of support for contractions (at least in the version in Debian). +my @spell; +my %options = (aspell => [ qw(-d en_US --home-dir=./ list) ], + ispell => [ qw(-d american -l -p /dev/null) ]); +SEARCH: for my $program (qw/aspell ispell/) { + for my $dir (split ':', $ENV{PATH}) { + if (-x "$dir/$program") { + @spell = ("$dir/$program", @{ $options{$program} }); + } + last SEARCH if @spell; + } +} +plan skip_all => 'aspell or ispell required to test POD spelling' + unless @spell; + +# Prerequisites are satisfied, so we're going to do some testing. Figure out +# what POD files we have and from that develop our plan. +$| = 1; +my @pod = all_pod_files (); +plan tests => scalar @pod; + +# Finally, do the checks. +for my $pod (@pod) { + my $child = open (CHILD, '-|'); + if (not defined $child) { + die "Cannot fork: $!\n"; + } elsif ($child == 0) { + my $pid = open (SPELL, '|-', @spell) or die "Cannot run @spell: $!\n"; + open (POD, '<', $pod) or die "Cannot open $pod: $!\n"; + my $parser = Pod::Spell->new; + $parser->parse_from_filehandle (\*POD, \*SPELL); + close POD; + close SPELL; + exit ($? >> 8); + } else { + my @words = ; + close CHILD; + SKIP: { + skip "@spell failed for $pod", 1 unless $? == 0; + for (@words) { + s/^\s+//; + s/\s+$//; + } + is ("@words", '', $pod); + } + } +} diff --git a/perl/t/pod.t b/perl/t/pod.t index e9aa0a8..c467b82 100755 --- a/perl/t/pod.t +++ b/perl/t/pod.t @@ -1,16 +1,14 @@ -#!/usr/bin/perl +#!/usr/bin/perl -w # -# t/pod.t -- Test POD formatting for the wallet Perl modules. +# Test POD formatting for the wallet Perl modules. # # Written by Russ Allbery -# Copyright 2007 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2010 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. +use strict; +use Test::More; eval 'use Test::Pod 1.00'; -if ($@) { - print "1..1\n"; - print "ok 1 # skip - Test::Pod 1.00 required for testing POD\n"; - exit; -} +plan skip_all => 'Test::Pod 1.00 required for testing POD' if $@; all_pod_files_ok (); -- cgit v1.2.3 From a24d3ac3c7e8cb68fe2268f337a4edb599d5f881 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Thu, 18 Feb 2010 21:31:10 -0800 Subject: Support unchanging keytabs with Heimdal without remctl Heimdal supports retrieving a keytab containing the existing keys over the kadmin protocol. Move the support for using remctl to retrieve an existing keytab into Wallet::Kadmin::MIT and provide two separate methods in the Wallet::Kadmin interface: one which rekeys and one which doesn't. Implement the non-rekeying interface for Heimdal. Expand the test suite for the unchanging keytabs to include tests for the Heimdal method. --- TODO | 2 - perl/Wallet/Config.pm | 21 +++++-- perl/Wallet/Kadmin.pm | 43 ++++++++------ perl/Wallet/Kadmin/Heimdal.pm | 74 +++++++++++++++++++++--- perl/Wallet/Kadmin/MIT.pm | 68 +++++++++++++++++++--- perl/Wallet/Object/Keytab.pm | 49 +--------------- perl/t/kadmin.t | 4 +- perl/t/keytab.t | 127 ++++++++++++++++++++++++++++-------------- 8 files changed, 257 insertions(+), 131 deletions(-) (limited to 'perl/Wallet/Config.pm') diff --git a/TODO b/TODO index 92bd025..662ea47 100644 --- a/TODO +++ b/TODO @@ -2,8 +2,6 @@ Release 0.10: -* Handle unchanging support for Heimdal. - * Move reporting code from Wallet::Admin to Wallet::Report. * Check whether we can just drop the realm restriction on keytabs and diff --git a/perl/Wallet/Config.pm b/perl/Wallet/Config.pm index c59d3e3..396bf7d 100644 --- a/perl/Wallet/Config.pm +++ b/perl/Wallet/Config.pm @@ -26,7 +26,8 @@ Wallet::Config - Configuration handling for the wallet server =for stopwords DBI DSN SQLite subdirectories KEYTAB keytab kadmind KDC add-ons kadmin DNS SRV kadmin keytabs remctl backend lowercased NETDB ACL NetDB unscoped -usernames rekey hostnames Allbery wallet-backend keytab-backend +usernames rekey hostnames Allbery wallet-backend keytab-backend Heimdal +rekeys =head1 SYNOPSIS @@ -313,11 +314,19 @@ our $KEYTAB_TMP; =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. This is enabled by setting the -C flag on keytab objects. To configure that support, set the -following variables. +Heimdal provides the choice, over the network protocol, of either +downloading the existing keys for a principal or generating new random +keys. MIT Kerberos does not; downloading a keytab over the kadmin +protocol always rekeys the principal. + +For MIT Kerberos, the keytab object backend therefore optionally supports +retrieving existing keys, and hence keytabs, for Kerberos principals by +contacting the KDC via remctl and talking to B. This is +enabled by setting the C flag on keytab objects. To configure +that support, set the following variables. + +This is not required for Heimdal; for Heimdal, setting the C +flag is all that's needed. =over 4 diff --git a/perl/Wallet/Kadmin.pm b/perl/Wallet/Kadmin.pm index 3ca531e..f3c2895 100644 --- a/perl/Wallet/Kadmin.pm +++ b/perl/Wallet/Kadmin.pm @@ -83,10 +83,12 @@ Wallet::Kadmin - Kerberos administration API for wallet keytab backend =head1 SYNOPSIS my $kadmin = Wallet::Kadmin->new; - $kadmin->create ("host/foo.example.com"); - $kadmin->keytab ("host/foo.example.com", "aes256-cts-hmac-sha1-96"); - my $exists = $kadmin->exists ("host/oldshell.example.com"); - $kadmin->destroy ("host/oldshell.example.com") if $exists; + $kadmin->create ('host/foo.example.com'); + $kadmin->keytab_rekey ('host/foo.example.com', 'keytab', + 'aes256-cts-hmac-sha1-96'); + my $data = $kadmin->keytab ('host/foo.example.com'); + my $exists = $kadmin->exists ('host/oldshell.example.com'); + $kadmin->destroy ('host/oldshell.example.com') if $exists; =head1 DESCRIPTION @@ -162,19 +164,26 @@ kadmin command-line client, the sub CALLBACK will be called in the child process before running the program. This can be used to, for example, properly clean up shared database handles. -=item keytab(PRINCIPAL, FILE [, ENCTYPE ... ]) - -A keytab is an on-disk store for the key or keys for a Kerberos principal. -Keytabs are used by services to verify incoming authentication from -clients or by automated processes that need to authenticate to Kerberos. -To create a keytab, the principal has to be created in Kerberos and then a -keytab is generated and stored in a file on disk. - -ktadd() creates a new keytab for the given principal, storing it in the -given file and limited to the enctypes supplied. The enctype values must -be enctype strings recognized by the Kerberos implementation (strings like -C or C). Returns true on success -and false on failure. +=item keytab(PRINCIPAL) + +keytab() creates a keytab for the given principal, storing it in the given +file. A keytab is an on-disk store for the key or keys for a Kerberos +principal. Keytabs are used by services to verify incoming authentication +from clients or by automated processes that need to authenticate to +Kerberos. To create a keytab, the principal has to have previously been +created in the Kerberos KDC. Returns the keytab as binary data on success +and undef on failure. + +=item keytab_rekey(PRINCIPAL, FILE [, ENCTYPE ...]) + +Like keytab(), but randomizes the key for the principal before generating +the keytab and writes it to the given file. This will invalidate any +existing keytabs for that principal. This method can also limit the +encryption types of the keys for that principal via the optional ENCTYPE +arguments. The enctype values must be enctype strings recognized by the +Kerberos implementation (strings like C or +C). If none are given, the KDC defaults will be used. +Returns true on success and false on failure. =back diff --git a/perl/Wallet/Kadmin/Heimdal.pm b/perl/Wallet/Kadmin/Heimdal.pm index 0ac8cd9..e066006 100644 --- a/perl/Wallet/Kadmin/Heimdal.pm +++ b/perl/Wallet/Kadmin/Heimdal.pm @@ -39,6 +39,23 @@ sub canonicalize_principal { return $principal; } +# Read the entirety of a possibly binary file and return the contents. If +# reading the file fails, set the error message and return undef. +sub slurp_file { + my ($self, $file) = @_; + unless (open (TMPFILE, '<', $file)) { + $self->error ("cannot open temporary file $file: $!"); + return; + } + local $/; + my $data = ; + unless (close TMPFILE) { + $self->error ("cannot read temporary file $file: $!"); + return; + } + return $data; +} + ############################################################################## # Public interfaces ############################################################################## @@ -93,11 +110,38 @@ sub create { return 1; } -# 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. +# Create a keytab for a principal. Returns the keytab as binary data or undef +# on failure, setting the error. sub keytab { + my ($self, $principal) = @_; + $principal = $self->canonicalize_principal ($principal); + my $kadmin = $self->{client}; + my $file = $Wallet::Config::KEYTAB_TMP . "/keytab.$$"; + unlink $file; + my $princdata = eval { $kadmin->getPrincipal ($principal) }; + if ($@) { + $self->error ("error creating keytab for $principal: $@"); + return; + } elsif (!$princdata) { + $self->error ("error creating keytab for $principal: principal does" + . " not exist"); + return; + } + eval { $kadmin->extractKeytab ($princdata, $file) }; + if ($@) { + $self->error ("error creating keytab for principal: $@"); + return; + } + my $data = $self->slurp_file ($file); + unlink $file; + return $data; +} + +# Create a keytab for a principal, randomizing the keys for that principal at +# the same time. 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 keytab_rekey { my ($self, $principal, $file, @enctypes) = @_; $principal = $self->canonicalize_principal ($principal); @@ -213,10 +257,12 @@ Wallet::Kadmin::Heimdal - Wallet Kerberos administration API for Heimdal =head1 SYNOPSIS my $kadmin = Wallet::Kadmin::Heimdal->new; - $kadmin->create ("host/foo.example.com"); - $kadmin->keytab ("host/foo.example.com", "aes256-cts-hmac-sha1-96"); - my $exists = $kadmin->exists ("host/oldshell.example.com"); - $kadmin->destroy ("host/oldshell.example.com") if $exists; + $kadmin->create ('host/foo.example.com'); + $kadmin->keytab_rekey ('host/foo.example.com', 'keytab', + 'aes256-cts-hmac-sha1-96'); + my $data = $kadmin->keytab ('host/foo.example.com'); + my $exists = $kadmin->exists ('host/oldshell.example.com'); + $kadmin->destroy ('host/oldshell.example.com') if $exists; =head1 DESCRIPTION @@ -228,6 +274,18 @@ To use this object, several configuration parameters must be set. See Wallet::Config(3) for details on those configuration parameters and information about how to set wallet configuration. +=head1 FILES + +=over 4 + +=item KEYTAB_TMP/keytab. + +The keytab is created in this file and then read into memory. KEYTAB_TMP +is set in the wallet configuration, and is the process ID of the +current process. The file is unlinked after being read. + +=back + =head1 SEE ALSO kadmin(8), Wallet::Config(3), Wallet::Kadmin(3), diff --git a/perl/Wallet/Kadmin/MIT.pm b/perl/Wallet/Kadmin/MIT.pm index 9ab575c..1c6d2c1 100644 --- a/perl/Wallet/Kadmin/MIT.pm +++ b/perl/Wallet/Kadmin/MIT.pm @@ -137,11 +137,52 @@ sub create { return 1; } -# 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. +# 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 { + my ($self, $principal) = @_; + my $host = $Wallet::Config::KEYTAB_REMCTL_HOST; + unless ($host and $Wallet::Config::KEYTAB_REMCTL_CACHE) { + $self->error ('keytab unchanging support not configured'); + return; + } + eval { require Net::Remctl }; + if ($@) { + $self->error ("keytab unchanging support not available: $@"); + return; + } + if ($principal !~ /\@/ && $Wallet::Config::KEYTAB_REALM) { + $principal .= '@' . $Wallet::Config::KEYTAB_REALM; + } + local $ENV{KRB5CCNAME} = $Wallet::Config::KEYTAB_REMCTL_CACHE; + my $port = $Wallet::Config::KEYTAB_REMCTL_PORT || 0; + my $remctl_princ = $Wallet::Config::KEYTAB_REMCTL_PRINCIPAL || ''; + my @command = ('keytab', 'retrieve', $principal); + my $result = Net::Remctl::remctl ($host, $port, $remctl_princ, @command); + if ($result->error) { + $self->error ("cannot retrieve keytab for $principal: ", + $result->error); + return; + } elsif ($result->status != 0) { + my $error = $result->stderr; + $error =~ s/\s+$//; + $error =~ s/\n/ /g; + $self->error ("cannot retrieve keytab for $principal: $error"); + return; + } else { + return $result->stdout; + } +} + +# Create a keytab for a principal, randomizing the keys for that principal +# in the process. 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 keytab_rekey { my ($self, $principal, $file, @enctypes) = @_; unless ($self->valid_principal ($principal)) { $self->error ("invalid principal name: $principal"); @@ -210,7 +251,7 @@ __END__ ############################################################################## =for stopwords -keytabs keytab kadmin KDC API Allbery +rekeying rekeys remctl backend keytabs keytab kadmin KDC API Allbery =head1 NAME @@ -219,10 +260,12 @@ Wallet::Kadmin::MIT - Wallet Kerberos administration API for MIT =head1 SYNOPSIS my $kadmin = Wallet::Kadmin::MIT->new; - $kadmin->create ("host/foo.example.com"); - $kadmin->keytab ("host/foo.example.com", "aes256-cts-hmac-sha1-96"); - my $exists = $kadmin->exists ("host/oldshell.example.com"); - $kadmin->destroy ("host/oldshell.example.com") if $exists; + $kadmin->create ('host/foo.example.com'); + $kadmin->keytab_rekey ('host/foo.example.com', 'keytab', + 'aes256-cts-hmac-sha1-96'); + my $data = $kadmin->keytab ('host/foo.example.com'); + my $exists = $kadmin->exists ('host/oldshell.example.com'); + $kadmin->destroy ('host/oldshell.example.com') if $exists; =head1 DESCRIPTION @@ -231,6 +274,13 @@ providing an interface to create and delete principals and create keytabs. It provides the API documented in Wallet::Kadmin(3) for an MIT Kerberos KDC. +MIT Kerberos does not provide any method via the kadmin network protocol +to retrieve a keytab for a principal without rekeying it, so the keytab() +method (as opposed to keytab_rekey(), which rekeys the principal) is +implemented using a remctl backend. For that method (used for unchanging +keytab objects) to work, the necessary wallet configuration and remctl +interface on the KDC must be set up. + To use this object, several configuration parameters must be set. See Wallet::Config(3) for details on those configuration parameters and information about how to set wallet configuration. diff --git a/perl/Wallet/Object/Keytab.pm b/perl/Wallet/Object/Keytab.pm index 44ee003..5c66967 100644 --- a/perl/Wallet/Object/Keytab.pm +++ b/perl/Wallet/Object/Keytab.pm @@ -179,49 +179,6 @@ sub sync_list { return @targets; } -############################################################################## -# 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_REMCTL_CACHE) { - $self->error ('keytab unchanging support not configured'); - return; - } - eval { require Net::Remctl }; - if ($@) { - $self->error ("keytab unchanging support not available: $@"); - return; - } - if ($Wallet::Config::KEYTAB_REALM) { - $keytab .= '@' . $Wallet::Config::KEYTAB_REALM; - } - local $ENV{KRB5CCNAME} = $Wallet::Config::KEYTAB_REMCTL_CACHE; - my $port = $Wallet::Config::KEYTAB_REMCTL_PORT || 0; - 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; - } elsif ($result->status != 0) { - my $error = $result->stderr; - $error =~ s/\s+$//; - $error =~ s/\n/ /g; - $self->error ("cannot retrieve keytab for $keytab: $error"); - return; - } else { - return $result->stdout; - } -} - ############################################################################## # Core methods ############################################################################## @@ -365,8 +322,9 @@ sub get { $self->error ("cannot get $id: object is locked"); return; } + my $kadmin = $self->{kadmin}; if ($self->flag_check ('unchanging')) { - my $result = $self->keytab_retrieve ($self->{name}); + my $result = $kadmin->keytab ($self->{name}); if (defined $result) { $self->log_action ('get', $user, $host, $time); } @@ -379,8 +337,7 @@ sub get { my $file = $Wallet::Config::KEYTAB_TMP . "/keytab.$$"; unlink $file; my @enctypes = $self->attr ('enctypes'); - my $kadmin = $self->{kadmin}; - if (not $kadmin->keytab ($self->{name}, $file, @enctypes)) { + if (not $kadmin->keytab_rekey ($self->{name}, $file, @enctypes)) { $self->error ($kadmin->error); return; } diff --git a/perl/t/kadmin.t b/perl/t/kadmin.t index 9c49995..a29cae3 100755 --- a/perl/t/kadmin.t +++ b/perl/t/kadmin.t @@ -91,7 +91,7 @@ SKIP: { is ($kadmin->create ('wallet/one'), 1, 'Creating wallet/one works'); is ($kadmin->exists ('wallet/one'), 1, ' and it now exists'); unlink ('./tmp.keytab'); - is ($kadmin->keytab ('wallet/one', './tmp.keytab'), 1, + is ($kadmin->keytab_rekey ('wallet/one', './tmp.keytab'), 1, ' and retrieving a keytab works'); ok (-s './tmp.keytab', ' and the resulting keytab is non-zero'); is (getcreds ('./tmp.keytab', "wallet/one\@$Wallet::Config::KEYTAB_REALM"), @@ -101,7 +101,7 @@ SKIP: { # Delete the principal and confirm behavior. is ($kadmin->destroy ('wallet/one'), 1, 'Deleting principal works'); is ($kadmin->exists ('wallet/one'), 0, ' and now it does not exist'); - is ($kadmin->keytab ('wallet/one', './tmp.keytab'), undef, + is ($kadmin->keytab_rekey ('wallet/one', './tmp.keytab'), undef, ' and retrieving the keytab does not work'); ok (! -f './tmp.keytab', ' and no file was created'); like ($kadmin->error, qr%^error creating keytab for wallet/one%, diff --git a/perl/t/keytab.t b/perl/t/keytab.t index a14b63e..a702c0f 100755 --- a/perl/t/keytab.t +++ b/perl/t/keytab.t @@ -9,7 +9,7 @@ # See LICENSE for licensing terms. use POSIX qw(strftime); -use Test::More tests => 125; +use Test::More tests => 135; use Wallet::Admin; use Wallet::Config; @@ -378,12 +378,7 @@ EOO # 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', 17 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', 17 unless $remctld; - eval { require Net::Remctl }; - skip 'Net::Remctl not available', 17 if $@; + skip 'no keytab configuration', 27 unless -f 't/data/test.keytab'; # Set up our configuration. $Wallet::Config::KEYTAB_FILE = 't/data/test.keytab'; @@ -406,41 +401,85 @@ SKIP: { 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. - remctld_spawn ($remctld, $principal, 't/data/test.keytab', - 't/data/keytab.conf'); - $ENV{KRB5CCNAME} = 'krb5cc_test'; - getcreds ('t/data/test.keytab', $principal); - $ENV{KRB5CCNAME} = 'krb5cc_good'; + # Finally we can test. First the MIT Kerberos tests. + SKIP: { + skip 'skipping MIT unchanging tests for Heimdal', 12 + if (lc ($Wallet::Config::KEYTAB_KRBTYPE) eq 'heimdal'); + + # We need remctld and Net::Remctl. + my @path = (split (':', $ENV{PATH}), '/usr/local/sbin', '/usr/sbin'); + my ($remctld) = grep { -x $_ } map { "$_/remctld" } @path; + skip 'remctld not found', 12 unless $remctld; + eval { require Net::Remctl }; + skip 'Net::Remctl not available', 12 if $@; + + # Now spawn our remctld server and get a ticket cache. + remctld_spawn ($remctld, $principal, 't/data/test.keytab', + 't/data/keytab.conf'); + $ENV{KRB5CCNAME} = 'krb5cc_test'; + getcreds ('t/data/test.keytab', $principal); + $ENV{KRB5CCNAME} = 'krb5cc_good'; + + # Do the unchanging tests for MIT Kerberos. + is ($one->get (@trace), undef, 'Get without configuration fails'); + is ($one->error, 'keytab unchanging support not configured', + ' with the right error'); + $Wallet::Config::KEYTAB_REMCTL_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 ($one->get (@trace), 'Keytab for wallet/one', + ' and we get the same thing the second time'); + is ($one->flag_clear ('unchanging', @trace), 1, + 'Clearing the unchanging flag works'); + my $data = $object->get (@trace); + ok (defined ($data), ' and getting the keytab works'); + ok (valid ($data, 'wallet/one'), ' and the keytab is valid'); + is ($two->get (@trace), undef, 'Get for wallet/two does not work'); + 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'); + remctld_stop; + } - # 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_REMCTL_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'); - remctld_stop; + # Now Heimdal. Since the keytab contains timestamps, before testing for + # equality we have to substitute out the timestamps. + SKIP: { + skip 'skipping Heimdal unchanging tests for MIT', 10 + if (lc ($Wallet::Config::KEYTAB_KRBTYPE) eq 'mit'); + my $data = $one->get (@trace); + ok (defined $data, 'Get of unchanging keytab works'); + ok (valid ($data, 'wallet/one'), ' and the keytab is valid'); + my $second = $one->get (@trace); + ok (defined $second, ' and second retrieval also works'); + $data =~ s/one.{8}/one\000\000\000\000\000\000\000\000/g; + $second =~ s/one.{8}/one\000\000\000\000\000\000\000\000/g; + is ($data, $second, ' and the keytab matches'); + is ($one->flag_clear ('unchanging', @trace), 1, + 'Clearing the unchanging flag works'); + $data = $one->get (@trace); + ok (defined ($data), ' and getting the keytab works'); + ok (valid ($data, 'wallet/one'), ' and the keytab is valid'); + $data =~ s/one.{8}/one\000\000\000\000\000\000\000\000/g; + ok ($data ne $second, ' and the new keytab is different'); + is ($one->destroy (@trace), 1, 'Destroying wallet/one works'); + is ($two->destroy (@trace), 1, ' as does destroying wallet/two'); + } # Check that history has been updated correctly. $history .= <<"EOO"; @@ -450,6 +489,12 @@ $date set flag unchanging by $user from $host $date get by $user from $host +$date get + by $user from $host +$date clear flag unchanging + by $user from $host +$date get + by $user from $host $date destroy by $user from $host EOO -- cgit v1.2.3 From a131c767d1eee7b98170962f7f9d4063be69e576 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Wed, 3 Mar 2010 22:37:18 -0800 Subject: Add auditing for names that violate the naming policy Add an audit command to wallet-report and one audit: objects name, which returns all objects that do not pass the local naming policy. The corresponding Wallet::Report method is audit(). Wallet::Config::verify_name may now be called with an undefined third argument (normally the user attempting to create an object). This calling convention is used when auditing, and the local policy function should select the correct policy to apply for useful audit results. --- NEWS | 10 ++++++++++ perl/Wallet/Config.pm | 11 ++++++++++- perl/Wallet/Report.pm | 54 ++++++++++++++++++++++++++++++++++++++++++++++++++- perl/t/report.t | 25 +++++++++++++++++++++++- server/wallet-report | 19 ++++++++++++++++++ tests/server/report-t | 32 +++++++++++++++++++++++------- 6 files changed, 141 insertions(+), 10 deletions(-) (limited to 'perl/Wallet/Config.pm') diff --git a/NEWS b/NEWS index e66d1b3..03fe99b 100644 --- a/NEWS +++ b/NEWS @@ -8,6 +8,16 @@ wallet 0.11 (unreleased) integrity. This also allows us to return a better error message naming an object that's still using that ACL. + Add an audit command to wallet-report and one audit: objects name, + which returns all objects that do not pass the local naming policy. + The corresponding Wallet::Report method is audit(). + + Wallet::Config::verify_name may now be called with an undefined third + argument (normally the user attempting to create an object). This + calling convention is used when auditing, and the local policy + function should select the correct policy to apply for useful audit + results. + Fix portability to older Kerberos libraries without krb5_free_error_message. diff --git a/perl/Wallet/Config.pm b/perl/Wallet/Config.pm index 396bf7d..2991361 100644 --- a/perl/Wallet/Config.pm +++ b/perl/Wallet/Config.pm @@ -14,7 +14,7 @@ use vars qw($PATH $VERSION); # This version should be increased on any code change to this module. Always # use two digits for the minor version with a leading zero if necessary so # that it will sort properly. -$VERSION = '0.04'; +$VERSION = '0.05'; # Path to the config file to load. $PATH = $ENV{WALLET_CONFIG} || '/etc/wallet/wallet.conf'; @@ -519,6 +519,15 @@ creation. If it returns undef or the empty string, object creation will be allowed. If it returns anything else, object creation is rejected and the return value is used as the error message. +This function is also called for naming audits done via Wallet::Report +to find any existing objects that violate a (possibly updated) naming +policy. In this case, the third argument (the identity of the person +creating the object) will be undef. As a general rule, if the third +argument is undef, the function should apply the most liberal accepted +naming policy so that the audit returns only objects that violate all +naming policies, but some sites may wish different results for their audit +reports. + Please note that this return status is backwards from what one would normally expect. A false value is success; a true value is failure with an error message. diff --git a/perl/Wallet/Report.pm b/perl/Wallet/Report.pm index 7cd8653..ff4fa8b 100644 --- a/perl/Wallet/Report.pm +++ b/perl/Wallet/Report.pm @@ -20,7 +20,7 @@ use Wallet::Database; # This version should be increased on any code change to this module. Always # use two digits for the minor version with a leading zero if necessary so # that it will sort properly. -$VERSION = '0.01'; +$VERSION = '0.02'; ############################################################################## # Constructor, destructor, and accessors @@ -290,6 +290,43 @@ sub owners { return @lines; } +############################################################################## +# Auditing +############################################################################## + +# Audit the database for violations of local policy. Returns a list of +# objects (as type and name pairs) or a list of ACLs. On error and for no +# matching entries, the empty list will be returned. To distinguish between +# an empty return and an error, call error(), which will return undef if there +# was no error. +sub audit { + my ($self, $type, $audit) = @_; + undef $self->{error}; + unless (defined ($type) and defined ($audit)) { + $self->error ("type and audit not specified"); + return; + } + if ($type eq 'objects') { + if ($audit eq 'name') { + return unless defined &Wallet::Config::verify_name; + my @objects = $self->objects; + my @results; + for my $object (@objects) { + my ($type, $name) = @$object; + my $error = Wallet::Config::verify_name ($type, $name); + push (@results, $object) if $error; + } + return @results; + } else { + $self->error ("unknown object audit: $audit"); + return; + } + } else { + $self->error ("unknown audit type: $type"); + return; + } +} + 1; __DATA__ @@ -312,6 +349,7 @@ ACL ACLs wildcard Allbery SQL tuples for my $object (@objects) { print "@$object\n"; } + @objects = $report->audit ('objects', 'name'); =head1 DESCRIPTION @@ -366,6 +404,20 @@ Returns the empty list on failure. An error can be distinguished from empty search results by calling error(). error() is guaranteed to return the error message if there was an error and undef if there was no error. +=item audit(TYPE, AUDIT) + +Audits the wallet database for violations of local policy. TYPE is the +general class of thing to audit, and AUDIT is the specific audit to +perform. Currently, the only implemented type is C and the only +audit is C. This returns a list of all objects, as references to +pairs of type and name, that are not accepted by the verify_name() +function defined in the wallet configuration. See L for +more information. + +Returns the empty list on failure. An error can be distinguished from +empty search results by calling error(). error() is guaranteed to return +the error message if there was an error and undef if there was no error. + =item error() Returns the error of the last failing operation or undef if no operations diff --git a/perl/t/report.t b/perl/t/report.t index a37681a..3b94d00 100755 --- a/perl/t/report.t +++ b/perl/t/report.t @@ -7,7 +7,7 @@ # # See LICENSE for licensing terms. -use Test::More tests => 83; +use Test::More tests => 88; use Wallet::Admin; use Wallet::Report; @@ -166,6 +166,29 @@ is ($server->flag_clear ('base', 'service/admin', 'unchanging'), 1, is (scalar (@lines), 0, ' and now there are no objects in the report'); is ($report->error, undef, ' with no error'); +# The naming audit returns nothing if there's no naming policy. +@lines = $report->audit ('objects', 'name'); +is (scalar (@lines), 0, 'Searching for naming violations finds none'); +is ($report->error, undef, ' with no error'); + +# Set a naming policy and then look for objects that fail that policy. We +# have to deactivate this policy until now so that it doesn't prevent the +# creation of that name originally, which is the reason for the variable +# reference. +our $naming_active = 1; +package Wallet::Config; +sub verify_name { + my ($type, $name) = @_; + return unless $naming_active; + return 'admin not allowed' if $name eq 'service/admin'; + return; +} +package main; +@lines = $report->audit ('objects', 'name'); +is (scalar (@lines), 1, 'Searching for naming violations finds one'); +is ($lines[0][0], 'base', ' and the first has the right type'); +is ($lines[0][1], 'service/admin', ' and the right name'); + # Clean up. $admin->destroy; unlink 'wallet-db'; diff --git a/server/wallet-report b/server/wallet-report index a6b3b8d..caa7e2c 100755 --- a/server/wallet-report +++ b/server/wallet-report @@ -35,6 +35,16 @@ sub command { for my $acl (sort { $$a[1] cmp $$b[1] } @acls) { print "$$acl[1] (ACL ID: $$acl[0])\n"; } + } elsif ($command eq 'audit') { + die "too many arguments to audit\n" if @args > 2; + die "too few arguments to audit\n" if @args < 2; + my @objects = $report->audit (@args); + if (!@objects and $report->error) { + die $report->error, "\n"; + } + for my $object (@objects) { + print join (' ', @$object), "\n"; + } } elsif ($command eq 'objects') { die "too many arguments to objects\n" if @args > 2; my @objects = $report->objects (@args); @@ -129,6 +139,15 @@ any identifier containing that string. =back +=item audit objects name + +Returns all objects that violate the current site naming policy. Objects +will be listed in the form: + + + +There will be one line per object. + =item objects =item objects acl diff --git a/tests/server/report-t b/tests/server/report-t index 285ee5a..61cfd9b 100755 --- a/tests/server/report-t +++ b/tests/server/report-t @@ -8,7 +8,7 @@ # See LICENSE for licensing terms. use strict; -use Test::More tests => 32; +use Test::More tests => 42; # Create a dummy class for Wallet::Report that prints what method was called # with its arguments and returns data for testing. @@ -38,6 +38,13 @@ sub acls { return ([ 1, 'ADMIN' ], [ 2, 'group/admins' ], [ 4, 'group/users' ]); } +sub audit { + shift; + print "audit @_\n"; + return if ($error or $empty); + return ([ file => 'unix-wallet-password' ]); +} + sub objects { shift; print "objects @_\n"; @@ -81,6 +88,7 @@ is ($out, "new\n", ' and nothing ran'); # Check too few and too many arguments for every command. my %commands = (acls => [0, 3], + audit => [2, 2], objects => [0, 2], owners => [2, 2]); for my $command (sort keys %commands) { @@ -110,6 +118,10 @@ is ($err, '', 'List succeeds for ACLs'); is ($out, "new\nacls entry foo foo\n" . "ADMIN (ACL ID: 1)\ngroup/admins (ACL ID: 2)\ngroup/users (ACL ID: 4)\n", ' and returns the right output'); +($out, $err) = run_report ('audit', 'objects', 'name'); +is ($err, '', 'Audit report succeeds'); +is ($out, "new\naudit objects name\nfile unix-wallet-password\n", + ' and returns the right output'); ($out, $err) = run_report ('objects'); is ($err, '', 'List succeeds for objects'); is ($out, "new\nobjects \n" @@ -128,24 +140,30 @@ is ($out, "new\nowners % %\nkrb5 admin\@EXAMPLE.COM\n", # Test error handling. $Wallet::Report::error = 1; ($out, $err) = run_report ('acls'); -is ($err, "some error\n", 'Error handling succeeds for list acls'); +is ($err, "some error\n", 'Error handling succeeds for acls'); is ($out, "new\nacls \n", ' and calls the right methods'); +($out, $err) = run_report ('audit', 'objects', 'name'); +is ($err, "some error\n", 'Error handling succeeds for audit'); +is ($out, "new\naudit objects name\n", ' and calls the right methods'); ($out, $err) = run_report ('objects'); -is ($err, "some error\n", 'Error handling succeeds for list objects'); +is ($err, "some error\n", 'Error handling succeeds for objects'); is ($out, "new\nobjects \n", ' and calls the right methods'); ($out, $err) = run_report ('owners', 'foo', 'bar'); -is ($err, "some error\n", 'Error handling succeeds for report owners'); +is ($err, "some error\n", 'Error handling succeeds for owners'); is ($out, "new\nowners foo bar\n", ' and calls the right methods'); # Test empty lists. $Wallet::Report::error = 0; $Wallet::Report::empty = 1; ($out, $err) = run_report ('acls'); -is ($err, '', 'list acls runs with an empty list and no errors'); +is ($err, '', 'acls runs with an empty list and no errors'); is ($out, "new\nacls \n", ' and calls the right methods'); +($out, $err) = run_report ('audit', 'objects', 'name'); +is ($err, '', 'audit runs with an empty list and no errors'); +is ($out, "new\naudit objects name\n", ' and calls the right methods'); ($out, $err) = run_report ('objects'); -is ($err, '', 'list objects runs with an empty list with no errors'); +is ($err, '', 'objects runs with an empty list with no errors'); is ($out, "new\nobjects \n", ' and calls the right methods'); ($out, $err) = run_report ('owners', 'foo', 'bar'); -is ($err, '', 'report owners runs with an empty list and no errors'); +is ($err, '', 'owners runs with an empty list and no errors'); is ($out, "new\nowners foo bar\n", ' and calls the right methods'); -- cgit v1.2.3 From acc73c988b845448230942de0f07263546763420 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Wed, 3 Mar 2010 22:44:53 -0800 Subject: Use L<> links instead of man page references for modules Do this only in the main text, not in the SEE ALSO section, since the latter is more for conventional man pages. This will produce better results for some POD to HTML converters (although not mine, yet). --- perl/Wallet/ACL/NetDB.pm | 4 ++-- perl/Wallet/Admin.pm | 4 ++-- perl/Wallet/Config.pm | 12 ++++++------ perl/Wallet/Database.pm | 4 ++-- perl/Wallet/Kadmin/Heimdal.pm | 4 ++-- perl/Wallet/Kadmin/MIT.pm | 4 ++-- perl/Wallet/Object/File.pm | 4 ++-- perl/Wallet/Object/Keytab.pm | 6 +++--- perl/Wallet/Report.pm | 4 ++-- perl/Wallet/Server.pm | 2 +- 10 files changed, 24 insertions(+), 24 deletions(-) (limited to 'perl/Wallet/Config.pm') diff --git a/perl/Wallet/ACL/NetDB.pm b/perl/Wallet/ACL/NetDB.pm index 2096ba8..0fb5a2c 100644 --- a/perl/Wallet/ACL/NetDB.pm +++ b/perl/Wallet/ACL/NetDB.pm @@ -23,7 +23,7 @@ use Wallet::Config; # This version should be increased on any code change to this module. Always # use two digits for the minor version with a leading zero if necessary so # that it will sort properly. -$VERSION = '0.04'; +$VERSION = '0.05'; ############################################################################## # Interface @@ -163,7 +163,7 @@ only if that principal has one of the roles user, admin, or team for that node. To use this object, several configuration parameters must be set. See -Wallet::Config(3) for details on those configuration parameters and +L for details on those configuration parameters and information about how to set wallet configuration. =head1 METHODS diff --git a/perl/Wallet/Admin.pm b/perl/Wallet/Admin.pm index e835713..f208e13 100644 --- a/perl/Wallet/Admin.pm +++ b/perl/Wallet/Admin.pm @@ -183,8 +183,8 @@ its actions. To use this object, several configuration variables must be set (at least the database configuration). For information on those variables and how -to set them, see Wallet::Config(3). For more information on the normal -user interface to the wallet server, see Wallet::Server(3). +to set them, see L. For more information on the normal +user interface to the wallet server, see L. =head1 CLASS METHODS diff --git a/perl/Wallet/Config.pm b/perl/Wallet/Config.pm index 2991361..c86fb80 100644 --- a/perl/Wallet/Config.pm +++ b/perl/Wallet/Config.pm @@ -90,7 +90,7 @@ Sets the Perl database driver to use for the wallet database. Common values would be C or C. Less common values would be C, C, or C. The appropriate DBD::* Perl module for the chosen driver must be installed and will be dynamically loaded by the -wallet. For more information, see DBI(3). +wallet. For more information, see L. This variable must be set. @@ -104,7 +104,7 @@ Sets the remaining contents for the DBI DSN (everything after the driver). Using this variable provides full control over the connect string passed to DBI. When using SQLite, set this variable to the path to the SQLite database. If this variable is set, DB_NAME, DB_HOST, and DB_PORT are -ignored. For more information, see DBI(3) and the documentation for the +ignored. For more information, see L and the documentation for the database driver you're using. Either DB_INFO or DB_NAME must be set. If you don't need to pass any @@ -119,7 +119,7 @@ our $DB_INFO; If DB_INFO is not set, specifies the database name. The third part of the DBI connect string will be set to C, possibly with a host and port appended if DB_HOST and DB_PORT are set. For more -information, see DBI(3) and the documentation for the database driver +information, see L and the documentation for the database driver you're using. Either DB_INFO or DB_NAME must be set. @@ -131,7 +131,7 @@ our $DB_NAME; =item DB_HOST If DB_INFO is not set, specifies the database host. C<;host=DB_HOST> will -be appended to the DBI connect string. For more information, see DBI(3) +be appended to the DBI connect string. For more information, see L and the documentation for the database driver you're using. =cut @@ -142,7 +142,7 @@ our $DB_HOST; If DB_PORT is not set, specifies the database port. C<;port=DB_PORT> will be appended to the DBI connect string. If this variable is set, DB_HOST -should also be set. For more information, see DBI(3) and the +should also be set. For more information, see L and the documentation for the database driver you're using. =cut @@ -179,7 +179,7 @@ C object type (the Wallet::Object::File class). =item FILE_BUCKET The directory into which to store file objects. File objects will be -stored in subdirectories of this directory. See Wallet::Object::File(3) +stored in subdirectories of this directory. See L for the full details of the naming scheme. This directory must be writable by the wallet server and the wallet server must be able to create subdirectories of it. diff --git a/perl/Wallet/Database.pm b/perl/Wallet/Database.pm index 7b3474a..7daab9f 100644 --- a/perl/Wallet/Database.pm +++ b/perl/Wallet/Database.pm @@ -39,7 +39,7 @@ use Wallet::Config; # This version should be increased on any code change to this module. Always # use two digits for the minor version with a leading zero if necessary so # that it will sort properly. -$VERSION = '0.02'; +$VERSION = '0.03'; ############################################################################## # Core overrides @@ -101,7 +101,7 @@ methods should work the same as in DBI and Wallet::Database objects should be usable exactly as if they were DBI objects. connect() will obtain the database connection information from the wallet -configuration; see Wallet::Config(3) for more details. It will also +configuration; see L for more details. It will also automatically set the RaiseError attribute to true and the PrintError and AutoCommit attributes to false, matching the assumptions made by the wallet database code. diff --git a/perl/Wallet/Kadmin/Heimdal.pm b/perl/Wallet/Kadmin/Heimdal.pm index d1eecda..658ac04 100644 --- a/perl/Wallet/Kadmin/Heimdal.pm +++ b/perl/Wallet/Kadmin/Heimdal.pm @@ -24,7 +24,7 @@ use Wallet::Kadmin (); # This version should be increased on any code change to this module. Always # use two digits for the minor version with a leading zero if necessary so # that it will sort properly. -$VERSION = '0.03'; +$VERSION = '0.04'; ############################################################################## # Utility functions @@ -254,7 +254,7 @@ Wallet::Kadmin::Heimdal - Wallet Kerberos administration API for Heimdal Wallet::Kadmin::Heimdal implements the Wallet::Kadmin API for Heimdal, providing an interface to create and delete principals and create keytabs. -It provides the API documented in Wallet::Kadmin(3) for a Heimdal KDC. +It provides the API documented in L for a Heimdal KDC. To use this class, several configuration parameters must be set. See L for details. diff --git a/perl/Wallet/Kadmin/MIT.pm b/perl/Wallet/Kadmin/MIT.pm index 434e93d..fc4d271 100644 --- a/perl/Wallet/Kadmin/MIT.pm +++ b/perl/Wallet/Kadmin/MIT.pm @@ -25,7 +25,7 @@ use Wallet::Kadmin (); # This version should be increased on any code change to this module. Always # use two digits for the minor version with a leading zero if necessary so # that it will sort properly. -$VERSION = '0.02'; +$VERSION = '0.03'; ############################################################################## # kadmin Interaction @@ -275,7 +275,7 @@ Wallet::Kadmin::MIT - Wallet Kerberos administration API for MIT Wallet::Kadmin::MIT implements the Wallet::Kadmin API for MIT Kerberos, providing an interface to create and delete principals and create keytabs. -It provides the API documented in Wallet::Kadmin(3) for an MIT Kerberos +It provides the API documented in L for an MIT Kerberos KDC. MIT Kerberos does not provide any method via the kadmin network protocol diff --git a/perl/Wallet/Object/File.pm b/perl/Wallet/Object/File.pm index c655b44..47c8ac2 100644 --- a/perl/Wallet/Object/File.pm +++ b/perl/Wallet/Object/File.pm @@ -24,7 +24,7 @@ use Wallet::Object::Base; # This version should be increased on any code change to this module. Always # use two digits for the minor version with a leading zero if necessary so # that it will sort properly. -$VERSION = '0.02'; +$VERSION = '0.03'; ############################################################################## # File naming @@ -159,7 +159,7 @@ it when the file object is deleted. A file object must be stored before it can be retrieved with get. To use this object, the configuration option specifying where on the -wallet server to store file objects must be set. See Wallet::Config(3) +wallet server to store file objects must be set. See L for details on this configuration parameter and information about how to set wallet configuration. diff --git a/perl/Wallet/Object/Keytab.pm b/perl/Wallet/Object/Keytab.pm index edb26b3..b7c2805 100644 --- a/perl/Wallet/Object/Keytab.pm +++ b/perl/Wallet/Object/Keytab.pm @@ -25,7 +25,7 @@ use Wallet::Kadmin; # This version should be increased on any code change to this module. Always # use two digits for the minor version with a leading zero if necessary so # that it will sort properly. -$VERSION = '0.08'; +$VERSION = '0.09'; ############################################################################## # Enctype restriction @@ -379,7 +379,7 @@ This implementation generates a new random key (and hence invalidates all existing keytabs) each time the keytab is retrieved with the get() method. To use this object, several configuration parameters must be set. See -Wallet::Config(3) for details on those configuration parameters and +L for details on those configuration parameters and information about how to set wallet configuration. =head1 METHODS @@ -456,7 +456,7 @@ configuration. If the principal already exists, create() still succeeds wallet). Otherwise, if the Kerberos principal could not be created, create() fails. The principal is created with the randomized keys. NAME must not contain the realm; instead, the KEYTAB_REALM configuration -variable should be set. See Wallet::Config(3) for more information. +variable should be set. See L for more information. If create() fails, it throws an exception. diff --git a/perl/Wallet/Report.pm b/perl/Wallet/Report.pm index ff4fa8b..462cd6f 100644 --- a/perl/Wallet/Report.pm +++ b/perl/Wallet/Report.pm @@ -360,8 +360,8 @@ tuples identifying objects, ACLs, or ACL entries. To use this object, several configuration variables must be set (at least the database configuration). For information on those variables and how -to set them, see Wallet::Config(3). For more information on the normal -user interface to the wallet server, see Wallet::Server(3). +to set them, see L. For more information on the normal +user interface to the wallet server, see L. =head1 CLASS METHODS diff --git a/perl/Wallet/Server.pm b/perl/Wallet/Server.pm index dd596c4..5f36c28 100644 --- a/perl/Wallet/Server.pm +++ b/perl/Wallet/Server.pm @@ -739,7 +739,7 @@ object. To use this object, several configuration variables must be set (at least the database configuration). For information on those variables and how -to set them, see Wallet::Config(3). +to set them, see L. =head1 CLASS METHODS -- cgit v1.2.3 From fd7f47ed7dccb3ee01ddaa7e24b8bd7bffb6a1c6 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Fri, 5 Mar 2010 17:25:50 -0800 Subject: Allow naming policy enforcement for ACL names Wallet::Config now supports an additional local function, verify_acl_name, which can be used to enforce ACL naming policies. If set, it is called for any ACL creation or rename and can reject the new ACL name. --- NEWS | 5 +++++ perl/Wallet/Config.pm | 41 ++++++++++++++++++++++++++++++++++++++--- perl/Wallet/Server.pm | 18 ++++++++++++++++-- perl/t/server.t | 24 ++++++++++++++++++++++-- 4 files changed, 81 insertions(+), 7 deletions(-) (limited to 'perl/Wallet/Config.pm') diff --git a/NEWS b/NEWS index e41b86e..1f63e07 100644 --- a/NEWS +++ b/NEWS @@ -8,6 +8,11 @@ wallet 0.11 (unreleased) integrity. This also allows us to return a better error message naming an object that's still using that ACL. + Wallet::Config now supports an additional local function, + verify_acl_name, which can be used to enforce ACL naming policies. If + set, it is called for any ACL creation or rename and can reject the + new ACL name. + Add an audit command to wallet-report and one audit: objects name, which returns all objects that do not pass the local naming policy. The corresponding Wallet::Report method is audit(). diff --git a/perl/Wallet/Config.pm b/perl/Wallet/Config.pm index c86fb80..e4014a1 100644 --- a/perl/Wallet/Config.pm +++ b/perl/Wallet/Config.pm @@ -513,8 +513,8 @@ By default, wallet permits administrators to create objects of any name (unless the object backend rejects the name). However, naming standards for objects can be enforced, even for administrators, by defining a Perl function in the configuration file named verify_name. If such a function -exists, it will be called for any object creation and given the type of -object, the object name, and the identity of the person doing the +exists, it will be called for any object creation and will be passed the +type of object, the object name, and the identity of the person doing the creation. If it returns undef or the empty string, object creation will be allowed. If it returns anything else, object creation is rejected and the return value is used as the error message. @@ -549,7 +549,42 @@ keytab objects for particular principals have fully-qualified hostnames: } Objects that aren't of type C or which aren't for a host-based key -have no naming requirements enforced. +have no naming requirements enforced by this example. + +=head1 ACL NAMING ENFORCEMENT + +Similar to object names, by default wallet permits administrators to +create ACLs with any name. However, naming standards for ACLs can be +enforced by defining a Perl function in the configuration file named +verify_acl_name. If such a function exists, it will be called for any ACL +creation or rename and will be passed given the new ACL name and the +identity of the person doing the creation. If it returns undef or the +empty string, object creation will be allowed. If it returns anything +else, object creation is rejected and the return value is used as the +error message. + +Please note that this return status is backwards from what one would +normally expect. A false value is success; a true value is failure with +an error message. + +For example, the following verify_acl_name function would ensure that any +ACLs created contain a slash and the part before the slash be one of +C, C, C, or C. + + sub verify_acl_name { + my ($name, $user) = @_; + return 'ACL names must contain a slash' unless $name =~ m,/,; + my ($first, $rest) = split ('/', $name, 2); + my %types = map { $_ => 1 } qw(host group user service); + unless ($types{$first}) { + return "unknown ACL type $first"; + } + return; + } + +Obvious improvements could be made, such as checking that the part after +the slash for a C ACL looked like a host name and the part after a +slash for a C ACL look like a user name. =head1 ENVIRONMENT diff --git a/perl/Wallet/Server.pm b/perl/Wallet/Server.pm index d525fe3..185bf23 100644 --- a/perl/Wallet/Server.pm +++ b/perl/Wallet/Server.pm @@ -23,7 +23,7 @@ use Wallet::Schema; # This version should be increased on any code change to this module. Always # use two digits for the minor version with a leading zero if necessary so # that it will sort properly. -$VERSION = '0.08'; +$VERSION = '0.09'; ############################################################################## # Utility methods @@ -536,9 +536,16 @@ sub acl_create { $self->error ("$self->{user} not authorized to create ACL"); return; } - my $dbh = $self->{dbh}; my $user = $self->{user}; my $host = $self->{host}; + if (defined (&Wallet::Config::verify_acl_name)) { + my $error = Wallet::Config::verify_acl_name ($name, $user); + if ($error) { + $self->error ("$name rejected: $error"); + return; + } + } + my $dbh = $self->{dbh}; my $acl = eval { Wallet::ACL->create ($name, $dbh, $user, $host) }; if ($@) { $self->error ($@); @@ -620,6 +627,13 @@ sub acl_rename { $self->error ('cannot rename the ADMIN ACL'); return; } + if (defined (&Wallet::Config::verify_acl_name)) { + my $error = Wallet::Config::verify_acl_name ($name, $self->{user}); + if ($error) { + $self->error ("$name rejected: $error"); + return; + } + } unless ($acl->rename ($name)) { $self->error ($acl->error); return; diff --git a/perl/t/server.t b/perl/t/server.t index 2a178e8..ed92d6e 100755 --- a/perl/t/server.t +++ b/perl/t/server.t @@ -3,11 +3,11 @@ # Tests for the wallet server API. # # Written by Russ Allbery -# Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2008, 2010 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. -use Test::More tests => 349; +use Test::More tests => 355; use POSIX qw(strftime); use Wallet::Admin; @@ -938,6 +938,26 @@ is ($server->owner ('base', 'service/acl-user', ''), 1, is ($server->acl_destroy ('test-destroy'), 1, ' now we can destroy the ACL'); is ($server->destroy ('base', 'service/acl-user'), 1, ' and the object'); +# Test ACL naming enforcement. Require that ACL names not contain a slash. +package Wallet::Config; +sub verify_acl_name { + my ($name, $user) = @_; + return 'ACL names may not contain slash' if $name =~ m,/,; + return; +} +package main; +is ($server->acl_create ('test/naming'), undef, + 'Creating an ACL with a disallowed name fails'); +is ($server->error, 'test/naming rejected: ACL names may not contain slash', + ' with the right error message'); +is ($server->acl_create ('test-naming'), 1, + 'Creating test-naming succeeds'); +is ($server->acl_rename ('test-naming', 'test/naming'), undef, + ' but renaming it fails'); +is ($server->error, 'test/naming rejected: ACL names may not contain slash', + ' with the right error message'); +is ($server->acl_destroy ('test-naming'), 1, 'Destroying it succeeds'); + # Clean up. $setup->destroy; unlink 'wallet-db'; -- cgit v1.2.3 From bc105004b8e88e1ede75dae0028d3ef10c15b57a Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Mon, 8 Mar 2010 10:19:03 -0800 Subject: Add an ACL name audit to wallet-report and Wallet::Report Parallel to objects name, add an acls name audit that returns all ACLs that do not follow the site naming standard. --- NEWS | 7 ++++--- perl/Wallet/Config.pm | 8 ++++++++ perl/Wallet/Report.pm | 33 ++++++++++++++++++++++++--------- perl/t/report.t | 17 ++++++++++++++++- server/wallet-report | 26 +++++++++++++++++++------- tests/server/report-t | 16 +++++++++++++--- 6 files changed, 84 insertions(+), 23 deletions(-) (limited to 'perl/Wallet/Config.pm') diff --git a/NEWS b/NEWS index 1f63e07..6744475 100644 --- a/NEWS +++ b/NEWS @@ -13,9 +13,10 @@ wallet 0.11 (unreleased) set, it is called for any ACL creation or rename and can reject the new ACL name. - Add an audit command to wallet-report and one audit: objects name, - which returns all objects that do not pass the local naming policy. - The corresponding Wallet::Report method is audit(). + Add an audit command to wallet-report and two audits: acls name, which + returns all ACLs that do not pass the local naming policy, and objects + name, which does the same for objects. The corresponding + Wallet::Report method is audit(). Add the acls unused report to wallet-report and Wallet::Report, returning all ACLs not referenced by any database objects. diff --git a/perl/Wallet/Config.pm b/perl/Wallet/Config.pm index e4014a1..23a051d 100644 --- a/perl/Wallet/Config.pm +++ b/perl/Wallet/Config.pm @@ -563,6 +563,14 @@ empty string, object creation will be allowed. If it returns anything else, object creation is rejected and the return value is used as the error message. +This function is also called for naming audits done via Wallet::Report to +find any existing objects that violate a (possibly updated) naming policy. +In this case, the second argument (the identity of the person creating the +ACL) will be undef. As a general rule, if the second argument is undef, +the function should apply the most liberal accepted naming policy so that +the audit returns only ACLs that violate all naming policies, but some +sites may wish different results for their audit reports. + Please note that this return status is backwards from what one would normally expect. A false value is success; a true value is failure with an error message. diff --git a/perl/Wallet/Report.pm b/perl/Wallet/Report.pm index f6e6753..c743060 100644 --- a/perl/Wallet/Report.pm +++ b/perl/Wallet/Report.pm @@ -310,10 +310,10 @@ sub owners { ############################################################################## # Audit the database for violations of local policy. Returns a list of -# objects (as type and name pairs) or a list of ACLs. On error and for no -# matching entries, the empty list will be returned. To distinguish between -# an empty return and an error, call error(), which will return undef if there -# was no error. +# objects (as type and name pairs) or a list of ACLs (as ID and name pairs). +# On error and for no matching entries, the empty list will be returned. To +# distinguish between an empty return and an error, call error(), which will +# return undef if there was no error. sub audit { my ($self, $type, $audit) = @_; undef $self->{error}; @@ -336,6 +336,20 @@ sub audit { $self->error ("unknown object audit: $audit"); return; } + } elsif ($type eq 'acls') { + if ($audit eq 'name') { + return unless defined &Wallet::Config::verify_acl_name; + my @acls = $self->acls; + my @results; + for my $acl (@acls) { + my $error = Wallet::Config::verify_acl_name ($acl->[1]); + push (@results, $acl) if $error; + } + return @results; + } else { + $self->error ("unknown acl audit: $audit"); + return; + } } else { $self->error ("unknown audit type: $type"); return; @@ -424,11 +438,12 @@ the error message if there was an error and undef if there was no error. Audits the wallet database for violations of local policy. TYPE is the general class of thing to audit, and AUDIT is the specific audit to -perform. Currently, the only implemented type is C and the only -audit is C. This returns a list of all objects, as references to -pairs of type and name, that are not accepted by the verify_name() -function defined in the wallet configuration. See L for -more information. +perform. TYPE may be either C or C. Currently, the only +implemented audit is C. This returns a list of all objects, as +references to pairs of type and name, or ACLs, as references to pairs of +ID and name, that are not accepted by the verify_name() or +verify_acl_name() function defined in the wallet configuration. See +L for more information. Returns the empty list on failure. An error can be distinguished from empty search results by calling error(). error() is guaranteed to return diff --git a/perl/t/report.t b/perl/t/report.t index b283576..1dc69f7 100755 --- a/perl/t/report.t +++ b/perl/t/report.t @@ -7,7 +7,7 @@ # # See LICENSE for licensing terms. -use Test::More tests => 148; +use Test::More tests => 151; use Wallet::Admin; use Wallet::Report; @@ -224,6 +224,21 @@ is (scalar (@lines), 1, 'Searching for naming violations finds one'); is ($lines[0][0], 'base', ' and the first has the right type'); is ($lines[0][1], 'service/admin', ' and the right name'); +# Set an ACL naming policy and then look for objects that fail that policy. +# Use the same deactivation trick as above. +package Wallet::Config; +sub verify_acl_name { + my ($name) = @_; + return unless $naming_active; + return 'second not allowed' if $name eq 'second'; + return; +} +package main; +@lines = $report->audit ('acls', 'name'); +is (scalar (@lines), 1, 'Searching for ACL naming violations finds one'); +is ($lines[0][0], 3, ' and the first has the right ID'); +is ($lines[0][1], 'second', ' and the right name'); + # Clean up. $admin->destroy; unlink 'wallet-db'; diff --git a/server/wallet-report b/server/wallet-report index 2b7cd45..435fb73 100755 --- a/server/wallet-report +++ b/server/wallet-report @@ -38,12 +38,16 @@ sub command { } elsif ($command eq 'audit') { die "too many arguments to audit\n" if @args > 2; die "too few arguments to audit\n" if @args < 2; - my @objects = $report->audit (@args); - if (!@objects and $report->error) { + my @result = $report->audit (@args); + if (!@result and $report->error) { die $report->error, "\n"; } - for my $object (@objects) { - print join (' ', @$object), "\n"; + for my $item (@result) { + if ($args[0] eq 'acls') { + print "$$item[1] (ACL ID: $$item[0])\n"; + } else { + print join (' ', @$item), "\n"; + } } } elsif ($command eq 'objects') { die "too many arguments to objects\n" if @args > 2; @@ -146,14 +150,22 @@ wallet database, either as an owner or on one of the more specific ACLs. =back +=item audit acls name + =item audit objects name -Returns all objects that violate the current site naming policy. Objects -will be listed in the form: +Returns all ACLs or objects that violate the current site naming policy. +Objects will be listed in the form: -There will be one line per object. +and ACLs in the form: + + (ACL ID: ) + +where is the human-readable name and is the numeric ID. The +numeric ID is what's used internally by the wallet system. There will be +one line per object or ACL. =item objects diff --git a/tests/server/report-t b/tests/server/report-t index 61cfd9b..394a869 100755 --- a/tests/server/report-t +++ b/tests/server/report-t @@ -8,7 +8,7 @@ # See LICENSE for licensing terms. use strict; -use Test::More tests => 42; +use Test::More tests => 44; # Create a dummy class for Wallet::Report that prints what method was called # with its arguments and returns data for testing. @@ -42,7 +42,13 @@ sub audit { shift; print "audit @_\n"; return if ($error or $empty); - return ([ file => 'unix-wallet-password' ]); + if ($_[0] eq 'objects') { + return ([ file => 'unix-wallet-password' ]); + } elsif ($_[0] eq 'acls') { + return ([ 2, 'group/admins' ]); + } else { + return; + } } sub objects { @@ -119,9 +125,13 @@ is ($out, "new\nacls entry foo foo\n" . "ADMIN (ACL ID: 1)\ngroup/admins (ACL ID: 2)\ngroup/users (ACL ID: 4)\n", ' and returns the right output'); ($out, $err) = run_report ('audit', 'objects', 'name'); -is ($err, '', 'Audit report succeeds'); +is ($err, '', 'Object audit report succeeds'); is ($out, "new\naudit objects name\nfile unix-wallet-password\n", ' and returns the right output'); +($out, $err) = run_report ('audit', 'acls', 'name'); +is ($err, '', 'ACL audit report succeeds'); +is ($out, "new\naudit acls name\ngroup/admins (ACL ID: 2)\n", + ' and returns the right output'); ($out, $err) = run_report ('objects'); is ($err, '', 'List succeeds for objects'); is ($out, "new\nobjects \n" -- cgit v1.2.3 From f1eab726c10be66e94f6984418babfa9d68993b0 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 3 Apr 2012 20:40:01 -0700 Subject: Add initial LDAP attribute ACL verifier A new ACL type, ldap-attr (Wallet::ACL::LDAP::Attribute), is now supported. This ACL type grants access if the LDAP entry corresponding to the principal contains the attribute name and value specified in the ACL. The Net::LDAP and Authen::SASL Perl modules are required to use this ACL type. New configuration settings are required as well; see Wallet::Config for more information. To enable this ACL type for an existing wallet database, use wallet-admin to register the new verifier. --- NEWS | 9 ++ README | 4 + TODO | 10 +- perl/Wallet/ACL/LDAP/Attribute.pm | 258 ++++++++++++++++++++++++++++++++++++++ perl/Wallet/Config.pm | 79 ++++++++++++ perl/Wallet/Schema.pm | 2 + perl/t/schema.t | 2 +- perl/t/verifier-ldap-attr.t | 66 ++++++++++ 8 files changed, 426 insertions(+), 4 deletions(-) create mode 100644 perl/Wallet/ACL/LDAP/Attribute.pm create mode 100755 perl/t/verifier-ldap-attr.t (limited to 'perl/Wallet/Config.pm') diff --git a/NEWS b/NEWS index 42fb3e7..d08cb14 100644 --- a/NEWS +++ b/NEWS @@ -6,6 +6,15 @@ wallet 1.0 (unreleased) database to the latest schema version. This command should be run when deploying any new version of the wallet server. + A new ACL type, ldap-attr (Wallet::ACL::LDAP::Attribute), is now + supported. This ACL type grants access if the LDAP entry + corresponding to the principal contains the attribute name and value + specified in the ACL. The Net::LDAP and Authen::SASL Perl modules are + required to use this ACL type. New configuration settings are + required as well; see Wallet::Config for more information. To enable + this ACL type for an existing wallet database, use wallet-admin to + register the new verifier. + Add a comment field to objects and corresponding commands to wallet-backend and wallet to set and retrieve it. The comment field can only be set by the owner or wallet administrators but can be seen diff --git a/README b/README index c981272..c440b8c 100644 --- a/README +++ b/README @@ -95,6 +95,10 @@ REQUIREMENTS binary that supports the -norandkey option to ktadd. This option is included in MIT Kerberos 1.7 and later. + To support the LDAP attribute ACL verifier, the Authen::SASL and + Net::LDAP Perl modules must be installed on the server. This verifier + only works with LDAP servers that support GSS-API binds. + To support the NetDB ACL verifier (only of interest at sites using NetDB to manage DNS), the Net::Remctl Perl module must be installed on the server. diff --git a/TODO b/TODO index b0b4652..b019903 100644 --- a/TODO +++ b/TODO @@ -63,8 +63,6 @@ ACLs: * Error messages from ACL operations should refer to the ACLs by name instead of by ID. - * Write the LDAP entitlement ACL verifier. - * Write the PTS ACL verifier. * Rename Wallet::ACL::* to Wallet::Verifier::*. Add Wallet::ACL as a @@ -81,7 +79,8 @@ ACLs: * A group-in-groups ACL schema. * Provide an API for verifiers to syntax-check the values before an ACL - is set and implement syntax checking for the Krb5 verifier. + is set and implement syntax checking for the krb5 and ldap-attr + verifiers. * Investigate how best to support client authentication using anonymous PKINIT for things like initial system keying. @@ -195,6 +194,11 @@ Code Style and Cleanup: Test Suite: + * The ldap-attr verifier test case is awful and completely specific to + people with admin access to the Stanford LDAP tree. Write a real test. + + * Rename the tests to use a subdirectory organization. + * Add POD coverage testing using Test::POD::Coverage for the server modules. diff --git a/perl/Wallet/ACL/LDAP/Attribute.pm b/perl/Wallet/ACL/LDAP/Attribute.pm new file mode 100644 index 0000000..7a54546 --- /dev/null +++ b/perl/Wallet/ACL/LDAP/Attribute.pm @@ -0,0 +1,258 @@ +# Wallet::ACL::LDAP::Attribute -- Wallet LDAP attribute ACL verifier. +# +# Written by Russ Allbery +# Copyright 2012 +# The Board of Trustees of the Leland Stanford Junior University +# +# See LICENSE for licensing terms. + +############################################################################## +# Modules and declarations +############################################################################## + +package Wallet::ACL::LDAP::Attribute; +require 5.006; + +use strict; +use vars qw(@ISA $VERSION); + +use Authen::SASL (); +use Net::LDAP qw(LDAP_COMPARE_TRUE); +use Wallet::ACL::Base; + +@ISA = qw(Wallet::ACL::Base); + +# This version should be increased on any code change to this module. Always +# use two digits for the minor version with a leading zero if necessary so +# that it will sort properly. +$VERSION = '0.01'; + +############################################################################## +# Interface +############################################################################## + +# Create a new persistant verifier. Load the Net::LDAP module and open a +# persistant LDAP server connection that we'll use for later calls. +sub new { + my $type = shift; + my $host = $Wallet::Config::LDAP_HOST; + my $base = $Wallet::Config::LDAP_BASE; + unless ($host and defined ($base) and $Wallet::Config::LDAP_CACHE) { + die "LDAP attribute ACL support not configured\n"; + } + + # Ensure the required Perl modules are available and bind to the directory + # server. Catch any errors with a try/catch block. + my $ldap; + eval { + local $ENV{KRB5CCNAME} = $Wallet::Config::LDAP_CACHE; + my $sasl = Authen::SASL->new (mechanism => 'GSSAPI'); + $ldap = Net::LDAP->new ($host, onerror => 'die'); + my $mesg = eval { $ldap->bind (undef, sasl => $sasl) }; + }; + if ($@) { + my $error = $@; + chomp $error; + 1 while ($error =~ s/ at \S+ line \d+\.?\z//); + die "LDAP attribute ACL support not available: $error\n"; + } + + # We successfully bound, so create our object and return it. + my $self = { ldap => $ldap }; + bless ($self, $type); + return $self; +} + +# Check whether a given principal has the required LDAP attribute. We first +# map the principal to a DN by doing a search for that principal (and bailing +# if we get more than one entry). Then, we do a compare to see if that DN has +# the desired attribute and value. +# +# If the ldap_map_principal sub is defined in Wallet::Config, call it on the +# principal first to map it to the value for which we'll search. +# +# The connection is configured to die on any error, so we do all the work in a +# try/catch block to report errors. +sub check { + my ($self, $principal, $acl) = @_; + undef $self->{error}; + unless ($principal) { + $self->error ('no principal specified'); + return; + } + my ($attr, $value); + if ($acl) { + ($attr, $value) = split ('=', $acl, 2); + } + unless (defined ($attr) and defined ($value)) { + $self->error ('malformed ldap-attr ACL'); + return; + } + my $ldap = $self->{ldap}; + + # Map the principal name to an attribute value for our search if we're + # doing a custom mapping. + if (defined &Wallet::Config::ldap_map_principal) { + eval { $principal = Wallet::Config::ldap_map_principal ($principal) }; + if ($@) { + $self->error ("mapping principal to LDAP failed: $@"); + return; + } + } + + # Now, map the user to a DN by doing a search. + my $entry; + eval { + my $fattr = $Wallet::Config::LDAP_FILTER_ATTR || 'krb5PrincipalName'; + my $filter = "($fattr=$principal)"; + my $base = $Wallet::Config::LDAP_BASE; + my @options = (base => $base, filter => $filter, attrs => [ 'dn' ]); + my $search = $ldap->search (@options); + if ($search->count == 1) { + $entry = $search->pop_entry; + } elsif ($search->count > 1) { + die $search->count . " LDAP entries found for $principal"; + } + }; + if ($@) { + $self->error ("cannot search for $principal in LDAP: $@"); + return; + } + return 0 unless $entry; + + # We have a user entry. We can now check whether that user has the + # desired attribute and value. + my $result; + eval { + my $mesg = $ldap->compare ($entry, attr => $attr, value => $value); + $result = $mesg->code; + }; + if ($@) { + $self->error ("cannot check LDAP attribute $attr for $principal: $@"); + return; + } + return ($result == LDAP_COMPARE_TRUE) ? 1 : 0; +} + +1; + +############################################################################## +# Documentation +############################################################################## + +=for stopwords +ACL Allbery + +=head1 NAME + +Wallet::ACL::LDAP::Attribute - Wallet ACL verifier for LDAP attribute compares + +=head1 SYNOPSIS + + my $verifier = Wallet::ACL::LDAP::Attribute->new; + my $status = $verifier->check ($principal, "$attr=$value"); + if (not defined $status) { + die "Something failed: ", $verifier->error, "\n"; + } elsif ($status) { + print "Access granted\n"; + } else { + print "Access denied\n"; + } + +=head1 DESCRIPTION + +Wallet::ACL::LDAP::Attribute checks whether the LDAP record for the entry +corresponding to a principal contains an attribute with a particular +value. It is used to verify ACL lines of type C. The value of +such an ACL is an attribute followed by an equal sign and a value, and the +ACL grants access to a given principal if and only if the LDAP entry for +that principal has that attribute set to that value. + +To use this object, several configuration parameters must be set. See +L for details on those configuration parameters and +information about how to set wallet configuration. + +=head1 METHODS + +=item new() + +Creates a new ACL verifier. Opens and binds the connection to the LDAP +server. + +=item check(PRINCIPAL, ACL) + +Returns true if PRINCIPAL is granted access according to ACL, false if +not, and undef on an error (see L<"DIAGNOSTICS"> below). ACL must be an +attribute name and a value, separated by an equal sign (with no +whitespace). PRINCIPAL will be granted access if its LDAP entry contains +that attribute with that value. + +=item error() + +Returns the error if check() returned undef. + +=back + +=head1 DIAGNOSTICS + +The new() method may fail with one of the following exceptions: + +=item LDAP attribute ACL support not available: %s + +Attempting to connect or bind to the LDAP server failed. + +=item LDAP attribute ACL support not configured + +The required configuration parameters were not set. See Wallet::Config(3) +for the required configuration parameters and how to set them. + +=back + +Verifying an LDAP attribute ACL may fail with the following errors +(returned by the error() method): + +=over 4 + +=item cannot check LDAP attribute %s for %s: %s + +The LDAP compare to check for the required attribute failed. The +attribute may have been misspelled, or there may be LDAP directory +permission issues. This error indicates that PRINCIPAL's entry was +located in LDAP, but the check failed during the compare to verify the +attribute value. + +=item cannot search for %s in LDAP: %s + +Searching for PRINCIPAL (possibly after ldap_map_principal() mapping) +failed. This is often due to LDAP directory permissions issues. This +indicates a failure during the mapping of PRINCIPAL to an LDAP DN. + +=item malformed ldap-attr ACL + +The ACL parameter to check() was malformed. Usually this means that +either the attribute or the value were empty or the required C<=> sign +separating them was missing. + +=item mapping principal to LDAP failed: %s + +There was an ldap_map_principal() function defined in the wallet +configuration, but calling it for the PRINCIPAL argument failed. + +=item no principal specified + +The PRINCIPAL parameter to check() was undefined or the empty string. + +=back + +=head1 SEE ALSO + +Wallet::ACL(3), Wallet::ACL::Base(3), Wallet::Config(3), wallet-backend(8) + +This module is part of the wallet system. The current version is +available from L. + +=head1 AUTHOR + +Russ Allbery + +=cut diff --git a/perl/Wallet/Config.pm b/perl/Wallet/Config.pm index 23a051d..3f53f74 100644 --- a/perl/Wallet/Config.pm +++ b/perl/Wallet/Config.pm @@ -378,6 +378,85 @@ our $KEYTAB_REMCTL_PORT; =back +=head1 LDAP ACL CONFIGURATION + +These configuration variables are only needed if you intend to use the +C ACL type (the Wallet::ACL::LDAP::Attribute class). They +specify the LDAP server and additional connection and data model +information required for the wallet to check for the existence of +attributes. + +=over 4 + +=item LDAP_HOST + +The LDAP server name to use to verify LDAP ACLs. This variable must be +set to use LDAP ACLs. + +=cut + +our $LDAP_HOST; + +=item LDAP_BASE + +The base DN under which to search for the entry corresponding to a +principal. Currently, the wallet always does a full subtree search under +this base DN. This variable must be set to use LDAP ACLs. + +=cut + +our $LDAP_BASE; + +=item LDAP_FILTER_ATTR + +The attribute used to find the entry corresponding to a principal. The +LDAP entry containing this attribute with a value equal to the principal +will be found and checked for the required attribute and value. If this +variable is not set, the default is C. + +=cut + +our $LDAP_FILTER_ATTR; + +=item LDAP_CACHE + +Specifies the Kerberos ticket cache to use when connecting to the LDAP +server. GSS-API authentication is always used; there is currently no +support for any other type of bind. The ticket cache must be for a +principal with access to verify the values of attributes that will be used +with this ACL type. This variable must be set to use LDAP ACLs. + +=cut + +our $LDAP_CACHE; + +=back + +Finally, depending on the structure of the LDAP directory being queried, +there may not be any attribute in the directory whose value exactly +matches the Kerberos principal. The attribute designated by +LDAP_FILTER_ATTR may instead hold a transformation of the principal name +(such as the principal with the local realm stripped off, or rewritten +into an LDAP DN form). If this is the case, define a Perl function named +ldap_map_attribute. This function will be called whenever an LDAP +attribute ACL is being verified. It will take one argument, the +principal, and is expected to return the value to search for in the LDAP +directory server. + +For example, if the principal name without the local realm is stored in +the C attribute in the directory, set LDAP_FILTER_ATTR to C and +then define ldap_map_attribute as follows: + + sub ldap_map_attribute { + my ($principal) = @_; + $principal =~ s/\@EXAMPLE\.COM$//; + return $principal; + } + +Note that this example only removes the local realm (here, EXAMPLE.COM). +Any principal from some other realm will be left fully qualified, and then +presumably will not be found in the directory. + =head1 NETDB ACL CONFIGURATION These configuration variables are only needed if you intend to use the diff --git a/perl/Wallet/Schema.pm b/perl/Wallet/Schema.pm index 7400776..5c6b9ca 100644 --- a/perl/Wallet/Schema.pm +++ b/perl/Wallet/Schema.pm @@ -276,6 +276,8 @@ Holds the supported ACL schemes and their corresponding Perl classes: values ('krb5', 'Wallet::ACL::Krb5'); insert into acl_schemes (as_name, as_class) values ('krb5-regex', 'Wallet::ACL::Krb5::Regex'); + insert into acl_schemes (as_name, as_class) + values ('ldap-attr', 'Wallet::ACL::LDAP::Attribute'); insert into acl_schemes (as_name, as_class) values ('netdb', 'Wallet::ACL::NetDB'); insert into acl_schemes (as_name, as_class) diff --git a/perl/t/schema.t b/perl/t/schema.t index ce8a62a..5dd90d1 100755 --- a/perl/t/schema.t +++ b/perl/t/schema.t @@ -23,7 +23,7 @@ ok (defined $schema, 'Wallet::Schema creation'); ok ($schema->isa ('Wallet::Schema'), ' and class verification'); my @sql = $schema->sql; ok (@sql > 0, 'sql() returns something'); -is (scalar (@sql), 31, ' and returns the right number of statements'); +is (scalar (@sql), 32, ' and returns the right number of statements'); # Connect to a database and test create. db_setup; diff --git a/perl/t/verifier-ldap-attr.t b/perl/t/verifier-ldap-attr.t new file mode 100755 index 0000000..1c84fac --- /dev/null +++ b/perl/t/verifier-ldap-attr.t @@ -0,0 +1,66 @@ +#!/usr/bin/perl -w +# +# Tests for the LDAP attribute ACL verifier. +# +# This test can only be run by someone local to Stanford with appropriate +# access to the LDAP server and will be skipped in all other environments. +# +# Written by Russ Allbery +# Copyright 2012 +# The Board of Trustees of the Leland Stanford Junior University +# +# See LICENSE for licensing terms. + +use Test::More tests => 10; + +use lib 't/lib'; +use Util; + +BEGIN { use_ok ('Wallet::ACL::LDAP::Attribute') }; + +my $host = 'ldap.stanford.edu'; +my $base = 'cn=people,dc=stanford,dc=edu'; +my $filter = 'uid'; +my $user = 'rra@stanford.edu'; +my $attr = 'suPrivilegeGroup'; +my $value = 'stanford:stanford'; + +# Remove the realm from principal names. +package Wallet::Config; +sub ldap_map_principal { + my ($principal) = @_; + $principal =~ s/\@.*//; + return $principal; +} +package main; + +# Determine the local principal. +my $klist = `klist 2>&1` || ''; +SKIP: { + skip "tests useful only with Stanford Kerberos tickets", 4 + unless ($klist =~ /[Pp]rincipal: \S+\@stanford\.edu$/m); + + # Set up our configuration. + $Wallet::Config::LDAP_HOST = $host; + $Wallet::Config::LDAP_CACHE = $ENV{KRB5CCNAME}; + $Wallet::Config::LDAP_BASE = $base; + $Wallet::Config::LDAP_FILTER_ATTR = $filter; + + # Finally, we can test. + my $verifier = eval { Wallet::ACL::LDAP::Attribute->new }; + isa_ok ($verifier, 'Wallet::ACL::LDAP::Attribute'); + is ($verifier->check ($user, "$attr=$value"), 1, + "Checking $attr=$value succeeds"); + is ($verifier->error, undef, '...with no error'); + is ($verifier->check ($user, "$attr=BOGUS"), 0, + "Checking $attr=BOGUS fails"); + is ($verifier->error, undef, '...with no error'); + is ($verifier->check ($user, "BOGUS=$value"), undef, + "Checking BOGUS=$value fails with error"); + is ($verifier->error, + 'cannot check LDAP attribute BOGUS for rra: Undefined attribute type', + '...with correct error'); + is ($verifier->check ('user-does-not-exist', "$attr=$value"), 0, + "Checking for nonexistent user fails"); + is ($verifier->error, undef, '...with no error'); +} -- cgit v1.2.3 From 41eb131dc6ae8c8f5aead797703fd12aaa59a9d9 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 7 Aug 2012 19:23:30 -0700 Subject: Initial implementation of WebAuth keyring objects This is very preliminary. There is no test suite yet, no documentation, and the test suite currently doesn't pass for other reasons. --- perl/Wallet/Config.pm | 61 ++++++++++ perl/Wallet/Object/WAKeyring.pm | 249 ++++++++++++++++++++++++++++++++++++++++ 2 files changed, 310 insertions(+) create mode 100644 perl/Wallet/Object/WAKeyring.pm (limited to 'perl/Wallet/Config.pm') diff --git a/perl/Wallet/Config.pm b/perl/Wallet/Config.pm index 3f53f74..1a74506 100644 --- a/perl/Wallet/Config.pm +++ b/perl/Wallet/Config.pm @@ -378,6 +378,67 @@ our $KEYTAB_REMCTL_PORT; =back +=head1 WEBAUTH KEYRING OBJECT CONFIGURATION + +These configuration variables only need to be set if you intend to use the +C object type (the Wallet::Object::WAKeyring class). + +=over 4 + +=item WAKEYRING_BUCKET + +The directory into which to store WebAuth keyring objects. WebAuth +keyring objects will be stored in subdirectories of this directory. See +L for the full details of the naming scheme. +This directory must be writable by the wallet server and the wallet server +must be able to create subdirectories of it. + +WAKEYRING_BUCKET must be set to use file objects. + +=cut + +our $WAKEYRING_BUCKET; + +=item WAKEYRING_REKEY_INTERVAL + +The interval, in seconds, at which new keys are generated in a keyring. +The object implementation will try to arrange for there to be keys added +to the keyring separated by this interval. + +It's useful to provide some interval to install the keyring everywhere +that it's used before the key becomes inactive. Every keyring will +therefore normally have at least three keys: one that's currently active, +one that becomes valid in the future but less than +WAKEYRING_REKEY_INTERVAL from now, and one that becomes valid between one +and two of those intervals into the future. This means that one has twice +this interval to distribute the keyring everywhere it is used. + +Internally, this is implemented by adding a new key that becomes valid in +twice this interval from the current time if the newest key becomes valid +at or less than this interval in the future. + +The default value is 60 * 60 * 24 (one day). + +=cut + +our $WAKEYRING_REKEY_INTERVAL = 60 * 60 * 24; + +=item WAKEYRING_PURGE_INTERVAL + +The interval, in seconds, from the key creation date after which keys are +removed from the keyring. This is used to clean up old keys and finish +key rotation. Keys won't be removed unless there are more than three keys +in the keyring to try to keep a misconfiguration from removing all valid +keys. + +The default value is 60 * 60 * 24 * 90 (90 days). + +=cut + +our $WAKEYRING_PURGE_INTERVAL = 60 * 60 * 24 * 90; + +=back + =head1 LDAP ACL CONFIGURATION These configuration variables are only needed if you intend to use the diff --git a/perl/Wallet/Object/WAKeyring.pm b/perl/Wallet/Object/WAKeyring.pm new file mode 100644 index 0000000..20d3047 --- /dev/null +++ b/perl/Wallet/Object/WAKeyring.pm @@ -0,0 +1,249 @@ +# Wallet::Object::WAKeyring -- WebAuth keyring object implementation. +# +# Written by Russ Allbery +# Copyright 2012 +# The Board of Trustees of the Leland Stanford Junior University +# +# See LICENSE for licensing terms. + +############################################################################## +# Modules and declarations +############################################################################## + +package Wallet::Object::WAKeyring; +require 5.006; + +use strict; +use vars qw(@ISA $VERSION); + +use Digest::MD5 qw(md5_hex); +use Fcntl qw(LOCK_EX); +use Wallet::Config (); +use Wallet::Object::Base; +use WebAuth qw(WA_KEY_AES WA_AES_128); + +@ISA = qw(Wallet::Object::Base); + +# This version should be increased on any code change to this module. Always +# use two digits for the minor version with a leading zero if necessary so +# that it will sort properly. +$VERSION = '0.01'; + +############################################################################## +# File naming +############################################################################## + +# Returns the path into which that keyring object will be stored or undef on +# error. On error, sets the internal error. +sub file_path { + my ($self) = @_; + my $name = $self->{name}; + unless ($Wallet::Config::WAKEYRING_BUCKET) { + $self->error ('WebAuth keyring support not configured'); + return; + } + unless ($name) { + $self->error ('WebAuth keyring objects may not have empty names'); + return; + } + my $hash = substr (md5_hex ($name), 0, 2); + $name =~ s/([^\w-])/sprintf ('%%%02X', ord ($1))/ge; + my $parent = "$Wallet::Config::WAKEYRING_BUCKET/$hash"; + unless (-d $parent || mkdir ($parent, 0700)) { + $self->error ("cannot create file bucket $hash: $!"); + return; + } + return "$Wallet::Config::WAKEYRING_BUCKET/$hash/$name"; +} + +############################################################################## +# Core methods +############################################################################## + +# Override destroy to delete the file as well. +sub destroy { + my ($self, $user, $host, $time) = @_; + my $id = $self->{type} . ':' . $self->{name}; + my $path = $self->file_path; + if (defined ($path) && -f $path && !unlink ($path)) { + $self->error ("cannot delete $id: $!"); + return; + } + return $self->SUPER::destroy ($user, $host, $time); +} + +# Update the keyring if needed, and then return the contents of the current +# keyring. +sub get { + my ($self, $user, $host, $time) = @_; + $time ||= time; + my $id = $self->{type} . ':' . $self->{name}; + if ($self->flag_check ('locked')) { + $self->error ("cannot get $id: object is locked"); + return; + } + my $path = $self->file_path; + + # Create a WebAuth context and ensure we can load the relevant modules. + my $wa = eval { WebAuth->new }; + if ($@) { + $self->error ("cannot initialize WebAuth: $@"); + return; + } + + # Check if the keyring already exists. If not, create a new one with a + # single key that's immediately valid and two more that will become valid + # in the future. + # + # If the keyring does already exist, get a lock on the file. At the end + # of this process, we'll do an atomic update and then drop our lock. + # + # FIXME: There are probably better ways to do this. There are some race + # conditions here, particularly with new keyrings. + unless (open (FILE, '+<', $path)) { + my $data; + eval { + my $key = $wa->key_create (WA_KEY_AES, WA_AES_128); + my $ring = $wa->keyring_new ($key); + $key = $wa->key_create (WA_KEY_AES, WA_AES_128); + my $valid = time + $Wallet::Config::WAKEYRING_REKEY_INTERVAL; + $ring->add (time, $valid, $key); + $key = $wa->key_create (WA_KEY_AES, WA_AES_128); + $valid += $Wallet::Config::WAKEYRING_REKEY_INTERVAL; + $ring->add (time, $valid, $key); + $data = $ring->encode; + $ring->write ($path); + }; + if ($@) { + $self->error ("cannot create new keyring"); + return; + }; + $self->log_action ('get', $user, $host, $time); + return $data; + } + unless (flock (FILE, LOCK_EX)) { + $self->error ("cannot get lock on keyring: $!"); + return; + } + + # Read the keyring. + my $ring = eval { WebAuth::Keyring->read ($path) }; + if ($@) { + $self->error ("cannot read keyring: $@"); + return; + } + + # If the most recent key has a valid-after older than now + + # WAKEYRING_REKEY_INTERVAL, we generate a new key with a valid_after of + # now + 2 * WAKEYRING_REKEY_INTERVAL. + my ($count, $newest) = (0, 0); + for my $entry ($ring->entries) { + $count++; + if ($entry->valid_after > $newest) { + $newest = $entry->valid_after; + } + } + eval { + if ($newest <= time + $Wallet::Config::WAKEYRING_REKEY_INTERVAL) { + my $valid = time + 2 * $Wallet::Config::WAKEYRING_REKEY_INTERVAL; + my $key = $wa->key_create (WA_KEY_AES, WA_AES_128); + $ring->add (time, $valid, $key); + } + }; + if ($@) { + $self->error ("cannot add new key: $@"); + return; + } + + # If there are any keys older than the purge interval, remove them, but + # only do so if we have more than three keys (the one that's currently + # active, the one that's going to come active in the rekey interval, and + # the one that's going to come active after that. + my $cutoff = time - $Wallet::Config::WAKEYRING_PURGE_INTERVAL; + my $i = 0; + my @purge; + if ($count > 3) { + for my $entry ($ring->entries) { + if ($entry->creation < $cutoff) { + push (@purge, $i); + } + $i++; + } + } + if (@purge) { + eval { + for my $key (reverse @purge) { + $ring->remove ($key); + } + }; + if ($@) { + $self->error ("cannot remove old keys: $@"); + return; + } + } + + # Encode the key. + my $data = eval { $ring->encode }; + if ($@) { + $self->error ("cannot encode keyring: $@"); + return; + } + + # Write the new keyring to the path. + eval { $ring->write ($path) }; + if ($@) { + $self->error ("cannot store new keyring: $@"); + return; + } + close FILE; + $self->log_action ('get', $user, $host, $time); + return $data; +} + +# Store the file on the wallet server. +sub store { + my ($self, $data, $user, $host, $time) = @_; + $time ||= time; + my $id = $self->{type} . ':' . $self->{name}; + if ($self->flag_check ('locked')) { + $self->error ("cannot store $id: object is locked"); + return; + } + if ($Wallet::Config::FILE_MAX_SIZE) { + my $max = $Wallet::Config::FILE_MAX_SIZE; + if (length ($data) > $max) { + $self->error ("data exceeds maximum of $max bytes"); + return; + } + } + my $path = $self->file_path; + return unless $path; + unless (open (FILE, '>', $path)) { + $self->error ("cannot store $id: $!"); + return; + } + unless (print FILE ($data) and close FILE) { + $self->error ("cannot store $id: $!"); + close FILE; + return; + } + $self->log_action ('store', $user, $host, $time); + return 1; +} + +1; +__END__ + +############################################################################## +# Documentation +############################################################################## + +=head1 NAME + +Wallet::Object::WAKeyring - WebAuth keyring object implementation for wallet + +=head1 DESCRIPTION + +To be written. + +=cut -- cgit v1.2.3 From fef66a4c6ca0c452ce9af641469c831e36399c19 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Thu, 30 Aug 2012 14:57:10 -0700 Subject: Fix POD stopwords and formatting Fix a formatting error in Wallet::ACL::LDAP::Attribute and add new stopwords required by the latest aspell. --- perl/Wallet/ACL.pm | 2 +- perl/Wallet/ACL/Base.pm | 2 +- perl/Wallet/ACL/Krb5.pm | 2 +- perl/Wallet/ACL/Krb5/Regex.pm | 2 +- perl/Wallet/ACL/LDAP/Attribute.pm | 6 +++++- perl/Wallet/ACL/NetDB.pm | 2 +- perl/Wallet/ACL/NetDB/Root.pm | 2 +- perl/Wallet/Admin.pm | 2 +- perl/Wallet/Config.pm | 2 +- perl/Wallet/Kadmin/Heimdal.pm | 2 +- perl/Wallet/Kadmin/MIT.pm | 1 + perl/Wallet/Object/Base.pm | 2 +- perl/Wallet/Object/Keytab.pm | 2 +- perl/Wallet/Schema.pm | 2 +- perl/Wallet/Server.pm | 2 +- 15 files changed, 19 insertions(+), 14 deletions(-) (limited to 'perl/Wallet/Config.pm') diff --git a/perl/Wallet/ACL.pm b/perl/Wallet/ACL.pm index 44a82b2..2a06442 100644 --- a/perl/Wallet/ACL.pm +++ b/perl/Wallet/ACL.pm @@ -442,7 +442,7 @@ __END__ Wallet::ACL - Implementation of ACLs in the wallet system =for stopwords -ACL DBH metadata HOSTNAME DATETIME timestamp Allbery +ACL DBH metadata HOSTNAME DATETIME timestamp Allbery verifier verifiers =head1 SYNOPSIS diff --git a/perl/Wallet/ACL/Base.pm b/perl/Wallet/ACL/Base.pm index 9a8a3cb..85eaefa 100644 --- a/perl/Wallet/ACL/Base.pm +++ b/perl/Wallet/ACL/Base.pm @@ -60,7 +60,7 @@ __END__ ############################################################################## =for stopwords -ACL Allbery +ACL Allbery verifier verifiers =head1 NAME diff --git a/perl/Wallet/ACL/Krb5.pm b/perl/Wallet/ACL/Krb5.pm index 496fcf0..12be141 100644 --- a/perl/Wallet/ACL/Krb5.pm +++ b/perl/Wallet/ACL/Krb5.pm @@ -51,7 +51,7 @@ __END__ ############################################################################## =for stopwords -ACL krb5 Allbery +ACL krb5 Allbery verifier =head1 NAME diff --git a/perl/Wallet/ACL/Krb5/Regex.pm b/perl/Wallet/ACL/Krb5/Regex.pm index 52f4bf5..8f9702e 100644 --- a/perl/Wallet/ACL/Krb5/Regex.pm +++ b/perl/Wallet/ACL/Krb5/Regex.pm @@ -56,7 +56,7 @@ __END__ ############################################################################## =for stopwords -ACL krb5-regex Durkacz Allbery +ACL krb5-regex Durkacz Allbery verifier =head1 NAME diff --git a/perl/Wallet/ACL/LDAP/Attribute.pm b/perl/Wallet/ACL/LDAP/Attribute.pm index 7a54546..802c710 100644 --- a/perl/Wallet/ACL/LDAP/Attribute.pm +++ b/perl/Wallet/ACL/LDAP/Attribute.pm @@ -141,7 +141,7 @@ sub check { ############################################################################## =for stopwords -ACL Allbery +ACL Allbery verifier LDAP PRINCIPAL's DN ldap-attr =head1 NAME @@ -174,6 +174,8 @@ information about how to set wallet configuration. =head1 METHODS +=over 4 + =item new() Creates a new ACL verifier. Opens and binds the connection to the LDAP @@ -197,6 +199,8 @@ Returns the error if check() returned undef. The new() method may fail with one of the following exceptions: +=over 4 + =item LDAP attribute ACL support not available: %s Attempting to connect or bind to the LDAP server failed. diff --git a/perl/Wallet/ACL/NetDB.pm b/perl/Wallet/ACL/NetDB.pm index 0fb5a2c..0aa8958 100644 --- a/perl/Wallet/ACL/NetDB.pm +++ b/perl/Wallet/ACL/NetDB.pm @@ -136,7 +136,7 @@ __END__ ############################################################################## =for stopwords -ACL NetDB remctl DNS DHCP Allbery netdb +ACL NetDB remctl DNS DHCP Allbery netdb verifier =head1 NAME diff --git a/perl/Wallet/ACL/NetDB/Root.pm b/perl/Wallet/ACL/NetDB/Root.pm index 3aeebda..c28bb1e 100644 --- a/perl/Wallet/ACL/NetDB/Root.pm +++ b/perl/Wallet/ACL/NetDB/Root.pm @@ -49,7 +49,7 @@ sub check { ############################################################################## =for stopwords -ACL NetDB DNS DHCP Allbery +ACL NetDB DNS DHCP Allbery verifier =head1 NAME diff --git a/perl/Wallet/Admin.pm b/perl/Wallet/Admin.pm index 8fb49af..a1aef83 100644 --- a/perl/Wallet/Admin.pm +++ b/perl/Wallet/Admin.pm @@ -178,7 +178,7 @@ __DATA__ Wallet::Admin - Wallet system administrative interface =for stopwords -ACL hostname Allbery +ACL hostname Allbery verifier =head1 SYNOPSIS diff --git a/perl/Wallet/Config.pm b/perl/Wallet/Config.pm index 1a74506..cd4e569 100644 --- a/perl/Wallet/Config.pm +++ b/perl/Wallet/Config.pm @@ -27,7 +27,7 @@ Wallet::Config - Configuration handling for the wallet server DBI DSN SQLite subdirectories KEYTAB keytab kadmind KDC add-ons kadmin DNS SRV kadmin keytabs remctl backend lowercased NETDB ACL NetDB unscoped usernames rekey hostnames Allbery wallet-backend keytab-backend Heimdal -rekeys +rekeys WebAuth WEBAUTH keyring LDAP DN GSS-API =head1 SYNOPSIS diff --git a/perl/Wallet/Kadmin/Heimdal.pm b/perl/Wallet/Kadmin/Heimdal.pm index 658ac04..6c91b1d 100644 --- a/perl/Wallet/Kadmin/Heimdal.pm +++ b/perl/Wallet/Kadmin/Heimdal.pm @@ -234,7 +234,7 @@ __END__ ############################################################################## =for stopwords -keytabs keytab kadmin KDC API Allbery Heimdal +keytabs keytab kadmin KDC API Allbery Heimdal unlinked =head1 NAME diff --git a/perl/Wallet/Kadmin/MIT.pm b/perl/Wallet/Kadmin/MIT.pm index fc4d271..c191bc9 100644 --- a/perl/Wallet/Kadmin/MIT.pm +++ b/perl/Wallet/Kadmin/MIT.pm @@ -256,6 +256,7 @@ __END__ =for stopwords rekeying rekeys remctl backend keytabs keytab kadmin KDC API Allbery +unlinked =head1 NAME diff --git a/perl/Wallet/Object/Base.pm b/perl/Wallet/Object/Base.pm index 556cb27..87506f4 100644 --- a/perl/Wallet/Object/Base.pm +++ b/perl/Wallet/Object/Base.pm @@ -695,7 +695,7 @@ Wallet::Object::Base - Generic parent class for wallet objects =for stopwords DBH HOSTNAME DATETIME ACL backend metadata timestamp Allbery wallet-backend -backend-specific +backend-specific subclasses =head1 SYNOPSIS diff --git a/perl/Wallet/Object/Keytab.pm b/perl/Wallet/Object/Keytab.pm index b7c2805..fd3001f 100644 --- a/perl/Wallet/Object/Keytab.pm +++ b/perl/Wallet/Object/Keytab.pm @@ -347,7 +347,7 @@ __END__ =for stopwords keytab API KDC keytabs HOSTNAME DATETIME enctypes enctype DBH metadata -unmanaged kadmin Allbery +unmanaged kadmin Allbery unlinked =head1 NAME diff --git a/perl/Wallet/Schema.pm b/perl/Wallet/Schema.pm index 5c6b9ca..9a7fe44 100644 --- a/perl/Wallet/Schema.pm +++ b/perl/Wallet/Schema.pm @@ -171,7 +171,7 @@ Wallet::Schema - Database schema for the wallet system =for stopwords SQL ACL API APIs enums Enums Keytab Backend keytab backend enctypes -enctype Allbery Metadata metadata +enctype Allbery Metadata metadata verifier =head1 SYNOPSIS diff --git a/perl/Wallet/Server.pm b/perl/Wallet/Server.pm index 7b3fb8f..b2bae2c 100644 --- a/perl/Wallet/Server.pm +++ b/perl/Wallet/Server.pm @@ -753,7 +753,7 @@ Wallet::Server - Wallet system server implementation =for stopwords keytabs metadata backend HOSTNAME ACL timestamp ACL's nul Allbery -backend-specific wallet-backend +backend-specific wallet-backend verifier =head1 SYNOPSIS -- cgit v1.2.3 From 34138105d0f78c6809ac7111bfed833344d85f7a Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 8 Jan 2013 13:27:27 -0800 Subject: Fix a mistake in the WebAuth keyring section of Wallet::Config A copy/paste error from the file object configuration. Change-Id: Ie3ee48ed7adcf3fa50a510f085e664c5b0c91300 Reviewed-on: https://gerrit.stanford.edu/712 Reviewed-by: Russ Allbery Tested-by: Russ Allbery --- perl/Wallet/Config.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'perl/Wallet/Config.pm') diff --git a/perl/Wallet/Config.pm b/perl/Wallet/Config.pm index cd4e569..71f6e0f 100644 --- a/perl/Wallet/Config.pm +++ b/perl/Wallet/Config.pm @@ -393,7 +393,7 @@ L for the full details of the naming scheme. This directory must be writable by the wallet server and the wallet server must be able to create subdirectories of it. -WAKEYRING_BUCKET must be set to use file objects. +WAKEYRING_BUCKET must be set to use WebAuth keyring objects. =cut -- cgit v1.2.3 From 593e9b1e100ace54d1d9da7eb16e60f4e37c34ff Mon Sep 17 00:00:00 2001 From: Jon Robertson Date: Sun, 2 Dec 2012 22:07:16 -0800 Subject: Moved the Perl wallet modules and tests to DBIx::Class Moved all the Perl code to use DBIx::Class for the database interface. This includes updating all database calls, how the schema is generated and maintained, and the tests in places where some output has changed. We also remove the schema.t test, as the tests for it are more covered in the admin.t tests now. Change-Id: Ie5083432d09a0d9fe364a61c31378b77aa7b3cb7 Reviewed-on: https://gerrit.stanford.edu/598 Reviewed-by: Russ Allbery Tested-by: Russ Allbery --- perl/Wallet/ACL.pm | 196 +++++++++-------- perl/Wallet/Admin.pm | 102 +++++++-- perl/Wallet/Config.pm | 10 + perl/Wallet/Database.pm | 27 +-- perl/Wallet/Object/Base.pm | 318 ++++++++++++++++------------ perl/Wallet/Object/Keytab.pm | 116 +++++----- perl/Wallet/Report.pm | 298 +++++++++++++++++--------- perl/Wallet/Schema.pm | 282 ++++++------------------ perl/Wallet/Schema/Result/Acl.pm | 99 +++++++++ perl/Wallet/Schema/Result/AclEntry.pm | 63 ++++++ perl/Wallet/Schema/Result/AclHistory.pm | 101 +++++++++ perl/Wallet/Schema/Result/AclScheme.pm | 73 +++++++ perl/Wallet/Schema/Result/Enctype.pm | 34 +++ perl/Wallet/Schema/Result/Flag.pm | 54 +++++ perl/Wallet/Schema/Result/KeytabEnctype.pm | 42 ++++ perl/Wallet/Schema/Result/KeytabSync.pm | 42 ++++ perl/Wallet/Schema/Result/Object.pm | 258 ++++++++++++++++++++++ perl/Wallet/Schema/Result/ObjectHistory.pm | 127 +++++++++++ perl/Wallet/Schema/Result/SyncTarget.pm | 40 ++++ perl/Wallet/Schema/Result/Type.pm | 64 ++++++ perl/Wallet/Server.pm | 19 +- perl/create-ddl | 93 ++++++++ perl/sql/Wallet-Schema-0.07-0.08-MySQL.sql | 7 + perl/sql/Wallet-Schema-0.07-0.08-SQLite.sql | 6 + perl/sql/Wallet-Schema-0.07-MySQL.sql | 211 ++++++++++++++++++ perl/sql/Wallet-Schema-0.07-SQLite.sql | 219 +++++++++++++++++++ perl/sql/Wallet-Schema-0.08-MySQL.sql | 193 +++++++++++++++++ perl/sql/Wallet-Schema-0.08-PostgreSQL.sql | 201 ++++++++++++++++++ perl/sql/Wallet-Schema-0.08-SQLite.sql | 201 ++++++++++++++++++ perl/t/admin.t | 21 +- perl/t/lib/Util.pm | 5 + perl/t/report.t | 2 +- perl/t/schema.t | 111 ---------- perl/t/server.t | 2 +- server/wallet-admin | 23 ++ 35 files changed, 2886 insertions(+), 774 deletions(-) create mode 100644 perl/Wallet/Schema/Result/Acl.pm create mode 100644 perl/Wallet/Schema/Result/AclEntry.pm create mode 100644 perl/Wallet/Schema/Result/AclHistory.pm create mode 100644 perl/Wallet/Schema/Result/AclScheme.pm create mode 100644 perl/Wallet/Schema/Result/Enctype.pm create mode 100644 perl/Wallet/Schema/Result/Flag.pm create mode 100644 perl/Wallet/Schema/Result/KeytabEnctype.pm create mode 100644 perl/Wallet/Schema/Result/KeytabSync.pm create mode 100644 perl/Wallet/Schema/Result/Object.pm create mode 100644 perl/Wallet/Schema/Result/ObjectHistory.pm create mode 100644 perl/Wallet/Schema/Result/SyncTarget.pm create mode 100644 perl/Wallet/Schema/Result/Type.pm create mode 100755 perl/create-ddl create mode 100644 perl/sql/Wallet-Schema-0.07-0.08-MySQL.sql create mode 100644 perl/sql/Wallet-Schema-0.07-0.08-SQLite.sql create mode 100644 perl/sql/Wallet-Schema-0.07-MySQL.sql create mode 100644 perl/sql/Wallet-Schema-0.07-SQLite.sql create mode 100644 perl/sql/Wallet-Schema-0.08-MySQL.sql create mode 100644 perl/sql/Wallet-Schema-0.08-PostgreSQL.sql create mode 100644 perl/sql/Wallet-Schema-0.08-SQLite.sql delete mode 100755 perl/t/schema.t (limited to 'perl/Wallet/Config.pm') diff --git a/perl/Wallet/ACL.pm b/perl/Wallet/ACL.pm index 2a06442..4f51c70 100644 --- a/perl/Wallet/ACL.pm +++ b/perl/Wallet/ACL.pm @@ -33,26 +33,24 @@ $VERSION = '0.07'; # doesn't exist, throws an exception. sub new { my ($class, $id, $dbh) = @_; - my ($sql, $data, $name); + my (%search, $data, $name); if ($id =~ /^\d+\z/) { - $sql = 'select ac_id, ac_name from acls where ac_id = ?'; + $search{ac_id} = $id; } else { - $sql = 'select ac_id, ac_name from acls where ac_name = ?'; + $search{ac_name} = $id; } eval { - ($data, $name) = $dbh->selectrow_array ($sql, undef, $id); - $dbh->commit; + $data = $dbh->resultset('Acl')->find (\%search); }; if ($@) { - $dbh->rollback; die "cannot search for ACL $id: $@\n"; } elsif (not defined $data) { die "ACL $id not found\n"; } my $self = { dbh => $dbh, - id => $data, - name => $name, + id => $data->ac_id, + name => $data->ac_name, }; bless ($self, $class); return $self; @@ -69,18 +67,27 @@ sub create { $time ||= time; my $id; eval { - my $sql = 'insert into acls (ac_name) values (?)'; - $dbh->do ($sql, undef, $name); - $id = $dbh->last_insert_id (undef, undef, 'acls', 'ac_id'); + my $guard = $dbh->txn_scope_guard; + + # Create the new record. + my %record = (ac_name => $name); + my $acl = $dbh->resultset('Acl')->create (\%record); + $id = $acl->ac_id; die "unable to retrieve new ACL ID" unless defined $id; + + # Add to the history table. my $date = strftime ('%Y-%m-%d %T', localtime $time); - $sql = "insert into acl_history (ah_acl, ah_action, ah_by, ah_from, - ah_on) values (?, 'create', ?, ?, ?)"; - $dbh->do ($sql, undef, $id, $user, $host, $date); - $dbh->commit; + %record = (ah_acl => $id, + ah_action => 'create', + ah_by => $user, + ah_from => $host, + ah_on => $date); + my $history = $dbh->resultset('AclHistory')->create (\%record); + die "unable to create new history entry" unless defined $history; + + $guard->commit; }; if ($@) { - $dbh->rollback; die "cannot create ACL $name: $@\n"; } my $self = { @@ -126,13 +133,13 @@ sub scheme_mapping { my ($self, $scheme) = @_; my $class; eval { - my $sql = 'select as_class from acl_schemes where as_name = ?'; - ($class) = $self->{dbh}->selectrow_array ($sql, undef, $scheme); - $self->{dbh}->commit; + my %search = (as_name => $scheme); + my $scheme_rec = $self->{dbh}->resultset('AclScheme') + ->find (\%search); + $class = $scheme_rec->as_class; }; if ($@) { $self->error ($@); - $self->{dbh}->rollback; return; } if (defined $class) { @@ -155,11 +162,14 @@ sub log_acl { unless ($action =~ /^(add|remove)\z/) { die "invalid history action $action"; } - my $date = strftime ('%Y-%m-%d %T', localtime $time); - my $sql = 'insert into acl_history (ah_acl, ah_action, ah_scheme, - ah_identifier, ah_by, ah_from, ah_on) values (?, ?, ?, ?, ?, ?, ?)'; - $self->{dbh}->do ($sql, undef, $self->{id}, $action, $scheme, $identifier, - $user, $host, $date); + my %record = (ah_acl => $self->{id}, + ah_action => $action, + ah_scheme => $scheme, + ah_identifier => $identifier, + ah_by => $user, + ah_from => $host, + ah_on => strftime ('%Y-%m-%d %T', localtime $time)); + $self->{dbh}->resultset('AclHistory')->create (\%record); } ############################################################################## @@ -176,13 +186,15 @@ sub rename { return; } eval { - my $sql = 'update acls set ac_name = ? where ac_id = ?'; - $self->{dbh}->do ($sql, undef, $name, $self->{id}); - $self->{dbh}->commit; + my $guard = $self->{dbh}->txn_scope_guard; + my %search = (ac_id => $self->{id}); + my $acls = $self->{dbh}->resultset('Acl')->find (\%search); + $acls->ac_name ($name); + $acls->update; + $guard->commit; }; if ($@) { $self->error ("cannot rename ACL $self->{id} to $name: $@"); - $self->{dbh}->rollback; return; } $self->{name} = $name; @@ -200,27 +212,44 @@ sub destroy { my ($self, $user, $host, $time) = @_; $time ||= time; eval { - my $sql = 'select ob_type, ob_name from objects where ob_owner = ? - or ob_acl_get = ? or ob_acl_store = ? or ob_acl_show = ? or - ob_acl_destroy = ? or ob_acl_flags = ?'; - my $sth = $self->{dbh}->prepare ($sql); - $sth->execute (($self->{id}) x 6); - my $entry = $sth->fetchrow_arrayref; - if (defined $entry) { - die "ACL in use by $entry->[0]:$entry->[1]"; + my $guard = $self->{dbh}->txn_scope_guard; + + # Make certain no one is using the ACL. + my @search = ({ ob_owner => $self->{id} }, + { ob_acl_get => $self->{id} }, + { ob_acl_store => $self->{id} }, + { ob_acl_show => $self->{id} }, + { ob_acl_destroy => $self->{id} }, + { ob_acl_flags => $self->{id} }); + my @entries = $self->{dbh}->resultset('Object')->search (\@search); + if (@entries) { + my ($entry) = @entries; + die "ACL in use by ".$entry->ob_type.":".$entry->ob_name; } - $sql = 'delete from acl_entries where ae_id = ?'; - $self->{dbh}->do ($sql, undef, $self->{id}); - $sql = 'delete from acls where ac_id = ?'; - $self->{dbh}->do ($sql, undef, $self->{id}); - $sql = "insert into acl_history (ah_acl, ah_action, ah_by, ah_from, - ah_on) values (?, 'destroy', ?, ?, ?)"; - $self->{dbh}->do ($sql, undef, $self->{id}, $user, $host, $time); - $self->{dbh}->commit; + + # Delete any entries (there may or may not be any). + my %search = (ae_id => $self->{id}); + @entries = $self->{dbh}->resultset('AclEntry')->search(\%search); + for my $entry (@entries) { + $entry->delete; + } + + # There should definitely be an ACL record to delete. + %search = (ac_id => $self->{id}); + my $entry = $self->{dbh}->resultset('Acl')->find(\%search); + $entry->delete if defined $entry; + + # Create new history line for the deletion. + my %record = (ah_acl => $self->{id}, + ah_action => 'destroy', + ah_by => $user, + ah_from => $host, + ah_on => $time); + $self->{dbh}->resultset('AclHistory')->create (\%record); + $guard->commit; }; if ($@) { $self->error ("cannot destroy ACL $self->{id}: $@"); - $self->{dbh}->rollback; return; } return 1; @@ -239,15 +268,16 @@ sub add { return; } eval { - my $sql = 'insert into acl_entries (ae_id, ae_scheme, ae_identifier) - values (?, ?, ?)'; - $self->{dbh}->do ($sql, undef, $self->{id}, $scheme, $identifier); + my $guard = $self->{dbh}->txn_scope_guard; + my %record = (ae_id => $self->{id}, + ae_scheme => $scheme, + ae_identifier => $identifier); + my $entry = $self->{dbh}->resultset('AclEntry')->create (\%record); $self->log_acl ('add', $scheme, $identifier, $user, $host, $time); - $self->{dbh}->commit; + $guard->commit; }; if ($@) { $self->error ("cannot add $scheme:$identifier to $self->{id}: $@"); - $self->{dbh}->rollback; return; } return 1; @@ -260,23 +290,21 @@ sub remove { my ($self, $scheme, $identifier, $user, $host, $time) = @_; $time ||= time; eval { - my $sql = 'select * from acl_entries where ae_id = ? and ae_scheme = ? - and ae_identifier = ?'; - my ($data) = $self->{dbh}->selectrow_array ($sql, undef, $self->{id}, - $scheme, $identifier); - unless (defined $data) { + my $guard = $self->{dbh}->txn_scope_guard; + my %search = (ae_id => $self->{id}, + ae_scheme => $scheme, + ae_identifier => $identifier); + my $entry = $self->{dbh}->resultset('AclEntry')->find (\%search); + unless (defined $entry) { die "entry not found in ACL\n"; } - $sql = 'delete from acl_entries where ae_id = ? and ae_scheme = ? - and ae_identifier = ?'; - $self->{dbh}->do ($sql, undef, $self->{id}, $scheme, $identifier); + $entry->delete; $self->log_acl ('remove', $scheme, $identifier, $user, $host, $time); - $self->{dbh}->commit; + $guard->commit; }; if ($@) { my $entry = "$scheme:$identifier"; $self->error ("cannot remove $entry from $self->{id}: $@"); - $self->{dbh}->rollback; return; } return 1; @@ -294,19 +322,17 @@ sub list { undef $self->{error}; my @entries; eval { - my $sql = 'select ae_scheme, ae_identifier from acl_entries where - ae_id = ?'; - my $sth = $self->{dbh}->prepare ($sql); - $sth->execute ($self->{id}); - my $entry; - while (defined ($entry = $sth->fetchrow_arrayref)) { - push (@entries, [ @$entry ]); + my $guard = $self->{dbh}->txn_scope_guard; + my %search = (ae_id => $self->{id}); + my @entry_recs = $self->{dbh}->resultset('AclEntry') + ->search (\%search); + for my $entry (@entry_recs) { + push (@entries, [ $entry->ae_scheme, $entry->ae_identifier ]); } - $self->{dbh}->commit; + $guard->commit; }; if ($@) { $self->error ("cannot retrieve ACL $self->{id}: $@"); - $self->{dbh}->rollback; return; } else { return @entries; @@ -338,25 +364,27 @@ sub history { my ($self) = @_; my $output = ''; eval { - my $sql = 'select ah_action, ah_scheme, ah_identifier, ah_by, ah_from, - ah_on from acl_history where ah_acl = ? order by ah_on'; - my $sth = $self->{dbh}->prepare ($sql); - $sth->execute ($self->{id}); - my @data; - while (@data = $sth->fetchrow_array) { - $output .= "$data[5] "; - if ($data[0] eq 'add' or $data[0] eq 'remove') { - $output .= "$data[0] $data[1] $data[2]"; + my $guard = $self->{dbh}->txn_scope_guard; + my %search = (ah_acl => $self->{id}); + my %options = (order_by => 'ah_on'); + my @data = $self->{dbh}->resultset('AclHistory')->search (\%search, + \%options); + for my $data (@data) { + $output .= sprintf ("%s %s ", $data->ah_on->ymd, + $data->ah_on->hms); + if ($data->ah_action eq 'add' || $data->ah_action eq 'remove') { + $output .= sprintf ("%s %s %s", $data->ah_action, + $data->ah_scheme, $data->ah_identifier); } else { - $output .= $data[0]; + $output .= $data->ah_action; } - $output .= "\n by $data[3] from $data[4]\n"; + $output .= sprintf ("\n by %s from %s\n", $data->ah_by, + $data->ah_from); } - $self->{dbh}->commit; + $guard->commit; }; if ($@) { $self->error ("cannot read history for $self->{id}: $@"); - $self->{dbh}->rollback; return; } return $output; @@ -487,7 +515,7 @@ references. =item new(ACL, DBH) Instantiate a new ACL object with the given ACL ID or name. Takes the -Wallet::Database object to use for retrieving metadata from the wallet +Wallet::Schema object to use for retrieving metadata from the wallet database. Returns a new ACL object if the ACL was found and throws an exception if it wasn't or on any other error. diff --git a/perl/Wallet/Admin.pm b/perl/Wallet/Admin.pm index a1aef83..511916d 100644 --- a/perl/Wallet/Admin.pm +++ b/perl/Wallet/Admin.pm @@ -1,7 +1,7 @@ # Wallet::Admin -- Wallet system administrative interface. # # Written by Russ Allbery -# Copyright 2008, 2009, 2010, 2011 +# Copyright 2008, 2009, 2010, 2011, 2012 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -17,13 +17,12 @@ use strict; use vars qw($VERSION); use Wallet::ACL; -use Wallet::Database; use Wallet::Schema; # This version should be increased on any code change to this module. Always # use two digits for the minor version with a leading zero if necessary so # that it will sort properly. -$VERSION = '0.06'; +$VERSION = '0.07'; ############################################################################## # Constructor, destructor, and accessors @@ -34,7 +33,7 @@ $VERSION = '0.06'; # Throw an exception if anything goes wrong. sub new { my ($class) = @_; - my $dbh = Wallet::Database->connect; + my $dbh = Wallet::Schema->connect; my $self = { dbh => $dbh }; bless ($self, $class); return $self; @@ -61,7 +60,7 @@ sub error { # Disconnect the database handle on object destruction to avoid warnings. sub DESTROY { my ($self) = @_; - $self->{dbh}->disconnect unless $self->{dbh}->{InactiveDestroy}; + $self->{dbh}->storage->dbh->disconnect; } ############################################################################## @@ -75,17 +74,49 @@ sub DESTROY { # true on success and false on failure, setting the object error. sub initialize { my ($self, $user) = @_; - my $schema = Wallet::Schema->new; - eval { $schema->create ($self->{dbh}) }; + + # Deploy the database schema from DDL files, if they exist. If not then + # we automatically get the database from the Schema modules. + $self->{dbh}->deploy ({}, $Wallet::Config::DB_DDL_DIRECTORY); if ($@) { $self->error ($@); return; } + $self->default_data; + + # Create a default admin ACL. my $acl = Wallet::ACL->create ('ADMIN', $self->{dbh}, $user, 'localhost'); unless ($acl->add ('krb5', $user, $user, 'localhost')) { $self->error ($acl->error); return; } + + return 1; +} + +# Load default data into various tables. We'd like to do this more directly +# in the schema definitions, but not yet seeing a good way to do that. +sub default_data { + my ($self) = @_; + + # acl_schemes default rows. + my ($r1) = $self->{dbh}->resultset('AclScheme')->populate ([ + [ qw/as_name as_class/ ], + [ 'krb5', 'Wallet::ACL::Krb5' ], + [ 'krb5-regex', 'Wallet::ACL::Krb5::Regex' ], + [ 'ldap-attr', 'Wallet::ACL::LDAP::Attribute' ], + [ 'netdb', 'Wallet::ACL::NetDB' ], + [ 'netdb-root', 'Wallet::ACL::NetDB::Root' ], + ]); + warn "default AclScheme not installed" unless defined $r1; + + # types default rows. + my @record = ([ qw/ty_name ty_class/ ], + [ 'file', 'Wallet::Object::File' ], + [ 'keytab', 'Wallet::Object::Keytab' ]); + ($r1) = $self->{dbh}->resultset('Type')->populate (\@record); + warn "default Type not installed" unless defined $r1; + return 1; } @@ -102,12 +133,31 @@ sub reinitialize { # false on failure. sub destroy { my ($self) = @_; - my $schema = Wallet::Schema->new; - eval { $schema->drop ($self->{dbh}) }; - if ($@) { - $self->error ($@); - return; + + # Get an actual DBI handle and use it to delete all tables. + my $real_dbh = $self->{dbh}->storage->dbh; + my @tables = qw/acls acl_entries acl_history acl_schemes enctypes + flags keytab_enctypes keytab_sync objects object_history + sync_targets types dbix_class_schema_versions/; + for my $table (@tables) { + my $sql = "DROP TABLE IF EXISTS $table"; + $real_dbh->do ($sql); } + + return 1; +} + +# Save a DDL of the database in every supported database server. Returns +# true on success and false on failure. +sub backup { + my ($self, $oldversion) = @_; + + my @dbs = qw/MySQL SQLite PostgreSQL/; + my $version = $Wallet::Schema::VERSION; + $self->{dbh}->create_ddl_dir (\@dbs, $version, + $Wallet::Config::DB_DDL_DIRECTORY, + $oldversion); + return 1; } @@ -115,12 +165,16 @@ sub destroy { # and false on failure. sub upgrade { my ($self) = @_; - my $schema = Wallet::Schema->new; - eval { $schema->upgrade ($self->{dbh}) }; + + if ($self->{dbh}->get_db_version) { + eval { $self->{dbh}->upgrade; }; + } if ($@) { $self->error ($@); + warn $@; return; } + return 1; } @@ -135,13 +189,14 @@ sub upgrade { sub register_object { my ($self, $type, $class) = @_; eval { - my $sql = 'insert into types (ty_name, ty_class) values (?, ?)'; - $self->{dbh}->do ($sql, undef, $type, $class); - $self->{dbh}->commit; + my $guard = $self->{dbh}->txn_scope_guard; + my %record = (ty_name => $type, + ty_class => $class); + $self->{dbh}->resultset('Type')->create (\%record); + $guard->commit; }; if ($@) { $self->error ("cannot register $class for $type: $@"); - $self->{dbh}->rollback; return; } return 1; @@ -154,13 +209,14 @@ sub register_object { sub register_verifier { my ($self, $scheme, $class) = @_; eval { - my $sql = 'insert into acl_schemes (as_name, as_class) values (?, ?)'; - $self->{dbh}->do ($sql, undef, $scheme, $class); - $self->{dbh}->commit; + my $guard = $self->{dbh}->txn_scope_guard; + my %record = (as_name => $scheme, + as_class => $class); + $self->{dbh}->resultset('AclScheme')->create (\%record); + $guard->commit; }; if ($@) { - $self->error ("cannot registery $class for $scheme: $@"); - $self->{dbh}->rollback; + $self->error ("cannot register $class for $scheme: $@"); return; } return 1; diff --git a/perl/Wallet/Config.pm b/perl/Wallet/Config.pm index 71f6e0f..98dae03 100644 --- a/perl/Wallet/Config.pm +++ b/perl/Wallet/Config.pm @@ -167,6 +167,16 @@ backends, particularly SQLite, do not need this. our $DB_PASSWORD; +=item DB_DDL_DIRECTORY + +Specifies the directory used to dump the database schema in formats for +each possible database server. This also includes diffs between schema +versions, for upgrades. + +=cut + +our $DB_DDL_DIRECTORY; + =back =head1 FILE OBJECT CONFIGURATION diff --git a/perl/Wallet/Database.pm b/perl/Wallet/Database.pm index 7daab9f..8df338a 100644 --- a/perl/Wallet/Database.pm +++ b/perl/Wallet/Database.pm @@ -1,12 +1,12 @@ # Wallet::Database -- Wallet system database connection management. # -# This module is a thin wrapper around DBI to handle determination of the -# database driver and configuration settings automatically on connect. The +# This module is a thin wrapper around DBIx::Class to handle determination +# of the database configuration settings automatically on connect. The # intention is that Wallet::Database objects can be treated in all respects -# like DBI objects in the rest of the code. +# like DBIx::Class objects in the rest of the code. # # Written by Russ Allbery -# Copyright 2008, 2010 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008-2012 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -14,32 +14,21 @@ # Modules and declarations ############################################################################## -# Set up the subclasses. This is required to avoid warnings under DBI 1.40 -# and later, even though we don't actually make use of any overridden -# statement handle or database handle methods. -package Wallet::Database::st; -use vars qw(@ISA); -@ISA = qw(DBI::st); - -package Wallet::Database::db; -use vars qw(@ISA); -@ISA = qw(DBI::db); - package Wallet::Database; require 5.006; use strict; use vars qw(@ISA $VERSION); -use DBI; +use Wallet::Schema; use Wallet::Config; -@ISA = qw(DBI); +@ISA = qw(Wallet::Schema); # This version should be increased on any code change to this module. Always # use two digits for the minor version with a leading zero if necessary so # that it will sort properly. -$VERSION = '0.03'; +$VERSION = '0.04'; ############################################################################## # Core overrides @@ -65,7 +54,7 @@ sub connect { } my $user = $Wallet::Config::DB_USER; my $pass = $Wallet::Config::DB_PASSWORD; - my %attrs = (PrintError => 0, RaiseError => 1, AutoCommit => 0); + my %attrs = (PrintError => 0, RaiseError => 1); my $dbh = eval { $class->SUPER::connect ($dsn, $user, $pass, \%attrs) }; if ($@) { die "cannot connect to database: $@\n"; diff --git a/perl/Wallet/Object/Base.pm b/perl/Wallet/Object/Base.pm index 87506f4..5bd89a7 100644 --- a/perl/Wallet/Object/Base.pm +++ b/perl/Wallet/Object/Base.pm @@ -24,7 +24,7 @@ use Wallet::ACL; # This version should be increased on any code change to this module. Always # use two digits for the minor version with a leading zero if necessary so # that it will sort properly. -$VERSION = '0.05'; +$VERSION = '0.06'; ############################################################################## # Constructors @@ -37,10 +37,11 @@ $VERSION = '0.05'; # probably be usable as-is by most object types. sub new { my ($class, $type, $name, $dbh) = @_; - my $sql = 'select ob_name from objects where ob_type = ? and ob_name = ?'; - my $data = $dbh->selectrow_array ($sql, undef, $type, $name); - $dbh->commit; - die "cannot find ${type}:${name}\n" unless ($data and $data eq $name); + my %search = (ob_type => $type, + ob_name => $name); + my $object = $dbh->resultset('Object')->find (\%search); + die "cannot find ${type}:${name}\n" + unless ($object and $object->ob_name eq $name); my $self = { dbh => $dbh, name => $name, @@ -59,18 +60,27 @@ sub create { $time ||= time; die "invalid object type\n" unless $type; die "invalid object name\n" unless $name; + my $guard = $dbh->txn_scope_guard; eval { - my $date = strftime ('%Y-%m-%d %T', localtime $time); - my $sql = 'insert into objects (ob_type, ob_name, ob_created_by, - ob_created_from, ob_created_on) values (?, ?, ?, ?, ?)'; - $dbh->do ($sql, undef, $type, $name, $user, $host, $date); - $sql = "insert into object_history (oh_type, oh_name, oh_action, - oh_by, oh_from, oh_on) values (?, ?, 'create', ?, ?, ?)"; - $dbh->do ($sql, undef, $type, $name, $user, $host, $date); - $dbh->commit; + my %record = (ob_type => $type, + ob_name => $name, + ob_created_by => $user, + ob_created_from => $host, + ob_created_on => strftime ('%Y-%m-%d %T', + localtime $time)); + $dbh->resultset('Object')->create (\%record); + + %record = (oh_type => $type, + oh_name => $name, + oh_action => 'create', + oh_by => $user, + oh_from => $host, + oh_on => strftime ('%Y-%m-%d %T', localtime $time)); + $dbh->resultset('ObjectHistory')->create (\%record); + + $guard->commit; }; if ($@) { - $dbh->rollback; die "cannot create object ${type}:${name}: $@\n"; } my $self = { @@ -126,30 +136,36 @@ sub log_action { # We have two traces to record, one in the object_history table and one in # the object record itself. Commit both changes as a transaction. We # assume that AutoCommit is turned off. + my $guard = $self->{dbh}->txn_scope_guard; eval { - my $date = strftime ('%Y-%m-%d %T', localtime $time); - my $sql = 'insert into object_history (oh_type, oh_name, oh_action, - oh_by, oh_from, oh_on) values (?, ?, ?, ?, ?, ?)'; - $self->{dbh}->do ($sql, undef, $self->{type}, $self->{name}, $action, - $user, $host, $date); + my %record = (oh_type => $self->{type}, + oh_name => $self->{name}, + oh_action => $action, + oh_by => $user, + oh_from => $host, + oh_on => strftime ('%Y-%m-%d %T', localtime $time)); + $self->{dbh}->resultset('ObjectHistory')->create (\%record); + + my %search = (ob_type => $self->{type}, + ob_name => $self->{name}); + my $object = $self->{dbh}->resultset('Object')->find (\%search); if ($action eq 'get') { - $sql = 'update objects set ob_downloaded_by = ?, - ob_downloaded_from = ?, ob_downloaded_on = ? where - ob_type = ? and ob_name = ?'; - $self->{dbh}->do ($sql, undef, $user, $host, $date, $self->{type}, - $self->{name}); + $object->ob_downloaded_by ($user); + $object->ob_downloaded_from ($host); + $object->ob_downloaded_on (strftime ('%Y-%m-%d %T', + localtime $time)); } elsif ($action eq 'store') { - $sql = 'update objects set ob_stored_by = ?, ob_stored_from = ?, - ob_stored_on = ? where ob_type = ? and ob_name = ?'; - $self->{dbh}->do ($sql, undef, $user, $host, $date, $self->{type}, - $self->{name}); + $object->ob_stored_by ($user); + $object->ob_stored_from ($host); + $object->ob_stored_on (strftime ('%Y-%m-%d %T', + localtime $time)); } - $self->{dbh}->commit; + $object->update; + $guard->commit; }; if ($@) { my $id = $self->{type} . ':' . $self->{name}; $self->error ("cannot update history for $id: $@"); - $self->{dbh}->rollback; return; } return 1; @@ -175,12 +191,18 @@ sub log_set { unless ($fields{$field}) { die "invalid history field $field"; } - my $date = strftime ('%Y-%m-%d %T', localtime $time); - my $sql = "insert into object_history (oh_type, oh_name, oh_action, - oh_field, oh_type_field, oh_old, oh_new, oh_by, oh_from, oh_on) - values (?, ?, 'set', ?, ?, ?, ?, ?, ?, ?)"; - $self->{dbh}->do ($sql, undef, $self->{type}, $self->{name}, $field, - $type_field, $old, $new, $user, $host, $date); + + my %record = (oh_type => $self->{type}, + oh_name => $self->{name}, + oh_action => 'set', + oh_field => $field, + oh_type_field => $type_field, + oh_old => $old, + oh_new => $new, + oh_by => $user, + oh_from => $host, + oh_on => strftime ('%Y-%m-%d %T', localtime $time)); + $self->{dbh}->resultset('ObjectHistory')->create (\%record); } ############################################################################## @@ -202,20 +224,21 @@ sub _set_internal { $self->error ("cannot modify ${type}:${name}: object is locked"); return; } + + my $guard = $self->{dbh}->txn_scope_guard; eval { - my $sql = "select ob_$attr from objects where ob_type = ? and - ob_name = ?"; - my $old = $self->{dbh}->selectrow_array ($sql, undef, $type, $name); - $sql = "update objects set ob_$attr = ? where ob_type = ? and - ob_name = ?"; - $self->{dbh}->do ($sql, undef, $value, $type, $name); + my %search = (ob_type => $type, + ob_name => $name); + my $object = $self->{dbh}->resultset('Object')->find (\%search); + my $old = $object->get_column ("ob_$attr"); + + $object->update ({ "ob_$attr" => $value }); $self->log_set ($attr, $old, $value, $user, $host, $time); - $self->{dbh}->commit; + $guard->commit; }; if ($@) { my $id = $self->{type} . ':' . $self->{name}; $self->error ("cannot set $attr on $id: $@"); - $self->{dbh}->rollback; return; } return 1; @@ -236,14 +259,13 @@ sub _get_internal { my $type = $self->{type}; my $value; eval { - my $sql = "select $attr from objects where ob_type = ? and - ob_name = ?"; - $value = $self->{dbh}->selectrow_array ($sql, undef, $type, $name); - $self->{dbh}->commit; + my %search = (ob_type => $type, + ob_name => $name); + my $object = $self->{dbh}->resultset('Object')->find (\%search); + $value = $object->get_column ($attr); }; if ($@) { $self->error ($@); - $self->{dbh}->rollback; return; } return $value; @@ -356,14 +378,18 @@ sub flag_check { my $dbh = $self->{dbh}; my $value; eval { - my $sql = 'select fl_flag from flags where fl_type = ? and fl_name = ? - and fl_flag = ?'; - $value = $dbh->selectrow_array ($sql, undef, $type, $name, $flag); - $dbh->commit; + my %search = (fl_type => $type, + fl_name => $name, + fl_flag => $flag); + my $flag = $dbh->resultset('Flag')->find (\%search); + if (not defined $flag) { + $value = 0; + } else { + $value = $flag->fl_flag; + } }; if ($@) { $self->error ("cannot check flag $flag for ${type}:${name}: $@"); - $dbh->rollback; return; } else { return ($value) ? 1 : 0; @@ -378,22 +404,21 @@ sub flag_clear { my $name = $self->{name}; my $type = $self->{type}; my $dbh = $self->{dbh}; + my $guard = $dbh->txn_scope_guard; eval { - my $sql = 'select * from flags where fl_type = ? and fl_name = ? and - fl_flag = ?'; - my ($data) = $dbh->selectrow_array ($sql, undef, $type, $name, $flag); - unless (defined $data) { + my %search = (fl_type => $type, + fl_name => $name, + fl_flag => $flag); + my $flag = $dbh->resultset('Flag')->find (\%search); + unless (defined $flag) { die "flag not set\n"; } - $sql = 'delete from flags where fl_type = ? and fl_name = ? and - fl_flag = ?'; - $dbh->do ($sql, undef, $type, $name, $flag); - $self->log_set ('flags', $flag, undef, $user, $host, $time); - $dbh->commit; + $flag->delete; + $self->log_set ('flags', $flag->fl_flag, undef, $user, $host, $time); + $guard->commit; }; if ($@) { $self->error ("cannot clear flag $flag on ${type}:${name}: $@"); - $dbh->rollback; return; } return 1; @@ -407,20 +432,18 @@ sub flag_list { undef $self->{error}; my @flags; eval { - my $sql = 'select fl_flag from flags where fl_type = ? and - fl_name = ? order by fl_flag'; - my $sth = $self->{dbh}->prepare ($sql); - $sth->execute ($self->{type}, $self->{name}); - my $flag; - while (defined ($flag = $sth->fetchrow_array)) { - push (@flags, $flag); + my %search = (fl_type => $self->{type}, + fl_name => $self->{name}); + my %attrs = (order_by => 'fl_flag'); + my @flags_rs = $self->{dbh}->resultset('Flag')->search (\%search, + \%attrs); + for my $flag (@flags_rs) { + push (@flags, $flag->fl_flag); } - $self->{dbh}->commit; }; if ($@) { my $id = $self->{type} . ':' . $self->{name}; $self->error ("cannot retrieve flags for $id: $@"); - $self->{dbh}->rollback; return; } else { return @flags; @@ -435,22 +458,21 @@ sub flag_set { my $name = $self->{name}; my $type = $self->{type}; my $dbh = $self->{dbh}; + my $guard = $dbh->txn_scope_guard; eval { - my $sql = 'select * from flags where fl_type = ? and fl_name = ? and - fl_flag = ?'; - my ($data) = $dbh->selectrow_array ($sql, undef, $type, $name, $flag); - if (defined $data) { + my %search = (fl_type => $type, + fl_name => $name, + fl_flag => $flag); + my $flag = $dbh->resultset('Flag')->find (\%search); + if (defined $flag) { die "flag already set\n"; } - $sql = 'insert into flags (fl_type, fl_name, fl_flag) - values (?, ?, ?)'; - $dbh->do ($sql, undef, $type, $name, $flag); - $self->log_set ('flags', undef, $flag, $user, $host, $time); - $dbh->commit; + $flag = $dbh->resultset('Flag')->create (\%search); + $self->log_set ('flags', undef, $flag->fl_flag, $user, $host, $time); + $guard->commit; }; if ($@) { $self->error ("cannot set flag $flag on ${type}:${name}: $@"); - $dbh->rollback; return; } return 1; @@ -466,11 +488,10 @@ sub format_acl_id { my ($self, $id) = @_; my $name = $id; - my $sql = 'select ac_name from acls where ac_id = ?'; - my $sth = $self->{dbh}->prepare ($sql); - $sth->execute ($id); - if (my @ref = $sth->fetchrow_array) { - $name = $ref[0] . " ($id)"; + my %search = (ac_id => $id); + my $acl_rs = $self->{dbh}->resultset('Acl')->find (\%search); + if (defined $acl_rs) { + $name = $acl_rs->ac_name . " ($id)"; } return $name; @@ -483,23 +504,29 @@ sub history { my ($self) = @_; my $output = ''; eval { - my $sql = 'select oh_action, oh_field, oh_type_field, oh_old, oh_new, - oh_by, oh_from, oh_on from object_history where oh_type = ? and - oh_name = ? order by oh_on'; - my $sth = $self->{dbh}->prepare ($sql); - $sth->execute ($self->{type}, $self->{name}); - my @data; - while (@data = $sth->fetchrow_array) { - $output .= "$data[7] "; - my ($old, $new) = @data[3..4]; - if ($data[0] eq 'set' and $data[1] eq 'flags') { - if (defined ($data[4])) { - $output .= "set flag $data[4]"; - } elsif (defined ($data[3])) { - $output .= "clear flag $data[3]"; + my %search = (oh_type => $self->{type}, + oh_name => $self->{name}); + my %attrs = (order_by => 'oh_on'); + my @history = $self->{dbh}->resultset('ObjectHistory') + ->search (\%search, \%attrs); + + for my $history_rs (@history) { + $output .= sprintf ("%s %s ", $history_rs->oh_on->ymd, + $history_rs->oh_on->hms); + + my $old = $history_rs->oh_old; + my $new = $history_rs->oh_new; + my $action = $history_rs->oh_action; + my $field = $history_rs->oh_field; + + if ($action eq 'set' and $field eq 'flags') { + if (defined ($new)) { + $output .= "set flag $new"; + } elsif (defined ($old)) { + $output .= "clear flag $old"; } - } elsif ($data[0] eq 'set' and $data[1] eq 'type_data') { - my $attr = $data[2]; + } elsif ($action eq 'set' and $field eq 'type_data') { + my $attr = $history_rs->oh_type_field; if (defined ($old) and defined ($new)) { $output .= "set attribute $attr to $new (was $old)"; } elsif (defined ($old)) { @@ -507,9 +534,8 @@ sub history { } elsif (defined ($new)) { $output .= "add $new to attribute $attr"; } - } elsif ($data[0] eq 'set' - and ($data[1] eq 'owner' or $data[1] =~ /^acl_/)) { - my $field = $data[1]; + } elsif ($action eq 'set' + and ($field eq 'owner' or $field =~ /^acl_/)) { $old = $self->format_acl_id ($old) if defined ($old); $new = $self->format_acl_id ($new) if defined ($new); if (defined ($old) and defined ($new)) { @@ -519,8 +545,7 @@ sub history { } elsif (defined ($old)) { $output .= "unset $field (was $old)"; } - } elsif ($data[0] eq 'set') { - my $field = $data[1]; + } elsif ($action eq 'set') { if (defined ($old) and defined ($new)) { $output .= "set $field to $new (was $old)"; } elsif (defined ($new)) { @@ -529,16 +554,15 @@ sub history { $output .= "unset $field (was $old)"; } } else { - $output .= $data[0]; + $output .= $action; } - $output .= "\n by $data[5] from $data[6]\n"; + $output .= sprintf ("\n by %s from %s\n", $history_rs->oh_by, + $history_rs->oh_from); } - $self->{dbh}->commit; }; if ($@) { my $id = $self->{type} . ':' . $self->{name}; $self->error ("cannot read history for $id: $@"); - $self->{dbh}->rollback; return; } return $output; @@ -592,15 +616,14 @@ sub show { [ ob_downloaded_on => 'Downloaded on' ]); my $fields = join (', ', map { $_->[0] } @attrs); my @data; + my $object_rs; eval { - my $sql = "select $fields from objects where ob_type = ? and - ob_name = ?"; - @data = $self->{dbh}->selectrow_array ($sql, undef, $type, $name); - $self->{dbh}->commit; + my %search = (ob_type => $type, + ob_name => $name); + $object_rs = $self->{dbh}->resultset('Object')->find (\%search); }; if ($@) { $self->error ("cannot retrieve data for ${type}:${name}: $@"); - $self->{dbh}->rollback; return; } my $output = ''; @@ -609,15 +632,18 @@ sub show { # Format the results. We use a hack to insert the flags before the first # trace field since they're not a field in the object in their own right. # The comment should be word-wrapped at 80 columns. - for my $i (0 .. $#data) { - next unless defined $data[$i]; - if ($attrs[$i][0] eq 'ob_comment' && length ($data[$i]) > 79 - 17) { + for my $i (0 .. $#attrs) { + my $field = $attrs[$i][0]; + my $fieldtext = $attrs[$i][1]; + next unless my $value = $object_rs->get_column ($field); + + if ($field eq 'ob_comment' && length ($value) > 79 - 17) { local $Text::Wrap::columns = 80; local $Text::Wrap::unexpand = 0; - $data[$i] = wrap (' ' x 17, ' ' x 17, $data[$i]); - $data[$i] =~ s/^ {17}//; + $value = wrap (' ' x 17, ' ' x 17, $value); + $value =~ s/^ {17}//; } - if ($attrs[$i][0] eq 'ob_created_by') { + if ($field eq 'ob_created_by') { my @flags = $self->flag_list; if (not @flags and $self->error) { return; @@ -631,15 +657,14 @@ sub show { } $output .= $attr_output; } - next unless defined $data[$i]; - if ($attrs[$i][0] =~ /^ob_(owner|acl_)/) { - my $acl = eval { Wallet::ACL->new ($data[$i], $self->{dbh}) }; + if ($field =~ /^ob_(owner|acl_)/) { + my $acl = eval { Wallet::ACL->new ($value, $self->{dbh}) }; if ($acl and not $@) { - $data[$i] = $acl->name || $data[$i]; - push (@acls, [ $acl, $data[$i] ]); + $value = $acl->name || $value; + push (@acls, [ $acl, $value ]); } } - $output .= sprintf ("%15s: %s\n", $attrs[$i][1], $data[$i]); + $output .= sprintf ("%15s: %s\n", $fieldtext, $value); } if (@acls) { my %seen; @@ -663,20 +688,31 @@ sub destroy { $self->error ("cannot destroy ${type}:${name}: object is locked"); return; } + my $guard = $self->{dbh}->txn_scope_guard; eval { - my $date = strftime ('%Y-%m-%d %T', localtime $time); - my $sql = 'delete from flags where fl_type = ? and fl_name = ?'; - $self->{dbh}->do ($sql, undef, $type, $name); - $sql = 'delete from objects where ob_type = ? and ob_name = ?'; - $self->{dbh}->do ($sql, undef, $type, $name); - $sql = "insert into object_history (oh_type, oh_name, oh_action, - oh_by, oh_from, oh_on) values (?, ?, 'destroy', ?, ?, ?)"; - $self->{dbh}->do ($sql, undef, $type, $name, $user, $host, $date); - $self->{dbh}->commit; + + # Remove any flags that may exist for the record. + my %search = (fl_type => $type, + fl_name => $name); + $self->{dbh}->resultset('Flag')->search (\%search)->delete; + + # Remove any object records + %search = (ob_type => $type, + ob_name => $name); + $self->{dbh}->resultset('Object')->search (\%search)->delete; + + # And create a new history object for the destroy action. + my %record = (oh_type => $type, + oh_name => $name, + oh_action => 'destroy', + oh_by => $user, + oh_from => $host, + oh_on => strftime ('%Y-%m-%d %T', localtime $time)); + $self->{dbh}->resultset('ObjectHistory')->create (\%record); + $guard->commit; }; if ($@) { $self->error ("cannot destroy ${type}:${name}: $@"); - $self->{dbh}->rollback; return; } return 1; @@ -733,7 +769,7 @@ such object exits, throws an exception. Otherwise, returns an object blessed into the class used for the new() call (so subclasses can leave this method alone and not override it). -Takes a Wallet::Database object, which is stored in the object and used +Takes a Wallet::Schema object, which is stored in the object and used for any further operations. =item create(TYPE, NAME, DBH, PRINCIPAL, HOSTNAME [, DATETIME]) diff --git a/perl/Wallet/Object/Keytab.pm b/perl/Wallet/Object/Keytab.pm index fd3001f..083dae6 100644 --- a/perl/Wallet/Object/Keytab.pm +++ b/perl/Wallet/Object/Keytab.pm @@ -40,21 +40,29 @@ sub enctypes_set { my @trace = ($user, $host, $time); my $name = $self->{name}; my %enctypes = map { $_ => 1 } @$enctypes; + my $guard = $self->{dbh}->txn_scope_guard; 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); + + # Find all enctypes for the given keytab. + my %search = (ke_name => $name); + my @enctypes = $self->{dbh}->resultset('KeytabEnctype') + ->search (\%search); + my (@current); + for my $enctype_rs (@enctypes) { + push (@current, $enctype_rs->ke_enctype); } + + # Use the existing enctypes and the enctypes we should have to match + # against ones that need to be removed, and note those that already + # exist. 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); + %search = (ke_name => $name, + ke_enctype => $enctype); + $self->{dbh}->resultset('KeytabEnctype')->find (\%search) + ->delete; $self->log_set ('type_data enctypes', $enctype, undef, @trace); } } @@ -64,21 +72,20 @@ sub enctypes_set { # doesn't enforce integrity constraints. We do this in sorted order # to make it easier to test. for my $enctype (sort keys %enctypes) { - $sql = 'select en_name from enctypes where en_name = ?'; - my $status = $self->{dbh}->selectrow_array ($sql, undef, $enctype); - unless ($status) { + my %search = (en_name => $enctype); + my $enctype_rs = $self->{dbh}->('Enctype')->find (\%search); + unless (defined $enctype_rs) { die "unknown encryption type $enctype\n"; } - $sql = 'insert into keytab_enctypes (ke_name, ke_enctype) values - (?, ?)'; - $self->{dbh}->do ($sql, undef, $name, $enctype); + my %record = (ke_name => $name, + ke_enctype => $enctype); + $self->{dbh}->resultset('Enctype')->create (\%record); $self->log_set ('type_data enctypes', undef, $enctype, @trace); } - $self->{dbh}->commit; + $guard->commit; }; if ($@) { $self->error ($@); - $self->{dbh}->rollback; return; } return 1; @@ -92,19 +99,16 @@ 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); + my %search = (ke_name => $self->{name}); + my %attrs = (order_by => 'ke_enctype'); + my @enctypes_rs = $self->{dbh}->resultset('KeytabEnctype') + ->search (\%search, \%attrs); + for my $enctype_rs (@enctypes_rs) { + push (@enctypes, $enctype_rs->ke_enctype); } - $self->{dbh}->commit; }; if ($@) { $self->error ($@); - $self->{dbh}->rollback; return; } return @enctypes; @@ -132,21 +136,21 @@ sub sync_set { $self->error ("unsupported synchronization target $target"); return; } else { + my $guard = $self->{dbh}->txn_scope_guard; eval { - my $sql = 'select ks_target from keytab_sync where ks_name = ?'; - my $dbh = $self->{dbh}; my $name = $self->{name}; - my ($result) = $dbh->selectrow_array ($sql, undef, $name); - if ($result) { - my $sql = 'delete from keytab_sync where ks_name = ?'; - $self->{dbh}->do ($sql, undef, $name); - $self->log_set ('type_data sync', $result, undef, @trace); + my %search = (ks_name => $name); + my $sync_rs = $self->dbh->resultset('KeytabSync') + ->search (\%search); + if (defined $sync_rs) { + my $target = $sync_rs->ks_target; + $sync_rs->delete; + $self->log_set ('type_data sync', $target, undef, @trace); } - $self->{dbh}->commit; + $guard->commit; }; if ($@) { $self->error ($@); - $self->{dbh}->rollback; return; } } @@ -161,19 +165,16 @@ sub sync_list { my ($self) = @_; 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); + my %search = (ks_name => $self->{name}); + my %attrs = (order_by => 'ks_target'); + my @syncs = $self->dbh->resultset('KeytabSync')->search (\%search, + \%attrs); + for my $sync_rs (@syncs) { + push (@targets, $sync_rs->ks_target); } - $self->{dbh}->commit; }; if ($@) { $self->error ($@); - $self->{dbh}->rollback; return; } return @targets; @@ -247,11 +248,6 @@ sub new { my $kadmin = Wallet::Kadmin->new (); $self->{kadmin} = $kadmin; - # Set a callback for things to do after a fork, specifically for the MIT - # kadmin module which forks to kadmin. - my $callback = sub { $self->{dbh}->{InactiveDestroy} = 1 }; - $kadmin->fork_callback ($callback); - $self = $class->SUPER::new ($type, $name, $dbh); $self->{kadmin} = $kadmin; return $self; @@ -271,11 +267,6 @@ sub create { my $kadmin = Wallet::Kadmin->new (); $self->{kadmin} = $kadmin; - # Set a callback for things to do after a fork, specifically for the MIT - # kadmin module which forks to kadmin. - my $callback = sub { $self->{dbh}->{InactiveDestroy} = 1 }; - $kadmin->fork_callback ($callback); - if (not $kadmin->create ($name)) { die $kadmin->error, "\n"; } @@ -292,16 +283,21 @@ sub destroy { $self->error ("cannot destroy $id: object is locked"); return; } + my $dbh = $self->{dbh}; + my $guard = $dbh->txn_scope_guard; 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; + my %search = (ks_name => $self->{name}); + my $sync_rs = $dbh->resultset('KeytabSync')->search (\%search); + $sync_rs->delete_all if defined $sync_rs; + + %search = (ke_name => $self->{name}); + my $enctype_rs = $dbh->resultset('KeytabEnctype')->search (\%search); + $enctype_rs->delete_all if defined $enctype_rs; + + $guard->commit; }; if ($@) { $self->error ($@); - $self->{dbh}->rollback; return; } my $kadmin = $self->{kadmin}; diff --git a/perl/Wallet/Report.pm b/perl/Wallet/Report.pm index 5a8dc52..ea8cd2f 100644 --- a/perl/Wallet/Report.pm +++ b/perl/Wallet/Report.pm @@ -16,12 +16,12 @@ use strict; use vars qw($VERSION); use Wallet::ACL; -use Wallet::Database; +use Wallet::Schema; # This version should be increased on any code change to this module. Always # use two digits for the minor version with a leading zero if necessary so # that it will sort properly. -$VERSION = '0.03'; +$VERSION = '0.04'; ############################################################################## # Constructor, destructor, and accessors @@ -32,7 +32,7 @@ $VERSION = '0.03'; # exception if anything goes wrong. sub new { my ($class) = @_; - my $dbh = Wallet::Database->connect; + my $dbh = Wallet::Schema->connect; my $self = { dbh => $dbh }; bless ($self, $class); return $self; @@ -59,7 +59,7 @@ sub error { # Disconnect the database handle on object destruction to avoid warnings. sub DESTROY { my ($self) = @_; - $self->{dbh}->disconnect unless $self->{dbh}->{InactiveDestroy}; + $self->{dbh}->storage->dbh->disconnect; } ############################################################################## @@ -69,18 +69,26 @@ sub DESTROY { # Return the SQL statement to find every object in the database. sub objects_all { my ($self) = @_; - my $sql = 'select ob_type, ob_name from objects order by ob_type, - ob_name'; - return $sql; + my @objects; + + my %search = (); + my %options = (order_by => [ qw/ob_type ob_name/ ], + select => [ qw/ob_type ob_name/ ]); + + return (\%search, \%options); } # Return the SQL statement and the search field required to find all objects # matching a specific type. sub objects_type { my ($self, $type) = @_; - my $sql = 'select ob_type, ob_name from objects where ob_type=? order - by ob_type, ob_name'; - return ($sql, $type); + my @objects; + + my %search = (ob_type => $type); + my %options = (order_by => [ qw/ob_type ob_name/ ], + select => [ qw/ob_type ob_name/ ]); + + return (\%search, \%options); } # Return the SQL statement and search field required to find all objects owned @@ -89,28 +97,36 @@ sub objects_type { # match any ACLs, set an error and return undef. sub objects_owner { my ($self, $owner) = @_; - my ($sth); + my @objects; + + my %search; + my %options = (order_by => [ qw/ob_type ob_name/ ], + select => [ qw/ob_type ob_name/ ]); + if (lc ($owner) eq 'null') { - my $sql = 'select ob_type, ob_name from objects where ob_owner is null - order by objects.ob_type, objects.ob_name'; - return ($sql); + %search = (ob_owner => undef); } else { my $acl = eval { Wallet::ACL->new ($owner, $self->{dbh}) }; return unless $acl; - my $sql = 'select ob_type, ob_name from objects where ob_owner = ? - order by objects.ob_type, objects.ob_name'; - return ($sql, $acl->id); + %search = (ob_owner => $acl->id); } + + return (\%search, \%options); } # Return the SQL statement and search field required to find all objects that # have a specific flag set. sub objects_flag { my ($self, $flag) = @_; - my $sql = 'select ob_type, ob_name from objects left join flags on - (objects.ob_type = flags.fl_type and objects.ob_name = flags.fl_name) - where flags.fl_flag = ? order by objects.ob_type, objects.ob_name'; - return ($sql, $flag); + my @objects; + + my %search = ('flags.fl_flag' => $flag); + my %options = (join => 'flags', + prefetch => 'flags', + order_by => [ qw/ob_type ob_name/ ], + select => [ qw/ob_type ob_name/ ]); + + return (\%search, \%options); } # Return the SQL statement and search field required to find all objects that @@ -120,22 +136,35 @@ sub objects_flag { # set an error and return the empty string. sub objects_acl { my ($self, $search) = @_; - my $acl = eval { Wallet::ACL->new ($search, $self->{dbh}) }; + my @objects; + + my $dbh = $self->{dbh}; + my $acl = eval { Wallet::ACL->new ($search, $dbh) }; return unless $acl; - my $sql = 'select ob_type, ob_name from objects where ob_owner = ? or - ob_acl_get = ? or ob_acl_store = ? or ob_acl_show = ? or - ob_acl_destroy = ? or ob_acl_flags = ? order by objects.ob_type, - objects.ob_name'; - return ($sql, ($acl->id) x 6); + + my @search = ({ ob_owner => $acl->id }, + { ob_acl_get => $acl->id }, + { ob_acl_store => $acl->id }, + { ob_acl_show => $acl->id }, + { ob_acl_destroy => $acl->id }, + { ob_acl_flags => $acl->id }); + my %options = (order_by => [ qw/ob_type ob_name/ ], + select => [ qw/ob_type ob_name/ ]); + + return (\@search, \%options); } # Return the SQL statement to find all objects that have been created but # have never been retrieved (via get). sub objects_unused { my ($self) = @_; - my $sql = 'select ob_type, ob_name from objects where ob_downloaded_on - is null order by objects.ob_type, objects.ob_name'; - return ($sql); + my @objects; + + my %search = (ob_downloaded_on => undef); + my %options = (order_by => [ qw/ob_type ob_name/ ], + select => [ qw/ob_type ob_name/ ]); + + return (\%search, \%options); } # Returns a list of all objects stored in the wallet database in the form of @@ -148,46 +177,44 @@ sub objects { my ($self, $type, @args) = @_; undef $self->{error}; - # Find the SQL statement and the arguments to use. - my $sql = ''; - my @search = (); + # Get the search and options array refs from specific functions. + my ($search_ref, $options_ref); if (!defined $type || $type eq '') { - ($sql) = $self->objects_all; + ($search_ref, $options_ref) = $self->objects_all; } else { if ($type ne 'unused' && @args != 1) { $self->error ("object searches require one argument to search"); } elsif ($type eq 'type') { - ($sql, @search) = $self->objects_type (@args); + ($search_ref, $options_ref) = $self->objects_type (@args); } elsif ($type eq 'owner') { - ($sql, @search) = $self->objects_owner (@args); + ($search_ref, $options_ref) = $self->objects_owner (@args); } elsif ($type eq 'flag') { - ($sql, @search) = $self->objects_flag (@args); + ($search_ref, $options_ref) = $self->objects_flag (@args); } elsif ($type eq 'acl') { - ($sql, @search) = $self->objects_acl (@args); + ($search_ref, $options_ref) = $self->objects_acl (@args); } elsif ($type eq 'unused') { - ($sql) = $self->objects_unused (@args); + ($search_ref, $options_ref) = $self->objects_unused (@args); } else { $self->error ("do not know search type: $type"); } - return unless $sql; + return unless $search_ref; } - # Do the search. + # Perform the search and return on any errors. my @objects; + my $dbh = $self->{dbh}; eval { - my $sth = $self->{dbh}->prepare ($sql); - $sth->execute (@search); - my $object; - while (defined ($object = $sth->fetchrow_arrayref)) { - push (@objects, [ @$object ]); + my @objects_rs = $dbh->resultset('Object')->search ($search_ref, + $options_ref); + for my $object_rs (@objects_rs) { + push (@objects, [ $object_rs->ob_type, $object_rs->ob_name ]); } - $self->{dbh}->commit; }; if ($@) { $self->error ("cannot list objects: $@"); - $self->{dbh}->rollback; return; } + return @objects; } @@ -199,17 +226,51 @@ sub objects { # database. sub acls_all { my ($self) = @_; - my $sql = 'select ac_id, ac_name from acls order by ac_id'; - return ($sql); + my @acls; + + my $dbh = $self->{dbh}; + my %search = (); + my %options = (order_by => [ qw/ac_id/ ], + select => [ qw/ac_id ac_name/ ]); + + eval { + my @acls_rs = $dbh->resultset('Acl')->search (\%search, \%options); + for my $acl_rs (@acls_rs) { + push (@acls, [ $acl_rs->ac_id, $acl_rs->ac_name ]); + } + }; + + if ($@) { + $self->error ("cannot list ACLs: $@"); + return; + } + return (@acls); } # Returns the SQL statement required to find all empty ACLs in the database. sub acls_empty { my ($self) = @_; - my $sql = 'select ac_id, ac_name from acls left join acl_entries - on (acls.ac_id = acl_entries.ae_id) where ae_id is null order by - ac_id'; - return ($sql); + my @acls; + + my $dbh = $self->{dbh}; + my %search = (ae_id => undef); + my %options = (join => 'acl_entries', + prefetch => 'acl_entries', + order_by => [ qw/ac_id/ ], + select => [ qw/ac_id ac_name/ ]); + + eval { + my @acls_rs = $dbh->resultset('Acl')->search (\%search, \%options); + for my $acl_rs (@acls_rs) { + push (@acls, [ $acl_rs->ac_id, $acl_rs->ac_name ]); + } + }; + + if ($@) { + $self->error ("cannot list ACLs: $@"); + return; + } + return (@acls); } # Returns the SQL statement and the field required to find ACLs containing the @@ -217,22 +278,69 @@ sub acls_empty { # do a substring search. sub acls_entry { my ($self, $type, $identifier) = @_; - my $sql = 'select distinct ac_id, ac_name from acl_entries left join acls - on (ae_id = ac_id) where ae_scheme = ? and ae_identifier like ? order - by ac_id'; - return ($sql, $type, '%' . $identifier . '%'); + my @acls; + + my $dbh = $self->{dbh}; + my %search = (ae_scheme => $type, + ae_identifier => { like => '%'.$identifier.'%' }); + my %options = (join => 'acl_entries', + prefetch => 'acl_entries', + order_by => [ qw/ac_id/ ], + select => [ qw/ac_id ac_name/ ], + distinct => 1); + + eval { + my @acls_rs = $dbh->resultset('Acl')->search (\%search, \%options); + for my $acl_rs (@acls_rs) { + push (@acls, [ $acl_rs->ac_id, $acl_rs->ac_name ]); + } + }; + + if ($@) { + $self->error ("cannot list ACLs: $@"); + return; + } + return (@acls); } # Returns the SQL statement required to find unused ACLs. sub acls_unused { my ($self) = @_; - my $sql = 'select ac_id, ac_name from acls where not ac_id in (select - ob_owner from objects where ob_owner = ac_id)'; - for my $acl (qw/get store show destroy flags/) { - $sql .= " and not ac_id in (select ob_acl_$acl from objects where - ob_acl_$acl = ac_id)"; + my @acls; + + my $dbh = $self->{dbh}; + my %search = ( + #'acls_owner.ob_owner' => undef, + #'acls_get.ob_owner' => undef, + #'acls_store.ob_owner' => undef, + #'acls_show.ob_owner' => undef, + #'acls_destroy.ob_owner' => undef, + #'acls_flags.ob_owner' => undef, + ); + my %options = (#join => [ qw/acls_owner acls_get acls_store acls_show acls_destroy acls_flags/ ], + order_by => [ qw/ac_id/ ], + select => [ qw/ac_id ac_name/ ]); + + eval { + my @acls_rs = $dbh->resultset('Acl')->search (\%search, \%options); + + # FIXME: Almost certainly a way of doing this with the search itself. + for my $acl_rs (@acls_rs) { + next if $acl_rs->acls_owner->first; + next if $acl_rs->acls_get->first; + next if $acl_rs->acls_store->first; + next if $acl_rs->acls_show->first; + next if $acl_rs->acls_destroy->first; + next if $acl_rs->acls_flags->first; + push (@acls, [ $acl_rs->ac_id, $acl_rs->ac_name ]); + } + }; + + if ($@) { + $self->error ("cannot list ACLs: $@"); + return; } - return ($sql); + return (@acls); } # Obtain a textual representation of the membership of an ACL, returning undef @@ -290,11 +398,10 @@ sub acls { my ($self, $type, @args) = @_; undef $self->{error}; - # Find the SQL statement and the arguments to use. - my $sql; - my @search = (); + # Find the ACLs for any given search. + my @acls; if (!defined $type || $type eq '') { - ($sql) = $self->acls_all; + @acls = $self->acls_all; } else { if ($type eq 'duplicate') { return $self->acls_duplicate; @@ -303,34 +410,17 @@ sub acls { $self->error ('ACL searches require an argument to search'); return; } else { - ($sql, @search) = $self->acls_entry (@args); + @acls = $self->acls_entry (@args); } } elsif ($type eq 'empty') { - ($sql) = $self->acls_empty; + @acls = $self->acls_empty; } elsif ($type eq 'unused') { - ($sql) = $self->acls_unused; + @acls = $self->acls_unused; } else { $self->error ("unknown search type: $type"); return; } } - - # Do the search. - my @acls; - eval { - my $sth = $self->{dbh}->prepare ($sql); - $sth->execute (@search); - my $object; - while (defined ($object = $sth->fetchrow_arrayref)) { - push (@acls, [ @$object ]); - } - $self->{dbh}->commit; - }; - if ($@) { - $self->error ("cannot list ACLs: $@"); - $self->{dbh}->rollback; - return; - } return @acls; } @@ -343,26 +433,32 @@ sub acls { sub owners { my ($self, $type, $name) = @_; undef $self->{error}; - my @lines; + my $dbh = $self->{dbh}; + + my @owners; eval { - my $sql = 'select distinct ae_scheme, ae_identifier from acl_entries, - acls, objects where ae_id = ac_id and ac_id = ob_owner and - ob_type like ? and ob_name like ? order by ae_scheme, - ae_identifier'; - my $sth = $self->{dbh}->prepare ($sql); - $sth->execute ($type, $name); - my $object; - while (defined ($object = $sth->fetchrow_arrayref)) { - push (@lines, [ @$object ]); + my %search = ( + 'acls_owner.ob_type' => { like => $type }, + 'acls_owner.ob_name' => { like => $name }); + my %options = ( + join => { 'acls' => 'acls_owner' }, + order_by => [ qw/ae_scheme ae_identifier/ ], + distinct => 1, + ); + + my @acls_rs = $dbh->resultset('AclEntry')->search (\%search, + \%options); + for my $acl_rs (@acls_rs) { + my $scheme = $acl_rs->ae_scheme; + my $identifier = $acl_rs->ae_identifier; + push (@owners, [ $scheme, $identifier ]); } - $self->{dbh}->commit; }; if ($@) { $self->error ("cannot report on owners: $@"); - $self->{dbh}->rollback; return; } - return @lines; + return @owners; } ############################################################################## diff --git a/perl/Wallet/Schema.pm b/perl/Wallet/Schema.pm index 9a7fe44..d36b7ac 100644 --- a/perl/Wallet/Schema.pm +++ b/perl/Wallet/Schema.pm @@ -1,262 +1,85 @@ -# Wallet::Schema -- Database schema for the wallet system. -# -# Written by Russ Allbery -# Copyright 2007, 2008, 2010, 2011 -# The Board of Trustees of the Leland Stanford Junior University -# -# See LICENSE for licensing terms. - -############################################################################## -# Modules and declarations -############################################################################## - package Wallet::Schema; -require 5.006; use strict; -use vars qw(@SQL @TABLES $VERSION); +use warnings; -use DBI; +use Wallet::Config; + +use base 'DBIx::Class::Schema'; # This version should be increased on any code change to this module. Always # use two digits for the minor version with a leading zero if necessary so # that it will sort properly. -$VERSION = '0.07'; +our $VERSION = '0.08'; + +__PACKAGE__->load_namespaces; +__PACKAGE__->load_components (qw/Schema::Versioned/); ############################################################################## -# Data manipulation +# Core overrides ############################################################################## -# Create a new Wallet::Schema object, parse the SQL out of the documentation, -# and store it in the object. We have to store the SQL in a static variable, -# since we can't read DATA multiple times. -sub new { +# Override DBI::connect to supply our own connect string, username, and +# password and to set some standard options. Takes no arguments other than +# the implicit class argument. +sub connect { my ($class) = @_; - unless (@SQL) { - local $_; - my $found; - my $command = ''; - while () { - if (not $found and /^=head1 SCHEMA/) { - $found = 1; - } elsif ($found and /^=head1 /) { - last; - } elsif ($found and /^ /) { - s/^ //; - $command .= $_; - if (/;$/) { - push (@SQL, $command); - $command = ''; - } - } - } - close DATA; + unless ($Wallet::Config::DB_DRIVER + and (defined ($Wallet::Config::DB_INFO) + or defined ($Wallet::Config::DB_NAME))) { + die "database connection information not configured\n"; } - my $self = { sql => [ @SQL ] }; - bless ($self, $class); - return $self; -} - -# Returns the SQL as a list of commands. -sub sql { - my ($self) = @_; - return @{ $self->{sql} }; -} - -############################################################################## -# Initialization and cleanup -############################################################################## - -# Run a set of SQL commands, forcing a transaction, rolling back on error, and -# throwing an exception if anything fails. -sub _run_sql { - my ($self, $dbh, @sql) = @_; - eval { - $dbh->begin_work if $dbh->{AutoCommit}; - for my $sql (@sql) { - $dbh->do ($sql, { RaiseError => 1, PrintError => 0 }); - } - $dbh->commit; - }; - if ($@) { - $dbh->rollback; - die "$@\n"; + my $dsn = "DBI:$Wallet::Config::DB_DRIVER:"; + if (defined $Wallet::Config::DB_INFO) { + $dsn .= $Wallet::Config::DB_INFO; + } else { + $dsn .= "database=$Wallet::Config::DB_NAME"; + $dsn .= ";host=$Wallet::Config::DB_HOST" if $Wallet::Config::DB_HOST; + $dsn .= ";port=$Wallet::Config::DB_PORT" if $Wallet::Config::DB_PORT; } -} - -# Given a database handle, try to create our database by running the SQL. Do -# this in a transaction regardless of the database settings and throw an -# exception if this fails. We have to do a bit of fiddling to get syntax that -# works with both MySQL and SQLite. -sub create { - my ($self, $dbh) = @_; - my $driver = $dbh->{Driver}->{Name}; - my @create = map { - if ($driver eq 'SQLite') { - s/auto_increment primary key/primary key autoincrement/; - } elsif ($driver eq 'mysql' and /^\s*create\s+table\s/) { - s/;$/ engine=InnoDB;/; - } - $_; - } @{ $self->{sql} }; - $self->_run_sql ($dbh, @create); -} - -# Given a database handle, try to remove the wallet database tables by -# reversing the SQL. Do this in a transaction regardless of the database -# settings and throw an exception if this fails. -sub drop { - my ($self, $dbh) = @_; - my @drop = map { - if (/^\s*create\s+table\s+(\S+)/i) { - "drop table if exists $1;"; - } else { - (); - } - } reverse @{ $self->{sql} }; - $self->_run_sql ($dbh, @drop); -} - -# Given an open database handle, determine the current database schema -# version. If we can't read the version number, we currently assume a version -# 0 database. This will change in the future. -sub _schema_version { - my ($self, $dbh) = @_; - my $version; - eval { - my $sql = 'select md_version from metadata'; - my $result = $dbh->selectrow_arrayref ($sql); - $version = $result->[0]; - }; + my $user = $Wallet::Config::DB_USER; + my $pass = $Wallet::Config::DB_PASSWORD; + my %attrs = (PrintError => 0, RaiseError => 1); + my $dbh = eval { $class->SUPER::connect ($dsn, $user, $pass, \%attrs) }; if ($@) { - $version = 0; + die "cannot connect to database: $@\n"; } - return $version; + return $dbh; } -# Given a database handle, try to upgrade the schema of that database to the -# current version while preserving all data. Do this in a transaction -# regardless of the database settings and throw an exception if this fails. -sub upgrade { - my ($self, $dbh) = @_; - my $version = $self->_schema_version ($dbh); - my @sql; - if ($version == 1) { - return; - } elsif ($version == 0) { - @sql = ('create table metadata (md_version integer)', - 'insert into metadata (md_version) values (1)', - 'alter table objects add ob_comment varchar(255) default null' - ); - } else { - die "unknown database version $version\n"; - } - $self->_run_sql ($dbh, @sql); -} +__END__ + +1; ############################################################################## -# Schema +# Documentation ############################################################################## -# The following POD is also parsed by the code to extract SQL blocks. Don't -# add any verbatim blocks to this documentation in the SCHEMA section that -# aren't intended to be SQL. - -1; -__DATA__ - =head1 NAME -Wallet::Schema - Database schema for the wallet system - -=for stopwords -SQL ACL API APIs enums Enums Keytab Backend keytab backend enctypes -enctype Allbery Metadata metadata verifier +Wallet::Schema - Database schema and connector for the wallet system =head1 SYNOPSIS use Wallet::Schema; - my $schema = Wallet::Schema->new; - my @sql = $schema->sql; - $schema->create ($dbh); + my $dbh = Wallet::Schema->connect; =head1 DESCRIPTION This class encapsulates the database schema for the wallet system. The -documentation you're reading explains and comments the schema. The Perl -object extracts the schema from the documentation and can either return it -as a list of SQL commands to run or run those commands given a connected -database handle. +documentation you're reading explains and comments the schema. The +class runs using the DBIx::Class module. -This schema attempts to be portable SQL, but it is designed for use with -MySQL and may require some modifications for other databases. - -=head1 METHODS - -=over 4 - -=item new() - -Instantiates a new Wallet::Schema object. This parses the documentation -and extracts the schema, but otherwise doesn't do anything. - -=item create(DBH) - -Given a connected database handle, runs the SQL commands necessary to -create the wallet database in an otherwise empty database. This method -will not drop any existing tables and will therefore fail if a wallet -database has already been created. On any error, this method will throw a -database exception. - -=item drop(DBH) - -Given a connected database handle, drop all of the wallet tables from that -database if any of those tables exist. This method will only remove -tables that are part of the current schema or one of the previous known -schema and won't remove other tables. On any error, this method will -throw a database exception. - -=item sql() - -Returns the schema and the population of the normalization tables as a -list of SQL commands to run to create the wallet database in an otherwise -empty database. - -=item upgrade(DBH) - -Given a connected database handle, runs the SQL commands necessary to -upgrade that database to the current schema version. On any error, this -method will throw a database exception. - -=back +connect() will obtain the database connection information from the wallet +configuration; see L for more details. It will also +automatically set the RaiseError attribute to true and the PrintError and +AutoCommit attributes to false, matching the assumptions made by the +wallet database code. =head1 SCHEMA -=head2 Metadata Tables - -This table is used to store metadata about the wallet database, used for -upgrades and in similar situations: - - create table metadata - (md_version integer); - insert into metadata (md_version) values (1); - -This table will normally only have one row. md_version holds the version -number of the schema (which does not necessarily have any relationship to -the version number of wallet itself). - =head2 Normalization Tables -The following are normalization tables used to constrain the values in -other tables. - -Holds the supported flag names: - - create table flag_names - (fn_name varchar(32) primary key); - insert into flag_names (fn_name) values ('locked'); - insert into flag_names (fn_name) values ('unchanging'); - Holds the supported object types and their corresponding Perl classes: create table types @@ -390,8 +213,8 @@ object may have zero or more flags associated with it: not null references objects(ob_type), fl_name varchar(255) not null references objects(ob_name), - fl_flag varchar(32) - not null references flag_names(fn_name), + fl_flag enum('locked', 'unchanging') + not null, primary key (fl_type, fl_name, fl_flag)); create index fl_object on flags (fl_type, fl_name); @@ -477,9 +300,22 @@ 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 automated mechanism to do this. +=head1 CLASS METHODS + +=over 4 + +=item connect() + +Opens a new database connection and returns the database object. On any +failure, throws an exception. Unlike the DBI method, connect() takes no +arguments; all database connection information is derived from the wallet +configuration. + +=back + =head1 SEE ALSO -wallet-backend(8) +wallet-backend(8), Wallet::Config(3) This module is part of the wallet system. The current version is available from L. diff --git a/perl/Wallet/Schema/Result/Acl.pm b/perl/Wallet/Schema/Result/Acl.pm new file mode 100644 index 0000000..60a357b --- /dev/null +++ b/perl/Wallet/Schema/Result/Acl.pm @@ -0,0 +1,99 @@ +package Wallet::Schema::Result::Acl; + +use strict; +use warnings; + +use base 'DBIx::Class::Core'; + +=head1 NAME + +Wallet::Schema::Result::Acl + +=head1 DESCRIPTION + +=cut + +__PACKAGE__->table("acls"); + +=head1 ACCESSORS + +=head2 ac_id + + data_type: 'integer' + is_auto_increment: 1 + is_nullable: 0 + +=head2 ac_name + + data_type: 'varchar' + is_nullable: 0 + size: 255 + +=cut + +__PACKAGE__->add_columns( + "ac_id", + { data_type => "integer", is_auto_increment => 1, is_nullable => 0 }, + "ac_name", + { data_type => "varchar", is_nullable => 0, size => 255 }, +); +__PACKAGE__->set_primary_key("ac_id"); +__PACKAGE__->add_unique_constraint("ac_name", ["ac_name"]); + +__PACKAGE__->has_one( + 'acl_entries', + 'Wallet::Schema::Result::AclEntry', + { 'foreign.ae_id' => 'self.ac_id' }, + { cascade_copy => 0, cascade_delete => 0 }, + ); +__PACKAGE__->has_many( + 'acl_history', + 'Wallet::Schema::Result::AclHistory', + { 'foreign.ah_id' => 'self.ac_id' }, + { cascade_copy => 0, cascade_delete => 0 }, + ); + +# References for all of the various potential ACLs in owners. +__PACKAGE__->has_many( + 'acls_owner', + 'Wallet::Schema::Result::Object', + { 'foreign.ob_owner' => 'self.ac_id' }, + ); +__PACKAGE__->has_many( + 'acls_get', + 'Wallet::Schema::Result::Object', + { 'foreign.ob_acl_get' => 'self.ac_id' }, + ); +__PACKAGE__->has_many( + 'acls_store', + 'Wallet::Schema::Result::Object', + { 'foreign.ob_acl_store' => 'self.ac_id' }, + ); +__PACKAGE__->has_many( + 'acls_show', + 'Wallet::Schema::Result::Object', + { 'foreign.ob_acl_show' => 'self.ac_id' }, + ); +__PACKAGE__->has_many( + 'acls_destroy', + 'Wallet::Schema::Result::Object', + { 'foreign.ob_acl_destroy' => 'self.ac_id' }, + ); +__PACKAGE__->has_many( + 'acls_flags', + 'Wallet::Schema::Result::Object', + { 'foreign.ob_acl_flags' => 'self.ac_id' }, + ); + +# Override the insert method so that we can automatically create history +# items. +#sub insert { +# my ($self, @args) = @_; +# my $ret = $self->next::method (@args); +# print "ID: ".$self->ac_id."\n"; +# use Data::Dumper; print Dumper (@args); + +# return $self; +#} + +1; diff --git a/perl/Wallet/Schema/Result/AclEntry.pm b/perl/Wallet/Schema/Result/AclEntry.pm new file mode 100644 index 0000000..99105a0 --- /dev/null +++ b/perl/Wallet/Schema/Result/AclEntry.pm @@ -0,0 +1,63 @@ +package Wallet::Schema::Result::AclEntry; + +use strict; +use warnings; + +use base 'DBIx::Class::Core'; + +=head1 NAME + +Wallet::Schema::Result::AclEntry + +=head1 DESCRIPTION + +=cut + +__PACKAGE__->table("acl_entries"); + +=head1 ACCESSORS + +=head2 ae_id + + data_type: 'integer' + is_nullable: 0 + +=head2 ae_scheme + + data_type: 'varchar' + is_nullable: 0 + size: 32 + +=head2 ae_identifier + + data_type: 'varchar' + is_nullable: 0 + size: 255 + +=cut + +__PACKAGE__->add_columns( + "ae_id", + { data_type => "integer", is_nullable => 0 }, + "ae_scheme", + { data_type => "varchar", is_nullable => 0, size => 32 }, + "ae_identifier", + { data_type => "varchar", is_nullable => 0, size => 255 }, +); +__PACKAGE__->set_primary_key("ae_id", "ae_scheme", "ae_identifier"); + +__PACKAGE__->belongs_to( + 'acls', + 'Wallet::Schema::Result::Acl', + { 'foreign.ac_id' => 'self.ae_id' }, + { is_deferrable => 1, on_delete => 'CASCADE', + on_update => 'CASCADE' }, + ); + +__PACKAGE__->has_one( + 'acl_scheme', + 'Wallet::Schema::Result::AclScheme', + { 'foreign.as_name' => 'self.ae_scheme' }, + { cascade_delete => 0 }, + ); +1; diff --git a/perl/Wallet/Schema/Result/AclHistory.pm b/perl/Wallet/Schema/Result/AclHistory.pm new file mode 100644 index 0000000..2ad56ff --- /dev/null +++ b/perl/Wallet/Schema/Result/AclHistory.pm @@ -0,0 +1,101 @@ +package Wallet::Schema::Result::AclHistory; + +use strict; +use warnings; + +use base 'DBIx::Class::Core'; + +__PACKAGE__->load_components("InflateColumn::DateTime"); + +=head1 NAME + +Wallet::Schema::Result::AclHistory + +=head1 DESCRIPTION + +=cut + +__PACKAGE__->table("acl_history"); + +=head1 ACCESSORS + +=head2 ah_id + + data_type: 'integer' + is_auto_increment: 1 + is_nullable: 0 + +=head2 ah_acl + + data_type: 'integer' + is_nullable: 0 + +=head2 ah_action + + data_type: 'varchar' + is_nullable: 0 + size: 16 + +=head2 ah_scheme + + data_type: 'varchar' + is_nullable: 1 + size: 32 + +=head2 ah_identifier + + data_type: 'varchar' + is_nullable: 1 + size: 255 + +=head2 ah_by + + data_type: 'varchar' + is_nullable: 0 + size: 255 + +=head2 ah_from + + data_type: 'varchar' + is_nullable: 0 + size: 255 + +=head2 ah_on + + data_type: 'datetime' + datetime_undef_if_invalid: 1 + is_nullable: 0 + +=cut + +__PACKAGE__->add_columns( + "ah_id", + { data_type => "integer", is_auto_increment => 1, is_nullable => 0 }, + "ah_acl", + { data_type => "integer", is_nullable => 0 }, + "ah_action", + { data_type => "varchar", is_nullable => 0, size => 16 }, + "ah_scheme", + { data_type => "varchar", is_nullable => 1, size => 32 }, + "ah_identifier", + { data_type => "varchar", is_nullable => 1, size => 255 }, + "ah_by", + { data_type => "varchar", is_nullable => 0, size => 255 }, + "ah_from", + { data_type => "varchar", is_nullable => 0, size => 255 }, + "ah_on", + { + data_type => "datetime", + datetime_undef_if_invalid => 1, + is_nullable => 0, + }, +); +__PACKAGE__->set_primary_key("ah_id"); + +__PACKAGE__->might_have( + 'acls', + 'Wallet::Schema::Result::Acl', + { 'foreign.ac_id' => 'self.ah_id' }, + ); + +1; diff --git a/perl/Wallet/Schema/Result/AclScheme.pm b/perl/Wallet/Schema/Result/AclScheme.pm new file mode 100644 index 0000000..96db79d --- /dev/null +++ b/perl/Wallet/Schema/Result/AclScheme.pm @@ -0,0 +1,73 @@ +package Wallet::Schema::Result::AclScheme; + +use strict; +use warnings; + +use base 'DBIx::Class::Core'; +__PACKAGE__->load_components (qw//); + +=head1 NAME + +Wallet::Schema::Result::AclScheme + +=head1 DESCRIPTION + +This is a normalization table used to constrain the values in other +tables. It contains the types of ACL schemes that Wallet will +recognize, and the modules that govern each of those schemes. + +By default it contains the following entries: + + insert into acl_schemes (as_name, as_class) + values ('krb5', 'Wallet::ACL::Krb5'); + insert into acl_schemes (as_name, as_class) + values ('krb5-regex', 'Wallet::ACL::Krb5::Regex'); + insert into acl_schemes (as_name, as_class) + values ('ldap-attr', 'Wallet::ACL::LDAP::Attribute'); + insert into acl_schemes (as_name, as_class) + values ('netdb', 'Wallet::ACL::NetDB'); + insert into acl_schemes (as_name, as_class) + values ('netdb-root', 'Wallet::ACL::NetDB::Root'); + +If you have extended the wallet to support additional ACL schemes, you +will want to add additional rows to this table mapping those schemes +to Perl classes that implement the ACL verifier APIs. + +=cut + +__PACKAGE__->table("acl_schemes"); + +=head1 ACCESSORS + +=head2 as_name + + data_type: 'varchar' + is_nullable: 0 + size: 32 + +=head2 as_class + + data_type: 'varchar' + is_nullable: 1 + size: 64 + +=cut + +__PACKAGE__->add_columns( + "as_name", + { data_type => "varchar", is_nullable => 0, size => 32 }, + "as_class", + { data_type => "varchar", is_nullable => 1, size => 64 }, +); +__PACKAGE__->set_primary_key("as_name"); + +#__PACKAGE__->resultset->populate ([ +# [ qw/as_name as_class/ ], +# [ 'krb5', 'Wallet::ACL::Krb5' ], +# [ 'krb5-regex', 'Wallet::ACL::Krb5::Regex' ], +# [ 'ldap-attr', 'Wallet::ACL::LDAP::Attribute' ], +# [ 'netdb', 'Wallet::ACL::NetDB' ], +# [ 'netdb-root', 'Wallet::ACL::NetDB::Root' ], +# ]); + +1; diff --git a/perl/Wallet/Schema/Result/Enctype.pm b/perl/Wallet/Schema/Result/Enctype.pm new file mode 100644 index 0000000..be41b84 --- /dev/null +++ b/perl/Wallet/Schema/Result/Enctype.pm @@ -0,0 +1,34 @@ +package Wallet::Schema::Result::Enctype; + +use strict; +use warnings; + +use base 'DBIx::Class::Core'; + +=head1 NAME + +Wallet::Schema::Result::Enctype + +=head1 DESCRIPTION + +=cut + +__PACKAGE__->table("enctypes"); + +=head1 ACCESSORS + +=head2 en_name + + data_type: 'varchar' + is_nullable: 0 + size: 255 + +=cut + +__PACKAGE__->add_columns( + "en_name", + { data_type => "varchar", is_nullable => 0, size => 255 }, +); +__PACKAGE__->set_primary_key("en_name"); + +1; diff --git a/perl/Wallet/Schema/Result/Flag.pm b/perl/Wallet/Schema/Result/Flag.pm new file mode 100644 index 0000000..b38e85f --- /dev/null +++ b/perl/Wallet/Schema/Result/Flag.pm @@ -0,0 +1,54 @@ +package Wallet::Schema::Result::Flag; + +use strict; +use warnings; + +use base 'DBIx::Class::Core'; + +=head1 NAME + +Wallet::Schema::Result::Flag + +=head1 DESCRIPTION + +=cut + +__PACKAGE__->table("flags"); + +=head1 ACCESSORS + +=head2 fl_type + + data_type: 'varchar' + is_nullable: 0 + size: 16 + +=head2 fl_name + + data_type: 'varchar' + is_nullable: 0 + size: 255 + +=head2 fl_flag + + data_type: 'varchar' + is_nullable: 0 + size: 32 + +=cut + +__PACKAGE__->add_columns( + "fl_type" => + { data_type => "varchar", is_nullable => 0, size => 16 }, + "fl_name" => + { data_type => "varchar", is_nullable => 0, size => 255 }, + "fl_flag" => { + data_type => 'enum', + is_enum => 1, + extra => { list => [qw/locked unchanging/] }, + }, +); +__PACKAGE__->set_primary_key("fl_type", "fl_name", "fl_flag"); + + +1; diff --git a/perl/Wallet/Schema/Result/KeytabEnctype.pm b/perl/Wallet/Schema/Result/KeytabEnctype.pm new file mode 100644 index 0000000..ae40c52 --- /dev/null +++ b/perl/Wallet/Schema/Result/KeytabEnctype.pm @@ -0,0 +1,42 @@ +package Wallet::Schema::Result::KeytabEnctype; + +use strict; +use warnings; + +use base 'DBIx::Class::Core'; + +=head1 NAME + +Wallet::Schema::Result::KeytabEnctype + +=head1 DESCRIPTION + +=cut + +__PACKAGE__->table("keytab_enctypes"); + +=head1 ACCESSORS + +=head2 ke_name + + data_type: 'varchar' + is_nullable: 0 + size: 255 + +=head2 ke_enctype + + data_type: 'varchar' + is_nullable: 0 + size: 255 + +=cut + +__PACKAGE__->add_columns( + "ke_name", + { data_type => "varchar", is_nullable => 0, size => 255 }, + "ke_enctype", + { data_type => "varchar", is_nullable => 0, size => 255 }, +); +__PACKAGE__->set_primary_key("ke_name", "ke_enctype"); + +1; diff --git a/perl/Wallet/Schema/Result/KeytabSync.pm b/perl/Wallet/Schema/Result/KeytabSync.pm new file mode 100644 index 0000000..92ab6b8 --- /dev/null +++ b/perl/Wallet/Schema/Result/KeytabSync.pm @@ -0,0 +1,42 @@ +package Wallet::Schema::Result::KeytabSync; + +use strict; +use warnings; + +use base 'DBIx::Class::Core'; + +=head1 NAME + +Wallet::Schema::Result::KeytabSync + +=head1 DESCRIPTION + +=cut + +__PACKAGE__->table("keytab_sync"); + +=head1 ACCESSORS + +=head2 ks_name + + data_type: 'varchar' + is_nullable: 0 + size: 255 + +=head2 ks_target + + data_type: 'varchar' + is_nullable: 0 + size: 255 + +=cut + +__PACKAGE__->add_columns( + "ks_name", + { data_type => "varchar", is_nullable => 0, size => 255 }, + "ks_target", + { data_type => "varchar", is_nullable => 0, size => 255 }, +); +__PACKAGE__->set_primary_key("ks_name", "ks_target"); + +1; diff --git a/perl/Wallet/Schema/Result/Object.pm b/perl/Wallet/Schema/Result/Object.pm new file mode 100644 index 0000000..17c51e2 --- /dev/null +++ b/perl/Wallet/Schema/Result/Object.pm @@ -0,0 +1,258 @@ +package Wallet::Schema::Result::Object; + +use strict; +use warnings; + +use base 'DBIx::Class::Core'; + +__PACKAGE__->load_components("InflateColumn::DateTime"); + +=head1 NAME + +Wallet::Schema::Result::Object + +=head1 DESCRIPTION + +=cut + +__PACKAGE__->table("objects"); + +=head1 ACCESSORS + +=head2 ob_type + + data_type: 'varchar' + is_nullable: 0 + size: 16 + +=head2 ob_name + + data_type: 'varchar' + is_nullable: 0 + size: 255 + +=head2 ob_owner + + data_type: 'integer' + is_nullable: 1 + +=head2 ob_acl_get + + data_type: 'integer' + is_nullable: 1 + +=head2 ob_acl_store + + data_type: 'integer' + is_nullable: 1 + +=head2 ob_acl_show + + data_type: 'integer' + is_nullable: 1 + +=head2 ob_acl_destroy + + data_type: 'integer' + is_nullable: 1 + +=head2 ob_acl_flags + + data_type: 'integer' + is_nullable: 1 + +=head2 ob_expires + + data_type: 'datetime' + datetime_undef_if_invalid: 1 + is_nullable: 1 + +=head2 ob_created_by + + data_type: 'varchar' + is_nullable: 0 + size: 255 + +=head2 ob_created_from + + data_type: 'varchar' + is_nullable: 0 + size: 255 + +=head2 ob_created_on + + data_type: 'datetime' + datetime_undef_if_invalid: 1 + is_nullable: 0 + +=head2 ob_stored_by + + data_type: 'varchar' + is_nullable: 1 + size: 255 + +=head2 ob_stored_from + + data_type: 'varchar' + is_nullable: 1 + size: 255 + +=head2 ob_stored_on + + data_type: 'datetime' + datetime_undef_if_invalid: 1 + is_nullable: 1 + +=head2 ob_downloaded_by + + data_type: 'varchar' + is_nullable: 1 + size: 255 + +=head2 ob_downloaded_from + + data_type: 'varchar' + is_nullable: 1 + size: 255 + +=head2 ob_downloaded_on + + data_type: 'datetime' + datetime_undef_if_invalid: 1 + is_nullable: 1 + +=head2 ob_comment + + data_type: 'varchar' + is_nullable: 1 + size: 255 + +=cut + +__PACKAGE__->add_columns( + "ob_type", + { data_type => "varchar", is_nullable => 0, size => 16 }, + "ob_name", + { data_type => "varchar", is_nullable => 0, size => 255 }, + "ob_owner", + { data_type => "integer", is_nullable => 1 }, + "ob_acl_get", + { data_type => "integer", is_nullable => 1 }, + "ob_acl_store", + { data_type => "integer", is_nullable => 1 }, + "ob_acl_show", + { data_type => "integer", is_nullable => 1 }, + "ob_acl_destroy", + { data_type => "integer", is_nullable => 1 }, + "ob_acl_flags", + { data_type => "integer", is_nullable => 1 }, + "ob_expires", + { + data_type => "datetime", + datetime_undef_if_invalid => 1, + is_nullable => 1, + }, + "ob_created_by", + { data_type => "varchar", is_nullable => 0, size => 255 }, + "ob_created_from", + { data_type => "varchar", is_nullable => 0, size => 255 }, + "ob_created_on", + { + data_type => "datetime", + datetime_undef_if_invalid => 1, + is_nullable => 0, + }, + "ob_stored_by", + { data_type => "varchar", is_nullable => 1, size => 255 }, + "ob_stored_from", + { data_type => "varchar", is_nullable => 1, size => 255 }, + "ob_stored_on", + { + data_type => "datetime", + datetime_undef_if_invalid => 1, + is_nullable => 1, + }, + "ob_downloaded_by", + { data_type => "varchar", is_nullable => 1, size => 255 }, + "ob_downloaded_from", + { data_type => "varchar", is_nullable => 1, size => 255 }, + "ob_downloaded_on", + { + data_type => "datetime", + datetime_undef_if_invalid => 1, + is_nullable => 1, + }, + "ob_comment", + { data_type => "varchar", is_nullable => 1, size => 255 }, +); +__PACKAGE__->set_primary_key("ob_name", "ob_type"); + +__PACKAGE__->has_one( + 'types', + 'Wallet::Schema::Result::Type', + { 'foreign.ty_name' => 'self.ob_type' }, + ); + +__PACKAGE__->has_many( + 'flags', + 'Wallet::Schema::Result::Flag', + { 'foreign.fl_type' => 'self.ob_type', + 'foreign.fl_name' => 'self.ob_name' }, + { cascade_copy => 0, cascade_delete => 0 }, + ); + +__PACKAGE__->has_many( + 'object_history', + 'Wallet::Schema::Result::ObjectHistory', + { 'foreign.oh_type' => 'self.ob_type', + 'foreign.oh_name' => 'self.ob_name' }, + { cascade_copy => 0, cascade_delete => 0 }, + ); + +__PACKAGE__->has_many( + 'keytab_enctypes', + 'Wallet::Schema::Result::KeytabEnctype', + { 'foreign.ke_name' => 'self.ob_name' }, + { cascade_copy => 0, cascade_delete => 0 }, + ); + +__PACKAGE__->has_many( + 'keytab_sync', + 'Wallet::Schema::Result::KeytabSync', + { 'foreign.ks_name' => 'self.ob_name' }, + { cascade_copy => 0, cascade_delete => 0 }, + ); + +# References for all of the various potential ACLs. +__PACKAGE__->belongs_to( + 'acls_owner', + 'Wallet::Schema::Result::Acl', + { 'foreign.ac_id' => 'self.ob_owner' }, + ); +__PACKAGE__->belongs_to( + 'acls_get', + 'Wallet::Schema::Result::Acl', + { 'foreign.ac_id' => 'self.ob_acl_get' }, + ); +__PACKAGE__->belongs_to( + 'acls_store', + 'Wallet::Schema::Result::Acl', + { 'foreign.ac_id' => 'self.ob_acl_store' }, + ); +__PACKAGE__->belongs_to( + 'acls_show', + 'Wallet::Schema::Result::Acl', + { 'foreign.ac_id' => 'self.ob_acl_show' }, + ); +__PACKAGE__->belongs_to( + 'acls_destroy', + 'Wallet::Schema::Result::Acl', + { 'foreign.ac_id' => 'self.ob_acl_destroy' }, + ); +__PACKAGE__->belongs_to( + 'acls_flags', + 'Wallet::Schema::Result::Acl', + { 'foreign.ac_id' => 'self.ob_acl_flags' }, + ); + +1; diff --git a/perl/Wallet/Schema/Result/ObjectHistory.pm b/perl/Wallet/Schema/Result/ObjectHistory.pm new file mode 100644 index 0000000..067712f --- /dev/null +++ b/perl/Wallet/Schema/Result/ObjectHistory.pm @@ -0,0 +1,127 @@ +package Wallet::Schema::Result::ObjectHistory; + +use strict; +use warnings; + +use base 'DBIx::Class::Core'; + +__PACKAGE__->load_components("InflateColumn::DateTime"); + +=head1 NAME + +Wallet::Schema::Result::ObjectHistory + +=head1 DESCRIPTION + +=cut + +__PACKAGE__->table("object_history"); + +=head1 ACCESSORS + +=head2 oh_id + + data_type: 'integer' + is_auto_increment: 1 + is_nullable: 0 + +=head2 oh_type + + data_type: 'varchar' + is_nullable: 0 + size: 16 + +=head2 oh_name + + data_type: 'varchar' + is_nullable: 0 + size: 255 + +=head2 oh_action + + data_type: 'varchar' + is_nullable: 0 + size: 16 + +=head2 oh_field + + data_type: 'varchar' + is_nullable: 1 + size: 16 + +=head2 oh_type_field + + data_type: 'varchar' + is_nullable: 1 + size: 255 + +=head2 oh_old + + data_type: 'varchar' + is_nullable: 1 + size: 255 + +=head2 oh_new + + data_type: 'varchar' + is_nullable: 1 + size: 255 + +=head2 oh_by + + data_type: 'varchar' + is_nullable: 0 + size: 255 + +=head2 oh_from + + data_type: 'varchar' + is_nullable: 0 + size: 255 + +=head2 oh_on + + data_type: 'datetime' + datetime_undef_if_invalid: 1 + is_nullable: 0 + +=cut + +__PACKAGE__->add_columns( + "oh_id", + { data_type => "integer", is_auto_increment => 1, is_nullable => 0 }, + "oh_type", + { data_type => "varchar", is_nullable => 0, size => 16 }, + "oh_name", + { data_type => "varchar", is_nullable => 0, size => 255 }, + "oh_action", + { data_type => "varchar", is_nullable => 0, size => 16 }, + "oh_field", + { data_type => "varchar", is_nullable => 1, size => 16 }, + "oh_type_field", + { data_type => "varchar", is_nullable => 1, size => 255 }, + "oh_old", + { data_type => "varchar", is_nullable => 1, size => 255 }, + "oh_new", + { data_type => "varchar", is_nullable => 1, size => 255 }, + "oh_by", + { data_type => "varchar", is_nullable => 0, size => 255 }, + "oh_from", + { data_type => "varchar", is_nullable => 0, size => 255 }, + "oh_on", + { + data_type => "datetime", + datetime_undef_if_invalid => 1, + is_nullable => 0, + }, +); +__PACKAGE__->set_primary_key("oh_id"); + +__PACKAGE__->might_have( + 'objects', + 'Wallet::Schema::Result::Object', + { 'foreign.ob_type' => 'self.oh_type', + 'foreign.ob_name' => 'self.oh_name' }, + ); + +1; diff --git a/perl/Wallet/Schema/Result/SyncTarget.pm b/perl/Wallet/Schema/Result/SyncTarget.pm new file mode 100644 index 0000000..17f4320 --- /dev/null +++ b/perl/Wallet/Schema/Result/SyncTarget.pm @@ -0,0 +1,40 @@ +package Wallet::Schema::Result::SyncTarget; + +use strict; +use warnings; + +use base 'DBIx::Class::Core'; + +=head1 NAME + +Wallet::Schema::Result::SyncTarget + +=head1 DESCRIPTION + +=cut + +__PACKAGE__->table("sync_targets"); + +=head1 ACCESSORS + +=head2 st_name + + data_type: 'varchar' + is_nullable: 0 + size: 255 + +=cut + +__PACKAGE__->add_columns( + "st_name", + { data_type => "varchar", is_nullable => 0, size => 255 }, +); +__PACKAGE__->set_primary_key("st_name"); + +#__PACKAGE__->has_many( +# 'keytab_sync', +# 'Wallet::Schema::Result::KeytabSync', +# { 'foreign.ks_target' => 'self.st_name' }, +# { cascade_copy => 0, cascade_delete => 0 }, +# ); +1; diff --git a/perl/Wallet/Schema/Result/Type.pm b/perl/Wallet/Schema/Result/Type.pm new file mode 100644 index 0000000..89fb4c3 --- /dev/null +++ b/perl/Wallet/Schema/Result/Type.pm @@ -0,0 +1,64 @@ +package Wallet::Schema::Result::Type; + +use strict; +use warnings; + +use base 'DBIx::Class::Core'; + +=head1 NAME + +Wallet::Schema::Result::Type + +=head1 DESCRIPTION + +This is a normalization table used to constrain the values in other +tables. It contains the types of wallet objects that are considered +valid, and the modules that govern each. + +By default it contains the following entries: + + insert into types (ty_name, ty_class) + values ('file', 'Wallet::Object::File'); + insert into types (ty_name, ty_class) + values ('keytab', 'Wallet::Object::Keytab'); + +If you have extended the wallet to support additional object types , +you will want to add additional rows to this table mapping those types +to Perl classes that implement the object APIs. + +=cut + +__PACKAGE__->table("types"); + +=head1 ACCESSORS + +=head2 ty_name + + data_type: 'varchar' + is_nullable: 0 + size: 16 + +=head2 ty_class + + data_type: 'varchar' + is_nullable: 1 + size: 64 + +=cut + +__PACKAGE__->add_columns( + "ty_name", + { data_type => "varchar", is_nullable => 0, size => 16 }, + "ty_class", + { data_type => "varchar", is_nullable => 1, size => 64 }, +); +__PACKAGE__->set_primary_key("ty_name"); + +#__PACKAGE__->has_many( +# 'objects', +# 'Wallet::Schema::Result::Object', +# { 'foreign.ob_type' => 'self.ty_name' }, +# { cascade_copy => 0, cascade_delete => 0 }, +# ); + +1; diff --git a/perl/Wallet/Server.pm b/perl/Wallet/Server.pm index dfb7dbb..402fbe0 100644 --- a/perl/Wallet/Server.pm +++ b/perl/Wallet/Server.pm @@ -18,13 +18,12 @@ use vars qw(%MAPPING $VERSION); use Wallet::ACL; use Wallet::Config; -use Wallet::Database; use Wallet::Schema; # This version should be increased on any code change to this module. Always # use two digits for the minor version with a leading zero if necessary so # that it will sort properly. -$VERSION = '0.10'; +$VERSION = '0.11'; ############################################################################## # Utility methods @@ -38,7 +37,7 @@ $VERSION = '0.10'; # for various things. Throw an exception if anything goes wrong. sub new { my ($class, $user, $host) = @_; - my $dbh = Wallet::Database->connect; + my $dbh = Wallet::Schema->connect; my $acl = Wallet::ACL->new ('ADMIN', $dbh); my $self = { dbh => $dbh, @@ -71,8 +70,9 @@ sub error { # Disconnect the database handle on object destruction to avoid warnings. sub DESTROY { my ($self) = @_; - if ($self->{dbh} and not $self->{dbh}->{InactiveDestroy}) { - $self->{dbh}->disconnect; + + if ($self->{dbh}) { + $self->{dbh}->storage->dbh->disconnect; } } @@ -86,13 +86,14 @@ sub type_mapping { my ($self, $type) = @_; my $class; eval { - my $sql = 'select ty_class from types where ty_name = ?'; - ($class) = $self->{dbh}->selectrow_array ($sql, undef, $type); - $self->{dbh}->commit; + my $guard = $self->{dbh}->txn_scope_guard; + my %search = (ty_name => $type); + my $type_rec = $self->{dbh}->resultset('Type')->find (\%search); + $class = $type_rec->ty_class; + $guard->commit; }; if ($@) { $self->error ($@); - $self->{dbh}->rollback; return; } if (defined $class) { diff --git a/perl/create-ddl b/perl/create-ddl new file mode 100755 index 0000000..62deb86 --- /dev/null +++ b/perl/create-ddl @@ -0,0 +1,93 @@ +#!/usr/bin/perl -w +# +# create-ddl - Create DDL files for Wallet +# +# Written by Jon Robertson +# Copyright 2012 Board of Trustees, Leland Stanford Jr. University + +############################################################################# +# Modules and declarations +############################################################################# + +use strict; +use vars qw(); + +use Getopt::Long; +use Wallet::Admin; + +############################################################################# +# Main routine +############################################################################# + +# Get errors and output in the same order. +$| = 0; + +# Clean up the path name. +my $fullpath = $0; +$0 =~ s%^.*/%%; + +# Parse command-line options. +my ($help); +my $oldversion = ''; +Getopt::Long::config ('bundling'); +GetOptions ('h|help' => \$help, + 'o|oldversion=s' => \$oldversion) or exit 1; +if ($help) { + print "Feeding myself to perldoc, please wait....\n"; + exec ('perldoc', '-t', $fullpath); +} + +# Default wallet settings, for Wallet::Admin. +$Wallet::Config::DB_DDL_DIRECTORY = 'sql/'; +$Wallet::Config::DB_DRIVER = 'SQLite'; +$Wallet::Config::DB_INFO = 'wallet-db'; + +# Create a Wallet::Admin object and run the backup. +my $admin = Wallet::Admin->new; +$admin->backup ($oldversion); + +exit(0); + +############################################################################## +# Documentation +############################################################################## + +=head1 NAME + +create-ddl - Create DDL files for Wallet + +=head1 SYNOPSIS + +create-ddl [B<--help>] [B<--oldversion>] + +=head1 DESCRIPTION + +create-ddl is used to create DDL files for the various DBIx::Class +Wallet::Schema modules. It simply is an interface for the backup command +in Wallet::Admin, which does the work via DBIx::Class. The end result +is a number of files that can be used to load the database for each +supported database server. + +These files can be modified after creation to customize the database +load, though should only be done when necessary to prevent confusion +for the schema modules not matching the actual table definitions. This +is currently only done in the case of SQLite databases, due to the +SQLite parser creating keys without AUTOINCREMENT. + +=head1 OPTIONS + +B<--help> + +Prints the perldoc information (this document) for the script. + +B<--oldversion>= + +The version number of the previous version. If there are existing DDL +files for this version, then we will also create diff files to upgrade +a database from the old version to the current. + +=head1 AUTHORS + +Jon Robertson + +=cut diff --git a/perl/sql/Wallet-Schema-0.07-0.08-MySQL.sql b/perl/sql/Wallet-Schema-0.07-0.08-MySQL.sql new file mode 100644 index 0000000..ed0bde1 --- /dev/null +++ b/perl/sql/Wallet-Schema-0.07-0.08-MySQL.sql @@ -0,0 +1,7 @@ +BEGIN; +ALTER TABLE flags MODIFY `fl_flag` enum('locked', 'unchanging') NOT NULL; +DROP TABLE IF EXISTS flag_names; +DROP TABLE IF EXISTS metadata; +ALTER TABLE objects ADD ob_comment varchar(255) default null; +COMMIT; + diff --git a/perl/sql/Wallet-Schema-0.07-0.08-SQLite.sql b/perl/sql/Wallet-Schema-0.07-0.08-SQLite.sql new file mode 100644 index 0000000..3e600b0 --- /dev/null +++ b/perl/sql/Wallet-Schema-0.07-0.08-SQLite.sql @@ -0,0 +1,6 @@ +BEGIN; +DROP TABLE IF EXISTS flag_names; +DROP TABLE IF EXISTS metadata; +ALTER TABLE objects ADD ob_comment varchar(255) default null; +COMMIT; + diff --git a/perl/sql/Wallet-Schema-0.07-MySQL.sql b/perl/sql/Wallet-Schema-0.07-MySQL.sql new file mode 100644 index 0000000..1bd38b3 --- /dev/null +++ b/perl/sql/Wallet-Schema-0.07-MySQL.sql @@ -0,0 +1,211 @@ +-- +-- Created by SQL::Translator::Producer::MySQL +-- Created on Fri Jan 25 14:12:02 2013 +-- +SET foreign_key_checks=0; + +DROP TABLE IF EXISTS `acl_history`; + +-- +-- Table: `acl_history` +-- +CREATE TABLE `acl_history` ( + `ah_id` integer NOT NULL auto_increment, + `ah_acl` integer NOT NULL, + `ah_action` varchar(16) NOT NULL, + `ah_scheme` varchar(32), + `ah_identifier` varchar(255), + `ah_by` varchar(255) NOT NULL, + `ah_from` varchar(255) NOT NULL, + `ah_on` datetime NOT NULL, + PRIMARY KEY (`ah_id`) +); + +DROP TABLE IF EXISTS `acl_schemes`; + +-- +-- Table: `acl_schemes` +-- +CREATE TABLE `acl_schemes` ( + `as_name` varchar(32) NOT NULL, + `as_class` varchar(64), + PRIMARY KEY (`as_name`) +) ENGINE=InnoDB; + +DROP TABLE IF EXISTS `acls`; + +-- +-- Table: `acls` +-- +CREATE TABLE `acls` ( + `ac_id` integer NOT NULL auto_increment, + `ac_name` varchar(255) NOT NULL, + PRIMARY KEY (`ac_id`), + UNIQUE `ac_name` (`ac_name`) +) ENGINE=InnoDB; + +DROP TABLE IF EXISTS `enctypes`; + +-- +-- Table: `enctypes` +-- +CREATE TABLE `enctypes` ( + `en_name` varchar(255) NOT NULL, + PRIMARY KEY (`en_name`) +); + +DROP TABLE IF EXISTS `flags`; + +-- +-- Table: `flags` +-- +CREATE TABLE `flag_names` ( + `fn_name` varchar(32) NOT NULL, + PRIMARY KEY (`fn_name`) +); + +DROP TABLE IF EXISTS `flags`; + +-- +-- Table: `flags` +-- +CREATE TABLE `flags` ( + `fl_type` varchar(16) NOT NULL, + `fl_name` varchar(255) NOT NULL, + `fl_flag` varchar(32) NOT NULL, + PRIMARY KEY (`fl_type`, `fl_name`, `fl_flag`) +); + +DROP TABLE IF EXISTS `keytab_enctypes`; + +-- +-- Table: `keytab_enctypes` +-- +CREATE TABLE `keytab_enctypes` ( + `ke_name` varchar(255) NOT NULL, + `ke_enctype` varchar(255) NOT NULL, + PRIMARY KEY (`ke_name`, `ke_enctype`) +); + +DROP TABLE IF EXISTS `keytab_sync`; + +-- +-- Table: `keytab_sync` +-- +CREATE TABLE `keytab_sync` ( + `ks_name` varchar(255) NOT NULL, + `ks_target` varchar(255) NOT NULL, + PRIMARY KEY (`ks_name`, `ks_target`) +); + +DROP TABLE IF EXISTS `metadata`; + +-- +-- Table: `metadata` +-- +CREATE TABLE `metadata` ( + `md_version` integer +); + +DROP TABLE IF EXISTS `sync_targets`; + +-- +-- Table: `sync_targets` +-- +CREATE TABLE `sync_targets` ( + `st_name` varchar(255) NOT NULL, + PRIMARY KEY (`st_name`) +); + +DROP TABLE IF EXISTS `types`; + +-- +-- Table: `types` +-- +CREATE TABLE `types` ( + `ty_name` varchar(16) NOT NULL, + `ty_class` varchar(64), + PRIMARY KEY (`ty_name`) +) ENGINE=InnoDB; + +DROP TABLE IF EXISTS `acl_entries`; + +-- +-- Table: `acl_entries` +-- +CREATE TABLE `acl_entries` ( + `ae_id` integer NOT NULL, + `ae_scheme` varchar(32) NOT NULL, + `ae_identifier` varchar(255) NOT NULL, + INDEX `acl_entries_idx_ae_scheme` (`ae_scheme`), + INDEX `acl_entries_idx_ae_id` (`ae_id`), + PRIMARY KEY (`ae_id`, `ae_scheme`, `ae_identifier`), + CONSTRAINT `acl_entries_fk_ae_scheme` FOREIGN KEY (`ae_scheme`) REFERENCES `acl_schemes` (`as_name`), + CONSTRAINT `acl_entries_fk_ae_id` FOREIGN KEY (`ae_id`) REFERENCES `acls` (`ac_id`) ON DELETE CASCADE ON UPDATE CASCADE +) ENGINE=InnoDB; + +DROP TABLE IF EXISTS `objects`; + +-- +-- Table: `objects` +-- +CREATE TABLE `objects` ( + `ob_type` varchar(16) NOT NULL, + `ob_name` varchar(255) NOT NULL, + `ob_owner` integer, + `ob_acl_get` integer, + `ob_acl_store` integer, + `ob_acl_show` integer, + `ob_acl_destroy` integer, + `ob_acl_flags` integer, + `ob_expires` datetime, + `ob_created_by` varchar(255) NOT NULL, + `ob_created_from` varchar(255) NOT NULL, + `ob_created_on` datetime NOT NULL, + `ob_stored_by` varchar(255), + `ob_stored_from` varchar(255), + `ob_stored_on` datetime, + `ob_downloaded_by` varchar(255), + `ob_downloaded_from` varchar(255), + `ob_downloaded_on` datetime, + INDEX `objects_idx_ob_acl_destroy` (`ob_acl_destroy`), + INDEX `objects_idx_ob_acl_flags` (`ob_acl_flags`), + INDEX `objects_idx_ob_acl_get` (`ob_acl_get`), + INDEX `objects_idx_ob_owner` (`ob_owner`), + INDEX `objects_idx_ob_acl_show` (`ob_acl_show`), + INDEX `objects_idx_ob_acl_store` (`ob_acl_store`), + INDEX `objects_idx_ob_type` (`ob_type`), + PRIMARY KEY (`ob_name`, `ob_type`), + CONSTRAINT `objects_fk_ob_acl_destroy` FOREIGN KEY (`ob_acl_destroy`) REFERENCES `acls` (`ac_id`) ON DELETE CASCADE ON UPDATE CASCADE, + CONSTRAINT `objects_fk_ob_acl_flags` FOREIGN KEY (`ob_acl_flags`) REFERENCES `acls` (`ac_id`) ON DELETE CASCADE ON UPDATE CASCADE, + CONSTRAINT `objects_fk_ob_acl_get` FOREIGN KEY (`ob_acl_get`) REFERENCES `acls` (`ac_id`) ON DELETE CASCADE ON UPDATE CASCADE, + CONSTRAINT `objects_fk_ob_owner` FOREIGN KEY (`ob_owner`) REFERENCES `acls` (`ac_id`) ON DELETE CASCADE ON UPDATE CASCADE, + CONSTRAINT `objects_fk_ob_acl_show` FOREIGN KEY (`ob_acl_show`) REFERENCES `acls` (`ac_id`) ON DELETE CASCADE ON UPDATE CASCADE, + CONSTRAINT `objects_fk_ob_acl_store` FOREIGN KEY (`ob_acl_store`) REFERENCES `acls` (`ac_id`) ON DELETE CASCADE ON UPDATE CASCADE, + CONSTRAINT `objects_fk_ob_type` FOREIGN KEY (`ob_type`) REFERENCES `types` (`ty_name`) +) ENGINE=InnoDB; + +DROP TABLE IF EXISTS `object_history`; + +-- +-- Table: `object_history` +-- +CREATE TABLE `object_history` ( + `oh_id` integer NOT NULL auto_increment, + `oh_type` varchar(16) NOT NULL, + `oh_name` varchar(255) NOT NULL, + `oh_action` varchar(16) NOT NULL, + `oh_field` varchar(16), + `oh_type_field` varchar(255), + `oh_old` varchar(255), + `oh_new` varchar(255), + `oh_by` varchar(255) NOT NULL, + `oh_from` varchar(255) NOT NULL, + `oh_on` datetime NOT NULL, + INDEX `object_history_idx_oh_type_oh_name` (`oh_type`, `oh_name`), + PRIMARY KEY (`oh_id`), + CONSTRAINT `object_history_fk_oh_type_oh_name` FOREIGN KEY (`oh_type`, `oh_name`) REFERENCES `objects` (`ob_type`, `ob_name`) +) ENGINE=InnoDB; + +SET foreign_key_checks=1; + diff --git a/perl/sql/Wallet-Schema-0.07-SQLite.sql b/perl/sql/Wallet-Schema-0.07-SQLite.sql new file mode 100644 index 0000000..e24ea15 --- /dev/null +++ b/perl/sql/Wallet-Schema-0.07-SQLite.sql @@ -0,0 +1,219 @@ +-- +-- Created by SQL::Translator::Producer::SQLite +-- Created on Fri Jan 25 14:12:02 2013 +-- + +BEGIN TRANSACTION; + +-- +-- Table: acl_history +-- +DROP TABLE IF EXISTS acl_history; + +CREATE TABLE acl_history ( + ah_id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL, + ah_acl integer NOT NULL, + ah_action varchar(16) NOT NULL, + ah_scheme varchar(32), + ah_identifier varchar(255), + ah_by varchar(255) NOT NULL, + ah_from varchar(255) NOT NULL, + ah_on datetime NOT NULL +); + +-- +-- Table: acl_schemes +-- +DROP TABLE IF EXISTS acl_schemes; + +CREATE TABLE acl_schemes ( + as_name varchar(32) NOT NULL, + as_class varchar(64), + PRIMARY KEY (as_name) +); + +-- +-- Table: acls +-- +DROP TABLE IF EXISTS acls; + +CREATE TABLE acls ( + ac_id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL, + ac_name varchar(255) NOT NULL +); + +CREATE UNIQUE INDEX ac_name ON acls (ac_name); + +-- +-- Table: enctypes +-- +DROP TABLE IF EXISTS enctypes; + +CREATE TABLE enctypes ( + en_name varchar(255) NOT NULL, + PRIMARY KEY (en_name) +); + +-- +-- Table: flags +-- +DROP TABLE IF EXISTS flag_names; + +CREATE TABLE flag_names ( + fn_name varchar(32) NOT NULL, + PRIMARY KEY (fn_name) +); + +-- +-- Table: flags +-- +DROP TABLE IF EXISTS flags; + +CREATE TABLE flags ( + fl_type varchar(16) NOT NULL, + fl_name varchar(255) NOT NULL, + fl_flag varchar(32) NOT NULL, + PRIMARY KEY (fl_type, fl_name, fl_flag) +); + +-- +-- Table: keytab_enctypes +-- +DROP TABLE IF EXISTS keytab_enctypes; + +CREATE TABLE keytab_enctypes ( + ke_name varchar(255) NOT NULL, + ke_enctype varchar(255) NOT NULL, + PRIMARY KEY (ke_name, ke_enctype) +); + +-- +-- Table: keytab_sync +-- +DROP TABLE IF EXISTS keytab_sync; + +CREATE TABLE keytab_sync ( + ks_name varchar(255) NOT NULL, + ks_target varchar(255) NOT NULL, + PRIMARY KEY (ks_name, ks_target) +); + +-- +-- Table: metadata +-- +DROP TABLE IF EXISTS metadata; + +CREATE TABLE metadata ( + md_version integer +); + +-- +-- Table: sync_targets +-- +DROP TABLE IF EXISTS sync_targets; + +CREATE TABLE sync_targets ( + st_name varchar(255) NOT NULL, + PRIMARY KEY (st_name) +); + +-- +-- Table: types +-- +DROP TABLE IF EXISTS types; + +CREATE TABLE types ( + ty_name varchar(16) NOT NULL, + ty_class varchar(64), + PRIMARY KEY (ty_name) +); + +-- +-- Table: acl_entries +-- +DROP TABLE IF EXISTS acl_entries; + +CREATE TABLE acl_entries ( + ae_id integer NOT NULL, + ae_scheme varchar(32) NOT NULL, + ae_identifier varchar(255) NOT NULL, + PRIMARY KEY (ae_id, ae_scheme, ae_identifier), + FOREIGN KEY(ae_scheme) REFERENCES acl_schemes(as_name), + FOREIGN KEY(ae_id) REFERENCES acls(ac_id) +); + +CREATE INDEX acl_entries_idx_ae_scheme ON acl_entries (ae_scheme); + +CREATE INDEX acl_entries_idx_ae_id ON acl_entries (ae_id); + +-- +-- Table: objects +-- +DROP TABLE IF EXISTS objects; + +CREATE TABLE objects ( + ob_type varchar(16) NOT NULL, + ob_name varchar(255) NOT NULL, + ob_owner integer, + ob_acl_get integer, + ob_acl_store integer, + ob_acl_show integer, + ob_acl_destroy integer, + ob_acl_flags integer, + ob_expires datetime, + ob_created_by varchar(255) NOT NULL, + ob_created_from varchar(255) NOT NULL, + ob_created_on datetime NOT NULL, + ob_stored_by varchar(255), + ob_stored_from varchar(255), + ob_stored_on datetime, + ob_downloaded_by varchar(255), + ob_downloaded_from varchar(255), + ob_downloaded_on datetime, + PRIMARY KEY (ob_name, ob_type), + FOREIGN KEY(ob_acl_destroy) REFERENCES acls(ac_id), + FOREIGN KEY(ob_acl_flags) REFERENCES acls(ac_id), + FOREIGN KEY(ob_acl_get) REFERENCES acls(ac_id), + FOREIGN KEY(ob_owner) REFERENCES acls(ac_id), + FOREIGN KEY(ob_acl_show) REFERENCES acls(ac_id), + FOREIGN KEY(ob_acl_store) REFERENCES acls(ac_id), + FOREIGN KEY(ob_type) REFERENCES types(ty_name) +); + +CREATE INDEX objects_idx_ob_acl_destroy ON objects (ob_acl_destroy); + +CREATE INDEX objects_idx_ob_acl_flags ON objects (ob_acl_flags); + +CREATE INDEX objects_idx_ob_acl_get ON objects (ob_acl_get); + +CREATE INDEX objects_idx_ob_owner ON objects (ob_owner); + +CREATE INDEX objects_idx_ob_acl_show ON objects (ob_acl_show); + +CREATE INDEX objects_idx_ob_acl_store ON objects (ob_acl_store); + +CREATE INDEX objects_idx_ob_type ON objects (ob_type); + +-- +-- Table: object_history +-- +DROP TABLE IF EXISTS object_history; + +CREATE TABLE object_history ( + oh_id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL, + oh_type varchar(16) NOT NULL, + oh_name varchar(255) NOT NULL, + oh_action varchar(16) NOT NULL, + oh_field varchar(16), + oh_type_field varchar(255), + oh_old varchar(255), + oh_new varchar(255), + oh_by varchar(255) NOT NULL, + oh_from varchar(255) NOT NULL, + oh_on datetime NOT NULL, + FOREIGN KEY(oh_type) REFERENCES objects(ob_type) +); + +CREATE INDEX object_history_idx_oh_type_oh_name ON object_history (oh_type, oh_name); + +COMMIT; diff --git a/perl/sql/Wallet-Schema-0.08-MySQL.sql b/perl/sql/Wallet-Schema-0.08-MySQL.sql new file mode 100644 index 0000000..44b6475 --- /dev/null +++ b/perl/sql/Wallet-Schema-0.08-MySQL.sql @@ -0,0 +1,193 @@ +-- +-- Created by SQL::Translator::Producer::MySQL +-- Created on Fri Jan 25 14:12:02 2013 +-- +SET foreign_key_checks=0; + +DROP TABLE IF EXISTS `acl_history`; + +-- +-- Table: `acl_history` +-- +CREATE TABLE `acl_history` ( + `ah_id` integer NOT NULL auto_increment, + `ah_acl` integer NOT NULL, + `ah_action` varchar(16) NOT NULL, + `ah_scheme` varchar(32), + `ah_identifier` varchar(255), + `ah_by` varchar(255) NOT NULL, + `ah_from` varchar(255) NOT NULL, + `ah_on` datetime NOT NULL, + PRIMARY KEY (`ah_id`) +); + +DROP TABLE IF EXISTS `acl_schemes`; + +-- +-- Table: `acl_schemes` +-- +CREATE TABLE `acl_schemes` ( + `as_name` varchar(32) NOT NULL, + `as_class` varchar(64), + PRIMARY KEY (`as_name`) +) ENGINE=InnoDB; + +DROP TABLE IF EXISTS `acls`; + +-- +-- Table: `acls` +-- +CREATE TABLE `acls` ( + `ac_id` integer NOT NULL auto_increment, + `ac_name` varchar(255) NOT NULL, + PRIMARY KEY (`ac_id`), + UNIQUE `ac_name` (`ac_name`) +) ENGINE=InnoDB; + +DROP TABLE IF EXISTS `enctypes`; + +-- +-- Table: `enctypes` +-- +CREATE TABLE `enctypes` ( + `en_name` varchar(255) NOT NULL, + PRIMARY KEY (`en_name`) +); + +DROP TABLE IF EXISTS `flags`; + +-- +-- Table: `flags` +-- +CREATE TABLE `flags` ( + `fl_type` varchar(16) NOT NULL, + `fl_name` varchar(255) NOT NULL, + `fl_flag` enum('locked', 'unchanging') NOT NULL, + PRIMARY KEY (`fl_type`, `fl_name`, `fl_flag`) +); + +DROP TABLE IF EXISTS `keytab_enctypes`; + +-- +-- Table: `keytab_enctypes` +-- +CREATE TABLE `keytab_enctypes` ( + `ke_name` varchar(255) NOT NULL, + `ke_enctype` varchar(255) NOT NULL, + PRIMARY KEY (`ke_name`, `ke_enctype`) +); + +DROP TABLE IF EXISTS `keytab_sync`; + +-- +-- Table: `keytab_sync` +-- +CREATE TABLE `keytab_sync` ( + `ks_name` varchar(255) NOT NULL, + `ks_target` varchar(255) NOT NULL, + PRIMARY KEY (`ks_name`, `ks_target`) +); + +DROP TABLE IF EXISTS `sync_targets`; + +-- +-- Table: `sync_targets` +-- +CREATE TABLE `sync_targets` ( + `st_name` varchar(255) NOT NULL, + PRIMARY KEY (`st_name`) +); + +DROP TABLE IF EXISTS `types`; + +-- +-- Table: `types` +-- +CREATE TABLE `types` ( + `ty_name` varchar(16) NOT NULL, + `ty_class` varchar(64), + PRIMARY KEY (`ty_name`) +) ENGINE=InnoDB; + +DROP TABLE IF EXISTS `acl_entries`; + +-- +-- Table: `acl_entries` +-- +CREATE TABLE `acl_entries` ( + `ae_id` integer NOT NULL, + `ae_scheme` varchar(32) NOT NULL, + `ae_identifier` varchar(255) NOT NULL, + INDEX `acl_entries_idx_ae_scheme` (`ae_scheme`), + INDEX `acl_entries_idx_ae_id` (`ae_id`), + PRIMARY KEY (`ae_id`, `ae_scheme`, `ae_identifier`), + CONSTRAINT `acl_entries_fk_ae_scheme` FOREIGN KEY (`ae_scheme`) REFERENCES `acl_schemes` (`as_name`), + CONSTRAINT `acl_entries_fk_ae_id` FOREIGN KEY (`ae_id`) REFERENCES `acls` (`ac_id`) ON DELETE CASCADE ON UPDATE CASCADE +) ENGINE=InnoDB; + +DROP TABLE IF EXISTS `objects`; + +-- +-- Table: `objects` +-- +CREATE TABLE `objects` ( + `ob_type` varchar(16) NOT NULL, + `ob_name` varchar(255) NOT NULL, + `ob_owner` integer, + `ob_acl_get` integer, + `ob_acl_store` integer, + `ob_acl_show` integer, + `ob_acl_destroy` integer, + `ob_acl_flags` integer, + `ob_expires` datetime, + `ob_created_by` varchar(255) NOT NULL, + `ob_created_from` varchar(255) NOT NULL, + `ob_created_on` datetime NOT NULL, + `ob_stored_by` varchar(255), + `ob_stored_from` varchar(255), + `ob_stored_on` datetime, + `ob_downloaded_by` varchar(255), + `ob_downloaded_from` varchar(255), + `ob_downloaded_on` datetime, + `ob_comment` varchar(255), + INDEX `objects_idx_ob_acl_destroy` (`ob_acl_destroy`), + INDEX `objects_idx_ob_acl_flags` (`ob_acl_flags`), + INDEX `objects_idx_ob_acl_get` (`ob_acl_get`), + INDEX `objects_idx_ob_owner` (`ob_owner`), + INDEX `objects_idx_ob_acl_show` (`ob_acl_show`), + INDEX `objects_idx_ob_acl_store` (`ob_acl_store`), + INDEX `objects_idx_ob_type` (`ob_type`), + PRIMARY KEY (`ob_name`, `ob_type`), + CONSTRAINT `objects_fk_ob_acl_destroy` FOREIGN KEY (`ob_acl_destroy`) REFERENCES `acls` (`ac_id`) ON DELETE CASCADE ON UPDATE CASCADE, + CONSTRAINT `objects_fk_ob_acl_flags` FOREIGN KEY (`ob_acl_flags`) REFERENCES `acls` (`ac_id`) ON DELETE CASCADE ON UPDATE CASCADE, + CONSTRAINT `objects_fk_ob_acl_get` FOREIGN KEY (`ob_acl_get`) REFERENCES `acls` (`ac_id`) ON DELETE CASCADE ON UPDATE CASCADE, + CONSTRAINT `objects_fk_ob_owner` FOREIGN KEY (`ob_owner`) REFERENCES `acls` (`ac_id`) ON DELETE CASCADE ON UPDATE CASCADE, + CONSTRAINT `objects_fk_ob_acl_show` FOREIGN KEY (`ob_acl_show`) REFERENCES `acls` (`ac_id`) ON DELETE CASCADE ON UPDATE CASCADE, + CONSTRAINT `objects_fk_ob_acl_store` FOREIGN KEY (`ob_acl_store`) REFERENCES `acls` (`ac_id`) ON DELETE CASCADE ON UPDATE CASCADE, + CONSTRAINT `objects_fk_ob_type` FOREIGN KEY (`ob_type`) REFERENCES `types` (`ty_name`) +) ENGINE=InnoDB; + +DROP TABLE IF EXISTS `object_history`; + +-- +-- Table: `object_history` +-- +CREATE TABLE `object_history` ( + `oh_id` integer NOT NULL auto_increment, + `oh_type` varchar(16) NOT NULL, + `oh_name` varchar(255) NOT NULL, + `oh_action` varchar(16) NOT NULL, + `oh_field` varchar(16), + `oh_type_field` varchar(255), + `oh_old` varchar(255), + `oh_new` varchar(255), + `oh_by` varchar(255) NOT NULL, + `oh_from` varchar(255) NOT NULL, + `oh_on` datetime NOT NULL, + INDEX `object_history_idx_oh_type_oh_name` (`oh_type`, `oh_name`), + PRIMARY KEY (`oh_id`), + CONSTRAINT `object_history_fk_oh_type_oh_name` FOREIGN KEY (`oh_type`, `oh_name`) REFERENCES `objects` (`ob_type`, `ob_name`) +) ENGINE=InnoDB; + +SET foreign_key_checks=1; + diff --git a/perl/sql/Wallet-Schema-0.08-PostgreSQL.sql b/perl/sql/Wallet-Schema-0.08-PostgreSQL.sql new file mode 100644 index 0000000..2f79147 --- /dev/null +++ b/perl/sql/Wallet-Schema-0.08-PostgreSQL.sql @@ -0,0 +1,201 @@ +-- +-- Created by SQL::Translator::Producer::PostgreSQL +-- Created on Fri Jan 25 14:12:02 2013 +-- +-- +-- Table: acl_history +-- +DROP TABLE "acl_history" CASCADE; +CREATE TABLE "acl_history" ( + "ah_id" serial NOT NULL, + "ah_acl" integer NOT NULL, + "ah_action" character varying(16) NOT NULL, + "ah_scheme" character varying(32), + "ah_identifier" character varying(255), + "ah_by" character varying(255) NOT NULL, + "ah_from" character varying(255) NOT NULL, + "ah_on" timestamp NOT NULL, + PRIMARY KEY ("ah_id") +); + +-- +-- Table: acl_schemes +-- +DROP TABLE "acl_schemes" CASCADE; +CREATE TABLE "acl_schemes" ( + "as_name" character varying(32) NOT NULL, + "as_class" character varying(64), + PRIMARY KEY ("as_name") +); + +-- +-- Table: acls +-- +DROP TABLE "acls" CASCADE; +CREATE TABLE "acls" ( + "ac_id" serial NOT NULL, + "ac_name" character varying(255) NOT NULL, + PRIMARY KEY ("ac_id"), + CONSTRAINT "ac_name" UNIQUE ("ac_name") +); + +-- +-- Table: enctypes +-- +DROP TABLE "enctypes" CASCADE; +CREATE TABLE "enctypes" ( + "en_name" character varying(255) NOT NULL, + PRIMARY KEY ("en_name") +); + +-- +-- Table: flags +-- +DROP TABLE "flags" CASCADE; +CREATE TABLE "flags" ( + "fl_type" character varying(16) NOT NULL, + "fl_name" character varying(255) NOT NULL, + "fl_flag" character varying NOT NULL, + PRIMARY KEY ("fl_type", "fl_name", "fl_flag") +); + +-- +-- Table: keytab_enctypes +-- +DROP TABLE "keytab_enctypes" CASCADE; +CREATE TABLE "keytab_enctypes" ( + "ke_name" character varying(255) NOT NULL, + "ke_enctype" character varying(255) NOT NULL, + PRIMARY KEY ("ke_name", "ke_enctype") +); + +-- +-- Table: keytab_sync +-- +DROP TABLE "keytab_sync" CASCADE; +CREATE TABLE "keytab_sync" ( + "ks_name" character varying(255) NOT NULL, + "ks_target" character varying(255) NOT NULL, + PRIMARY KEY ("ks_name", "ks_target") +); + +-- +-- Table: sync_targets +-- +DROP TABLE "sync_targets" CASCADE; +CREATE TABLE "sync_targets" ( + "st_name" character varying(255) NOT NULL, + PRIMARY KEY ("st_name") +); + +-- +-- Table: types +-- +DROP TABLE "types" CASCADE; +CREATE TABLE "types" ( + "ty_name" character varying(16) NOT NULL, + "ty_class" character varying(64), + PRIMARY KEY ("ty_name") +); + +-- +-- Table: acl_entries +-- +DROP TABLE "acl_entries" CASCADE; +CREATE TABLE "acl_entries" ( + "ae_id" integer NOT NULL, + "ae_scheme" character varying(32) NOT NULL, + "ae_identifier" character varying(255) NOT NULL, + PRIMARY KEY ("ae_id", "ae_scheme", "ae_identifier") +); +CREATE INDEX "acl_entries_idx_ae_scheme" on "acl_entries" ("ae_scheme"); +CREATE INDEX "acl_entries_idx_ae_id" on "acl_entries" ("ae_id"); + +-- +-- Table: objects +-- +DROP TABLE "objects" CASCADE; +CREATE TABLE "objects" ( + "ob_type" character varying(16) NOT NULL, + "ob_name" character varying(255) NOT NULL, + "ob_owner" integer, + "ob_acl_get" integer, + "ob_acl_store" integer, + "ob_acl_show" integer, + "ob_acl_destroy" integer, + "ob_acl_flags" integer, + "ob_expires" timestamp, + "ob_created_by" character varying(255) NOT NULL, + "ob_created_from" character varying(255) NOT NULL, + "ob_created_on" timestamp NOT NULL, + "ob_stored_by" character varying(255), + "ob_stored_from" character varying(255), + "ob_stored_on" timestamp, + "ob_downloaded_by" character varying(255), + "ob_downloaded_from" character varying(255), + "ob_downloaded_on" timestamp, + "ob_comment" character varying(255), + PRIMARY KEY ("ob_name", "ob_type") +); +CREATE INDEX "objects_idx_ob_acl_destroy" on "objects" ("ob_acl_destroy"); +CREATE INDEX "objects_idx_ob_acl_flags" on "objects" ("ob_acl_flags"); +CREATE INDEX "objects_idx_ob_acl_get" on "objects" ("ob_acl_get"); +CREATE INDEX "objects_idx_ob_owner" on "objects" ("ob_owner"); +CREATE INDEX "objects_idx_ob_acl_show" on "objects" ("ob_acl_show"); +CREATE INDEX "objects_idx_ob_acl_store" on "objects" ("ob_acl_store"); +CREATE INDEX "objects_idx_ob_type" on "objects" ("ob_type"); + +-- +-- Table: object_history +-- +DROP TABLE "object_history" CASCADE; +CREATE TABLE "object_history" ( + "oh_id" serial NOT NULL, + "oh_type" character varying(16) NOT NULL, + "oh_name" character varying(255) NOT NULL, + "oh_action" character varying(16) NOT NULL, + "oh_field" character varying(16), + "oh_type_field" character varying(255), + "oh_old" character varying(255), + "oh_new" character varying(255), + "oh_by" character varying(255) NOT NULL, + "oh_from" character varying(255) NOT NULL, + "oh_on" timestamp NOT NULL, + PRIMARY KEY ("oh_id") +); +CREATE INDEX "object_history_idx_oh_type_oh_name" on "object_history" ("oh_type", "oh_name"); + +-- +-- Foreign Key Definitions +-- + +ALTER TABLE "acl_entries" ADD FOREIGN KEY ("ae_scheme") + REFERENCES "acl_schemes" ("as_name") DEFERRABLE; + +ALTER TABLE "acl_entries" ADD FOREIGN KEY ("ae_id") + REFERENCES "acls" ("ac_id") ON DELETE CASCADE ON UPDATE CASCADE DEFERRABLE; + +ALTER TABLE "objects" ADD FOREIGN KEY ("ob_acl_destroy") + REFERENCES "acls" ("ac_id") ON DELETE CASCADE ON UPDATE CASCADE DEFERRABLE; + +ALTER TABLE "objects" ADD FOREIGN KEY ("ob_acl_flags") + REFERENCES "acls" ("ac_id") ON DELETE CASCADE ON UPDATE CASCADE DEFERRABLE; + +ALTER TABLE "objects" ADD FOREIGN KEY ("ob_acl_get") + REFERENCES "acls" ("ac_id") ON DELETE CASCADE ON UPDATE CASCADE DEFERRABLE; + +ALTER TABLE "objects" ADD FOREIGN KEY ("ob_owner") + REFERENCES "acls" ("ac_id") ON DELETE CASCADE ON UPDATE CASCADE DEFERRABLE; + +ALTER TABLE "objects" ADD FOREIGN KEY ("ob_acl_show") + REFERENCES "acls" ("ac_id") ON DELETE CASCADE ON UPDATE CASCADE DEFERRABLE; + +ALTER TABLE "objects" ADD FOREIGN KEY ("ob_acl_store") + REFERENCES "acls" ("ac_id") ON DELETE CASCADE ON UPDATE CASCADE DEFERRABLE; + +ALTER TABLE "objects" ADD FOREIGN KEY ("ob_type") + REFERENCES "types" ("ty_name") DEFERRABLE; + +ALTER TABLE "object_history" ADD FOREIGN KEY ("oh_type", "oh_name") + REFERENCES "objects" ("ob_type", "ob_name") DEFERRABLE; + diff --git a/perl/sql/Wallet-Schema-0.08-SQLite.sql b/perl/sql/Wallet-Schema-0.08-SQLite.sql new file mode 100644 index 0000000..9936c20 --- /dev/null +++ b/perl/sql/Wallet-Schema-0.08-SQLite.sql @@ -0,0 +1,201 @@ +-- +-- Created by SQL::Translator::Producer::SQLite +-- Created on Fri Jan 25 14:12:02 2013 +-- + +BEGIN TRANSACTION; + +-- +-- Table: acl_history +-- +DROP TABLE IF EXISTS acl_history; + +CREATE TABLE acl_history ( + ah_id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL, + ah_acl integer NOT NULL, + ah_action varchar(16) NOT NULL, + ah_scheme varchar(32), + ah_identifier varchar(255), + ah_by varchar(255) NOT NULL, + ah_from varchar(255) NOT NULL, + ah_on datetime NOT NULL +); + +-- +-- Table: acl_schemes +-- +DROP TABLE IF EXISTS acl_schemes; + +CREATE TABLE acl_schemes ( + as_name varchar(32) NOT NULL, + as_class varchar(64), + PRIMARY KEY (as_name) +); + +-- +-- Table: acls +-- +DROP TABLE IF EXISTS acls; + +CREATE TABLE acls ( + ac_id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL, + ac_name varchar(255) NOT NULL +); + +CREATE UNIQUE INDEX ac_name ON acls (ac_name); + +-- +-- Table: enctypes +-- +DROP TABLE IF EXISTS enctypes; + +CREATE TABLE enctypes ( + en_name varchar(255) NOT NULL, + PRIMARY KEY (en_name) +); + +-- +-- Table: flags +-- +DROP TABLE IF EXISTS flags; + +CREATE TABLE flags ( + fl_type varchar(16) NOT NULL, + fl_name varchar(255) NOT NULL, + fl_flag varchar(32) NOT NULL, + PRIMARY KEY (fl_type, fl_name, fl_flag) +); + +-- +-- Table: keytab_enctypes +-- +DROP TABLE IF EXISTS keytab_enctypes; + +CREATE TABLE keytab_enctypes ( + ke_name varchar(255) NOT NULL, + ke_enctype varchar(255) NOT NULL, + PRIMARY KEY (ke_name, ke_enctype) +); + +-- +-- Table: keytab_sync +-- +DROP TABLE IF EXISTS keytab_sync; + +CREATE TABLE keytab_sync ( + ks_name varchar(255) NOT NULL, + ks_target varchar(255) NOT NULL, + PRIMARY KEY (ks_name, ks_target) +); + +-- +-- Table: sync_targets +-- +DROP TABLE IF EXISTS sync_targets; + +CREATE TABLE sync_targets ( + st_name varchar(255) NOT NULL, + PRIMARY KEY (st_name) +); + +-- +-- Table: types +-- +DROP TABLE IF EXISTS types; + +CREATE TABLE types ( + ty_name varchar(16) NOT NULL, + ty_class varchar(64), + PRIMARY KEY (ty_name) +); + +-- +-- Table: acl_entries +-- +DROP TABLE IF EXISTS acl_entries; + +CREATE TABLE acl_entries ( + ae_id integer NOT NULL, + ae_scheme varchar(32) NOT NULL, + ae_identifier varchar(255) NOT NULL, + PRIMARY KEY (ae_id, ae_scheme, ae_identifier), + FOREIGN KEY(ae_scheme) REFERENCES acl_schemes(as_name), + FOREIGN KEY(ae_id) REFERENCES acls(ac_id) +); + +CREATE INDEX acl_entries_idx_ae_scheme ON acl_entries (ae_scheme); + +CREATE INDEX acl_entries_idx_ae_id ON acl_entries (ae_id); + +-- +-- Table: objects +-- +DROP TABLE IF EXISTS objects; + +CREATE TABLE objects ( + ob_type varchar(16) NOT NULL, + ob_name varchar(255) NOT NULL, + ob_owner integer, + ob_acl_get integer, + ob_acl_store integer, + ob_acl_show integer, + ob_acl_destroy integer, + ob_acl_flags integer, + ob_expires datetime, + ob_created_by varchar(255) NOT NULL, + ob_created_from varchar(255) NOT NULL, + ob_created_on datetime NOT NULL, + ob_stored_by varchar(255), + ob_stored_from varchar(255), + ob_stored_on datetime, + ob_downloaded_by varchar(255), + ob_downloaded_from varchar(255), + ob_downloaded_on datetime, + ob_comment varchar(255), + PRIMARY KEY (ob_name, ob_type), + FOREIGN KEY(ob_acl_destroy) REFERENCES acls(ac_id), + FOREIGN KEY(ob_acl_flags) REFERENCES acls(ac_id), + FOREIGN KEY(ob_acl_get) REFERENCES acls(ac_id), + FOREIGN KEY(ob_owner) REFERENCES acls(ac_id), + FOREIGN KEY(ob_acl_show) REFERENCES acls(ac_id), + FOREIGN KEY(ob_acl_store) REFERENCES acls(ac_id), + FOREIGN KEY(ob_type) REFERENCES types(ty_name) +); + +CREATE INDEX objects_idx_ob_acl_destroy ON objects (ob_acl_destroy); + +CREATE INDEX objects_idx_ob_acl_flags ON objects (ob_acl_flags); + +CREATE INDEX objects_idx_ob_acl_get ON objects (ob_acl_get); + +CREATE INDEX objects_idx_ob_owner ON objects (ob_owner); + +CREATE INDEX objects_idx_ob_acl_show ON objects (ob_acl_show); + +CREATE INDEX objects_idx_ob_acl_store ON objects (ob_acl_store); + +CREATE INDEX objects_idx_ob_type ON objects (ob_type); + +-- +-- Table: object_history +-- +DROP TABLE IF EXISTS object_history; + +CREATE TABLE object_history ( + oh_id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL, + oh_type varchar(16) NOT NULL, + oh_name varchar(255) NOT NULL, + oh_action varchar(16) NOT NULL, + oh_field varchar(16), + oh_type_field varchar(255), + oh_old varchar(255), + oh_new varchar(255), + oh_by varchar(255) NOT NULL, + oh_from varchar(255) NOT NULL, + oh_on datetime NOT NULL, + FOREIGN KEY(oh_type) REFERENCES objects(ob_type) +); + +CREATE INDEX object_history_idx_oh_type_oh_name ON object_history (oh_type, oh_name); + +COMMIT; diff --git a/perl/t/admin.t b/perl/t/admin.t index 6250f8e..cf6a637 100755 --- a/perl/t/admin.t +++ b/perl/t/admin.t @@ -8,12 +8,13 @@ # # See LICENSE for licensing terms. -use Test::More tests => 18; +use Test::More tests => 23; use Wallet::Admin; use Wallet::Report; use Wallet::Schema; use Wallet::Server; +use DBI; use lib 't/lib'; use Util; @@ -56,6 +57,24 @@ is ($admin->register_verifier ('base', 'Wallet::ACL::Base'), undef, is ($server->acl_add ('ADMIN', 'base', 'foo'), 1, ' and adding a base ACL now works'); +# Test an upgrade. Reinitialize to an older version, then test upgrade to +# the current version. +$Wallet::Schema::VERSION = '0.07'; +is ($admin->reinitialize ('admin@EXAMPLE.COM'), 1, + ' and re-initialization succeeds'); +$Wallet::Schema::VERSION = '0.08'; +my $schema = $admin->dbh; +$schema->upgrade_directory ('sql/'); +my $retval = $admin->upgrade; +is ($retval, 1, 'Performing an upgrade succeeds'); +my $dbh = $schema->storage->dbh; +my $sql = "select version from dbix_class_schema_versions order by version " + ."DESC"; +$version = $dbh->selectall_arrayref ($sql); +is (@$version, 2, ' and versions table has correct number of rows'); +is (@{ $version->[0] }, 1, ' and correct number of columns'); +is ($version->[0][0], '0.08', ' and the schema version is correct'); + # Clean up. is ($admin->destroy, 1, 'Destruction succeeds'); unlink 'wallet-db'; diff --git a/perl/t/lib/Util.pm b/perl/t/lib/Util.pm index 8bbefc4..c15ccfe 100644 --- a/perl/t/lib/Util.pm +++ b/perl/t/lib/Util.pm @@ -45,6 +45,7 @@ sub contents { # for testing by default, but support t/data/test.database as a configuration # file to use another database backend. sub db_setup { + $Wallet::Config::DB_DDL_DIRECTORY = 'sql/'; if (-f 't/data/test.database') { open (DB, '<', 't/data/test.database') or die "cannot open t/data/test.database: $!"; @@ -60,6 +61,10 @@ sub db_setup { $Wallet::Config::DB_USER = $user if $user; $Wallet::Config::DB_PASSWORD = $password if $password; } else { + + # If we have a new SQLite db by default, disable version checking. + $ENV{DBIC_NO_VERSION_CHECK} = 1; + $Wallet::Config::DB_DRIVER = 'SQLite'; $Wallet::Config::DB_INFO = 'wallet-db'; unlink 'wallet-db'; diff --git a/perl/t/report.t b/perl/t/report.t index 363db20..13ef7b6 100755 --- a/perl/t/report.t +++ b/perl/t/report.t @@ -145,7 +145,7 @@ is (scalar (@lines), 1, 'Searching for objects owned by ADMIN finds one'); is ($lines[0][0], 'base', ' and it has the right type'); is ($lines[0][1], 'service/admin', ' and the right name'); @lines = $report->objects ('owner', 'null'); -is (scalar (@lines), 1, 'Searching for objects with no set ownerfinds one'); +is (scalar (@lines), 1, 'Searching for objects with no set owner finds one'); is ($lines[0][0], 'base', ' and it has the right type'); is ($lines[0][1], 'service/null', ' and the right name'); @lines = $report->objects ('acl', 'ADMIN'); diff --git a/perl/t/schema.t b/perl/t/schema.t deleted file mode 100755 index 5dd90d1..0000000 --- a/perl/t/schema.t +++ /dev/null @@ -1,111 +0,0 @@ -#!/usr/bin/perl -w -# -# Tests for the wallet schema class. -# -# Written by Russ Allbery -# Copyright 2007, 2008, 2011 -# The Board of Trustees of the Leland Stanford Junior University -# -# See LICENSE for licensing terms. - -use Test::More tests => 16; - -use DBI (); -use POSIX qw(strftime); -use Wallet::Config (); -use Wallet::Schema (); - -use lib 't/lib'; -use Util; - -my $schema = Wallet::Schema->new; -ok (defined $schema, 'Wallet::Schema creation'); -ok ($schema->isa ('Wallet::Schema'), ' and class verification'); -my @sql = $schema->sql; -ok (@sql > 0, 'sql() returns something'); -is (scalar (@sql), 32, ' and returns the right number of statements'); - -# Connect to a database and test create. -db_setup; -my $connect = "DBI:${Wallet::Config::DB_DRIVER}:${Wallet::Config::DB_INFO}"; -my $user = $Wallet::Config::DB_USER; -my $password = $Wallet::Config::DB_PASSWORD; -$dbh = DBI->connect ($connect, $user, $password); -if (not defined $dbh) { - die "cannot connect to database $connect: $DBI::errstr\n"; -} -$dbh->{RaiseError} = 1; -$dbh->{PrintError} = 0; -eval { $schema->create ($dbh) }; -is ($@, '', "create() doesn't die"); - -# Check that the version number is correct. -my $sql = "select md_version from metadata"; -my $version = $dbh->selectall_arrayref ($sql); -is (@$version, 1, 'metadata has correct number of rows'); -is (@{ $version->[0] }, 1, ' and correct number of columns'); -is ($version->[0][0], 1, ' and the schema version is correct'); - -# Test upgrading the database from version 0. SQLite cannot drop table -# columns, so we have to kill the table and then recreate it. -$dbh->do ("drop table metadata"); -if (lc ($Wallet::Config::DB_DRIVER) eq 'sqlite') { - ($sql) = grep { /create table objects/ } $schema->sql; - $sql =~ s/ob_comment .*,//; - $dbh->do ("drop table objects") - or die "cannot drop objects table: $DBI::errstr\n"; - $dbh->do ($sql) - or die "cannot recreate objects table: $DBI::errstr\n"; -} else { - $dbh->do ("alter table objects drop column ob_comment") - or die "cannot drop ob_comment column: $DBI::errstr\n"; -} -eval { $schema->upgrade ($dbh) }; -is ($@, '', "upgrade() doesn't die"); -$sql = "select md_version from metadata"; -$version = $dbh->selectall_arrayref ($sql); -is (@$version, 1, ' and metadata has correct number of rows'); -is (@{ $version->[0] }, 1, ' and correct number of columns'); -is ($version->[0][0], 1, ' and the schema version is correct'); -$sql = "insert into objects (ob_type, ob_name, ob_created_by, ob_created_from, - ob_created_on, ob_comment) values ('file', 'test', 'test', - 'test.example.org', ?, 'a test comment')"; -$dbh->do ($sql, undef, strftime ('%Y-%m-%d %T', localtime time)); -$sql = "select ob_comment from objects where ob_name = 'test'"; -my ($comment) = $dbh->selectrow_array ($sql); -is ($comment, 'a test comment', ' and ob_comment was added to objects'); - -# Test dropping the database. -eval { $schema->drop ($dbh) }; -is ($@, '', "drop() doesn't die"); - -# Make sure all the tables are gone. -SKIP: { - if (lc ($Wallet::Config::DB_DRIVER) eq 'sqlite') { - my $sql = "select name from sqlite_master where type = 'table'"; - my $sth = $dbh->prepare ($sql); - $sth->execute; - my ($table, @tables); - while (defined ($table = $sth->fetchrow_array)) { - push (@tables, $table) unless $table =~ /^sqlite_/; - } - is ("@tables", '', ' and there are no tables in the database'); - } elsif (lc ($Wallet::Config::DB_DRIVER) eq 'mysql') { - my $sql = "show tables"; - my $sth = $dbh->prepare ($sql); - $sth->execute; - my ($table, @tables); - while (defined ($table = $sth->fetchrow_array)) { - push (@tables, $table); - } - is ("@tables", '', ' and there are no tables in the database'); - } else { - skip 1; - } -} -eval { $schema->create ($dbh) }; -is ($@, '', ' and we can run create again'); - -# Clean up. -eval { $schema->drop ($dbh) }; -unlink 'wallet-db'; diff --git a/perl/t/server.t b/perl/t/server.t index 8e0a30d..63f2e76 100755 --- a/perl/t/server.t +++ b/perl/t/server.t @@ -1030,5 +1030,5 @@ is ($@, "database connection information not configured\n", ' or if DB_INFO is not set'); $Wallet::Config::DB_INFO = 't'; $server = eval { Wallet::Server->new ($user2, $host) }; -like ($@, qr/^cannot connect to database: /, +like ($@, qr/unable to open database file/, ' or if the database connection fails'); diff --git a/server/wallet-admin b/server/wallet-admin index 94d62c7..7e5a402 100755 --- a/server/wallet-admin +++ b/server/wallet-admin @@ -15,6 +15,13 @@ use strict; use Wallet::Admin; +# The last non-DBIx::Class version. If a database has no DBIx::Class +# versioning, we want to set it to this so that upgrades can begin. +our $BASE_VERSION = '0.07'; + +# Directory that contains the wallet SQL files for upgrades. +our $SQL_DIR = '/usr/share/wallet/sql/'; + ############################################################################## # Implementation ############################################################################## @@ -41,6 +48,9 @@ sub command { die "too few arguments to initialize\n" if @args < 1; die "invalid admin principal $args[0]\n" unless $args[0] =~ /^[^\@\s]+\@\S+$/; + + my $schema = $admin->{dbh}; + $schema->upgrade_directory ($SQL_DIR); $admin->initialize (@args) or die $admin->error, "\n"; } elsif ($command eq 'register') { die "too many arguments to register\n" if @args > 3; @@ -59,7 +69,20 @@ sub command { } } elsif ($command eq 'upgrade') { die "too many arguments to upgrade\n" if @args; + + my $schema = $admin->{dbh}; + $schema->upgrade_directory ($SQL_DIR); + + # Check to see if the database is versioned. If not, install the + # versioning table and default version. + if (!$schema->get_db_version) { + print "Versioning database.\n"; + $schema->install ($BASE_VERSION); + } + + # Actually upgrade. $admin->upgrade or die $admin->error, "\n"; + } else { die "unknown command $command\n"; } -- cgit v1.2.3 From dc5d5b7d4a10cf44c356e8f920d852ef26601e1b Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Wed, 13 Feb 2013 18:25:53 -0800 Subject: Install the wallet schema during make install Install the wallet schema files generated by DBIx::Class for the various supported database engines into /usr/local/share/wallet (by default, using pkgdatadir) on make install. Set the default $DB_DDL_DIRECTORY value in Wallet::Config accordingly. Change-Id: I7ec52b171bc6aca2c3e1040c037e7cf24553231f Reviewed-on: https://gerrit.stanford.edu/794 Reviewed-by: Russ Allbery Tested-by: Russ Allbery --- Makefile.am | 13 +++++++++++-- TODO | 6 ------ perl/Wallet/Config.pm | 21 +++++++++++---------- 3 files changed, 22 insertions(+), 18 deletions(-) (limited to 'perl/Wallet/Config.pm') diff --git a/Makefile.am b/Makefile.am index 1c42b2d..0e1d99c 100644 --- a/Makefile.am +++ b/Makefile.am @@ -1,8 +1,8 @@ # Automake makefile for wallet. # # Written by Russ Allbery -# Copyright 2006, 2007, 2008, 2010 -# Board of Trustees, Leland Stanford Jr. University +# Copyright 2006, 2007, 2008, 2010, 2013 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -82,6 +82,15 @@ client_wallet_rekey_LDADD = client/libwallet.a util/libutil.a \ dist_man_MANS = client/wallet.1 client/wallet-rekey.1 server/keytab-backend.8 \ server/wallet-admin.8 server/wallet-backend.8 server/wallet-report.8 +# Install the SQL files that are used by the server code to do upgrades. +dist_pkgdata_DATA = perl/sql/Wallet-Schema-0.07-0.08-MySQL.sql \ + perl/sql/Wallet-Schema-0.07-0.08-SQLite.sql \ + perl/sql/Wallet-Schema-0.07-MySQL.sql \ + perl/sql/Wallet-Schema-0.07-SQLite.sql \ + perl/sql/Wallet-Schema-0.08-MySQL.sql \ + perl/sql/Wallet-Schema-0.08-PostgreSQL.sql \ + perl/sql/Wallet-Schema-0.08-SQLite.sql + # A set of flags for warnings. Add -O because gcc won't find some warnings # without optimization turned on. Desirable warnings that can't be turned # on due to other problems: diff --git a/TODO b/TODO index 07d7a2c..cd95736 100644 --- a/TODO +++ b/TODO @@ -183,12 +183,6 @@ Administrative Interface: but it's supposed to work directly from the classes. Double-check this. -Installation: - - * WALLET-65: Install the SQL files and set a default value for - $DB_DDL_DIRECTORY. Document this in the installation instructions. - Test for the validity of that variable before doing upgrades? - Documentation: * WALLET-43: Write a conventions document for ACL naming, object naming, diff --git a/perl/Wallet/Config.pm b/perl/Wallet/Config.pm index 98dae03..9649c6c 100644 --- a/perl/Wallet/Config.pm +++ b/perl/Wallet/Config.pm @@ -84,6 +84,17 @@ file. =over 4 +=item DB_DDL_DIRECTORY + +Specifies the directory used to dump the database schema in formats for +each possible database server. This also includes diffs between schema +versions, for upgrades. The default value is F, +which matches the default installation location. + +=cut + +our $DB_DDL_DIRECTORY = '/usr/local/share/wallet'; + =item DB_DRIVER Sets the Perl database driver to use for the wallet database. Common @@ -167,16 +178,6 @@ backends, particularly SQLite, do not need this. our $DB_PASSWORD; -=item DB_DDL_DIRECTORY - -Specifies the directory used to dump the database schema in formats for -each possible database server. This also includes diffs between schema -versions, for upgrades. - -=cut - -our $DB_DDL_DIRECTORY; - =back =head1 FILE OBJECT CONFIGURATION -- cgit v1.2.3 From 4d11772001f65264bf714711550acdbb05900f4c Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Wed, 27 Feb 2013 14:46:47 -0800 Subject: Use correct form of Stanford's copyright statement Change-Id: I06dd9ecca19315179bdd34d4b301548fe7604331 Reviewed-on: https://gerrit.stanford.edu/842 Reviewed-by: Russ Allbery Tested-by: Russ Allbery --- client/file.c | 3 ++- client/internal.h | 3 ++- client/keytab.c | 3 ++- client/krb5.c | 3 ++- client/options.c | 2 +- client/remctl.c | 3 ++- client/srvtab.c | 3 ++- client/wallet-rekey.c | 3 ++- client/wallet.c | 2 +- configure.ac | 4 +--- contrib/convert-srvtab-db | 3 ++- contrib/used-principals | 3 ++- contrib/wallet-contacts | 3 ++- contrib/wallet-summary | 3 ++- contrib/wallet-unknown-hosts | 3 ++- examples/stanford.conf | 3 ++- perl/Wallet/ACL.pm | 3 ++- perl/Wallet/ACL/Base.pm | 3 ++- perl/Wallet/ACL/Krb5.pm | 3 ++- perl/Wallet/ACL/Krb5/Regex.pm | 3 ++- perl/Wallet/ACL/NetDB.pm | 3 ++- perl/Wallet/ACL/NetDB/Root.pm | 3 ++- perl/Wallet/Config.pm | 3 ++- perl/Wallet/Database.pm | 3 ++- perl/Wallet/Kadmin.pm | 3 ++- perl/Wallet/Kadmin/Heimdal.pm | 3 ++- perl/Wallet/Kadmin/MIT.pm | 2 +- perl/Wallet/Object/File.pm | 3 ++- perl/Wallet/Object/Keytab.pm | 4 ++-- perl/Wallet/Report.pm | 3 ++- perl/create-ddl | 3 ++- perl/t/acl.t | 3 ++- perl/t/config.t | 3 ++- perl/t/file.t | 3 ++- perl/t/init.t | 3 ++- perl/t/keytab.t | 2 +- perl/t/lib/Util.pm | 3 ++- perl/t/pod.t | 3 ++- perl/t/report.t | 3 ++- perl/t/verifier-netdb.t | 3 ++- perl/t/verifier.t | 3 ++- server/keytab-backend | 2 +- server/wallet-report | 3 ++- tests/client/basic-t.in | 2 +- tests/client/full-t.in | 3 ++- tests/client/prompt-t.in | 3 ++- tests/client/rekey-t.in | 2 +- tests/data/cmd-fake | 4 +++- tests/data/fake-kadmin | 3 ++- tests/server/keytab-t | 3 ++- tests/server/report-t | 3 ++- 51 files changed, 95 insertions(+), 54 deletions(-) (limited to 'perl/Wallet/Config.pm') diff --git a/client/file.c b/client/file.c index 861da6a..c171969 100644 --- a/client/file.c +++ b/client/file.c @@ -2,7 +2,8 @@ * File handling for the wallet client. * * Written by Russ Allbery - * Copyright 2007, 2008, 2010 Board of Trustees, Leland Stanford Jr. University + * Copyright 2007, 2008, 2010 + * The Board of Trustees of the Leland Stanford Junior University * * See LICENSE for licensing terms. */ diff --git a/client/internal.h b/client/internal.h index c8e5802..24dd875 100644 --- a/client/internal.h +++ b/client/internal.h @@ -2,7 +2,8 @@ * Internal support functions for the wallet client. * * Written by Russ Allbery - * Copyright 2007, 2008, 2010 Board of Trustees, Leland Stanford Jr. University + * Copyright 2007, 2008, 2010 + * The Board of Trustees of the Leland Stanford Junior University * * See LICENSE for licensing terms. */ diff --git a/client/keytab.c b/client/keytab.c index 6614c4b..0a3e419 100644 --- a/client/keytab.c +++ b/client/keytab.c @@ -2,7 +2,8 @@ * Implementation of keytab handling for the wallet client. * * Written by Russ Allbery - * Copyright 2007, 2008, 2010 Board of Trustees, Leland Stanford Jr. University + * Copyright 2007, 2008, 2010, 2013 + * The Board of Trustees of the Leland Stanford Junior University * * See LICENSE for licensing terms. */ diff --git a/client/krb5.c b/client/krb5.c index aad39f6..e86a225 100644 --- a/client/krb5.c +++ b/client/krb5.c @@ -6,7 +6,8 @@ * client. * * Written by Russ Allbery - * Copyright 2007, 2008, 2010 Board of Trustees, Leland Stanford Jr. University + * Copyright 2007, 2008, 2010 + * The Board of Trustees of the Leland Stanford Junior University */ #include diff --git a/client/options.c b/client/options.c index 2f1de70..67ecb7f 100644 --- a/client/options.c +++ b/client/options.c @@ -6,7 +6,7 @@ * * Written by Russ Allbery * Copyright 2006, 2007, 2008, 2010 - * Board of Trustees, Leland Stanford Jr. University + * The Board of Trustees of the Leland Stanford Junior University * * See LICENSE for licensing terms. */ diff --git a/client/remctl.c b/client/remctl.c index 5a541d5..071e410 100644 --- a/client/remctl.c +++ b/client/remctl.c @@ -2,7 +2,8 @@ * remctl interface for the wallet client. * * Written by Russ Allbery - * Copyright 2007, 2010 Board of Trustees, Leland Stanford Jr. University + * Copyright 2007, 2010 + * The Board of Trustees of the Leland Stanford Junior University * * See LICENSE for licensing terms. */ diff --git a/client/srvtab.c b/client/srvtab.c index b26e6fc..73277e9 100644 --- a/client/srvtab.c +++ b/client/srvtab.c @@ -2,7 +2,8 @@ * Implementation of srvtab handling for the wallet client. * * Written by Russ Allbery - * Copyright 2007, 2008, 2010 Board of Trustees, Leland Stanford Jr. University + * Copyright 2007, 2008, 2010 + * The Board of Trustees of the Leland Stanford Junior University * * See LICENSE for licensing terms. */ diff --git a/client/wallet-rekey.c b/client/wallet-rekey.c index 3a9687c..5007f41 100644 --- a/client/wallet-rekey.c +++ b/client/wallet-rekey.c @@ -3,7 +3,8 @@ * * Written by Russ Allbery * and Jon Robertson - * Copyright 2010 Board of Trustees, Leland Stanford Jr. University + * Copyright 2010 + * The Board of Trustees of the Leland Stanford Junior University * * See LICENSE for licensing terms. */ diff --git a/client/wallet.c b/client/wallet.c index dc04dcd..c5a7877 100644 --- a/client/wallet.c +++ b/client/wallet.c @@ -3,7 +3,7 @@ * * Written by Russ Allbery * Copyright 2006, 2007, 2008, 2010 - * Board of Trustees, Leland Stanford Jr. University + * The Board of Trustees of the Leland Stanford Junior University * * See LICENSE for licensing terms. */ diff --git a/configure.ac b/configure.ac index a79e42d..4fc218b 100644 --- a/configure.ac +++ b/configure.ac @@ -2,12 +2,10 @@ dnl Autoconf configuration for wallet. dnl dnl Written by Russ Allbery dnl Copyright 2006, 2007, 2008, 2010 -dnl Board of Trustees, Leland Stanford Jr. University +dnl The Board of Trustees of the Leland Stanford Junior University dnl dnl See LICENSE for licensing terms. -dnl We cannot use -Wall -Werror with AM_INIT_AUTOMAKE since we override -dnl distuninstallcheck (not supported by Perl). AC_PREREQ([2.64]) AC_INIT([wallet], [0.12], [rra@stanford.edu]) AC_CONFIG_AUX_DIR([build-aux]) diff --git a/contrib/convert-srvtab-db b/contrib/convert-srvtab-db index 8d3b31e..6263472 100755 --- a/contrib/convert-srvtab-db +++ b/contrib/convert-srvtab-db @@ -3,7 +3,8 @@ # convert-srvtab-db -- Converts a leland_srvtab database to wallet # # Written by Russ Allbery -# Copyright 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/contrib/used-principals b/contrib/used-principals index aa838fe..ca431e3 100755 --- a/contrib/used-principals +++ b/contrib/used-principals @@ -3,7 +3,8 @@ # used-principals -- Report which Kerberos v5 principals are in use. # # Written by Russ Allbery -# Copyright 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/contrib/wallet-contacts b/contrib/wallet-contacts index 177fc76..907c161 100755 --- a/contrib/wallet-contacts +++ b/contrib/wallet-contacts @@ -3,7 +3,8 @@ # wallet-contacts -- Report contact addresses for matching wallet objects. # # Written by Russ Allbery -# Copyright 2009 Board of Trustees, Leland Stanford Jr. University +# Copyright 2009 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/contrib/wallet-summary b/contrib/wallet-summary index aba8406..2237351 100755 --- a/contrib/wallet-summary +++ b/contrib/wallet-summary @@ -3,7 +3,8 @@ # wallet-summary -- Summarize keytabs in the wallet database. # # Written by Russ Allbery -# Copyright 2003, 2008, 2010 Board of Trustees, Leland Stanford Jr. University +# Copyright 2003, 2008, 2010 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/contrib/wallet-unknown-hosts b/contrib/wallet-unknown-hosts index da972b2..e19dcf0 100755 --- a/contrib/wallet-unknown-hosts +++ b/contrib/wallet-unknown-hosts @@ -3,7 +3,8 @@ # wallet-unknown-hosts -- Report host keytabs in wallet for unknown hosts. # # Written by Russ Allbery -# Copyright 2010 Board of Trustees, Leland Stanford Jr. University +# Copyright 2010 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/examples/stanford.conf b/examples/stanford.conf index becfc6e..1d14796 100644 --- a/examples/stanford.conf +++ b/examples/stanford.conf @@ -6,7 +6,8 @@ # ACL rules. # # Written by Russ Allbery -# Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2008 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/perl/Wallet/ACL.pm b/perl/Wallet/ACL.pm index 1e62e7b..5d9e8f2 100644 --- a/perl/Wallet/ACL.pm +++ b/perl/Wallet/ACL.pm @@ -1,7 +1,8 @@ # Wallet::ACL -- Implementation of ACLs in the wallet system. # # Written by Russ Allbery -# Copyright 2007, 2008, 2010 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2008, 2010, 2013 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/perl/Wallet/ACL/Base.pm b/perl/Wallet/ACL/Base.pm index 85eaefa..5112c2f 100644 --- a/perl/Wallet/ACL/Base.pm +++ b/perl/Wallet/ACL/Base.pm @@ -1,7 +1,8 @@ # Wallet::ACL::Base -- Parent class for wallet ACL verifiers. # # Written by Russ Allbery -# Copyright 2007, 2010 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2010 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/perl/Wallet/ACL/Krb5.pm b/perl/Wallet/ACL/Krb5.pm index 12be141..716a223 100644 --- a/perl/Wallet/ACL/Krb5.pm +++ b/perl/Wallet/ACL/Krb5.pm @@ -1,7 +1,8 @@ # Wallet::ACL::Krb5 -- Wallet Kerberos v5 principal ACL verifier. # # Written by Russ Allbery -# Copyright 2007, 2010 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2010 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/perl/Wallet/ACL/Krb5/Regex.pm b/perl/Wallet/ACL/Krb5/Regex.pm index 8f9702e..ce2fe48 100644 --- a/perl/Wallet/ACL/Krb5/Regex.pm +++ b/perl/Wallet/ACL/Krb5/Regex.pm @@ -1,7 +1,8 @@ # Wallet::ACL::Krb5::Regex -- Wallet Kerberos v5 principal regex ACL verifier # # Written by Russ Allbery -# Copyright 2007, 2010 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2010 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/perl/Wallet/ACL/NetDB.pm b/perl/Wallet/ACL/NetDB.pm index 0aa8958..2d35f49 100644 --- a/perl/Wallet/ACL/NetDB.pm +++ b/perl/Wallet/ACL/NetDB.pm @@ -1,7 +1,8 @@ # Wallet::ACL::NetDB -- Wallet NetDB role ACL verifier. # # Written by Russ Allbery -# Copyright 2007, 2010 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2010 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/perl/Wallet/ACL/NetDB/Root.pm b/perl/Wallet/ACL/NetDB/Root.pm index c28bb1e..ea79d79 100644 --- a/perl/Wallet/ACL/NetDB/Root.pm +++ b/perl/Wallet/ACL/NetDB/Root.pm @@ -1,7 +1,8 @@ # Wallet::ACL::NetDB::Root -- Wallet NetDB role ACL verifier (root instances). # # Written by Russ Allbery -# Copyright 2007, 2010 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2010 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/perl/Wallet/Config.pm b/perl/Wallet/Config.pm index 9649c6c..af153e7 100644 --- a/perl/Wallet/Config.pm +++ b/perl/Wallet/Config.pm @@ -1,7 +1,8 @@ # Wallet::Config -- Configuration handling for the wallet server. # # Written by Russ Allbery -# Copyright 2007, 2008, 2010 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2008, 2010, 2013 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/perl/Wallet/Database.pm b/perl/Wallet/Database.pm index 8df338a..61de0ba 100644 --- a/perl/Wallet/Database.pm +++ b/perl/Wallet/Database.pm @@ -6,7 +6,8 @@ # like DBIx::Class objects in the rest of the code. # # Written by Russ Allbery -# Copyright 2008-2012 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008, 2009, 2010, 2012, 2013 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/perl/Wallet/Kadmin.pm b/perl/Wallet/Kadmin.pm index 074dd1e..bfff3ef 100644 --- a/perl/Wallet/Kadmin.pm +++ b/perl/Wallet/Kadmin.pm @@ -1,7 +1,8 @@ # Wallet::Kadmin -- Kerberos administration API for wallet keytab backend. # # Written by Jon Robertson -# Copyright 2009, 2010 Board of Trustees, Leland Stanford Jr. University +# Copyright 2009, 2010 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/perl/Wallet/Kadmin/Heimdal.pm b/perl/Wallet/Kadmin/Heimdal.pm index 6c91b1d..bb07b93 100644 --- a/perl/Wallet/Kadmin/Heimdal.pm +++ b/perl/Wallet/Kadmin/Heimdal.pm @@ -1,7 +1,8 @@ # Wallet::Kadmin::Heimdal -- Wallet Kerberos administration API for Heimdal. # # Written by Jon Robertson -# Copyright 2009, 2010 Board of Trustees, Leland Stanford Jr. University +# Copyright 2009, 2010 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/perl/Wallet/Kadmin/MIT.pm b/perl/Wallet/Kadmin/MIT.pm index c191bc9..b633e67 100644 --- a/perl/Wallet/Kadmin/MIT.pm +++ b/perl/Wallet/Kadmin/MIT.pm @@ -3,7 +3,7 @@ # Written by Russ Allbery # Pulled into a module by Jon Robertson # Copyright 2007, 2008, 2009, 2010 -# Board of Trustees, Leland Stanford Jr. University +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/perl/Wallet/Object/File.pm b/perl/Wallet/Object/File.pm index 69468e1..49589f1 100644 --- a/perl/Wallet/Object/File.pm +++ b/perl/Wallet/Object/File.pm @@ -1,7 +1,8 @@ # Wallet::Object::File -- File object implementation for the wallet. # # Written by Russ Allbery -# Copyright 2008, 2010 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008, 2010 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/perl/Wallet/Object/Keytab.pm b/perl/Wallet/Object/Keytab.pm index 962c19b..e00747b 100644 --- a/perl/Wallet/Object/Keytab.pm +++ b/perl/Wallet/Object/Keytab.pm @@ -1,8 +1,8 @@ # Wallet::Object::Keytab -- Keytab object implementation for the wallet. # # Written by Russ Allbery -# Copyright 2007, 2008, 2009, 2010 -# Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2008, 2009, 2010, 2013 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/perl/Wallet/Report.pm b/perl/Wallet/Report.pm index ff25b3a..b27a998 100644 --- a/perl/Wallet/Report.pm +++ b/perl/Wallet/Report.pm @@ -1,7 +1,8 @@ # Wallet::Report -- Wallet system reporting interface. # # Written by Russ Allbery -# Copyright 2008, 2009, 2010 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008, 2009, 2010, 2013 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/perl/create-ddl b/perl/create-ddl index 62deb86..10f126a 100755 --- a/perl/create-ddl +++ b/perl/create-ddl @@ -3,7 +3,8 @@ # create-ddl - Create DDL files for Wallet # # Written by Jon Robertson -# Copyright 2012 Board of Trustees, Leland Stanford Jr. University +# Copyright 2012 +# The Board of Trustees of the Leland Stanford Junior University ############################################################################# # Modules and declarations diff --git a/perl/t/acl.t b/perl/t/acl.t index 62eb411..26b4903 100755 --- a/perl/t/acl.t +++ b/perl/t/acl.t @@ -3,7 +3,8 @@ # Tests for the wallet ACL API. # # Written by Russ Allbery -# Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2008 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/perl/t/config.t b/perl/t/config.t index 6b9f226..543e5d6 100755 --- a/perl/t/config.t +++ b/perl/t/config.t @@ -3,7 +3,8 @@ # Tests for the wallet server configuration. # # Written by Russ Allbery -# Copyright 2008, 2010 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008, 2010 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/perl/t/file.t b/perl/t/file.t index f902fba..5cb7c35 100755 --- a/perl/t/file.t +++ b/perl/t/file.t @@ -3,7 +3,8 @@ # Tests for the file object implementation. # # Written by Russ Allbery -# Copyright 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/perl/t/init.t b/perl/t/init.t index aa028e3..142f54c 100755 --- a/perl/t/init.t +++ b/perl/t/init.t @@ -3,7 +3,8 @@ # Tests for database initialization. # # Written by Russ Allbery -# Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2008 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/perl/t/keytab.t b/perl/t/keytab.t index 561f130..3ced592 100755 --- a/perl/t/keytab.t +++ b/perl/t/keytab.t @@ -4,7 +4,7 @@ # # Written by Russ Allbery # Copyright 2007, 2008, 2009, 2010 -# Board of Trustees, Leland Stanford Jr. University +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/perl/t/lib/Util.pm b/perl/t/lib/Util.pm index c15ccfe..3e606fe 100644 --- a/perl/t/lib/Util.pm +++ b/perl/t/lib/Util.pm @@ -1,7 +1,8 @@ # Utility class for wallet tests. # # Written by Russ Allbery -# Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2008 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/perl/t/pod.t b/perl/t/pod.t index c467b82..dc5f468 100755 --- a/perl/t/pod.t +++ b/perl/t/pod.t @@ -3,7 +3,8 @@ # Test POD formatting for the wallet Perl modules. # # Written by Russ Allbery -# Copyright 2007, 2010 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2010 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/perl/t/report.t b/perl/t/report.t index 13ef7b6..a6b85df 100755 --- a/perl/t/report.t +++ b/perl/t/report.t @@ -3,7 +3,8 @@ # Tests for the wallet reporting interface. # # Written by Russ Allbery -# Copyright 2008, 2009, 2010 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008, 2009, 2010 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/perl/t/verifier-netdb.t b/perl/t/verifier-netdb.t index 6bd4e73..398cc6a 100755 --- a/perl/t/verifier-netdb.t +++ b/perl/t/verifier-netdb.t @@ -7,7 +7,8 @@ # environments. # # Written by Russ Allbery -# Copyright 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/perl/t/verifier.t b/perl/t/verifier.t index f56f5fa..75f1afa 100755 --- a/perl/t/verifier.t +++ b/perl/t/verifier.t @@ -3,7 +3,8 @@ # Tests for the basic wallet ACL verifiers. # # Written by Russ Allbery -# Copyright 2007, 2008, 2010 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2008, 2010 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/server/keytab-backend b/server/keytab-backend index 7b6adb4..3ea3df0 100755 --- a/server/keytab-backend +++ b/server/keytab-backend @@ -18,7 +18,7 @@ # # Written by Russ Allbery # Copyright 2006, 2007, 2008, 2010 -# Board of Trustees, Leland Stanford Jr. University +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/server/wallet-report b/server/wallet-report index 992f5b8..0fd8aa9 100755 --- a/server/wallet-report +++ b/server/wallet-report @@ -3,7 +3,8 @@ # wallet-report -- Wallet server reporting interface. # # Written by Russ Allbery -# Copyright 2008, 2009, 2010 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008, 2009, 2010 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/tests/client/basic-t.in b/tests/client/basic-t.in index 11f0bce..836f394 100644 --- a/tests/client/basic-t.in +++ b/tests/client/basic-t.in @@ -4,7 +4,7 @@ # # Written by Russ Allbery # Copyright 2006, 2007, 2008, 2010 -# Board of Trustees, Leland Stanford Jr. University +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/tests/client/full-t.in b/tests/client/full-t.in index 680e78f..ebdba03 100644 --- a/tests/client/full-t.in +++ b/tests/client/full-t.in @@ -3,7 +3,8 @@ # End-to-end tests for the wallet client. # # Written by Russ Allbery -# Copyright 2008, 2010 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008, 2010 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/tests/client/prompt-t.in b/tests/client/prompt-t.in index 682cd70..06991cc 100644 --- a/tests/client/prompt-t.in +++ b/tests/client/prompt-t.in @@ -3,7 +3,8 @@ # Password prompting tests for the wallet client. # # Written by Russ Allbery -# Copyright 2008, 2010 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008, 2010 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/tests/client/rekey-t.in b/tests/client/rekey-t.in index 390a362..0cfcb5d 100644 --- a/tests/client/rekey-t.in +++ b/tests/client/rekey-t.in @@ -4,7 +4,7 @@ # # Written by Russ Allbery # Copyright 2006, 2007, 2008, 2010 -# Board of Trustees, Leland Stanford Jr. University +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/tests/data/cmd-fake b/tests/data/cmd-fake index add72fc..11791a6 100755 --- a/tests/data/cmd-fake +++ b/tests/data/cmd-fake @@ -4,7 +4,9 @@ # the client test suite. It doesn't test any of the wallet server code. # # Written by Russ Allbery -# Copyright 2007, 2008, 2010 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2008, 2010 +# The Board of Trustees of the Leland Stanford Junior University +# # See LICENSE for licensing terms. command="$1" diff --git a/tests/data/fake-kadmin b/tests/data/fake-kadmin index 4c0ceac..c073ea5 100755 --- a/tests/data/fake-kadmin +++ b/tests/data/fake-kadmin @@ -3,7 +3,8 @@ # Fake kadmin.local used to test the keytab backend. # # Written by Russ Allbery -# Copyright 2007 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/tests/server/keytab-t b/tests/server/keytab-t index 2a0ceed..a9f5450 100755 --- a/tests/server/keytab-t +++ b/tests/server/keytab-t @@ -3,7 +3,8 @@ # Tests for the keytab-backend dispatch code. # # Written by Russ Allbery -# Copyright 2006, 2007, 2010 Board of Trustees, Leland Stanford Jr. University +# Copyright 2006, 2007, 2010 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/tests/server/report-t b/tests/server/report-t index 0771946..43ec9d1 100755 --- a/tests/server/report-t +++ b/tests/server/report-t @@ -3,7 +3,8 @@ # Tests for the wallet-report dispatch code. # # Written by Russ Allbery -# Copyright 2008, 2009, 2010 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008, 2009, 2010 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. -- cgit v1.2.3