diff options
author | Russ Allbery <eagle@eyrie.org> | 2014-07-16 13:46:50 -0700 |
---|---|---|
committer | Russ Allbery <eagle@eyrie.org> | 2014-07-16 13:46:50 -0700 |
commit | 1796d631f0846ec98cd286bc4284898a7300ee78 (patch) | |
tree | 6fd42de6dc858ef06c6d270410c32ec61f39e593 /perl | |
parent | f5194217566a6f4cdeffbae551153feb1412210d (diff) | |
parent | 6409733ee3b7b1910dc1c166a392cc628834146c (diff) |
Merge tag 'upstream/1.1' into debian
Upstream version 1.1
Conflicts:
NEWS
README
client/keytab.c
perl/lib/Wallet/ACL.pm
perl/sql/Wallet-Schema-0.08-PostgreSQL.sql
perl/t/general/admin.t
perl/t/verifier/ldap-attr.t
Change-Id: I1a1dc09b97c9258e61f1c8877d0837193c8ae2c6
Diffstat (limited to 'perl')
-rw-r--r-- | perl/Build.PL | 49 | ||||
-rw-r--r-- | perl/MANIFEST | 81 | ||||
-rw-r--r-- | perl/MANIFEST.SKIP | 41 | ||||
-rw-r--r-- | perl/Makefile.PL.in | 18 | ||||
-rwxr-xr-x | perl/create-ddl | 6 | ||||
-rw-r--r-- | perl/lib/Wallet/ACL.pm (renamed from perl/Wallet/ACL.pm) | 38 | ||||
-rw-r--r-- | perl/lib/Wallet/ACL/Base.pm (renamed from perl/Wallet/ACL/Base.pm) | 7 | ||||
-rw-r--r-- | perl/lib/Wallet/ACL/Krb5.pm (renamed from perl/Wallet/ACL/Krb5.pm) | 7 | ||||
-rw-r--r-- | perl/lib/Wallet/ACL/Krb5/Regex.pm (renamed from perl/Wallet/ACL/Krb5/Regex.pm) | 5 | ||||
-rw-r--r-- | perl/lib/Wallet/ACL/LDAP/Attribute.pm (renamed from perl/Wallet/ACL/LDAP/Attribute.pm) | 6 | ||||
-rw-r--r-- | perl/lib/Wallet/ACL/NetDB.pm (renamed from perl/Wallet/ACL/NetDB.pm) | 7 | ||||
-rw-r--r-- | perl/lib/Wallet/ACL/NetDB/Root.pm (renamed from perl/Wallet/ACL/NetDB/Root.pm) | 7 | ||||
-rw-r--r-- | perl/lib/Wallet/Admin.pm (renamed from perl/Wallet/Admin.pm) | 42 | ||||
-rw-r--r-- | perl/lib/Wallet/Config.pm (renamed from perl/Wallet/Config.pm) | 58 | ||||
-rw-r--r-- | perl/lib/Wallet/Database.pm (renamed from perl/Wallet/Database.pm) | 7 | ||||
-rw-r--r-- | perl/lib/Wallet/Kadmin.pm (renamed from perl/Wallet/Kadmin.pm) | 5 | ||||
-rw-r--r-- | perl/lib/Wallet/Kadmin/Heimdal.pm (renamed from perl/Wallet/Kadmin/Heimdal.pm) | 3 | ||||
-rw-r--r-- | perl/lib/Wallet/Kadmin/MIT.pm (renamed from perl/Wallet/Kadmin/MIT.pm) | 7 | ||||
-rw-r--r-- | perl/lib/Wallet/Object/Base.pm (renamed from perl/Wallet/Object/Base.pm) | 107 | ||||
-rw-r--r-- | perl/lib/Wallet/Object/Duo.pm | 332 | ||||
-rw-r--r-- | perl/lib/Wallet/Object/File.pm (renamed from perl/Wallet/Object/File.pm) | 7 | ||||
-rw-r--r-- | perl/lib/Wallet/Object/Keytab.pm (renamed from perl/Wallet/Object/Keytab.pm) | 7 | ||||
-rw-r--r-- | perl/lib/Wallet/Object/WAKeyring.pm (renamed from perl/Wallet/Object/WAKeyring.pm) | 7 | ||||
-rw-r--r-- | perl/lib/Wallet/Policy/Stanford.pm (renamed from perl/Wallet/Policy/Stanford.pm) | 15 | ||||
-rw-r--r-- | perl/lib/Wallet/Report.pm (renamed from perl/Wallet/Report.pm) | 7 | ||||
-rw-r--r-- | perl/lib/Wallet/Schema.pm (renamed from perl/Wallet/Schema.pm) | 37 | ||||
-rw-r--r-- | perl/lib/Wallet/Schema/Result/Acl.pm (renamed from perl/Wallet/Schema/Result/Acl.pm) | 0 | ||||
-rw-r--r-- | perl/lib/Wallet/Schema/Result/AclEntry.pm (renamed from perl/Wallet/Schema/Result/AclEntry.pm) | 0 | ||||
-rw-r--r-- | perl/lib/Wallet/Schema/Result/AclHistory.pm (renamed from perl/Wallet/Schema/Result/AclHistory.pm) | 23 | ||||
-rw-r--r-- | perl/lib/Wallet/Schema/Result/AclScheme.pm (renamed from perl/Wallet/Schema/Result/AclScheme.pm) | 0 | ||||
-rw-r--r-- | perl/lib/Wallet/Schema/Result/Duo.pm | 53 | ||||
-rw-r--r-- | perl/lib/Wallet/Schema/Result/Enctype.pm (renamed from perl/Wallet/Schema/Result/Enctype.pm) | 0 | ||||
-rw-r--r-- | perl/lib/Wallet/Schema/Result/Flag.pm (renamed from perl/Wallet/Schema/Result/Flag.pm) | 0 | ||||
-rw-r--r-- | perl/lib/Wallet/Schema/Result/KeytabEnctype.pm (renamed from perl/Wallet/Schema/Result/KeytabEnctype.pm) | 0 | ||||
-rw-r--r-- | perl/lib/Wallet/Schema/Result/KeytabSync.pm (renamed from perl/Wallet/Schema/Result/KeytabSync.pm) | 0 | ||||
-rw-r--r-- | perl/lib/Wallet/Schema/Result/Object.pm (renamed from perl/Wallet/Schema/Result/Object.pm) | 0 | ||||
-rw-r--r-- | perl/lib/Wallet/Schema/Result/ObjectHistory.pm (renamed from perl/Wallet/Schema/Result/ObjectHistory.pm) | 14 | ||||
-rw-r--r-- | perl/lib/Wallet/Schema/Result/SyncTarget.pm (renamed from perl/Wallet/Schema/Result/SyncTarget.pm) | 0 | ||||
-rw-r--r-- | perl/lib/Wallet/Schema/Result/Type.pm (renamed from perl/Wallet/Schema/Result/Type.pm) | 0 | ||||
-rw-r--r-- | perl/lib/Wallet/Server.pm (renamed from perl/Wallet/Server.pm) | 17 | ||||
-rw-r--r-- | perl/sql/Wallet-Schema-0.08-0.09-MySQL.sql | 24 | ||||
-rw-r--r-- | perl/sql/Wallet-Schema-0.08-0.09-PostgreSQL.sql | 19 | ||||
-rw-r--r-- | perl/sql/Wallet-Schema-0.08-0.09-SQLite.sql | 17 | ||||
-rw-r--r-- | perl/sql/Wallet-Schema-0.08-PostgreSQL.sql | 5 | ||||
-rw-r--r-- | perl/sql/Wallet-Schema-0.09-MySQL.sql | 229 | ||||
-rw-r--r-- | perl/sql/Wallet-Schema-0.09-PostgreSQL.sql | 234 | ||||
-rw-r--r-- | perl/sql/Wallet-Schema-0.09-SQLite.sql | 238 | ||||
-rw-r--r-- | perl/t/data/duo/integration.json | 11 | ||||
-rw-r--r-- | perl/t/data/duo/keys.json | 5 | ||||
-rw-r--r-- | perl/t/data/perl.conf | 7 | ||||
-rwxr-xr-x | perl/t/docs/pod-spelling.t | 66 | ||||
-rwxr-xr-x | perl/t/docs/pod.t | 65 | ||||
-rwxr-xr-x | perl/t/general/acl.t (renamed from perl/t/acl.t) | 22 | ||||
-rwxr-xr-x | perl/t/general/admin.t (renamed from perl/t/admin.t) | 35 | ||||
-rwxr-xr-x | perl/t/general/config.t (renamed from perl/t/config.t) | 9 | ||||
-rwxr-xr-x | perl/t/general/init.t (renamed from perl/t/init.t) | 13 | ||||
-rwxr-xr-x | perl/t/general/report.t (renamed from perl/t/report.t) | 15 | ||||
-rwxr-xr-x | perl/t/general/server.t (renamed from perl/t/server.t) | 53 | ||||
-rw-r--r-- | perl/t/lib/Util.pm | 5 | ||||
-rwxr-xr-x | perl/t/object/base.t (renamed from perl/t/object.t) | 25 | ||||
-rwxr-xr-x | perl/t/object/duo.t | 157 | ||||
-rwxr-xr-x | perl/t/object/file.t (renamed from perl/t/file.t) | 15 | ||||
-rwxr-xr-x | perl/t/object/keytab.t (renamed from perl/t/keytab.t) | 42 | ||||
-rwxr-xr-x | perl/t/object/wa-keyring.t (renamed from perl/t/wa-keyring.t) | 9 | ||||
-rwxr-xr-x | perl/t/pod-spelling.t | 74 | ||||
-rwxr-xr-x | perl/t/pod.t | 15 | ||||
-rwxr-xr-x | perl/t/policy/stanford.t (renamed from perl/t/stanford-naming.t) | 15 | ||||
-rwxr-xr-x | perl/t/style/minimum-version.t | 47 | ||||
-rwxr-xr-x | perl/t/style/strict.t | 56 | ||||
-rwxr-xr-x | perl/t/util/kadmin.t (renamed from perl/t/kadmin.t) | 8 | ||||
-rwxr-xr-x | perl/t/verifier/basic.t (renamed from perl/t/verifier.t) | 23 | ||||
-rwxr-xr-x | perl/t/verifier/ldap-attr.t (renamed from perl/t/verifier-ldap-attr.t) | 7 | ||||
-rwxr-xr-x | perl/t/verifier/netdb.t (renamed from perl/t/verifier-netdb.t) | 18 |
73 files changed, 2225 insertions, 378 deletions
diff --git a/perl/Build.PL b/perl/Build.PL new file mode 100644 index 0000000..968ae37 --- /dev/null +++ b/perl/Build.PL @@ -0,0 +1,49 @@ +#!/usr/bin/perl +# +# Build script for the wallet distribution. +# +# Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2014 +# The Board of Trustees of the Leland Stanford Junior University +# +# See LICENSE for licensing terms. + +use 5.006; +use strict; +use warnings; + +use Module::Build; + +# Basic package configuration. +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', + license => 'mit', + module_name => 'Wallet::Server', + recursive_test_files => 1, + + # Other package relationships. + configure_requires => { 'Module::Build' => 0.28 }, + requires => { + 'Date::Parse' => 0, + DateTime => 0, + 'DBIx::Class' => 0, + DBI => 0, + 'Digest::MD5' => 0, + 'SQL::Translator' => 0, + perl => '5.008', + }, + recommends => { + 'Authen::SASL' => 0, + 'Heimdal::Kadm5' => 0, + 'Net::Duo' => 0, + 'Net::LDAP' => 0, + 'Net::Remctl' => 0, + WebAuth => 0, + }, +); + +# Generate the build script. +$build->create_build_script; diff --git a/perl/MANIFEST b/perl/MANIFEST new file mode 100644 index 0000000..77aef98 --- /dev/null +++ b/perl/MANIFEST @@ -0,0 +1,81 @@ +Build.PL +create-ddl +lib/Wallet/ACL.pm +lib/Wallet/ACL/Base.pm +lib/Wallet/ACL/Krb5.pm +lib/Wallet/ACL/Krb5/Regex.pm +lib/Wallet/ACL/LDAP/Attribute.pm +lib/Wallet/ACL/NetDB.pm +lib/Wallet/ACL/NetDB/Root.pm +lib/Wallet/Admin.pm +lib/Wallet/Config.pm +lib/Wallet/Database.pm +lib/Wallet/Kadmin.pm +lib/Wallet/Kadmin/Heimdal.pm +lib/Wallet/Kadmin/MIT.pm +lib/Wallet/Object/Base.pm +lib/Wallet/Object/Duo.pm +lib/Wallet/Object/File.pm +lib/Wallet/Object/Keytab.pm +lib/Wallet/Object/WAKeyring.pm +lib/Wallet/Policy/Stanford.pm +lib/Wallet/Report.pm +lib/Wallet/Schema.pm +lib/Wallet/Schema/Result/Acl.pm +lib/Wallet/Schema/Result/AclEntry.pm +lib/Wallet/Schema/Result/AclHistory.pm +lib/Wallet/Schema/Result/AclScheme.pm +lib/Wallet/Schema/Result/Duo.pm +lib/Wallet/Schema/Result/Enctype.pm +lib/Wallet/Schema/Result/Flag.pm +lib/Wallet/Schema/Result/KeytabEnctype.pm +lib/Wallet/Schema/Result/KeytabSync.pm +lib/Wallet/Schema/Result/Object.pm +lib/Wallet/Schema/Result/ObjectHistory.pm +lib/Wallet/Schema/Result/SyncTarget.pm +lib/Wallet/Schema/Result/Type.pm +lib/Wallet/Server.pm +MANIFEST This list of files +MANIFEST.SKIP +sql/Wallet-Schema-0.07-0.08-MySQL.sql +sql/Wallet-Schema-0.07-0.08-SQLite.sql +sql/Wallet-Schema-0.07-MySQL.sql +sql/Wallet-Schema-0.07-SQLite.sql +sql/Wallet-Schema-0.08-0.09-MySQL.sql +sql/Wallet-Schema-0.08-0.09-PostgreSQL.sql +sql/Wallet-Schema-0.08-0.09-SQLite.sql +sql/Wallet-Schema-0.08-MySQL.sql +sql/Wallet-Schema-0.08-PostgreSQL.sql +sql/Wallet-Schema-0.08-SQLite.sql +sql/Wallet-Schema-0.09-MySQL.sql +sql/Wallet-Schema-0.09-PostgreSQL.sql +sql/Wallet-Schema-0.09-SQLite.sql +t/data/duo/integration.json +t/data/duo/keys.json +t/data/keytab-fake +t/data/keytab.conf +t/data/netdb-fake +t/data/netdb.conf +t/data/perl.conf +t/data/README +t/docs/pod-spelling.t +t/docs/pod.t +t/general/acl.t +t/general/admin.t +t/general/config.t +t/general/init.t +t/general/report.t +t/general/server.t +t/lib/Util.pm +t/object/base.t +t/object/duo.t +t/object/file.t +t/object/keytab.t +t/object/wa-keyring.t +t/policy/stanford.t +t/style/minimum-version.t +t/style/strict.t +t/util/kadmin.t +t/verifier/basic.t +t/verifier/ldap-attr.t +t/verifier/netdb.t diff --git a/perl/MANIFEST.SKIP b/perl/MANIFEST.SKIP new file mode 100644 index 0000000..82fa711 --- /dev/null +++ b/perl/MANIFEST.SKIP @@ -0,0 +1,41 @@ +# -*- conf -*- + +# Avoid generated build files. +\bblib/ + +# Avoid Module::Build generated and utility files. +\bBuild$ +\b_build/ +\bBuild.bat$ +\bBuild.COM$ +\bBUILD.COM$ +\bbuild.com$ + +# Avoid temp and backup files. +~$ +\.old$ +\#$ +\b\.# +\.bak$ +\.tmp$ +\.# +\.rej$ + +# Avoid OS-specific files/dirs +# Mac OSX metadata +\B\.DS_Store +# Mac OSX SMB mount metadata files +\B\._ + +# Avoid Devel::Cover and Devel::CoverX::Covered files. +\bcover_db\b +\bcovered\b + +# Avoid MYMETA files +^MYMETA\. + +# Avoid archives of this distribution +\bWallet-[\d\.\_]+ + +# Avoid local test configuration files. +^t/config diff --git a/perl/Makefile.PL.in b/perl/Makefile.PL.in deleted file mode 100644 index 5804d9b..0000000 --- a/perl/Makefile.PL.in +++ /dev/null @@ -1,18 +0,0 @@ -# Makefile.PL for the Wallet Perl library. -*- perl -*- - -use ExtUtils::MakeMaker; - -my $version = '@PACKAGE_VERSION@'; -$version =~ s/\.(\d)$/.0$1/; - -# Set a prefix for ExtUtils::MakeMaker if we were given one for configure. -my $prefix = "@prefix@"; - -WriteMakefile( - NAME => 'Wallet', - VERSION => $version, - ABSTRACT => 'Wallet: a secure credential management system', - AUTHOR => 'Russ Allbery (rra@stanford.edu)', - (($prefix ne '/usr' && $prefix ne '/usr/local') ? - (PREFIX => $prefix) : ()) -); diff --git a/perl/create-ddl b/perl/create-ddl index 09225fa..b2b6f95 100755 --- a/perl/create-ddl +++ b/perl/create-ddl @@ -1,9 +1,9 @@ #!/usr/bin/perl -w # -# create-ddl - Create DDL files for Wallet +# Create DDL files for the wallet. # # Written by Jon Robertson <jonrober@stanford.edu> -# Copyright 2012 +# Copyright 2012, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -15,6 +15,8 @@ use strict; use vars qw(); +use lib 'lib'; + use Getopt::Long; use Wallet::Admin; diff --git a/perl/Wallet/ACL.pm b/perl/lib/Wallet/ACL.pm index 15a380f..a3b0146 100644 --- a/perl/Wallet/ACL.pm +++ b/perl/lib/Wallet/ACL.pm @@ -1,7 +1,7 @@ # Wallet::ACL -- Implementation of ACLs in the wallet system. # -# Written by Russ Allbery <rra@stanford.edu> -# Copyright 2007, 2008, 2010, 2013 +# Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2007, 2008, 2010, 2013, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -14,15 +14,16 @@ package Wallet::ACL; require 5.006; use strict; +use warnings; use vars qw($VERSION); +use DateTime; use DBI; -use POSIX qw(strftime); # This version should be increased on any code change to this module. Always # use two digits for the minor version with a leading zero if necessary so # that it will sort properly. -$VERSION = '0.07'; +$VERSION = '0.08'; ############################################################################## # Constructors @@ -77,15 +78,15 @@ sub create { die "unable to retrieve new ACL ID" unless defined $id; # Add to the history table. - my $date = strftime ('%Y-%m-%d %T', localtime $time); + my $date = DateTime->from_epoch (epoch => $time); %record = (ah_acl => $id, + ah_name => $name, ah_action => 'create', ah_by => $user, ah_from => $host, ah_on => $date); my $history = $schema->resultset('AclHistory')->create (\%record); die "unable to create new history entry" unless defined $history; - $guard->commit; }; if ($@) { @@ -160,16 +161,18 @@ sub scheme_mapping { # change and should be committed with that change. sub log_acl { my ($self, $action, $scheme, $identifier, $user, $host, $time) = @_; - unless ($action =~ /^(add|remove)\z/) { + unless ($action =~ /^(add|remove|rename)\z/) { die "invalid history action $action"; } + my $date = DateTime->from_epoch (epoch => $time); my %record = (ah_acl => $self->{id}, + ah_name => $self->{name}, ah_action => $action, ah_scheme => $scheme, ah_identifier => $identifier, ah_by => $user, ah_from => $host, - ah_on => strftime ('%Y-%m-%d %T', localtime $time)); + ah_on => $date); $self->{schema}->resultset('AclHistory')->create (\%record); } @@ -181,7 +184,8 @@ sub log_acl { # logged since it isn't a change to any of the data stored in the wallet. # Returns true on success, false on failure. sub rename { - my ($self, $name) = @_; + my ($self, $name, $user, $host, $time) = @_; + $time ||= time; if ($name =~ /^\d+\z/) { $self->error ("ACL name may not be all numbers"); return; @@ -192,6 +196,7 @@ sub rename { my $acls = $self->{schema}->resultset('Acl')->find (\%search); $acls->ac_name ($name); $acls->update; + $self->log_acl ('rename', undef, undef, $user, $host, $time); $guard->commit; }; if ($@) { @@ -241,11 +246,13 @@ sub destroy { $entry->delete if defined $entry; # Create new history line for the deletion. - my %record = (ah_acl => $self->{id}, + my $date = DateTime->from_epoch (epoch => $time); + my %record = (ah_acl => $self->{id}, + ah_name => $self->{name}, ah_action => 'destroy', ah_by => $user, ah_from => $host, - ah_on => strftime ('%Y-%m-%d %T', localtime $time)); + ah_on => $date); $self->{schema}->resultset('AclHistory')->create (\%record); $guard->commit; }; @@ -371,11 +378,14 @@ sub history { my @data = $self->{schema}->resultset('AclHistory') ->search (\%search, \%options); for my $data (@data) { - $output .= sprintf ("%s %s ", $data->ah_on->ymd, - $data->ah_on->hms); + my $date = $data->ah_on; + $date->set_time_zone ('local'); + $output .= sprintf ("%s %s ", $date->ymd, $date->hms); if ($data->ah_action eq 'add' || $data->ah_action eq 'remove') { $output .= sprintf ("%s %s %s", $data->ah_action, $data->ah_scheme, $data->ah_identifier); + } elsif ($data->ah_action eq 'rename') { + $output .= 'rename from ' . $data->ah_name; } else { $output .= $data->ah_action; } @@ -652,6 +662,6 @@ available from L<http://www.eyrie.org/~eagle/software/wallet/>. =head1 AUTHOR -Russ Allbery <rra@stanford.edu> +Russ Allbery <eagle@eyrie.org> =cut diff --git a/perl/Wallet/ACL/Base.pm b/perl/lib/Wallet/ACL/Base.pm index 5112c2f..a2b07cc 100644 --- a/perl/Wallet/ACL/Base.pm +++ b/perl/lib/Wallet/ACL/Base.pm @@ -1,7 +1,7 @@ # Wallet::ACL::Base -- Parent class for wallet ACL verifiers. # -# Written by Russ Allbery <rra@stanford.edu> -# Copyright 2007, 2010 +# Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2007, 2010, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -14,6 +14,7 @@ package Wallet::ACL::Base; require 5.006; use strict; +use warnings; use vars qw($VERSION); # This version should be increased on any code change to this module. Always @@ -120,6 +121,6 @@ available from L<http://www.eyrie.org/~eagle/software/wallet/>. =head1 AUTHOR -Russ Allbery <rra@stanford.edu> +Russ Allbery <eagle@eyrie.org> =cut diff --git a/perl/Wallet/ACL/Krb5.pm b/perl/lib/Wallet/ACL/Krb5.pm index 716a223..80d32bd 100644 --- a/perl/Wallet/ACL/Krb5.pm +++ b/perl/lib/Wallet/ACL/Krb5.pm @@ -1,7 +1,7 @@ # Wallet::ACL::Krb5 -- Wallet Kerberos v5 principal ACL verifier. # -# Written by Russ Allbery <rra@stanford.edu> -# Copyright 2007, 2010 +# Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2007, 2010, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -14,6 +14,7 @@ package Wallet::ACL::Krb5; require 5.006; use strict; +use warnings; use vars qw(@ISA $VERSION); use Wallet::ACL::Base; @@ -120,6 +121,6 @@ available from L<http://www.eyrie.org/~eagle/software/wallet/>. =head1 AUTHOR -Russ Allbery <rra@stanford.edu> +Russ Allbery <eagle@eyrie.org> =cut diff --git a/perl/Wallet/ACL/Krb5/Regex.pm b/perl/lib/Wallet/ACL/Krb5/Regex.pm index ce2fe48..4934cfc 100644 --- a/perl/Wallet/ACL/Krb5/Regex.pm +++ b/perl/lib/Wallet/ACL/Krb5/Regex.pm @@ -1,7 +1,7 @@ # Wallet::ACL::Krb5::Regex -- Wallet Kerberos v5 principal regex ACL verifier # -# Written by Russ Allbery <rra@stanford.edu> -# Copyright 2007, 2010 +# Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2007, 2010, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -14,6 +14,7 @@ package Wallet::ACL::Krb5::Regex; require 5.006; use strict; +use warnings; use vars qw(@ISA $VERSION); use Wallet::ACL::Krb5; diff --git a/perl/Wallet/ACL/LDAP/Attribute.pm b/perl/lib/Wallet/ACL/LDAP/Attribute.pm index 802c710..c27729e 100644 --- a/perl/Wallet/ACL/LDAP/Attribute.pm +++ b/perl/lib/Wallet/ACL/LDAP/Attribute.pm @@ -1,7 +1,7 @@ # Wallet::ACL::LDAP::Attribute -- Wallet LDAP attribute ACL verifier. # # Written by Russ Allbery -# Copyright 2012 +# Copyright 2012, 2013, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -14,11 +14,13 @@ package Wallet::ACL::LDAP::Attribute; require 5.006; use strict; +use warnings; use vars qw(@ISA $VERSION); use Authen::SASL (); use Net::LDAP qw(LDAP_COMPARE_TRUE); use Wallet::ACL::Base; +use Wallet::Config; @ISA = qw(Wallet::ACL::Base); @@ -257,6 +259,6 @@ available from L<http://www.eyrie.org/~eagle/software/wallet/>. =head1 AUTHOR -Russ Allbery <rra@stanford.edu> +Russ Allbery <eagle@eyrie.org> =cut diff --git a/perl/Wallet/ACL/NetDB.pm b/perl/lib/Wallet/ACL/NetDB.pm index 2d35f49..ad2164b 100644 --- a/perl/Wallet/ACL/NetDB.pm +++ b/perl/lib/Wallet/ACL/NetDB.pm @@ -1,7 +1,7 @@ # Wallet::ACL::NetDB -- Wallet NetDB role ACL verifier. # -# Written by Russ Allbery <rra@stanford.edu> -# Copyright 2007, 2010 +# Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2007, 2010, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -14,6 +14,7 @@ package Wallet::ACL::NetDB; require 5.006; use strict; +use warnings; use vars qw(@ISA $VERSION); use Wallet::ACL::Base; @@ -262,6 +263,6 @@ available from L<http://www.eyrie.org/~eagle/software/wallet/>. =head1 AUTHOR -Russ Allbery <rra@stanford.edu> +Russ Allbery <eagle@eyrie.org> =cut diff --git a/perl/Wallet/ACL/NetDB/Root.pm b/perl/lib/Wallet/ACL/NetDB/Root.pm index ea79d79..34163e7 100644 --- a/perl/Wallet/ACL/NetDB/Root.pm +++ b/perl/lib/Wallet/ACL/NetDB/Root.pm @@ -1,7 +1,7 @@ # Wallet::ACL::NetDB::Root -- Wallet NetDB role ACL verifier (root instances). # -# Written by Russ Allbery <rra@stanford.edu> -# Copyright 2007, 2010 +# Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2007, 2010, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -14,6 +14,7 @@ package Wallet::ACL::NetDB::Root; require 5.006; use strict; +use warnings; use vars qw(@ISA $VERSION); use Wallet::ACL::NetDB; @@ -123,6 +124,6 @@ available from L<http://www.eyrie.org/~eagle/software/wallet/>. =head1 AUTHOR -Russ Allbery <rra@stanford.edu> +Russ Allbery <eagle@eyrie.org> =cut diff --git a/perl/Wallet/Admin.pm b/perl/lib/Wallet/Admin.pm index 42476e9..8481979 100644 --- a/perl/Wallet/Admin.pm +++ b/perl/lib/Wallet/Admin.pm @@ -1,7 +1,7 @@ # Wallet::Admin -- Wallet system administrative interface. # -# Written by Russ Allbery <rra@stanford.edu> -# Copyright 2008, 2009, 2010, 2011, 2012, 2013 +# Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2008, 2009, 2010, 2011, 2012, 2013, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -14,6 +14,7 @@ package Wallet::Admin; require 5.006; use strict; +use warnings; use vars qw($VERSION); use Wallet::ACL; @@ -97,13 +98,22 @@ sub initialize { $self->default_data; # Create a default admin ACL. - my $acl = Wallet::ACL->create ('ADMIN', $self->{schema}, $user, - 'localhost'); - unless ($acl->add ('krb5', $user, $user, 'localhost')) { - $self->error ($acl->error); + eval { + my $guard = $self->{schema}->txn_scope_guard; + $self->{schema}->resultset ('Acl')->populate ([ + [ qw/ac_id ac_name/ ], + [ 1, 'ADMIN' ], + ]); + $self->{schema}->resultset ('AclEntry')->populate ([ + [ qw/ae_id ae_scheme ae_identifier/ ], + [ 1, 'krb5', $user ], + ]); + $guard->commit; + }; + if ($@) { + $self->error ("cannot add ADMIN ACL: $@"); return; } - return 1; } @@ -131,6 +141,16 @@ sub default_data { ($r1) = $self->{schema}->resultset('Type')->populate (\@record); warn "default Type not installed" unless defined $r1; + # enctypes default rows. + @record = ([ qw/en_name/ ], + [ 'aes128-cts-hmac-sha1-96' ], + [ 'aes256-cts-hmac-sha1-96' ], + [ 'arcfour-hmac-md5' ], + [ 'des-cbc-crc' ], + [ 'des3-cbc-sha1' ]); + ($r1) = $self->{schema}->resultset('Enctype')->populate (\@record); + warn "default Enctype not installed" unless defined $r1; + return 1; } @@ -150,9 +170,9 @@ sub destroy { # Get an actual DBI handle and use it to delete all tables. my $dbh = $self->dbh; - my @tables = qw/acls acl_entries acl_history acl_schemes enctypes - flags keytab_enctypes keytab_sync objects object_history - sync_targets types dbix_class_schema_versions/; + my @tables = qw/acl_entries object_history objects acls acl_history + acl_schemes enctypes flags keytab_enctypes keytab_sync sync_targets + duo types dbix_class_schema_versions/; for my $table (@tables) { my $sql = "DROP TABLE IF EXISTS $table"; $dbh->do ($sql); @@ -364,6 +384,6 @@ available from L<http://www.eyrie.org/~eagle/software/wallet/>. =head1 AUTHOR -Russ Allbery <rra@stanford.edu> +Russ Allbery <eagle@eyrie.org> =cut diff --git a/perl/Wallet/Config.pm b/perl/lib/Wallet/Config.pm index af153e7..527658c 100644 --- a/perl/Wallet/Config.pm +++ b/perl/lib/Wallet/Config.pm @@ -1,7 +1,7 @@ # Wallet::Config -- Configuration handling for the wallet server. # -# Written by Russ Allbery <rra@stanford.edu> -# Copyright 2007, 2008, 2010, 2013 +# Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2007, 2008, 2010, 2013, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -10,6 +10,7 @@ package Wallet::Config; require 5.006; use strict; +use warnings; use vars qw($PATH $VERSION); # This version should be increased on any code change to this module. Always @@ -28,7 +29,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 +rekeys WebAuth WEBAUTH keyring LDAP DN GSS-API integrations =head1 SYNOPSIS @@ -181,6 +182,51 @@ our $DB_PASSWORD; =back +=head1 DUO OBJECT CONFIGURATION + +These configuration variables only need to be set if you intend to use the +C<duo> object type (the Wallet::Object::Duo class). + +=over 4 + +=item DUO_AGENT + +If this configuration variable is set, its value should be an object that +is call-compatible with LWP::UserAgent. This object will be used instead +of LWP::UserAgent to make API calls to Duo. This is primarily useful for +testing, allowing replacement of the user agent with a mock implementation +so that a test can run without needing a Duo account. + +=cut + +our $DUO_AGENT; + +=item DUO_KEY_FILE + +The path to a file in JSON format that contains the key and hostname data +for the Duo Admin API integration used to manage integrations via wallet. +This file should be in the format expected by the C<key_file> parameter +to the Net::Duo::Admin constructor. See L<Net::Duo::Admin> for more +information. + +DUO_KEY_FILE must be set to use Duo objects. + +=cut + +our $DUO_KEY_FILE; + +=item DUO_TYPE + +The type of integration to create. Currently, only one type of integration +can be created by one wallet configuration. This restriction may be relaxed +in the future. The default value is C<unix> to create UNIX integrations. + +=cut + +our $DUO_TYPE = 'unix'; + +=back + =head1 FILE OBJECT CONFIGURATION These configuration variables only need to be set if you intend to use the @@ -511,7 +557,7 @@ matches the Kerberos principal. The attribute designated by LDAP_FILTER_ATTR may instead hold a transformation of the principal name (such as the principal with the local realm stripped off, or rewritten into an LDAP DN form). If this is the case, define a Perl function named -ldap_map_attribute. This function will be called whenever an LDAP +ldap_map_principal. This function will be called whenever an LDAP attribute ACL is being verified. It will take one argument, the principal, and is expected to return the value to search for in the LDAP directory server. @@ -520,7 +566,7 @@ For example, if the principal name without the local realm is stored in the C<uid> attribute in the directory, set LDAP_FILTER_ATTR to C<uid> and then define ldap_map_attribute as follows: - sub ldap_map_attribute { + sub ldap_map_principal { my ($principal) = @_; $principal =~ s/\@EXAMPLE\.COM$//; return $principal; @@ -776,6 +822,6 @@ available from L<http://www.eyrie.org/~eagle/software/wallet/>. =head1 AUTHOR -Russ Allbery <rra@stanford.edu> +Russ Allbery <eagle@eyrie.org> =cut diff --git a/perl/Wallet/Database.pm b/perl/lib/Wallet/Database.pm index 61de0ba..3a4e130 100644 --- a/perl/Wallet/Database.pm +++ b/perl/lib/Wallet/Database.pm @@ -5,8 +5,8 @@ # intention is that Wallet::Database objects can be treated in all respects # like DBIx::Class objects in the rest of the code. # -# Written by Russ Allbery <rra@stanford.edu> -# Copyright 2008, 2009, 2010, 2012, 2013 +# Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2008, 2009, 2010, 2012, 2013, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -19,6 +19,7 @@ package Wallet::Database; require 5.006; use strict; +use warnings; use vars qw(@ISA $VERSION); use Wallet::Schema; @@ -118,6 +119,6 @@ available from L<http://www.eyrie.org/~eagle/software/wallet/>. =head1 AUTHOR -Russ Allbery <rra@stanford.edu> +Russ Allbery <eagle@eyrie.org> =cut diff --git a/perl/Wallet/Kadmin.pm b/perl/lib/Wallet/Kadmin.pm index bfff3ef..65a5700 100644 --- a/perl/Wallet/Kadmin.pm +++ b/perl/lib/Wallet/Kadmin.pm @@ -1,7 +1,7 @@ # Wallet::Kadmin -- Kerberos administration API for wallet keytab backend. # # Written by Jon Robertson <jonrober@stanford.edu> -# Copyright 2009, 2010 +# Copyright 2009, 2010, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -14,6 +14,7 @@ package Wallet::Kadmin; require 5.006; use strict; +use warnings; use vars qw($VERSION); use Wallet::Config (); @@ -235,6 +236,6 @@ available from L<http://www.eyrie.org/~eagle/software/wallet/>. =head1 AUTHORS -Jon Robertson <jonrober@stanford.edu> and Russ Allbery <rra@stanford.edu> +Jon Robertson <jonrober@stanford.edu> and Russ Allbery <eagle@eyrie.org> =cut diff --git a/perl/Wallet/Kadmin/Heimdal.pm b/perl/lib/Wallet/Kadmin/Heimdal.pm index a1d63ae..1208801 100644 --- a/perl/Wallet/Kadmin/Heimdal.pm +++ b/perl/lib/Wallet/Kadmin/Heimdal.pm @@ -14,6 +14,7 @@ package Wallet::Kadmin::Heimdal; require 5.006; use strict; +use warnings; use vars qw(@ISA $VERSION); use Heimdal::Kadm5 qw(KRB5_KDB_DISALLOW_ALL_TIX); @@ -309,6 +310,6 @@ available from L<http://www.eyrie.org/~eagle/software/wallet/>. =head1 AUTHORS -Russ Allbery <rra@stanford.edu> and Jon Robertson <jonrober@stanford.edu>. +Russ Allbery <eagle@eyrie.org> and Jon Robertson <jonrober@stanford.edu>. =cut diff --git a/perl/Wallet/Kadmin/MIT.pm b/perl/lib/Wallet/Kadmin/MIT.pm index b633e67..ac45265 100644 --- a/perl/Wallet/Kadmin/MIT.pm +++ b/perl/lib/Wallet/Kadmin/MIT.pm @@ -1,8 +1,8 @@ # Wallet::Kadmin::MIT -- Wallet Kerberos administration API for MIT. # -# Written by Russ Allbery <rra@stanford.edu> +# Written by Russ Allbery <eagle@eyrie.org> # Pulled into a module by Jon Robertson <jonrober@stanford.edu> -# Copyright 2007, 2008, 2009, 2010 +# Copyright 2007, 2008, 2009, 2010, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -15,6 +15,7 @@ package Wallet::Kadmin::MIT; require 5.006; use strict; +use warnings; use vars qw(@ISA $VERSION); use Wallet::Config (); @@ -318,6 +319,6 @@ available from L<http://www.eyrie.org/~eagle/software/wallet/>. =head1 AUTHORS -Russ Allbery <rra@stanford.edu> and Jon Robertson <jonrober@stanford.edu>. +Russ Allbery <eagle@eyrie.org> and Jon Robertson <jonrober@stanford.edu>. =cut diff --git a/perl/Wallet/Object/Base.pm b/perl/lib/Wallet/Object/Base.pm index dd128cc..a6a78bf 100644 --- a/perl/Wallet/Object/Base.pm +++ b/perl/lib/Wallet/Object/Base.pm @@ -1,7 +1,7 @@ # Wallet::Object::Base -- Parent class for any object stored in the wallet. # -# Written by Russ Allbery <rra@stanford.edu> -# Copyright 2007, 2008, 2010, 2011 +# Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2007, 2008, 2010, 2011, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -14,17 +14,19 @@ package Wallet::Object::Base; require 5.006; use strict; +use warnings; use vars qw($VERSION); +use DateTime; +use Date::Parse qw(str2time); use DBI; -use POSIX qw(strftime); 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.06'; +$VERSION = '0.08'; ############################################################################## # Constructors @@ -62,22 +64,20 @@ sub create { die "invalid object name\n" unless $name; my $guard = $schema->txn_scope_guard; eval { + my $date = DateTime->from_epoch (epoch => $time); my %record = (ob_type => $type, ob_name => $name, ob_created_by => $user, ob_created_from => $host, - ob_created_on => strftime ('%Y-%m-%d %T', - localtime $time)); + ob_created_on => $date); $schema->resultset('Object')->create (\%record); - %record = (oh_type => $type, oh_name => $name, oh_action => 'create', oh_by => $user, oh_from => $host, - oh_on => strftime ('%Y-%m-%d %T', localtime $time)); + oh_on => $date); $schema->resultset('ObjectHistory')->create (\%record); - $guard->commit; }; if ($@) { @@ -138,27 +138,27 @@ sub log_action { # assume that AutoCommit is turned off. my $guard = $self->{schema}->txn_scope_guard; eval { + my $date = DateTime->from_epoch (epoch => $time); my %record = (oh_type => $self->{type}, oh_name => $self->{name}, oh_action => $action, oh_by => $user, oh_from => $host, - oh_on => strftime ('%Y-%m-%d %T', localtime $time)); + oh_on => $date); $self->{schema}->resultset('ObjectHistory')->create (\%record); + # Add in more timestamps based on the action type. my %search = (ob_type => $self->{type}, ob_name => $self->{name}); my $object = $self->{schema}->resultset('Object')->find (\%search); if ($action eq 'get') { $object->ob_downloaded_by ($user); $object->ob_downloaded_from ($host); - $object->ob_downloaded_on (strftime ('%Y-%m-%d %T', - localtime $time)); + $object->ob_downloaded_on ($date); } elsif ($action eq 'store') { $object->ob_stored_by ($user); $object->ob_stored_from ($host); - $object->ob_stored_on (strftime ('%Y-%m-%d %T', - localtime $time)); + $object->ob_stored_on ($date); } $object->update; $guard->commit; @@ -192,6 +192,7 @@ sub log_set { die "invalid history field $field"; } + my $date = DateTime->from_epoch (epoch => $time); my %record = (oh_type => $self->{type}, oh_name => $self->{name}, oh_action => 'set', @@ -201,7 +202,7 @@ sub log_set { oh_new => $new, oh_by => $user, oh_from => $host, - oh_on => strftime ('%Y-%m-%d %T', localtime $time)); + oh_on => $date); $self->{schema}->resultset('ObjectHistory')->create (\%record); } @@ -230,10 +231,20 @@ sub _set_internal { my %search = (ob_type => $type, ob_name => $name); my $object = $self->{schema}->resultset('Object')->find (\%search); - my $old = $object->get_column ("ob_$attr"); - - $object->update ({ "ob_$attr" => $value }); - $self->log_set ($attr, $old, $value, $user, $host, $time); + my $column = "ob_$attr"; + my $old = $object->$column; + my $new = $value; + $object->update ({ $column => $value }); + + if (ref ($old) && $old->isa ('DateTime')) { + $old->set_time_zone ('local'); + $old = $old->ymd . q{ } . $old->hms; + } + if (ref ($new) && $new->isa ('DateTime')) { + $new->set_time_zone ('local'); + $new = $new->ymd . q{ } . $new->hms; + } + $self->log_set ($attr, $old, $new, $user, $host, $time); $guard->commit; }; if ($@) { @@ -262,7 +273,7 @@ sub _get_internal { my %search = (ob_type => $type, ob_name => $name); my $object = $self->{schema}->resultset('Object')->find (\%search); - $value = $object->get_column ($attr); + $value = $object->$attr; }; if ($@) { $self->error ($@); @@ -291,7 +302,14 @@ sub acl { } elsif (defined $id) { return $self->_set_internal ($attr, undef, $user, $host, $time); } else { - return $self->_get_internal ($attr); + my $id = $self->_get_internal ($attr); + return unless defined $id; + my $acl = eval { Wallet::ACL->new ($id, $self->{schema}) }; + if ($@) { + $self->error ($@); + return; + } + return $acl->name; } } @@ -334,15 +352,23 @@ sub comment { sub expires { my ($self, $expires, $user, $host, $time) = @_; if ($expires) { - if ($expires !~ /^\d{4}-\d\d-\d\d( \d\d:\d\d:\d\d)?\z/) { + my $seconds = str2time ($expires); + unless (defined $seconds) { $self->error ("malformed expiration time $expires"); return; } - return $self->_set_internal ('expires', $expires, $user, $host, $time); + my $date = DateTime->from_epoch (epoch => $seconds); + return $self->_set_internal ('expires', $date, $user, $host, $time); } elsif (defined $expires) { return $self->_set_internal ('expires', undef, $user, $host, $time); } else { - return $self->_get_internal ('expires'); + my $date = $self->_get_internal ('expires'); + if (defined $date) { + $date->set_time_zone ('local'); + return $date->ymd . q{ } . $date->hms; + } else { + return; + } } } @@ -361,7 +387,14 @@ sub owner { } elsif (defined $owner) { return $self->_set_internal ('owner', undef, $user, $host, $time); } else { - return $self->_get_internal ('owner'); + my $id = $self->_get_internal ('owner'); + return unless defined $id; + my $acl = eval { Wallet::ACL->new ($id, $self->{schema}) }; + if ($@) { + $self->error ($@); + return; + } + return $acl->name; } } @@ -506,13 +539,14 @@ sub history { eval { my %search = (oh_type => $self->{type}, oh_name => $self->{name}); - my %attrs = (order_by => 'oh_on'); + my %attrs = (order_by => 'oh_id'); my @history = $self->{schema}->resultset('ObjectHistory') ->search (\%search, \%attrs); for my $history_rs (@history) { - $output .= sprintf ("%s %s ", $history_rs->oh_on->ymd, - $history_rs->oh_on->hms); + my $date = $history_rs->oh_on; + $date->set_time_zone ('local'); + $output .= sprintf ("%s %s ", $date->ymd, $date->hms); my $old = $history_rs->oh_old; my $new = $history_rs->oh_new; @@ -635,15 +669,15 @@ sub show { for my $i (0 .. $#attrs) { my $field = $attrs[$i][0]; my $fieldtext = $attrs[$i][1]; - next unless my $value = $object_rs->get_column ($field); + my $value = $object_rs->$field; + next unless defined($value); if ($field eq 'ob_comment' && length ($value) > 79 - 17) { local $Text::Wrap::columns = 80; local $Text::Wrap::unexpand = 0; $value = wrap (' ' x 17, ' ' x 17, $value); $value =~ s/^ {17}//; - } - if ($field eq 'ob_created_by') { + } elsif ($field eq 'ob_created_by') { my @flags = $self->flag_list; if (not @flags and $self->error) { return; @@ -656,8 +690,10 @@ sub show { return; } $output .= $attr_output; - } - if ($field =~ /^ob_(owner|acl_)/) { + } elsif (ref ($value) && $value->isa ('DateTime')) { + $value->set_time_zone ('local'); + $value = sprintf ("%s %s", $value->ymd, $value->hms); + } elsif ($field =~ /^ob_(owner|acl_)/) { my $acl = eval { Wallet::ACL->new ($value, $self->{schema}) }; if ($acl and not $@) { $value = $acl->name || $value; @@ -702,12 +738,13 @@ sub destroy { $self->{schema}->resultset('Object')->search (\%search)->delete; # And create a new history object for the destroy action. + my $date = DateTime->from_epoch (epoch => $time); my %record = (oh_type => $type, oh_name => $name, oh_action => 'destroy', oh_by => $user, oh_from => $host, - oh_on => strftime ('%Y-%m-%d %T', localtime $time)); + oh_on => $date); $self->{schema}->resultset('ObjectHistory')->create (\%record); $guard->commit; }; @@ -1010,6 +1047,6 @@ available from L<http://www.eyrie.org/~eagle/software/wallet/>. =head1 AUTHOR -Russ Allbery <rra@stanford.edu> +Russ Allbery <eagle@eyrie.org> =cut diff --git a/perl/lib/Wallet/Object/Duo.pm b/perl/lib/Wallet/Object/Duo.pm new file mode 100644 index 0000000..e3fe2da --- /dev/null +++ b/perl/lib/Wallet/Object/Duo.pm @@ -0,0 +1,332 @@ +# Wallet::Object::Duo -- Duo integration object implementation for the wallet. +# +# Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2014 +# The Board of Trustees of the Leland Stanford Junior University +# +# See LICENSE for licensing terms. + +############################################################################## +# Modules and declarations +############################################################################## + +package Wallet::Object::Duo; +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::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.01'; + +############################################################################## +# Core methods +############################################################################## + +# Override attr_show to display the Duo integration key attribute. +sub attr_show { + my ($self) = @_; + my $output = ''; + 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; + } + return sprintf ("%15s: %s\n", 'Duo key', $key); +} + +# Override new to start by creating a Net::Duo::Admin object for subsequent +# calls. +sub new { + my ($class, $type, $name, $schema) = @_; + + # We have to have a Duo integration key file set. + if (not $Wallet::Config::DUO_KEY_FILE) { + die "duo object implementation not configured\n"; + } + my $key_file = $Wallet::Config::DUO_KEY_FILE; + my $agent = $Wallet::Config::DUO_AGENT; + + # Construct the Net::Duo::Admin object. + require Net::Duo::Admin; + my $duo = Net::Duo::Admin->new ( + { + key_file => $key_file, + user_agent => $agent, + } + ); + + # Construct the object. + my $self = $class->SUPER::new ($type, $name, $schema); + $self->{duo} = $duo; + return $self; +} + +# Override create to start by creating a new integration in Duo, and only +# create the entry in the database if that succeeds. Error handling isn't +# great here since we don't have a way to communicate the error back to the +# caller. +sub create { + my ($class, $type, $name, $schema, $creator, $host, $time) = @_; + + # We have to have a Duo integration key file set. + if (not $Wallet::Config::DUO_KEY_FILE) { + die "duo object implementation not configured\n"; + } + my $key_file = $Wallet::Config::DUO_KEY_FILE; + my $agent = $Wallet::Config::DUO_AGENT; + + # Construct the Net::Duo::Admin object. + require Net::Duo::Admin; + my $duo = Net::Duo::Admin->new ( + { + key_file => $key_file, + user_agent => $agent, + } + ); + + # Create the object in Duo. + require Net::Duo::Admin::Integration; + my %data = ( + name => $name, + notes => 'Managed by wallet', + type => $Wallet::Config::DUO_TYPE, + ); + my $integration = Net::Duo::Admin::Integration->create ($duo, \%data); + + # Create the object in wallet. + my @trace = ($creator, $host, $time); + my $self = $class->SUPER::create ($type, $name, $schema, @trace); + $self->{duo} = $duo; + + # Add the integration key to the object metadata. + my $guard = $self->{schema}->txn_scope_guard; + eval { + my %record = ( + du_name => $name, + du_key => $integration->integration_key, + ); + $self->{schema}->resultset ('Duo')->create (\%record); + $guard->commit; + }; + if ($@) { + my $id = $self->{type} . ':' . $self->{name}; + $self->error ("cannot set Duo key for $id: $@"); + return; + } + + # Done. Return the object. + return $self; +} + +# Override destroy to delete the integration out of Duo as well. +sub destroy { + my ($self, $user, $host, $time) = @_; + my $id = $self->{type} . ':' . $self->{name}; + if ($self->flag_check ('locked')) { + $self->error ("cannot destroy $id: object is locked"); + return; + } + my $schema = $self->{schema}; + my $guard = $schema->txn_scope_guard; + eval { + my %search = (du_name => $self->{name}); + my $row = $schema->resultset ('Duo')->find (\%search); + my $key = $row->get_column ('du_key'); + my $int = Net::Duo::Admin::Integration->new ($self->{duo}, $key); + $int->delete; + $row->delete; + $guard->commit; + }; + if ($@) { + $self->error ($@); + return; + } + return $self->SUPER::destroy ($user, $host, $time); +} + +# Our get implementation. Retrieve the integration information from Duo and +# construct the configuration file expected by the Duo 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); + 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 - Duo integration object implementation for wallet + +=head1 SYNOPSIS + + my @name = qw(duo host.example.com); + my @trace = ($user, $host, time); + my $object = Wallet::Object::Duo->create (@name, $schema, @trace); + my $config = $object->get (@trace); + $object->destroy (@trace); + +=head1 DESCRIPTION + +Wallet::Object::Duo is a representation of Duo integrations the wallet. +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. + +Currently, only one configured integration type can be managed by the +wallet, and 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::Base. See the +documentation for that class for all generic methods. Below are only +those methods that are overridden or behave specially for this +implementation. + +=over 4 + +=item create(TYPE, NAME, DBH, PRINCIPAL, HOSTNAME [, DATETIME]) + +This is a class method and should be called on the Wallet::Object::Duo +class. It creates a new object with the given TYPE and NAME (TYPE is +normally C<duo> 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. The new integration's type is controlled by the DUO_TYPE +configuration variable, which defaults to C<unix>. See L<Wallet::Config> +for more information. + +If create() fails, it throws an exception. + +=item destroy(PRINCIPAL, HOSTNAME [, DATETIME]) + +Destroys a Duo integration object by removing it from the database and +deleting the integration from Duo. If deleting the Duo integration fails, +destroy() fails. Returns true on success and false on failure. The +caller should call error() to get the error message after a failure. +PRINCIPAL, HOSTNAME, and DATETIME are stored as history information. +PRINCIPAL should be the user who is destroying the object. If DATETIME +isn't given, the current time is used. + +=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. +Currently, only one Duo integration type is supported as well. Further +development should expand the available integration types, possibly as +additional wallet object types. + +=head1 SEE ALSO + +Net::Duo(3), Wallet::Config(3), Wallet::Object::Base(3), wallet-backend(8) + +This module is part of the wallet system. The current version is +available from L<http://www.eyrie.org/~eagle/software/wallet/>. + +=head1 AUTHOR + +Russ Allbery <eagle@eyrie.org> + +=cut diff --git a/perl/Wallet/Object/File.pm b/perl/lib/Wallet/Object/File.pm index 49589f1..1ff1288 100644 --- a/perl/Wallet/Object/File.pm +++ b/perl/lib/Wallet/Object/File.pm @@ -1,7 +1,7 @@ # Wallet::Object::File -- File object implementation for the wallet. # -# Written by Russ Allbery <rra@stanford.edu> -# Copyright 2008, 2010 +# Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2008, 2010, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -14,6 +14,7 @@ package Wallet::Object::File; require 5.006; use strict; +use warnings; use vars qw(@ISA $VERSION); use Digest::MD5 qw(md5_hex); @@ -237,6 +238,6 @@ available from L<http://www.eyrie.org/~eagle/software/wallet/>. =head1 AUTHOR -Russ Allbery <rra@stanford.edu> +Russ Allbery <eagle@eyrie.org> =cut diff --git a/perl/Wallet/Object/Keytab.pm b/perl/lib/Wallet/Object/Keytab.pm index 45d5826..975179b 100644 --- a/perl/Wallet/Object/Keytab.pm +++ b/perl/lib/Wallet/Object/Keytab.pm @@ -1,7 +1,7 @@ # Wallet::Object::Keytab -- Keytab object implementation for the wallet. # -# Written by Russ Allbery <rra@stanford.edu> -# Copyright 2007, 2008, 2009, 2010, 2013 +# Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2007, 2008, 2009, 2010, 2013, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -14,6 +14,7 @@ package Wallet::Object::Keytab; require 5.006; use strict; +use warnings; use vars qw(@ISA $VERSION); use Wallet::Config (); @@ -508,6 +509,6 @@ available from L<http://www.eyrie.org/~eagle/software/wallet/>. =head1 AUTHOR -Russ Allbery <rra@stanford.edu> +Russ Allbery <eagle@eyrie.org> =cut diff --git a/perl/Wallet/Object/WAKeyring.pm b/perl/lib/Wallet/Object/WAKeyring.pm index f33497c..3e80300 100644 --- a/perl/Wallet/Object/WAKeyring.pm +++ b/perl/lib/Wallet/Object/WAKeyring.pm @@ -1,7 +1,7 @@ # Wallet::Object::WAKeyring -- WebAuth keyring object implementation. # -# Written by Russ Allbery <rra@stanford.edu> -# Copyright 2012, 2013 +# Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2012, 2013, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -14,6 +14,7 @@ package Wallet::Object::WAKeyring; require 5.006; use strict; +use warnings; use vars qw(@ISA $VERSION); use Digest::MD5 qw(md5_hex); @@ -365,6 +366,6 @@ from <http://www.eyrie.org/~eagle/software/wallet/>. =head1 AUTHOR -Russ Allbery <rra@stanford.edu> +Russ Allbery <eagle@eyrie.org> =cut diff --git a/perl/Wallet/Policy/Stanford.pm b/perl/lib/Wallet/Policy/Stanford.pm index 5e04b4f..5ac29e0 100644 --- a/perl/Wallet/Policy/Stanford.pm +++ b/perl/lib/Wallet/Policy/Stanford.pm @@ -1,6 +1,6 @@ # Wallet::Policy::Stanford -- Stanford's wallet naming and ownership policy. # -# Written by Russ Allbery <rra@stanford.edu> +# Written by Russ Allbery <eagle@eyrie.org> # Copyright 2013 # The Board of Trustees of the Leland Stanford Junior University # @@ -43,7 +43,7 @@ our $DOMAIN = 'stanford.edu'; # non-host-based objects owned by that group. This default is entirely # Stanford-specific, even more so than the rest of this file. our %ACL_FOR_GROUP = ( - 'its-apps' => 'group/sharedapps', + 'its-apps' => 'group/its-app-support', 'its-crc-sg' => 'group/crcsg', 'its-idg' => 'group/its-idg', 'its-rc' => 'group/its-rc', @@ -266,6 +266,10 @@ sub verify_name { if ($instance !~ /^[a-z0-9-]+\.[a-z0-9.-]+$/) { return "host name $instance is not fully qualified"; } + } elsif ($principal eq 'afs') { + if ($instance !~ /^[a-z0-9-]+\.[a-z0-9.-]+$/) { + return "AFS cell name $instance is not fully qualified"; + } } elsif ($principal eq 'service') { if ($instance !~ /^[a-z0-9-]+$/) { return "invalid service principal name $name"; @@ -275,6 +279,11 @@ sub verify_name { and $principal !~ /^(class|dept|group)-[a-z0-9_-]+$/) { return "invalid CGI principal name $name"; } + } elsif ($instance eq 'cron') { + if ($principal !~ /^[a-z][a-z0-9]{1,7}$/ + and $principal !~ /^(class|dept|group)-[a-z0-9_-]+$/) { + return "invalid cron principal name $name"; + } } else { return "unknown principal type $principal"; } @@ -408,6 +417,6 @@ available from L<http://www.eyrie.org/~eagle/software/wallet/>. =head1 AUTHOR -Russ Allbery <rra@stanford.edu> +Russ Allbery <eagle@eyrie.org> =cut diff --git a/perl/Wallet/Report.pm b/perl/lib/Wallet/Report.pm index b27a998..bf48308 100644 --- a/perl/Wallet/Report.pm +++ b/perl/lib/Wallet/Report.pm @@ -1,7 +1,7 @@ # Wallet::Report -- Wallet system reporting interface. # -# Written by Russ Allbery <rra@stanford.edu> -# Copyright 2008, 2009, 2010, 2013 +# Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2008, 2009, 2010, 2013, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -14,6 +14,7 @@ package Wallet::Report; require 5.006; use strict; +use warnings; use vars qw($VERSION); use Wallet::ACL; @@ -675,6 +676,6 @@ available from L<http://www.eyrie.org/~eagle/software/wallet/>. =head1 AUTHOR -Russ Allbery <rra@stanford.edu> and Jon Robertson <jonrober@stanford.edu>. +Russ Allbery <eagle@eyrie.org> and Jon Robertson <jonrober@stanford.edu>. =cut diff --git a/perl/Wallet/Schema.pm b/perl/lib/Wallet/Schema.pm index d4ef241..cb4c93e 100644 --- a/perl/Wallet/Schema.pm +++ b/perl/lib/Wallet/Schema.pm @@ -1,7 +1,7 @@ # Database schema and connector for the wallet system. # # Written by Jon Robertson <jonrober@stanford.edu> -# Copyright 2012, 2013 +# Copyright 2012, 2013, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -18,7 +18,7 @@ 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. -our $VERSION = '0.08'; +our $VERSION = '0.09'; __PACKAGE__->load_namespaces; __PACKAGE__->load_components (qw/Schema::Versioned/); @@ -160,6 +160,7 @@ table. create table acl_history (ah_id integer auto_increment primary key, ah_acl integer not null, + ah_name varchar(255) default null, ah_action varchar(16) not null, ah_scheme varchar(32) default null, ah_identifier varchar(255) default null, @@ -168,14 +169,13 @@ table. ah_on datetime not null); create index ah_acl on acl_history (ah_acl); -ah_action must be one of C<create>, C<destroy>, C<add>, or C<remove> -(enums aren't used for compatibility with databases other than MySQL). -For a change of type create or destroy, only the action and the trace -records (by, from, and on) are stored. For a change to the lines of an -ACL, the scheme and identifier of the line that was added or removed is -included. Note that changes to the ACL name are not recorded; ACLs are -always tracked by system-generated ID, so name changes are purely -cosmetic. +ah_action must be one of C<create>, C<destroy>, C<add>, C<remove>, or +C<rename> (enums aren't used for compatibility with databases other than +MySQL). For a change of type create, destroy, or rename, only the action, +the ACL name (in the case of rename, the old ACL name prior to the +rename), and the trace records (by, from, and on) are stored. For a +change to the lines of an ACL, the scheme and identifier of the line that +was added or removed are included. ah_by stores the authenticated identity that made the change, ah_from stores the host from which they made the change, and ah_on stores the time @@ -272,6 +272,21 @@ oh_by stores the authenticated identity that made the change, oh_from stores the host from which they made the change, and oh_on stores the time the change was made. +=head2 Duo Backend Data + +Duo integration objects store some additional metadata about the +integration to aid in synchronization with Duo. + + create table duo + (du_name varchar(255) + not null references objects(ob_name), + du_key varchar(255) not null); + create index du_key on duo (du_key); + +du_key holds the Duo integration key, which is the unique name of the +integration within Duo. Additional data may be added later to represent +the other possible settings within Duo. + =head2 Keytab Backend Data The keytab backend has stub support for synchronizing keys with an @@ -334,6 +349,6 @@ available from L<http://www.eyrie.org/~eagle/software/wallet/>. =head1 AUTHOR -Russ Allbery <rra@stanford.edu> +Russ Allbery <eagle@eyrie.org> =cut diff --git a/perl/Wallet/Schema/Result/Acl.pm b/perl/lib/Wallet/Schema/Result/Acl.pm index 226738a..226738a 100644 --- a/perl/Wallet/Schema/Result/Acl.pm +++ b/perl/lib/Wallet/Schema/Result/Acl.pm diff --git a/perl/Wallet/Schema/Result/AclEntry.pm b/perl/lib/Wallet/Schema/Result/AclEntry.pm index a33a98c..a33a98c 100644 --- a/perl/Wallet/Schema/Result/AclEntry.pm +++ b/perl/lib/Wallet/Schema/Result/AclEntry.pm diff --git a/perl/Wallet/Schema/Result/AclHistory.pm b/perl/lib/Wallet/Schema/Result/AclHistory.pm index d3ef901..82e18a9 100644 --- a/perl/Wallet/Schema/Result/AclHistory.pm +++ b/perl/lib/Wallet/Schema/Result/AclHistory.pm @@ -1,7 +1,7 @@ # Wallet schema for ACL history. # # Written by Jon Robertson <jonrober@stanford.edu> -# Copyright 2012, 2013 +# Copyright 2012, 2013, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -41,6 +41,12 @@ __PACKAGE__->table("acl_history"); data_type: 'integer' is_nullable: 0 +=head2 ah_name + + data_type: 'varchar' + is_nullable: 1 + size: 255 + =head2 ah_action data_type: 'varchar' @@ -84,6 +90,8 @@ __PACKAGE__->add_columns( { data_type => "integer", is_auto_increment => 1, is_nullable => 0 }, "ah_acl", { data_type => "integer", is_nullable => 0 }, + "ah_name", + { data_type => "varchar", is_nullable => 1, size => 255 }, "ah_action", { data_type => "varchar", is_nullable => 0, size => 16 }, "ah_scheme", @@ -103,10 +111,13 @@ __PACKAGE__->add_columns( ); __PACKAGE__->set_primary_key("ah_id"); -__PACKAGE__->might_have( - 'acls', - 'Wallet::Schema::Result::Acl', - { 'foreign.ac_id' => 'self.ah_id' }, - ); +# Add an index on the ACL. +sub sqlt_deploy_hook { + my ($self, $sqlt_table) = @_; + my $name = 'acl_history_idx_ah_acl'; + $sqlt_table->add_index (name => $name, fields => [qw(ah_acl)]); + $name = 'acl_history_idx_ah_name'; + $sqlt_table->add_index (name => $name, fields => [qw(ah_name)]); +} 1; diff --git a/perl/Wallet/Schema/Result/AclScheme.pm b/perl/lib/Wallet/Schema/Result/AclScheme.pm index 91a58b2..91a58b2 100644 --- a/perl/Wallet/Schema/Result/AclScheme.pm +++ b/perl/lib/Wallet/Schema/Result/AclScheme.pm diff --git a/perl/lib/Wallet/Schema/Result/Duo.pm b/perl/lib/Wallet/Schema/Result/Duo.pm new file mode 100644 index 0000000..80a71dc --- /dev/null +++ b/perl/lib/Wallet/Schema/Result/Duo.pm @@ -0,0 +1,53 @@ +# Wallet schema for Duo metadata. +# +# Written by Jon Robertson <jonrober@stanford.edu> +# Copyright 2014 +# The Board of Trustees of the Leland Stanford Junior University +# +# See LICENSE for licensing terms. + +package Wallet::Schema::Result::Duo; + +use strict; +use warnings; + +use base 'DBIx::Class::Core'; + +=for stopwords +keytab enctype + +=head1 NAME + +Wallet::Schema::Result::Duo - Wallet schema for Duo metadata + +=head1 DESCRIPTION + +=cut + +__PACKAGE__->table("duo"); + +=head1 ACCESSORS + +=head2 du_name + + data_type: 'varchar' + is_nullable: 0 + size: 255 + +=head2 du_key + + data_type: 'varchar' + is_nullable: 0 + size: 255 + +=cut + +__PACKAGE__->add_columns( + "du_name", + { data_type => "varchar", is_nullable => 0, size => 255 }, + "du_key", + { data_type => "varchar", is_nullable => 0, size => 255 }, +); +__PACKAGE__->set_primary_key("du_name"); + +1; diff --git a/perl/Wallet/Schema/Result/Enctype.pm b/perl/lib/Wallet/Schema/Result/Enctype.pm index 5733669..5733669 100644 --- a/perl/Wallet/Schema/Result/Enctype.pm +++ b/perl/lib/Wallet/Schema/Result/Enctype.pm diff --git a/perl/Wallet/Schema/Result/Flag.pm b/perl/lib/Wallet/Schema/Result/Flag.pm index e223ff8..e223ff8 100644 --- a/perl/Wallet/Schema/Result/Flag.pm +++ b/perl/lib/Wallet/Schema/Result/Flag.pm diff --git a/perl/Wallet/Schema/Result/KeytabEnctype.pm b/perl/lib/Wallet/Schema/Result/KeytabEnctype.pm index daea724..daea724 100644 --- a/perl/Wallet/Schema/Result/KeytabEnctype.pm +++ b/perl/lib/Wallet/Schema/Result/KeytabEnctype.pm diff --git a/perl/Wallet/Schema/Result/KeytabSync.pm b/perl/lib/Wallet/Schema/Result/KeytabSync.pm index ca84277..ca84277 100644 --- a/perl/Wallet/Schema/Result/KeytabSync.pm +++ b/perl/lib/Wallet/Schema/Result/KeytabSync.pm diff --git a/perl/Wallet/Schema/Result/Object.pm b/perl/lib/Wallet/Schema/Result/Object.pm index fd64e1b..fd64e1b 100644 --- a/perl/Wallet/Schema/Result/Object.pm +++ b/perl/lib/Wallet/Schema/Result/Object.pm diff --git a/perl/Wallet/Schema/Result/ObjectHistory.pm b/perl/lib/Wallet/Schema/Result/ObjectHistory.pm index 9cbb159..5e9c8bd 100644 --- a/perl/Wallet/Schema/Result/ObjectHistory.pm +++ b/perl/lib/Wallet/Schema/Result/ObjectHistory.pm @@ -1,7 +1,7 @@ # Wallet schema for object history. # # Written by Jon Robertson <jonrober@stanford.edu> -# Copyright 2012, 2013 +# Copyright 2012, 2013, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -125,11 +125,11 @@ __PACKAGE__->add_columns( ); __PACKAGE__->set_primary_key("oh_id"); -__PACKAGE__->might_have( - 'objects', - 'Wallet::Schema::Result::Object', - { 'foreign.ob_type' => 'self.oh_type', - 'foreign.ob_name' => 'self.oh_name' }, - ); +# Add an index on object type and object name. +sub sqlt_deploy_hook { + my ($self, $sqlt_table) = @_; + my $name = 'object_history_idx_oh_type_oh_name'; + $sqlt_table->add_index (name => $name, fields => [qw(oh_type oh_name)]); +} 1; diff --git a/perl/Wallet/Schema/Result/SyncTarget.pm b/perl/lib/Wallet/Schema/Result/SyncTarget.pm index 4300a54..4300a54 100644 --- a/perl/Wallet/Schema/Result/SyncTarget.pm +++ b/perl/lib/Wallet/Schema/Result/SyncTarget.pm diff --git a/perl/Wallet/Schema/Result/Type.pm b/perl/lib/Wallet/Schema/Result/Type.pm index 748a8a8..748a8a8 100644 --- a/perl/Wallet/Schema/Result/Type.pm +++ b/perl/lib/Wallet/Schema/Result/Type.pm diff --git a/perl/Wallet/Server.pm b/perl/lib/Wallet/Server.pm index 6d67e17..95fd4e6 100644 --- a/perl/Wallet/Server.pm +++ b/perl/lib/Wallet/Server.pm @@ -1,7 +1,7 @@ # Wallet::Server -- Wallet system server implementation. # -# Written by Russ Allbery <rra@stanford.edu> -# Copyright 2007, 2008, 2010, 2011, 2013 +# Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2007, 2008, 2010, 2011, 2013, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -14,6 +14,7 @@ package Wallet::Server; require 5.006; use strict; +use warnings; use vars qw(%MAPPING $VERSION); use Wallet::ACL; @@ -680,7 +681,7 @@ sub acl_rename { return; } } - unless ($acl->rename ($name)) { + unless ($acl->rename ($name, $self->{user}, $self->{host})) { $self->error ($acl->error); return; } @@ -830,7 +831,7 @@ failure to get the error message. Gets or sets the ACL type ACL to ID for the object identified by TYPE and NAME. ACL should be one of C<get>, C<store>, C<show>, C<destroy>, or C<flags>. If ID is not given, returns the current setting of that ACL as -a numeric ACL ID or undef if that ACL isn't set or on failure. To +the name of the ACL or undef if that ACL isn't set or on failure. To distinguish between an ACL that isn't set and a failure to retrieve the ACL, the caller should call error() after an undef return. If error() also returns undef, that ACL wasn't set; otherwise, error() will return @@ -1040,9 +1041,9 @@ owner ACL will not be checked. =item owner(TYPE, NAME [, OWNER]) Gets or sets the owner for the object identified by TYPE and NAME. If -OWNER is not given, returns the current owner as a numeric ACL ID or undef -if no owner is set or on an error. To distinguish between an owner that -isn't set and a failure to retrieve the owner, the caller should call +OWNER is not given, returns the current owner as the name of the ACL or +undef if no owner is set or on an error. To distinguish between an owner +that isn't set and a failure to retrieve the owner, the caller should call error() after an undef return. If error() also returns undef, that ACL wasn't set; otherwise, error() will return the error message. @@ -1090,6 +1091,6 @@ available from L<http://www.eyrie.org/~eagle/software/wallet/>. =head1 AUTHOR -Russ Allbery <rra@stanford.edu> +Russ Allbery <eagle@eyrie.org> =cut diff --git a/perl/sql/Wallet-Schema-0.08-0.09-MySQL.sql b/perl/sql/Wallet-Schema-0.08-0.09-MySQL.sql new file mode 100644 index 0000000..f6b1abe --- /dev/null +++ b/perl/sql/Wallet-Schema-0.08-0.09-MySQL.sql @@ -0,0 +1,24 @@ +-- Convert schema 'sql/Wallet-Schema-0.08-MySQL.sql' to 'Wallet::Schema v0.09':; + +BEGIN; + +SET foreign_key_checks=0; + +CREATE TABLE duo ( + du_name varchar(255) NOT NULL, + du_key varchar(255) NOT NULL, + PRIMARY KEY (du_name) +); + +SET foreign_key_checks=1; + +ALTER TABLE acl_history ADD COLUMN ah_name varchar(255) NULL, + ADD INDEX acl_history_idx_ah_acl (ah_acl), + ADD INDEX acl_history_idx_ah_name (ah_name); + +ALTER TABLE object_history DROP FOREIGN KEY object_history_fk_oh_type_oh_name, + ALTER TABLE object_history; + + +COMMIT; + diff --git a/perl/sql/Wallet-Schema-0.08-0.09-PostgreSQL.sql b/perl/sql/Wallet-Schema-0.08-0.09-PostgreSQL.sql new file mode 100644 index 0000000..a1d3fa3 --- /dev/null +++ b/perl/sql/Wallet-Schema-0.08-0.09-PostgreSQL.sql @@ -0,0 +1,19 @@ +-- Convert schema 'sql/Wallet-Schema-0.08-PostgreSQL.sql' to 'sql/Wallet-Schema-0.09-PostgreSQL.sql':; + +BEGIN; + +CREATE TABLE "duo" ( + "du_name" character varying(255) NOT NULL, + "du_key" character varying(255) NOT NULL, + PRIMARY KEY ("du_name") +); + +ALTER TABLE acl_history ADD COLUMN ah_name character varying(255); + +CREATE INDEX acl_history_idx_ah_acl on acl_history (ah_acl); + +CREATE INDEX acl_history_idx_ah_name on acl_history (ah_name); + + +COMMIT; + diff --git a/perl/sql/Wallet-Schema-0.08-0.09-SQLite.sql b/perl/sql/Wallet-Schema-0.08-0.09-SQLite.sql new file mode 100644 index 0000000..df0fa09 --- /dev/null +++ b/perl/sql/Wallet-Schema-0.08-0.09-SQLite.sql @@ -0,0 +1,17 @@ +-- Convert schema 'sql/Wallet-Schema-0.08-SQLite.sql' to 'sql/Wallet-Schema-0.09-SQLite.sql':; + +BEGIN; + +CREATE TABLE duo ( + du_name varchar(255) NOT NULL, + du_key varchar(255) NOT NULL, + PRIMARY KEY (du_name) +); + +ALTER TABLE acl_history ADD ah_name varchar(255) default null; + +CREATE INDEX acl_history_idx_ah_acl ON acl_history (ah_acl); + +CREATE INDEX acl_history_idx_ah_name ON acl_history (ah_name); + +COMMIT; diff --git a/perl/sql/Wallet-Schema-0.08-PostgreSQL.sql b/perl/sql/Wallet-Schema-0.08-PostgreSQL.sql index 296909f..4347de8 100644 --- a/perl/sql/Wallet-Schema-0.08-PostgreSQL.sql +++ b/perl/sql/Wallet-Schema-0.08-PostgreSQL.sql @@ -2,7 +2,7 @@ -- Created by SQL::Translator::Producer::PostgreSQL -- Created on Fri Jan 25 14:12:02 2013 -- --- Copyright 2012, 2013 +-- Copyright 2012, 2013, 2014 -- The Board of Trustees of the Leland Stanford Junior University -- -- Permission is hereby granted, free of charge, to any person obtaining a @@ -218,6 +218,3 @@ ALTER TABLE "objects" ADD FOREIGN KEY ("ob_acl_store") ALTER TABLE "objects" ADD FOREIGN KEY ("ob_type") REFERENCES "types" ("ty_name") DEFERRABLE; ---ALTER TABLE "object_history" ADD FOREIGN KEY ("oh_type", "oh_name") --- REFERENCES "objects" ("ob_type", "ob_name") DEFERRABLE; - diff --git a/perl/sql/Wallet-Schema-0.09-MySQL.sql b/perl/sql/Wallet-Schema-0.09-MySQL.sql new file mode 100644 index 0000000..a9aa745 --- /dev/null +++ b/perl/sql/Wallet-Schema-0.09-MySQL.sql @@ -0,0 +1,229 @@ +-- +-- Created by SQL::Translator::Producer::MySQL +-- Created on Tue Jul 15 17:41:01 2014 +-- +-- Copyright 2012, 2013, 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`; + +-- +-- Table: `acl_history` +-- +CREATE TABLE `acl_history` ( + `ah_id` integer NOT NULL auto_increment, + `ah_acl` integer NOT NULL, + `ah_name` varchar(255) NULL, + `ah_action` varchar(16) NOT NULL, + `ah_scheme` varchar(32) NULL, + `ah_identifier` varchar(255) NULL, + `ah_by` varchar(255) NOT NULL, + `ah_from` varchar(255) NOT NULL, + `ah_on` datetime NOT NULL, + INDEX `acl_history_idx_ah_acl` (`ah_acl`), + INDEX `acl_history_idx_ah_name` (`ah_name`), + PRIMARY KEY (`ah_id`) +); + +DROP TABLE IF EXISTS `acl_schemes`; + +-- +-- Table: `acl_schemes` +-- +CREATE TABLE `acl_schemes` ( + `as_name` varchar(32) NOT NULL, + `as_class` varchar(64) NULL, + PRIMARY KEY (`as_name`) +) ENGINE=InnoDB; + +DROP TABLE IF EXISTS `acls`; + +-- +-- Table: `acls` +-- +CREATE TABLE `acls` ( + `ac_id` integer NOT NULL auto_increment, + `ac_name` varchar(255) NOT NULL, + PRIMARY KEY (`ac_id`), + UNIQUE `ac_name` (`ac_name`) +) ENGINE=InnoDB; + +DROP TABLE IF EXISTS `duo`; + +-- +-- Table: `duo` +-- +CREATE TABLE `duo` ( + `du_name` varchar(255) NOT NULL, + `du_key` varchar(255) NOT NULL, + PRIMARY KEY (`du_name`) +); + +DROP TABLE IF EXISTS `enctypes`; + +-- +-- Table: `enctypes` +-- +CREATE TABLE `enctypes` ( + `en_name` varchar(255) NOT NULL, + PRIMARY KEY (`en_name`) +); + +DROP TABLE IF EXISTS `flags`; + +-- +-- Table: `flags` +-- +CREATE TABLE `flags` ( + `fl_type` varchar(16) NOT NULL, + `fl_name` varchar(255) NOT NULL, + `fl_flag` enum('locked', 'unchanging') NOT NULL, + PRIMARY KEY (`fl_type`, `fl_name`, `fl_flag`) +); + +DROP TABLE IF EXISTS `keytab_enctypes`; + +-- +-- Table: `keytab_enctypes` +-- +CREATE TABLE `keytab_enctypes` ( + `ke_name` varchar(255) NOT NULL, + `ke_enctype` varchar(255) NOT NULL, + PRIMARY KEY (`ke_name`, `ke_enctype`) +); + +DROP TABLE IF EXISTS `keytab_sync`; + +-- +-- Table: `keytab_sync` +-- +CREATE TABLE `keytab_sync` ( + `ks_name` varchar(255) NOT NULL, + `ks_target` varchar(255) NOT NULL, + PRIMARY KEY (`ks_name`, `ks_target`) +); + +DROP TABLE IF EXISTS `object_history`; + +-- +-- Table: `object_history` +-- +CREATE TABLE `object_history` ( + `oh_id` integer NOT NULL auto_increment, + `oh_type` varchar(16) NOT NULL, + `oh_name` varchar(255) NOT NULL, + `oh_action` varchar(16) NOT NULL, + `oh_field` varchar(16) NULL, + `oh_type_field` varchar(255) NULL, + `oh_old` varchar(255) NULL, + `oh_new` varchar(255) NULL, + `oh_by` varchar(255) NOT NULL, + `oh_from` varchar(255) NOT NULL, + `oh_on` datetime NOT NULL, + INDEX `object_history_idx_oh_type_oh_name` (`oh_type`, `oh_name`), + PRIMARY KEY (`oh_id`) +); + +DROP TABLE IF EXISTS `sync_targets`; + +-- +-- Table: `sync_targets` +-- +CREATE TABLE `sync_targets` ( + `st_name` varchar(255) NOT NULL, + PRIMARY KEY (`st_name`) +); + +DROP TABLE IF EXISTS `types`; + +-- +-- Table: `types` +-- +CREATE TABLE `types` ( + `ty_name` varchar(16) NOT NULL, + `ty_class` varchar(64) NULL, + PRIMARY KEY (`ty_name`) +) ENGINE=InnoDB; + +DROP TABLE IF EXISTS `acl_entries`; + +-- +-- Table: `acl_entries` +-- +CREATE TABLE `acl_entries` ( + `ae_id` integer NOT NULL, + `ae_scheme` varchar(32) NOT NULL, + `ae_identifier` varchar(255) NOT NULL, + INDEX `acl_entries_idx_ae_scheme` (`ae_scheme`), + INDEX `acl_entries_idx_ae_id` (`ae_id`), + PRIMARY KEY (`ae_id`, `ae_scheme`, `ae_identifier`), + CONSTRAINT `acl_entries_fk_ae_scheme` FOREIGN KEY (`ae_scheme`) REFERENCES `acl_schemes` (`as_name`), + CONSTRAINT `acl_entries_fk_ae_id` FOREIGN KEY (`ae_id`) REFERENCES `acls` (`ac_id`) ON DELETE CASCADE ON UPDATE CASCADE +) ENGINE=InnoDB; + +DROP TABLE IF EXISTS `objects`; + +-- +-- Table: `objects` +-- +CREATE TABLE `objects` ( + `ob_type` varchar(16) NOT NULL, + `ob_name` varchar(255) NOT NULL, + `ob_owner` integer NULL, + `ob_acl_get` integer NULL, + `ob_acl_store` integer NULL, + `ob_acl_show` integer NULL, + `ob_acl_destroy` integer NULL, + `ob_acl_flags` integer NULL, + `ob_expires` datetime NULL, + `ob_created_by` varchar(255) NOT NULL, + `ob_created_from` varchar(255) NOT NULL, + `ob_created_on` datetime NOT NULL, + `ob_stored_by` varchar(255) NULL, + `ob_stored_from` varchar(255) NULL, + `ob_stored_on` datetime NULL, + `ob_downloaded_by` varchar(255) NULL, + `ob_downloaded_from` varchar(255) NULL, + `ob_downloaded_on` datetime NULL, + `ob_comment` varchar(255) NULL, + INDEX `objects_idx_ob_acl_destroy` (`ob_acl_destroy`), + INDEX `objects_idx_ob_acl_flags` (`ob_acl_flags`), + INDEX `objects_idx_ob_acl_get` (`ob_acl_get`), + INDEX `objects_idx_ob_owner` (`ob_owner`), + INDEX `objects_idx_ob_acl_show` (`ob_acl_show`), + INDEX `objects_idx_ob_acl_store` (`ob_acl_store`), + INDEX `objects_idx_ob_type` (`ob_type`), + PRIMARY KEY (`ob_name`, `ob_type`), + CONSTRAINT `objects_fk_ob_acl_destroy` FOREIGN KEY (`ob_acl_destroy`) REFERENCES `acls` (`ac_id`) ON DELETE CASCADE ON UPDATE CASCADE, + CONSTRAINT `objects_fk_ob_acl_flags` FOREIGN KEY (`ob_acl_flags`) REFERENCES `acls` (`ac_id`) ON DELETE CASCADE ON UPDATE CASCADE, + CONSTRAINT `objects_fk_ob_acl_get` FOREIGN KEY (`ob_acl_get`) REFERENCES `acls` (`ac_id`) ON DELETE CASCADE ON UPDATE CASCADE, + CONSTRAINT `objects_fk_ob_owner` FOREIGN KEY (`ob_owner`) REFERENCES `acls` (`ac_id`) ON DELETE CASCADE ON UPDATE CASCADE, + CONSTRAINT `objects_fk_ob_acl_show` FOREIGN KEY (`ob_acl_show`) REFERENCES `acls` (`ac_id`) ON DELETE CASCADE ON UPDATE CASCADE, + CONSTRAINT `objects_fk_ob_acl_store` FOREIGN KEY (`ob_acl_store`) REFERENCES `acls` (`ac_id`) ON DELETE CASCADE ON UPDATE CASCADE, + CONSTRAINT `objects_fk_ob_type` FOREIGN KEY (`ob_type`) REFERENCES `types` (`ty_name`) +) ENGINE=InnoDB; + +SET foreign_key_checks=1; + diff --git a/perl/sql/Wallet-Schema-0.09-PostgreSQL.sql b/perl/sql/Wallet-Schema-0.09-PostgreSQL.sql new file mode 100644 index 0000000..67f4a1b --- /dev/null +++ b/perl/sql/Wallet-Schema-0.09-PostgreSQL.sql @@ -0,0 +1,234 @@ +-- +-- Created by SQL::Translator::Producer::PostgreSQL +-- Created on Tue Jul 15 17:41:03 2014 +-- +-- Copyright 2012, 2013, 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: duo. +-- +DROP TABLE "duo" CASCADE; +CREATE TABLE "duo" ( + "du_name" character varying(255) NOT NULL, + "du_key" character varying(255) NOT NULL, + PRIMARY KEY ("du_name") +); + +-- +-- Table: acl_history. +-- +DROP TABLE "acl_history" CASCADE; +CREATE TABLE "acl_history" ( + "ah_id" serial NOT NULL, + "ah_acl" integer NOT NULL, + "ah_name" character varying(255), + "ah_action" character varying(16) NOT NULL, + "ah_scheme" character varying(32), + "ah_identifier" character varying(255), + "ah_by" character varying(255) NOT NULL, + "ah_from" character varying(255) NOT NULL, + "ah_on" timestamp NOT NULL, + PRIMARY KEY ("ah_id") +); +CREATE INDEX "acl_history_idx_ah_acl" on "acl_history" ("ah_acl"); +CREATE INDEX "acl_history_idx_ah_name" on "acl_history" ("ah_name"); + +-- +-- Table: acl_schemes. +-- +DROP TABLE "acl_schemes" CASCADE; +CREATE TABLE "acl_schemes" ( + "as_name" character varying(32) NOT NULL, + "as_class" character varying(64), + PRIMARY KEY ("as_name") +); + +-- +-- Table: acls. +-- +DROP TABLE "acls" CASCADE; +CREATE TABLE "acls" ( + "ac_id" serial NOT NULL, + "ac_name" character varying(255) NOT NULL, + PRIMARY KEY ("ac_id"), + CONSTRAINT "ac_name" UNIQUE ("ac_name") +); + +-- +-- Table: enctypes. +-- +DROP TABLE "enctypes" CASCADE; +CREATE TABLE "enctypes" ( + "en_name" character varying(255) NOT NULL, + PRIMARY KEY ("en_name") +); + +-- +-- Table: flags. +-- +DROP TABLE "flags" CASCADE; +CREATE TABLE "flags" ( + "fl_type" character varying(16) NOT NULL, + "fl_name" character varying(255) NOT NULL, + "fl_flag" character varying NOT NULL, + PRIMARY KEY ("fl_type", "fl_name", "fl_flag") +); + +-- +-- Table: keytab_enctypes. +-- +DROP TABLE "keytab_enctypes" CASCADE; +CREATE TABLE "keytab_enctypes" ( + "ke_name" character varying(255) NOT NULL, + "ke_enctype" character varying(255) NOT NULL, + PRIMARY KEY ("ke_name", "ke_enctype") +); + +-- +-- Table: keytab_sync. +-- +DROP TABLE "keytab_sync" CASCADE; +CREATE TABLE "keytab_sync" ( + "ks_name" character varying(255) NOT NULL, + "ks_target" character varying(255) NOT NULL, + PRIMARY KEY ("ks_name", "ks_target") +); + +-- +-- Table: object_history. +-- +DROP TABLE "object_history" CASCADE; +CREATE TABLE "object_history" ( + "oh_id" serial NOT NULL, + "oh_type" character varying(16) NOT NULL, + "oh_name" character varying(255) NOT NULL, + "oh_action" character varying(16) NOT NULL, + "oh_field" character varying(16), + "oh_type_field" character varying(255), + "oh_old" character varying(255), + "oh_new" character varying(255), + "oh_by" character varying(255) NOT NULL, + "oh_from" character varying(255) NOT NULL, + "oh_on" timestamp NOT NULL, + PRIMARY KEY ("oh_id") +); +CREATE INDEX "object_history_idx_oh_type_oh_name" on "object_history" ("oh_type", "oh_name"); + +-- +-- Table: sync_targets. +-- +DROP TABLE "sync_targets" CASCADE; +CREATE TABLE "sync_targets" ( + "st_name" character varying(255) NOT NULL, + PRIMARY KEY ("st_name") +); + +-- +-- Table: types. +-- +DROP TABLE "types" CASCADE; +CREATE TABLE "types" ( + "ty_name" character varying(16) NOT NULL, + "ty_class" character varying(64), + PRIMARY KEY ("ty_name") +); + +-- +-- Table: acl_entries. +-- +DROP TABLE "acl_entries" CASCADE; +CREATE TABLE "acl_entries" ( + "ae_id" integer NOT NULL, + "ae_scheme" character varying(32) NOT NULL, + "ae_identifier" character varying(255) NOT NULL, + PRIMARY KEY ("ae_id", "ae_scheme", "ae_identifier") +); +CREATE INDEX "acl_entries_idx_ae_scheme" on "acl_entries" ("ae_scheme"); +CREATE INDEX "acl_entries_idx_ae_id" on "acl_entries" ("ae_id"); + +-- +-- Table: objects. +-- +DROP TABLE "objects" CASCADE; +CREATE TABLE "objects" ( + "ob_type" character varying(16) NOT NULL, + "ob_name" character varying(255) NOT NULL, + "ob_owner" integer, + "ob_acl_get" integer, + "ob_acl_store" integer, + "ob_acl_show" integer, + "ob_acl_destroy" integer, + "ob_acl_flags" integer, + "ob_expires" timestamp, + "ob_created_by" character varying(255) NOT NULL, + "ob_created_from" character varying(255) NOT NULL, + "ob_created_on" timestamp NOT NULL, + "ob_stored_by" character varying(255), + "ob_stored_from" character varying(255), + "ob_stored_on" timestamp, + "ob_downloaded_by" character varying(255), + "ob_downloaded_from" character varying(255), + "ob_downloaded_on" timestamp, + "ob_comment" character varying(255), + PRIMARY KEY ("ob_name", "ob_type") +); +CREATE INDEX "objects_idx_ob_acl_destroy" on "objects" ("ob_acl_destroy"); +CREATE INDEX "objects_idx_ob_acl_flags" on "objects" ("ob_acl_flags"); +CREATE INDEX "objects_idx_ob_acl_get" on "objects" ("ob_acl_get"); +CREATE INDEX "objects_idx_ob_owner" on "objects" ("ob_owner"); +CREATE INDEX "objects_idx_ob_acl_show" on "objects" ("ob_acl_show"); +CREATE INDEX "objects_idx_ob_acl_store" on "objects" ("ob_acl_store"); +CREATE INDEX "objects_idx_ob_type" on "objects" ("ob_type"); + +-- +-- Foreign Key Definitions +-- + +ALTER TABLE "acl_entries" ADD CONSTRAINT "acl_entries_fk_ae_scheme" FOREIGN KEY ("ae_scheme") + REFERENCES "acl_schemes" ("as_name") DEFERRABLE; + +ALTER TABLE "acl_entries" ADD CONSTRAINT "acl_entries_fk_ae_id" FOREIGN KEY ("ae_id") + REFERENCES "acls" ("ac_id") ON DELETE CASCADE ON UPDATE CASCADE DEFERRABLE; + +ALTER TABLE "objects" ADD CONSTRAINT "objects_fk_ob_acl_destroy" FOREIGN KEY ("ob_acl_destroy") + REFERENCES "acls" ("ac_id") ON DELETE CASCADE ON UPDATE CASCADE DEFERRABLE; + +ALTER TABLE "objects" ADD CONSTRAINT "objects_fk_ob_acl_flags" FOREIGN KEY ("ob_acl_flags") + REFERENCES "acls" ("ac_id") ON DELETE CASCADE ON UPDATE CASCADE DEFERRABLE; + +ALTER TABLE "objects" ADD CONSTRAINT "objects_fk_ob_acl_get" FOREIGN KEY ("ob_acl_get") + REFERENCES "acls" ("ac_id") ON DELETE CASCADE ON UPDATE CASCADE DEFERRABLE; + +ALTER TABLE "objects" ADD CONSTRAINT "objects_fk_ob_owner" FOREIGN KEY ("ob_owner") + REFERENCES "acls" ("ac_id") ON DELETE CASCADE ON UPDATE CASCADE DEFERRABLE; + +ALTER TABLE "objects" ADD CONSTRAINT "objects_fk_ob_acl_show" FOREIGN KEY ("ob_acl_show") + REFERENCES "acls" ("ac_id") ON DELETE CASCADE ON UPDATE CASCADE DEFERRABLE; + +ALTER TABLE "objects" ADD CONSTRAINT "objects_fk_ob_acl_store" FOREIGN KEY ("ob_acl_store") + REFERENCES "acls" ("ac_id") ON DELETE CASCADE ON UPDATE CASCADE DEFERRABLE; + +ALTER TABLE "objects" ADD CONSTRAINT "objects_fk_ob_type" FOREIGN KEY ("ob_type") + REFERENCES "types" ("ty_name") DEFERRABLE; + diff --git a/perl/sql/Wallet-Schema-0.09-SQLite.sql b/perl/sql/Wallet-Schema-0.09-SQLite.sql new file mode 100644 index 0000000..9ce9b08 --- /dev/null +++ b/perl/sql/Wallet-Schema-0.09-SQLite.sql @@ -0,0 +1,238 @@ +-- +-- Created by SQL::Translator::Producer::SQLite +-- Created on Tue Jul 15 17:41:02 2014 +-- +-- Copyright 2012, 2013, 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; + +-- +-- Table: duo +-- +DROP TABLE IF EXISTS duo; + +CREATE TABLE duo ( + du_name varchar(255) NOT NULL, + du_key varchar(255) NOT NULL, + PRIMARY KEY (du_name) +); + +-- +-- Table: acl_history +-- +DROP TABLE IF EXISTS acl_history; + +CREATE TABLE acl_history ( + ah_id INTEGER PRIMARY KEY NOT NULL, + ah_acl integer NOT NULL, + ah_name varchar(255), + ah_action varchar(16) NOT NULL, + ah_scheme varchar(32), + ah_identifier varchar(255), + ah_by varchar(255) NOT NULL, + ah_from varchar(255) NOT NULL, + ah_on datetime NOT NULL +); + +CREATE INDEX acl_history_idx_ah_acl ON acl_history (ah_acl); + +CREATE INDEX acl_history_idx_ah_name ON acl_history (ah_name); + +-- +-- Table: acl_schemes +-- +DROP TABLE IF EXISTS acl_schemes; + +CREATE TABLE acl_schemes ( + as_name varchar(32) NOT NULL, + as_class varchar(64), + PRIMARY KEY (as_name) +); + +-- +-- Table: acls +-- +DROP TABLE IF EXISTS acls; + +CREATE TABLE acls ( + ac_id INTEGER PRIMARY KEY NOT NULL, + ac_name varchar(255) NOT NULL +); + +CREATE UNIQUE INDEX ac_name ON acls (ac_name); + +-- +-- Table: enctypes +-- +DROP TABLE IF EXISTS enctypes; + +CREATE TABLE enctypes ( + en_name varchar(255) NOT NULL, + PRIMARY KEY (en_name) +); + +-- +-- Table: flags +-- +DROP TABLE IF EXISTS flags; + +CREATE TABLE flags ( + fl_type varchar(16) NOT NULL, + fl_name varchar(255) NOT NULL, + fl_flag enum NOT NULL, + PRIMARY KEY (fl_type, fl_name, fl_flag) +); + +-- +-- Table: keytab_enctypes +-- +DROP TABLE IF EXISTS keytab_enctypes; + +CREATE TABLE keytab_enctypes ( + ke_name varchar(255) NOT NULL, + ke_enctype varchar(255) NOT NULL, + PRIMARY KEY (ke_name, ke_enctype) +); + +-- +-- Table: keytab_sync +-- +DROP TABLE IF EXISTS keytab_sync; + +CREATE TABLE keytab_sync ( + ks_name varchar(255) NOT NULL, + ks_target varchar(255) NOT NULL, + PRIMARY KEY (ks_name, ks_target) +); + +-- +-- Table: object_history +-- +DROP TABLE IF EXISTS object_history; + +CREATE TABLE object_history ( + oh_id INTEGER PRIMARY KEY NOT NULL, + oh_type varchar(16) NOT NULL, + oh_name varchar(255) NOT NULL, + oh_action varchar(16) NOT NULL, + oh_field varchar(16), + oh_type_field varchar(255), + oh_old varchar(255), + oh_new varchar(255), + oh_by varchar(255) NOT NULL, + oh_from varchar(255) NOT NULL, + oh_on datetime NOT NULL +); + +CREATE INDEX object_history_idx_oh_type_oh_name ON object_history (oh_type, oh_name); + +-- +-- Table: sync_targets +-- +DROP TABLE IF EXISTS sync_targets; + +CREATE TABLE sync_targets ( + st_name varchar(255) NOT NULL, + PRIMARY KEY (st_name) +); + +-- +-- Table: types +-- +DROP TABLE IF EXISTS types; + +CREATE TABLE types ( + ty_name varchar(16) NOT NULL, + ty_class varchar(64), + PRIMARY KEY (ty_name) +); + +-- +-- Table: acl_entries +-- +DROP TABLE IF EXISTS acl_entries; + +CREATE TABLE acl_entries ( + ae_id integer NOT NULL, + ae_scheme varchar(32) NOT NULL, + ae_identifier varchar(255) NOT NULL, + PRIMARY KEY (ae_id, ae_scheme, ae_identifier), + FOREIGN KEY (ae_scheme) REFERENCES acl_schemes(as_name), + FOREIGN KEY (ae_id) REFERENCES acls(ac_id) ON DELETE CASCADE ON UPDATE CASCADE +); + +CREATE INDEX acl_entries_idx_ae_scheme ON acl_entries (ae_scheme); + +CREATE INDEX acl_entries_idx_ae_id ON acl_entries (ae_id); + +-- +-- Table: objects +-- +DROP TABLE IF EXISTS objects; + +CREATE TABLE objects ( + ob_type varchar(16) NOT NULL, + ob_name varchar(255) NOT NULL, + ob_owner integer, + ob_acl_get integer, + ob_acl_store integer, + ob_acl_show integer, + ob_acl_destroy integer, + ob_acl_flags integer, + ob_expires datetime, + ob_created_by varchar(255) NOT NULL, + ob_created_from varchar(255) NOT NULL, + ob_created_on datetime NOT NULL, + ob_stored_by varchar(255), + ob_stored_from varchar(255), + ob_stored_on datetime, + ob_downloaded_by varchar(255), + ob_downloaded_from varchar(255), + ob_downloaded_on datetime, + ob_comment varchar(255), + PRIMARY KEY (ob_name, ob_type), + FOREIGN KEY (ob_acl_destroy) REFERENCES acls(ac_id) ON DELETE CASCADE ON UPDATE CASCADE, + FOREIGN KEY (ob_acl_flags) REFERENCES acls(ac_id) ON DELETE CASCADE ON UPDATE CASCADE, + FOREIGN KEY (ob_acl_get) REFERENCES acls(ac_id) ON DELETE CASCADE ON UPDATE CASCADE, + FOREIGN KEY (ob_owner) REFERENCES acls(ac_id) ON DELETE CASCADE ON UPDATE CASCADE, + FOREIGN KEY (ob_acl_show) REFERENCES acls(ac_id) ON DELETE CASCADE ON UPDATE CASCADE, + FOREIGN KEY (ob_acl_store) REFERENCES acls(ac_id) ON DELETE CASCADE ON UPDATE CASCADE, + FOREIGN KEY (ob_type) REFERENCES types(ty_name) +); + +CREATE INDEX objects_idx_ob_acl_destroy ON objects (ob_acl_destroy); + +CREATE INDEX objects_idx_ob_acl_flags ON objects (ob_acl_flags); + +CREATE INDEX objects_idx_ob_acl_get ON objects (ob_acl_get); + +CREATE INDEX objects_idx_ob_owner ON objects (ob_owner); + +CREATE INDEX objects_idx_ob_acl_show ON objects (ob_acl_show); + +CREATE INDEX objects_idx_ob_acl_store ON objects (ob_acl_store); + +CREATE INDEX objects_idx_ob_type ON objects (ob_type); + +COMMIT; diff --git a/perl/t/data/duo/integration.json b/perl/t/data/duo/integration.json new file mode 100644 index 0000000..6e569d6 --- /dev/null +++ b/perl/t/data/duo/integration.json @@ -0,0 +1,11 @@ +{ + "enroll_policy": "enroll", + "greeting": "", + "groups_allowed": [], + "integration_key": "DIRWIH0ZZPV4G88B37VQ", + "name": "Integration for UNIX PAM", + "notes": "", + "secret_key": "QO4ZLqQVRIOZYkHfdPDORfcNf8LeXIbCWwHazY7o", + "type": "unix", + "visual_style": "default" +} diff --git a/perl/t/data/duo/keys.json b/perl/t/data/duo/keys.json new file mode 100644 index 0000000..0de11ff --- /dev/null +++ b/perl/t/data/duo/keys.json @@ -0,0 +1,5 @@ +{ + "integration_key": "VWFQIFMA9E79ZFG0ABIQ", + "secret_key": "BAbja87NB8AmzlgalGAm09abNqpGZVva985al1zF", + "api_hostname": "example-admin.duosecurity.com" +} diff --git a/perl/t/data/perl.conf b/perl/t/data/perl.conf new file mode 100644 index 0000000..ca05568 --- /dev/null +++ b/perl/t/data/perl.conf @@ -0,0 +1,7 @@ +# Configuration for Perl tests. -*- perl -*- + +# Default minimum version requirement. +$MINIMUM_VERSION = '5.008'; + +# File must end with this line. +1; diff --git a/perl/t/docs/pod-spelling.t b/perl/t/docs/pod-spelling.t new file mode 100755 index 0000000..6debd42 --- /dev/null +++ b/perl/t/docs/pod-spelling.t @@ -0,0 +1,66 @@ +#!/usr/bin/perl +# +# Check for spelling errors in POD documentation. +# +# The canonical version of this file is maintained in the rra-c-util package, +# which can be found at <http://www.eyrie.org/~eagle/software/rra-c-util/>. +# +# Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2013, 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. + +use 5.006; +use strict; +use warnings; + +use lib 't/lib'; + +use Test::More; +use Test::RRA qw(skip_unless_author use_prereq); + +# Only run this test for the module author since the required stopwords are +# too sensitive to the exact spell-checking program and dictionary. +skip_unless_author('Spelling tests'); + +# Load prerequisite modules. +use_prereq('Test::Spelling'); + +# Check all POD in the Perl distribution. Add the examples directory if it +# exists. Also add any files in usr/bin or usr/sbin, which are widely used in +# Stanford-internal packages. +my @files = all_pod_files(); +if (-d 'examples') { + push(@files, all_pod_files('examples')); +} +for my $dir (qw(usr/bin usr/sbin)) { + if (-d $dir) { + push(@files, glob("$dir/*")); + } +} + +# We now have a list of all files to check, so output a plan and run the +# tests. We can't use all_pod_files_spelling_ok because it refuses to check +# non-Perl files and Stanford-internal packages have a lot of shell scripts +# with POD documentation. +plan tests => scalar(@files); +for my $file (@files) { + pod_file_spelling_ok($file); +} diff --git a/perl/t/docs/pod.t b/perl/t/docs/pod.t new file mode 100755 index 0000000..674ce30 --- /dev/null +++ b/perl/t/docs/pod.t @@ -0,0 +1,65 @@ +#!/usr/bin/perl +# +# Check all POD documents for POD formatting errors. +# +# The canonical version of this file is maintained in the rra-c-util package, +# which can be found at <http://www.eyrie.org/~eagle/software/rra-c-util/>. +# +# Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2012, 2013, 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. + +use 5.006; +use strict; +use warnings; + +use lib 't/lib'; + +use Test::More; +use Test::RRA qw(skip_unless_automated use_prereq); + +# Skip this test for normal user installs, although pod2man may still fail. +skip_unless_automated('POD syntax tests'); + +# Load prerequisite modules. +use_prereq('Test::Pod'); + +# Check all POD in the Perl distribution. Add the examples directory if it +# exists. Also add any files in usr/bin or usr/sbin, which are widely used in +# Stanford-internal packages. +my @files = all_pod_files(); +if (-d 'examples') { + push(@files, all_pod_files('examples')); +} +for my $dir (qw(usr/bin usr/sbin)) { + if (-d $dir) { + push(@files, glob("$dir/*")); + } +} + +# We now have a list of all files to check, so output a plan and run the +# tests. We can't use all_pod_files_ok because it refuses to check non-Perl +# files and Stanford-internal packages have a lot of shell scripts with POD +# documentation. +plan tests => scalar(@files); +for my $file (@files) { + pod_file_ok($file); +} diff --git a/perl/t/acl.t b/perl/t/general/acl.t index 26b4903..1dd5c53 100755 --- a/perl/t/acl.t +++ b/perl/t/general/acl.t @@ -1,13 +1,16 @@ -#!/usr/bin/perl -w +#!/usr/bin/perl # # Tests for the wallet ACL API. # -# Written by Russ Allbery <rra@stanford.edu> -# Copyright 2007, 2008 +# Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2007, 2008, 2014 # 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 => 101; @@ -60,7 +63,7 @@ ok ($acl->isa ('Wallet::ACL'), ' and the right class'); is ($acl->name, 'test', ' and the right name'); # Test rename. -if ($acl->rename ('example')) { +if ($acl->rename ('example', @trace)) { ok (1, 'Renaming the ACL'); } else { is ($acl->error, '', 'Renaming the ACL'); @@ -80,7 +83,8 @@ 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'), ' but renaming to an existing name fails'); +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'); @@ -192,6 +196,8 @@ 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 @@ -223,8 +229,10 @@ $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'); -is ($acl->id, 3, ' and a new ID'); +like ($acl->id, qr{\A[23]\z}, ' and an ID of 2 or 3'); # Clean up. $setup->destroy; -unlink 'wallet-db'; +END { + unlink 'wallet-db'; +} diff --git a/perl/t/admin.t b/perl/t/general/admin.t index 740c79e..7c62932 100755 --- a/perl/t/admin.t +++ b/perl/t/general/admin.t @@ -2,13 +2,16 @@ # # Tests for wallet administrative interface. # -# Written by Russ Allbery <rra@stanford.edu> -# Copyright 2008, 2009, 2010, 2011, 2013 +# Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2008, 2009, 2010, 2011, 2013, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. -use Test::More tests => 24; +use strict; +use warnings; + +use Test::More tests => 26; use Wallet::Admin; use Wallet::Report; @@ -44,7 +47,7 @@ is ($admin->register_object ('base', 'Wallet::Object::Base'), 1, 'Registering Wallet::Object::Base works'); is ($admin->register_object ('base', 'Wallet::Object::Base'), undef, ' and cannot be registered twice'); -$server = eval { Wallet::Server->new ('admin@EXAMPLE.COM', 'localhost') }; +my $server = eval { Wallet::Server->new ('admin@EXAMPLE.COM', 'localhost') }; is ($@, '', 'Creating a server instance did not die'); is ($server->create ('base', 'service/admin'), 1, ' and creating base:service/admin succeeds'); @@ -61,7 +64,6 @@ is ($server->acl_add ('ADMIN', 'base', 'foo'), 1, $Wallet::Schema::VERSION = '0.07'; is ($admin->reinitialize ('admin@EXAMPLE.COM'), 1, ' and re-initialization succeeds'); -$Wallet::Schema::VERSION = '0.08'; # Test an upgrade. Reinitialize to an older version, then test upgrade to the # current version. @@ -73,20 +75,35 @@ SKIP: { # Delete all tables and then redump them straight from the SQL file to # avoid getting the version table. unlink 'wallet-db'; - $admin = eval { Wallet::Admin->new }; my $status = system ('sqlite3', 'wallet-db', '.read sql/Wallet-Schema-0.07-SQLite.sql'); is ($status, 0, 'Reinstalling database from non-versioned SQL succeds'); + + # Upgrade to 0.08. + $Wallet::Schema::VERSION = '0.08'; + $admin = eval { Wallet::Admin->new }; my $retval = $admin->upgrade; - is ($retval, 1, ' and performing an upgrade succeeds'); + is ($retval, 1, ' and performing an upgrade to 0.08 succeeds'); my $sql = "select version from dbix_class_schema_versions order by" . " version DESC"; - $version = $admin->dbh->selectall_arrayref ($sql); + my $version = $admin->dbh->selectall_arrayref ($sql); is (@$version, 2, ' and versions table has correct number of rows'); is (@{ $version->[0] }, 1, ' and correct number of columns'); is ($version->[0][0], '0.08', ' and the schema version is correct'); + + # Upgrade to 0.09. + $Wallet::Schema::VERSION = '0.09'; + $admin = eval { Wallet::Admin->new }; + $retval = $admin->upgrade; + is ($retval, 1, ' and performing an upgrade to 0.09 succeeds'); + $sql = "select version from dbix_class_schema_versions order by" + . " version DESC"; + $version = $admin->dbh->selectall_arrayref ($sql); + is ($version->[0][0], '0.09', ' and the schema version is correct'); } # Clean up. is ($admin->destroy, 1, 'Destruction succeeds'); -unlink 'wallet-db'; +END { + unlink 'wallet-db'; +} diff --git a/perl/t/config.t b/perl/t/general/config.t index 543e5d6..bc200de 100755 --- a/perl/t/config.t +++ b/perl/t/general/config.t @@ -1,13 +1,16 @@ -#!/usr/bin/perl -w +#!/usr/bin/perl # # Tests for the wallet server configuration. # -# Written by Russ Allbery <rra@stanford.edu> -# Copyright 2008, 2010 +# Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2008, 2010, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. +use strict; +use warnings; + use Test::More tests => 6; # Silence warnings since we're not using use. diff --git a/perl/t/init.t b/perl/t/general/init.t index 142f54c..58b9a4c 100755 --- a/perl/t/init.t +++ b/perl/t/general/init.t @@ -1,13 +1,16 @@ -#!/usr/bin/perl -w +#!/usr/bin/perl # # Tests for database initialization. # -# Written by Russ Allbery <rra@stanford.edu> -# Copyright 2007, 2008 +# Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2007, 2008, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. +use strict; +use warnings; + use Test::More tests => 18; use Wallet::ACL; @@ -53,4 +56,6 @@ is ($admin->destroy, 1, 'Destroying the database works'); $acl = eval { Wallet::ACL->new ('ADMIN', $admin->schema) }; like ($@, qr/^cannot search for ACL ADMIN: /, ' and now the database is gone'); -unlink 'wallet-db'; +END { + unlink 'wallet-db'; +} diff --git a/perl/t/report.t b/perl/t/general/report.t index a6b85df..8d348ed 100755 --- a/perl/t/report.t +++ b/perl/t/general/report.t @@ -1,13 +1,16 @@ -#!/usr/bin/perl -w +#!/usr/bin/perl # # Tests for the wallet reporting interface. # -# Written by Russ Allbery <rra@stanford.edu> -# Copyright 2008, 2009, 2010 +# Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2008, 2009, 2010, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. +use strict; +use warnings; + use Test::More tests => 197; use Wallet::Admin; @@ -39,7 +42,7 @@ is ($acls[0][0], 1, ' and that is ACL ID 1'); is ($acls[0][1], 'ADMIN', ' with the right name'); # Create an object. -$server = eval { Wallet::Server->new ('admin@EXAMPLE.COM', 'localhost') }; +my $server = eval { Wallet::Server->new ('admin@EXAMPLE.COM', 'localhost') }; is ($@, '', 'Creating a server instance did not die'); is ($server->create ('base', 'service/admin'), 1, ' and creating base:service/admin succeeds'); @@ -324,5 +327,7 @@ is ($report->error, undef, ' and no error'); # Clean up. $admin->destroy; -unlink 'wallet-db'; system ('rm -r test-files') == 0 or die "cannot remove test-files\n"; +END { + unlink 'wallet-db'; +} diff --git a/perl/t/server.t b/perl/t/general/server.t index 4afda51..b270733 100755 --- a/perl/t/server.t +++ b/perl/t/general/server.t @@ -1,13 +1,16 @@ -#!/usr/bin/perl -w +#!/usr/bin/perl # # Tests for the wallet server API. # -# Written by Russ Allbery <rra@stanford.edu> -# Copyright 2007, 2008, 2010, 2011, 2012, 2013 +# Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2007, 2008, 2010, 2011, 2012, 2013, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. +use strict; +use warnings; + use Test::More tests => 382; use POSIX qw(strftime); @@ -33,7 +36,7 @@ is ($@, '', 'Database initialization did not die'); is ($setup->reinitialize ($admin), 1, 'Database initialization succeeded'); # Now test the new method. -$server = eval { Wallet::Server->new (@trace) }; +my $server = eval { Wallet::Server->new (@trace) }; is ($@, '', 'Reopening with new did not die'); ok ($server->isa ('Wallet::Server'), ' and returned the right class'); my $schema = $server->schema; @@ -51,18 +54,8 @@ is ($server->acl_show ('ADMIN'), is ($server->acl_show (1), "Members of ACL ADMIN (id: 1) are:\n krb5 $admin\n", ' including by number'); -my $history = <<"EOO"; -DATE create - by $admin from $host -DATE add krb5 $admin - by $admin from $host -EOO -my $result = $server->acl_history ('ADMIN'); -$result =~ s/^\d{4}-\d\d-\d\d \d\d:\d\d:\d\d/DATE/gm; -is ($result, $history, ' and displaying history works'); -$result = $server->acl_history (1); -$result =~ s/^\d{4}-\d\d-\d\d \d\d:\d\d:\d\d/DATE/gm; -is ($result, $history, ' including by number'); +is ($server->acl_history ('ADMIN'), '', ' and initial history is empty'); +is ($server->acl_history (1), '', ' including by number'); is ($server->acl_create (3), undef, 'Cannot create ACL with a numeric name'); is ($server->error, 'ACL name may not be all numbers', ' and returns the right error'); @@ -79,14 +72,14 @@ like ($server->error, qr/^cannot create ACL ADMIN: /, ' and returns a good error'); is ($server->acl_create ('user2'), 1, 'Create another ACL'); is ($server->acl_create ('both'), 1, ' and one for both users'); -is ($server->acl_create ('test'), 1, ' and an empty one'); -is ($server->acl_create ('test2'), 1, ' and another test one'); +is ($server->acl_create ('test2'), 1, ' and an empty one'); +is ($server->acl_create ('test'), 1, ' and another test one'); is ($server->acl_rename ('empty', 'test'), undef, 'Cannot rename nonexistent ACL'); 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 5 to test2: /, +like ($server->error, qr/^cannot rename ACL 6 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'); @@ -114,7 +107,7 @@ is ($server->acl_add ('both', 'krb5', $user2), 1, is ($server->acl_show ('both'), "Members of ACL both (id: 4) are:\n krb5 $user1\n krb5 $user2\n", ' and show returns the correct result'); -$history = <<"EOO"; +my $history = <<"EOO"; DATE create by $admin from $host DATE add krb5 $user1 @@ -122,7 +115,7 @@ DATE add krb5 $user1 DATE add krb5 $user2 by $admin from $host EOO -$result = $server->acl_history ('both'); +my $result = $server->acl_history ('both'); $result =~ s/^\d{4}-\d\d-\d\d \d\d:\d\d:\d\d/DATE/gm; is ($result, $history, ' as does history'); is ($server->acl_add ('empty', 'krb5', $user1), 1, ' and another to empty'); @@ -135,19 +128,19 @@ 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 5: entry not found in ACL", + "cannot remove krb5:$user2 from 6: entry not found in ACL", ' and returns the right error'); is ($server->acl_show ('empty'), - "Members of ACL empty (id: 5) are:\n krb5 $user1\n", + "Members of ACL empty (id: 6) are:\n krb5 $user1\n", ' and show returns the correct status'); is ($server->acl_remove ('empty', 'krb5', $user1), 1, ' but removing a good one works'); is ($server->acl_remove ('empty', 'krb5', $user1), undef, ' but does not work twice'); is ($server->error, - "cannot remove krb5:$user1 from 5: entry not found in ACL", + "cannot remove krb5:$user1 from 6: entry not found in ACL", ' and returns the right error'); -is ($server->acl_show ('empty'), "Members of ACL empty (id: 5) are:\n", +is ($server->acl_show ('empty'), "Members of ACL empty (id: 6) are:\n", ' and show returns the correct status'); # Make sure we can't cripple the ADMIN ACL. @@ -434,11 +427,11 @@ DATE unset acl_store (was ADMIN (1)) by $admin from $host DATE set owner to ADMIN (1) by $admin from $host -DATE set acl_get to empty (5) +DATE set acl_get to empty (6) by $admin from $host -DATE set acl_store to empty (5) +DATE set acl_store to empty (6) by $admin from $host -DATE unset acl_store (was empty (5)) +DATE unset acl_store (was empty (6)) by $admin from $host DATE unset owner (was ADMIN (1)) by $admin from $host @@ -1020,7 +1013,9 @@ is ($server->acl_destroy ('test-naming'), 1, 'Destroying it succeeds'); # Clean up. $setup->destroy; -unlink 'wallet-db'; +END { + unlink 'wallet-db'; +} # Now test handling of some configuration errors. undef $Wallet::Config::DB_DRIVER; diff --git a/perl/t/lib/Util.pm b/perl/t/lib/Util.pm index 3e606fe..187e483 100644 --- a/perl/t/lib/Util.pm +++ b/perl/t/lib/Util.pm @@ -1,7 +1,7 @@ # Utility class for wallet tests. # -# Written by Russ Allbery <rra@stanford.edu> -# Copyright 2007, 2008 +# Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2007, 2008, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -10,6 +10,7 @@ package Util; require 5.006; use strict; +use warnings; use vars qw(@ISA @EXPORT $VERSION); use Wallet::Config; diff --git a/perl/t/object.t b/perl/t/object/base.t index 5eb6941..ee9ff4b 100755 --- a/perl/t/object.t +++ b/perl/t/object/base.t @@ -1,13 +1,16 @@ -#!/usr/bin/perl -w +#!/usr/bin/perl # # Tests for the basic object implementation. # -# Written by Russ Allbery <rra@stanford.edu> -# Copyright 2007, 2008, 2011 +# Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2007, 2008, 2011, 2014 # 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 => 137; @@ -67,7 +70,7 @@ if ($object->owner ('ADMIN', @trace)) { } else { is ($object->error, '', ' and setting it to ADMIN works'); } -is ($object->owner, $acl->id, ' at which point it is ADMIN'); +is ($object->owner, $acl->name, ' at which point it is ADMIN'); ok (! $object->owner ('unknown', @trace), ' but setting it to something bogus fails'); is ($object->error, 'ACL unknown not found', ' with the right error'); @@ -125,7 +128,7 @@ for my $type (qw/get store show destroy flags/) { } else { is ($object->error, '', ' and setting it to ADMIN (numeric) works'); } - is ($object->acl ($type), $acl->id, ' at which point it is ADMIN'); + is ($object->acl ($type), $acl->name, ' at which point it is ADMIN'); ok (! $object->acl ($type, 22, @trace), ' but setting it to something bogus fails'); is ($object->error, 'ACL 22 not found', ' with the right error'); @@ -135,8 +138,8 @@ for my $type (qw/get store show destroy flags/) { is ($object->error, '', ' and clearing it works'); } is ($object->acl ($type), undef, ' at which point it is cleared'); - is ($object->acl ($type, $acl->id, @trace), 1, - ' and setting it again works'); + is ($object->acl ($type, $acl->name, @trace), 1, + ' and setting it again by name works'); } # Flags. @@ -186,7 +189,7 @@ is ($object->error, "cannot store keytab:${princ}: object is locked", is ($object->owner ('', @trace), undef, ' and setting owner fails'); is ($object->error, "cannot modify keytab:${princ}: object is locked", ' for the same reason'); -is ($object->owner, 1, ' but retrieving the owner works'); +is ($object->owner, 'ADMIN', ' but retrieving the owner works'); is ($object->expires ('', @trace), undef, ' and setting expires fails'); is ($object->error, "cannot modify keytab:${princ}: object is locked", ' for the same reason'); @@ -195,7 +198,7 @@ for my $acl (qw/get store show destroy flags/) { is ($object->acl ($acl, '', @trace), undef, " and setting $acl ACL fails"); is ($object->error, "cannot modify keytab:${princ}: object is locked", ' for the same reason'); - is ($object->acl ($acl), 1, " but retrieving $acl ACL works"); + is ($object->acl ($acl), 'ADMIN', " but retrieving $acl ACL works"); } is ($object->flag_check ('locked'), 1, ' and checking flags works'); @flags = $object->flag_list; @@ -348,4 +351,6 @@ is ($object->history, $output, ' and the history is correct'); # Clean up. $admin->destroy; -unlink 'wallet-db'; +END { + unlink 'wallet-db'; +} diff --git a/perl/t/object/duo.t b/perl/t/object/duo.t new file mode 100755 index 0000000..4229afe --- /dev/null +++ b/perl/t/object/duo.t @@ -0,0 +1,157 @@ +#!/usr/bin/perl +# +# Tests for the Duo integration object implementation. +# +# Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2014 +# 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; + +BEGIN { + eval 'use Net::Duo'; + plan skip_all => 'Net::Duo required for testing duo' + if $@; + eval 'use Net::Duo::Mock::Agent'; + plan skip_all => 'Net::Duo::Mock::Agent required for testing duo' + if $@; +} + +BEGIN { + use_ok('Wallet::Admin'); + use_ok('Wallet::Config'); + use_ok('Wallet::Object::Duo'); +} + +use lib 't/lib'; +use Util; + +# Some global defaults to use. +my $user = 'admin@EXAMPLE.COM'; +my $host = 'localhost'; +my @trace = ($user, $host, time); +my $date = strftime ('%Y-%m-%d %H:%M:%S', localtime $trace[2]); + +# Flush all output immediately. +$| = 1; + +# Use Wallet::Admin to set up the database. +db_setup; +my $admin = eval { Wallet::Admin->new }; +is ($@, '', 'Database connection succeeded'); +is ($admin->reinitialize ($user), 1, 'Database initialization succeeded'); +my $schema = $admin->schema; + +# Create a mock object to use for Duo calls. +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->new ('duo', 'test', $schema); +}; +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->create ('duo', 'test', $schema, @trace); +}; +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. +$Wallet::Config::DUO_AGENT = $mock; +$Wallet::Config::DUO_KEY_FILE = 't/data/duo/keys.json'; + +# Test creating an integration. +note ('Test creating an integration'); +my $expected = { + name => 'test', + notes => 'Managed by wallet', + type => 'unix', +}; +$mock->expect ( + { + method => 'POST', + uri => '/admin/v1/integrations', + content => $expected, + response_file => 't/data/duo/integration.json', + } +); +$object = Wallet::Object::Duo->create ('duo', 'test', $schema, @trace); +isa_ok ($object, 'Wallet::Object::Duo'); + +# Check the metadata about the new wallet object. +$expected = <<"EOO"; + Type: duo + Name: test + Duo key: DIRWIH0ZZPV4G88B37VQ + Created by: $user + Created from: $host + Created on: $date +EOO +is ($object->show, $expected, 'Show output is correct'); + +# Test retrieving the integration information. +note ('Test retrieving an integration'); +$mock->expect ( + { + method => 'GET', + uri => '/admin/v1/integrations/DIRWIH0ZZPV4G88B37VQ', + response_file => 't/data/duo/integration.json', + } +); +my $data = $object->get (@trace); +ok (defined ($data), 'Retrieval succeeds'); +$expected = <<'EOO'; +[duo] +ikey = DIRWIH0ZZPV4G88B37VQ +skey = QO4ZLqQVRIOZYkHfdPDORfcNf8LeXIbCWwHazY7o +host = example-admin.duosecurity.com +EOO +is ($data, $expected, '...and integration data is correct'); + +# Ensure that we can't retrieve the object when locked. +is ($object->flag_set ('locked', @trace), 1, + 'Setting object to locked succeeds'); +is ($object->get, undef, '...and now get fails'); +is ($object->error, 'cannot get duo:test: object is locked', + '...with correct error'); +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->new ('duo', '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 +# calls and delete makes two calls. +note ('Test deleting an integration'); +$mock->expect ( + { + method => 'GET', + uri => '/admin/v1/integrations/DIRWIH0ZZPV4G88B37VQ', + response_file => 't/data/duo/integration.json', + } +); +TODO: { + local $TODO = 'Net::Duo::Mock::Agent not yet capable'; + + is ($object->destroy (@trace), 1, 'Duo object deletion succeeded'); + $object = eval { Wallet::Object::Duo->new ('duo', 'test', $schema) }; + is ($object, undef, '...and now object cannot be retrieved'); + is ($@, "cannot find duo:test\n", '...with correct error'); +} + +# Clean up. +$admin->destroy; +END { + unlink ('wallet-db'); +} + +# Done testing. +done_testing (); diff --git a/perl/t/file.t b/perl/t/object/file.t index 5cb7c35..201f46d 100755 --- a/perl/t/file.t +++ b/perl/t/object/file.t @@ -1,13 +1,16 @@ -#!/usr/bin/perl -w +#!/usr/bin/perl # # Tests for the file object implementation. # -# Written by Russ Allbery <rra@stanford.edu> -# Copyright 2008 +# Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2008, 2014 # 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 => 56; @@ -39,7 +42,7 @@ my $history = ''; my $date = strftime ('%Y-%m-%d %H:%M:%S', localtime $trace[2]); # Test error handling in the absence of configuration. -$object = eval { +my $object = eval { Wallet::Object::File->create ('file', 'test', $schema, @trace) }; ok (defined ($object), 'Creating a basic file object succeeds'); @@ -145,4 +148,6 @@ is ($object->destroy (@trace), 1, ' but destroying the object succeeds'); # Clean up. $admin->destroy; -unlink ('wallet-db'); +END { + unlink ('wallet-db'); +} diff --git a/perl/t/keytab.t b/perl/t/object/keytab.t index f89b2c6..69db438 100755 --- a/perl/t/keytab.t +++ b/perl/t/object/keytab.t @@ -1,15 +1,18 @@ -#!/usr/bin/perl -w +#!/usr/bin/perl # # Tests for the keytab object implementation. # -# Written by Russ Allbery <rra@stanford.edu> -# Copyright 2007, 2008, 2009, 2010, 2013 +# Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2007, 2008, 2009, 2010, 2013, 2014 # 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 => 139; +use Test::More tests => 141; BEGIN { $Wallet::Config::KEYTAB_TMP = '.' } @@ -117,14 +120,14 @@ sub enctypes { next unless /^ *\d+ /; my ($string) = /\((.*)\)\s*$/; next unless $string; - $enctype = $enctype{lc $string} || 'UNKNOWN'; + my $enctype = $enctype{lc $string} || 'UNKNOWN'; push (@enctypes, $enctype); } close KLIST; # If that failed, we may have a Heimdal user space instead, so try ktutil. # If we try this directly, it will just hang with MIT ktutil. - if ($? != 0) { + if ($? != 0 || !@enctypes) { @enctypes = (); open (KTUTIL, '-|', 'ktutil', '-k', 'keytab', 'list') or die "cannot run ktutil: $!\n"; @@ -174,7 +177,7 @@ SKIP: { # Test that object creation without KEYTAB_TMP fails. undef $Wallet::Config::KEYTAB_TMP; - $object = eval { + my $object = eval { Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema, @trace) }; @@ -386,7 +389,7 @@ EOO # Tests for unchanging support. Skip these if we don't have a keytab or if we # can't find remctld. SKIP: { - skip 'no keytab configuration', 31 unless -f 't/data/test.keytab'; + skip 'no keytab configuration', 32 unless -f 't/data/test.keytab'; # Set up our configuration. $Wallet::Config::KEYTAB_FILE = 't/data/test.keytab'; @@ -471,7 +474,7 @@ SKIP: { # Now Heimdal. Since the keytab contains timestamps, before testing for # equality we have to substitute out the timestamps. SKIP: { - skip 'skipping Heimdal unchanging tests for MIT', 10 + skip 'skipping Heimdal unchanging tests for MIT', 11 if (lc ($Wallet::Config::KEYTAB_KRBTYPE) eq 'mit'); my $data = $one->get (@trace); ok (defined $data, 'Get of unchanging keytab works'); @@ -480,7 +483,8 @@ SKIP: { ok (defined $second, ' and second retrieval also works'); $data =~ s/one.{8}/one\000\000\000\000\000\000\000\000/g; $second =~ s/one.{8}/one\000\000\000\000\000\000\000\000/g; - is ($data, $second, ' and the keytab matches'); + ok (keytab_valid ($second, 'wallet/one'), ' and the keytab is valid'); + ok (keytab_valid ($data, 'wallet/one'), ' as is the first keytab'); is ($one->flag_clear ('unchanging', @trace), 1, 'Clearing the unchanging flag works'); $data = $one->get (@trace); @@ -585,7 +589,7 @@ EOO # Tests for enctype restriction. SKIP: { - skip 'no keytab configuration', 36 unless -f 't/data/test.keytab'; + skip 'no keytab configuration', 37 unless -f 't/data/test.keytab'; # Set up our configuration. $Wallet::Config::KEYTAB_FILE = 't/data/test.keytab'; @@ -619,18 +623,12 @@ EOO is ($one->history, $history, ' and history is still correct'); # No enctypes we recognize? - skip 'no recognized enctypes', 33 unless @enctypes; - - # We can test. Add the enctypes we recognized to the enctypes table so - # that we'll be allowed to use them. - for my $enctype (@enctypes) { - my $sql = 'insert into enctypes (en_name) values (?)'; - $dbh->do ($sql, undef, $enctype); - } + skip 'no recognized enctypes', 34 unless @enctypes; # Set those encryption types and make sure we get back a limited keytab. is ($one->attr ('enctypes', [ @enctypes ], @trace), 1, 'Setting enctypes works'); + is ($one->error, undef, ' with no error'); for my $enctype (@enctypes) { $history .= "$date add $enctype to attribute enctypes\n"; $history .= " by $user from $host\n"; @@ -639,7 +637,7 @@ EOO is ("@values", "@enctypes", ' and we get back the right enctype list'); my $eshow = join ("\n" . (' ' x 17), @enctypes); $eshow =~ s/\s+\z/\n/; - $expected = <<"EOO"; + my $expected = <<"EOO"; Type: keytab Name: wallet/one Enctypes: $eshow @@ -771,4 +769,6 @@ EOO # Clean up. $admin->destroy; -unlink ('wallet-db', 'krb5cc_temp', 'krb5cc_test', 'test-acl', 'test-pid'); +END { + unlink ('wallet-db', 'krb5cc_temp', 'krb5cc_test', 'test-acl', 'test-pid'); +} diff --git a/perl/t/wa-keyring.t b/perl/t/object/wa-keyring.t index 7ba5723..4a3bd48 100755 --- a/perl/t/wa-keyring.t +++ b/perl/t/object/wa-keyring.t @@ -2,8 +2,8 @@ # # Tests for the WebAuth keyring object implementation. # -# Written by Russ Allbery <rra@stanford.edu> -# Copyright 2013 +# Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2013, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -19,7 +19,6 @@ BEGIN { if $@; } -use POSIX qw(strftime); use WebAuth::Key 1.01 (); use WebAuth::Keyring 1.02 (); @@ -179,4 +178,6 @@ is ($object->destroy (@trace), 1, ' but destroying the object succeeds'); # Clean up. $admin->destroy; -unlink ('wallet-db'); +END { + unlink ('wallet-db'); +} diff --git a/perl/t/pod-spelling.t b/perl/t/pod-spelling.t deleted file mode 100755 index 6d9f7b0..0000000 --- a/perl/t/pod-spelling.t +++ /dev/null @@ -1,74 +0,0 @@ -#!/usr/bin/perl -w -# -# Check for spelling errors in POD documentation -# -# Checks all POD files in the tree for spelling problems using Pod::Spell and -# either aspell or ispell. aspell is preferred. This test is disabled unless -# RRA_MAINTAINER_TESTS is set, since spelling dictionaries vary too much -# between environments. -# -# Copyright 2008, 2009 Russ Allbery <rra@stanford.edu> -# -# See LICENSE for licensing terms. - -use strict; -use Test::More; - -# Skip all spelling tests unless the maintainer environment variable is set. -plan skip_all => 'Spelling tests only run for maintainer' - unless $ENV{RRA_MAINTAINER_TESTS}; - -# Load required Perl modules. -eval 'use Test::Pod 1.00'; -plan skip_all => 'Test::Pod 1.00 required for testing POD' if $@; -eval 'use Pod::Spell'; -plan skip_all => 'Pod::Spell required to test POD spelling' if $@; - -# Locate a spell-checker. hunspell is not currently supported due to its lack -# of support for contractions (at least in the version in Debian). -my @spell; -my %options = (aspell => [ qw(-d en_US --home-dir=./ list) ], - ispell => [ qw(-d american -l -p /dev/null) ]); -SEARCH: for my $program (qw/aspell ispell/) { - for my $dir (split ':', $ENV{PATH}) { - if (-x "$dir/$program") { - @spell = ("$dir/$program", @{ $options{$program} }); - } - last SEARCH if @spell; - } -} -plan skip_all => 'aspell or ispell required to test POD spelling' - unless @spell; - -# Prerequisites are satisfied, so we're going to do some testing. Figure out -# what POD files we have and from that develop our plan. -$| = 1; -my @pod = all_pod_files (); -plan tests => scalar @pod; - -# Finally, do the checks. -for my $pod (@pod) { - my $child = open (CHILD, '-|'); - if (not defined $child) { - die "Cannot fork: $!\n"; - } elsif ($child == 0) { - my $pid = open (SPELL, '|-', @spell) or die "Cannot run @spell: $!\n"; - open (POD, '<', $pod) or die "Cannot open $pod: $!\n"; - my $parser = Pod::Spell->new; - $parser->parse_from_filehandle (\*POD, \*SPELL); - close POD; - close SPELL; - exit ($? >> 8); - } else { - my @words = <CHILD>; - close CHILD; - SKIP: { - skip "@spell failed for $pod", 1 unless $? == 0; - for (@words) { - s/^\s+//; - s/\s+$//; - } - is ("@words", '', $pod); - } - } -} diff --git a/perl/t/pod.t b/perl/t/pod.t deleted file mode 100755 index dc5f468..0000000 --- a/perl/t/pod.t +++ /dev/null @@ -1,15 +0,0 @@ -#!/usr/bin/perl -w -# -# Test POD formatting for the wallet Perl modules. -# -# Written by Russ Allbery <rra@stanford.edu> -# Copyright 2007, 2010 -# The Board of Trustees of the Leland Stanford Junior University -# -# See LICENSE for licensing terms. - -use strict; -use Test::More; -eval 'use Test::Pod 1.00'; -plan skip_all => 'Test::Pod 1.00 required for testing POD' if $@; -all_pod_files_ok (); diff --git a/perl/t/stanford-naming.t b/perl/t/policy/stanford.t index 3b9ea60..555086c 100755 --- a/perl/t/stanford-naming.t +++ b/perl/t/policy/stanford.t @@ -6,8 +6,8 @@ # sites, but it's used at Stanford and this test suite is used to verify # behavior at Stanford. # -# Written by Russ Allbery <rra@stanford.edu> -# Copyright 2013 +# Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2013, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -16,7 +16,7 @@ use 5.008; use strict; use warnings; -use Test::More tests => 99; +use Test::More tests => 101; use lib 't/lib'; use Util; @@ -31,11 +31,12 @@ BEGIN { # 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 - group-example-01/cgi); + group-example-01/cgi afs/testcell.stanford.edu); # Various invalid keytab names. my @INVALID_KEYTABS = qw(example host/example service/example.stanford.edu - thisistoolong/cgi not-valid/cgi unknown/example.stanford.edu); + thisistoolong/cgi not-valid/cgi unknown/example.stanford.edu + afs/testcell); # Various valid file names. my @VALID_FILES = qw(htpasswd/example.stanford.edu/web @@ -254,4 +255,6 @@ for my $type (qw(htpasswd ssh-rsa ssh-dsa ssl-key tivoli-key)) { # Clean up. $setup->destroy; -unlink 'wallet-db'; +END { + unlink 'wallet-db'; +} diff --git a/perl/t/style/minimum-version.t b/perl/t/style/minimum-version.t new file mode 100755 index 0000000..e4eeafd --- /dev/null +++ b/perl/t/style/minimum-version.t @@ -0,0 +1,47 @@ +#!/usr/bin/perl +# +# Check that too-new features of Perl are not being used. +# +# The canonical version of this file is maintained in the rra-c-util package, +# which can be found at <http://www.eyrie.org/~eagle/software/rra-c-util/>. +# +# Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2013, 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. + +use 5.006; +use strict; +use warnings; + +use lib 't/lib'; + +use Test::More; +use Test::RRA qw(skip_unless_automated use_prereq); +use Test::RRA::Config qw($MINIMUM_VERSION); + +# Skip for normal user installs since this doesn't affect functionality. +skip_unless_automated('Minimum version tests'); + +# Load prerequisite modules. +use_prereq('Test::MinimumVersion'); + +# Check all files in the Perl distribution. +all_minimum_version_ok($MINIMUM_VERSION); diff --git a/perl/t/style/strict.t b/perl/t/style/strict.t new file mode 100755 index 0000000..7137b15 --- /dev/null +++ b/perl/t/style/strict.t @@ -0,0 +1,56 @@ +#!/usr/bin/perl +# +# Test Perl code for strict, warnings, and syntax. +# +# The canonical version of this file is maintained in the rra-c-util package, +# which can be found at <http://www.eyrie.org/~eagle/software/rra-c-util/>. +# +# Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2013, 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. + +use 5.006; +use strict; +use warnings; + +use lib 't/lib'; + +use File::Spec; +use Test::RRA qw(skip_unless_automated use_prereq); + +# Skip for normal user installs since this doesn't affect functionality. +skip_unless_automated('Strictness tests'); + +# Load prerequisite modules. +use_prereq('Test::Strict'); + +# Test everything in the distribution directory except the Build and +# Makefile.PL scripts generated by Module::Build. We also want to check use +# warnings. +$Test::Strict::TEST_SKIP = ['Build', 'Makefile.PL']; +$Test::Strict::TEST_WARNINGS = 1; +all_perl_files_ok(File::Spec->curdir); + +# Hack to suppress "used only once" warnings. +END { + $Test::Strict::TEST_SKIP = []; + $Test::Strict::TEST_WARNINGS = 0; +} diff --git a/perl/t/kadmin.t b/perl/t/util/kadmin.t index 8eabc6b..db94780 100755 --- a/perl/t/kadmin.t +++ b/perl/t/util/kadmin.t @@ -1,14 +1,16 @@ -#!/usr/bin/perl -w +#!/usr/bin/perl # # Tests for the kadmin object implementation. # # Written by Jon Robertson <jonrober@stanford.edu> -# Copyright 2009, 2010, 2012, 2013 +# Copyright 2009, 2010, 2012, 2013, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. -use POSIX qw(strftime); +use strict; +use warnings; + use Test::More tests => 34; BEGIN { $Wallet::Config::KEYTAB_TMP = '.' } diff --git a/perl/t/verifier.t b/perl/t/verifier/basic.t index 75f1afa..ce44d44 100755 --- a/perl/t/verifier.t +++ b/perl/t/verifier/basic.t @@ -1,13 +1,16 @@ -#!/usr/bin/perl -w +#!/usr/bin/perl # # Tests for the basic wallet ACL verifiers. # -# Written by Russ Allbery <rra@stanford.edu> -# Copyright 2007, 2008, 2010 +# Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2007, 2008, 2010, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. +use strict; +use warnings; + use Test::More tests => 57; use Wallet::ACL::Base; @@ -23,22 +26,22 @@ use Util; my $verifier = Wallet::ACL::Base->new; ok (defined $verifier, 'Wallet::ACL::Base creation'); ok ($verifier->isa ('Wallet::ACL::Base'), ' and class verification'); -is ($verifier->check ('rra@stanford.edu', 'rra@stanford.edu'), 0, +is ($verifier->check ('eagle@eyrie.org', 'eagle@eyrie.org'), 0, 'Default check declines'); is ($verifier->error, undef, 'No error set'); $verifier = Wallet::ACL::Krb5->new; ok (defined $verifier, 'Wallet::ACL::Krb5 creation'); ok ($verifier->isa ('Wallet::ACL::Krb5'), ' and class verification'); -is ($verifier->check ('rra@stanford.edu', 'rra@stanford.edu'), 1, +is ($verifier->check ('eagle@eyrie.org', 'eagle@eyrie.org'), 1, 'Simple check'); -is ($verifier->check ('rra@stanford.edu', 'thoron@stanford.edu'), 0, +is ($verifier->check ('eagle@eyrie.org', 'thoron@stanford.edu'), 0, 'Simple failure'); is ($verifier->error, undef, 'No error set'); -is ($verifier->check (undef, 'rra@stanford.edu'), undef, +is ($verifier->check (undef, 'eagle@eyrie.org'), undef, 'Undefined principal'); is ($verifier->error, 'no principal specified', ' and right error'); -is ($verifier->check ('rra@stanford.edu', ''), undef, 'Empty ACL'); +is ($verifier->check ('eagle@eyrie.org', ''), undef, 'Empty ACL'); is ($verifier->error, 'malformed krb5 ACL', ' and right error'); $verifier = Wallet::ACL::Krb5::Regex->new; @@ -51,9 +54,9 @@ is ($verifier->error, undef, 'No error set'); is ($verifier->check (undef, '^rra@stanford\.edu\z'), undef, 'Undefined principal'); is ($verifier->error, 'no principal specified', ' and right error'); -is ($verifier->check ('rra@stanford.edu', ''), undef, 'Empty ACL'); +is ($verifier->check ('eagle@eyrie.org', ''), undef, 'Empty ACL'); is ($verifier->error, 'no ACL specified', ' and right error'); -is ($verifier->check ('rra@stanford.edu', '(rra'), undef, 'Malformed regex'); +is ($verifier->check ('eagle@eyrie.org', '(rra'), undef, 'Malformed regex'); is ($verifier->error, 'malformed krb5-regex ACL', ' and right error'); # Tests for the NetDB verifiers. Skip these if we don't have a keytab or if diff --git a/perl/t/verifier-ldap-attr.t b/perl/t/verifier/ldap-attr.t index 7fad990..3c132e2 100755 --- a/perl/t/verifier-ldap-attr.t +++ b/perl/t/verifier/ldap-attr.t @@ -1,16 +1,19 @@ -#!/usr/bin/perl -w +#!/usr/bin/perl # # Tests for the LDAP attribute ACL verifier. # # This test can only be run by someone local to Stanford with appropriate # access to the LDAP server and will be skipped in all other environments. # -# Written by Russ Allbery <rra@stanford.edu> +# Written by Russ Allbery <eagle@eyrie.org> # Copyright 2012, 2013, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. +use strict; +use warnings; + use Test::More; use lib 't/lib'; diff --git a/perl/t/verifier-netdb.t b/perl/t/verifier/netdb.t index 398cc6a..7048ef9 100755 --- a/perl/t/verifier-netdb.t +++ b/perl/t/verifier/netdb.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl -w +#!/usr/bin/perl # # Tests for the NetDB wallet ACL verifiers. # @@ -6,13 +6,16 @@ # access to the NetDB role server and will be skipped in all other # environments. # -# Written by Russ Allbery <rra@stanford.edu> -# Copyright 2008 +# Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2008, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. -use Test::More tests => 4; +use strict; +use warnings; + +use Test::More tests => 5; use Wallet::ACL::NetDB; @@ -26,8 +29,8 @@ my $user = 'rra@stanford.edu'; # Determine the local principal. my $klist = `klist 2>&1` || ''; SKIP: { - skip "tests useful only with Stanford Kerberos tickets", 4 - unless ($klist =~ /^Default principal: \S+\@stanford\.edu$/m); + skip "tests useful only with Stanford Kerberos tickets", 5 + unless ($klist =~ /^(Default p|\s+P)rincipal: \S+\@stanford\.edu$/m); # Set up our configuration. $Wallet::Config::NETDB_REALM = 'stanford.edu'; @@ -35,8 +38,9 @@ SKIP: { $Wallet::Config::NETDB_REMCTL_HOST = $netdb; # Finally, we can test. - $verifier = eval { Wallet::ACL::NetDB->new }; + my $verifier = eval { Wallet::ACL::NetDB->new }; ok (defined $verifier, ' and now creation succeeds'); + is ($@, q{}, ' with no errors'); ok ($verifier->isa ('Wallet::ACL::NetDB'), ' and returns the right class'); is ($verifier->check ($user, $host), 1, "Checking $host succeeds"); is ($verifier->check ('test-user@stanford.edu', $host), 0, |