diff options
Diffstat (limited to 'perl')
65 files changed, 3074 insertions, 1358 deletions
diff --git a/perl/Build.PL b/perl/Build.PL index 968ae37..c50e569 100644 --- a/perl/Build.PL +++ b/perl/Build.PL @@ -3,6 +3,7 @@ # Build script for the wallet distribution. # # Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2016 Russ Allbery <eagle@eyrie.org> # Copyright 2014 # The Board of Trustees of the Leland Stanford Junior University # @@ -19,7 +20,7 @@ my $build = Module::Build->new( dist_abstract => 'Secure credential management system', dist_author => 'Russ Allbery <eagle@eyrie.org>', dist_name => 'Wallet', - dist_version => '1.01', + dist_version_from => 'lib/Wallet/Server.pm', license => 'mit', module_name => 'Wallet::Server', recursive_test_files => 1, @@ -36,12 +37,16 @@ my $build = Module::Build->new( perl => '5.008', }, recommends => { - 'Authen::SASL' => 0, - 'Heimdal::Kadm5' => 0, - 'Net::Duo' => 0, - 'Net::LDAP' => 0, - 'Net::Remctl' => 0, - WebAuth => 0, + 'Authen::SASL' => 0, + 'Crypt::GeneratePassword' => 0, + 'DateTime::Format::SQLite' => 0, + 'DBD::SQLite' => 0, + 'Heimdal::Kadm5' => 0, + 'IPC::Run' => 0, + 'Net::Duo' => 0, + 'Net::LDAP' => 0, + 'Net::Remctl' => 0, + WebAuth => 0, }, ); diff --git a/perl/create-ddl b/perl/create-ddl index b2b6f95..51fa8ff 100755 --- a/perl/create-ddl +++ b/perl/create-ddl @@ -57,6 +57,9 @@ exit(0); # Documentation ############################################################################## +=for stopwords +DDL create-ddl + =head1 NAME create-ddl - Create DDL files for Wallet diff --git a/perl/lib/Wallet/ACL.pm b/perl/lib/Wallet/ACL.pm index a3b0146..ad0eb2c 100644 --- a/perl/lib/Wallet/ACL.pm +++ b/perl/lib/Wallet/ACL.pm @@ -1,7 +1,8 @@ -# Wallet::ACL -- Implementation of ACLs in the wallet system. +# Wallet::ACL -- Implementation of ACLs in the wallet system # # Written by Russ Allbery <eagle@eyrie.org> -# Copyright 2007, 2008, 2010, 2013, 2014 +# Copyright 2016 Russ Allbery <eagle@eyrie.org> +# Copyright 2007, 2008, 2010, 2013, 2014, 2015 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -11,19 +12,15 @@ ############################################################################## package Wallet::ACL; -require 5.006; +use 5.008; use strict; use warnings; -use vars qw($VERSION); use DateTime; -use DBI; +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.08'; +our $VERSION = '1.03'; ############################################################################## # Constructors @@ -197,16 +194,55 @@ sub rename { $acls->ac_name ($name); $acls->update; $self->log_acl ('rename', undef, undef, $user, $host, $time); + + # Find any references to this being used as a nested verifier and + # update the name. This really breaks out of the normal flow, but + # it's hard to do otherwise. + %search = (ae_scheme => 'nested', + ae_identifier => $self->{name}, + ); + my @entries = $self->{schema}->resultset('AclEntry')->search(\%search); + for my $entry (@entries) { + $entry->ae_identifier ($name); + $entry->update; + } + $guard->commit; }; if ($@) { - $self->error ("cannot rename ACL $self->{id} to $name: $@"); + $self->error ("cannot rename ACL $self->{name} to $name: $@"); return; } $self->{name} = $name; return 1; } +# Moves everything owned by one ACL to instead be owned by another. You'll +# normally want to use rename, but this exists for cases where the replacing +# ACL already exists and has things assigned to it. Returns true on success, +# false on failure. +sub replace { + my ($self, $replace_id, $user, $host, $time) = @_; + $time ||= time; + + my %search = (ob_owner => $self->{id}); + my @objects = $self->{schema}->resultset('Object')->search (\%search); + if (@objects) { + for my $object (@objects) { + my $type = $object->ob_type; + my $name = $object->ob_name; + my $object = eval { + Wallet::Object::Base->new($type, $name, $self->{schema}); + }; + $object->owner ($replace_id, $user, $host, $time); + } + } else { + $self->error ("no objects found for ACL $self->{name}"); + return; + } + return 1; +} + # Destroy the ACL, deleting it out of the database. Returns true on success, # false on failure. # @@ -233,8 +269,20 @@ sub destroy { die "ACL in use by ".$entry->ob_type.":".$entry->ob_name; } + # Also make certain the ACL isn't being nested in another. + my %search = (ae_scheme => 'nested', + ae_identifier => $self->{name}); + my %options = (join => 'acls', + prefetch => 'acls'); + @entries = $self->{schema}->resultset('AclEntry')->search(\%search, + \%options); + if (@entries) { + my ($entry) = @entries; + die "ACL is nested in ACL ".$entry->acls->ac_name; + } + # Delete any entries (there may or may not be any). - my %search = (ae_id => $self->{id}); + %search = (ae_id => $self->{id}); @entries = $self->{schema}->resultset('AclEntry')->search(\%search); for my $entry (@entries) { $entry->delete; @@ -257,7 +305,7 @@ sub destroy { $guard->commit; }; if ($@) { - $self->error ("cannot destroy ACL $self->{id}: $@"); + $self->error ("cannot destroy ACL $self->{name}: $@"); return; } return 1; @@ -275,6 +323,22 @@ sub add { $self->error ("unknown ACL scheme $scheme"); return; } + + # Check to make sure that this entry has a valid name for the scheme. + my $class = $self->scheme_mapping ($scheme); + my $object = eval { + $class->new ($identifier, $self->{schema}); + }; + if ($@) { + $self->error ("cannot create ACL verifier: $@"); + return; + } + unless ($object && $object->syntax_check ($identifier)) { + $self->error ("invalid ACL identifier $identifier for $scheme"); + return; + }; + + # Actually create the scheme. eval { my $guard = $self->{schema}->txn_scope_guard; my %record = (ae_id => $self->{id}, @@ -285,7 +349,7 @@ sub add { $guard->commit; }; if ($@) { - $self->error ("cannot add $scheme:$identifier to $self->{id}: $@"); + $self->error ("cannot add $scheme:$identifier to $self->{name}: $@"); return; } return 1; @@ -312,7 +376,7 @@ sub remove { }; if ($@) { my $entry = "$scheme:$identifier"; - $self->error ("cannot remove $entry from $self->{id}: $@"); + $self->error ("cannot remove $entry from $self->{name}: $@"); return; } return 1; @@ -340,7 +404,7 @@ sub list { $guard->commit; }; if ($@) { - $self->error ("cannot retrieve ACL $self->{id}: $@"); + $self->error ("cannot retrieve ACL $self->{name}: $@"); return; } else { return @entries; @@ -395,7 +459,7 @@ sub history { $guard->commit; }; if ($@) { - $self->error ("cannot read history for $self->{id}: $@"); + $self->error ("cannot read history for $self->{name}: $@"); return; } return $output; @@ -412,20 +476,21 @@ sub history { { my %verifier; sub check_line { - my ($self, $principal, $scheme, $identifier) = @_; + my ($self, $principal, $scheme, $identifier, $type, $name) = @_; unless ($verifier{$scheme}) { my $class = $self->scheme_mapping ($scheme); unless ($class) { push (@{ $self->{check_errors} }, "unknown scheme $scheme"); return; } - $verifier{$scheme} = $class->new; + $verifier{$scheme} = $class->new ($identifier, $self->{schema}); unless (defined $verifier{$scheme}) { push (@{ $self->{check_errors} }, "cannot verify $scheme"); return; } } - my $result = ($verifier{$scheme})->check ($principal, $identifier); + my $result = ($verifier{$scheme})->check ($principal, $identifier, + $type, $name); if (not defined $result) { push (@{ $self->{check_errors} }, ($verifier{$scheme})->error); return; @@ -435,13 +500,13 @@ sub history { } } -# Given a principal, check whether it should be granted access according to -# this ACL. Returns 1 if access was granted, 0 if access was denied, and -# undef on some error. Errors from ACL verifiers do not cause an error -# return, but are instead accumulated in the check_errors variable returned by -# the check_errors() method. +# Given a principal, object type, and object name, check whether that +# principal should be granted access according to this ACL. Returns 1 if +# access was granted, 0 if access was denied, and undef on some error. Errors +# from ACL verifiers do not cause an error return, but are instead accumulated +# in the check_errors variable returned by the check_errors() method. sub check { - my ($self, $principal) = @_; + my ($self, $principal, $type, $name) = @_; unless ($principal) { $self->error ('no principal specified'); return; @@ -452,7 +517,8 @@ sub check { $self->{check_errors} = []; for my $entry (@entries) { my ($scheme, $identifier) = @$entry; - my $result = $self->check_line ($principal, $scheme, $identifier); + my $result = $self->check_line ($principal, $scheme, $identifier, + $type, $name); return 1 if $result; } return 0; @@ -643,6 +709,14 @@ On failure, the caller should call error() to get the error message. Note that rename() operations are not logged in the ACL history. +=item replace(ID) + +Replace this ACL with another. This goes through each object owned by +the ACL and changes its ownership to the new ACL, leaving this ACL owning +nothing (and probably then needing to be deleted). Returns true on +success and false on failure. On failure, the caller should call error() +to get the error message. + =item show() Returns a human-readable description of this ACL, including its diff --git a/perl/lib/Wallet/ACL/Base.pm b/perl/lib/Wallet/ACL/Base.pm index a2b07cc..235a9cb 100644 --- a/perl/lib/Wallet/ACL/Base.pm +++ b/perl/lib/Wallet/ACL/Base.pm @@ -1,6 +1,7 @@ -# Wallet::ACL::Base -- Parent class for wallet ACL verifiers. +# Wallet::ACL::Base -- Parent class for wallet ACL verifiers # # Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2016 Russ Allbery <eagle@eyrie.org> # Copyright 2007, 2010, 2014 # The Board of Trustees of the Leland Stanford Junior University # @@ -11,16 +12,12 @@ ############################################################################## package Wallet::ACL::Base; -require 5.006; +use 5.008; use strict; use warnings; -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.02'; +our $VERSION = '1.03'; ############################################################################## # Interface @@ -37,6 +34,11 @@ sub new { return $self; } +# The default name check method allows any name. +sub syntax_check { + return 1; +} + # The default check method denies all access. sub check { return 0; @@ -92,10 +94,18 @@ inherit from it. It is not used directly. Creates a new ACL verifier. The generic function provided here just creates and blesses an object. -=item check(PRINCIPAL, ACL) +=item syntax_check(PRINCIPAL, ACL) + +This method should be overridden by any child classes that want to +implement validating the name of an ACL before creation. The default +implementation allows any name for an ACL. + +=item check(PRINCIPAL, ACL, TYPE, NAME) This method should always be overridden by child classes. The default -implementation just declines all access. +implementation just declines all access. TYPE and NAME are the type and +name of the object being accessed, which may be used by some ACL schemes +or may be ignored. =item error([ERROR ...]) diff --git a/perl/lib/Wallet/ACL/External.pm b/perl/lib/Wallet/ACL/External.pm new file mode 100644 index 0000000..caed80e --- /dev/null +++ b/perl/lib/Wallet/ACL/External.pm @@ -0,0 +1,192 @@ +# Wallet::ACL::External -- Wallet external ACL verifier +# +# Copyright 2016 Russ Allbery <eagle@eyrie.org> +# +# See LICENSE for licensing terms. + +############################################################################## +# Modules and declarations +############################################################################## + +package Wallet::ACL::External; + +use 5.008; +use strict; +use warnings; + +use POSIX qw(_exit); +use Wallet::ACL::Base; +use Wallet::Config; + +our @ISA = qw(Wallet::ACL::Base); +our $VERSION = '1.03'; + +############################################################################## +# Interface +############################################################################## + +# Creates a new persistent verifier. This just checks if the configuration +# is in place. +sub new { + my $type = shift; + unless ($Wallet::Config::EXTERNAL_COMMAND) { + die "external ACL support not configured\n"; + } + my $self = {}; + bless ($self, $type); + return $self; +} + +# The most trivial ACL verifier. Returns true if the provided principal +# matches the ACL. +sub check { + my ($self, $principal, $acl, $type, $name) = @_; + unless ($principal) { + $self->error ('no principal specified'); + return; + } + my @args = ($principal, $type, $name, $acl); + my $pid = open (EXTERNAL, '-|'); + if (not defined $pid) { + $self->error ("cannot fork: $!"); + return; + } elsif ($pid == 0) { + unless (open (STDERR, '>&STDOUT')) { + warn "wallet: cannot dup stdout: $!\n"; + _exit(1); + } + unless (exec ($Wallet::Config::EXTERNAL_COMMAND, @args)) { + warn "wallet: cannot run $Wallet::Config::EXTERNAL_COMMAND: $!\n"; + _exit(1); + } + } + local $_; + my @output = <EXTERNAL>; + close EXTERNAL; + if ($? == 0) { + return 1; + } else { + if (@output) { + $self->error ($output[0]); + return; + } else { + return 0; + } + } +} + +1; +__END__ + +############################################################################## +# Documentation +############################################################################## + +=for stopwords +ACL Allbery verifier remctl + +=head1 NAME + +Wallet::ACL::External - Wallet ACL verifier using an external command + +=head1 SYNOPSIS + + my $verifier = Wallet::ACL::External->new; + my $status = $verifier->check ($principal, $acl); + if (not defined $status) { + die "Something failed: ", $verifier->error, "\n"; + } elsif ($status) { + print "Access granted\n"; + } else { + print "Access denied\n"; + } + +=head1 DESCRIPTION + +Wallet::ACL::External runs an external command to determine whether access is +granted. The command configured via $EXTERNAL_COMMAND in L<Wallet::Config> +will be run. The first argument to the command will be the principal +requesting access. The identifier of the ACL will be split on whitespace and +passed in as the remaining arguments to this command. + +No other arguments are passed to the command, but the command will have access +to all of the remctl environment variables seen by the wallet server (such as +REMOTE_USER). For a full list of environment variables, see +L<remctld(8)/ENVIRONMENT>. + +The external command should exit with a non-zero status but no output to +indicate a normal failure to satisfy the ACL. Any output will be treated as +an error. + +=head1 METHODS + +=over 4 + +=item new() + +Creates a new ACL verifier. For this verifier, this just confirms that +the wallet configuration sets an external command. + +=item check(PRINCIPAL, ACL, TYPE, NAME) + +Returns true if the external command returns success when run with that +PRINCIPAL, object TYPE and NAME, and ACL. So, for example, the ACL C<external +mdbset shell> will, when triggered by a request from rra@EXAMPLE.COM for the +object C<file password>, result in the command: + + $Wallet::Config::EXTERNAL_COMMAND rra@EXAMPLE.COM file password \ + 'mdbset shell' + +=item error() + +Returns the error if check() returned undef. + +=back + +=head1 DIAGNOSTICS + +The new() method may fail with one of the following exceptions: + +=over 4 + +=item external ACL support not configured + +The required configuration parameters were not set. See L<Wallet::Config> +for the required configuration parameters and how to set them. + +=back + +Verifying an external ACL may fail with the following errors (returned by +the error() method): + +=over 4 + +=item cannot fork: %s + +The attempt to fork in order to execute the external ACL verifier +command failed, probably due to a lack of system resources. + +=item no principal specified + +The PRINCIPAL parameter to check() was undefined or the empty string. + +=back + +In addition, if the external command fails and produces some output, +that will be considered a failure and the first line of its output will +be returned as the error message. The external command should exit +with a non-zero status but no error to indicate a normal failure. + +=head1 SEE ALSO + +remctld(8), Wallet::ACL(3), Wallet::ACL::Base(3), Wallet::Config(3), +wallet-backend(8) + +This module is part of the wallet system. The current version is +available from L<http://www.eyrie.org/~eagle/software/wallet/>. + +=head1 AUTHOR + +Russ Allbery <eagle@eyrie.org> + +=cut diff --git a/perl/lib/Wallet/ACL/Krb5.pm b/perl/lib/Wallet/ACL/Krb5.pm index 80d32bd..e0e9a61 100644 --- a/perl/lib/Wallet/ACL/Krb5.pm +++ b/perl/lib/Wallet/ACL/Krb5.pm @@ -1,6 +1,7 @@ -# Wallet::ACL::Krb5 -- Wallet Kerberos v5 principal ACL verifier. +# Wallet::ACL::Krb5 -- Wallet Kerberos v5 principal ACL verifier # # Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2016 Russ Allbery <eagle@eyrie.org> # Copyright 2007, 2010, 2014 # The Board of Trustees of the Leland Stanford Junior University # @@ -11,20 +12,15 @@ ############################################################################## package Wallet::ACL::Krb5; -require 5.006; +use 5.008; use strict; use warnings; -use vars qw(@ISA $VERSION); use Wallet::ACL::Base; -@ISA = qw(Wallet::ACL::Base); - -# This version should be increased on any code change to this module. Always -# use two digits for the minor version with a leading zero if necessary so -# that it will sort properly. -$VERSION = '0.02'; +our @ISA = qw(Wallet::ACL::Base); +our $VERSION = '1.03'; ############################################################################## # Interface diff --git a/perl/lib/Wallet/ACL/Krb5/Regex.pm b/perl/lib/Wallet/ACL/Krb5/Regex.pm index 4934cfc..f3b9a06 100644 --- a/perl/lib/Wallet/ACL/Krb5/Regex.pm +++ b/perl/lib/Wallet/ACL/Krb5/Regex.pm @@ -1,6 +1,7 @@ # Wallet::ACL::Krb5::Regex -- Wallet Kerberos v5 principal regex ACL verifier # # Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2016 Russ Allbery <eagle@eyrie.org> # Copyright 2007, 2010, 2014 # The Board of Trustees of the Leland Stanford Junior University # @@ -11,20 +12,15 @@ ############################################################################## package Wallet::ACL::Krb5::Regex; -require 5.006; +use 5.008; use strict; use warnings; -use vars qw(@ISA $VERSION); use Wallet::ACL::Krb5; -@ISA = qw(Wallet::ACL::Krb5); - -# 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'; +our @ISA = qw(Wallet::ACL::Krb5); +our $VERSION = '1.03'; ############################################################################## # Interface diff --git a/perl/lib/Wallet/ACL/LDAP/Attribute.pm b/perl/lib/Wallet/ACL/LDAP/Attribute.pm index c27729e..fcb8447 100644 --- a/perl/lib/Wallet/ACL/LDAP/Attribute.pm +++ b/perl/lib/Wallet/ACL/LDAP/Attribute.pm @@ -1,6 +1,7 @@ -# Wallet::ACL::LDAP::Attribute -- Wallet LDAP attribute ACL verifier. +# Wallet::ACL::LDAP::Attribute -- Wallet LDAP attribute ACL verifier # # Written by Russ Allbery +# Copyright 2016 Russ Allbery <eagle@eyrie.org> # Copyright 2012, 2013, 2014 # The Board of Trustees of the Leland Stanford Junior University # @@ -11,23 +12,18 @@ ############################################################################## package Wallet::ACL::LDAP::Attribute; -require 5.006; +use 5.008; use strict; use warnings; -use vars qw(@ISA $VERSION); -use Authen::SASL (); +use Authen::SASL; use Net::LDAP qw(LDAP_COMPARE_TRUE); use Wallet::ACL::Base; use Wallet::Config; -@ISA = qw(Wallet::ACL::Base); - -# This version should be increased on any code change to this module. Always -# use two digits for the minor version with a leading zero if necessary so -# that it will sort properly. -$VERSION = '0.01'; +our @ISA = qw(Wallet::ACL::Base); +our $VERSION = '1.03'; ############################################################################## # Interface diff --git a/perl/lib/Wallet/ACL/LDAP/Attribute/Root.pm b/perl/lib/Wallet/ACL/LDAP/Attribute/Root.pm new file mode 100644 index 0000000..8451394 --- /dev/null +++ b/perl/lib/Wallet/ACL/LDAP/Attribute/Root.pm @@ -0,0 +1,123 @@ +# Wallet::ACL::LDAP::Attribute::Root -- Wallet root instance LDAP ACL verifier +# +# Written by Jon Robertson <jonrober@stanford.edu> +# Based on Wallet::ACL::NetDB::Root by Russ Allbery <eagle@eyrie.org> +# Copyright 2016 Russ Allbery <eagle@eyrie.org> +# Copyright 2015 +# The Board of Trustees of the Leland Stanford Junior University +# +# See LICENSE for licensing terms. + +############################################################################## +# Modules and declarations +############################################################################## + +package Wallet::ACL::LDAP::Attribute::Root; + +use 5.008; +use strict; +use warnings; + +use Wallet::ACL::LDAP::Attribute; + +our @ISA = qw(Wallet::ACL::LDAP::Attribute); +our $VERSION = '1.03'; + +############################################################################## +# Interface +############################################################################## + +# Override the check method of Wallet::ACL::LDAP::Attribute to require that +# the principal be a root instance and to strip /root out of the principal +# name before checking roles. +sub check { + my ($self, $principal, $acl) = @_; + undef $self->{error}; + unless ($principal) { + $self->error ('no principal specified'); + return; + } + unless ($principal =~ s%^([^/\@]+)/root(\@|\z)%$1$2%) { + return 0; + } + return $self->SUPER::check ($principal, $acl); +} + +############################################################################## +# Documentation +############################################################################## + +=for stopwords +ACL Allbery LDAP verifier + +=head1 NAME + +Wallet::ACL::LDAP::Attribute::Root - Wallet ACL verifier for LDAP attributes (root instances) + +=head1 SYNOPSIS + + my $verifier = Wallet::ACL::LDAP::Attribute::Root->new; + my $status = $verifier->check ($principal, "$attr=$value"); + if (not defined $status) { + die "Something failed: ", $verifier->error, "\n"; + } elsif ($status) { + print "Access granted\n"; + } else { + print "Access denied\n"; + } + +=head1 DESCRIPTION + +Wallet::ACL::LDAP::Attribute::Root works identically to +Wallet::ACL::LDAP::Attribute 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 the LDAP attribute and value. As +with the base LDAP Attribute ACL verifier, the value of such a +C<ldap-attr-root> ACL is an attribute followed by an equal sign and a +value, and the ACL grants access to a given principal if and only if +the LDAP entry for that principal (with C</root> stripped) has that +attribute set to that value. + +To use this object, the same configuration parameters must be set as for +Wallet::ACL::LDAP::Attribute. See Wallet::Config(3) for details on +those configuration parameters and information about how to set wallet +configuration. + +=head1 METHODS + +=over 4 + +=item check(PRINCIPAL, ACL) + +Returns true if PRINCIPAL is granted access according to ACL, false if +not, and undef on an error (see L<"DIAGNOSTICS"> below). ACL must be an +attribute name and a value, separated by an equal sign (with no +whitespace). PRINCIPAL will be granted access if it has an instance of +C<root> and if (with C</root> stripped off) its LDAP entry contains +that attribute with that value + +=back + +=head1 DIAGNOSTICS + +Same as for Wallet::ACL::LDAP::Attribute. + +=head1 CAVEATS + +The instance to strip is not currently configurable. + +=head1 SEE ALSO + +Net::Remctl(3), Wallet::ACL(3), Wallet::ACL::Base(3), +Wallet::ACL::LDAP::Attribute(3), Wallet::Config(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> +Russ Allbery <eagle@eyrie.org> + +=cut diff --git a/perl/lib/Wallet/ACL/Nested.pm b/perl/lib/Wallet/ACL/Nested.pm new file mode 100644 index 0000000..da42286 --- /dev/null +++ b/perl/lib/Wallet/ACL/Nested.pm @@ -0,0 +1,186 @@ +# Wallet::ACL::Nested - ACL class for nesting ACLs +# +# Written by Jon Robertson <jonrober@stanford.edu> +# Copyright 2016 Russ Allbery <eagle@eyrie.org> +# Copyright 2015 +# The Board of Trustees of the Leland Stanford Junior University +# +# See LICENSE for licensing terms. + +############################################################################## +# Modules and declarations +############################################################################## + +package Wallet::ACL::Nested; + +use 5.008; +use strict; +use warnings; + +use Wallet::ACL::Base; + +our @ISA = qw(Wallet::ACL::Base); +our $VERSION = '1.03'; + +############################################################################## +# Interface +############################################################################## + +# Creates a new persistant verifier, taking a database handle to use for +# syntax check validation. +sub new { + my $type = shift; + my ($name, $schema) = @_; + my $self = { + schema => $schema, + expanded => {}, + }; + bless ($self, $type); + return $self; +} + +# Name checking requires checking that there's an existing ACL already by +# this name. Try to create the ACL object and use that to determine. +sub syntax_check { + my ($self, $group) = @_; + + my $acl; + eval { $acl = Wallet::ACL->new ($group, $self->{schema}) }; + return 0 if $@; + return 0 unless $acl; + return 1; +} + +# For checking a nested ACL, we need to expand each entry and then check +# that entry. We also want to keep track of things already checked in order +# to avoid any loops. +sub check { + my ($self, $principal, $group, $type, $name) = @_; + unless ($principal) { + $self->error ('no principal specified'); + return; + } + unless ($group) { + $self->error ('malformed nested ACL'); + return; + } + + # Make an ACL object just so that we can use it to drop back into the + # normal ACL validation after we have expanded the nesting. + my $acl; + eval { $acl = Wallet::ACL->new ($group, $self->{schema}) }; + + # Get the list of all nested acl entries within this entry, and use it + # to go through each entry and decide if the given acl has access. + my @members = $self->get_membership ($group); + for my $entry (@members) { + my ($scheme, $identifier) = @{ $entry }; + my $result = $acl->check_line ($principal, $scheme, $identifier, + $type, $name); + return 1 if $result; + } + return 0; +} + +# Get the membership of a group recursively. The final result will be a list +# of arrayrefs like that from Wallet::ACL->list, but expanded for full +# membership. +sub get_membership { + my ($self, $group) = @_; + + # Get the list of members for this nested acl. Consider any missing acls + # as empty. + my $schema = $self->{schema}; + my @members; + eval { + my $acl = Wallet::ACL->new ($group, $schema); + @members = $acl->list; + }; + + # Now go through and expand any other nested groups into their own + # memberships. + my @expanded; + for my $entry (@members) { + my ($type, $name) = @{ $entry }; + if ($type eq 'nested') { + + # Keep track of things we've already expanded and don't look them + # up again. + next if exists $self->{expanded}{$name}; + $self->{expanded}{$name} = 1; + push (@expanded, $self->get_membership ($name)); + + } else { + push (@expanded, $entry); + } + } + + return @expanded; +} + +1; +__END__ + +############################################################################## +# Documentation +############################################################################## + +=for stopwords +ACL Allbery verifier verifiers + +=head1 NAME + +Wallet::ACL::Nested - Wallet ACL verifier to check another ACL + +=head1 SYNOPSIS + + my $verifier = Wallet::ACL::Nested->new; + my $status = $verifier->check ($principal, $acl); + if (not defined $status) { + die "Something failed: ", $verifier->error, "\n"; + } elsif ($status) { + print "Access granted\n"; + } else { + print "Access denied\n"; + } + +=head1 DESCRIPTION + +Wallet::ACL::Nested checks whether the principal is permitted by another +named ACL and, if so, returns success. It is used to nest one ACL inside +another. + +=head1 METHODS + +=over 4 + +=item new() + +Creates a new ACL verifier. + +=item check(PRINCIPAL, ACL) + +Returns true if PRINCIPAL is granted access according to the nested ACL, +specified by name. Returns false if it is not, and undef on error. + +=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. The returned errors +will generally come from the nested child ACL. + +=back + +=head1 SEE ALSO + +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/>. + +=head1 AUTHOR + +Jon Robertson <jonrober@stanford.edu> + +=cut diff --git a/perl/lib/Wallet/ACL/NetDB.pm b/perl/lib/Wallet/ACL/NetDB.pm index ad2164b..a4c7fb0 100644 --- a/perl/lib/Wallet/ACL/NetDB.pm +++ b/perl/lib/Wallet/ACL/NetDB.pm @@ -1,6 +1,7 @@ -# Wallet::ACL::NetDB -- Wallet NetDB role ACL verifier. +# Wallet::ACL::NetDB -- Wallet NetDB role ACL verifier # # Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2016 Russ Allbery <eagle@eyrie.org> # Copyright 2007, 2010, 2014 # The Board of Trustees of the Leland Stanford Junior University # @@ -11,21 +12,16 @@ ############################################################################## package Wallet::ACL::NetDB; -require 5.006; +use 5.008; use strict; use warnings; -use vars qw(@ISA $VERSION); use Wallet::ACL::Base; use Wallet::Config; -@ISA = qw(Wallet::ACL::Base); - -# This version should be increased on any code change to this module. Always -# use two digits for the minor version with a leading zero if necessary so -# that it will sort properly. -$VERSION = '0.05'; +our @ISA = qw(Wallet::ACL::Base); +our $VERSION = '1.03'; ############################################################################## # Interface diff --git a/perl/lib/Wallet/ACL/NetDB/Root.pm b/perl/lib/Wallet/ACL/NetDB/Root.pm index 34163e7..bfd13b4 100644 --- a/perl/lib/Wallet/ACL/NetDB/Root.pm +++ b/perl/lib/Wallet/ACL/NetDB/Root.pm @@ -1,6 +1,7 @@ -# Wallet::ACL::NetDB::Root -- Wallet NetDB role ACL verifier (root instances). +# Wallet::ACL::NetDB::Root -- Wallet NetDB role ACL verifier (root instances) # # Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2016 Russ Allbery <eagle@eyrie.org> # Copyright 2007, 2010, 2014 # The Board of Trustees of the Leland Stanford Junior University # @@ -11,21 +12,15 @@ ############################################################################## package Wallet::ACL::NetDB::Root; -require 5.006; +use 5.008; use strict; use warnings; -use vars qw(@ISA $VERSION); use Wallet::ACL::NetDB; -use Wallet::Config; -@ISA = qw(Wallet::ACL::NetDB); - -# 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'; +our @ISA = qw(Wallet::ACL::NetDB); +our $VERSION = '1.03'; ############################################################################## # Interface diff --git a/perl/lib/Wallet/Admin.pm b/perl/lib/Wallet/Admin.pm index 8120e9c..9b63174 100644 --- a/perl/lib/Wallet/Admin.pm +++ b/perl/lib/Wallet/Admin.pm @@ -1,6 +1,7 @@ -# Wallet::Admin -- Wallet system administrative interface. +# Wallet::Admin -- Wallet system administrative interface # # Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2016 Russ Allbery <eagle@eyrie.org> # Copyright 2008, 2009, 2010, 2011, 2012, 2013, 2014 # The Board of Trustees of the Leland Stanford Junior University # @@ -11,19 +12,15 @@ ############################################################################## package Wallet::Admin; -require 5.006; +use 5.008; use strict; use warnings; -use vars qw($VERSION); use Wallet::ACL; use Wallet::Schema; -# This version should be increased on any code change to this module. Always -# use two digits for the minor version with a leading zero if necessary so -# that it will sort properly. -$VERSION = '0.08'; +our $VERSION = '1.03'; # The last non-DBIx::Class version of Wallet::Schema. If a database has no # DBIx::Class versioning, we artificially install this version number before @@ -115,22 +112,25 @@ sub default_data { # acl_schemes default rows. my ($r1) = $self->{schema}->resultset('AclScheme')->populate ([ [ qw/as_name as_class/ ], - [ 'krb5', 'Wallet::ACL::Krb5' ], - [ 'krb5-regex', 'Wallet::ACL::Krb5::Regex' ], - [ 'ldap-attr', 'Wallet::ACL::LDAP::Attribute' ], - [ 'netdb', 'Wallet::ACL::NetDB' ], - [ 'netdb-root', 'Wallet::ACL::NetDB::Root' ], + [ 'krb5', 'Wallet::ACL::Krb5' ], + [ 'krb5-regex', 'Wallet::ACL::Krb5::Regex' ], + [ 'ldap-attr', 'Wallet::ACL::LDAP::Attribute' ], + [ 'ldap-attr-root', 'Wallet::ACL::LDAP::Attribute::Root' ], + [ 'nested', 'Wallet::ACL::Nested' ], + [ 'netdb', 'Wallet::ACL::NetDB' ], + [ 'netdb-root', 'Wallet::ACL::NetDB::Root' ], ]); warn "default AclScheme not installed" unless defined $r1; # types default rows. my @record = ([ qw/ty_name ty_class/ ], [ 'duo', 'Wallet::Object::Duo' ], - [ 'duo-ldap', 'Wallet::Object::Duo::LDAPProxy' ], - [ 'duo-pam', 'Wallet::Object::Duo::PAM' ], - [ 'duo-radius', 'Wallet::Object::Duo::RadiusProxy' ], - [ 'duo-rdp', 'Wallet::Object::Duo::RDP' ], + [ 'duo-ldap', 'Wallet::Object::Duo' ], + [ 'duo-pam', 'Wallet::Object::Duo' ], + [ 'duo-radius', 'Wallet::Object::Duo' ], + [ 'duo-rdp', 'Wallet::Object::Duo' ], [ 'file', 'Wallet::Object::File' ], + [ 'password', 'Wallet::Object::Password' ], [ 'keytab', 'Wallet::Object::Keytab' ], [ 'wa-keyring', 'Wallet::Object::WAKeyring' ]); ($r1) = $self->{schema}->resultset('Type')->populate (\@record); diff --git a/perl/lib/Wallet/Config.pm b/perl/lib/Wallet/Config.pm index 2eb57f9..b8771c3 100644 --- a/perl/lib/Wallet/Config.pm +++ b/perl/lib/Wallet/Config.pm @@ -1,25 +1,22 @@ -# Wallet::Config -- Configuration handling for the wallet server. +# Wallet::Config -- Configuration handling for the wallet server # # Written by Russ Allbery <eagle@eyrie.org> -# Copyright 2007, 2008, 2010, 2013, 2014 +# Copyright 2016 Russ Allbery <eagle@eyrie.org> +# Copyright 2007, 2008, 2010, 2013, 2014, 2015 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. package Wallet::Config; -require 5.006; +use 5.008; use strict; use warnings; -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.05'; +our $VERSION = '1.03'; # Path to the config file to load. -$PATH = $ENV{WALLET_CONFIG} || '/etc/wallet/wallet.conf'; +our $PATH = $ENV{WALLET_CONFIG} || '/etc/wallet/wallet.conf'; =head1 NAME @@ -29,7 +26,7 @@ Wallet::Config - Configuration handling for the wallet server DBI DSN SQLite subdirectories KEYTAB keytab kadmind KDC add-ons kadmin DNS SRV kadmin keytabs remctl backend lowercased NETDB ACL NetDB unscoped usernames rekey hostnames Allbery wallet-backend keytab-backend Heimdal -rekeys WebAuth WEBAUTH keyring LDAP DN GSS-API integrations +rekeys WebAuth WEBAUTH keyring LDAP DN GSS-API integrations msktutil =head1 SYNOPSIS @@ -260,6 +257,49 @@ our $FILE_MAX_SIZE; =back +=head1 PASSWORD OBJECT CONFIGURATION + +These configuration variables only need to be set if you intend to use the +C<password> object type (the Wallet::Object::Password class). You will also +need to set the FILE_MAX_SIZE value from the file object configuration, as +that is inherited. + +=over 4 + +=item PWD_FILE_BUCKET + +The directory into which to store password objects. Password objects will +be stored in subdirectories of this directory. See +L<Wallet::Object::Password> for the full details of the naming scheme. This +directory must be writable by the wallet server and the wallet server must +be able to create subdirectories of it. + +PWD_FILE_BUCKET must be set to use file objects. + +=cut + +our $PWD_FILE_BUCKET; + +=item PWD_LENGTH_MIN + +The minimum length for any auto-generated password objects created when get +is run before data is stored. + +=cut + +our $PWD_LENGTH_MIN = 20; + +=item PWD_LENGTH_MAX + +The maximum length for any auto-generated password objects created when get +is run before data is stored. + +=cut + +our $PWD_LENGTH_MAX = 21; + +=back + =head1 KEYTAB OBJECT CONFIGURATION These configuration variables only need to be set if you intend to use the @@ -275,7 +315,8 @@ 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. +KEYTAB_FILE must be set to use keytab objects with any backend other than +Active Directory. =cut @@ -292,16 +333,18 @@ 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.) +This option is ignored when using Active Directory. + =cut our $KEYTAB_FLAGS = '-clearpolicy'; =item KEYTAB_HOST -Specifies the host on which the kadmin service is running. This setting -overrides the C<admin_server> setting in the [realms] section of -F<krb5.conf> and any DNS SRV records and allows the wallet to run on a -system that doesn't have a Kerberos configuration for the wallet's realm. +Specifies the host on which the kadmin or Active Directory service is running. +This setting overrides the C<admin_server> setting in the [realms] section of +F<krb5.conf> and any DNS SRV records and allows the wallet to run on a system +that doesn't have a Kerberos configuration for the wallet's realm. =cut @@ -313,13 +356,15 @@ The path to the B<kadmin> command-line client. The default value is C<kadmin>, which will cause the wallet to search for B<kadmin> on its default PATH. +This option is ignored when using Active Directory. + =cut our $KEYTAB_KADMIN = 'kadmin'; =item KEYTAB_KRBTYPE -The Kerberos KDC implementation type, either C<Heimdal> or C<MIT> +The Kerberos KDC implementation type, chosen from C<AD>, C<Heimdal>, or C<MIT> (case-insensitive). KEYTAB_KRBTYPE must be set to use keytab objects. =cut @@ -331,9 +376,9 @@ our $KEYTAB_KRBTYPE; The principal whose key is stored in KEYTAB_FILE. The wallet will authenticate as this principal to the kadmin service. -KEYTAB_PRINCIPAL must be set to use keytab objects, at least until -B<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 unless Active Directory is +the backend, at least until B<kadmin> is smart enough to use the first +principal found in the keytab it's using for authentication. =cut @@ -347,7 +392,7 @@ installation and the keytab object names are stored without realm. KEYTAB_REALM is added when talking to the KDC via B<kadmin>. KEYTAB_REALM must be set to use keytab objects. C<ktadd> doesn't always -default to the local realm. +default to the local realm and the Active Directory integration requires it. =cut @@ -370,6 +415,69 @@ our $KEYTAB_TMP; =back +The following parameters are specific to generating keytabs from Active +Directory (KEYTAB_KRBTYPE is set to C<AD>). + +=over 4 + +=item AD_CACHE + +Specifies the ticket cache to use when manipulating Active Directory objects. +The ticket cache must be for a principal able to bind to Active Directory and +run B<msktutil>. + +AD_CACHE must be set to use Active Directory support. + +=cut + +our $AD_CACHE; + +=item AD_COMPUTER_DN + +The LDAP base DN for computer objects inside Active Directory. All keytabs of +the form host/<hostname> will be mapped to objects with a C<samAccountName> of +the <hostname> portion under this DN. + +AD_COMPUTER_DN must be set if using Active Directory as the keytab backend. + +=cut + +our $AD_COMPUTER_DN; + +=item AD_DEBUG + +If set to true, asks for some additional debugging information, such as the +B<msktutil> command, to be logged to syslog. These debugging messages will be +logged to the C<local3> facility. + +=cut + +our $AD_DEBUG = 0; + +=item AD_MSKTUTIL + +The path to the B<msktutil> command-line client. The default value is +C<msktutil>, which will cause the wallet to search for B<msktutil> on its +default PATH. + +=cut + +our $AD_MSKTUTIL = 'msktutil'; + +=item AD_USER_DN + +The LDAP base DN for user objects inside Active Directory. All keytabs of the +form service/<user> will be mapped to objects with a C<servicePrincipalName> +matching the wallet object name under this DN. + +AD_USER_DN must be set if using Active Directory as the keytab backend. + +=cut + +our $AD_USER_DN; + +=back + =head2 Retrieving Existing Keytabs Heimdal provides the choice, over the network protocol, of either @@ -497,6 +605,36 @@ our $WAKEYRING_PURGE_INTERVAL = 60 * 60 * 24 * 90; =back +=head1 EXTERNAL ACL CONFIGURATION + +This configuration variable is only needed if you intend to use the +C<external> ACL type (the Wallet::ACL::External class). This ACL type +runs an external command to determine if access is granted. + +=over 4 + +=item EXTERNAL_COMMAND + +Path to the command to run to determine whether access is granted. The first +argument to the command will be the principal requesting access. The second +and third arguments will be the type and name of the object that principal is +requesting access to. The final argument will be the identifier of the ACL. + +No other arguments are passed to the command, but the command will have +access to all of the remctl environment variables seen by the wallet +server (such as REMOTE_USER). For a full list of environment variables, +see L<remctld(8)/ENVIRONMENT>. + +The external command should exit with a non-zero status but no output to +indicate a normal failure to satisfy the ACL. Any output will be treated +as an error. + +=cut + +our $EXTERNAL_COMMAND; + +=back + =head1 LDAP ACL CONFIGURATION These configuration variables are only needed if you intend to use the @@ -749,6 +887,34 @@ keytab objects for particular principals have fully-qualified hostnames: Objects that aren't of type C<keytab> or which aren't for a host-based key have no naming requirements enforced by this example. +=head1 OBJECT HOST-BASED NAMES + +The above demonstrates having a host-based naming convention, where we +expect one part of an object name to be the name of the host that this +object is for. The most obvious examples are those keytab objects +above, where we want certain keytab names to be in the form of +<service>/<hostname>. It's then also useful to provide a Perl function +named is_for_host which then can be used to tell if a given object is a +host-based keytab for a specific host. This function is then called by +the objects_hostname in Wallet::Report to give a list of all host-based +objects for a given hostname. It should return true if the given object +is a host-based object for the hostname, otherwise false. + +An example that matches the same policy as the last verify_name example +would be: + + sub is_for_host { + my ($type, $name, $hostname) = @_; + my %host_based = map { $_ => 1 } + qw(HTTP cifs host imap ldap nfs pop sieve smtp webauth); + return 0 unless $type eq 'keytab'; + return 0 unless $name =~ m%/%; + my ($service, $instance) = split ('/', $name, 2); + return 0 unless $host_based{$service}; + return 1 if $hostname eq $instance; + return 0; + } + =head1 ACL NAMING ENFORCEMENT Similar to object names, by default wallet permits administrators to diff --git a/perl/lib/Wallet/Database.pm b/perl/lib/Wallet/Database.pm index 3a4e130..23b059f 100644 --- a/perl/lib/Wallet/Database.pm +++ b/perl/lib/Wallet/Database.pm @@ -1,4 +1,4 @@ -# Wallet::Database -- Wallet system database connection management. +# Wallet::Database -- Wallet system database connection management # # This module is a thin wrapper around DBIx::Class to handle determination # of the database configuration settings automatically on connect. The @@ -6,6 +6,7 @@ # like DBIx::Class objects in the rest of the code. # # Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2016 Russ Allbery <eagle@eyrie.org> # Copyright 2008, 2009, 2010, 2012, 2013, 2014 # The Board of Trustees of the Leland Stanford Junior University # @@ -16,21 +17,16 @@ ############################################################################## package Wallet::Database; -require 5.006; +use 5.008; use strict; use warnings; -use vars qw(@ISA $VERSION); -use Wallet::Schema; use Wallet::Config; +use Wallet::Schema; -@ISA = qw(Wallet::Schema); - -# This version should be increased on any code change to this module. Always -# use two digits for the minor version with a leading zero if necessary so -# that it will sort properly. -$VERSION = '0.04'; +our @ISA = qw(Wallet::Schema); +our $VERSION = '1.03'; ############################################################################## # Core overrides diff --git a/perl/lib/Wallet/Kadmin.pm b/perl/lib/Wallet/Kadmin.pm index 65a5700..8851c7e 100644 --- a/perl/lib/Wallet/Kadmin.pm +++ b/perl/lib/Wallet/Kadmin.pm @@ -1,6 +1,7 @@ -# Wallet::Kadmin -- Kerberos administration API for wallet keytab backend. +# Wallet::Kadmin -- Kerberos administration API for wallet keytab backend # # Written by Jon Robertson <jonrober@stanford.edu> +# Copyright 2016 Russ Allbery <eagle@eyrie.org> # Copyright 2009, 2010, 2014 # The Board of Trustees of the Leland Stanford Junior University # @@ -11,18 +12,14 @@ ############################################################################## package Wallet::Kadmin; -require 5.006; +use 5.008; use strict; use warnings; -use vars qw($VERSION); -use Wallet::Config (); +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'; +our $VERSION = '1.03'; ############################################################################## # Utility functions for child classes @@ -69,6 +66,9 @@ sub new { } elsif (lc ($Wallet::Config::KEYTAB_KRBTYPE) eq 'heimdal') { require Wallet::Kadmin::Heimdal; $kadmin = Wallet::Kadmin::Heimdal->new; + } elsif (lc ($Wallet::Config::KEYTAB_KRBTYPE) eq 'ad') { + require Wallet::Kadmin::AD; + $kadmin = Wallet::Kadmin::AD->new; } else { my $type = $Wallet::Config::KEYTAB_KRBTYPE; die "unknown KEYTAB_KRBTYPE setting: $type\n"; diff --git a/perl/lib/Wallet/Kadmin/AD.pm b/perl/lib/Wallet/Kadmin/AD.pm new file mode 100644 index 0000000..5b71d41 --- /dev/null +++ b/perl/lib/Wallet/Kadmin/AD.pm @@ -0,0 +1,472 @@ +# Wallet::Kadmin::AD -- Wallet Kerberos administration API for AD +# +# Written by Bill MacAllister <bill@ca-zephyr.org> +# Copyright 2016 Russ Allbery <eagle@eyrie.org> +# Copyright 2015 Dropbox, Inc. +# Copyright 2007, 2008, 2009, 2010, 2014 +# The Board of Trustees of the Leland Stanford Junior University +# +# See LICENSE for licensing terms. + +############################################################################## +# Modules and declarations +############################################################################## + +package Wallet::Kadmin::AD; + +use 5.008; +use strict; +use warnings; + +use Authen::SASL; +use Net::LDAP; +use IPC::Run qw(run timeout); +use Sys::Syslog qw(:standard :macros); +use Wallet::Config; +use Wallet::Kadmin; + +our @ISA = qw(Wallet::Kadmin); +our $VERSION = '1.03'; + +############################################################################## +# kadmin Interaction +############################################################################## + +# Send debugging output to syslog. + +sub ad_debug { + my ($self, $l, $m) = @_; + if (!$self->{SYSLOG}) { + openlog('wallet-server', 'ndelay,nofatal', 'local3'); + $self->{SYSLOG} = 1; + } + syslog($l, $m); + return; +} + +# 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) = @_; + my $valid = 0; + if ($principal =~ m,^(host|service)(/[\w_.-]+)?\z,) { + my $k_type = $1; + my $k_id = $2; + if ($k_type eq 'host') { + $valid = 1 if $k_id =~ m/[.]/xms; + } elsif ($k_type eq 'service') { + $valid = 1 if length($k_id) < 19; + } + } + return $valid; +} + +# Connect to the Active Directory server using LDAP. The connection is +# used to retrieve information about existing keytabs since msktutil +# does not have this functionality. +sub ldap_connect { + my ($self) = @_; + + if (!-e $Wallet::Config::AD_CACHE) { + die 'Missing kerberos ticket cache ' . $Wallet::Config::AD_CACHE; + } + + my $ldap; + eval { + local $ENV{KRB5CCNAME} = $Wallet::Config::AD_CACHE; + my $sasl = Authen::SASL->new(mechanism => 'GSSAPI'); + $ldap = Net::LDAP->new($Wallet::Config::KEYTAB_HOST, onerror => 'die'); + my $mesg = eval { $ldap->bind(undef, sasl => $sasl) }; + }; + if ($@) { + my $error = $@; + chomp $error; + 1 while ($error =~ s/ at \S+ line \d+\.?\z//); + die "LDAP bind to AD failed: $error\n"; + } + + return $ldap; +} + +# Construct a base filter for searching Active Directory. + +sub ldap_base_filter { + my ($self, $principal) = @_; + my $base; + my $filter; + if ($principal =~ m,^host/(\S+),xms) { + my $fqdn = $1; + my $host = $fqdn; + $host =~ s/[.].*//xms; + $base = $Wallet::Config::AD_COMPUTER_DN; + $filter = "(samAccountName=${host}\$)"; + } elsif ($principal =~ m,^service/(\S+),xms) { + my $id = $1; + $base = $Wallet::Config::AD_USER_DN; + $filter = "(servicePrincipalName=service/${id})"; + } + return ($base, $filter); +} + +# TODO: Get a keytab from the keytab cache. +sub get_ad_keytab { + my ($self, $principal) = @_; + return; +} + +# Run a msktutil command and capture the output. Returns the output, +# either as a list of lines or, in scalar context, as one string. +# Depending on the exit status of msktutil or on the eval trap to know +# when the msktutil command fails. The error string returned from the +# call to run frequently contains information about a success rather +# that error output. +sub msktutil { + my ($self, $args_ref) = @_; + unless (defined($Wallet::Config::KEYTAB_HOST) + and defined($Wallet::Config::KEYTAB_REALM)) + { + die "keytab object implementation not configured\n"; + } + unless (defined($Wallet::Config::AD_CACHE) + and defined($Wallet::Config::AD_COMPUTER_DN) + and defined($Wallet::Config::AD_USER_DN)) + { + die "Active Directory support not configured\n"; + } + my @args = @{$args_ref}; + my @cmd = ($Wallet::Config::AD_MSKTUTIL); + push @cmd, @args; + if ($Wallet::Config::AD_DEBUG) { + $self->ad_debug('debug', join(' ', @cmd)); + } + + my $in; + my $out; + my $err; + my $err_msg; + my $err_no; + eval { + local $ENV{KRB5CCNAME} = $Wallet::Config::AD_CACHE; + run \@cmd, \$in, \$out, \$err, timeout(120); + if ($?) { + $err_no = $?; + } + }; + if ($@) { + $err_msg .= "ERROR ($err_no): $@\n"; + } + if ($err_no || $err_msg) { + if ($err) { + $err_msg .= "ERROR: $err\n"; + $err_msg .= 'Problem command: ' . join(' ', @cmd) . "\n"; + } + die $err_msg; + } else { + if ($err) { + $out .= "\n" . $err; + } + } + if ($Wallet::Config::AD_DEBUG) { + $self->ad_debug('debug', $out); + } + return $out; +} + +# Either create or update a keytab for the principal. Return the +# name of the keytab file created. +sub ad_create_update { + my ($self, $principal, $action) = @_; + my $keytab = $Wallet::Config::KEYTAB_TMP . "/keytab.$$"; + if (-e $keytab) { + unlink $keytab or die "Problem deleting $keytab\n"; + } + my @cmd = ('--' . $action); + push @cmd, '--server', $Wallet::Config::AD_SERVER; + push @cmd, '--enctypes', '0x4'; + push @cmd, '--enctypes', '0x8'; + push @cmd, '--enctypes', '0x10'; + push @cmd, '--keytab', $keytab; + push @cmd, '--realm', $Wallet::Config::KEYTAB_REALM; + + if ($principal =~ m,^host/(\S+),xms) { + my $fqdn = $1; + my $host = $fqdn; + $host =~ s/[.].*//xms; + push @cmd, '--dont-expire-password'; + push @cmd, '--computer-name', $host; + push @cmd, '--upn', "host/$fqdn"; + push @cmd, '--hostname', $fqdn; + } elsif ($principal =~ m,^service/(\S+),xms) { + my $service_id = $1; + push @cmd, '--use-service-account'; + push @cmd, '--service', "service/$service_id"; + push @cmd, '--account-name', "srv-${service_id}"; + push @cmd, '--no-pac'; + } + my $out = $self->msktutil(\@cmd); + if ($out =~ /Error:\s+\S+\s+failed/xms) { + $self->ad_delete($principal); + my $m = "ERROR: problem creating keytab:\n" . $out; + $m .= 'INFO: the keytab used to by wallet probably has' + . " insufficient access to AD\n"; + die $m; + } + + return $keytab; +} + +############################################################################## +# 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. Returns true if so, +# false otherwise. The best way to do this with AD is to perform an +# ldap query. +sub exists { + my ($self, $principal) = @_; + return unless $self->valid_principal($principal); + + my $ldap = $self->ldap_connect(); + my ($base, $filter) = $self->ldap_base_filter($principal); + my @attrs = ('objectClass', 'msds-KeyVersionNumber'); + + my $result; + eval { + $result = $ldap->search( + base => $base, + scope => 'subtree', + filter => $filter, + attrs => \@attrs + ); + }; + + if ($@) { + my $error = $@; + die "LDAP search error: $error\n"; + } + if ($result->code) { + my $m; + $m .= "INFO base:$base filter:$filter scope:subtree\n"; + $m .= 'ERROR:' . $result->error . "\n"; + die $m; + } + if ($result->count > 1) { + my $m = "ERROR: too many AD entries for this keytab\n"; + for my $entry ($result->entries) { + $m .= 'INFO: dn found ' . $entry->dn . "\n"; + } + die $m; + } + if ($result->count) { + for my $entry ($result->entries) { + return $entry->get_value('msds-KeyVersionNumber'); + } + } else { + return 0; + } + return; +} + +# Call msktutil to Create a principal in Kerberos. Sets the error and +# returns undef on failure, and returns 1 on either success or if the +# principal already exists. Note, this creates a keytab that is never +# used because it is not returned to the user. +sub create { + my ($self, $principal) = @_; + unless ($self->valid_principal($principal)) { + die "ERROR: invalid principal name $principal\n"; + return; + } + if ($self->exists($principal)) { + if ($Wallet::Config::AD_DEBUG) { + $self->ad_debug('debug', "$principal exists"); + } + return 1; + } + my $file = $self->ad_create_update($principal, 'create'); + if (-e $file) { + unlink $file or die "Problem deleting $file\n"; + } + return 1; +} + +# TODO: Return a keytab. Need to create a local keytab cache when +# a keytab is marked unchanging and return that. +sub keytab { + my ($self, $principal) = @_; + unless ($self->valid_principal($principal)) { + die "ERROR: invalid principal name $principal\n"; + return; + } + my $file = 'call to route to get the file name of local keytab file'; + if (!-e $file) { + die "ERROR: keytab file $file does not exist.\n"; + } + return $self->read_keytab($file); +} + +# Update a keytab for a principal. This action changes the AD +# password for the principal and increments the kvno. The enctypes +# passed in are ignored. +sub keytab_rekey { + my ($self, $principal, @enctypes) = @_; + unless ($self->valid_principal($principal)) { + die "ERROR: invalid principal name: $principal\n"; + return; + } + if (!$self->exists($principal)) { + die "ERROR: $principal does not exist\n"; + } + unless ($self->valid_principal($principal)) { + die "ERROR: invalid principal name $principal\n"; + return; + } + my $file = $self->ad_create_update($principal, 'update'); + 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. For AD this means just delete the object using +# LDAP. +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; + } + + return $self->ad_delete($principal); +} + +# Delete an entry from AD using LDAP. + +sub ad_delete { + my ($self, $principal) = @_; + + my $k_type; + my $k_id; + my $dn; + if ($principal =~ m,^(host|service)/(\S+),xms) { + $k_type = $1; + $k_id = $2; + if ($k_type eq 'host') { + my $host = $k_id; + $host =~ s/[.].*//; + $dn = "cn=${host}," . $Wallet::Config::AD_COMPUTER_DN; + } elsif ($k_type eq 'service') { + $dn = "cn=srv-${k_id}," . $Wallet::Config::AD_USER_DN; + } + } + + my $ldap = $self->ldap_connect(); + my $msgid = $ldap->delete($dn); + if ($msgid->code) { + my $m; + $m .= "ERROR: Problem deleting $dn\n"; + $m .= $msgid->error; + die $m; + } + return 1; +} + +# Create a new AD 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 = {}; + $self->{SYSLOG} = undef; + bless($self, $class); + return $self; +} + +1; +__END__ + +############################################################################## +# Documentation +############################################################################## + +=for stopwords +rekeying rekeys remctl backend keytabs keytab kadmin KDC API Allbery +unlinked MacAllister msktutil + +=head1 NAME + +Wallet::Kadmin::AD - Wallet Kerberos administration API for Active Directory + +=head1 SYNOPSIS + + my $kadmin = Wallet::Kadmin::AD->new; + $kadmin->create ('host/foo.example.com'); + my $data = $kadmin->keytab_rekey ('host/foo.example.com'); + $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::AD implements the Wallet::Kadmin API for Active +Directory Kerberos, providing an interface to create and delete +principals and create keytabs. It provides the API documented in +L<Wallet::Kadmin> for an Active Directory Kerberos KDC. + +AD Kerberos does not provide any method via msktutil 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 local keytab cache. + +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<msktutil> program rather +than using a native Perl module and therefore requires B<msktutil> be +installed and parses its output. + +=head1 SEE ALSO + +msktutil, 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 + +Bill MacAllister <whm@dropbox.com> +and Russ Allbery <eagle@eyrie.org> +and Jon Robertson <jonrober@stanford.edu>. + +=cut diff --git a/perl/lib/Wallet/Kadmin/Heimdal.pm b/perl/lib/Wallet/Kadmin/Heimdal.pm index 1208801..22bdd59 100644 --- a/perl/lib/Wallet/Kadmin/Heimdal.pm +++ b/perl/lib/Wallet/Kadmin/Heimdal.pm @@ -1,6 +1,7 @@ -# Wallet::Kadmin::Heimdal -- Wallet Kerberos administration API for Heimdal. +# Wallet::Kadmin::Heimdal -- Wallet Kerberos administration API for Heimdal # # Written by Jon Robertson <jonrober@stanford.edu> +# Copyright 2016 Russ Allbery <eagle@eyrie.org> # Copyright 2009, 2010, 2014 # The Board of Trustees of the Leland Stanford Junior University # @@ -11,22 +12,17 @@ ############################################################################## package Wallet::Kadmin::Heimdal; -require 5.006; +use 5.008; use strict; use warnings; -use vars qw(@ISA $VERSION); use Heimdal::Kadm5 qw(KRB5_KDB_DISALLOW_ALL_TIX); -use Wallet::Config (); -use Wallet::Kadmin (); +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.04'; +our @ISA = qw(Wallet::Kadmin); +our $VERSION = '1.03'; ############################################################################## # Utility functions diff --git a/perl/lib/Wallet/Kadmin/MIT.pm b/perl/lib/Wallet/Kadmin/MIT.pm index ac45265..9f0f50f 100644 --- a/perl/lib/Wallet/Kadmin/MIT.pm +++ b/perl/lib/Wallet/Kadmin/MIT.pm @@ -1,7 +1,8 @@ -# Wallet::Kadmin::MIT -- Wallet Kerberos administration API for MIT. +# Wallet::Kadmin::MIT -- Wallet Kerberos administration API for MIT # # Written by Russ Allbery <eagle@eyrie.org> # Pulled into a module by Jon Robertson <jonrober@stanford.edu> +# Copyright 2016 Russ Allbery <eagle@eyrie.org> # Copyright 2007, 2008, 2009, 2010, 2014 # The Board of Trustees of the Leland Stanford Junior University # @@ -12,21 +13,17 @@ ############################################################################## package Wallet::Kadmin::MIT; -require 5.006; +use 5.008; use strict; use warnings; -use vars qw(@ISA $VERSION); -use Wallet::Config (); -use Wallet::Kadmin (); +use POSIX qw(_exit); +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'; +our @ISA = qw(Wallet::Kadmin); +our $VERSION = '1.03'; ############################################################################## # kadmin Interaction @@ -65,11 +62,11 @@ sub kadmin { $self->{fork_callback} () if $self->{fork_callback}; unless (open (STDERR, '>&STDOUT')) { warn "wallet: cannot dup stdout: $!\n"; - exit 1; + _exit(1); } unless (exec ($Wallet::Config::KEYTAB_KADMIN, @args)) { warn "wallet: cannot run $Wallet::Config::KEYTAB_KADMIN: $!\n"; - exit 1; + _exit(1); } } local $_; diff --git a/perl/lib/Wallet/Object/Base.pm b/perl/lib/Wallet/Object/Base.pm index bdd61fb..221031f 100644 --- a/perl/lib/Wallet/Object/Base.pm +++ b/perl/lib/Wallet/Object/Base.pm @@ -1,6 +1,7 @@ -# Wallet::Object::Base -- Parent class for any object stored in the wallet. +# Wallet::Object::Base -- Parent class for any object stored in the wallet # # Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2016 Russ Allbery <eagle@eyrie.org> # Copyright 2007, 2008, 2010, 2011, 2014 # The Board of Trustees of the Leland Stanford Junior University # @@ -11,22 +12,17 @@ ############################################################################## package Wallet::Object::Base; -require 5.006; +use 5.008; use strict; use warnings; -use vars qw($VERSION); use DateTime; use Date::Parse qw(str2time); -use DBI; use Text::Wrap qw(wrap); 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.08'; +our $VERSION = '1.03'; ############################################################################## # Constructors @@ -609,6 +605,15 @@ sub history { # The get methods must always be overridden by the subclass. sub get { die "Do not instantiate Wallet::Object::Base directly\n"; } +# The update method should only work if a subclass supports it as something +# different from get. That makes it explicit about whether the subclass has +# a meaningful update. +sub update { + my ($self) = @_; + $self->error ("update is not supported for this type, use get instead"); + return; +} + # Provide a default store implementation that returns an immutable object # error so that auto-generated types don't have to provide their own. sub store { diff --git a/perl/lib/Wallet/Object/Duo.pm b/perl/lib/Wallet/Object/Duo.pm index d08294b..1aca979 100644 --- a/perl/lib/Wallet/Object/Duo.pm +++ b/perl/lib/Wallet/Object/Duo.pm @@ -1,7 +1,8 @@ # Wallet::Object::Duo -- Base Duo object implementation for the wallet # # Written by Russ Allbery <eagle@eyrie.org> -# Copyright 2014 +# Copyright 2016 Russ Allbery <eagle@eyrie.org> +# Copyright 2014, 2015 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -11,25 +12,111 @@ ############################################################################## package Wallet::Object::Duo; -require 5.006; +use 5.008; use strict; use warnings; -use vars qw(@ISA $VERSION); use JSON; -use Net::Duo::Admin; -use Net::Duo::Admin::Integration; use Perl6::Slurp qw(slurp); -use Wallet::Config (); +use Wallet::Config; use Wallet::Object::Base; -@ISA = qw(Wallet::Object::Base); +our @ISA = qw(Wallet::Object::Base); +our $VERSION = '1.03'; + +# Mappings from our types into what Duo calls the integration types. +our %DUO_TYPES = ( + 'duo' => { + integration => 'unix', + output => \&_output_generic, + }, + 'duo-ldap' => { + integration => 'ldapproxy', + output => \&_output_ldap, + }, + 'duo-pam' => { + integration => 'unix', + output => \&_output_pam, + }, + 'duo-radius' => { + integration => 'radius', + output => \&_output_radius, + }, + ); + +# Extra types to add. These are all just named as the Duo integration name +# with duo- before it and go to the generic output. Put them here to prevent +# pages of settings. These are also not all actually set as types in the +# types table to prevent overpopulation. You should manually create the +# entries in that table for any Duo integrations you want to add. +our @EXTRA_TYPES = ('accountsapi', 'adfs', 'adminapi', 'array', 'barracuda', + 'cisco', 'citrixcag', 'citrixns', 'confluence', 'drupal', + 'f5bigip', 'f5firepass', 'fortinet', 'jira', 'juniper', + 'juniperuac', 'lastpass', 'okta', 'onelogin', 'openvpn', + 'openvpnas', 'owa', 'paloalto', 'rdgateway', 'rdp', + 'rdweb', 'rest', 'rras', 'shibboleth', 'sonicwallsra', + 'splunk', 'tmg', 'uag', 'verify', 'vmwareview', 'websdk', + 'wordpress'); +for my $type (@EXTRA_TYPES) { + my $wallet_type = 'duo-'.$type; + $DUO_TYPES{$wallet_type}{integration} = $type; + $DUO_TYPES{$wallet_type}{output} = \&_output_generic; +}; -# 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'; +############################################################################## +# Get output methods +############################################################################## + +# Output for any miscellaneous Duo integration, usually those that use a GUI +# to set information and so don't need a custom configuration file. +sub _output_generic { + my ($key, $secret, $hostname) = @_; + + my $output; + $output .= "Integration key: $key\n"; + $output .= "Secret key: $secret\n"; + $output .= "Host: $hostname\n"; + + return $output; +} + +# Output for the Duo unix integration, which hooks into the PAM stack. +sub _output_pam { + my ($key, $secret, $hostname) = @_; + + my $output = "[duo]\n"; + $output .= "ikey = $key\n"; + $output .= "skey = $secret\n"; + $output .= "host = $hostname\n"; + + return $output; +} + +# Output for the radius proxy, which can be plugged into the proxy config. +sub _output_radius { + my ($key, $secret, $hostname) = @_; + + my $output = "[radius_server_challenge]\n"; + $output .= "ikey = $key\n"; + $output .= "skey = $secret\n"; + $output .= "api_host = $hostname\n"; + $output .= "client = radius_client\n"; + + return $output; +} + +# Output for the LDAP proxy, which can be plugged into the proxy config. +sub _output_ldap { + my ($key, $secret, $hostname) = @_; + + my $output = "[ldap_server_challenge]\n"; + $output .= "ikey = $key\n"; + $output .= "skey = $secret\n"; + $output .= "api_host = $hostname\n"; + + return $output; +} ############################################################################## # Core methods @@ -66,8 +153,20 @@ sub new { my $key_file = $Wallet::Config::DUO_KEY_FILE; my $agent = $Wallet::Config::DUO_AGENT; + # Check that we can load all of the required modules. + eval { + require Net::Duo; + require Net::Duo::Admin; + require Net::Duo::Admin::Integration; + }; + if ($@) { + my $error = $@; + chomp $error; + 1 while ($error =~ s/ at \S+ line \d+\.?\z//); + die "Duo object support not available: $error\n"; + } + # Construct the Net::Duo::Admin object. - require Net::Duo::Admin; my $duo = Net::Duo::Admin->new ( { key_file => $key_file, @@ -86,7 +185,7 @@ sub new { # great here since we don't have a way to communicate the error back to the # caller. sub create { - my ($class, $type, $name, $schema, $creator, $host, $time, $duo_type) = @_; + my ($class, $type, $name, $schema, $creator, $host, $time) = @_; # We have to have a Duo integration key file set. if (not $Wallet::Config::DUO_KEY_FILE) { @@ -95,8 +194,26 @@ sub create { my $key_file = $Wallet::Config::DUO_KEY_FILE; my $agent = $Wallet::Config::DUO_AGENT; + # Make sure this is actually a type we know about, since this handler + # can handle many types. + if (!exists $DUO_TYPES{$type}) { + die "$type is not a valid duo integration\n"; + } + + # Check that we can load all of the required modules. + eval { + require Net::Duo; + require Net::Duo::Admin; + require Net::Duo::Admin::Integration; + }; + if ($@) { + my $error = $@; + chomp $error; + 1 while ($error =~ s/ at \S+ line \d+\.?\z//); + die "Duo object support not available: $error\n"; + } + # Construct the Net::Duo::Admin object. - require Net::Duo::Admin; my $duo = Net::Duo::Admin->new ( { key_file => $key_file, @@ -105,8 +222,7 @@ sub create { ); # Create the object in Duo. - require Net::Duo::Admin::Integration; - $duo_type ||= $Wallet::Config::DUO_TYPE; + my $duo_type = $DUO_TYPES{$type}{integration}; my %data = ( name => "$name ($duo_type)", notes => 'Managed by wallet', @@ -201,11 +317,17 @@ sub get { my $json = JSON->new->utf8 (1)->relaxed (1); my $config = $json->decode (scalar slurp $Wallet::Config::DUO_KEY_FILE); - # Construct the returned file. - my $output; - $output .= "Integration key: $key\n"; - $output .= 'Secret key: ' . $integration->secret_key . "\n"; - $output .= "Host: $config->{api_hostname}\n"; + # Construct the returned file. Assume the generic handler in case there + # is no valid handler, though that shouldn't happen. + my $output_sub; + my $type = $self->{type}; + if (exists $DUO_TYPES{$type}{output}) { + $output_sub = $DUO_TYPES{$type}{output}; + } else { + $output_sub = \&_output_generic; + } + my $output = $output_sub->($key, $integration->secret_key, + $config->{api_hostname}); # Log the action and return. $self->log_action ('get', $user, $host, $time); diff --git a/perl/lib/Wallet/Object/Duo/LDAPProxy.pm b/perl/lib/Wallet/Object/Duo/LDAPProxy.pm deleted file mode 100644 index 74ff43c..0000000 --- a/perl/lib/Wallet/Object/Duo/LDAPProxy.pm +++ /dev/null @@ -1,202 +0,0 @@ -# Wallet::Object::Duo::LDAPProxy -- Duo auth proxy integration for LDAP -# -# Written by Jon Robertson <jonrober@stanford.edu> -# Copyright 2014 -# The Board of Trustees of the Leland Stanford Junior University -# -# See LICENSE for licensing terms. - -############################################################################## -# Modules and declarations -############################################################################## - -package Wallet::Object::Duo::LDAPProxy; -require 5.006; - -use strict; -use warnings; -use vars qw(@ISA $VERSION); - -use JSON; -use Net::Duo::Admin; -use Net::Duo::Admin::Integration; -use Perl6::Slurp qw(slurp); -use Wallet::Config (); -use Wallet::Object::Duo; - -@ISA = qw(Wallet::Object::Duo); - -# 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'; - -############################################################################## -# Core methods -############################################################################## - -# Override create to provide the specific Duo integration type that will be -# used in the remote Duo record. -sub create { - my ($class, $type, $name, $schema, $creator, $host, $time) = @_; - - $time ||= time; - my $self = $class->SUPER::create ($type, $name, $schema, $creator, $host, - $time, 'ldapproxy'); - return $self; -} - -# Override get to output the data in a specific format used for Duo LDAP -# integration -sub get { - my ($self, $user, $host, $time) = @_; - $time ||= time; - - # Check that the object isn't locked. - my $id = $self->{type} . ':' . $self->{name}; - if ($self->flag_check ('locked')) { - $self->error ("cannot get $id: object is locked"); - return; - } - - # Retrieve the integration from Duo. - my $key; - eval { - my %search = (du_name => $self->{name}); - my $row = $self->{schema}->resultset ('Duo')->find (\%search); - $key = $row->get_column ('du_key'); - }; - if ($@) { - $self->error ($@); - return; - } - my $integration = Net::Duo::Admin::Integration->new ($self->{duo}, $key); - - # We also need the admin server name, which we can get from the Duo object - # configuration with a bit of JSON decoding. - my $json = JSON->new->utf8 (1)->relaxed (1); - my $config = $json->decode (scalar slurp $Wallet::Config::DUO_KEY_FILE); - - # Construct the returned file. - my $output = "[ldap_server_challenge]\n"; - $output .= "ikey = $key\n"; - $output .= 'skey = ' . $integration->secret_key . "\n"; - $output .= "api_host = $config->{api_hostname}\n"; - - # Log the action and return. - $self->log_action ('get', $user, $host, $time); - return $output; -} - -1; -__END__ - -############################################################################## -# Documentation -############################################################################## - -=for stopwords -Allbery Duo integration DBH keytab LDAP auth - -=head1 NAME - -Wallet::Object::Duo::LDAPProxy -- Duo auth proxy integration for LDAP - -=head1 SYNOPSIS - - my @name = qw(duo-ldap host.example.com); - my @trace = ($user, $host, time); - my $object = Wallet::Object::Duo::LDAPProxy->create (@name, $schema, @trace); - my $config = $object->get (@trace); - $object->destroy (@trace); - -=head1 DESCRIPTION - -Wallet::Object::Duo::LDAPProxy is a representation of Duo -integrations with the wallet, specifically to output Duo integrations -in a format that can easily be pulled into configuring the Duo -Authentication Proxy for LDAP. It implements the wallet object API -and provides the necessary glue to create a Duo integration, return a -configuration file containing the key and API information for that -integration, and delete the integration from Duo when the wallet object -is destroyed. - -The integration information is always returned in the configuration file -format expected by the Authentication Proxy for Duo in configuring it -for LDAP. - -This object can be retrieved repeatedly without changing the secret key, -matching Duo's native behavior with integrations. To change the keys of -the integration, delete it and recreate it. - -To use this object, at least one configuration parameter must be set. See -L<Wallet::Config> for details on supported configuration parameters and -information about how to set wallet configuration. - -=head1 METHODS - -This object mostly inherits from Wallet::Object::Duo. See the -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 create(TYPE, NAME, DBH, PRINCIPAL, HOSTNAME [, DATETIME]) - -This will override the Wallet::Object::Duo class with the information -needed to create a specific integration type in Duo. It creates a new -object with the given TYPE and NAME (TYPE is normally C<duo-ldap> 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 Duo integration object is created, a new integration will be -created in the configured Duo account and the integration key will be -stored in the wallet object. If the integration already exists, create() -will fail. - -If create() fails, it throws an exception. - -=item get(PRINCIPAL, HOSTNAME [, DATETIME]) - -Retrieves the configuration information for the Duo integration and -returns that information in the format expected by the configuration file -for the Duo UNIX integration. Returns undef on failure. The caller -should call error() to get the error message if get() returns undef. - -The returned configuration look look like: - - [ldap_server_challenge] - ikey = <integration-key> - skey = <secret-key> - api_host = <api-hostname> - -The C<host> parameter will be taken from the configuration file pointed -to by the DUO_KEY_FILE configuration variable. - -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 - -=head1 LIMITATIONS - -Only one Duo account is supported for a given wallet implementation. - -=head1 SEE ALSO - -Net::Duo(3), Wallet::Config(3), Wallet::Object::Duo(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> - -=cut diff --git a/perl/lib/Wallet/Object/Duo/PAM.pm b/perl/lib/Wallet/Object/Duo/PAM.pm deleted file mode 100644 index 6f90ba1..0000000 --- a/perl/lib/Wallet/Object/Duo/PAM.pm +++ /dev/null @@ -1,205 +0,0 @@ -# Wallet::Object::Duo::PAM -- Duo PAM int. object implementation for wallet -# -# Written by Russ Allbery <eagle@eyrie.org> -# Jon Robertson <jonrober@stanford.edu> -# Copyright 2014 -# The Board of Trustees of the Leland Stanford Junior University -# -# See LICENSE for licensing terms. - -############################################################################## -# Modules and declarations -############################################################################## - -package Wallet::Object::Duo::PAM; -require 5.006; - -use strict; -use warnings; -use vars qw(@ISA $VERSION); - -use JSON; -use Net::Duo::Admin; -use Net::Duo::Admin::Integration; -use Perl6::Slurp qw(slurp); -use Wallet::Config (); -use Wallet::Object::Duo; - -@ISA = qw(Wallet::Object::Duo); - -# 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'; - -############################################################################## -# Core methods -############################################################################## - -# Override create to provide the specific Duo integration type that will be -# used in the remote Duo record. -sub create { - my ($class, $type, $name, $schema, $creator, $host, $time) = @_; - - $time ||= time; - my $self = $class->SUPER::create ($type, $name, $schema, $creator, $host, - $time, 'unix'); - return $self; -} - -# Override get to output the data in a specific format used by Duo's PAM -# module. -sub get { - my ($self, $user, $host, $time) = @_; - $time ||= time; - - # Check that the object isn't locked. - my $id = $self->{type} . ':' . $self->{name}; - if ($self->flag_check ('locked')) { - $self->error ("cannot get $id: object is locked"); - return; - } - - # Retrieve the integration from Duo. - my $key; - eval { - my %search = (du_name => $self->{name}); - my $row = $self->{schema}->resultset ('Duo')->find (\%search); - $key = $row->get_column ('du_key'); - }; - if ($@) { - $self->error ($@); - return; - } - my $integration = Net::Duo::Admin::Integration->new ($self->{duo}, $key); - - # We also need the admin server name, which we can get from the Duo object - # configuration with a bit of JSON decoding. - my $json = JSON->new->utf8 (1)->relaxed (1); - my $config = $json->decode (scalar slurp $Wallet::Config::DUO_KEY_FILE); - - # Construct the returned file. - my $output = "[duo]\n"; - $output .= "ikey = $key\n"; - $output .= 'skey = ' . $integration->secret_key . "\n"; - $output .= "host = $config->{api_hostname}\n"; - - # Log the action and return. - $self->log_action ('get', $user, $host, $time); - return $output; -} - -1; -__END__ - -############################################################################## -# Documentation -############################################################################## - -=for stopwords -Allbery Duo integration DBH keytab - -=head1 NAME - -Wallet::Object::Duo::PAM -- Duo PAM int. object implementation for wallet - -=head1 SYNOPSIS - - my @name = qw(duo-pam host.example.com); - my @trace = ($user, $host, time); - my $object = Wallet::Object::Duo::PAM->create (@name, $schema, @trace); - my $config = $object->get (@trace); - $object->destroy (@trace); - -=head1 DESCRIPTION - -Wallet::Object::Duo::PAM is a representation of Duo integrations with -the wallet, specifically to output Duo integrations in a format that -can easily be pulled into configuring the Duo PAM interface. It -implements the wallet object API and provides the necessary glue to -create a Duo integration, return a configuration file containing the key -and API information for that integration, and delete the integration from -Duo when the wallet object is destroyed. - -The integration information is always returned in the configuration file -format expected by the Duo UNIX integration. The results of retrieving -this object will be text, suitable for putting in the UNIX integration -configuration file, containing the integration key, secret key, and admin -hostname for that integration. - -This object can be retrieved repeatedly without changing the secret key, -matching Duo's native behavior with integrations. To change the keys of -the integration, delete it and recreate it. - -To use this object, at least one configuration parameter must be set. See -L<Wallet::Config> for details on supported configuration parameters and -information about how to set wallet configuration. - -=head1 METHODS - -This object mostly inherits from Wallet::Object::Duo. See the -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 create(TYPE, NAME, DBH, PRINCIPAL, HOSTNAME [, DATETIME]) - -This will override the Wallet::Object::Duo class with the information -needed to create a specific integration type in Duo. It creates a new -object with the given TYPE and NAME (TYPE is normally C<duo-pam> 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 Duo integration object is created, a new integration will be -created in the configured Duo account and the integration key will be -stored in the wallet object. If the integration already exists, create() -will fail. - -If create() fails, it throws an exception. - -=item get(PRINCIPAL, HOSTNAME [, DATETIME]) - -Retrieves the configuration information for the Duo integration and -returns that information in the format expected by the configuration file -for the Duo UNIX integration. Returns undef on failure. The caller -should call error() to get the error message if get() returns undef. - -The returned configuration look look like: - - [duo] - ikey = <integration-key> - skey = <secret-key> - host = <api-hostname> - -The C<host> parameter will be taken from the configuration file pointed -to by the DUO_KEY_FILE configuration variable. - -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 - -=head1 LIMITATIONS - -Only one Duo account is supported for a given wallet implementation. - -=head1 SEE ALSO - -Net::Duo(3), Wallet::Config(3), Wallet::Object::Duo(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 <eagle@eyrie.org> -Jon Robertson <eagle@eyrie.org> - -=cut diff --git a/perl/lib/Wallet/Object/Duo/RDP.pm b/perl/lib/Wallet/Object/Duo/RDP.pm deleted file mode 100644 index 2e975fc..0000000 --- a/perl/lib/Wallet/Object/Duo/RDP.pm +++ /dev/null @@ -1,204 +0,0 @@ -# Wallet::Object::Duo::RDP -- Duo RDP int. object implementation for wallet -# -# Written by Russ Allbery <eagle@eyrie.org> -# Jon Robertson <jonrober@stanford.edu> -# Copyright 2014 -# The Board of Trustees of the Leland Stanford Junior University -# -# See LICENSE for licensing terms. - -############################################################################## -# Modules and declarations -############################################################################## - -package Wallet::Object::Duo::RDP; -require 5.006; - -use strict; -use warnings; -use vars qw(@ISA $VERSION); - -use JSON; -use Net::Duo::Admin; -use Net::Duo::Admin::Integration; -use Perl6::Slurp qw(slurp); -use Wallet::Config (); -use Wallet::Object::Duo; - -@ISA = qw(Wallet::Object::Duo); - -# 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'; - -############################################################################## -# Core methods -############################################################################## - -# Override create to provide the specific Duo integration type that will be -# used in the remote Duo record. -sub create { - my ($class, $type, $name, $schema, $creator, $host, $time) = @_; - - $time ||= time; - my $self = $class->SUPER::create ($type, $name, $schema, $creator, $host, - $time, 'rdp'); - return $self; -} - -# Override get to output the data in a specific format used by Duo's RDP -# module. -sub get { - my ($self, $user, $host, $time) = @_; - $time ||= time; - - # Check that the object isn't locked. - my $id = $self->{type} . ':' . $self->{name}; - if ($self->flag_check ('locked')) { - $self->error ("cannot get $id: object is locked"); - return; - } - - # Retrieve the integration from Duo. - my $key; - eval { - my %search = (du_name => $self->{name}); - my $row = $self->{schema}->resultset ('Duo')->find (\%search); - $key = $row->get_column ('du_key'); - }; - if ($@) { - $self->error ($@); - return; - } - my $integration = Net::Duo::Admin::Integration->new ($self->{duo}, $key); - - # We also need the admin server name, which we can get from the Duo object - # configuration with a bit of JSON decoding. - my $json = JSON->new->utf8 (1)->relaxed (1); - my $config = $json->decode (scalar slurp $Wallet::Config::DUO_KEY_FILE); - - # Construct the returned file. - my $output; - $output .= "Integration key: $key\n"; - $output .= 'Secret key: ' . $integration->secret_key . "\n"; - $output .= "Host: $config->{api_hostname}\n"; - - # Log the action and return. - $self->log_action ('get', $user, $host, $time); - return $output; -} - -1; -__END__ - -############################################################################## -# Documentation -############################################################################## - -=for stopwords -Allbery Duo integration DBH keytab RDP - -=head1 NAME - -Wallet::Object::Duo::RDP -- Duo RDP int. object implementation for wallet - -=head1 SYNOPSIS - - my @name = qw(duo-rdp host.example.com); - my @trace = ($user, $host, time); - my $object = Wallet::Object::Duo::RDP->create (@name, $schema, @trace); - my $config = $object->get (@trace); - $object->destroy (@trace); - -=head1 DESCRIPTION - -Wallet::Object::Duo::RDP is a representation of Duo integrations with -the wallet, specifically to output Duo integrations to set up an RDP -integration. This can be used to set up remote logins, or all Windows -logins period if so selected in Duo's software. It implements the -wallet object API and provides the necessary glue to create a Duo -integration, return a configuration file containing the key and API -information for that integration, and delete the integration from Duo -when the wallet object is destroyed. - -Because the Duo RDP software is configured by a GUI, the information -returned for a get operation is a simple set that's readable but not -useful for directly plugging into a config file. The values would need -to be cut and pasted into the GUI. - -This object can be retrieved repeatedly without changing the secret key, -matching Duo's native behavior with integrations. To change the keys of -the integration, delete it and recreate it. - -To use this object, at least one configuration parameter must be set. See -L<Wallet::Config> for details on supported configuration parameters and -information about how to set wallet configuration. - -=head1 METHODS - -This object mostly inherits from Wallet::Object::Duo. See the -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 create(TYPE, NAME, DBH, PRINCIPAL, HOSTNAME [, DATETIME]) - -This will override the Wallet::Object::Duo class with the information -needed to create a specific integration type in Duo. It creates a new -object with the given TYPE and NAME (TYPE is normally C<duo-pam> 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 Duo integration object is created, a new integration will be -created in the configured Duo account and the integration key will be -stored in the wallet object. If the integration already exists, create() -will fail. - -If create() fails, it throws an exception. - -=item get(PRINCIPAL, HOSTNAME [, DATETIME]) - -Retrieves the configuration information for the Duo integration and -returns that information in the format expected by the configuration file -for the Duo UNIX integration. Returns undef on failure. The caller -should call error() to get the error message if get() returns undef. - -The returned configuration look look like: - - Integration key: <integration-key> - Secret key: <secret-key> - Host: <api-hostname> - -The C<host> parameter will be taken from the configuration file pointed -to by the DUO_KEY_FILE configuration variable. - -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 - -=head1 LIMITATIONS - -Only one Duo account is supported for a given wallet implementation. - -=head1 SEE ALSO - -Net::Duo(3), Wallet::Config(3), Wallet::Object::Duo(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 <eagle@eyrie.org> -Jon Robertson <eagle@eyrie.org> - -=cut diff --git a/perl/lib/Wallet/Object/Duo/RadiusProxy.pm b/perl/lib/Wallet/Object/Duo/RadiusProxy.pm deleted file mode 100644 index faa0c2f..0000000 --- a/perl/lib/Wallet/Object/Duo/RadiusProxy.pm +++ /dev/null @@ -1,204 +0,0 @@ -# Wallet::Object::Duo::RadiusProxy -- Duo auth proxy integration for radius -# -# Written by Jon Robertson <jonrober@stanford.edu> -# Copyright 2014 -# The Board of Trustees of the Leland Stanford Junior University -# -# See LICENSE for licensing terms. - -############################################################################## -# Modules and declarations -############################################################################## - -package Wallet::Object::Duo::RadiusProxy; -require 5.006; - -use strict; -use warnings; -use vars qw(@ISA $VERSION); - -use JSON; -use Net::Duo::Admin; -use Net::Duo::Admin::Integration; -use Perl6::Slurp qw(slurp); -use Wallet::Config (); -use Wallet::Object::Duo; - -@ISA = qw(Wallet::Object::Duo); - -# 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'; - -############################################################################## -# Core methods -############################################################################## - -# Override create to provide the specific Duo integration type that will be -# used in the remote Duo record. -sub create { - my ($class, $type, $name, $schema, $creator, $host, $time) = @_; - - $time ||= time; - my $self = $class->SUPER::create ($type, $name, $schema, $creator, $host, - $time, 'radius'); - return $self; -} - -# Override get to output the data in a specific format used for Duo radius -# integration -sub get { - my ($self, $user, $host, $time) = @_; - $time ||= time; - - # Check that the object isn't locked. - my $id = $self->{type} . ':' . $self->{name}; - if ($self->flag_check ('locked')) { - $self->error ("cannot get $id: object is locked"); - return; - } - - # Retrieve the integration from Duo. - my $key; - eval { - my %search = (du_name => $self->{name}); - my $row = $self->{schema}->resultset ('Duo')->find (\%search); - $key = $row->get_column ('du_key'); - }; - if ($@) { - $self->error ($@); - return; - } - my $integration = Net::Duo::Admin::Integration->new ($self->{duo}, $key); - - # We also need the admin server name, which we can get from the Duo object - # configuration with a bit of JSON decoding. - my $json = JSON->new->utf8 (1)->relaxed (1); - my $config = $json->decode (scalar slurp $Wallet::Config::DUO_KEY_FILE); - - # Construct the returned file. - my $output = "[radius_server_challenge]\n"; - $output .= "ikey = $key\n"; - $output .= 'skey = ' . $integration->secret_key . "\n"; - $output .= "api_host = $config->{api_hostname}\n"; - $output .= "client = radius_client\n"; - - # Log the action and return. - $self->log_action ('get', $user, $host, $time); - return $output; -} - -1; -__END__ - -############################################################################## -# Documentation -############################################################################## - -=for stopwords -Allbery Duo integration DBH keytab auth - -=head1 NAME - -Wallet::Object::Duo::RadiusProxy -- Duo auth proxy integration for RADIUS - -=head1 SYNOPSIS - - my @name = qw(duo-radius host.example.com); - my @trace = ($user, $host, time); - my $object = Wallet::Object::Duo::RadiusProxy->create (@name, $schema, @trace); - my $config = $object->get (@trace); - $object->destroy (@trace); - -=head1 DESCRIPTION - -Wallet::Object::Duo::RadiusProxy is a representation of Duo -integrations with the wallet, specifically to output Duo integrations -in a format that can easily be pulled into configuring the Duo -Authentication Proxy for Radius. It implements the wallet object API -and provides the necessary glue to create a Duo integration, return a -configuration file containing the key and API information for that -integration, and delete the integration from Duo when the wallet object -is destroyed. - -The integration information is always returned in the configuration file -format expected by the Authentication Proxy for Duo in configuring it -for Radius. - -This object can be retrieved repeatedly without changing the secret key, -matching Duo's native behavior with integrations. To change the keys of -the integration, delete it and recreate it. - -To use this object, at least one configuration parameter must be set. See -L<Wallet::Config> for details on supported configuration parameters and -information about how to set wallet configuration. - -=head1 METHODS - -This object mostly inherits from Wallet::Object::Duo. See the -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 create(TYPE, NAME, DBH, PRINCIPAL, HOSTNAME [, DATETIME]) - -This will override the Wallet::Object::Duo class with the information -needed to create a specific integration type in Duo. It creates a new -object with the given TYPE and NAME (TYPE is normally C<duo-radius> 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 Duo integration object is created, a new integration will be -created in the configured Duo account and the integration key will be -stored in the wallet object. If the integration already exists, create() -will fail. - -If create() fails, it throws an exception. - -=item get(PRINCIPAL, HOSTNAME [, DATETIME]) - -Retrieves the configuration information for the Duo integration and -returns that information in the format expected by the configuration file -for the Duo UNIX integration. Returns undef on failure. The caller -should call error() to get the error message if get() returns undef. - -The returned configuration look look like: - - [radius_server_challenge] - ikey = <integration-key> - skey = <secret-key> - api_host = <api-hostname> - client = radius_client - -The C<host> parameter will be taken from the configuration file pointed -to by the DUO_KEY_FILE configuration variable. - -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 - -=head1 LIMITATIONS - -Only one Duo account is supported for a given wallet implementation. - -=head1 SEE ALSO - -Net::Duo(3), Wallet::Config(3), Wallet::Object::Duo(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> - -=cut diff --git a/perl/lib/Wallet/Object/File.pm b/perl/lib/Wallet/Object/File.pm index 226e32c..9452ff4 100644 --- a/perl/lib/Wallet/Object/File.pm +++ b/perl/lib/Wallet/Object/File.pm @@ -1,6 +1,7 @@ -# Wallet::Object::File -- File object implementation for the wallet. +# Wallet::Object::File -- File object implementation for the wallet # # Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2016 Russ Allbery <eagle@eyrie.org> # Copyright 2008, 2010, 2014 # The Board of Trustees of the Leland Stanford Junior University # @@ -11,23 +12,18 @@ ############################################################################## package Wallet::Object::File; -require 5.006; +use 5.006; use strict; use warnings; -use vars qw(@ISA $VERSION); use Digest::MD5 qw(md5_hex); use File::Copy qw(move); -use Wallet::Config (); +use Wallet::Config; use Wallet::Object::Base; -@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.03'; +our @ISA = qw(Wallet::Object::Base); +our $VERSION = '1.03'; ############################################################################## # File naming diff --git a/perl/lib/Wallet/Object/Keytab.pm b/perl/lib/Wallet/Object/Keytab.pm index 975179b..f276b3f 100644 --- a/perl/lib/Wallet/Object/Keytab.pm +++ b/perl/lib/Wallet/Object/Keytab.pm @@ -1,6 +1,7 @@ -# Wallet::Object::Keytab -- Keytab object implementation for the wallet. +# Wallet::Object::Keytab -- Keytab object implementation for the wallet # # Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2016 Russ Allbery <eagle@eyrie.org> # Copyright 2007, 2008, 2009, 2010, 2013, 2014 # The Board of Trustees of the Leland Stanford Junior University # @@ -11,22 +12,48 @@ ############################################################################## package Wallet::Object::Keytab; -require 5.006; +use 5.008; use strict; use warnings; -use vars qw(@ISA $VERSION); -use Wallet::Config (); -use Wallet::Object::Base; +use Wallet::Config; use Wallet::Kadmin; +use Wallet::Object::Base; -@ISA = qw(Wallet::Object::Base); +our @ISA = qw(Wallet::Object::Base); +our $VERSION = '1.03'; -# 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.09'; +############################################################################## +# Shared methods +############################################################################## + +# Generate a keytab into a temporary file and then return that as the return +# value. Used by both get and update, as the only difference is how we +# handle the unchanging flag. +sub retrieve { + my ($self, $operation, $user, $host, $time) = @_; + $time ||= time; + my $id = $self->{type} . ':' . $self->{name}; + if ($self->flag_check ('locked')) { + $self->error ("cannot get $id: object is locked"); + return; + } + my $kadmin = $self->{kadmin}; + my $result; + if ($operation eq 'get' && $self->flag_check ('unchanging')) { + $result = $kadmin->keytab ($self->{name}); + } else { + my @enctypes = $self->attr ('enctypes'); + $result = $kadmin->keytab_rekey ($self->{name}, @enctypes); + } + if (defined $result) { + $self->log_action ($operation, $user, $host, $time); + } else { + $self->error ($kadmin->error); + } + return $result; +} ############################################################################## # Enctype restriction @@ -314,25 +341,15 @@ sub destroy { # return that as the return value. sub get { my ($self, $user, $host, $time) = @_; - $time ||= time; - my $id = $self->{type} . ':' . $self->{name}; - if ($self->flag_check ('locked')) { - $self->error ("cannot get $id: object is locked"); - return; - } - my $kadmin = $self->{kadmin}; - my $result; - if ($self->flag_check ('unchanging')) { - $result = $kadmin->keytab ($self->{name}); - } else { - my @enctypes = $self->attr ('enctypes'); - $result = $kadmin->keytab_rekey ($self->{name}, @enctypes); - } - if (defined $result) { - $self->log_action ('get', $user, $host, $time); - } else { - $self->error ($kadmin->error); - } + my $result = $self->retrieve ('get', $user, $host, $time); + return $result; +} + +# Our update implementation. Generate a new keytab regardless of the +# unchanging flag. +sub update { + my ($self, $user, $host, $time) = @_; + my $result = $self->retrieve ('update', $user, $host, $time); return $result; } diff --git a/perl/lib/Wallet/Object/Password.pm b/perl/lib/Wallet/Object/Password.pm new file mode 100644 index 0000000..1db53f3 --- /dev/null +++ b/perl/lib/Wallet/Object/Password.pm @@ -0,0 +1,224 @@ +# Wallet::Object::Password -- Password object implementation for the wallet +# +# Written by Jon Robertson <jonrober@stanford.edu> +# Copyright 2016 Russ Allbery <eagle@eyrie.org> +# Copyright 2015 +# The Board of Trustees of the Leland Stanford Junior University +# +# See LICENSE for licensing terms. + +############################################################################## +# Modules and declarations +############################################################################## + +package Wallet::Object::Password; + +use 5.008; +use strict; +use warnings; + +use Crypt::GeneratePassword qw(chars); +use Digest::MD5 qw(md5_hex); +use Wallet::Config; +use Wallet::Object::File; + +our @ISA = qw(Wallet::Object::File); +our $VERSION = '1.03'; + +############################################################################## +# File naming +############################################################################## + +# Returns the path into which that password object will be stored or undef on +# error. On error, sets the internal error. +sub file_path { + my ($self) = @_; + my $name = $self->{name}; + unless ($Wallet::Config::PWD_FILE_BUCKET) { + $self->error ('password support not configured'); + return; + } + unless ($name) { + $self->error ('password objects may not have empty names'); + return; + } + my $hash = substr (md5_hex ($name), 0, 2); + $name =~ s/([^\w-])/sprintf ('%%%02X', ord ($1))/ge; + my $parent = "$Wallet::Config::PWD_FILE_BUCKET/$hash"; + unless (-d $parent || mkdir ($parent, 0700)) { + $self->error ("cannot create password bucket $hash: $!"); + return; + } + return "$Wallet::Config::PWD_FILE_BUCKET/$hash/$name"; +} + +############################################################################## +# Shared methods +############################################################################## + +# Return the contents of the file. +sub retrieve { + my ($self, $operation, $user, $host, $time) = @_; + $time ||= time; + my $id = $self->{type} . ':' . $self->{name}; + if ($self->flag_check ('locked')) { + $self->error ("cannot get $id: object is locked"); + return; + } + my $path = $self->file_path; + return unless $path; + + # If nothing is yet stored, or we have requested an update, generate a + # random password and save it to the file. + my $schema = $self->{schema}; + my %search = (ob_type => $self->{type}, + ob_name => $self->{name}); + my $object = $schema->resultset('Object')->find (\%search); + if (!$object->ob_stored_on || $operation eq 'update') { + unless (open (FILE, '>', $path)) { + $self->error ("cannot store initial settings for $id: $!\n"); + return; + } + my $pass = chars ($Wallet::Config::PWD_LENGTH_MIN, + $Wallet::Config::PWD_LENGTH_MAX); + print FILE $pass; + $self->log_action ('store', $user, $host, $time); + unless (close FILE) { + $self->error ("cannot get $id: $!"); + return; + } + } + + unless (open (FILE, '<', $path)) { + $self->error ("cannot get $id: object has not been stored"); + return; + } + local $/; + my $data = <FILE>; + unless (close FILE) { + $self->error ("cannot get $id: $!"); + return; + } + $self->log_action ($operation, $user, $host, $time); + return $data; +} + +############################################################################## +# Core methods +############################################################################## + +# Return the contents of the file. +sub get { + my ($self, $user, $host, $time) = @_; + my $result = $self->retrieve ('get', $user, $host, $time); + return $result; +} + +# Return the contents of the file after resetting them to a random string. +sub update { + my ($self, $user, $host, $time) = @_; + my $result = $self->retrieve ('update', $user, $host, $time); + return $result; +} + +1; +__END__ + +############################################################################## +# Documentation +############################################################################## + +=head1 NAME + +Wallet::Object::Password - Password object implementation for wallet + +=for stopwords +API HOSTNAME DATETIME keytab remctld backend nul Allbery wallet-backend + +=head1 SYNOPSIS + + my @name = qw(file mysql-lsdb) + my @trace = ($user, $host, time); + my $object = Wallet::Object::Password->create (@name, $schema, @trace); + unless ($object->store ("the-password\n")) { + die $object->error, "\n"; + } + my $password = $object->get (@trace); + $object->destroy (@trace); + +=head1 DESCRIPTION + +Wallet::Object::Password is an extension of Wallet::Object::File, +acting as a representation of simple file objects in the wallet. The +difference between the two is that if there is no data stored in a +password object when a user tries to get it for the first time, then a +random string suited for a password will be generated and put into the +object data. + +It implements the wallet object API and provides the necessary +glue to store a file on the wallet server, retrieve it later, and delete +it when the password object is deleted. + +To use this object, the configuration option specifying where on the +wallet server to store password objects must be set. See +L<Wallet::Config> for details on this configuration parameter and +information about how to set wallet configuration. + +=head1 METHODS + +This object mostly inherits from Wallet::Object::File. See the +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 get(PRINCIPAL, HOSTNAME [, DATETIME]) + +Retrieves the current contents of the file object or undef on error. +store() must be called before get() will be successful. The caller should +call error() to get the error message if get() returns undef. 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 + +=head1 FILES + +=over 4 + +=item PWD_FILE_BUCKET/<hash>/<file> + +Password files are stored on the wallet server under the directory +PWD_FILE_BUCKET as set in the wallet configuration. <hash> is the +first two characters of the hex-encoded MD5 hash of the wallet password +object name, used to not put too many files in the same directory. +<file> is the name of the password object with all characters other +than alphanumerics, underscores, and dashes replaced by C<%> and the +hex code of the character. + +=back + +=head1 LIMITATIONS + +The wallet implementation itself can handle arbitrary password object +names. However, due to limitations in the B<remctld> server usually +used to run B<wallet-backend>, password 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 +password object name. + +=head1 SEE ALSO + +remctld(8), Wallet::Config(3), Wallet::Object::File(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 AUTHOR + +Jon Robertson <jonrober@stanford.edu> + +=cut diff --git a/perl/lib/Wallet/Object/WAKeyring.pm b/perl/lib/Wallet/Object/WAKeyring.pm index 3e80300..3c99785 100644 --- a/perl/lib/Wallet/Object/WAKeyring.pm +++ b/perl/lib/Wallet/Object/WAKeyring.pm @@ -1,6 +1,7 @@ -# Wallet::Object::WAKeyring -- WebAuth keyring object implementation. +# Wallet::Object::WAKeyring -- WebAuth keyring object implementation # # Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2016 Russ Allbery <eagle@eyrie.org> # Copyright 2012, 2013, 2014 # The Board of Trustees of the Leland Stanford Junior University # @@ -11,24 +12,19 @@ ############################################################################## package Wallet::Object::WAKeyring; -require 5.006; +use 5.008; use strict; use warnings; -use vars qw(@ISA $VERSION); use Digest::MD5 qw(md5_hex); use Fcntl qw(LOCK_EX); -use Wallet::Config (); +use Wallet::Config; use Wallet::Object::Base; use WebAuth 3.06 qw(WA_KEY_AES WA_AES_128); -@ISA = qw(Wallet::Object::Base); - -# This version should be increased on any code change to this module. Always -# use two digits for the minor version with a leading zero if necessary so -# that it will sort properly. -$VERSION = '0.01'; +our @ISA = qw(Wallet::Object::Base); +our $VERSION = '1.03'; ############################################################################## # File naming diff --git a/perl/lib/Wallet/Policy/Stanford.pm b/perl/lib/Wallet/Policy/Stanford.pm index a392476..efb9d28 100644 --- a/perl/lib/Wallet/Policy/Stanford.pm +++ b/perl/lib/Wallet/Policy/Stanford.pm @@ -1,7 +1,8 @@ -# Wallet::Policy::Stanford -- Stanford's wallet naming and ownership policy. +# Wallet::Policy::Stanford -- Stanford's wallet naming and ownership policy # # Written by Russ Allbery <eagle@eyrie.org> -# Copyright 2013 +# Copyright 2016 Russ Allbery <eagle@eyrie.org> +# Copyright 2013, 2014, 2015 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -25,8 +26,8 @@ our (@EXPORT_OK, $VERSION); # against circular module loading (not that we load any modules, but # consistency is good). BEGIN { - $VERSION = '1.00'; - @EXPORT_OK = qw(default_owner verify_name); + $VERSION = '1.03'; + @EXPORT_OK = qw(default_owner verify_name is_for_host); } ############################################################################## @@ -66,8 +67,9 @@ our %FILE_TYPE = ( 'password-root' => { host => 1 }, 'password-tivoli' => { host => 1 }, properties => { extra => 1 }, - 'ssh-dsa' => { host => 1 }, - 'ssh-rsa' => { host => 1 }, + 'ssh-dsa' => { host => 1, extra => 1 }, + 'ssh-rsa' => { host => 1, extra => 1 }, + 'ssl-chain' => { host => 1, extra => 1 }, 'ssl-key' => { host => 1, extra => 1 }, 'ssl-keypair' => { host => 1, extra => 1 }, 'ssl-keystore' => { extra => 1 }, @@ -75,6 +77,29 @@ our %FILE_TYPE = ( 'tivoli-key' => { host => 1 }, ); +# Password object types. Most of these mimic file object types (which should +# be gradually phased out). +our %PASSWORD_TYPE = ( + 'ipmi' => { host => 1 }, + 'root' => { host => 1 }, + 'tivoli' => { host => 1 }, + 'system' => { host => 1, extra => 1, need_extra => 1 }, + 'app' => { host => 1, extra => 1, need_extra => 1 }, + 'service' => { extra => 1, need_extra => 1 }, +); + +# Mappings that let us determine the host for a host-based object, if any. +our %HOST_FOR = ( + 'keytab' => \&_host_for_keytab, + 'file' => \&_host_for_file, + 'password' => \&_host_for_password, + 'duo' => \&_host_for_duo, + 'duo-pam' => \&_host_for_duo, + 'duo-radius' => \&_host_for_duo, + 'duo-ldap' => \&_host_for_duo, + 'duo-rdp' => \&_host_for_duo, +); + # Host-based file object types for the legacy file object naming scheme. our @FILE_HOST_LEGACY = qw(htpasswd ssh-rsa ssh-dsa ssl-key tivoli-key); @@ -144,6 +169,17 @@ sub _host_for_file_legacy { return $host; } +# Map a password object name to a hostname. Returns undef if this password +# object name doesn't map to a hostname. +sub _host_for_password { + my ($name) = @_; + + # Parse the name and check whether this is a host-based object. + my ($type, $host) = split('/', $name); + return if !$PASSWORD_TYPE{$type}{host}; + return $host; +} + # Map a file object name to a hostname. Returns undef if this file object # name doesn't map to a hostname. sub _host_for_file { @@ -181,6 +217,23 @@ sub _host_for_duo { return $name; } +# Take a object type and name, along with a host name, and use these to +# decide if the given object is host-based and matches the given host. +sub is_for_host { + my ($type, $name, $host) = @_; + + # If we have a possible host mapping, get the host and see if it matches. + if (defined($HOST_FOR{$type})) { + my $object_host = $HOST_FOR{$type}->($name); + return 0 unless $object_host; + if ($host eq $object_host) { + return 1; + } + } + + return 0; +} + # The default owner of host-based objects should be the host keytab and the # NetDB ACL for that host, with one twist. If the creator of a new node is # using a root instance, we want to require everyone managing that node be @@ -188,20 +241,9 @@ sub _host_for_duo { sub default_owner { my ($type, $name) = @_; - # How to determine the host for host-based objects. - my %host_for = ( - 'keytab' => \&_host_for_keytab, - 'file' => \&_host_for_file, - 'duo' => \&_host_for_duo, - 'duo-pam' => \&_host_for_duo, - 'duo-radius' => \&_host_for_duo, - 'duo-ldap' => \&_host_for_duo, - 'duo-rdp' => \&_host_for_duo, - ); - # If we have a possible host mapping, see if we can use that. - if (defined($host_for{$type})) { - my $host = $host_for{$type}->($name); + if (defined($HOST_FOR{$type})) { + my $host = $HOST_FOR{$type}->($name); if ($host) { my $acl_name = "host/$host"; my @acl; @@ -242,7 +284,7 @@ sub default_owner { # hostnames, limit the acceptable characters for service/* keytabs, and # enforce our naming constraints on */cgi principals. # -# Also use this function to require that IDG staff always do implicit object +# Also use this function to require that ACS staff always do implicit object # creation using a */root instance. sub verify_name { my ($type, $name, $user) = @_; @@ -363,6 +405,8 @@ sub verify_name { return "missing component in $name"; } return; + + } else { # Legacy naming scheme. my %groups = map { $_ => 1 } @GROUPS_LEGACY; @@ -380,6 +424,71 @@ sub verify_name { } } + # Check password object naming conventions. + if ($type eq 'password') { + if ($name =~ m{ / }xms) { + my @name = split('/', $name); + + # Names have between two and four components and all must be + # non-empty. + if (@name > 4) { + return "too many components in $name"; + } + if (@name < 2) { + return "too few components in $name"; + } + if (grep { $_ eq q{} } @name) { + return "empty component in $name"; + } + + # All objects start with the type. First check if this is a + # host-based type. + my $type = shift @name; + if ($PASSWORD_TYPE{$type} && $PASSWORD_TYPE{$type}{host}) { + my ($host, $extra) = @name; + if ($host !~ m{ [.] }xms) { + return "host name $host is not fully qualified"; + } + if (defined($extra) && !$PASSWORD_TYPE{$type}{extra}) { + return "extraneous component at end of $name"; + } + if (!defined($extra) && $PASSWORD_TYPE{$type}{need_extra}) { + return "missing component in $name"; + } + return; + } + + # Otherwise, the name is group-based. There be at least two + # remaining components. + if (@name < 2) { + return "too few components in $name"; + } + my ($group, $service, $extra) = @name; + + # Check the group. + if (!$ACL_FOR_GROUP{$group}) { + return "unknown group $group"; + } + + # Check the type. Be sure it's not host-based. + if (!$PASSWORD_TYPE{$type}) { + return "unknown type $type"; + } + if ($PASSWORD_TYPE{$type}{host}) { + return "bad name for host-based file type $type"; + } + + # Check the extra data. + if (defined($extra) && !$PASSWORD_TYPE{$type}{extra}) { + return "extraneous component at end of $name"; + } + if (!defined($extra) && $PASSWORD_TYPE{$type}{need_extra}) { + return "missing component in $name"; + } + return; + } + } + # Check the naming conventions for all Duo object types. The object # should simply be the host name for now. if ($type =~ m{^duo(-\w+)?$}) { diff --git a/perl/lib/Wallet/Report.pm b/perl/lib/Wallet/Report.pm index bf48308..3d59bf8 100644 --- a/perl/lib/Wallet/Report.pm +++ b/perl/lib/Wallet/Report.pm @@ -1,6 +1,7 @@ -# Wallet::Report -- Wallet system reporting interface. +# Wallet::Report -- Wallet system reporting interface # # Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2016 Russ Allbery <eagle@eyrie.org> # Copyright 2008, 2009, 2010, 2013, 2014 # The Board of Trustees of the Leland Stanford Junior University # @@ -11,19 +12,15 @@ ############################################################################## package Wallet::Report; -require 5.006; +use 5.008; use strict; use warnings; -use vars qw($VERSION); use Wallet::ACL; 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.04'; +our $VERSION = '1.03'; ############################################################################## # Constructor, destructor, and accessors @@ -175,6 +172,20 @@ sub objects_unused { return (\%search, \%options); } +# Return the SQL statement to find all fiel objects that have been created +# but have never had information stored (via store). +sub objects_unstored { + my ($self) = @_; + my @objects; + + my %search = (ob_stored_on => undef, + ob_type => 'file'); + my %options = (order_by => [ qw/ob_type ob_name/ ], + select => [ qw/ob_type ob_name/ ]); + + return (\%search, \%options); +} + # Returns a list of all objects stored in the wallet database in the form of # 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 @@ -190,7 +201,7 @@ sub objects { if (!defined $type || $type eq '') { ($search_ref, $options_ref) = $self->objects_all; } else { - if ($type ne 'unused' && @args != 1) { + if ($type ne 'unused' && $type ne 'unstored' && @args != 1) { $self->error ("object searches require one argument to search"); } elsif ($type eq 'type') { ($search_ref, $options_ref) = $self->objects_type (@args); @@ -202,6 +213,8 @@ sub objects { ($search_ref, $options_ref) = $self->objects_acl (@args); } elsif ($type eq 'unused') { ($search_ref, $options_ref) = $self->objects_unused (@args); + } elsif ($type eq 'unstored') { + ($search_ref, $options_ref) = $self->objects_unstored (@args); } else { $self->error ("do not know search type: $type"); } @@ -226,12 +239,124 @@ sub objects { return @objects; } +# Returns a list of all object_history records stored in the wallet database +# including all of their fields. 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_history { + my ($self, $search_type, @args) = @_; + undef $self->{error}; + + # All fields in the order we want to see them. + my @fields = ('oh_on', 'oh_by', 'oh_type', 'oh_name', 'oh_action', + 'oh_from'); + + # Get the search and options array refs from specific functions. + my %search = (); + my %options = (order_by => \@fields, + select => \@fields); + + # Perform the search and return on any errors. + my @objects; + my $schema = $self->{schema}; + eval { + my @objects_rs + = $schema->resultset('ObjectHistory')->search (\%search, + \%options); + for my $object_rs (@objects_rs) { + my @rec; + for my $field (@fields) { + push (@rec, $object_rs->get_column($field)); + } + push (@objects, \@rec); + } + }; + if ($@) { + $self->error ("cannot list objects: $@"); + return; + } + + return @objects; +} + +# 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_hostname { + my ($self, $type, $hostname) = @_; + undef $self->{error}; + + # Make sure we have a given hostname. + if (!$hostname) { + $self->error ("object hosts requires one argument to search"); + return; + } + + # If we don't have a way to get host-based object lists, quit. + unless (defined &Wallet::Config::is_for_host) { + $self->error ('no host-based policy defined'); + return; + } + + # Search on all objects. + my %search = (); + my %options = (order_by => [ qw/ob_type ob_name/ ], + select => [ qw/ob_type ob_name/ ]); + + my @objects; + my $schema = $self->{schema}; + eval { + my @objects_rs = $schema->resultset('Object')->search (\%search, + \%options); + + # Check to see if an object is for the given host and add to list if + # so. + for my $object_rs (@objects_rs) { + my $type = $object_rs->ob_type; + my $name = $object_rs->ob_name; + next unless &Wallet::Config::is_for_host($type, $name, $hostname); + push (@objects, [ $type, $name ]); + } + }; + if ($@) { + $self->error ("cannot list objects: $@"); + return; + } + + return @objects; +} + +############################################################################## +# Type reports +############################################################################## + +# Return an alphabetical list of all valid types set up, along with the class +# that they belong to. +sub types { + my ($self) = @_; + + my (@types); + my @types_rs = $self->{schema}->resultset('Type')->all; + for my $type_rs (@types_rs) { + my $name = $type_rs->ty_name; + my $class = $type_rs->ty_class; + push(@types, [ $name, $class ]); + } + + @types = sort { $a->[0] cmp $b->[0] } @types; + return @types; +} + ############################################################################## # ACL reports ############################################################################## -# Returns the SQL statement required to find and return all ACLs in the -# database. +# Returns the array of all ACLs in the database. sub acls_all { my ($self) = @_; my @acls; @@ -255,7 +380,7 @@ sub acls_all { return (@acls); } -# Returns the SQL statement required to find all empty ACLs in the database. +# Returns the array of all empty ACLs in the database. sub acls_empty { my ($self) = @_; my @acls; @@ -281,9 +406,36 @@ sub acls_empty { return (@acls); } -# 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. +# Returns the array of ACLs that nest a given ACL. +sub acls_nesting { + my ($self, $name) = @_; + my @acls; + + my $schema = $self->{schema}; + my %search = (ae_scheme => 'nested', + ae_identifier => $name); + my %options = (join => 'acl_entries', + prefetch => 'acl_entries', + order_by => [ qw/ac_id/ ], + select => [ qw/ac_id ac_name/ ]); + + eval { + my @acls_rs = $schema->resultset('Acl')->search (\%search, \%options); + for my $acl_rs (@acls_rs) { + push (@acls, [ $acl_rs->ac_id, $acl_rs->ac_name ]); + } + }; + + if ($@) { + $self->error ("cannot list ACLs: $@"); + return; + } + return (@acls); +} + +# Returns the array of all ACLs containing the specified entry. The given +# identifier is automatically surrounded by wildcards to do a substring +# search. sub acls_entry { my ($self, $type, $identifier) = @_; my @acls; @@ -311,7 +463,7 @@ sub acls_entry { return (@acls); } -# Returns the SQL statement required to find unused ACLs. +# Returns the array of all unused ACLs. sub acls_unused { my ($self) = @_; my @acls; @@ -424,6 +576,13 @@ sub acls { @acls = $self->acls_empty; } elsif ($type eq 'unused') { @acls = $self->acls_unused; + } elsif ($type eq 'nesting') { + if (@args == 0) { + $self->error ('ACL nesting search requires an ACL to search'); + return; + } else { + @acls = $self->acls_nesting (@args); + } } else { $self->error ("unknown search type: $type"); return; @@ -469,6 +628,23 @@ sub owners { return @owners; } +# Return an alphabetical list of all valid types set up, along with the class +# that they belong to. +sub acl_schemes { + my ($self) = @_; + + my (@schemes); + my @acls_rs = $self->{schema}->resultset('AclScheme')->all; + for my $acl_rs (@acls_rs) { + my $name = $acl_rs->as_name; + my $class = $acl_rs->as_class; + push(@schemes, [ $name, $class ]); + } + + @schemes = sort { $a->[0] cmp $b->[0] } @schemes; + return @schemes; +} + ############################################################################## # Auditing ############################################################################## @@ -633,14 +809,17 @@ 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 five 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. C<unused> will -return all entries for which a get command has never been issued. +There are several types of searches. 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. +C<unused> will return all entries for which a get command has never +been issued. C<unstored> will return all entries for which a store +command has never been issued (limited to file type since storing isn't +needed for other types). 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> @@ -654,6 +833,24 @@ 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 objects_history(TYPE) + +Returns a dump of the entire object history table. The return value is +a list of references to each field in that table, in the following order: + + oh_on, oh_by, oh_type, oh_name, oh_action, oh_from + +=item objects_hostname(TYPE, HOSTNAME) + +Returns a list of all host-based objects for a given hostname. The +output is identical to the general objects command, but we need to +separate this out because the way it searches is very different. + +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 diff --git a/perl/lib/Wallet/Schema.pm b/perl/lib/Wallet/Schema.pm index 5b850c0..6b3de39 100644 --- a/perl/lib/Wallet/Schema.pm +++ b/perl/lib/Wallet/Schema.pm @@ -1,6 +1,7 @@ -# Database schema and connector for the wallet system. +# Wallet::Schema -- Database schema and connector for the wallet system # # Written by Jon Robertson <jonrober@stanford.edu> +# Copyright 2016 Russ Allbery <eagle@eyrie.org> # Copyright 2012, 2013, 2014 # The Board of Trustees of the Leland Stanford Junior University # @@ -8,6 +9,7 @@ package Wallet::Schema; +use 5.008; use strict; use warnings; @@ -15,9 +17,9 @@ use Wallet::Config; use base 'DBIx::Class::Schema'; -# This version should be increased on any code change to this module. Always -# use two digits for the minor version with a leading zero if necessary so -# that it will sort properly. +# Unlike all of the other wallet modules, this module's version is tied to the +# version of the schema in the database. It should only be changed on schema +# changes, at least until better handling of upgrades is available. our $VERSION = '0.10'; __PACKAGE__->load_namespaces; @@ -114,6 +116,10 @@ Holds the supported ACL schemes and their corresponding Perl classes: insert into acl_schemes (as_name, as_class) values ('ldap-attr', 'Wallet::ACL::LDAP::Attribute'); insert into acl_schemes (as_name, as_class) + values ('ldap-attr-root', 'Wallet::ACL::LDAP::Attribute::Root'); + insert into acl_schemes (as_name, as_class) + values ('nested', 'Wallet::ACL::Nested'); + insert into acl_schemes (as_name, as_class) values ('netdb', 'Wallet::ACL::NetDB'); insert into acl_schemes (as_name, as_class) values ('netdb-root', 'Wallet::ACL::NetDB::Root'); diff --git a/perl/lib/Wallet/Schema/Result/Acl.pm b/perl/lib/Wallet/Schema/Result/Acl.pm index 226738a..59a628a 100644 --- a/perl/lib/Wallet/Schema/Result/Acl.pm +++ b/perl/lib/Wallet/Schema/Result/Acl.pm @@ -13,6 +13,8 @@ use warnings; use base 'DBIx::Class::Core'; +our $VERSION = '1.03'; + =for stopwords ACL diff --git a/perl/lib/Wallet/Schema/Result/AclEntry.pm b/perl/lib/Wallet/Schema/Result/AclEntry.pm index a33a98c..ea531bd 100644 --- a/perl/lib/Wallet/Schema/Result/AclEntry.pm +++ b/perl/lib/Wallet/Schema/Result/AclEntry.pm @@ -13,6 +13,8 @@ use warnings; use base 'DBIx::Class::Core'; +our $VERSION = '1.03'; + =for stopwords ACL diff --git a/perl/lib/Wallet/Schema/Result/AclHistory.pm b/perl/lib/Wallet/Schema/Result/AclHistory.pm index 82e18a9..dc6bed7 100644 --- a/perl/lib/Wallet/Schema/Result/AclHistory.pm +++ b/perl/lib/Wallet/Schema/Result/AclHistory.pm @@ -13,6 +13,8 @@ use warnings; use base 'DBIx::Class::Core'; +our $VERSION = '1.03'; + __PACKAGE__->load_components("InflateColumn::DateTime"); =for stopwords diff --git a/perl/lib/Wallet/Schema/Result/AclScheme.pm b/perl/lib/Wallet/Schema/Result/AclScheme.pm index 91a58b2..004e5d2 100644 --- a/perl/lib/Wallet/Schema/Result/AclScheme.pm +++ b/perl/lib/Wallet/Schema/Result/AclScheme.pm @@ -12,6 +12,9 @@ use strict; use warnings; use base 'DBIx::Class::Core'; + +our $VERSION = '1.03'; + __PACKAGE__->load_components (qw//); =for stopwords @@ -36,6 +39,10 @@ By default it contains the following entries: insert into acl_schemes (as_name, as_class) values ('ldap-attr', 'Wallet::ACL::LDAP::Attribute'); insert into acl_schemes (as_name, as_class) + values ('ldap-attr-root', 'Wallet::ACL::LDAP::Attribute::Root'); + insert into acl_schemes (as_name, as_class) + values ('nested', 'Wallet::ACL::Nested'); + insert into acl_schemes (as_name, as_class) values ('netdb', 'Wallet::ACL::NetDB'); insert into acl_schemes (as_name, as_class) values ('netdb-root', 'Wallet::ACL::NetDB::Root'); diff --git a/perl/lib/Wallet/Schema/Result/Duo.pm b/perl/lib/Wallet/Schema/Result/Duo.pm index 6ad61e9..b5328bb 100644 --- a/perl/lib/Wallet/Schema/Result/Duo.pm +++ b/perl/lib/Wallet/Schema/Result/Duo.pm @@ -13,6 +13,8 @@ use warnings; use base 'DBIx::Class::Core'; +our $VERSION = '1.03'; + =for stopwords keytab enctype diff --git a/perl/lib/Wallet/Schema/Result/Enctype.pm b/perl/lib/Wallet/Schema/Result/Enctype.pm index 5733669..f1f42a9 100644 --- a/perl/lib/Wallet/Schema/Result/Enctype.pm +++ b/perl/lib/Wallet/Schema/Result/Enctype.pm @@ -13,6 +13,8 @@ use warnings; use base 'DBIx::Class::Core'; +our $VERSION = '1.03'; + =for stopwords Kerberos diff --git a/perl/lib/Wallet/Schema/Result/Flag.pm b/perl/lib/Wallet/Schema/Result/Flag.pm index e223ff8..84e3ee3 100644 --- a/perl/lib/Wallet/Schema/Result/Flag.pm +++ b/perl/lib/Wallet/Schema/Result/Flag.pm @@ -13,6 +13,8 @@ use warnings; use base 'DBIx::Class::Core'; +our $VERSION = '1.03'; + =head1 NAME Wallet::Schema::Result::Flag - Wallet schema for object flags diff --git a/perl/lib/Wallet/Schema/Result/KeytabEnctype.pm b/perl/lib/Wallet/Schema/Result/KeytabEnctype.pm index daea724..2a16af8 100644 --- a/perl/lib/Wallet/Schema/Result/KeytabEnctype.pm +++ b/perl/lib/Wallet/Schema/Result/KeytabEnctype.pm @@ -13,6 +13,8 @@ use warnings; use base 'DBIx::Class::Core'; +our $VERSION = '1.03'; + =for stopwords keytab enctype diff --git a/perl/lib/Wallet/Schema/Result/KeytabSync.pm b/perl/lib/Wallet/Schema/Result/KeytabSync.pm index ca84277..bd57310 100644 --- a/perl/lib/Wallet/Schema/Result/KeytabSync.pm +++ b/perl/lib/Wallet/Schema/Result/KeytabSync.pm @@ -13,6 +13,8 @@ use warnings; use base 'DBIx::Class::Core'; +our $VERSION = '1.03'; + =for stopwords keytab diff --git a/perl/lib/Wallet/Schema/Result/Object.pm b/perl/lib/Wallet/Schema/Result/Object.pm index fd64e1b..fdec3b8 100644 --- a/perl/lib/Wallet/Schema/Result/Object.pm +++ b/perl/lib/Wallet/Schema/Result/Object.pm @@ -13,6 +13,8 @@ use warnings; use base 'DBIx::Class::Core'; +our $VERSION = '1.03'; + __PACKAGE__->load_components("InflateColumn::DateTime"); =head1 NAME diff --git a/perl/lib/Wallet/Schema/Result/ObjectHistory.pm b/perl/lib/Wallet/Schema/Result/ObjectHistory.pm index 5e9c8bd..2fe687e 100644 --- a/perl/lib/Wallet/Schema/Result/ObjectHistory.pm +++ b/perl/lib/Wallet/Schema/Result/ObjectHistory.pm @@ -13,6 +13,8 @@ use warnings; use base 'DBIx::Class::Core'; +our $VERSION = '1.03'; + __PACKAGE__->load_components("InflateColumn::DateTime"); =head1 NAME diff --git a/perl/lib/Wallet/Schema/Result/SyncTarget.pm b/perl/lib/Wallet/Schema/Result/SyncTarget.pm index 4300a54..ab8ea47 100644 --- a/perl/lib/Wallet/Schema/Result/SyncTarget.pm +++ b/perl/lib/Wallet/Schema/Result/SyncTarget.pm @@ -13,6 +13,8 @@ use warnings; use base 'DBIx::Class::Core'; +our $VERSION = '1.03'; + =head1 NAME Wallet::Schema::Result::SyncTarget - Wallet schema for synchronization targets diff --git a/perl/lib/Wallet/Schema/Result/Type.pm b/perl/lib/Wallet/Schema/Result/Type.pm index 748a8a8..abc7017 100644 --- a/perl/lib/Wallet/Schema/Result/Type.pm +++ b/perl/lib/Wallet/Schema/Result/Type.pm @@ -13,6 +13,8 @@ use warnings; use base 'DBIx::Class::Core'; +our $VERSION = '1.03'; + =for stopwords APIs diff --git a/perl/lib/Wallet/Server.pm b/perl/lib/Wallet/Server.pm index f6ea342..552ba9d 100644 --- a/perl/lib/Wallet/Server.pm +++ b/perl/lib/Wallet/Server.pm @@ -1,6 +1,7 @@ -# Wallet::Server -- Wallet system server implementation. +# Wallet::Server -- Wallet system server implementation # # Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2016 Russ Allbery <eagle@eyrie.org> # Copyright 2007, 2008, 2010, 2011, 2013, 2014 # The Board of Trustees of the Leland Stanford Junior University # @@ -11,20 +12,16 @@ ############################################################################## package Wallet::Server; -require 5.006; +use 5.008; use strict; use warnings; -use vars qw(%MAPPING $VERSION); use Wallet::ACL; use Wallet::Config; 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.11'; +our $VERSION = '1.03'; ############################################################################## # Utility methods @@ -154,8 +151,8 @@ sub create_check { $self->error ($acl->error); return; } - @entries = sort { $$a[0] cmp $$b[0] && $$a[1] cmp $$b[1] } @entries; - @acl = sort { $$a[0] cmp $$b[0] && $$a[1] cmp $$b[1] } @acl; + @entries = sort { $$a[0] cmp $$b[0] || $$a[1] cmp $$b[1] } @entries; + @acl = sort { $$a[0] cmp $$b[0] || $$a[1] cmp $$b[1] } @acl; my $okay = 1; if (@entries != @acl) { $okay = 0; @@ -516,6 +513,21 @@ sub get { return $result; } +# Retrieve the information associated with an object, updating the current +# information if we are of a type that allows autogenerated information. +# Returns undef and sets the internal error if the retrieval fails or if the +# user isn't authorized. If the object doesn't exist, attempts dynamic +# creation of the object using the default ACL mappings (if any). +sub update { + my ($self, $type, $name) = @_; + my $object = $self->retrieve ($type, $name); + return unless defined $object; + return unless $self->acl_verify ($object, 'get'); + my $result = $object->update ($self->{user}, $self->{host}); + $self->error ($object->error) unless defined $result; + return $result; +} + # Store new data in an object, or returns undef and sets the internal error if # the object can't be found or if the user isn't authorized. Also don't # permit storing undef, although storing the empty string is fine. If the @@ -734,6 +746,36 @@ sub acl_rename { return 1; } +# Move all ACLs owned by one ACL to another, or return undef and set the +# internal error. +sub acl_replace { + my ($self, $old_id, $replace_id) = @_; + unless ($self->{admin}->check ($self->{user})) { + $self->acl_error ($old_id, 'replace'); + return; + } + my $acl = eval { Wallet::ACL->new ($old_id, $self->{schema}) }; + if ($@) { + $self->error ($@); + return; + } + if ($acl->name eq 'ADMIN') { + $self->error ('cannot replace the ADMIN ACL'); + return; + } + my $replace_acl = eval { Wallet::ACL->new ($replace_id, $self->{schema}) }; + if ($@) { + $self->error ($@); + return; + } + + unless ($acl->replace ($replace_id, $self->{user}, $self->{host})) { + $self->error ($acl->error); + return; + } + return 1; +} + # Destroy an ACL, deleting it out of the database. Returns true on success. # On failure, returns undef, setting the internal error. sub acl_destroy { @@ -942,6 +984,14 @@ 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_replace(OLD, NEW) + +Moves any object owned by the ACL identified by OLD to be instead owned by +NEW. This goes through all objects owned by OLD and individually changes +the owner, along with history updates. OLD and NEW may be either the name +or the numeric ID. To replace 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 diff --git a/perl/sql/Wallet-Schema-0.10-MySQL.sql b/perl/sql/Wallet-Schema-0.10-MySQL.sql index c0b7fcc..ba73062 100644 --- a/perl/sql/Wallet-Schema-0.10-MySQL.sql +++ b/perl/sql/Wallet-Schema-0.10-MySQL.sql @@ -2,6 +2,29 @@ -- Created by SQL::Translator::Producer::MySQL -- Created on Thu Oct 9 20:54:55 2014 -- +-- Copyright 2014 +-- The Board of Trustees of the Leland Stanford Junior University +-- +-- Permission is hereby granted, free of charge, to any person obtaining a +-- copy of this software and associated documentation files (the +-- "Software"), to deal in the Software without restriction, including +-- without limitation the rights to use, copy, modify, merge, publish, +-- distribute, sublicense, and/or sell copies of the Software, and to +-- permit persons to whom the Software is furnished to do so, subject to +-- the following conditions: +-- +-- The above copyright notice and this permission notice shall be included +-- in all copies or substantial portions of the Software. +-- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS +-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +-- IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY +-- CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, +-- TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE +-- SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +-- + SET foreign_key_checks=0; DROP TABLE IF EXISTS `acl_history`; diff --git a/perl/sql/Wallet-Schema-0.10-PostgreSQL.sql b/perl/sql/Wallet-Schema-0.10-PostgreSQL.sql index 3bcb0ae..d1658dd 100644 --- a/perl/sql/Wallet-Schema-0.10-PostgreSQL.sql +++ b/perl/sql/Wallet-Schema-0.10-PostgreSQL.sql @@ -2,6 +2,29 @@ -- Created by SQL::Translator::Producer::PostgreSQL -- Created on Thu Oct 9 20:54:56 2014 -- +-- Copyright 2014 +-- The Board of Trustees of the Leland Stanford Junior University +-- +-- Permission is hereby granted, free of charge, to any person obtaining a +-- copy of this software and associated documentation files (the +-- "Software"), to deal in the Software without restriction, including +-- without limitation the rights to use, copy, modify, merge, publish, +-- distribute, sublicense, and/or sell copies of the Software, and to +-- permit persons to whom the Software is furnished to do so, subject to +-- the following conditions: +-- +-- The above copyright notice and this permission notice shall be included +-- in all copies or substantial portions of the Software. +-- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS +-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +-- IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY +-- CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, +-- TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE +-- SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +-- + -- -- Table: acl_history. -- diff --git a/perl/sql/Wallet-Schema-0.10-SQLite.sql b/perl/sql/Wallet-Schema-0.10-SQLite.sql index 94a185c..c13bc29 100644 --- a/perl/sql/Wallet-Schema-0.10-SQLite.sql +++ b/perl/sql/Wallet-Schema-0.10-SQLite.sql @@ -1,6 +1,28 @@ -- -- Created by SQL::Translator::Producer::SQLite -- Created on Thu Oct 9 20:51:25 2014 +-- +-- Copyright 2014 +-- The Board of Trustees of the Leland Stanford Junior University +-- +-- Permission is hereby granted, free of charge, to any person obtaining a +-- copy of this software and associated documentation files (the +-- "Software"), to deal in the Software without restriction, including +-- without limitation the rights to use, copy, modify, merge, publish, +-- distribute, sublicense, and/or sell copies of the Software, and to +-- permit persons to whom the Software is furnished to do so, subject to +-- the following conditions: +-- +-- The above copyright notice and this permission notice shall be included +-- in all copies or substantial portions of the Software. +-- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS +-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +-- IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY +-- CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, +-- TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE +-- SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- BEGIN TRANSACTION; diff --git a/perl/sql/wallet-1.3-update-duo.sql b/perl/sql/wallet-1.3-update-duo.sql new file mode 100644 index 0000000..affadcd --- /dev/null +++ b/perl/sql/wallet-1.3-update-duo.sql @@ -0,0 +1,9 @@ +-- +-- Run on installing wallet 1.3 in order to update what the Duo types +-- point to for modules. +-- + +UPDATE types set ty_class='Wallet::Object::Duo' where ty_name='duo-ldap'; +UPDATE types set ty_class='Wallet::Object::Duo' where ty_name='duo-pam'; +UPDATE types set ty_class='Wallet::Object::Duo' where ty_name='duo-radius'; +UPDATE types set ty_class='Wallet::Object::Duo' where ty_name='duo-rdp'; diff --git a/perl/t/data/acl-command b/perl/t/data/acl-command new file mode 100755 index 0000000..b7c3066 --- /dev/null +++ b/perl/t/data/acl-command @@ -0,0 +1,47 @@ +#!/bin/sh +# +# An external ACL implementation. Checks that the first argument is +# eagle@eyrie.org, the second argument is "test", and then returns success, +# failure, or reports an error based on whether the second argument is +# success, failure, or error. +# +# Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2016 Russ Allbery <eagle@eyrie.org> +# +# See LICENSE for licensing terms. + +set -e + +# Check the initial principal argument. +if [ "$1" != 'eagle@eyrie.org' ]; then + echo 'incorrect principal' >&2 + exit 1 +fi + +# Check that the second and third arguments are file test (the test object). +if [ "$2" != 'file' ]; then + echo 'incorrect second argument' >&2 + exit 1 +fi +if [ "$3" != 'test' ]; then + echo 'incorrect third argument' >&2 + exit 1 +fi + +# Process the fourth argument. +case $4 in + 'test success') + exit 0 + ;; + 'test failure') + exit 1 + ;; + 'test error') + echo 'some error' >&2 + exit 1 + ;; + *) + echo 'unknown fourth argument' >&2 + exit 1 + ;; +esac diff --git a/perl/t/general/acl.t b/perl/t/general/acl.t index 1dd5c53..4de7493 100755 --- a/perl/t/general/acl.t +++ b/perl/t/general/acl.t @@ -12,11 +12,11 @@ use strict; use warnings; use POSIX qw(strftime); -use Test::More tests => 101; +use Test::More tests => 115; use Wallet::ACL; use Wallet::Admin; -use Wallet::Server; +use Wallet::Object::Base; use lib 't/lib'; use Util; @@ -46,7 +46,7 @@ $acl = eval { Wallet::ACL->create (3, $schema, @trace) }; ok (!defined ($acl), 'Creating with a numeric name'); is ($@, "ACL name may not be all numbers\n", ' with the right error message'); $acl = eval { Wallet::ACL->create ('test', $schema, @trace) }; -ok (!defined ($acl), 'Creating a duplicate object'); +ok (!defined ($acl), 'Creating a duplicate acl'); like ($@, qr/^cannot create ACL test: /, ' with the right error message'); $acl = eval { Wallet::ACL->new ('test2', $schema) }; ok (!defined ($acl), 'Searching for a non-existent ACL'); @@ -62,32 +62,6 @@ is ($@, '', ' with no exceptions'); ok ($acl->isa ('Wallet::ACL'), ' and the right class'); is ($acl->name, 'test', ' and the right name'); -# Test rename. -if ($acl->rename ('example', @trace)) { - ok (1, 'Renaming the ACL'); -} else { - is ($acl->error, '', 'Renaming the ACL'); -} -is ($acl->name, 'example', ' and the new name is right'); -is ($acl->id, 2, ' and the ID did not change'); -$acl = eval { Wallet::ACL->new ('test', $schema) }; -ok (!defined ($acl), ' and it cannot be found under the old name'); -is ($@, "ACL test not found\n", ' with the right error message'); -$acl = eval { Wallet::ACL->new ('example', $schema) }; -ok (defined ($acl), ' and it can be found with the new name'); -is ($@, '', ' with no exceptions'); -is ($acl->name, 'example', ' and the right name'); -is ($acl->id, 2, ' and the right ID'); -$acl = eval { Wallet::ACL->new (2, $schema) }; -ok (defined ($acl), ' and it can still found by ID'); -is ($@, '', ' with no exceptions'); -is ($acl->name, 'example', ' and the right name'); -is ($acl->id, 2, ' and the right ID'); -ok (! $acl->rename ('ADMIN', @trace), - ' but renaming to an existing name fails'); -like ($acl->error, qr/^cannot rename ACL 2 to ADMIN: /, - ' with the right error'); - # Test add, check, remove, list, and show. my @entries = $acl->list; is (scalar (@entries), 0, 'ACL starts empty'); @@ -124,14 +98,14 @@ is ($entries[0][1], $user1, ' and the right identifier for 1'); is ($entries[1][0], 'krb5', ' and the right scheme for 2'); is ($entries[1][1], $user2, ' and the right identifier for 2'); my $expected = <<"EOE"; -Members of ACL example (id: 2) are: +Members of ACL test (id: 2) are: krb5 $user1 krb5 $user2 EOE is ($acl->show, $expected, ' and show returns correctly'); ok (! $acl->remove ('krb5', $admin, @trace), 'Removing a nonexistent entry fails'); -is ($acl->error, "cannot remove krb5:$admin from 2: entry not found in ACL", +is ($acl->error, "cannot remove krb5:$admin from test: entry not found in ACL", ' with the right error'); if ($acl->remove ('krb5', $user1, @trace)) { ok (1, ' but removing the first user works'); @@ -145,7 +119,7 @@ is (scalar (@entries), 1, ' and now there is one entry'); is ($entries[0][0], 'krb5', ' with the right scheme'); is ($entries[0][1], $user2, ' and the right identifier'); ok (! $acl->add ('krb5', $user2), 'Adding the same entry again fails'); -like ($acl->error, qr/^cannot add \Qkrb5:$user2\E to 2: /, +like ($acl->error, qr/^cannot add \Qkrb5:$user2\E to test: /, ' with the right error'); if ($acl->add ('krb5', '', @trace)) { ok (1, 'Adding a bad entry works'); @@ -159,7 +133,7 @@ is ($entries[0][1], '', ' and the right identifier for 1'); is ($entries[1][0], 'krb5', ' and the right scheme for 2'); is ($entries[1][1], $user2, ' and the right identifier for 2'); $expected = <<"EOE"; -Members of ACL example (id: 2) are: +Members of ACL test (id: 2) are: krb5 krb5 $user2 EOE @@ -187,17 +161,50 @@ if ($acl->remove ('krb5', '', @trace)) { } @entries = $acl->list; is (scalar (@entries), 0, ' and now there are no entries'); -is ($acl->show, "Members of ACL example (id: 2) are:\n", ' and show concurs'); +is ($acl->show, "Members of ACL test (id: 2) are:\n", ' and show concurs'); is ($acl->check ($user2), 0, ' and the second user check fails'); is (scalar ($acl->check_errors), '', ' with no error message'); +# Test rename. +my $acl_nest = eval { Wallet::ACL->create ('test-nesting', $schema, @trace) }; +ok (defined ($acl_nest), 'ACL creation for setting up nested'); +if ($acl_nest->add ('nested', 'test', @trace)) { + ok (1, ' and adding the nesting'); +} else { + is ($acl_nest->error, '', ' and adding the nesting'); +} +if ($acl->rename ('example', @trace)) { + ok (1, 'Renaming the ACL'); +} else { + is ($acl->error, '', 'Renaming the ACL'); +} +is ($acl->name, 'example', ' and the new name is right'); +is ($acl->id, 2, ' and the ID did not change'); +$acl = eval { Wallet::ACL->new ('test', $schema) }; +ok (!defined ($acl), ' and it cannot be found under the old name'); +is ($@, "ACL test not found\n", ' with the right error message'); +$acl = eval { Wallet::ACL->new ('example', $schema) }; +ok (defined ($acl), ' and it can be found with the new name'); +is ($@, '', ' with no exceptions'); +is ($acl->name, 'example', ' and the right name'); +is ($acl->id, 2, ' and the right ID'); +$acl = eval { Wallet::ACL->new (2, $schema) }; +ok (defined ($acl), ' and it can still found by ID'); +is ($@, '', ' with no exceptions'); +is ($acl->name, 'example', ' and the right name'); +is ($acl->id, 2, ' and the right ID'); +ok (! $acl->rename ('ADMIN', @trace), + ' but renaming to an existing name fails'); +like ($acl->error, qr/^cannot rename ACL example to ADMIN: /, + ' with the right error'); +@entries = $acl_nest->list; +is ($entries[0][1], 'example', ' and the name in a nested ACL updated'); + # Test history. my $date = strftime ('%Y-%m-%d %H:%M:%S', localtime $trace[2]); my $history = <<"EOO"; $date create by $admin from $host -$date rename from test - by $admin from $host $date add krb5 $user1 by $admin from $host $date add krb5 $user2 @@ -210,14 +217,24 @@ $date remove krb5 $user2 by $admin from $host $date remove krb5 by $admin from $host +$date rename from test + by $admin from $host EOO is ($acl->history, $history, 'History is correct'); # Test destroy. +$acl->destroy (@trace); +is ($acl->error, 'cannot destroy ACL example: ACL is nested in ACL test-nesting', + 'Destroying a nested ACL fails'); +if ($acl_nest->remove ('nested', 'example', @trace)) { + ok (1, ' and removing the nesting succeeds'); +} else { + is ($acl_nest->error, '', 'and removing the nesting succeeds'); +} if ($acl->destroy (@trace)) { - ok (1, 'Destroying the ACL works'); + ok (1, ' and now destroying the ACL works'); } else { - is ($acl->error, '', 'Destroying the ACL works'); + is ($acl->error, '', ' and now destroying the ACL works'); } $acl = eval { Wallet::ACL->new ('example', $schema) }; ok (!defined ($acl), ' and now cannot be found'); @@ -225,11 +242,71 @@ is ($@, "ACL example not found\n", ' with the right error message'); $acl = eval { Wallet::ACL->new (2, $schema) }; ok (!defined ($acl), ' or by ID'); is ($@, "ACL 2 not found\n", ' with the right error message'); +@entries = $acl_nest->list; +is (scalar (@entries), 0, ' and it is no longer a nested entry'); $acl = eval { Wallet::ACL->create ('example', $schema, @trace) }; ok (defined ($acl), ' and creating another with the same name works'); is ($@, '', ' with no exceptions'); is ($acl->name, 'example', ' and the right name'); -like ($acl->id, qr{\A[23]\z}, ' and an ID of 2 or 3'); +like ($acl->id, qr{\A[34]\z}, ' and an ID of 3 or 4'); + +# Test replace. by creating three acls, then assigning two objects to the +# first, one to the second, and another to the third. Then replace the first +# acl with the second, so that we can verify that multiple objects are moved, +# that an object already belonging to the new acl is okay, and that the +# objects with unrelated ACL are unaffected. +my ($acl_old, $acl_new, $acl_other, $obj_old_one, $obj_old_two, $obj_new, + $obj_unrelated); +eval { + $acl_old = Wallet::ACL->create ('example-old', $schema, @trace); + $acl_new = Wallet::ACL->create ('example-new', $schema, @trace); + $acl_other = Wallet::ACL->create ('example-other', $schema, @trace); +}; +is ($@, '', 'ACLs needed for testing replace are created'); +eval { + $obj_old_one = Wallet::Object::Base->create ('keytab', + 'service/test1@EXAMPLE.COM', + $schema, @trace); + $obj_old_two = Wallet::Object::Base->create ('keytab', + 'service/test2@EXAMPLE.COM', + $schema, @trace); + $obj_new = Wallet::Object::Base->create ('keytab', + 'service/test3@EXAMPLE.COM', + $schema, @trace); + $obj_unrelated = Wallet::Object::Base->create ('keytab', + 'service/test4@EXAMPLE.COM', + $schema, @trace); +}; +is ($@, '', ' and so were needed objects'); +if ($obj_old_one->owner ('example-old', @trace) + && $obj_old_two->owner ('example-old', @trace) + && $obj_new->owner ('example-new', @trace) + && $obj_unrelated->owner ('example-other', @trace)) { + + ok (1, ' and setting initial ownership on the objects succeeds'); +} +is ($acl_old->replace('example-new', @trace), 1, + ' and replace ran successfully'); +eval { + $obj_old_one = Wallet::Object::Base->new ('keytab', + 'service/test1@EXAMPLE.COM', + $schema); + $obj_old_two = Wallet::Object::Base->new ('keytab', + 'service/test2@EXAMPLE.COM', + $schema); + $obj_new = Wallet::Object::Base->new ('keytab', + 'service/test3@EXAMPLE.COM', + $schema); + $obj_unrelated = Wallet::Object::Base->new ('keytab', + 'service/test4@EXAMPLE.COM', + $schema); +}; +is ($obj_old_one->owner, 'example-new', ' and first replace is correct'); +is ($obj_old_two->owner, 'example-new', ' and second replace is correct'); +is ($obj_new->owner, 'example-new', + ' and object already with new acl is correct'); +is ($obj_unrelated->owner, 'example-other', + ' and unrelated object ownership is correct'); # Clean up. $setup->destroy; diff --git a/perl/t/general/report.t b/perl/t/general/report.t index 8d348ed..e47cdc6 100755 --- a/perl/t/general/report.t +++ b/perl/t/general/report.t @@ -11,7 +11,7 @@ use strict; use warnings; -use Test::More tests => 197; +use Test::More tests => 223; use Wallet::Admin; use Wallet::Report; @@ -41,6 +41,32 @@ 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'); +# Check to see that we have all types that we expect. +my @types = $report->types; +is (scalar (@types), 10, 'There are ten types created'); +is ($types[0][0], 'base', ' and the first member is correct'); +is ($types[1][0], 'duo', ' and the second member is correct'); +is ($types[2][0], 'duo-ldap', ' and the third member is correct'); +is ($types[3][0], 'duo-pam', ' and the fourth member is correct'); +is ($types[4][0], 'duo-radius', ' and the fifth member is correct'); +is ($types[5][0], 'duo-rdp', ' and the sixth member is correct'); +is ($types[6][0], 'file', ' and the seventh member is correct'); +is ($types[7][0], 'keytab', ' and the eighth member is correct'); +is ($types[8][0], 'password', ' and the nineth member is correct'); +is ($types[9][0], 'wa-keyring', ' and the tenth member is correct'); + +# And that we have all schemes that we expect. +my @schemes = $report->acl_schemes; +is (scalar (@schemes), 8, 'There are seven acl schemes created'); +is ($schemes[0][0], 'base', ' and the first member is correct'); +is ($schemes[1][0], 'krb5', ' and the second member is correct'); +is ($schemes[2][0], 'krb5-regex', ' and the third member is correct'); +is ($schemes[3][0], 'ldap-attr', ' and the fourth member is correct'); +is ($schemes[4][0], 'ldap-attr-root', ' and the fifth member is correct'); +is ($schemes[5][0], 'nested', ' and the sixth member is correct'); +is ($schemes[6][0], 'netdb', ' and the seventh member is correct'); +is ($schemes[7][0], 'netdb-root', ' and the eighth member is correct'); + # Create an object. my $server = eval { Wallet::Server->new ('admin@EXAMPLE.COM', 'localhost') }; is ($@, '', 'Creating a server instance did not die'); @@ -257,6 +283,22 @@ is (scalar (@lines), 1, 'Searching for ACL naming violations finds one'); is ($lines[0][0], 3, ' and the first has the right ID'); is ($lines[0][1], 'second', ' and the right name'); +# Set a host-based object matching script so that we can test the host report. +# The deactivation trick isn't needed here. +package Wallet::Config; +sub is_for_host { + my ($type, $name, $host) = @_; + my ($service, $principal) = split ('/', $name, 2); + return 0 unless $service && $principal; + return 1 if $host eq $principal; + return 0; +} +package main; +@lines = $report->objects_hostname ('host', 'admin'); +is (scalar (@lines), 1, 'Searching for host-based objects finds one'); +is ($lines[0][0], 'base', ' and the first has the right type'); +is ($lines[0][1], 'service/admin', ' and the right name'); + # Set up a file bucket so that we can create an object we can retrieve. system ('rm -rf test-files') == 0 or die "cannot remove test-files\n"; mkdir 'test-files' or die "cannot create test-files: $!\n"; @@ -325,6 +367,13 @@ is ($server->acl_add ('third', 'base', 'baz'), 1, is (scalar (@acls), 0, 'There are no duplicate ACLs'); is ($report->error, undef, ' and no error'); +# See if the acl nesting report works correctly. +is ($server->acl_add ('fourth', 'nested', 'second'), 1, + 'Adding an ACL as a nested entry for another works'); +@acls = $report->acls ('nesting', 'second'); +is (scalar (@acls), 1, ' and the nested report shows one nesting'); +is ($acls[0][1], 'fourth', ' with the correct ACL nesting it'); + # Clean up. $admin->destroy; system ('rm -r test-files') == 0 or die "cannot remove test-files\n"; diff --git a/perl/t/general/server.t b/perl/t/general/server.t index 0a527a5..8f4c16c 100755 --- a/perl/t/general/server.t +++ b/perl/t/general/server.t @@ -89,7 +89,7 @@ is ($server->acl_rename ('empty', 'test'), undef, is ($server->error, 'ACL empty not found', ' and returns the right error'); is ($server->acl_rename ('test', 'test2'), undef, ' and cannot rename to an existing name'); -like ($server->error, qr/^cannot rename ACL 6 to test2: /, +like ($server->error, qr/^cannot rename ACL test to test2: /, ' and returns the right error'); is ($server->acl_rename ('test', 'empty'), 1, 'Renaming does work'); is ($server->acl_rename ('test', 'empty'), undef, ' but not twice'); @@ -138,7 +138,7 @@ is ($server->error, 'ACL test not found', ' and returns the right error'); is ($server->acl_remove ('empty', 'krb5', $user2), undef, ' and removing an entry not there fails'); is ($server->error, - "cannot remove krb5:$user2 from 6: entry not found in ACL", + "cannot remove krb5:$user2 from empty: entry not found in ACL", ' and returns the right error'); is ($server->acl_show ('empty'), "Members of ACL empty (id: 6) are:\n krb5 $user1\n", @@ -148,7 +148,7 @@ is ($server->acl_remove ('empty', 'krb5', $user1), 1, is ($server->acl_remove ('empty', 'krb5', $user1), undef, ' but does not work twice'); is ($server->error, - "cannot remove krb5:$user1 from 6: entry not found in ACL", + "cannot remove krb5:$user1 from empty: entry not found in ACL", ' and returns the right error'); is ($server->acl_show ('empty'), "Members of ACL empty (id: 6) are:\n", ' and show returns the correct status'); @@ -168,7 +168,7 @@ is ($server->acl_remove ('ADMIN', 'krb5', $user1), 1, ' and then remove it'); is ($server->acl_remove ('ADMIN', 'krb5', $user1), undef, ' and remove a user not on it'); is ($server->error, - "cannot remove krb5:$user1 from 1: entry not found in ACL", + "cannot remove krb5:$user1 from ADMIN: entry not found in ACL", ' and get the right error'); # Now, create a few objects to use for testing and test the object API while @@ -994,7 +994,7 @@ is ($server->owner ('base', 'service/acl-user', 'test-destroy'), 1, is ($server->acl_destroy ('test-destroy'), undef, ' and now we cannot destroy that ACL'); is ($server->error, - 'cannot destroy ACL 9: ACL in use by base:service/acl-user', + 'cannot destroy ACL test-destroy: ACL in use by base:service/acl-user', ' with the right error'); is ($server->owner ('base', 'service/acl-user', ''), 1, ' but after we clear the owner'); diff --git a/perl/t/object/base.t b/perl/t/object/base.t index ee9ff4b..8fedd64 100755 --- a/perl/t/object/base.t +++ b/perl/t/object/base.t @@ -12,7 +12,7 @@ use strict; use warnings; use POSIX qw(strftime); -use Test::More tests => 137; +use Test::More tests => 139; use Wallet::ACL; use Wallet::Admin; @@ -208,6 +208,9 @@ is ($object->flag_clear ('locked', @trace), 1, 'Clearing locked succeeds'); eval { $object->get (@trace) }; is ($@, "Do not instantiate Wallet::Object::Base directly\n", 'Get fails with the right error'); +ok (!$object->update (@trace), 'Update fails'); +is ($object->error, 'update is not supported for this type, use get instead', + ' with the right error'); ok (! $object->store ("Some data", @trace), 'Store fails'); is ($object->error, "cannot store keytab:$princ: object type is immutable", ' with the right error'); diff --git a/perl/t/object/duo-ldap.t b/perl/t/object/duo-ldap.t index 3648eba..8a00dbb 100644 --- a/perl/t/object/duo-ldap.t +++ b/perl/t/object/duo-ldap.t @@ -26,7 +26,7 @@ BEGIN { BEGIN { use_ok('Wallet::Admin'); use_ok('Wallet::Config'); - use_ok('Wallet::Object::Duo::LDAPProxy'); + use_ok('Wallet::Object::Duo'); } use lib 't/lib'; @@ -53,15 +53,14 @@ my $mock = Net::Duo::Mock::Agent->new ({ key_file => 't/data/duo/keys.json' }); # Test error handling in the absence of configuration. my $object = eval { - Wallet::Object::Duo::LDAPProxy->new ('duo-ldap', 'test', $schema); + Wallet::Object::Duo->new ('duo-ldap', 'test', $schema); }; -is ($object, undef, 'Wallet::Object::Duo::LDAPProxy new with no config failed'); +is ($object, undef, 'Wallet::Object::Duo new with no config failed'); is ($@, "duo object implementation not configured\n", '...with correct error'); $object = eval { - Wallet::Object::Duo::LDAPProxy->create ('duo-ldap', 'test', $schema, - @trace); + Wallet::Object::Duo->create ('duo-ldap', 'test', $schema, @trace); }; -is ($object, undef, 'Wallet::Object::Duo::LDAPProxy creation with no config failed'); +is ($object, undef, 'Wallet::Object::Duo creation with no config failed'); is ($@, "duo object implementation not configured\n", '...with correct error'); # Set up the Duo configuration. @@ -83,9 +82,8 @@ $mock->expect ( response_file => 't/data/duo/integration.json', } ); -$object = Wallet::Object::Duo::LDAPProxy->create ('duo-ldap', 'test', $schema, - @trace); -isa_ok ($object, 'Wallet::Object::Duo::LDAPProxy'); +$object = Wallet::Object::Duo->create ('duo-ldap', 'test', $schema, @trace); +isa_ok ($object, 'Wallet::Object::Duo'); # Check the metadata about the new wallet object. $expected = <<"EOO"; @@ -127,7 +125,7 @@ is ($object->flag_clear ('locked', @trace), 1, '...and clearing locked flag works'); # Create a new object by wallet type and name. -$object = Wallet::Object::Duo::LDAPProxy->new ('duo-ldap', 'test', $schema); +$object = Wallet::Object::Duo->new ('duo-ldap', 'test', $schema); # Test deleting an integration. We can't test this entirely properly because # currently Net::Duo::Mock::Agent doesn't support stacking multiple expected @@ -144,8 +142,7 @@ TODO: { local $TODO = 'Net::Duo::Mock::Agent not yet capable'; is ($object->destroy (@trace), 1, 'Duo object deletion succeeded'); - $object = eval { Wallet::Object::Duo::LDAPProxy->new ('duo-ldap', 'test', - $schema) }; + $object = eval { Wallet::Object::Duo->new ('duo-ldap', 'test', $schema) }; is ($object, undef, '...and now object cannot be retrieved'); is ($@, "cannot find duo:test\n", '...with correct error'); } diff --git a/perl/t/object/duo-pam.t b/perl/t/object/duo-pam.t index 7b88787..047343e 100644 --- a/perl/t/object/duo-pam.t +++ b/perl/t/object/duo-pam.t @@ -26,7 +26,7 @@ BEGIN { BEGIN { use_ok('Wallet::Admin'); use_ok('Wallet::Config'); - use_ok('Wallet::Object::Duo::PAM'); + use_ok('Wallet::Object::Duo'); } use lib 't/lib'; @@ -53,14 +53,14 @@ my $mock = Net::Duo::Mock::Agent->new ({ key_file => 't/data/duo/keys.json' }); # Test error handling in the absence of configuration. my $object = eval { - Wallet::Object::Duo::PAM->new ('duo-pam', 'test', $schema); + Wallet::Object::Duo->new ('duo-pam', 'test', $schema); }; -is ($object, undef, 'Wallet::Object::Duo::PAM new with no config failed'); +is ($object, undef, 'Wallet::Object::Duo new with no config failed'); is ($@, "duo object implementation not configured\n", '...with correct error'); $object = eval { - Wallet::Object::Duo::PAM->create ('duo-pam', 'test', $schema, @trace); + Wallet::Object::Duo->create ('duo-pam', 'test', $schema, @trace); }; -is ($object, undef, 'Wallet::Object::Duo::PAM creation with no config failed'); +is ($object, undef, 'Wallet::Object::Duo creation with no config failed'); is ($@, "duo object implementation not configured\n", '...with correct error'); # Set up the Duo configuration. @@ -82,9 +82,8 @@ $mock->expect ( response_file => 't/data/duo/integration.json', } ); -$object = Wallet::Object::Duo::PAM->create ('duo-pam', 'test', $schema, - @trace); -isa_ok ($object, 'Wallet::Object::Duo::PAM'); +$object = Wallet::Object::Duo->create ('duo-pam', 'test', $schema, @trace); +isa_ok ($object, 'Wallet::Object::Duo'); # Check the metadata about the new wallet object. $expected = <<"EOO"; @@ -126,7 +125,7 @@ is ($object->flag_clear ('locked', @trace), 1, '...and clearing locked flag works'); # Create a new object by wallet type and name. -$object = Wallet::Object::Duo::PAM->new ('duo-pam', 'test', $schema); +$object = Wallet::Object::Duo->new ('duo-pam', 'test', $schema); # Test deleting an integration. We can't test this entirely properly because # currently Net::Duo::Mock::Agent doesn't support stacking multiple expected @@ -143,8 +142,7 @@ TODO: { local $TODO = 'Net::Duo::Mock::Agent not yet capable'; is ($object->destroy (@trace), 1, 'Duo object deletion succeeded'); - $object = eval { Wallet::Object::Duo::PAM->new ('duo-pam', 'test', - $schema) }; + $object = eval { Wallet::Object::Duo->new ('duo-pam', 'test', $schema) }; is ($object, undef, '...and now object cannot be retrieved'); is ($@, "cannot find duo:test\n", '...with correct error'); } diff --git a/perl/t/object/duo-radius.t b/perl/t/object/duo-radius.t index f258518..55cbb9d 100644 --- a/perl/t/object/duo-radius.t +++ b/perl/t/object/duo-radius.t @@ -26,7 +26,7 @@ BEGIN { BEGIN { use_ok('Wallet::Admin'); use_ok('Wallet::Config'); - use_ok('Wallet::Object::Duo::RadiusProxy'); + use_ok('Wallet::Object::Duo'); } use lib 't/lib'; @@ -53,17 +53,16 @@ my $mock = Net::Duo::Mock::Agent->new ({ key_file => 't/data/duo/keys.json' }); # Test error handling in the absence of configuration. my $object = eval { - Wallet::Object::Duo::RadiusProxy->new ('duo-raduys', 'test', $schema); + Wallet::Object::Duo->new ('duo-radius', 'test', $schema); }; is ($object, undef, - 'Wallet::Object::Duo::RadiusProxy new with no config failed'); + 'Wallet::Object::Duo new with no config failed'); is ($@, "duo object implementation not configured\n", '...with correct error'); $object = eval { - Wallet::Object::Duo::RadiusProxy->create ('duo-radius', 'test', $schema, - @trace); + Wallet::Object::Duo->create ('duo-radius', 'test', $schema, @trace); }; is ($object, undef, - 'Wallet::Object::Duo::RadiusProxy creation with no config failed'); + 'Wallet::Object::Duo creation with no config failed'); is ($@, "duo object implementation not configured\n", '...with correct error'); # Set up the Duo configuration. @@ -85,9 +84,8 @@ $mock->expect ( response_file => 't/data/duo/integration-radius.json', } ); -$object = Wallet::Object::Duo::RadiusProxy->create ('duo-radius', 'test', - $schema, @trace); -isa_ok ($object, 'Wallet::Object::Duo::RadiusProxy'); +$object = Wallet::Object::Duo->create ('duo-radius', 'test', $schema, @trace); +isa_ok ($object, 'Wallet::Object::Duo'); # Check the metadata about the new wallet object. $expected = <<"EOO"; @@ -130,8 +128,7 @@ is ($object->flag_clear ('locked', @trace), 1, '...and clearing locked flag works'); # Create a new object by wallet type and name. -$object = Wallet::Object::Duo::RadiusProxy->new ('duo-radius', 'test', - $schema); +$object = Wallet::Object::Duo->new ('duo-radius', 'test', $schema); # Test deleting an integration. We can't test this entirely properly because # currently Net::Duo::Mock::Agent doesn't support stacking multiple expected @@ -149,7 +146,7 @@ TODO: { is ($object->destroy (@trace), 1, 'Duo object deletion succeeded'); $object = eval { - Wallet::Object::Duo::RadiusProxy->new ('duo-radius', 'test', $schema); + Wallet::Object::Duo->new ('duo-radius', 'test', $schema); }; is ($object, undef, '...and now object cannot be retrieved'); is ($@, "cannot find duo:test\n", '...with correct error'); diff --git a/perl/t/object/duo-rdp.t b/perl/t/object/duo-rdp.t index 9b2d566..25060ac 100644 --- a/perl/t/object/duo-rdp.t +++ b/perl/t/object/duo-rdp.t @@ -26,7 +26,7 @@ BEGIN { BEGIN { use_ok('Wallet::Admin'); use_ok('Wallet::Config'); - use_ok('Wallet::Object::Duo::RDP'); + use_ok('Wallet::Object::Duo'); } use lib 't/lib'; @@ -53,14 +53,14 @@ my $mock = Net::Duo::Mock::Agent->new ({ key_file => 't/data/duo/keys.json' }); # Test error handling in the absence of configuration. my $object = eval { - Wallet::Object::Duo::RDP->new ('duo-rdp', 'test', $schema); + Wallet::Object::Duo->new ('duo-rdp', 'test', $schema); }; -is ($object, undef, 'Wallet::Object::Duo::RDP new with no config failed'); +is ($object, undef, 'Wallet::Object::Duo new with no config failed'); is ($@, "duo object implementation not configured\n", '...with correct error'); $object = eval { - Wallet::Object::Duo::RDP->create ('duo-rdp', 'test', $schema, @trace); + Wallet::Object::Duo->create ('duo-rdp', 'test', $schema, @trace); }; -is ($object, undef, 'Wallet::Object::Duo::RDP creation with no config failed'); +is ($object, undef, 'Wallet::Object::Duo creation with no config failed'); is ($@, "duo object implementation not configured\n", '...with correct error'); # Set up the Duo configuration. @@ -82,9 +82,8 @@ $mock->expect ( response_file => 't/data/duo/integration-rdp.json', } ); -$object = Wallet::Object::Duo::RDP->create ('duo-rdp', 'test', $schema, - @trace); -isa_ok ($object, 'Wallet::Object::Duo::RDP'); +$object = Wallet::Object::Duo->create ('duo-rdp', 'test', $schema, @trace); +isa_ok ($object, 'Wallet::Object::Duo'); # Check the metadata about the new wallet object. $expected = <<"EOO"; @@ -125,7 +124,7 @@ is ($object->flag_clear ('locked', @trace), 1, '...and clearing locked flag works'); # Create a new object by wallet type and name. -$object = Wallet::Object::Duo::RDP->new ('duo-rdp', 'test', $schema); +$object = Wallet::Object::Duo->new ('duo-rdp', 'test', $schema); # Test deleting an integration. We can't test this entirely properly because # currently Net::Duo::Mock::Agent doesn't support stacking multiple expected @@ -142,8 +141,7 @@ TODO: { local $TODO = 'Net::Duo::Mock::Agent not yet capable'; is ($object->destroy (@trace), 1, 'Duo object deletion succeeded'); - $object = eval { Wallet::Object::Duo::RDP->new ('duo-rdp', 'test', - $schema) }; + $object = eval { Wallet::Object::Duo->new ('duo-rdp', 'test', $schema) }; is ($object, undef, '...and now object cannot be retrieved'); is ($@, "cannot find duo:test\n", '...with correct error'); } diff --git a/perl/t/object/keytab.t b/perl/t/object/keytab.t index 69db438..111b7d0 100755 --- a/perl/t/object/keytab.t +++ b/perl/t/object/keytab.t @@ -12,7 +12,7 @@ use strict; use warnings; use POSIX qw(strftime); -use Test::More tests => 141; +use Test::More tests => 142; BEGIN { $Wallet::Config::KEYTAB_TMP = '.' } @@ -25,15 +25,28 @@ use Wallet::Object::Keytab; use lib 't/lib'; use Util; -# Mapping of klist -ke encryption type names to the strings that Kerberos uses -# internally. It's very annoying to have to maintain this, and it probably -# breaks with Heimdal. +# Mapping of klist -ke output from old MIT Kerberos implementations to to the +# strings that Kerberos uses internally. It's very annoying to have to +# maintain this, and it probably breaks with Heimdal. +# +# Newer versions of MIT Kerberos just print out the canonical enctype names +# and don't need this logic, but the current test requires that they still +# have entries. That's why the second set where the key and value are the +# same. 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-128 cts mode with 96-bit sha-1 hmac' => 'aes128-cts-hmac-sha1-96', 'aes-256 cts mode with 96-bit sha-1 hmac' => 'aes256-cts-hmac-sha1-96', - 'arcfour with hmac/md5' => 'rc4-hmac'); + 'arcfour with hmac/md5' => 'rc4-hmac', + + 'des3-cbc-sha1' => 'des3-cbc-sha1', + 'des-cbc-crc' => 'des-cbc-crc', + 'des-cbc-md5' => 'des-cbc-md5', + 'aes128-cts-hmac-sha1-96' => 'aes128-cts-hmac-sha1-96', + 'aes256-cts-hmac-sha1-96' => 'aes256-cts-hmac-sha1-96', + 'rc4-hmac' => 'rc4-hmac'); # Some global defaults to use. my $user = 'admin@EXAMPLE.COM'; @@ -159,7 +172,7 @@ my $date = strftime ('%Y-%m-%d %H:%M:%S', localtime $trace[2]); # Basic keytab creation and manipulation tests. SKIP: { - skip 'no keytab configuration', 52 unless -f 't/data/test.keytab'; + skip 'no keytab configuration', 53 unless -f 't/data/test.keytab'; # Set up our configuration. $Wallet::Config::KEYTAB_FILE = 't/data/test.keytab'; @@ -296,6 +309,7 @@ EOO @trace) }; ok (defined ($object), 'Creating good principal succeeds'); + is ($@, '', ' with no error'); ok (created ('wallet/one'), ' and the principal was created'); SKIP: { skip 'no kadmin program test for Heimdal', 2 diff --git a/perl/t/object/password.t b/perl/t/object/password.t new file mode 100644 index 0000000..306d82b --- /dev/null +++ b/perl/t/object/password.t @@ -0,0 +1,125 @@ +#!/usr/bin/perl +# +# Tests for the password object implementation. Only includes tests that are +# basic or different from the file object implementation. +# +# Written by Jon Robertson <jonrober@stanford.edu> +# Copyright 2015 +# The Board of Trustees of the Leland Stanford Junior University +# +# See LICENSE for licensing terms. + +use strict; +use warnings; + +use POSIX qw(strftime); +use Test::More tests => 33; + +use Wallet::Admin; +use Wallet::Config; +use Wallet::Object::Password; + +use lib 't/lib'; +use Util; + +# Some global defaults to use. +my $user = 'admin@EXAMPLE.COM'; +my $host = 'localhost'; +my @trace = ($user, $host, time); + +# Flush all output immediately. +$| = 1; + +# Use Wallet::Admin to set up the database. +system ('rm -rf test-files') == 0 or die "cannot remove test-files\n"; +db_setup; +my $admin = eval { Wallet::Admin->new }; +is ($@, '', 'Database connection succeeded'); +is ($admin->reinitialize ($user), 1, 'Database initialization succeeded'); +my $schema = $admin->schema; + +# Use this to accumulate the history traces so that we can check history. +my $history = ''; +my $date = strftime ('%Y-%m-%d %H:%M:%S', localtime $trace[2]); + +$Wallet::Config::PWD_FILE_BUCKET = undef; + +# Test error handling in the absence of configuration. +my $object = eval { + Wallet::Object::Password->create ('password', 'test', $schema, @trace) + }; +ok (defined ($object), 'Creating a basic password object succeeds'); +ok ($object->isa ('Wallet::Object::Password'), ' and is the right class'); +is ($object->get (@trace), undef, ' and get fails'); +is ($object->error, 'password support not configured', + ' with the right error'); +is ($object->store (@trace), undef, ' and store fails'); +is ($object->error, 'password support not configured', + ' with the right error'); +is ($object->destroy (@trace), 1, ' but destroy succeeds'); + +# Set up our configuration. +mkdir 'test-files' or die "cannot create test-files: $!\n"; +$Wallet::Config::PWD_FILE_BUCKET = 'test-files'; +$Wallet::Config::PWD_LENGTH_MIN = 10; +$Wallet::Config::PWD_LENGTH_MAX = 10; + +# Okay, now we can test. First, the basic object without store. +$object = eval { + Wallet::Object::Password->create ('password', 'test', $schema, @trace) + }; +ok (defined ($object), 'Creating a basic password object succeeds'); +ok ($object->isa ('Wallet::Object::Password'), ' and is the right class'); +my $pwd = $object->get (@trace); +like ($pwd, qr{^.{$Wallet::Config::PWD_LENGTH_MIN}$}, + ' and get creates a random password string of the right length'); +ok (-d 'test-files/09', ' and the hash bucket was created'); +ok (-f 'test-files/09/test', ' and the file exists'); +is (contents ('test-files/09/test'), $pwd, ' with the right contents'); +my $pwd2 = $object->get (@trace); +is ($pwd, $pwd2, ' and getting again gives the same string'); +is ($object->destroy (@trace), 1, ' and destroying the object succeeds'); + +# Now check to see if the password length is adjusted. +$Wallet::Config::PWD_LENGTH_MIN = 20; +$Wallet::Config::PWD_LENGTH_MAX = 20; +$object = eval { + Wallet::Object::Password->create ('password', 'test', $schema, @trace) + }; +ok (defined ($object), 'Recreating the object succeeds'); +$pwd = $object->get (@trace); +like ($pwd, qr{^.{$Wallet::Config::PWD_LENGTH_MIN}$}, + ' and get creates a random password string of a longer length'); +is ($object->destroy (@trace), 1, ' and destroying the object succeeds'); + +# Now store something and be sure that we get something reasonable. +$object = eval { + Wallet::Object::Password->create ('password', 'test', $schema, @trace) + }; +ok (defined ($object), 'Recreating the object succeeds'); +is ($object->store ("foo\n", @trace), 1, ' and storing data in it succeeds'); +ok (-f 'test-files/09/test', ' and the file exists'); +is (contents ('test-files/09/test'), 'foo', ' with the right contents'); +is ($object->get (@trace), "foo\n", ' and get returns correctly'); +unlink 'test-files/09/test'; +is ($object->get (@trace), undef, + ' and get will not autocreate a password if there used to be data'); +is ($object->error, 'cannot get password:test: object has not been stored', + ' as if it had not been stored'); +is ($object->store ("bar\n\0baz\n", @trace), 1, ' but storing again works'); +ok (-f 'test-files/09/test', ' and the file exists'); +is (contents ('test-files/09/test'), 'bar', ' with the right contents'); +is ($object->get (@trace), "bar\n\0baz\n", ' and get returns correctly'); + +# And check to make sure update changes the contents. +$pwd = $object->update (@trace); +isnt ($pwd, "bar\n\0baz\n", 'Update changes the contents'); +like ($pwd, qr{^.{$Wallet::Config::PWD_LENGTH_MIN}$}, + ' to a random password string of the right length'); + +# Clean up. +$admin->destroy; +END { + system ('rm -r test-files') == 0 or die "cannot remove test-files\n"; + unlink ('wallet-db'); +} diff --git a/perl/t/policy/stanford.t b/perl/t/policy/stanford.t index 555086c..d2727c8 100755 --- a/perl/t/policy/stanford.t +++ b/perl/t/policy/stanford.t @@ -16,7 +16,7 @@ use 5.008; use strict; use warnings; -use Test::More tests => 101; +use Test::More tests => 130; use lib 't/lib'; use Util; @@ -24,10 +24,16 @@ use Util; # Load the naming policy module. BEGIN { use_ok('Wallet::Admin'); - use_ok('Wallet::Policy::Stanford', qw(default_owner verify_name)); + use_ok('Wallet::Policy::Stanford', + qw(default_owner verify_name is_for_host)); use_ok('Wallet::Server'); } +# Set up our configuration for netdb, needed for the netdb verifier. +$Wallet::Config::NETDB_REALM = 'stanford.edu'; +$Wallet::Config::NETDB_REMCTL_CACHE = $ENV{KRB5CCNAME}; +$Wallet::Config::NETDB_REMCTL_HOST = 'netdb-node-roles-rc.stanford.edu'; + # Various valid keytab names. my @VALID_KEYTABS = qw(host/example.stanford.edu HTTP/example.stanford.edu service/example example/cgi class-example01/cgi dept-01example/cgi @@ -101,160 +107,209 @@ for my $name (@INVALID_FILES) { isnt(verify_name('file', $name), undef, "Invalid file $name"); } -# Now we need an actual database. Use Wallet::Admin to set it up. -db_setup; -my $setup = eval { Wallet::Admin->new }; -is($@, q{}, 'Database initialization did not die'); -is($setup->reinitialize($ADMIN), 1, 'Database initialization succeeded'); -my $server = eval { Wallet::Server->new(@TRACE) }; -is($@, q{}, 'Server creation did not die'); +# Now test a few cases for checking to see if a file is host-based. We don't +# test the legacy examples because they're more complicated and less obvious. +for my $name (@VALID_KEYTABS) { + my $hostname = 'example.stanford.edu'; + if ($name =~ m{\b$hostname\b}) { + is(is_for_host('keytab', $name, $hostname), 1, + "Keytab $name belongs to $hostname"); + } else { + is(is_for_host('keytab', $name, $hostname), 0, + "Keytab $name doesn't belong to $hostname"); + } +} +for my $name (@VALID_FILES) { + my $hostname = 'example.stanford.edu'; + if ($name =~ m{\b$hostname\b}) { + is(is_for_host('file', $name, $hostname), 1, + "File $name belongs to $hostname"); + } else { + is(is_for_host('file', $name, $hostname), 0, + "File $name doesn't belong to $hostname"); + } +} -# Create a host/example.stanford.edu ACL that uses the netdb ACL type. -is($server->acl_create('host/example.stanford.edu'), 1, 'Created netdb ACL'); -is( - $server->acl_add('host/example.stanford.edu', 'netdb', - 'example.stanford.edu'), - 1, - '...with netdb ACL line' -); -is( - $server->acl_add('host/example.stanford.edu', 'krb5', - 'host/example.stanford.edu@stanford.edu'), - 1, - '...and krb5 ACL line' -); +# Now we need an actual database. Use Wallet::Admin to set it up. These +# remaining tests require creating NetDB ACLs, so need a Stanford Kerberos +# principal currently. +my $klist = `klist 2>&1` || ''; +SKIP: { + skip "tests useful only with Stanford Kerberos tickets", 27 + unless ($klist =~ /^(Default p|\s+P)rincipal: \S+\@stanford\.edu$/m); -# Likewise for host/foo.example.edu with the netdb-root ACL type. -is($server->acl_create('host/foo.stanford.edu'), 1, 'Created netdb-root ACL'); -is( - $server->acl_add('host/foo.stanford.edu', 'netdb-root', - 'foo.stanford.edu'), - 1, - '...with netdb-root ACL line' -); -is( - $server->acl_add('host/foo.stanford.edu', 'krb5', - 'host/foo.stanford.edu@stanford.edu'), - 1, - '...and krb5 ACL line' -); + db_setup; + my $setup = eval { Wallet::Admin->new }; + is($@, q{}, 'Database initialization did not die'); + is($setup->reinitialize($ADMIN), 1, 'Database initialization succeeded'); + my $server = eval { Wallet::Server->new(@TRACE) }; + is($@, q{}, 'Server creation did not die'); -# Create a group/its-idg ACL, which will be used for autocreation of file -# objects. -is($server->acl_create('group/its-idg'), 1, 'Created group/its-idg ACL'); -is($server->acl_add('group/its-idg', 'krb5', $ADMIN), 1, '...with member'); + # Create a host/example.stanford.edu ACL that uses the netdb ACL type. + is( + $server->acl_create('host/example.stanford.edu'), + 1, + 'Created netdb ACL' + ); + is($server->error, undef, ' with no error'); + is( + $server->acl_add('host/example.stanford.edu', 'netdb', + 'example.stanford.edu'), + 1, + '...with netdb ACL line' + ); + is($server->error, undef, ' with no error'); + is( + $server->acl_add('host/example.stanford.edu', 'krb5', + 'host/example.stanford.edu@stanford.edu'), + 1, + '...and krb5 ACL line' + ); + is($server->error, undef, ' with no error'); -# Now we can test default ACLs. First, without a root instance. -local $ENV{REMOTE_USER} = $ADMIN; -is_deeply( - [default_owner('keytab', 'host/bar.stanford.edu')], - [ - 'host/bar.stanford.edu', - ['netdb', 'bar.stanford.edu'], - ['krb5', 'host/bar.stanford.edu@stanford.edu'] - ], - 'Correct default owner for host-based keytab' -); -is_deeply( - [default_owner('keytab', 'HTTP/example.stanford.edu')], - [ - 'host/example.stanford.edu', - ['netdb', 'example.stanford.edu'], - ['krb5', 'host/example.stanford.edu@stanford.edu'] - ], - '...and when netdb ACL already exists' -); -is_deeply( - [default_owner('keytab', 'webauth/foo.stanford.edu')], - [ - 'host/foo.stanford.edu', - ['netdb-root', 'foo.stanford.edu'], - ['krb5', 'host/foo.stanford.edu@stanford.edu'] - ], - '...and when netdb-root ACL already exists' -); + # Likewise for host/foo.example.edu with the netdb-root ACL type. + is( + $server->acl_create('host/foo.stanford.edu'), + 1, + 'Created netdb-root ACL' + ); + is( + $server->acl_add('host/foo.stanford.edu', 'netdb-root', + 'foo.stanford.edu'), + 1, + '...with netdb-root ACL line' + ); + is( + $server->acl_add('host/foo.stanford.edu', 'krb5', + 'host/foo.stanford.edu@stanford.edu'), + 1, + '...and krb5 ACL line' + ); -# Now with a root instance. -local $ENV{REMOTE_USER} = 'admin/root@stanford.edu'; -is_deeply( - [default_owner('keytab', 'host/bar.stanford.edu')], - [ - 'host/bar.stanford.edu', - ['netdb-root', 'bar.stanford.edu'], - ['krb5', 'host/bar.stanford.edu@stanford.edu'] - ], - 'Correct default owner for host-based keytab for /root' -); -is_deeply( - [default_owner('keytab', 'HTTP/example.stanford.edu')], - [ - 'host/example.stanford.edu', - ['netdb-root', 'example.stanford.edu'], - ['krb5', 'host/example.stanford.edu@stanford.edu'] - ], - '...and when netdb ACL already exists' -); -is_deeply( - [default_owner('keytab', 'webauth/foo.stanford.edu')], - [ - 'host/foo.stanford.edu', - ['netdb-root', 'foo.stanford.edu'], - ['krb5', 'host/foo.stanford.edu@stanford.edu'] - ], - '...and when netdb-root ACL already exists' -); + # Create a group/its-idg ACL, which will be used for autocreation of file + # objects. + is($server->acl_create('group/its-idg'), 1, 'Created group/its-idg ACL'); + is($server->acl_add('group/its-idg', 'krb5', $ADMIN), 1, '...with member'); -# Check for a type that isn't host-based. -is(default_owner('keytab', 'service/foo'), undef, - 'No default owner for service/foo'); + # Now we can test default ACLs. First, without a root instance. + local $ENV{REMOTE_USER} = $ADMIN; + is_deeply( + [default_owner('keytab', 'host/bar.stanford.edu')], + [ + 'host/bar.stanford.edu', + ['netdb', 'bar.stanford.edu'], + ['krb5', 'host/bar.stanford.edu@stanford.edu'] + ], + 'Correct default owner for host-based keytab' + ); + is_deeply( + [default_owner('keytab', 'HTTP/example.stanford.edu')], + [ + 'host/example.stanford.edu', + ['netdb', 'example.stanford.edu'], + ['krb5', 'host/example.stanford.edu@stanford.edu'] + ], + '...and when netdb ACL already exists' + ); + is_deeply( + [default_owner('keytab', 'webauth/foo.stanford.edu')], + [ + 'host/foo.stanford.edu', + ['netdb-root', 'foo.stanford.edu'], + ['krb5', 'host/foo.stanford.edu@stanford.edu'] + ], + '...and when netdb-root ACL already exists' + ); -# Check for an unknown object type. -is(default_owner('unknown', 'foo'), undef, - 'No default owner for unknown type'); + # Now with a root instance. + local $ENV{REMOTE_USER} = 'admin/root@stanford.edu'; + is_deeply( + [default_owner('keytab', 'host/bar.stanford.edu')], + [ + 'host/bar.stanford.edu', + ['netdb-root', 'bar.stanford.edu'], + ['krb5', 'host/bar.stanford.edu@stanford.edu'] + ], + 'Correct default owner for host-based keytab for /root' + ); + is_deeply( + [default_owner('keytab', 'HTTP/example.stanford.edu')], + [ + 'host/example.stanford.edu', + ['netdb-root', 'example.stanford.edu'], + ['krb5', 'host/example.stanford.edu@stanford.edu'] + ], + '...and when netdb ACL already exists' + ); + is_deeply( + [default_owner('keytab', 'webauth/foo.stanford.edu')], + [ + 'host/foo.stanford.edu', + ['netdb-root', 'foo.stanford.edu'], + ['krb5', 'host/foo.stanford.edu@stanford.edu'] + ], + '...and when netdb-root ACL already exists' + ); -# Check for autocreation mappings for host-based file objects. -is_deeply( - [default_owner('file', 'ssl-key/example.stanford.edu')], - [ - 'host/example.stanford.edu', - ['netdb-root', 'example.stanford.edu'], - ['krb5', 'host/example.stanford.edu@stanford.edu'] - ], - 'Default owner for file ssl-key/example.stanford.edu', -); -is_deeply( - [default_owner('file', 'ssl-key/example.stanford.edu/mysql')], - [ - 'host/example.stanford.edu', - ['netdb-root', 'example.stanford.edu'], - ['krb5', 'host/example.stanford.edu@stanford.edu'] - ], - 'Default owner for file ssl-key/example.stanford.edu/mysql', -); + # Check for a type that isn't host-based. + is( + default_owner('keytab', 'service/foo'), + undef, + 'No default owner for service/foo' + ); -# Check for a file object that isn't host-based. -is_deeply( - [default_owner('file', 'config/its-idg/example/foo')], - ['group/its-idg', ['krb5', $ADMIN]], - 'Default owner for file config/its-idg/example/foo', -); + # Check for an unknown object type. + is( + default_owner('unknown', 'foo'), + undef, + 'No default owner for unknown type' + ); -# Check for legacy autocreation mappings for file objects. -for my $type (qw(htpasswd ssh-rsa ssh-dsa ssl-key tivoli-key)) { - my $name = "idg-example-$type"; + # Check for autocreation mappings for host-based file objects. is_deeply( - [default_owner('file', $name)], + [default_owner('file', 'ssl-key/example.stanford.edu')], [ 'host/example.stanford.edu', ['netdb-root', 'example.stanford.edu'], ['krb5', 'host/example.stanford.edu@stanford.edu'] ], - "Default owner for file $name", + 'Default owner for file ssl-key/example.stanford.edu', ); + is_deeply( + [default_owner('file', 'ssl-key/example.stanford.edu/mysql')], + [ + 'host/example.stanford.edu', + ['netdb-root', 'example.stanford.edu'], + ['krb5', 'host/example.stanford.edu@stanford.edu'] + ], + 'Default owner for file ssl-key/example.stanford.edu/mysql', + ); + + # Check for a file object that isn't host-based. + is_deeply( + [default_owner('file', 'config/its-idg/example/foo')], + ['group/its-idg', ['krb5', $ADMIN]], + 'Default owner for file config/its-idg/example/foo', + ); + + # Check for legacy autocreation mappings for file objects. + for my $type (qw(htpasswd ssh-rsa ssh-dsa ssl-key tivoli-key)) { + my $name = "idg-example-$type"; + is_deeply( + [default_owner('file', $name)], + [ + 'host/example.stanford.edu', + ['netdb-root', 'example.stanford.edu'], + ['krb5', 'host/example.stanford.edu@stanford.edu'] + ], + "Default owner for file $name", + ); + } + + # Clean up. + $setup->destroy; } -# Clean up. -$setup->destroy; END { unlink 'wallet-db'; } diff --git a/perl/t/verifier/external.t b/perl/t/verifier/external.t new file mode 100755 index 0000000..d1438de --- /dev/null +++ b/perl/t/verifier/external.t @@ -0,0 +1,35 @@ +#!/usr/bin/perl +# +# Tests for the external wallet ACL verifier. +# +# Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2016 Russ Allbery <eagle@eyrie.org> +# +# See LICENSE for licensing terms. + +use strict; +use warnings; + +use Test::More tests => 9; + +use Wallet::ACL::External; +use Wallet::Config; + +# Configure the external ACL verifier. +$Wallet::Config::EXTERNAL_COMMAND = 't/data/acl-command'; + +# Check a few verifications. +my $verifier = Wallet::ACL::External->new; +ok (defined $verifier, 'Wallet::ACL::External creation'); +ok ($verifier->isa ('Wallet::ACL::External'), ' and class verification'); +is ($verifier->check ('eagle@eyrie.org', 'test success', 'file', 'test'), + 1, 'Success'); +is ($verifier->check ('eagle@eyrie.org', 'test failure', 'file', 'test'), + 0, 'Failure'); +is ($verifier->error, undef, 'No error set'); +is ($verifier->check ('eagle@eyrie.org', 'test error', 'file', 'test'), + undef, 'Error'); +is ($verifier->error, 'some error', ' and right error'); +is ($verifier->check (undef, 'eagle@eyrie.org', 'file', 'test'), undef, + 'Undefined principal'); +is ($verifier->error, 'no principal specified', ' and right error'); diff --git a/perl/t/verifier/ldap-attr.t b/perl/t/verifier/ldap-attr.t index 3c132e2..cff3b63 100755 --- a/perl/t/verifier/ldap-attr.t +++ b/perl/t/verifier/ldap-attr.t @@ -24,16 +24,18 @@ plan skip_all => 'LDAP verifier tests only run for maintainer' unless $ENV{RRA_MAINTAINER_TESTS}; # Declare a plan. -plan tests => 10; +plan tests => 22; require_ok ('Wallet::ACL::LDAP::Attribute'); +require_ok ('Wallet::ACL::LDAP::Attribute::Root'); -my $host = 'ldap.stanford.edu'; -my $base = 'cn=people,dc=stanford,dc=edu'; -my $filter = 'uid'; -my $user = 'rra@stanford.edu'; -my $attr = 'suPrivilegeGroup'; -my $value = 'stanford:stanford'; +my $host = 'ldap.stanford.edu'; +my $base = 'cn=people,dc=stanford,dc=edu'; +my $filter = 'uid'; +my $user = 'jonrober@stanford.edu'; +my $rootuser = 'jonrober/root@stanford.edu'; +my $attr = 'suPrivilegeGroup'; +my $value = 'stanford:stanford'; # Remove the realm from principal names. package Wallet::Config; @@ -68,7 +70,28 @@ SKIP: { is ($verifier->check ($user, "BOGUS=$value"), undef, "Checking BOGUS=$value fails with error"); is ($verifier->error, - 'cannot check LDAP attribute BOGUS for rra: Undefined attribute type', + 'cannot check LDAP attribute BOGUS for jonrober: Undefined attribute type', + '...with correct error'); + is ($verifier->check ('user-does-not-exist', "$attr=$value"), 0, + "Checking for nonexistent user fails"); + is ($verifier->error, undef, '...with no error'); + + # Then also test the root version. + $verifier = eval { Wallet::ACL::LDAP::Attribute::Root->new }; + isa_ok ($verifier, 'Wallet::ACL::LDAP::Attribute::Root'); + is ($verifier->check ($user, "$attr=$value"), 0, + "Checking as a non /root user fails"); + is ($verifier->error, undef, '...with no error'); + is ($verifier->check ($rootuser, "$attr=$value"), 1, + "Checking $attr=$value succeeds"); + is ($verifier->error, undef, '...with no error'); + is ($verifier->check ($rootuser, "$attr=BOGUS"), 0, + "Checking $attr=BOGUS fails"); + is ($verifier->error, undef, '...with no error'); + is ($verifier->check ($rootuser, "BOGUS=$value"), undef, + "Checking BOGUS=$value fails with error"); + is ($verifier->error, + 'cannot check LDAP attribute BOGUS for jonrober: Undefined attribute type', '...with correct error'); is ($verifier->check ('user-does-not-exist', "$attr=$value"), 0, "Checking for nonexistent user fails"); diff --git a/perl/t/verifier/nested.t b/perl/t/verifier/nested.t new file mode 100755 index 0000000..ec7ce40 --- /dev/null +++ b/perl/t/verifier/nested.t @@ -0,0 +1,84 @@ +#!/usr/bin/perl +# +# Tests for the wallet ACL nested verifier. +# +# Written by Jon Robertson <jonrober@stanford.edu> +# Copyright 2015 +# The Board of Trustees of the Leland Stanford Junior University +# +# See LICENSE for licensing terms. + +use strict; +use warnings; + +use Test::More tests => 22; + +use Wallet::ACL::Base; +use Wallet::ACL::Nested; +use Wallet::Admin; +use Wallet::Config; + +use lib 't/lib'; +use Util; + +# Some global defaults to use. +my $admin = 'admin@EXAMPLE.COM'; +my $user1 = 'alice@EXAMPLE.COM'; +my $user2 = 'bob@EXAMPLE.COM'; +my $user3 = 'jack@EXAMPLE.COM'; +my $host = 'localhost'; +my @trace = ($admin, $host, time); + +# Use Wallet::Admin to set up the database. +db_setup; +my $setup = eval { Wallet::Admin->new }; +is ($@, '', 'Database connection succeeded'); +is ($setup->reinitialize ($setup), 1, 'Database initialization succeeded'); +my $schema = $setup->schema; + +# Create a few ACLs for later testing. +my $acl = eval { Wallet::ACL->create ('test', $schema, @trace) }; +ok (defined ($acl), 'ACL creation'); +my $acl_nesting = eval { Wallet::ACL->create ('nesting', $schema, @trace) }; +ok (defined ($acl), ' and another'); +my $acl_deep = eval { Wallet::ACL->create ('deepnesting', $schema, @trace) }; +ok (defined ($acl), ' and another'); + +# Create an verifier to make sure that works +my $verifier = Wallet::ACL::Nested->new ('test', $schema); +ok (defined $verifier, 'Wallet::ACL::Nested creation'); +ok ($verifier->isa ('Wallet::ACL::Nested'), ' and class verification'); +is ($verifier->syntax_check ('notcreated'), 0, + ' and it rejects a nested name that is not already an ACL'); +is ($verifier->syntax_check ('test'), 1, + ' and accepts one that already exists'); + +# Add a few entries to one ACL and then see if they validate. +ok ($acl->add ('krb5', $user1, @trace), 'Added test scheme'); +ok ($acl->add ('krb5', $user2, @trace), ' and another'); +ok ($acl_nesting->add ('nested', 'test', @trace), ' and then nested it'); +ok ($acl_nesting->add ('krb5', $user3, @trace), + ' and added a non-nesting user'); +is ($acl_nesting->check ($user1), 1, ' so check of nested succeeds'); +is ($acl_nesting->check ($user3), 1, ' so check of non-nested succeeds'); +is (scalar ($acl_nesting->list), 2, + ' and the acl has the right number of items'); + +# Add a recursive nesting to make sure it doesn't send us into loop. +ok ($acl_deep->add ('nested', 'test', @trace), + 'Adding deep nesting for one nest succeeds'); +ok ($acl_deep->add ('nested', 'nesting', @trace), ' and another'); +ok ($acl_deep->add ('krb5', $user3, @trace), + ' and added a non-nesting user'); +is ($acl_deep->check ($user1), 1, ' so check of nested succeeds'); +is ($acl_deep->check ($user3), 1, ' so check of non-nested succeeds'); + +# Test getting an error in adding an invalid group to an ACL object itself. +isnt ($acl->add ('nested', 'doesnotexist', @trace), 1, + 'Adding bad nested acl fails'); + +# Clean up. +$setup->destroy; +END { + unlink 'wallet-db'; +} |