From 6b7b9a29d20a65712061648404bbc6f1be5cacee Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Mon, 8 Dec 2014 21:48:35 -0800 Subject: Fix syntax of NAME section of Wallet::Object::Duo::* modules --- perl/lib/Wallet/Object/Duo/LDAPProxy.pm | 2 +- perl/lib/Wallet/Object/Duo/PAM.pm | 2 +- perl/lib/Wallet/Object/Duo/RDP.pm | 2 +- perl/lib/Wallet/Object/Duo/RadiusProxy.pm | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) (limited to 'perl/lib/Wallet/Object') diff --git a/perl/lib/Wallet/Object/Duo/LDAPProxy.pm b/perl/lib/Wallet/Object/Duo/LDAPProxy.pm index 74ff43c..23894ac 100644 --- a/perl/lib/Wallet/Object/Duo/LDAPProxy.pm +++ b/perl/lib/Wallet/Object/Duo/LDAPProxy.pm @@ -100,7 +100,7 @@ Allbery Duo integration DBH keytab LDAP auth =head1 NAME -Wallet::Object::Duo::LDAPProxy -- Duo auth proxy integration for LDAP +Wallet::Object::Duo::LDAPProxy - Duo auth proxy integration for LDAP =head1 SYNOPSIS diff --git a/perl/lib/Wallet/Object/Duo/PAM.pm b/perl/lib/Wallet/Object/Duo/PAM.pm index 6f90ba1..d9d17f8 100644 --- a/perl/lib/Wallet/Object/Duo/PAM.pm +++ b/perl/lib/Wallet/Object/Duo/PAM.pm @@ -101,7 +101,7 @@ Allbery Duo integration DBH keytab =head1 NAME -Wallet::Object::Duo::PAM -- Duo PAM int. object implementation for wallet +Wallet::Object::Duo::PAM - Duo PAM int. object implementation for wallet =head1 SYNOPSIS diff --git a/perl/lib/Wallet/Object/Duo/RDP.pm b/perl/lib/Wallet/Object/Duo/RDP.pm index 2e975fc..c74661c 100644 --- a/perl/lib/Wallet/Object/Duo/RDP.pm +++ b/perl/lib/Wallet/Object/Duo/RDP.pm @@ -101,7 +101,7 @@ Allbery Duo integration DBH keytab RDP =head1 NAME -Wallet::Object::Duo::RDP -- Duo RDP int. object implementation for wallet +Wallet::Object::Duo::RDP - Duo RDP int. object implementation for wallet =head1 SYNOPSIS diff --git a/perl/lib/Wallet/Object/Duo/RadiusProxy.pm b/perl/lib/Wallet/Object/Duo/RadiusProxy.pm index faa0c2f..a1f6e24 100644 --- a/perl/lib/Wallet/Object/Duo/RadiusProxy.pm +++ b/perl/lib/Wallet/Object/Duo/RadiusProxy.pm @@ -101,7 +101,7 @@ Allbery Duo integration DBH keytab auth =head1 NAME -Wallet::Object::Duo::RadiusProxy -- Duo auth proxy integration for RADIUS +Wallet::Object::Duo::RadiusProxy - Duo auth proxy integration for RADIUS =head1 SYNOPSIS -- cgit v1.2.3 From 55875aa020f31751f295ae6c07547fe2949c5e82 Mon Sep 17 00:00:00 2001 From: Jon Robertson Date: Sat, 7 Feb 2015 13:59:34 -0800 Subject: Added a new password object type The password type inherits almost everything from the file object, but if you try to get a password object that has never been stored, we generate a random string to put in the object rather than just erroring out. The maximum and minimum length of the string can be set in the wallet config. If a password object was stored earlier and then cleared out, we don't generate another random string. Change-Id: I17a65ca7dac9d4430e8a731f417297890ee612bb --- perl/lib/Wallet/Admin.pm | 1 + perl/lib/Wallet/Config.pm | 43 ++++++++ perl/lib/Wallet/Object/Password.pm | 210 +++++++++++++++++++++++++++++++++++++ perl/t/object/password.t | 118 +++++++++++++++++++++ 4 files changed, 372 insertions(+) create mode 100644 perl/lib/Wallet/Object/Password.pm create mode 100644 perl/t/object/password.t (limited to 'perl/lib/Wallet/Object') diff --git a/perl/lib/Wallet/Admin.pm b/perl/lib/Wallet/Admin.pm index 8120e9c..a8b8368 100644 --- a/perl/lib/Wallet/Admin.pm +++ b/perl/lib/Wallet/Admin.pm @@ -131,6 +131,7 @@ sub default_data { [ 'duo-radius', 'Wallet::Object::Duo::RadiusProxy' ], [ 'duo-rdp', 'Wallet::Object::Duo::RDP' ], [ 'file', 'Wallet::Object::File' ], + [ 'password', 'Wallet::Object::Password' ], [ 'keytab', 'Wallet::Object::Keytab' ], [ 'wa-keyring', 'Wallet::Object::WAKeyring' ]); ($r1) = $self->{schema}->resultset('Type')->populate (\@record); diff --git a/perl/lib/Wallet/Config.pm b/perl/lib/Wallet/Config.pm index 2eb57f9..76c7ecd 100644 --- a/perl/lib/Wallet/Config.pm +++ b/perl/lib/Wallet/Config.pm @@ -260,6 +260,49 @@ our $FILE_MAX_SIZE; =back +=head1 PASSWORD OBJECT CONFIGURATION + +These configuration variables only need to be set if you intend to use the +C object type (the Wallet::Object::Password class). You will also +need to set the FILE_MAX_SIZE value from the file object configuration, as +that is inherited. + +=over 4 + +=item PWD_FILE_BUCKET + +The directory into which to store password objects. Password objects will +be stored in subdirectories of this directory. See +L for the full details of the naming scheme. This +directory must be writable by the wallet server and the wallet server must +be able to create subdirectories of it. + +PWD_FILE_BUCKET must be set to use file objects. + +=cut + +our $PWD_FILE_BUCKET; + +=item PWD_LENGTH_MIN + +The minimum length for any auto-generated password objects created when get +is run before data is stored. + +=cut + +our $PWD_LENGTH_MIN = 20; + +=item PWD_LENGTH_MAX + +The maximum length for any auto-generated password objects created when get +is run before data is stored. + +=cut + +our $PWD_LENGTH_MAX = 21; + +=back + =head1 KEYTAB OBJECT CONFIGURATION These configuration variables only need to be set if you intend to use the diff --git a/perl/lib/Wallet/Object/Password.pm b/perl/lib/Wallet/Object/Password.pm new file mode 100644 index 0000000..d06c8a6 --- /dev/null +++ b/perl/lib/Wallet/Object/Password.pm @@ -0,0 +1,210 @@ +# Wallet::Object::Password -- Password object implementation for the wallet. +# +# Written by Jon Robertson +# Copyright 2015 +# The Board of Trustees of the Leland Stanford Junior University +# +# See LICENSE for licensing terms. + +############################################################################## +# Modules and declarations +############################################################################## + +package Wallet::Object::Password; +require 5.006; + +use strict; +use warnings; +use vars qw(@ISA $VERSION); + +use Crypt::GeneratePassword qw(chars); +use Digest::MD5 qw(md5_hex); +use Wallet::Config (); +use Wallet::Object::File; + +@ISA = qw(Wallet::Object::File); + +# This version should be increased on any code change to this module. Always +# use two digits for the minor version with a leading zero if necessary so +# that it will sort properly. +$VERSION = '0.01'; + +############################################################################## +# File naming +############################################################################## + +# Returns the path into which that password object will be stored or undef on +# error. On error, sets the internal error. +sub file_path { + my ($self) = @_; + my $name = $self->{name}; + unless ($Wallet::Config::PWD_FILE_BUCKET) { + $self->error ('password support not configured'); + return; + } + unless ($name) { + $self->error ('password objects may not have empty names'); + return; + } + my $hash = substr (md5_hex ($name), 0, 2); + $name =~ s/([^\w-])/sprintf ('%%%02X', ord ($1))/ge; + my $parent = "$Wallet::Config::PWD_FILE_BUCKET/$hash"; + unless (-d $parent || mkdir ($parent, 0700)) { + $self->error ("cannot create password bucket $hash: $!"); + return; + } + return "$Wallet::Config::PWD_FILE_BUCKET/$hash/$name"; +} + +############################################################################## +# Core methods +############################################################################## + +# Return the contents of the file. +sub get { + my ($self, $user, $host, $time) = @_; + $time ||= time; + my $id = $self->{type} . ':' . $self->{name}; + if ($self->flag_check ('locked')) { + $self->error ("cannot get $id: object is locked"); + return; + } + my $path = $self->file_path; + return unless $path; + + # If nothing is yet stored, generate a random password and save it to + # the file. + my $schema = $self->{schema}; + my %search = (ob_type => $self->{type}, + ob_name => $self->{name}); + my $object = $schema->resultset('Object')->find (\%search); + unless ($object->ob_stored_on) { + unless (open (FILE, '>', $path)) { + $self->error ("cannot store initial settings for $id: $!\n"); + return; + } + my $pass = chars ($Wallet::Config::PWD_LENGTH_MIN, + $Wallet::Config::PWD_LENGTH_MAX); + print FILE $pass; + $self->log_action ('store', $user, $host, $time); + unless (close FILE) { + $self->error ("cannot get $id: $!"); + return; + } + } + + unless (open (FILE, '<', $path)) { + $self->error ("cannot get $id: object has not been stored"); + return; + } + local $/; + my $data = ; + unless (close FILE) { + $self->error ("cannot get $id: $!"); + return; + } + $self->log_action ('get', $user, $host, $time); + return $data; +} + +1; +__END__ + +############################################################################## +# Documentation +############################################################################## + +=head1 NAME + +Wallet::Object::Password - Password object implementation for wallet + +=for stopwords +API HOSTNAME DATETIME keytab remctld backend nul Allbery wallet-backend + +=head1 SYNOPSIS + + my @name = qw(file mysql-lsdb) + my @trace = ($user, $host, time); + my $object = Wallet::Object::Password->create (@name, $schema, @trace); + unless ($object->store ("the-password\n")) { + die $object->error, "\n"; + } + my $password = $object->get (@trace); + $object->destroy (@trace); + +=head1 DESCRIPTION + +Wallet::Object::Password is an extension of Wallet::Object::File, +acting as a representation of simple file objects in the wallet. The +difference between the two is that if there is no data stored in a +password object when a user tries to get it for the first time, then a +random string suited for a password will be generated and put into the +object data. + +It implements the wallet object API and provides the necessary +glue to store a file on the wallet server, retrieve it later, and delete +it when the password object is deleted. + +To use this object, the configuration option specifying where on the +wallet server to store password objects must be set. See +L for details on this configuration parameter and +information about how to set wallet configuration. + +=head1 METHODS + +This object mostly inherits from Wallet::Object::File. See the +documentation for that class for all generic methods. Below are only +those methods that are overridden or behave specially for this +implementation. + +=over 4 + +=item get(PRINCIPAL, HOSTNAME [, DATETIME]) + +Retrieves the current contents of the file object or undef on error. +store() must be called before get() will be successful. The caller should +call error() to get the error message if get() returns undef. PRINCIPAL, +HOSTNAME, and DATETIME are stored as history information. PRINCIPAL +should be the user who is downloading the keytab. If DATETIME isn't +given, the current time is used. + +=back + +=head1 FILES + +=over 4 + +=item PWD_FILE_BUCKET// + +Password files are stored on the wallet server under the directory +PWD_FILE_BUCKET as set in the wallet configuration. is the +first two characters of the hex-encoded MD5 hash of the wallet password +object name, used to not put too many files in the same directory. + is the name of the password object with all characters other +than alphanumerics, underscores, and dashes replaced by C<%> and the +hex code of the character. + +=back + +=head1 LIMITATIONS + +The wallet implementation itself can handle arbitrary password object +names. However, due to limitations in the B server usually +used to run B, password object names containing nul +characters (ASCII 0) may not be permitted. The file system used for +storing file objects may impose a length limitation on the +password object name. + +=head1 SEE ALSO + +remctld(8), Wallet::Config(3), Wallet::Object::File(3), +wallet-backend(8) + +This module is part of the wallet system. The current version is +available from L. + +=head1 AUTHOR + +Jon Robertson + +=cut diff --git a/perl/t/object/password.t b/perl/t/object/password.t new file mode 100644 index 0000000..c0f2fbc --- /dev/null +++ b/perl/t/object/password.t @@ -0,0 +1,118 @@ +#!/usr/bin/perl +# +# Tests for the password object implementation. Only includes tests that are +# basic or different from the file object implementation. +# +# Written by Jon Robertson +# Copyright 2015 +# The Board of Trustees of the Leland Stanford Junior University +# +# See LICENSE for licensing terms. + +use strict; +use warnings; + +use POSIX qw(strftime); +use Test::More tests => 31; + +use Wallet::Admin; +use Wallet::Config; +use Wallet::Object::Password; + +use lib 't/lib'; +use Util; + +# Some global defaults to use. +my $user = 'admin@EXAMPLE.COM'; +my $host = 'localhost'; +my @trace = ($user, $host, time); + +# Flush all output immediately. +$| = 1; + +# Use Wallet::Admin to set up the database. +system ('rm -rf test-files') == 0 or die "cannot remove test-files\n"; +db_setup; +my $admin = eval { Wallet::Admin->new }; +is ($@, '', 'Database connection succeeded'); +is ($admin->reinitialize ($user), 1, 'Database initialization succeeded'); +my $schema = $admin->schema; + +# Use this to accumulate the history traces so that we can check history. +my $history = ''; +my $date = strftime ('%Y-%m-%d %H:%M:%S', localtime $trace[2]); + +$Wallet::Config::PWD_FILE_BUCKET = undef; + +# Test error handling in the absence of configuration. +my $object = eval { + Wallet::Object::Password->create ('password', 'test', $schema, @trace) + }; +ok (defined ($object), 'Creating a basic password object succeeds'); +ok ($object->isa ('Wallet::Object::Password'), ' and is the right class'); +is ($object->get (@trace), undef, ' and get fails'); +is ($object->error, 'password support not configured', + ' with the right error'); +is ($object->store (@trace), undef, ' and store fails'); +is ($object->error, 'password support not configured', + ' with the right error'); +is ($object->destroy (@trace), 1, ' but destroy succeeds'); + +# Set up our configuration. +mkdir 'test-files' or die "cannot create test-files: $!\n"; +$Wallet::Config::PWD_FILE_BUCKET = 'test-files'; +$Wallet::Config::PWD_LENGTH_MIN = 10; +$Wallet::Config::PWD_LENGTH_MAX = 10; + +# Okay, now we can test. First, the basic object without store. +$object = eval { + Wallet::Object::Password->create ('password', 'test', $schema, @trace) + }; +ok (defined ($object), 'Creating a basic password object succeeds'); +ok ($object->isa ('Wallet::Object::Password'), ' and is the right class'); +my $pwd = $object->get (@trace); +like ($pwd, qr{^.{$Wallet::Config::PWD_LENGTH_MIN}$}, + ' and get creates a random password string of the right length'); +ok (-d 'test-files/09', ' and the hash bucket was created'); +ok (-f 'test-files/09/test', ' and the file exists'); +is (contents ('test-files/09/test'), $pwd, ' with the right contents'); +my $pwd2 = $object->get (@trace); +is ($pwd, $pwd2, ' and getting again gives the same string'); +is ($object->destroy (@trace), 1, ' and destroying the object succeeds'); + +# Now check to see if the password length is adjusted. +$Wallet::Config::PWD_LENGTH_MIN = 20; +$Wallet::Config::PWD_LENGTH_MAX = 20; +$object = eval { + Wallet::Object::Password->create ('password', 'test', $schema, @trace) + }; +ok (defined ($object), 'Recreating the object succeeds'); +$pwd = $object->get (@trace); +like ($pwd, qr{^.{$Wallet::Config::PWD_LENGTH_MIN}$}, + ' and get creates a random password string of a longer length'); +is ($object->destroy (@trace), 1, ' and destroying the object succeeds'); + +# Now store something and be sure that we get something reasonable. +$object = eval { + Wallet::Object::Password->create ('password', 'test', $schema, @trace) + }; +ok (defined ($object), 'Recreating the object succeeds'); +is ($object->store ("foo\n", @trace), 1, ' and storing data in it succeeds'); +ok (-f 'test-files/09/test', ' and the file exists'); +is (contents ('test-files/09/test'), 'foo', ' with the right contents'); +is ($object->get (@trace), "foo\n", ' and get returns correctly'); +unlink 'test-files/09/test'; +is ($object->get (@trace), undef, + ' and get will not autocreate a password if there used to be data'); +is ($object->error, 'cannot get password:test: object has not been stored', + ' as if it had not been stored'); +is ($object->store ("bar\n\0baz\n", @trace), 1, ' but storing again works'); +ok (-f 'test-files/09/test', ' and the file exists'); +is (contents ('test-files/09/test'), 'bar', ' with the right contents'); +is ($object->get (@trace), "bar\n\0baz\n", ' and get returns correctly'); + +# Clean up. +$admin->destroy; +END { + unlink ('wallet-db'); +} -- cgit v1.2.3 From 000b338694fae87996220336678fe990a1c3e3e1 Mon Sep 17 00:00:00 2001 From: Jon Robertson Date: Wed, 18 Feb 2015 15:17:51 -0800 Subject: Added new method for wallet-backend, update update will work generally like get, but only for objects that have a concept of updating content automatically, like keytabs and passwords. For these, the content will be updated before sending to the client. In a later release get for keytabs will be modified to never update the kvno before sending to the user, and so the unchanging flag will be phased out in lieu of explicitly using the method that does what you want. Change-Id: I96a84416c5e50278eb29fe07052dde6e063bc071 --- NEWS | 9 ++++++ client/wallet.pod | 13 +++++++++ perl/lib/Wallet/Object/Base.pm | 9 ++++++ perl/lib/Wallet/Object/Keytab.pm | 59 ++++++++++++++++++++++++++------------ perl/lib/Wallet/Object/Password.pm | 32 ++++++++++++++++----- perl/lib/Wallet/Server.pm | 15 ++++++++++ perl/t/object/base.t | 5 +++- perl/t/object/password.t | 8 +++++- server/wallet-backend | 16 +++++++++++ 9 files changed, 138 insertions(+), 28 deletions(-) (limited to 'perl/lib/Wallet/Object') diff --git a/NEWS b/NEWS index 64c0fbc..664da05 100644 --- a/NEWS +++ b/NEWS @@ -7,6 +7,15 @@ wallet 1.3 (xxxx-xx-xx) generate content for the object if you do a get before storing any content inside it. + Added a new command to wallet-backend, update. This will update the + contents of an object before running a get on it, and is only valid + for objects that can automatically get new content, such as keytab + and password objects. A keytab will get a new kvno regardless of + the unchanging flag if called with update. In a future release get + will be changed to never update a keytab, and the unchanging flag + will be ignored. Please start moving to use get or update as the + situation warrants. + Added an acl replace command, to change all objects owned by one ACL to be owned by another. diff --git a/client/wallet.pod b/client/wallet.pod index 20d1874..672f0e4 100644 --- a/client/wallet.pod +++ b/client/wallet.pod @@ -385,6 +385,19 @@ If an object with type and name does not already exist when this command is issued (as checked with the check interface), B will attempt to automatically create it (using autocreate). +=item update + +Prints to standard output the data associated with the object identified +by and , or stores it in a file if the B<-f> option was +given. This will generate new data in the object, and only works for +objects that support generating new data automatically, such as keytabs or +passwords. Types that do not support generating new data will fail and +direct you to use get instead. + +If an object with type and name does not already exist when +this command is issued (as checked with the check interface), B +will attempt to automatically create it (using autocreate). + =back =head1 ATTRIBUTES diff --git a/perl/lib/Wallet/Object/Base.pm b/perl/lib/Wallet/Object/Base.pm index bdd61fb..97e6127 100644 --- a/perl/lib/Wallet/Object/Base.pm +++ b/perl/lib/Wallet/Object/Base.pm @@ -609,6 +609,15 @@ sub history { # The get methods must always be overridden by the subclass. sub get { die "Do not instantiate Wallet::Object::Base directly\n"; } +# The update method should only work if a subclass supports it as something +# different from get. That makes it explicit about whether the subclass has +# a meaningful update. +sub update { + my ($self) = @_; + $self->error ("update is not supported for this type, use get instead"); + return; +} + # Provide a default store implementation that returns an immutable object # error so that auto-generated types don't have to provide their own. sub store { diff --git a/perl/lib/Wallet/Object/Keytab.pm b/perl/lib/Wallet/Object/Keytab.pm index 975179b..c625766 100644 --- a/perl/lib/Wallet/Object/Keytab.pm +++ b/perl/lib/Wallet/Object/Keytab.pm @@ -28,6 +28,37 @@ use Wallet::Kadmin; # that it will sort properly. $VERSION = '0.09'; +############################################################################## +# Shared methods +############################################################################## + +# Generate a keytab into a temporary file and then return that as the return +# value. Used by both get and update, as the only difference is how we +# handle the unchanging flag. +sub retrieve { + my ($self, $operation, $user, $host, $time) = @_; + $time ||= time; + my $id = $self->{type} . ':' . $self->{name}; + if ($self->flag_check ('locked')) { + $self->error ("cannot get $id: object is locked"); + return; + } + my $kadmin = $self->{kadmin}; + my $result; + if ($operation eq 'get' && $self->flag_check ('unchanging')) { + $result = $kadmin->keytab ($self->{name}); + } else { + my @enctypes = $self->attr ('enctypes'); + $result = $kadmin->keytab_rekey ($self->{name}, @enctypes); + } + if (defined $result) { + $self->log_action ($operation, $user, $host, $time); + } else { + $self->error ($kadmin->error); + } + return $result; +} + ############################################################################## # Enctype restriction ############################################################################## @@ -314,25 +345,15 @@ sub destroy { # return that as the return value. sub get { my ($self, $user, $host, $time) = @_; - $time ||= time; - my $id = $self->{type} . ':' . $self->{name}; - if ($self->flag_check ('locked')) { - $self->error ("cannot get $id: object is locked"); - return; - } - my $kadmin = $self->{kadmin}; - my $result; - if ($self->flag_check ('unchanging')) { - $result = $kadmin->keytab ($self->{name}); - } else { - my @enctypes = $self->attr ('enctypes'); - $result = $kadmin->keytab_rekey ($self->{name}, @enctypes); - } - if (defined $result) { - $self->log_action ('get', $user, $host, $time); - } else { - $self->error ($kadmin->error); - } + my $result = $self->retrieve ('get', $user, $host, $time); + return $result; +} + +# Our update implementation. Generate a new keytab regardless of the +# unchanging flag. +sub update { + my ($self, $user, $host, $time) = @_; + my $result = $self->retrieve ('update', $user, $host, $time); return $result; } diff --git a/perl/lib/Wallet/Object/Password.pm b/perl/lib/Wallet/Object/Password.pm index d06c8a6..3fd6ec8 100644 --- a/perl/lib/Wallet/Object/Password.pm +++ b/perl/lib/Wallet/Object/Password.pm @@ -57,12 +57,12 @@ sub file_path { } ############################################################################## -# Core methods +# Shared methods ############################################################################## # Return the contents of the file. -sub get { - my ($self, $user, $host, $time) = @_; +sub retrieve { + my ($self, $operation, $user, $host, $time) = @_; $time ||= time; my $id = $self->{type} . ':' . $self->{name}; if ($self->flag_check ('locked')) { @@ -72,13 +72,13 @@ sub get { my $path = $self->file_path; return unless $path; - # If nothing is yet stored, generate a random password and save it to - # the file. + # If nothing is yet stored, or we have requested an update, generate a + # random password and save it to the file. my $schema = $self->{schema}; my %search = (ob_type => $self->{type}, ob_name => $self->{name}); my $object = $schema->resultset('Object')->find (\%search); - unless ($object->ob_stored_on) { + if (!$object->ob_stored_on || $operation eq 'update') { unless (open (FILE, '>', $path)) { $self->error ("cannot store initial settings for $id: $!\n"); return; @@ -103,10 +103,28 @@ sub get { $self->error ("cannot get $id: $!"); return; } - $self->log_action ('get', $user, $host, $time); + $self->log_action ($operation, $user, $host, $time); return $data; } +############################################################################## +# Core methods +############################################################################## + +# Return the contents of the file. +sub get { + my ($self, $user, $host, $time) = @_; + my $result = $self->retrieve ('get', $user, $host, $time); + return $result; +} + +# Return the contents of the file after resetting them to a random string. +sub update { + my ($self, $user, $host, $time) = @_; + my $result = $self->retrieve ('update', $user, $host, $time); + return $result; +} + 1; __END__ diff --git a/perl/lib/Wallet/Server.pm b/perl/lib/Wallet/Server.pm index 6af0570..3ef5954 100644 --- a/perl/lib/Wallet/Server.pm +++ b/perl/lib/Wallet/Server.pm @@ -516,6 +516,21 @@ sub get { return $result; } +# Retrieve the information associated with an object, updating the current +# information if we are of a type that allows autogenerated information. +# Returns undef and sets the internal error if the retrieval fails or if the +# user isn't authorized. If the object doesn't exist, attempts dynamic +# creation of the object using the default ACL mappings (if any). +sub update { + my ($self, $type, $name) = @_; + my $object = $self->retrieve ($type, $name); + return unless defined $object; + return unless $self->acl_verify ($object, 'get'); + my $result = $object->update ($self->{user}, $self->{host}); + $self->error ($object->error) unless defined $result; + return $result; +} + # Store new data in an object, or returns undef and sets the internal error if # the object can't be found or if the user isn't authorized. Also don't # permit storing undef, although storing the empty string is fine. If the diff --git a/perl/t/object/base.t b/perl/t/object/base.t index ee9ff4b..8fedd64 100755 --- a/perl/t/object/base.t +++ b/perl/t/object/base.t @@ -12,7 +12,7 @@ use strict; use warnings; use POSIX qw(strftime); -use Test::More tests => 137; +use Test::More tests => 139; use Wallet::ACL; use Wallet::Admin; @@ -208,6 +208,9 @@ is ($object->flag_clear ('locked', @trace), 1, 'Clearing locked succeeds'); eval { $object->get (@trace) }; is ($@, "Do not instantiate Wallet::Object::Base directly\n", 'Get fails with the right error'); +ok (!$object->update (@trace), 'Update fails'); +is ($object->error, 'update is not supported for this type, use get instead', + ' with the right error'); ok (! $object->store ("Some data", @trace), 'Store fails'); is ($object->error, "cannot store keytab:$princ: object type is immutable", ' with the right error'); diff --git a/perl/t/object/password.t b/perl/t/object/password.t index c0f2fbc..4fe6b50 100644 --- a/perl/t/object/password.t +++ b/perl/t/object/password.t @@ -13,7 +13,7 @@ use strict; use warnings; use POSIX qw(strftime); -use Test::More tests => 31; +use Test::More tests => 33; use Wallet::Admin; use Wallet::Config; @@ -111,6 +111,12 @@ ok (-f 'test-files/09/test', ' and the file exists'); is (contents ('test-files/09/test'), 'bar', ' with the right contents'); is ($object->get (@trace), "bar\n\0baz\n", ' and get returns correctly'); +# And check to make sure update changes the contents. +$pwd = $object->update (@trace); +isnt ($pwd, "bar\n\0baz\n", 'Update changes the contents'); +like ($pwd, qr{^.{$Wallet::Config::PWD_LENGTH_MIN}$}, + ' to a random password string of the right length'); + # Clean up. $admin->destroy; END { diff --git a/server/wallet-backend b/server/wallet-backend index dcf2300..ea3e21e 100755 --- a/server/wallet-backend +++ b/server/wallet-backend @@ -315,6 +315,14 @@ sub command { } splice (@_, 3); $server->store (@args) or failure ($server->error, @_); + } elsif ($command eq 'update') { + check_args (2, 2, [], @args); + my $output = $server->update (@args); + if (defined $output) { + print $output; + } else { + failure ($server->error, @_); + } } else { error "unknown command $command"; } @@ -611,6 +619,14 @@ Stores for the object identified by and for later retrieval with C. Not all object types support this. If is not given as an argument, it will be read from standard input. +=item update + +Prints to standard output the data associated with the object identified +by and . If the object is one that can have changing +information, such as a keytab or password, then we generate new data for +that object regardless of whether there is current data or the unchanging +flag is set. + =back =head1 ATTRIBUTES -- cgit v1.2.3 From 0f943b75d34623b6825a0acf34ee2cd965bc6799 Mon Sep 17 00:00:00 2001 From: Jon Robertson Date: Fri, 17 Apr 2015 13:30:45 -0700 Subject: ACL.pm: Fixed capitalization of ACL in pod Change-Id: I9e4632f3ff81f916f9157ef8128b20915ecded08 --- perl/lib/Wallet/ACL.pm | 2 +- perl/lib/Wallet/Object/Duo/RDP.pm | 204 -------------------------------------- 2 files changed, 1 insertion(+), 205 deletions(-) delete mode 100644 perl/lib/Wallet/Object/Duo/RDP.pm (limited to 'perl/lib/Wallet/Object') diff --git a/perl/lib/Wallet/ACL.pm b/perl/lib/Wallet/ACL.pm index 370df8b..a090256 100644 --- a/perl/lib/Wallet/ACL.pm +++ b/perl/lib/Wallet/ACL.pm @@ -673,7 +673,7 @@ Note that rename() operations are not logged in the ACL history. =item replace(ID) Replace this ACL with another. This goes through each object owned by -the ACL and changes its ownership to the new ACL, leaving this acl owning +the ACL and changes its ownership to the new ACL, leaving this ACL owning nothing (and probably then needing to be deleted). Returns true on success and false on failure. On failure, the caller should call error() to get the error message. diff --git a/perl/lib/Wallet/Object/Duo/RDP.pm b/perl/lib/Wallet/Object/Duo/RDP.pm deleted file mode 100644 index c74661c..0000000 --- a/perl/lib/Wallet/Object/Duo/RDP.pm +++ /dev/null @@ -1,204 +0,0 @@ -# Wallet::Object::Duo::RDP -- Duo RDP int. object implementation for wallet -# -# Written by Russ Allbery -# Jon Robertson -# Copyright 2014 -# The Board of Trustees of the Leland Stanford Junior University -# -# See LICENSE for licensing terms. - -############################################################################## -# Modules and declarations -############################################################################## - -package Wallet::Object::Duo::RDP; -require 5.006; - -use strict; -use warnings; -use vars qw(@ISA $VERSION); - -use JSON; -use Net::Duo::Admin; -use Net::Duo::Admin::Integration; -use Perl6::Slurp qw(slurp); -use Wallet::Config (); -use Wallet::Object::Duo; - -@ISA = qw(Wallet::Object::Duo); - -# This version should be increased on any code change to this module. Always -# use two digits for the minor version with a leading zero if necessary so -# that it will sort properly. -$VERSION = '0.01'; - -############################################################################## -# Core methods -############################################################################## - -# Override create to provide the specific Duo integration type that will be -# used in the remote Duo record. -sub create { - my ($class, $type, $name, $schema, $creator, $host, $time) = @_; - - $time ||= time; - my $self = $class->SUPER::create ($type, $name, $schema, $creator, $host, - $time, 'rdp'); - return $self; -} - -# Override get to output the data in a specific format used by Duo's RDP -# module. -sub get { - my ($self, $user, $host, $time) = @_; - $time ||= time; - - # Check that the object isn't locked. - my $id = $self->{type} . ':' . $self->{name}; - if ($self->flag_check ('locked')) { - $self->error ("cannot get $id: object is locked"); - return; - } - - # Retrieve the integration from Duo. - my $key; - eval { - my %search = (du_name => $self->{name}); - my $row = $self->{schema}->resultset ('Duo')->find (\%search); - $key = $row->get_column ('du_key'); - }; - if ($@) { - $self->error ($@); - return; - } - my $integration = Net::Duo::Admin::Integration->new ($self->{duo}, $key); - - # We also need the admin server name, which we can get from the Duo object - # configuration with a bit of JSON decoding. - my $json = JSON->new->utf8 (1)->relaxed (1); - my $config = $json->decode (scalar slurp $Wallet::Config::DUO_KEY_FILE); - - # Construct the returned file. - my $output; - $output .= "Integration key: $key\n"; - $output .= 'Secret key: ' . $integration->secret_key . "\n"; - $output .= "Host: $config->{api_hostname}\n"; - - # Log the action and return. - $self->log_action ('get', $user, $host, $time); - return $output; -} - -1; -__END__ - -############################################################################## -# Documentation -############################################################################## - -=for stopwords -Allbery Duo integration DBH keytab RDP - -=head1 NAME - -Wallet::Object::Duo::RDP - Duo RDP int. object implementation for wallet - -=head1 SYNOPSIS - - my @name = qw(duo-rdp host.example.com); - my @trace = ($user, $host, time); - my $object = Wallet::Object::Duo::RDP->create (@name, $schema, @trace); - my $config = $object->get (@trace); - $object->destroy (@trace); - -=head1 DESCRIPTION - -Wallet::Object::Duo::RDP is a representation of Duo integrations with -the wallet, specifically to output Duo integrations to set up an RDP -integration. This can be used to set up remote logins, or all Windows -logins period if so selected in Duo's software. It implements the -wallet object API and provides the necessary glue to create a Duo -integration, return a configuration file containing the key and API -information for that integration, and delete the integration from Duo -when the wallet object is destroyed. - -Because the Duo RDP software is configured by a GUI, the information -returned for a get operation is a simple set that's readable but not -useful for directly plugging into a config file. The values would need -to be cut and pasted into the GUI. - -This object can be retrieved repeatedly without changing the secret key, -matching Duo's native behavior with integrations. To change the keys of -the integration, delete it and recreate it. - -To use this object, at least one configuration parameter must be set. See -L for details on supported configuration parameters and -information about how to set wallet configuration. - -=head1 METHODS - -This object mostly inherits from Wallet::Object::Duo. See the -documentation for that class for all generic methods. Below are only -those methods that are overridden or behave specially for this -implementation. - -=over 4 - -=item create(TYPE, NAME, DBH, PRINCIPAL, HOSTNAME [, DATETIME]) - -This will override the Wallet::Object::Duo class with the information -needed to create a specific integration type in Duo. It creates a new -object with the given TYPE and NAME (TYPE is normally C and must -be for the rest of the wallet system to use the right class, but this -module doesn't check for ease of subclassing), using DBH as the handle -to the wallet metadata database. PRINCIPAL, HOSTNAME, and DATETIME are -stored as history information. PRINCIPAL should be the user who is -creating the object. If DATETIME isn't given, the current time is -used. - -When a new Duo integration object is created, a new integration will be -created in the configured Duo account and the integration key will be -stored in the wallet object. If the integration already exists, create() -will fail. - -If create() fails, it throws an exception. - -=item get(PRINCIPAL, HOSTNAME [, DATETIME]) - -Retrieves the configuration information for the Duo integration and -returns that information in the format expected by the configuration file -for the Duo UNIX integration. Returns undef on failure. The caller -should call error() to get the error message if get() returns undef. - -The returned configuration look look like: - - Integration key: - Secret key: - Host: - -The C parameter will be taken from the configuration file pointed -to by the DUO_KEY_FILE configuration variable. - -PRINCIPAL, HOSTNAME, and DATETIME are stored as history information. -PRINCIPAL should be the user who is downloading the keytab. If DATETIME -isn't given, the current time is used. - -=back - -=head1 LIMITATIONS - -Only one Duo account is supported for a given wallet implementation. - -=head1 SEE ALSO - -Net::Duo(3), Wallet::Config(3), Wallet::Object::Duo(3), wallet-backend(8) - -This module is part of the wallet system. The current version is -available from L. - -=head1 AUTHORS - -Russ Allbery -Jon Robertson - -=cut -- cgit v1.2.3 From feacbd7d685b1790579f949b3e72a48412835d92 Mon Sep 17 00:00:00 2001 From: Jon Robertson Date: Fri, 17 Apr 2015 13:41:52 -0700 Subject: Merged all Duo objects into one module To handle local proliferation of Duo integration type requests, all Duo types have been merged into one module that will pick up and decide integration specifics off of the object type. If you are using the Duo types locally already, you'll want to load perl/sql/wallet-1.3-update-duo.sql to your database to update the old object types to all use the Duo module. All existing Duo integrations have been added to the module for handling, but nothing new has been added to the wallet object types. Since there are a lot of Duo integrations, sites should only manually add the ones they're interested in to the wallet types table. Change-Id: If9c9a0a3e77923354f31d8f9c98a519c93df200b --- perl/lib/Wallet/Admin.pm | 8 +- perl/lib/Wallet/Object/Duo.pm | 121 ++++++++++++++++-- perl/lib/Wallet/Object/Duo/LDAPProxy.pm | 202 ----------------------------- perl/lib/Wallet/Object/Duo/PAM.pm | 205 ------------------------------ perl/lib/Wallet/Object/Duo/RadiusProxy.pm | 204 ----------------------------- perl/sql/wallet-1.3-update-duo.sql | 9 ++ perl/t/object/duo-ldap.t | 21 ++- perl/t/object/duo-pam.t | 20 ++- perl/t/object/duo-radius.t | 21 ++- perl/t/object/duo-rdp.t | 20 ++- 10 files changed, 162 insertions(+), 669 deletions(-) delete mode 100644 perl/lib/Wallet/Object/Duo/LDAPProxy.pm delete mode 100644 perl/lib/Wallet/Object/Duo/PAM.pm delete mode 100644 perl/lib/Wallet/Object/Duo/RadiusProxy.pm create mode 100644 perl/sql/wallet-1.3-update-duo.sql (limited to 'perl/lib/Wallet/Object') diff --git a/perl/lib/Wallet/Admin.pm b/perl/lib/Wallet/Admin.pm index a8b8368..b38cc94 100644 --- a/perl/lib/Wallet/Admin.pm +++ b/perl/lib/Wallet/Admin.pm @@ -126,10 +126,10 @@ sub default_data { # types default rows. my @record = ([ qw/ty_name ty_class/ ], [ 'duo', 'Wallet::Object::Duo' ], - [ 'duo-ldap', 'Wallet::Object::Duo::LDAPProxy' ], - [ 'duo-pam', 'Wallet::Object::Duo::PAM' ], - [ 'duo-radius', 'Wallet::Object::Duo::RadiusProxy' ], - [ 'duo-rdp', 'Wallet::Object::Duo::RDP' ], + [ 'duo-ldap', 'Wallet::Object::Duo' ], + [ 'duo-pam', 'Wallet::Object::Duo' ], + [ 'duo-radius', 'Wallet::Object::Duo' ], + [ 'duo-rdp', 'Wallet::Object::Duo' ], [ 'file', 'Wallet::Object::File' ], [ 'password', 'Wallet::Object::Password' ], [ 'keytab', 'Wallet::Object::Keytab' ], diff --git a/perl/lib/Wallet/Object/Duo.pm b/perl/lib/Wallet/Object/Duo.pm index d08294b..d0901de 100644 --- a/perl/lib/Wallet/Object/Duo.pm +++ b/perl/lib/Wallet/Object/Duo.pm @@ -29,7 +29,100 @@ use Wallet::Object::Base; # This version should be increased on any code change to this module. Always # use two digits for the minor version with a leading zero if necessary so # that it will sort properly. -$VERSION = '0.02'; +$VERSION = '0.03'; + +# Mappings from our types into what Duo calls the integration types. +our %DUO_TYPES = ( + 'duo' => { + integration => 'unix', + output => \&_output_generic, + }, + 'duo-ldap' => { + integration => 'ldapproxy', + output => \&_output_ldap, + }, + 'duo-pam' => { + integration => 'unix', + output => \&_output_pam, + }, + 'duo-radius' => { + integration => 'radius', + output => \&_output_radius, + }, + ); + +# Extra types to add. These are all just named as the Duo integration name +# with duo- before it and go to the generic output. Put them here to prevent +# pages of settings. These are also not all actually set as types in the +# types table to prevent overpopulation. You should manually create the +# entries in that table for any Duo integrations you want to add. +our @EXTRA_TYPES = ('accountsapi', 'adfs', 'adminapi', 'array', 'barracuda', + 'cisco', 'citrixcag', 'citrixns', 'confluence', 'drupal', + 'f5bigip', 'f5firepass', 'fortinet', 'jira', 'juniper', + 'juniperuac', 'lastpass', 'okta', 'onelogin', 'openvpn', + 'openvpnas', 'owa', 'paloalto', 'rdgateway', 'rdp', + 'rdweb', 'rest', 'rras', 'shibboleth', 'sonicwallsra', + 'splunk', 'tmg', 'uag', 'verify', 'vmwareview', 'websdk', + 'wordpress'); +for my $type (@EXTRA_TYPES) { + my $wallet_type = 'duo-'.$type; + $DUO_TYPES{$wallet_type}{integration} = $type; + $DUO_TYPES{$wallet_type}{output} = \&_output_generic; +}; + +############################################################################## +# Get output methods +############################################################################## + +# Output for any miscellaneous Duo integration, usually those that use a GUI +# to set information and so don't need a custom configuration file. +sub _output_generic { + my ($key, $secret, $hostname) = @_; + + my $output; + $output .= "Integration key: $key\n"; + $output .= "Secret key: $secret\n"; + $output .= "Host: $hostname\n"; + + return $output; +} + +# Output for the Duo unix integration, which hooks into the PAM stack. +sub _output_pam { + my ($key, $secret, $hostname) = @_; + + my $output = "[duo]\n"; + $output .= "ikey = $key\n"; + $output .= "skey = $secret\n"; + $output .= "host = $hostname\n"; + + return $output; +} + +# Output for the radius proxy, which can be plugged into the proxy config. +sub _output_radius { + my ($key, $secret, $hostname) = @_; + + my $output = "[radius_server_challenge]\n"; + $output .= "ikey = $key\n"; + $output .= "skey = $secret\n"; + $output .= "api_host = $hostname\n"; + $output .= "client = radius_client\n"; + + return $output; +} + +# Output for the LDAP proxy, which can be plugged into the proxy config. +sub _output_ldap { + my ($key, $secret, $hostname) = @_; + + my $output = "[ldap_server_challenge]\n"; + $output .= "ikey = $key\n"; + $output .= "skey = $secret\n"; + $output .= "api_host = $hostname\n"; + + return $output; +} ############################################################################## # Core methods @@ -86,7 +179,7 @@ sub new { # great here since we don't have a way to communicate the error back to the # caller. sub create { - my ($class, $type, $name, $schema, $creator, $host, $time, $duo_type) = @_; + my ($class, $type, $name, $schema, $creator, $host, $time) = @_; # We have to have a Duo integration key file set. if (not $Wallet::Config::DUO_KEY_FILE) { @@ -95,6 +188,12 @@ sub create { my $key_file = $Wallet::Config::DUO_KEY_FILE; my $agent = $Wallet::Config::DUO_AGENT; + # Make sure this is actually a type we know about, since this handler + # can handle many types. + if (!exists $DUO_TYPES{$type}) { + die "$type is not a valid duo integration\n"; + } + # Construct the Net::Duo::Admin object. require Net::Duo::Admin; my $duo = Net::Duo::Admin->new ( @@ -106,7 +205,7 @@ sub create { # Create the object in Duo. require Net::Duo::Admin::Integration; - $duo_type ||= $Wallet::Config::DUO_TYPE; + my $duo_type = $DUO_TYPES{$type}{integration}; my %data = ( name => "$name ($duo_type)", notes => 'Managed by wallet', @@ -201,11 +300,17 @@ sub get { my $json = JSON->new->utf8 (1)->relaxed (1); my $config = $json->decode (scalar slurp $Wallet::Config::DUO_KEY_FILE); - # Construct the returned file. - my $output; - $output .= "Integration key: $key\n"; - $output .= 'Secret key: ' . $integration->secret_key . "\n"; - $output .= "Host: $config->{api_hostname}\n"; + # Construct the returned file. Assume the generic handler in case there + # is no valid handler, though that shouldn't happen. + my $output_sub; + my $type = $self->{type}; + if (exists $DUO_TYPES{$type}{output}) { + $output_sub = $DUO_TYPES{$type}{output}; + } else { + $output_sub = \&_output_generic; + } + my $output = $output_sub->($key, $integration->secret_key, + $config->{api_hostname}); # Log the action and return. $self->log_action ('get', $user, $host, $time); diff --git a/perl/lib/Wallet/Object/Duo/LDAPProxy.pm b/perl/lib/Wallet/Object/Duo/LDAPProxy.pm deleted file mode 100644 index 23894ac..0000000 --- a/perl/lib/Wallet/Object/Duo/LDAPProxy.pm +++ /dev/null @@ -1,202 +0,0 @@ -# Wallet::Object::Duo::LDAPProxy -- Duo auth proxy integration for LDAP -# -# Written by Jon Robertson -# Copyright 2014 -# The Board of Trustees of the Leland Stanford Junior University -# -# See LICENSE for licensing terms. - -############################################################################## -# Modules and declarations -############################################################################## - -package Wallet::Object::Duo::LDAPProxy; -require 5.006; - -use strict; -use warnings; -use vars qw(@ISA $VERSION); - -use JSON; -use Net::Duo::Admin; -use Net::Duo::Admin::Integration; -use Perl6::Slurp qw(slurp); -use Wallet::Config (); -use Wallet::Object::Duo; - -@ISA = qw(Wallet::Object::Duo); - -# This version should be increased on any code change to this module. Always -# use two digits for the minor version with a leading zero if necessary so -# that it will sort properly. -$VERSION = '0.01'; - -############################################################################## -# Core methods -############################################################################## - -# Override create to provide the specific Duo integration type that will be -# used in the remote Duo record. -sub create { - my ($class, $type, $name, $schema, $creator, $host, $time) = @_; - - $time ||= time; - my $self = $class->SUPER::create ($type, $name, $schema, $creator, $host, - $time, 'ldapproxy'); - return $self; -} - -# Override get to output the data in a specific format used for Duo LDAP -# integration -sub get { - my ($self, $user, $host, $time) = @_; - $time ||= time; - - # Check that the object isn't locked. - my $id = $self->{type} . ':' . $self->{name}; - if ($self->flag_check ('locked')) { - $self->error ("cannot get $id: object is locked"); - return; - } - - # Retrieve the integration from Duo. - my $key; - eval { - my %search = (du_name => $self->{name}); - my $row = $self->{schema}->resultset ('Duo')->find (\%search); - $key = $row->get_column ('du_key'); - }; - if ($@) { - $self->error ($@); - return; - } - my $integration = Net::Duo::Admin::Integration->new ($self->{duo}, $key); - - # We also need the admin server name, which we can get from the Duo object - # configuration with a bit of JSON decoding. - my $json = JSON->new->utf8 (1)->relaxed (1); - my $config = $json->decode (scalar slurp $Wallet::Config::DUO_KEY_FILE); - - # Construct the returned file. - my $output = "[ldap_server_challenge]\n"; - $output .= "ikey = $key\n"; - $output .= 'skey = ' . $integration->secret_key . "\n"; - $output .= "api_host = $config->{api_hostname}\n"; - - # Log the action and return. - $self->log_action ('get', $user, $host, $time); - return $output; -} - -1; -__END__ - -############################################################################## -# Documentation -############################################################################## - -=for stopwords -Allbery Duo integration DBH keytab LDAP auth - -=head1 NAME - -Wallet::Object::Duo::LDAPProxy - Duo auth proxy integration for LDAP - -=head1 SYNOPSIS - - my @name = qw(duo-ldap host.example.com); - my @trace = ($user, $host, time); - my $object = Wallet::Object::Duo::LDAPProxy->create (@name, $schema, @trace); - my $config = $object->get (@trace); - $object->destroy (@trace); - -=head1 DESCRIPTION - -Wallet::Object::Duo::LDAPProxy is a representation of Duo -integrations with the wallet, specifically to output Duo integrations -in a format that can easily be pulled into configuring the Duo -Authentication Proxy for LDAP. It implements the wallet object API -and provides the necessary glue to create a Duo integration, return a -configuration file containing the key and API information for that -integration, and delete the integration from Duo when the wallet object -is destroyed. - -The integration information is always returned in the configuration file -format expected by the Authentication Proxy for Duo in configuring it -for LDAP. - -This object can be retrieved repeatedly without changing the secret key, -matching Duo's native behavior with integrations. To change the keys of -the integration, delete it and recreate it. - -To use this object, at least one configuration parameter must be set. See -L for details on supported configuration parameters and -information about how to set wallet configuration. - -=head1 METHODS - -This object mostly inherits from Wallet::Object::Duo. See the -documentation for that class for all generic methods. Below are only -those methods that are overridden or behave specially for this -implementation. - -=over 4 - -=item create(TYPE, NAME, DBH, PRINCIPAL, HOSTNAME [, DATETIME]) - -This will override the Wallet::Object::Duo class with the information -needed to create a specific integration type in Duo. It creates a new -object with the given TYPE and NAME (TYPE is normally C and -must be for the rest of the wallet system to use the right class, but -this module doesn't check for ease of subclassing), using DBH as the -handle to the wallet metadata database. PRINCIPAL, HOSTNAME, and -DATETIME are stored as history information. PRINCIPAL should be the -user who is creating the object. If DATETIME isn't given, the current -time is used. - -When a new Duo integration object is created, a new integration will be -created in the configured Duo account and the integration key will be -stored in the wallet object. If the integration already exists, create() -will fail. - -If create() fails, it throws an exception. - -=item get(PRINCIPAL, HOSTNAME [, DATETIME]) - -Retrieves the configuration information for the Duo integration and -returns that information in the format expected by the configuration file -for the Duo UNIX integration. Returns undef on failure. The caller -should call error() to get the error message if get() returns undef. - -The returned configuration look look like: - - [ldap_server_challenge] - ikey = - skey = - api_host = - -The C parameter will be taken from the configuration file pointed -to by the DUO_KEY_FILE configuration variable. - -PRINCIPAL, HOSTNAME, and DATETIME are stored as history information. -PRINCIPAL should be the user who is downloading the keytab. If DATETIME -isn't given, the current time is used. - -=back - -=head1 LIMITATIONS - -Only one Duo account is supported for a given wallet implementation. - -=head1 SEE ALSO - -Net::Duo(3), Wallet::Config(3), Wallet::Object::Duo(3), wallet-backend(8) - -This module is part of the wallet system. The current version is -available from L. - -=head1 AUTHORS - -Jon Robertson - -=cut diff --git a/perl/lib/Wallet/Object/Duo/PAM.pm b/perl/lib/Wallet/Object/Duo/PAM.pm deleted file mode 100644 index d9d17f8..0000000 --- a/perl/lib/Wallet/Object/Duo/PAM.pm +++ /dev/null @@ -1,205 +0,0 @@ -# Wallet::Object::Duo::PAM -- Duo PAM int. object implementation for wallet -# -# Written by Russ Allbery -# Jon Robertson -# Copyright 2014 -# The Board of Trustees of the Leland Stanford Junior University -# -# See LICENSE for licensing terms. - -############################################################################## -# Modules and declarations -############################################################################## - -package Wallet::Object::Duo::PAM; -require 5.006; - -use strict; -use warnings; -use vars qw(@ISA $VERSION); - -use JSON; -use Net::Duo::Admin; -use Net::Duo::Admin::Integration; -use Perl6::Slurp qw(slurp); -use Wallet::Config (); -use Wallet::Object::Duo; - -@ISA = qw(Wallet::Object::Duo); - -# This version should be increased on any code change to this module. Always -# use two digits for the minor version with a leading zero if necessary so -# that it will sort properly. -$VERSION = '0.01'; - -############################################################################## -# Core methods -############################################################################## - -# Override create to provide the specific Duo integration type that will be -# used in the remote Duo record. -sub create { - my ($class, $type, $name, $schema, $creator, $host, $time) = @_; - - $time ||= time; - my $self = $class->SUPER::create ($type, $name, $schema, $creator, $host, - $time, 'unix'); - return $self; -} - -# Override get to output the data in a specific format used by Duo's PAM -# module. -sub get { - my ($self, $user, $host, $time) = @_; - $time ||= time; - - # Check that the object isn't locked. - my $id = $self->{type} . ':' . $self->{name}; - if ($self->flag_check ('locked')) { - $self->error ("cannot get $id: object is locked"); - return; - } - - # Retrieve the integration from Duo. - my $key; - eval { - my %search = (du_name => $self->{name}); - my $row = $self->{schema}->resultset ('Duo')->find (\%search); - $key = $row->get_column ('du_key'); - }; - if ($@) { - $self->error ($@); - return; - } - my $integration = Net::Duo::Admin::Integration->new ($self->{duo}, $key); - - # We also need the admin server name, which we can get from the Duo object - # configuration with a bit of JSON decoding. - my $json = JSON->new->utf8 (1)->relaxed (1); - my $config = $json->decode (scalar slurp $Wallet::Config::DUO_KEY_FILE); - - # Construct the returned file. - my $output = "[duo]\n"; - $output .= "ikey = $key\n"; - $output .= 'skey = ' . $integration->secret_key . "\n"; - $output .= "host = $config->{api_hostname}\n"; - - # Log the action and return. - $self->log_action ('get', $user, $host, $time); - return $output; -} - -1; -__END__ - -############################################################################## -# Documentation -############################################################################## - -=for stopwords -Allbery Duo integration DBH keytab - -=head1 NAME - -Wallet::Object::Duo::PAM - Duo PAM int. object implementation for wallet - -=head1 SYNOPSIS - - my @name = qw(duo-pam host.example.com); - my @trace = ($user, $host, time); - my $object = Wallet::Object::Duo::PAM->create (@name, $schema, @trace); - my $config = $object->get (@trace); - $object->destroy (@trace); - -=head1 DESCRIPTION - -Wallet::Object::Duo::PAM is a representation of Duo integrations with -the wallet, specifically to output Duo integrations in a format that -can easily be pulled into configuring the Duo PAM interface. It -implements the wallet object API and provides the necessary glue to -create a Duo integration, return a configuration file containing the key -and API information for that integration, and delete the integration from -Duo when the wallet object is destroyed. - -The integration information is always returned in the configuration file -format expected by the Duo UNIX integration. The results of retrieving -this object will be text, suitable for putting in the UNIX integration -configuration file, containing the integration key, secret key, and admin -hostname for that integration. - -This object can be retrieved repeatedly without changing the secret key, -matching Duo's native behavior with integrations. To change the keys of -the integration, delete it and recreate it. - -To use this object, at least one configuration parameter must be set. See -L for details on supported configuration parameters and -information about how to set wallet configuration. - -=head1 METHODS - -This object mostly inherits from Wallet::Object::Duo. See the -documentation for that class for all generic methods. Below are only -those methods that are overridden or behave specially for this -implementation. - -=over 4 - -=item create(TYPE, NAME, DBH, PRINCIPAL, HOSTNAME [, DATETIME]) - -This will override the Wallet::Object::Duo class with the information -needed to create a specific integration type in Duo. It creates a new -object with the given TYPE and NAME (TYPE is normally C and must -be for the rest of the wallet system to use the right class, but this -module doesn't check for ease of subclassing), using DBH as the handle -to the wallet metadata database. PRINCIPAL, HOSTNAME, and DATETIME are -stored as history information. PRINCIPAL should be the user who is -creating the object. If DATETIME isn't given, the current time is -used. - -When a new Duo integration object is created, a new integration will be -created in the configured Duo account and the integration key will be -stored in the wallet object. If the integration already exists, create() -will fail. - -If create() fails, it throws an exception. - -=item get(PRINCIPAL, HOSTNAME [, DATETIME]) - -Retrieves the configuration information for the Duo integration and -returns that information in the format expected by the configuration file -for the Duo UNIX integration. Returns undef on failure. The caller -should call error() to get the error message if get() returns undef. - -The returned configuration look look like: - - [duo] - ikey = - skey = - host = - -The C parameter will be taken from the configuration file pointed -to by the DUO_KEY_FILE configuration variable. - -PRINCIPAL, HOSTNAME, and DATETIME are stored as history information. -PRINCIPAL should be the user who is downloading the keytab. If DATETIME -isn't given, the current time is used. - -=back - -=head1 LIMITATIONS - -Only one Duo account is supported for a given wallet implementation. - -=head1 SEE ALSO - -Net::Duo(3), Wallet::Config(3), Wallet::Object::Duo(3), wallet-backend(8) - -This module is part of the wallet system. The current version is -available from L. - -=head1 AUTHORS - -Russ Allbery -Jon Robertson - -=cut diff --git a/perl/lib/Wallet/Object/Duo/RadiusProxy.pm b/perl/lib/Wallet/Object/Duo/RadiusProxy.pm deleted file mode 100644 index a1f6e24..0000000 --- a/perl/lib/Wallet/Object/Duo/RadiusProxy.pm +++ /dev/null @@ -1,204 +0,0 @@ -# Wallet::Object::Duo::RadiusProxy -- Duo auth proxy integration for radius -# -# Written by Jon Robertson -# Copyright 2014 -# The Board of Trustees of the Leland Stanford Junior University -# -# See LICENSE for licensing terms. - -############################################################################## -# Modules and declarations -############################################################################## - -package Wallet::Object::Duo::RadiusProxy; -require 5.006; - -use strict; -use warnings; -use vars qw(@ISA $VERSION); - -use JSON; -use Net::Duo::Admin; -use Net::Duo::Admin::Integration; -use Perl6::Slurp qw(slurp); -use Wallet::Config (); -use Wallet::Object::Duo; - -@ISA = qw(Wallet::Object::Duo); - -# This version should be increased on any code change to this module. Always -# use two digits for the minor version with a leading zero if necessary so -# that it will sort properly. -$VERSION = '0.01'; - -############################################################################## -# Core methods -############################################################################## - -# Override create to provide the specific Duo integration type that will be -# used in the remote Duo record. -sub create { - my ($class, $type, $name, $schema, $creator, $host, $time) = @_; - - $time ||= time; - my $self = $class->SUPER::create ($type, $name, $schema, $creator, $host, - $time, 'radius'); - return $self; -} - -# Override get to output the data in a specific format used for Duo radius -# integration -sub get { - my ($self, $user, $host, $time) = @_; - $time ||= time; - - # Check that the object isn't locked. - my $id = $self->{type} . ':' . $self->{name}; - if ($self->flag_check ('locked')) { - $self->error ("cannot get $id: object is locked"); - return; - } - - # Retrieve the integration from Duo. - my $key; - eval { - my %search = (du_name => $self->{name}); - my $row = $self->{schema}->resultset ('Duo')->find (\%search); - $key = $row->get_column ('du_key'); - }; - if ($@) { - $self->error ($@); - return; - } - my $integration = Net::Duo::Admin::Integration->new ($self->{duo}, $key); - - # We also need the admin server name, which we can get from the Duo object - # configuration with a bit of JSON decoding. - my $json = JSON->new->utf8 (1)->relaxed (1); - my $config = $json->decode (scalar slurp $Wallet::Config::DUO_KEY_FILE); - - # Construct the returned file. - my $output = "[radius_server_challenge]\n"; - $output .= "ikey = $key\n"; - $output .= 'skey = ' . $integration->secret_key . "\n"; - $output .= "api_host = $config->{api_hostname}\n"; - $output .= "client = radius_client\n"; - - # Log the action and return. - $self->log_action ('get', $user, $host, $time); - return $output; -} - -1; -__END__ - -############################################################################## -# Documentation -############################################################################## - -=for stopwords -Allbery Duo integration DBH keytab auth - -=head1 NAME - -Wallet::Object::Duo::RadiusProxy - Duo auth proxy integration for RADIUS - -=head1 SYNOPSIS - - my @name = qw(duo-radius host.example.com); - my @trace = ($user, $host, time); - my $object = Wallet::Object::Duo::RadiusProxy->create (@name, $schema, @trace); - my $config = $object->get (@trace); - $object->destroy (@trace); - -=head1 DESCRIPTION - -Wallet::Object::Duo::RadiusProxy is a representation of Duo -integrations with the wallet, specifically to output Duo integrations -in a format that can easily be pulled into configuring the Duo -Authentication Proxy for Radius. It implements the wallet object API -and provides the necessary glue to create a Duo integration, return a -configuration file containing the key and API information for that -integration, and delete the integration from Duo when the wallet object -is destroyed. - -The integration information is always returned in the configuration file -format expected by the Authentication Proxy for Duo in configuring it -for Radius. - -This object can be retrieved repeatedly without changing the secret key, -matching Duo's native behavior with integrations. To change the keys of -the integration, delete it and recreate it. - -To use this object, at least one configuration parameter must be set. See -L for details on supported configuration parameters and -information about how to set wallet configuration. - -=head1 METHODS - -This object mostly inherits from Wallet::Object::Duo. See the -documentation for that class for all generic methods. Below are only -those methods that are overridden or behave specially for this -implementation. - -=over 4 - -=item create(TYPE, NAME, DBH, PRINCIPAL, HOSTNAME [, DATETIME]) - -This will override the Wallet::Object::Duo class with the information -needed to create a specific integration type in Duo. It creates a new -object with the given TYPE and NAME (TYPE is normally C and -must be for the rest of the wallet system to use the right class, but -this module doesn't check for ease of subclassing), using DBH as the -handle to the wallet metadata database. PRINCIPAL, HOSTNAME, and -DATETIME are stored as history information. PRINCIPAL should be the -user who is creating the object. If DATETIME isn't given, the current -time is used. - -When a new Duo integration object is created, a new integration will be -created in the configured Duo account and the integration key will be -stored in the wallet object. If the integration already exists, create() -will fail. - -If create() fails, it throws an exception. - -=item get(PRINCIPAL, HOSTNAME [, DATETIME]) - -Retrieves the configuration information for the Duo integration and -returns that information in the format expected by the configuration file -for the Duo UNIX integration. Returns undef on failure. The caller -should call error() to get the error message if get() returns undef. - -The returned configuration look look like: - - [radius_server_challenge] - ikey = - skey = - api_host = - client = radius_client - -The C parameter will be taken from the configuration file pointed -to by the DUO_KEY_FILE configuration variable. - -PRINCIPAL, HOSTNAME, and DATETIME are stored as history information. -PRINCIPAL should be the user who is downloading the keytab. If DATETIME -isn't given, the current time is used. - -=back - -=head1 LIMITATIONS - -Only one Duo account is supported for a given wallet implementation. - -=head1 SEE ALSO - -Net::Duo(3), Wallet::Config(3), Wallet::Object::Duo(3), wallet-backend(8) - -This module is part of the wallet system. The current version is -available from L. - -=head1 AUTHORS - -Jon Robertson - -=cut diff --git a/perl/sql/wallet-1.3-update-duo.sql b/perl/sql/wallet-1.3-update-duo.sql new file mode 100644 index 0000000..affadcd --- /dev/null +++ b/perl/sql/wallet-1.3-update-duo.sql @@ -0,0 +1,9 @@ +-- +-- Run on installing wallet 1.3 in order to update what the Duo types +-- point to for modules. +-- + +UPDATE types set ty_class='Wallet::Object::Duo' where ty_name='duo-ldap'; +UPDATE types set ty_class='Wallet::Object::Duo' where ty_name='duo-pam'; +UPDATE types set ty_class='Wallet::Object::Duo' where ty_name='duo-radius'; +UPDATE types set ty_class='Wallet::Object::Duo' where ty_name='duo-rdp'; diff --git a/perl/t/object/duo-ldap.t b/perl/t/object/duo-ldap.t index 3648eba..8a00dbb 100644 --- a/perl/t/object/duo-ldap.t +++ b/perl/t/object/duo-ldap.t @@ -26,7 +26,7 @@ BEGIN { BEGIN { use_ok('Wallet::Admin'); use_ok('Wallet::Config'); - use_ok('Wallet::Object::Duo::LDAPProxy'); + use_ok('Wallet::Object::Duo'); } use lib 't/lib'; @@ -53,15 +53,14 @@ my $mock = Net::Duo::Mock::Agent->new ({ key_file => 't/data/duo/keys.json' }); # Test error handling in the absence of configuration. my $object = eval { - Wallet::Object::Duo::LDAPProxy->new ('duo-ldap', 'test', $schema); + Wallet::Object::Duo->new ('duo-ldap', 'test', $schema); }; -is ($object, undef, 'Wallet::Object::Duo::LDAPProxy new with no config failed'); +is ($object, undef, 'Wallet::Object::Duo new with no config failed'); is ($@, "duo object implementation not configured\n", '...with correct error'); $object = eval { - Wallet::Object::Duo::LDAPProxy->create ('duo-ldap', 'test', $schema, - @trace); + Wallet::Object::Duo->create ('duo-ldap', 'test', $schema, @trace); }; -is ($object, undef, 'Wallet::Object::Duo::LDAPProxy creation with no config failed'); +is ($object, undef, 'Wallet::Object::Duo creation with no config failed'); is ($@, "duo object implementation not configured\n", '...with correct error'); # Set up the Duo configuration. @@ -83,9 +82,8 @@ $mock->expect ( response_file => 't/data/duo/integration.json', } ); -$object = Wallet::Object::Duo::LDAPProxy->create ('duo-ldap', 'test', $schema, - @trace); -isa_ok ($object, 'Wallet::Object::Duo::LDAPProxy'); +$object = Wallet::Object::Duo->create ('duo-ldap', 'test', $schema, @trace); +isa_ok ($object, 'Wallet::Object::Duo'); # Check the metadata about the new wallet object. $expected = <<"EOO"; @@ -127,7 +125,7 @@ is ($object->flag_clear ('locked', @trace), 1, '...and clearing locked flag works'); # Create a new object by wallet type and name. -$object = Wallet::Object::Duo::LDAPProxy->new ('duo-ldap', 'test', $schema); +$object = Wallet::Object::Duo->new ('duo-ldap', 'test', $schema); # Test deleting an integration. We can't test this entirely properly because # currently Net::Duo::Mock::Agent doesn't support stacking multiple expected @@ -144,8 +142,7 @@ TODO: { local $TODO = 'Net::Duo::Mock::Agent not yet capable'; is ($object->destroy (@trace), 1, 'Duo object deletion succeeded'); - $object = eval { Wallet::Object::Duo::LDAPProxy->new ('duo-ldap', 'test', - $schema) }; + $object = eval { Wallet::Object::Duo->new ('duo-ldap', 'test', $schema) }; is ($object, undef, '...and now object cannot be retrieved'); is ($@, "cannot find duo:test\n", '...with correct error'); } diff --git a/perl/t/object/duo-pam.t b/perl/t/object/duo-pam.t index 7b88787..047343e 100644 --- a/perl/t/object/duo-pam.t +++ b/perl/t/object/duo-pam.t @@ -26,7 +26,7 @@ BEGIN { BEGIN { use_ok('Wallet::Admin'); use_ok('Wallet::Config'); - use_ok('Wallet::Object::Duo::PAM'); + use_ok('Wallet::Object::Duo'); } use lib 't/lib'; @@ -53,14 +53,14 @@ my $mock = Net::Duo::Mock::Agent->new ({ key_file => 't/data/duo/keys.json' }); # Test error handling in the absence of configuration. my $object = eval { - Wallet::Object::Duo::PAM->new ('duo-pam', 'test', $schema); + Wallet::Object::Duo->new ('duo-pam', 'test', $schema); }; -is ($object, undef, 'Wallet::Object::Duo::PAM new with no config failed'); +is ($object, undef, 'Wallet::Object::Duo new with no config failed'); is ($@, "duo object implementation not configured\n", '...with correct error'); $object = eval { - Wallet::Object::Duo::PAM->create ('duo-pam', 'test', $schema, @trace); + Wallet::Object::Duo->create ('duo-pam', 'test', $schema, @trace); }; -is ($object, undef, 'Wallet::Object::Duo::PAM creation with no config failed'); +is ($object, undef, 'Wallet::Object::Duo creation with no config failed'); is ($@, "duo object implementation not configured\n", '...with correct error'); # Set up the Duo configuration. @@ -82,9 +82,8 @@ $mock->expect ( response_file => 't/data/duo/integration.json', } ); -$object = Wallet::Object::Duo::PAM->create ('duo-pam', 'test', $schema, - @trace); -isa_ok ($object, 'Wallet::Object::Duo::PAM'); +$object = Wallet::Object::Duo->create ('duo-pam', 'test', $schema, @trace); +isa_ok ($object, 'Wallet::Object::Duo'); # Check the metadata about the new wallet object. $expected = <<"EOO"; @@ -126,7 +125,7 @@ is ($object->flag_clear ('locked', @trace), 1, '...and clearing locked flag works'); # Create a new object by wallet type and name. -$object = Wallet::Object::Duo::PAM->new ('duo-pam', 'test', $schema); +$object = Wallet::Object::Duo->new ('duo-pam', 'test', $schema); # Test deleting an integration. We can't test this entirely properly because # currently Net::Duo::Mock::Agent doesn't support stacking multiple expected @@ -143,8 +142,7 @@ TODO: { local $TODO = 'Net::Duo::Mock::Agent not yet capable'; is ($object->destroy (@trace), 1, 'Duo object deletion succeeded'); - $object = eval { Wallet::Object::Duo::PAM->new ('duo-pam', 'test', - $schema) }; + $object = eval { Wallet::Object::Duo->new ('duo-pam', 'test', $schema) }; is ($object, undef, '...and now object cannot be retrieved'); is ($@, "cannot find duo:test\n", '...with correct error'); } diff --git a/perl/t/object/duo-radius.t b/perl/t/object/duo-radius.t index f258518..55cbb9d 100644 --- a/perl/t/object/duo-radius.t +++ b/perl/t/object/duo-radius.t @@ -26,7 +26,7 @@ BEGIN { BEGIN { use_ok('Wallet::Admin'); use_ok('Wallet::Config'); - use_ok('Wallet::Object::Duo::RadiusProxy'); + use_ok('Wallet::Object::Duo'); } use lib 't/lib'; @@ -53,17 +53,16 @@ my $mock = Net::Duo::Mock::Agent->new ({ key_file => 't/data/duo/keys.json' }); # Test error handling in the absence of configuration. my $object = eval { - Wallet::Object::Duo::RadiusProxy->new ('duo-raduys', 'test', $schema); + Wallet::Object::Duo->new ('duo-radius', 'test', $schema); }; is ($object, undef, - 'Wallet::Object::Duo::RadiusProxy new with no config failed'); + 'Wallet::Object::Duo new with no config failed'); is ($@, "duo object implementation not configured\n", '...with correct error'); $object = eval { - Wallet::Object::Duo::RadiusProxy->create ('duo-radius', 'test', $schema, - @trace); + Wallet::Object::Duo->create ('duo-radius', 'test', $schema, @trace); }; is ($object, undef, - 'Wallet::Object::Duo::RadiusProxy creation with no config failed'); + 'Wallet::Object::Duo creation with no config failed'); is ($@, "duo object implementation not configured\n", '...with correct error'); # Set up the Duo configuration. @@ -85,9 +84,8 @@ $mock->expect ( response_file => 't/data/duo/integration-radius.json', } ); -$object = Wallet::Object::Duo::RadiusProxy->create ('duo-radius', 'test', - $schema, @trace); -isa_ok ($object, 'Wallet::Object::Duo::RadiusProxy'); +$object = Wallet::Object::Duo->create ('duo-radius', 'test', $schema, @trace); +isa_ok ($object, 'Wallet::Object::Duo'); # Check the metadata about the new wallet object. $expected = <<"EOO"; @@ -130,8 +128,7 @@ is ($object->flag_clear ('locked', @trace), 1, '...and clearing locked flag works'); # Create a new object by wallet type and name. -$object = Wallet::Object::Duo::RadiusProxy->new ('duo-radius', 'test', - $schema); +$object = Wallet::Object::Duo->new ('duo-radius', 'test', $schema); # Test deleting an integration. We can't test this entirely properly because # currently Net::Duo::Mock::Agent doesn't support stacking multiple expected @@ -149,7 +146,7 @@ TODO: { is ($object->destroy (@trace), 1, 'Duo object deletion succeeded'); $object = eval { - Wallet::Object::Duo::RadiusProxy->new ('duo-radius', 'test', $schema); + Wallet::Object::Duo->new ('duo-radius', 'test', $schema); }; is ($object, undef, '...and now object cannot be retrieved'); is ($@, "cannot find duo:test\n", '...with correct error'); diff --git a/perl/t/object/duo-rdp.t b/perl/t/object/duo-rdp.t index 9b2d566..25060ac 100644 --- a/perl/t/object/duo-rdp.t +++ b/perl/t/object/duo-rdp.t @@ -26,7 +26,7 @@ BEGIN { BEGIN { use_ok('Wallet::Admin'); use_ok('Wallet::Config'); - use_ok('Wallet::Object::Duo::RDP'); + use_ok('Wallet::Object::Duo'); } use lib 't/lib'; @@ -53,14 +53,14 @@ my $mock = Net::Duo::Mock::Agent->new ({ key_file => 't/data/duo/keys.json' }); # Test error handling in the absence of configuration. my $object = eval { - Wallet::Object::Duo::RDP->new ('duo-rdp', 'test', $schema); + Wallet::Object::Duo->new ('duo-rdp', 'test', $schema); }; -is ($object, undef, 'Wallet::Object::Duo::RDP new with no config failed'); +is ($object, undef, 'Wallet::Object::Duo new with no config failed'); is ($@, "duo object implementation not configured\n", '...with correct error'); $object = eval { - Wallet::Object::Duo::RDP->create ('duo-rdp', 'test', $schema, @trace); + Wallet::Object::Duo->create ('duo-rdp', 'test', $schema, @trace); }; -is ($object, undef, 'Wallet::Object::Duo::RDP creation with no config failed'); +is ($object, undef, 'Wallet::Object::Duo creation with no config failed'); is ($@, "duo object implementation not configured\n", '...with correct error'); # Set up the Duo configuration. @@ -82,9 +82,8 @@ $mock->expect ( response_file => 't/data/duo/integration-rdp.json', } ); -$object = Wallet::Object::Duo::RDP->create ('duo-rdp', 'test', $schema, - @trace); -isa_ok ($object, 'Wallet::Object::Duo::RDP'); +$object = Wallet::Object::Duo->create ('duo-rdp', 'test', $schema, @trace); +isa_ok ($object, 'Wallet::Object::Duo'); # Check the metadata about the new wallet object. $expected = <<"EOO"; @@ -125,7 +124,7 @@ is ($object->flag_clear ('locked', @trace), 1, '...and clearing locked flag works'); # Create a new object by wallet type and name. -$object = Wallet::Object::Duo::RDP->new ('duo-rdp', 'test', $schema); +$object = Wallet::Object::Duo->new ('duo-rdp', 'test', $schema); # Test deleting an integration. We can't test this entirely properly because # currently Net::Duo::Mock::Agent doesn't support stacking multiple expected @@ -142,8 +141,7 @@ TODO: { local $TODO = 'Net::Duo::Mock::Agent not yet capable'; is ($object->destroy (@trace), 1, 'Duo object deletion succeeded'); - $object = eval { Wallet::Object::Duo::RDP->new ('duo-rdp', 'test', - $schema) }; + $object = eval { Wallet::Object::Duo->new ('duo-rdp', 'test', $schema) }; is ($object, undef, '...and now object cannot be retrieved'); is ($@, "cannot find duo:test\n", '...with correct error'); } -- cgit v1.2.3 From a7b518bd54a73e0234d9dcb9bf9ef78272f73add Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Sun, 3 Jan 2016 19:57:04 -0800 Subject: Fix Wallet::Object::Duo to pass strict.t test w/o Net::Duo Ubuntu precise and trusty don't have Net::Duo packages. Delay loading to the constructor so that the modules will still pass strictness tests. This also fixes Travis-CI testing. Change-Id: I23f1fe6dbdddaac2040f459410a74be4a13b6755 --- perl/lib/Wallet/Object/Duo.pm | 34 ++++++++++++++++++++++++++++------ 1 file changed, 28 insertions(+), 6 deletions(-) (limited to 'perl/lib/Wallet/Object') diff --git a/perl/lib/Wallet/Object/Duo.pm b/perl/lib/Wallet/Object/Duo.pm index d0901de..378c123 100644 --- a/perl/lib/Wallet/Object/Duo.pm +++ b/perl/lib/Wallet/Object/Duo.pm @@ -1,7 +1,8 @@ # Wallet::Object::Duo -- Base Duo object implementation for the wallet # # Written by Russ Allbery -# Copyright 2014 +# Copyright 2016 Russ Allbery +# Copyright 2014, 2015 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -18,8 +19,6 @@ 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; @@ -159,8 +158,20 @@ sub new { my $key_file = $Wallet::Config::DUO_KEY_FILE; my $agent = $Wallet::Config::DUO_AGENT; + # Check that we can load all of the required modules. + eval { + require Net::Duo; + require Net::Duo::Admin; + require Net::Duo::Admin::Integration; + }; + if ($@) { + my $error = $@; + chomp $error; + 1 while ($error =~ s/ at \S+ line \d+\.?\z//); + die "Duo object support not available: $error\n"; + } + # Construct the Net::Duo::Admin object. - require Net::Duo::Admin; my $duo = Net::Duo::Admin->new ( { key_file => $key_file, @@ -194,8 +205,20 @@ sub create { die "$type is not a valid duo integration\n"; } + # Check that we can load all of the required modules. + eval { + require Net::Duo; + require Net::Duo::Admin; + require Net::Duo::Admin::Integration; + }; + if ($@) { + my $error = $@; + chomp $error; + 1 while ($error =~ s/ at \S+ line \d+\.?\z//); + die "Duo object support not available: $error\n"; + } + # Construct the Net::Duo::Admin object. - require Net::Duo::Admin; my $duo = Net::Duo::Admin->new ( { key_file => $key_file, @@ -204,7 +227,6 @@ sub create { ); # Create the object in Duo. - require Net::Duo::Admin::Integration; my $duo_type = $DUO_TYPES{$type}{integration}; my %data = ( name => "$name ($duo_type)", -- cgit v1.2.3 From 4feab8a987a345e38c44077d1042bf05ec03f0eb Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Sun, 17 Jan 2016 12:25:15 -0800 Subject: Standardize Perl module versions The versions of all of the wallet Perl modules now match the overall package version except for Wallet::Schema, which is used to version the database schema. Import the test from rra-c-util 5.10 and exclude Wallet::Schema from the tests. Go through all Perl modules and standardize the syntax for setting the version and indicating the required version of Perl. Fix a few other syntax issues while I'm in there. --- NEWS | 4 + perl/Build.PL | 2 +- perl/lib/Wallet/ACL.pm | 14 +- perl/lib/Wallet/ACL/Base.pm | 11 +- perl/lib/Wallet/ACL/External.pm | 12 +- perl/lib/Wallet/ACL/Krb5.pm | 14 +- perl/lib/Wallet/ACL/Krb5/Regex.pm | 12 +- perl/lib/Wallet/ACL/LDAP/Attribute.pm | 16 +- perl/lib/Wallet/ACL/LDAP/Attribute/Root.pm | 17 +- perl/lib/Wallet/ACL/Nested.pm | 12 +- perl/lib/Wallet/ACL/NetDB.pm | 14 +- perl/lib/Wallet/ACL/NetDB/Root.pm | 15 +- perl/lib/Wallet/Admin.pm | 11 +- perl/lib/Wallet/Config.pm | 12 +- perl/lib/Wallet/Database.pm | 16 +- perl/lib/Wallet/Kadmin.pm | 13 +- perl/lib/Wallet/Kadmin/AD.pm | 32 ++- perl/lib/Wallet/Kadmin/Heimdal.pm | 18 +- perl/lib/Wallet/Kadmin/MIT.pm | 18 +- perl/lib/Wallet/Object/Base.pm | 12 +- perl/lib/Wallet/Object/Duo.pm | 13 +- perl/lib/Wallet/Object/File.pm | 16 +- perl/lib/Wallet/Object/Keytab.pm | 18 +- perl/lib/Wallet/Object/Password.pm | 16 +- perl/lib/Wallet/Object/WAKeyring.pm | 16 +- perl/lib/Wallet/Policy/Stanford.pm | 7 +- perl/lib/Wallet/Report.pm | 11 +- perl/lib/Wallet/Schema.pm | 10 +- perl/lib/Wallet/Schema/Result/Acl.pm | 2 + perl/lib/Wallet/Schema/Result/AclEntry.pm | 2 + perl/lib/Wallet/Schema/Result/AclHistory.pm | 2 + perl/lib/Wallet/Schema/Result/AclScheme.pm | 3 + perl/lib/Wallet/Schema/Result/Duo.pm | 2 + perl/lib/Wallet/Schema/Result/Enctype.pm | 2 + perl/lib/Wallet/Schema/Result/Flag.pm | 2 + perl/lib/Wallet/Schema/Result/KeytabEnctype.pm | 2 + perl/lib/Wallet/Schema/Result/KeytabSync.pm | 2 + perl/lib/Wallet/Schema/Result/Object.pm | 2 + perl/lib/Wallet/Schema/Result/ObjectHistory.pm | 2 + perl/lib/Wallet/Schema/Result/SyncTarget.pm | 2 + perl/lib/Wallet/Schema/Result/Type.pm | 2 + perl/lib/Wallet/Server.pm | 11 +- tests/TESTS | 1 + tests/data/perl.conf | 5 +- tests/perl/module-version-t | 169 ++++++++++++++ tests/tap/perl/Test/RRA.pm | 104 ++++----- tests/tap/perl/Test/RRA/Automake.pm | 164 ++++++-------- tests/tap/perl/Test/RRA/Config.pm | 138 ++++++------ tests/tap/perl/Test/RRA/ModuleVersion.pm | 295 +++++++++++++++++++++++++ 49 files changed, 826 insertions(+), 470 deletions(-) create mode 100755 tests/perl/module-version-t create mode 100644 tests/tap/perl/Test/RRA/ModuleVersion.pm (limited to 'perl/lib/Wallet/Object') diff --git a/NEWS b/NEWS index 9d5b1a6..fe4429d 100644 --- a/NEWS +++ b/NEWS @@ -75,6 +75,10 @@ wallet 1.3 (unreleased) Displays of ACLs and ACL entries are now sorted correctly. + The versions of all of the wallet Perl modules now match the overall + package version except for Wallet::Schema, which is used to version + the database schema. + wallet 1.2 (2014-12-08) The duo object type has been split into several sub-types, each for a diff --git a/perl/Build.PL b/perl/Build.PL index 968ae37..05111dd 100644 --- a/perl/Build.PL +++ b/perl/Build.PL @@ -19,7 +19,7 @@ my $build = Module::Build->new( dist_abstract => 'Secure credential management system', dist_author => 'Russ Allbery ', dist_name => 'Wallet', - dist_version => '1.01', + dist_version => '1.03', license => 'mit', module_name => 'Wallet::Server', recursive_test_files => 1, diff --git a/perl/lib/Wallet/ACL.pm b/perl/lib/Wallet/ACL.pm index 69e6890..ad0eb2c 100644 --- a/perl/lib/Wallet/ACL.pm +++ b/perl/lib/Wallet/ACL.pm @@ -1,6 +1,7 @@ -# Wallet::ACL -- Implementation of ACLs in the wallet system. +# Wallet::ACL -- Implementation of ACLs in the wallet system # # Written by Russ Allbery +# Copyright 2016 Russ Allbery # Copyright 2007, 2008, 2010, 2013, 2014, 2015 # The Board of Trustees of the Leland Stanford Junior University # @@ -11,20 +12,15 @@ ############################################################################## package Wallet::ACL; -require 5.006; +use 5.008; use strict; use warnings; -use vars qw($VERSION); -use Wallet::Object::Base; use DateTime; -use DBI; +use Wallet::Object::Base; -# This version should be increased on any code change to this module. Always -# use two digits for the minor version with a leading zero if necessary so -# that it will sort properly. -$VERSION = '0.09'; +our $VERSION = '1.03'; ############################################################################## # Constructors diff --git a/perl/lib/Wallet/ACL/Base.pm b/perl/lib/Wallet/ACL/Base.pm index 3778c07..235a9cb 100644 --- a/perl/lib/Wallet/ACL/Base.pm +++ b/perl/lib/Wallet/ACL/Base.pm @@ -1,6 +1,7 @@ -# Wallet::ACL::Base -- Parent class for wallet ACL verifiers. +# Wallet::ACL::Base -- Parent class for wallet ACL verifiers # # Written by Russ Allbery +# Copyright 2016 Russ Allbery # Copyright 2007, 2010, 2014 # The Board of Trustees of the Leland Stanford Junior University # @@ -11,16 +12,12 @@ ############################################################################## package Wallet::ACL::Base; -require 5.006; +use 5.008; use strict; use warnings; -use vars qw($VERSION); -# This version should be increased on any code change to this module. Always -# use two digits for the minor version with a leading zero if necessary so -# that it will sort properly. -$VERSION = '0.03'; +our $VERSION = '1.03'; ############################################################################## # Interface diff --git a/perl/lib/Wallet/ACL/External.pm b/perl/lib/Wallet/ACL/External.pm index f1bd577..caed80e 100644 --- a/perl/lib/Wallet/ACL/External.pm +++ b/perl/lib/Wallet/ACL/External.pm @@ -1,6 +1,5 @@ # Wallet::ACL::External -- Wallet external ACL verifier # -# Written by Russ Allbery # Copyright 2016 Russ Allbery # # See LICENSE for licensing terms. @@ -10,22 +9,17 @@ ############################################################################## package Wallet::ACL::External; -require 5.008; +use 5.008; use strict; use warnings; -use vars qw(@ISA $VERSION); use POSIX qw(_exit); use Wallet::ACL::Base; use Wallet::Config; -@ISA = qw(Wallet::ACL::Base); - -# This version should be increased on any code change to this module. Always -# use two digits for the minor version with a leading zero if necessary so -# that it will sort properly. -$VERSION = '0.01'; +our @ISA = qw(Wallet::ACL::Base); +our $VERSION = '1.03'; ############################################################################## # Interface diff --git a/perl/lib/Wallet/ACL/Krb5.pm b/perl/lib/Wallet/ACL/Krb5.pm index 80d32bd..e0e9a61 100644 --- a/perl/lib/Wallet/ACL/Krb5.pm +++ b/perl/lib/Wallet/ACL/Krb5.pm @@ -1,6 +1,7 @@ -# Wallet::ACL::Krb5 -- Wallet Kerberos v5 principal ACL verifier. +# Wallet::ACL::Krb5 -- Wallet Kerberos v5 principal ACL verifier # # Written by Russ Allbery +# Copyright 2016 Russ Allbery # Copyright 2007, 2010, 2014 # The Board of Trustees of the Leland Stanford Junior University # @@ -11,20 +12,15 @@ ############################################################################## package Wallet::ACL::Krb5; -require 5.006; +use 5.008; use strict; use warnings; -use vars qw(@ISA $VERSION); use Wallet::ACL::Base; -@ISA = qw(Wallet::ACL::Base); - -# This version should be increased on any code change to this module. Always -# use two digits for the minor version with a leading zero if necessary so -# that it will sort properly. -$VERSION = '0.02'; +our @ISA = qw(Wallet::ACL::Base); +our $VERSION = '1.03'; ############################################################################## # Interface diff --git a/perl/lib/Wallet/ACL/Krb5/Regex.pm b/perl/lib/Wallet/ACL/Krb5/Regex.pm index 4934cfc..f3b9a06 100644 --- a/perl/lib/Wallet/ACL/Krb5/Regex.pm +++ b/perl/lib/Wallet/ACL/Krb5/Regex.pm @@ -1,6 +1,7 @@ # Wallet::ACL::Krb5::Regex -- Wallet Kerberos v5 principal regex ACL verifier # # Written by Russ Allbery +# Copyright 2016 Russ Allbery # Copyright 2007, 2010, 2014 # The Board of Trustees of the Leland Stanford Junior University # @@ -11,20 +12,15 @@ ############################################################################## package Wallet::ACL::Krb5::Regex; -require 5.006; +use 5.008; use strict; use warnings; -use vars qw(@ISA $VERSION); use Wallet::ACL::Krb5; -@ISA = qw(Wallet::ACL::Krb5); - -# This version should be increased on any code change to this module. Always -# use two digits for the minor version with a leading zero if necessary so -# that it will sort properly. -$VERSION = '0.01'; +our @ISA = qw(Wallet::ACL::Krb5); +our $VERSION = '1.03'; ############################################################################## # Interface diff --git a/perl/lib/Wallet/ACL/LDAP/Attribute.pm b/perl/lib/Wallet/ACL/LDAP/Attribute.pm index c27729e..fcb8447 100644 --- a/perl/lib/Wallet/ACL/LDAP/Attribute.pm +++ b/perl/lib/Wallet/ACL/LDAP/Attribute.pm @@ -1,6 +1,7 @@ -# Wallet::ACL::LDAP::Attribute -- Wallet LDAP attribute ACL verifier. +# Wallet::ACL::LDAP::Attribute -- Wallet LDAP attribute ACL verifier # # Written by Russ Allbery +# Copyright 2016 Russ Allbery # Copyright 2012, 2013, 2014 # The Board of Trustees of the Leland Stanford Junior University # @@ -11,23 +12,18 @@ ############################################################################## package Wallet::ACL::LDAP::Attribute; -require 5.006; +use 5.008; use strict; use warnings; -use vars qw(@ISA $VERSION); -use Authen::SASL (); +use Authen::SASL; use Net::LDAP qw(LDAP_COMPARE_TRUE); use Wallet::ACL::Base; use Wallet::Config; -@ISA = qw(Wallet::ACL::Base); - -# This version should be increased on any code change to this module. Always -# use two digits for the minor version with a leading zero if necessary so -# that it will sort properly. -$VERSION = '0.01'; +our @ISA = qw(Wallet::ACL::Base); +our $VERSION = '1.03'; ############################################################################## # Interface diff --git a/perl/lib/Wallet/ACL/LDAP/Attribute/Root.pm b/perl/lib/Wallet/ACL/LDAP/Attribute/Root.pm index eb30931..8451394 100644 --- a/perl/lib/Wallet/ACL/LDAP/Attribute/Root.pm +++ b/perl/lib/Wallet/ACL/LDAP/Attribute/Root.pm @@ -1,7 +1,8 @@ -# Wallet::ACL::LDAP::Attribute::Root -- Wallet LDAP ACL verifier (root instances). +# Wallet::ACL::LDAP::Attribute::Root -- Wallet root instance LDAP ACL verifier # # Written by Jon Robertson -# From Wallet::ACL::NetDB::Root by Russ Allbery +# Based on Wallet::ACL::NetDB::Root by Russ Allbery +# Copyright 2016 Russ Allbery # Copyright 2015 # The Board of Trustees of the Leland Stanford Junior University # @@ -12,21 +13,15 @@ ############################################################################## package Wallet::ACL::LDAP::Attribute::Root; -require 5.006; +use 5.008; use strict; use warnings; -use vars qw(@ISA $VERSION); use Wallet::ACL::LDAP::Attribute; -use Wallet::Config; -@ISA = qw(Wallet::ACL::LDAP::Attribute); - -# This version should be increased on any code change to this module. Always -# use two digits for the minor version with a leading zero if necessary so -# that it will sort properly. -$VERSION = '0.01'; +our @ISA = qw(Wallet::ACL::LDAP::Attribute); +our $VERSION = '1.03'; ############################################################################## # Interface diff --git a/perl/lib/Wallet/ACL/Nested.pm b/perl/lib/Wallet/ACL/Nested.pm index 3b6c827..da42286 100644 --- a/perl/lib/Wallet/ACL/Nested.pm +++ b/perl/lib/Wallet/ACL/Nested.pm @@ -1,6 +1,7 @@ # Wallet::ACL::Nested - ACL class for nesting ACLs # # Written by Jon Robertson +# Copyright 2016 Russ Allbery # Copyright 2015 # The Board of Trustees of the Leland Stanford Junior University # @@ -11,20 +12,15 @@ ############################################################################## package Wallet::ACL::Nested; -require 5.006; +use 5.008; use strict; use warnings; -use vars qw($VERSION @ISA); use Wallet::ACL::Base; -@ISA = qw(Wallet::ACL::Base); - -# This version should be increased on any code change to this module. Always -# use two digits for the minor version with a leading zero if necessary so -# that it will sort properly. -$VERSION = '0.01'; +our @ISA = qw(Wallet::ACL::Base); +our $VERSION = '1.03'; ############################################################################## # Interface diff --git a/perl/lib/Wallet/ACL/NetDB.pm b/perl/lib/Wallet/ACL/NetDB.pm index ad2164b..a4c7fb0 100644 --- a/perl/lib/Wallet/ACL/NetDB.pm +++ b/perl/lib/Wallet/ACL/NetDB.pm @@ -1,6 +1,7 @@ -# Wallet::ACL::NetDB -- Wallet NetDB role ACL verifier. +# Wallet::ACL::NetDB -- Wallet NetDB role ACL verifier # # Written by Russ Allbery +# Copyright 2016 Russ Allbery # Copyright 2007, 2010, 2014 # The Board of Trustees of the Leland Stanford Junior University # @@ -11,21 +12,16 @@ ############################################################################## package Wallet::ACL::NetDB; -require 5.006; +use 5.008; use strict; use warnings; -use vars qw(@ISA $VERSION); use Wallet::ACL::Base; use Wallet::Config; -@ISA = qw(Wallet::ACL::Base); - -# This version should be increased on any code change to this module. Always -# use two digits for the minor version with a leading zero if necessary so -# that it will sort properly. -$VERSION = '0.05'; +our @ISA = qw(Wallet::ACL::Base); +our $VERSION = '1.03'; ############################################################################## # Interface diff --git a/perl/lib/Wallet/ACL/NetDB/Root.pm b/perl/lib/Wallet/ACL/NetDB/Root.pm index 34163e7..bfd13b4 100644 --- a/perl/lib/Wallet/ACL/NetDB/Root.pm +++ b/perl/lib/Wallet/ACL/NetDB/Root.pm @@ -1,6 +1,7 @@ -# Wallet::ACL::NetDB::Root -- Wallet NetDB role ACL verifier (root instances). +# Wallet::ACL::NetDB::Root -- Wallet NetDB role ACL verifier (root instances) # # Written by Russ Allbery +# Copyright 2016 Russ Allbery # Copyright 2007, 2010, 2014 # The Board of Trustees of the Leland Stanford Junior University # @@ -11,21 +12,15 @@ ############################################################################## package Wallet::ACL::NetDB::Root; -require 5.006; +use 5.008; use strict; use warnings; -use vars qw(@ISA $VERSION); use Wallet::ACL::NetDB; -use Wallet::Config; -@ISA = qw(Wallet::ACL::NetDB); - -# This version should be increased on any code change to this module. Always -# use two digits for the minor version with a leading zero if necessary so -# that it will sort properly. -$VERSION = '0.02'; +our @ISA = qw(Wallet::ACL::NetDB); +our $VERSION = '1.03'; ############################################################################## # Interface diff --git a/perl/lib/Wallet/Admin.pm b/perl/lib/Wallet/Admin.pm index b4246ba..9b63174 100644 --- a/perl/lib/Wallet/Admin.pm +++ b/perl/lib/Wallet/Admin.pm @@ -1,6 +1,7 @@ -# Wallet::Admin -- Wallet system administrative interface. +# Wallet::Admin -- Wallet system administrative interface # # Written by Russ Allbery +# Copyright 2016 Russ Allbery # Copyright 2008, 2009, 2010, 2011, 2012, 2013, 2014 # The Board of Trustees of the Leland Stanford Junior University # @@ -11,19 +12,15 @@ ############################################################################## package Wallet::Admin; -require 5.006; +use 5.008; use strict; use warnings; -use vars qw($VERSION); use Wallet::ACL; use Wallet::Schema; -# This version should be increased on any code change to this module. Always -# use two digits for the minor version with a leading zero if necessary so -# that it will sort properly. -$VERSION = '0.08'; +our $VERSION = '1.03'; # The last non-DBIx::Class version of Wallet::Schema. If a database has no # DBIx::Class versioning, we artificially install this version number before diff --git a/perl/lib/Wallet/Config.pm b/perl/lib/Wallet/Config.pm index ac66676..b8771c3 100644 --- a/perl/lib/Wallet/Config.pm +++ b/perl/lib/Wallet/Config.pm @@ -1,4 +1,4 @@ -# Wallet::Config -- Configuration handling for the wallet server. +# Wallet::Config -- Configuration handling for the wallet server # # Written by Russ Allbery # Copyright 2016 Russ Allbery @@ -8,19 +8,15 @@ # See LICENSE for licensing terms. package Wallet::Config; -require 5.006; +use 5.008; use strict; use warnings; -use vars qw($PATH $VERSION); -# This version should be increased on any code change to this module. Always -# use two digits for the minor version with a leading zero if necessary so -# that it will sort properly. -$VERSION = '0.06'; +our $VERSION = '1.03'; # Path to the config file to load. -$PATH = $ENV{WALLET_CONFIG} || '/etc/wallet/wallet.conf'; +our $PATH = $ENV{WALLET_CONFIG} || '/etc/wallet/wallet.conf'; =head1 NAME diff --git a/perl/lib/Wallet/Database.pm b/perl/lib/Wallet/Database.pm index 3a4e130..23b059f 100644 --- a/perl/lib/Wallet/Database.pm +++ b/perl/lib/Wallet/Database.pm @@ -1,4 +1,4 @@ -# Wallet::Database -- Wallet system database connection management. +# Wallet::Database -- Wallet system database connection management # # This module is a thin wrapper around DBIx::Class to handle determination # of the database configuration settings automatically on connect. The @@ -6,6 +6,7 @@ # like DBIx::Class objects in the rest of the code. # # Written by Russ Allbery +# Copyright 2016 Russ Allbery # Copyright 2008, 2009, 2010, 2012, 2013, 2014 # The Board of Trustees of the Leland Stanford Junior University # @@ -16,21 +17,16 @@ ############################################################################## package Wallet::Database; -require 5.006; +use 5.008; use strict; use warnings; -use vars qw(@ISA $VERSION); -use Wallet::Schema; use Wallet::Config; +use Wallet::Schema; -@ISA = qw(Wallet::Schema); - -# This version should be increased on any code change to this module. Always -# use two digits for the minor version with a leading zero if necessary so -# that it will sort properly. -$VERSION = '0.04'; +our @ISA = qw(Wallet::Schema); +our $VERSION = '1.03'; ############################################################################## # Core overrides diff --git a/perl/lib/Wallet/Kadmin.pm b/perl/lib/Wallet/Kadmin.pm index cb3bd47..8851c7e 100644 --- a/perl/lib/Wallet/Kadmin.pm +++ b/perl/lib/Wallet/Kadmin.pm @@ -1,6 +1,7 @@ -# Wallet::Kadmin -- Kerberos administration API for wallet keytab backend. +# Wallet::Kadmin -- Kerberos administration API for wallet keytab backend # # Written by Jon Robertson +# Copyright 2016 Russ Allbery # Copyright 2009, 2010, 2014 # The Board of Trustees of the Leland Stanford Junior University # @@ -11,18 +12,14 @@ ############################################################################## package Wallet::Kadmin; -require 5.006; +use 5.008; use strict; use warnings; -use vars qw($VERSION); -use Wallet::Config (); +use Wallet::Config; -# This version should be increased on any code change to this module. Always -# use two digits for the minor version with a leading zero if necessary so -# that it will sort properly. -$VERSION = '0.03'; +our $VERSION = '1.03'; ############################################################################## # Utility functions for child classes diff --git a/perl/lib/Wallet/Kadmin/AD.pm b/perl/lib/Wallet/Kadmin/AD.pm index 40e4376..5b71d41 100644 --- a/perl/lib/Wallet/Kadmin/AD.pm +++ b/perl/lib/Wallet/Kadmin/AD.pm @@ -1,10 +1,10 @@ -# Wallet::Kadmin::AD -- Wallet Kerberos administration API for AD. +# Wallet::Kadmin::AD -- Wallet Kerberos administration API for AD # # Written by Bill MacAllister -# Based on work by Russ Allbery and -# Jon Robertson -# Copyright 2015 -# Dropbox +# Copyright 2016 Russ Allbery +# Copyright 2015 Dropbox, Inc. +# Copyright 2007, 2008, 2009, 2010, 2014 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -13,26 +13,20 @@ ############################################################################## package Wallet::Kadmin::AD; -require 5.006; +use 5.008; use strict; use warnings; -use vars qw(@ISA $VERSION); -use Wallet::Config (); -use Wallet::Kadmin (); - -use Authen::SASL (); +use Authen::SASL; use Net::LDAP; -use IPC::Run qw( run timeout ); -use Sys::Syslog qw( :standard :macros ); - -@ISA = qw(Wallet::Kadmin); +use IPC::Run qw(run timeout); +use Sys::Syslog qw(:standard :macros); +use Wallet::Config; +use Wallet::Kadmin; -# This version should be increased on any code change to this module. -# Always use two digits for the minor version with a leading zero if -# necessary so that it will sort properly. -$VERSION = '0.02'; +our @ISA = qw(Wallet::Kadmin); +our $VERSION = '1.03'; ############################################################################## # kadmin Interaction diff --git a/perl/lib/Wallet/Kadmin/Heimdal.pm b/perl/lib/Wallet/Kadmin/Heimdal.pm index 1208801..22bdd59 100644 --- a/perl/lib/Wallet/Kadmin/Heimdal.pm +++ b/perl/lib/Wallet/Kadmin/Heimdal.pm @@ -1,6 +1,7 @@ -# Wallet::Kadmin::Heimdal -- Wallet Kerberos administration API for Heimdal. +# Wallet::Kadmin::Heimdal -- Wallet Kerberos administration API for Heimdal # # Written by Jon Robertson +# Copyright 2016 Russ Allbery # Copyright 2009, 2010, 2014 # The Board of Trustees of the Leland Stanford Junior University # @@ -11,22 +12,17 @@ ############################################################################## package Wallet::Kadmin::Heimdal; -require 5.006; +use 5.008; use strict; use warnings; -use vars qw(@ISA $VERSION); use Heimdal::Kadm5 qw(KRB5_KDB_DISALLOW_ALL_TIX); -use Wallet::Config (); -use Wallet::Kadmin (); +use Wallet::Config; +use Wallet::Kadmin; -@ISA = qw(Wallet::Kadmin); - -# This version should be increased on any code change to this module. Always -# use two digits for the minor version with a leading zero if necessary so -# that it will sort properly. -$VERSION = '0.04'; +our @ISA = qw(Wallet::Kadmin); +our $VERSION = '1.03'; ############################################################################## # Utility functions diff --git a/perl/lib/Wallet/Kadmin/MIT.pm b/perl/lib/Wallet/Kadmin/MIT.pm index c5dea23..9f0f50f 100644 --- a/perl/lib/Wallet/Kadmin/MIT.pm +++ b/perl/lib/Wallet/Kadmin/MIT.pm @@ -1,7 +1,8 @@ -# Wallet::Kadmin::MIT -- Wallet Kerberos administration API for MIT. +# Wallet::Kadmin::MIT -- Wallet Kerberos administration API for MIT # # Written by Russ Allbery # Pulled into a module by Jon Robertson +# Copyright 2016 Russ Allbery # Copyright 2007, 2008, 2009, 2010, 2014 # The Board of Trustees of the Leland Stanford Junior University # @@ -12,22 +13,17 @@ ############################################################################## package Wallet::Kadmin::MIT; -require 5.006; +use 5.008; use strict; use warnings; -use vars qw(@ISA $VERSION); use POSIX qw(_exit); -use Wallet::Config (); -use Wallet::Kadmin (); +use Wallet::Config; +use Wallet::Kadmin; -@ISA = qw(Wallet::Kadmin); - -# This version should be increased on any code change to this module. Always -# use two digits for the minor version with a leading zero if necessary so -# that it will sort properly. -$VERSION = '0.03'; +our @ISA = qw(Wallet::Kadmin); +our $VERSION = '1.03'; ############################################################################## # kadmin Interaction diff --git a/perl/lib/Wallet/Object/Base.pm b/perl/lib/Wallet/Object/Base.pm index 97e6127..221031f 100644 --- a/perl/lib/Wallet/Object/Base.pm +++ b/perl/lib/Wallet/Object/Base.pm @@ -1,6 +1,7 @@ -# Wallet::Object::Base -- Parent class for any object stored in the wallet. +# Wallet::Object::Base -- Parent class for any object stored in the wallet # # Written by Russ Allbery +# Copyright 2016 Russ Allbery # Copyright 2007, 2008, 2010, 2011, 2014 # The Board of Trustees of the Leland Stanford Junior University # @@ -11,22 +12,17 @@ ############################################################################## package Wallet::Object::Base; -require 5.006; +use 5.008; use strict; use warnings; -use vars qw($VERSION); use DateTime; use Date::Parse qw(str2time); -use DBI; use Text::Wrap qw(wrap); use Wallet::ACL; -# This version should be increased on any code change to this module. Always -# use two digits for the minor version with a leading zero if necessary so -# that it will sort properly. -$VERSION = '0.08'; +our $VERSION = '1.03'; ############################################################################## # Constructors diff --git a/perl/lib/Wallet/Object/Duo.pm b/perl/lib/Wallet/Object/Duo.pm index 378c123..1aca979 100644 --- a/perl/lib/Wallet/Object/Duo.pm +++ b/perl/lib/Wallet/Object/Duo.pm @@ -12,23 +12,18 @@ ############################################################################## package Wallet::Object::Duo; -require 5.006; +use 5.008; use strict; use warnings; -use vars qw(@ISA $VERSION); use JSON; use Perl6::Slurp qw(slurp); -use Wallet::Config (); +use Wallet::Config; use Wallet::Object::Base; -@ISA = qw(Wallet::Object::Base); - -# This version should be increased on any code change to this module. Always -# use two digits for the minor version with a leading zero if necessary so -# that it will sort properly. -$VERSION = '0.03'; +our @ISA = qw(Wallet::Object::Base); +our $VERSION = '1.03'; # Mappings from our types into what Duo calls the integration types. our %DUO_TYPES = ( diff --git a/perl/lib/Wallet/Object/File.pm b/perl/lib/Wallet/Object/File.pm index 226e32c..9452ff4 100644 --- a/perl/lib/Wallet/Object/File.pm +++ b/perl/lib/Wallet/Object/File.pm @@ -1,6 +1,7 @@ -# Wallet::Object::File -- File object implementation for the wallet. +# Wallet::Object::File -- File object implementation for the wallet # # Written by Russ Allbery +# Copyright 2016 Russ Allbery # Copyright 2008, 2010, 2014 # The Board of Trustees of the Leland Stanford Junior University # @@ -11,23 +12,18 @@ ############################################################################## package Wallet::Object::File; -require 5.006; +use 5.006; use strict; use warnings; -use vars qw(@ISA $VERSION); use Digest::MD5 qw(md5_hex); use File::Copy qw(move); -use Wallet::Config (); +use Wallet::Config; use Wallet::Object::Base; -@ISA = qw(Wallet::Object::Base); - -# This version should be increased on any code change to this module. Always -# use two digits for the minor version with a leading zero if necessary so -# that it will sort properly. -$VERSION = '0.03'; +our @ISA = qw(Wallet::Object::Base); +our $VERSION = '1.03'; ############################################################################## # File naming diff --git a/perl/lib/Wallet/Object/Keytab.pm b/perl/lib/Wallet/Object/Keytab.pm index c625766..f276b3f 100644 --- a/perl/lib/Wallet/Object/Keytab.pm +++ b/perl/lib/Wallet/Object/Keytab.pm @@ -1,6 +1,7 @@ -# Wallet::Object::Keytab -- Keytab object implementation for the wallet. +# Wallet::Object::Keytab -- Keytab object implementation for the wallet # # Written by Russ Allbery +# Copyright 2016 Russ Allbery # Copyright 2007, 2008, 2009, 2010, 2013, 2014 # The Board of Trustees of the Leland Stanford Junior University # @@ -11,22 +12,17 @@ ############################################################################## package Wallet::Object::Keytab; -require 5.006; +use 5.008; use strict; use warnings; -use vars qw(@ISA $VERSION); -use Wallet::Config (); -use Wallet::Object::Base; +use Wallet::Config; use Wallet::Kadmin; +use Wallet::Object::Base; -@ISA = qw(Wallet::Object::Base); - -# This version should be increased on any code change to this module. Always -# use two digits for the minor version with a leading zero if necessary so -# that it will sort properly. -$VERSION = '0.09'; +our @ISA = qw(Wallet::Object::Base); +our $VERSION = '1.03'; ############################################################################## # Shared methods diff --git a/perl/lib/Wallet/Object/Password.pm b/perl/lib/Wallet/Object/Password.pm index 3fd6ec8..1db53f3 100644 --- a/perl/lib/Wallet/Object/Password.pm +++ b/perl/lib/Wallet/Object/Password.pm @@ -1,6 +1,7 @@ -# Wallet::Object::Password -- Password object implementation for the wallet. +# Wallet::Object::Password -- Password object implementation for the wallet # # Written by Jon Robertson +# Copyright 2016 Russ Allbery # Copyright 2015 # The Board of Trustees of the Leland Stanford Junior University # @@ -11,23 +12,18 @@ ############################################################################## package Wallet::Object::Password; -require 5.006; +use 5.008; use strict; use warnings; -use vars qw(@ISA $VERSION); use Crypt::GeneratePassword qw(chars); use Digest::MD5 qw(md5_hex); -use Wallet::Config (); +use Wallet::Config; use Wallet::Object::File; -@ISA = qw(Wallet::Object::File); - -# This version should be increased on any code change to this module. Always -# use two digits for the minor version with a leading zero if necessary so -# that it will sort properly. -$VERSION = '0.01'; +our @ISA = qw(Wallet::Object::File); +our $VERSION = '1.03'; ############################################################################## # File naming diff --git a/perl/lib/Wallet/Object/WAKeyring.pm b/perl/lib/Wallet/Object/WAKeyring.pm index 3e80300..3c99785 100644 --- a/perl/lib/Wallet/Object/WAKeyring.pm +++ b/perl/lib/Wallet/Object/WAKeyring.pm @@ -1,6 +1,7 @@ -# Wallet::Object::WAKeyring -- WebAuth keyring object implementation. +# Wallet::Object::WAKeyring -- WebAuth keyring object implementation # # Written by Russ Allbery +# Copyright 2016 Russ Allbery # Copyright 2012, 2013, 2014 # The Board of Trustees of the Leland Stanford Junior University # @@ -11,24 +12,19 @@ ############################################################################## package Wallet::Object::WAKeyring; -require 5.006; +use 5.008; use strict; use warnings; -use vars qw(@ISA $VERSION); use Digest::MD5 qw(md5_hex); use Fcntl qw(LOCK_EX); -use Wallet::Config (); +use Wallet::Config; use Wallet::Object::Base; use WebAuth 3.06 qw(WA_KEY_AES WA_AES_128); -@ISA = qw(Wallet::Object::Base); - -# This version should be increased on any code change to this module. Always -# use two digits for the minor version with a leading zero if necessary so -# that it will sort properly. -$VERSION = '0.01'; +our @ISA = qw(Wallet::Object::Base); +our $VERSION = '1.03'; ############################################################################## # File naming diff --git a/perl/lib/Wallet/Policy/Stanford.pm b/perl/lib/Wallet/Policy/Stanford.pm index 86e204e..efb9d28 100644 --- a/perl/lib/Wallet/Policy/Stanford.pm +++ b/perl/lib/Wallet/Policy/Stanford.pm @@ -1,7 +1,8 @@ -# Wallet::Policy::Stanford -- Stanford's wallet naming and ownership policy. +# Wallet::Policy::Stanford -- Stanford's wallet naming and ownership policy # # Written by Russ Allbery -# Copyright 2013 +# Copyright 2016 Russ Allbery +# Copyright 2013, 2014, 2015 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -25,7 +26,7 @@ our (@EXPORT_OK, $VERSION); # against circular module loading (not that we load any modules, but # consistency is good). BEGIN { - $VERSION = '1.01'; + $VERSION = '1.03'; @EXPORT_OK = qw(default_owner verify_name is_for_host); } diff --git a/perl/lib/Wallet/Report.pm b/perl/lib/Wallet/Report.pm index 353cd97..3d59bf8 100644 --- a/perl/lib/Wallet/Report.pm +++ b/perl/lib/Wallet/Report.pm @@ -1,6 +1,7 @@ -# Wallet::Report -- Wallet system reporting interface. +# Wallet::Report -- Wallet system reporting interface # # Written by Russ Allbery +# Copyright 2016 Russ Allbery # Copyright 2008, 2009, 2010, 2013, 2014 # The Board of Trustees of the Leland Stanford Junior University # @@ -11,19 +12,15 @@ ############################################################################## package Wallet::Report; -require 5.006; +use 5.008; use strict; use warnings; -use vars qw($VERSION); use Wallet::ACL; use Wallet::Schema; -# This version should be increased on any code change to this module. Always -# use two digits for the minor version with a leading zero if necessary so -# that it will sort properly. -$VERSION = '0.04'; +our $VERSION = '1.03'; ############################################################################## # Constructor, destructor, and accessors diff --git a/perl/lib/Wallet/Schema.pm b/perl/lib/Wallet/Schema.pm index 386801a..6b3de39 100644 --- a/perl/lib/Wallet/Schema.pm +++ b/perl/lib/Wallet/Schema.pm @@ -1,6 +1,7 @@ -# Database schema and connector for the wallet system. +# Wallet::Schema -- Database schema and connector for the wallet system # # Written by Jon Robertson +# Copyright 2016 Russ Allbery # Copyright 2012, 2013, 2014 # The Board of Trustees of the Leland Stanford Junior University # @@ -8,6 +9,7 @@ package Wallet::Schema; +use 5.008; use strict; use warnings; @@ -15,9 +17,9 @@ use Wallet::Config; use base 'DBIx::Class::Schema'; -# This version should be increased on any code change to this module. Always -# use two digits for the minor version with a leading zero if necessary so -# that it will sort properly. +# Unlike all of the other wallet modules, this module's version is tied to the +# version of the schema in the database. It should only be changed on schema +# changes, at least until better handling of upgrades is available. our $VERSION = '0.10'; __PACKAGE__->load_namespaces; diff --git a/perl/lib/Wallet/Schema/Result/Acl.pm b/perl/lib/Wallet/Schema/Result/Acl.pm index 226738a..59a628a 100644 --- a/perl/lib/Wallet/Schema/Result/Acl.pm +++ b/perl/lib/Wallet/Schema/Result/Acl.pm @@ -13,6 +13,8 @@ use warnings; use base 'DBIx::Class::Core'; +our $VERSION = '1.03'; + =for stopwords ACL diff --git a/perl/lib/Wallet/Schema/Result/AclEntry.pm b/perl/lib/Wallet/Schema/Result/AclEntry.pm index a33a98c..ea531bd 100644 --- a/perl/lib/Wallet/Schema/Result/AclEntry.pm +++ b/perl/lib/Wallet/Schema/Result/AclEntry.pm @@ -13,6 +13,8 @@ use warnings; use base 'DBIx::Class::Core'; +our $VERSION = '1.03'; + =for stopwords ACL diff --git a/perl/lib/Wallet/Schema/Result/AclHistory.pm b/perl/lib/Wallet/Schema/Result/AclHistory.pm index 82e18a9..dc6bed7 100644 --- a/perl/lib/Wallet/Schema/Result/AclHistory.pm +++ b/perl/lib/Wallet/Schema/Result/AclHistory.pm @@ -13,6 +13,8 @@ use warnings; use base 'DBIx::Class::Core'; +our $VERSION = '1.03'; + __PACKAGE__->load_components("InflateColumn::DateTime"); =for stopwords diff --git a/perl/lib/Wallet/Schema/Result/AclScheme.pm b/perl/lib/Wallet/Schema/Result/AclScheme.pm index be4ec09..004e5d2 100644 --- a/perl/lib/Wallet/Schema/Result/AclScheme.pm +++ b/perl/lib/Wallet/Schema/Result/AclScheme.pm @@ -12,6 +12,9 @@ use strict; use warnings; use base 'DBIx::Class::Core'; + +our $VERSION = '1.03'; + __PACKAGE__->load_components (qw//); =for stopwords diff --git a/perl/lib/Wallet/Schema/Result/Duo.pm b/perl/lib/Wallet/Schema/Result/Duo.pm index 6ad61e9..b5328bb 100644 --- a/perl/lib/Wallet/Schema/Result/Duo.pm +++ b/perl/lib/Wallet/Schema/Result/Duo.pm @@ -13,6 +13,8 @@ use warnings; use base 'DBIx::Class::Core'; +our $VERSION = '1.03'; + =for stopwords keytab enctype diff --git a/perl/lib/Wallet/Schema/Result/Enctype.pm b/perl/lib/Wallet/Schema/Result/Enctype.pm index 5733669..f1f42a9 100644 --- a/perl/lib/Wallet/Schema/Result/Enctype.pm +++ b/perl/lib/Wallet/Schema/Result/Enctype.pm @@ -13,6 +13,8 @@ use warnings; use base 'DBIx::Class::Core'; +our $VERSION = '1.03'; + =for stopwords Kerberos diff --git a/perl/lib/Wallet/Schema/Result/Flag.pm b/perl/lib/Wallet/Schema/Result/Flag.pm index e223ff8..84e3ee3 100644 --- a/perl/lib/Wallet/Schema/Result/Flag.pm +++ b/perl/lib/Wallet/Schema/Result/Flag.pm @@ -13,6 +13,8 @@ use warnings; use base 'DBIx::Class::Core'; +our $VERSION = '1.03'; + =head1 NAME Wallet::Schema::Result::Flag - Wallet schema for object flags diff --git a/perl/lib/Wallet/Schema/Result/KeytabEnctype.pm b/perl/lib/Wallet/Schema/Result/KeytabEnctype.pm index daea724..2a16af8 100644 --- a/perl/lib/Wallet/Schema/Result/KeytabEnctype.pm +++ b/perl/lib/Wallet/Schema/Result/KeytabEnctype.pm @@ -13,6 +13,8 @@ use warnings; use base 'DBIx::Class::Core'; +our $VERSION = '1.03'; + =for stopwords keytab enctype diff --git a/perl/lib/Wallet/Schema/Result/KeytabSync.pm b/perl/lib/Wallet/Schema/Result/KeytabSync.pm index ca84277..bd57310 100644 --- a/perl/lib/Wallet/Schema/Result/KeytabSync.pm +++ b/perl/lib/Wallet/Schema/Result/KeytabSync.pm @@ -13,6 +13,8 @@ use warnings; use base 'DBIx::Class::Core'; +our $VERSION = '1.03'; + =for stopwords keytab diff --git a/perl/lib/Wallet/Schema/Result/Object.pm b/perl/lib/Wallet/Schema/Result/Object.pm index fd64e1b..fdec3b8 100644 --- a/perl/lib/Wallet/Schema/Result/Object.pm +++ b/perl/lib/Wallet/Schema/Result/Object.pm @@ -13,6 +13,8 @@ use warnings; use base 'DBIx::Class::Core'; +our $VERSION = '1.03'; + __PACKAGE__->load_components("InflateColumn::DateTime"); =head1 NAME diff --git a/perl/lib/Wallet/Schema/Result/ObjectHistory.pm b/perl/lib/Wallet/Schema/Result/ObjectHistory.pm index 5e9c8bd..2fe687e 100644 --- a/perl/lib/Wallet/Schema/Result/ObjectHistory.pm +++ b/perl/lib/Wallet/Schema/Result/ObjectHistory.pm @@ -13,6 +13,8 @@ use warnings; use base 'DBIx::Class::Core'; +our $VERSION = '1.03'; + __PACKAGE__->load_components("InflateColumn::DateTime"); =head1 NAME diff --git a/perl/lib/Wallet/Schema/Result/SyncTarget.pm b/perl/lib/Wallet/Schema/Result/SyncTarget.pm index 4300a54..ab8ea47 100644 --- a/perl/lib/Wallet/Schema/Result/SyncTarget.pm +++ b/perl/lib/Wallet/Schema/Result/SyncTarget.pm @@ -13,6 +13,8 @@ use warnings; use base 'DBIx::Class::Core'; +our $VERSION = '1.03'; + =head1 NAME Wallet::Schema::Result::SyncTarget - Wallet schema for synchronization targets diff --git a/perl/lib/Wallet/Schema/Result/Type.pm b/perl/lib/Wallet/Schema/Result/Type.pm index 748a8a8..abc7017 100644 --- a/perl/lib/Wallet/Schema/Result/Type.pm +++ b/perl/lib/Wallet/Schema/Result/Type.pm @@ -13,6 +13,8 @@ use warnings; use base 'DBIx::Class::Core'; +our $VERSION = '1.03'; + =for stopwords APIs diff --git a/perl/lib/Wallet/Server.pm b/perl/lib/Wallet/Server.pm index 946ba10..552ba9d 100644 --- a/perl/lib/Wallet/Server.pm +++ b/perl/lib/Wallet/Server.pm @@ -1,6 +1,7 @@ -# Wallet::Server -- Wallet system server implementation. +# Wallet::Server -- Wallet system server implementation # # Written by Russ Allbery +# Copyright 2016 Russ Allbery # Copyright 2007, 2008, 2010, 2011, 2013, 2014 # The Board of Trustees of the Leland Stanford Junior University # @@ -11,20 +12,16 @@ ############################################################################## package Wallet::Server; -require 5.006; +use 5.008; use strict; use warnings; -use vars qw(%MAPPING $VERSION); use Wallet::ACL; use Wallet::Config; use Wallet::Schema; -# This version should be increased on any code change to this module. Always -# use two digits for the minor version with a leading zero if necessary so -# that it will sort properly. -$VERSION = '0.11'; +our $VERSION = '1.03'; ############################################################################## # Utility methods diff --git a/tests/TESTS b/tests/TESTS index d947e97..f78a477 100644 --- a/tests/TESTS +++ b/tests/TESTS @@ -5,6 +5,7 @@ client/rekey docs/pod docs/pod-spelling perl/minimum-version +perl/module-version perl/strict portable/asprintf portable/mkstemp diff --git a/tests/data/perl.conf b/tests/data/perl.conf index eaf7443..0c1e34e 100644 --- a/tests/data/perl.conf +++ b/tests/data/perl.conf @@ -1,6 +1,9 @@ # Configuration for Perl tests. -*- perl -*- -# No special configuration yet. +# Wallet::Schema's version number is used to version the database schema and +# requires upgrade SQL files for each version bump. Until this is replaced +# with some better system, exclude it from version checking. +@MODULE_VERSION_IGNORE = qw(perl/lib/Wallet/Schema.pm); # File must end with this line. 1; diff --git a/tests/perl/module-version-t b/tests/perl/module-version-t new file mode 100755 index 0000000..a9ebf3b --- /dev/null +++ b/tests/perl/module-version-t @@ -0,0 +1,169 @@ +#!/usr/bin/perl +# +# Check or update the version of embedded Perl modules. +# +# Examines all module files (*.pm) under the perl/lib directory, if it exists, +# and verifies that their $VERSION is set to the same value as the current +# version number as determined by the NEWS file at the top level of the source +# tree (or the current directory if not being run as a test). +# +# When given the --update option, instead fixes all of the Perl modules found +# to have the correct version. + +use 5.006; +use strict; +use warnings; + +# SOURCE may not be set if we're running this script manually to update +# version numbers. If it isn't, assume we're being run from the top of the +# tree. +BEGIN { + if ($ENV{SOURCE}) { + unshift(@INC, "$ENV{SOURCE}/tap/perl"); + } else { + unshift(@INC, 'tests/tap/perl'); + } +} + +use Getopt::Long qw(GetOptions); +use Test::RRA qw(skip_unless_automated); +use Test::RRA::Automake qw(automake_setup); +use Test::RRA::ModuleVersion qw(test_module_versions update_module_versions); + +# Return the current version and, optionally, the package name from the NEWS +# file. Munges the version to be appropriate for Perl if necessary. +# +# Returns: Scalar: The version number of the latest version in NEWS +# List: The version number and the package name +# Throws: Text exception if NEWS is not found or doesn't contain a version +sub news_version { + my ($package, $version); + open(my $news, q{<}, 'NEWS') or die "$0: cannot open NEWS: $!\n"; + SCAN: + while (defined(my $line = <$news>)) { + ## no critic (RegularExpressions::ProhibitEscapedMetacharacters) + if ($line =~ m{ \A ([\w\s-]+) \s ([\d.]+) \s \( }xms) { + ($package, $version) = ($1, $2); + last SCAN; + } + ## use critic + } + close($news) or die "$0: error reading from NEWS: $!\n"; + if (!defined($version)) { + die "$0: cannot find version number in NEWS\n"; + } + + # Munge the version for Perl purposes by ensuring that each component + # has two digits and by dropping the second period. + $version =~ s{ [.] (\d) (?= [.] | \z ) }{.0$1}xmsg; + $version =~ s{ ([.] \d+) [.] (\d+) }{$1$2}xms; + + # Return the appropriate value based on context. + return wantarray ? ($version, $package) : $version; +} + +# Get the package name and version. +my ($version, $package) = news_version(); + +# rra-c-util itself checks the versions of the testing support modules instead +# of an embedded tree of Perl modules. +my $root = ($package eq 'rra-c-util') ? 'tests/tap/perl' : 'perl/lib'; + +# Main routine. We run as either a test suite or as a script to update all of +# the module versions, selecting based on whether we got the -u / --update +# command-line option. +my $update; +Getopt::Long::config('bundling', 'no_ignore_case'); +GetOptions('update|u' => \$update) or exit 1; +if ($update) { + update_module_versions($root, $version); +} else { + skip_unless_automated('Module version tests'); + automake_setup(); + test_module_versions($root, $version); +} +exit 0; +__END__ + +=for stopwords +Allbery sublicense MERCHANTABILITY NONINFRINGEMENT rra-c-util + +=head1 NAME + +module-version-t - Check or update versions of embedded Perl modules + +=head1 SYNOPSIS + +B [B<--update>] + +=head1 REQUIREMENTS + +Perl 5.6.2 or later. + +=head1 DESCRIPTION + +This script has a dual purpose as either a test script or a utility script. +The intent is to assist with maintaining consistent versions between a larger +primarily C project and any embedded Perl modules, supporting both the package +keyword syntax introduced in Perl 5.12 or the older explicit setting of a +$VERSION variable. + +As a test, it reads the current version of a package from the F file and +then looks for any Perl modules in F. (As a special exception, if +the package name as determined from the F file is C, it +looks for Perl modules in F instead.) If it finds any, it +checks that the version number of the Perl module matches the version number +of the package from the F file. These test results are reported with +Test::More, suitable for any TAP harness. + +As a utility script, when run with the B<--update> option, it similarly finds +all Perl modules in F (or F per above) and then +rewrites their version setting to match the version of the package as +determined from the F file. + +=head1 OPTIONS + +=over 4 + +=item B<-u>, B<--update> + +Rather than test the Perl modules for the correct version, update all Perl +modules found in the tree under F to the current version from the +NEWS file. + +=back + +=head1 AUTHOR + +Russ Allbery + +=head1 COPYRIGHT AND LICENSE + +Copyright 2014, 2016 Russ Allbery + +Copyright 2013 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. + +=head1 SEE ALSO + +This module is maintained in the rra-c-util package. The current version is +available from L. + +=cut diff --git a/tests/tap/perl/Test/RRA.pm b/tests/tap/perl/Test/RRA.pm index bb7de7d..8608e31 100644 --- a/tests/tap/perl/Test/RRA.pm +++ b/tests/tap/perl/Test/RRA.pm @@ -5,31 +5,6 @@ # by both C packages with Automake and by stand-alone Perl modules. See # Test::RRA::Automake for additional functions specifically for C Automake # distributions. -# -# The canonical version of this file is maintained in the rra-c-util package, -# which can be found at . -# -# Written by Russ Allbery -# 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. package Test::RRA; @@ -56,7 +31,7 @@ BEGIN { # This version should match the corresponding rra-c-util release, but with # two digits for the minor version, including a leading zero if necessary, # so that it will sort properly. - $VERSION = '5.05'; + $VERSION = '5.10'; } # Skip this test unless author tests are requested. Takes a short description @@ -153,7 +128,7 @@ __END__ =for stopwords Allbery Allbery's DESC bareword sublicense MERCHANTABILITY NONINFRINGEMENT -rra-c-util +rra-c-util CPAN =head1 NAME @@ -176,46 +151,45 @@ Test::RRA - Support functions for Perl tests =head1 DESCRIPTION -This module collects utility functions that are useful for Perl test -scripts. It assumes Russ Allbery's Perl module layout and test -conventions and will only be useful for other people if they use the -same conventions. +This module collects utility functions that are useful for Perl test scripts. +It assumes Russ Allbery's Perl module layout and test conventions and will +only be useful for other people if they use the same conventions. =head1 FUNCTIONS -None of these functions are imported by default. The ones used by a -script should be explicitly imported. +None of these functions are imported by default. The ones used by a script +should be explicitly imported. =over 4 =item skip_unless_author(DESC) -Checks whether AUTHOR_TESTING is set in the environment and skips the -whole test (by calling C from Test::More) if it is not. -DESC is a description of the tests being skipped. A space and C will be appended to it and used as the skip reason. +Checks whether AUTHOR_TESTING is set in the environment and skips the whole +test (by calling C from Test::More) if it is not. DESC is a +description of the tests being skipped. A space and C +will be appended to it and used as the skip reason. =item skip_unless_automated(DESC) -Checks whether AUTHOR_TESTING, AUTOMATED_TESTING, or RELEASE_TESTING are -set in the environment and skips the whole test (by calling C from Test::More) if they are not. This should be used by tests -that should not run during end-user installs of the module, but which -should run as part of CPAN smoke testing and release testing. +Checks whether AUTHOR_TESTING, AUTOMATED_TESTING, or RELEASE_TESTING are set +in the environment and skips the whole test (by calling C from +Test::More) if they are not. This should be used by tests that should not run +during end-user installs of the module, but which should run as part of CPAN +smoke testing and release testing. DESC is a description of the tests being skipped. A space and C will be appended to it and used as the skip reason. =item use_prereq(MODULE[, VERSION][, IMPORT ...]) -Attempts to load MODULE with the given VERSION and import arguments. If -this fails for any reason, the test will be skipped (by calling C from Test::More) with a skip reason saying that MODULE is -required for the test. +Attempts to load MODULE with the given VERSION and import arguments. If this +fails for any reason, the test will be skipped (by calling C +from Test::More) with a skip reason saying that MODULE is required for the +test. VERSION will be passed to C as a version bareword if it looks like a -version number. The remaining IMPORT arguments will be passed as the -value of an array. +version number. The remaining IMPORT arguments will be passed as the value of +an array. =back @@ -228,33 +202,33 @@ Russ Allbery 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: +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 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. +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. =head1 SEE ALSO Test::More(3), Test::RRA::Automake(3), Test::RRA::Config(3) -This module is maintained in the rra-c-util package. The current version -is available from L. +This module is maintained in the rra-c-util package. The current version is +available from L. -The functions to control when tests are run use environment variables -defined by the L. =cut diff --git a/tests/tap/perl/Test/RRA/Automake.pm b/tests/tap/perl/Test/RRA/Automake.pm index a064ed9..79e825c 100644 --- a/tests/tap/perl/Test/RRA/Automake.pm +++ b/tests/tap/perl/Test/RRA/Automake.pm @@ -9,31 +9,6 @@ # # All the functions here assume that BUILD and SOURCE are set in the # environment. This is normally done via the C TAP Harness runtests wrapper. -# -# The canonical version of this file is maintained in the rra-c-util package, -# which can be found at . -# -# Written by Russ Allbery -# Copyright 2013 -# 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. package Test::RRA::Automake; @@ -87,7 +62,7 @@ BEGIN { # This version should match the corresponding rra-c-util release, but with # two digits for the minor version, including a leading zero if necessary, # so that it will sort properly. - $VERSION = '5.05'; + $VERSION = '5.10'; } # Perl directories to skip globally for perl_dirs. We ignore the perl @@ -126,7 +101,15 @@ sub automake_setup { my ($vol, $dirs) = File::Spec->splitpath($start, 1); my @dirs = File::Spec->splitdir($dirs); pop(@dirs); - if ($dirs[-1] eq File::Spec->updir) { + + # Simplify relative paths at the end of the directory. + my $ups = 0; + my $i = $#dirs; + while ($i > 2 && $dirs[$i] eq File::Spec->updir) { + $ups++; + $i--; + } + for (1 .. $ups) { pop(@dirs); pop(@dirs); } @@ -196,7 +179,7 @@ sub perl_dirs { # Build the list of top-level directories to test. opendir(my $rootdir, q{.}) or BAIL_OUT("cannot open .: $!"); - my @dirs = grep { -d $_ && !$skip{$_} } readdir($rootdir); + my @dirs = grep { -d && !$skip{$_} } readdir($rootdir); closedir($rootdir); @dirs = File::Spec->no_upwards(@dirs); @@ -288,8 +271,8 @@ END { __END__ =for stopwords -Allbery Automake Automake-aware Automake-based rra-c-util ARGS -subdirectories sublicense MERCHANTABILITY NONINFRINGEMENT umask +Allbery Automake Automake-aware Automake-based rra-c-util ARGS subdirectories +sublicense MERCHANTABILITY NONINFRINGEMENT umask =head1 NAME @@ -309,75 +292,71 @@ Test::RRA::Automake - Automake-aware support functions for Perl tests =head1 DESCRIPTION This module collects utility functions that are useful for test scripts -written in Perl and included in a C Automake-based package. They assume -the layout of a package that uses rra-c-util and C TAP Harness for the -test structure. +written in Perl and included in a C Automake-based package. They assume the +layout of a package that uses rra-c-util and C TAP Harness for the test +structure. Loading this module will also add the directories C and -C to the Perl library search path, relative to BUILD if -that environment variable is set. This is harmless for C Automake -projects that don't contain an embedded Perl module, and for those -projects that do, this will allow subsequent C calls to find modules -that are built as part of the package build process. +C to the Perl library search path, relative to BUILD if that +environment variable is set. This is harmless for C Automake projects that +don't contain an embedded Perl module, and for those projects that do, this +will allow subsequent C calls to find modules that are built as part of +the package build process. The automake_setup() function should be called before calling any other functions provided by this module. =head1 FUNCTIONS -None of these functions are imported by default. The ones used by a -script should be explicitly imported. On failure, all of these functions -call BAIL_OUT (from Test::More). +None of these functions are imported by default. The ones used by a script +should be explicitly imported. On failure, all of these functions call +BAIL_OUT (from Test::More). =over 4 =item automake_setup([ARGS]) -Verifies that the BUILD and SOURCE environment variables are set and -then changes directory to the top of the source tree (which is one -directory up from the SOURCE path, since SOURCE points to the top of -the tests directory). +Verifies that the BUILD and SOURCE environment variables are set and then +changes directory to the top of the source tree (which is one directory up +from the SOURCE path, since SOURCE points to the top of the tests directory). -If ARGS is given, it should be a reference to a hash of configuration -options. Only one option is supported: C. If it is set -to a true value, automake_setup() changes directories to the top of -the build tree instead. +If ARGS is given, it should be a reference to a hash of configuration options. +Only one option is supported: C. If it is set to a true value, +automake_setup() changes directories to the top of the build tree instead. =item perl_dirs([ARGS]) Returns a list of directories that may contain Perl scripts that should be -tested by test scripts that test all Perl in the source tree (such as -syntax or coding style checks). The paths will be simple directory names -relative to the current directory or two-part directory names under the -F directory. (Directories under F are broken out separately -since it's common to want to apply different policies to different -subdirectories of F.) - -If ARGS is given, it should be a reference to a hash of configuration -options. Only one option is supported: C, whose value should be a -reference to an array of additional top-level directories or directories -starting with C that should be skipped. +tested by test scripts that test all Perl in the source tree (such as syntax +or coding style checks). The paths will be simple directory names relative to +the current directory or two-part directory names under the F +directory. (Directories under F are broken out separately since it's +common to want to apply different policies to different subdirectories of +F.) + +If ARGS is given, it should be a reference to a hash of configuration options. +Only one option is supported: C, whose value should be a reference to an +array of additional top-level directories or directories starting with +C that should be skipped. =item test_file_path(FILE) -Given FILE, which should be a relative path, locates that file relative to -the test directory in either the source or build tree. FILE will be -checked for relative to the environment variable BUILD first, and then -relative to SOURCE. test_file_path() returns the full path to FILE or -calls BAIL_OUT if FILE could not be found. +Given FILE, which should be a relative path, locates that file relative to the +test directory in either the source or build tree. FILE will be checked for +relative to the environment variable BUILD first, and then relative to SOURCE. +test_file_path() returns the full path to FILE or calls BAIL_OUT if FILE could +not be found. =item test_tmpdir() -Create a temporary directory for tests to use for transient files and -return the path to that directory. The directory is created relative to -the BUILD environment variable, which must be set. Permissions on the -directory are set using the current umask. test_tmpdir() returns the full -path to the temporary directory or calls BAIL_OUT if it could not be -created. +Create a temporary directory for tests to use for transient files and return +the path to that directory. The directory is created relative to the BUILD +environment variable, which must be set. Permissions on the directory are set +using the current umask. test_tmpdir() returns the full path to the temporary +directory or calls BAIL_OUT if it could not be created. -The directory is automatically removed if possible on program exit. -Failure to remove the directory on exit is reported with diag() and -otherwise ignored. +The directory is automatically removed if possible on program exit. Failure +to remove the directory on exit is reported with diag() and otherwise ignored. =back @@ -387,35 +366,36 @@ Russ Allbery =head1 COPYRIGHT AND LICENSE -Copyright 2013 The Board of Trustees of the Leland Stanford Junior -University +Copyright 2014, 2015 Russ Allbery + +Copyright 2013 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: +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 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. +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. =head1 SEE ALSO Test::More(3), Test::RRA(3), Test::RRA::Config(3) +This module is maintained in the rra-c-util package. The current version is +available from L. + The C TAP Harness test driver and libraries for TAP-based C testing are available from L. -This module is maintained in the rra-c-util package. The current version -is available from L. - =cut diff --git a/tests/tap/perl/Test/RRA/Config.pm b/tests/tap/perl/Test/RRA/Config.pm index 3e77650..a5b0d0d 100644 --- a/tests/tap/perl/Test/RRA/Config.pm +++ b/tests/tap/perl/Test/RRA/Config.pm @@ -4,9 +4,6 @@ # configuration file to store some package-specific data. This module loads # that configuration and provides the namespace for the configuration # settings. -# -# The canonical version of this file is maintained in the rra-c-util package, -# which can be found at . package Test::RRA::Config; @@ -30,22 +27,23 @@ BEGIN { @ISA = qw(Exporter); @EXPORT_OK = qw( $COVERAGE_LEVEL @COVERAGE_SKIP_TESTS @CRITIC_IGNORE $LIBRARY_PATH - $MINIMUM_VERSION %MINIMUM_VERSION @POD_COVERAGE_EXCLUDE @STRICT_IGNORE - @STRICT_PREREQ + $MINIMUM_VERSION %MINIMUM_VERSION @MODULE_VERSION_IGNORE + @POD_COVERAGE_EXCLUDE @STRICT_IGNORE @STRICT_PREREQ ); # This version should match the corresponding rra-c-util release, but with # two digits for the minor version, including a leading zero if necessary, # so that it will sort properly. - $VERSION = '5.05'; + $VERSION = '5.10'; } # If BUILD or SOURCE are set in the environment, look for data/perl.conf under # those paths for a C Automake package. Otherwise, look in t/data/perl.conf -# for a standalone Perl module. Don't use Test::RRA::Automake since it may -# not exist. +# for a standalone Perl module or tests/data/perl.conf for Perl tests embedded +# in a larger distribution. Don't use Test::RRA::Automake since it may not +# exist. our $PATH; -for my $base ($ENV{BUILD}, $ENV{SOURCE}, 't') { +for my $base ($ENV{BUILD}, $ENV{SOURCE}, 't', 'tests') { next if !defined($base); my $path = "$base/data/perl.conf"; if (-r $path) { @@ -64,6 +62,7 @@ our @CRITIC_IGNORE; our $LIBRARY_PATH; our $MINIMUM_VERSION = '5.008'; our %MINIMUM_VERSION; +our @MODULE_VERSION_IGNORE; our @POD_COVERAGE_EXCLUDE; our @STRICT_IGNORE; our @STRICT_PREREQ; @@ -78,8 +77,8 @@ if (!do($PATH)) { __END__ =for stopwords -Allbery rra-c-util Automake perlcritic .libs namespace subdirectory -sublicense MERCHANTABILITY NONINFRINGEMENT +Allbery rra-c-util Automake perlcritic .libs namespace subdirectory sublicense +MERCHANTABILITY NONINFRINGEMENT regexes =head1 NAME @@ -92,19 +91,17 @@ Test::RRA::Config - Perl test configuration =head1 DESCRIPTION -Test::RRA::Config encapsulates per-package configuration for generic Perl -test programs that are shared between multiple packages using the -rra-c-util infrastructure. It handles locating and loading the test -configuration file for both C Automake packages and stand-alone Perl -modules. +Test::RRA::Config encapsulates per-package configuration for generic Perl test +programs that are shared between multiple packages using the rra-c-util +infrastructure. It handles locating and loading the test configuration file +for both C Automake packages and stand-alone Perl modules. Test::RRA::Config looks for a file named F relative to the -root of the test directory. That root is taken from the environment -variables BUILD or SOURCE (in that order) if set, which will be the case -for C Automake packages using C TAP Harness. If neither is set, it -expects the root of the test directory to be a directory named F -relative to the current directory, which will be the case for stand-alone -Perl modules. +root of the test directory. That root is taken from the environment variables +BUILD or SOURCE (in that order) if set, which will be the case for C Automake +packages using C TAP Harness. If neither is set, it expects the root of the +test directory to be a directory named F relative to the current directory, +which will be the case for stand-alone Perl modules. The following variables are supported: @@ -112,70 +109,75 @@ The following variables are supported: =item $COVERAGE_LEVEL -The coverage level achieved by the test suite for Perl test coverage -testing using Test::Strict, as a percentage. The test will fail if test -coverage less than this percentage is achieved. If not given, defaults -to 100. +The coverage level achieved by the test suite for Perl test coverage testing +using Test::Strict, as a percentage. The test will fail if test coverage less +than this percentage is achieved. If not given, defaults to 100. =item @COVERAGE_SKIP_TESTS Directories under F whose tests should be skipped when doing coverage -testing. This can be tests that won't contribute to coverage or tests -that don't run properly under Devel::Cover for some reason (such as ones -that use taint checking). F and F