diff options
Diffstat (limited to 'perl')
39 files changed, 2708 insertions, 1660 deletions
diff --git a/perl/Makefile.PL.in b/perl/Makefile.PL.in index 1ba6004..5804d9b 100644 --- a/perl/Makefile.PL.in +++ b/perl/Makefile.PL.in @@ -1,5 +1,4 @@ # Makefile.PL for the Wallet Perl library. -*- perl -*- -# $Id$ use ExtUtils::MakeMaker; diff --git a/perl/Wallet/ACL.pm b/perl/Wallet/ACL.pm index b96d2ac..76e7354 100644 --- a/perl/Wallet/ACL.pm +++ b/perl/Wallet/ACL.pm @@ -1,8 +1,7 @@ # Wallet::ACL -- Implementation of ACLs in the wallet system. -# $Id$ # # Written by Russ Allbery <rra@stanford.edu> -# 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 +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 @@ -428,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'); @@ -446,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 @@ -482,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 @@ -493,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() @@ -543,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() @@ -570,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 @@ -599,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<http://www.eyrie.org/~eagle/software/wallet/>. +This module is part of the wallet system. The current version is +available from L<http://www.eyrie.org/~eagle/software/wallet/>. =head1 AUTHOR diff --git a/perl/Wallet/ACL/Base.pm b/perl/Wallet/ACL/Base.pm index 87df824..9a8a3cb 100644 --- a/perl/Wallet/ACL/Base.pm +++ b/perl/Wallet/ACL/Base.pm @@ -1,8 +1,7 @@ # Wallet::ACL::Base -- Parent class for wallet ACL verifiers. -# $Id$ # # Written by Russ Allbery <rra@stanford.edu> -# Copyright 2007 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2010 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -19,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 @@ -60,6 +59,9 @@ __END__ # Documentation ############################################################################## +=for stopwords +ACL Allbery + =head1 NAME Wallet::ACL::Base - Generic parent class for wallet ACL verifiers @@ -75,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 @@ -85,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) @@ -100,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<C< at \S+ line -\d+\.?>> 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<C< at \S+ +line \d+\.?>> 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 @@ -112,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<http://www.eyrie.org/~eagle/software/wallet/>. +This module is part of the wallet system. The current version is +available from L<http://www.eyrie.org/~eagle/software/wallet/>. =head1 AUTHOR diff --git a/perl/Wallet/ACL/Krb5.pm b/perl/Wallet/ACL/Krb5.pm index f94475f..496fcf0 100644 --- a/perl/Wallet/ACL/Krb5.pm +++ b/perl/Wallet/ACL/Krb5.pm @@ -1,8 +1,7 @@ # Wallet::ACL::Krb5 -- Wallet Kerberos v5 principal ACL verifier. -# $Id$ # # Written by Russ Allbery <rra@stanford.edu> -# 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 +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 @@ -51,6 +50,9 @@ __END__ # Documentation ############################################################################## +=for stopwords +ACL krb5 Allbery + =head1 NAME Wallet::ACL::Krb5 - Simple wallet ACL verifier for Kerberos principals @@ -70,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<krb5>. 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. @@ -112,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<http://www.eyrie.org/~eagle/software/wallet/>. +This module is part of the wallet system. The current version is +available from L<http://www.eyrie.org/~eagle/software/wallet/>. =head1 AUTHOR diff --git a/perl/Wallet/ACL/NetDB.pm b/perl/Wallet/ACL/NetDB.pm index cc7121b..2096ba8 100644 --- a/perl/Wallet/ACL/NetDB.pm +++ b/perl/Wallet/ACL/NetDB.pm @@ -1,8 +1,7 @@ # Wallet::ACL::NetDB -- Wallet NetDB role ACL verifier. -# $Id$ # # Written by Russ Allbery <rra@stanford.edu> -# Copyright 2007 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2010 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -24,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 @@ -136,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 @@ -155,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<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. To use this object, several configuration parameters must be set. See Wallet::Config(3) for details on those configuration parameters and @@ -228,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. @@ -249,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<http://www.stanford.edu/group/networking/netdb/>. +NetDB is a free software system for managing DNS, DHCP, and related +machine information for large organizations. For more information on +NetDB, see L<http://www.stanford.edu/group/networking/netdb/>. -This module is part of the wallet system. The current version is available -from L<http://www.eyrie.org/~eagle/software/wallet/>. +This module is part of the wallet system. The current version is +available from L<http://www.eyrie.org/~eagle/software/wallet/>. =head1 AUTHOR diff --git a/perl/Wallet/ACL/NetDB/Root.pm b/perl/Wallet/ACL/NetDB/Root.pm index 8c2c6b2..3aeebda 100644 --- a/perl/Wallet/ACL/NetDB/Root.pm +++ b/perl/Wallet/ACL/NetDB/Root.pm @@ -1,8 +1,7 @@ # Wallet::ACL::NetDB::Root -- Wallet NetDB role ACL verifier (root instances). -# $Id$ # # Written by Russ Allbery <rra@stanford.edu> -# Copyright 2007 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2010 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -24,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 @@ -49,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) @@ -67,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 <principal>/root@<realm>) and strips the C</root> 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</root> -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 <principal>/root@<realm>) and strips the C</root> portion +from the principal before checking against NetDB roles. As with the base +NetDB ACL verifier, the value of a C<netdb-root> ACL is a node, and the +ACL grants access to a given principal if and only if the that principal +(with C</root> 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 @@ -86,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<root> and if -(with C</root> 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<root> and +if (with C</root> stripped off and the realm stripped off if configured) +has the user, admin, or team role for that node. =back @@ -107,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<http://www.stanford.edu/group/networking/netdb/>. +NetDB is a free software system for managing DNS, DHCP, and related +machine information for large organizations. For more information on +NetDB, see L<http://www.stanford.edu/group/networking/netdb/>. -This module is part of the wallet system. The current version is available -from L<http://www.eyrie.org/~eagle/software/wallet/>. +This module is part of the wallet system. The current version is +available from L<http://www.eyrie.org/~eagle/software/wallet/>. =head1 AUTHOR diff --git a/perl/Wallet/Admin.pm b/perl/Wallet/Admin.pm index 37d538e..e835713 100644 --- a/perl/Wallet/Admin.pm +++ b/perl/Wallet/Admin.pm @@ -1,8 +1,7 @@ # Wallet::Admin -- Wallet system administrative interface. -# $Id$ # # Written by Russ Allbery <rra@stanford.edu> -# Copyright 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008, 2009, 2010 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -23,7 +22,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.02'; +$VERSION = '0.05'; ############################################################################## # Constructor, destructor, and accessors @@ -112,67 +111,6 @@ sub destroy { } ############################################################################## -# Reporting -############################################################################## - -# Returns a list of all objects stored in the wallet database in the form of -# type and name pairs. On error and for an empty database, the empty list -# will be returned. To distinguish between an empty list and an error, call -# error(), which will return undef if there was no error. -sub list_objects { - my ($self) = @_; - undef $self->{error}; - my @objects; - eval { - my $sql = 'select ob_type, ob_name from objects order by ob_type, - ob_name'; - my $sth = $self->{dbh}->prepare ($sql); - $sth->execute; - my $object; - while (defined ($object = $sth->fetchrow_arrayref)) { - push (@objects, [ @$object ]); - } - $self->{dbh}->commit; - }; - if ($@) { - $self->error ("cannot list objects: $@"); - $self->{dbh}->rollback; - return; - } else { - return @objects; - } -} - -# Returns a list of all ACLs stored in the wallet database as a list of pairs -# of ACL IDs and ACL names. On error and for an empty database, the empty -# list will be returned; however, this is unlikely since any valid database -# will have at least an ADMIN ACL. Still, to distinguish between an empty -# list and an error, call error(), which will return undef if there was no -# error. -sub list_acls { - my ($self) = @_; - undef $self->{error}; - my @acls; - eval { - my $sql = 'select ac_id, ac_name from acls order by ac_id'; - my $sth = $self->{dbh}->prepare ($sql); - $sth->execute; - my $object; - while (defined ($object = $sth->fetchrow_arrayref)) { - push (@acls, [ @$object ]); - } - $self->{dbh}->commit; - }; - if ($@) { - $self->error ("cannot list ACLs: $@"); - $self->{dbh}->rollback; - return; - } else { - return @acls; - } -} - -############################################################################## # Object registration ############################################################################## @@ -225,6 +163,9 @@ __DATA__ Wallet::Admin - Wallet system administrative interface +=for stopwords +ACL hostname Allbery + =head1 SYNOPSIS use Wallet::Admin; @@ -241,9 +182,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 @@ -287,34 +228,6 @@ initialize() uses C<localhost> as the hostname and PRINCIPAL as the user when logging the history of the ADMIN ACL creation and for any subsequent actions on the object it returns. -=item list_acls() - -Returns a list of all ACLs in the database. The return value is a list of -references to pairs of ACL ID and name. For example, if there are two -ACLs in the database, one with name "ADMIN" and ID 1 and one with name -"group/admins" and ID 3, list_acls() would return: - - ([ 1, 'ADMIN' ], [ 3, 'group/admins' ]) - -Returns the empty list on failure. Any valid wallet database should have -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. - -=item list_objects() - -Returns a list of all objects in the database. 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() would return: - - ([ 'keytab', 'host/example.com' ], [ 'keytab', 'foo' ]) - -Returns the empty list on failure. To distinguish between this and a -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. - =item register_object (TYPE, CLASS) Register in the database a mapping from the object type TYPE to the class @@ -342,8 +255,8 @@ Returns true on success and false on failure. wallet-admin(8) -This module is part of the wallet system. The current version is available -from L<http://www.eyrie.org/~eagle/software/wallet/>. +This module is part of the wallet system. The current version is +available from L<http://www.eyrie.org/~eagle/software/wallet/>. =head1 AUTHOR diff --git a/perl/Wallet/Config.pm b/perl/Wallet/Config.pm index 6c72781..396bf7d 100644 --- a/perl/Wallet/Config.pm +++ b/perl/Wallet/Config.pm @@ -1,8 +1,7 @@ # Wallet::Config -- Configuration handling for the wallet server. -# $Id$ # # Written by Russ Allbery <rra@stanford.edu> -# 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. @@ -15,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'; @@ -24,6 +23,12 @@ $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 Heimdal +rekeys + =head1 SYNOPSIS use Wallet::Config; @@ -64,9 +69,9 @@ variable DB_DRIVER to C<MySQL>, 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: @@ -81,11 +86,11 @@ file. =item DB_DRIVER -Sets the Perl database driver to use for the wallet database. Common values -would be C<SQLite> or C<MySQL>. Less common values would be C<Oracle>, -C<Sybase>, or C<ODBC>. 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<SQLite> or C<MySQL>. Less common values would be +C<Oracle>, C<Sybase>, or C<ODBC>. 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. @@ -96,8 +101,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. @@ -112,9 +117,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<database=DB_NAME>, 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<database=DB_NAME>, 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. @@ -125,8 +131,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 @@ -136,8 +142,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 @@ -154,8 +160,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 @@ -206,9 +212,10 @@ C<keytab> object type (the Wallet::Object::Keytab class). =item KEYTAB_FILE Specifies the keytab to use to authenticate to B<kadmind>. 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<kadm5.acl> parlance, this is C<admci> 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<kadm5.acl> parlance, this is C<admci> +privileges.) KEYTAB_FILE must be set to use keytab objects. @@ -219,12 +226,13 @@ our $KEYTAB_FILE; =item KEYTAB_FLAGS These flags, if any, are passed to the C<addprinc> 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<addprinc -randkey> 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<addprinc +-randkey> works when third-party add-ons for password strength checking +are used.) =cut @@ -251,14 +259,23 @@ default PATH. our $KEYTAB_KADMIN = 'kadmin'; +=item KEYTAB_KRBTYPE + +The Kerberos KDC implementation type, either C<Heimdal> or C<MIT> +(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 authenticate as this principal to the kadmin service. -KEYTAB_PRINCIPAL must be set to use keytab objects, at least until B<kadmin> -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<kadmin> is smart enough to use the first principal found in the keytab +it's using for authentication. =cut @@ -281,11 +298,11 @@ our $KEYTAB_REALM; =item KEYTAB_TMP A directory into which the wallet can write keytabs temporarily while -processing C<get> commands from clients. The keytabs are written into this -directory with predictable names, so this should not be a system temporary -directory such as F</tmp> or F</var/tmp>. It's best to create a directory -solely for this purpose that's owned by the user the wallet server will run -as. +processing C<get> commands from clients. The keytabs are written into +this directory with predictable names, so this should not be a system +temporary directory such as F</tmp> or F</var/tmp>. It's best to create a +directory solely for this purpose that's owned by the user the wallet +server will run as. KEYTAB_TMP must be set to use keytab objects. @@ -297,20 +314,28 @@ 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<keytab-backend>. This is enabled by setting the C<unchanging> -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<keytab-backend>. This is +enabled by setting the C<unchanging> flag on keytab objects. To configure +that support, set the following variables. + +This is not required for Heimdal; for Heimdal, setting the C<unchanging> +flag is all that's needed. =over 4 =item KEYTAB_REMCTL_CACHE -Specifies the ticket cache to use when retrieving existing keytabs from the -KDC. This is only used to implement support for the C<unchanging> flag. -The ticket cache must be for a principal with access to run C<keytab -retrieve> via remctl on KEYTAB_REMCTL_HOST. +Specifies the ticket cache to use when retrieving existing keytabs from +the KDC. This is only used to implement support for the C<unchanging> +flag. The ticket cache must be for a principal with access to run +C<keytab retrieve> via remctl on KEYTAB_REMCTL_HOST. =cut @@ -318,10 +343,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<unchanging> flag. This host -must provide the C<keytab retrieve> 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<unchanging> flag. This +host must provide the C<keytab retrieve> command and KEYTAB_REMCTL_CACHE +must also be set to a ticket cache for a principal with access to run that command. =cut @@ -331,9 +356,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<unchanging> flag. -If this variable is not set, the default is formed by prepending C<host/> to -KEYTAB_REMCTL_HOST. (Note that KEYTAB_REMCTL_HOST is not lowercased first.) +keytabs. This is only used to implement support for the C<unchanging> +flag. If this variable is not set, the default is formed by prepending +C<host/> to KEYTAB_REMCTL_HOST. (Note that KEYTAB_REMCTL_HOST is not +lowercased first.) =cut @@ -352,102 +378,23 @@ 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<kasetkey> and is controlled by the C<sync> -attribute on keytab objects. To configure that support, set the following -variables. - -=over 4 - -=item KEYTAB_AFS_ADMIN - -The Kerberos v4 principal to use for authentication to the AFS kaserver. If -this principal is not in the default local Kerberos v4 realm, it must be -fully qualified. A srvtab for this principal must be stored in the path set -in $KEYTAB_AFS_SRVTAB. This principal must have the ADMIN flag set in the -AFS kaserver so that it can create and remove principals. This variable -must be set to use the kaserver synchronization support. - -=cut - -our $KEYTAB_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<kasetkey> command-line client. The default value is -C<kasetkey>, which will cause the wallet to search for B<kasetkey> on its -default PATH. - -=cut - -our $KEYTAB_AFS_KASETKEY = 'kasetkey'; - -=item KEYTAB_AFS_REALM - -The name of the Kerberos v4 realm with which to synchronize keys. This is a -realm, not a cell, so it should be in all uppercase. If this variable is -not set, the default is the realm determined from the local cell name. - -=cut - -our $KEYTAB_AFS_REALM; - -=item KEYTAB_AFS_SRVTAB - -The path to a srvtab used to authenticate to the AFS kaserver. This srvtab -should be for the principal set in $KEYTAB_AFS_ADMIN. This variable must be -set to use the kaserver synchronization support. - -=cut - -our $KEYTAB_AFS_SRVTAB; - -=back - =head1 NETDB ACL CONFIGURATION These configuration variables are only needed if you intend to use the C<netdb> 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 @@ -456,9 +403,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<netdb node-roles> 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<netdb node-roles> via remctl on KEYTAB_REMCTL_HOST. This variable +must be set to use NetDB ACLs. =cut @@ -477,10 +424,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<host/> 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<host/> to NETDB_REMCTL_HOST. (Note that NETDB_REMCTL_HOST is +not lowercased first.) =cut @@ -488,9 +435,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 @@ -501,17 +448,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<default> with one entry of type C<krb5> and identifier C<rra@example.com> -for the object with type C<keytab> and name C<host/example.com>: +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<default> with one entry of type C<krb5> and identifier +C<rra@example.com> for the object with type C<keytab> and name +C<host/example.com>: sub default_owner { my ($type, $name) = @_; @@ -524,8 +472,8 @@ for the object with type C<keytab> and name C<host/example.com>: 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. @@ -545,17 +493,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<host/I<system>> where I<system> 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<host/I<system>> where I<system> 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 3edf059..7b3474a 100644 --- a/perl/Wallet/Database.pm +++ b/perl/Wallet/Database.pm @@ -1,5 +1,4 @@ # Wallet::Database -- Wallet system database connection management. -# $Id$ # # This module is a thin wrapper around DBI to handle determination of the # database driver and configuration settings automatically on connect. The @@ -7,7 +6,7 @@ # like DBI objects in the rest of the code. # # Written by Russ Allbery <rra@stanford.edu> -# Copyright 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008, 2010 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -40,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 @@ -85,6 +84,9 @@ __END__ Wallet::Dabase - Wrapper module for wallet database connections +=for stopwords +DBI RaiseError PrintError AutoCommit Allbery + =head1 SYNOPSIS use Wallet::Database; @@ -94,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 @@ -121,8 +123,8 @@ configuration. DBI(3), Wallet::Config(3) -This module is part of the wallet system. The current version is available -from L<http://www.eyrie.org/~eagle/software/wallet/>. +This module is part of the wallet system. The current version is +available from L<http://www.eyrie.org/~eagle/software/wallet/>. =head1 AUTHOR diff --git a/perl/Wallet/Kadmin.pm b/perl/Wallet/Kadmin.pm new file mode 100644 index 0000000..074dd1e --- /dev/null +++ b/perl/Wallet/Kadmin.pm @@ -0,0 +1,239 @@ +# Wallet::Kadmin -- Kerberos administration API for wallet keytab backend. +# +# Written by Jon Robertson <jonrober@stanford.edu> +# Copyright 2009, 2010 Board of Trustees, Leland Stanford Jr. University +# +# See LICENSE for licensing terms. + +############################################################################## +# Modules and declarations +############################################################################## + +package Wallet::Kadmin; +require 5.006; + +use strict; +use vars qw($VERSION); + +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'; + +############################################################################## +# Utility functions for child classes +############################################################################## + +# Read the entirety of a possibly binary file and return the contents, +# deleting the file after reading it. If reading the file fails, set the +# error message and return undef. +sub read_keytab { + my ($self, $file) = @_; + local *TMPFILE; + unless (open (TMPFILE, '<', $file)) { + $self->error ("cannot open temporary file $file: $!"); + return; + } + local $/; + undef $!; + my $data = <TMPFILE>; + if ($!) { + $self->error ("cannot read temporary file $file: $!"); + unlink $file; + return; + } + close TMPFILE; + unlink $file; + return $data; +} + +############################################################################## +# Public methods +############################################################################## + +# Create a new kadmin object, by finding the type requested in the wallet +# config and passing off to the proper module. Returns the object directly +# from the specific Wallet::Kadmin::* module. +sub new { + my ($class) = @_; + my $kadmin; + if (not $Wallet::Config::KEYTAB_KRBTYPE) { + die "keytab object implementation not configured\n"; + } elsif (lc ($Wallet::Config::KEYTAB_KRBTYPE) eq 'mit') { + require Wallet::Kadmin::MIT; + $kadmin = Wallet::Kadmin::MIT->new; + } elsif (lc ($Wallet::Config::KEYTAB_KRBTYPE) eq 'heimdal') { + require Wallet::Kadmin::Heimdal; + $kadmin = Wallet::Kadmin::Heimdal->new; + } else { + my $type = $Wallet::Config::KEYTAB_KRBTYPE; + die "unknown KEYTAB_KRBTYPE setting: $type\n"; + } + + return $kadmin; +} + +# Set or return the error stashed in the object. +sub error { + my ($self, @error) = @_; + if (@error) { + my $error = join ('', @error); + chomp $error; + 1 while ($error =~ s/ at \S+ line \d+\.?\z//); + $self->{error} = $error; + } + return $self->{error}; +} + +# Set a callback to be called for forked kadmin processes. This does nothing +# by default but may be overridden by subclasses that need special behavior +# (such as the current Wallet::Kadmin::MIT module). +sub fork_callback { } + +1; +__END__ + +############################################################################## +# Documentation +############################################################################## + +=for stopwords +backend Kadmin keytabs keytab Heimdal API kadmind kadmin KDC ENCTYPE +enctypes enctype Allbery + +=head1 NAME + +Wallet::Kadmin - Kerberos administration API for wallet keytab backend + +=head1 SYNOPSIS + + my $kadmin = Wallet::Kadmin->new; + $kadmin->create ('host/foo.example.com'); + my $data = $kadmin->keytab_rekey ('host/foo.example.com', + 'aes256-cts-hmac-sha1-96'); + $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 + +Wallet::Kadmin is a wrapper and base class for modules that provide an +interface for wallet to do Kerberos administration, specifically create +and delete principals and create keytabs for a principal. Each subclass +administers a specific type of Kerberos implementation, such as MIT +Kerberos or Heimdal, providing a standard set of API calls used to +interact with that implementation's kadmin interface. + +The class uses Wallet::Config to find which type of kadmin interface is in +use and then returns an object to use for interacting with that interface. +See L<Wallet::Config/"KEYTAB OBJECT CONFIGURATION"> for details on how to +configure this module. + +=head1 CLASS METHODS + +=over 4 + +=item new() + +Finds the proper Kerberos implementation and calls the new() constructor +for that implementation's module, returning the resulting object. If the +implementation is not recognized or set, die with an error message. + +=back + +=head1 INSTANCE METHODS + +These methods are provided by any object returned by new(), regardless of +the underlying kadmin interface. They are implemented by the child class +appropriate for the configured Kerberos implementation. + +=over 4 + +=item create(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 and false on failure. If the principal already exists, return +true as we are bringing our expectations in line with reality. + +=item destroy(PRINCIPAL) + +Removes a principal with the given name. Returns true on success or false +on failure. If the principal does not exist, return true as we are +bringing our expectations in line with reality. + +=item error([ERROR ...]) + +Returns the error of the last failing operation or undef if no operations +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<C< at \S+ +line \d+\.?>> 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 exists(PRINCIPAL) + +Returns true if the given principal exists in the KDC and C<0> if it +doesn't. If an error is encountered in checking whether the principal +exists, exists() returns undef. + +=item fork_callback(CALLBACK) + +If the module has to fork an external process for some reason, such as a +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) + +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 [, 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<aes256-cts-hmac-sha1-96> or +C<des-cbc-crc>). If none are given, the KDC defaults will be used. +Returns the keytab as binary data on success and undef on failure. + +=back + +The following methods are utility methods to aid with child class +implementation and should only be called by child classes. + +=over 4 + +=item read_keytab(FILE) + +Reads the contents of the keytab stored in FILE into memory and returns it +as binary data. On failure, returns undef and sets the object error. + +=back + +=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<http://www.eyrie.org/~eagle/software/wallet/>. + +=head1 AUTHORS + +Jon Robertson <jonrober@stanford.edu> and Russ Allbery <rra@stanford.edu> + +=cut diff --git a/perl/Wallet/Kadmin/Heimdal.pm b/perl/Wallet/Kadmin/Heimdal.pm new file mode 100644 index 0000000..d1eecda --- /dev/null +++ b/perl/Wallet/Kadmin/Heimdal.pm @@ -0,0 +1,286 @@ +# Wallet::Kadmin::Heimdal -- Wallet Kerberos administration API for Heimdal. +# +# Written by Jon Robertson <jonrober@stanford.edu> +# Copyright 2009, 2010 Board of Trustees, Leland Stanford Jr. University +# +# See LICENSE for licensing terms. + +############################################################################## +# Modules and declarations +############################################################################## + +package Wallet::Kadmin::Heimdal; +require 5.006; + +use strict; +use vars qw(@ISA $VERSION); + +use Heimdal::Kadm5 qw(KRB5_KDB_DISALLOW_ALL_TIX); +use Wallet::Config (); +use Wallet::Kadmin (); + +@ISA = qw(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'; + +############################################################################## +# Utility functions +############################################################################## + +# Add the realm to the end of the principal if no realm is currently present. +sub canonicalize_principal { + my ($self, $principal) = @_; + if ($Wallet::Config::KEYTAB_REALM && $principal !~ /\@/) { + $principal .= '@' . $Wallet::Config::KEYTAB_REALM; + } + return $principal; +} + +############################################################################## +# Public interfaces +############################################################################## + +# Check whether a given principal already exists in Kerberos. Returns true if +# so, false otherwise. +sub exists { + my ($self, $principal) = @_; + $principal = $self->canonicalize_principal ($principal); + my $kadmin = $self->{client}; + my $princdata = eval { $kadmin->getPrincipal ($principal) }; + if ($@) { + $self->error ("error getting principal: $@"); + return; + } + return $princdata ? 1 : 0; +} + +# Create a principal in Kerberos. If there is an error, return undef and set +# the error. Return 1 on success or the principal already existing. +sub create { + my ($self, $principal) = @_; + $principal = $self->canonicalize_principal ($principal); + my $exists = eval { $self->exists ($principal) }; + if ($@) { + $self->error ("error adding principal $principal: $@"); + return; + } + return 1 if $exists; + + # The way Heimdal::Kadm5 works, we create a principal object, create the + # actual principal set inactive, then randomize it and activate it. + # + # TODO - Paranoia makes me want to set the password to something random + # on creation even if it is inactive until after randomized by + # module. + my $kadmin = $self->{client}; + eval { + my $princdata = $kadmin->makePrincipal ($principal); + my $attrs = $princdata->getAttributes; + $attrs |= KRB5_KDB_DISALLOW_ALL_TIX; + $princdata->setAttributes ($attrs); + my $password = 'inactive'; + $kadmin->createPrincipal ($princdata, $password, 0); + $kadmin->randKeyPrincipal ($principal); + $kadmin->enablePrincipal ($principal); + }; + if ($@) { + $self->error ("error adding principal $principal: $@"); + return; + } + return 1; +} + +# 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; + } + return $self->read_keytab ($file); +} + +# Create a keytab for a principal, randomizing the keys for that principal at +# the same time. Takes the principal and an optional list of encryption types +# to which to limit the keytab. Return the keytab data on success and undef +# on failure. If the keytab creation fails, sets the error. +sub keytab_rekey { + my ($self, $principal, @enctypes) = @_; + $principal = $self->canonicalize_principal ($principal); + + # The way Heimdal works, you can only remove enctypes from a principal, + # not add them back in. So we need to run randkeyPrincipal first each + # time to restore all possible enctypes and then whittle them back down + # to those we have been asked for this time. + my $kadmin = $self->{client}; + eval { $kadmin->randKeyPrincipal ($principal) }; + if ($@) { + $self->error ("error creating keytab for $principal: could not" + . " reinit enctypes: $@"); + return; + } + 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; + } + + # Now actually remove any non-requested enctypes, if we requested any. + if (@enctypes) { + my $alltypes = $princdata->getKeytypes; + my %wanted = map { $_ => 1 } @enctypes; + for my $key (@{ $alltypes }) { + my $keytype = $key->[0]; + next if exists $wanted{$keytype}; + eval { $princdata->delKeytypes ($keytype) }; + if ($@) { + $self->error ("error removing keytype $keytype from the" + . " keytab: $@"); + return; + } + } + eval { $kadmin->modifyPrincipal ($princdata) }; + if ($@) { + $self->error ("error saving principal modifications: $@"); + return; + } + } + + # Create the keytab. + my $file = $Wallet::Config::KEYTAB_TMP . "/keytab.$$"; + unlink $file; + eval { $kadmin->extractKeytab ($princdata, $file) }; + if ($@) { + $self->error ("error creating keytab for principal: $@"); + return; + } + return $self->read_keytab ($file); +} + +# Delete a principal from Kerberos. Return true if successful, false +# otherwise. If the deletion fails, sets the error. If the principal doesn't +# exist, return success; we're bringing reality in line with our expectations. +sub destroy { + my ($self, $principal) = @_; + $principal = $self->canonicalize_principal ($principal); + my $exists = eval { $self->exists ($principal) }; + if ($@) { + $self->error ("error checking principal existance: $@"); + return; + } elsif (not $exists) { + return 1; + } + my $kadmin = $self->{client}; + my $retval = eval { $kadmin->deletePrincipal ($principal) }; + if ($@) { + $self->error ("error deleting $principal: $@"); + return; + } + return 1; +} + +# Create a new Wallet::Kadmin::Heimdal object and its underlying +# Heimdal::Kadm5 object. +sub new { + my ($class) = @_; + unless (defined ($Wallet::Config::KEYTAB_PRINCIPAL) + and defined ($Wallet::Config::KEYTAB_FILE) + and defined ($Wallet::Config::KEYTAB_REALM)) { + die "keytab object implementation not configured\n"; + } + unless (defined ($Wallet::Config::KEYTAB_TMP)) { + die "KEYTAB_TMP configuration variable not set\n"; + } + my @options = (RaiseError => 1, + Principal => $Wallet::Config::KEYTAB_PRINCIPAL, + Realm => $Wallet::Config::KEYTAB_REALM, + Keytab => $Wallet::Config::KEYTAB_FILE); + if ($Wallet::Config::KEYTAB_HOST) { + push (@options, Server => $Wallet::Config::KEYTAB_HOST); + } + my $client = Heimdal::Kadm5::Client->new (@options); + my $self = { client => $client }; + bless ($self, $class); + return $self; +} + +1; +__END__ + +############################################################################## +# Documentation +############################################################################## + +=for stopwords +keytabs keytab kadmin KDC API Allbery Heimdal + +=head1 NAME + +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_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 + +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. + +To use this class, several configuration parameters must be set. See +L<Wallet::Config/"KEYTAB OBJECT CONFIGURATION"> for details. + +=head1 FILES + +=over 4 + +=item KEYTAB_TMP/keytab.<pid> + +The keytab is created in this file and then read into memory. KEYTAB_TMP +is set in the wallet configuration, and <pid> 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), +Wallet::Object::Keytab(3), wallet-backend(8) + +This module is part of the wallet system. The current version is +available from L<http://www.eyrie.org/~eagle/software/wallet/>. + +=head1 AUTHORS + +Russ Allbery <rra@stanford.edu> and Jon Robertson <jonrober@stanford.edu>. + +=cut diff --git a/perl/Wallet/Kadmin/MIT.pm b/perl/Wallet/Kadmin/MIT.pm new file mode 100644 index 0000000..434e93d --- /dev/null +++ b/perl/Wallet/Kadmin/MIT.pm @@ -0,0 +1,322 @@ +# Wallet::Kadmin::MIT -- Wallet Kerberos administration API for MIT. +# +# Written by Russ Allbery <rra@stanford.edu> +# Pulled into a module by Jon Robertson <jonrober@stanford.edu> +# Copyright 2007, 2008, 2009, 2010 +# Board of Trustees, Leland Stanford Jr. University +# +# See LICENSE for licensing terms. + +############################################################################## +# Modules and declarations +############################################################################## + +package Wallet::Kadmin::MIT; +require 5.006; + +use strict; +use vars qw(@ISA $VERSION); + +use Wallet::Config (); +use Wallet::Kadmin (); + +@ISA = qw(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'; + +############################################################################## +# kadmin Interaction +############################################################################## + +# Make sure that principals are well-formed and don't contain characters that +# will cause us problems when talking to kadmin. Takes a principal and +# returns true if it's okay, false otherwise. Note that we do not permit +# realm information here. +sub valid_principal { + my ($self, $principal) = @_; + return scalar ($principal =~ m,^[\w-]+(/[\w_.-]+)?\z,); +} + +# Run a kadmin command and capture the output. Returns the output, either as +# a list of lines or, in scalar context, as one string. The exit status of +# kadmin is often worthless. +sub kadmin { + my ($self, $command) = @_; + unless (defined ($Wallet::Config::KEYTAB_PRINCIPAL) + and defined ($Wallet::Config::KEYTAB_FILE) + and defined ($Wallet::Config::KEYTAB_REALM)) { + die "keytab object implementation not configured\n"; + } + my @args = ('-p', $Wallet::Config::KEYTAB_PRINCIPAL, '-k', '-t', + $Wallet::Config::KEYTAB_FILE, '-q', $command); + push (@args, '-s', $Wallet::Config::KEYTAB_HOST) + if $Wallet::Config::KEYTAB_HOST; + push (@args, '-r', $Wallet::Config::KEYTAB_REALM) + if $Wallet::Config::KEYTAB_REALM; + my $pid = open (KADMIN, '-|'); + if (not defined $pid) { + $self->error ("cannot fork: $!"); + return; + } elsif ($pid == 0) { + $self->{fork_callback} () if $self->{fork_callback}; + unless (open (STDERR, '>&STDOUT')) { + warn "wallet: cannot dup stdout: $!\n"; + exit 1; + } + unless (exec ($Wallet::Config::KEYTAB_KADMIN, @args)) { + warn "wallet: cannot run $Wallet::Config::KEYTAB_KADMIN: $!\n"; + exit 1; + } + } + local $_; + my @output; + while (<KADMIN>) { + if (/^wallet: cannot /) { + s/^wallet: //; + $self->error ($_); + return; + } + push (@output, $_) unless /Authenticating as principal/; + } + close KADMIN; + return wantarray ? @output : join ('', @output); +} + +############################################################################## +# Public interfaces +############################################################################## + +# Set a callback to be called for forked kadmin processes. +sub fork_callback { + my ($self, $callback) = @_; + $self->{fork_callback} = $callback; +} + +# Check whether a given principal already exists in Kerberos. Returns true if +# so, false otherwise. Returns undef if kadmin fails, with the error already +# set by kadmin. +sub exists { + my ($self, $principal) = @_; + return unless $self->valid_principal ($principal); + if ($Wallet::Config::KEYTAB_REALM) { + $principal .= '@' . $Wallet::Config::KEYTAB_REALM; + } + my $output = $self->kadmin ("getprinc $principal"); + if (!defined $output) { + return; + } elsif ($output =~ /^get_principal: /) { + return 0; + } else { + return 1; + } +} + +# Create a principal in Kerberos. Sets the error and returns undef on failure, +# and returns 1 on either success or the principal already existing. +sub create { + my ($self, $principal) = @_; + unless ($self->valid_principal ($principal)) { + $self->error ("invalid principal name $principal"); + return; + } + return 1 if $self->exists ($principal); + if ($Wallet::Config::KEYTAB_REALM) { + $principal .= '@' . $Wallet::Config::KEYTAB_REALM; + } + my $flags = $Wallet::Config::KEYTAB_FLAGS || ''; + my $output = $self->kadmin ("addprinc -randkey $flags $principal"); + if (!defined $output) { + return; + } elsif ($output =~ /^add_principal: (.*)/m) { + $self->error ("error adding principal $principal: $1"); + return; + } + return 1; +} + +# 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 and an optional list of encryption +# types to which to limit the keytab. Return the keytab data on success +# and undef otherwise. If the keytab creation fails, sets the error. +sub keytab_rekey { + my ($self, $principal, @enctypes) = @_; + unless ($self->valid_principal ($principal)) { + $self->error ("invalid principal name: $principal"); + return; + } + if ($Wallet::Config::KEYTAB_REALM) { + $principal .= '@' . $Wallet::Config::KEYTAB_REALM; + } + my $file = $Wallet::Config::KEYTAB_TMP . "/keytab.$$"; + unlink $file; + my $command = "ktadd -q -k $file"; + if (@enctypes) { + @enctypes = map { /:/ ? $_ : "$_:normal" } @enctypes; + $command .= ' -e "' . join (' ', @enctypes) . '"'; + } + my $output = $self->kadmin ("$command $principal"); + if (!defined $output) { + return; + } elsif ($output =~ /^(?:kadmin|ktadd): (.*)/m) { + $self->error ("error creating keytab for $principal: $1"); + return; + } + return $self->read_keytab ($file); +} + +# Delete a principal from Kerberos. Return true if successful, false +# otherwise. If the deletion fails, sets the error. If the principal doesn't +# exist, return success; we're bringing reality in line with our expectations. +sub destroy { + my ($self, $principal) = @_; + unless ($self->valid_principal ($principal)) { + $self->error ("invalid principal name: $principal"); + } + my $exists = $self->exists ($principal); + if (!defined $exists) { + return; + } elsif (not $exists) { + return 1; + } + if ($Wallet::Config::KEYTAB_REALM) { + $principal .= '@' . $Wallet::Config::KEYTAB_REALM; + } + my $output = $self->kadmin ("delprinc -force $principal"); + if (!defined $output) { + return; + } elsif ($output =~ /^delete_principal: (.*)/m) { + $self->error ("error deleting $principal: $1"); + return; + } + return 1; +} + +# Create a new MIT kadmin object. Very empty for the moment, but later it +# will probably fill out if we go to using a module rather than calling +# kadmin directly. +sub new { + my ($class) = @_; + unless (defined ($Wallet::Config::KEYTAB_TMP)) { + die "KEYTAB_TMP configuration variable not set\n"; + } + my $self = {}; + bless ($self, $class); + return $self; +} + +1; +__END__ + +############################################################################## +# Documentation +############################################################################## + +=for stopwords +rekeying rekeys remctl backend keytabs keytab kadmin KDC API Allbery + +=head1 NAME + +Wallet::Kadmin::MIT - Wallet Kerberos administration API for MIT + +=head1 SYNOPSIS + + my $kadmin = Wallet::Kadmin::MIT->new; + $kadmin->create ('host/foo.example.com'); + my $data = $kadmin->keytab_rekey ('host/foo.example.com', + 'aes256-cts-hmac-sha1-96'); + $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 + +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 +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 class, several configuration parameters must be set. See +L<Wallet::Config/"KEYTAB OBJECT CONFIGURATION"> for details. + +=head1 FILES + +=over 4 + +=item KEYTAB_TMP/keytab.<pid> + +The keytab is created in this file and then read into memory. KEYTAB_TMP +is set in the wallet configuration, and <pid> is the process ID of the +current process. The file is unlinked after being read. + +=back + +=head1 LIMITATIONS + +Currently, this implementation calls an external B<kadmin> program rather +than using a native Perl module and therefore requires B<kadmin> be +installed and parses its output. It may miss some error conditions if the +output of B<kadmin> ever changes. + +=head1 SEE ALSO + +kadmin(8), Wallet::Config(3), Wallet::Kadmin(3), +Wallet::Object::Keytab(3), wallet-backend(8) + +This module is part of the wallet system. The current version is +available from L<http://www.eyrie.org/~eagle/software/wallet/>. + +=head1 AUTHORS + +Russ Allbery <rra@stanford.edu> and Jon Robertson <jonrober@stanford.edu>. + +=cut diff --git a/perl/Wallet/Object/Base.pm b/perl/Wallet/Object/Base.pm index bc4f096..5097729 100644 --- a/perl/Wallet/Object/Base.pm +++ b/perl/Wallet/Object/Base.pm @@ -1,8 +1,7 @@ # Wallet::Object::Base -- Parent class for any object stored in the wallet. -# $Id$ # # Written by Russ Allbery <rra@stanford.edu> -# 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 +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 @@ -446,6 +445,22 @@ sub flag_set { # History ############################################################################## +# Expand a given ACL id to add its name, for readability. Returns the +# original id alone if there was a problem finding the name. +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)"; + } + + return $name; +} + # Return the formatted history for a given object or undef on error. # Currently always returns the complete history, but eventually will need to # provide some way of showing only recent entries. @@ -477,6 +492,18 @@ 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]; + $old = $self->format_acl_id ($old) if defined ($old); + $new = $self->format_acl_id ($new) if defined ($new); + if (defined ($old) and defined ($new)) { + $output .= "set $field to $new (was $old)"; + } elsif (defined ($new)) { + $output .= "set $field to $new"; + } elsif (defined ($old)) { + $output .= "unset $field (was $old)"; + } } elsif ($data[0] eq 'set') { my $field = $data[1]; if (defined ($old) and defined ($new)) { @@ -642,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; @@ -655,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<get>, C<store>, C<show>, C<destroy>, or C<flags>, 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<get>, C<store>, C<show>, C<destroy>, or C<flags>, 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 ...]) @@ -762,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<C< at \S+ line -\d+\.?>> 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<C< at \S+ +line \d+\.?>> 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<YYYY-MM-DD -HH:MM:SS>, 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<YYYY-MM-DD HH:MM:SS>, 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]) @@ -829,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() @@ -839,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() @@ -867,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<get> or C<store>. No other changes are made to the -database, just updates of the history table and trace fields with the +which should be either C<get> or C<store>. 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<owner>, C<acl_get>, C<acl_store>, C<acl_show>, -C<acl_destroy>, C<acl_flags>, C<expires>, C<flags>, or a value starting with -C<type_data> 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<owner>, C<acl_get>, C<acl_store>, +C<acl_show>, C<acl_destroy>, C<acl_flags>, C<expires>, C<flags>, or a +value starting with C<type_data> 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 @@ -895,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<http://www.eyrie.org/~eagle/software/wallet/>. +This module is part of the wallet system. The current version is +available from L<http://www.eyrie.org/~eagle/software/wallet/>. =head1 AUTHOR diff --git a/perl/Wallet/Object/File.pm b/perl/Wallet/Object/File.pm index b4e23f8..c655b44 100644 --- a/perl/Wallet/Object/File.pm +++ b/perl/Wallet/Object/File.pm @@ -1,8 +1,7 @@ # Wallet::Object::File -- File object implementation for the wallet. -# $Id$ # # Written by Russ Allbery <rra@stanford.edu> -# Copyright 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008, 2010 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -25,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 @@ -137,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) @@ -164,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. @@ -218,12 +221,11 @@ dashes replaced by C<%> and the hex code of the character. =head1 LIMITATIONS -The wallet implementation itself can handle arbitrary file object names -and arbitrary content. However, due to limitations in the B<remctld> -server usually used to run B<wallet-backend>, file object names and -contents containing nul characters (ASCII 0) may not be permitted. The -file system used for storing file objects may impose a length limitation -on the file object name. +The wallet implementation itself can handle arbitrary file object names. +However, due to limitations in the B<remctld> server usually used to run +B<wallet-backend>, file object names containing nul characters (ASCII 0) +may not be permitted. The file system used for storing file objects may +impose a length limitation on the file object name. =head1 SEE ALSO diff --git a/perl/Wallet/Object/Keytab.pm b/perl/Wallet/Object/Keytab.pm index 8739f89..edb26b3 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. -# $Id$ # # Written by Russ Allbery <rra@stanford.edu> -# Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2008, 2009, 2010 +# Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -18,390 +18,14 @@ use vars qw(@ISA $VERSION); use Wallet::Config (); use Wallet::Object::Base; +use Wallet::Kadmin; @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.06'; - -############################################################################## -# kadmin Interaction -############################################################################## - -# Make sure that principals are well-formed and don't contain characters that -# will cause us problems when talking to kadmin. Takes a principal and -# returns true if it's okay, false otherwise. Note that we do not permit -# realm information here. -sub valid_principal { - my ($self, $principal) = @_; - return scalar ($principal =~ m,^[\w-]+(/[\w_.-]+)?\z,); -} - -# Run a kadmin command and capture the output. Returns the output, either as -# a list of lines or, in scalar context, as one string. The exit status of -# kadmin is often worthless. -sub kadmin { - my ($self, $command) = @_; - unless (defined ($Wallet::Config::KEYTAB_PRINCIPAL) - and defined ($Wallet::Config::KEYTAB_FILE) - and defined ($Wallet::Config::KEYTAB_REALM)) { - die "keytab object implementation not configured\n"; - } - my @args = ('-p', $Wallet::Config::KEYTAB_PRINCIPAL, '-k', '-t', - $Wallet::Config::KEYTAB_FILE, '-q', $command); - push (@args, '-s', $Wallet::Config::KEYTAB_HOST) - if $Wallet::Config::KEYTAB_HOST; - push (@args, '-r', $Wallet::Config::KEYTAB_REALM) - if $Wallet::Config::KEYTAB_REALM; - my $pid = open (KADMIN, '-|'); - if (not defined $pid) { - die "cannot fork: $!\n"; - } 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 "wallet: cannot dup stdout: $!\n"; - exit 1; - } - unless (exec ($Wallet::Config::KEYTAB_KADMIN, @args)) { - warn "wallet: cannot run $Wallet::Config::KEYTAB_KADMIN: $!\n"; - exit 1; - } - } - local $_; - my @output; - while (<KADMIN>) { - if (/^wallet: cannot /) { - s/^wallet: //; - die $_; - } - push (@output, $_) unless /Authenticating as principal/; - } - close KADMIN; - return wantarray ? @output : join ('', @output); -} - -# Check whether a given principal already exists in Kerberos. Returns true if -# so, false otherwise. Throws an exception if kadmin fails. -sub kadmin_exists { - my ($self, $principal) = @_; - return unless $self->valid_principal ($principal); - if ($Wallet::Config::KEYTAB_REALM) { - $principal .= '@' . $Wallet::Config::KEYTAB_REALM; - } - my $output = $self->kadmin ("getprinc $principal"); - if ($output =~ /^get_principal: /) { - return; - } else { - return 1; - } -} - -# Create a principal in Kerberos. Since this is only called by create, it -# throws an exception on failure rather than setting the error and returning -# undef. -sub kadmin_addprinc { - my ($self, $principal) = @_; - unless ($self->valid_principal ($principal)) { - die "invalid principal name $principal\n"; - } - return 1 if $self->kadmin_exists ($principal); - if ($Wallet::Config::KEYTAB_REALM) { - $principal .= '@' . $Wallet::Config::KEYTAB_REALM; - } - my $flags = $Wallet::Config::KEYTAB_FLAGS || ''; - my $output = $self->kadmin ("addprinc -randkey $flags $principal"); - if ($output =~ /^add_principal: (.*)/m) { - die "error adding principal $principal: $1\n"; - } - 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. -sub kadmin_ktadd { - my ($self, $principal, $file, @enctypes) = @_; - unless ($self->valid_principal ($principal)) { - $self->error ("invalid principal name: $principal"); - return; - } - if ($Wallet::Config::KEYTAB_REALM) { - $principal .= '@' . $Wallet::Config::KEYTAB_REALM; - } - my $command = "ktadd -q -k $file"; - if (@enctypes) { - @enctypes = map { /:/ ? $_ : "$_:normal" } @enctypes; - $command .= ' -e "' . join (' ', @enctypes) . '"'; - } - my $output = eval { $self->kadmin ("$command $principal") }; - if ($@) { - $self->error ($@); - return; - } elsif ($output =~ /^(?:kadmin|ktadd): (.*)/m) { - $self->error ("error creating keytab for $principal: $1"); - return; - } - return 1; -} - -# Delete a principal from Kerberos. Return true if successful, false -# otherwise. If the deletion fails, sets the error. If the principal doesn't -# exist, return success; we're bringing reality in line with our expectations. -sub kadmin_delprinc { - my ($self, $principal) = @_; - unless ($self->valid_principal ($principal)) { - $self->error ("invalid principal name: $principal"); - return; - } - my $exists = eval { $self->kadmin_exists ($principal) }; - if ($@) { - $self->error ($@); - return; - } elsif (not $exists) { - return 1; - } - if ($Wallet::Config::KEYTAB_REALM) { - $principal .= '@' . $Wallet::Config::KEYTAB_REALM; - } - my $output = eval { $self->kadmin ("delprinc -force $principal") }; - if ($@) { - $self->error ($@); - return; - } elsif ($output =~ /^delete_principal: (.*)/m) { - $self->error ("error deleting $principal: $1"); - return; - } - return 1; -} - -############################################################################## -# 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 = <KASETKEY>; - close KASETKEY; - if ($? != 0) { - $output =~ s/\s+\z//; - $output =~ s/\n/, /g; - $output = ': ' . $output if $output; - $self->error ("cannot synchronize key with kaserver$output"); - 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 @@ -487,55 +111,86 @@ sub enctypes_list { } ############################################################################## -# Keytab retrieval +# Synchronization ############################################################################## -# 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'); +# Set a synchronization target or clear the targets if $targets is an +# empty list. Returns true on success and false on failure. +# +# Currently, no synchronization targets are supported, but we preserve the +# ability to clear synchronization and the basic structure of the code so +# that they can be added later. +sub sync_set { + my ($self, $targets, $user, $host, $time) = @_; + $time ||= time; + my @trace = ($user, $host, $time); + if (@$targets > 1) { + $self->error ('only one synchronization target supported'); return; - } - eval { require Net::Remctl }; - if ($@) { - $self->error ("keytab unchanging support not available: $@"); + } elsif (@$targets) { + my $target = $targets->[0]; + $self->error ("unsupported synchronization target $target"); return; + } else { + 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; + }; + if ($@) { + $self->error ($@); + $self->{dbh}->rollback; + 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 1; +} + +# Return a list of the current synchronization targets. Returns the empty +# list on failure or on an empty list of enctype restrictions, but sets +# the object error on failure so the caller should use that to determine +# success. +sub 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); + } + $self->{dbh}->commit; + }; + if ($@) { + $self->error ($@); + $self->{dbh}->rollback; return; - } else { - return $result->stdout; } + return @targets; } ############################################################################## # 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}) { @@ -544,43 +199,15 @@ sub attr { } if ($values) { if ($attribute eq 'enctypes') { - $self->enctypes_set ($values, $user, $host, $time); + return $self->enctypes_set ($values, $user, $host, $time); } elsif ($attribute eq 'sync') { - if (@$values > 1) { - $self->error ('only one synchronization target supported'); - return; - } elsif (@$values and $values->[0] ne 'kaserver') { - my $target = $values->[0]; - $self->error ("unsupported synchronization target $target"); - return; - } elsif (@$values) { - return $self->kaserver_set ($user, $host, $time); - } else { - return $self->kaserver_clear ($user, $host, $time); - } + return $self->sync_set ($values, $user, $host, $time); } } else { if ($attribute eq 'enctypes') { return $self->enctypes_list; } elsif ($attribute eq 'sync') { - my @targets; - eval { - my $sql = 'select ks_target from keytab_sync where ks_name = ? - order by ks_target'; - my $sth = $self->{dbh}->prepare ($sql); - $sth->execute ($self->{name}); - my $target; - while (defined ($target = $sth->fetchrow_array)) { - push (@targets, $target); - } - $self->{dbh}->commit; - }; - if ($@) { - $self->error ($@); - $self->{dbh}->rollback; - return; - } - return @targets; + return $self->sync_list; } } } @@ -608,16 +235,53 @@ sub attr_show { return $output; } +# Override new to start by creating a handle for the kadmin module we're +# using. +sub new { + my ($class, $type, $name, $dbh) = @_; + my $self = { + dbh => $dbh, + kadmin => undef, + }; + bless $self, $class; + 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; +} + # Override create to start by creating the principal in Kerberos and only # create the entry in the database if that succeeds. Error handling isn't # great here since we don't have a way to communicate the error back to the # caller. sub create { my ($class, $type, $name, $dbh, $creator, $host, $time) = @_; - my $self = { dbh => $dbh }; + my $self = { + dbh => $dbh, + kadmin => undef, + }; bless $self, $class; - $self->kadmin_addprinc ($name); - return $class->SUPER::create ($type, $name, $dbh, $creator, $host, $time); + 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"; + } + $self = $class->SUPER::create ($type, $name, $dbh, $creator, $host, $time); + $self->{kadmin} = $kadmin; + return $self; } # Override destroy to delete the principal out of Kerberos as well. @@ -628,12 +292,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}); @@ -646,7 +304,11 @@ sub destroy { $self->{dbh}->rollback; return; } - return if not $self->kadmin_delprinc ($self->{name}); + my $kadmin = $self->{kadmin}; + if (not $kadmin->destroy ($self->{name})) { + $self->error ($kadmin->error); + return; + } return $self->SUPER::destroy ($user, $host, $time); } @@ -660,49 +322,20 @@ sub get { $self->error ("cannot get $id: object is locked"); return; } + my $kadmin = $self->{kadmin}; + my $result; if ($self->flag_check ('unchanging')) { - my $result = $self->keytab_retrieve ($self->{name}); - if (defined $result) { - $self->log_action ('get', $user, $host, $time); - } - return $result; - } - unless (defined ($Wallet::Config::KEYTAB_TMP)) { - $self->error ('KEYTAB_TMP configuration variable not set'); - return; - } - my $file = $Wallet::Config::KEYTAB_TMP . "/keytab.$$"; - unlink $file; - my @enctypes = $self->attr ('enctypes'); - return if not $self->kadmin_ktadd ($self->{name}, $file, @enctypes); - local *KEYTAB; - unless (open (KEYTAB, '<', $file)) { - my $princ = $self->{name}; - $self->error ("error opening keytab for principal $princ: $!"); - return; - } - local $/; - undef $!; - my $data = <KEYTAB>; - if ($!) { - my $princ = $self->{name}; - $self->error ("error reading keytab for principal $princ: $!"); - unlink $file; - return; + $result = $kadmin->keytab ($self->{name}); + } else { + my @enctypes = $self->attr ('enctypes'); + $result = $kadmin->keytab_rekey ($self->{name}, @enctypes); } - 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}); + if (defined $result) { + $self->log_action ('get', $user, $host, $time); + } else { + $self->error ($kadmin->error); } - unlink $file; - $self->log_action ('get', $user, $host, $time); - return $data; + return $result; } 1; @@ -712,6 +345,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 @@ -726,17 +363,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. @@ -748,14 +385,15 @@ 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 =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 @@ -764,15 +402,15 @@ 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<aes256-cts> or C<des-cbc-crc>). 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<normal> by the wallet. +(strings like C<aes256-cts-hmac-sha1-96> or C<des-cbc-crc>). 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<unchanging> flag is set on a keytab. Keytabs retrieved with C<unchanging> set will contain all keys present in @@ -781,33 +419,21 @@ 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<kaserver>, -which says to synchronize the key with an AFS Kerberos v4 kaserver. - -If this attribute is set on a keytab, whenever get() is called for that -keytab, the new DES key will be extracted from that keytab and set in the -configured AFS kaserver. The Kerberos v4 principal name will be the same as -the Kerberos v5 principal name except that the components are separated by -C<.> instead of C</>; the second component is truncated after the first C<.> -if the first component is one of C<host>, C<ident>, C<imap>, C<pop>, or -C<smtp>; and the first component is C<rcmd> if the Kerberos v5 principal -component is C<host>. The principal name must not contain more than two -components. - -If this attribute is set, calling destroy() will also destroy the principal -from the AFS kaserver, with a principal mapping determined as above. +This attribute is intended to set a list of external systems with which +data about this keytab is synchronized, but there are no supported targets +currently. However, there is support for clearing this attribute or +returning its current value. =back If no other arguments besides ATTRIBUTE are given, returns the values of that attribute, if any, as a list. On error, returns the empty list. To -distinguish between an error and an empty return, call error() afterwards. +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. @@ -816,20 +442,20 @@ 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<keytab> 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<keytab> 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 -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. @@ -847,18 +473,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<ktadd>, 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<sync> -attribute is not set to C<kaserver>, 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 @@ -868,30 +490,24 @@ variable is not set by default. =item KEYTAB_TMP/keytab.<pid> -The keytab is created in this file using C<ktadd> and then read into memory. -KEYTAB_TMP is set in the wallet configuration, and <pid> is the process ID -of the current process. The file is unlinked after being read. +The keytab is created in this file and then read into memory. KEYTAB_TMP +is set in the wallet configuration, and <pid> is the process ID of the +current process. The file is unlinked after being read. =back =head1 LIMITATIONS -Currently, this implementation only supports MIT Kerberos and needs -modifications to support Heimdal. It calls an external B<kadmin> program -rather than using a native Perl module and therefore requires B<kadmin> be -installed and parses its output. It may miss some error conditions if the -output of B<kadmin> 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 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<http://www.eyrie.org/~eagle/software/wallet/>. +This module is part of the wallet system. The current version is +available from L<http://www.eyrie.org/~eagle/software/wallet/>. =head1 AUTHOR diff --git a/perl/Wallet/Report.pm b/perl/Wallet/Report.pm new file mode 100644 index 0000000..7cd8653 --- /dev/null +++ b/perl/Wallet/Report.pm @@ -0,0 +1,425 @@ +# Wallet::Report -- Wallet system reporting interface. +# +# Written by Russ Allbery <rra@stanford.edu> +# Copyright 2008, 2009, 2010 Board of Trustees, Leland Stanford Jr. University +# +# See LICENSE for licensing terms. + +############################################################################## +# Modules and declarations +############################################################################## + +package Wallet::Report; +require 5.006; + +use strict; +use vars qw($VERSION); + +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'; + +############################################################################## +# Constructor, destructor, and accessors +############################################################################## + +# Create a new wallet report object. Opens a connection to the database that +# will be used for all of the wallet configuration information. Throw an +# exception if anything goes wrong. +sub new { + my ($class) = @_; + my $dbh = Wallet::Database->connect; + my $self = { dbh => $dbh }; + bless ($self, $class); + return $self; +} + +# Returns the database handle (used mostly for testing). +sub dbh { + my ($self) = @_; + return $self->{dbh}; +} + +# Set or return the error stashed in the object. +sub error { + my ($self, @error) = @_; + if (@error) { + my $error = join ('', @error); + chomp $error; + 1 while ($error =~ s/ at \S+ line \d+\.?\z//); + $self->{error} = $error; + } + return $self->{error}; +} + +# Disconnect the database handle on object destruction to avoid warnings. +sub DESTROY { + my ($self) = @_; + $self->{dbh}->disconnect unless $self->{dbh}->{InactiveDestroy}; +} + +############################################################################## +# Object reports +############################################################################## + +# 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; +} + +# 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); +} + +# Return the SQL statement and search field required to find all objects owned +# by a given ACL. If the requested owner is null, we ignore this and do a +# different search for IS NULL. If the requested owner does not actually +# match any ACLs, set an error and return undef. +sub objects_owner { + my ($self, $owner) = @_; + my ($sth); + 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); + } 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); + } +} + +# 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); +} + +# Return the SQL statement and search field required to find all objects that +# a given ACL has any permissions on. This expands from objects_owner in that +# it will also match any records that have the ACL set for get, store, show, +# destroy, or flags. If the requested owner does not actually match any ACLs, +# set an error and return the empty string. +sub objects_acl { + my ($self, $search) = @_; + my $acl = eval { Wallet::ACL->new ($search, $self->{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); +} + +# Returns a list of all objects stored in the wallet database in the form of +# type and name pairs. On error and for an empty database, the empty list +# will be returned. To distinguish between an empty list and an error, call +# error(), which will return undef if there was no error. Farms out specific +# statement to another subroutine for specific search types, but each case +# should return ob_type and ob_name in that order. +sub objects { + my ($self, $type, @args) = @_; + undef $self->{error}; + + # Find the SQL statement and the arguments to use. + my $sql = ''; + my @search = (); + if (!defined $type || $type eq '') { + ($sql) = $self->objects_all; + } else { + if (@args != 1) { + $self->error ("object searches require one argument to search"); + } elsif ($type eq 'type') { + ($sql, @search) = $self->objects_type (@args); + } elsif ($type eq 'owner') { + ($sql, @search) = $self->objects_owner (@args); + } elsif ($type eq 'flag') { + ($sql, @search) = $self->objects_flag (@args); + } elsif ($type eq 'acl') { + ($sql, @search) = $self->objects_acl (@args); + } else { + $self->error ("do not know search type: $type"); + } + return unless $sql; + } + + # Do the search. + my @objects; + eval { + my $sth = $self->{dbh}->prepare ($sql); + $sth->execute (@search); + my $object; + while (defined ($object = $sth->fetchrow_arrayref)) { + push (@objects, [ @$object ]); + } + $self->{dbh}->commit; + }; + if ($@) { + $self->error ("cannot list objects: $@"); + $self->{dbh}->rollback; + return; + } + return @objects; +} + +############################################################################## +# ACL reports +############################################################################## + +# Returns the SQL statement required to find and return all ACLs in the +# database. +sub acls_all { + my ($self) = @_; + my $sql = 'select ac_id, ac_name from acls order by ac_id'; + return ($sql); +} + +# 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'; + return ($sql); +} + +# Returns the SQL statement and the field required to find ACLs containing the +# specified entry. The identifier is automatically surrounded by wildcards to +# 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 . '%'); +} + +# Returns a list of all ACLs stored in the wallet database as a list of pairs +# of ACL IDs and ACL names, possibly limited by some criteria. On error and +# for an empty database, the empty list will be returned. To distinguish +# between an empty list and an error, call error(), which will return undef if +# there was no error. +sub acls { + my ($self, $type, @args) = @_; + undef $self->{error}; + + # Find the SQL statement and the arguments to use. + my $sql; + my @search = (); + if (!defined $type || $type eq '') { + ($sql) = $self->acls_all; + } else { + if ($type eq 'entry') { + if (@args == 0) { + $self->error ('ACL searches require an argument to search'); + return; + } else { + ($sql, @search) = $self->acls_entry (@args); + } + } elsif ($type eq 'empty') { + ($sql) = $self->acls_empty; + } else { + $self->error ("do not know 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; +} + +# Returns all ACL entries contained in owner ACLs for matching objects. +# Objects are specified by type and name, which may be SQL wildcard +# expressions. Each list member will be a pair of ACL scheme and ACL +# identifier, with duplicates removed. 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 owners { + my ($self, $type, $name) = @_; + undef $self->{error}; + my @lines; + 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 ]); + } + $self->{dbh}->commit; + }; + if ($@) { + $self->error ("cannot report on owners: $@"); + $self->{dbh}->rollback; + return; + } + return @lines; +} + +1; +__DATA__ + +############################################################################## +# Documentation +############################################################################## + +=head1 NAME + +Wallet::Report - Wallet system reporting interface + +=for stopwords +ACL ACLs wildcard Allbery SQL tuples + +=head1 SYNOPSIS + + use Wallet::Report; + my $report = Wallet::Report->new; + my @objects = $report->objects ('type', 'keytab'); + for my $object (@objects) { + print "@$object\n"; + } + +=head1 DESCRIPTION + +Wallet::Report provides a mechanism to generate lists and reports on the +contents of the wallet database. The format of the results returned +depend on the type of search, but will generally be returned as a list of +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). + +=head1 CLASS METHODS + +=over 4 + +=item new() + +Creates a new wallet report object and connects to the database. On any +error, this method throws an exception. + +=back + +=head1 INSTANCE METHODS + +For all methods that can fail, the caller should call error() after a +failure to get the error message. For all methods that return lists, if +they return an empty list, the caller should call error() to distinguish +between an empty report and an error. + +=over 4 + +=item acls([ TYPE [, SEARCH ... ]]) + +Returns a list of all ACLs matching a search type and string in the +database, or all ACLs if no search information is given. There are +currently two search types. C<empty> takes no arguments and will return +only those ACLs that have no entries within them. C<entry> takes two +arguments, an entry scheme and a (possibly partial) entry identifier, and +will return any ACLs containing an entry with that scheme and with an +identifier containing that value. + +The return value is a list of references to pairs of ACL ID and name. For +example, if there are two ACLs in the database, one with name C<ADMIN> and +ID 1 and one with name C<group/admins> and ID 3, acls() with no arguments +would return: + + ([ 1, 'ADMIN' ], [ 3, 'group/admins' ]) + +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 +have failed. Callers should call this function to get the error message +after an undef return from any other instance method. + +=item objects([ TYPE [, SEARCH ... ]]) + +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. + +There are four types of searches currently. C<type>, with a given type, +will return only those entries where the type matches the given type. +C<owner>, with a given owner, will only return those objects owned by the +given ACL name or ID. C<flag>, with a given flag name, will only return +those items with a flag set to the given value. C<acl> operates like +C<owner>, but will return only those objects that have the given ACL name +or ID on any of the possible ACL settings, not just owner. + +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 C<keytab> +and with values C<host/example.com> and C<foo>, objects() with no +arguments would return: + + ([ 'keytab', 'host/example.com' ], [ 'keytab', 'foo' ]) + +Returns the empty list on failure. To distinguish between this and an +empty search result, 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. + +=item owners(TYPE, NAME) + +Returns a list of all ACL lines contained in owner ACLs for objects +matching TYPE and NAME, which are interpreted as SQL patterns using C<%> +as a wildcard. The return value is a list of references to pairs of +schema and identifier, with duplicates removed. + +Returns the empty list on failure. To distinguish between this and no +matches, 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. + +=back + +=head1 SEE ALSO + +Wallet::Config(3), Wallet::Server(3) + +This module is part of the wallet system. The current version is +available from L<http://www.eyrie.org/~eagle/software/wallet/>. + +=head1 AUTHOR + +Russ Allbery <rra@stanford.edu> and Jon Robertson <jonrober@stanford.edu>. + +=cut diff --git a/perl/Wallet/Schema.pm b/perl/Wallet/Schema.pm index 2fb3d64..589a15d 100644 --- a/perl/Wallet/Schema.pm +++ b/perl/Wallet/Schema.pm @@ -1,8 +1,7 @@ # Wallet::Schema -- Database schema for the wallet system. -# $Id$ # # Written by Russ Allbery <rra@stanford.edu> -# 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 +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 @@ -134,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; @@ -158,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 @@ -189,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: @@ -222,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, @@ -250,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<ADMIN> (case-sensitive) is special-cased in the Wallet::Server code and granted global access. @@ -270,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<create>, C<destroy>, C<add>, or C<remove> (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<create>, C<destroy>, C<add>, or C<remove> +(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 @@ -312,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) @@ -349,36 +354,37 @@ 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<create>, C<destroy>, C<get>, C<store>, or C<set>. -oh_field must be one of C<owner>, C<acl_get>, C<acl_store>, C<acl_show>, -C<acl_destroy>, C<acl_flags>, C<expires>, C<flags>, or C<type_data>. 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<create>, C<destroy>, C<get>, C<store>, or +C<set>. oh_field must be one of C<owner>, C<acl_get>, C<acl_store>, +C<acl_show>, C<acl_destroy>, C<acl_flags>, C<expires>, C<flags>, or +C<type_data>. 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 -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: @@ -407,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<http://www.eyrie.org/~eagle/software/wallet/>. +This module is part of the wallet system. The current version is +available from L<http://www.eyrie.org/~eagle/software/wallet/>. =head1 AUTHOR diff --git a/perl/Wallet/Server.pm b/perl/Wallet/Server.pm index d4e6a91..dd596c4 100644 --- a/perl/Wallet/Server.pm +++ b/perl/Wallet/Server.pm @@ -1,8 +1,7 @@ # Wallet::Server -- Wallet system server implementation. -# $Id$ # # Written by Russ Allbery <rra@stanford.edu> -# 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. @@ -24,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 @@ -715,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; @@ -726,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<wallet-backend>, a thin wrapper around this object that determines the authenticated remote @@ -735,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 @@ -766,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<get>, C<store>, C<show>, C<destroy>, or -C<flags>. 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<flags>. 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 @@ -799,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) @@ -878,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 @@ -889,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() @@ -910,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<YYYY-MM-DD +HH:MM:SS>, although the time portion may be @@ -925,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. @@ -951,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 @@ -1000,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<http://www.eyrie.org/~eagle/software/wallet/>. +This module is part of the wallet system. The current version is +available from L<http://www.eyrie.org/~eagle/software/wallet/>. =head1 AUTHOR diff --git a/perl/t/acl.t b/perl/t/acl.t index e46b7f8..95aa763 100755 --- a/perl/t/acl.t +++ b/perl/t/acl.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ # # t/api.t -- Tests for the wallet ACL API. # diff --git a/perl/t/admin.t b/perl/t/admin.t index 4b8302d..e22088e 100755 --- a/perl/t/admin.t +++ b/perl/t/admin.t @@ -1,16 +1,16 @@ #!/usr/bin/perl -w -# $Id$ # # t/admin.t -- Tests for wallet administrative interface. # # Written by Russ Allbery <rra@stanford.edu> -# Copyright 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008, 2009, 2010 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. -use Test::More tests => 29; +use Test::More tests => 16; use Wallet::Admin; +use Wallet::Report; use Wallet::Schema; use Wallet::Server; @@ -26,10 +26,11 @@ is ($admin->initialize ('admin@EXAMPLE.COM'), 1, ' and initialization succeeds'); # We have an empty database, so we should see no objects and one ACL. -my @objects = $admin->list_objects; +my $report = Wallet::Report->new; +my @objects = $report->objects; is (scalar (@objects), 0, 'No objects in the database'); -is ($admin->error, undef, ' and no error'); -my @acls = $admin->list_acls; +is ($report->error, undef, ' and no error'); +my @acls = $report->acls; is (scalar (@acls), 1, 'One ACL in the database'); is ($acls[0][0], 1, ' and that is ACL ID 1'); is ($acls[0][1], 'ADMIN', ' with the right name'); @@ -37,42 +38,20 @@ is ($acls[0][1], 'ADMIN', ' with the right name'); # Register a base object so that we can create a simple object. is ($admin->register_object ('base', 'Wallet::Object::Base'), 1, 'Registering Wallet::Object::Base works'); - -# Create an object. +is ($admin->register_object ('base', 'Wallet::Object::Base'), undef, + ' and cannot be registered twice'); $server = eval { Wallet::Server->new ('admin@EXAMPLE.COM', 'localhost') }; is ($@, '', 'Creating a server instance did not die'); is ($server->create ('base', 'service/admin'), 1, ' and creating base:service/admin succeeds'); -# Now, we should see one object. -@objects = $admin->list_objects; -is (scalar (@objects), 1, ' and now there is one object'); -is ($objects[0][0], 'base', ' with the right type'); -is ($objects[0][1], 'service/admin', ' and the right name'); - -# Test registering a new ACL type. We don't have a good way of really using -# this right now. +# Test registering a new ACL type. is ($admin->register_verifier ('base', 'Wallet::ACL::Base'), 1, 'Registering Wallet::ACL::Base works'); - -# Create another ACL. -is ($server->acl_create ('first'), 1, 'ACL creation succeeds'); -@acls = $admin->list_acls; -is (scalar (@acls), 2, ' and now there are two ACLs'); -is ($acls[0][0], 1, ' and the first ID is correct'); -is ($acls[0][1], 'ADMIN', ' and the first name is correct'); -is ($acls[1][0], 2, ' and the second ID is correct'); -is ($acls[1][1], 'first', ' and the second name is correct'); - -# Delete that ACL and create another. -is ($server->acl_create ('second'), 1, 'Second ACL creation succeeds'); -is ($server->acl_destroy ('first'), 1, ' and deletion of the first succeeds'); -@acls = $admin->list_acls; -is (scalar (@acls), 2, ' and there are still two ACLs'); -is ($acls[0][0], 1, ' and the first ID is still the same'); -is ($acls[0][1], 'ADMIN', ' and the first name is still the same'); -is ($acls[1][0], 3, ' but the second ID has changed'); -is ($acls[1][1], 'second', ' and the second name is correct'); +is ($admin->register_verifier ('base', 'Wallet::ACL::Base'), undef, + ' and cannot be registered twice'); +is ($server->acl_add ('ADMIN', 'base', 'foo'), 1, + ' and adding a base ACL now works'); # Clean up. is ($admin->destroy, 1, 'Destruction succeeds'); diff --git a/perl/t/config.t b/perl/t/config.t index 0d159dc..1377cb8 100755 --- a/perl/t/config.t +++ b/perl/t/config.t @@ -1,14 +1,13 @@ #!/usr/bin/perl -w -# $Id$ # # t/config.t -- Tests for the wallet server configuration. # # Written by Russ Allbery <rra@stanford.edu> -# 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; @@ -26,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/data/README b/perl/t/data/README index 4abbaeb..d250d33 100644 --- a/perl/t/data/README +++ b/perl/t/data/README @@ -21,6 +21,7 @@ following files: test.keytab Keytab for an authorized user test.principal Principal of the authorized user test.realm Kerberos realm in which to do testing + test.krbtype Type of Kerberos server (Heimdal or MIT) This realm will also need to be configured in your local krb5.conf, including the admin_server for the realm. diff --git a/perl/t/data/keytab-fake b/perl/t/data/keytab-fake index df21294..0ecf264 100755 --- a/perl/t/data/keytab-fake +++ b/perl/t/data/keytab-fake @@ -1,5 +1,4 @@ #!/bin/sh -# $Id$ # # keytab-fake -- Fake keytab-backend implementation. # diff --git a/perl/t/data/keytab.conf b/perl/t/data/keytab.conf index eb105e2..484443f 100644 --- a/perl/t/data/keytab.conf +++ b/perl/t/data/keytab.conf @@ -1,5 +1,3 @@ -# $Id$ -# # This is the remctl configuration used for testing the keytab backend's # ability to retrieve existing keytabs through remctl. Currently the only # supported and used command is keytab retrieve. The ACL is written on diff --git a/perl/t/data/netdb-fake b/perl/t/data/netdb-fake index 56744a7..ae5be18 100755 --- a/perl/t/data/netdb-fake +++ b/perl/t/data/netdb-fake @@ -1,5 +1,4 @@ #!/bin/sh -# $Id$ # # netdb-fake -- Fake NetDB remctl interface. # diff --git a/perl/t/data/netdb.conf b/perl/t/data/netdb.conf index e7908ed..f08bfaa 100644 --- a/perl/t/data/netdb.conf +++ b/perl/t/data/netdb.conf @@ -1,5 +1,3 @@ -# $Id$ -# # This is the remctl configuration used for testing the NetDB ACL verifier. # The ACL is written on the fly by the test program. diff --git a/perl/t/file.t b/perl/t/file.t index 8eaa0f1..7ab5d75 100755 --- a/perl/t/file.t +++ b/perl/t/file.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ # # t/file.t -- Tests for the file object implementation. # diff --git a/perl/t/init.t b/perl/t/init.t index 70085c9..d0fae9f 100755 --- a/perl/t/init.t +++ b/perl/t/init.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ # # t/init.t -- Tests for database initialization. # diff --git a/perl/t/kadmin.t b/perl/t/kadmin.t new file mode 100755 index 0000000..bbcb15a --- /dev/null +++ b/perl/t/kadmin.t @@ -0,0 +1,109 @@ +#!/usr/bin/perl -w +# +# t/kadmin.t -- Tests for the kadmin object implementation. +# +# Written by Jon Robertson <jonrober@stanford.edu> +# Copyright 2009, 2010 Board of Trustees, Leland Stanford Jr. University +# +# See LICENSE for licensing terms. + +use POSIX qw(strftime); +use Test::More tests => 32; + +BEGIN { $Wallet::Config::KEYTAB_TMP = '.' } + +use Wallet::Admin; +use Wallet::Config; +use Wallet::Kadmin; +use Wallet::Kadmin::MIT; + +# Only load Wallet::Kadmin::Heimdal if a required module is found. +my $heimdal_kadm5 = 0; +eval 'use Heimdal::Kadm5'; +if (!$@) { + $heimdal_kadm5 = 1; + require Wallet::Kadmin::Heimdal; +} + +use lib 't/lib'; +use Util; + +# Test creating an MIT object and seeing if the callback works. +$Wallet::Config::KEYTAB_KRBTYPE = 'MIT'; +my $kadmin = Wallet::Kadmin->new; +ok (defined ($kadmin), 'MIT kadmin object created'); +my $callback = sub { return 1 }; +$kadmin->fork_callback ($callback); +is ($kadmin->{fork_callback} (), 1, ' and callback works'); +$callback = sub { return 2 }; +$kadmin->fork_callback ($callback); +is ($kadmin->{fork_callback} (), 2, ' and changing it works'); + +# Check principal validation in the Wallet::Kadmin::MIT module. This is +# specific to that module, since Heimdal doesn't require passing the principal +# through the kadmin client. +for my $bad (qw{service\* = host/foo+bar host/foo/bar /bar bar/ rcmd.foo}) { + ok (! Wallet::Kadmin::MIT->valid_principal ($bad), + "Invalid principal name $bad"); +} +for my $good (qw{service service/foo bar foo/bar host/example.org + aservice/foo}) { + ok (Wallet::Kadmin::MIT->valid_principal ($good), + "Valid principal name $good"); +} + +# Test creating a Heimdal object. We deliberately connect without +# configuration to get the error. That tests that we can find the Heimdal +# module and it dies how it should. +SKIP: { + skip 'Heimdal::Kadm5 not installed', 3 unless $heimdal_kadm5; + undef $Wallet::Config::KEYTAB_PRINCIPAL; + undef $Wallet::Config::KEYTAB_FILE; + undef $Wallet::Config::KEYTAB_REALM; + undef $kadmin; + $Wallet::Config::KEYTAB_KRBTYPE = 'Heimdal'; + $kadmin = eval { Wallet::Kadmin->new }; + is ($kadmin, undef, 'Heimdal fails properly'); + is ($@, "keytab object implementation not configured\n", + ' with the right error'); +} + +# Now, check the generic API. We can run this test no matter which +# implementation is configured. This retests some things that are also tested +# by the keytab test, but specifically through the Wallet::Kadmin API. +SKIP: { + skip 'no keytab configuration', 14 unless -f 't/data/test.keytab'; + + # Set up our configuration. + $Wallet::Config::KEYTAB_FILE = 't/data/test.keytab'; + $Wallet::Config::KEYTAB_PRINCIPAL = contents ('t/data/test.principal'); + $Wallet::Config::KEYTAB_REALM = contents ('t/data/test.realm'); + $Wallet::Config::KEYTAB_KRBTYPE = contents ('t/data/test.krbtype'); + $Wallet::Config::KEYTAB_TMP = '.'; + + # Create the object and clean up the principal we're going to use. + $kadmin = eval { Wallet::Kadmin->new }; + ok (defined $kadmin, 'Creating Wallet::Kadmin object succeeds'); + is ($@, '', ' and there is no error'); + is ($kadmin->destroy ('wallet/one'), 1, 'Deleting wallet/one works'); + is ($kadmin->exists ('wallet/one'), 0, ' and it does not exist'); + + # Create the principal and check that keytab returns something. We'll + # check the details of the return in the keytab check. + is ($kadmin->create ('wallet/one'), 1, 'Creating wallet/one works'); + is ($kadmin->exists ('wallet/one'), 1, ' and it now exists'); + my $data = $kadmin->keytab_rekey ('wallet/one'); + ok (defined ($data), ' and retrieving a keytab works'); + is (keytab_valid ($data, 'wallet/one'), 1, + ' and works for authentication'); + + # 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_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%, + ' and the right error message is set'); + is ($kadmin->destroy ('wallet/one'), 1, ' and deleting it again works'); +} diff --git a/perl/t/keytab.t b/perl/t/keytab.t index c1348d4..046da9c 100755 --- a/perl/t/keytab.t +++ b/perl/t/keytab.t @@ -1,18 +1,21 @@ #!/usr/bin/perl -w -# $Id$ # # t/keytab.t -- Tests for the keytab object implementation. # # Written by Russ Allbery <rra@stanford.edu> -# Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2008, 2009, 2010 +# Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. use POSIX qw(strftime); -use Test::More tests => 223; +use Test::More tests => 135; + +BEGIN { $Wallet::Config::KEYTAB_TMP = '.' } use Wallet::Admin; use Wallet::Config; +use Wallet::Kadmin; use Wallet::Object::Keytab; use lib 't/lib'; @@ -25,7 +28,7 @@ my %enctype = ('triple des cbc mode with hmac/sha1' => 'des3-cbc-sha1', 'des cbc mode with crc-32' => 'des-cbc-crc', 'des cbc mode with rsa-md5' => 'des-cbc-md5', - 'aes-256 cts mode with 96-bit sha-1 hmac' => 'aes256-cts', + 'aes-256 cts mode with 96-bit sha-1 hmac' => 'aes256-cts-hmac-sha1-96', 'arcfour with hmac/md5' => 'rc4-hmac'); # Some global defaults to use. @@ -57,60 +60,51 @@ sub system_quiet { # been set up. sub create { my ($principal) = @_; - my @args = ('-p', $Wallet::Config::KEYTAB_PRINCIPAL, '-k', - '-t', $Wallet::Config::KEYTAB_FILE, - '-r', $Wallet::Config::KEYTAB_REALM, - '-q', "addprinc -clearpolicy -randkey $principal"); - system_quiet ($Wallet::Config::KEYTAB_KADMIN, @args); + my $kadmin = Wallet::Kadmin->new; + return $kadmin->create ($principal); } # Destroy a principal out of Kerberos. Only usable once the configuration has # been set up. sub destroy { my ($principal) = @_; - my @args = ('-p', $Wallet::Config::KEYTAB_PRINCIPAL, '-k', - '-t', $Wallet::Config::KEYTAB_FILE, - '-r', $Wallet::Config::KEYTAB_REALM, - '-q', "delprinc -force $principal"); - system_quiet ($Wallet::Config::KEYTAB_KADMIN, @args); + my $kadmin = Wallet::Kadmin->new; + return $kadmin->destroy ($principal); } -# Check whether a principal exists. +# Check whether a principal exists. MIT uses kvno and Heimdal uses kgetcred. +# Note that the Kerberos type may be different than our local userspace, so +# don't use the Kerberos type to decide here. Instead, check for which +# program is available on the path. sub created { my ($principal) = @_; $principal .= '@' . $Wallet::Config::KEYTAB_REALM; local $ENV{KRB5CCNAME} = 'krb5cc_temp'; getcreds ('t/data/test.keytab', $Wallet::Config::KEYTAB_PRINCIPAL); - return (system_quiet ('kvno', $principal) == 0); -} - -# Given keytab data and the principal, write it to a file and try -# authenticating using kinit. -sub valid { - my ($keytab, $principal) = @_; - open (KEYTAB, '>', 'keytab') or die "cannot create keytab: $!\n"; - print KEYTAB $keytab; - close KEYTAB; - $principal .= '@' . $Wallet::Config::KEYTAB_REALM; - my $result = getcreds ('keytab', $principal); - if ($result) { - unlink 'keytab'; + if (grep { -x "$_/kvno" } split (':', $ENV{PATH})) { + return (system_quiet ('kvno', $principal) == 0); + } elsif (grep { -x "$_/kgetcred" } split (':', $ENV{PATH})) { + return (system_quiet ('kgetcred', $principal) == 0); + } else { + warn "# No kvno or kgetcred found\n"; + return; } - return $result; } # Given keytab data, write it to a file and try to determine the enctypes of # the keys present in that file. Returns the enctypes as a list, with UNKNOWN # for encryption types that weren't recognized. This is an ugly way of doing -# this. +# this for MIT. Heimdal is much more straightforward, but MIT ktutil doesn't +# have the needed abilities. sub enctypes { my ($keytab) = @_; open (KEYTAB, '>', 'keytab') or die "cannot create keytab: $!\n"; print KEYTAB $keytab; close KEYTAB; + + my @enctypes; open (KLIST, '-|', 'klist', '-ke', 'keytab') or die "cannot run klist: $!\n"; - my @enctypes; local $_; while (<KLIST>) { next unless /^ *\d+ /; @@ -120,26 +114,24 @@ sub enctypes { push (@enctypes, $enctype); } close KLIST; - unlink 'keytab'; - 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; + # If that failed, we may have a Heimdal user space instead, so try ktutil. + # If we try this directly, it will just hang with MIT ktutil. + if ($? != 0) { + @enctypes = (); + open (KTUTIL, '-|', 'ktutil', '-k', 'keytab', 'list') + or die "cannot run ktutil: $!\n"; + local $_; + while (<KTUTIL>) { + next unless /^ *\d+ /; + my ($string) = /^\s*\d+\s+(\S+)/; + next unless $string; + push (@enctypes, $string); + } + close KTUTIL; } - $ENV{KRBTKFILE} = 'krb4cc_temp'; - system ("k4start -f srvtab $k4 2>&1 >/dev/null </dev/null"); - unlink 'keytab', 'srvtab', 'krb4cc_temp'; - return ($? == 0) ? 1 : 0; + unlink 'keytab'; + return sort @enctypes; } # Use Wallet::Admin to set up the database. @@ -154,27 +146,15 @@ my $dbh = $admin->dbh; my $history = ''; my $date = strftime ('%Y-%m-%d %H:%M:%S', localtime $trace[2]); -# Do some white-box testing of the principal validation regex. -for my $bad (qw{service\* = host/foo+bar host/foo/bar /bar bar/ - rcmd.foo}) { - ok (! Wallet::Object::Keytab->valid_principal ($bad), - "Invalid principal name $bad"); -} -for my $good (qw{service service/foo bar foo/bar host/example.org - aservice/foo}) { - ok (Wallet::Object::Keytab->valid_principal ($good), - "Valid principal name $good"); -} - # Basic keytab creation and manipulation tests. SKIP: { - skip 'no keytab configuration', 49 unless -f 't/data/test.keytab'; + skip 'no keytab configuration', 52 unless -f 't/data/test.keytab'; # Set up our configuration. $Wallet::Config::KEYTAB_FILE = 't/data/test.keytab'; $Wallet::Config::KEYTAB_PRINCIPAL = contents ('t/data/test.principal'); $Wallet::Config::KEYTAB_REALM = contents ('t/data/test.realm'); - $Wallet::Config::KEYTAB_TMP = '.'; + $Wallet::Config::KEYTAB_KRBTYPE = contents ('t/data/test.krbtype'); my $realm = $Wallet::Config::KEYTAB_REALM; # Clean up the principals we're going to use. @@ -184,17 +164,36 @@ SKIP: { # Don't destroy the user's Kerberos ticket cache. $ENV{KRB5CCNAME} = 'krb5cc_test'; + # Test that object creation without KEYTAB_TMP fails. + undef $Wallet::Config::KEYTAB_TMP; + $object = eval { + Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace) + }; + is ($object, undef, 'Creating keytab without KEYTAB_TMP fails'); + is ($@, "KEYTAB_TMP configuration variable not set\n", + ' with the right error'); + $Wallet::Config::KEYTAB_TMP = '.'; + # Okay, now we can test. First, create. $object = eval { Wallet::Object::Keytab->create ('keytab', "wallet\nf", $dbh, @trace) }; is ($object, undef, 'Creating malformed principal fails'); - is ($@, "invalid principal name wallet\nf\n", ' with the right error'); + if ($Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') { + is ($@, "invalid principal name wallet\nf\n", ' with the right error'); + } elsif ($Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal') { + like ($@, qr/^error adding principal wallet\nf/, + ' with the right error'); + } $object = eval { Wallet::Object::Keytab->create ('keytab', '', $dbh, @trace) }; is ($object, undef, 'Creating empty principal fails'); - is ($@, "invalid principal name \n", ' with the right error'); + if ($Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') { + is ($@, "invalid principal name \n", ' with the right error'); + } elsif ($Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal') { + like ($@, qr/^error adding principal \@/, ' with the right error'); + } $object = eval { Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace) }; @@ -209,9 +208,14 @@ SKIP: { $object = eval { Wallet::Object::Keytab->create ('keytab', 'wallet/two', $dbh, @trace) }; - ok (defined ($object), 'Creating an existing principal succeeds'); + if (defined ($object)) { + ok (defined ($object), 'Creating an existing principal succeeds'); + } else { + is ($@, '', 'Creating an existing principal succeeds'); + } ok ($object->isa ('Wallet::Object::Keytab'), ' and is the right class'); is ($object->destroy (@trace), 1, ' and destroying it succeeds'); + is ($object->error, undef, ' with no error message'); ok (! created ('wallet/two'), ' and now it does not exist'); my @name = qw(keytab wallet-test/one); $object = eval { Wallet::Object::Keytab->create (@name, $dbh, @trace) }; @@ -236,7 +240,7 @@ SKIP: { is ($object->error, '', ' and getting the keytab works'); } ok (! -f "./keytab.$$", ' and the temporary file was cleaned up'); - ok (valid ($data, 'wallet/one'), ' and the keytab is valid'); + ok (keytab_valid ($data, 'wallet/one'), ' and the keytab is valid'); # For right now, this is the only backend type that we have for which we # can do a get, so test display of the last download information. @@ -253,18 +257,16 @@ EOO is ($object->show, $expected, 'Show output is correct'); # Test error handling on keytab retrieval. - undef $Wallet::Config::KEYTAB_TMP; - $data = $object->get (@trace); - is ($data, undef, 'Getting a keytab without a tmp directory fails'); - is ($object->error, 'KEYTAB_TMP configuration variable not set', - ' with the right error'); - $Wallet::Config::KEYTAB_TMP = '.'; - $Wallet::Config::KEYTAB_KADMIN = '/some/nonexistent/file'; - $data = $object->get (@trace); - is ($data, undef, 'Cope with a failure to run kadmin'); - like ($object->error, qr{^cannot run /some/nonexistent/file: }, - ' with the right error'); - $Wallet::Config::KEYTAB_KADMIN = 'kadmin'; + SKIP: { + skip 'no kadmin program test for Heimdal', 2 + if $Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal'; + $Wallet::Config::KEYTAB_KADMIN = '/some/nonexistent/file'; + $data = $object->get (@trace); + is ($data, undef, 'Cope with a failure to run kadmin'); + like ($object->error, qr{^cannot run /some/nonexistent/file: }, + ' with the right error'); + $Wallet::Config::KEYTAB_KADMIN = 'kadmin'; + } destroy ('wallet/one'); $data = $object->get (@trace); is ($data, undef, 'Getting a keytab for a nonexistent principal fails'); @@ -279,12 +281,16 @@ EOO }; ok (defined ($object), 'Creating good principal succeeds'); ok (created ('wallet/one'), ' and the principal was created'); - $Wallet::Config::KEYTAB_KADMIN = '/some/nonexistent/file'; - is ($object->destroy (@trace), undef, - ' and destroying it with bad kadmin fails'); - like ($object->error, qr{^cannot run /some/nonexistent/file: }, - ' with the right error'); - $Wallet::Config::KEYTAB_KADMIN = 'kadmin'; + SKIP: { + skip 'no kadmin program test for Heimdal', 2 + if $Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal'; + $Wallet::Config::KEYTAB_KADMIN = '/some/nonexistent/file'; + is ($object->destroy (@trace), undef, + ' and destroying it with bad kadmin fails'); + like ($object->error, qr{^cannot run /some/nonexistent/file: }, + ' with the right error'); + $Wallet::Config::KEYTAB_KADMIN = 'kadmin'; + } is ($object->flag_set ('locked', @trace), 1, ' and setting locked works'); is ($object->destroy (@trace), undef, ' and destroying it fails'); is ($object->error, "cannot destroy keytab:wallet/one: object is locked", @@ -342,30 +348,33 @@ EOO is ($@, "keytab object implementation not configured\n", ' with the right error'); $Wallet::Config::KEYTAB_REALM = contents ('t/data/test.realm'); - $Wallet::Config::KEYTAB_KADMIN = '/some/nonexistent/file'; + undef $Wallet::Config::KEYTAB_KRBTYPE; $object = eval { Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace) }; - is ($object, undef, 'Cope with a failure to run kadmin'); - like ($@, qr{^cannot run /some/nonexistent/file: }, - ' with the right error'); - $Wallet::Config::KEYTAB_KADMIN = 'kadmin'; + is ($object, undef, ' and another'); + is ($@, "keytab object implementation not configured\n", + ' with the right error'); + $Wallet::Config::KEYTAB_KRBTYPE = 'Active Directory'; + $object = eval { + Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace) + }; + is ($object, undef, ' and one set to an invalid value'); + is ($@, "unknown KEYTAB_KRBTYPE setting: Active Directory\n", + ' with the right error'); + $Wallet::Config::KEYTAB_KRBTYPE = contents ('t/data/test.krbtype'); } # 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'; $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 = '.'; my $realm = $Wallet::Config::KEYTAB_REALM; my $principal = $Wallet::Config::KEYTAB_PRINCIPAL; @@ -382,41 +391,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 (keytab_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 (keytab_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 (keytab_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"; @@ -426,61 +479,30 @@ $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 is ($one->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'; + skip 'no keytab configuration', 18 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 @@ -495,16 +517,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'); @@ -521,15 +547,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 @@ -537,135 +558,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_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. @@ -676,6 +569,7 @@ SKIP: { $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 = '.'; my $realm = $Wallet::Config::KEYTAB_REALM; my $principal = $Wallet::Config::KEYTAB_PRINCIPAL; @@ -742,8 +636,7 @@ EOO 'Setting an unrecognized enctype fails'); is ($one->error, 'unknown encryption type foo-bar', ' with the right error message'); - @values = enctypes ($keytab); - is ("@values", "@enctypes", ' and we did rollback properly'); + is ($one->show, $expected, ' and we did rollback properly'); $history .= <<"EOO"; $date get by $user from $host @@ -753,6 +646,7 @@ EOO # Now, try testing limiting the enctypes to just one. SKIP: { skip 'insufficient recognized enctypes', 14 unless @enctypes > 1; + is ($one->attr ('enctypes', [ $enctypes[0] ], @trace), 1, 'Setting a single enctype works'); for my $enctype (@enctypes) { @@ -764,8 +658,12 @@ EOO is ("@values", $enctypes[0], ' and we get back the right value'); $keytab = $one->get (@trace); ok (defined ($keytab), ' and retrieving the keytab still works'); - @values = enctypes ($keytab); - is ("@values", $enctypes[0], ' and it has the right enctype'); + if (defined ($keytab)) { + @values = enctypes ($keytab); + is ("@values", $enctypes[0], ' and it has the right enctype'); + } else { + ok (0, ' and it has the right keytab'); + } is ($one->attr ('enctypes', [ $enctypes[1] ], @trace), 1, 'Setting a different single enctype works'); @values = $one->attr ('enctypes'); diff --git a/perl/t/lib/Util.pm b/perl/t/lib/Util.pm index a1bacbd..ab88b39 100644 --- a/perl/t/lib/Util.pm +++ b/perl/t/lib/Util.pm @@ -1,5 +1,4 @@ # Util -- Utility class for wallet tests. -# $Id$ # # Written by Russ Allbery <rra@stanford.edu> # Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University @@ -21,7 +20,8 @@ $VERSION = '0.02'; use Exporter (); @ISA = qw(Exporter); -@EXPORT = qw(contents db_setup getcreds remctld_spawn remctld_stop); +@EXPORT = qw(contents db_setup getcreds keytab_valid remctld_spawn + remctld_stop); ############################################################################## # General utility functions @@ -67,7 +67,7 @@ sub db_setup { } ############################################################################## -# Local ticket cache +# Kerberos utility functions ############################################################################## # Given a keytab file and a principal, try authenticating with kinit. @@ -86,6 +86,22 @@ sub getcreds { return 0; } +# Given keytab data and the principal, write it to a file and try +# authenticating using kinit. +sub keytab_valid { + my ($keytab, $principal) = @_; + open (KEYTAB, '>', 'keytab') or die "cannot create keytab: $!\n"; + print KEYTAB $keytab; + close KEYTAB; + $principal .= '@' . $Wallet::Config::KEYTAB_REALM + unless $principal =~ /\@/; + my $result = getcreds ('keytab', $principal); + if ($result) { + unlink 'keytab'; + } + return $result; +} + ############################################################################## # remctld handling ############################################################################## diff --git a/perl/t/object.t b/perl/t/object.t index 94fe22b..46e67e5 100755 --- a/perl/t/object.t +++ b/perl/t/object.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ # # t/object.t -- Tests for the basic object implementation. # @@ -256,11 +255,11 @@ ok (defined ($object), 'Recreating the object succeeds'); $output = <<"EOO"; $date create by $user from $host -$date set owner to 1 +$date set owner to ADMIN (1) by $user from $host -$date unset owner (was 1) +$date unset owner (was ADMIN (1)) by $user from $host -$date set owner to 1 +$date set owner to ADMIN (1) by $user from $host $date set expires to $now by $user from $host @@ -268,35 +267,35 @@ $date unset expires (was $now) by $user from $host $date set expires to $now by $user from $host -$date set acl_get to 1 +$date set acl_get to ADMIN (1) by $user from $host -$date unset acl_get (was 1) +$date unset acl_get (was ADMIN (1)) by $user from $host -$date set acl_get to 1 +$date set acl_get to ADMIN (1) by $user from $host -$date set acl_store to 1 +$date set acl_store to ADMIN (1) by $user from $host -$date unset acl_store (was 1) +$date unset acl_store (was ADMIN (1)) by $user from $host -$date set acl_store to 1 +$date set acl_store to ADMIN (1) by $user from $host -$date set acl_show to 1 +$date set acl_show to ADMIN (1) by $user from $host -$date unset acl_show (was 1) +$date unset acl_show (was ADMIN (1)) by $user from $host -$date set acl_show to 1 +$date set acl_show to ADMIN (1) by $user from $host -$date set acl_destroy to 1 +$date set acl_destroy to ADMIN (1) by $user from $host -$date unset acl_destroy (was 1) +$date unset acl_destroy (was ADMIN (1)) by $user from $host -$date set acl_destroy to 1 +$date set acl_destroy to ADMIN (1) by $user from $host -$date set acl_flags to 1 +$date set acl_flags to ADMIN (1) by $user from $host -$date unset acl_flags (was 1) +$date unset acl_flags (was ADMIN (1)) by $user from $host -$date set acl_flags to 1 +$date set acl_flags to ADMIN (1) by $user from $host $date set flag locked by $user from $host 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 <rra@stanford.edu> +# +# 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 = <CHILD>; + 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 da4d0d3..c467b82 100755 --- a/perl/t/pod.t +++ b/perl/t/pod.t @@ -1,17 +1,14 @@ -#!/usr/bin/perl -# $Id$ +#!/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 <rra@stanford.edu> -# 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 (); diff --git a/perl/t/report.t b/perl/t/report.t new file mode 100755 index 0000000..a18b995 --- /dev/null +++ b/perl/t/report.t @@ -0,0 +1,171 @@ +#!/usr/bin/perl -w +# +# t/report.t -- Tests for the wallet reporting interface. +# +# Written by Russ Allbery <rra@stanford.edu> +# Copyright 2008, 2009, 2010 Board of Trustees, Leland Stanford Jr. University +# +# See LICENSE for licensing terms. + +use Test::More tests => 83; + +use Wallet::Admin; +use Wallet::Report; +use Wallet::Server; + +use lib 't/lib'; +use Util; + +# Use Wallet::Admin to set up the database. +db_setup; +my $admin = eval { Wallet::Admin->new }; +is ($@, '', 'Wallet::Admin creation did not die'); +is ($admin->reinitialize ('admin@EXAMPLE.COM'), 1, + 'Database initialization succeeded'); +$admin->register_object ('base', 'Wallet::Object::Base'); +$admin->register_verifier ('base', 'Wallet::ACL::Base'); + +# We have an empty database, so we should see no objects and one ACL. +my $report = eval { Wallet::Report->new }; +is ($@, '', 'Wallet::Report creation did not die'); +ok ($report->isa ('Wallet::Report'), ' and returned the right class'); +my @objects = $report->objects; +is (scalar (@objects), 0, 'No objects in the database'); +is ($report->error, undef, ' and no error'); +my @acls = $report->acls; +is (scalar (@acls), 1, 'One ACL in the database'); +is ($acls[0][0], 1, ' and that is ACL ID 1'); +is ($acls[0][1], 'ADMIN', ' with the right name'); + +# Create an object. +$server = eval { Wallet::Server->new ('admin@EXAMPLE.COM', 'localhost') }; +is ($@, '', 'Creating a server instance did not die'); +is ($server->create ('base', 'service/admin'), 1, + ' and creating base:service/admin succeeds'); + +# Now, we should see one object. +@objects = $report->objects; +is (scalar (@objects), 1, ' and now there is one object'); +is ($objects[0][0], 'base', ' with the right type'); +is ($objects[0][1], 'service/admin', ' and the right name'); + +# Create another ACL. +is ($server->acl_create ('first'), 1, 'ACL creation succeeds'); +@acls = $report->acls; +is (scalar (@acls), 2, ' and now there are two ACLs'); +is ($acls[0][0], 1, ' and the first ID is correct'); +is ($acls[0][1], 'ADMIN', ' and the first name is correct'); +is ($acls[1][0], 2, ' and the second ID is correct'); +is ($acls[1][1], 'first', ' and the second name is correct'); + +# Delete that ACL and create another. +is ($server->acl_create ('second'), 1, 'Second ACL creation succeeds'); +is ($server->acl_destroy ('first'), 1, ' and deletion of the first succeeds'); +@acls = $report->acls; +is (scalar (@acls), 2, ' and there are still two ACLs'); +is ($acls[0][0], 1, ' and the first ID is still the same'); +is ($acls[0][1], 'ADMIN', ' and the first name is still the same'); +is ($acls[1][0], 3, ' but the second ID has changed'); +is ($acls[1][1], 'second', ' and the second name is correct'); + +# Currently, we have no owners, so we should get an empty owner report. +my @lines = $report->owners ('%', '%'); +is (scalar (@lines), 0, 'Owner report is currently empty'); +is ($report->error, undef, ' and there is no error'); + +# Set an owner and make sure we now see something in the report. +is ($server->owner ('base', 'service/admin', 'ADMIN'), 1, + 'Setting an owner works'); +@lines = $report->owners ('%', '%'); +is (scalar (@lines), 1, ' and now there is one owner in the report'); +is ($lines[0][0], 'krb5', ' with the right scheme'); +is ($lines[0][1], 'admin@EXAMPLE.COM', ' and the right identifier'); +@lines = $report->owners ('keytab', '%'); +is (scalar (@lines), 0, 'Owners of keytabs is empty'); +is ($report->error, undef, ' with no error'); +@lines = $report->owners ('base', 'foo/%'); +is (scalar (@lines), 0, 'Owners of base foo/* objects is empty'); +is ($report->error, undef, ' with no error'); + +# Create a second object with the same owner. +is ($server->create ('base', 'service/foo'), 1, + 'Creating base:service/foo succeeds'); +is ($server->owner ('base', 'service/foo', 'ADMIN'), 1, + ' and setting the owner to the same value works'); +@lines = $report->owners ('base', 'service/%'); +is (scalar (@lines), 1, ' and there is still owner in the report'); +is ($lines[0][0], 'krb5', ' with the right scheme'); +is ($lines[0][1], 'admin@EXAMPLE.COM', ' and the right identifier'); + +# Change the owner of the second object to an empty ACL. +is ($server->owner ('base', 'service/foo', 'second'), 1, + ' and changing the owner to an empty ACL works'); +@lines = $report->owners ('base', '%'); +is (scalar (@lines), 1, ' and there is still owner in the report'); +is ($lines[0][0], 'krb5', ' with the right scheme'); +is ($lines[0][1], 'admin@EXAMPLE.COM', ' and the right identifier'); + +# Add a few things to the second ACL to see what happens. +is ($server->acl_add ('second', 'base', 'foo'), 1, + 'Adding an ACL line to the new ACL works'); +is ($server->acl_add ('second', 'base', 'bar'), 1, + ' and adding another ACL line to the new ACL works'); +@lines = $report->owners ('base', '%'); +is (scalar (@lines), 3, ' and now there are three owners in the report'); +is ($lines[0][0], 'base', ' first has the right scheme'); +is ($lines[0][1], 'bar', ' and the right identifier'); +is ($lines[1][0], 'base', ' second has the right scheme'); +is ($lines[1][1], 'foo', ' and the right identifier'); +is ($lines[2][0], 'krb5', ' third has the right scheme'); +is ($lines[2][1], 'admin@EXAMPLE.COM', ' and the right identifier'); + +# Test ownership and other ACL values. Change one keytab to be not owned by +# ADMIN, but have group permission on it. We'll need a third object neither +# owned by ADMIN or with any permissions from it. +is ($server->create ('base', 'service/null'), 1, + 'Creating base:service/null succeeds'); +is ($server->acl ('base', 'service/foo', 'get', 'ADMIN'), 1, + 'Changing the get ACL for the search also does'); +@lines = $report->objects ('owner', 'ADMIN'); +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 ($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'); +is (scalar (@lines), 2, 'ADMIN has any rights at all on two objects'); +is ($lines[0][0], 'base', ' and the first has the right type'); +is ($lines[0][1], 'service/admin', ' and the right name'); +is ($lines[1][0], 'base', ' and the second has the right type'); +is ($lines[1][1], 'service/foo', ' and the right name'); + +# Listing objects of a specific type. +@lines = $report->objects ('type', 'base'); +is (scalar (@lines), 3, 'Searching for all objects of type base finds three'); +is ($lines[0][0], 'base', ' and the first has the right type'); +is ($lines[0][1], 'service/admin', ' and the right name'); +is ($lines[1][0], 'base', ' and the second has the right type'); +is ($lines[1][1], 'service/foo', ' and the right name'); +is ($lines[2][0], 'base', ' and the third has the right type'); +is ($lines[2][1], 'service/null', ' and the right name'); +@lines = $report->objects ('type', 'keytab'); +is (scalar (@lines), 0, 'Searching for all objects of type keytab finds none'); + +# Test setting a flag, searching for objects with it, and then clearing it. +is ($server->flag_set ('base', 'service/admin', 'unchanging'), 1, + 'Setting a flag works'); +@lines = $report->objects ('flag', 'unchanging'); +is (scalar (@lines), 1, 'Searching for all objects with that flag finds one'); +is ($lines[0][0], 'base', ' and it has the right type'); +is ($lines[0][1], 'service/admin', ' and the right name'); +is ($server->flag_clear ('base', 'service/admin', 'unchanging'), 1, + 'Clearing the flag works'); +@lines = $report->objects ('flag', 'unchanging'); +is (scalar (@lines), 0, ' and now there are no objects in the report'); +is ($report->error, undef, ' with no error'); + +# Clean up. +$admin->destroy; +unlink 'wallet-db'; diff --git a/perl/t/schema.t b/perl/t/schema.t index c7e9133..559ece4 100755 --- a/perl/t/schema.t +++ b/perl/t/schema.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ # # t/schema.t -- Tests for the wallet schema class. # @@ -22,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; diff --git a/perl/t/server.t b/perl/t/server.t index 08edd56..090387b 100755 --- a/perl/t/server.t +++ b/perl/t/server.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ # # t/server.t -- Tests for the wallet server API. # @@ -398,31 +397,31 @@ DATE set expires to $now by $admin from $host DATE unset expires (was $now) by $admin from $host -DATE set acl_get to 1 +DATE set acl_get to ADMIN (1) by $admin from $host -DATE unset acl_get (was 1) +DATE unset acl_get (was ADMIN (1)) by $admin from $host -DATE set acl_store to 1 +DATE set acl_store to ADMIN (1) by $admin from $host -DATE unset acl_store (was 1) +DATE unset acl_store (was ADMIN (1)) by $admin from $host -DATE set owner to 1 +DATE set owner to ADMIN (1) by $admin from $host -DATE set acl_get to 5 +DATE set acl_get to empty (5) by $admin from $host -DATE set acl_store to 5 +DATE set acl_store to empty (5) by $admin from $host -DATE unset acl_store (was 5) +DATE unset acl_store (was empty (5)) by $admin from $host -DATE unset owner (was 1) +DATE unset owner (was ADMIN (1)) by $admin from $host -DATE set owner to 1 +DATE set owner to ADMIN (1) by $admin from $host DATE set flag locked by $admin from $host DATE clear flag locked by $admin from $host -DATE unset owner (was 1) +DATE unset owner (was ADMIN (1)) by $admin from $host DATE set flag unchanging by $admin from $host @@ -528,7 +527,7 @@ is ($show, $expected, ' and show an object we own'); $history = <<"EOO"; DATE create by $admin from $host -DATE set owner to 2 +DATE set owner to user1 (2) by $admin from $host EOO $seen = $server->history ('base', 'service/user1'); @@ -609,13 +608,13 @@ is ($show, $expected, ' and show an object we jointly own'); $history = <<"EOO"; DATE create by $admin from $host -DATE set owner to 4 +DATE set owner to both (4) by $admin from $host -DATE set acl_show to 2 +DATE set acl_show to user1 (2) by $admin from $host -DATE set acl_destroy to 3 +DATE set acl_destroy to user2 (3) by $admin from $host -DATE set acl_flags to 2 +DATE set acl_flags to user1 (2) by $admin from $host DATE set flag unchanging by $user1 from $host @@ -680,7 +679,7 @@ is ($show, $expected, ' and show an object we own'); $history = <<"EOO"; DATE create by $admin from $host -DATE set owner to 3 +DATE set owner to user2 (3) by $admin from $host EOO $seen = $server->history ('base', 'service/user2'); diff --git a/perl/t/verifier-netdb.t b/perl/t/verifier-netdb.t index 6a77e3c..dcbbdd8 100755 --- a/perl/t/verifier-netdb.t +++ b/perl/t/verifier-netdb.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ # # t/verifier-netdb.t -- Tests for the NetDB wallet ACL verifiers. # diff --git a/perl/t/verifier.t b/perl/t/verifier.t index 96e641d..3243d9c 100755 --- a/perl/t/verifier.t +++ b/perl/t/verifier.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ # # t/verifier.t -- Tests for the basic wallet ACL verifiers. # |