From 345333f027be0b34318584b3f1b5e3e12adcaa98 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Fri, 19 Feb 2010 01:21:48 -0800 Subject: Refactor reporting into a separate module and script Move all reporting from Wallet::Admin to Wallet::Report and simplify the method names since they're now part of a dedicated reporting class. Similarly, create a new wallet-report script to wrap Wallet::Report, moving all reporting commands to it from wallet-admin, and simplify the commands since they're for a dedicated reporting script. Remove the contrib script wallet-report to wallet-summary so that it doesn't conflict with the new reporting backend script. --- perl/Wallet/Report.pm | 425 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 425 insertions(+) create mode 100644 perl/Wallet/Report.pm (limited to 'perl/Wallet/Report.pm') diff --git a/perl/Wallet/Report.pm b/perl/Wallet/Report.pm new file mode 100644 index 0000000..7cd8653 --- /dev/null +++ b/perl/Wallet/Report.pm @@ -0,0 +1,425 @@ +# Wallet::Report -- Wallet system reporting interface. +# +# Written by Russ Allbery +# Copyright 2008, 2009, 2010 Board of Trustees, Leland Stanford Jr. University +# +# See LICENSE for licensing terms. + +############################################################################## +# Modules and declarations +############################################################################## + +package Wallet::Report; +require 5.006; + +use strict; +use vars qw($VERSION); + +use Wallet::Database; + +# This version should be increased on any code change to this module. Always +# use two digits for the minor version with a leading zero if necessary so +# that it will sort properly. +$VERSION = '0.01'; + +############################################################################## +# Constructor, destructor, and accessors +############################################################################## + +# Create a new wallet report object. Opens a connection to the database that +# will be used for all of the wallet configuration information. Throw an +# exception if anything goes wrong. +sub new { + my ($class) = @_; + my $dbh = Wallet::Database->connect; + my $self = { dbh => $dbh }; + bless ($self, $class); + return $self; +} + +# Returns the database handle (used mostly for testing). +sub dbh { + my ($self) = @_; + return $self->{dbh}; +} + +# 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}; +} + +# Disconnect the database handle on object destruction to avoid warnings. +sub DESTROY { + my ($self) = @_; + $self->{dbh}->disconnect unless $self->{dbh}->{InactiveDestroy}; +} + +############################################################################## +# Object reports +############################################################################## + +# Return the SQL statement to find every object in the database. +sub objects_all { + my ($self) = @_; + my $sql = 'select ob_type, ob_name from objects order by ob_type, + ob_name'; + return $sql; +} + +# Return the SQL statement and the search field required to find all objects +# matching a specific type. +sub objects_type { + my ($self, $type) = @_; + my $sql = 'select ob_type, ob_name from objects where ob_type=? order + by ob_type, ob_name'; + return ($sql, $type); +} + +# Return the SQL statement and search field required to find all objects owned +# by a given ACL. If the requested owner is null, we ignore this and do a +# different search for IS NULL. If the requested owner does not actually +# match any ACLs, set an error and return undef. +sub objects_owner { + my ($self, $owner) = @_; + my ($sth); + if (lc ($owner) eq 'null') { + my $sql = 'select ob_type, ob_name from objects where ob_owner is null + order by objects.ob_type, objects.ob_name'; + return ($sql); + } else { + my $acl = eval { Wallet::ACL->new ($owner, $self->{dbh}) }; + return unless $acl; + my $sql = 'select ob_type, ob_name from objects where ob_owner = ? + order by objects.ob_type, objects.ob_name'; + return ($sql, $acl->id); + } +} + +# Return the SQL statement and search field required to find all objects that +# have a specific flag set. +sub objects_flag { + my ($self, $flag) = @_; + my $sql = 'select ob_type, ob_name from objects left join flags on + (objects.ob_type = flags.fl_type and objects.ob_name = flags.fl_name) + where flags.fl_flag = ? order by objects.ob_type, objects.ob_name'; + return ($sql, $flag); +} + +# Return the SQL statement and search field required to find all objects that +# a given ACL has any permissions on. This expands from objects_owner in that +# it will also match any records that have the ACL set for get, store, show, +# destroy, or flags. If the requested owner does not actually match any ACLs, +# set an error and return the empty string. +sub objects_acl { + my ($self, $search) = @_; + my $acl = eval { Wallet::ACL->new ($search, $self->{dbh}) }; + return unless $acl; + my $sql = 'select ob_type, ob_name from objects where ob_owner = ? or + ob_acl_get = ? or ob_acl_store = ? or ob_acl_show = ? or + ob_acl_destroy = ? or ob_acl_flags = ? order by objects.ob_type, + objects.ob_name'; + return ($sql, ($acl->id) x 6); +} + +# Returns a list of all objects stored in the wallet database in the form of +# type and name pairs. On error and for an empty database, the empty list +# will be returned. To distinguish between an empty list and an error, call +# error(), which will return undef if there was no error. Farms out specific +# statement to another subroutine for specific search types, but each case +# should return ob_type and ob_name in that order. +sub objects { + my ($self, $type, @args) = @_; + undef $self->{error}; + + # Find the SQL statement and the arguments to use. + my $sql = ''; + my @search = (); + if (!defined $type || $type eq '') { + ($sql) = $self->objects_all; + } else { + if (@args != 1) { + $self->error ("object searches require one argument to search"); + } elsif ($type eq 'type') { + ($sql, @search) = $self->objects_type (@args); + } elsif ($type eq 'owner') { + ($sql, @search) = $self->objects_owner (@args); + } elsif ($type eq 'flag') { + ($sql, @search) = $self->objects_flag (@args); + } elsif ($type eq 'acl') { + ($sql, @search) = $self->objects_acl (@args); + } else { + $self->error ("do not know search type: $type"); + } + return unless $sql; + } + + # Do the search. + my @objects; + eval { + my $sth = $self->{dbh}->prepare ($sql); + $sth->execute (@search); + my $object; + while (defined ($object = $sth->fetchrow_arrayref)) { + push (@objects, [ @$object ]); + } + $self->{dbh}->commit; + }; + if ($@) { + $self->error ("cannot list objects: $@"); + $self->{dbh}->rollback; + return; + } + return @objects; +} + +############################################################################## +# ACL reports +############################################################################## + +# Returns the SQL statement required to find and return all ACLs in the +# database. +sub acls_all { + my ($self) = @_; + my $sql = 'select ac_id, ac_name from acls order by ac_id'; + return ($sql); +} + +# Returns the SQL statement required to find all empty ACLs in the database. +sub acls_empty { + my ($self) = @_; + my $sql = 'select ac_id, ac_name from acls left join acl_entries + on (acls.ac_id = acl_entries.ae_id) where ae_id is null'; + return ($sql); +} + +# Returns the SQL statement and the field required to find ACLs containing the +# specified entry. The identifier is automatically surrounded by wildcards to +# do a substring search. +sub acls_entry { + my ($self, $type, $identifier) = @_; + my $sql = 'select distinct ac_id, ac_name from acl_entries left join acls + on (ae_id = ac_id) where ae_scheme = ? and ae_identifier like ? order + by ac_id'; + return ($sql, $type, '%' . $identifier . '%'); +} + +# Returns a list of all ACLs stored in the wallet database as a list of pairs +# of ACL IDs and ACL names, possibly limited by some criteria. On error and +# for an empty database, the empty list will be returned. To distinguish +# between an empty list and an error, call error(), which will return undef if +# there was no error. +sub acls { + my ($self, $type, @args) = @_; + undef $self->{error}; + + # Find the SQL statement and the arguments to use. + my $sql; + my @search = (); + if (!defined $type || $type eq '') { + ($sql) = $self->acls_all; + } else { + if ($type eq 'entry') { + if (@args == 0) { + $self->error ('ACL searches require an argument to search'); + return; + } else { + ($sql, @search) = $self->acls_entry (@args); + } + } elsif ($type eq 'empty') { + ($sql) = $self->acls_empty; + } else { + $self->error ("do not know search type: $type"); + return; + } + } + + # Do the search. + my @acls; + eval { + my $sth = $self->{dbh}->prepare ($sql); + $sth->execute (@search); + my $object; + while (defined ($object = $sth->fetchrow_arrayref)) { + push (@acls, [ @$object ]); + } + $self->{dbh}->commit; + }; + if ($@) { + $self->error ("cannot list ACLs: $@"); + $self->{dbh}->rollback; + return; + } + return @acls; +} + +# Returns all ACL entries contained in owner ACLs for matching objects. +# Objects are specified by type and name, which may be SQL wildcard +# expressions. Each list member will be a pair of ACL scheme and ACL +# identifier, with duplicates removed. On error and for no matching entries, +# the empty list will be returned. To distinguish between an empty return and +# an error, call error(), which will return undef if there was no error. +sub owners { + my ($self, $type, $name) = @_; + undef $self->{error}; + my @lines; + eval { + my $sql = 'select distinct ae_scheme, ae_identifier from acl_entries, + acls, objects where ae_id = ac_id and ac_id = ob_owner and + ob_type like ? and ob_name like ? order by ae_scheme, + ae_identifier'; + my $sth = $self->{dbh}->prepare ($sql); + $sth->execute ($type, $name); + my $object; + while (defined ($object = $sth->fetchrow_arrayref)) { + push (@lines, [ @$object ]); + } + $self->{dbh}->commit; + }; + if ($@) { + $self->error ("cannot report on owners: $@"); + $self->{dbh}->rollback; + return; + } + return @lines; +} + +1; +__DATA__ + +############################################################################## +# Documentation +############################################################################## + +=head1 NAME + +Wallet::Report - Wallet system reporting interface + +=for stopwords +ACL ACLs wildcard Allbery SQL tuples + +=head1 SYNOPSIS + + use Wallet::Report; + my $report = Wallet::Report->new; + my @objects = $report->objects ('type', 'keytab'); + for my $object (@objects) { + print "@$object\n"; + } + +=head1 DESCRIPTION + +Wallet::Report provides a mechanism to generate lists and reports on the +contents of the wallet database. The format of the results returned +depend on the type of search, but will generally be returned as a list of +tuples identifying objects, ACLs, or ACL entries. + +To use this object, several configuration variables must be set (at least +the database configuration). For information on those variables and how +to set them, see Wallet::Config(3). For more information on the normal +user interface to the wallet server, see Wallet::Server(3). + +=head1 CLASS METHODS + +=over 4 + +=item new() + +Creates a new wallet report object and connects to the database. On any +error, this method throws an exception. + +=back + +=head1 INSTANCE METHODS + +For all methods that can fail, the caller should call error() after a +failure to get the error message. For all methods that return lists, if +they return an empty list, the caller should call error() to distinguish +between an empty report and an error. + +=over 4 + +=item acls([ TYPE [, SEARCH ... ]]) + +Returns a list of all ACLs matching a search type and string in the +database, or all ACLs if no search information is given. There are +currently two search types. C takes no arguments and will return +only those ACLs that have no entries within them. C takes two +arguments, an entry scheme and a (possibly partial) entry identifier, and +will return any ACLs containing an entry with that scheme and with an +identifier containing that value. + +The return value is a list of references to pairs of ACL ID and name. For +example, if there are two ACLs in the database, one with name C and +ID 1 and one with name C and ID 3, acls() with no arguments +would return: + + ([ 1, 'ADMIN' ], [ 3, 'group/admins' ]) + +Returns the empty list on failure. An error can be distinguished from +empty search results by calling error(). error() is guaranteed to return +the error message if there was an error and undef if there was no error. + +=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 objects([ TYPE [, SEARCH ... ]]) + +Returns a list of all objects matching a search type and string in the +database, or all objects in the database if no search information is +given. + +There are four types of searches currently. C, with a given type, +will return only those entries where the type matches the given type. +C, with a given owner, will only return those objects owned by the +given ACL name or ID. C, with a given flag name, will only return +those items with a flag set to the given value. C operates like +C, but will return only those objects that have the given ACL name +or ID on any of the possible ACL settings, not just owner. + +The return value is a list of references to pairs of type and name. For +example, if two objects existed in the database, both of type C +and with values C and C, objects() with no +arguments would return: + + ([ 'keytab', 'host/example.com' ], [ 'keytab', 'foo' ]) + +Returns the empty list on failure. To distinguish between this and an +empty search result, the caller should call error(). error() is +guaranteed to return the error message if there was an error and undef if +there was no error. + +=item owners(TYPE, NAME) + +Returns a list of all ACL lines contained in owner ACLs for objects +matching TYPE and NAME, which are interpreted as SQL patterns using C<%> +as a wildcard. The return value is a list of references to pairs of +schema and identifier, with duplicates removed. + +Returns the empty list on failure. To distinguish between this and no +matches, 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. + +=back + +=head1 SEE ALSO + +Wallet::Config(3), Wallet::Server(3) + +This module is part of the wallet system. The current version is +available from L. + +=head1 AUTHOR + +Russ Allbery and Jon Robertson . + +=cut -- cgit v1.2.3 From a131c767d1eee7b98170962f7f9d4063be69e576 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Wed, 3 Mar 2010 22:37:18 -0800 Subject: Add auditing for names that violate the naming policy Add an audit command to wallet-report and one audit: objects name, which returns all objects that do not pass the local naming policy. The corresponding Wallet::Report method is audit(). Wallet::Config::verify_name may now be called with an undefined third argument (normally the user attempting to create an object). This calling convention is used when auditing, and the local policy function should select the correct policy to apply for useful audit results. --- NEWS | 10 ++++++++++ perl/Wallet/Config.pm | 11 ++++++++++- perl/Wallet/Report.pm | 54 ++++++++++++++++++++++++++++++++++++++++++++++++++- perl/t/report.t | 25 +++++++++++++++++++++++- server/wallet-report | 19 ++++++++++++++++++ tests/server/report-t | 32 +++++++++++++++++++++++------- 6 files changed, 141 insertions(+), 10 deletions(-) (limited to 'perl/Wallet/Report.pm') diff --git a/NEWS b/NEWS index e66d1b3..03fe99b 100644 --- a/NEWS +++ b/NEWS @@ -8,6 +8,16 @@ wallet 0.11 (unreleased) integrity. This also allows us to return a better error message naming an object that's still using that ACL. + Add an audit command to wallet-report and one audit: objects name, + which returns all objects that do not pass the local naming policy. + The corresponding Wallet::Report method is audit(). + + Wallet::Config::verify_name may now be called with an undefined third + argument (normally the user attempting to create an object). This + calling convention is used when auditing, and the local policy + function should select the correct policy to apply for useful audit + results. + Fix portability to older Kerberos libraries without krb5_free_error_message. diff --git a/perl/Wallet/Config.pm b/perl/Wallet/Config.pm index 396bf7d..2991361 100644 --- a/perl/Wallet/Config.pm +++ b/perl/Wallet/Config.pm @@ -14,7 +14,7 @@ use vars qw($PATH $VERSION); # This version should be increased on any code change to this module. Always # use two digits for the minor version with a leading zero if necessary so # that it will sort properly. -$VERSION = '0.04'; +$VERSION = '0.05'; # Path to the config file to load. $PATH = $ENV{WALLET_CONFIG} || '/etc/wallet/wallet.conf'; @@ -519,6 +519,15 @@ creation. If it returns undef or the empty string, object creation will be allowed. If it returns anything else, object creation is rejected and the return value is used as the error message. +This function is also called for naming audits done via Wallet::Report +to find any existing objects that violate a (possibly updated) naming +policy. In this case, the third argument (the identity of the person +creating the object) will be undef. As a general rule, if the third +argument is undef, the function should apply the most liberal accepted +naming policy so that the audit returns only objects that violate all +naming policies, but some sites may wish different results for their audit +reports. + Please note that this return status is backwards from what one would normally expect. A false value is success; a true value is failure with an error message. diff --git a/perl/Wallet/Report.pm b/perl/Wallet/Report.pm index 7cd8653..ff4fa8b 100644 --- a/perl/Wallet/Report.pm +++ b/perl/Wallet/Report.pm @@ -20,7 +20,7 @@ use Wallet::Database; # This version should be increased on any code change to this module. Always # use two digits for the minor version with a leading zero if necessary so # that it will sort properly. -$VERSION = '0.01'; +$VERSION = '0.02'; ############################################################################## # Constructor, destructor, and accessors @@ -290,6 +290,43 @@ sub owners { return @lines; } +############################################################################## +# Auditing +############################################################################## + +# Audit the database for violations of local policy. Returns a list of +# objects (as type and name pairs) or a list of ACLs. On error and for no +# matching entries, the empty list will be returned. To distinguish between +# an empty return and an error, call error(), which will return undef if there +# was no error. +sub audit { + my ($self, $type, $audit) = @_; + undef $self->{error}; + unless (defined ($type) and defined ($audit)) { + $self->error ("type and audit not specified"); + return; + } + if ($type eq 'objects') { + if ($audit eq 'name') { + return unless defined &Wallet::Config::verify_name; + my @objects = $self->objects; + my @results; + for my $object (@objects) { + my ($type, $name) = @$object; + my $error = Wallet::Config::verify_name ($type, $name); + push (@results, $object) if $error; + } + return @results; + } else { + $self->error ("unknown object audit: $audit"); + return; + } + } else { + $self->error ("unknown audit type: $type"); + return; + } +} + 1; __DATA__ @@ -312,6 +349,7 @@ ACL ACLs wildcard Allbery SQL tuples for my $object (@objects) { print "@$object\n"; } + @objects = $report->audit ('objects', 'name'); =head1 DESCRIPTION @@ -366,6 +404,20 @@ Returns the empty list on failure. An error can be distinguished from empty search results by calling error(). error() is guaranteed to return the error message if there was an error and undef if there was no error. +=item audit(TYPE, AUDIT) + +Audits the wallet database for violations of local policy. TYPE is the +general class of thing to audit, and AUDIT is the specific audit to +perform. Currently, the only implemented type is C and the only +audit is C. This returns a list of all objects, as references to +pairs of type and name, that are not accepted by the verify_name() +function defined in the wallet configuration. See L for +more information. + +Returns the empty list on failure. An error can be distinguished from +empty search results by calling error(). error() is guaranteed to return +the error message if there was an error and undef if there was no error. + =item error() Returns the error of the last failing operation or undef if no operations diff --git a/perl/t/report.t b/perl/t/report.t index a37681a..3b94d00 100755 --- a/perl/t/report.t +++ b/perl/t/report.t @@ -7,7 +7,7 @@ # # See LICENSE for licensing terms. -use Test::More tests => 83; +use Test::More tests => 88; use Wallet::Admin; use Wallet::Report; @@ -166,6 +166,29 @@ is ($server->flag_clear ('base', 'service/admin', 'unchanging'), 1, is (scalar (@lines), 0, ' and now there are no objects in the report'); is ($report->error, undef, ' with no error'); +# The naming audit returns nothing if there's no naming policy. +@lines = $report->audit ('objects', 'name'); +is (scalar (@lines), 0, 'Searching for naming violations finds none'); +is ($report->error, undef, ' with no error'); + +# Set a naming policy and then look for objects that fail that policy. We +# have to deactivate this policy until now so that it doesn't prevent the +# creation of that name originally, which is the reason for the variable +# reference. +our $naming_active = 1; +package Wallet::Config; +sub verify_name { + my ($type, $name) = @_; + return unless $naming_active; + return 'admin not allowed' if $name eq 'service/admin'; + return; +} +package main; +@lines = $report->audit ('objects', 'name'); +is (scalar (@lines), 1, 'Searching for naming violations finds one'); +is ($lines[0][0], 'base', ' and the first has the right type'); +is ($lines[0][1], 'service/admin', ' and the right name'); + # Clean up. $admin->destroy; unlink 'wallet-db'; diff --git a/server/wallet-report b/server/wallet-report index a6b3b8d..caa7e2c 100755 --- a/server/wallet-report +++ b/server/wallet-report @@ -35,6 +35,16 @@ sub command { for my $acl (sort { $$a[1] cmp $$b[1] } @acls) { print "$$acl[1] (ACL ID: $$acl[0])\n"; } + } elsif ($command eq 'audit') { + die "too many arguments to audit\n" if @args > 2; + die "too few arguments to audit\n" if @args < 2; + my @objects = $report->audit (@args); + if (!@objects and $report->error) { + die $report->error, "\n"; + } + for my $object (@objects) { + print join (' ', @$object), "\n"; + } } elsif ($command eq 'objects') { die "too many arguments to objects\n" if @args > 2; my @objects = $report->objects (@args); @@ -129,6 +139,15 @@ any identifier containing that string. =back +=item audit objects name + +Returns all objects that violate the current site naming policy. Objects +will be listed in the form: + + + +There will be one line per object. + =item objects =item objects acl diff --git a/tests/server/report-t b/tests/server/report-t index 285ee5a..61cfd9b 100755 --- a/tests/server/report-t +++ b/tests/server/report-t @@ -8,7 +8,7 @@ # See LICENSE for licensing terms. use strict; -use Test::More tests => 32; +use Test::More tests => 42; # Create a dummy class for Wallet::Report that prints what method was called # with its arguments and returns data for testing. @@ -38,6 +38,13 @@ sub acls { return ([ 1, 'ADMIN' ], [ 2, 'group/admins' ], [ 4, 'group/users' ]); } +sub audit { + shift; + print "audit @_\n"; + return if ($error or $empty); + return ([ file => 'unix-wallet-password' ]); +} + sub objects { shift; print "objects @_\n"; @@ -81,6 +88,7 @@ is ($out, "new\n", ' and nothing ran'); # Check too few and too many arguments for every command. my %commands = (acls => [0, 3], + audit => [2, 2], objects => [0, 2], owners => [2, 2]); for my $command (sort keys %commands) { @@ -110,6 +118,10 @@ is ($err, '', 'List succeeds for ACLs'); is ($out, "new\nacls entry foo foo\n" . "ADMIN (ACL ID: 1)\ngroup/admins (ACL ID: 2)\ngroup/users (ACL ID: 4)\n", ' and returns the right output'); +($out, $err) = run_report ('audit', 'objects', 'name'); +is ($err, '', 'Audit report succeeds'); +is ($out, "new\naudit objects name\nfile unix-wallet-password\n", + ' and returns the right output'); ($out, $err) = run_report ('objects'); is ($err, '', 'List succeeds for objects'); is ($out, "new\nobjects \n" @@ -128,24 +140,30 @@ is ($out, "new\nowners % %\nkrb5 admin\@EXAMPLE.COM\n", # Test error handling. $Wallet::Report::error = 1; ($out, $err) = run_report ('acls'); -is ($err, "some error\n", 'Error handling succeeds for list acls'); +is ($err, "some error\n", 'Error handling succeeds for acls'); is ($out, "new\nacls \n", ' and calls the right methods'); +($out, $err) = run_report ('audit', 'objects', 'name'); +is ($err, "some error\n", 'Error handling succeeds for audit'); +is ($out, "new\naudit objects name\n", ' and calls the right methods'); ($out, $err) = run_report ('objects'); -is ($err, "some error\n", 'Error handling succeeds for list objects'); +is ($err, "some error\n", 'Error handling succeeds for objects'); is ($out, "new\nobjects \n", ' and calls the right methods'); ($out, $err) = run_report ('owners', 'foo', 'bar'); -is ($err, "some error\n", 'Error handling succeeds for report owners'); +is ($err, "some error\n", 'Error handling succeeds for owners'); is ($out, "new\nowners foo bar\n", ' and calls the right methods'); # Test empty lists. $Wallet::Report::error = 0; $Wallet::Report::empty = 1; ($out, $err) = run_report ('acls'); -is ($err, '', 'list acls runs with an empty list and no errors'); +is ($err, '', 'acls runs with an empty list and no errors'); is ($out, "new\nacls \n", ' and calls the right methods'); +($out, $err) = run_report ('audit', 'objects', 'name'); +is ($err, '', 'audit runs with an empty list and no errors'); +is ($out, "new\naudit objects name\n", ' and calls the right methods'); ($out, $err) = run_report ('objects'); -is ($err, '', 'list objects runs with an empty list with no errors'); +is ($err, '', 'objects runs with an empty list with no errors'); is ($out, "new\nobjects \n", ' and calls the right methods'); ($out, $err) = run_report ('owners', 'foo', 'bar'); -is ($err, '', 'report owners runs with an empty list and no errors'); +is ($err, '', 'owners runs with an empty list and no errors'); is ($out, "new\nowners foo bar\n", ' and calls the right methods'); -- cgit v1.2.3 From acc73c988b845448230942de0f07263546763420 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Wed, 3 Mar 2010 22:44:53 -0800 Subject: Use L<> links instead of man page references for modules Do this only in the main text, not in the SEE ALSO section, since the latter is more for conventional man pages. This will produce better results for some POD to HTML converters (although not mine, yet). --- perl/Wallet/ACL/NetDB.pm | 4 ++-- perl/Wallet/Admin.pm | 4 ++-- perl/Wallet/Config.pm | 12 ++++++------ perl/Wallet/Database.pm | 4 ++-- perl/Wallet/Kadmin/Heimdal.pm | 4 ++-- perl/Wallet/Kadmin/MIT.pm | 4 ++-- perl/Wallet/Object/File.pm | 4 ++-- perl/Wallet/Object/Keytab.pm | 6 +++--- perl/Wallet/Report.pm | 4 ++-- perl/Wallet/Server.pm | 2 +- 10 files changed, 24 insertions(+), 24 deletions(-) (limited to 'perl/Wallet/Report.pm') diff --git a/perl/Wallet/ACL/NetDB.pm b/perl/Wallet/ACL/NetDB.pm index 2096ba8..0fb5a2c 100644 --- a/perl/Wallet/ACL/NetDB.pm +++ b/perl/Wallet/ACL/NetDB.pm @@ -23,7 +23,7 @@ use Wallet::Config; # This version should be increased on any code change to this module. Always # use two digits for the minor version with a leading zero if necessary so # that it will sort properly. -$VERSION = '0.04'; +$VERSION = '0.05'; ############################################################################## # Interface @@ -163,7 +163,7 @@ only if that principal has one of the roles user, admin, or team for that node. To use this object, several configuration parameters must be set. See -Wallet::Config(3) for details on those configuration parameters and +L for details on those configuration parameters and information about how to set wallet configuration. =head1 METHODS diff --git a/perl/Wallet/Admin.pm b/perl/Wallet/Admin.pm index e835713..f208e13 100644 --- a/perl/Wallet/Admin.pm +++ b/perl/Wallet/Admin.pm @@ -183,8 +183,8 @@ its actions. To use this object, several configuration variables must be set (at least the database configuration). For information on those variables and how -to set them, see Wallet::Config(3). For more information on the normal -user interface to the wallet server, see Wallet::Server(3). +to set them, see L. For more information on the normal +user interface to the wallet server, see L. =head1 CLASS METHODS diff --git a/perl/Wallet/Config.pm b/perl/Wallet/Config.pm index 2991361..c86fb80 100644 --- a/perl/Wallet/Config.pm +++ b/perl/Wallet/Config.pm @@ -90,7 +90,7 @@ Sets the Perl database driver to use for the wallet database. Common values would be C or C. Less common values would be C, C, or C. The appropriate DBD::* Perl module for the chosen driver must be installed and will be dynamically loaded by the -wallet. For more information, see DBI(3). +wallet. For more information, see L. This variable must be set. @@ -104,7 +104,7 @@ Sets the remaining contents for the DBI DSN (everything after the driver). Using this variable provides full control over the connect string passed to DBI. When using SQLite, set this variable to the path to the SQLite database. If this variable is set, DB_NAME, DB_HOST, and DB_PORT are -ignored. For more information, see DBI(3) and the documentation for the +ignored. For more information, see L and the documentation for the database driver you're using. Either DB_INFO or DB_NAME must be set. If you don't need to pass any @@ -119,7 +119,7 @@ our $DB_INFO; If DB_INFO is not set, specifies the database name. The third part of the DBI connect string will be set to C, possibly with a host and port appended if DB_HOST and DB_PORT are set. For more -information, see DBI(3) and the documentation for the database driver +information, see L and the documentation for the database driver you're using. Either DB_INFO or DB_NAME must be set. @@ -131,7 +131,7 @@ our $DB_NAME; =item DB_HOST If DB_INFO is not set, specifies the database host. C<;host=DB_HOST> will -be appended to the DBI connect string. For more information, see DBI(3) +be appended to the DBI connect string. For more information, see L and the documentation for the database driver you're using. =cut @@ -142,7 +142,7 @@ our $DB_HOST; If DB_PORT is not set, specifies the database port. C<;port=DB_PORT> will be appended to the DBI connect string. If this variable is set, DB_HOST -should also be set. For more information, see DBI(3) and the +should also be set. For more information, see L and the documentation for the database driver you're using. =cut @@ -179,7 +179,7 @@ C object type (the Wallet::Object::File class). =item FILE_BUCKET The directory into which to store file objects. File objects will be -stored in subdirectories of this directory. See Wallet::Object::File(3) +stored in subdirectories of this directory. See L for the full details of the naming scheme. This directory must be writable by the wallet server and the wallet server must be able to create subdirectories of it. diff --git a/perl/Wallet/Database.pm b/perl/Wallet/Database.pm index 7b3474a..7daab9f 100644 --- a/perl/Wallet/Database.pm +++ b/perl/Wallet/Database.pm @@ -39,7 +39,7 @@ use Wallet::Config; # This version should be increased on any code change to this module. Always # use two digits for the minor version with a leading zero if necessary so # that it will sort properly. -$VERSION = '0.02'; +$VERSION = '0.03'; ############################################################################## # Core overrides @@ -101,7 +101,7 @@ methods should work the same as in DBI and Wallet::Database objects should be usable exactly as if they were DBI objects. connect() will obtain the database connection information from the wallet -configuration; see Wallet::Config(3) for more details. It will also +configuration; see L for more details. It will also automatically set the RaiseError attribute to true and the PrintError and AutoCommit attributes to false, matching the assumptions made by the wallet database code. diff --git a/perl/Wallet/Kadmin/Heimdal.pm b/perl/Wallet/Kadmin/Heimdal.pm index d1eecda..658ac04 100644 --- a/perl/Wallet/Kadmin/Heimdal.pm +++ b/perl/Wallet/Kadmin/Heimdal.pm @@ -24,7 +24,7 @@ use Wallet::Kadmin (); # This version should be increased on any code change to this module. Always # use two digits for the minor version with a leading zero if necessary so # that it will sort properly. -$VERSION = '0.03'; +$VERSION = '0.04'; ############################################################################## # Utility functions @@ -254,7 +254,7 @@ Wallet::Kadmin::Heimdal - Wallet Kerberos administration API for Heimdal Wallet::Kadmin::Heimdal implements the Wallet::Kadmin API for Heimdal, providing an interface to create and delete principals and create keytabs. -It provides the API documented in Wallet::Kadmin(3) for a Heimdal KDC. +It provides the API documented in L for a Heimdal KDC. To use this class, several configuration parameters must be set. See L for details. diff --git a/perl/Wallet/Kadmin/MIT.pm b/perl/Wallet/Kadmin/MIT.pm index 434e93d..fc4d271 100644 --- a/perl/Wallet/Kadmin/MIT.pm +++ b/perl/Wallet/Kadmin/MIT.pm @@ -25,7 +25,7 @@ use Wallet::Kadmin (); # This version should be increased on any code change to this module. Always # use two digits for the minor version with a leading zero if necessary so # that it will sort properly. -$VERSION = '0.02'; +$VERSION = '0.03'; ############################################################################## # kadmin Interaction @@ -275,7 +275,7 @@ Wallet::Kadmin::MIT - Wallet Kerberos administration API for MIT Wallet::Kadmin::MIT implements the Wallet::Kadmin API for MIT Kerberos, providing an interface to create and delete principals and create keytabs. -It provides the API documented in Wallet::Kadmin(3) for an MIT Kerberos +It provides the API documented in L for an MIT Kerberos KDC. MIT Kerberos does not provide any method via the kadmin network protocol diff --git a/perl/Wallet/Object/File.pm b/perl/Wallet/Object/File.pm index c655b44..47c8ac2 100644 --- a/perl/Wallet/Object/File.pm +++ b/perl/Wallet/Object/File.pm @@ -24,7 +24,7 @@ use Wallet::Object::Base; # This version should be increased on any code change to this module. Always # use two digits for the minor version with a leading zero if necessary so # that it will sort properly. -$VERSION = '0.02'; +$VERSION = '0.03'; ############################################################################## # File naming @@ -159,7 +159,7 @@ it when the file object is deleted. A file object must be stored before it can be retrieved with get. To use this object, the configuration option specifying where on the -wallet server to store file objects must be set. See Wallet::Config(3) +wallet server to store file objects must be set. See L for details on this configuration parameter and information about how to set wallet configuration. diff --git a/perl/Wallet/Object/Keytab.pm b/perl/Wallet/Object/Keytab.pm index edb26b3..b7c2805 100644 --- a/perl/Wallet/Object/Keytab.pm +++ b/perl/Wallet/Object/Keytab.pm @@ -25,7 +25,7 @@ use Wallet::Kadmin; # This version should be increased on any code change to this module. Always # use two digits for the minor version with a leading zero if necessary so # that it will sort properly. -$VERSION = '0.08'; +$VERSION = '0.09'; ############################################################################## # Enctype restriction @@ -379,7 +379,7 @@ This implementation generates a new random key (and hence invalidates all existing keytabs) each time the keytab is retrieved with the get() method. To use this object, several configuration parameters must be set. See -Wallet::Config(3) for details on those configuration parameters and +L for details on those configuration parameters and information about how to set wallet configuration. =head1 METHODS @@ -456,7 +456,7 @@ configuration. If the principal already exists, create() still succeeds wallet). Otherwise, if the Kerberos principal could not be created, create() fails. The principal is created with the randomized keys. NAME must not contain the realm; instead, the KEYTAB_REALM configuration -variable should be set. See Wallet::Config(3) for more information. +variable should be set. See L for more information. If create() fails, it throws an exception. diff --git a/perl/Wallet/Report.pm b/perl/Wallet/Report.pm index ff4fa8b..462cd6f 100644 --- a/perl/Wallet/Report.pm +++ b/perl/Wallet/Report.pm @@ -360,8 +360,8 @@ tuples identifying objects, ACLs, or ACL entries. To use this object, several configuration variables must be set (at least the database configuration). For information on those variables and how -to set them, see Wallet::Config(3). For more information on the normal -user interface to the wallet server, see Wallet::Server(3). +to set them, see L. For more information on the normal +user interface to the wallet server, see L. =head1 CLASS METHODS diff --git a/perl/Wallet/Server.pm b/perl/Wallet/Server.pm index dd596c4..5f36c28 100644 --- a/perl/Wallet/Server.pm +++ b/perl/Wallet/Server.pm @@ -739,7 +739,7 @@ object. To use this object, several configuration variables must be set (at least the database configuration). For information on those variables and how -to set them, see Wallet::Config(3). +to set them, see L. =head1 CLASS METHODS -- cgit v1.2.3 From 0e3df4c4159650e6de7fdcf6a0f0b661f25c03f7 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Fri, 5 Mar 2010 16:56:47 -0800 Subject: Add a report of unused ACLs Add the acls unused report to wallet-report and Wallet::Report, returning all ACLs not referenced by any database objects. --- NEWS | 3 +++ perl/Wallet/Report.pm | 24 ++++++++++++++++++++---- perl/t/report.t | 37 ++++++++++++++++++++++++++++++++++++- server/wallet-report | 7 +++++++ 4 files changed, 66 insertions(+), 5 deletions(-) (limited to 'perl/Wallet/Report.pm') diff --git a/NEWS b/NEWS index 03fe99b..e41b86e 100644 --- a/NEWS +++ b/NEWS @@ -12,6 +12,9 @@ wallet 0.11 (unreleased) which returns all objects that do not pass the local naming policy. The corresponding Wallet::Report method is audit(). + Add the acls unused report to wallet-report and Wallet::Report, + returning all ACLs not referenced by any database objects. + Wallet::Config::verify_name may now be called with an undefined third argument (normally the user attempting to create an object). This calling convention is used when auditing, and the local policy diff --git a/perl/Wallet/Report.pm b/perl/Wallet/Report.pm index 462cd6f..f6e6753 100644 --- a/perl/Wallet/Report.pm +++ b/perl/Wallet/Report.pm @@ -195,7 +195,8 @@ sub acls_all { sub acls_empty { my ($self) = @_; my $sql = 'select ac_id, ac_name from acls left join acl_entries - on (acls.ac_id = acl_entries.ae_id) where ae_id is null'; + on (acls.ac_id = acl_entries.ae_id) where ae_id is null order by + ac_id'; return ($sql); } @@ -210,6 +211,18 @@ sub acls_entry { return ($sql, $type, '%' . $identifier . '%'); } +# Returns the SQL statement required to find unused ACLs. +sub acls_unused { + my ($self) = @_; + my $sql = 'select ac_id, ac_name from acls where not ac_id in (select + ob_owner from objects where ob_owner = ac_id)'; + for my $acl (qw/get store show destroy flags/) { + $sql .= " and not ac_id in (select ob_acl_$acl from objects where + ob_acl_$acl = ac_id)"; + } + return ($sql); +} + # Returns a list of all ACLs stored in the wallet database as a list of pairs # of ACL IDs and ACL names, possibly limited by some criteria. On error and # for an empty database, the empty list will be returned. To distinguish @@ -234,8 +247,10 @@ sub acls { } } elsif ($type eq 'empty') { ($sql) = $self->acls_empty; + } elsif ($type eq 'unused') { + ($sql) = $self->acls_unused; } else { - $self->error ("do not know search type: $type"); + $self->error ("unknown search type: $type"); return; } } @@ -387,11 +402,12 @@ between an empty report and an error. Returns a list of all ACLs matching a search type and string in the database, or all ACLs if no search information is given. There are -currently two search types. C takes no arguments and will return +currently three search types. C takes no arguments and will return only those ACLs that have no entries within them. C takes two arguments, an entry scheme and a (possibly partial) entry identifier, and will return any ACLs containing an entry with that scheme and with an -identifier containing that value. +identifier containing that value. C returns all ACLs that are not +referenced by any object. The return value is a list of references to pairs of ACL ID and name. For example, if there are two ACLs in the database, one with name C and diff --git a/perl/t/report.t b/perl/t/report.t index 3b94d00..b283576 100755 --- a/perl/t/report.t +++ b/perl/t/report.t @@ -7,7 +7,7 @@ # # See LICENSE for licensing terms. -use Test::More tests => 88; +use Test::More tests => 148; use Wallet::Admin; use Wallet::Report; @@ -166,6 +166,41 @@ is ($server->flag_clear ('base', 'service/admin', 'unchanging'), 1, is (scalar (@lines), 0, ' and now there are no objects in the report'); is ($report->error, undef, ' with no error'); +# All of our ACLs should be in use. +@lines = $report->acls ('unused'); +is (scalar (@lines), 0, 'Searching for unused ACLs returns nothing'); +is ($report->error, undef, ' with no error'); + +# Create some unused ACLs that should show up in the report. +is ($server->acl_create ('third'), 1, 'Creating an empty ACL succeeds'); +is ($server->acl_create ('fourth'), 1, ' and creating another succeeds'); +@lines = $report->acls ('unused'); +is (scalar (@lines), 2, ' and now we see two unused ACLs'); +is ($server->error, undef, ' with no error'); +is ($lines[0][0], 4, ' and the first has the right ID'); +is ($lines[0][1], 'third', ' and the right name'); +is ($lines[1][0], 5, ' and the second has the right ID'); +is ($lines[1][1], 'fourth', ' and the right name'); + +# Use one of those ACLs and ensure it drops out of the report. Test that we +# try all of the possible ACL types. +for my $type (qw/get store show destroy flags/) { + is ($server->acl ('base', 'service/admin', $type, 'fourth'), 1, + "Setting ACL $type to fourth succeeds"); + @lines = $report->acls ('unused'); + is (scalar (@lines), 1, ' and now we see only one unused ACL'); + is ($lines[0][0], 4, ' with the right ID'); + is ($lines[0][1], 'third', ' and the right name'); + is ($server->acl ('base', 'service/admin', $type, ''), 1, + ' and clearing the ACL succeeds'); + @lines = $report->acls ('unused'); + is (scalar (@lines), 2, ' and now we see two unused ACLs'); + is ($lines[0][0], 4, ' and the first has the right ID'); + is ($lines[0][1], 'third', ' and the right name'); + is ($lines[1][0], 5, ' and the second has the right ID'); + is ($lines[1][1], 'fourth', ' and the right name'); +} + # The naming audit returns nothing if there's no naming policy. @lines = $report->audit ('objects', 'name'); is (scalar (@lines), 0, 'Searching for naming violations finds none'); diff --git a/server/wallet-report b/server/wallet-report index 610e278..2b7cd45 100755 --- a/server/wallet-report +++ b/server/wallet-report @@ -110,6 +110,8 @@ B takes no traditional options. =item acls entry +=item acls unused + Returns a list of ACLs in the database. ACLs will be listed in the form: (ACL ID: ) @@ -137,6 +139,11 @@ Returns all ACLs containing an entry with given scheme and identifier. The scheme must be an exact match, but the string will match any identifier containing that string. +=item acls unused + +Returns all ACLs that are not referenced by any of the objects in the +wallet database, either as an owner or on one of the more specific ACLs. + =back =item audit objects name -- cgit v1.2.3 From bc105004b8e88e1ede75dae0028d3ef10c15b57a Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Mon, 8 Mar 2010 10:19:03 -0800 Subject: Add an ACL name audit to wallet-report and Wallet::Report Parallel to objects name, add an acls name audit that returns all ACLs that do not follow the site naming standard. --- NEWS | 7 ++++--- perl/Wallet/Config.pm | 8 ++++++++ perl/Wallet/Report.pm | 33 ++++++++++++++++++++++++--------- perl/t/report.t | 17 ++++++++++++++++- server/wallet-report | 26 +++++++++++++++++++------- tests/server/report-t | 16 +++++++++++++--- 6 files changed, 84 insertions(+), 23 deletions(-) (limited to 'perl/Wallet/Report.pm') diff --git a/NEWS b/NEWS index 1f63e07..6744475 100644 --- a/NEWS +++ b/NEWS @@ -13,9 +13,10 @@ wallet 0.11 (unreleased) set, it is called for any ACL creation or rename and can reject the new ACL name. - Add an audit command to wallet-report and one audit: objects name, - which returns all objects that do not pass the local naming policy. - The corresponding Wallet::Report method is audit(). + Add an audit command to wallet-report and two audits: acls name, which + returns all ACLs that do not pass the local naming policy, and objects + name, which does the same for objects. The corresponding + Wallet::Report method is audit(). Add the acls unused report to wallet-report and Wallet::Report, returning all ACLs not referenced by any database objects. diff --git a/perl/Wallet/Config.pm b/perl/Wallet/Config.pm index e4014a1..23a051d 100644 --- a/perl/Wallet/Config.pm +++ b/perl/Wallet/Config.pm @@ -563,6 +563,14 @@ empty string, object creation will be allowed. If it returns anything else, object creation is rejected and the return value is used as the error message. +This function is also called for naming audits done via Wallet::Report to +find any existing objects that violate a (possibly updated) naming policy. +In this case, the second argument (the identity of the person creating the +ACL) will be undef. As a general rule, if the second argument is undef, +the function should apply the most liberal accepted naming policy so that +the audit returns only ACLs that violate all naming policies, but some +sites may wish different results for their audit reports. + Please note that this return status is backwards from what one would normally expect. A false value is success; a true value is failure with an error message. diff --git a/perl/Wallet/Report.pm b/perl/Wallet/Report.pm index f6e6753..c743060 100644 --- a/perl/Wallet/Report.pm +++ b/perl/Wallet/Report.pm @@ -310,10 +310,10 @@ sub owners { ############################################################################## # Audit the database for violations of local policy. Returns a list of -# objects (as type and name pairs) or a list of ACLs. On error and for no -# matching entries, the empty list will be returned. To distinguish between -# an empty return and an error, call error(), which will return undef if there -# was no error. +# objects (as type and name pairs) or a list of ACLs (as ID and name pairs). +# On error and for no matching entries, the empty list will be returned. To +# distinguish between an empty return and an error, call error(), which will +# return undef if there was no error. sub audit { my ($self, $type, $audit) = @_; undef $self->{error}; @@ -336,6 +336,20 @@ sub audit { $self->error ("unknown object audit: $audit"); return; } + } elsif ($type eq 'acls') { + if ($audit eq 'name') { + return unless defined &Wallet::Config::verify_acl_name; + my @acls = $self->acls; + my @results; + for my $acl (@acls) { + my $error = Wallet::Config::verify_acl_name ($acl->[1]); + push (@results, $acl) if $error; + } + return @results; + } else { + $self->error ("unknown acl audit: $audit"); + return; + } } else { $self->error ("unknown audit type: $type"); return; @@ -424,11 +438,12 @@ the error message if there was an error and undef if there was no error. Audits the wallet database for violations of local policy. TYPE is the general class of thing to audit, and AUDIT is the specific audit to -perform. Currently, the only implemented type is C and the only -audit is C. This returns a list of all objects, as references to -pairs of type and name, that are not accepted by the verify_name() -function defined in the wallet configuration. See L for -more information. +perform. TYPE may be either C or C. Currently, the only +implemented audit is C. This returns a list of all objects, as +references to pairs of type and name, or ACLs, as references to pairs of +ID and name, that are not accepted by the verify_name() or +verify_acl_name() function defined in the wallet configuration. See +L for more information. Returns the empty list on failure. An error can be distinguished from empty search results by calling error(). error() is guaranteed to return diff --git a/perl/t/report.t b/perl/t/report.t index b283576..1dc69f7 100755 --- a/perl/t/report.t +++ b/perl/t/report.t @@ -7,7 +7,7 @@ # # See LICENSE for licensing terms. -use Test::More tests => 148; +use Test::More tests => 151; use Wallet::Admin; use Wallet::Report; @@ -224,6 +224,21 @@ is (scalar (@lines), 1, 'Searching for naming violations finds one'); is ($lines[0][0], 'base', ' and the first has the right type'); is ($lines[0][1], 'service/admin', ' and the right name'); +# Set an ACL naming policy and then look for objects that fail that policy. +# Use the same deactivation trick as above. +package Wallet::Config; +sub verify_acl_name { + my ($name) = @_; + return unless $naming_active; + return 'second not allowed' if $name eq 'second'; + return; +} +package main; +@lines = $report->audit ('acls', 'name'); +is (scalar (@lines), 1, 'Searching for ACL naming violations finds one'); +is ($lines[0][0], 3, ' and the first has the right ID'); +is ($lines[0][1], 'second', ' and the right name'); + # Clean up. $admin->destroy; unlink 'wallet-db'; diff --git a/server/wallet-report b/server/wallet-report index 2b7cd45..435fb73 100755 --- a/server/wallet-report +++ b/server/wallet-report @@ -38,12 +38,16 @@ sub command { } elsif ($command eq 'audit') { die "too many arguments to audit\n" if @args > 2; die "too few arguments to audit\n" if @args < 2; - my @objects = $report->audit (@args); - if (!@objects and $report->error) { + my @result = $report->audit (@args); + if (!@result and $report->error) { die $report->error, "\n"; } - for my $object (@objects) { - print join (' ', @$object), "\n"; + for my $item (@result) { + if ($args[0] eq 'acls') { + print "$$item[1] (ACL ID: $$item[0])\n"; + } else { + print join (' ', @$item), "\n"; + } } } elsif ($command eq 'objects') { die "too many arguments to objects\n" if @args > 2; @@ -146,14 +150,22 @@ wallet database, either as an owner or on one of the more specific ACLs. =back +=item audit acls name + =item audit objects name -Returns all objects that violate the current site naming policy. Objects -will be listed in the form: +Returns all ACLs or objects that violate the current site naming policy. +Objects will be listed in the form: -There will be one line per object. +and ACLs in the form: + + (ACL ID: ) + +where is the human-readable name and is the numeric ID. The +numeric ID is what's used internally by the wallet system. There will be +one line per object or ACL. =item objects diff --git a/tests/server/report-t b/tests/server/report-t index 61cfd9b..394a869 100755 --- a/tests/server/report-t +++ b/tests/server/report-t @@ -8,7 +8,7 @@ # See LICENSE for licensing terms. use strict; -use Test::More tests => 42; +use Test::More tests => 44; # Create a dummy class for Wallet::Report that prints what method was called # with its arguments and returns data for testing. @@ -42,7 +42,13 @@ sub audit { shift; print "audit @_\n"; return if ($error or $empty); - return ([ file => 'unix-wallet-password' ]); + if ($_[0] eq 'objects') { + return ([ file => 'unix-wallet-password' ]); + } elsif ($_[0] eq 'acls') { + return ([ 2, 'group/admins' ]); + } else { + return; + } } sub objects { @@ -119,9 +125,13 @@ is ($out, "new\nacls entry foo foo\n" . "ADMIN (ACL ID: 1)\ngroup/admins (ACL ID: 2)\ngroup/users (ACL ID: 4)\n", ' and returns the right output'); ($out, $err) = run_report ('audit', 'objects', 'name'); -is ($err, '', 'Audit report succeeds'); +is ($err, '', 'Object audit report succeeds'); is ($out, "new\naudit objects name\nfile unix-wallet-password\n", ' and returns the right output'); +($out, $err) = run_report ('audit', 'acls', 'name'); +is ($err, '', 'ACL audit report succeeds'); +is ($out, "new\naudit acls name\ngroup/admins (ACL ID: 2)\n", + ' and returns the right output'); ($out, $err) = run_report ('objects'); is ($err, '', 'List succeeds for objects'); is ($out, "new\nobjects \n" -- cgit v1.2.3 From 7bed6b6110af7532fc4a49cdb425f7f668e17c21 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Wed, 12 May 2010 11:32:31 -0700 Subject: Add a report of all objects that have never been downloaded Add a objects unused report to wallet-report and Wallet::Report, returning all objects that have never been downloaded (in other words, have never been the target of a get command). --- NEWS | 6 ++++++ TODO | 2 +- perl/Wallet/Report.pm | 20 ++++++++++++++++---- perl/t/report.t | 51 ++++++++++++++++++++++++++++++++++++++++++++++++++- server/wallet-report | 7 +++++++ 5 files changed, 80 insertions(+), 6 deletions(-) (limited to 'perl/Wallet/Report.pm') diff --git a/NEWS b/NEWS index f9d4a9a..79a24d1 100644 --- a/NEWS +++ b/NEWS @@ -1,5 +1,11 @@ User-Visible wallet Changes +wallet 0.12 (unreleased) + + Add a objects unused report to wallet-report and Wallet::Report, + returning all objects that have never been downloaded (in other words, + have never been the target of a get command). + wallet 0.11 (2010-03-08) When deleting an ACL on the server, verify that the ACL is not diff --git a/TODO b/TODO index 1e9f3c9..06521cd 100644 --- a/TODO +++ b/TODO @@ -137,7 +137,7 @@ Reports: previous versions before ACL deletion was checked with database backends that don't do referential integrity. - * Add report for all objects that have never been stored or downloaded. + * Add report for all objects that have never been stored. * Add report of all ACLs with identical contents. diff --git a/perl/Wallet/Report.pm b/perl/Wallet/Report.pm index c743060..64418ee 100644 --- a/perl/Wallet/Report.pm +++ b/perl/Wallet/Report.pm @@ -20,7 +20,7 @@ use Wallet::Database; # This version should be increased on any code change to this module. Always # use two digits for the minor version with a leading zero if necessary so # that it will sort properly. -$VERSION = '0.02'; +$VERSION = '0.03'; ############################################################################## # Constructor, destructor, and accessors @@ -128,6 +128,15 @@ sub objects_acl { return ($sql, ($acl->id) x 6); } +# Return the SQL statement to find all objects that have been created but +# have never been retrieved (via get). +sub objects_unused { + my ($self) = @_; + my $sql = 'select ob_type, ob_name from objects where ob_downloaded_on + is null order by objects.ob_type, objects.ob_name'; + return ($sql); +} + # Returns a list of all objects stored in the wallet database in the form of # type and name pairs. On error and for an empty database, the empty list # will be returned. To distinguish between an empty list and an error, call @@ -144,7 +153,7 @@ sub objects { if (!defined $type || $type eq '') { ($sql) = $self->objects_all; } else { - if (@args != 1) { + if ($type ne 'unused' && @args != 1) { $self->error ("object searches require one argument to search"); } elsif ($type eq 'type') { ($sql, @search) = $self->objects_type (@args); @@ -154,6 +163,8 @@ sub objects { ($sql, @search) = $self->objects_flag (@args); } elsif ($type eq 'acl') { ($sql, @search) = $self->objects_acl (@args); + } elsif ($type eq 'unused') { + ($sql) = $self->objects_unused (@args); } else { $self->error ("do not know search type: $type"); } @@ -461,13 +472,14 @@ Returns a list of all objects matching a search type and string in the database, or all objects in the database if no search information is given. -There are four types of searches currently. C, with a given type, +There are five types of searches currently. C, with a given type, will return only those entries where the type matches the given type. C, with a given owner, will only return those objects owned by the given ACL name or ID. C, with a given flag name, will only return those items with a flag set to the given value. C operates like C, but will return only those objects that have the given ACL name -or ID on any of the possible ACL settings, not just owner. +or ID on any of the possible ACL settings, not just owner. C will +return all entries for which a get command has never been issued. The return value is a list of references to pairs of type and name. For example, if two objects existed in the database, both of type C diff --git a/perl/t/report.t b/perl/t/report.t index 1dc69f7..00636db 100755 --- a/perl/t/report.t +++ b/perl/t/report.t @@ -7,7 +7,7 @@ # # See LICENSE for licensing terms. -use Test::More tests => 151; +use Test::More tests => 179; use Wallet::Admin; use Wallet::Report; @@ -49,6 +49,12 @@ is (scalar (@objects), 1, ' and now there is one object'); is ($objects[0][0], 'base', ' with the right type'); is ($objects[0][1], 'service/admin', ' and the right name'); +# That object should be unused. +@objects = $report->objects ('unused'); +is (scalar (@objects), 1, ' and that object is unused'); +is ($objects[0][0], 'base', ' with the right type'); +is ($objects[0][1], 'service/admin', ' and the right name'); + # Create another ACL. is ($server->acl_create ('first'), 1, 'ACL creation succeeds'); @acls = $report->acls; @@ -97,6 +103,14 @@ is (scalar (@lines), 1, ' and there is still owner in the report'); is ($lines[0][0], 'krb5', ' with the right scheme'); is ($lines[0][1], 'admin@EXAMPLE.COM', ' and the right identifier'); +# Both objects should now show as unused. +@objects = $report->objects ('unused'); +is (scalar (@objects), 2, 'There are now two unused objects'); +is ($objects[0][0], 'base', ' and the first has the right type'); +is ($objects[0][1], 'service/admin', ' and the right name'); +is ($objects[1][0], 'base', ' and the second has the right type'); +is ($objects[1][1], 'service/foo', ' and the right name'); + # Change the owner of the second object to an empty ACL. is ($server->owner ('base', 'service/foo', 'second'), 1, ' and changing the owner to an empty ACL works'); @@ -239,6 +253,41 @@ is (scalar (@lines), 1, 'Searching for ACL naming violations finds one'); is ($lines[0][0], 3, ' and the first has the right ID'); is ($lines[0][1], 'second', ' and the right name'); +# Set up a file bucket so that we can create an object we can retrieve. +system ('rm -rf test-files') == 0 or die "cannot remove test-files\n"; +mkdir 'test-files' or die "cannot create test-files: $!\n"; +$Wallet::Config::FILE_BUCKET = 'test-files'; + +# Create a file object and ensure that it shows up in the unused list. +is ($server->create ('file', 'test'), 1, 'Creating file:test succeeds'); +is ($server->owner ('file', 'test', 'ADMIN'), 1, + ' and setting its owner works'); +@objects = $report->objects ('unused'); +is (scalar (@objects), 4, 'There are now four unused objects'); +is ($objects[0][0], 'base', ' and the first has the right type'); +is ($objects[0][1], 'service/admin', ' and the right name'); +is ($objects[1][0], 'base', ' and the second has the right type'); +is ($objects[1][1], 'service/foo', ' and the right name'); +is ($objects[2][0], 'base', ' and the third has the right type'); +is ($objects[2][1], 'service/null', ' and the right name'); +is ($objects[3][0], 'file', ' and the fourth has the right type'); +is ($objects[3][1], 'test', ' and the right name'); + +# Store something and retrieve it, and then check that the file object fell +# off of the list. +is ($server->store ('file', 'test', 'Some data'), 1, + 'Storing data in file:test succeeds'); +is ($server->get ('file', 'test'), 'Some data', ' and retrieving it works'); +@objects = $report->objects ('unused'); +is (scalar (@objects), 3, ' and now there are three unused objects'); +is ($objects[0][0], 'base', ' and the first has the right type'); +is ($objects[0][1], 'service/admin', ' and the right name'); +is ($objects[1][0], 'base', ' and the second has the right type'); +is ($objects[1][1], 'service/foo', ' and the right name'); +is ($objects[2][0], 'base', ' and the third has the right type'); +is ($objects[2][1], 'service/null', ' and the right name'); + # Clean up. $admin->destroy; unlink 'wallet-db'; +system ('rm -r test-files') == 0 or die "cannot remove test-files\n"; diff --git a/server/wallet-report b/server/wallet-report index 435fb73..28d5b9a 100755 --- a/server/wallet-report +++ b/server/wallet-report @@ -177,6 +177,8 @@ one line per object or ACL. =item objects type +=item objects unused + Returns a list of objects in the database. Objects will be listed in the form: @@ -210,6 +212,11 @@ Returns all objects owned by the given ACL name or ID. Returns all objects of the given type. +=item objects unused + +Returns all objects that have never been downloaded (have never been the +target of a get command). + =back =item owners -- cgit v1.2.3 From 4dbf126b079d87639d0a463770c3e72b5b53d5d1 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 18 May 2010 16:44:38 -0700 Subject: Add acls duplicate report Add an acls duplicate report to wallet-report and Wallet::Report, returning sets of ACLs that have exactly the same entries. --- NEWS | 3 ++ perl/Wallet/Report.pm | 81 +++++++++++++++++++++++++++++++++++++++++++-------- perl/t/report.t | 36 ++++++++++++++++++++++- server/wallet-report | 25 ++++++++++++++-- tests/server/report-t | 10 ++++++- 5 files changed, 138 insertions(+), 17 deletions(-) (limited to 'perl/Wallet/Report.pm') diff --git a/NEWS b/NEWS index 79a24d1..738459b 100644 --- a/NEWS +++ b/NEWS @@ -6,6 +6,9 @@ wallet 0.12 (unreleased) returning all objects that have never been downloaded (in other words, have never been the target of a get command). + Add an acls duplicate report to wallet-report and Wallet::Report, + returning sets of ACLs that have exactly the same entries. + wallet 0.11 (2010-03-08) When deleting an ACL on the server, verify that the ACL is not diff --git a/perl/Wallet/Report.pm b/perl/Wallet/Report.pm index 64418ee..5a8dc52 100644 --- a/perl/Wallet/Report.pm +++ b/perl/Wallet/Report.pm @@ -15,6 +15,7 @@ require 5.006; use strict; use vars qw($VERSION); +use Wallet::ACL; use Wallet::Database; # This version should be increased on any code change to this module. Always @@ -234,6 +235,52 @@ sub acls_unused { return ($sql); } +# Obtain a textual representation of the membership of an ACL, returning undef +# on error and setting the internal error. +sub acl_membership { + my ($self, $id) = @_; + my $acl = eval { Wallet::ACL->new ($id, $self->{dbh}) }; + if ($@) { + $self->error ($@); + return; + } + my @members = map { "$_->[0] $_->[1]" } $acl->list; + if (!@members && $acl->error) { + $self->error ($acl->error); + return; + } + return join ("\n", @members); +} + +# Duplicate ACL detection unfortunately needs to do something more complex +# than just return a SQL statement, so it's handled differently than other +# reports. All the work is done here and the results returned as a list of +# sets of duplicates. +sub acls_duplicate { + my ($self) = @_; + my @acls = sort map { $_->[1] } $self->acls; + return if (!@acls && $self->{error}); + return if @acls < 2; + my %result; + for my $i (0 .. ($#acls - 1)) { + my $members = $self->acl_membership ($acls[$i]); + return unless defined $members; + for my $j (($i + 1) .. $#acls) { + my $check = $self->acl_membership ($acls[$j]); + return unless defined $check; + if ($check eq $members) { + $result{$acls[$i]} ||= []; + push (@{ $result{$acls[$i]} }, $acls[$j]); + } + } + } + my @result; + for my $acl (sort keys %result) { + push (@result, [ $acl, sort @{ $result{$acl} } ]); + } + return @result; +} + # Returns a list of all ACLs stored in the wallet database as a list of pairs # of ACL IDs and ACL names, possibly limited by some criteria. On error and # for an empty database, the empty list will be returned. To distinguish @@ -249,7 +296,9 @@ sub acls { if (!defined $type || $type eq '') { ($sql) = $self->acls_all; } else { - if ($type eq 'entry') { + if ($type eq 'duplicate') { + return $self->acls_duplicate; + } elsif ($type eq 'entry') { if (@args == 0) { $self->error ('ACL searches require an argument to search'); return; @@ -427,20 +476,28 @@ between an empty report and an error. Returns a list of all ACLs matching a search type and string in the database, or all ACLs if no search information is given. There are -currently three search types. C takes no arguments and will return -only those ACLs that have no entries within them. C takes two -arguments, an entry scheme and a (possibly partial) entry identifier, and -will return any ACLs containing an entry with that scheme and with an -identifier containing that value. C returns all ACLs that are not -referenced by any object. - -The return value is a list of references to pairs of ACL ID and name. For -example, if there are two ACLs in the database, one with name C and -ID 1 and one with name C and ID 3, acls() with no arguments -would return: +currently four search types. C returns sets of duplicate ACLs +(ones with exactly the same entries). C takes no arguments and +will return only those ACLs that have no entries within them. C +takes two arguments, an entry scheme and a (possibly partial) entry +identifier, and will return any ACLs containing an entry with that scheme +and with an identifier containing that value. C returns all ACLs +that are not referenced by any object. + +The return value for everything except C is a list of +references to pairs of ACL ID and name. For example, if there are two +ACLs in the database, one with name C and ID 1 and one with name +C and ID 3, acls() with no arguments would return: ([ 1, 'ADMIN' ], [ 3, 'group/admins' ]) +The return value for the C search is sets of ACL names that are +duplicates (have the same entries). For example, if C, C, and +C are all duplicates, and C and C are also duplicates, the +result would be: + + ([ 'd1', 'd2', 'd3' ], [ 'o1', 'o2' ]) + Returns the empty list on failure. An error can be distinguished from empty search results by calling error(). error() is guaranteed to return the error message if there was an error and undef if there was no error. diff --git a/perl/t/report.t b/perl/t/report.t index 00636db..363db20 100755 --- a/perl/t/report.t +++ b/perl/t/report.t @@ -7,7 +7,7 @@ # # See LICENSE for licensing terms. -use Test::More tests => 179; +use Test::More tests => 197; use Wallet::Admin; use Wallet::Report; @@ -287,6 +287,40 @@ is ($objects[1][1], 'service/foo', ' and the right name'); is ($objects[2][0], 'base', ' and the third has the right type'); is ($objects[2][1], 'service/null', ' and the right name'); +# The third and fourth ACLs are both empty and should show up as duplicate. +@acls = $report->acls ('duplicate'); +is (scalar (@acls), 1, 'There is one set of duplicate ACLs'); +is (scalar (@{ $acls[0] }), 2, ' with two members'); +is ($acls[0][0], 'fourth', ' and the first member is correct'); +is ($acls[0][1], 'third', ' and the second member is correct'); + +# Add the same line to both ACLs. They should still show up as duplicate. +is ($server->acl_add ('fourth', 'base', 'bar'), 1, + 'Adding a line to the fourth ACL works'); +is ($server->acl_add ('third', 'base', 'bar'), 1, + ' and adding a line to the third ACL works'); +@acls = $report->acls ('duplicate'); +is (scalar (@acls), 1, 'There is one set of duplicate ACLs'); +is (scalar (@{ $acls[0] }), 2, ' with two members'); +is ($acls[0][0], 'fourth', ' and the first member is correct'); +is ($acls[0][1], 'third', ' and the second member is correct'); + +# Add another line to the third ACL. Now we match second. +is ($server->acl_add ('third', 'base', 'foo'), 1, + 'Adding another line to the third ACL works'); +@acls = $report->acls ('duplicate'); +is (scalar (@acls), 1, 'There is one set of duplicate ACLs'); +is (scalar (@{ $acls[0] }), 2, ' with two members'); +is ($acls[0][0], 'second', ' and the first member is correct'); +is ($acls[0][1], 'third', ' and the second member is correct'); + +# Add yet another line to the third ACL. Now all ACLs are distinct. +is ($server->acl_add ('third', 'base', 'baz'), 1, + 'Adding another line to the third ACL works'); +@acls = $report->acls ('duplicate'); +is (scalar (@acls), 0, 'There are no duplicate ACLs'); +is ($report->error, undef, ' and no error'); + # Clean up. $admin->destroy; unlink 'wallet-db'; diff --git a/server/wallet-report b/server/wallet-report index 28d5b9a..466fe46 100755 --- a/server/wallet-report +++ b/server/wallet-report @@ -32,8 +32,14 @@ sub command { if (!@acls and $report->error) { die $report->error, "\n"; } - for my $acl (sort { $$a[1] cmp $$b[1] } @acls) { - print "$$acl[1] (ACL ID: $$acl[0])\n"; + if (@args && $args[0] eq 'duplicate') { + for my $group (@acls) { + print join (' ', @$group), "\n"; + } + } else { + for my $acl (sort { $$a[1] cmp $$b[1] } @acls) { + print "$$acl[1] (ACL ID: $$acl[0])\n"; + } } } elsif ($command eq 'audit') { die "too many arguments to audit\n" if @args > 2; @@ -110,13 +116,16 @@ B takes no traditional options. =item acls +=item acls duplicate + =item acls empty =item acls entry =item acls unused -Returns a list of ACLs in the database. ACLs will be listed in the form: +Returns a list of ACLs in the database. Except for the C +report, ACLs will be listed in the form: (ACL ID: ) @@ -124,6 +133,10 @@ where is the human-readable name and is the numeric ID. The numeric ID is what's used internally by the wallet system. There will be one line per ACL. +For the C report, the output will instead be one duplicate set +per line. This will be a set of ACLs that all have the same entries. +Only the names will be given, separated by spaces. + If no search type is given, all the ACLs in the database will be returned. If a search type (and possible search arguments) are given, then the ACLs will be limited to those that match the search. @@ -132,6 +145,12 @@ The currently supported ACL search types are: =over 4 +=item acls duplicate + +Returns all sets of ACLs that are duplicates, meaning that they contain +exactly the same entries. Each line will be the names of the ACLs in a +set of duplicates, separated by spaces. + =item acls empty Returns all ACLs which have no entries, generally so that abandoned ACLs diff --git a/tests/server/report-t b/tests/server/report-t index 394a869..0771946 100755 --- a/tests/server/report-t +++ b/tests/server/report-t @@ -8,7 +8,7 @@ # See LICENSE for licensing terms. use strict; -use Test::More tests => 44; +use Test::More tests => 48; # Create a dummy class for Wallet::Report that prints what method was called # with its arguments and returns data for testing. @@ -35,6 +35,7 @@ sub acls { shift; print "acls @_\n"; return if ($error or $empty); + return ([ qw/d1 d2 d3/ ], [ qw/o1 o2/ ]) if (@_ && $_[0] eq 'duplicate'); return ([ 1, 'ADMIN' ], [ 2, 'group/admins' ], [ 4, 'group/users' ]); } @@ -119,6 +120,10 @@ is ($err, '', 'List succeeds for ACLs'); is ($out, "new\nacls \n" . "ADMIN (ACL ID: 1)\ngroup/admins (ACL ID: 2)\ngroup/users (ACL ID: 4)\n", ' and returns the right output'); +($out, $err) = run_report ('acls', 'duplicate'); +is ($err, '', 'Duplicate report succeeds for ACLs'); +is ($out, "new\nacls duplicate\nd1 d2 d3\no1 o2\n", + ' and returns the right output'); ($out, $err) = run_report ('acls', 'entry', 'foo', 'foo'); is ($err, '', 'List succeeds for ACLs'); is ($out, "new\nacls entry foo foo\n" @@ -168,6 +173,9 @@ $Wallet::Report::empty = 1; ($out, $err) = run_report ('acls'); is ($err, '', 'acls runs with an empty list and no errors'); is ($out, "new\nacls \n", ' and calls the right methods'); +($out, $err) = run_report ('acls', 'duplicate'); +is ($err, '', 'acls duplicate runs with an empty list and no errors'); +is ($out, "new\nacls duplicate\n", ' and calls the right methods'); ($out, $err) = run_report ('audit', 'objects', 'name'); is ($err, '', 'audit runs with an empty list and no errors'); is ($out, "new\naudit objects name\n", ' and calls the right methods'); -- cgit v1.2.3 From 593e9b1e100ace54d1d9da7eb16e60f4e37c34ff Mon Sep 17 00:00:00 2001 From: Jon Robertson Date: Sun, 2 Dec 2012 22:07:16 -0800 Subject: Moved the Perl wallet modules and tests to DBIx::Class Moved all the Perl code to use DBIx::Class for the database interface. This includes updating all database calls, how the schema is generated and maintained, and the tests in places where some output has changed. We also remove the schema.t test, as the tests for it are more covered in the admin.t tests now. Change-Id: Ie5083432d09a0d9fe364a61c31378b77aa7b3cb7 Reviewed-on: https://gerrit.stanford.edu/598 Reviewed-by: Russ Allbery Tested-by: Russ Allbery --- perl/Wallet/ACL.pm | 196 +++++++++-------- perl/Wallet/Admin.pm | 102 +++++++-- perl/Wallet/Config.pm | 10 + perl/Wallet/Database.pm | 27 +-- perl/Wallet/Object/Base.pm | 318 ++++++++++++++++------------ perl/Wallet/Object/Keytab.pm | 116 +++++----- perl/Wallet/Report.pm | 298 +++++++++++++++++--------- perl/Wallet/Schema.pm | 282 ++++++------------------ perl/Wallet/Schema/Result/Acl.pm | 99 +++++++++ perl/Wallet/Schema/Result/AclEntry.pm | 63 ++++++ perl/Wallet/Schema/Result/AclHistory.pm | 101 +++++++++ perl/Wallet/Schema/Result/AclScheme.pm | 73 +++++++ perl/Wallet/Schema/Result/Enctype.pm | 34 +++ perl/Wallet/Schema/Result/Flag.pm | 54 +++++ perl/Wallet/Schema/Result/KeytabEnctype.pm | 42 ++++ perl/Wallet/Schema/Result/KeytabSync.pm | 42 ++++ perl/Wallet/Schema/Result/Object.pm | 258 ++++++++++++++++++++++ perl/Wallet/Schema/Result/ObjectHistory.pm | 127 +++++++++++ perl/Wallet/Schema/Result/SyncTarget.pm | 40 ++++ perl/Wallet/Schema/Result/Type.pm | 64 ++++++ perl/Wallet/Server.pm | 19 +- perl/create-ddl | 93 ++++++++ perl/sql/Wallet-Schema-0.07-0.08-MySQL.sql | 7 + perl/sql/Wallet-Schema-0.07-0.08-SQLite.sql | 6 + perl/sql/Wallet-Schema-0.07-MySQL.sql | 211 ++++++++++++++++++ perl/sql/Wallet-Schema-0.07-SQLite.sql | 219 +++++++++++++++++++ perl/sql/Wallet-Schema-0.08-MySQL.sql | 193 +++++++++++++++++ perl/sql/Wallet-Schema-0.08-PostgreSQL.sql | 201 ++++++++++++++++++ perl/sql/Wallet-Schema-0.08-SQLite.sql | 201 ++++++++++++++++++ perl/t/admin.t | 21 +- perl/t/lib/Util.pm | 5 + perl/t/report.t | 2 +- perl/t/schema.t | 111 ---------- perl/t/server.t | 2 +- server/wallet-admin | 23 ++ 35 files changed, 2886 insertions(+), 774 deletions(-) create mode 100644 perl/Wallet/Schema/Result/Acl.pm create mode 100644 perl/Wallet/Schema/Result/AclEntry.pm create mode 100644 perl/Wallet/Schema/Result/AclHistory.pm create mode 100644 perl/Wallet/Schema/Result/AclScheme.pm create mode 100644 perl/Wallet/Schema/Result/Enctype.pm create mode 100644 perl/Wallet/Schema/Result/Flag.pm create mode 100644 perl/Wallet/Schema/Result/KeytabEnctype.pm create mode 100644 perl/Wallet/Schema/Result/KeytabSync.pm create mode 100644 perl/Wallet/Schema/Result/Object.pm create mode 100644 perl/Wallet/Schema/Result/ObjectHistory.pm create mode 100644 perl/Wallet/Schema/Result/SyncTarget.pm create mode 100644 perl/Wallet/Schema/Result/Type.pm create mode 100755 perl/create-ddl create mode 100644 perl/sql/Wallet-Schema-0.07-0.08-MySQL.sql create mode 100644 perl/sql/Wallet-Schema-0.07-0.08-SQLite.sql create mode 100644 perl/sql/Wallet-Schema-0.07-MySQL.sql create mode 100644 perl/sql/Wallet-Schema-0.07-SQLite.sql create mode 100644 perl/sql/Wallet-Schema-0.08-MySQL.sql create mode 100644 perl/sql/Wallet-Schema-0.08-PostgreSQL.sql create mode 100644 perl/sql/Wallet-Schema-0.08-SQLite.sql delete mode 100755 perl/t/schema.t (limited to 'perl/Wallet/Report.pm') diff --git a/perl/Wallet/ACL.pm b/perl/Wallet/ACL.pm index 2a06442..4f51c70 100644 --- a/perl/Wallet/ACL.pm +++ b/perl/Wallet/ACL.pm @@ -33,26 +33,24 @@ $VERSION = '0.07'; # doesn't exist, throws an exception. sub new { my ($class, $id, $dbh) = @_; - my ($sql, $data, $name); + my (%search, $data, $name); if ($id =~ /^\d+\z/) { - $sql = 'select ac_id, ac_name from acls where ac_id = ?'; + $search{ac_id} = $id; } else { - $sql = 'select ac_id, ac_name from acls where ac_name = ?'; + $search{ac_name} = $id; } eval { - ($data, $name) = $dbh->selectrow_array ($sql, undef, $id); - $dbh->commit; + $data = $dbh->resultset('Acl')->find (\%search); }; if ($@) { - $dbh->rollback; die "cannot search for ACL $id: $@\n"; } elsif (not defined $data) { die "ACL $id not found\n"; } my $self = { dbh => $dbh, - id => $data, - name => $name, + id => $data->ac_id, + name => $data->ac_name, }; bless ($self, $class); return $self; @@ -69,18 +67,27 @@ sub create { $time ||= time; my $id; eval { - my $sql = 'insert into acls (ac_name) values (?)'; - $dbh->do ($sql, undef, $name); - $id = $dbh->last_insert_id (undef, undef, 'acls', 'ac_id'); + my $guard = $dbh->txn_scope_guard; + + # Create the new record. + my %record = (ac_name => $name); + my $acl = $dbh->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); - $sql = "insert into acl_history (ah_acl, ah_action, ah_by, ah_from, - ah_on) values (?, 'create', ?, ?, ?)"; - $dbh->do ($sql, undef, $id, $user, $host, $date); - $dbh->commit; + %record = (ah_acl => $id, + ah_action => 'create', + ah_by => $user, + ah_from => $host, + ah_on => $date); + my $history = $dbh->resultset('AclHistory')->create (\%record); + die "unable to create new history entry" unless defined $history; + + $guard->commit; }; if ($@) { - $dbh->rollback; die "cannot create ACL $name: $@\n"; } my $self = { @@ -126,13 +133,13 @@ sub scheme_mapping { my ($self, $scheme) = @_; my $class; eval { - my $sql = 'select as_class from acl_schemes where as_name = ?'; - ($class) = $self->{dbh}->selectrow_array ($sql, undef, $scheme); - $self->{dbh}->commit; + my %search = (as_name => $scheme); + my $scheme_rec = $self->{dbh}->resultset('AclScheme') + ->find (\%search); + $class = $scheme_rec->as_class; }; if ($@) { $self->error ($@); - $self->{dbh}->rollback; return; } if (defined $class) { @@ -155,11 +162,14 @@ sub log_acl { unless ($action =~ /^(add|remove)\z/) { die "invalid history action $action"; } - my $date = strftime ('%Y-%m-%d %T', localtime $time); - my $sql = 'insert into acl_history (ah_acl, ah_action, ah_scheme, - ah_identifier, ah_by, ah_from, ah_on) values (?, ?, ?, ?, ?, ?, ?)'; - $self->{dbh}->do ($sql, undef, $self->{id}, $action, $scheme, $identifier, - $user, $host, $date); + 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->{dbh}->resultset('AclHistory')->create (\%record); } ############################################################################## @@ -176,13 +186,15 @@ sub rename { return; } eval { - my $sql = 'update acls set ac_name = ? where ac_id = ?'; - $self->{dbh}->do ($sql, undef, $name, $self->{id}); - $self->{dbh}->commit; + my $guard = $self->{dbh}->txn_scope_guard; + my %search = (ac_id => $self->{id}); + my $acls = $self->{dbh}->resultset('Acl')->find (\%search); + $acls->ac_name ($name); + $acls->update; + $guard->commit; }; if ($@) { $self->error ("cannot rename ACL $self->{id} to $name: $@"); - $self->{dbh}->rollback; return; } $self->{name} = $name; @@ -200,27 +212,44 @@ sub destroy { my ($self, $user, $host, $time) = @_; $time ||= time; eval { - my $sql = 'select ob_type, ob_name from objects where ob_owner = ? - or ob_acl_get = ? or ob_acl_store = ? or ob_acl_show = ? or - ob_acl_destroy = ? or ob_acl_flags = ?'; - my $sth = $self->{dbh}->prepare ($sql); - $sth->execute (($self->{id}) x 6); - my $entry = $sth->fetchrow_arrayref; - if (defined $entry) { - die "ACL in use by $entry->[0]:$entry->[1]"; + my $guard = $self->{dbh}->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->{dbh}->resultset('Object')->search (\@search); + if (@entries) { + my ($entry) = @entries; + die "ACL in use by ".$entry->ob_type.":".$entry->ob_name; } - $sql = 'delete from acl_entries where ae_id = ?'; - $self->{dbh}->do ($sql, undef, $self->{id}); - $sql = 'delete from acls where ac_id = ?'; - $self->{dbh}->do ($sql, undef, $self->{id}); - $sql = "insert into acl_history (ah_acl, ah_action, ah_by, ah_from, - ah_on) values (?, 'destroy', ?, ?, ?)"; - $self->{dbh}->do ($sql, undef, $self->{id}, $user, $host, $time); - $self->{dbh}->commit; + + # Delete any entries (there may or may not be any). + my %search = (ae_id => $self->{id}); + @entries = $self->{dbh}->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->{dbh}->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 => $time); + $self->{dbh}->resultset('AclHistory')->create (\%record); + $guard->commit; }; if ($@) { $self->error ("cannot destroy ACL $self->{id}: $@"); - $self->{dbh}->rollback; return; } return 1; @@ -239,15 +268,16 @@ sub add { return; } eval { - my $sql = 'insert into acl_entries (ae_id, ae_scheme, ae_identifier) - values (?, ?, ?)'; - $self->{dbh}->do ($sql, undef, $self->{id}, $scheme, $identifier); + my $guard = $self->{dbh}->txn_scope_guard; + my %record = (ae_id => $self->{id}, + ae_scheme => $scheme, + ae_identifier => $identifier); + my $entry = $self->{dbh}->resultset('AclEntry')->create (\%record); $self->log_acl ('add', $scheme, $identifier, $user, $host, $time); - $self->{dbh}->commit; + $guard->commit; }; if ($@) { $self->error ("cannot add $scheme:$identifier to $self->{id}: $@"); - $self->{dbh}->rollback; return; } return 1; @@ -260,23 +290,21 @@ sub remove { my ($self, $scheme, $identifier, $user, $host, $time) = @_; $time ||= time; eval { - my $sql = 'select * from acl_entries where ae_id = ? and ae_scheme = ? - and ae_identifier = ?'; - my ($data) = $self->{dbh}->selectrow_array ($sql, undef, $self->{id}, - $scheme, $identifier); - unless (defined $data) { + my $guard = $self->{dbh}->txn_scope_guard; + my %search = (ae_id => $self->{id}, + ae_scheme => $scheme, + ae_identifier => $identifier); + my $entry = $self->{dbh}->resultset('AclEntry')->find (\%search); + unless (defined $entry) { die "entry not found in ACL\n"; } - $sql = 'delete from acl_entries where ae_id = ? and ae_scheme = ? - and ae_identifier = ?'; - $self->{dbh}->do ($sql, undef, $self->{id}, $scheme, $identifier); + $entry->delete; $self->log_acl ('remove', $scheme, $identifier, $user, $host, $time); - $self->{dbh}->commit; + $guard->commit; }; if ($@) { my $entry = "$scheme:$identifier"; $self->error ("cannot remove $entry from $self->{id}: $@"); - $self->{dbh}->rollback; return; } return 1; @@ -294,19 +322,17 @@ sub list { undef $self->{error}; my @entries; eval { - my $sql = 'select ae_scheme, ae_identifier from acl_entries where - ae_id = ?'; - my $sth = $self->{dbh}->prepare ($sql); - $sth->execute ($self->{id}); - my $entry; - while (defined ($entry = $sth->fetchrow_arrayref)) { - push (@entries, [ @$entry ]); + my $guard = $self->{dbh}->txn_scope_guard; + my %search = (ae_id => $self->{id}); + my @entry_recs = $self->{dbh}->resultset('AclEntry') + ->search (\%search); + for my $entry (@entry_recs) { + push (@entries, [ $entry->ae_scheme, $entry->ae_identifier ]); } - $self->{dbh}->commit; + $guard->commit; }; if ($@) { $self->error ("cannot retrieve ACL $self->{id}: $@"); - $self->{dbh}->rollback; return; } else { return @entries; @@ -338,25 +364,27 @@ sub history { my ($self) = @_; my $output = ''; eval { - my $sql = 'select ah_action, ah_scheme, ah_identifier, ah_by, ah_from, - ah_on from acl_history where ah_acl = ? order by ah_on'; - my $sth = $self->{dbh}->prepare ($sql); - $sth->execute ($self->{id}); - my @data; - while (@data = $sth->fetchrow_array) { - $output .= "$data[5] "; - if ($data[0] eq 'add' or $data[0] eq 'remove') { - $output .= "$data[0] $data[1] $data[2]"; + my $guard = $self->{dbh}->txn_scope_guard; + my %search = (ah_acl => $self->{id}); + my %options = (order_by => 'ah_on'); + my @data = $self->{dbh}->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[0]; + $output .= $data->ah_action; } - $output .= "\n by $data[3] from $data[4]\n"; + $output .= sprintf ("\n by %s from %s\n", $data->ah_by, + $data->ah_from); } - $self->{dbh}->commit; + $guard->commit; }; if ($@) { $self->error ("cannot read history for $self->{id}: $@"); - $self->{dbh}->rollback; return; } return $output; @@ -487,7 +515,7 @@ references. =item new(ACL, DBH) Instantiate a new ACL object with the given ACL ID or name. Takes the -Wallet::Database object to use for retrieving metadata from the wallet +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. diff --git a/perl/Wallet/Admin.pm b/perl/Wallet/Admin.pm index a1aef83..511916d 100644 --- a/perl/Wallet/Admin.pm +++ b/perl/Wallet/Admin.pm @@ -1,7 +1,7 @@ # Wallet::Admin -- Wallet system administrative interface. # # Written by Russ Allbery -# Copyright 2008, 2009, 2010, 2011 +# Copyright 2008, 2009, 2010, 2011, 2012 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -17,13 +17,12 @@ use strict; use vars qw($VERSION); use Wallet::ACL; -use Wallet::Database; use Wallet::Schema; # This version should be increased on any code change to this module. Always # use two digits for the minor version with a leading zero if necessary so # that it will sort properly. -$VERSION = '0.06'; +$VERSION = '0.07'; ############################################################################## # Constructor, destructor, and accessors @@ -34,7 +33,7 @@ $VERSION = '0.06'; # Throw an exception if anything goes wrong. sub new { my ($class) = @_; - my $dbh = Wallet::Database->connect; + my $dbh = Wallet::Schema->connect; my $self = { dbh => $dbh }; bless ($self, $class); return $self; @@ -61,7 +60,7 @@ sub error { # Disconnect the database handle on object destruction to avoid warnings. sub DESTROY { my ($self) = @_; - $self->{dbh}->disconnect unless $self->{dbh}->{InactiveDestroy}; + $self->{dbh}->storage->dbh->disconnect; } ############################################################################## @@ -75,17 +74,49 @@ sub DESTROY { # true on success and false on failure, setting the object error. sub initialize { my ($self, $user) = @_; - my $schema = Wallet::Schema->new; - eval { $schema->create ($self->{dbh}) }; + + # Deploy the database schema from DDL files, if they exist. If not then + # we automatically get the database from the Schema modules. + $self->{dbh}->deploy ({}, $Wallet::Config::DB_DDL_DIRECTORY); if ($@) { $self->error ($@); return; } + $self->default_data; + + # Create a default admin ACL. my $acl = Wallet::ACL->create ('ADMIN', $self->{dbh}, $user, 'localhost'); unless ($acl->add ('krb5', $user, $user, 'localhost')) { $self->error ($acl->error); return; } + + return 1; +} + +# Load default data into various tables. We'd like to do this more directly +# in the schema definitions, but not yet seeing a good way to do that. +sub default_data { + my ($self) = @_; + + # acl_schemes default rows. + my ($r1) = $self->{dbh}->resultset('AclScheme')->populate ([ + [ qw/as_name as_class/ ], + [ 'krb5', 'Wallet::ACL::Krb5' ], + [ 'krb5-regex', 'Wallet::ACL::Krb5::Regex' ], + [ 'ldap-attr', 'Wallet::ACL::LDAP::Attribute' ], + [ 'netdb', 'Wallet::ACL::NetDB' ], + [ 'netdb-root', 'Wallet::ACL::NetDB::Root' ], + ]); + warn "default AclScheme not installed" unless defined $r1; + + # types default rows. + my @record = ([ qw/ty_name ty_class/ ], + [ 'file', 'Wallet::Object::File' ], + [ 'keytab', 'Wallet::Object::Keytab' ]); + ($r1) = $self->{dbh}->resultset('Type')->populate (\@record); + warn "default Type not installed" unless defined $r1; + return 1; } @@ -102,12 +133,31 @@ sub reinitialize { # false on failure. sub destroy { my ($self) = @_; - my $schema = Wallet::Schema->new; - eval { $schema->drop ($self->{dbh}) }; - if ($@) { - $self->error ($@); - return; + + # Get an actual DBI handle and use it to delete all tables. + my $real_dbh = $self->{dbh}->storage->dbh; + my @tables = qw/acls acl_entries acl_history acl_schemes enctypes + flags keytab_enctypes keytab_sync objects object_history + sync_targets types dbix_class_schema_versions/; + for my $table (@tables) { + my $sql = "DROP TABLE IF EXISTS $table"; + $real_dbh->do ($sql); } + + return 1; +} + +# Save a DDL of the database in every supported database server. Returns +# true on success and false on failure. +sub backup { + my ($self, $oldversion) = @_; + + my @dbs = qw/MySQL SQLite PostgreSQL/; + my $version = $Wallet::Schema::VERSION; + $self->{dbh}->create_ddl_dir (\@dbs, $version, + $Wallet::Config::DB_DDL_DIRECTORY, + $oldversion); + return 1; } @@ -115,12 +165,16 @@ sub destroy { # and false on failure. sub upgrade { my ($self) = @_; - my $schema = Wallet::Schema->new; - eval { $schema->upgrade ($self->{dbh}) }; + + if ($self->{dbh}->get_db_version) { + eval { $self->{dbh}->upgrade; }; + } if ($@) { $self->error ($@); + warn $@; return; } + return 1; } @@ -135,13 +189,14 @@ sub upgrade { sub register_object { my ($self, $type, $class) = @_; eval { - my $sql = 'insert into types (ty_name, ty_class) values (?, ?)'; - $self->{dbh}->do ($sql, undef, $type, $class); - $self->{dbh}->commit; + my $guard = $self->{dbh}->txn_scope_guard; + my %record = (ty_name => $type, + ty_class => $class); + $self->{dbh}->resultset('Type')->create (\%record); + $guard->commit; }; if ($@) { $self->error ("cannot register $class for $type: $@"); - $self->{dbh}->rollback; return; } return 1; @@ -154,13 +209,14 @@ sub register_object { sub register_verifier { my ($self, $scheme, $class) = @_; eval { - my $sql = 'insert into acl_schemes (as_name, as_class) values (?, ?)'; - $self->{dbh}->do ($sql, undef, $scheme, $class); - $self->{dbh}->commit; + my $guard = $self->{dbh}->txn_scope_guard; + my %record = (as_name => $scheme, + as_class => $class); + $self->{dbh}->resultset('AclScheme')->create (\%record); + $guard->commit; }; if ($@) { - $self->error ("cannot registery $class for $scheme: $@"); - $self->{dbh}->rollback; + $self->error ("cannot register $class for $scheme: $@"); return; } return 1; diff --git a/perl/Wallet/Config.pm b/perl/Wallet/Config.pm index 71f6e0f..98dae03 100644 --- a/perl/Wallet/Config.pm +++ b/perl/Wallet/Config.pm @@ -167,6 +167,16 @@ backends, particularly SQLite, do not need this. our $DB_PASSWORD; +=item DB_DDL_DIRECTORY + +Specifies the directory used to dump the database schema in formats for +each possible database server. This also includes diffs between schema +versions, for upgrades. + +=cut + +our $DB_DDL_DIRECTORY; + =back =head1 FILE OBJECT CONFIGURATION diff --git a/perl/Wallet/Database.pm b/perl/Wallet/Database.pm index 7daab9f..8df338a 100644 --- a/perl/Wallet/Database.pm +++ b/perl/Wallet/Database.pm @@ -1,12 +1,12 @@ # Wallet::Database -- Wallet system database connection management. # -# This module is a thin wrapper around DBI to handle determination of the -# database driver and configuration settings automatically on connect. The +# This module is a thin wrapper around DBIx::Class to handle determination +# of the database configuration settings automatically on connect. The # intention is that Wallet::Database objects can be treated in all respects -# like DBI objects in the rest of the code. +# like DBIx::Class objects in the rest of the code. # # Written by Russ Allbery -# Copyright 2008, 2010 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008-2012 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -14,32 +14,21 @@ # Modules and declarations ############################################################################## -# Set up the subclasses. This is required to avoid warnings under DBI 1.40 -# and later, even though we don't actually make use of any overridden -# statement handle or database handle methods. -package Wallet::Database::st; -use vars qw(@ISA); -@ISA = qw(DBI::st); - -package Wallet::Database::db; -use vars qw(@ISA); -@ISA = qw(DBI::db); - package Wallet::Database; require 5.006; use strict; use vars qw(@ISA $VERSION); -use DBI; +use Wallet::Schema; use Wallet::Config; -@ISA = qw(DBI); +@ISA = qw(Wallet::Schema); # This version should be increased on any code change to this module. Always # use two digits for the minor version with a leading zero if necessary so # that it will sort properly. -$VERSION = '0.03'; +$VERSION = '0.04'; ############################################################################## # Core overrides @@ -65,7 +54,7 @@ sub connect { } my $user = $Wallet::Config::DB_USER; my $pass = $Wallet::Config::DB_PASSWORD; - my %attrs = (PrintError => 0, RaiseError => 1, AutoCommit => 0); + my %attrs = (PrintError => 0, RaiseError => 1); my $dbh = eval { $class->SUPER::connect ($dsn, $user, $pass, \%attrs) }; if ($@) { die "cannot connect to database: $@\n"; diff --git a/perl/Wallet/Object/Base.pm b/perl/Wallet/Object/Base.pm index 87506f4..5bd89a7 100644 --- a/perl/Wallet/Object/Base.pm +++ b/perl/Wallet/Object/Base.pm @@ -24,7 +24,7 @@ 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.05'; +$VERSION = '0.06'; ############################################################################## # Constructors @@ -37,10 +37,11 @@ $VERSION = '0.05'; # probably be usable as-is by most object types. sub new { my ($class, $type, $name, $dbh) = @_; - my $sql = 'select ob_name from objects where ob_type = ? and ob_name = ?'; - my $data = $dbh->selectrow_array ($sql, undef, $type, $name); - $dbh->commit; - die "cannot find ${type}:${name}\n" unless ($data and $data eq $name); + my %search = (ob_type => $type, + ob_name => $name); + my $object = $dbh->resultset('Object')->find (\%search); + die "cannot find ${type}:${name}\n" + unless ($object and $object->ob_name eq $name); my $self = { dbh => $dbh, name => $name, @@ -59,18 +60,27 @@ sub create { $time ||= time; die "invalid object type\n" unless $type; die "invalid object name\n" unless $name; + my $guard = $dbh->txn_scope_guard; eval { - my $date = strftime ('%Y-%m-%d %T', localtime $time); - my $sql = 'insert into objects (ob_type, ob_name, ob_created_by, - ob_created_from, ob_created_on) values (?, ?, ?, ?, ?)'; - $dbh->do ($sql, undef, $type, $name, $user, $host, $date); - $sql = "insert into object_history (oh_type, oh_name, oh_action, - oh_by, oh_from, oh_on) values (?, ?, 'create', ?, ?, ?)"; - $dbh->do ($sql, undef, $type, $name, $user, $host, $date); - $dbh->commit; + 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)); + $dbh->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)); + $dbh->resultset('ObjectHistory')->create (\%record); + + $guard->commit; }; if ($@) { - $dbh->rollback; die "cannot create object ${type}:${name}: $@\n"; } my $self = { @@ -126,30 +136,36 @@ sub log_action { # We have two traces to record, one in the object_history table and one in # the object record itself. Commit both changes as a transaction. We # assume that AutoCommit is turned off. + my $guard = $self->{dbh}->txn_scope_guard; eval { - my $date = strftime ('%Y-%m-%d %T', localtime $time); - my $sql = 'insert into object_history (oh_type, oh_name, oh_action, - oh_by, oh_from, oh_on) values (?, ?, ?, ?, ?, ?)'; - $self->{dbh}->do ($sql, undef, $self->{type}, $self->{name}, $action, - $user, $host, $date); + 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)); + $self->{dbh}->resultset('ObjectHistory')->create (\%record); + + my %search = (ob_type => $self->{type}, + ob_name => $self->{name}); + my $object = $self->{dbh}->resultset('Object')->find (\%search); if ($action eq 'get') { - $sql = 'update objects set ob_downloaded_by = ?, - ob_downloaded_from = ?, ob_downloaded_on = ? where - ob_type = ? and ob_name = ?'; - $self->{dbh}->do ($sql, undef, $user, $host, $date, $self->{type}, - $self->{name}); + $object->ob_downloaded_by ($user); + $object->ob_downloaded_from ($host); + $object->ob_downloaded_on (strftime ('%Y-%m-%d %T', + localtime $time)); } elsif ($action eq 'store') { - $sql = 'update objects set ob_stored_by = ?, ob_stored_from = ?, - ob_stored_on = ? where ob_type = ? and ob_name = ?'; - $self->{dbh}->do ($sql, undef, $user, $host, $date, $self->{type}, - $self->{name}); + $object->ob_stored_by ($user); + $object->ob_stored_from ($host); + $object->ob_stored_on (strftime ('%Y-%m-%d %T', + localtime $time)); } - $self->{dbh}->commit; + $object->update; + $guard->commit; }; if ($@) { my $id = $self->{type} . ':' . $self->{name}; $self->error ("cannot update history for $id: $@"); - $self->{dbh}->rollback; return; } return 1; @@ -175,12 +191,18 @@ sub log_set { unless ($fields{$field}) { die "invalid history field $field"; } - my $date = strftime ('%Y-%m-%d %T', localtime $time); - my $sql = "insert into object_history (oh_type, oh_name, oh_action, - oh_field, oh_type_field, oh_old, oh_new, oh_by, oh_from, oh_on) - values (?, ?, 'set', ?, ?, ?, ?, ?, ?, ?)"; - $self->{dbh}->do ($sql, undef, $self->{type}, $self->{name}, $field, - $type_field, $old, $new, $user, $host, $date); + + my %record = (oh_type => $self->{type}, + oh_name => $self->{name}, + oh_action => 'set', + oh_field => $field, + oh_type_field => $type_field, + oh_old => $old, + oh_new => $new, + oh_by => $user, + oh_from => $host, + oh_on => strftime ('%Y-%m-%d %T', localtime $time)); + $self->{dbh}->resultset('ObjectHistory')->create (\%record); } ############################################################################## @@ -202,20 +224,21 @@ sub _set_internal { $self->error ("cannot modify ${type}:${name}: object is locked"); return; } + + my $guard = $self->{dbh}->txn_scope_guard; eval { - my $sql = "select ob_$attr from objects where ob_type = ? and - ob_name = ?"; - my $old = $self->{dbh}->selectrow_array ($sql, undef, $type, $name); - $sql = "update objects set ob_$attr = ? where ob_type = ? and - ob_name = ?"; - $self->{dbh}->do ($sql, undef, $value, $type, $name); + my %search = (ob_type => $type, + ob_name => $name); + my $object = $self->{dbh}->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); - $self->{dbh}->commit; + $guard->commit; }; if ($@) { my $id = $self->{type} . ':' . $self->{name}; $self->error ("cannot set $attr on $id: $@"); - $self->{dbh}->rollback; return; } return 1; @@ -236,14 +259,13 @@ sub _get_internal { my $type = $self->{type}; my $value; eval { - my $sql = "select $attr from objects where ob_type = ? and - ob_name = ?"; - $value = $self->{dbh}->selectrow_array ($sql, undef, $type, $name); - $self->{dbh}->commit; + my %search = (ob_type => $type, + ob_name => $name); + my $object = $self->{dbh}->resultset('Object')->find (\%search); + $value = $object->get_column ($attr); }; if ($@) { $self->error ($@); - $self->{dbh}->rollback; return; } return $value; @@ -356,14 +378,18 @@ sub flag_check { my $dbh = $self->{dbh}; my $value; eval { - my $sql = 'select fl_flag from flags where fl_type = ? and fl_name = ? - and fl_flag = ?'; - $value = $dbh->selectrow_array ($sql, undef, $type, $name, $flag); - $dbh->commit; + my %search = (fl_type => $type, + fl_name => $name, + fl_flag => $flag); + my $flag = $dbh->resultset('Flag')->find (\%search); + if (not defined $flag) { + $value = 0; + } else { + $value = $flag->fl_flag; + } }; if ($@) { $self->error ("cannot check flag $flag for ${type}:${name}: $@"); - $dbh->rollback; return; } else { return ($value) ? 1 : 0; @@ -378,22 +404,21 @@ sub flag_clear { my $name = $self->{name}; my $type = $self->{type}; my $dbh = $self->{dbh}; + my $guard = $dbh->txn_scope_guard; eval { - my $sql = 'select * from flags where fl_type = ? and fl_name = ? and - fl_flag = ?'; - my ($data) = $dbh->selectrow_array ($sql, undef, $type, $name, $flag); - unless (defined $data) { + my %search = (fl_type => $type, + fl_name => $name, + fl_flag => $flag); + my $flag = $dbh->resultset('Flag')->find (\%search); + unless (defined $flag) { die "flag not set\n"; } - $sql = 'delete from flags where fl_type = ? and fl_name = ? and - fl_flag = ?'; - $dbh->do ($sql, undef, $type, $name, $flag); - $self->log_set ('flags', $flag, undef, $user, $host, $time); - $dbh->commit; + $flag->delete; + $self->log_set ('flags', $flag->fl_flag, undef, $user, $host, $time); + $guard->commit; }; if ($@) { $self->error ("cannot clear flag $flag on ${type}:${name}: $@"); - $dbh->rollback; return; } return 1; @@ -407,20 +432,18 @@ sub flag_list { undef $self->{error}; my @flags; eval { - my $sql = 'select fl_flag from flags where fl_type = ? and - fl_name = ? order by fl_flag'; - my $sth = $self->{dbh}->prepare ($sql); - $sth->execute ($self->{type}, $self->{name}); - my $flag; - while (defined ($flag = $sth->fetchrow_array)) { - push (@flags, $flag); + my %search = (fl_type => $self->{type}, + fl_name => $self->{name}); + my %attrs = (order_by => 'fl_flag'); + my @flags_rs = $self->{dbh}->resultset('Flag')->search (\%search, + \%attrs); + for my $flag (@flags_rs) { + push (@flags, $flag->fl_flag); } - $self->{dbh}->commit; }; if ($@) { my $id = $self->{type} . ':' . $self->{name}; $self->error ("cannot retrieve flags for $id: $@"); - $self->{dbh}->rollback; return; } else { return @flags; @@ -435,22 +458,21 @@ sub flag_set { my $name = $self->{name}; my $type = $self->{type}; my $dbh = $self->{dbh}; + my $guard = $dbh->txn_scope_guard; eval { - my $sql = 'select * from flags where fl_type = ? and fl_name = ? and - fl_flag = ?'; - my ($data) = $dbh->selectrow_array ($sql, undef, $type, $name, $flag); - if (defined $data) { + my %search = (fl_type => $type, + fl_name => $name, + fl_flag => $flag); + my $flag = $dbh->resultset('Flag')->find (\%search); + if (defined $flag) { die "flag already set\n"; } - $sql = 'insert into flags (fl_type, fl_name, fl_flag) - values (?, ?, ?)'; - $dbh->do ($sql, undef, $type, $name, $flag); - $self->log_set ('flags', undef, $flag, $user, $host, $time); - $dbh->commit; + $flag = $dbh->resultset('Flag')->create (\%search); + $self->log_set ('flags', undef, $flag->fl_flag, $user, $host, $time); + $guard->commit; }; if ($@) { $self->error ("cannot set flag $flag on ${type}:${name}: $@"); - $dbh->rollback; return; } return 1; @@ -466,11 +488,10 @@ sub format_acl_id { my ($self, $id) = @_; my $name = $id; - my $sql = 'select ac_name from acls where ac_id = ?'; - my $sth = $self->{dbh}->prepare ($sql); - $sth->execute ($id); - if (my @ref = $sth->fetchrow_array) { - $name = $ref[0] . " ($id)"; + my %search = (ac_id => $id); + my $acl_rs = $self->{dbh}->resultset('Acl')->find (\%search); + if (defined $acl_rs) { + $name = $acl_rs->ac_name . " ($id)"; } return $name; @@ -483,23 +504,29 @@ sub history { my ($self) = @_; my $output = ''; eval { - my $sql = 'select oh_action, oh_field, oh_type_field, oh_old, oh_new, - oh_by, oh_from, oh_on from object_history where oh_type = ? and - oh_name = ? order by oh_on'; - my $sth = $self->{dbh}->prepare ($sql); - $sth->execute ($self->{type}, $self->{name}); - my @data; - while (@data = $sth->fetchrow_array) { - $output .= "$data[7] "; - my ($old, $new) = @data[3..4]; - if ($data[0] eq 'set' and $data[1] eq 'flags') { - if (defined ($data[4])) { - $output .= "set flag $data[4]"; - } elsif (defined ($data[3])) { - $output .= "clear flag $data[3]"; + my %search = (oh_type => $self->{type}, + oh_name => $self->{name}); + my %attrs = (order_by => 'oh_on'); + my @history = $self->{dbh}->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 $old = $history_rs->oh_old; + my $new = $history_rs->oh_new; + my $action = $history_rs->oh_action; + my $field = $history_rs->oh_field; + + if ($action eq 'set' and $field eq 'flags') { + if (defined ($new)) { + $output .= "set flag $new"; + } elsif (defined ($old)) { + $output .= "clear flag $old"; } - } elsif ($data[0] eq 'set' and $data[1] eq 'type_data') { - my $attr = $data[2]; + } elsif ($action eq 'set' and $field eq 'type_data') { + my $attr = $history_rs->oh_type_field; if (defined ($old) and defined ($new)) { $output .= "set attribute $attr to $new (was $old)"; } elsif (defined ($old)) { @@ -507,9 +534,8 @@ sub history { } elsif (defined ($new)) { $output .= "add $new to attribute $attr"; } - } elsif ($data[0] eq 'set' - and ($data[1] eq 'owner' or $data[1] =~ /^acl_/)) { - my $field = $data[1]; + } elsif ($action eq 'set' + and ($field eq 'owner' or $field =~ /^acl_/)) { $old = $self->format_acl_id ($old) if defined ($old); $new = $self->format_acl_id ($new) if defined ($new); if (defined ($old) and defined ($new)) { @@ -519,8 +545,7 @@ sub history { } elsif (defined ($old)) { $output .= "unset $field (was $old)"; } - } elsif ($data[0] eq 'set') { - my $field = $data[1]; + } elsif ($action eq 'set') { if (defined ($old) and defined ($new)) { $output .= "set $field to $new (was $old)"; } elsif (defined ($new)) { @@ -529,16 +554,15 @@ sub history { $output .= "unset $field (was $old)"; } } else { - $output .= $data[0]; + $output .= $action; } - $output .= "\n by $data[5] from $data[6]\n"; + $output .= sprintf ("\n by %s from %s\n", $history_rs->oh_by, + $history_rs->oh_from); } - $self->{dbh}->commit; }; if ($@) { my $id = $self->{type} . ':' . $self->{name}; $self->error ("cannot read history for $id: $@"); - $self->{dbh}->rollback; return; } return $output; @@ -592,15 +616,14 @@ sub show { [ ob_downloaded_on => 'Downloaded on' ]); my $fields = join (', ', map { $_->[0] } @attrs); my @data; + my $object_rs; eval { - my $sql = "select $fields from objects where ob_type = ? and - ob_name = ?"; - @data = $self->{dbh}->selectrow_array ($sql, undef, $type, $name); - $self->{dbh}->commit; + my %search = (ob_type => $type, + ob_name => $name); + $object_rs = $self->{dbh}->resultset('Object')->find (\%search); }; if ($@) { $self->error ("cannot retrieve data for ${type}:${name}: $@"); - $self->{dbh}->rollback; return; } my $output = ''; @@ -609,15 +632,18 @@ sub show { # Format the results. We use a hack to insert the flags before the first # trace field since they're not a field in the object in their own right. # The comment should be word-wrapped at 80 columns. - for my $i (0 .. $#data) { - next unless defined $data[$i]; - if ($attrs[$i][0] eq 'ob_comment' && length ($data[$i]) > 79 - 17) { + for my $i (0 .. $#attrs) { + my $field = $attrs[$i][0]; + my $fieldtext = $attrs[$i][1]; + next unless my $value = $object_rs->get_column ($field); + + if ($field eq 'ob_comment' && length ($value) > 79 - 17) { local $Text::Wrap::columns = 80; local $Text::Wrap::unexpand = 0; - $data[$i] = wrap (' ' x 17, ' ' x 17, $data[$i]); - $data[$i] =~ s/^ {17}//; + $value = wrap (' ' x 17, ' ' x 17, $value); + $value =~ s/^ {17}//; } - if ($attrs[$i][0] eq 'ob_created_by') { + if ($field eq 'ob_created_by') { my @flags = $self->flag_list; if (not @flags and $self->error) { return; @@ -631,15 +657,14 @@ sub show { } $output .= $attr_output; } - next unless defined $data[$i]; - if ($attrs[$i][0] =~ /^ob_(owner|acl_)/) { - my $acl = eval { Wallet::ACL->new ($data[$i], $self->{dbh}) }; + if ($field =~ /^ob_(owner|acl_)/) { + my $acl = eval { Wallet::ACL->new ($value, $self->{dbh}) }; if ($acl and not $@) { - $data[$i] = $acl->name || $data[$i]; - push (@acls, [ $acl, $data[$i] ]); + $value = $acl->name || $value; + push (@acls, [ $acl, $value ]); } } - $output .= sprintf ("%15s: %s\n", $attrs[$i][1], $data[$i]); + $output .= sprintf ("%15s: %s\n", $fieldtext, $value); } if (@acls) { my %seen; @@ -663,20 +688,31 @@ sub destroy { $self->error ("cannot destroy ${type}:${name}: object is locked"); return; } + my $guard = $self->{dbh}->txn_scope_guard; eval { - my $date = strftime ('%Y-%m-%d %T', localtime $time); - my $sql = 'delete from flags where fl_type = ? and fl_name = ?'; - $self->{dbh}->do ($sql, undef, $type, $name); - $sql = 'delete from objects where ob_type = ? and ob_name = ?'; - $self->{dbh}->do ($sql, undef, $type, $name); - $sql = "insert into object_history (oh_type, oh_name, oh_action, - oh_by, oh_from, oh_on) values (?, ?, 'destroy', ?, ?, ?)"; - $self->{dbh}->do ($sql, undef, $type, $name, $user, $host, $date); - $self->{dbh}->commit; + + # Remove any flags that may exist for the record. + my %search = (fl_type => $type, + fl_name => $name); + $self->{dbh}->resultset('Flag')->search (\%search)->delete; + + # Remove any object records + %search = (ob_type => $type, + ob_name => $name); + $self->{dbh}->resultset('Object')->search (\%search)->delete; + + # And create a new history object for the destroy action. + 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)); + $self->{dbh}->resultset('ObjectHistory')->create (\%record); + $guard->commit; }; if ($@) { $self->error ("cannot destroy ${type}:${name}: $@"); - $self->{dbh}->rollback; return; } return 1; @@ -733,7 +769,7 @@ such object exits, throws an exception. Otherwise, returns an object blessed into the class used for the new() call (so subclasses can leave this method alone and not override it). -Takes a Wallet::Database object, which is stored in the object and used +Takes a Wallet::Schema object, which is stored in the object and used for any further operations. =item create(TYPE, NAME, DBH, PRINCIPAL, HOSTNAME [, DATETIME]) diff --git a/perl/Wallet/Object/Keytab.pm b/perl/Wallet/Object/Keytab.pm index fd3001f..083dae6 100644 --- a/perl/Wallet/Object/Keytab.pm +++ b/perl/Wallet/Object/Keytab.pm @@ -40,21 +40,29 @@ sub enctypes_set { my @trace = ($user, $host, $time); my $name = $self->{name}; my %enctypes = map { $_ => 1 } @$enctypes; + my $guard = $self->{dbh}->txn_scope_guard; eval { - my $sql = 'select ke_enctype from keytab_enctypes where ke_name = ?'; - my $sth = $self->{dbh}->prepare ($sql); - $sth->execute ($name); - my (@current, $entry); - while (defined ($entry = $sth->fetchrow_arrayref)) { - push (@current, @$entry); + + # Find all enctypes for the given keytab. + my %search = (ke_name => $name); + my @enctypes = $self->{dbh}->resultset('KeytabEnctype') + ->search (\%search); + my (@current); + for my $enctype_rs (@enctypes) { + push (@current, $enctype_rs->ke_enctype); } + + # Use the existing enctypes and the enctypes we should have to match + # against ones that need to be removed, and note those that already + # exist. for my $enctype (@current) { if ($enctypes{$enctype}) { delete $enctypes{$enctype}; } else { - $sql = 'delete from keytab_enctypes where ke_name = ? and - ke_enctype = ?'; - $self->{dbh}->do ($sql, undef, $name, $enctype); + %search = (ke_name => $name, + ke_enctype => $enctype); + $self->{dbh}->resultset('KeytabEnctype')->find (\%search) + ->delete; $self->log_set ('type_data enctypes', $enctype, undef, @trace); } } @@ -64,21 +72,20 @@ sub enctypes_set { # doesn't enforce integrity constraints. We do this in sorted order # to make it easier to test. for my $enctype (sort keys %enctypes) { - $sql = 'select en_name from enctypes where en_name = ?'; - my $status = $self->{dbh}->selectrow_array ($sql, undef, $enctype); - unless ($status) { + my %search = (en_name => $enctype); + my $enctype_rs = $self->{dbh}->('Enctype')->find (\%search); + unless (defined $enctype_rs) { die "unknown encryption type $enctype\n"; } - $sql = 'insert into keytab_enctypes (ke_name, ke_enctype) values - (?, ?)'; - $self->{dbh}->do ($sql, undef, $name, $enctype); + my %record = (ke_name => $name, + ke_enctype => $enctype); + $self->{dbh}->resultset('Enctype')->create (\%record); $self->log_set ('type_data enctypes', undef, $enctype, @trace); } - $self->{dbh}->commit; + $guard->commit; }; if ($@) { $self->error ($@); - $self->{dbh}->rollback; return; } return 1; @@ -92,19 +99,16 @@ sub enctypes_list { my ($self) = @_; my @enctypes; eval { - my $sql = 'select ke_enctype from keytab_enctypes where ke_name = ? - order by ke_enctype'; - my $sth = $self->{dbh}->prepare ($sql); - $sth->execute ($self->{name}); - my $entry; - while (defined ($entry = $sth->fetchrow_arrayref)) { - push (@enctypes, @$entry); + my %search = (ke_name => $self->{name}); + my %attrs = (order_by => 'ke_enctype'); + my @enctypes_rs = $self->{dbh}->resultset('KeytabEnctype') + ->search (\%search, \%attrs); + for my $enctype_rs (@enctypes_rs) { + push (@enctypes, $enctype_rs->ke_enctype); } - $self->{dbh}->commit; }; if ($@) { $self->error ($@); - $self->{dbh}->rollback; return; } return @enctypes; @@ -132,21 +136,21 @@ sub sync_set { $self->error ("unsupported synchronization target $target"); return; } else { + my $guard = $self->{dbh}->txn_scope_guard; eval { - my $sql = 'select ks_target from keytab_sync where ks_name = ?'; - my $dbh = $self->{dbh}; my $name = $self->{name}; - my ($result) = $dbh->selectrow_array ($sql, undef, $name); - if ($result) { - my $sql = 'delete from keytab_sync where ks_name = ?'; - $self->{dbh}->do ($sql, undef, $name); - $self->log_set ('type_data sync', $result, undef, @trace); + my %search = (ks_name => $name); + my $sync_rs = $self->dbh->resultset('KeytabSync') + ->search (\%search); + if (defined $sync_rs) { + my $target = $sync_rs->ks_target; + $sync_rs->delete; + $self->log_set ('type_data sync', $target, undef, @trace); } - $self->{dbh}->commit; + $guard->commit; }; if ($@) { $self->error ($@); - $self->{dbh}->rollback; return; } } @@ -161,19 +165,16 @@ sub sync_list { my ($self) = @_; my @targets; eval { - my $sql = 'select ks_target from keytab_sync where ks_name = ? - order by ks_target'; - my $sth = $self->{dbh}->prepare ($sql); - $sth->execute ($self->{name}); - my $target; - while (defined ($target = $sth->fetchrow_array)) { - push (@targets, $target); + my %search = (ks_name => $self->{name}); + my %attrs = (order_by => 'ks_target'); + my @syncs = $self->dbh->resultset('KeytabSync')->search (\%search, + \%attrs); + for my $sync_rs (@syncs) { + push (@targets, $sync_rs->ks_target); } - $self->{dbh}->commit; }; if ($@) { $self->error ($@); - $self->{dbh}->rollback; return; } return @targets; @@ -247,11 +248,6 @@ sub new { my $kadmin = Wallet::Kadmin->new (); $self->{kadmin} = $kadmin; - # Set a callback for things to do after a fork, specifically for the MIT - # kadmin module which forks to kadmin. - my $callback = sub { $self->{dbh}->{InactiveDestroy} = 1 }; - $kadmin->fork_callback ($callback); - $self = $class->SUPER::new ($type, $name, $dbh); $self->{kadmin} = $kadmin; return $self; @@ -271,11 +267,6 @@ sub create { my $kadmin = Wallet::Kadmin->new (); $self->{kadmin} = $kadmin; - # Set a callback for things to do after a fork, specifically for the MIT - # kadmin module which forks to kadmin. - my $callback = sub { $self->{dbh}->{InactiveDestroy} = 1 }; - $kadmin->fork_callback ($callback); - if (not $kadmin->create ($name)) { die $kadmin->error, "\n"; } @@ -292,16 +283,21 @@ sub destroy { $self->error ("cannot destroy $id: object is locked"); return; } + my $dbh = $self->{dbh}; + my $guard = $dbh->txn_scope_guard; eval { - my $sql = 'delete from keytab_sync where ks_name = ?'; - $self->{dbh}->do ($sql, undef, $self->{name}); - $sql = 'delete from keytab_enctypes where ke_name = ?'; - $self->{dbh}->do ($sql, undef, $self->{name}); - $self->{dbh}->commit; + my %search = (ks_name => $self->{name}); + my $sync_rs = $dbh->resultset('KeytabSync')->search (\%search); + $sync_rs->delete_all if defined $sync_rs; + + %search = (ke_name => $self->{name}); + my $enctype_rs = $dbh->resultset('KeytabEnctype')->search (\%search); + $enctype_rs->delete_all if defined $enctype_rs; + + $guard->commit; }; if ($@) { $self->error ($@); - $self->{dbh}->rollback; return; } my $kadmin = $self->{kadmin}; diff --git a/perl/Wallet/Report.pm b/perl/Wallet/Report.pm index 5a8dc52..ea8cd2f 100644 --- a/perl/Wallet/Report.pm +++ b/perl/Wallet/Report.pm @@ -16,12 +16,12 @@ use strict; use vars qw($VERSION); use Wallet::ACL; -use Wallet::Database; +use Wallet::Schema; # This version should be increased on any code change to this module. Always # use two digits for the minor version with a leading zero if necessary so # that it will sort properly. -$VERSION = '0.03'; +$VERSION = '0.04'; ############################################################################## # Constructor, destructor, and accessors @@ -32,7 +32,7 @@ $VERSION = '0.03'; # exception if anything goes wrong. sub new { my ($class) = @_; - my $dbh = Wallet::Database->connect; + my $dbh = Wallet::Schema->connect; my $self = { dbh => $dbh }; bless ($self, $class); return $self; @@ -59,7 +59,7 @@ sub error { # Disconnect the database handle on object destruction to avoid warnings. sub DESTROY { my ($self) = @_; - $self->{dbh}->disconnect unless $self->{dbh}->{InactiveDestroy}; + $self->{dbh}->storage->dbh->disconnect; } ############################################################################## @@ -69,18 +69,26 @@ sub DESTROY { # Return the SQL statement to find every object in the database. sub objects_all { my ($self) = @_; - my $sql = 'select ob_type, ob_name from objects order by ob_type, - ob_name'; - return $sql; + my @objects; + + my %search = (); + my %options = (order_by => [ qw/ob_type ob_name/ ], + select => [ qw/ob_type ob_name/ ]); + + return (\%search, \%options); } # Return the SQL statement and the search field required to find all objects # matching a specific type. sub objects_type { my ($self, $type) = @_; - my $sql = 'select ob_type, ob_name from objects where ob_type=? order - by ob_type, ob_name'; - return ($sql, $type); + my @objects; + + my %search = (ob_type => $type); + my %options = (order_by => [ qw/ob_type ob_name/ ], + select => [ qw/ob_type ob_name/ ]); + + return (\%search, \%options); } # Return the SQL statement and search field required to find all objects owned @@ -89,28 +97,36 @@ sub objects_type { # match any ACLs, set an error and return undef. sub objects_owner { my ($self, $owner) = @_; - my ($sth); + my @objects; + + my %search; + my %options = (order_by => [ qw/ob_type ob_name/ ], + select => [ qw/ob_type ob_name/ ]); + if (lc ($owner) eq 'null') { - my $sql = 'select ob_type, ob_name from objects where ob_owner is null - order by objects.ob_type, objects.ob_name'; - return ($sql); + %search = (ob_owner => undef); } else { my $acl = eval { Wallet::ACL->new ($owner, $self->{dbh}) }; return unless $acl; - my $sql = 'select ob_type, ob_name from objects where ob_owner = ? - order by objects.ob_type, objects.ob_name'; - return ($sql, $acl->id); + %search = (ob_owner => $acl->id); } + + return (\%search, \%options); } # Return the SQL statement and search field required to find all objects that # have a specific flag set. sub objects_flag { my ($self, $flag) = @_; - my $sql = 'select ob_type, ob_name from objects left join flags on - (objects.ob_type = flags.fl_type and objects.ob_name = flags.fl_name) - where flags.fl_flag = ? order by objects.ob_type, objects.ob_name'; - return ($sql, $flag); + my @objects; + + my %search = ('flags.fl_flag' => $flag); + my %options = (join => 'flags', + prefetch => 'flags', + order_by => [ qw/ob_type ob_name/ ], + select => [ qw/ob_type ob_name/ ]); + + return (\%search, \%options); } # Return the SQL statement and search field required to find all objects that @@ -120,22 +136,35 @@ sub objects_flag { # set an error and return the empty string. sub objects_acl { my ($self, $search) = @_; - my $acl = eval { Wallet::ACL->new ($search, $self->{dbh}) }; + my @objects; + + my $dbh = $self->{dbh}; + my $acl = eval { Wallet::ACL->new ($search, $dbh) }; return unless $acl; - my $sql = 'select ob_type, ob_name from objects where ob_owner = ? or - ob_acl_get = ? or ob_acl_store = ? or ob_acl_show = ? or - ob_acl_destroy = ? or ob_acl_flags = ? order by objects.ob_type, - objects.ob_name'; - return ($sql, ($acl->id) x 6); + + my @search = ({ ob_owner => $acl->id }, + { ob_acl_get => $acl->id }, + { ob_acl_store => $acl->id }, + { ob_acl_show => $acl->id }, + { ob_acl_destroy => $acl->id }, + { ob_acl_flags => $acl->id }); + my %options = (order_by => [ qw/ob_type ob_name/ ], + select => [ qw/ob_type ob_name/ ]); + + return (\@search, \%options); } # Return the SQL statement to find all objects that have been created but # have never been retrieved (via get). sub objects_unused { my ($self) = @_; - my $sql = 'select ob_type, ob_name from objects where ob_downloaded_on - is null order by objects.ob_type, objects.ob_name'; - return ($sql); + my @objects; + + my %search = (ob_downloaded_on => undef); + my %options = (order_by => [ qw/ob_type ob_name/ ], + select => [ qw/ob_type ob_name/ ]); + + return (\%search, \%options); } # Returns a list of all objects stored in the wallet database in the form of @@ -148,46 +177,44 @@ sub objects { my ($self, $type, @args) = @_; undef $self->{error}; - # Find the SQL statement and the arguments to use. - my $sql = ''; - my @search = (); + # Get the search and options array refs from specific functions. + my ($search_ref, $options_ref); if (!defined $type || $type eq '') { - ($sql) = $self->objects_all; + ($search_ref, $options_ref) = $self->objects_all; } else { if ($type ne 'unused' && @args != 1) { $self->error ("object searches require one argument to search"); } elsif ($type eq 'type') { - ($sql, @search) = $self->objects_type (@args); + ($search_ref, $options_ref) = $self->objects_type (@args); } elsif ($type eq 'owner') { - ($sql, @search) = $self->objects_owner (@args); + ($search_ref, $options_ref) = $self->objects_owner (@args); } elsif ($type eq 'flag') { - ($sql, @search) = $self->objects_flag (@args); + ($search_ref, $options_ref) = $self->objects_flag (@args); } elsif ($type eq 'acl') { - ($sql, @search) = $self->objects_acl (@args); + ($search_ref, $options_ref) = $self->objects_acl (@args); } elsif ($type eq 'unused') { - ($sql) = $self->objects_unused (@args); + ($search_ref, $options_ref) = $self->objects_unused (@args); } else { $self->error ("do not know search type: $type"); } - return unless $sql; + return unless $search_ref; } - # Do the search. + # Perform the search and return on any errors. my @objects; + my $dbh = $self->{dbh}; eval { - my $sth = $self->{dbh}->prepare ($sql); - $sth->execute (@search); - my $object; - while (defined ($object = $sth->fetchrow_arrayref)) { - push (@objects, [ @$object ]); + my @objects_rs = $dbh->resultset('Object')->search ($search_ref, + $options_ref); + for my $object_rs (@objects_rs) { + push (@objects, [ $object_rs->ob_type, $object_rs->ob_name ]); } - $self->{dbh}->commit; }; if ($@) { $self->error ("cannot list objects: $@"); - $self->{dbh}->rollback; return; } + return @objects; } @@ -199,17 +226,51 @@ sub objects { # database. sub acls_all { my ($self) = @_; - my $sql = 'select ac_id, ac_name from acls order by ac_id'; - return ($sql); + my @acls; + + my $dbh = $self->{dbh}; + my %search = (); + my %options = (order_by => [ qw/ac_id/ ], + select => [ qw/ac_id ac_name/ ]); + + eval { + my @acls_rs = $dbh->resultset('Acl')->search (\%search, \%options); + for my $acl_rs (@acls_rs) { + push (@acls, [ $acl_rs->ac_id, $acl_rs->ac_name ]); + } + }; + + if ($@) { + $self->error ("cannot list ACLs: $@"); + return; + } + return (@acls); } # Returns the SQL statement required to find all empty ACLs in the database. sub acls_empty { my ($self) = @_; - my $sql = 'select ac_id, ac_name from acls left join acl_entries - on (acls.ac_id = acl_entries.ae_id) where ae_id is null order by - ac_id'; - return ($sql); + my @acls; + + my $dbh = $self->{dbh}; + my %search = (ae_id => undef); + my %options = (join => 'acl_entries', + prefetch => 'acl_entries', + order_by => [ qw/ac_id/ ], + select => [ qw/ac_id ac_name/ ]); + + eval { + my @acls_rs = $dbh->resultset('Acl')->search (\%search, \%options); + for my $acl_rs (@acls_rs) { + push (@acls, [ $acl_rs->ac_id, $acl_rs->ac_name ]); + } + }; + + if ($@) { + $self->error ("cannot list ACLs: $@"); + return; + } + return (@acls); } # Returns the SQL statement and the field required to find ACLs containing the @@ -217,22 +278,69 @@ sub acls_empty { # do a substring search. sub acls_entry { my ($self, $type, $identifier) = @_; - my $sql = 'select distinct ac_id, ac_name from acl_entries left join acls - on (ae_id = ac_id) where ae_scheme = ? and ae_identifier like ? order - by ac_id'; - return ($sql, $type, '%' . $identifier . '%'); + my @acls; + + my $dbh = $self->{dbh}; + my %search = (ae_scheme => $type, + ae_identifier => { like => '%'.$identifier.'%' }); + my %options = (join => 'acl_entries', + prefetch => 'acl_entries', + order_by => [ qw/ac_id/ ], + select => [ qw/ac_id ac_name/ ], + distinct => 1); + + eval { + my @acls_rs = $dbh->resultset('Acl')->search (\%search, \%options); + for my $acl_rs (@acls_rs) { + push (@acls, [ $acl_rs->ac_id, $acl_rs->ac_name ]); + } + }; + + if ($@) { + $self->error ("cannot list ACLs: $@"); + return; + } + return (@acls); } # Returns the SQL statement required to find unused ACLs. sub acls_unused { my ($self) = @_; - my $sql = 'select ac_id, ac_name from acls where not ac_id in (select - ob_owner from objects where ob_owner = ac_id)'; - for my $acl (qw/get store show destroy flags/) { - $sql .= " and not ac_id in (select ob_acl_$acl from objects where - ob_acl_$acl = ac_id)"; + my @acls; + + my $dbh = $self->{dbh}; + my %search = ( + #'acls_owner.ob_owner' => undef, + #'acls_get.ob_owner' => undef, + #'acls_store.ob_owner' => undef, + #'acls_show.ob_owner' => undef, + #'acls_destroy.ob_owner' => undef, + #'acls_flags.ob_owner' => undef, + ); + my %options = (#join => [ qw/acls_owner acls_get acls_store acls_show acls_destroy acls_flags/ ], + order_by => [ qw/ac_id/ ], + select => [ qw/ac_id ac_name/ ]); + + eval { + my @acls_rs = $dbh->resultset('Acl')->search (\%search, \%options); + + # FIXME: Almost certainly a way of doing this with the search itself. + for my $acl_rs (@acls_rs) { + next if $acl_rs->acls_owner->first; + next if $acl_rs->acls_get->first; + next if $acl_rs->acls_store->first; + next if $acl_rs->acls_show->first; + next if $acl_rs->acls_destroy->first; + next if $acl_rs->acls_flags->first; + push (@acls, [ $acl_rs->ac_id, $acl_rs->ac_name ]); + } + }; + + if ($@) { + $self->error ("cannot list ACLs: $@"); + return; } - return ($sql); + return (@acls); } # Obtain a textual representation of the membership of an ACL, returning undef @@ -290,11 +398,10 @@ sub acls { my ($self, $type, @args) = @_; undef $self->{error}; - # Find the SQL statement and the arguments to use. - my $sql; - my @search = (); + # Find the ACLs for any given search. + my @acls; if (!defined $type || $type eq '') { - ($sql) = $self->acls_all; + @acls = $self->acls_all; } else { if ($type eq 'duplicate') { return $self->acls_duplicate; @@ -303,34 +410,17 @@ sub acls { $self->error ('ACL searches require an argument to search'); return; } else { - ($sql, @search) = $self->acls_entry (@args); + @acls = $self->acls_entry (@args); } } elsif ($type eq 'empty') { - ($sql) = $self->acls_empty; + @acls = $self->acls_empty; } elsif ($type eq 'unused') { - ($sql) = $self->acls_unused; + @acls = $self->acls_unused; } else { $self->error ("unknown search type: $type"); return; } } - - # Do the search. - my @acls; - eval { - my $sth = $self->{dbh}->prepare ($sql); - $sth->execute (@search); - my $object; - while (defined ($object = $sth->fetchrow_arrayref)) { - push (@acls, [ @$object ]); - } - $self->{dbh}->commit; - }; - if ($@) { - $self->error ("cannot list ACLs: $@"); - $self->{dbh}->rollback; - return; - } return @acls; } @@ -343,26 +433,32 @@ sub acls { sub owners { my ($self, $type, $name) = @_; undef $self->{error}; - my @lines; + my $dbh = $self->{dbh}; + + my @owners; eval { - my $sql = 'select distinct ae_scheme, ae_identifier from acl_entries, - acls, objects where ae_id = ac_id and ac_id = ob_owner and - ob_type like ? and ob_name like ? order by ae_scheme, - ae_identifier'; - my $sth = $self->{dbh}->prepare ($sql); - $sth->execute ($type, $name); - my $object; - while (defined ($object = $sth->fetchrow_arrayref)) { - push (@lines, [ @$object ]); + my %search = ( + 'acls_owner.ob_type' => { like => $type }, + 'acls_owner.ob_name' => { like => $name }); + my %options = ( + join => { 'acls' => 'acls_owner' }, + order_by => [ qw/ae_scheme ae_identifier/ ], + distinct => 1, + ); + + my @acls_rs = $dbh->resultset('AclEntry')->search (\%search, + \%options); + for my $acl_rs (@acls_rs) { + my $scheme = $acl_rs->ae_scheme; + my $identifier = $acl_rs->ae_identifier; + push (@owners, [ $scheme, $identifier ]); } - $self->{dbh}->commit; }; if ($@) { $self->error ("cannot report on owners: $@"); - $self->{dbh}->rollback; return; } - return @lines; + return @owners; } ############################################################################## diff --git a/perl/Wallet/Schema.pm b/perl/Wallet/Schema.pm index 9a7fe44..d36b7ac 100644 --- a/perl/Wallet/Schema.pm +++ b/perl/Wallet/Schema.pm @@ -1,262 +1,85 @@ -# Wallet::Schema -- Database schema for the wallet system. -# -# Written by Russ Allbery -# Copyright 2007, 2008, 2010, 2011 -# The Board of Trustees of the Leland Stanford Junior University -# -# See LICENSE for licensing terms. - -############################################################################## -# Modules and declarations -############################################################################## - package Wallet::Schema; -require 5.006; use strict; -use vars qw(@SQL @TABLES $VERSION); +use warnings; -use DBI; +use Wallet::Config; + +use base 'DBIx::Class::Schema'; # This version should be increased on any code change to this module. Always # use two digits for the minor version with a leading zero if necessary so # that it will sort properly. -$VERSION = '0.07'; +our $VERSION = '0.08'; + +__PACKAGE__->load_namespaces; +__PACKAGE__->load_components (qw/Schema::Versioned/); ############################################################################## -# Data manipulation +# Core overrides ############################################################################## -# Create a new Wallet::Schema object, parse the SQL out of the documentation, -# and store it in the object. We have to store the SQL in a static variable, -# since we can't read DATA multiple times. -sub new { +# Override DBI::connect to supply our own connect string, username, and +# password and to set some standard options. Takes no arguments other than +# the implicit class argument. +sub connect { my ($class) = @_; - unless (@SQL) { - local $_; - my $found; - my $command = ''; - while () { - if (not $found and /^=head1 SCHEMA/) { - $found = 1; - } elsif ($found and /^=head1 /) { - last; - } elsif ($found and /^ /) { - s/^ //; - $command .= $_; - if (/;$/) { - push (@SQL, $command); - $command = ''; - } - } - } - close DATA; + unless ($Wallet::Config::DB_DRIVER + and (defined ($Wallet::Config::DB_INFO) + or defined ($Wallet::Config::DB_NAME))) { + die "database connection information not configured\n"; } - my $self = { sql => [ @SQL ] }; - bless ($self, $class); - return $self; -} - -# Returns the SQL as a list of commands. -sub sql { - my ($self) = @_; - return @{ $self->{sql} }; -} - -############################################################################## -# Initialization and cleanup -############################################################################## - -# Run a set of SQL commands, forcing a transaction, rolling back on error, and -# throwing an exception if anything fails. -sub _run_sql { - my ($self, $dbh, @sql) = @_; - eval { - $dbh->begin_work if $dbh->{AutoCommit}; - for my $sql (@sql) { - $dbh->do ($sql, { RaiseError => 1, PrintError => 0 }); - } - $dbh->commit; - }; - if ($@) { - $dbh->rollback; - die "$@\n"; + my $dsn = "DBI:$Wallet::Config::DB_DRIVER:"; + if (defined $Wallet::Config::DB_INFO) { + $dsn .= $Wallet::Config::DB_INFO; + } else { + $dsn .= "database=$Wallet::Config::DB_NAME"; + $dsn .= ";host=$Wallet::Config::DB_HOST" if $Wallet::Config::DB_HOST; + $dsn .= ";port=$Wallet::Config::DB_PORT" if $Wallet::Config::DB_PORT; } -} - -# Given a database handle, try to create our database by running the SQL. Do -# this in a transaction regardless of the database settings and throw an -# exception if this fails. We have to do a bit of fiddling to get syntax that -# works with both MySQL and SQLite. -sub create { - my ($self, $dbh) = @_; - my $driver = $dbh->{Driver}->{Name}; - my @create = map { - if ($driver eq 'SQLite') { - s/auto_increment primary key/primary key autoincrement/; - } elsif ($driver eq 'mysql' and /^\s*create\s+table\s/) { - s/;$/ engine=InnoDB;/; - } - $_; - } @{ $self->{sql} }; - $self->_run_sql ($dbh, @create); -} - -# Given a database handle, try to remove the wallet database tables by -# reversing the SQL. Do this in a transaction regardless of the database -# settings and throw an exception if this fails. -sub drop { - my ($self, $dbh) = @_; - my @drop = map { - if (/^\s*create\s+table\s+(\S+)/i) { - "drop table if exists $1;"; - } else { - (); - } - } reverse @{ $self->{sql} }; - $self->_run_sql ($dbh, @drop); -} - -# Given an open database handle, determine the current database schema -# version. If we can't read the version number, we currently assume a version -# 0 database. This will change in the future. -sub _schema_version { - my ($self, $dbh) = @_; - my $version; - eval { - my $sql = 'select md_version from metadata'; - my $result = $dbh->selectrow_arrayref ($sql); - $version = $result->[0]; - }; + my $user = $Wallet::Config::DB_USER; + my $pass = $Wallet::Config::DB_PASSWORD; + my %attrs = (PrintError => 0, RaiseError => 1); + my $dbh = eval { $class->SUPER::connect ($dsn, $user, $pass, \%attrs) }; if ($@) { - $version = 0; + die "cannot connect to database: $@\n"; } - return $version; + return $dbh; } -# Given a database handle, try to upgrade the schema of that database to the -# current version while preserving all data. Do this in a transaction -# regardless of the database settings and throw an exception if this fails. -sub upgrade { - my ($self, $dbh) = @_; - my $version = $self->_schema_version ($dbh); - my @sql; - if ($version == 1) { - return; - } elsif ($version == 0) { - @sql = ('create table metadata (md_version integer)', - 'insert into metadata (md_version) values (1)', - 'alter table objects add ob_comment varchar(255) default null' - ); - } else { - die "unknown database version $version\n"; - } - $self->_run_sql ($dbh, @sql); -} +__END__ + +1; ############################################################################## -# Schema +# Documentation ############################################################################## -# The following POD is also parsed by the code to extract SQL blocks. Don't -# add any verbatim blocks to this documentation in the SCHEMA section that -# aren't intended to be SQL. - -1; -__DATA__ - =head1 NAME -Wallet::Schema - Database schema for the wallet system - -=for stopwords -SQL ACL API APIs enums Enums Keytab Backend keytab backend enctypes -enctype Allbery Metadata metadata verifier +Wallet::Schema - Database schema and connector for the wallet system =head1 SYNOPSIS use Wallet::Schema; - my $schema = Wallet::Schema->new; - my @sql = $schema->sql; - $schema->create ($dbh); + my $dbh = Wallet::Schema->connect; =head1 DESCRIPTION This class encapsulates the database schema for the wallet system. The -documentation you're reading explains and comments the schema. The Perl -object extracts the schema from the documentation and can either return it -as a list of SQL commands to run or run those commands given a connected -database handle. +documentation you're reading explains and comments the schema. The +class runs using the DBIx::Class module. -This schema attempts to be portable SQL, but it is designed for use with -MySQL and may require some modifications for other databases. - -=head1 METHODS - -=over 4 - -=item new() - -Instantiates a new Wallet::Schema object. This parses the documentation -and extracts the schema, but otherwise doesn't do anything. - -=item create(DBH) - -Given a connected database handle, runs the SQL commands necessary to -create the wallet database in an otherwise empty database. This method -will not drop any existing tables and will therefore fail if a wallet -database has already been created. On any error, this method will throw a -database exception. - -=item drop(DBH) - -Given a connected database handle, drop all of the wallet tables from that -database if any of those tables exist. This method will only remove -tables that are part of the current schema or one of the previous known -schema and won't remove other tables. On any error, this method will -throw a database exception. - -=item sql() - -Returns the schema and the population of the normalization tables as a -list of SQL commands to run to create the wallet database in an otherwise -empty database. - -=item upgrade(DBH) - -Given a connected database handle, runs the SQL commands necessary to -upgrade that database to the current schema version. On any error, this -method will throw a database exception. - -=back +connect() will obtain the database connection information from the wallet +configuration; see L for more details. It will also +automatically set the RaiseError attribute to true and the PrintError and +AutoCommit attributes to false, matching the assumptions made by the +wallet database code. =head1 SCHEMA -=head2 Metadata Tables - -This table is used to store metadata about the wallet database, used for -upgrades and in similar situations: - - create table metadata - (md_version integer); - insert into metadata (md_version) values (1); - -This table will normally only have one row. md_version holds the version -number of the schema (which does not necessarily have any relationship to -the version number of wallet itself). - =head2 Normalization Tables -The following are normalization tables used to constrain the values in -other tables. - -Holds the supported flag names: - - create table flag_names - (fn_name varchar(32) primary key); - insert into flag_names (fn_name) values ('locked'); - insert into flag_names (fn_name) values ('unchanging'); - Holds the supported object types and their corresponding Perl classes: create table types @@ -390,8 +213,8 @@ object may have zero or more flags associated with it: not null references objects(ob_type), fl_name varchar(255) not null references objects(ob_name), - fl_flag varchar(32) - not null references flag_names(fn_name), + fl_flag enum('locked', 'unchanging') + not null, primary key (fl_type, fl_name, fl_flag)); create index fl_object on flags (fl_type, fl_name); @@ -477,9 +300,22 @@ To use this functionality, you will need to populate the enctypes table with the enctypes that a keytab may be restricted to. Currently, there is no automated mechanism to do this. +=head1 CLASS METHODS + +=over 4 + +=item connect() + +Opens a new database connection and returns the database object. On any +failure, throws an exception. Unlike the DBI method, connect() takes no +arguments; all database connection information is derived from the wallet +configuration. + +=back + =head1 SEE ALSO -wallet-backend(8) +wallet-backend(8), Wallet::Config(3) This module is part of the wallet system. The current version is available from L. diff --git a/perl/Wallet/Schema/Result/Acl.pm b/perl/Wallet/Schema/Result/Acl.pm new file mode 100644 index 0000000..60a357b --- /dev/null +++ b/perl/Wallet/Schema/Result/Acl.pm @@ -0,0 +1,99 @@ +package Wallet::Schema::Result::Acl; + +use strict; +use warnings; + +use base 'DBIx::Class::Core'; + +=head1 NAME + +Wallet::Schema::Result::Acl + +=head1 DESCRIPTION + +=cut + +__PACKAGE__->table("acls"); + +=head1 ACCESSORS + +=head2 ac_id + + data_type: 'integer' + is_auto_increment: 1 + is_nullable: 0 + +=head2 ac_name + + data_type: 'varchar' + is_nullable: 0 + size: 255 + +=cut + +__PACKAGE__->add_columns( + "ac_id", + { data_type => "integer", is_auto_increment => 1, is_nullable => 0 }, + "ac_name", + { data_type => "varchar", is_nullable => 0, size => 255 }, +); +__PACKAGE__->set_primary_key("ac_id"); +__PACKAGE__->add_unique_constraint("ac_name", ["ac_name"]); + +__PACKAGE__->has_one( + 'acl_entries', + 'Wallet::Schema::Result::AclEntry', + { 'foreign.ae_id' => 'self.ac_id' }, + { cascade_copy => 0, cascade_delete => 0 }, + ); +__PACKAGE__->has_many( + 'acl_history', + 'Wallet::Schema::Result::AclHistory', + { 'foreign.ah_id' => 'self.ac_id' }, + { cascade_copy => 0, cascade_delete => 0 }, + ); + +# References for all of the various potential ACLs in owners. +__PACKAGE__->has_many( + 'acls_owner', + 'Wallet::Schema::Result::Object', + { 'foreign.ob_owner' => 'self.ac_id' }, + ); +__PACKAGE__->has_many( + 'acls_get', + 'Wallet::Schema::Result::Object', + { 'foreign.ob_acl_get' => 'self.ac_id' }, + ); +__PACKAGE__->has_many( + 'acls_store', + 'Wallet::Schema::Result::Object', + { 'foreign.ob_acl_store' => 'self.ac_id' }, + ); +__PACKAGE__->has_many( + 'acls_show', + 'Wallet::Schema::Result::Object', + { 'foreign.ob_acl_show' => 'self.ac_id' }, + ); +__PACKAGE__->has_many( + 'acls_destroy', + 'Wallet::Schema::Result::Object', + { 'foreign.ob_acl_destroy' => 'self.ac_id' }, + ); +__PACKAGE__->has_many( + 'acls_flags', + 'Wallet::Schema::Result::Object', + { 'foreign.ob_acl_flags' => 'self.ac_id' }, + ); + +# Override the insert method so that we can automatically create history +# items. +#sub insert { +# my ($self, @args) = @_; +# my $ret = $self->next::method (@args); +# print "ID: ".$self->ac_id."\n"; +# use Data::Dumper; print Dumper (@args); + +# return $self; +#} + +1; diff --git a/perl/Wallet/Schema/Result/AclEntry.pm b/perl/Wallet/Schema/Result/AclEntry.pm new file mode 100644 index 0000000..99105a0 --- /dev/null +++ b/perl/Wallet/Schema/Result/AclEntry.pm @@ -0,0 +1,63 @@ +package Wallet::Schema::Result::AclEntry; + +use strict; +use warnings; + +use base 'DBIx::Class::Core'; + +=head1 NAME + +Wallet::Schema::Result::AclEntry + +=head1 DESCRIPTION + +=cut + +__PACKAGE__->table("acl_entries"); + +=head1 ACCESSORS + +=head2 ae_id + + data_type: 'integer' + is_nullable: 0 + +=head2 ae_scheme + + data_type: 'varchar' + is_nullable: 0 + size: 32 + +=head2 ae_identifier + + data_type: 'varchar' + is_nullable: 0 + size: 255 + +=cut + +__PACKAGE__->add_columns( + "ae_id", + { data_type => "integer", is_nullable => 0 }, + "ae_scheme", + { data_type => "varchar", is_nullable => 0, size => 32 }, + "ae_identifier", + { data_type => "varchar", is_nullable => 0, size => 255 }, +); +__PACKAGE__->set_primary_key("ae_id", "ae_scheme", "ae_identifier"); + +__PACKAGE__->belongs_to( + 'acls', + 'Wallet::Schema::Result::Acl', + { 'foreign.ac_id' => 'self.ae_id' }, + { is_deferrable => 1, on_delete => 'CASCADE', + on_update => 'CASCADE' }, + ); + +__PACKAGE__->has_one( + 'acl_scheme', + 'Wallet::Schema::Result::AclScheme', + { 'foreign.as_name' => 'self.ae_scheme' }, + { cascade_delete => 0 }, + ); +1; diff --git a/perl/Wallet/Schema/Result/AclHistory.pm b/perl/Wallet/Schema/Result/AclHistory.pm new file mode 100644 index 0000000..2ad56ff --- /dev/null +++ b/perl/Wallet/Schema/Result/AclHistory.pm @@ -0,0 +1,101 @@ +package Wallet::Schema::Result::AclHistory; + +use strict; +use warnings; + +use base 'DBIx::Class::Core'; + +__PACKAGE__->load_components("InflateColumn::DateTime"); + +=head1 NAME + +Wallet::Schema::Result::AclHistory + +=head1 DESCRIPTION + +=cut + +__PACKAGE__->table("acl_history"); + +=head1 ACCESSORS + +=head2 ah_id + + data_type: 'integer' + is_auto_increment: 1 + is_nullable: 0 + +=head2 ah_acl + + data_type: 'integer' + is_nullable: 0 + +=head2 ah_action + + data_type: 'varchar' + is_nullable: 0 + size: 16 + +=head2 ah_scheme + + data_type: 'varchar' + is_nullable: 1 + size: 32 + +=head2 ah_identifier + + data_type: 'varchar' + is_nullable: 1 + size: 255 + +=head2 ah_by + + data_type: 'varchar' + is_nullable: 0 + size: 255 + +=head2 ah_from + + data_type: 'varchar' + is_nullable: 0 + size: 255 + +=head2 ah_on + + data_type: 'datetime' + datetime_undef_if_invalid: 1 + is_nullable: 0 + +=cut + +__PACKAGE__->add_columns( + "ah_id", + { data_type => "integer", is_auto_increment => 1, is_nullable => 0 }, + "ah_acl", + { data_type => "integer", is_nullable => 0 }, + "ah_action", + { data_type => "varchar", is_nullable => 0, size => 16 }, + "ah_scheme", + { data_type => "varchar", is_nullable => 1, size => 32 }, + "ah_identifier", + { data_type => "varchar", is_nullable => 1, size => 255 }, + "ah_by", + { data_type => "varchar", is_nullable => 0, size => 255 }, + "ah_from", + { data_type => "varchar", is_nullable => 0, size => 255 }, + "ah_on", + { + data_type => "datetime", + datetime_undef_if_invalid => 1, + is_nullable => 0, + }, +); +__PACKAGE__->set_primary_key("ah_id"); + +__PACKAGE__->might_have( + 'acls', + 'Wallet::Schema::Result::Acl', + { 'foreign.ac_id' => 'self.ah_id' }, + ); + +1; diff --git a/perl/Wallet/Schema/Result/AclScheme.pm b/perl/Wallet/Schema/Result/AclScheme.pm new file mode 100644 index 0000000..96db79d --- /dev/null +++ b/perl/Wallet/Schema/Result/AclScheme.pm @@ -0,0 +1,73 @@ +package Wallet::Schema::Result::AclScheme; + +use strict; +use warnings; + +use base 'DBIx::Class::Core'; +__PACKAGE__->load_components (qw//); + +=head1 NAME + +Wallet::Schema::Result::AclScheme + +=head1 DESCRIPTION + +This is a normalization table used to constrain the values in other +tables. It contains the types of ACL schemes that Wallet will +recognize, and the modules that govern each of those schemes. + +By default it contains the following entries: + + insert into acl_schemes (as_name, as_class) + values ('krb5', 'Wallet::ACL::Krb5'); + insert into acl_schemes (as_name, as_class) + values ('krb5-regex', 'Wallet::ACL::Krb5::Regex'); + insert into acl_schemes (as_name, as_class) + values ('ldap-attr', 'Wallet::ACL::LDAP::Attribute'); + insert into acl_schemes (as_name, as_class) + values ('netdb', 'Wallet::ACL::NetDB'); + insert into acl_schemes (as_name, as_class) + values ('netdb-root', 'Wallet::ACL::NetDB::Root'); + +If you have extended the wallet to support additional ACL schemes, you +will want to add additional rows to this table mapping those schemes +to Perl classes that implement the ACL verifier APIs. + +=cut + +__PACKAGE__->table("acl_schemes"); + +=head1 ACCESSORS + +=head2 as_name + + data_type: 'varchar' + is_nullable: 0 + size: 32 + +=head2 as_class + + data_type: 'varchar' + is_nullable: 1 + size: 64 + +=cut + +__PACKAGE__->add_columns( + "as_name", + { data_type => "varchar", is_nullable => 0, size => 32 }, + "as_class", + { data_type => "varchar", is_nullable => 1, size => 64 }, +); +__PACKAGE__->set_primary_key("as_name"); + +#__PACKAGE__->resultset->populate ([ +# [ qw/as_name as_class/ ], +# [ 'krb5', 'Wallet::ACL::Krb5' ], +# [ 'krb5-regex', 'Wallet::ACL::Krb5::Regex' ], +# [ 'ldap-attr', 'Wallet::ACL::LDAP::Attribute' ], +# [ 'netdb', 'Wallet::ACL::NetDB' ], +# [ 'netdb-root', 'Wallet::ACL::NetDB::Root' ], +# ]); + +1; diff --git a/perl/Wallet/Schema/Result/Enctype.pm b/perl/Wallet/Schema/Result/Enctype.pm new file mode 100644 index 0000000..be41b84 --- /dev/null +++ b/perl/Wallet/Schema/Result/Enctype.pm @@ -0,0 +1,34 @@ +package Wallet::Schema::Result::Enctype; + +use strict; +use warnings; + +use base 'DBIx::Class::Core'; + +=head1 NAME + +Wallet::Schema::Result::Enctype + +=head1 DESCRIPTION + +=cut + +__PACKAGE__->table("enctypes"); + +=head1 ACCESSORS + +=head2 en_name + + data_type: 'varchar' + is_nullable: 0 + size: 255 + +=cut + +__PACKAGE__->add_columns( + "en_name", + { data_type => "varchar", is_nullable => 0, size => 255 }, +); +__PACKAGE__->set_primary_key("en_name"); + +1; diff --git a/perl/Wallet/Schema/Result/Flag.pm b/perl/Wallet/Schema/Result/Flag.pm new file mode 100644 index 0000000..b38e85f --- /dev/null +++ b/perl/Wallet/Schema/Result/Flag.pm @@ -0,0 +1,54 @@ +package Wallet::Schema::Result::Flag; + +use strict; +use warnings; + +use base 'DBIx::Class::Core'; + +=head1 NAME + +Wallet::Schema::Result::Flag + +=head1 DESCRIPTION + +=cut + +__PACKAGE__->table("flags"); + +=head1 ACCESSORS + +=head2 fl_type + + data_type: 'varchar' + is_nullable: 0 + size: 16 + +=head2 fl_name + + data_type: 'varchar' + is_nullable: 0 + size: 255 + +=head2 fl_flag + + data_type: 'varchar' + is_nullable: 0 + size: 32 + +=cut + +__PACKAGE__->add_columns( + "fl_type" => + { data_type => "varchar", is_nullable => 0, size => 16 }, + "fl_name" => + { data_type => "varchar", is_nullable => 0, size => 255 }, + "fl_flag" => { + data_type => 'enum', + is_enum => 1, + extra => { list => [qw/locked unchanging/] }, + }, +); +__PACKAGE__->set_primary_key("fl_type", "fl_name", "fl_flag"); + + +1; diff --git a/perl/Wallet/Schema/Result/KeytabEnctype.pm b/perl/Wallet/Schema/Result/KeytabEnctype.pm new file mode 100644 index 0000000..ae40c52 --- /dev/null +++ b/perl/Wallet/Schema/Result/KeytabEnctype.pm @@ -0,0 +1,42 @@ +package Wallet::Schema::Result::KeytabEnctype; + +use strict; +use warnings; + +use base 'DBIx::Class::Core'; + +=head1 NAME + +Wallet::Schema::Result::KeytabEnctype + +=head1 DESCRIPTION + +=cut + +__PACKAGE__->table("keytab_enctypes"); + +=head1 ACCESSORS + +=head2 ke_name + + data_type: 'varchar' + is_nullable: 0 + size: 255 + +=head2 ke_enctype + + data_type: 'varchar' + is_nullable: 0 + size: 255 + +=cut + +__PACKAGE__->add_columns( + "ke_name", + { data_type => "varchar", is_nullable => 0, size => 255 }, + "ke_enctype", + { data_type => "varchar", is_nullable => 0, size => 255 }, +); +__PACKAGE__->set_primary_key("ke_name", "ke_enctype"); + +1; diff --git a/perl/Wallet/Schema/Result/KeytabSync.pm b/perl/Wallet/Schema/Result/KeytabSync.pm new file mode 100644 index 0000000..92ab6b8 --- /dev/null +++ b/perl/Wallet/Schema/Result/KeytabSync.pm @@ -0,0 +1,42 @@ +package Wallet::Schema::Result::KeytabSync; + +use strict; +use warnings; + +use base 'DBIx::Class::Core'; + +=head1 NAME + +Wallet::Schema::Result::KeytabSync + +=head1 DESCRIPTION + +=cut + +__PACKAGE__->table("keytab_sync"); + +=head1 ACCESSORS + +=head2 ks_name + + data_type: 'varchar' + is_nullable: 0 + size: 255 + +=head2 ks_target + + data_type: 'varchar' + is_nullable: 0 + size: 255 + +=cut + +__PACKAGE__->add_columns( + "ks_name", + { data_type => "varchar", is_nullable => 0, size => 255 }, + "ks_target", + { data_type => "varchar", is_nullable => 0, size => 255 }, +); +__PACKAGE__->set_primary_key("ks_name", "ks_target"); + +1; diff --git a/perl/Wallet/Schema/Result/Object.pm b/perl/Wallet/Schema/Result/Object.pm new file mode 100644 index 0000000..17c51e2 --- /dev/null +++ b/perl/Wallet/Schema/Result/Object.pm @@ -0,0 +1,258 @@ +package Wallet::Schema::Result::Object; + +use strict; +use warnings; + +use base 'DBIx::Class::Core'; + +__PACKAGE__->load_components("InflateColumn::DateTime"); + +=head1 NAME + +Wallet::Schema::Result::Object + +=head1 DESCRIPTION + +=cut + +__PACKAGE__->table("objects"); + +=head1 ACCESSORS + +=head2 ob_type + + data_type: 'varchar' + is_nullable: 0 + size: 16 + +=head2 ob_name + + data_type: 'varchar' + is_nullable: 0 + size: 255 + +=head2 ob_owner + + data_type: 'integer' + is_nullable: 1 + +=head2 ob_acl_get + + data_type: 'integer' + is_nullable: 1 + +=head2 ob_acl_store + + data_type: 'integer' + is_nullable: 1 + +=head2 ob_acl_show + + data_type: 'integer' + is_nullable: 1 + +=head2 ob_acl_destroy + + data_type: 'integer' + is_nullable: 1 + +=head2 ob_acl_flags + + data_type: 'integer' + is_nullable: 1 + +=head2 ob_expires + + data_type: 'datetime' + datetime_undef_if_invalid: 1 + is_nullable: 1 + +=head2 ob_created_by + + data_type: 'varchar' + is_nullable: 0 + size: 255 + +=head2 ob_created_from + + data_type: 'varchar' + is_nullable: 0 + size: 255 + +=head2 ob_created_on + + data_type: 'datetime' + datetime_undef_if_invalid: 1 + is_nullable: 0 + +=head2 ob_stored_by + + data_type: 'varchar' + is_nullable: 1 + size: 255 + +=head2 ob_stored_from + + data_type: 'varchar' + is_nullable: 1 + size: 255 + +=head2 ob_stored_on + + data_type: 'datetime' + datetime_undef_if_invalid: 1 + is_nullable: 1 + +=head2 ob_downloaded_by + + data_type: 'varchar' + is_nullable: 1 + size: 255 + +=head2 ob_downloaded_from + + data_type: 'varchar' + is_nullable: 1 + size: 255 + +=head2 ob_downloaded_on + + data_type: 'datetime' + datetime_undef_if_invalid: 1 + is_nullable: 1 + +=head2 ob_comment + + data_type: 'varchar' + is_nullable: 1 + size: 255 + +=cut + +__PACKAGE__->add_columns( + "ob_type", + { data_type => "varchar", is_nullable => 0, size => 16 }, + "ob_name", + { data_type => "varchar", is_nullable => 0, size => 255 }, + "ob_owner", + { data_type => "integer", is_nullable => 1 }, + "ob_acl_get", + { data_type => "integer", is_nullable => 1 }, + "ob_acl_store", + { data_type => "integer", is_nullable => 1 }, + "ob_acl_show", + { data_type => "integer", is_nullable => 1 }, + "ob_acl_destroy", + { data_type => "integer", is_nullable => 1 }, + "ob_acl_flags", + { data_type => "integer", is_nullable => 1 }, + "ob_expires", + { + data_type => "datetime", + datetime_undef_if_invalid => 1, + is_nullable => 1, + }, + "ob_created_by", + { data_type => "varchar", is_nullable => 0, size => 255 }, + "ob_created_from", + { data_type => "varchar", is_nullable => 0, size => 255 }, + "ob_created_on", + { + data_type => "datetime", + datetime_undef_if_invalid => 1, + is_nullable => 0, + }, + "ob_stored_by", + { data_type => "varchar", is_nullable => 1, size => 255 }, + "ob_stored_from", + { data_type => "varchar", is_nullable => 1, size => 255 }, + "ob_stored_on", + { + data_type => "datetime", + datetime_undef_if_invalid => 1, + is_nullable => 1, + }, + "ob_downloaded_by", + { data_type => "varchar", is_nullable => 1, size => 255 }, + "ob_downloaded_from", + { data_type => "varchar", is_nullable => 1, size => 255 }, + "ob_downloaded_on", + { + data_type => "datetime", + datetime_undef_if_invalid => 1, + is_nullable => 1, + }, + "ob_comment", + { data_type => "varchar", is_nullable => 1, size => 255 }, +); +__PACKAGE__->set_primary_key("ob_name", "ob_type"); + +__PACKAGE__->has_one( + 'types', + 'Wallet::Schema::Result::Type', + { 'foreign.ty_name' => 'self.ob_type' }, + ); + +__PACKAGE__->has_many( + 'flags', + 'Wallet::Schema::Result::Flag', + { 'foreign.fl_type' => 'self.ob_type', + 'foreign.fl_name' => 'self.ob_name' }, + { cascade_copy => 0, cascade_delete => 0 }, + ); + +__PACKAGE__->has_many( + 'object_history', + 'Wallet::Schema::Result::ObjectHistory', + { 'foreign.oh_type' => 'self.ob_type', + 'foreign.oh_name' => 'self.ob_name' }, + { cascade_copy => 0, cascade_delete => 0 }, + ); + +__PACKAGE__->has_many( + 'keytab_enctypes', + 'Wallet::Schema::Result::KeytabEnctype', + { 'foreign.ke_name' => 'self.ob_name' }, + { cascade_copy => 0, cascade_delete => 0 }, + ); + +__PACKAGE__->has_many( + 'keytab_sync', + 'Wallet::Schema::Result::KeytabSync', + { 'foreign.ks_name' => 'self.ob_name' }, + { cascade_copy => 0, cascade_delete => 0 }, + ); + +# References for all of the various potential ACLs. +__PACKAGE__->belongs_to( + 'acls_owner', + 'Wallet::Schema::Result::Acl', + { 'foreign.ac_id' => 'self.ob_owner' }, + ); +__PACKAGE__->belongs_to( + 'acls_get', + 'Wallet::Schema::Result::Acl', + { 'foreign.ac_id' => 'self.ob_acl_get' }, + ); +__PACKAGE__->belongs_to( + 'acls_store', + 'Wallet::Schema::Result::Acl', + { 'foreign.ac_id' => 'self.ob_acl_store' }, + ); +__PACKAGE__->belongs_to( + 'acls_show', + 'Wallet::Schema::Result::Acl', + { 'foreign.ac_id' => 'self.ob_acl_show' }, + ); +__PACKAGE__->belongs_to( + 'acls_destroy', + 'Wallet::Schema::Result::Acl', + { 'foreign.ac_id' => 'self.ob_acl_destroy' }, + ); +__PACKAGE__->belongs_to( + 'acls_flags', + 'Wallet::Schema::Result::Acl', + { 'foreign.ac_id' => 'self.ob_acl_flags' }, + ); + +1; diff --git a/perl/Wallet/Schema/Result/ObjectHistory.pm b/perl/Wallet/Schema/Result/ObjectHistory.pm new file mode 100644 index 0000000..067712f --- /dev/null +++ b/perl/Wallet/Schema/Result/ObjectHistory.pm @@ -0,0 +1,127 @@ +package Wallet::Schema::Result::ObjectHistory; + +use strict; +use warnings; + +use base 'DBIx::Class::Core'; + +__PACKAGE__->load_components("InflateColumn::DateTime"); + +=head1 NAME + +Wallet::Schema::Result::ObjectHistory + +=head1 DESCRIPTION + +=cut + +__PACKAGE__->table("object_history"); + +=head1 ACCESSORS + +=head2 oh_id + + data_type: 'integer' + is_auto_increment: 1 + is_nullable: 0 + +=head2 oh_type + + data_type: 'varchar' + is_nullable: 0 + size: 16 + +=head2 oh_name + + data_type: 'varchar' + is_nullable: 0 + size: 255 + +=head2 oh_action + + data_type: 'varchar' + is_nullable: 0 + size: 16 + +=head2 oh_field + + data_type: 'varchar' + is_nullable: 1 + size: 16 + +=head2 oh_type_field + + data_type: 'varchar' + is_nullable: 1 + size: 255 + +=head2 oh_old + + data_type: 'varchar' + is_nullable: 1 + size: 255 + +=head2 oh_new + + data_type: 'varchar' + is_nullable: 1 + size: 255 + +=head2 oh_by + + data_type: 'varchar' + is_nullable: 0 + size: 255 + +=head2 oh_from + + data_type: 'varchar' + is_nullable: 0 + size: 255 + +=head2 oh_on + + data_type: 'datetime' + datetime_undef_if_invalid: 1 + is_nullable: 0 + +=cut + +__PACKAGE__->add_columns( + "oh_id", + { data_type => "integer", is_auto_increment => 1, is_nullable => 0 }, + "oh_type", + { data_type => "varchar", is_nullable => 0, size => 16 }, + "oh_name", + { data_type => "varchar", is_nullable => 0, size => 255 }, + "oh_action", + { data_type => "varchar", is_nullable => 0, size => 16 }, + "oh_field", + { data_type => "varchar", is_nullable => 1, size => 16 }, + "oh_type_field", + { data_type => "varchar", is_nullable => 1, size => 255 }, + "oh_old", + { data_type => "varchar", is_nullable => 1, size => 255 }, + "oh_new", + { data_type => "varchar", is_nullable => 1, size => 255 }, + "oh_by", + { data_type => "varchar", is_nullable => 0, size => 255 }, + "oh_from", + { data_type => "varchar", is_nullable => 0, size => 255 }, + "oh_on", + { + data_type => "datetime", + datetime_undef_if_invalid => 1, + is_nullable => 0, + }, +); +__PACKAGE__->set_primary_key("oh_id"); + +__PACKAGE__->might_have( + 'objects', + 'Wallet::Schema::Result::Object', + { 'foreign.ob_type' => 'self.oh_type', + 'foreign.ob_name' => 'self.oh_name' }, + ); + +1; diff --git a/perl/Wallet/Schema/Result/SyncTarget.pm b/perl/Wallet/Schema/Result/SyncTarget.pm new file mode 100644 index 0000000..17f4320 --- /dev/null +++ b/perl/Wallet/Schema/Result/SyncTarget.pm @@ -0,0 +1,40 @@ +package Wallet::Schema::Result::SyncTarget; + +use strict; +use warnings; + +use base 'DBIx::Class::Core'; + +=head1 NAME + +Wallet::Schema::Result::SyncTarget + +=head1 DESCRIPTION + +=cut + +__PACKAGE__->table("sync_targets"); + +=head1 ACCESSORS + +=head2 st_name + + data_type: 'varchar' + is_nullable: 0 + size: 255 + +=cut + +__PACKAGE__->add_columns( + "st_name", + { data_type => "varchar", is_nullable => 0, size => 255 }, +); +__PACKAGE__->set_primary_key("st_name"); + +#__PACKAGE__->has_many( +# 'keytab_sync', +# 'Wallet::Schema::Result::KeytabSync', +# { 'foreign.ks_target' => 'self.st_name' }, +# { cascade_copy => 0, cascade_delete => 0 }, +# ); +1; diff --git a/perl/Wallet/Schema/Result/Type.pm b/perl/Wallet/Schema/Result/Type.pm new file mode 100644 index 0000000..89fb4c3 --- /dev/null +++ b/perl/Wallet/Schema/Result/Type.pm @@ -0,0 +1,64 @@ +package Wallet::Schema::Result::Type; + +use strict; +use warnings; + +use base 'DBIx::Class::Core'; + +=head1 NAME + +Wallet::Schema::Result::Type + +=head1 DESCRIPTION + +This is a normalization table used to constrain the values in other +tables. It contains the types of wallet objects that are considered +valid, and the modules that govern each. + +By default it contains the following entries: + + insert into types (ty_name, ty_class) + values ('file', 'Wallet::Object::File'); + insert into types (ty_name, ty_class) + values ('keytab', 'Wallet::Object::Keytab'); + +If you have extended the wallet to support additional object types , +you will want to add additional rows to this table mapping those types +to Perl classes that implement the object APIs. + +=cut + +__PACKAGE__->table("types"); + +=head1 ACCESSORS + +=head2 ty_name + + data_type: 'varchar' + is_nullable: 0 + size: 16 + +=head2 ty_class + + data_type: 'varchar' + is_nullable: 1 + size: 64 + +=cut + +__PACKAGE__->add_columns( + "ty_name", + { data_type => "varchar", is_nullable => 0, size => 16 }, + "ty_class", + { data_type => "varchar", is_nullable => 1, size => 64 }, +); +__PACKAGE__->set_primary_key("ty_name"); + +#__PACKAGE__->has_many( +# 'objects', +# 'Wallet::Schema::Result::Object', +# { 'foreign.ob_type' => 'self.ty_name' }, +# { cascade_copy => 0, cascade_delete => 0 }, +# ); + +1; diff --git a/perl/Wallet/Server.pm b/perl/Wallet/Server.pm index dfb7dbb..402fbe0 100644 --- a/perl/Wallet/Server.pm +++ b/perl/Wallet/Server.pm @@ -18,13 +18,12 @@ use vars qw(%MAPPING $VERSION); use Wallet::ACL; use Wallet::Config; -use Wallet::Database; use Wallet::Schema; # This version should be increased on any code change to this module. Always # use two digits for the minor version with a leading zero if necessary so # that it will sort properly. -$VERSION = '0.10'; +$VERSION = '0.11'; ############################################################################## # Utility methods @@ -38,7 +37,7 @@ $VERSION = '0.10'; # for various things. Throw an exception if anything goes wrong. sub new { my ($class, $user, $host) = @_; - my $dbh = Wallet::Database->connect; + my $dbh = Wallet::Schema->connect; my $acl = Wallet::ACL->new ('ADMIN', $dbh); my $self = { dbh => $dbh, @@ -71,8 +70,9 @@ sub error { # Disconnect the database handle on object destruction to avoid warnings. sub DESTROY { my ($self) = @_; - if ($self->{dbh} and not $self->{dbh}->{InactiveDestroy}) { - $self->{dbh}->disconnect; + + if ($self->{dbh}) { + $self->{dbh}->storage->dbh->disconnect; } } @@ -86,13 +86,14 @@ sub type_mapping { my ($self, $type) = @_; my $class; eval { - my $sql = 'select ty_class from types where ty_name = ?'; - ($class) = $self->{dbh}->selectrow_array ($sql, undef, $type); - $self->{dbh}->commit; + my $guard = $self->{dbh}->txn_scope_guard; + my %search = (ty_name => $type); + my $type_rec = $self->{dbh}->resultset('Type')->find (\%search); + $class = $type_rec->ty_class; + $guard->commit; }; if ($@) { $self->error ($@); - $self->{dbh}->rollback; return; } if (defined $class) { diff --git a/perl/create-ddl b/perl/create-ddl new file mode 100755 index 0000000..62deb86 --- /dev/null +++ b/perl/create-ddl @@ -0,0 +1,93 @@ +#!/usr/bin/perl -w +# +# create-ddl - Create DDL files for Wallet +# +# Written by Jon Robertson +# Copyright 2012 Board of Trustees, Leland Stanford Jr. University + +############################################################################# +# Modules and declarations +############################################################################# + +use strict; +use vars qw(); + +use Getopt::Long; +use Wallet::Admin; + +############################################################################# +# Main routine +############################################################################# + +# Get errors and output in the same order. +$| = 0; + +# Clean up the path name. +my $fullpath = $0; +$0 =~ s%^.*/%%; + +# Parse command-line options. +my ($help); +my $oldversion = ''; +Getopt::Long::config ('bundling'); +GetOptions ('h|help' => \$help, + 'o|oldversion=s' => \$oldversion) or exit 1; +if ($help) { + print "Feeding myself to perldoc, please wait....\n"; + exec ('perldoc', '-t', $fullpath); +} + +# Default wallet settings, for Wallet::Admin. +$Wallet::Config::DB_DDL_DIRECTORY = 'sql/'; +$Wallet::Config::DB_DRIVER = 'SQLite'; +$Wallet::Config::DB_INFO = 'wallet-db'; + +# Create a Wallet::Admin object and run the backup. +my $admin = Wallet::Admin->new; +$admin->backup ($oldversion); + +exit(0); + +############################################################################## +# Documentation +############################################################################## + +=head1 NAME + +create-ddl - Create DDL files for Wallet + +=head1 SYNOPSIS + +create-ddl [B<--help>] [B<--oldversion>] + +=head1 DESCRIPTION + +create-ddl is used to create DDL files for the various DBIx::Class +Wallet::Schema modules. It simply is an interface for the backup command +in Wallet::Admin, which does the work via DBIx::Class. The end result +is a number of files that can be used to load the database for each +supported database server. + +These files can be modified after creation to customize the database +load, though should only be done when necessary to prevent confusion +for the schema modules not matching the actual table definitions. This +is currently only done in the case of SQLite databases, due to the +SQLite parser creating keys without AUTOINCREMENT. + +=head1 OPTIONS + +B<--help> + +Prints the perldoc information (this document) for the script. + +B<--oldversion>= + +The version number of the previous version. If there are existing DDL +files for this version, then we will also create diff files to upgrade +a database from the old version to the current. + +=head1 AUTHORS + +Jon Robertson + +=cut diff --git a/perl/sql/Wallet-Schema-0.07-0.08-MySQL.sql b/perl/sql/Wallet-Schema-0.07-0.08-MySQL.sql new file mode 100644 index 0000000..ed0bde1 --- /dev/null +++ b/perl/sql/Wallet-Schema-0.07-0.08-MySQL.sql @@ -0,0 +1,7 @@ +BEGIN; +ALTER TABLE flags MODIFY `fl_flag` enum('locked', 'unchanging') NOT NULL; +DROP TABLE IF EXISTS flag_names; +DROP TABLE IF EXISTS metadata; +ALTER TABLE objects ADD ob_comment varchar(255) default null; +COMMIT; + diff --git a/perl/sql/Wallet-Schema-0.07-0.08-SQLite.sql b/perl/sql/Wallet-Schema-0.07-0.08-SQLite.sql new file mode 100644 index 0000000..3e600b0 --- /dev/null +++ b/perl/sql/Wallet-Schema-0.07-0.08-SQLite.sql @@ -0,0 +1,6 @@ +BEGIN; +DROP TABLE IF EXISTS flag_names; +DROP TABLE IF EXISTS metadata; +ALTER TABLE objects ADD ob_comment varchar(255) default null; +COMMIT; + diff --git a/perl/sql/Wallet-Schema-0.07-MySQL.sql b/perl/sql/Wallet-Schema-0.07-MySQL.sql new file mode 100644 index 0000000..1bd38b3 --- /dev/null +++ b/perl/sql/Wallet-Schema-0.07-MySQL.sql @@ -0,0 +1,211 @@ +-- +-- Created by SQL::Translator::Producer::MySQL +-- Created on Fri Jan 25 14:12:02 2013 +-- +SET foreign_key_checks=0; + +DROP TABLE IF EXISTS `acl_history`; + +-- +-- Table: `acl_history` +-- +CREATE TABLE `acl_history` ( + `ah_id` integer NOT NULL auto_increment, + `ah_acl` integer NOT NULL, + `ah_action` varchar(16) NOT NULL, + `ah_scheme` varchar(32), + `ah_identifier` varchar(255), + `ah_by` varchar(255) NOT NULL, + `ah_from` varchar(255) NOT NULL, + `ah_on` datetime NOT NULL, + PRIMARY KEY (`ah_id`) +); + +DROP TABLE IF EXISTS `acl_schemes`; + +-- +-- Table: `acl_schemes` +-- +CREATE TABLE `acl_schemes` ( + `as_name` varchar(32) NOT NULL, + `as_class` varchar(64), + PRIMARY KEY (`as_name`) +) ENGINE=InnoDB; + +DROP TABLE IF EXISTS `acls`; + +-- +-- Table: `acls` +-- +CREATE TABLE `acls` ( + `ac_id` integer NOT NULL auto_increment, + `ac_name` varchar(255) NOT NULL, + PRIMARY KEY (`ac_id`), + UNIQUE `ac_name` (`ac_name`) +) ENGINE=InnoDB; + +DROP TABLE IF EXISTS `enctypes`; + +-- +-- Table: `enctypes` +-- +CREATE TABLE `enctypes` ( + `en_name` varchar(255) NOT NULL, + PRIMARY KEY (`en_name`) +); + +DROP TABLE IF EXISTS `flags`; + +-- +-- Table: `flags` +-- +CREATE TABLE `flag_names` ( + `fn_name` varchar(32) NOT NULL, + PRIMARY KEY (`fn_name`) +); + +DROP TABLE IF EXISTS `flags`; + +-- +-- Table: `flags` +-- +CREATE TABLE `flags` ( + `fl_type` varchar(16) NOT NULL, + `fl_name` varchar(255) NOT NULL, + `fl_flag` varchar(32) NOT NULL, + PRIMARY KEY (`fl_type`, `fl_name`, `fl_flag`) +); + +DROP TABLE IF EXISTS `keytab_enctypes`; + +-- +-- Table: `keytab_enctypes` +-- +CREATE TABLE `keytab_enctypes` ( + `ke_name` varchar(255) NOT NULL, + `ke_enctype` varchar(255) NOT NULL, + PRIMARY KEY (`ke_name`, `ke_enctype`) +); + +DROP TABLE IF EXISTS `keytab_sync`; + +-- +-- Table: `keytab_sync` +-- +CREATE TABLE `keytab_sync` ( + `ks_name` varchar(255) NOT NULL, + `ks_target` varchar(255) NOT NULL, + PRIMARY KEY (`ks_name`, `ks_target`) +); + +DROP TABLE IF EXISTS `metadata`; + +-- +-- Table: `metadata` +-- +CREATE TABLE `metadata` ( + `md_version` integer +); + +DROP TABLE IF EXISTS `sync_targets`; + +-- +-- Table: `sync_targets` +-- +CREATE TABLE `sync_targets` ( + `st_name` varchar(255) NOT NULL, + PRIMARY KEY (`st_name`) +); + +DROP TABLE IF EXISTS `types`; + +-- +-- Table: `types` +-- +CREATE TABLE `types` ( + `ty_name` varchar(16) NOT NULL, + `ty_class` varchar(64), + PRIMARY KEY (`ty_name`) +) ENGINE=InnoDB; + +DROP TABLE IF EXISTS `acl_entries`; + +-- +-- Table: `acl_entries` +-- +CREATE TABLE `acl_entries` ( + `ae_id` integer NOT NULL, + `ae_scheme` varchar(32) NOT NULL, + `ae_identifier` varchar(255) NOT NULL, + INDEX `acl_entries_idx_ae_scheme` (`ae_scheme`), + INDEX `acl_entries_idx_ae_id` (`ae_id`), + PRIMARY KEY (`ae_id`, `ae_scheme`, `ae_identifier`), + CONSTRAINT `acl_entries_fk_ae_scheme` FOREIGN KEY (`ae_scheme`) REFERENCES `acl_schemes` (`as_name`), + CONSTRAINT `acl_entries_fk_ae_id` FOREIGN KEY (`ae_id`) REFERENCES `acls` (`ac_id`) ON DELETE CASCADE ON UPDATE CASCADE +) ENGINE=InnoDB; + +DROP TABLE IF EXISTS `objects`; + +-- +-- Table: `objects` +-- +CREATE TABLE `objects` ( + `ob_type` varchar(16) NOT NULL, + `ob_name` varchar(255) NOT NULL, + `ob_owner` integer, + `ob_acl_get` integer, + `ob_acl_store` integer, + `ob_acl_show` integer, + `ob_acl_destroy` integer, + `ob_acl_flags` integer, + `ob_expires` datetime, + `ob_created_by` varchar(255) NOT NULL, + `ob_created_from` varchar(255) NOT NULL, + `ob_created_on` datetime NOT NULL, + `ob_stored_by` varchar(255), + `ob_stored_from` varchar(255), + `ob_stored_on` datetime, + `ob_downloaded_by` varchar(255), + `ob_downloaded_from` varchar(255), + `ob_downloaded_on` datetime, + INDEX `objects_idx_ob_acl_destroy` (`ob_acl_destroy`), + INDEX `objects_idx_ob_acl_flags` (`ob_acl_flags`), + INDEX `objects_idx_ob_acl_get` (`ob_acl_get`), + INDEX `objects_idx_ob_owner` (`ob_owner`), + INDEX `objects_idx_ob_acl_show` (`ob_acl_show`), + INDEX `objects_idx_ob_acl_store` (`ob_acl_store`), + INDEX `objects_idx_ob_type` (`ob_type`), + PRIMARY KEY (`ob_name`, `ob_type`), + CONSTRAINT `objects_fk_ob_acl_destroy` FOREIGN KEY (`ob_acl_destroy`) REFERENCES `acls` (`ac_id`) ON DELETE CASCADE ON UPDATE CASCADE, + CONSTRAINT `objects_fk_ob_acl_flags` FOREIGN KEY (`ob_acl_flags`) REFERENCES `acls` (`ac_id`) ON DELETE CASCADE ON UPDATE CASCADE, + CONSTRAINT `objects_fk_ob_acl_get` FOREIGN KEY (`ob_acl_get`) REFERENCES `acls` (`ac_id`) ON DELETE CASCADE ON UPDATE CASCADE, + CONSTRAINT `objects_fk_ob_owner` FOREIGN KEY (`ob_owner`) REFERENCES `acls` (`ac_id`) ON DELETE CASCADE ON UPDATE CASCADE, + CONSTRAINT `objects_fk_ob_acl_show` FOREIGN KEY (`ob_acl_show`) REFERENCES `acls` (`ac_id`) ON DELETE CASCADE ON UPDATE CASCADE, + CONSTRAINT `objects_fk_ob_acl_store` FOREIGN KEY (`ob_acl_store`) REFERENCES `acls` (`ac_id`) ON DELETE CASCADE ON UPDATE CASCADE, + CONSTRAINT `objects_fk_ob_type` FOREIGN KEY (`ob_type`) REFERENCES `types` (`ty_name`) +) ENGINE=InnoDB; + +DROP TABLE IF EXISTS `object_history`; + +-- +-- Table: `object_history` +-- +CREATE TABLE `object_history` ( + `oh_id` integer NOT NULL auto_increment, + `oh_type` varchar(16) NOT NULL, + `oh_name` varchar(255) NOT NULL, + `oh_action` varchar(16) NOT NULL, + `oh_field` varchar(16), + `oh_type_field` varchar(255), + `oh_old` varchar(255), + `oh_new` varchar(255), + `oh_by` varchar(255) NOT NULL, + `oh_from` varchar(255) NOT NULL, + `oh_on` datetime NOT NULL, + INDEX `object_history_idx_oh_type_oh_name` (`oh_type`, `oh_name`), + PRIMARY KEY (`oh_id`), + CONSTRAINT `object_history_fk_oh_type_oh_name` FOREIGN KEY (`oh_type`, `oh_name`) REFERENCES `objects` (`ob_type`, `ob_name`) +) ENGINE=InnoDB; + +SET foreign_key_checks=1; + diff --git a/perl/sql/Wallet-Schema-0.07-SQLite.sql b/perl/sql/Wallet-Schema-0.07-SQLite.sql new file mode 100644 index 0000000..e24ea15 --- /dev/null +++ b/perl/sql/Wallet-Schema-0.07-SQLite.sql @@ -0,0 +1,219 @@ +-- +-- Created by SQL::Translator::Producer::SQLite +-- Created on Fri Jan 25 14:12:02 2013 +-- + +BEGIN TRANSACTION; + +-- +-- Table: acl_history +-- +DROP TABLE IF EXISTS acl_history; + +CREATE TABLE acl_history ( + ah_id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL, + ah_acl integer NOT NULL, + ah_action varchar(16) NOT NULL, + ah_scheme varchar(32), + ah_identifier varchar(255), + ah_by varchar(255) NOT NULL, + ah_from varchar(255) NOT NULL, + ah_on datetime NOT NULL +); + +-- +-- Table: acl_schemes +-- +DROP TABLE IF EXISTS acl_schemes; + +CREATE TABLE acl_schemes ( + as_name varchar(32) NOT NULL, + as_class varchar(64), + PRIMARY KEY (as_name) +); + +-- +-- Table: acls +-- +DROP TABLE IF EXISTS acls; + +CREATE TABLE acls ( + ac_id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL, + ac_name varchar(255) NOT NULL +); + +CREATE UNIQUE INDEX ac_name ON acls (ac_name); + +-- +-- Table: enctypes +-- +DROP TABLE IF EXISTS enctypes; + +CREATE TABLE enctypes ( + en_name varchar(255) NOT NULL, + PRIMARY KEY (en_name) +); + +-- +-- Table: flags +-- +DROP TABLE IF EXISTS flag_names; + +CREATE TABLE flag_names ( + fn_name varchar(32) NOT NULL, + PRIMARY KEY (fn_name) +); + +-- +-- Table: flags +-- +DROP TABLE IF EXISTS flags; + +CREATE TABLE flags ( + fl_type varchar(16) NOT NULL, + fl_name varchar(255) NOT NULL, + fl_flag varchar(32) NOT NULL, + PRIMARY KEY (fl_type, fl_name, fl_flag) +); + +-- +-- Table: keytab_enctypes +-- +DROP TABLE IF EXISTS keytab_enctypes; + +CREATE TABLE keytab_enctypes ( + ke_name varchar(255) NOT NULL, + ke_enctype varchar(255) NOT NULL, + PRIMARY KEY (ke_name, ke_enctype) +); + +-- +-- Table: keytab_sync +-- +DROP TABLE IF EXISTS keytab_sync; + +CREATE TABLE keytab_sync ( + ks_name varchar(255) NOT NULL, + ks_target varchar(255) NOT NULL, + PRIMARY KEY (ks_name, ks_target) +); + +-- +-- Table: metadata +-- +DROP TABLE IF EXISTS metadata; + +CREATE TABLE metadata ( + md_version integer +); + +-- +-- Table: sync_targets +-- +DROP TABLE IF EXISTS sync_targets; + +CREATE TABLE sync_targets ( + st_name varchar(255) NOT NULL, + PRIMARY KEY (st_name) +); + +-- +-- Table: types +-- +DROP TABLE IF EXISTS types; + +CREATE TABLE types ( + ty_name varchar(16) NOT NULL, + ty_class varchar(64), + PRIMARY KEY (ty_name) +); + +-- +-- Table: acl_entries +-- +DROP TABLE IF EXISTS acl_entries; + +CREATE TABLE acl_entries ( + ae_id integer NOT NULL, + ae_scheme varchar(32) NOT NULL, + ae_identifier varchar(255) NOT NULL, + PRIMARY KEY (ae_id, ae_scheme, ae_identifier), + FOREIGN KEY(ae_scheme) REFERENCES acl_schemes(as_name), + FOREIGN KEY(ae_id) REFERENCES acls(ac_id) +); + +CREATE INDEX acl_entries_idx_ae_scheme ON acl_entries (ae_scheme); + +CREATE INDEX acl_entries_idx_ae_id ON acl_entries (ae_id); + +-- +-- Table: objects +-- +DROP TABLE IF EXISTS objects; + +CREATE TABLE objects ( + ob_type varchar(16) NOT NULL, + ob_name varchar(255) NOT NULL, + ob_owner integer, + ob_acl_get integer, + ob_acl_store integer, + ob_acl_show integer, + ob_acl_destroy integer, + ob_acl_flags integer, + ob_expires datetime, + ob_created_by varchar(255) NOT NULL, + ob_created_from varchar(255) NOT NULL, + ob_created_on datetime NOT NULL, + ob_stored_by varchar(255), + ob_stored_from varchar(255), + ob_stored_on datetime, + ob_downloaded_by varchar(255), + ob_downloaded_from varchar(255), + ob_downloaded_on datetime, + PRIMARY KEY (ob_name, ob_type), + FOREIGN KEY(ob_acl_destroy) REFERENCES acls(ac_id), + FOREIGN KEY(ob_acl_flags) REFERENCES acls(ac_id), + FOREIGN KEY(ob_acl_get) REFERENCES acls(ac_id), + FOREIGN KEY(ob_owner) REFERENCES acls(ac_id), + FOREIGN KEY(ob_acl_show) REFERENCES acls(ac_id), + FOREIGN KEY(ob_acl_store) REFERENCES acls(ac_id), + FOREIGN KEY(ob_type) REFERENCES types(ty_name) +); + +CREATE INDEX objects_idx_ob_acl_destroy ON objects (ob_acl_destroy); + +CREATE INDEX objects_idx_ob_acl_flags ON objects (ob_acl_flags); + +CREATE INDEX objects_idx_ob_acl_get ON objects (ob_acl_get); + +CREATE INDEX objects_idx_ob_owner ON objects (ob_owner); + +CREATE INDEX objects_idx_ob_acl_show ON objects (ob_acl_show); + +CREATE INDEX objects_idx_ob_acl_store ON objects (ob_acl_store); + +CREATE INDEX objects_idx_ob_type ON objects (ob_type); + +-- +-- Table: object_history +-- +DROP TABLE IF EXISTS object_history; + +CREATE TABLE object_history ( + oh_id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL, + oh_type varchar(16) NOT NULL, + oh_name varchar(255) NOT NULL, + oh_action varchar(16) NOT NULL, + oh_field varchar(16), + oh_type_field varchar(255), + oh_old varchar(255), + oh_new varchar(255), + oh_by varchar(255) NOT NULL, + oh_from varchar(255) NOT NULL, + oh_on datetime NOT NULL, + FOREIGN KEY(oh_type) REFERENCES objects(ob_type) +); + +CREATE INDEX object_history_idx_oh_type_oh_name ON object_history (oh_type, oh_name); + +COMMIT; diff --git a/perl/sql/Wallet-Schema-0.08-MySQL.sql b/perl/sql/Wallet-Schema-0.08-MySQL.sql new file mode 100644 index 0000000..44b6475 --- /dev/null +++ b/perl/sql/Wallet-Schema-0.08-MySQL.sql @@ -0,0 +1,193 @@ +-- +-- Created by SQL::Translator::Producer::MySQL +-- Created on Fri Jan 25 14:12:02 2013 +-- +SET foreign_key_checks=0; + +DROP TABLE IF EXISTS `acl_history`; + +-- +-- Table: `acl_history` +-- +CREATE TABLE `acl_history` ( + `ah_id` integer NOT NULL auto_increment, + `ah_acl` integer NOT NULL, + `ah_action` varchar(16) NOT NULL, + `ah_scheme` varchar(32), + `ah_identifier` varchar(255), + `ah_by` varchar(255) NOT NULL, + `ah_from` varchar(255) NOT NULL, + `ah_on` datetime NOT NULL, + PRIMARY KEY (`ah_id`) +); + +DROP TABLE IF EXISTS `acl_schemes`; + +-- +-- Table: `acl_schemes` +-- +CREATE TABLE `acl_schemes` ( + `as_name` varchar(32) NOT NULL, + `as_class` varchar(64), + PRIMARY KEY (`as_name`) +) ENGINE=InnoDB; + +DROP TABLE IF EXISTS `acls`; + +-- +-- Table: `acls` +-- +CREATE TABLE `acls` ( + `ac_id` integer NOT NULL auto_increment, + `ac_name` varchar(255) NOT NULL, + PRIMARY KEY (`ac_id`), + UNIQUE `ac_name` (`ac_name`) +) ENGINE=InnoDB; + +DROP TABLE IF EXISTS `enctypes`; + +-- +-- Table: `enctypes` +-- +CREATE TABLE `enctypes` ( + `en_name` varchar(255) NOT NULL, + PRIMARY KEY (`en_name`) +); + +DROP TABLE IF EXISTS `flags`; + +-- +-- Table: `flags` +-- +CREATE TABLE `flags` ( + `fl_type` varchar(16) NOT NULL, + `fl_name` varchar(255) NOT NULL, + `fl_flag` enum('locked', 'unchanging') NOT NULL, + PRIMARY KEY (`fl_type`, `fl_name`, `fl_flag`) +); + +DROP TABLE IF EXISTS `keytab_enctypes`; + +-- +-- Table: `keytab_enctypes` +-- +CREATE TABLE `keytab_enctypes` ( + `ke_name` varchar(255) NOT NULL, + `ke_enctype` varchar(255) NOT NULL, + PRIMARY KEY (`ke_name`, `ke_enctype`) +); + +DROP TABLE IF EXISTS `keytab_sync`; + +-- +-- Table: `keytab_sync` +-- +CREATE TABLE `keytab_sync` ( + `ks_name` varchar(255) NOT NULL, + `ks_target` varchar(255) NOT NULL, + PRIMARY KEY (`ks_name`, `ks_target`) +); + +DROP TABLE IF EXISTS `sync_targets`; + +-- +-- Table: `sync_targets` +-- +CREATE TABLE `sync_targets` ( + `st_name` varchar(255) NOT NULL, + PRIMARY KEY (`st_name`) +); + +DROP TABLE IF EXISTS `types`; + +-- +-- Table: `types` +-- +CREATE TABLE `types` ( + `ty_name` varchar(16) NOT NULL, + `ty_class` varchar(64), + PRIMARY KEY (`ty_name`) +) ENGINE=InnoDB; + +DROP TABLE IF EXISTS `acl_entries`; + +-- +-- Table: `acl_entries` +-- +CREATE TABLE `acl_entries` ( + `ae_id` integer NOT NULL, + `ae_scheme` varchar(32) NOT NULL, + `ae_identifier` varchar(255) NOT NULL, + INDEX `acl_entries_idx_ae_scheme` (`ae_scheme`), + INDEX `acl_entries_idx_ae_id` (`ae_id`), + PRIMARY KEY (`ae_id`, `ae_scheme`, `ae_identifier`), + CONSTRAINT `acl_entries_fk_ae_scheme` FOREIGN KEY (`ae_scheme`) REFERENCES `acl_schemes` (`as_name`), + CONSTRAINT `acl_entries_fk_ae_id` FOREIGN KEY (`ae_id`) REFERENCES `acls` (`ac_id`) ON DELETE CASCADE ON UPDATE CASCADE +) ENGINE=InnoDB; + +DROP TABLE IF EXISTS `objects`; + +-- +-- Table: `objects` +-- +CREATE TABLE `objects` ( + `ob_type` varchar(16) NOT NULL, + `ob_name` varchar(255) NOT NULL, + `ob_owner` integer, + `ob_acl_get` integer, + `ob_acl_store` integer, + `ob_acl_show` integer, + `ob_acl_destroy` integer, + `ob_acl_flags` integer, + `ob_expires` datetime, + `ob_created_by` varchar(255) NOT NULL, + `ob_created_from` varchar(255) NOT NULL, + `ob_created_on` datetime NOT NULL, + `ob_stored_by` varchar(255), + `ob_stored_from` varchar(255), + `ob_stored_on` datetime, + `ob_downloaded_by` varchar(255), + `ob_downloaded_from` varchar(255), + `ob_downloaded_on` datetime, + `ob_comment` varchar(255), + INDEX `objects_idx_ob_acl_destroy` (`ob_acl_destroy`), + INDEX `objects_idx_ob_acl_flags` (`ob_acl_flags`), + INDEX `objects_idx_ob_acl_get` (`ob_acl_get`), + INDEX `objects_idx_ob_owner` (`ob_owner`), + INDEX `objects_idx_ob_acl_show` (`ob_acl_show`), + INDEX `objects_idx_ob_acl_store` (`ob_acl_store`), + INDEX `objects_idx_ob_type` (`ob_type`), + PRIMARY KEY (`ob_name`, `ob_type`), + CONSTRAINT `objects_fk_ob_acl_destroy` FOREIGN KEY (`ob_acl_destroy`) REFERENCES `acls` (`ac_id`) ON DELETE CASCADE ON UPDATE CASCADE, + CONSTRAINT `objects_fk_ob_acl_flags` FOREIGN KEY (`ob_acl_flags`) REFERENCES `acls` (`ac_id`) ON DELETE CASCADE ON UPDATE CASCADE, + CONSTRAINT `objects_fk_ob_acl_get` FOREIGN KEY (`ob_acl_get`) REFERENCES `acls` (`ac_id`) ON DELETE CASCADE ON UPDATE CASCADE, + CONSTRAINT `objects_fk_ob_owner` FOREIGN KEY (`ob_owner`) REFERENCES `acls` (`ac_id`) ON DELETE CASCADE ON UPDATE CASCADE, + CONSTRAINT `objects_fk_ob_acl_show` FOREIGN KEY (`ob_acl_show`) REFERENCES `acls` (`ac_id`) ON DELETE CASCADE ON UPDATE CASCADE, + CONSTRAINT `objects_fk_ob_acl_store` FOREIGN KEY (`ob_acl_store`) REFERENCES `acls` (`ac_id`) ON DELETE CASCADE ON UPDATE CASCADE, + CONSTRAINT `objects_fk_ob_type` FOREIGN KEY (`ob_type`) REFERENCES `types` (`ty_name`) +) ENGINE=InnoDB; + +DROP TABLE IF EXISTS `object_history`; + +-- +-- Table: `object_history` +-- +CREATE TABLE `object_history` ( + `oh_id` integer NOT NULL auto_increment, + `oh_type` varchar(16) NOT NULL, + `oh_name` varchar(255) NOT NULL, + `oh_action` varchar(16) NOT NULL, + `oh_field` varchar(16), + `oh_type_field` varchar(255), + `oh_old` varchar(255), + `oh_new` varchar(255), + `oh_by` varchar(255) NOT NULL, + `oh_from` varchar(255) NOT NULL, + `oh_on` datetime NOT NULL, + INDEX `object_history_idx_oh_type_oh_name` (`oh_type`, `oh_name`), + PRIMARY KEY (`oh_id`), + CONSTRAINT `object_history_fk_oh_type_oh_name` FOREIGN KEY (`oh_type`, `oh_name`) REFERENCES `objects` (`ob_type`, `ob_name`) +) ENGINE=InnoDB; + +SET foreign_key_checks=1; + diff --git a/perl/sql/Wallet-Schema-0.08-PostgreSQL.sql b/perl/sql/Wallet-Schema-0.08-PostgreSQL.sql new file mode 100644 index 0000000..2f79147 --- /dev/null +++ b/perl/sql/Wallet-Schema-0.08-PostgreSQL.sql @@ -0,0 +1,201 @@ +-- +-- Created by SQL::Translator::Producer::PostgreSQL +-- Created on Fri Jan 25 14:12:02 2013 +-- +-- +-- Table: acl_history +-- +DROP TABLE "acl_history" CASCADE; +CREATE TABLE "acl_history" ( + "ah_id" serial NOT NULL, + "ah_acl" integer NOT NULL, + "ah_action" character varying(16) NOT NULL, + "ah_scheme" character varying(32), + "ah_identifier" character varying(255), + "ah_by" character varying(255) NOT NULL, + "ah_from" character varying(255) NOT NULL, + "ah_on" timestamp NOT NULL, + PRIMARY KEY ("ah_id") +); + +-- +-- Table: acl_schemes +-- +DROP TABLE "acl_schemes" CASCADE; +CREATE TABLE "acl_schemes" ( + "as_name" character varying(32) NOT NULL, + "as_class" character varying(64), + PRIMARY KEY ("as_name") +); + +-- +-- Table: acls +-- +DROP TABLE "acls" CASCADE; +CREATE TABLE "acls" ( + "ac_id" serial NOT NULL, + "ac_name" character varying(255) NOT NULL, + PRIMARY KEY ("ac_id"), + CONSTRAINT "ac_name" UNIQUE ("ac_name") +); + +-- +-- Table: enctypes +-- +DROP TABLE "enctypes" CASCADE; +CREATE TABLE "enctypes" ( + "en_name" character varying(255) NOT NULL, + PRIMARY KEY ("en_name") +); + +-- +-- Table: flags +-- +DROP TABLE "flags" CASCADE; +CREATE TABLE "flags" ( + "fl_type" character varying(16) NOT NULL, + "fl_name" character varying(255) NOT NULL, + "fl_flag" character varying NOT NULL, + PRIMARY KEY ("fl_type", "fl_name", "fl_flag") +); + +-- +-- Table: keytab_enctypes +-- +DROP TABLE "keytab_enctypes" CASCADE; +CREATE TABLE "keytab_enctypes" ( + "ke_name" character varying(255) NOT NULL, + "ke_enctype" character varying(255) NOT NULL, + PRIMARY KEY ("ke_name", "ke_enctype") +); + +-- +-- Table: keytab_sync +-- +DROP TABLE "keytab_sync" CASCADE; +CREATE TABLE "keytab_sync" ( + "ks_name" character varying(255) NOT NULL, + "ks_target" character varying(255) NOT NULL, + PRIMARY KEY ("ks_name", "ks_target") +); + +-- +-- Table: sync_targets +-- +DROP TABLE "sync_targets" CASCADE; +CREATE TABLE "sync_targets" ( + "st_name" character varying(255) NOT NULL, + PRIMARY KEY ("st_name") +); + +-- +-- Table: types +-- +DROP TABLE "types" CASCADE; +CREATE TABLE "types" ( + "ty_name" character varying(16) NOT NULL, + "ty_class" character varying(64), + PRIMARY KEY ("ty_name") +); + +-- +-- Table: acl_entries +-- +DROP TABLE "acl_entries" CASCADE; +CREATE TABLE "acl_entries" ( + "ae_id" integer NOT NULL, + "ae_scheme" character varying(32) NOT NULL, + "ae_identifier" character varying(255) NOT NULL, + PRIMARY KEY ("ae_id", "ae_scheme", "ae_identifier") +); +CREATE INDEX "acl_entries_idx_ae_scheme" on "acl_entries" ("ae_scheme"); +CREATE INDEX "acl_entries_idx_ae_id" on "acl_entries" ("ae_id"); + +-- +-- Table: objects +-- +DROP TABLE "objects" CASCADE; +CREATE TABLE "objects" ( + "ob_type" character varying(16) NOT NULL, + "ob_name" character varying(255) NOT NULL, + "ob_owner" integer, + "ob_acl_get" integer, + "ob_acl_store" integer, + "ob_acl_show" integer, + "ob_acl_destroy" integer, + "ob_acl_flags" integer, + "ob_expires" timestamp, + "ob_created_by" character varying(255) NOT NULL, + "ob_created_from" character varying(255) NOT NULL, + "ob_created_on" timestamp NOT NULL, + "ob_stored_by" character varying(255), + "ob_stored_from" character varying(255), + "ob_stored_on" timestamp, + "ob_downloaded_by" character varying(255), + "ob_downloaded_from" character varying(255), + "ob_downloaded_on" timestamp, + "ob_comment" character varying(255), + PRIMARY KEY ("ob_name", "ob_type") +); +CREATE INDEX "objects_idx_ob_acl_destroy" on "objects" ("ob_acl_destroy"); +CREATE INDEX "objects_idx_ob_acl_flags" on "objects" ("ob_acl_flags"); +CREATE INDEX "objects_idx_ob_acl_get" on "objects" ("ob_acl_get"); +CREATE INDEX "objects_idx_ob_owner" on "objects" ("ob_owner"); +CREATE INDEX "objects_idx_ob_acl_show" on "objects" ("ob_acl_show"); +CREATE INDEX "objects_idx_ob_acl_store" on "objects" ("ob_acl_store"); +CREATE INDEX "objects_idx_ob_type" on "objects" ("ob_type"); + +-- +-- Table: object_history +-- +DROP TABLE "object_history" CASCADE; +CREATE TABLE "object_history" ( + "oh_id" serial NOT NULL, + "oh_type" character varying(16) NOT NULL, + "oh_name" character varying(255) NOT NULL, + "oh_action" character varying(16) NOT NULL, + "oh_field" character varying(16), + "oh_type_field" character varying(255), + "oh_old" character varying(255), + "oh_new" character varying(255), + "oh_by" character varying(255) NOT NULL, + "oh_from" character varying(255) NOT NULL, + "oh_on" timestamp NOT NULL, + PRIMARY KEY ("oh_id") +); +CREATE INDEX "object_history_idx_oh_type_oh_name" on "object_history" ("oh_type", "oh_name"); + +-- +-- Foreign Key Definitions +-- + +ALTER TABLE "acl_entries" ADD FOREIGN KEY ("ae_scheme") + REFERENCES "acl_schemes" ("as_name") DEFERRABLE; + +ALTER TABLE "acl_entries" ADD FOREIGN KEY ("ae_id") + REFERENCES "acls" ("ac_id") ON DELETE CASCADE ON UPDATE CASCADE DEFERRABLE; + +ALTER TABLE "objects" ADD FOREIGN KEY ("ob_acl_destroy") + REFERENCES "acls" ("ac_id") ON DELETE CASCADE ON UPDATE CASCADE DEFERRABLE; + +ALTER TABLE "objects" ADD FOREIGN KEY ("ob_acl_flags") + REFERENCES "acls" ("ac_id") ON DELETE CASCADE ON UPDATE CASCADE DEFERRABLE; + +ALTER TABLE "objects" ADD FOREIGN KEY ("ob_acl_get") + REFERENCES "acls" ("ac_id") ON DELETE CASCADE ON UPDATE CASCADE DEFERRABLE; + +ALTER TABLE "objects" ADD FOREIGN KEY ("ob_owner") + REFERENCES "acls" ("ac_id") ON DELETE CASCADE ON UPDATE CASCADE DEFERRABLE; + +ALTER TABLE "objects" ADD FOREIGN KEY ("ob_acl_show") + REFERENCES "acls" ("ac_id") ON DELETE CASCADE ON UPDATE CASCADE DEFERRABLE; + +ALTER TABLE "objects" ADD FOREIGN KEY ("ob_acl_store") + REFERENCES "acls" ("ac_id") ON DELETE CASCADE ON UPDATE CASCADE DEFERRABLE; + +ALTER TABLE "objects" ADD FOREIGN KEY ("ob_type") + REFERENCES "types" ("ty_name") DEFERRABLE; + +ALTER TABLE "object_history" ADD FOREIGN KEY ("oh_type", "oh_name") + REFERENCES "objects" ("ob_type", "ob_name") DEFERRABLE; + diff --git a/perl/sql/Wallet-Schema-0.08-SQLite.sql b/perl/sql/Wallet-Schema-0.08-SQLite.sql new file mode 100644 index 0000000..9936c20 --- /dev/null +++ b/perl/sql/Wallet-Schema-0.08-SQLite.sql @@ -0,0 +1,201 @@ +-- +-- Created by SQL::Translator::Producer::SQLite +-- Created on Fri Jan 25 14:12:02 2013 +-- + +BEGIN TRANSACTION; + +-- +-- Table: acl_history +-- +DROP TABLE IF EXISTS acl_history; + +CREATE TABLE acl_history ( + ah_id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL, + ah_acl integer NOT NULL, + ah_action varchar(16) NOT NULL, + ah_scheme varchar(32), + ah_identifier varchar(255), + ah_by varchar(255) NOT NULL, + ah_from varchar(255) NOT NULL, + ah_on datetime NOT NULL +); + +-- +-- Table: acl_schemes +-- +DROP TABLE IF EXISTS acl_schemes; + +CREATE TABLE acl_schemes ( + as_name varchar(32) NOT NULL, + as_class varchar(64), + PRIMARY KEY (as_name) +); + +-- +-- Table: acls +-- +DROP TABLE IF EXISTS acls; + +CREATE TABLE acls ( + ac_id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL, + ac_name varchar(255) NOT NULL +); + +CREATE UNIQUE INDEX ac_name ON acls (ac_name); + +-- +-- Table: enctypes +-- +DROP TABLE IF EXISTS enctypes; + +CREATE TABLE enctypes ( + en_name varchar(255) NOT NULL, + PRIMARY KEY (en_name) +); + +-- +-- Table: flags +-- +DROP TABLE IF EXISTS flags; + +CREATE TABLE flags ( + fl_type varchar(16) NOT NULL, + fl_name varchar(255) NOT NULL, + fl_flag varchar(32) NOT NULL, + PRIMARY KEY (fl_type, fl_name, fl_flag) +); + +-- +-- Table: keytab_enctypes +-- +DROP TABLE IF EXISTS keytab_enctypes; + +CREATE TABLE keytab_enctypes ( + ke_name varchar(255) NOT NULL, + ke_enctype varchar(255) NOT NULL, + PRIMARY KEY (ke_name, ke_enctype) +); + +-- +-- Table: keytab_sync +-- +DROP TABLE IF EXISTS keytab_sync; + +CREATE TABLE keytab_sync ( + ks_name varchar(255) NOT NULL, + ks_target varchar(255) NOT NULL, + PRIMARY KEY (ks_name, ks_target) +); + +-- +-- Table: sync_targets +-- +DROP TABLE IF EXISTS sync_targets; + +CREATE TABLE sync_targets ( + st_name varchar(255) NOT NULL, + PRIMARY KEY (st_name) +); + +-- +-- Table: types +-- +DROP TABLE IF EXISTS types; + +CREATE TABLE types ( + ty_name varchar(16) NOT NULL, + ty_class varchar(64), + PRIMARY KEY (ty_name) +); + +-- +-- Table: acl_entries +-- +DROP TABLE IF EXISTS acl_entries; + +CREATE TABLE acl_entries ( + ae_id integer NOT NULL, + ae_scheme varchar(32) NOT NULL, + ae_identifier varchar(255) NOT NULL, + PRIMARY KEY (ae_id, ae_scheme, ae_identifier), + FOREIGN KEY(ae_scheme) REFERENCES acl_schemes(as_name), + FOREIGN KEY(ae_id) REFERENCES acls(ac_id) +); + +CREATE INDEX acl_entries_idx_ae_scheme ON acl_entries (ae_scheme); + +CREATE INDEX acl_entries_idx_ae_id ON acl_entries (ae_id); + +-- +-- Table: objects +-- +DROP TABLE IF EXISTS objects; + +CREATE TABLE objects ( + ob_type varchar(16) NOT NULL, + ob_name varchar(255) NOT NULL, + ob_owner integer, + ob_acl_get integer, + ob_acl_store integer, + ob_acl_show integer, + ob_acl_destroy integer, + ob_acl_flags integer, + ob_expires datetime, + ob_created_by varchar(255) NOT NULL, + ob_created_from varchar(255) NOT NULL, + ob_created_on datetime NOT NULL, + ob_stored_by varchar(255), + ob_stored_from varchar(255), + ob_stored_on datetime, + ob_downloaded_by varchar(255), + ob_downloaded_from varchar(255), + ob_downloaded_on datetime, + ob_comment varchar(255), + PRIMARY KEY (ob_name, ob_type), + FOREIGN KEY(ob_acl_destroy) REFERENCES acls(ac_id), + FOREIGN KEY(ob_acl_flags) REFERENCES acls(ac_id), + FOREIGN KEY(ob_acl_get) REFERENCES acls(ac_id), + FOREIGN KEY(ob_owner) REFERENCES acls(ac_id), + FOREIGN KEY(ob_acl_show) REFERENCES acls(ac_id), + FOREIGN KEY(ob_acl_store) REFERENCES acls(ac_id), + FOREIGN KEY(ob_type) REFERENCES types(ty_name) +); + +CREATE INDEX objects_idx_ob_acl_destroy ON objects (ob_acl_destroy); + +CREATE INDEX objects_idx_ob_acl_flags ON objects (ob_acl_flags); + +CREATE INDEX objects_idx_ob_acl_get ON objects (ob_acl_get); + +CREATE INDEX objects_idx_ob_owner ON objects (ob_owner); + +CREATE INDEX objects_idx_ob_acl_show ON objects (ob_acl_show); + +CREATE INDEX objects_idx_ob_acl_store ON objects (ob_acl_store); + +CREATE INDEX objects_idx_ob_type ON objects (ob_type); + +-- +-- Table: object_history +-- +DROP TABLE IF EXISTS object_history; + +CREATE TABLE object_history ( + oh_id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL, + oh_type varchar(16) NOT NULL, + oh_name varchar(255) NOT NULL, + oh_action varchar(16) NOT NULL, + oh_field varchar(16), + oh_type_field varchar(255), + oh_old varchar(255), + oh_new varchar(255), + oh_by varchar(255) NOT NULL, + oh_from varchar(255) NOT NULL, + oh_on datetime NOT NULL, + FOREIGN KEY(oh_type) REFERENCES objects(ob_type) +); + +CREATE INDEX object_history_idx_oh_type_oh_name ON object_history (oh_type, oh_name); + +COMMIT; diff --git a/perl/t/admin.t b/perl/t/admin.t index 6250f8e..cf6a637 100755 --- a/perl/t/admin.t +++ b/perl/t/admin.t @@ -8,12 +8,13 @@ # # See LICENSE for licensing terms. -use Test::More tests => 18; +use Test::More tests => 23; use Wallet::Admin; use Wallet::Report; use Wallet::Schema; use Wallet::Server; +use DBI; use lib 't/lib'; use Util; @@ -56,6 +57,24 @@ is ($admin->register_verifier ('base', 'Wallet::ACL::Base'), undef, is ($server->acl_add ('ADMIN', 'base', 'foo'), 1, ' and adding a base ACL now works'); +# Test an upgrade. Reinitialize to an older version, then test upgrade to +# the current version. +$Wallet::Schema::VERSION = '0.07'; +is ($admin->reinitialize ('admin@EXAMPLE.COM'), 1, + ' and re-initialization succeeds'); +$Wallet::Schema::VERSION = '0.08'; +my $schema = $admin->dbh; +$schema->upgrade_directory ('sql/'); +my $retval = $admin->upgrade; +is ($retval, 1, 'Performing an upgrade succeeds'); +my $dbh = $schema->storage->dbh; +my $sql = "select version from dbix_class_schema_versions order by version " + ."DESC"; +$version = $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'); + # Clean up. is ($admin->destroy, 1, 'Destruction succeeds'); unlink 'wallet-db'; diff --git a/perl/t/lib/Util.pm b/perl/t/lib/Util.pm index 8bbefc4..c15ccfe 100644 --- a/perl/t/lib/Util.pm +++ b/perl/t/lib/Util.pm @@ -45,6 +45,7 @@ sub contents { # for testing by default, but support t/data/test.database as a configuration # file to use another database backend. sub db_setup { + $Wallet::Config::DB_DDL_DIRECTORY = 'sql/'; if (-f 't/data/test.database') { open (DB, '<', 't/data/test.database') or die "cannot open t/data/test.database: $!"; @@ -60,6 +61,10 @@ sub db_setup { $Wallet::Config::DB_USER = $user if $user; $Wallet::Config::DB_PASSWORD = $password if $password; } else { + + # If we have a new SQLite db by default, disable version checking. + $ENV{DBIC_NO_VERSION_CHECK} = 1; + $Wallet::Config::DB_DRIVER = 'SQLite'; $Wallet::Config::DB_INFO = 'wallet-db'; unlink 'wallet-db'; diff --git a/perl/t/report.t b/perl/t/report.t index 363db20..13ef7b6 100755 --- a/perl/t/report.t +++ b/perl/t/report.t @@ -145,7 +145,7 @@ is (scalar (@lines), 1, 'Searching for objects owned by ADMIN finds one'); is ($lines[0][0], 'base', ' and it has the right type'); is ($lines[0][1], 'service/admin', ' and the right name'); @lines = $report->objects ('owner', 'null'); -is (scalar (@lines), 1, 'Searching for objects with no set ownerfinds one'); +is (scalar (@lines), 1, 'Searching for objects with no set owner finds one'); is ($lines[0][0], 'base', ' and it has the right type'); is ($lines[0][1], 'service/null', ' and the right name'); @lines = $report->objects ('acl', 'ADMIN'); diff --git a/perl/t/schema.t b/perl/t/schema.t deleted file mode 100755 index 5dd90d1..0000000 --- a/perl/t/schema.t +++ /dev/null @@ -1,111 +0,0 @@ -#!/usr/bin/perl -w -# -# Tests for the wallet schema class. -# -# Written by Russ Allbery -# Copyright 2007, 2008, 2011 -# The Board of Trustees of the Leland Stanford Junior University -# -# See LICENSE for licensing terms. - -use Test::More tests => 16; - -use DBI (); -use POSIX qw(strftime); -use Wallet::Config (); -use Wallet::Schema (); - -use lib 't/lib'; -use Util; - -my $schema = Wallet::Schema->new; -ok (defined $schema, 'Wallet::Schema creation'); -ok ($schema->isa ('Wallet::Schema'), ' and class verification'); -my @sql = $schema->sql; -ok (@sql > 0, 'sql() returns something'); -is (scalar (@sql), 32, ' and returns the right number of statements'); - -# Connect to a database and test create. -db_setup; -my $connect = "DBI:${Wallet::Config::DB_DRIVER}:${Wallet::Config::DB_INFO}"; -my $user = $Wallet::Config::DB_USER; -my $password = $Wallet::Config::DB_PASSWORD; -$dbh = DBI->connect ($connect, $user, $password); -if (not defined $dbh) { - die "cannot connect to database $connect: $DBI::errstr\n"; -} -$dbh->{RaiseError} = 1; -$dbh->{PrintError} = 0; -eval { $schema->create ($dbh) }; -is ($@, '', "create() doesn't die"); - -# Check that the version number is correct. -my $sql = "select md_version from metadata"; -my $version = $dbh->selectall_arrayref ($sql); -is (@$version, 1, 'metadata has correct number of rows'); -is (@{ $version->[0] }, 1, ' and correct number of columns'); -is ($version->[0][0], 1, ' and the schema version is correct'); - -# Test upgrading the database from version 0. SQLite cannot drop table -# columns, so we have to kill the table and then recreate it. -$dbh->do ("drop table metadata"); -if (lc ($Wallet::Config::DB_DRIVER) eq 'sqlite') { - ($sql) = grep { /create table objects/ } $schema->sql; - $sql =~ s/ob_comment .*,//; - $dbh->do ("drop table objects") - or die "cannot drop objects table: $DBI::errstr\n"; - $dbh->do ($sql) - or die "cannot recreate objects table: $DBI::errstr\n"; -} else { - $dbh->do ("alter table objects drop column ob_comment") - or die "cannot drop ob_comment column: $DBI::errstr\n"; -} -eval { $schema->upgrade ($dbh) }; -is ($@, '', "upgrade() doesn't die"); -$sql = "select md_version from metadata"; -$version = $dbh->selectall_arrayref ($sql); -is (@$version, 1, ' and metadata has correct number of rows'); -is (@{ $version->[0] }, 1, ' and correct number of columns'); -is ($version->[0][0], 1, ' and the schema version is correct'); -$sql = "insert into objects (ob_type, ob_name, ob_created_by, ob_created_from, - ob_created_on, ob_comment) values ('file', 'test', 'test', - 'test.example.org', ?, 'a test comment')"; -$dbh->do ($sql, undef, strftime ('%Y-%m-%d %T', localtime time)); -$sql = "select ob_comment from objects where ob_name = 'test'"; -my ($comment) = $dbh->selectrow_array ($sql); -is ($comment, 'a test comment', ' and ob_comment was added to objects'); - -# Test dropping the database. -eval { $schema->drop ($dbh) }; -is ($@, '', "drop() doesn't die"); - -# Make sure all the tables are gone. -SKIP: { - if (lc ($Wallet::Config::DB_DRIVER) eq 'sqlite') { - my $sql = "select name from sqlite_master where type = 'table'"; - my $sth = $dbh->prepare ($sql); - $sth->execute; - my ($table, @tables); - while (defined ($table = $sth->fetchrow_array)) { - push (@tables, $table) unless $table =~ /^sqlite_/; - } - is ("@tables", '', ' and there are no tables in the database'); - } elsif (lc ($Wallet::Config::DB_DRIVER) eq 'mysql') { - my $sql = "show tables"; - my $sth = $dbh->prepare ($sql); - $sth->execute; - my ($table, @tables); - while (defined ($table = $sth->fetchrow_array)) { - push (@tables, $table); - } - is ("@tables", '', ' and there are no tables in the database'); - } else { - skip 1; - } -} -eval { $schema->create ($dbh) }; -is ($@, '', ' and we can run create again'); - -# Clean up. -eval { $schema->drop ($dbh) }; -unlink 'wallet-db'; diff --git a/perl/t/server.t b/perl/t/server.t index 8e0a30d..63f2e76 100755 --- a/perl/t/server.t +++ b/perl/t/server.t @@ -1030,5 +1030,5 @@ is ($@, "database connection information not configured\n", ' or if DB_INFO is not set'); $Wallet::Config::DB_INFO = 't'; $server = eval { Wallet::Server->new ($user2, $host) }; -like ($@, qr/^cannot connect to database: /, +like ($@, qr/unable to open database file/, ' or if the database connection fails'); diff --git a/server/wallet-admin b/server/wallet-admin index 94d62c7..7e5a402 100755 --- a/server/wallet-admin +++ b/server/wallet-admin @@ -15,6 +15,13 @@ use strict; use Wallet::Admin; +# The last non-DBIx::Class version. If a database has no DBIx::Class +# versioning, we want to set it to this so that upgrades can begin. +our $BASE_VERSION = '0.07'; + +# Directory that contains the wallet SQL files for upgrades. +our $SQL_DIR = '/usr/share/wallet/sql/'; + ############################################################################## # Implementation ############################################################################## @@ -41,6 +48,9 @@ sub command { die "too few arguments to initialize\n" if @args < 1; die "invalid admin principal $args[0]\n" unless $args[0] =~ /^[^\@\s]+\@\S+$/; + + my $schema = $admin->{dbh}; + $schema->upgrade_directory ($SQL_DIR); $admin->initialize (@args) or die $admin->error, "\n"; } elsif ($command eq 'register') { die "too many arguments to register\n" if @args > 3; @@ -59,7 +69,20 @@ sub command { } } elsif ($command eq 'upgrade') { die "too many arguments to upgrade\n" if @args; + + my $schema = $admin->{dbh}; + $schema->upgrade_directory ($SQL_DIR); + + # Check to see if the database is versioned. If not, install the + # versioning table and default version. + if (!$schema->get_db_version) { + print "Versioning database.\n"; + $schema->install ($BASE_VERSION); + } + + # Actually upgrade. $admin->upgrade or die $admin->error, "\n"; + } else { die "unknown command $command\n"; } -- cgit v1.2.3 From bf18b39b6afe541e6888d32d6a555643cbe9d22e Mon Sep 17 00:00:00 2001 From: Jon Robertson Date: Thu, 31 Jan 2013 16:27:49 -0800 Subject: Renamed dbh subroutines and variables for clarity In moving from DBI to DBIx::Class, we at first left the various variables the same. This goes through to update them for the proper names. * Wallet::Admin::schema was created to return the schema object (and similarly for Wallet::Server and Wallet::Report). * Wallet::Admin::dbh was modified to return the actual DBI handle again (and similarly for Wallet::Server and Wallet::Report). * Various places that used $admin->{dbh} were moved to $admin->{schema}. * Various places using $dbh for the schema object were changed to $schema. Change-Id: I00914866e9a8250855a7828474aa9ce0f37b914f Reviewed-on: https://gerrit.stanford.edu/733 Reviewed-by: Russ Allbery Tested-by: Russ Allbery --- perl/Wallet/ACL.pm | 64 ++++++++++++++++----------------- perl/Wallet/Admin.pm | 49 ++++++++++++++----------- perl/Wallet/Object/Base.pm | 80 ++++++++++++++++++++--------------------- perl/Wallet/Object/File.pm | 2 +- perl/Wallet/Object/Keytab.pm | 43 +++++++++++----------- perl/Wallet/Object/WAKeyring.pm | 2 +- perl/Wallet/Report.pm | 50 ++++++++++++++------------ perl/Wallet/Schema.pm | 6 ++-- perl/Wallet/Server.pm | 64 +++++++++++++++++++-------------- perl/t/acl.t | 26 +++++++------- perl/t/admin.t | 4 +-- perl/t/file.t | 14 ++++---- perl/t/init.t | 6 ++-- perl/t/keytab.t | 4 +-- perl/t/object.t | 20 +++++------ perl/t/server.t | 4 +-- perl/t/wa-keyring.t | 10 +++--- 17 files changed, 236 insertions(+), 212 deletions(-) (limited to 'perl/Wallet/Report.pm') diff --git a/perl/Wallet/ACL.pm b/perl/Wallet/ACL.pm index 4f51c70..1e62e7b 100644 --- a/perl/Wallet/ACL.pm +++ b/perl/Wallet/ACL.pm @@ -32,7 +32,7 @@ $VERSION = '0.07'; # and the database handle to use for future operations. If the object # doesn't exist, throws an exception. sub new { - my ($class, $id, $dbh) = @_; + my ($class, $id, $schema) = @_; my (%search, $data, $name); if ($id =~ /^\d+\z/) { $search{ac_id} = $id; @@ -40,7 +40,7 @@ sub new { $search{ac_name} = $id; } eval { - $data = $dbh->resultset('Acl')->find (\%search); + $data = $schema->resultset('Acl')->find (\%search); }; if ($@) { die "cannot search for ACL $id: $@\n"; @@ -48,9 +48,9 @@ sub new { die "ACL $id not found\n"; } my $self = { - dbh => $dbh, - id => $data->ac_id, - name => $data->ac_name, + schema => $schema, + id => $data->ac_id, + name => $data->ac_name, }; bless ($self, $class); return $self; @@ -60,18 +60,18 @@ sub 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, $dbh, $user, $host, $time) = @_; + 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 = $dbh->txn_scope_guard; + my $guard = $schema->txn_scope_guard; # Create the new record. my %record = (ac_name => $name); - my $acl = $dbh->resultset('Acl')->create (\%record); + my $acl = $schema->resultset('Acl')->create (\%record); $id = $acl->ac_id; die "unable to retrieve new ACL ID" unless defined $id; @@ -82,7 +82,7 @@ sub create { ah_by => $user, ah_from => $host, ah_on => $date); - my $history = $dbh->resultset('AclHistory')->create (\%record); + my $history = $schema->resultset('AclHistory')->create (\%record); die "unable to create new history entry" unless defined $history; $guard->commit; @@ -91,9 +91,9 @@ sub create { die "cannot create ACL $name: $@\n"; } my $self = { - dbh => $dbh, - id => $id, - name => $name, + schema => $schema, + id => $id, + name => $name, }; bless ($self, $class); return $self; @@ -134,7 +134,7 @@ sub scheme_mapping { my $class; eval { my %search = (as_name => $scheme); - my $scheme_rec = $self->{dbh}->resultset('AclScheme') + my $scheme_rec = $self->{schema}->resultset('AclScheme') ->find (\%search); $class = $scheme_rec->as_class; }; @@ -169,7 +169,7 @@ sub log_acl { ah_by => $user, ah_from => $host, ah_on => strftime ('%Y-%m-%d %T', localtime $time)); - $self->{dbh}->resultset('AclHistory')->create (\%record); + $self->{schema}->resultset('AclHistory')->create (\%record); } ############################################################################## @@ -186,9 +186,9 @@ sub rename { return; } eval { - my $guard = $self->{dbh}->txn_scope_guard; + my $guard = $self->{schema}->txn_scope_guard; my %search = (ac_id => $self->{id}); - my $acls = $self->{dbh}->resultset('Acl')->find (\%search); + my $acls = $self->{schema}->resultset('Acl')->find (\%search); $acls->ac_name ($name); $acls->update; $guard->commit; @@ -212,7 +212,7 @@ sub destroy { my ($self, $user, $host, $time) = @_; $time ||= time; eval { - my $guard = $self->{dbh}->txn_scope_guard; + my $guard = $self->{schema}->txn_scope_guard; # Make certain no one is using the ACL. my @search = ({ ob_owner => $self->{id} }, @@ -221,7 +221,7 @@ sub destroy { { ob_acl_show => $self->{id} }, { ob_acl_destroy => $self->{id} }, { ob_acl_flags => $self->{id} }); - my @entries = $self->{dbh}->resultset('Object')->search (\@search); + my @entries = $self->{schema}->resultset('Object')->search (\@search); if (@entries) { my ($entry) = @entries; die "ACL in use by ".$entry->ob_type.":".$entry->ob_name; @@ -229,14 +229,14 @@ sub destroy { # Delete any entries (there may or may not be any). my %search = (ae_id => $self->{id}); - @entries = $self->{dbh}->resultset('AclEntry')->search(\%search); + @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->{dbh}->resultset('Acl')->find(\%search); + my $entry = $self->{schema}->resultset('Acl')->find(\%search); $entry->delete if defined $entry; # Create new history line for the deletion. @@ -245,7 +245,7 @@ sub destroy { ah_by => $user, ah_from => $host, ah_on => $time); - $self->{dbh}->resultset('AclHistory')->create (\%record); + $self->{schema}->resultset('AclHistory')->create (\%record); $guard->commit; }; if ($@) { @@ -268,11 +268,11 @@ sub add { return; } eval { - my $guard = $self->{dbh}->txn_scope_guard; + my $guard = $self->{schema}->txn_scope_guard; my %record = (ae_id => $self->{id}, ae_scheme => $scheme, ae_identifier => $identifier); - my $entry = $self->{dbh}->resultset('AclEntry')->create (\%record); + my $entry = $self->{schema}->resultset('AclEntry')->create (\%record); $self->log_acl ('add', $scheme, $identifier, $user, $host, $time); $guard->commit; }; @@ -290,11 +290,11 @@ sub remove { my ($self, $scheme, $identifier, $user, $host, $time) = @_; $time ||= time; eval { - my $guard = $self->{dbh}->txn_scope_guard; + my $guard = $self->{schema}->txn_scope_guard; my %search = (ae_id => $self->{id}, ae_scheme => $scheme, ae_identifier => $identifier); - my $entry = $self->{dbh}->resultset('AclEntry')->find (\%search); + my $entry = $self->{schema}->resultset('AclEntry')->find (\%search); unless (defined $entry) { die "entry not found in ACL\n"; } @@ -322,9 +322,9 @@ sub list { undef $self->{error}; my @entries; eval { - my $guard = $self->{dbh}->txn_scope_guard; + my $guard = $self->{schema}->txn_scope_guard; my %search = (ae_id => $self->{id}); - my @entry_recs = $self->{dbh}->resultset('AclEntry') + my @entry_recs = $self->{schema}->resultset('AclEntry') ->search (\%search); for my $entry (@entry_recs) { push (@entries, [ $entry->ae_scheme, $entry->ae_identifier ]); @@ -364,11 +364,11 @@ sub history { my ($self) = @_; my $output = ''; eval { - my $guard = $self->{dbh}->txn_scope_guard; + my $guard = $self->{schema}->txn_scope_guard; my %search = (ah_acl => $self->{id}); my %options = (order_by => 'ah_on'); - my @data = $self->{dbh}->resultset('AclHistory')->search (\%search, - \%options); + 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); @@ -512,14 +512,14 @@ references. =over 4 -=item new(ACL, DBH) +=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, DBH, PRINCIPAL, HOSTNAME [, DATETIME]) +=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 diff --git a/perl/Wallet/Admin.pm b/perl/Wallet/Admin.pm index c0b1730..9fc146c 100644 --- a/perl/Wallet/Admin.pm +++ b/perl/Wallet/Admin.pm @@ -39,8 +39,8 @@ our $BASE_VERSION = '0.07'; # Throw an exception if anything goes wrong. sub new { my ($class) = @_; - my $dbh = Wallet::Schema->connect; - my $self = { dbh => $dbh }; + my $schema = Wallet::Schema->connect; + my $self = { schema => $schema }; bless ($self, $class); return $self; } @@ -48,7 +48,13 @@ sub new { # Returns the database handle (used mostly for testing). sub dbh { my ($self) = @_; - return $self->{dbh}; + return $self->{schema}->storage->dbh; +} + +# Returns the DBIx::Class-based database schema object. +sub schema { + my ($self) = @_; + return $self->{schema}; } # Set or return the error stashed in the object. @@ -66,7 +72,7 @@ sub error { # Disconnect the database handle on object destruction to avoid warnings. sub DESTROY { my ($self) = @_; - $self->{dbh}->storage->dbh->disconnect; + $self->{schema}->storage->dbh->disconnect; } ############################################################################## @@ -83,7 +89,7 @@ sub initialize { # Deploy the database schema from DDL files, if they exist. If not then # we automatically get the database from the Schema modules. - $self->{dbh}->deploy ({}, $Wallet::Config::DB_DDL_DIRECTORY); + $self->{schema}->deploy ({}, $Wallet::Config::DB_DDL_DIRECTORY); if ($@) { $self->error ($@); return; @@ -91,7 +97,8 @@ sub initialize { $self->default_data; # Create a default admin ACL. - my $acl = Wallet::ACL->create ('ADMIN', $self->{dbh}, $user, 'localhost'); + my $acl = Wallet::ACL->create ('ADMIN', $self->{schema}, $user, + 'localhost'); unless ($acl->add ('krb5', $user, $user, 'localhost')) { $self->error ($acl->error); return; @@ -106,7 +113,7 @@ sub default_data { my ($self) = @_; # acl_schemes default rows. - my ($r1) = $self->{dbh}->resultset('AclScheme')->populate ([ + my ($r1) = $self->{schema}->resultset('AclScheme')->populate ([ [ qw/as_name as_class/ ], [ 'krb5', 'Wallet::ACL::Krb5' ], [ 'krb5-regex', 'Wallet::ACL::Krb5::Regex' ], @@ -120,7 +127,7 @@ sub default_data { my @record = ([ qw/ty_name ty_class/ ], [ 'file', 'Wallet::Object::File' ], [ 'keytab', 'Wallet::Object::Keytab' ]); - ($r1) = $self->{dbh}->resultset('Type')->populate (\@record); + ($r1) = $self->{schema}->resultset('Type')->populate (\@record); warn "default Type not installed" unless defined $r1; return 1; @@ -141,13 +148,13 @@ sub destroy { my ($self) = @_; # Get an actual DBI handle and use it to delete all tables. - my $real_dbh = $self->{dbh}->storage->dbh; + my $dbh = $self->dbh; my @tables = qw/acls acl_entries acl_history acl_schemes enctypes flags keytab_enctypes keytab_sync objects object_history sync_targets types dbix_class_schema_versions/; for my $table (@tables) { my $sql = "DROP TABLE IF EXISTS $table"; - $real_dbh->do ($sql); + $dbh->do ($sql); } return 1; @@ -160,9 +167,9 @@ sub backup { my @dbs = qw/MySQL SQLite PostgreSQL/; my $version = $Wallet::Schema::VERSION; - $self->{dbh}->create_ddl_dir (\@dbs, $version, - $Wallet::Config::DB_DDL_DIRECTORY, - $oldversion); + $self->{schema}->create_ddl_dir (\@dbs, $version, + $Wallet::Config::DB_DDL_DIRECTORY, + $oldversion); return 1; } @@ -174,8 +181,8 @@ sub upgrade { # Check to see if the database is versioned. If not, install the # versioning table and default version. - if (!$self->{dbh}->get_db_version) { - $self->{dbh}->install ($BASE_VERSION); + if (!$self->{schema}->get_db_version) { + $self->{schema}->install ($BASE_VERSION); } # Suppress warnings that actually are just informational messages. @@ -187,8 +194,8 @@ sub upgrade { }; # Perform the actual upgrade. - if ($self->{dbh}->get_db_version) { - eval { $self->{dbh}->upgrade; }; + if ($self->{schema}->get_db_version) { + eval { $self->{schema}->upgrade; }; } if ($@) { $self->error ($@); @@ -210,10 +217,10 @@ sub upgrade { sub register_object { my ($self, $type, $class) = @_; eval { - my $guard = $self->{dbh}->txn_scope_guard; + my $guard = $self->{schema}->txn_scope_guard; my %record = (ty_name => $type, ty_class => $class); - $self->{dbh}->resultset('Type')->create (\%record); + $self->{schema}->resultset('Type')->create (\%record); $guard->commit; }; if ($@) { @@ -230,10 +237,10 @@ sub register_object { sub register_verifier { my ($self, $scheme, $class) = @_; eval { - my $guard = $self->{dbh}->txn_scope_guard; + my $guard = $self->{schema}->txn_scope_guard; my %record = (as_name => $scheme, as_class => $class); - $self->{dbh}->resultset('AclScheme')->create (\%record); + $self->{schema}->resultset('AclScheme')->create (\%record); $guard->commit; }; if ($@) { diff --git a/perl/Wallet/Object/Base.pm b/perl/Wallet/Object/Base.pm index 5bd89a7..dd128cc 100644 --- a/perl/Wallet/Object/Base.pm +++ b/perl/Wallet/Object/Base.pm @@ -36,16 +36,16 @@ $VERSION = '0.06'; # type in the object. If the object doesn't exist, returns undef. This will # probably be usable as-is by most object types. sub new { - my ($class, $type, $name, $dbh) = @_; + my ($class, $type, $name, $schema) = @_; my %search = (ob_type => $type, ob_name => $name); - my $object = $dbh->resultset('Object')->find (\%search); + my $object = $schema->resultset('Object')->find (\%search); die "cannot find ${type}:${name}\n" unless ($object and $object->ob_name eq $name); my $self = { - dbh => $dbh, - name => $name, - type => $type, + schema => $schema, + name => $name, + type => $type, }; bless ($self, $class); return $self; @@ -56,11 +56,11 @@ sub new { # specified class. Stores the database handle to use, the name, and the type # in the object. Subclasses may need to override this to do additional setup. sub create { - my ($class, $type, $name, $dbh, $user, $host, $time) = @_; + my ($class, $type, $name, $schema, $user, $host, $time) = @_; $time ||= time; die "invalid object type\n" unless $type; die "invalid object name\n" unless $name; - my $guard = $dbh->txn_scope_guard; + my $guard = $schema->txn_scope_guard; eval { my %record = (ob_type => $type, ob_name => $name, @@ -68,7 +68,7 @@ sub create { ob_created_from => $host, ob_created_on => strftime ('%Y-%m-%d %T', localtime $time)); - $dbh->resultset('Object')->create (\%record); + $schema->resultset('Object')->create (\%record); %record = (oh_type => $type, oh_name => $name, @@ -76,7 +76,7 @@ sub create { oh_by => $user, oh_from => $host, oh_on => strftime ('%Y-%m-%d %T', localtime $time)); - $dbh->resultset('ObjectHistory')->create (\%record); + $schema->resultset('ObjectHistory')->create (\%record); $guard->commit; }; @@ -84,9 +84,9 @@ sub create { die "cannot create object ${type}:${name}: $@\n"; } my $self = { - dbh => $dbh, - name => $name, - type => $type, + schema => $schema, + name => $name, + type => $type, }; bless ($self, $class); return $self; @@ -136,7 +136,7 @@ sub log_action { # We have two traces to record, one in the object_history table and one in # the object record itself. Commit both changes as a transaction. We # assume that AutoCommit is turned off. - my $guard = $self->{dbh}->txn_scope_guard; + my $guard = $self->{schema}->txn_scope_guard; eval { my %record = (oh_type => $self->{type}, oh_name => $self->{name}, @@ -144,11 +144,11 @@ sub log_action { oh_by => $user, oh_from => $host, oh_on => strftime ('%Y-%m-%d %T', localtime $time)); - $self->{dbh}->resultset('ObjectHistory')->create (\%record); + $self->{schema}->resultset('ObjectHistory')->create (\%record); my %search = (ob_type => $self->{type}, ob_name => $self->{name}); - my $object = $self->{dbh}->resultset('Object')->find (\%search); + my $object = $self->{schema}->resultset('Object')->find (\%search); if ($action eq 'get') { $object->ob_downloaded_by ($user); $object->ob_downloaded_from ($host); @@ -202,7 +202,7 @@ sub log_set { oh_by => $user, oh_from => $host, oh_on => strftime ('%Y-%m-%d %T', localtime $time)); - $self->{dbh}->resultset('ObjectHistory')->create (\%record); + $self->{schema}->resultset('ObjectHistory')->create (\%record); } ############################################################################## @@ -225,11 +225,11 @@ sub _set_internal { return; } - my $guard = $self->{dbh}->txn_scope_guard; + my $guard = $self->{schema}->txn_scope_guard; eval { my %search = (ob_type => $type, ob_name => $name); - my $object = $self->{dbh}->resultset('Object')->find (\%search); + my $object = $self->{schema}->resultset('Object')->find (\%search); my $old = $object->get_column ("ob_$attr"); $object->update ({ "ob_$attr" => $value }); @@ -261,7 +261,7 @@ sub _get_internal { eval { my %search = (ob_type => $type, ob_name => $name); - my $object = $self->{dbh}->resultset('Object')->find (\%search); + my $object = $self->{schema}->resultset('Object')->find (\%search); $value = $object->get_column ($attr); }; if ($@) { @@ -282,7 +282,7 @@ sub acl { my $attr = "acl_$type"; if ($id) { my $acl; - eval { $acl = Wallet::ACL->new ($id, $self->{dbh}) }; + eval { $acl = Wallet::ACL->new ($id, $self->{schema}) }; if ($@) { $self->error ($@); return; @@ -352,7 +352,7 @@ sub owner { my ($self, $owner, $user, $host, $time) = @_; if ($owner) { my $acl; - eval { $acl = Wallet::ACL->new ($owner, $self->{dbh}) }; + eval { $acl = Wallet::ACL->new ($owner, $self->{schema}) }; if ($@) { $self->error ($@); return; @@ -375,13 +375,13 @@ sub flag_check { my ($self, $flag) = @_; my $name = $self->{name}; my $type = $self->{type}; - my $dbh = $self->{dbh}; + my $schema = $self->{schema}; my $value; eval { my %search = (fl_type => $type, fl_name => $name, fl_flag => $flag); - my $flag = $dbh->resultset('Flag')->find (\%search); + my $flag = $schema->resultset('Flag')->find (\%search); if (not defined $flag) { $value = 0; } else { @@ -403,13 +403,13 @@ sub flag_clear { $time ||= time; my $name = $self->{name}; my $type = $self->{type}; - my $dbh = $self->{dbh}; - my $guard = $dbh->txn_scope_guard; + my $schema = $self->{schema}; + my $guard = $schema->txn_scope_guard; eval { my %search = (fl_type => $type, fl_name => $name, fl_flag => $flag); - my $flag = $dbh->resultset('Flag')->find (\%search); + my $flag = $schema->resultset('Flag')->find (\%search); unless (defined $flag) { die "flag not set\n"; } @@ -435,8 +435,8 @@ sub flag_list { my %search = (fl_type => $self->{type}, fl_name => $self->{name}); my %attrs = (order_by => 'fl_flag'); - my @flags_rs = $self->{dbh}->resultset('Flag')->search (\%search, - \%attrs); + my @flags_rs = $self->{schema}->resultset('Flag')->search (\%search, + \%attrs); for my $flag (@flags_rs) { push (@flags, $flag->fl_flag); } @@ -457,17 +457,17 @@ sub flag_set { $time ||= time; my $name = $self->{name}; my $type = $self->{type}; - my $dbh = $self->{dbh}; - my $guard = $dbh->txn_scope_guard; + my $schema = $self->{schema}; + my $guard = $schema->txn_scope_guard; eval { my %search = (fl_type => $type, fl_name => $name, fl_flag => $flag); - my $flag = $dbh->resultset('Flag')->find (\%search); + my $flag = $schema->resultset('Flag')->find (\%search); if (defined $flag) { die "flag already set\n"; } - $flag = $dbh->resultset('Flag')->create (\%search); + $flag = $schema->resultset('Flag')->create (\%search); $self->log_set ('flags', undef, $flag->fl_flag, $user, $host, $time); $guard->commit; }; @@ -489,7 +489,7 @@ sub format_acl_id { my $name = $id; my %search = (ac_id => $id); - my $acl_rs = $self->{dbh}->resultset('Acl')->find (\%search); + my $acl_rs = $self->{schema}->resultset('Acl')->find (\%search); if (defined $acl_rs) { $name = $acl_rs->ac_name . " ($id)"; } @@ -507,7 +507,7 @@ sub history { my %search = (oh_type => $self->{type}, oh_name => $self->{name}); my %attrs = (order_by => 'oh_on'); - my @history = $self->{dbh}->resultset('ObjectHistory') + my @history = $self->{schema}->resultset('ObjectHistory') ->search (\%search, \%attrs); for my $history_rs (@history) { @@ -620,7 +620,7 @@ sub show { eval { my %search = (ob_type => $type, ob_name => $name); - $object_rs = $self->{dbh}->resultset('Object')->find (\%search); + $object_rs = $self->{schema}->resultset('Object')->find (\%search); }; if ($@) { $self->error ("cannot retrieve data for ${type}:${name}: $@"); @@ -658,7 +658,7 @@ sub show { $output .= $attr_output; } if ($field =~ /^ob_(owner|acl_)/) { - my $acl = eval { Wallet::ACL->new ($value, $self->{dbh}) }; + my $acl = eval { Wallet::ACL->new ($value, $self->{schema}) }; if ($acl and not $@) { $value = $acl->name || $value; push (@acls, [ $acl, $value ]); @@ -688,18 +688,18 @@ sub destroy { $self->error ("cannot destroy ${type}:${name}: object is locked"); return; } - my $guard = $self->{dbh}->txn_scope_guard; + my $guard = $self->{schema}->txn_scope_guard; eval { # Remove any flags that may exist for the record. my %search = (fl_type => $type, fl_name => $name); - $self->{dbh}->resultset('Flag')->search (\%search)->delete; + $self->{schema}->resultset('Flag')->search (\%search)->delete; # Remove any object records %search = (ob_type => $type, ob_name => $name); - $self->{dbh}->resultset('Object')->search (\%search)->delete; + $self->{schema}->resultset('Object')->search (\%search)->delete; # And create a new history object for the destroy action. my %record = (oh_type => $type, @@ -708,7 +708,7 @@ sub destroy { oh_by => $user, oh_from => $host, oh_on => strftime ('%Y-%m-%d %T', localtime $time)); - $self->{dbh}->resultset('ObjectHistory')->create (\%record); + $self->{schema}->resultset('ObjectHistory')->create (\%record); $guard->commit; }; if ($@) { diff --git a/perl/Wallet/Object/File.pm b/perl/Wallet/Object/File.pm index 47c8ac2..69468e1 100644 --- a/perl/Wallet/Object/File.pm +++ b/perl/Wallet/Object/File.pm @@ -143,7 +143,7 @@ API HOSTNAME DATETIME keytab remctld backend nul Allbery wallet-backend my @name = qw(file mysql-lsdb) my @trace = ($user, $host, time); - my $object = Wallet::Object::Keytab->create (@name, $dbh, @trace); + my $object = Wallet::Object::Keytab->create (@name, $schema, @trace); unless ($object->store ("the-password\n")) { die $object->error, "\n"; } diff --git a/perl/Wallet/Object/Keytab.pm b/perl/Wallet/Object/Keytab.pm index b50fb6e..962c19b 100644 --- a/perl/Wallet/Object/Keytab.pm +++ b/perl/Wallet/Object/Keytab.pm @@ -40,12 +40,12 @@ sub enctypes_set { my @trace = ($user, $host, $time); my $name = $self->{name}; my %enctypes = map { $_ => 1 } @$enctypes; - my $guard = $self->{dbh}->txn_scope_guard; + my $guard = $self->{schema}->txn_scope_guard; eval { # Find all enctypes for the given keytab. my %search = (ke_name => $name); - my @enctypes = $self->{dbh}->resultset('KeytabEnctype') + my @enctypes = $self->{schema}->resultset('KeytabEnctype') ->search (\%search); my (@current); for my $enctype_rs (@enctypes) { @@ -61,7 +61,7 @@ sub enctypes_set { } else { %search = (ke_name => $name, ke_enctype => $enctype); - $self->{dbh}->resultset('KeytabEnctype')->find (\%search) + $self->{schema}->resultset('KeytabEnctype')->find (\%search) ->delete; $self->log_set ('type_data enctypes', $enctype, undef, @trace); } @@ -73,13 +73,13 @@ sub enctypes_set { # to make it easier to test. for my $enctype (sort keys %enctypes) { my %search = (en_name => $enctype); - my $enctype_rs = $self->{dbh}->('Enctype')->find (\%search); + my $enctype_rs = $self->{schema}->('Enctype')->find (\%search); unless (defined $enctype_rs) { die "unknown encryption type $enctype\n"; } my %record = (ke_name => $name, ke_enctype => $enctype); - $self->{dbh}->resultset('Enctype')->create (\%record); + $self->{schema}->resultset('Enctype')->create (\%record); $self->log_set ('type_data enctypes', undef, $enctype, @trace); } $guard->commit; @@ -101,7 +101,7 @@ sub enctypes_list { eval { my %search = (ke_name => $self->{name}); my %attrs = (order_by => 'ke_enctype'); - my @enctypes_rs = $self->{dbh}->resultset('KeytabEnctype') + my @enctypes_rs = $self->{schema}->resultset('KeytabEnctype') ->search (\%search, \%attrs); for my $enctype_rs (@enctypes_rs) { push (@enctypes, $enctype_rs->ke_enctype); @@ -136,11 +136,11 @@ sub sync_set { $self->error ("unsupported synchronization target $target"); return; } else { - my $guard = $self->{dbh}->txn_scope_guard; + my $guard = $self->{schema}->txn_scope_guard; eval { my $name = $self->{name}; my %search = (ks_name => $name); - my $sync_rs = $self->{dbh}->resultset('KeytabSync') + my $sync_rs = $self->{schema}->resultset('KeytabSync') ->find (\%search); if (defined $sync_rs) { my $target = $sync_rs->ks_target; @@ -167,8 +167,8 @@ sub sync_list { eval { my %search = (ks_name => $self->{name}); my %attrs = (order_by => 'ks_target'); - my @syncs = $self->{dbh}->resultset('KeytabSync')->search (\%search, - \%attrs); + my @syncs = $self->{schema}->resultset('KeytabSync')->search (\%search, + \%attrs); for my $sync_rs (@syncs) { push (@targets, $sync_rs->ks_target); } @@ -239,16 +239,16 @@ sub attr_show { # Override new to start by creating a handle for the kadmin module we're # using. sub new { - my ($class, $type, $name, $dbh) = @_; + my ($class, $type, $name, $schema) = @_; my $self = { - dbh => $dbh, + schema => $schema, kadmin => undef, }; bless $self, $class; my $kadmin = Wallet::Kadmin->new (); $self->{kadmin} = $kadmin; - $self = $class->SUPER::new ($type, $name, $dbh); + $self = $class->SUPER::new ($type, $name, $schema); $self->{kadmin} = $kadmin; return $self; } @@ -258,9 +258,9 @@ sub new { # great here since we don't have a way to communicate the error back to the # caller. sub create { - my ($class, $type, $name, $dbh, $creator, $host, $time) = @_; + my ($class, $type, $name, $schema, $creator, $host, $time) = @_; my $self = { - dbh => $dbh, + schema => $schema, kadmin => undef, }; bless $self, $class; @@ -270,7 +270,8 @@ sub create { if (not $kadmin->create ($name)) { die $kadmin->error, "\n"; } - $self = $class->SUPER::create ($type, $name, $dbh, $creator, $host, $time); + $self = $class->SUPER::create ($type, $name, $schema, $creator, $host, + $time); $self->{kadmin} = $kadmin; return $self; } @@ -283,15 +284,15 @@ sub destroy { $self->error ("cannot destroy $id: object is locked"); return; } - my $dbh = $self->{dbh}; - my $guard = $dbh->txn_scope_guard; + my $schema = $self->{schema}; + my $guard = $schema->txn_scope_guard; eval { my %search = (ks_name => $self->{name}); - my $sync_rs = $dbh->resultset('KeytabSync')->search (\%search); + my $sync_rs = $schema->resultset('KeytabSync')->search (\%search); $sync_rs->delete_all if defined $sync_rs; %search = (ke_name => $self->{name}); - my $enctype_rs = $dbh->resultset('KeytabEnctype')->search (\%search); + my $enctype_rs = $schema->resultset('KeytabEnctype')->search (\%search); $enctype_rs->delete_all if defined $enctype_rs; $guard->commit; @@ -353,7 +354,7 @@ Wallet::Object::Keytab - Keytab object implementation for wallet my @name = qw(keytab host/shell.example.com); my @trace = ($user, $host, time); - my $object = Wallet::Object::Keytab->create (@name, $dbh, @trace); + my $object = Wallet::Object::Keytab->create (@name, $schema, @trace); my $keytab = $object->get (@trace); $object->destroy (@trace); diff --git a/perl/Wallet/Object/WAKeyring.pm b/perl/Wallet/Object/WAKeyring.pm index b26be58..f33497c 100644 --- a/perl/Wallet/Object/WAKeyring.pm +++ b/perl/Wallet/Object/WAKeyring.pm @@ -255,7 +255,7 @@ Wallet::Object::WAKeyring - WebAuth keyring object implementation for wallet my ($user, $host, $time); my @name = qw(wa-keyring www.stanford.edu); my @trace = ($user, $host, $time); - my $object = Wallet::Object::WAKeyring->create (@name, $dbh, $trace); + my $object = Wallet::Object::WAKeyring->create (@name, $schema, $trace); my $keyring = $object->get (@trace); unless ($object->store ($keyring)) { die $object->error, "\n"; diff --git a/perl/Wallet/Report.pm b/perl/Wallet/Report.pm index ea8cd2f..ff25b3a 100644 --- a/perl/Wallet/Report.pm +++ b/perl/Wallet/Report.pm @@ -32,8 +32,8 @@ $VERSION = '0.04'; # exception if anything goes wrong. sub new { my ($class) = @_; - my $dbh = Wallet::Schema->connect; - my $self = { dbh => $dbh }; + my $schema = Wallet::Schema->connect; + my $self = { schema => $schema }; bless ($self, $class); return $self; } @@ -41,7 +41,13 @@ sub new { # Returns the database handle (used mostly for testing). sub dbh { my ($self) = @_; - return $self->{dbh}; + return $self->{schema}->storage->dbh; +} + +# Returns the DBIx::Class-based database schema object. +sub schema { + my ($self) = @_; + return $self->{schema}; } # Set or return the error stashed in the object. @@ -59,7 +65,7 @@ sub error { # Disconnect the database handle on object destruction to avoid warnings. sub DESTROY { my ($self) = @_; - $self->{dbh}->storage->dbh->disconnect; + $self->{schema}->storage->dbh->disconnect; } ############################################################################## @@ -106,7 +112,7 @@ sub objects_owner { if (lc ($owner) eq 'null') { %search = (ob_owner => undef); } else { - my $acl = eval { Wallet::ACL->new ($owner, $self->{dbh}) }; + my $acl = eval { Wallet::ACL->new ($owner, $self->{schema}) }; return unless $acl; %search = (ob_owner => $acl->id); } @@ -138,8 +144,8 @@ sub objects_acl { my ($self, $search) = @_; my @objects; - my $dbh = $self->{dbh}; - my $acl = eval { Wallet::ACL->new ($search, $dbh) }; + my $schema = $self->{schema}; + my $acl = eval { Wallet::ACL->new ($search, $schema) }; return unless $acl; my @search = ({ ob_owner => $acl->id }, @@ -202,10 +208,10 @@ sub objects { # Perform the search and return on any errors. my @objects; - my $dbh = $self->{dbh}; + my $schema = $self->{schema}; eval { - my @objects_rs = $dbh->resultset('Object')->search ($search_ref, - $options_ref); + my @objects_rs = $schema->resultset('Object')->search ($search_ref, + $options_ref); for my $object_rs (@objects_rs) { push (@objects, [ $object_rs->ob_type, $object_rs->ob_name ]); } @@ -228,13 +234,13 @@ sub acls_all { my ($self) = @_; my @acls; - my $dbh = $self->{dbh}; + my $schema = $self->{schema}; my %search = (); my %options = (order_by => [ qw/ac_id/ ], select => [ qw/ac_id ac_name/ ]); eval { - my @acls_rs = $dbh->resultset('Acl')->search (\%search, \%options); + my @acls_rs = $schema->resultset('Acl')->search (\%search, \%options); for my $acl_rs (@acls_rs) { push (@acls, [ $acl_rs->ac_id, $acl_rs->ac_name ]); } @@ -252,7 +258,7 @@ sub acls_empty { my ($self) = @_; my @acls; - my $dbh = $self->{dbh}; + my $schema = $self->{schema}; my %search = (ae_id => undef); my %options = (join => 'acl_entries', prefetch => 'acl_entries', @@ -260,7 +266,7 @@ sub acls_empty { select => [ qw/ac_id ac_name/ ]); eval { - my @acls_rs = $dbh->resultset('Acl')->search (\%search, \%options); + my @acls_rs = $schema->resultset('Acl')->search (\%search, \%options); for my $acl_rs (@acls_rs) { push (@acls, [ $acl_rs->ac_id, $acl_rs->ac_name ]); } @@ -280,7 +286,7 @@ sub acls_entry { my ($self, $type, $identifier) = @_; my @acls; - my $dbh = $self->{dbh}; + my $schema = $self->{schema}; my %search = (ae_scheme => $type, ae_identifier => { like => '%'.$identifier.'%' }); my %options = (join => 'acl_entries', @@ -290,7 +296,7 @@ sub acls_entry { distinct => 1); eval { - my @acls_rs = $dbh->resultset('Acl')->search (\%search, \%options); + my @acls_rs = $schema->resultset('Acl')->search (\%search, \%options); for my $acl_rs (@acls_rs) { push (@acls, [ $acl_rs->ac_id, $acl_rs->ac_name ]); } @@ -308,7 +314,7 @@ sub acls_unused { my ($self) = @_; my @acls; - my $dbh = $self->{dbh}; + my $schema = $self->{schema}; my %search = ( #'acls_owner.ob_owner' => undef, #'acls_get.ob_owner' => undef, @@ -322,7 +328,7 @@ sub acls_unused { select => [ qw/ac_id ac_name/ ]); eval { - my @acls_rs = $dbh->resultset('Acl')->search (\%search, \%options); + my @acls_rs = $schema->resultset('Acl')->search (\%search, \%options); # FIXME: Almost certainly a way of doing this with the search itself. for my $acl_rs (@acls_rs) { @@ -347,7 +353,7 @@ sub acls_unused { # on error and setting the internal error. sub acl_membership { my ($self, $id) = @_; - my $acl = eval { Wallet::ACL->new ($id, $self->{dbh}) }; + my $acl = eval { Wallet::ACL->new ($id, $self->{schema}) }; if ($@) { $self->error ($@); return; @@ -433,7 +439,7 @@ sub acls { sub owners { my ($self, $type, $name) = @_; undef $self->{error}; - my $dbh = $self->{dbh}; + my $schema = $self->{schema}; my @owners; eval { @@ -446,8 +452,8 @@ sub owners { distinct => 1, ); - my @acls_rs = $dbh->resultset('AclEntry')->search (\%search, - \%options); + my @acls_rs = $schema->resultset('AclEntry')->search (\%search, + \%options); for my $acl_rs (@acls_rs) { my $scheme = $acl_rs->ae_scheme; my $identifier = $acl_rs->ae_identifier; diff --git a/perl/Wallet/Schema.pm b/perl/Wallet/Schema.pm index d36b7ac..cee94f7 100644 --- a/perl/Wallet/Schema.pm +++ b/perl/Wallet/Schema.pm @@ -40,11 +40,11 @@ sub connect { my $user = $Wallet::Config::DB_USER; my $pass = $Wallet::Config::DB_PASSWORD; my %attrs = (PrintError => 0, RaiseError => 1); - my $dbh = eval { $class->SUPER::connect ($dsn, $user, $pass, \%attrs) }; + my $schema = eval { $class->SUPER::connect ($dsn, $user, $pass, \%attrs) }; if ($@) { die "cannot connect to database: $@\n"; } - return $dbh; + return $schema; } __END__ @@ -62,7 +62,7 @@ Wallet::Schema - Database schema and connector for the wallet system =head1 SYNOPSIS use Wallet::Schema; - my $dbh = Wallet::Schema->connect; + my $schema = Wallet::Schema->connect; =head1 DESCRIPTION diff --git a/perl/Wallet/Server.pm b/perl/Wallet/Server.pm index 402fbe0..db53f6c 100644 --- a/perl/Wallet/Server.pm +++ b/perl/Wallet/Server.pm @@ -37,13 +37,13 @@ $VERSION = '0.11'; # for various things. Throw an exception if anything goes wrong. sub new { my ($class, $user, $host) = @_; - my $dbh = Wallet::Schema->connect; - my $acl = Wallet::ACL->new ('ADMIN', $dbh); + my $schema = Wallet::Schema->connect; + my $acl = Wallet::ACL->new ('ADMIN', $schema); my $self = { - dbh => $dbh, - user => $user, - host => $host, - admin => $acl, + schema => $schema, + user => $user, + host => $host, + admin => $acl, }; bless ($self, $class); return $self; @@ -52,7 +52,13 @@ sub new { # Returns the database handle (used mostly for testing). sub dbh { my ($self) = @_; - return $self->{dbh}; + return $self->{schema}->storage->dbh; +} + +# Returns the DBIx::Class-based database schema object. +sub schema { + my ($self) = @_; + return $self->{schema}; } # Set or return the error stashed in the object. @@ -71,8 +77,8 @@ sub error { sub DESTROY { my ($self) = @_; - if ($self->{dbh}) { - $self->{dbh}->storage->dbh->disconnect; + if ($self->{schema}) { + $self->{schema}->storage->dbh->disconnect; } } @@ -86,9 +92,9 @@ sub type_mapping { my ($self, $type) = @_; my $class; eval { - my $guard = $self->{dbh}->txn_scope_guard; + my $guard = $self->{schema}->txn_scope_guard; my %search = (ty_name => $type); - my $type_rec = $self->{dbh}->resultset('Type')->find (\%search); + my $type_rec = $self->{schema}->resultset('Type')->find (\%search); $class = $type_rec->ty_class; $guard->commit; }; @@ -118,7 +124,7 @@ sub create_check { my ($self, $type, $name) = @_; my $user = $self->{user}; my $host = $self->{host}; - my $dbh = $self->{dbh}; + my $schema = $self->{schema}; unless (defined (&Wallet::Config::default_owner)) { $self->error ("$user not authorized to create ${type}:${name}"); return; @@ -128,9 +134,9 @@ sub create_check { $self->error ("$user not authorized to create ${type}:${name}"); return; } - my $acl = eval { Wallet::ACL->new ($aname, $dbh) }; + my $acl = eval { Wallet::ACL->new ($aname, $schema) }; if ($@) { - $acl = eval { Wallet::ACL->create ($aname, $dbh, $user, $host) }; + $acl = eval { Wallet::ACL->create ($aname, $schema, $user, $host) }; if ($@) { $self->error ($@); return; @@ -181,10 +187,10 @@ sub create_object { $self->error ("unknown object type $type"); return; } - my $dbh = $self->{dbh}; + my $schema = $self->{schema}; my $user = $self->{user}; my $host = $self->{host}; - my $object = eval { $class->create ($type, $name, $dbh, $user, $host) }; + my $object = eval { $class->create ($type, $name, $schema, $user, $host) }; if ($@) { $self->error ($@); return; @@ -246,7 +252,7 @@ sub retrieve { $self->error ("unknown object type $type"); return; } - my $object = eval { $class->new ($type, $name, $self->{dbh}) }; + my $object = eval { $class->new ($type, $name, $self->{schema}) }; if ($@) { $self->error ($@); return; @@ -302,7 +308,7 @@ sub acl_verify { $self->object_error ($object, $action); return; } - my $acl = eval { Wallet::ACL->new ($id, $self->{dbh}) }; + my $acl = eval { Wallet::ACL->new ($id, $self->{schema}) }; if ($@) { $self->error ($@); return; @@ -556,7 +562,7 @@ sub flag_set { # and undef if there was an error in checking the existence of the object. sub acl_check { my ($self, $id) = @_; - my $acl = eval { Wallet::ACL->new ($id, $self->{dbh}) }; + my $acl = eval { Wallet::ACL->new ($id, $self->{schema}) }; if ($@) { if ($@ =~ /^ACL .* not found/) { return 0; @@ -585,8 +591,8 @@ sub acl_create { return; } } - my $dbh = $self->{dbh}; - my $acl = eval { Wallet::ACL->create ($name, $dbh, $user, $host) }; + my $schema = $self->{schema}; + my $acl = eval { Wallet::ACL->create ($name, $schema, $user, $host) }; if ($@) { $self->error ($@); return; @@ -617,7 +623,7 @@ sub acl_history { $self->acl_error ($id, 'history'); return; } - my $acl = eval { Wallet::ACL->new ($id, $self->{dbh}) }; + my $acl = eval { Wallet::ACL->new ($id, $self->{schema}) }; if ($@) { $self->error ($@); return; @@ -637,7 +643,7 @@ sub acl_show { $self->acl_error ($id, 'show'); return; } - my $acl = eval { Wallet::ACL->new ($id, $self->{dbh}) }; + my $acl = eval { Wallet::ACL->new ($id, $self->{schema}) }; if ($@) { $self->error ($@); return; @@ -658,7 +664,7 @@ sub acl_rename { $self->acl_error ($id, 'rename'); return; } - my $acl = eval { Wallet::ACL->new ($id, $self->{dbh}) }; + my $acl = eval { Wallet::ACL->new ($id, $self->{schema}) }; if ($@) { $self->error ($@); return; @@ -689,7 +695,7 @@ sub acl_destroy { $self->acl_error ($id, 'destroy'); return; } - my $acl = eval { Wallet::ACL->new ($id, $self->{dbh}) }; + my $acl = eval { Wallet::ACL->new ($id, $self->{schema}) }; if ($@) { $self->error ($@); return; @@ -713,7 +719,7 @@ sub acl_add { $self->acl_error ($id, 'add'); return; } - my $acl = eval { Wallet::ACL->new ($id, $self->{dbh}) }; + my $acl = eval { Wallet::ACL->new ($id, $self->{schema}) }; if ($@) { $self->error ($@); return; @@ -733,7 +739,7 @@ sub acl_remove { $self->acl_error ($id, 'remove'); return; } - my $acl = eval { Wallet::ACL->new ($id, $self->{dbh}) }; + my $acl = eval { Wallet::ACL->new ($id, $self->{schema}) }; if ($@) { $self->error ($@); return; @@ -975,6 +981,10 @@ mostly for testing; normally, clients should perform all actions through the Wallet::Server object to ensure that authorization and history logging is done properly. +=item schema() + +Returns the DBIx::Class schema object. + =item error() Returns the error of the last failing operation or undef if no operations diff --git a/perl/t/acl.t b/perl/t/acl.t index f169eb5..62eb411 100755 --- a/perl/t/acl.t +++ b/perl/t/acl.t @@ -29,30 +29,30 @@ db_setup; my $setup = eval { Wallet::Admin->new }; is ($@, '', 'Database connection succeeded'); is ($setup->reinitialize ($setup), 1, 'Database initialization succeeded'); -my $dbh = $setup->dbh; +my $schema = $setup->schema; # Test create and new. -my $acl = eval { Wallet::ACL->create ('test', $dbh, @trace) }; +my $acl = eval { Wallet::ACL->create ('test', $schema, @trace) }; ok (defined ($acl), 'ACL creation'); is ($@, '', ' with no exceptions'); ok ($acl->isa ('Wallet::ACL'), ' and the right class'); is ($acl->name, 'test', ' and the right name'); is ($acl->id, 2, ' and the right ID'); -$acl = eval { Wallet::ACL->create (3, $dbh, @trace) }; +$acl = eval { Wallet::ACL->create (3, $schema, @trace) }; ok (!defined ($acl), 'Creating with a numeric name'); is ($@, "ACL name may not be all numbers\n", ' with the right error message'); -$acl = eval { Wallet::ACL->create ('test', $dbh, @trace) }; +$acl = eval { Wallet::ACL->create ('test', $schema, @trace) }; ok (!defined ($acl), 'Creating a duplicate object'); like ($@, qr/^cannot create ACL test: /, ' with the right error message'); -$acl = eval { Wallet::ACL->new ('test2', $dbh) }; +$acl = eval { Wallet::ACL->new ('test2', $schema) }; ok (!defined ($acl), 'Searching for a non-existent ACL'); is ($@, "ACL test2 not found\n", ' with the right error message'); -$acl = eval { Wallet::ACL->new ('test', $dbh) }; +$acl = eval { Wallet::ACL->new ('test', $schema) }; ok (defined ($acl), 'Searching for the test ACL by name'); is ($@, '', ' with no exceptions'); ok ($acl->isa ('Wallet::ACL'), ' and the right class'); is ($acl->id, 2, ' and the right ID'); -$acl = eval { Wallet::ACL->new (2, $dbh) }; +$acl = eval { Wallet::ACL->new (2, $schema) }; ok (defined ($acl), 'Searching for the test ACL by ID'); is ($@, '', ' with no exceptions'); ok ($acl->isa ('Wallet::ACL'), ' and the right class'); @@ -66,15 +66,15 @@ if ($acl->rename ('example')) { } is ($acl->name, 'example', ' and the new name is right'); is ($acl->id, 2, ' and the ID did not change'); -$acl = eval { Wallet::ACL->new ('test', $dbh) }; +$acl = eval { Wallet::ACL->new ('test', $schema) }; ok (!defined ($acl), ' and it cannot be found under the old name'); is ($@, "ACL test not found\n", ' with the right error message'); -$acl = eval { Wallet::ACL->new ('example', $dbh) }; +$acl = eval { Wallet::ACL->new ('example', $schema) }; ok (defined ($acl), ' and it can be found with the new name'); is ($@, '', ' with no exceptions'); is ($acl->name, 'example', ' and the right name'); is ($acl->id, 2, ' and the right ID'); -$acl = eval { Wallet::ACL->new (2, $dbh) }; +$acl = eval { Wallet::ACL->new (2, $schema) }; ok (defined ($acl), ' and it can still found by ID'); is ($@, '', ' with no exceptions'); is ($acl->name, 'example', ' and the right name'); @@ -212,13 +212,13 @@ if ($acl->destroy (@trace)) { } else { is ($acl->error, '', 'Destroying the ACL works'); } -$acl = eval { Wallet::ACL->new ('example', $dbh) }; +$acl = eval { Wallet::ACL->new ('example', $schema) }; ok (!defined ($acl), ' and now cannot be found'); is ($@, "ACL example not found\n", ' with the right error message'); -$acl = eval { Wallet::ACL->new (2, $dbh) }; +$acl = eval { Wallet::ACL->new (2, $schema) }; ok (!defined ($acl), ' or by ID'); is ($@, "ACL 2 not found\n", ' with the right error message'); -$acl = eval { Wallet::ACL->create ('example', $dbh, @trace) }; +$acl = eval { Wallet::ACL->create ('example', $schema, @trace) }; ok (defined ($acl), ' and creating another with the same name works'); is ($@, '', ' with no exceptions'); is ($acl->name, 'example', ' and the right name'); diff --git a/perl/t/admin.t b/perl/t/admin.t index cf6a637..ff69ee9 100755 --- a/perl/t/admin.t +++ b/perl/t/admin.t @@ -63,11 +63,11 @@ $Wallet::Schema::VERSION = '0.07'; is ($admin->reinitialize ('admin@EXAMPLE.COM'), 1, ' and re-initialization succeeds'); $Wallet::Schema::VERSION = '0.08'; -my $schema = $admin->dbh; +my $schema = $admin->schema; $schema->upgrade_directory ('sql/'); my $retval = $admin->upgrade; is ($retval, 1, 'Performing an upgrade succeeds'); -my $dbh = $schema->storage->dbh; +my $dbh = $admin->dbh; my $sql = "select version from dbix_class_schema_versions order by version " ."DESC"; $version = $dbh->selectall_arrayref ($sql); diff --git a/perl/t/file.t b/perl/t/file.t index a821c4f..f902fba 100755 --- a/perl/t/file.t +++ b/perl/t/file.t @@ -31,7 +31,7 @@ db_setup; my $admin = eval { Wallet::Admin->new }; is ($@, '', 'Database connection succeeded'); is ($admin->reinitialize ($user), 1, 'Database initialization succeeded'); -my $dbh = $admin->dbh; +my $schema = $admin->schema; # Use this to accumulate the history traces so that we can check history. my $history = ''; @@ -39,7 +39,7 @@ my $date = strftime ('%Y-%m-%d %H:%M:%S', localtime $trace[2]); # Test error handling in the absence of configuration. $object = eval { - Wallet::Object::File->create ('file', 'test', $dbh, @trace) + Wallet::Object::File->create ('file', 'test', $schema, @trace) }; ok (defined ($object), 'Creating a basic file object succeeds'); ok ($object->isa ('Wallet::Object::File'), ' and is the right class'); @@ -55,7 +55,7 @@ $Wallet::Config::FILE_BUCKET = 'test-files'; # Okay, now we can test. First, the basic object without store. $object = eval { - Wallet::Object::File->create ('file', 'test', $dbh, @trace) + Wallet::Object::File->create ('file', 'test', $schema, @trace) }; ok (defined ($object), 'Creating a basic file object succeeds'); ok ($object->isa ('Wallet::Object::File'), ' and is the right class'); @@ -66,7 +66,7 @@ is ($object->destroy (@trace), 1, ' but destroying the object succeeds'); # Now store something and be sure that we get something reasonable. $object = eval { - Wallet::Object::File->create ('file', 'test', $dbh, @trace) + Wallet::Object::File->create ('file', 'test', $schema, @trace) }; ok (defined ($object), 'Recreating the object succeeds'); is ($object->store ("foo\n", @trace), 1, ' and storing data in it succeeds'); @@ -103,7 +103,7 @@ ok (! -f 'test-files/09/test', ' and the file is gone'); # Now try some aggressive names. $object = eval { - Wallet::Object::File->create ('file', '../foo', $dbh, @trace) + Wallet::Object::File->create ('file', '../foo', $schema, @trace) }; ok (defined ($object), 'Creating ../foo succeeds'); is ($object->store ("foo\n", @trace), 1, ' and storing data in it succeeds'); @@ -115,7 +115,7 @@ is ($object->get (@trace), "foo\n", ' and get returns correctly'); is ($object->destroy (@trace), 1, 'Destroying the object works'); ok (! -f 'test-files/39/%2E%2E%2Ffoo', ' and the file is gone'); $object = eval { - Wallet::Object::File->create ('file', "\0", $dbh, @trace) + Wallet::Object::File->create ('file', "\0", $schema, @trace) }; ok (defined ($object), 'Creating nul succeeds'); is ($object->store ("foo\n", @trace), 1, ' and storing data in it succeeds'); @@ -130,7 +130,7 @@ ok (! -f 'test-files/93/%00', ' and the file is gone'); # Test error handling in the file store. system ('rm -r test-files') == 0 or die "cannot remove test-files\n"; $object = eval { - Wallet::Object::File->create ('file', 'test', $dbh, @trace) + Wallet::Object::File->create ('file', 'test', $schema, @trace) }; ok (defined ($object), 'Recreating the object succeeds'); is ($object->store ("foo\n", @trace), undef, diff --git a/perl/t/init.t b/perl/t/init.t index 213aedf..aa028e3 100755 --- a/perl/t/init.t +++ b/perl/t/init.t @@ -24,7 +24,7 @@ is ($admin->initialize ('admin@EXAMPLE.COM'), 1, ' and initialization succeeds'); # Check whether the database entries that should be created were. -my $acl = eval { Wallet::ACL->new ('ADMIN', $admin->dbh) }; +my $acl = eval { Wallet::ACL->new ('ADMIN', $admin->schema) }; is ($@, '', 'Retrieving ADMIN ACL successful'); ok ($acl->isa ('Wallet::ACL'), ' and is the right class'); my @entries = $acl->list; @@ -38,7 +38,7 @@ is ($admin->reinitialize ('admin@EXAMPLE.ORG'), 1, 'Reinitialization succeeded'); # Now repeat the database content checks. -$acl = eval { Wallet::ACL->new ('ADMIN', $admin->dbh) }; +$acl = eval { Wallet::ACL->new ('ADMIN', $admin->schema) }; is ($@, '', 'Retrieving ADMIN ACL successful'); ok ($acl->isa ('Wallet::ACL'), ' and is the right class'); @entries = $acl->list; @@ -49,7 +49,7 @@ is ($entries[0][1], 'admin@EXAMPLE.ORG', ' with the right user'); # Test cleanup. is ($admin->destroy, 1, 'Destroying the database works'); -$acl = eval { Wallet::ACL->new ('ADMIN', $admin->dbh) }; +$acl = eval { Wallet::ACL->new ('ADMIN', $admin->schema) }; like ($@, qr/^cannot search for ACL ADMIN: /, ' and now the database is gone'); unlink 'wallet-db'; diff --git a/perl/t/keytab.t b/perl/t/keytab.t index c263f58..561f130 100755 --- a/perl/t/keytab.t +++ b/perl/t/keytab.t @@ -147,8 +147,8 @@ db_setup; my $admin = eval { Wallet::Admin->new }; is ($@, '', 'Database connection succeeded'); is ($admin->reinitialize ($user), 1, 'Database initialization succeeded'); -my $schema = $admin->dbh; -my $dbh = $schema->storage->dbh; +my $schema = $admin->schema; +my $dbh = $admin->dbh; # Use this to accumulate the history traces so that we can check history. my $history = ''; diff --git a/perl/t/object.t b/perl/t/object.t index 2d60dd2..5eb6941 100755 --- a/perl/t/object.t +++ b/perl/t/object.t @@ -30,26 +30,26 @@ db_setup; my $admin = eval { Wallet::Admin->new }; is ($@, '', 'Database connection succeeded'); is ($admin->reinitialize ($user), 1, 'Database initialization succeeded'); -my $dbh = $admin->dbh; +my $schema = $admin->schema; # Okay, now we have a database. Test create and new. We make believe this is # a keytab object; it won't matter for what we're doing. my $object = eval { - Wallet::Object::Base->create ('keytab', $princ, $dbh, @trace) + Wallet::Object::Base->create ('keytab', $princ, $schema, @trace) }; is ($@, '', 'Object creation did not die'); ok ($object->isa ('Wallet::Object::Base'), ' and returned the right class'); my $other = eval { - Wallet::Object::Base->create ('keytab', $princ, $dbh, @trace) + Wallet::Object::Base->create ('keytab', $princ, $schema, @trace) }; like ($@, qr/^cannot create object \Qkeytab:$princ: /, 'Repeating fails'); -$other = eval { Wallet::Object::Base->create ('', $princ, $dbh, @trace) }; +$other = eval { Wallet::Object::Base->create ('', $princ, $schema, @trace) }; is ($@, "invalid object type\n", 'Using an empty type fails'); -$other = eval { Wallet::Object::Base->create ('keytab', '', $dbh, @trace) }; +$other = eval { Wallet::Object::Base->create ('keytab', '', $schema, @trace) }; is ($@, "invalid object name\n", ' as does an empty name'); -$object = eval { Wallet::Object::Base->new ('keytab', "a$princ", $dbh) }; +$object = eval { Wallet::Object::Base->new ('keytab', "a$princ", $schema) }; is ($@, "cannot find keytab:a$princ\n", 'Searching for unknown object fails'); -$object = eval { Wallet::Object::Base->new ('keytab', $princ, $dbh) }; +$object = eval { Wallet::Object::Base->new ('keytab', $princ, $schema) }; is ($@, '', 'Object new did not die'); ok ($object->isa ('Wallet::Object::Base'), ' and returned the right class'); @@ -58,7 +58,7 @@ is ($object->type, 'keytab', 'Type accessor works'); is ($object->name, $princ, 'Name accessor works'); # We'll use this for later tests. -my $acl = Wallet::ACL->new ('ADMIN', $dbh); +my $acl = Wallet::ACL->new ('ADMIN', $schema); # Owner. is ($object->owner, undef, 'Owner is not set to start'); @@ -266,12 +266,12 @@ if ($object->destroy (@trace)) { } else { is ($object->error, '', 'Destroy is successful'); } -$object = eval { Wallet::Object::Base->new ('keytab', $princ, $dbh) }; +$object = eval { Wallet::Object::Base->new ('keytab', $princ, $schema) }; is ($@, "cannot find keytab:$princ\n", ' and object is all gone'); # Test history. $object = eval { - Wallet::Object::Base->create ('keytab', $princ, $dbh, @trace) + Wallet::Object::Base->create ('keytab', $princ, $schema, @trace) }; ok (defined ($object), 'Recreating the object succeeds'); $output = <<"EOO"; diff --git a/perl/t/server.t b/perl/t/server.t index 63f2e76..8474989 100755 --- a/perl/t/server.t +++ b/perl/t/server.t @@ -36,8 +36,8 @@ is ($setup->reinitialize ($admin), 1, 'Database initialization succeeded'); $server = eval { Wallet::Server->new (@trace) }; is ($@, '', 'Reopening with new did not die'); ok ($server->isa ('Wallet::Server'), ' and returned the right class'); -my $dbh = $server->dbh; -ok (defined ($dbh), ' and returns a defined database handle'); +my $schema = $server->schema; +ok (defined ($schema), ' and returns a defined schema object'); # Allow creation of base objects for testing purposes. $setup->register_object ('base', 'Wallet::Object::Base'); diff --git a/perl/t/wa-keyring.t b/perl/t/wa-keyring.t index 703b7fe..3011d54 100755 --- a/perl/t/wa-keyring.t +++ b/perl/t/wa-keyring.t @@ -40,14 +40,14 @@ db_setup; my $admin = eval { Wallet::Admin->new }; is ($@, '', 'Database connection succeeded'); is ($admin->reinitialize ($user), 1, 'Database initialization succeeded'); -my $dbh = $admin->dbh; +my $schema = $admin->schema; # Create a WebAuth context to use. my $wa = WebAuth->new; # Test error handling in the absence of configuration. my $object = eval { - Wallet::Object::WAKeyring->create ('wa-keyring', 'test', $dbh, @trace) + Wallet::Object::WAKeyring->create ('wa-keyring', 'test', $schema, @trace) }; ok (defined ($object), 'Creating a basic WebAuth keyring object succeeds'); ok ($object->isa ('Wallet::Object::WAKeyring'), ' and is the right class'); @@ -65,7 +65,7 @@ $Wallet::Config::WAKEYRING_BUCKET = 'test-keyrings'; # Okay, now we can test. First, the basic object without store. $object = eval { - Wallet::Object::WAKeyring->create ('wa-keyring', 'test', $dbh, @trace) + Wallet::Object::WAKeyring->create ('wa-keyring', 'test', $schema, @trace) }; ok (defined ($object), 'Creating a basic WebAuth keyring object succeeds'); ok ($object->isa ('Wallet::Object::WAKeyring'), ' and is the right class'); @@ -100,7 +100,7 @@ is ($object->destroy (@trace), 1, 'Destroying the object succeeds'); # Now store something and be sure that we get something reasonable. $object = eval { - Wallet::Object::WAKeyring->create ('wa-keyring', 'test', $dbh, @trace) + Wallet::Object::WAKeyring->create ('wa-keyring', 'test', $schema, @trace) }; ok (defined ($object), 'Recreating the object succeeds'); my $key = WebAuth::Key->new ($wa, WA_KEY_AES, WA_AES_128); @@ -159,7 +159,7 @@ is ($object->destroy (@trace), 1, 'Destroying the object succeeds'); # Test error handling in the file store. system ('rm -r test-keyrings') == 0 or die "cannot remove test-keyrings\n"; $object = eval { - Wallet::Object::WAKeyring->create ('wa-keyring', 'test', $dbh, @trace) + Wallet::Object::WAKeyring->create ('wa-keyring', 'test', $schema, @trace) }; ok (defined ($object), 'Recreating the object succeeds'); is ($object->get (@trace), undef, ' but retrieving it fails'); -- cgit v1.2.3 From 4d11772001f65264bf714711550acdbb05900f4c Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Wed, 27 Feb 2013 14:46:47 -0800 Subject: Use correct form of Stanford's copyright statement Change-Id: I06dd9ecca19315179bdd34d4b301548fe7604331 Reviewed-on: https://gerrit.stanford.edu/842 Reviewed-by: Russ Allbery Tested-by: Russ Allbery --- client/file.c | 3 ++- client/internal.h | 3 ++- client/keytab.c | 3 ++- client/krb5.c | 3 ++- client/options.c | 2 +- client/remctl.c | 3 ++- client/srvtab.c | 3 ++- client/wallet-rekey.c | 3 ++- client/wallet.c | 2 +- configure.ac | 4 +--- contrib/convert-srvtab-db | 3 ++- contrib/used-principals | 3 ++- contrib/wallet-contacts | 3 ++- contrib/wallet-summary | 3 ++- contrib/wallet-unknown-hosts | 3 ++- examples/stanford.conf | 3 ++- perl/Wallet/ACL.pm | 3 ++- perl/Wallet/ACL/Base.pm | 3 ++- perl/Wallet/ACL/Krb5.pm | 3 ++- perl/Wallet/ACL/Krb5/Regex.pm | 3 ++- perl/Wallet/ACL/NetDB.pm | 3 ++- perl/Wallet/ACL/NetDB/Root.pm | 3 ++- perl/Wallet/Config.pm | 3 ++- perl/Wallet/Database.pm | 3 ++- perl/Wallet/Kadmin.pm | 3 ++- perl/Wallet/Kadmin/Heimdal.pm | 3 ++- perl/Wallet/Kadmin/MIT.pm | 2 +- perl/Wallet/Object/File.pm | 3 ++- perl/Wallet/Object/Keytab.pm | 4 ++-- perl/Wallet/Report.pm | 3 ++- perl/create-ddl | 3 ++- perl/t/acl.t | 3 ++- perl/t/config.t | 3 ++- perl/t/file.t | 3 ++- perl/t/init.t | 3 ++- perl/t/keytab.t | 2 +- perl/t/lib/Util.pm | 3 ++- perl/t/pod.t | 3 ++- perl/t/report.t | 3 ++- perl/t/verifier-netdb.t | 3 ++- perl/t/verifier.t | 3 ++- server/keytab-backend | 2 +- server/wallet-report | 3 ++- tests/client/basic-t.in | 2 +- tests/client/full-t.in | 3 ++- tests/client/prompt-t.in | 3 ++- tests/client/rekey-t.in | 2 +- tests/data/cmd-fake | 4 +++- tests/data/fake-kadmin | 3 ++- tests/server/keytab-t | 3 ++- tests/server/report-t | 3 ++- 51 files changed, 95 insertions(+), 54 deletions(-) (limited to 'perl/Wallet/Report.pm') diff --git a/client/file.c b/client/file.c index 861da6a..c171969 100644 --- a/client/file.c +++ b/client/file.c @@ -2,7 +2,8 @@ * File handling for the wallet client. * * Written by Russ Allbery - * Copyright 2007, 2008, 2010 Board of Trustees, Leland Stanford Jr. University + * Copyright 2007, 2008, 2010 + * The Board of Trustees of the Leland Stanford Junior University * * See LICENSE for licensing terms. */ diff --git a/client/internal.h b/client/internal.h index c8e5802..24dd875 100644 --- a/client/internal.h +++ b/client/internal.h @@ -2,7 +2,8 @@ * Internal support functions for the wallet client. * * Written by Russ Allbery - * Copyright 2007, 2008, 2010 Board of Trustees, Leland Stanford Jr. University + * Copyright 2007, 2008, 2010 + * The Board of Trustees of the Leland Stanford Junior University * * See LICENSE for licensing terms. */ diff --git a/client/keytab.c b/client/keytab.c index 6614c4b..0a3e419 100644 --- a/client/keytab.c +++ b/client/keytab.c @@ -2,7 +2,8 @@ * Implementation of keytab handling for the wallet client. * * Written by Russ Allbery - * Copyright 2007, 2008, 2010 Board of Trustees, Leland Stanford Jr. University + * Copyright 2007, 2008, 2010, 2013 + * The Board of Trustees of the Leland Stanford Junior University * * See LICENSE for licensing terms. */ diff --git a/client/krb5.c b/client/krb5.c index aad39f6..e86a225 100644 --- a/client/krb5.c +++ b/client/krb5.c @@ -6,7 +6,8 @@ * client. * * Written by Russ Allbery - * Copyright 2007, 2008, 2010 Board of Trustees, Leland Stanford Jr. University + * Copyright 2007, 2008, 2010 + * The Board of Trustees of the Leland Stanford Junior University */ #include diff --git a/client/options.c b/client/options.c index 2f1de70..67ecb7f 100644 --- a/client/options.c +++ b/client/options.c @@ -6,7 +6,7 @@ * * Written by Russ Allbery * Copyright 2006, 2007, 2008, 2010 - * Board of Trustees, Leland Stanford Jr. University + * The Board of Trustees of the Leland Stanford Junior University * * See LICENSE for licensing terms. */ diff --git a/client/remctl.c b/client/remctl.c index 5a541d5..071e410 100644 --- a/client/remctl.c +++ b/client/remctl.c @@ -2,7 +2,8 @@ * remctl interface for the wallet client. * * Written by Russ Allbery - * Copyright 2007, 2010 Board of Trustees, Leland Stanford Jr. University + * Copyright 2007, 2010 + * The Board of Trustees of the Leland Stanford Junior University * * See LICENSE for licensing terms. */ diff --git a/client/srvtab.c b/client/srvtab.c index b26e6fc..73277e9 100644 --- a/client/srvtab.c +++ b/client/srvtab.c @@ -2,7 +2,8 @@ * Implementation of srvtab handling for the wallet client. * * Written by Russ Allbery - * Copyright 2007, 2008, 2010 Board of Trustees, Leland Stanford Jr. University + * Copyright 2007, 2008, 2010 + * The Board of Trustees of the Leland Stanford Junior University * * See LICENSE for licensing terms. */ diff --git a/client/wallet-rekey.c b/client/wallet-rekey.c index 3a9687c..5007f41 100644 --- a/client/wallet-rekey.c +++ b/client/wallet-rekey.c @@ -3,7 +3,8 @@ * * Written by Russ Allbery * and Jon Robertson - * Copyright 2010 Board of Trustees, Leland Stanford Jr. University + * Copyright 2010 + * The Board of Trustees of the Leland Stanford Junior University * * See LICENSE for licensing terms. */ diff --git a/client/wallet.c b/client/wallet.c index dc04dcd..c5a7877 100644 --- a/client/wallet.c +++ b/client/wallet.c @@ -3,7 +3,7 @@ * * Written by Russ Allbery * Copyright 2006, 2007, 2008, 2010 - * Board of Trustees, Leland Stanford Jr. University + * The Board of Trustees of the Leland Stanford Junior University * * See LICENSE for licensing terms. */ diff --git a/configure.ac b/configure.ac index a79e42d..4fc218b 100644 --- a/configure.ac +++ b/configure.ac @@ -2,12 +2,10 @@ dnl Autoconf configuration for wallet. dnl dnl Written by Russ Allbery dnl Copyright 2006, 2007, 2008, 2010 -dnl Board of Trustees, Leland Stanford Jr. University +dnl The Board of Trustees of the Leland Stanford Junior University dnl dnl See LICENSE for licensing terms. -dnl We cannot use -Wall -Werror with AM_INIT_AUTOMAKE since we override -dnl distuninstallcheck (not supported by Perl). AC_PREREQ([2.64]) AC_INIT([wallet], [0.12], [rra@stanford.edu]) AC_CONFIG_AUX_DIR([build-aux]) diff --git a/contrib/convert-srvtab-db b/contrib/convert-srvtab-db index 8d3b31e..6263472 100755 --- a/contrib/convert-srvtab-db +++ b/contrib/convert-srvtab-db @@ -3,7 +3,8 @@ # convert-srvtab-db -- Converts a leland_srvtab database to wallet # # Written by Russ Allbery -# Copyright 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/contrib/used-principals b/contrib/used-principals index aa838fe..ca431e3 100755 --- a/contrib/used-principals +++ b/contrib/used-principals @@ -3,7 +3,8 @@ # used-principals -- Report which Kerberos v5 principals are in use. # # Written by Russ Allbery -# Copyright 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/contrib/wallet-contacts b/contrib/wallet-contacts index 177fc76..907c161 100755 --- a/contrib/wallet-contacts +++ b/contrib/wallet-contacts @@ -3,7 +3,8 @@ # wallet-contacts -- Report contact addresses for matching wallet objects. # # Written by Russ Allbery -# Copyright 2009 Board of Trustees, Leland Stanford Jr. University +# Copyright 2009 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/contrib/wallet-summary b/contrib/wallet-summary index aba8406..2237351 100755 --- a/contrib/wallet-summary +++ b/contrib/wallet-summary @@ -3,7 +3,8 @@ # wallet-summary -- Summarize keytabs in the wallet database. # # Written by Russ Allbery -# Copyright 2003, 2008, 2010 Board of Trustees, Leland Stanford Jr. University +# Copyright 2003, 2008, 2010 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/contrib/wallet-unknown-hosts b/contrib/wallet-unknown-hosts index da972b2..e19dcf0 100755 --- a/contrib/wallet-unknown-hosts +++ b/contrib/wallet-unknown-hosts @@ -3,7 +3,8 @@ # wallet-unknown-hosts -- Report host keytabs in wallet for unknown hosts. # # Written by Russ Allbery -# Copyright 2010 Board of Trustees, Leland Stanford Jr. University +# Copyright 2010 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/examples/stanford.conf b/examples/stanford.conf index becfc6e..1d14796 100644 --- a/examples/stanford.conf +++ b/examples/stanford.conf @@ -6,7 +6,8 @@ # ACL rules. # # Written by Russ Allbery -# Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2008 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/perl/Wallet/ACL.pm b/perl/Wallet/ACL.pm index 1e62e7b..5d9e8f2 100644 --- a/perl/Wallet/ACL.pm +++ b/perl/Wallet/ACL.pm @@ -1,7 +1,8 @@ # Wallet::ACL -- Implementation of ACLs in the wallet system. # # Written by Russ Allbery -# Copyright 2007, 2008, 2010 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2008, 2010, 2013 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/perl/Wallet/ACL/Base.pm b/perl/Wallet/ACL/Base.pm index 85eaefa..5112c2f 100644 --- a/perl/Wallet/ACL/Base.pm +++ b/perl/Wallet/ACL/Base.pm @@ -1,7 +1,8 @@ # Wallet::ACL::Base -- Parent class for wallet ACL verifiers. # # Written by Russ Allbery -# Copyright 2007, 2010 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2010 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/perl/Wallet/ACL/Krb5.pm b/perl/Wallet/ACL/Krb5.pm index 12be141..716a223 100644 --- a/perl/Wallet/ACL/Krb5.pm +++ b/perl/Wallet/ACL/Krb5.pm @@ -1,7 +1,8 @@ # Wallet::ACL::Krb5 -- Wallet Kerberos v5 principal ACL verifier. # # Written by Russ Allbery -# Copyright 2007, 2010 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2010 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/perl/Wallet/ACL/Krb5/Regex.pm b/perl/Wallet/ACL/Krb5/Regex.pm index 8f9702e..ce2fe48 100644 --- a/perl/Wallet/ACL/Krb5/Regex.pm +++ b/perl/Wallet/ACL/Krb5/Regex.pm @@ -1,7 +1,8 @@ # Wallet::ACL::Krb5::Regex -- Wallet Kerberos v5 principal regex ACL verifier # # Written by Russ Allbery -# Copyright 2007, 2010 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2010 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/perl/Wallet/ACL/NetDB.pm b/perl/Wallet/ACL/NetDB.pm index 0aa8958..2d35f49 100644 --- a/perl/Wallet/ACL/NetDB.pm +++ b/perl/Wallet/ACL/NetDB.pm @@ -1,7 +1,8 @@ # Wallet::ACL::NetDB -- Wallet NetDB role ACL verifier. # # Written by Russ Allbery -# Copyright 2007, 2010 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2010 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/perl/Wallet/ACL/NetDB/Root.pm b/perl/Wallet/ACL/NetDB/Root.pm index c28bb1e..ea79d79 100644 --- a/perl/Wallet/ACL/NetDB/Root.pm +++ b/perl/Wallet/ACL/NetDB/Root.pm @@ -1,7 +1,8 @@ # Wallet::ACL::NetDB::Root -- Wallet NetDB role ACL verifier (root instances). # # Written by Russ Allbery -# Copyright 2007, 2010 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2010 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/perl/Wallet/Config.pm b/perl/Wallet/Config.pm index 9649c6c..af153e7 100644 --- a/perl/Wallet/Config.pm +++ b/perl/Wallet/Config.pm @@ -1,7 +1,8 @@ # Wallet::Config -- Configuration handling for the wallet server. # # Written by Russ Allbery -# Copyright 2007, 2008, 2010 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2008, 2010, 2013 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/perl/Wallet/Database.pm b/perl/Wallet/Database.pm index 8df338a..61de0ba 100644 --- a/perl/Wallet/Database.pm +++ b/perl/Wallet/Database.pm @@ -6,7 +6,8 @@ # like DBIx::Class objects in the rest of the code. # # Written by Russ Allbery -# Copyright 2008-2012 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008, 2009, 2010, 2012, 2013 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/perl/Wallet/Kadmin.pm b/perl/Wallet/Kadmin.pm index 074dd1e..bfff3ef 100644 --- a/perl/Wallet/Kadmin.pm +++ b/perl/Wallet/Kadmin.pm @@ -1,7 +1,8 @@ # Wallet::Kadmin -- Kerberos administration API for wallet keytab backend. # # Written by Jon Robertson -# Copyright 2009, 2010 Board of Trustees, Leland Stanford Jr. University +# Copyright 2009, 2010 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/perl/Wallet/Kadmin/Heimdal.pm b/perl/Wallet/Kadmin/Heimdal.pm index 6c91b1d..bb07b93 100644 --- a/perl/Wallet/Kadmin/Heimdal.pm +++ b/perl/Wallet/Kadmin/Heimdal.pm @@ -1,7 +1,8 @@ # Wallet::Kadmin::Heimdal -- Wallet Kerberos administration API for Heimdal. # # Written by Jon Robertson -# Copyright 2009, 2010 Board of Trustees, Leland Stanford Jr. University +# Copyright 2009, 2010 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/perl/Wallet/Kadmin/MIT.pm b/perl/Wallet/Kadmin/MIT.pm index c191bc9..b633e67 100644 --- a/perl/Wallet/Kadmin/MIT.pm +++ b/perl/Wallet/Kadmin/MIT.pm @@ -3,7 +3,7 @@ # Written by Russ Allbery # Pulled into a module by Jon Robertson # Copyright 2007, 2008, 2009, 2010 -# Board of Trustees, Leland Stanford Jr. University +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/perl/Wallet/Object/File.pm b/perl/Wallet/Object/File.pm index 69468e1..49589f1 100644 --- a/perl/Wallet/Object/File.pm +++ b/perl/Wallet/Object/File.pm @@ -1,7 +1,8 @@ # Wallet::Object::File -- File object implementation for the wallet. # # Written by Russ Allbery -# Copyright 2008, 2010 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008, 2010 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/perl/Wallet/Object/Keytab.pm b/perl/Wallet/Object/Keytab.pm index 962c19b..e00747b 100644 --- a/perl/Wallet/Object/Keytab.pm +++ b/perl/Wallet/Object/Keytab.pm @@ -1,8 +1,8 @@ # Wallet::Object::Keytab -- Keytab object implementation for the wallet. # # Written by Russ Allbery -# Copyright 2007, 2008, 2009, 2010 -# Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2008, 2009, 2010, 2013 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/perl/Wallet/Report.pm b/perl/Wallet/Report.pm index ff25b3a..b27a998 100644 --- a/perl/Wallet/Report.pm +++ b/perl/Wallet/Report.pm @@ -1,7 +1,8 @@ # Wallet::Report -- Wallet system reporting interface. # # Written by Russ Allbery -# Copyright 2008, 2009, 2010 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008, 2009, 2010, 2013 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/perl/create-ddl b/perl/create-ddl index 62deb86..10f126a 100755 --- a/perl/create-ddl +++ b/perl/create-ddl @@ -3,7 +3,8 @@ # create-ddl - Create DDL files for Wallet # # Written by Jon Robertson -# Copyright 2012 Board of Trustees, Leland Stanford Jr. University +# Copyright 2012 +# The Board of Trustees of the Leland Stanford Junior University ############################################################################# # Modules and declarations diff --git a/perl/t/acl.t b/perl/t/acl.t index 62eb411..26b4903 100755 --- a/perl/t/acl.t +++ b/perl/t/acl.t @@ -3,7 +3,8 @@ # Tests for the wallet ACL API. # # Written by Russ Allbery -# Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2008 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/perl/t/config.t b/perl/t/config.t index 6b9f226..543e5d6 100755 --- a/perl/t/config.t +++ b/perl/t/config.t @@ -3,7 +3,8 @@ # Tests for the wallet server configuration. # # Written by Russ Allbery -# Copyright 2008, 2010 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008, 2010 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/perl/t/file.t b/perl/t/file.t index f902fba..5cb7c35 100755 --- a/perl/t/file.t +++ b/perl/t/file.t @@ -3,7 +3,8 @@ # Tests for the file object implementation. # # Written by Russ Allbery -# Copyright 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/perl/t/init.t b/perl/t/init.t index aa028e3..142f54c 100755 --- a/perl/t/init.t +++ b/perl/t/init.t @@ -3,7 +3,8 @@ # Tests for database initialization. # # Written by Russ Allbery -# Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2008 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/perl/t/keytab.t b/perl/t/keytab.t index 561f130..3ced592 100755 --- a/perl/t/keytab.t +++ b/perl/t/keytab.t @@ -4,7 +4,7 @@ # # Written by Russ Allbery # Copyright 2007, 2008, 2009, 2010 -# Board of Trustees, Leland Stanford Jr. University +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/perl/t/lib/Util.pm b/perl/t/lib/Util.pm index c15ccfe..3e606fe 100644 --- a/perl/t/lib/Util.pm +++ b/perl/t/lib/Util.pm @@ -1,7 +1,8 @@ # Utility class for wallet tests. # # Written by Russ Allbery -# Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2008 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/perl/t/pod.t b/perl/t/pod.t index c467b82..dc5f468 100755 --- a/perl/t/pod.t +++ b/perl/t/pod.t @@ -3,7 +3,8 @@ # Test POD formatting for the wallet Perl modules. # # Written by Russ Allbery -# Copyright 2007, 2010 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2010 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/perl/t/report.t b/perl/t/report.t index 13ef7b6..a6b85df 100755 --- a/perl/t/report.t +++ b/perl/t/report.t @@ -3,7 +3,8 @@ # Tests for the wallet reporting interface. # # Written by Russ Allbery -# Copyright 2008, 2009, 2010 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008, 2009, 2010 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/perl/t/verifier-netdb.t b/perl/t/verifier-netdb.t index 6bd4e73..398cc6a 100755 --- a/perl/t/verifier-netdb.t +++ b/perl/t/verifier-netdb.t @@ -7,7 +7,8 @@ # environments. # # Written by Russ Allbery -# Copyright 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/perl/t/verifier.t b/perl/t/verifier.t index f56f5fa..75f1afa 100755 --- a/perl/t/verifier.t +++ b/perl/t/verifier.t @@ -3,7 +3,8 @@ # Tests for the basic wallet ACL verifiers. # # Written by Russ Allbery -# Copyright 2007, 2008, 2010 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2008, 2010 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/server/keytab-backend b/server/keytab-backend index 7b6adb4..3ea3df0 100755 --- a/server/keytab-backend +++ b/server/keytab-backend @@ -18,7 +18,7 @@ # # Written by Russ Allbery # Copyright 2006, 2007, 2008, 2010 -# Board of Trustees, Leland Stanford Jr. University +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/server/wallet-report b/server/wallet-report index 992f5b8..0fd8aa9 100755 --- a/server/wallet-report +++ b/server/wallet-report @@ -3,7 +3,8 @@ # wallet-report -- Wallet server reporting interface. # # Written by Russ Allbery -# Copyright 2008, 2009, 2010 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008, 2009, 2010 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/tests/client/basic-t.in b/tests/client/basic-t.in index 11f0bce..836f394 100644 --- a/tests/client/basic-t.in +++ b/tests/client/basic-t.in @@ -4,7 +4,7 @@ # # Written by Russ Allbery # Copyright 2006, 2007, 2008, 2010 -# Board of Trustees, Leland Stanford Jr. University +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/tests/client/full-t.in b/tests/client/full-t.in index 680e78f..ebdba03 100644 --- a/tests/client/full-t.in +++ b/tests/client/full-t.in @@ -3,7 +3,8 @@ # End-to-end tests for the wallet client. # # Written by Russ Allbery -# Copyright 2008, 2010 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008, 2010 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/tests/client/prompt-t.in b/tests/client/prompt-t.in index 682cd70..06991cc 100644 --- a/tests/client/prompt-t.in +++ b/tests/client/prompt-t.in @@ -3,7 +3,8 @@ # Password prompting tests for the wallet client. # # Written by Russ Allbery -# Copyright 2008, 2010 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008, 2010 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/tests/client/rekey-t.in b/tests/client/rekey-t.in index 390a362..0cfcb5d 100644 --- a/tests/client/rekey-t.in +++ b/tests/client/rekey-t.in @@ -4,7 +4,7 @@ # # Written by Russ Allbery # Copyright 2006, 2007, 2008, 2010 -# Board of Trustees, Leland Stanford Jr. University +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/tests/data/cmd-fake b/tests/data/cmd-fake index add72fc..11791a6 100755 --- a/tests/data/cmd-fake +++ b/tests/data/cmd-fake @@ -4,7 +4,9 @@ # the client test suite. It doesn't test any of the wallet server code. # # Written by Russ Allbery -# Copyright 2007, 2008, 2010 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2008, 2010 +# The Board of Trustees of the Leland Stanford Junior University +# # See LICENSE for licensing terms. command="$1" diff --git a/tests/data/fake-kadmin b/tests/data/fake-kadmin index 4c0ceac..c073ea5 100755 --- a/tests/data/fake-kadmin +++ b/tests/data/fake-kadmin @@ -3,7 +3,8 @@ # Fake kadmin.local used to test the keytab backend. # # Written by Russ Allbery -# Copyright 2007 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/tests/server/keytab-t b/tests/server/keytab-t index 2a0ceed..a9f5450 100755 --- a/tests/server/keytab-t +++ b/tests/server/keytab-t @@ -3,7 +3,8 @@ # Tests for the keytab-backend dispatch code. # # Written by Russ Allbery -# Copyright 2006, 2007, 2010 Board of Trustees, Leland Stanford Jr. University +# Copyright 2006, 2007, 2010 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. diff --git a/tests/server/report-t b/tests/server/report-t index 0771946..43ec9d1 100755 --- a/tests/server/report-t +++ b/tests/server/report-t @@ -3,7 +3,8 @@ # Tests for the wallet-report dispatch code. # # Written by Russ Allbery -# Copyright 2008, 2009, 2010 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008, 2009, 2010 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. -- cgit v1.2.3