From 1575d5c34a2c6235bbf6a5010f8a8c142fe47079 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Fri, 11 Jul 2014 21:39:23 -0700 Subject: Switch to Module::Build for the Perl module The wallet server now requires Perl 5.8 or later (instead of 5.006 in previous versions) and is now built with Module::Build instead of ExtUtils::MakeMaker. This should be transparent to anyone not working with the source code, since Perl 5.8 was released in 2002, but Module::Build is now required to build the wallet server. It is included in some versions of Perl, or can be installed separately from CPAN, distribution packages, or other sources. Also reorganize the test suite to use subdirectories. Change-Id: Id06120ba2bad1ebbfee3d8a48ca2f25869463165 Reviewed-on: https://gerrit.stanford.edu/1530 Reviewed-by: Russ Allbery Tested-by: Russ Allbery --- perl/lib/Wallet/ACL.pm | 657 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 657 insertions(+) create mode 100644 perl/lib/Wallet/ACL.pm (limited to 'perl/lib/Wallet/ACL.pm') diff --git a/perl/lib/Wallet/ACL.pm b/perl/lib/Wallet/ACL.pm new file mode 100644 index 0000000..808be3c --- /dev/null +++ b/perl/lib/Wallet/ACL.pm @@ -0,0 +1,657 @@ +# Wallet::ACL -- Implementation of ACLs in the wallet system. +# +# Written by Russ Allbery +# Copyright 2007, 2008, 2010, 2013 +# The Board of Trustees of the Leland Stanford Junior University +# +# See LICENSE for licensing terms. + +############################################################################## +# Modules and declarations +############################################################################## + +package Wallet::ACL; +require 5.006; + +use strict; +use vars qw($VERSION); + +use DBI; +use POSIX qw(strftime); + +# This version should be increased on any code change to this module. Always +# use two digits for the minor version with a leading zero if necessary so +# that it will sort properly. +$VERSION = '0.07'; + +############################################################################## +# Constructors +############################################################################## + +# Initialize a new ACL from the database. Verify that the ACL already exists +# in the database and, if so, return a new blessed object. Stores the ACL ID +# and the database handle to use for future operations. If the object +# doesn't exist, throws an exception. +sub new { + my ($class, $id, $schema) = @_; + my (%search, $data, $name); + if ($id =~ /^\d+\z/) { + $search{ac_id} = $id; + } else { + $search{ac_name} = $id; + } + eval { + $data = $schema->resultset('Acl')->find (\%search); + }; + if ($@) { + die "cannot search for ACL $id: $@\n"; + } elsif (not defined $data) { + die "ACL $id not found\n"; + } + my $self = { + schema => $schema, + id => $data->ac_id, + name => $data->ac_name, + }; + bless ($self, $class); + return $self; +} + +# Create a new ACL in the database with the given name and return a new +# blessed ACL object for it. Stores the database handle to use and the ID of +# the newly created ACL in the object. On failure, throws an exception. +sub create { + my ($class, $name, $schema, $user, $host, $time) = @_; + if ($name =~ /^\d+\z/) { + die "ACL name may not be all numbers\n"; + } + $time ||= time; + my $id; + eval { + my $guard = $schema->txn_scope_guard; + + # Create the new record. + my %record = (ac_name => $name); + my $acl = $schema->resultset('Acl')->create (\%record); + $id = $acl->ac_id; + die "unable to retrieve new ACL ID" unless defined $id; + + # Add to the history table. + my $date = strftime ('%Y-%m-%d %T', localtime $time); + %record = (ah_acl => $id, + ah_action => 'create', + ah_by => $user, + ah_from => $host, + ah_on => $date); + my $history = $schema->resultset('AclHistory')->create (\%record); + die "unable to create new history entry" unless defined $history; + + $guard->commit; + }; + if ($@) { + die "cannot create ACL $name: $@\n"; + } + my $self = { + schema => $schema, + id => $id, + name => $name, + }; + bless ($self, $class); + return $self; +} + +############################################################################## +# Utility functions +############################################################################## + +# Set or return the error stashed in the object. +sub error { + my ($self, @error) = @_; + if (@error) { + my $error = join ('', @error); + chomp $error; + 1 while ($error =~ s/ at \S+ line \d+\.?\z//); + $self->{error} = $error; + } + return $self->{error}; +} + +# Returns the ID of an ACL. +sub id { + my ($self) = @_; + return $self->{id}; +} + +# Returns the name of the ACL. +sub name { + my ($self)= @_; + return $self->{name}; +} + +# Given an ACL scheme, return the mapping to a class by querying the +# database, or undef if no mapping exists. Also load the relevant module. +sub scheme_mapping { + my ($self, $scheme) = @_; + my $class; + eval { + my %search = (as_name => $scheme); + my $scheme_rec = $self->{schema}->resultset('AclScheme') + ->find (\%search); + $class = $scheme_rec->as_class; + }; + if ($@) { + $self->error ($@); + return; + } + if (defined $class) { + eval "require $class"; + if ($@) { + $self->error ($@); + return; + } + } + return $class; +} + +# Record a change to an ACL. Takes the type of change, the scheme and +# identifier of the entry, and the trace information (user, host, and time). +# This function does not commit and does not catch exceptions. It should +# normally be called as part of a larger transaction that implements the +# change and should be committed with that change. +sub log_acl { + my ($self, $action, $scheme, $identifier, $user, $host, $time) = @_; + unless ($action =~ /^(add|remove)\z/) { + die "invalid history action $action"; + } + my %record = (ah_acl => $self->{id}, + ah_action => $action, + ah_scheme => $scheme, + ah_identifier => $identifier, + ah_by => $user, + ah_from => $host, + ah_on => strftime ('%Y-%m-%d %T', localtime $time)); + $self->{schema}->resultset('AclHistory')->create (\%record); +} + +############################################################################## +# ACL manipulation +############################################################################## + +# Changes the human-readable name of the ACL. Note that this operation is not +# logged since it isn't a change to any of the data stored in the wallet. +# Returns true on success, false on failure. +sub rename { + my ($self, $name) = @_; + if ($name =~ /^\d+\z/) { + $self->error ("ACL name may not be all numbers"); + return; + } + eval { + my $guard = $self->{schema}->txn_scope_guard; + my %search = (ac_id => $self->{id}); + my $acls = $self->{schema}->resultset('Acl')->find (\%search); + $acls->ac_name ($name); + $acls->update; + $guard->commit; + }; + if ($@) { + $self->error ("cannot rename ACL $self->{id} to $name: $@"); + return; + } + $self->{name} = $name; + return 1; +} + +# Destroy the ACL, deleting it out of the database. Returns true on success, +# false on failure. +# +# Checks to ensure that the ACL is not referenced anywhere in the database, +# since we may not have referential integrity enforcement. It's not clear +# that this is the right place to do this; it's a bit of an abstraction +# violation, since it's a query against the object table. +sub destroy { + my ($self, $user, $host, $time) = @_; + $time ||= time; + eval { + my $guard = $self->{schema}->txn_scope_guard; + + # Make certain no one is using the ACL. + my @search = ({ ob_owner => $self->{id} }, + { ob_acl_get => $self->{id} }, + { ob_acl_store => $self->{id} }, + { ob_acl_show => $self->{id} }, + { ob_acl_destroy => $self->{id} }, + { ob_acl_flags => $self->{id} }); + my @entries = $self->{schema}->resultset('Object')->search (\@search); + if (@entries) { + my ($entry) = @entries; + die "ACL in use by ".$entry->ob_type.":".$entry->ob_name; + } + + # Delete any entries (there may or may not be any). + my %search = (ae_id => $self->{id}); + @entries = $self->{schema}->resultset('AclEntry')->search(\%search); + for my $entry (@entries) { + $entry->delete; + } + + # There should definitely be an ACL record to delete. + %search = (ac_id => $self->{id}); + my $entry = $self->{schema}->resultset('Acl')->find(\%search); + $entry->delete if defined $entry; + + # Create new history line for the deletion. + my %record = (ah_acl => $self->{id}, + ah_action => 'destroy', + ah_by => $user, + ah_from => $host, + ah_on => strftime ('%Y-%m-%d %T', localtime $time)); + $self->{schema}->resultset('AclHistory')->create (\%record); + $guard->commit; + }; + if ($@) { + $self->error ("cannot destroy ACL $self->{id}: $@"); + return; + } + return 1; +} + +############################################################################## +# ACL entry manipulation +############################################################################## + +# Add an ACL entry to this ACL. Returns true on success and false on failure. +sub add { + my ($self, $scheme, $identifier, $user, $host, $time) = @_; + $time ||= time; + unless ($self->scheme_mapping ($scheme)) { + $self->error ("unknown ACL scheme $scheme"); + return; + } + eval { + my $guard = $self->{schema}->txn_scope_guard; + my %record = (ae_id => $self->{id}, + ae_scheme => $scheme, + ae_identifier => $identifier); + my $entry = $self->{schema}->resultset('AclEntry')->create (\%record); + $self->log_acl ('add', $scheme, $identifier, $user, $host, $time); + $guard->commit; + }; + if ($@) { + $self->error ("cannot add $scheme:$identifier to $self->{id}: $@"); + return; + } + return 1; +} + +# Remove an ACL entry to this ACL. Returns true on success and false on +# failure. Detect the case where no such row exists before doing the delete +# so that we can provide a good error message. +sub remove { + my ($self, $scheme, $identifier, $user, $host, $time) = @_; + $time ||= time; + eval { + my $guard = $self->{schema}->txn_scope_guard; + my %search = (ae_id => $self->{id}, + ae_scheme => $scheme, + ae_identifier => $identifier); + my $entry = $self->{schema}->resultset('AclEntry')->find (\%search); + unless (defined $entry) { + die "entry not found in ACL\n"; + } + $entry->delete; + $self->log_acl ('remove', $scheme, $identifier, $user, $host, $time); + $guard->commit; + }; + if ($@) { + my $entry = "$scheme:$identifier"; + $self->error ("cannot remove $entry from $self->{id}: $@"); + return; + } + return 1; +} + +############################################################################## +# ACL checking +############################################################################## + +# List all of the entries in an ACL. Returns an array of tuples, each of +# which contains a scheme and identifier, or an array containing undef on +# error. Sets the internal error string on error. +sub list { + my ($self) = @_; + undef $self->{error}; + my @entries; + eval { + my $guard = $self->{schema}->txn_scope_guard; + my %search = (ae_id => $self->{id}); + my @entry_recs = $self->{schema}->resultset('AclEntry') + ->search (\%search); + for my $entry (@entry_recs) { + push (@entries, [ $entry->ae_scheme, $entry->ae_identifier ]); + } + $guard->commit; + }; + if ($@) { + $self->error ("cannot retrieve ACL $self->{id}: $@"); + return; + } else { + return @entries; + } +} + +# Return as a string a human-readable description of an ACL, including its +# membership. This method is only for human-readable output; use the list() +# method if you are using the results in other code. Returns undef on +# failure. +sub show { + my ($self) = @_; + my @entries = $self->list; + if (not @entries and $self->error) { + return; + } + my $name = $self->name; + my $id = $self->id; + my $output = "Members of ACL $name (id: $id) are:\n"; + for my $entry (sort { $$a[0] cmp $$b[0] or $$a[1] cmp $$b[1] } @entries) { + my ($scheme, $identifier) = @$entry; + $output .= " $scheme $identifier\n"; + } + return $output; +} + +# Return as a string the history of an ACL. Returns undef on failure. +sub history { + my ($self) = @_; + my $output = ''; + eval { + my $guard = $self->{schema}->txn_scope_guard; + my %search = (ah_acl => $self->{id}); + my %options = (order_by => 'ah_on'); + my @data = $self->{schema}->resultset('AclHistory') + ->search (\%search, \%options); + for my $data (@data) { + $output .= sprintf ("%s %s ", $data->ah_on->ymd, + $data->ah_on->hms); + if ($data->ah_action eq 'add' || $data->ah_action eq 'remove') { + $output .= sprintf ("%s %s %s", $data->ah_action, + $data->ah_scheme, $data->ah_identifier); + } else { + $output .= $data->ah_action; + } + $output .= sprintf ("\n by %s from %s\n", $data->ah_by, + $data->ah_from); + } + $guard->commit; + }; + if ($@) { + $self->error ("cannot read history for $self->{id}: $@"); + return; + } + return $output; +} + +# Given a principal, a scheme, and an identifier, check whether that ACL +# scheme and identifier grant access to that principal. Return 1 if access +# was granted, 0 if access was deined, and undef on some error. On error, the +# error message is also added to the check_errors variable. This method is +# internal to the class. +# +# Maintain ACL verifiers for all schemes we've seen in the local %verifier +# hash so that we can optimize repeated ACL checks. +{ + my %verifier; + sub check_line { + my ($self, $principal, $scheme, $identifier) = @_; + unless ($verifier{$scheme}) { + my $class = $self->scheme_mapping ($scheme); + unless ($class) { + push (@{ $self->{check_errors} }, "unknown scheme $scheme"); + return; + } + $verifier{$scheme} = $class->new; + unless (defined $verifier{$scheme}) { + push (@{ $self->{check_errors} }, "cannot verify $scheme"); + return; + } + } + my $result = ($verifier{$scheme})->check ($principal, $identifier); + if (not defined $result) { + push (@{ $self->{check_errors} }, ($verifier{$scheme})->error); + return; + } else { + return $result; + } + } +} + +# Given a principal, check whether it should be granted access according to +# this ACL. Returns 1 if access was granted, 0 if access was denied, and +# undef on some error. Errors from ACL verifiers do not cause an error +# return, but are instead accumulated in the check_errors variable returned by +# the check_errors() method. +sub check { + my ($self, $principal) = @_; + unless ($principal) { + $self->error ('no principal specified'); + return; + } + my @entries = $self->list; + return if (not @entries and $self->error); + my %verifier; + $self->{check_errors} = []; + for my $entry (@entries) { + my ($scheme, $identifier) = @$entry; + my $result = $self->check_line ($principal, $scheme, $identifier); + return 1 if $result; + } + return 0; +} + +# Returns the errors from the last ACL verification as an array in array +# context or as a string with newlines after each error in a scalar context. +sub check_errors { + my ($self) = @_; + my @errors; + if ($self->{check_errors}) { + @errors = @{ $self->{check_errors} }; + } + return wantarray ? @errors : join ("\n", @errors, ''); +} + +1; +__END__ + +############################################################################## +# Documentation +############################################################################## + +=head1 NAME + +Wallet::ACL - Implementation of ACLs in the wallet system + +=for stopwords +ACL DBH metadata HOSTNAME DATETIME timestamp Allbery verifier verifiers + +=head1 SYNOPSIS + + my $acl = Wallet::ACL->create ('group:sysadmin'); + $acl->rename ('group:unix'); + $acl->add ('krb5', 'alice@EXAMPLE.COM', $admin, $host); + $acl->add ('krb5', 'bob@EXAMPLE.COM', $admin, $host); + if ($acl->check ($user)) { + print "Permission granted\n"; + warn scalar ($acl->check_errors) if $acl->check_errors; + } + $acl->remove ('krb5', 'bob@EXAMPLE.COM', $admin, $host); + my @entries = $acl->list; + my $summary = $acl->show; + my $history = $acl->history; + $acl->destroy ($admin, $host); + +=head1 DESCRIPTION + +Wallet::ACL implements the ACL system for the wallet: the methods to +create, find, rename, and destroy ACLs; the methods to add and remove +entries from an ACL; and the methods to list the contents of an ACL and +check a principal against it. + +An ACL is a list of zero or more ACL entries, each of which consists of a +scheme and an identifier. Each scheme is associated with a verifier +module that checks Kerberos principals against identifiers for that scheme +and returns whether the principal should be permitted access by that +identifier. The interpretation of the identifier is entirely left to the +scheme. This module maintains the ACLs and dispatches check operations to +the appropriate verifier module. + +Each ACL is identified by a human-readable name and a persistent unique +numeric identifier. The numeric identifier (ID) should be used to refer +to the ACL so that it can be renamed as needed without breaking external +references. + +=head1 CLASS METHODS + +=over 4 + +=item new(ACL, SCHEMA) + +Instantiate a new ACL object with the given ACL ID or name. Takes the +Wallet::Schema object to use for retrieving metadata from the wallet +database. Returns a new ACL object if the ACL was found and throws an +exception if it wasn't or on any other error. + +=item create(NAME, SCHEMA, PRINCIPAL, HOSTNAME [, DATETIME]) + +Similar to new() in that it instantiates a new ACL object, but instead of +finding an existing one, creates a new ACL record in the database with the +given NAME. NAME must not be all-numeric, since that would conflict with +the automatically assigned IDs. Returns the new object on success and +throws an exception on failure. PRINCIPAL, HOSTNAME, and DATETIME are +stored as history information. PRINCIPAL should be the user who is +creating the ACL. If DATETIME isn't given, the current time is used. + +=back + +=head1 INSTANCE METHODS + +=over 4 + +=item add(SCHEME, INSTANCE, PRINCIPAL, HOSTNAME [, DATETIME]) + +Add the given ACL entry (given by SCHEME and INSTANCE) to this ACL. +Returns true on success and false on failure. On failure, the caller +should call error() to get the error message. PRINCIPAL, HOSTNAME, and +DATETIME are stored as history information. PRINCIPAL should be the user +who is adding the ACL entry. If DATETIME isn't given, the current time is +used. + +=item check(PRINCIPAL) + +Checks whether the given PRINCIPAL should be allowed access given ACL. +Returns 1 if access was granted, 0 if access is declined, and undef on +error. On error, the caller should call error() to get the error text. +Any errors found by the individual ACL verifiers can be retrieved by +calling check_errors(). Errors from individual ACL verifiers will not +result in an error return from check(); instead, the check will continue +with the next entry in the ACL. + +check() returns success as soon as an entry in the ACL grants access to +PRINCIPAL. There is no provision for negative ACLs or exceptions. + +=item check_errors() + +Return (as a list in array context and a string with newlines between +errors and at the end of the last error in scalar context) the errors, if +any, returned by ACL verifiers for the last check operation. If there +were no errors from the last check() operation, returns the empty list in +array context and undef in scalar context. + +=item destroy(PRINCIPAL, HOSTNAME [, DATETIME]) + +Destroys this ACL from the database. Note that this will fail if the ACL +is still referenced by any object; the ACL must be removed from all +objects first. Returns true on success and false on failure. On failure, +the caller should call error() to get the error message. PRINCIPAL, +HOSTNAME, and DATETIME are stored as history information. PRINCIPAL +should be the user who is destroying the ACL. If DATETIME isn't given, +the current time is used. + +=item error() + +Returns the error of the last failing operation or undef if no operations +have failed. Callers should call this function to get the error message +after an undef return from any other instance method. + +=item history() + +Returns the human-readable history of this ACL. Each action that changes +the ACL (not including changes to the name of the ACL) will be represented +by two lines. The first line will have a timestamp of the change followed +by a description of the change, and the second line will give the user who +made the change and the host from which the change was made. On failure, +returns undef, and the caller should call error() to get the error +message. + +=item id() + +Returns the numeric system-generated ID of this ACL. + +=item list() + +Returns all the entries of this ACL. The return value will be a list of +references to pairs of scheme and identifier. For example, for an ACL +containing two entries, both of scheme C and with values +C and C, list() would return: + + ([ 'krb5', 'alice@EXAMPLE.COM' ], [ 'krb5', 'bob@EXAMPLE.COM' ]) + +Returns the empty list on failure. To distinguish between this and the +ACL containing no entries, the caller should call error(). error() is +guaranteed to return the error message if there was an error and undef if +there was no error. + +=item name() + +Returns the human-readable name of this ACL. + +=item remove(SCHEME, INSTANCE, PRINCIPAL, HOSTNAME [, DATETIME]) + +Remove the given ACL line (given by SCHEME and INSTANCE) from this ACL. +Returns true on success and false on failure. On failure, the caller +should call error() to get the error message. PRINCIPAL, HOSTNAME, and +DATETIME are stored as history information. PRINCIPAL should be the user +who is removing the ACL entry. If DATETIME isn't given, the current time +is used. + +=item rename(NAME) + +Rename this ACL. This changes the name used for human convenience but not +the system-generated ACL ID that is used to reference this ACL. The new +NAME must not be all-numeric, since that would conflict with +system-generated ACL IDs. Returns true on success and false on failure. +On failure, the caller should call error() to get the error message. + +Note that rename() operations are not logged in the ACL history. + +=item show() + +Returns a human-readable description of this ACL, including its +membership. This method should only be used for display of the ACL to +humans. Use the list(), name(), and id() methods instead to get ACL +information for use in other code. On failure, returns undef, and the +caller should call error() to get the error message. + +=back + +=head1 SEE ALSO + +Wallet::ACL::Base(3), wallet-backend(8) + +This module is part of the wallet system. The current version is +available from L. + +=head1 AUTHOR + +Russ Allbery + +=cut -- cgit v1.2.3 From 1329e6db944a6fce5578b249de08a8250a920877 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Fri, 11 Jul 2014 22:36:11 -0700 Subject: Test for Perl strict and minimum version Fix strictness issues across the whole code base, and ensure that all Perl scripts enable warnings. (Hopefully enabling warnings won't cause problems for the server.) Change-Id: I4dee49f7a6bcbeeee21d74bf61a1fd26514f832c Reviewed-on: https://gerrit.stanford.edu/1532 Reviewed-by: Russ Allbery Tested-by: Russ Allbery --- Makefile.am | 8 ++-- README | 34 ++++++++++++----- contrib/wallet-summary | 33 +++++++++-------- contrib/wallet-unknown-hosts | 36 ++++++++++-------- perl/lib/Wallet/ACL.pm | 3 +- perl/lib/Wallet/ACL/Base.pm | 3 +- perl/lib/Wallet/ACL/Krb5.pm | 3 +- perl/lib/Wallet/ACL/Krb5/Regex.pm | 3 +- perl/lib/Wallet/ACL/LDAP/Attribute.pm | 3 +- perl/lib/Wallet/ACL/NetDB.pm | 3 +- perl/lib/Wallet/ACL/NetDB/Root.pm | 3 +- perl/lib/Wallet/Admin.pm | 3 +- perl/lib/Wallet/Config.pm | 1 + perl/lib/Wallet/Database.pm | 3 +- perl/lib/Wallet/Kadmin.pm | 3 +- perl/lib/Wallet/Kadmin/Heimdal.pm | 1 + perl/lib/Wallet/Kadmin/MIT.pm | 3 +- perl/lib/Wallet/Object/Base.pm | 3 +- perl/lib/Wallet/Object/Duo.pm | 1 + perl/lib/Wallet/Object/File.pm | 3 +- perl/lib/Wallet/Object/Keytab.pm | 3 +- perl/lib/Wallet/Object/WAKeyring.pm | 3 +- perl/lib/Wallet/Report.pm | 3 +- perl/lib/Wallet/Server.pm | 3 +- perl/t/data/perl.conf | 7 ++++ perl/t/general/acl.t | 5 ++- perl/t/general/admin.t | 7 +++- perl/t/general/config.t | 7 +++- perl/t/general/init.t | 5 ++- perl/t/general/report.t | 7 +++- perl/t/general/server.t | 7 +++- perl/t/lib/Util.pm | 3 +- perl/t/object/base.t | 5 ++- perl/t/object/file.t | 7 +++- perl/t/object/keytab.t | 11 ++++-- perl/t/style/minimum-version.t | 47 ++++++++++++++++++++++++ perl/t/style/strict.t | 56 ++++++++++++++++++++++++++++ perl/t/util/kadmin.t | 7 +++- perl/t/verifier/basic.t | 5 ++- perl/t/verifier/ldap-attr.t | 5 ++- perl/t/verifier/netdb.t | 7 +++- server/keytab-backend | 1 + server/wallet-backend | 1 + tests/TESTS | 2 + tests/client/full-t.in | 12 +++--- tests/client/prompt-t.in | 14 ++++--- tests/data/fake-kadmin | 7 +++- tests/perl/minimum-version-t | 69 +++++++++++++++++++++++++++++++++++ tests/perl/strict-t | 66 +++++++++++++++++++++++++++++++++ 49 files changed, 437 insertions(+), 98 deletions(-) create mode 100644 perl/t/data/perl.conf create mode 100755 perl/t/style/minimum-version.t create mode 100755 perl/t/style/strict.t create mode 100755 tests/perl/minimum-version-t create mode 100755 tests/perl/strict-t (limited to 'perl/lib/Wallet/ACL.pm') diff --git a/Makefile.am b/Makefile.am index 19dbe11..8e65151 100644 --- a/Makefile.am +++ b/Makefile.am @@ -66,6 +66,7 @@ PERL_FILES = perl/Build.PL perl/MANIFEST perl/MANIFEST.SKIP \ perl/t/general/server.t perl/t/lib/Util.pm perl/t/object/base.t \ perl/t/object/duo.t perl/t/object/file.t perl/t/object/keytab.t \ perl/t/object/wa-keyring.t perl/t/policy/stanford.t \ + perl/t/style/minimum-version.t perl/t/style/strict.t \ perl/t/util/kadmin.t perl/t/verifier/basic.t \ perl/t/verifier/ldap-attr.t perl/t/verifier/netdb.t @@ -99,9 +100,10 @@ EXTRA_DIST = .gitignore LICENSE autogen client/wallet.pod \ tests/data/fake-keytab-partial-result tests/data/fake-keytab-rekey \ tests/data/fake-keytab-unknown tests/data/fake-srvtab \ tests/data/full.conf tests/data/perl.conf tests/data/wallet.conf \ - tests/docs/pod-spelling-t tests/docs/pod-t tests/server/admin-t \ - tests/server/backend-t tests/server/keytab-t tests/server/report-t \ - tests/tap/kerberos.sh tests/tap/libtap.sh \ + tests/docs/pod-spelling-t tests/docs/pod-t \ + tests/perl/minimum-version-t tests/perl/strict-t \ + tests/server/admin-t tests/server/backend-t tests/server/keytab-t \ + tests/server/report-t tests/tap/kerberos.sh tests/tap/libtap.sh \ tests/tap/perl/Test/RRA.pm tests/tap/perl/Test/RRA/Automake.pm \ tests/tap/perl/Test/RRA/Config.pm tests/tap/remctl.sh \ tests/util/xmalloc-t $(PERL_FILES) diff --git a/README b/README index e72bc80..ef910bd 100644 --- a/README +++ b/README @@ -118,16 +118,30 @@ REQUIREMENTS server. To run the full test suite, all of the above software requirements must - be met. Tests requiring some bit of software that's not installed - should be skipped, but not all the permutations have been checked. The - full test suite also requires the Test::Pod Perl module (available from - CPAN), that remctld be installed and available on the user's path or in - /usr/local/sbin or /usr/sbin, that sqlite3 be installed and available on - the user's path, that test cases can run services on and connect to port - 14373 on 127.0.0.1, and that kinit and either kvno or kgetcred (which - come with Kerberos) be installed and available on the user's path. The - full test suite also requires a local keytab and some additional - configuration. + be met. The full test suite also requires that remctld be installed and + available on the user's path or in /usr/local/sbin or /usr/sbin, that + sqlite3 be installed and available on the user's path, that test cases + can run services on and connect to port 14373 on 127.0.0.1, and that + kinit and either kvno or kgetcred (which come with Kerberos) be + installed and available on the user's path. The full test suite also + requires a local keytab and some additional configuration. + + The following additional Perl modules will be used if present: + + Test::MinimumVersion + Test::Pod + Test::Spelling + Test::Strict + + All are available on CPAN. Those tests will be skipped if the modules + are not available. + + To enable tests that don't detect functionality problems but are used to + sanity-check the release, set the environment variable RELEASE_TESTING + to a true value. To enable tests that may be sensitive to the local + environment or that produce a lot of false positives without uncovering + many problems, set the environment variable AUTHOR_TESTING to a true + value. To bootstrap from a Git checkout, or if you change the Automake files and need to regenerate Makefile.in, you will need Automake 1.11 or diff --git a/contrib/wallet-summary b/contrib/wallet-summary index 55501ad..5cbf6e0 100755 --- a/contrib/wallet-summary +++ b/contrib/wallet-summary @@ -1,7 +1,22 @@ -#!/usr/bin/perl -w +#!/usr/bin/perl # # Summarize keytabs in the wallet database. +############################################################################## +# Modules and declarations +############################################################################## + +require 5.005; + +use strict; +use vars qw($ADDRESS $DUMPFILE @PATTERNS $REPORTS); +use warnings; + +use Getopt::Long qw(GetOptions); +use File::Path qw(mkpath); +use POSIX qw(strftime); +use Wallet::Report (); + ############################################################################## # Site configuration ############################################################################## @@ -29,20 +44,6 @@ $ADDRESS = 'nobody@example.com'; [qr(^webauth/), 'webauth/*', 'WebAuth v3'], [qr(^service/), 'service/*', 'Service principals']); -############################################################################## -# Modules and declarations -############################################################################## - -require 5.005; - -use strict; -use vars qw($ADDRESS $DUMPFILE @PATTERNS $REPORTS); - -use Getopt::Long qw(GetOptions); -use File::Path qw(mkpath); -use POSIX qw(strftime); -use Wallet::Report (); - ############################################################################## # Database queries ############################################################################## @@ -145,7 +146,7 @@ if ($mail) { } # Run the report. -my @principals = read_dump; +my @principals = read_dump (); report_principals (@principals); # If -m was given, take the saved report and mail it as well. diff --git a/contrib/wallet-unknown-hosts b/contrib/wallet-unknown-hosts index 339983d..50b5a04 100755 --- a/contrib/wallet-unknown-hosts +++ b/contrib/wallet-unknown-hosts @@ -1,7 +1,20 @@ -#!/usr/bin/perl -w +#!/usr/bin/perl # # Report host keytabs in wallet for unknown hosts. +############################################################################## +# Modules and declarations +############################################################################## + +require 5.006; + +use strict; +use warnings; + +use DB_File (); +use Wallet::Report (); +use Wallet::Server (); + ############################################################################## # Site configuration ############################################################################## @@ -22,9 +35,10 @@ our $MIN = 3; our $THRESHOLD = time - 30 * 24 * 60 * 60; # Set up a Net::DNS resolver that will be used by local_check_keytab. +my $DNS; BEGIN { use Net::DNS; - our $DNS = Net::DNS::Resolver->new; + $DNS = Net::DNS::Resolver->new; } # Pre-filter. This is called for all host-based keytabs and is the place to @@ -54,18 +68,6 @@ sub local_check_keytab { return; } -############################################################################## -# Modules and declarations -############################################################################## - -require 5.006; - -use strict; - -use DB_File (); -use Wallet::Report (); -use Wallet::Server (); - ############################################################################## # Utility functions ############################################################################## @@ -97,6 +99,7 @@ sub check_host { # Do a scan of all host-based keytabs in wallet and record those that are not # found in DNS or which should not be used according to site configuration. sub check { + my %history; tie %history, 'DB_File', $HISTORY; my @keytabs = list_keytabs; for my $keytab (@keytabs) { @@ -124,6 +127,7 @@ sub check { # list (given as a threshold time in seconds since epoch). sub report { my ($min, $threshold) = @_; + my %history; tie %history, 'DB_File', $HISTORY; for my $keytab (sort keys %history) { my ($count, $time) = split (',', $history{$keytab}); @@ -142,6 +146,7 @@ sub report { sub purge { my ($user, $min, $threshold) = @_; my $wallet = Wallet::Server->new ($user, 'localhost'); + my %history; tie %history, 'DB_File', $HISTORY; for my $keytab (sort keys %history) { my ($count, $time) = split (',', $history{$keytab}); @@ -161,7 +166,7 @@ sub purge { my $command = shift or die "Usage: $0 (check | report | purge)\n"; if ($command eq 'check') { - check; + check (); } elsif ($command eq 'report') { my ($min, $threshold) = @_; $min = $MIN unless defined ($min); @@ -170,6 +175,7 @@ if ($command eq 'check') { report ($min, $threshold); } elsif ($command eq 'purge') { my $user = $ENV{REMOTE_USER} or die "$0: REMOTE_USER must be set\n"; + my ($min, $threshold) = @_; $min = $MIN unless defined ($min); die "$0: minimum count must be at least 1\n" if $min < 1; $threshold = $THRESHOLD unless defined ($threshold); diff --git a/perl/lib/Wallet/ACL.pm b/perl/lib/Wallet/ACL.pm index 808be3c..9507c64 100644 --- a/perl/lib/Wallet/ACL.pm +++ b/perl/lib/Wallet/ACL.pm @@ -1,7 +1,7 @@ # Wallet::ACL -- Implementation of ACLs in the wallet system. # # Written by Russ Allbery -# Copyright 2007, 2008, 2010, 2013 +# Copyright 2007, 2008, 2010, 2013, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -14,6 +14,7 @@ package Wallet::ACL; require 5.006; use strict; +use warnings; use vars qw($VERSION); use DBI; diff --git a/perl/lib/Wallet/ACL/Base.pm b/perl/lib/Wallet/ACL/Base.pm index b6e4ce3..a2b07cc 100644 --- a/perl/lib/Wallet/ACL/Base.pm +++ b/perl/lib/Wallet/ACL/Base.pm @@ -1,7 +1,7 @@ # Wallet::ACL::Base -- Parent class for wallet ACL verifiers. # # Written by Russ Allbery -# Copyright 2007, 2010 +# Copyright 2007, 2010, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -14,6 +14,7 @@ package Wallet::ACL::Base; require 5.006; use strict; +use warnings; use vars qw($VERSION); # This version should be increased on any code change to this module. Always diff --git a/perl/lib/Wallet/ACL/Krb5.pm b/perl/lib/Wallet/ACL/Krb5.pm index ed0b7df..80d32bd 100644 --- a/perl/lib/Wallet/ACL/Krb5.pm +++ b/perl/lib/Wallet/ACL/Krb5.pm @@ -1,7 +1,7 @@ # Wallet::ACL::Krb5 -- Wallet Kerberos v5 principal ACL verifier. # # Written by Russ Allbery -# Copyright 2007, 2010 +# Copyright 2007, 2010, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -14,6 +14,7 @@ package Wallet::ACL::Krb5; require 5.006; use strict; +use warnings; use vars qw(@ISA $VERSION); use Wallet::ACL::Base; diff --git a/perl/lib/Wallet/ACL/Krb5/Regex.pm b/perl/lib/Wallet/ACL/Krb5/Regex.pm index 30f5527..4934cfc 100644 --- a/perl/lib/Wallet/ACL/Krb5/Regex.pm +++ b/perl/lib/Wallet/ACL/Krb5/Regex.pm @@ -1,7 +1,7 @@ # Wallet::ACL::Krb5::Regex -- Wallet Kerberos v5 principal regex ACL verifier # # Written by Russ Allbery -# Copyright 2007, 2010 +# Copyright 2007, 2010, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -14,6 +14,7 @@ package Wallet::ACL::Krb5::Regex; require 5.006; use strict; +use warnings; use vars qw(@ISA $VERSION); use Wallet::ACL::Krb5; diff --git a/perl/lib/Wallet/ACL/LDAP/Attribute.pm b/perl/lib/Wallet/ACL/LDAP/Attribute.pm index aea8a72..c27729e 100644 --- a/perl/lib/Wallet/ACL/LDAP/Attribute.pm +++ b/perl/lib/Wallet/ACL/LDAP/Attribute.pm @@ -1,7 +1,7 @@ # Wallet::ACL::LDAP::Attribute -- Wallet LDAP attribute ACL verifier. # # Written by Russ Allbery -# Copyright 2012, 2013 +# Copyright 2012, 2013, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -14,6 +14,7 @@ package Wallet::ACL::LDAP::Attribute; require 5.006; use strict; +use warnings; use vars qw(@ISA $VERSION); use Authen::SASL (); diff --git a/perl/lib/Wallet/ACL/NetDB.pm b/perl/lib/Wallet/ACL/NetDB.pm index b76d4ed..ad2164b 100644 --- a/perl/lib/Wallet/ACL/NetDB.pm +++ b/perl/lib/Wallet/ACL/NetDB.pm @@ -1,7 +1,7 @@ # Wallet::ACL::NetDB -- Wallet NetDB role ACL verifier. # # Written by Russ Allbery -# Copyright 2007, 2010 +# Copyright 2007, 2010, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -14,6 +14,7 @@ package Wallet::ACL::NetDB; require 5.006; use strict; +use warnings; use vars qw(@ISA $VERSION); use Wallet::ACL::Base; diff --git a/perl/lib/Wallet/ACL/NetDB/Root.pm b/perl/lib/Wallet/ACL/NetDB/Root.pm index 6c95c6e..34163e7 100644 --- a/perl/lib/Wallet/ACL/NetDB/Root.pm +++ b/perl/lib/Wallet/ACL/NetDB/Root.pm @@ -1,7 +1,7 @@ # Wallet::ACL::NetDB::Root -- Wallet NetDB role ACL verifier (root instances). # # Written by Russ Allbery -# Copyright 2007, 2010 +# Copyright 2007, 2010, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -14,6 +14,7 @@ package Wallet::ACL::NetDB::Root; require 5.006; use strict; +use warnings; use vars qw(@ISA $VERSION); use Wallet::ACL::NetDB; diff --git a/perl/lib/Wallet/Admin.pm b/perl/lib/Wallet/Admin.pm index 3a05284..d39c272 100644 --- a/perl/lib/Wallet/Admin.pm +++ b/perl/lib/Wallet/Admin.pm @@ -1,7 +1,7 @@ # Wallet::Admin -- Wallet system administrative interface. # # Written by Russ Allbery -# Copyright 2008, 2009, 2010, 2011, 2012, 2013 +# Copyright 2008, 2009, 2010, 2011, 2012, 2013, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -14,6 +14,7 @@ package Wallet::Admin; require 5.006; use strict; +use warnings; use vars qw($VERSION); use Wallet::ACL; diff --git a/perl/lib/Wallet/Config.pm b/perl/lib/Wallet/Config.pm index 5b0ab1c..527658c 100644 --- a/perl/lib/Wallet/Config.pm +++ b/perl/lib/Wallet/Config.pm @@ -10,6 +10,7 @@ package Wallet::Config; require 5.006; use strict; +use warnings; use vars qw($PATH $VERSION); # This version should be increased on any code change to this module. Always diff --git a/perl/lib/Wallet/Database.pm b/perl/lib/Wallet/Database.pm index 031be9e..3a4e130 100644 --- a/perl/lib/Wallet/Database.pm +++ b/perl/lib/Wallet/Database.pm @@ -6,7 +6,7 @@ # like DBIx::Class objects in the rest of the code. # # Written by Russ Allbery -# Copyright 2008, 2009, 2010, 2012, 2013 +# Copyright 2008, 2009, 2010, 2012, 2013, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -19,6 +19,7 @@ package Wallet::Database; require 5.006; use strict; +use warnings; use vars qw(@ISA $VERSION); use Wallet::Schema; diff --git a/perl/lib/Wallet/Kadmin.pm b/perl/lib/Wallet/Kadmin.pm index 4ea7920..65a5700 100644 --- a/perl/lib/Wallet/Kadmin.pm +++ b/perl/lib/Wallet/Kadmin.pm @@ -1,7 +1,7 @@ # Wallet::Kadmin -- Kerberos administration API for wallet keytab backend. # # Written by Jon Robertson -# Copyright 2009, 2010 +# Copyright 2009, 2010, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -14,6 +14,7 @@ package Wallet::Kadmin; require 5.006; use strict; +use warnings; use vars qw($VERSION); use Wallet::Config (); diff --git a/perl/lib/Wallet/Kadmin/Heimdal.pm b/perl/lib/Wallet/Kadmin/Heimdal.pm index 42de8e0..1208801 100644 --- a/perl/lib/Wallet/Kadmin/Heimdal.pm +++ b/perl/lib/Wallet/Kadmin/Heimdal.pm @@ -14,6 +14,7 @@ package Wallet::Kadmin::Heimdal; require 5.006; use strict; +use warnings; use vars qw(@ISA $VERSION); use Heimdal::Kadm5 qw(KRB5_KDB_DISALLOW_ALL_TIX); diff --git a/perl/lib/Wallet/Kadmin/MIT.pm b/perl/lib/Wallet/Kadmin/MIT.pm index 1ae01bf..ac45265 100644 --- a/perl/lib/Wallet/Kadmin/MIT.pm +++ b/perl/lib/Wallet/Kadmin/MIT.pm @@ -2,7 +2,7 @@ # # Written by Russ Allbery # Pulled into a module by Jon Robertson -# Copyright 2007, 2008, 2009, 2010 +# Copyright 2007, 2008, 2009, 2010, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -15,6 +15,7 @@ package Wallet::Kadmin::MIT; require 5.006; use strict; +use warnings; use vars qw(@ISA $VERSION); use Wallet::Config (); diff --git a/perl/lib/Wallet/Object/Base.pm b/perl/lib/Wallet/Object/Base.pm index 8debac9..a009d76 100644 --- a/perl/lib/Wallet/Object/Base.pm +++ b/perl/lib/Wallet/Object/Base.pm @@ -1,7 +1,7 @@ # Wallet::Object::Base -- Parent class for any object stored in the wallet. # # Written by Russ Allbery -# Copyright 2007, 2008, 2010, 2011 +# Copyright 2007, 2008, 2010, 2011, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -14,6 +14,7 @@ package Wallet::Object::Base; require 5.006; use strict; +use warnings; use vars qw($VERSION); use DBI; diff --git a/perl/lib/Wallet/Object/Duo.pm b/perl/lib/Wallet/Object/Duo.pm index e5773c8..e3fe2da 100644 --- a/perl/lib/Wallet/Object/Duo.pm +++ b/perl/lib/Wallet/Object/Duo.pm @@ -14,6 +14,7 @@ package Wallet::Object::Duo; require 5.006; use strict; +use warnings; use vars qw(@ISA $VERSION); use JSON; diff --git a/perl/lib/Wallet/Object/File.pm b/perl/lib/Wallet/Object/File.pm index 4afef04..1ff1288 100644 --- a/perl/lib/Wallet/Object/File.pm +++ b/perl/lib/Wallet/Object/File.pm @@ -1,7 +1,7 @@ # Wallet::Object::File -- File object implementation for the wallet. # # Written by Russ Allbery -# Copyright 2008, 2010 +# Copyright 2008, 2010, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -14,6 +14,7 @@ package Wallet::Object::File; require 5.006; use strict; +use warnings; use vars qw(@ISA $VERSION); use Digest::MD5 qw(md5_hex); diff --git a/perl/lib/Wallet/Object/Keytab.pm b/perl/lib/Wallet/Object/Keytab.pm index 24c3302..975179b 100644 --- a/perl/lib/Wallet/Object/Keytab.pm +++ b/perl/lib/Wallet/Object/Keytab.pm @@ -1,7 +1,7 @@ # Wallet::Object::Keytab -- Keytab object implementation for the wallet. # # Written by Russ Allbery -# Copyright 2007, 2008, 2009, 2010, 2013 +# Copyright 2007, 2008, 2009, 2010, 2013, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -14,6 +14,7 @@ package Wallet::Object::Keytab; require 5.006; use strict; +use warnings; use vars qw(@ISA $VERSION); use Wallet::Config (); diff --git a/perl/lib/Wallet/Object/WAKeyring.pm b/perl/lib/Wallet/Object/WAKeyring.pm index f8bd0f7..3e80300 100644 --- a/perl/lib/Wallet/Object/WAKeyring.pm +++ b/perl/lib/Wallet/Object/WAKeyring.pm @@ -1,7 +1,7 @@ # Wallet::Object::WAKeyring -- WebAuth keyring object implementation. # # Written by Russ Allbery -# Copyright 2012, 2013 +# Copyright 2012, 2013, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -14,6 +14,7 @@ package Wallet::Object::WAKeyring; require 5.006; use strict; +use warnings; use vars qw(@ISA $VERSION); use Digest::MD5 qw(md5_hex); diff --git a/perl/lib/Wallet/Report.pm b/perl/lib/Wallet/Report.pm index 1085546..bf48308 100644 --- a/perl/lib/Wallet/Report.pm +++ b/perl/lib/Wallet/Report.pm @@ -1,7 +1,7 @@ # Wallet::Report -- Wallet system reporting interface. # # Written by Russ Allbery -# Copyright 2008, 2009, 2010, 2013 +# Copyright 2008, 2009, 2010, 2013, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -14,6 +14,7 @@ package Wallet::Report; require 5.006; use strict; +use warnings; use vars qw($VERSION); use Wallet::ACL; diff --git a/perl/lib/Wallet/Server.pm b/perl/lib/Wallet/Server.pm index 3266928..2765d34 100644 --- a/perl/lib/Wallet/Server.pm +++ b/perl/lib/Wallet/Server.pm @@ -1,7 +1,7 @@ # Wallet::Server -- Wallet system server implementation. # # Written by Russ Allbery -# Copyright 2007, 2008, 2010, 2011, 2013 +# Copyright 2007, 2008, 2010, 2011, 2013, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -14,6 +14,7 @@ package Wallet::Server; require 5.006; use strict; +use warnings; use vars qw(%MAPPING $VERSION); use Wallet::ACL; diff --git a/perl/t/data/perl.conf b/perl/t/data/perl.conf new file mode 100644 index 0000000..ca05568 --- /dev/null +++ b/perl/t/data/perl.conf @@ -0,0 +1,7 @@ +# Configuration for Perl tests. -*- perl -*- + +# Default minimum version requirement. +$MINIMUM_VERSION = '5.008'; + +# File must end with this line. +1; diff --git a/perl/t/general/acl.t b/perl/t/general/acl.t index e633f46..01b4801 100755 --- a/perl/t/general/acl.t +++ b/perl/t/general/acl.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl -w +#!/usr/bin/perl # # Tests for the wallet ACL API. # @@ -8,6 +8,9 @@ # # See LICENSE for licensing terms. +use strict; +use warnings; + use POSIX qw(strftime); use Test::More tests => 101; diff --git a/perl/t/general/admin.t b/perl/t/general/admin.t index 41bc33a..7c62932 100755 --- a/perl/t/general/admin.t +++ b/perl/t/general/admin.t @@ -8,6 +8,9 @@ # # See LICENSE for licensing terms. +use strict; +use warnings; + use Test::More tests => 26; use Wallet::Admin; @@ -44,7 +47,7 @@ is ($admin->register_object ('base', 'Wallet::Object::Base'), 1, 'Registering Wallet::Object::Base works'); is ($admin->register_object ('base', 'Wallet::Object::Base'), undef, ' and cannot be registered twice'); -$server = eval { Wallet::Server->new ('admin@EXAMPLE.COM', 'localhost') }; +my $server = eval { Wallet::Server->new ('admin@EXAMPLE.COM', 'localhost') }; is ($@, '', 'Creating a server instance did not die'); is ($server->create ('base', 'service/admin'), 1, ' and creating base:service/admin succeeds'); @@ -83,7 +86,7 @@ SKIP: { is ($retval, 1, ' and performing an upgrade to 0.08 succeeds'); my $sql = "select version from dbix_class_schema_versions order by" . " version DESC"; - $version = $admin->dbh->selectall_arrayref ($sql); + my $version = $admin->dbh->selectall_arrayref ($sql); is (@$version, 2, ' and versions table has correct number of rows'); is (@{ $version->[0] }, 1, ' and correct number of columns'); is ($version->[0][0], '0.08', ' and the schema version is correct'); diff --git a/perl/t/general/config.t b/perl/t/general/config.t index 881f2bd..bc200de 100755 --- a/perl/t/general/config.t +++ b/perl/t/general/config.t @@ -1,13 +1,16 @@ -#!/usr/bin/perl -w +#!/usr/bin/perl # # Tests for the wallet server configuration. # # Written by Russ Allbery -# Copyright 2008, 2010 +# Copyright 2008, 2010, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. +use strict; +use warnings; + use Test::More tests => 6; # Silence warnings since we're not using use. diff --git a/perl/t/general/init.t b/perl/t/general/init.t index b8ec3c9..58b9a4c 100755 --- a/perl/t/general/init.t +++ b/perl/t/general/init.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl -w +#!/usr/bin/perl # # Tests for database initialization. # @@ -8,6 +8,9 @@ # # See LICENSE for licensing terms. +use strict; +use warnings; + use Test::More tests => 18; use Wallet::ACL; diff --git a/perl/t/general/report.t b/perl/t/general/report.t index 9563362..8d348ed 100755 --- a/perl/t/general/report.t +++ b/perl/t/general/report.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl -w +#!/usr/bin/perl # # Tests for the wallet reporting interface. # @@ -8,6 +8,9 @@ # # See LICENSE for licensing terms. +use strict; +use warnings; + use Test::More tests => 197; use Wallet::Admin; @@ -39,7 +42,7 @@ is ($acls[0][0], 1, ' and that is ACL ID 1'); is ($acls[0][1], 'ADMIN', ' with the right name'); # Create an object. -$server = eval { Wallet::Server->new ('admin@EXAMPLE.COM', 'localhost') }; +my $server = eval { Wallet::Server->new ('admin@EXAMPLE.COM', 'localhost') }; is ($@, '', 'Creating a server instance did not die'); is ($server->create ('base', 'service/admin'), 1, ' and creating base:service/admin succeeds'); diff --git a/perl/t/general/server.t b/perl/t/general/server.t index 9026439..0a527a5 100755 --- a/perl/t/general/server.t +++ b/perl/t/general/server.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl -w +#!/usr/bin/perl # # Tests for the wallet server API. # @@ -8,6 +8,9 @@ # # See LICENSE for licensing terms. +use strict; +use warnings; + use Test::More tests => 382; use POSIX qw(strftime); @@ -33,7 +36,7 @@ is ($@, '', 'Database initialization did not die'); is ($setup->reinitialize ($admin), 1, 'Database initialization succeeded'); # Now test the new method. -$server = eval { Wallet::Server->new (@trace) }; +my $server = eval { Wallet::Server->new (@trace) }; is ($@, '', 'Reopening with new did not die'); ok ($server->isa ('Wallet::Server'), ' and returned the right class'); my $schema = $server->schema; diff --git a/perl/t/lib/Util.pm b/perl/t/lib/Util.pm index 9e5b95e..187e483 100644 --- a/perl/t/lib/Util.pm +++ b/perl/t/lib/Util.pm @@ -1,7 +1,7 @@ # Utility class for wallet tests. # # Written by Russ Allbery -# Copyright 2007, 2008 +# Copyright 2007, 2008, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -10,6 +10,7 @@ package Util; require 5.006; use strict; +use warnings; use vars qw(@ISA @EXPORT $VERSION); use Wallet::Config; diff --git a/perl/t/object/base.t b/perl/t/object/base.t index 0432a23..11f18b7 100755 --- a/perl/t/object/base.t +++ b/perl/t/object/base.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl -w +#!/usr/bin/perl # # Tests for the basic object implementation. # @@ -8,6 +8,9 @@ # # See LICENSE for licensing terms. +use strict; +use warnings; + use POSIX qw(strftime); use Test::More tests => 137; diff --git a/perl/t/object/file.t b/perl/t/object/file.t index 0aecd9d..201f46d 100755 --- a/perl/t/object/file.t +++ b/perl/t/object/file.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl -w +#!/usr/bin/perl # # Tests for the file object implementation. # @@ -8,6 +8,9 @@ # # See LICENSE for licensing terms. +use strict; +use warnings; + use POSIX qw(strftime); use Test::More tests => 56; @@ -39,7 +42,7 @@ my $history = ''; my $date = strftime ('%Y-%m-%d %H:%M:%S', localtime $trace[2]); # Test error handling in the absence of configuration. -$object = eval { +my $object = eval { Wallet::Object::File->create ('file', 'test', $schema, @trace) }; ok (defined ($object), 'Creating a basic file object succeeds'); diff --git a/perl/t/object/keytab.t b/perl/t/object/keytab.t index 127762a..0f4a8b8 100755 --- a/perl/t/object/keytab.t +++ b/perl/t/object/keytab.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl -w +#!/usr/bin/perl # # Tests for the keytab object implementation. # @@ -8,6 +8,9 @@ # # See LICENSE for licensing terms. +use strict; +use warnings; + use POSIX qw(strftime); use Test::More tests => 141; @@ -117,7 +120,7 @@ sub enctypes { next unless /^ *\d+ /; my ($string) = /\((.*)\)\s*$/; next unless $string; - $enctype = $enctype{lc $string} || 'UNKNOWN'; + my $enctype = $enctype{lc $string} || 'UNKNOWN'; push (@enctypes, $enctype); } close KLIST; @@ -174,7 +177,7 @@ SKIP: { # Test that object creation without KEYTAB_TMP fails. undef $Wallet::Config::KEYTAB_TMP; - $object = eval { + my $object = eval { Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema, @trace) }; @@ -634,7 +637,7 @@ EOO is ("@values", "@enctypes", ' and we get back the right enctype list'); my $eshow = join ("\n" . (' ' x 17), @enctypes); $eshow =~ s/\s+\z/\n/; - $expected = <<"EOO"; + my $expected = <<"EOO"; Type: keytab Name: wallet/one Enctypes: $eshow diff --git a/perl/t/style/minimum-version.t b/perl/t/style/minimum-version.t new file mode 100755 index 0000000..e4eeafd --- /dev/null +++ b/perl/t/style/minimum-version.t @@ -0,0 +1,47 @@ +#!/usr/bin/perl +# +# Check that too-new features of Perl are not being used. +# +# The canonical version of this file is maintained in the rra-c-util package, +# which can be found at . +# +# 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. + +use 5.006; +use strict; +use warnings; + +use lib 't/lib'; + +use Test::More; +use Test::RRA qw(skip_unless_automated use_prereq); +use Test::RRA::Config qw($MINIMUM_VERSION); + +# Skip for normal user installs since this doesn't affect functionality. +skip_unless_automated('Minimum version tests'); + +# Load prerequisite modules. +use_prereq('Test::MinimumVersion'); + +# Check all files in the Perl distribution. +all_minimum_version_ok($MINIMUM_VERSION); diff --git a/perl/t/style/strict.t b/perl/t/style/strict.t new file mode 100755 index 0000000..7137b15 --- /dev/null +++ b/perl/t/style/strict.t @@ -0,0 +1,56 @@ +#!/usr/bin/perl +# +# Test Perl code for strict, warnings, and syntax. +# +# The canonical version of this file is maintained in the rra-c-util package, +# which can be found at . +# +# 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. + +use 5.006; +use strict; +use warnings; + +use lib 't/lib'; + +use File::Spec; +use Test::RRA qw(skip_unless_automated use_prereq); + +# Skip for normal user installs since this doesn't affect functionality. +skip_unless_automated('Strictness tests'); + +# Load prerequisite modules. +use_prereq('Test::Strict'); + +# Test everything in the distribution directory except the Build and +# Makefile.PL scripts generated by Module::Build. We also want to check use +# warnings. +$Test::Strict::TEST_SKIP = ['Build', 'Makefile.PL']; +$Test::Strict::TEST_WARNINGS = 1; +all_perl_files_ok(File::Spec->curdir); + +# Hack to suppress "used only once" warnings. +END { + $Test::Strict::TEST_SKIP = []; + $Test::Strict::TEST_WARNINGS = 0; +} diff --git a/perl/t/util/kadmin.t b/perl/t/util/kadmin.t index 8eabc6b..2a3d984 100755 --- a/perl/t/util/kadmin.t +++ b/perl/t/util/kadmin.t @@ -1,13 +1,16 @@ -#!/usr/bin/perl -w +#!/usr/bin/perl # # Tests for the kadmin object implementation. # # Written by Jon Robertson -# Copyright 2009, 2010, 2012, 2013 +# Copyright 2009, 2010, 2012, 2013, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. +use strict; +use warnings; + use POSIX qw(strftime); use Test::More tests => 34; diff --git a/perl/t/verifier/basic.t b/perl/t/verifier/basic.t index 5697ae6..ce44d44 100755 --- a/perl/t/verifier/basic.t +++ b/perl/t/verifier/basic.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl -w +#!/usr/bin/perl # # Tests for the basic wallet ACL verifiers. # @@ -8,6 +8,9 @@ # # See LICENSE for licensing terms. +use strict; +use warnings; + use Test::More tests => 57; use Wallet::ACL::Base; diff --git a/perl/t/verifier/ldap-attr.t b/perl/t/verifier/ldap-attr.t index d8e416b..3c132e2 100755 --- a/perl/t/verifier/ldap-attr.t +++ b/perl/t/verifier/ldap-attr.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl -w +#!/usr/bin/perl # # Tests for the LDAP attribute ACL verifier. # @@ -11,6 +11,9 @@ # # See LICENSE for licensing terms. +use strict; +use warnings; + use Test::More; use lib 't/lib'; diff --git a/perl/t/verifier/netdb.t b/perl/t/verifier/netdb.t index d8fe561..7048ef9 100755 --- a/perl/t/verifier/netdb.t +++ b/perl/t/verifier/netdb.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl -w +#!/usr/bin/perl # # Tests for the NetDB wallet ACL verifiers. # @@ -12,6 +12,9 @@ # # See LICENSE for licensing terms. +use strict; +use warnings; + use Test::More tests => 5; use Wallet::ACL::NetDB; @@ -35,7 +38,7 @@ SKIP: { $Wallet::Config::NETDB_REMCTL_HOST = $netdb; # Finally, we can test. - $verifier = eval { Wallet::ACL::NetDB->new }; + my $verifier = eval { Wallet::ACL::NetDB->new }; ok (defined $verifier, ' and now creation succeeds'); is ($@, q{}, ' with no errors'); ok ($verifier->isa ('Wallet::ACL::NetDB'), ' and returns the right class'); diff --git a/server/keytab-backend b/server/keytab-backend index cf283bb..bd5a3f9 100755 --- a/server/keytab-backend +++ b/server/keytab-backend @@ -21,6 +21,7 @@ ############################################################################## use strict; +use warnings; use Sys::Syslog qw(openlog syslog); diff --git a/server/wallet-backend b/server/wallet-backend index 0b6a3fa..a97c8ce 100755 --- a/server/wallet-backend +++ b/server/wallet-backend @@ -7,6 +7,7 @@ ############################################################################## use strict; +use warnings; use Getopt::Long qw(GetOptions); use Sys::Syslog qw(openlog syslog); diff --git a/tests/TESTS b/tests/TESTS index 807d944..d947e97 100644 --- a/tests/TESTS +++ b/tests/TESTS @@ -4,6 +4,8 @@ client/prompt client/rekey docs/pod docs/pod-spelling +perl/minimum-version +perl/strict portable/asprintf portable/mkstemp portable/setenv diff --git a/tests/client/full-t.in b/tests/client/full-t.in index 9822b37..4861723 100644 --- a/tests/client/full-t.in +++ b/tests/client/full-t.in @@ -1,4 +1,4 @@ -#!/usr/bin/perl -w +#!/usr/bin/perl # # End-to-end tests for the wallet client. # @@ -8,12 +8,14 @@ # # See LICENSE for licensing terms. +use strict; +use warnings; + # Point to our server configuration. This must be done before Wallet::Config # is loaded, and it's pulled in as a prerequisite for Wallet::Admin. BEGIN { $ENV{WALLET_CONFIG} = "$ENV{SOURCE}/data/wallet.conf" } -BEGIN { our $total = 59 } -use Test::More tests => $total; +use Test::More tests => 59; use lib "$ENV{SOURCE}/../perl/lib"; use Wallet::Admin; @@ -56,10 +58,10 @@ sub wallet { chdir "$ENV{SOURCE}" or die "Cannot chdir to $ENV{SOURCE}: $!\n"; SKIP: { - skip 'no keytab configuration', $total + skip 'no keytab configuration', 59 unless -f "$ENV{BUILD}/config/keytab"; my $remctld = '@REMCTLD@'; - skip 'remctld not found', $total unless $remctld; + skip 'remctld not found', 59 unless $remctld; # Spawn remctld and get local tickets. Don't destroy the user's Kerberos # ticket cache. diff --git a/tests/client/prompt-t.in b/tests/client/prompt-t.in index 8467411..686cc88 100644 --- a/tests/client/prompt-t.in +++ b/tests/client/prompt-t.in @@ -1,4 +1,4 @@ -#!/usr/bin/perl -w +#!/usr/bin/perl # # Password prompting tests for the wallet client. # @@ -8,8 +8,10 @@ # # See LICENSE for licensing terms. -BEGIN { our $total = 5 } -use Test::More tests => $total; +use strict; +use warnings; + +use Test::More tests => 5; use lib "$ENV{SOURCE}/../perl/lib"; use Wallet::Admin; @@ -21,12 +23,12 @@ use Util; chdir "$ENV{SOURCE}" or die "Cannot chdir to $ENV{SOURCE}: $!\n"; SKIP: { - skip 'no password configuration', $total + skip 'no password configuration', 5 unless -f "$ENV{BUILD}/config/password"; my $remctld = '@REMCTLD@'; - skip 'remctld not found', $total unless $remctld; + skip 'remctld not found', 5 unless $remctld; eval { require Expect }; - skip 'Expect module not found', $total if $@; + skip 'Expect module not found', 5 if $@; # Disable sending of wallet's output to our standard output. Do this # twice to avoid Perl warnings. diff --git a/tests/data/fake-kadmin b/tests/data/fake-kadmin index 57f9c97..ff90f88 100755 --- a/tests/data/fake-kadmin +++ b/tests/data/fake-kadmin @@ -1,13 +1,16 @@ -#!/usr/bin/perl -w +#!/usr/bin/perl # # Fake kadmin.local used to test the keytab backend. # # Written by Russ Allbery -# Copyright 2007 +# Copyright 2007, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. +use strict; +use warnings; + unless ($ARGV[0] eq '-q' && @ARGV == 2) { die "invalid arguments\n"; } diff --git a/tests/perl/minimum-version-t b/tests/perl/minimum-version-t new file mode 100755 index 0000000..8c49327 --- /dev/null +++ b/tests/perl/minimum-version-t @@ -0,0 +1,69 @@ +#!/usr/bin/perl +# +# Check that too-new features of Perl are not being used. +# +# This version of the check script supports mapping various directories to +# different version numbers. This allows a newer version of Perl to be +# required for internal tools than for public code. +# +# The canonical version of this file is maintained in the rra-c-util package, +# which can be found at . +# +# Written by Russ Allbery +# Copyright 2012, 2013, 2014 +# The Board of Trustees of the Leland Stanford Junior University +# +# Permission is hereby granted, free of charge, to any person obtaining a +# copy of this software and associated documentation files (the "Software"), +# to deal in the Software without restriction, including without limitation +# the rights to use, copy, modify, merge, publish, distribute, sublicense, +# and/or sell copies of the Software, and to permit persons to whom the +# Software is furnished to do so, subject to the following conditions: +# +# The above copyright notice and this permission notice shall be included in +# all copies or substantial portions of the Software. +# +# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL +# THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING +# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER +# DEALINGS IN THE SOFTWARE. + +use 5.006; +use strict; +use warnings; + +use lib "$ENV{SOURCE}/tap/perl"; + +use Test::More; +use Test::RRA qw(skip_unless_automated use_prereq); +use Test::RRA::Automake qw(automake_setup perl_dirs); +use Test::RRA::Config qw($MINIMUM_VERSION %MINIMUM_VERSION); + +# Skip for normal user installs since this doesn't affect functionality. +skip_unless_automated('Minimum version tests'); + +# Load prerequisite modules. +use_prereq('Test::MinimumVersion'); + +# Set up Automake testing. +automake_setup(); + +# For each exception case in %MINIMUM_VERSION, check the files that should +# have that minium version. Sort for reproducible test order. Also +# accumulate the list of directories we've already tested. +my @tested; +for my $version (sort keys %MINIMUM_VERSION) { + my $paths_ref = $MINIMUM_VERSION{$version}; + all_minimum_version_ok($version, { paths => $paths_ref, no_plan => 1 }); + push(@tested, @{$paths_ref}); +} + +# Now, check anything that's left against the default minimum version. +my @paths = perl_dirs({ skip => [@tested] }); +all_minimum_version_ok($MINIMUM_VERSION, { paths => \@paths, no_plan => 1 }); + +# Tell the TAP harness that we're done. +done_testing(); diff --git a/tests/perl/strict-t b/tests/perl/strict-t new file mode 100755 index 0000000..2df6d58 --- /dev/null +++ b/tests/perl/strict-t @@ -0,0 +1,66 @@ +#!/usr/bin/perl +# +# Check Perl scripts for strict, warnings, and syntax. +# +# Checks all Perl scripts in the tree for problems uncovered by Test::Strict. +# This includes using strict and warnings for every script and ensuring they +# all pass a syntax check. Currently, test suite coverage is not checked. +# +# The canonical version of this file is maintained in the rra-c-util package, +# which can be found at . +# +# Written by Russ Allbery +# Copyright 2012, 2013, 2014 +# The Board of Trustees of the Leland Stanford Junior University +# +# Permission is hereby granted, free of charge, to any person obtaining a +# copy of this software and associated documentation files (the "Software"), +# to deal in the Software without restriction, including without limitation +# the rights to use, copy, modify, merge, publish, distribute, sublicense, +# and/or sell copies of the Software, and to permit persons to whom the +# Software is furnished to do so, subject to the following conditions: +# +# The above copyright notice and this permission notice shall be included in +# all copies or substantial portions of the Software. +# +# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL +# THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING +# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER +# DEALINGS IN THE SOFTWARE. + +use 5.006; +use strict; +use warnings; + +use lib "$ENV{SOURCE}/tap/perl"; + +use Test::More; +use Test::RRA qw(skip_unless_automated use_prereq); +use Test::RRA::Automake qw(automake_setup perl_dirs); +use Test::RRA::Config qw(@STRICT_IGNORE @STRICT_PREREQ); + +# Skip for normal user installs since this doesn't affect functionality. +skip_unless_automated('Strictness tests'); + +# Load prerequisite modules. +use_prereq('Test::Strict'); + +# Check whether all prerequisites are available, and skip the test if any of +# them are not. +for my $module (@STRICT_PREREQ) { + use_prereq($module); +} + +# Set up Automake testing. This must be done after loading Test::Strict, +# since it wants to use FindBin to locate this script. +automake_setup(); + +# Run the actual tests. We also want to check warnings. +$Test::Strict::TEST_WARNINGS = 1; +all_perl_files_ok(perl_dirs({ skip => [@STRICT_IGNORE] })); + +# Suppress "used only once" warnings. +END { $Test::Strict::TEST_WARNINGS = 0 } -- cgit v1.2.3 From 6d7b65a912e6ea7e36d3ea5121bea2f427de453f Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 15 Jul 2014 16:50:13 -0700 Subject: Use DateTime objects in the database layer, not strings Pass in DateTime objects for the date fields in the database instead of formatted time strings. This provides better compatibility with different database engines. Document in README the need to install the DateTime::Format::* module corresponding to the DBD::* module used for the server database. Change-Id: Id25796da718d734ac96ca27ccea9045b0c80c03f Reviewed-on: https://gerrit.stanford.edu/1551 Reviewed-by: Russ Allbery Tested-by: Russ Allbery --- NEWS | 6 ++++++ README | 9 +++++---- perl/lib/Wallet/ACL.pm | 13 +++++++------ perl/lib/Wallet/Object/Base.pm | 28 ++++++++++++++-------------- 4 files changed, 32 insertions(+), 24 deletions(-) (limited to 'perl/lib/Wallet/ACL.pm') diff --git a/NEWS b/NEWS index 1594797..beddf7f 100644 --- a/NEWS +++ b/NEWS @@ -40,6 +40,12 @@ wallet 1.1 (unreleased) and an incorrect linkage in the schema for the ACL history, and add indices for the object type, name, and ACL instead. + Pass in DateTime objects for the date fields in the database instead + of formatted time strings. This provides better compatibility with + different database engines. Document in README the need to install + the DateTime::Format::* module corresponding to the DBD::* module used + for the server database. + The wallet server now requires Perl 5.8 or later (instead of 5.006 in previous versions) and is now built with Module::Build instead of ExtUtils::MakeMaker. This should be transparent to anyone not working diff --git a/README b/README index ef910bd..4c9f1d7 100644 --- a/README +++ b/README @@ -68,10 +68,11 @@ REQUIREMENTS plus Module::Build to build. It uses DBIx::Class and DBI to talk to a database, and therefore the DBIx::Class and DBI modules (and their dependencies) and a DBD module for the database it will use must be - installed. The SQL::Translator Perl module is also required for schema - deployment and database upgrades. If the wallet server is used with a - SQLite 3 database, the Perl module DateTime::Format::SQLite should also - be installed. + installed. The DateTime module is required for date handling, and the + SQL::Translator Perl module is also required for schema deployment and + database upgrades. You will also need the DateTime::Format::* module + corresponding to your DBD module (such as DateTime::Format::SQLite or + DateTime::Format::PG). Currently, the server has only been tested against SQLite 3, MySQL 5, and PostgreSQL, and prebuilt SQL files (for database upgrades) are only diff --git a/perl/lib/Wallet/ACL.pm b/perl/lib/Wallet/ACL.pm index 9507c64..57097c0 100644 --- a/perl/lib/Wallet/ACL.pm +++ b/perl/lib/Wallet/ACL.pm @@ -17,13 +17,13 @@ use strict; use warnings; use vars qw($VERSION); +use DateTime; use DBI; -use POSIX qw(strftime); # This version should be increased on any code change to this module. Always # use two digits for the minor version with a leading zero if necessary so # that it will sort properly. -$VERSION = '0.07'; +$VERSION = '0.08'; ############################################################################## # Constructors @@ -78,7 +78,7 @@ sub create { die "unable to retrieve new ACL ID" unless defined $id; # Add to the history table. - my $date = strftime ('%Y-%m-%d %T', localtime $time); + my $date = DateTime->from_epoch (epoch => $time); %record = (ah_acl => $id, ah_action => 'create', ah_by => $user, @@ -86,7 +86,6 @@ sub create { ah_on => $date); my $history = $schema->resultset('AclHistory')->create (\%record); die "unable to create new history entry" unless defined $history; - $guard->commit; }; if ($@) { @@ -164,13 +163,14 @@ sub log_acl { unless ($action =~ /^(add|remove)\z/) { die "invalid history action $action"; } + my $date = DateTime->from_epoch (epoch => $time); my %record = (ah_acl => $self->{id}, ah_action => $action, ah_scheme => $scheme, ah_identifier => $identifier, ah_by => $user, ah_from => $host, - ah_on => strftime ('%Y-%m-%d %T', localtime $time)); + ah_on => $date); $self->{schema}->resultset('AclHistory')->create (\%record); } @@ -242,11 +242,12 @@ sub destroy { $entry->delete if defined $entry; # Create new history line for the deletion. + my $date = DateTime->from_epoch (epoch => $time); my %record = (ah_acl => $self->{id}, ah_action => 'destroy', ah_by => $user, ah_from => $host, - ah_on => strftime ('%Y-%m-%d %T', localtime $time)); + ah_on => $date); $self->{schema}->resultset('AclHistory')->create (\%record); $guard->commit; }; diff --git a/perl/lib/Wallet/Object/Base.pm b/perl/lib/Wallet/Object/Base.pm index a009d76..f1b8b72 100644 --- a/perl/lib/Wallet/Object/Base.pm +++ b/perl/lib/Wallet/Object/Base.pm @@ -17,15 +17,15 @@ use strict; use warnings; use vars qw($VERSION); +use DateTime; use DBI; -use POSIX qw(strftime); use Text::Wrap qw(wrap); use Wallet::ACL; # This version should be increased on any code change to this module. Always # use two digits for the minor version with a leading zero if necessary so # that it will sort properly. -$VERSION = '0.06'; +$VERSION = '0.07'; ############################################################################## # Constructors @@ -63,22 +63,20 @@ sub create { die "invalid object name\n" unless $name; my $guard = $schema->txn_scope_guard; eval { + my $date = DateTime->from_epoch (epoch => $time); my %record = (ob_type => $type, ob_name => $name, ob_created_by => $user, ob_created_from => $host, - ob_created_on => strftime ('%Y-%m-%d %T', - localtime $time)); + ob_created_on => $date); $schema->resultset('Object')->create (\%record); - %record = (oh_type => $type, oh_name => $name, oh_action => 'create', oh_by => $user, oh_from => $host, - oh_on => strftime ('%Y-%m-%d %T', localtime $time)); + oh_on => $date); $schema->resultset('ObjectHistory')->create (\%record); - $guard->commit; }; if ($@) { @@ -139,27 +137,27 @@ sub log_action { # assume that AutoCommit is turned off. my $guard = $self->{schema}->txn_scope_guard; eval { + my $date = DateTime->from_epoch (epoch => $time); my %record = (oh_type => $self->{type}, oh_name => $self->{name}, oh_action => $action, oh_by => $user, oh_from => $host, - oh_on => strftime ('%Y-%m-%d %T', localtime $time)); + oh_on => $date); $self->{schema}->resultset('ObjectHistory')->create (\%record); + # Add in more timestamps based on the action type. my %search = (ob_type => $self->{type}, ob_name => $self->{name}); my $object = $self->{schema}->resultset('Object')->find (\%search); if ($action eq 'get') { $object->ob_downloaded_by ($user); $object->ob_downloaded_from ($host); - $object->ob_downloaded_on (strftime ('%Y-%m-%d %T', - localtime $time)); + $object->ob_downloaded_on ($date); } elsif ($action eq 'store') { $object->ob_stored_by ($user); $object->ob_stored_from ($host); - $object->ob_stored_on (strftime ('%Y-%m-%d %T', - localtime $time)); + $object->ob_stored_on ($date); } $object->update; $guard->commit; @@ -193,6 +191,7 @@ sub log_set { die "invalid history field $field"; } + my $date = DateTime->from_epoch (epoch => $time); my %record = (oh_type => $self->{type}, oh_name => $self->{name}, oh_action => 'set', @@ -202,7 +201,7 @@ sub log_set { oh_new => $new, oh_by => $user, oh_from => $host, - oh_on => strftime ('%Y-%m-%d %T', localtime $time)); + oh_on => $date); $self->{schema}->resultset('ObjectHistory')->create (\%record); } @@ -703,12 +702,13 @@ sub destroy { $self->{schema}->resultset('Object')->search (\%search)->delete; # And create a new history object for the destroy action. + my $date = DateTime->from_epoch (epoch => $time); my %record = (oh_type => $type, oh_name => $name, oh_action => 'destroy', oh_by => $user, oh_from => $host, - oh_on => strftime ('%Y-%m-%d %T', localtime $time)); + oh_on => $date); $self->{schema}->resultset('ObjectHistory')->create (\%record); $guard->commit; }; -- cgit v1.2.3 From b1bd88daea1dde6de9e6a8688c6190cdc0b5c617 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 15 Jul 2014 20:29:19 -0700 Subject: Record the ACL name in the acl_history table Store the current name of the ACL with each history row, and index the name. This will eventually allow retrieval of history by name for ACLs that have been deleted, although the rest of the code is not yet in place. The initial creation and membership of the ADMIN ACL during database initialization or reinitialization is no longer recorded in the acl_history table, since otherwise it produces errors due to the missing ah_name field when building the database with schema 0.07. There should be some better solution to this, but this will be okay for the time being. Change-Id: I015a00c972e0c2730c3d449952fcfe9b79c6e54f Reviewed-on: https://gerrit.stanford.edu/1553 Reviewed-by: Russ Allbery Tested-by: Russ Allbery --- NEWS | 5 +++++ perl/lib/Wallet/ACL.pm | 5 ++++- perl/lib/Wallet/Admin.pm | 19 ++++++++++++++----- perl/lib/Wallet/Schema/Result/AclHistory.pm | 10 ++++++++++ perl/sql/Wallet-Schema-0.08-0.09-MySQL.sql | 4 +++- perl/sql/Wallet-Schema-0.08-0.09-PostgreSQL.sql | 4 ++++ perl/sql/Wallet-Schema-0.08-0.09-SQLite.sql | 4 ++++ perl/sql/Wallet-Schema-0.09-MySQL.sql | 4 +++- perl/sql/Wallet-Schema-0.09-PostgreSQL.sql | 4 +++- perl/sql/Wallet-Schema-0.09-SQLite.sql | 5 ++++- perl/t/general/server.t | 18 ++++-------------- 11 files changed, 58 insertions(+), 24 deletions(-) (limited to 'perl/lib/Wallet/ACL.pm') diff --git a/NEWS b/NEWS index beddf7f..f6e3fdd 100644 --- a/NEWS +++ b/NEWS @@ -46,6 +46,11 @@ wallet 1.1 (unreleased) the DateTime::Format::* module corresponding to the DBD::* module used for the server database. + The initial creation and membership of the ADMIN ACL during database + initialization or reinitialization is no longer recorded in the + acl_history table. (This is fallout from making a specific type of + upgrade testable, and may be fixed in the future.) + The wallet server now requires Perl 5.8 or later (instead of 5.006 in previous versions) and is now built with Module::Build instead of ExtUtils::MakeMaker. This should be transparent to anyone not working diff --git a/perl/lib/Wallet/ACL.pm b/perl/lib/Wallet/ACL.pm index 57097c0..6f5172a 100644 --- a/perl/lib/Wallet/ACL.pm +++ b/perl/lib/Wallet/ACL.pm @@ -80,6 +80,7 @@ sub create { # Add to the history table. my $date = DateTime->from_epoch (epoch => $time); %record = (ah_acl => $id, + ah_name => $name, ah_action => 'create', ah_by => $user, ah_from => $host, @@ -165,6 +166,7 @@ sub log_acl { } my $date = DateTime->from_epoch (epoch => $time); my %record = (ah_acl => $self->{id}, + ah_name => $self->{name}, ah_action => $action, ah_scheme => $scheme, ah_identifier => $identifier, @@ -243,7 +245,8 @@ sub destroy { # Create new history line for the deletion. my $date = DateTime->from_epoch (epoch => $time); - my %record = (ah_acl => $self->{id}, + my %record = (ah_acl => $self->{id}, + ah_name => $self->{name}, ah_action => 'destroy', ah_by => $user, ah_from => $host, diff --git a/perl/lib/Wallet/Admin.pm b/perl/lib/Wallet/Admin.pm index 29b2f21..b07c7d1 100644 --- a/perl/lib/Wallet/Admin.pm +++ b/perl/lib/Wallet/Admin.pm @@ -98,13 +98,22 @@ sub initialize { $self->default_data; # Create a default admin ACL. - my $acl = Wallet::ACL->create ('ADMIN', $self->{schema}, $user, - 'localhost'); - unless ($acl->add ('krb5', $user, $user, 'localhost')) { - $self->error ($acl->error); + eval { + my $guard = $self->{schema}->txn_scope_guard; + $self->{schema}->resultset ('Acl')->populate ([ + [ qw/ac_id ac_name/ ], + [ 1, 'ADMIN' ], + ]); + $self->{schema}->resultset ('AclEntry')->populate ([ + [ qw/ae_id ae_scheme ae_identifier/ ], + [ 1, 'krb5', $user ], + ]); + $guard->commit; + }; + if ($@) { + $self->error ("cannot add ADMIN ACL: $@"); return; } - return 1; } diff --git a/perl/lib/Wallet/Schema/Result/AclHistory.pm b/perl/lib/Wallet/Schema/Result/AclHistory.pm index 11593b7..82e18a9 100644 --- a/perl/lib/Wallet/Schema/Result/AclHistory.pm +++ b/perl/lib/Wallet/Schema/Result/AclHistory.pm @@ -41,6 +41,12 @@ __PACKAGE__->table("acl_history"); data_type: 'integer' is_nullable: 0 +=head2 ah_name + + data_type: 'varchar' + is_nullable: 1 + size: 255 + =head2 ah_action data_type: 'varchar' @@ -84,6 +90,8 @@ __PACKAGE__->add_columns( { data_type => "integer", is_auto_increment => 1, is_nullable => 0 }, "ah_acl", { data_type => "integer", is_nullable => 0 }, + "ah_name", + { data_type => "varchar", is_nullable => 1, size => 255 }, "ah_action", { data_type => "varchar", is_nullable => 0, size => 16 }, "ah_scheme", @@ -108,6 +116,8 @@ sub sqlt_deploy_hook { my ($self, $sqlt_table) = @_; my $name = 'acl_history_idx_ah_acl'; $sqlt_table->add_index (name => $name, fields => [qw(ah_acl)]); + $name = 'acl_history_idx_ah_name'; + $sqlt_table->add_index (name => $name, fields => [qw(ah_name)]); } 1; diff --git a/perl/sql/Wallet-Schema-0.08-0.09-MySQL.sql b/perl/sql/Wallet-Schema-0.08-0.09-MySQL.sql index 8127613..f6b1abe 100644 --- a/perl/sql/Wallet-Schema-0.08-0.09-MySQL.sql +++ b/perl/sql/Wallet-Schema-0.08-0.09-MySQL.sql @@ -12,7 +12,9 @@ CREATE TABLE duo ( SET foreign_key_checks=1; -ALTER TABLE acl_history ADD INDEX acl_history_idx_ah_acl (ah_acl); +ALTER TABLE acl_history ADD COLUMN ah_name varchar(255) NULL, + ADD INDEX acl_history_idx_ah_acl (ah_acl), + ADD INDEX acl_history_idx_ah_name (ah_name); ALTER TABLE object_history DROP FOREIGN KEY object_history_fk_oh_type_oh_name, ALTER TABLE object_history; diff --git a/perl/sql/Wallet-Schema-0.08-0.09-PostgreSQL.sql b/perl/sql/Wallet-Schema-0.08-0.09-PostgreSQL.sql index 66603f7..a1d3fa3 100644 --- a/perl/sql/Wallet-Schema-0.08-0.09-PostgreSQL.sql +++ b/perl/sql/Wallet-Schema-0.08-0.09-PostgreSQL.sql @@ -8,8 +8,12 @@ CREATE TABLE "duo" ( PRIMARY KEY ("du_name") ); +ALTER TABLE acl_history ADD COLUMN ah_name character varying(255); + CREATE INDEX acl_history_idx_ah_acl on acl_history (ah_acl); +CREATE INDEX acl_history_idx_ah_name on acl_history (ah_name); + COMMIT; diff --git a/perl/sql/Wallet-Schema-0.08-0.09-SQLite.sql b/perl/sql/Wallet-Schema-0.08-0.09-SQLite.sql index 42f4ea5..df0fa09 100644 --- a/perl/sql/Wallet-Schema-0.08-0.09-SQLite.sql +++ b/perl/sql/Wallet-Schema-0.08-0.09-SQLite.sql @@ -8,6 +8,10 @@ CREATE TABLE duo ( PRIMARY KEY (du_name) ); +ALTER TABLE acl_history ADD ah_name varchar(255) default null; + CREATE INDEX acl_history_idx_ah_acl ON acl_history (ah_acl); +CREATE INDEX acl_history_idx_ah_name ON acl_history (ah_name); + COMMIT; diff --git a/perl/sql/Wallet-Schema-0.09-MySQL.sql b/perl/sql/Wallet-Schema-0.09-MySQL.sql index 86eeec4..200b941 100644 --- a/perl/sql/Wallet-Schema-0.09-MySQL.sql +++ b/perl/sql/Wallet-Schema-0.09-MySQL.sql @@ -1,6 +1,6 @@ -- -- Created by SQL::Translator::Producer::MySQL --- Created on Fri Jul 11 19:17:16 2014 +-- Created on Tue Jul 15 17:41:01 2014 -- SET foreign_key_checks=0; @@ -12,6 +12,7 @@ DROP TABLE IF EXISTS `acl_history`; CREATE TABLE `acl_history` ( `ah_id` integer NOT NULL auto_increment, `ah_acl` integer NOT NULL, + `ah_name` varchar(255) NULL, `ah_action` varchar(16) NOT NULL, `ah_scheme` varchar(32) NULL, `ah_identifier` varchar(255) NULL, @@ -19,6 +20,7 @@ CREATE TABLE `acl_history` ( `ah_from` varchar(255) NOT NULL, `ah_on` datetime NOT NULL, INDEX `acl_history_idx_ah_acl` (`ah_acl`), + INDEX `acl_history_idx_ah_name` (`ah_name`), PRIMARY KEY (`ah_id`) ); diff --git a/perl/sql/Wallet-Schema-0.09-PostgreSQL.sql b/perl/sql/Wallet-Schema-0.09-PostgreSQL.sql index 38fc6ca..a66f0b1 100644 --- a/perl/sql/Wallet-Schema-0.09-PostgreSQL.sql +++ b/perl/sql/Wallet-Schema-0.09-PostgreSQL.sql @@ -1,6 +1,6 @@ -- -- Created by SQL::Translator::Producer::PostgreSQL --- Created on Fri Jul 11 19:17:17 2014 +-- Created on Tue Jul 15 17:41:03 2014 -- -- -- Table: duo. @@ -19,6 +19,7 @@ DROP TABLE "acl_history" CASCADE; CREATE TABLE "acl_history" ( "ah_id" serial NOT NULL, "ah_acl" integer NOT NULL, + "ah_name" character varying(255), "ah_action" character varying(16) NOT NULL, "ah_scheme" character varying(32), "ah_identifier" character varying(255), @@ -28,6 +29,7 @@ CREATE TABLE "acl_history" ( PRIMARY KEY ("ah_id") ); CREATE INDEX "acl_history_idx_ah_acl" on "acl_history" ("ah_acl"); +CREATE INDEX "acl_history_idx_ah_name" on "acl_history" ("ah_name"); -- -- Table: acl_schemes. diff --git a/perl/sql/Wallet-Schema-0.09-SQLite.sql b/perl/sql/Wallet-Schema-0.09-SQLite.sql index 97db821..19a77c2 100644 --- a/perl/sql/Wallet-Schema-0.09-SQLite.sql +++ b/perl/sql/Wallet-Schema-0.09-SQLite.sql @@ -1,6 +1,6 @@ -- -- Created by SQL::Translator::Producer::SQLite --- Created on Fri Jul 11 19:17:16 2014 +-- Created on Tue Jul 15 17:41:02 2014 -- BEGIN TRANSACTION; @@ -24,6 +24,7 @@ DROP TABLE IF EXISTS acl_history; CREATE TABLE acl_history ( ah_id INTEGER PRIMARY KEY NOT NULL, ah_acl integer NOT NULL, + ah_name varchar(255), ah_action varchar(16) NOT NULL, ah_scheme varchar(32), ah_identifier varchar(255), @@ -34,6 +35,8 @@ CREATE TABLE acl_history ( CREATE INDEX acl_history_idx_ah_acl ON acl_history (ah_acl); +CREATE INDEX acl_history_idx_ah_name ON acl_history (ah_name); + -- -- Table: acl_schemes -- diff --git a/perl/t/general/server.t b/perl/t/general/server.t index 0a527a5..b270733 100755 --- a/perl/t/general/server.t +++ b/perl/t/general/server.t @@ -54,18 +54,8 @@ is ($server->acl_show ('ADMIN'), is ($server->acl_show (1), "Members of ACL ADMIN (id: 1) are:\n krb5 $admin\n", ' including by number'); -my $history = <<"EOO"; -DATE create - by $admin from $host -DATE add krb5 $admin - by $admin from $host -EOO -my $result = $server->acl_history ('ADMIN'); -$result =~ s/^\d{4}-\d\d-\d\d \d\d:\d\d:\d\d/DATE/gm; -is ($result, $history, ' and displaying history works'); -$result = $server->acl_history (1); -$result =~ s/^\d{4}-\d\d-\d\d \d\d:\d\d:\d\d/DATE/gm; -is ($result, $history, ' including by number'); +is ($server->acl_history ('ADMIN'), '', ' and initial history is empty'); +is ($server->acl_history (1), '', ' including by number'); is ($server->acl_create (3), undef, 'Cannot create ACL with a numeric name'); is ($server->error, 'ACL name may not be all numbers', ' and returns the right error'); @@ -117,7 +107,7 @@ is ($server->acl_add ('both', 'krb5', $user2), 1, is ($server->acl_show ('both'), "Members of ACL both (id: 4) are:\n krb5 $user1\n krb5 $user2\n", ' and show returns the correct result'); -$history = <<"EOO"; +my $history = <<"EOO"; DATE create by $admin from $host DATE add krb5 $user1 @@ -125,7 +115,7 @@ DATE add krb5 $user1 DATE add krb5 $user2 by $admin from $host EOO -$result = $server->acl_history ('both'); +my $result = $server->acl_history ('both'); $result =~ s/^\d{4}-\d\d-\d\d \d\d:\d\d:\d\d/DATE/gm; is ($result, $history, ' as does history'); is ($server->acl_add ('empty', 'krb5', $user1), 1, ' and another to empty'); -- cgit v1.2.3 From 443c2c7ac38672f18a14a84e7a220d1a3b1cd545 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 15 Jul 2014 20:33:18 -0700 Subject: Record ACL names in the ACL history Change-Id: I0d7a088bb34dda2fc554b9f104c2a33e5faf879e Reviewed-on: https://gerrit.stanford.edu/1554 Reviewed-by: Russ Allbery Tested-by: Russ Allbery --- NEWS | 2 ++ perl/lib/Wallet/ACL.pm | 8 ++++++-- perl/lib/Wallet/Schema.pm | 18 +++++++++--------- perl/lib/Wallet/Server.pm | 2 +- perl/t/general/acl.t | 7 +++++-- 5 files changed, 23 insertions(+), 14 deletions(-) (limited to 'perl/lib/Wallet/ACL.pm') diff --git a/NEWS b/NEWS index f6e3fdd..08a7e14 100644 --- a/NEWS +++ b/NEWS @@ -46,6 +46,8 @@ wallet 1.1 (unreleased) the DateTime::Format::* module corresponding to the DBD::* module used for the server database. + ACL renames are now recorded in the ACL history. + The initial creation and membership of the ADMIN ACL during database initialization or reinitialization is no longer recorded in the acl_history table. (This is fallout from making a specific type of diff --git a/perl/lib/Wallet/ACL.pm b/perl/lib/Wallet/ACL.pm index 6f5172a..b488b43 100644 --- a/perl/lib/Wallet/ACL.pm +++ b/perl/lib/Wallet/ACL.pm @@ -161,7 +161,7 @@ sub scheme_mapping { # change and should be committed with that change. sub log_acl { my ($self, $action, $scheme, $identifier, $user, $host, $time) = @_; - unless ($action =~ /^(add|remove)\z/) { + unless ($action =~ /^(add|remove|rename)\z/) { die "invalid history action $action"; } my $date = DateTime->from_epoch (epoch => $time); @@ -184,7 +184,8 @@ sub log_acl { # logged since it isn't a change to any of the data stored in the wallet. # Returns true on success, false on failure. sub rename { - my ($self, $name) = @_; + my ($self, $name, $user, $host, $time) = @_; + $time ||= time; if ($name =~ /^\d+\z/) { $self->error ("ACL name may not be all numbers"); return; @@ -195,6 +196,7 @@ sub rename { my $acls = $self->{schema}->resultset('Acl')->find (\%search); $acls->ac_name ($name); $acls->update; + $self->log_acl ('rename', undef, undef, $user, $host, $time); $guard->commit; }; if ($@) { @@ -381,6 +383,8 @@ sub history { if ($data->ah_action eq 'add' || $data->ah_action eq 'remove') { $output .= sprintf ("%s %s %s", $data->ah_action, $data->ah_scheme, $data->ah_identifier); + } elsif ($data->ah_action eq 'rename') { + $output .= 'rename from ' . $data->ah_name; } else { $output .= $data->ah_action; } diff --git a/perl/lib/Wallet/Schema.pm b/perl/lib/Wallet/Schema.pm index 74b4c99..cb4c93e 100644 --- a/perl/lib/Wallet/Schema.pm +++ b/perl/lib/Wallet/Schema.pm @@ -1,7 +1,7 @@ # Database schema and connector for the wallet system. # # Written by Jon Robertson -# Copyright 2012, 2013 +# Copyright 2012, 2013, 2014 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -160,6 +160,7 @@ table. create table acl_history (ah_id integer auto_increment primary key, ah_acl integer not null, + ah_name varchar(255) default null, ah_action varchar(16) not null, ah_scheme varchar(32) default null, ah_identifier varchar(255) default null, @@ -168,14 +169,13 @@ table. ah_on datetime not null); create index ah_acl on acl_history (ah_acl); -ah_action must be one of C, C, C, or C -(enums aren't used for compatibility with databases other than MySQL). -For a change of type create or destroy, only the action and the trace -records (by, from, and on) are stored. For a change to the lines of an -ACL, the scheme and identifier of the line that was added or removed is -included. Note that changes to the ACL name are not recorded; ACLs are -always tracked by system-generated ID, so name changes are purely -cosmetic. +ah_action must be one of C, C, C, C, or +C (enums aren't used for compatibility with databases other than +MySQL). For a change of type create, destroy, or rename, only the action, +the ACL name (in the case of rename, the old ACL name prior to the +rename), and the trace records (by, from, and on) are stored. For a +change to the lines of an ACL, the scheme and identifier of the line that +was added or removed are included. ah_by stores the authenticated identity that made the change, ah_from stores the host from which they made the change, and ah_on stores the time diff --git a/perl/lib/Wallet/Server.pm b/perl/lib/Wallet/Server.pm index 2765d34..e278489 100644 --- a/perl/lib/Wallet/Server.pm +++ b/perl/lib/Wallet/Server.pm @@ -681,7 +681,7 @@ sub acl_rename { return; } } - unless ($acl->rename ($name)) { + unless ($acl->rename ($name, $self->{user}, $self->{host})) { $self->error ($acl->error); return; } diff --git a/perl/t/general/acl.t b/perl/t/general/acl.t index 01b4801..1dd5c53 100755 --- a/perl/t/general/acl.t +++ b/perl/t/general/acl.t @@ -63,7 +63,7 @@ ok ($acl->isa ('Wallet::ACL'), ' and the right class'); is ($acl->name, 'test', ' and the right name'); # Test rename. -if ($acl->rename ('example')) { +if ($acl->rename ('example', @trace)) { ok (1, 'Renaming the ACL'); } else { is ($acl->error, '', 'Renaming the ACL'); @@ -83,7 +83,8 @@ ok (defined ($acl), ' and it can still found by ID'); is ($@, '', ' with no exceptions'); is ($acl->name, 'example', ' and the right name'); is ($acl->id, 2, ' and the right ID'); -ok (! $acl->rename ('ADMIN'), ' but renaming to an existing name fails'); +ok (! $acl->rename ('ADMIN', @trace), + ' but renaming to an existing name fails'); like ($acl->error, qr/^cannot rename ACL 2 to ADMIN: /, ' with the right error'); @@ -195,6 +196,8 @@ my $date = strftime ('%Y-%m-%d %H:%M:%S', localtime $trace[2]); my $history = <<"EOO"; $date create by $admin from $host +$date rename from test + by $admin from $host $date add krb5 $user1 by $admin from $host $date add krb5 $user2 -- cgit v1.2.3 From c2112bf049d193c677335c94b477eb5cadb403ed Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 15 Jul 2014 20:46:57 -0700 Subject: Use DateTime objects uniformly, improve expires parsing Always use DateTime objects for every date field in the database, and translate them into the local time zone for display when pulling them out of the database. This should provide better portability to different database backends. Change the parsing of expires arguments to use Date::Parse, thus supporting a much broader variety of possible date and time formats and allowing easy conversion to a DateTime object. Document the new dependency. Change-Id: I2ee8eaa6aa6ae9925ac419e49234ec9880d4fe95 Reviewed-on: https://gerrit.stanford.edu/1555 Reviewed-by: Russ Allbery Tested-by: Russ Allbery --- NEWS | 4 ++++ README | 7 +++--- perl/lib/Wallet/ACL.pm | 5 ++-- perl/lib/Wallet/Object/Base.pm | 54 +++++++++++++++++++++++++++++------------- 4 files changed, 49 insertions(+), 21 deletions(-) (limited to 'perl/lib/Wallet/ACL.pm') diff --git a/NEWS b/NEWS index 08a7e14..d0ac4c3 100644 --- a/NEWS +++ b/NEWS @@ -12,6 +12,10 @@ wallet 1.1 (unreleased) an existing wallet database, use wallet-admin to register the new object. + The date passed to expires can now be any date format understood by + Date::Parse, and Date::Parse (part of the TimeDate CPAN distribution) + is now a required prerequisite for the wallet server. + Fix wallet-rekey on keytabs containing multiple principals. Previous versions assumed one could concatenate keytab files together to make a valid keytab file, which doesn't work with some Kerberos libraries. diff --git a/README b/README index 4c9f1d7..f32ba15 100644 --- a/README +++ b/README @@ -68,9 +68,10 @@ REQUIREMENTS plus Module::Build to build. It uses DBIx::Class and DBI to talk to a database, and therefore the DBIx::Class and DBI modules (and their dependencies) and a DBD module for the database it will use must be - installed. The DateTime module is required for date handling, and the - SQL::Translator Perl module is also required for schema deployment and - database upgrades. You will also need the DateTime::Format::* module + installed. The Date::Parse (part of the TimeDate distribution) and + DateTime modules are required for date handling, and the SQL::Translator + Perl module is also required for schema deployment and database + upgrades. You will also need the DateTime::Format::* module corresponding to your DBD module (such as DateTime::Format::SQLite or DateTime::Format::PG). diff --git a/perl/lib/Wallet/ACL.pm b/perl/lib/Wallet/ACL.pm index b488b43..a3b0146 100644 --- a/perl/lib/Wallet/ACL.pm +++ b/perl/lib/Wallet/ACL.pm @@ -378,8 +378,9 @@ sub history { my @data = $self->{schema}->resultset('AclHistory') ->search (\%search, \%options); for my $data (@data) { - $output .= sprintf ("%s %s ", $data->ah_on->ymd, - $data->ah_on->hms); + my $date = $data->ah_on; + $date->set_time_zone ('local'); + $output .= sprintf ("%s %s ", $date->ymd, $date->hms); if ($data->ah_action eq 'add' || $data->ah_action eq 'remove') { $output .= sprintf ("%s %s %s", $data->ah_action, $data->ah_scheme, $data->ah_identifier); diff --git a/perl/lib/Wallet/Object/Base.pm b/perl/lib/Wallet/Object/Base.pm index f1b8b72..4939bf5 100644 --- a/perl/lib/Wallet/Object/Base.pm +++ b/perl/lib/Wallet/Object/Base.pm @@ -18,6 +18,7 @@ use warnings; use vars qw($VERSION); use DateTime; +use Date::Parse qw(str2time); use DBI; use Text::Wrap qw(wrap); use Wallet::ACL; @@ -230,10 +231,20 @@ sub _set_internal { my %search = (ob_type => $type, ob_name => $name); my $object = $self->{schema}->resultset('Object')->find (\%search); - my $old = $object->get_column ("ob_$attr"); - - $object->update ({ "ob_$attr" => $value }); - $self->log_set ($attr, $old, $value, $user, $host, $time); + my $column = "ob_$attr"; + my $old = $object->$column; + my $new = $value; + $object->update ({ $column => $value }); + + if (ref ($old) && $old->isa ('DateTime')) { + $old->set_time_zone ('local'); + $old = $old->ymd . q{ } . $old->hms; + } + if (ref ($new) && $new->isa ('DateTime')) { + $new->set_time_zone ('local'); + $new = $new->ymd . q{ } . $new->hms; + } + $self->log_set ($attr, $old, $new, $user, $host, $time); $guard->commit; }; if ($@) { @@ -262,7 +273,7 @@ sub _get_internal { my %search = (ob_type => $type, ob_name => $name); my $object = $self->{schema}->resultset('Object')->find (\%search); - $value = $object->get_column ($attr); + $value = $object->$attr; }; if ($@) { $self->error ($@); @@ -334,15 +345,23 @@ sub comment { sub expires { my ($self, $expires, $user, $host, $time) = @_; if ($expires) { - if ($expires !~ /^\d{4}-\d\d-\d\d( \d\d:\d\d:\d\d)?\z/) { + my $seconds = str2time ($expires); + unless (defined $seconds) { $self->error ("malformed expiration time $expires"); return; } - return $self->_set_internal ('expires', $expires, $user, $host, $time); + my $date = DateTime->from_epoch (epoch => $seconds); + return $self->_set_internal ('expires', $date, $user, $host, $time); } elsif (defined $expires) { return $self->_set_internal ('expires', undef, $user, $host, $time); } else { - return $self->_get_internal ('expires'); + my $date = $self->_get_internal ('expires'); + if (defined $date) { + $date->set_time_zone ('local'); + return $date->ymd . q{ } . $date->hms; + } else { + return; + } } } @@ -506,13 +525,14 @@ sub history { eval { my %search = (oh_type => $self->{type}, oh_name => $self->{name}); - my %attrs = (order_by => 'oh_on'); + my %attrs = (order_by => 'oh_id'); my @history = $self->{schema}->resultset('ObjectHistory') ->search (\%search, \%attrs); for my $history_rs (@history) { - $output .= sprintf ("%s %s ", $history_rs->oh_on->ymd, - $history_rs->oh_on->hms); + my $date = $history_rs->oh_on; + $date->set_time_zone ('local'); + $output .= sprintf ("%s %s ", $date->ymd, $date->hms); my $old = $history_rs->oh_old; my $new = $history_rs->oh_new; @@ -635,15 +655,15 @@ sub show { for my $i (0 .. $#attrs) { my $field = $attrs[$i][0]; my $fieldtext = $attrs[$i][1]; - next unless my $value = $object_rs->get_column ($field); + my $value = $object_rs->$field; + next unless defined($value); if ($field eq 'ob_comment' && length ($value) > 79 - 17) { local $Text::Wrap::columns = 80; local $Text::Wrap::unexpand = 0; $value = wrap (' ' x 17, ' ' x 17, $value); $value =~ s/^ {17}//; - } - if ($field eq 'ob_created_by') { + } elsif ($field eq 'ob_created_by') { my @flags = $self->flag_list; if (not @flags and $self->error) { return; @@ -656,8 +676,10 @@ sub show { return; } $output .= $attr_output; - } - if ($field =~ /^ob_(owner|acl_)/) { + } elsif (ref ($value) && $value->isa ('DateTime')) { + $value->set_time_zone ('local'); + $value = sprintf ("%s %s", $value->ymd, $value->hms); + } elsif ($field =~ /^ob_(owner|acl_)/) { my $acl = eval { Wallet::ACL->new ($value, $self->{schema}) }; if ($acl and not $@) { $value = $acl->name || $value; -- cgit v1.2.3