From 55875aa020f31751f295ae6c07547fe2949c5e82 Mon Sep 17 00:00:00 2001 From: Jon Robertson Date: Sat, 7 Feb 2015 13:59:34 -0800 Subject: Added a new password object type The password type inherits almost everything from the file object, but if you try to get a password object that has never been stored, we generate a random string to put in the object rather than just erroring out. The maximum and minimum length of the string can be set in the wallet config. If a password object was stored earlier and then cleared out, we don't generate another random string. Change-Id: I17a65ca7dac9d4430e8a731f417297890ee612bb --- perl/lib/Wallet/Admin.pm | 1 + 1 file changed, 1 insertion(+) (limited to 'perl/lib/Wallet/Admin.pm') diff --git a/perl/lib/Wallet/Admin.pm b/perl/lib/Wallet/Admin.pm index 8120e9c..a8b8368 100644 --- a/perl/lib/Wallet/Admin.pm +++ b/perl/lib/Wallet/Admin.pm @@ -131,6 +131,7 @@ sub default_data { [ 'duo-radius', 'Wallet::Object::Duo::RadiusProxy' ], [ 'duo-rdp', 'Wallet::Object::Duo::RDP' ], [ 'file', 'Wallet::Object::File' ], + [ 'password', 'Wallet::Object::Password' ], [ 'keytab', 'Wallet::Object::Keytab' ], [ 'wa-keyring', 'Wallet::Object::WAKeyring' ]); ($r1) = $self->{schema}->resultset('Type')->populate (\@record); -- cgit v1.2.3 From feacbd7d685b1790579f949b3e72a48412835d92 Mon Sep 17 00:00:00 2001 From: Jon Robertson Date: Fri, 17 Apr 2015 13:41:52 -0700 Subject: Merged all Duo objects into one module To handle local proliferation of Duo integration type requests, all Duo types have been merged into one module that will pick up and decide integration specifics off of the object type. If you are using the Duo types locally already, you'll want to load perl/sql/wallet-1.3-update-duo.sql to your database to update the old object types to all use the Duo module. All existing Duo integrations have been added to the module for handling, but nothing new has been added to the wallet object types. Since there are a lot of Duo integrations, sites should only manually add the ones they're interested in to the wallet types table. Change-Id: If9c9a0a3e77923354f31d8f9c98a519c93df200b --- perl/lib/Wallet/Admin.pm | 8 +- perl/lib/Wallet/Object/Duo.pm | 121 ++++++++++++++++-- perl/lib/Wallet/Object/Duo/LDAPProxy.pm | 202 ----------------------------- perl/lib/Wallet/Object/Duo/PAM.pm | 205 ------------------------------ perl/lib/Wallet/Object/Duo/RadiusProxy.pm | 204 ----------------------------- perl/sql/wallet-1.3-update-duo.sql | 9 ++ perl/t/object/duo-ldap.t | 21 ++- perl/t/object/duo-pam.t | 20 ++- perl/t/object/duo-radius.t | 21 ++- perl/t/object/duo-rdp.t | 20 ++- 10 files changed, 162 insertions(+), 669 deletions(-) delete mode 100644 perl/lib/Wallet/Object/Duo/LDAPProxy.pm delete mode 100644 perl/lib/Wallet/Object/Duo/PAM.pm delete mode 100644 perl/lib/Wallet/Object/Duo/RadiusProxy.pm create mode 100644 perl/sql/wallet-1.3-update-duo.sql (limited to 'perl/lib/Wallet/Admin.pm') diff --git a/perl/lib/Wallet/Admin.pm b/perl/lib/Wallet/Admin.pm index a8b8368..b38cc94 100644 --- a/perl/lib/Wallet/Admin.pm +++ b/perl/lib/Wallet/Admin.pm @@ -126,10 +126,10 @@ sub default_data { # 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' ], diff --git a/perl/lib/Wallet/Object/Duo.pm b/perl/lib/Wallet/Object/Duo.pm index d08294b..d0901de 100644 --- a/perl/lib/Wallet/Object/Duo.pm +++ b/perl/lib/Wallet/Object/Duo.pm @@ -29,7 +29,100 @@ use Wallet::Object::Base; # This version should be increased on any code change to this module. Always # use two digits for the minor version with a leading zero if necessary so # that it will sort properly. -$VERSION = '0.02'; +$VERSION = '0.03'; + +# 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; +}; + +############################################################################## +# 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 @@ -86,7 +179,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,6 +188,12 @@ 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"; + } + # Construct the Net::Duo::Admin object. require Net::Duo::Admin; my $duo = Net::Duo::Admin->new ( @@ -106,7 +205,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 +300,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 23894ac..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 -# 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 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 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 = - skey = - api_host = - -The C 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. - -=head1 AUTHORS - -Jon Robertson - -=cut diff --git a/perl/lib/Wallet/Object/Duo/PAM.pm b/perl/lib/Wallet/Object/Duo/PAM.pm deleted file mode 100644 index d9d17f8..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 -# Jon Robertson -# 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 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 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 = - skey = - host = - -The C 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. - -=head1 AUTHORS - -Russ Allbery -Jon Robertson - -=cut diff --git a/perl/lib/Wallet/Object/Duo/RadiusProxy.pm b/perl/lib/Wallet/Object/Duo/RadiusProxy.pm deleted file mode 100644 index a1f6e24..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 -# 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 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 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 = - skey = - api_host = - client = radius_client - -The C 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. - -=head1 AUTHORS - -Jon Robertson - -=cut 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/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'); } -- cgit v1.2.3 From 86533bf43d071048d654691dc18a3004b6142081 Mon Sep 17 00:00:00 2001 From: Jon Robertson Date: Mon, 8 Jun 2015 11:15:37 -0700 Subject: Added nested acl verifier This verifier will allow embedding one ACL in another for more flexible ACL handling. As part of thise we've also added the ability for each verifier to do a syntax check to see if a given name is valid for that verifier. For the moment this returns true for everything but Nested. Nested will check to make sure the given name is an existing group. Change-Id: Iacdf146d46ed882d57b7534058d34db6e6ec1de4 --- perl/lib/Wallet/ACL.pm | 38 +++++++- perl/lib/Wallet/ACL/Base.pm | 13 ++- perl/lib/Wallet/ACL/Nested.pm | 195 ++++++++++++++++++++++++++++++++++++++++++ perl/lib/Wallet/Admin.pm | 1 + perl/t/general/acl.t | 81 ++++++++++-------- perl/t/general/report.t | 9 +- perl/t/policy/stanford.t | 2 +- perl/t/verifier/nested.t | 84 ++++++++++++++++++ 8 files changed, 381 insertions(+), 42 deletions(-) create mode 100644 perl/lib/Wallet/ACL/Nested.pm create mode 100755 perl/t/verifier/nested.t (limited to 'perl/lib/Wallet/Admin.pm') diff --git a/perl/lib/Wallet/ACL.pm b/perl/lib/Wallet/ACL.pm index 260ff22..6d8005d 100644 --- a/perl/lib/Wallet/ACL.pm +++ b/perl/lib/Wallet/ACL.pm @@ -198,6 +198,19 @@ 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 ($@) { @@ -267,6 +280,17 @@ sub destroy { $entry->delete; } + # Find any references to this being used as a nested verifier and + # remove them. This really breaks out of the normal flow, but it's + # hard to do otherwise. + %search = (ae_scheme => 'nested', + ae_identifier => $self->{name}, + ); + @entries = $self->{schema}->resultset('AclEntry')->search(\%search); + for my $entry (@entries) { + $entry->delete; + } + # There should definitely be an ACL record to delete. %search = (ac_id => $self->{id}); my $entry = $self->{schema}->resultset('Acl')->find(\%search); @@ -302,6 +326,18 @@ 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}); + }; + 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}, @@ -446,7 +482,7 @@ sub history { 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; diff --git a/perl/lib/Wallet/ACL/Base.pm b/perl/lib/Wallet/ACL/Base.pm index a2b07cc..19ca612 100644 --- a/perl/lib/Wallet/ACL/Base.pm +++ b/perl/lib/Wallet/ACL/Base.pm @@ -20,7 +20,7 @@ use vars qw($VERSION); # This version should be increased on any code change to this module. Always # use two digits for the minor version with a leading zero if necessary so # that it will sort properly. -$VERSION = '0.02'; +$VERSION = '0.03'; ############################################################################## # Interface @@ -37,6 +37,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,6 +97,12 @@ 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 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) This method should always be overridden by child classes. The default diff --git a/perl/lib/Wallet/ACL/Nested.pm b/perl/lib/Wallet/ACL/Nested.pm new file mode 100644 index 0000000..3be84bd --- /dev/null +++ b/perl/lib/Wallet/ACL/Nested.pm @@ -0,0 +1,195 @@ +# Wallet::ACL::Nested - ACL class for nesting ACLs +# +# Written by Jon Robertson +# Copyright 2015 +# The Board of Trustees of the Leland Stanford Junior University +# +# See LICENSE for licensing terms. + +############################################################################## +# Modules and declarations +############################################################################## + +package Wallet::ACL::Nested; +require 5.006; + +use strict; +use warnings; +use vars qw($VERSION @ISA); + +use Wallet::ACL::Base; + +@ISA = qw(Wallet::ACL::Base); + +# This version should be increased on any code change to this module. Always +# use two digits for the minor version with a leading zero if necessary so +# that it will sort properly. +$VERSION = '0.01'; + +############################################################################## +# Interface +############################################################################## + +# Creates a new persistant verifier, taking a database handle. This parent +# class just creates an empty object and ignores the handle. Child classes +# should override if there are necessary initialization tasks or if the handle +# will be used by the verifier. +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) = @_; + 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 ($type, $name) = @{ $entry }; + my $result = $acl->check_line ($principal, $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::Base - Generic parent class for wallet ACL verifiers + +=head1 SYNOPSIS + + package Wallet::ACL::Simple + @ISA = qw(Wallet::ACL::Base); + sub check { + my ($self, $principal, $acl) = @_; + return ($principal eq $acl) ? 1 : 0; + } + +=head1 DESCRIPTION + +Wallet::ACL::Base is the generic parent class for wallet ACL verifiers. +It provides default functions and behavior and all ACL verifiers should +inherit from it. It is not used directly. + +=head1 METHODS + +=over 4 + +=item new() + +Creates a new ACL verifier. The generic function provided here just +creates and blesses an object. + +=item check(PRINCIPAL, ACL) + +This method should always be overridden by child classes. The default +implementation just declines all access. + +=item error([ERROR ...]) + +Returns the error of the last failing operation or undef if no operations +have failed. Callers should call this function to get the error message +after an undef return from any other instance method. + +For the convenience of child classes, this method can also be called with +one or more error strings. If so, those strings are concatenated +together, trailing newlines are removed, any text of the form S> at the end of the message is stripped off, and the result is +stored as the error. Only child classes should call this method with an +error string. + +=back + +=head1 SEE ALSO + +Wallet::ACL(3), wallet-backend(8) + +This module is part of the wallet system. The current version is +available from L. + +=head1 AUTHOR + +Russ Allbery + +=cut diff --git a/perl/lib/Wallet/Admin.pm b/perl/lib/Wallet/Admin.pm index b38cc94..f6f1f90 100644 --- a/perl/lib/Wallet/Admin.pm +++ b/perl/lib/Wallet/Admin.pm @@ -118,6 +118,7 @@ sub default_data { [ 'krb5', 'Wallet::ACL::Krb5' ], [ 'krb5-regex', 'Wallet::ACL::Krb5::Regex' ], [ 'ldap-attr', 'Wallet::ACL::LDAP::Attribute' ], + [ 'nested', 'Wallet::ACL::Nested' ], [ 'netdb', 'Wallet::ACL::NetDB' ], [ 'netdb-root', 'Wallet::ACL::NetDB::Root' ], ]); diff --git a/perl/t/general/acl.t b/perl/t/general/acl.t index 80e8b3c..aad4b6d 100755 --- a/perl/t/general/acl.t +++ b/perl/t/general/acl.t @@ -12,7 +12,7 @@ use strict; use warnings; use POSIX qw(strftime); -use Test::More tests => 109; +use Test::More tests => 113; use Wallet::ACL; use Wallet::Admin; @@ -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 example 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 example: 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 example: /, +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,6 +217,8 @@ $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'); @@ -225,11 +234,13 @@ 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 diff --git a/perl/t/general/report.t b/perl/t/general/report.t index 170fe29..6f6b750 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 => 218; +use Test::More tests => 219; use Wallet::Admin; use Wallet::Report; @@ -57,13 +57,14 @@ 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), 6, 'There are six acl schemes created'); +is (scalar (@schemes), 7, '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], 'netdb', ' and the fifth member is correct'); -is ($schemes[5][0], 'netdb-root', ' and the sixth member is correct'); +is ($schemes[4][0], 'nested', ' and the fifth member is correct'); +is ($schemes[5][0], 'netdb', ' and the sixth member is correct'); +is ($schemes[6][0], 'netdb-root', ' and the seventh member is correct'); # Create an object. my $server = eval { Wallet::Server->new ('admin@EXAMPLE.COM', 'localhost') }; diff --git a/perl/t/policy/stanford.t b/perl/t/policy/stanford.t index 9ed0fa6..c58985b 100755 --- a/perl/t/policy/stanford.t +++ b/perl/t/policy/stanford.t @@ -140,7 +140,7 @@ is( 'example.stanford.edu'), 1, '...with netdb ACL line' -); + ); is( $server->acl_add('host/example.stanford.edu', 'krb5', 'host/example.stanford.edu@stanford.edu'), 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 +# 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'; +} -- cgit v1.2.3 From 6b0cad572edef05d119abc8fc843c8c5d33665b8 Mon Sep 17 00:00:00 2001 From: Jon Robertson Date: Thu, 27 Aug 2015 10:34:22 -0700 Subject: Added Wallet::ACL::LDAP::Attribute::Root Added a version of the LDAP attribute ACL. Like the root version for NetDB, this requires that the principal end in /root, and then strips off /root before doing matching against the given LDAP attribute. Change-Id: I23119ef9c9ce3e0556f5d71a509815f2efc1bbe6 --- perl/lib/Wallet/ACL/LDAP/Attribute/Root.pm | 128 +++++++++++++++++++++++++++++ perl/lib/Wallet/Admin.pm | 13 +-- perl/lib/Wallet/Schema.pm | 4 + perl/lib/Wallet/Schema/Result/AclScheme.pm | 4 + perl/t/general/report.t | 11 +-- perl/t/verifier/ldap-attr.t | 37 +++++++-- 6 files changed, 179 insertions(+), 18 deletions(-) create mode 100644 perl/lib/Wallet/ACL/LDAP/Attribute/Root.pm (limited to 'perl/lib/Wallet/Admin.pm') 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..eb30931 --- /dev/null +++ b/perl/lib/Wallet/ACL/LDAP/Attribute/Root.pm @@ -0,0 +1,128 @@ +# Wallet::ACL::LDAP::Attribute::Root -- Wallet LDAP ACL verifier (root instances). +# +# Written by Jon Robertson +# From Wallet::ACL::NetDB::Root by Russ Allbery +# 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; +require 5.006; + +use strict; +use warnings; +use vars qw(@ISA $VERSION); + +use Wallet::ACL::LDAP::Attribute; +use Wallet::Config; + +@ISA = qw(Wallet::ACL::LDAP::Attribute); + +# This version should be increased on any code change to this module. Always +# use two digits for the minor version with a leading zero if necessary so +# that it will sort properly. +$VERSION = '0.01'; + +############################################################################## +# Interface +############################################################################## + +# 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 +/root@) and strips the C 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 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 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 and if (with C 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. + +=head1 AUTHORS + +Jon Robertson +Russ Allbery + +=cut diff --git a/perl/lib/Wallet/Admin.pm b/perl/lib/Wallet/Admin.pm index f6f1f90..b4246ba 100644 --- a/perl/lib/Wallet/Admin.pm +++ b/perl/lib/Wallet/Admin.pm @@ -115,12 +115,13 @@ 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' ], - [ 'nested', 'Wallet::ACL::Nested' ], - [ '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; diff --git a/perl/lib/Wallet/Schema.pm b/perl/lib/Wallet/Schema.pm index 5b850c0..386801a 100644 --- a/perl/lib/Wallet/Schema.pm +++ b/perl/lib/Wallet/Schema.pm @@ -113,6 +113,10 @@ Holds the supported ACL schemes and their corresponding Perl classes: values ('krb5-regex', 'Wallet::ACL::Krb5::Regex'); insert into acl_schemes (as_name, as_class) values ('ldap-attr', 'Wallet::ACL::LDAP::Attribute'); + insert into acl_schemes (as_name, as_class) + values ('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) diff --git a/perl/lib/Wallet/Schema/Result/AclScheme.pm b/perl/lib/Wallet/Schema/Result/AclScheme.pm index 91a58b2..be4ec09 100644 --- a/perl/lib/Wallet/Schema/Result/AclScheme.pm +++ b/perl/lib/Wallet/Schema/Result/AclScheme.pm @@ -35,6 +35,10 @@ By default it contains the following entries: values ('krb5-regex', 'Wallet::ACL::Krb5::Regex'); insert into acl_schemes (as_name, as_class) values ('ldap-attr', 'Wallet::ACL::LDAP::Attribute'); + insert into acl_schemes (as_name, as_class) + values ('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) diff --git a/perl/t/general/report.t b/perl/t/general/report.t index a841acd..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 => 222; +use Test::More tests => 223; use Wallet::Admin; use Wallet::Report; @@ -57,14 +57,15 @@ 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), 7, 'There are seven acl schemes created'); +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], 'nested', ' and the fifth member is correct'); -is ($schemes[5][0], 'netdb', ' and the sixth member is correct'); -is ($schemes[6][0], 'netdb-root', ' and the seventh 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') }; diff --git a/perl/t/verifier/ldap-attr.t b/perl/t/verifier/ldap-attr.t index 3caaf8b..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 = 'jonrober@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; @@ -73,4 +75,25 @@ SKIP: { 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"); + is ($verifier->error, undef, '...with no error'); } -- cgit v1.2.3