From 574a9c0456c182831b3d01a4d7ee0c737b91b107 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 9 Jun 2009 14:39:39 -0700 Subject: Remove Subversion Id strings --- perl/Wallet/Object/Base.pm | 1 - 1 file changed, 1 deletion(-) (limited to 'perl/Wallet/Object/Base.pm') diff --git a/perl/Wallet/Object/Base.pm b/perl/Wallet/Object/Base.pm index bc4f096..0f40028 100644 --- a/perl/Wallet/Object/Base.pm +++ b/perl/Wallet/Object/Base.pm @@ -1,5 +1,4 @@ # Wallet::Object::Base -- Parent class for any object stored in the wallet. -# $Id$ # # Written by Russ Allbery # Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University -- cgit v1.2.3 From 99e39ac2639d99acdfd74acc05c25b5a95189860 Mon Sep 17 00:00:00 2001 From: Jon Robertson Date: Thu, 7 Jan 2010 09:33:50 -0800 Subject: Added ACL name to object history entries When listing an object history, ACLs were only shown as the ACL id. This changes that behavior to show the ACL name as well as ID. Where before it might say "set owner to 1", now it would say "set owner to ADMIN (1)". --- perl/Wallet/Object/Base.pm | 28 ++++++++++++++++++++++++++++ perl/t/server.t | 34 +++++++++++++++++----------------- 2 files changed, 45 insertions(+), 17 deletions(-) (limited to 'perl/Wallet/Object/Base.pm') diff --git a/perl/Wallet/Object/Base.pm b/perl/Wallet/Object/Base.pm index 0f40028..f2568eb 100644 --- a/perl/Wallet/Object/Base.pm +++ b/perl/Wallet/Object/Base.pm @@ -445,6 +445,22 @@ sub flag_set { # History ############################################################################## +# Expand a given ACL id to add its name, for readability. Returns the +# original id alone if there was a problem finding the name. +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)"; + } + + return $name; +} + # Return the formatted history for a given object or undef on error. # Currently always returns the complete history, but eventually will need to # provide some way of showing only recent entries. @@ -476,6 +492,18 @@ 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]; + $old = $self->format_acl_id ($old) if defined ($old); + $new = $self->format_acl_id ($new) if defined ($new); + if (defined ($old) and defined ($new)) { + $output .= "set $field to $new (was $old)"; + } elsif (defined ($new)) { + $output .= "set $field to $new"; + } elsif (defined ($old)) { + $output .= "unset $field (was $old)"; + } } elsif ($data[0] eq 'set') { my $field = $data[1]; if (defined ($old) and defined ($new)) { diff --git a/perl/t/server.t b/perl/t/server.t index d4fd068..090387b 100755 --- a/perl/t/server.t +++ b/perl/t/server.t @@ -397,31 +397,31 @@ DATE set expires to $now by $admin from $host DATE unset expires (was $now) by $admin from $host -DATE set acl_get to 1 +DATE set acl_get to ADMIN (1) by $admin from $host -DATE unset acl_get (was 1) +DATE unset acl_get (was ADMIN (1)) by $admin from $host -DATE set acl_store to 1 +DATE set acl_store to ADMIN (1) by $admin from $host -DATE unset acl_store (was 1) +DATE unset acl_store (was ADMIN (1)) by $admin from $host -DATE set owner to 1 +DATE set owner to ADMIN (1) by $admin from $host -DATE set acl_get to 5 +DATE set acl_get to empty (5) by $admin from $host -DATE set acl_store to 5 +DATE set acl_store to empty (5) by $admin from $host -DATE unset acl_store (was 5) +DATE unset acl_store (was empty (5)) by $admin from $host -DATE unset owner (was 1) +DATE unset owner (was ADMIN (1)) by $admin from $host -DATE set owner to 1 +DATE set owner to ADMIN (1) by $admin from $host DATE set flag locked by $admin from $host DATE clear flag locked by $admin from $host -DATE unset owner (was 1) +DATE unset owner (was ADMIN (1)) by $admin from $host DATE set flag unchanging by $admin from $host @@ -527,7 +527,7 @@ is ($show, $expected, ' and show an object we own'); $history = <<"EOO"; DATE create by $admin from $host -DATE set owner to 2 +DATE set owner to user1 (2) by $admin from $host EOO $seen = $server->history ('base', 'service/user1'); @@ -608,13 +608,13 @@ is ($show, $expected, ' and show an object we jointly own'); $history = <<"EOO"; DATE create by $admin from $host -DATE set owner to 4 +DATE set owner to both (4) by $admin from $host -DATE set acl_show to 2 +DATE set acl_show to user1 (2) by $admin from $host -DATE set acl_destroy to 3 +DATE set acl_destroy to user2 (3) by $admin from $host -DATE set acl_flags to 2 +DATE set acl_flags to user1 (2) by $admin from $host DATE set flag unchanging by $user1 from $host @@ -679,7 +679,7 @@ is ($show, $expected, ' and show an object we own'); $history = <<"EOO"; DATE create by $admin from $host -DATE set owner to 3 +DATE set owner to user2 (3) by $admin from $host EOO $seen = $server->history ('base', 'service/user2'); -- cgit v1.2.3 From d684049761db4eb88cd936c530196ea89a524c07 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 19 Jan 2010 22:48:01 -0800 Subject: Coding style fixes for Perl wallet code Strip trailing whitespace, convert tabs to spaces, add newlines to exceptions, and remove a few stray blank lines and a few other minor coding style oddities. Make the SQL style consistent. --- perl/Wallet/Admin.pm | 105 +++++++++++++++---------------- perl/Wallet/Kadmin.pm | 10 +-- perl/Wallet/Kadmin/Heimdal.pm | 102 ++++++++++++++---------------- perl/Wallet/Kadmin/MIT.pm | 32 +++++----- perl/Wallet/Object/Base.pm | 12 ++-- perl/Wallet/Object/Keytab.pm | 13 ++-- perl/t/admin.t | 4 +- perl/t/keytab.t | 140 ++++++++++++++++++++---------------------- 8 files changed, 198 insertions(+), 220 deletions(-) (limited to 'perl/Wallet/Object/Base.pm') diff --git a/perl/Wallet/Admin.pm b/perl/Wallet/Admin.pm index 0e437ec..701c813 100644 --- a/perl/Wallet/Admin.pm +++ b/perl/Wallet/Admin.pm @@ -114,23 +114,22 @@ sub destroy { # Reporting ############################################################################## -# Given an ACL name, translate it to the ID for that ACL and return it. +# Given an ACL name, translate it to the ID for that ACL and return it. # Often this is unneeded and could be done with a join, but by doing it in a -# separate step, we can give an error for the specific case of someone +# separate step, we can give an error for the specific case of someone # searching for a non-existant ACL. sub acl_name_to_id { my ($self, $acl) = @_; my ($id); eval { - my $sql = 'select ac_id from acls where ac_name=?'; - my $sth = $self->{dbh}->prepare ($sql); - $sth->execute ($acl); - while (defined (my $row = $sth->fetchrow_hashref)) { - $id = $row->{'ac_id'}; - } - $self->{dbh}->commit; + my $sql = 'select ac_id from acls where ac_name = ?'; + my $sth = $self->{dbh}->prepare ($sql); + $sth->execute ($acl); + while (defined (my $row = $sth->fetchrow_hashref)) { + $id = $row->{ac_id}; + } + $self->{dbh}->commit; }; - if (!defined $id || $id !~ /^\d+$/) { $self->error ("could not find the acl $acl"); return ''; @@ -155,7 +154,7 @@ sub list_objects_type { return ($sql, $type); } -# Return the SQL statement and search field required to find all objects +# Return the SQL statement and search field required to find all objects # owned by a given ACL. If the requested owner is 'null', then 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 the empty string. @@ -163,15 +162,15 @@ sub list_objects_owner { my ($self, $owner) = @_; my ($sth); if ($owner =~ /^null$/i) { - my $sql = 'select ob_type, ob_name from objects where ob_owner is 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); + return ($sql); } else { - my $id = $self->acl_name_to_id ($owner); - return '' unless $id; - my $sql = 'select ob_type, ob_name from objects where ob_owner=? + my $id = $self->acl_name_to_id ($owner); + return '' unless $id; + my $sql = 'select ob_type, ob_name from objects where ob_owner = ? order by objects.ob_type, objects.ob_name'; - return ($sql, $id); + return ($sql, $id); } } @@ -180,26 +179,24 @@ sub list_objects_owner { sub list_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'; + (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 +# Return the SQL statement and search field required to find all objects # that a given ACL has any permissions on. This expands from # list_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 list_objects_acl { my ($self, $acl) = @_; - my $id = $self->acl_name_to_id ($acl); return '' unless $id; - - 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'; + 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, $id, $id, $id, $id, $id, $id); } @@ -217,29 +214,29 @@ sub list_objects { my $sql = ''; my @search = (); if (!defined $type || $type eq '') { - ($sql) = $self->list_objects_all (); + ($sql) = $self->list_objects_all (); } else { - if (@args != 1) { - $self->error ("object searches require an argument to search"); - } elsif ($type eq 'type') { - ($sql, @search) = $self->list_objects_type (@args); - } elsif ($type eq 'owner') { - ($sql, @search) = $self->list_objects_owner (@args); - } elsif ($type eq 'flag') { - ($sql, @search) = $self->list_objects_flag (@args); - } elsif ($type eq 'acl') { - ($sql, @search) = $self->list_objects_acl (@args); - } else { - $self->error ("do not know search type: $type"); - } - return unless $sql; + if (@args != 1) { + $self->error ("object searches require an argument to search"); + } elsif ($type eq 'type') { + ($sql, @search) = $self->list_objects_type (@args); + } elsif ($type eq 'owner') { + ($sql, @search) = $self->list_objects_owner (@args); + } elsif ($type eq 'flag') { + ($sql, @search) = $self->list_objects_flag (@args); + } elsif ($type eq 'acl') { + ($sql, @search) = $self->list_objects_acl (@args); + } else { + $self->error ("do not know search type: $type"); + } + return unless $sql; } my @objects; eval { my $object; - my $sth = $self->{dbh}->prepare ($sql); - $sth->execute (@search); + my $sth = $self->{dbh}->prepare ($sql); + $sth->execute (@search); while (defined ($object = $sth->fetchrow_arrayref)) { push (@objects, [ @$object ]); } @@ -265,19 +262,19 @@ sub list_acls_all { # the db. sub list_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;'; + 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 search the ACLs and -# return only those entries which contain a entries with identifiers +# return only those entries which contain a entries with identifiers # matching a particular given string. sub list_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'; + 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'; $identifier = '%'.$identifier.'%'; return ($sql, $type, $identifier); } @@ -299,11 +296,11 @@ sub list_acls { ($sql) = $self->list_acls_all (); } else { if ($type eq 'entry') { - if (@args == 0) { - $self->error ("acl searches require an argument to search"); - } else { - ($sql, @search) = $self->list_acls_entry (@args); - } + if (@args == 0) { + $self->error ("acl searches require an argument to search"); + } else { + ($sql, @search) = $self->list_acls_entry (@args); + } } elsif ($type eq 'empty') { ($sql) = $self->list_acls_empty (); } else { diff --git a/perl/Wallet/Kadmin.pm b/perl/Wallet/Kadmin.pm index 33c84a1..200136c 100644 --- a/perl/Wallet/Kadmin.pm +++ b/perl/Wallet/Kadmin.pm @@ -27,8 +27,8 @@ $VERSION = '0.02'; ############################################################################## # Validate a principal with a submodule's validator. We can also do this via -# creating an object with new and then running valid_principal from that, -# but there are times we might wish to run it without going through the +# creating an object with new and then running valid_principal from that, +# but there are times we might wish to run it without going through the # object creation. sub valid_principal { my ($class, $principal) = @_; @@ -48,10 +48,10 @@ sub new { my ($class) = @_; my ($kadmin); if ($Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') { - require Wallet::Kadmin::MIT; + require Wallet::Kadmin::MIT; $kadmin = Wallet::Kadmin::MIT->new (); } elsif ($Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal') { - require Wallet::Kadmin::Heimdal; + require Wallet::Kadmin::Heimdal; $kadmin = Wallet::Kadmin::Heimdal->new (); } else { die "keytab krb server type not set to a valid value\n"; @@ -82,7 +82,7 @@ Wallet::Kadmin - Kadmin module wrapper for wallet keytabs =head1 DESCRIPTION Wallet::Kadmin is a wrapper to modules that provide an interface for keytab -integration with the wallet. Each module is meant to interface with a +integration with the wallet. Each module is meant to interface with a specific type of Kerberos implementation, such as MIT Kerberos or Heimdal Kerberos, and provide a standndard set of API calls used to interact with that implementation's kadmind. diff --git a/perl/Wallet/Kadmin/Heimdal.pm b/perl/Wallet/Kadmin/Heimdal.pm index e4d175b..a8859bf 100644 --- a/perl/Wallet/Kadmin/Heimdal.pm +++ b/perl/Wallet/Kadmin/Heimdal.pm @@ -15,8 +15,7 @@ require 5.006; use strict; use vars qw($VERSION); -use Heimdal::Kadm5 qw (KRB5_KDB_DISALLOW_ALL_TIX); - +use Heimdal::Kadm5 qw(KRB5_KDB_DISALLOW_ALL_TIX); use Wallet::Config (); # This version should be increased on any code change to this module. Always @@ -37,7 +36,7 @@ sub valid_principal { return scalar ($principal =~ m,^[\w-]+(/[\w_.-]+)?\z,); } -# Create a Heimdal::Kadm5 client object and return it. It should load +# Create a Heimdal::Kadm5 client object and return it. It should load # configuration from Wallet::Config. sub kadmin_client { unless (defined ($Wallet::Config::KEYTAB_PRINCIPAL) @@ -45,15 +44,13 @@ sub kadmin_client { and defined ($Wallet::Config::KEYTAB_REALM)) { die "keytab object implementation not configured\n"; } - my $server = $Wallet::Config::KEYTAB_HOST || 'localhost'; - my $client = Heimdal::Kadm5::Client->new( - RaiseErrors => 1, - Server => $server, - Principal => $Wallet::Config::KEYTAB_PRINCIPAL, - Realm => $Wallet::Config::KEYTAB_REALM, - Keytab => $Wallet::Config::KEYTAB_FILE, - ); + my @options = (RaiseErrors => 1, + Server => $server, + Principal => $Wallet::Config::KEYTAB_PRINCIPAL, + Realm => $Wallet::Config::KEYTAB_REALM, + Keytab => $Wallet::Config::KEYTAB_FILE); + my $client = Heimdal::Kadm5::Client->new (@options); return $client; } @@ -70,16 +67,8 @@ sub exists { $principal .= '@' . $Wallet::Config::KEYTAB_REALM; } my $kadmin = $self->{client}; - my $princdata = eval { $kadmin->getPrincipal ($principal) }; - - if ($@) { - die $@; - return 0; - } elsif ($princdata) { - return 1; - } else { - return 0; - } + my $princdata = $kadmin->getPrincipal ($principal); + return $princdata ? 1 : 0; } # Create a principal in Kerberos. Since this is only called by create, it @@ -95,7 +84,7 @@ sub addprinc { if ($Wallet::Config::KEYTAB_REALM) { $principal .= '@' . $Wallet::Config::KEYTAB_REALM; } - die "error adding principal $principal: $@" if $@; + die "error adding principal $principal: $@\n" if $@; return 1 if $exists; # The way Heimdal::Kadm5 works, we create a principal object, create the @@ -106,20 +95,19 @@ sub addprinc { my $kadmin = $self->{client}; my $princdata = $kadmin->makePrincipal ($principal); - # Disable the principal before creating, until we've randomized the + # Disable the principal before creating, until we've randomized the # password. my $attrs = $princdata->getAttributes; $attrs |= KRB5_KDB_DISALLOW_ALL_TIX; $princdata->setAttributes ($attrs); my $password = 'inactive'; - my $retval = eval { $kadmin->createPrincipal ($princdata, $password, 0) }; - die "error adding principal $principal: $@" if $@; - $retval = eval { $kadmin->randKeyPrincipal ($principal) }; - die "error adding principal $principal: $@" if $@; - $retval = eval { $kadmin->enablePrincipal ($principal) }; + eval { + $kadmin->createPrincipal ($princdata, $password, 0); + $kadmin->randKeyPrincipal ($principal); + $kadmin->enablePrincipal ($principal); + }; die "error adding principal $principal: $@" if $@; - return 1; } @@ -130,7 +118,7 @@ sub addprinc { sub ktadd { my ($self, $principal, $file, @enctypes) = @_; unless ($self->valid_principal ($principal)) { - die ("invalid principal name: $principal"); + die "invalid principal name: $principal\n"; } if ($Wallet::Config::KEYTAB_REALM) { $principal .= '@' . $Wallet::Config::KEYTAB_REALM; @@ -138,35 +126,35 @@ sub ktadd { # The way Heimdal works, you can only remove enctypes from a principal, # not add them back in. So we need to run randkeyPrincipal first each - # time to restore all possible enctypes and then whittle them back down + # time to restore all possible enctypes and then whittle them back down # to those we have been asked for this time. my $kadmin = $self->{client}; eval { $kadmin->randKeyPrincipal ($principal) }; - die "error creating keytab for $principal: could not reinit enctypes: $@" + die "error creating keytab for $principal: could not reinit enctypes: $@\n" if $@; my $princdata = eval { $kadmin->getPrincipal ($principal) }; if ($@) { - die "error creating keytab for $principal: $@"; + die "error creating keytab for $principal: $@\n"; } elsif (!$princdata) { - die "error creating keytab for $principal: principal does not exist"; + die "error creating keytab for $principal: principal does not exist\n"; } # Now actually remove any non-requested enctypes, if we requested any. if (@enctypes) { - my (%wanted); - my $alltypes = $princdata->getKeytypes (); - foreach (@enctypes) { $wanted{$_} = 1 } - foreach my $key (@{$alltypes}) { - my $keytype = ${$key}[0]; - next if exists $wanted{$keytype}; - eval { $princdata->delKeytypes ($keytype) }; - die "error removing keytype $keytype from the keytab: $@" if $@; - } - eval { $kadmin->modifyPrincipal ($princdata) }; + my (%wanted); + my $alltypes = $princdata->getKeytypes (); + foreach (@enctypes) { $wanted{$_} = 1 } + foreach my $key (@{$alltypes}) { + my $keytype = ${$key}[0]; + next if exists $wanted{$keytype}; + eval { $princdata->delKeytypes ($keytype) }; + die "error removing keytype $keytype from the keytab: $@\n" if $@; + } + eval { $kadmin->modifyPrincipal ($princdata) }; } eval { $kadmin->extractKeytab ($princdata, $file) }; - die "error creating keytab for principal: $@" if $@; + die "error creating keytab for principal: $@\n" if $@; return 1; } @@ -177,7 +165,7 @@ sub ktadd { sub delprinc { my ($self, $principal) = @_; unless ($self->valid_principal ($principal)) { - die ("invalid principal name: $principal"); + die "invalid principal name: $principal\n"; } my $exists = eval { $self->exists ($principal) }; die $@ if $@; @@ -190,7 +178,7 @@ sub delprinc { my $kadmin = $self->{client}; my $retval = eval { $kadmin->deletePrincipal ($principal) }; - die "error deleting $principal: $@" if $@; + die "error deleting $principal: $@\n" if $@; return 1; } @@ -199,12 +187,12 @@ sub delprinc { ############################################################################## # Create a new MIT kadmin object. Very empty for the moment, but later it -# will probably fill out if we go to using a module rather than calling +# will probably fill out if we go to using a module rather than calling # kadmin directly. sub new { my ($class) = @_; my $self = { - client => kadmin_client (), + client => kadmin_client (), }; bless ($self, $class); return $self; @@ -235,7 +223,7 @@ Wallet::Kadmin::MIT is an interface for keytab integration with the wallet, specifically for using kadmin to create, delete, and add enctypes to keytabs. It implments the wallet kadmin API and provides the necessary glue to MIT Kerberos installs for each of these functions, while allowing the wallet -to keep the details of what type of Kerberos installation is being used +to keep the details of what type of Kerberos installation is being used abstracted. A keytab is an on-disk store for the key or keys for a Kerberos principal. @@ -254,15 +242,15 @@ information about how to set wallet configuration. =item addprinc(PRINCIPAL) -Adds a new principal with a given name. The principal is created with a -random password, and any other flags set by Wallet::Config. Returns true on +Adds a new principal with a given name. The principal is created with a +random password, and any other flags set by Wallet::Config. Returns true on success, or throws an error if there was a failure in adding the principal. -If the principal already exists, return true as we are bringing our +If the principal already exists, return true as we are bringing our expectations in line with reality. =item addprinc(PRINCIPAL) -Removes a principal with the given name. Returns true on success, or throws +Removes a principal with the given name. Returns true on success, or throws an error if there was a failure in removing the principal. If the principal does not exist, return true as we are bringing our expectations in line with reality. @@ -270,8 +258,8 @@ reality. =item ktadd(PRINCIPAL, FILE, ENCTYPES) Creates a new keytab for the given principal, as the given file, limited to -the enctypes supplied. The enctype values must be enctype strings recognized -by Kerberos (strings like C or C). An error is +the enctypes supplied. The enctype values must be enctype strings recognized +by Kerberos (strings like C or C). An error is thrown on failure or if the creation fails, otherwise true is returned. =back @@ -279,7 +267,7 @@ thrown on failure or if the creation fails, otherwise true is returned. =head1 LIMITATIONS Currently, this implementation calls an external B program rather - than using a native Perl module and therefore requires B be + than using a native Perl module and therefore requires B be installed and parses its output. It may miss some error conditions if the output of B ever changes. diff --git a/perl/Wallet/Kadmin/MIT.pm b/perl/Wallet/Kadmin/MIT.pm index b7d4913..7bbb248 100644 --- a/perl/Wallet/Kadmin/MIT.pm +++ b/perl/Wallet/Kadmin/MIT.pm @@ -130,7 +130,7 @@ sub addprinc { sub ktadd { my ($self, $principal, $file, @enctypes) = @_; unless ($self->valid_principal ($principal)) { - die ("invalid principal name: $principal"); + die "invalid principal name: $principal\n"; } if ($Wallet::Config::KEYTAB_REALM) { $principal .= '@' . $Wallet::Config::KEYTAB_REALM; @@ -143,7 +143,7 @@ sub ktadd { my $output = eval { $self->kadmin ("$command $principal") }; die ($@) if ($@); if ($output =~ /^(?:kadmin|ktadd): (.*)/m) { - die ("error creating keytab for $principal: $1"); + die "error creating keytab for $principal: $1\n"; } return 1; } @@ -154,7 +154,7 @@ sub ktadd { sub delprinc { my ($self, $principal) = @_; unless ($self->valid_principal ($principal)) { - die ("invalid principal name: $principal"); + die "invalid principal name: $principal\n"; } my $exists = eval { $self->exists ($principal) }; die $@ if $@; @@ -167,7 +167,7 @@ sub delprinc { my $output = eval { $self->kadmin ("delprinc -force $principal") }; die $@ if $@; if ($output =~ /^delete_principal: (.*)/m) { - die ("error deleting $principal: $1"); + die "error deleting $principal: $1\n"; } return 1; } @@ -177,12 +177,11 @@ sub delprinc { ############################################################################## # Create a new MIT kadmin object. Very empty for the moment, but later it -# will probably fill out if we go to using a module rather than calling +# will probably fill out if we go to using a module rather than calling # kadmin directly. sub new { my ($class) = @_; - my $self = { - }; + my $self = {}; bless ($self, $class); return $self; } @@ -212,7 +211,7 @@ Wallet::Kadmin::MIT is an interface for keytab integration with the wallet, specifically for using kadmin to create, delete, and add enctypes to keytabs. It implments the wallet kadmin API and provides the necessary glue to MIT Kerberos installs for each of these functions, while allowing the wallet -to keep the details of what type of Kerberos installation is being used +to keep the details of what type of Kerberos installation is being used abstracted. A keytab is an on-disk store for the key or keys for a Kerberos principal. @@ -231,15 +230,15 @@ information about how to set wallet configuration. =item addprinc(PRINCIPAL) -Adds a new principal with a given name. The principal is created with a -random password, and any other flags set by Wallet::Config. Returns true on +Adds a new principal with a given name. The principal is created with a +random password, and any other flags set by Wallet::Config. Returns true on success, or throws an error if there was a failure in adding the principal. -If the principal already exists, return true as we are bringing our +If the principal already exists, return true as we are bringing our expectations in line with reality. =item addprinc(PRINCIPAL) -Removes a principal with the given name. Returns true on success, or throws +Removes a principal with the given name. Returns true on success, or throws an error if there was a failure in removing the principal. If the principal does not exist, return true as we are bringing our expectations in line with reality. @@ -247,8 +246,8 @@ reality. =item ktadd(PRINCIPAL, FILE, ENCTYPES) Creates a new keytab for the given principal, as the given file, limited to -the enctypes supplied. The enctype values must be enctype strings recognized -by Kerberos (strings like C or C). An error is +the enctypes supplied. The enctype values must be enctype strings recognized +by Kerberos (strings like C or C). An error is thrown on failure or if the creation fails, otherwise true is returned. =back @@ -256,7 +255,7 @@ thrown on failure or if the creation fails, otherwise true is returned. =head1 LIMITATIONS Currently, this implementation calls an external B program rather - than using a native Perl module and therefore requires B be +than using a native Perl module and therefore requires B be installed and parses its output. It may miss some error conditions if the output of B ever changes. @@ -269,7 +268,6 @@ from L. =head1 AUTHORS -Russ Allbery -Jon Robertson +Russ Allbery and Jon Robertson . =cut diff --git a/perl/Wallet/Object/Base.pm b/perl/Wallet/Object/Base.pm index f2568eb..fea0320 100644 --- a/perl/Wallet/Object/Base.pm +++ b/perl/Wallet/Object/Base.pm @@ -445,7 +445,7 @@ sub flag_set { # History ############################################################################## -# Expand a given ACL id to add its name, for readability. Returns the +# Expand a given ACL id to add its name, for readability. Returns the # original id alone if there was a problem finding the name. sub format_acl_id { my ($self, $id) = @_; @@ -455,7 +455,7 @@ sub format_acl_id { my $sth = $self->{dbh}->prepare ($sql); $sth->execute ($id); if (my @ref = $sth->fetchrow_array) { - $name = $ref[0] . " ($id)"; + $name = $ref[0] . " ($id)"; } return $name; @@ -492,11 +492,11 @@ 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_/)) { + } elsif ($data[0] eq 'set' + and ($data[1] eq 'owner' or $data[1] =~ /^acl_/)) { my $field = $data[1]; - $old = $self->format_acl_id ($old) if defined ($old); - $new = $self->format_acl_id ($new) if defined ($new); + $old = $self->format_acl_id ($old) if defined ($old); + $new = $self->format_acl_id ($new) if defined ($new); if (defined ($old) and defined ($new)) { $output .= "set $field to $new (was $old)"; } elsif (defined ($new)) { diff --git a/perl/Wallet/Object/Keytab.pm b/perl/Wallet/Object/Keytab.pm index b1c9d6d..a361599 100644 --- a/perl/Wallet/Object/Keytab.pm +++ b/perl/Wallet/Object/Keytab.pm @@ -1,7 +1,7 @@ # Wallet::Object::Keytab -- Keytab object implementation for the wallet. # # Written by Russ Allbery -# Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2008, 2009 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -477,15 +477,14 @@ sub new { # caller. sub create { my ($class, $type, $name, $dbh, $creator, $host, $time) = @_; - my $self = { - dbh => $dbh, - kadmin => undef, + my $self = { + dbh => $dbh, + kadmin => undef, }; bless $self, $class; my $kadmin = Wallet::Kadmin->new (); $self->{kadmin} = $kadmin; $kadmin->addprinc ($name); - $self = $class->SUPER::create ($type, $name, $dbh, $creator, $host, $time); $self->{kadmin} = $kadmin; return $self; @@ -556,8 +555,8 @@ sub get { my $kadmin = $self->{kadmin}; my $retval = eval { $kadmin->ktadd ($self->{name}, $file, @enctypes) }; if ($@) { - $self->error ($@); - return; + $self->error ($@); + return; } return unless $retval; local *KEYTAB; diff --git a/perl/t/admin.t b/perl/t/admin.t index 77c786d..e963857 100755 --- a/perl/t/admin.t +++ b/perl/t/admin.t @@ -120,7 +120,7 @@ is ($lines[2][1], 'admin@EXAMPLE.COM', ' and the right identifier'); # owned by ADMIN or with any permissions from it. is ($server->create ('base', 'service/null'), 1, 'Creating base:service/null succeeds'); -is ($server->acl ('base', 'service/foo', 'get', 'ADMIN'), 1, +is ($server->acl ('base', 'service/foo', 'get', 'ADMIN'), 1, 'Changing the get ACL for the search also does'); @lines = $admin->list_objects ('owner', 'ADMIN'); is (scalar (@lines), 1, 'Searching for objects owned by ADMIN finds one'); @@ -150,7 +150,7 @@ is ($lines[2][1], 'service/null', ' and the right name'); is (scalar (@lines), 0, 'Searching for all objects of type keytab finds none'); # Test setting a flag, searching for objects with it, and then clearing it. -is ($server->flag_set ('base', 'service/admin', 'unchanging'), 1, +is ($server->flag_set ('base', 'service/admin', 'unchanging'), 1, 'Setting a flag works'); @lines = $admin->list_objects ('flag', 'unchanging'); is (scalar (@lines), 1, 'Searching for all objects with that flag finds one'); diff --git a/perl/t/keytab.t b/perl/t/keytab.t index 5c9ee68..3cd77d8 100755 --- a/perl/t/keytab.t +++ b/perl/t/keytab.t @@ -8,7 +8,7 @@ # See LICENSE for licensing terms. use POSIX qw(strftime); -use Test::More tests => 221; +use Test::More tests => 219; use Wallet::Admin; use Wallet::Config; @@ -57,15 +57,15 @@ sub system_quiet { sub create { my ($principal) = @_; if ($Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') { - my @args = ('-p', $Wallet::Config::KEYTAB_PRINCIPAL, '-k', - '-t', $Wallet::Config::KEYTAB_FILE, - '-r', $Wallet::Config::KEYTAB_REALM, - '-q', "addprinc -clearpolicy -randkey $principal"); + my @args = ('-p', $Wallet::Config::KEYTAB_PRINCIPAL, '-k', + '-t', $Wallet::Config::KEYTAB_FILE, + '-r', $Wallet::Config::KEYTAB_REALM, + '-q', "addprinc -clearpolicy -randkey $principal"); } elsif ($Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal') { - @args = ('-p', $Wallet::Config::KEYTAB_PRINCIPAL, - '-K', $Wallet::Config::KEYTAB_FILE, - '-r', $Wallet::Config::KEYTAB_REALM, - 'add', $principal); + @args = ('-p', $Wallet::Config::KEYTAB_PRINCIPAL, + '-K', $Wallet::Config::KEYTAB_FILE, + '-r', $Wallet::Config::KEYTAB_REALM, + 'add', $principal); } system_quiet ($Wallet::Config::KEYTAB_KADMIN, @args); } @@ -76,15 +76,15 @@ sub destroy { my ($principal) = @_; my (@args); if ($Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') { - @args = ('-p', $Wallet::Config::KEYTAB_PRINCIPAL, '-k', - '-t', $Wallet::Config::KEYTAB_FILE, - '-r', $Wallet::Config::KEYTAB_REALM, - '-q', "delprinc -force $principal"); + @args = ('-p', $Wallet::Config::KEYTAB_PRINCIPAL, '-k', + '-t', $Wallet::Config::KEYTAB_FILE, + '-r', $Wallet::Config::KEYTAB_REALM, + '-q', "delprinc -force $principal"); } elsif ($Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal') { - @args = ('-p', $Wallet::Config::KEYTAB_PRINCIPAL, - '-K', $Wallet::Config::KEYTAB_FILE, - '-r', $Wallet::Config::KEYTAB_REALM, - 'delete', $principal); + @args = ('-p', $Wallet::Config::KEYTAB_PRINCIPAL, + '-K', $Wallet::Config::KEYTAB_FILE, + '-r', $Wallet::Config::KEYTAB_REALM, + 'delete', $principal); } system_quiet ($Wallet::Config::KEYTAB_KADMIN, @args); } @@ -95,15 +95,15 @@ sub created { my ($principal) = @_; $principal .= '@' . $Wallet::Config::KEYTAB_REALM; if ($Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') { - local $ENV{KRB5CCNAME} = 'krb5cc_temp'; - getcreds ('t/data/test.keytab', $Wallet::Config::KEYTAB_PRINCIPAL); - return (system_quiet ('kvno', $principal) == 0); + local $ENV{KRB5CCNAME} = 'krb5cc_temp'; + getcreds ('t/data/test.keytab', $Wallet::Config::KEYTAB_PRINCIPAL); + return (system_quiet ('kvno', $principal) == 0); } elsif ($Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal') { - @args = ('-p', $Wallet::Config::KEYTAB_PRINCIPAL, - '-K', $Wallet::Config::KEYTAB_FILE, - '-r', $Wallet::Config::KEYTAB_REALM, - 'get', $principal); - return (system_quiet ($Wallet::Config::KEYTAB_KADMIN, @args) == 0); + @args = ('-p', $Wallet::Config::KEYTAB_PRINCIPAL, + '-K', $Wallet::Config::KEYTAB_FILE, + '-r', $Wallet::Config::KEYTAB_REALM, + 'get', $principal); + return (system_quiet ($Wallet::Config::KEYTAB_KADMIN, @args) == 0); } } @@ -135,28 +135,28 @@ sub enctypes { my @enctypes; if ($Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') { - open (KLIST, '-|', 'klist', '-ke', 'keytab') - or die "cannot run klist: $!\n"; - local $_; - while () { - next unless /^ *\d+ /; - my ($string) = /\((.*)\)\s*$/; - next unless $string; - $enctype = $enctype{lc $string} || 'UNKNOWN'; - push (@enctypes, $enctype); - } - close KLIST; + open (KLIST, '-|', 'klist', '-ke', 'keytab') + or die "cannot run klist: $!\n"; + local $_; + while () { + next unless /^ *\d+ /; + my ($string) = /\((.*)\)\s*$/; + next unless $string; + $enctype = $enctype{lc $string} || 'UNKNOWN'; + push (@enctypes, $enctype); + } + close KLIST; } elsif ($Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal') { - open (KTUTIL, '-|', 'ktutil', '-k', 'keytab', 'list') - or die "cannot run ktutil: $!\n"; - local $_; - while () { - next unless /^ *\d+ /; - my ($string) = /^\s*\d+\s+(\S+)/; - next unless $string; - push (@enctypes, $string); - } - close KTUTIL; + open (KTUTIL, '-|', 'ktutil', '-k', 'keytab', 'list') + or die "cannot run ktutil: $!\n"; + local $_; + while () { + next unless /^ *\d+ /; + my ($string) = /^\s*\d+\s+(\S+)/; + next unless $string; + push (@enctypes, $string); + } + close KTUTIL; } unlink 'keytab'; return sort @enctypes; @@ -298,16 +298,15 @@ EOO is ($object->error, 'KEYTAB_TMP configuration variable not set', ' with the right error'); $Wallet::Config::KEYTAB_TMP = '.'; - SKIP: { - skip ' no kadmin program test for Heimdal', 2 - if $Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal'; - - $Wallet::Config::KEYTAB_KADMIN = '/some/nonexistent/file'; - $data = $object->get (@trace); - is ($data, undef, 'Cope with a failure to run kadmin'); - like ($object->error, qr{^cannot run /some/nonexistent/file: }, - ' with the right error'); - $Wallet::Config::KEYTAB_KADMIN = 'kadmin'; + SKIP: { + skip 'no kadmin program test for Heimdal', 2 + if $Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal'; + $Wallet::Config::KEYTAB_KADMIN = '/some/nonexistent/file'; + $data = $object->get (@trace); + is ($data, undef, 'Cope with a failure to run kadmin'); + like ($object->error, qr{^cannot run /some/nonexistent/file: }, + ' with the right error'); + $Wallet::Config::KEYTAB_KADMIN = 'kadmin'; } destroy ('wallet/one'); $data = $object->get (@trace); @@ -323,19 +322,16 @@ EOO }; ok (defined ($object), 'Creating good principal succeeds'); ok (created ('wallet/one'), ' and the principal was created'); - - SKIP: { - skip ' no kadmin program test for Heimdal', 2 - if $Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal'; - - $Wallet::Config::KEYTAB_KADMIN = '/some/nonexistent/file'; - is ($object->destroy (@trace), undef, - ' and destroying it with bad kadmin fails'); - like ($object->error, qr{^cannot run /some/nonexistent/file: }, - ' with the right error'); - $Wallet::Config::KEYTAB_KADMIN = 'kadmin'; + SKIP: { + skip 'no kadmin program test for Heimdal', 2 + if $Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal'; + $Wallet::Config::KEYTAB_KADMIN = '/some/nonexistent/file'; + is ($object->destroy (@trace), undef, + ' and destroying it with bad kadmin fails'); + like ($object->error, qr{^cannot run /some/nonexistent/file: }, + ' with the right error'); + $Wallet::Config::KEYTAB_KADMIN = 'kadmin'; } - is ($object->flag_set ('locked', @trace), 1, ' and setting locked works'); is ($object->destroy (@trace), undef, ' and destroying it fails'); is ($object->error, "cannot destroy keytab:wallet/one: object is locked", @@ -713,8 +709,10 @@ EOO # Tests for enctype restriction. SKIP: { - skip 'no keytab configuration', 36 unless (-f 't/data/test.keytab' - && $Wallet::Config::KEYTAB_KRBTYPE eq 'MIT'); + unless (-f 't/data/test.keytab' + && $Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') { + skip 'no keytab configuration', 36; + } # Set up our configuration. $Wallet::Config::KEYTAB_FILE = 't/data/test.keytab'; @@ -810,7 +808,6 @@ EOO ok (defined ($keytab), ' and retrieving the keytab still works'); @values = enctypes ($keytab); is ("@values", $enctypes[0], ' and it has the right enctype'); - ok (defined ($one), ' and recreating it succeeds'); is ($one->attr ('enctypes', [ $enctypes[1] ], @trace), 1, 'Setting a different single enctype works'); @values = $one->attr ('enctypes'); @@ -819,7 +816,6 @@ EOO ok (defined ($keytab), ' and retrieving the keytab still works'); @values = enctypes ($keytab); is ("@values", $enctypes[1], ' and it has the right enctype'); - ok (defined ($one), ' and recreating it succeeds'); is ($one->attr ('enctypes', [ @enctypes[0..1] ], @trace), 1, 'Setting two enctypes works'); @values = $one->attr ('enctypes'); -- cgit v1.2.3 From ae02de1488068b84371b05842c81a9aecc5f24c4 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 9 Feb 2010 23:19:27 -0800 Subject: Check spelling of server API POD and tweak server docs Also update the POD syntax check to the current version of that check I use elsewhere. Since I'm touching all the POD anyway, also rewrap all of the POD to 74 columns. Fix some references to MIT in the Wallet::Kadmin::Heimdal module documentation. --- perl/Wallet/ACL.pm | 110 +++++++++++----------- perl/Wallet/ACL/Base.pm | 31 ++++--- perl/Wallet/ACL/Krb5.pm | 13 ++- perl/Wallet/ACL/NetDB.pm | 26 +++--- perl/Wallet/ACL/NetDB/Root.pm | 46 +++++----- perl/Wallet/Admin.pm | 39 ++++---- perl/Wallet/Config.pm | 196 ++++++++++++++++++++------------------- perl/Wallet/Database.pm | 17 ++-- perl/Wallet/Kadmin.pm | 31 ++++--- perl/Wallet/Kadmin/Heimdal.pm | 52 +++++------ perl/Wallet/Kadmin/MIT.pm | 45 ++++----- perl/Wallet/Object/Base.pm | 209 ++++++++++++++++++++++-------------------- perl/Wallet/Object/File.pm | 18 ++-- perl/Wallet/Object/Keytab.pm | 55 ++++++----- perl/Wallet/Schema.pm | 129 ++++++++++++++------------ perl/Wallet/Server.pm | 209 ++++++++++++++++++++++-------------------- perl/t/pod-spelling.t | 75 +++++++++++++++ perl/t/pod.t | 14 ++- 18 files changed, 731 insertions(+), 584 deletions(-) create mode 100755 perl/t/pod-spelling.t (limited to 'perl/Wallet/Object/Base.pm') diff --git a/perl/Wallet/ACL.pm b/perl/Wallet/ACL.pm index 9136fc2..76e7354 100644 --- a/perl/Wallet/ACL.pm +++ b/perl/Wallet/ACL.pm @@ -1,7 +1,7 @@ # Wallet::ACL -- Implementation of ACLs in the wallet system. # # Written by Russ Allbery -# Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2008, 2010 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -21,7 +21,7 @@ use POSIX qw(strftime); # This version should be increased on any code change to this module. Always # use two digits for the minor version with a leading zero if necessary so # that it will sort properly. -$VERSION = '0.05'; +$VERSION = '0.06'; ############################################################################## # Constructors @@ -427,6 +427,9 @@ __END__ Wallet::ACL - Implementation of ACLs in the wallet system +=for stopwords +ACL DBH metadata HOSTNAME DATETIME timestamp Allbery + =head1 SYNOPSIS my $acl = Wallet::ACL->create ('group:sysadmin'); @@ -445,22 +448,22 @@ Wallet::ACL - Implementation of ACLs in the wallet system =head1 DESCRIPTION -Wallet::ACL implements the ACL system for the wallet: the methods to create, -find, rename, and destroy ACLs; the methods to add and remove entries from -an ACL; and the methods to list the contents of an ACL and check a principal -against it. +Wallet::ACL implements the ACL system for the wallet: the methods to +create, find, rename, and destroy ACLs; the methods to add and remove +entries from an ACL; and the methods to list the contents of an ACL and +check a principal against it. An ACL is a list of zero or more ACL entries, each of which consists of a -scheme and an identifier. Each scheme is associated with a verifier module -that checks Kerberos principals against identifiers for that scheme and -returns whether the principal should be permitted access by that identifier. -The interpretation of the identifier is entirely left to the scheme. This -module maintains the ACLs and dispatches check operations to the appropriate -verifier module. - -Each ACL is identified by a human-readable name and a persistant unique -numeric identifier. The numeric identifier (ID) should be used to refer to -the ACL so that it can be renamed as needed without breaking external +scheme and an identifier. Each scheme is associated with a verifier +module that checks Kerberos principals against identifiers for that scheme +and returns whether the principal should be permitted access by that +identifier. The interpretation of the identifier is entirely left to the +scheme. This module maintains the ACLs and dispatches check operations to +the appropriate verifier module. + +Each ACL is identified by a human-readable name and a persistent unique +numeric identifier. The numeric identifier (ID) should be used to refer +to the ACL so that it can be renamed as needed without breaking external references. =head1 CLASS METHODS @@ -481,8 +484,8 @@ finding an existing one, creates a new ACL record in the database with the given NAME. NAME must not be all-numeric, since that would conflict with the automatically assigned IDs. Returns the new object on success and throws an exception on failure. PRINCIPAL, HOSTNAME, and DATETIME are -stored as history information. PRINCIPAL should be the user who is creating -the ACL. If DATETIME isn't given, the current time is used. +stored as history information. PRINCIPAL should be the user who is +creating the ACL. If DATETIME isn't given, the current time is used. =back @@ -492,42 +495,43 @@ the ACL. If DATETIME isn't given, the current time is used. =item add(SCHEME, INSTANCE, PRINCIPAL, HOSTNAME [, DATETIME]) -Add the given ACL entry (given by SCHEME and INSTANCE) to this ACL. Returns -true on success and false on failure. On failure, the caller should call -error() to get the error message. PRINCIPAL, HOSTNAME, and DATETIME are -stored as history information. PRINCIPAL should be the user who is adding -the ACL entry. If DATETIME isn't given, the current time is used. +Add the given ACL entry (given by SCHEME and INSTANCE) to this ACL. +Returns true on success and false on failure. On failure, the caller +should call error() to get the error message. PRINCIPAL, HOSTNAME, and +DATETIME are stored as history information. PRINCIPAL should be the user +who is adding the ACL entry. If DATETIME isn't given, the current time is +used. =item check(PRINCIPAL) Checks whether the given PRINCIPAL should be allowed access given ACL. Returns 1 if access was granted, 0 if access is declined, and undef on -error. On error, the caller should call error() to get the error text. Any -errors found by the individual ACL verifiers can be retrieved by calling -check_errors(). Errors from individual ACL verifiers will not result in an -error return from check(); instead, the check will continue with the next -entry in the ACL. +error. On error, the caller should call error() to get the error text. +Any errors found by the individual ACL verifiers can be retrieved by +calling check_errors(). Errors from individual ACL verifiers will not +result in an error return from check(); instead, the check will continue +with the next entry in the ACL. check() returns success as soon as an entry in the ACL grants access to PRINCIPAL. There is no provision for negative ACLs or exceptions. =item check_errors() -Return (as a list in array context and a string with newlines between errors -and at the end of the last error in scalar context) the errors, if any, -returned by ACL verifiers for the last check operation. If there were no -errors from the last check() operation, returns the empty list in array -context and undef in scalar context. +Return (as a list in array context and a string with newlines between +errors and at the end of the last error in scalar context) the errors, if +any, returned by ACL verifiers for the last check operation. If there +were no errors from the last check() operation, returns the empty list in +array context and undef in scalar context. =item destroy(PRINCIPAL, HOSTNAME [, DATETIME]) Destroys this ACL from the database. Note that this will fail due to integrity constraint errors if the ACL is still referenced by any object; -the ACL must be removed from all objects first. Returns true on success and -false on failure. On failure, the caller should call error() to get the -error message. PRINCIPAL, HOSTNAME, and DATETIME are stored as history -information. PRINCIPAL should be the user who is destroying the ACL. If -DATETIME isn't given, the current time is used. +the ACL must be removed from all objects first. Returns true on success +and false on failure. On failure, the caller should call error() to get +the error message. PRINCIPAL, HOSTNAME, and DATETIME are stored as +history information. PRINCIPAL should be the user who is destroying the +ACL. If DATETIME isn't given, the current time is used. =item error() @@ -542,7 +546,8 @@ the ACL (not including changes to the name of the ACL) will be represented by two lines. The first line will have a timestamp of the change followed by a description of the change, and the second line will give the user who made the change and the host from which the change was made. On failure, -returns undef, and the caller should call error() to get the error message. +returns undef, and the caller should call error() to get the error +message. =item id() @@ -569,28 +574,29 @@ Returns the human-readable name of this ACL. =item remove(SCHEME, INSTANCE, PRINCIPAL, HOSTNAME [, DATETIME]) Remove the given ACL line (given by SCHEME and INSTANCE) from this ACL. -Returns true on success and false on failure. On failure, the caller should -call error() to get the error message. PRINCIPAL, HOSTNAME, and DATETIME -are stored as history information. PRINCIPAL should be the user who is -removing the ACL entry. If DATETIME isn't given, the current time is used. +Returns true on success and false on failure. On failure, the caller +should call error() to get the error message. PRINCIPAL, HOSTNAME, and +DATETIME are stored as history information. PRINCIPAL should be the user +who is removing the ACL entry. If DATETIME isn't given, the current time +is used. =item rename(NAME) Rename this ACL. This changes the name used for human convenience but not the system-generated ACL ID that is used to reference this ACL. The new NAME must not be all-numeric, since that would conflict with -system-generated ACL IDs. Returns true on success and false on failure. On -failure, the caller should call error() to get the error message. +system-generated ACL IDs. Returns true on success and false on failure. +On failure, the caller should call error() to get the error message. Note that rename() operations are not logged in the ACL history. =item show() -Returns a human-readable description of this ACL, including its membership. -This method should only be used for display of the ACL to humans. Use the -list(), name(), and id() methods instead to get ACL information for use in -other code. On failure, returns undef, and the caller should call error() -to get the error message. +Returns a human-readable description of this ACL, including its +membership. This method should only be used for display of the ACL to +humans. Use the list(), name(), and id() methods instead to get ACL +information for use in other code. On failure, returns undef, and the +caller should call error() to get the error message. =back @@ -598,8 +604,8 @@ to get the error message. Wallet::ACL::Base(3), wallet-backend(8) -This module is part of the wallet system. The current version is available -from L. +This module is part of the wallet system. The current version is +available from L. =head1 AUTHOR diff --git a/perl/Wallet/ACL/Base.pm b/perl/Wallet/ACL/Base.pm index 004de75..9a8a3cb 100644 --- a/perl/Wallet/ACL/Base.pm +++ b/perl/Wallet/ACL/Base.pm @@ -1,7 +1,7 @@ # Wallet::ACL::Base -- Parent class for wallet ACL verifiers. # # Written by Russ Allbery -# Copyright 2007 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2010 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -18,7 +18,7 @@ use vars qw($VERSION); # This version should be increased on any code change to this module. Always # use two digits for the minor version with a leading zero if necessary so # that it will sort properly. -$VERSION = '0.01'; +$VERSION = '0.02'; ############################################################################## # Interface @@ -59,6 +59,9 @@ __END__ # Documentation ############################################################################## +=for stopwords +ACL Allbery + =head1 NAME Wallet::ACL::Base - Generic parent class for wallet ACL verifiers @@ -74,9 +77,9 @@ Wallet::ACL::Base - Generic parent class for wallet ACL verifiers =head1 DESCRIPTION -Wallet::ACL::Base is the generic parent class for wallet ACL verifiers. It -provides default functions and behavior and all ACL verifiers should inherit -from it. It is not used directly. +Wallet::ACL::Base is the generic parent class for wallet ACL verifiers. +It provides default functions and behavior and all ACL verifiers should +inherit from it. It is not used directly. =head1 METHODS @@ -84,8 +87,8 @@ from it. It is not used directly. =item new() -Creates a new ACL verifier. The generic function provided here just creates -and blesses an object. +Creates a new ACL verifier. The generic function provided here just +creates and blesses an object. =item check(PRINCIPAL, ACL) @@ -99,11 +102,11 @@ have failed. Callers should call this function to get the error message after an undef return from any other instance method. For the convenience of child classes, this method can also be called with -one or more error strings. If so, those strings are concatenated together, -trailing newlines are removed, any text of the form S> at the end of the message is stripped off, and the result is stored -as the error. Only child classes should call this method with an error -string. +one or more error strings. If so, those strings are concatenated +together, trailing newlines are removed, any text of the form S> at the end of the message is stripped off, and the result is +stored as the error. Only child classes should call this method with an +error string. =back @@ -111,8 +114,8 @@ string. Wallet::ACL(3), wallet-backend(8) -This module is part of the wallet system. The current version is available -from L. +This module is part of the wallet system. The current version is +available from L. =head1 AUTHOR diff --git a/perl/Wallet/ACL/Krb5.pm b/perl/Wallet/ACL/Krb5.pm index 1c584c5..496fcf0 100644 --- a/perl/Wallet/ACL/Krb5.pm +++ b/perl/Wallet/ACL/Krb5.pm @@ -1,7 +1,7 @@ # Wallet::ACL::Krb5 -- Wallet Kerberos v5 principal ACL verifier. # # Written by Russ Allbery -# Copyright 2007 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2010 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -22,7 +22,7 @@ use Wallet::ACL::Base; # This version should be increased on any code change to this module. Always # use two digits for the minor version with a leading zero if necessary so # that it will sort properly. -$VERSION = '0.01'; +$VERSION = '0.02'; ############################################################################## # Interface @@ -50,6 +50,9 @@ __END__ # Documentation ############################################################################## +=for stopwords +ACL krb5 Allbery + =head1 NAME Wallet::ACL::Krb5 - Simple wallet ACL verifier for Kerberos principals @@ -69,7 +72,7 @@ Wallet::ACL::Krb5 - Simple wallet ACL verifier for Kerberos principals =head1 DESCRIPTION Wallet::ACL::Krb5 is the simplest wallet ACL verifier, used to verify ACL -lines of type krb5. The value of such an ACL is a simple Kerberos +lines of type C. The value of such an ACL is a simple Kerberos principal in its text display form, and the ACL grants access to a given principal if and only if the principal exactly matches the ACL. @@ -111,8 +114,8 @@ The PRINCIPAL parameter to check() was undefined or the empty string. Wallet::ACL(3), Wallet::ACL::Base(3), wallet-backend(8) -This module is part of the wallet system. The current version is available -from L. +This module is part of the wallet system. The current version is +available from L. =head1 AUTHOR diff --git a/perl/Wallet/ACL/NetDB.pm b/perl/Wallet/ACL/NetDB.pm index 6775c62..2096ba8 100644 --- a/perl/Wallet/ACL/NetDB.pm +++ b/perl/Wallet/ACL/NetDB.pm @@ -1,7 +1,7 @@ # Wallet::ACL::NetDB -- Wallet NetDB role ACL verifier. # # Written by Russ Allbery -# Copyright 2007 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2010 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -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.03'; +$VERSION = '0.04'; ############################################################################## # Interface @@ -135,6 +135,9 @@ __END__ # Documentation ############################################################################## +=for stopwords +ACL NetDB remctl DNS DHCP Allbery netdb + =head1 NAME Wallet::ACL::NetDB - Wallet ACL verifier for NetDB roles @@ -154,9 +157,10 @@ Wallet::ACL::NetDB - Wallet ACL verifier for NetDB roles =head1 DESCRIPTION Wallet::ACL::NetDB checks a principal against the NetDB roles for a given -host. It is used to verify ACL lines of type netdb. The value of such an -ACL is a node, and the ACL grants access to a given principal if and only -if that principal has one of the roles user, admin, or team for that node. +host. It is used to verify ACL lines of type C. The value of such +an ACL is a node, and the ACL grants access to a given principal if and +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 @@ -227,7 +231,7 @@ error message or otherwise returned failure. The ACL parameter to check() was malformed. Currently, this error is only given if ACL is undefined or the empty string. -=item malformed NetDBL remctl token: %s +=item malformed NetDB remctl token: %s The Net::Remctl Perl library returned a malformed token. This should never happen and indicates a bug in Net::Remctl. @@ -248,12 +252,12 @@ grant access is not currently configurable. Net::Remctl(3), Wallet::ACL(3), Wallet::ACL::Base(3), Wallet::Config(3), wallet-backend(8) -NetDB is a free software system for managing DNS, DHCP, and related machine -information for large organizations. For more information on NetDB, see -L. +NetDB is a free software system for managing DNS, DHCP, and related +machine information for large organizations. For more information on +NetDB, see L. -This module is part of the wallet system. The current version is available -from L. +This module is part of the wallet system. The current version is +available from L. =head1 AUTHOR diff --git a/perl/Wallet/ACL/NetDB/Root.pm b/perl/Wallet/ACL/NetDB/Root.pm index cbd1387..3aeebda 100644 --- a/perl/Wallet/ACL/NetDB/Root.pm +++ b/perl/Wallet/ACL/NetDB/Root.pm @@ -1,7 +1,7 @@ # Wallet::ACL::NetDB::Root -- Wallet NetDB role ACL verifier (root instances). # # Written by Russ Allbery -# Copyright 2007 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2010 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -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.01'; +$VERSION = '0.02'; ############################################################################## # Interface @@ -48,6 +48,9 @@ sub check { # Documentation ############################################################################## +=for stopwords +ACL NetDB DNS DHCP Allbery + =head1 NAME Wallet::ACL::NetDB::Root - Wallet ACL verifier for NetDB roles (root instances) @@ -66,13 +69,14 @@ Wallet::ACL::NetDB::Root - Wallet ACL verifier for NetDB roles (root instances) =head1 DESCRIPTION -Wallet::ACL::NetDB::Root works identically to Wallet::ACL::NetDB except that -it requires the principal to be a root instance (in other words, to be in -the form /root@) and strips the C portion from the -principal before checking against NetDB roles. As with the base NetDB ACL -verifier, the value of a netdb-root ACL is a node, and the ACL grants access -to a given principal if and only if the that principal (with C -stripped) has one of the roles user, admin, or team for that node. +Wallet::ACL::NetDB::Root works identically to Wallet::ACL::NetDB except +that it requires the principal to be a root instance (in other words, to +be in the form /root@) and strips the C portion +from the principal before checking against NetDB roles. As with the base +NetDB ACL verifier, the value of a C ACL is a node, and the +ACL grants access to a given principal if and only if the that principal +(with C stripped) has one of the roles user, admin, or team for +that node. To use this object, the same configuration parameters must be set as for Wallet::ACL::NetDB. See Wallet::Config(3) for details on those @@ -85,11 +89,11 @@ configuration. =item check(PRINCIPAL, ACL) -Returns true if PRINCIPAL is granted access according to ACL, false if not, -and undef on an error (see L<"DIAGNOSTICS"> below). ACL is a node, and -PRINCIPAL will be granted access if it has an instance of C and if -(with C stripped off and the realm stripped off if configured) has -the user, admin, or team role for that node. +Returns true if PRINCIPAL is granted access according to ACL, false if +not, and undef on an error (see L<"DIAGNOSTICS"> below). ACL is a node, +and PRINCIPAL will be granted access if it has an instance of C and +if (with C stripped off and the realm stripped off if configured) +has the user, admin, or team role for that node. =back @@ -106,15 +110,15 @@ grant access is not currently configurable. =head1 SEE ALSO -Net::Remctl(3), Wallet::ACL(3), Wallet::ACL::Base(3), Wallet::ACL::NetDB(3), -Wallet::Config(3), wallet-backend(8) +Net::Remctl(3), Wallet::ACL(3), Wallet::ACL::Base(3), +Wallet::ACL::NetDB(3), Wallet::Config(3), wallet-backend(8) -NetDB is a free software system for managing DNS, DHCP, and related machine -information for large organizations. For more information on NetDB, see -L. +NetDB is a free software system for managing DNS, DHCP, and related +machine information for large organizations. For more information on +NetDB, see L. -This module is part of the wallet system. The current version is available -from L. +This module is part of the wallet system. The current version is +available from L. =head1 AUTHOR diff --git a/perl/Wallet/Admin.pm b/perl/Wallet/Admin.pm index ff87b94..b4b3d86 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 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008, 2009, 2010 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -413,6 +413,9 @@ __DATA__ Wallet::Admin - Wallet system administrative interface +=for stopwords +ACL hostname ACLs SQL wildcard Allbery + =head1 SYNOPSIS use Wallet::Admin; @@ -429,9 +432,9 @@ thin wrapper around this object that provides a command-line interface to 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). +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 @@ -491,11 +494,11 @@ at least one ACL, but an error can be distinguished from the odd case of a database with no ACLs by calling error(). error() is guaranteed to return the error message if there was an error and undef if there was no error. -There are currently two search types. 'empty' takes no arguments, and will -return only those acls that have no entries within them. 'entry' takes two -arguments -- an entry scheme and an entry identifier -- and will return -any ACLs with an entry that matches the given scheme and contains the -given identifier. +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 an entry identifier, and will +return any ACLs with an entry that matches the given scheme and contains +the given identifier. =item list_objects(TYPE, SEARCH) @@ -503,7 +506,7 @@ 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. 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 -"keytab" and with values "host/example.com" and "foo", list_objects() +C and with values C and C, list_objects() with no arguments would return: ([ 'keytab', 'host/example.com' ], [ 'keytab', 'foo' ]) @@ -513,13 +516,13 @@ database containing no objects, 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. -There are four types of searches currently. 'type' (with a given type) +There are four types of searches currently. C (with a given type) will return only those entries where the type matches the given type. -'owner', with a given owner, will only return those objects owned by the -given acl name. 'flag', with a given flag name, will only return those -items with a flag set to the given value. 'acl' operates like 'owner', -but will return only those objects that have the given acl name on any -of the possible acl settings, not just owner. +C, with a given owner, will only return those objects owned by the +given ACL name. 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 on any of +the possible ACL settings, not just owner. =item register_object (TYPE, CLASS) @@ -559,8 +562,8 @@ the error message if there was an error and undef if there was no error. wallet-admin(8) -This module is part of the wallet system. The current version is available -from L. +This module is part of the wallet system. The current version is +available from L. =head1 AUTHOR diff --git a/perl/Wallet/Config.pm b/perl/Wallet/Config.pm index ae8cf9c..c59d3e3 100644 --- a/perl/Wallet/Config.pm +++ b/perl/Wallet/Config.pm @@ -23,6 +23,11 @@ $PATH = $ENV{WALLET_CONFIG} || '/etc/wallet/wallet.conf'; Wallet::Config - Configuration handling for the wallet server +=for stopwords +DBI DSN SQLite subdirectories KEYTAB keytab kadmind KDC add-ons kadmin DNS +SRV kadmin keytabs remctl backend lowercased NETDB ACL NetDB unscoped +usernames rekey hostnames Allbery wallet-backend keytab-backend + =head1 SYNOPSIS use Wallet::Config; @@ -63,9 +68,9 @@ variable DB_DRIVER to C, use: $DB_DRIVER = 'MySQL'; -Always remember the initial dollar sign (C<$>) and ending semicolon (C<;>). -Those familiar with Perl syntax can of course use the full range of Perl -expressions. +Always remember the initial dollar sign (C<$>) and ending semicolon +(C<;>). Those familiar with Perl syntax can of course use the full range +of Perl expressions. This configuration file should end with the line: @@ -80,11 +85,11 @@ file. =item DB_DRIVER -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). +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). This variable must be set. @@ -95,8 +100,8 @@ our $DB_DRIVER; =item DB_INFO 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 +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 database driver you're using. @@ -111,9 +116,10 @@ our $DB_INFO; =item DB_NAME 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 you're using. +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 +you're using. Either DB_INFO or DB_NAME must be set. @@ -124,8 +130,8 @@ 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) and -the documentation for the database driver you're using. +be appended to the DBI connect string. For more information, see DBI(3) +and the documentation for the database driver you're using. =cut @@ -135,8 +141,8 @@ 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 documentation -for the database driver you're using. +should also be set. For more information, see DBI(3) and the +documentation for the database driver you're using. =cut @@ -153,8 +159,8 @@ our $DB_USER; =item DB_PASSWORD -Specifies the password for database authentication. Some database backends, -particularly SQLite, do not need this. +Specifies the password for database authentication. Some database +backends, particularly SQLite, do not need this. =cut @@ -205,9 +211,10 @@ C object type (the Wallet::Object::Keytab class). =item KEYTAB_FILE Specifies the keytab to use to authenticate to B. The principal -whose key is stored in this keytab must have the ability to create, modify, -inspect, and delete any principals that should be managed by the wallet. -(In MIT Kerberos F parlance, this is C privileges.) +whose key is stored in this keytab must have the ability to create, +modify, inspect, and delete any principals that should be managed by the +wallet. (In MIT Kerberos F parlance, this is C +privileges.) KEYTAB_FILE must be set to use keytab objects. @@ -218,12 +225,13 @@ our $KEYTAB_FILE; =item KEYTAB_FLAGS These flags, if any, are passed to the C command when creating a -new principal in the Kerberos KDC. To not pass any flags, set KEYTAB_FLAGS -to the empty string. The default value is C<-clearpolicy>, which clears any -password strength policy from principals created by the wallet. (Since the -wallet randomizes the keys, password strength checking is generally -pointless and may interact poorly with the way C works -when third-party add-ons for password strength checking are used.) +new principal in the Kerberos KDC. To not pass any flags, set +KEYTAB_FLAGS to the empty string. The default value is C<-clearpolicy>, +which clears any password strength policy from principals created by the +wallet. (Since the wallet randomizes the keys, password strength checking +is generally pointless and may interact poorly with the way C works when third-party add-ons for password strength checking +are used.) =cut @@ -264,9 +272,9 @@ our $KEYTAB_KRBTYPE; The principal whose key is stored in KEYTAB_FILE. The wallet will authenticate as this principal to the kadmin service. -KEYTAB_PRINCIPAL must be set to use keytab objects, at least until B -is smart enough to use the first principal found in the keytab it's using -for authentication. +KEYTAB_PRINCIPAL must be set to use keytab objects, at least until +B is smart enough to use the first principal found in the keytab +it's using for authentication. =cut @@ -289,11 +297,11 @@ our $KEYTAB_REALM; =item KEYTAB_TMP A directory into which the wallet can write keytabs temporarily while -processing C commands from clients. The keytabs are written into this -directory with predictable names, so this should not be a system temporary -directory such as F or F. It's best to create a directory -solely for this purpose that's owned by the user the wallet server will run -as. +processing C commands from clients. The keytabs are written into +this directory with predictable names, so this should not be a system +temporary directory such as F or F. It's best to create a +directory solely for this purpose that's owned by the user the wallet +server will run as. KEYTAB_TMP must be set to use keytab objects. @@ -305,20 +313,20 @@ our $KEYTAB_TMP; =head2 Retrieving Existing Keytabs -The keytab object backend optionally supports retrieving existing keys, and -hence keytabs, for Kerberos principals by contacting the KDC via remctl and -talking to B. This is enabled by setting the C -flag on keytab objects. To configure that support, set the following -variables. +The keytab object backend optionally supports retrieving existing keys, +and hence keytabs, for Kerberos principals by contacting the KDC via +remctl and talking to B. This is enabled by setting the +C flag on keytab objects. To configure that support, set the +following variables. =over 4 =item KEYTAB_REMCTL_CACHE -Specifies the ticket cache to use when retrieving existing keytabs from the -KDC. This is only used to implement support for the C flag. -The ticket cache must be for a principal with access to run C via remctl on KEYTAB_REMCTL_HOST. +Specifies the ticket cache to use when retrieving existing keytabs from +the KDC. This is only used to implement support for the C +flag. The ticket cache must be for a principal with access to run +C via remctl on KEYTAB_REMCTL_HOST. =cut @@ -326,10 +334,10 @@ our $KEYTAB_REMCTL_CACHE; =item KEYTAB_REMCTL_HOST -The host to which to connect with remctl to retrieve existing keytabs. This -is only used to implement support for the C flag. This host -must provide the C command and KEYTAB_REMCTL_CACHE must -also be set to a ticket cache for a principal with access to run that +The host to which to connect with remctl to retrieve existing keytabs. +This is only used to implement support for the C flag. This +host must provide the C command and KEYTAB_REMCTL_CACHE +must also be set to a ticket cache for a principal with access to run that command. =cut @@ -339,9 +347,10 @@ our $KEYTAB_REMCTL_HOST; =item KEYTAB_REMCTL_PRINCIPAL The service principal to which to authenticate when retrieving existing -keytabs. This is only used to implement support for the C flag. -If this variable is not set, the default is formed by prepending C to -KEYTAB_REMCTL_HOST. (Note that KEYTAB_REMCTL_HOST is not lowercased first.) +keytabs. This is only used to implement support for the C +flag. If this variable is not set, the default is formed by prepending +C to KEYTAB_REMCTL_HOST. (Note that KEYTAB_REMCTL_HOST is not +lowercased first.) =cut @@ -365,18 +374,18 @@ our $KEYTAB_REMCTL_PORT; These configuration variables are only needed if you intend to use the C ACL type (the Wallet::ACL::NetDB class). They specify the remctl connection information for retrieving user roles from NetDB and the local -realm to remove from principals (since NetDB normally expects unscoped local -usernames). +realm to remove from principals (since NetDB normally expects unscoped +local usernames). =over 4 =item NETDB_REALM The wallet uses fully-qualified principal names (including the realm), but -NetDB normally expects local usernames without the realm. If this variable -is set, the given realm will be stripped from any principal names before -passing them to NetDB. Principals in other realms will be passed to NetDB -without modification. +NetDB normally expects local usernames without the realm. If this +variable is set, the given realm will be stripped from any principal names +before passing them to NetDB. Principals in other realms will be passed +to NetDB without modification. =cut @@ -385,9 +394,9 @@ our $NETDB_REALM; =item NETDB_REMCTL_CACHE Specifies the ticket cache to use when querying the NetDB remctl interface -for user roles. The ticket cache must be for a principal with access to run -C via remctl on KEYTAB_REMCTL_HOST. This variable must be -set to use NetDB ACLs. +for user roles. The ticket cache must be for a principal with access to +run C via remctl on KEYTAB_REMCTL_HOST. This variable +must be set to use NetDB ACLs. =cut @@ -406,10 +415,10 @@ our $NETDB_REMCTL_HOST; =item NETDB_REMCTL_PRINCIPAL -The service principal to which to authenticate when querying NetDB for user -roles. If this variable is not set, the default is formed by prepending -C to NETDB_REMCTL_HOST. (Note that NETDB_REMCTL_HOST is not -lowercased first.) +The service principal to which to authenticate when querying NetDB for +user roles. If this variable is not set, the default is formed by +prepending C to NETDB_REMCTL_HOST. (Note that NETDB_REMCTL_HOST is +not lowercased first.) =cut @@ -417,9 +426,9 @@ our $NETDB_REMCTL_PRINCIPAL; =item NETDB_REMCTL_PORT -The port on NETDB_REMCTL_HOST to which to connect with remctl to query NetDB -for user roles. If this variable is not set, the default remctl port will -be used. +The port on NETDB_REMCTL_HOST to which to connect with remctl to query +NetDB for user roles. If this variable is not set, the default remctl +port will be used. =cut @@ -430,17 +439,18 @@ our $NETDB_REMCTL_PORT; =head1 DEFAULT OWNERS By default, only users in the ADMIN ACL can create new objects in the -wallet. To allow other users to create new objects, define a Perl function -named default_owner. This function will be called whenever a non-ADMIN user -tries to create a new object and will be passed the type and name of the -object. It should return undef if there is no default owner for that -object. If there is, it should return a list containing the name to use for -the ACL and then zero or more anonymous arrays of two elements each giving -the type and identifier for each ACL entry. - -For example, the following simple function says to use a default owner named -C with one entry of type C and identifier C -for the object with type C and name C: +wallet. To allow other users to create new objects, define a Perl +function named default_owner. This function will be called whenever a +non-ADMIN user tries to create a new object and will be passed the type +and name of the object. It should return undef if there is no default +owner for that object. If there is, it should return a list containing +the name to use for the ACL and then zero or more anonymous arrays of two +elements each giving the type and identifier for each ACL entry. + +For example, the following simple function says to use a default owner +named C with one entry of type C and identifier +C for the object with type C and name +C: sub default_owner { my ($type, $name) = @_; @@ -453,8 +463,8 @@ for the object with type C and name C: Of course, normally this function is used for more complex mappings. Here is a more complete example. For objects of type keytab corresponding to -various types of per-machine principals, return a default owner that sets as -owner anyone with a NetDB role for that system and the system's host +various types of per-machine principals, return a default owner that sets +as owner anyone with a NetDB role for that system and the system's host principal. This permits authorization management using NetDB while also allowing the system to bootstrap itself once the host principal has been downloaded and rekey itself using the old host principal. @@ -474,17 +484,19 @@ downloaded and rekey itself using the old host principal. return ($acl_name, @acl); } -The auto-created ACL used for the owner of the new object will, in the above -example, be named C> where I is the fully-qualified -name of the system as derived from the keytab being requested. - -If the name of the ACL returned by the default_owner function matches an ACL -that already exists in the wallet database, the existing ACL will be -compared to the default ACL returned by the default_owner function. If the -existing ACL has the same entries as the one returned by default_owner, -creation continues if the user is authorized by that ACL. If they don't -match, creation of the object is rejected, since the presence of an existing -ACL may indicate that something different is being done with this object. +The auto-created ACL used for the owner of the new object will, in the +above example, be named C> where I is the +fully-qualified name of the system as derived from the keytab being +requested. + +If the name of the ACL returned by the default_owner function matches an +ACL that already exists in the wallet database, the existing ACL will be +compared to the default ACL returned by the default_owner function. If +the existing ACL has the same entries as the one returned by +default_owner, creation continues if the user is authorized by that ACL. +If they don't match, creation of the object is rejected, since the +presence of an existing ACL may indicate that something different is being +done with this object. =head1 NAMING ENFORCEMENT diff --git a/perl/Wallet/Database.pm b/perl/Wallet/Database.pm index 68fb6bb..7b3474a 100644 --- a/perl/Wallet/Database.pm +++ b/perl/Wallet/Database.pm @@ -6,7 +6,7 @@ # like DBI objects in the rest of the code. # # Written by Russ Allbery -# Copyright 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008, 2010 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -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.01'; +$VERSION = '0.02'; ############################################################################## # Core overrides @@ -84,6 +84,9 @@ __END__ Wallet::Dabase - Wrapper module for wallet database connections +=for stopwords +DBI RaiseError PrintError AutoCommit Allbery + =head1 SYNOPSIS use Wallet::Database; @@ -93,9 +96,9 @@ Wallet::Dabase - Wrapper module for wallet database connections Wallet::Database is a thin wrapper module around DBI that takes care of building a connect string and setting database options based on wallet -configuration. The only overriden method is connect(). All other methods -should work the same as in DBI and Wallet::Database objects should be -usable exactly as if they were DBI objects. +configuration. The only overridden method is connect(). All other +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 @@ -120,8 +123,8 @@ configuration. DBI(3), Wallet::Config(3) -This module is part of the wallet system. The current version is available -from L. +This module is part of the wallet system. The current version is +available from L. =head1 AUTHOR diff --git a/perl/Wallet/Kadmin.pm b/perl/Wallet/Kadmin.pm index 65ddf4b..b653f87 100644 --- a/perl/Wallet/Kadmin.pm +++ b/perl/Wallet/Kadmin.pm @@ -55,6 +55,9 @@ __END__ # Documentation ############################################################################## +=for stopwords +Kadmin keytabs keytab Heimdal API kadmind kadmin + =head1 NAME Wallet::Kadmin - Kadmin module wrapper for wallet keytabs @@ -69,21 +72,21 @@ Wallet::Kadmin - Kadmin module wrapper for wallet keytabs =head1 DESCRIPTION -Wallet::Kadmin is a wrapper to modules that provide an interface for keytab -integration with the wallet. Each module is meant to interface with a -specific type of Kerberos implementation, such as MIT Kerberos or Heimdal -Kerberos, and provide a standndard set of API calls used to interact with -that implementation's kadmind. +Wallet::Kadmin is a wrapper to modules that provide an interface for +keytab integration with wallet. Each module is meant to interface with a +specific type of Kerberos implementation, such as MIT Kerberos or Heimdal, +and provide a standard set of API calls used to interact with that +implementation's kadmin interface. The class simply uses Wallet::Config to find which type of kadmind we have requested to use, and then returns an object to use for interacting with that kadmind. A keytab is an on-disk store for the key or keys for a Kerberos principal. -Keytabs are used by services to verify incoming authentication from clients -or by automated processes that need to authenticate to Kerberos. To create -a keytab, the principal has to be created in Kerberos and then a keytab is -generated and stored in a file on disk. +Keytabs are used by services to verify incoming authentication from +clients or by automated processes that need to authenticate to Kerberos. +To create a keytab, the principal has to be created in Kerberos and then a +keytab is generated and stored in a file on disk. To use this object, several configuration parameters must be set. See Wallet::Config(3) for details on those configuration parameters and @@ -95,9 +98,9 @@ information about how to set wallet configuration. =item new() -Finds the proper Kerberos implementation and calls the new() constructor for -that implementation's module, returning the result. If the implementation -is not recognized or set, die with an error message. +Finds the proper Kerberos implementation and calls the new() constructor +for that implementation's module, returning the result. If the +implementation is not recognized or set, die with an error message. =back @@ -105,8 +108,8 @@ is not recognized or set, die with an error message. kadmin(8), Wallet::Config(3), Wallet::Object::Keytab(3), wallet-backend(8) -This module is part of the wallet system. The current version is available -from L. +This module is part of the wallet system. The current version is +available from L. =head1 AUTHORS diff --git a/perl/Wallet/Kadmin/Heimdal.pm b/perl/Wallet/Kadmin/Heimdal.pm index 428202b..2ad35e3 100644 --- a/perl/Wallet/Kadmin/Heimdal.pm +++ b/perl/Wallet/Kadmin/Heimdal.pm @@ -230,9 +230,12 @@ __END__ # Documentation ############################################################################## +=for stopwords +keytabs keytab kadmin enctypes API ENCTYPES enctype Allbery Heimdal + =head1 NAME -Wallet::Kadmin::MIT - MIT admin interactions for wallet keytabs +Wallet::Kadmin::Heimdal - Heimdal admin interactions for wallet keytabs =head1 SYNOPSIS @@ -244,18 +247,18 @@ Wallet::Kadmin::MIT - MIT admin interactions for wallet keytabs =head1 DESCRIPTION -Wallet::Kadmin::MIT is an interface for keytab integration with the wallet, -specifically for using kadmin to create, delete, and add enctypes to keytabs. -It implments the wallet kadmin API and provides the necessary glue to MIT -Kerberos installs for each of these functions, while allowing the wallet -to keep the details of what type of Kerberos installation is being used -abstracted. +Wallet::Kadmin::Heimdal is an interface for keytab integration with the +wallet, specifically for using kadmin to create, delete, and add enctypes +to keytabs. It implements the wallet kadmin API and provides the +necessary glue to Heimdal installs for each of these functions, while +allowing the wallet to keep the details of what type of Kerberos +installation is being used abstracted. A keytab is an on-disk store for the key or keys for a Kerberos principal. -Keytabs are used by services to verify incoming authentication from clients -or by automated processes that need to authenticate to Kerberos. To create -a keytab, the principal has to be created in Kerberos and then a keytab is -generated and stored in a file on disk. +Keytabs are used by services to verify incoming authentication from +clients or by automated processes that need to authenticate to Kerberos. +To create a keytab, the principal has to be created in Kerberos and then a +keytab is generated and stored in a file on disk. To use this object, several configuration parameters must be set. See Wallet::Config(3) for details on those configuration parameters and @@ -268,17 +271,17 @@ information about how to set wallet configuration. =item addprinc(PRINCIPAL) Adds a new principal with a given name. The principal is created with a -random password, and any other flags set by Wallet::Config. Returns true on -success, or throws an error if there was a failure in adding the principal. -If the principal already exists, return true as we are bringing our -expectations in line with reality. +random password, and any other flags set by Wallet::Config. Returns true +on success, or throws an error if there was a failure in adding the +principal. If the principal already exists, return true as we are +bringing our expectations in line with reality. =item addprinc(PRINCIPAL) -Removes a principal with the given name. Returns true on success, or throws -an error if there was a failure in removing the principal. If the principal -does not exist, return true as we are bringing our expectations in line with -reality. +Removes a principal with the given name. Returns true on success, or +throws an error if there was a failure in removing the principal. If the +principal does not exist, return true as we are bringing our expectations +in line with reality. =item ktadd(PRINCIPAL, FILE, ENCTYPES) @@ -290,19 +293,12 @@ otherwise true is returned. =back -=head1 LIMITATIONS - -Currently, this implementation calls an external B program rather - than using a native Perl module and therefore requires B be -installed and parses its output. It may miss some error conditions if the -output of B ever changes. - =head1 SEE ALSO kadmin(8), Wallet::Config(3), Wallet::Object::Keytab(3), wallet-backend(8) -This module is part of the wallet system. The current version is available -from L. +This module is part of the wallet system. The current version is +available from L. =head1 AUTHORS diff --git a/perl/Wallet/Kadmin/MIT.pm b/perl/Wallet/Kadmin/MIT.pm index 49691b0..8449868 100644 --- a/perl/Wallet/Kadmin/MIT.pm +++ b/perl/Wallet/Kadmin/MIT.pm @@ -226,6 +226,9 @@ __END__ # Documentation ############################################################################## +=for stopwords +keytabs keytab kadmin enctype enctypes API ENCTYPES Allbery + =head1 NAME Wallet::Kadmin::MIT - MIT admin interactions for wallet keytabs @@ -240,18 +243,18 @@ Wallet::Kadmin::MIT - MIT admin interactions for wallet keytabs =head1 DESCRIPTION -Wallet::Kadmin::MIT is an interface for keytab integration with the wallet, -specifically for using kadmin to create, delete, and add enctypes to keytabs. -It implments the wallet kadmin API and provides the necessary glue to MIT -Kerberos installs for each of these functions, while allowing the wallet -to keep the details of what type of Kerberos installation is being used -abstracted. +Wallet::Kadmin::MIT is an interface for keytab integration with the +wallet, specifically for using kadmin to create, delete, and add enctypes +to keytabs. It implements the wallet kadmin API and provides the +necessary glue to MIT Kerberos installs for each of these functions, while +allowing the wallet to keep the details of what type of Kerberos +installation is being used abstracted. A keytab is an on-disk store for the key or keys for a Kerberos principal. -Keytabs are used by services to verify incoming authentication from clients -or by automated processes that need to authenticate to Kerberos. To create -a keytab, the principal has to be created in Kerberos and then a keytab is -generated and stored in a file on disk. +Keytabs are used by services to verify incoming authentication from +clients or by automated processes that need to authenticate to Kerberos. +To create a keytab, the principal has to be created in Kerberos and then a +keytab is generated and stored in a file on disk. To use this object, several configuration parameters must be set. See Wallet::Config(3) for details on those configuration parameters and @@ -264,17 +267,17 @@ information about how to set wallet configuration. =item addprinc(PRINCIPAL) Adds a new principal with a given name. The principal is created with a -random password, and any other flags set by Wallet::Config. Returns true on -success, or throws an error if there was a failure in adding the principal. -If the principal already exists, return true as we are bringing our -expectations in line with reality. +random password, and any other flags set by Wallet::Config. Returns true +on success, or throws an error if there was a failure in adding the +principal. If the principal already exists, return true as we are +bringing our expectations in line with reality. -=item addprinc(PRINCIPAL) +=item delprinc(PRINCIPAL) -Removes a principal with the given name. Returns true on success, or throws -an error if there was a failure in removing the principal. If the principal -does not exist, return true as we are bringing our expectations in line with -reality. +Removes a principal with the given name. Returns true on success, or +throws an error if there was a failure in removing the principal. If the +principal does not exist, return true as we are bringing our expectations +in line with reality. =item ktadd(PRINCIPAL, FILE, ENCTYPES) @@ -297,8 +300,8 @@ output of B ever changes. kadmin(8), Wallet::Config(3), Wallet::Object::Keytab(3), wallet-backend(8) -This module is part of the wallet system. The current version is available -from L. +This module is part of the wallet system. The current version is +available from L. =head1 AUTHORS diff --git a/perl/Wallet/Object/Base.pm b/perl/Wallet/Object/Base.pm index fea0320..5097729 100644 --- a/perl/Wallet/Object/Base.pm +++ b/perl/Wallet/Object/Base.pm @@ -1,7 +1,7 @@ # Wallet::Object::Base -- Parent class for any object stored in the wallet. # # Written by Russ Allbery -# Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2008, 2010 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -22,7 +22,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.04'; +$VERSION = '0.05'; ############################################################################## # Constructors @@ -669,6 +669,10 @@ __END__ Wallet::Object::Base - Generic parent class for wallet objects +=for stopwords +DBH HOSTNAME DATETIME ACL backend metadata timestamp Allbery wallet-backend +backend-specific + =head1 SYNOPSIS package Wallet::Object::Simple; @@ -682,104 +686,107 @@ Wallet::Object::Base - Generic parent class for wallet objects =head1 DESCRIPTION Wallet::Object::Base is the generic parent class for wallet objects (data -types that can be stored in the wallet system). It provides defualt +types that can be stored in the wallet system). It provides default functions and behavior, including handling generic object settings. All handlers for objects stored in the wallet should inherit from it. It is not used directly. =head1 PUBLIC CLASS METHODS -The following methods are called by the rest of the wallet system and should -be implemented by all objects stored in the wallet. They should be called -with the desired wallet object class as the first argument (generally using -the Wallet::Object::Type->new syntax). +The following methods are called by the rest of the wallet system and +should be implemented by all objects stored in the wallet. They should be +called with the desired wallet object class as the first argument +(generally using the Wallet::Object::Type->new syntax). =over 4 =item new(TYPE, NAME, DBH) Creates a new object with the given object type and name, based on data -already in the database. This method will only succeed if an object of the -given TYPE and NAME is already present in the wallet database. If no 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). +already in the database. This method will only succeed if an object of +the given TYPE and NAME is already present in the wallet database. If no +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 for -any further operations. +Takes a Wallet::Database object, which is stored in the object and used +for any further operations. =item create(TYPE, NAME, DBH, PRINCIPAL, HOSTNAME [, DATETIME]) Similar to new() but instead creates a new entry in the database. This method will throw an exception if an entry for that type and name already -exists in the database or if creating the database record fails. Otherwise, -a new database entry will be created with that type and name, no owner, no -ACLs, no expiration, no flags, and with created by, from, and on set to the -PRINCIPAL, HOSTNAME, and DATETIME parameters. If DATETIME isn't given, the -current time is used. The database handle is treated as with new(). +exists in the database or if creating the database record fails. +Otherwise, a new database entry will be created with that type and name, +no owner, no ACLs, no expiration, no flags, and with created by, from, and +on set to the PRINCIPAL, HOSTNAME, and DATETIME parameters. If DATETIME +isn't given, the current time is used. The database handle is treated as +with new(). =back =head1 PUBLIC INSTANCE METHODS The following methods may be called on instantiated wallet objects. -Normally, the only methods that a subclass will need to override are get(), -store(), show(), and destroy(). +Normally, the only methods that a subclass will need to override are +get(), store(), show(), and destroy(). -If the locked flag is set on an object, no actions may be performed on that -object except for the flag methods and show(). All other actions will be -rejected with an error saying the object is locked. +If the locked flag is set on an object, no actions may be performed on +that object except for the flag methods and show(). All other actions +will be rejected with an error saying the object is locked. =over 4 =item acl(TYPE [, ACL, PRINCIPAL, HOSTNAME [, DATETIME]]) -Sets or retrieves a given object ACL as a numeric ACL ID. TYPE must be one -of C, C, C, C, or C, corresponding to the -ACLs kept on an object. If no other arguments are given, returns the -current ACL setting as an ACL ID or undef if that ACL isn't set. If other -arguments are given, change that ACL to ACL and return true on success and -false on failure. Pass in the empty string for ACL to clear the ACL. The -other arguments are used for logging and history and should indicate the -user and host from which the change is made and the time of the change. +Sets or retrieves a given object ACL as a numeric ACL ID. TYPE must be +one of C, C, C, C, or C, corresponding +to the ACLs kept on an object. If no other arguments are given, returns +the current ACL setting as an ACL ID or undef if that ACL isn't set. If +other arguments are given, change that ACL to ACL and return true on +success and false on failure. Pass in the empty string for ACL to clear +the ACL. The other arguments are used for logging and history and should +indicate the user and host from which the change is made and the time of +the change. =item attr(ATTRIBUTE [, VALUES, PRINCIPAL, HOSTNAME [, DATETIME]]) Sets or retrieves a given object attribute. Attributes are used to store -backend-specific information for a particular object type and ATTRIBUTE must -be an attribute type known to the underlying object implementation. The -default implementation of this method rejects all attributes as unknown. +backend-specific information for a particular object type and ATTRIBUTE +must be an attribute type known to the underlying object implementation. +The default implementation of this method rejects all attributes as +unknown. If no other arguments besides ATTRIBUTE are given, returns the values of that attribute, if any, as a list. On error, returns the empty list. To -distinguish between an error and an empty return, call error() afterwards. +distinguish between an error and an empty return, call error() afterward. It is guaranteed to return undef unless there was an error. If other arguments are given, sets the given ATTRIBUTE values to VALUES, -which must be a reference to an array (even if only one value is being set). -Pass a reference to an empty array to clear the attribute values. The other -arguments are used for logging and history and should indicate the user and -host from which the change is made and the time of the change. Returns true -on success and false on failure. +which must be a reference to an array (even if only one value is being +set). Pass a reference to an empty array to clear the attribute values. +The other arguments are used for logging and history and should indicate +the user and host from which the change is made and the time of the +change. Returns true on success and false on failure. =item attr_show() -Returns a formatted text description of the type-specific attributes of the -object, or undef on error. The default implementation of this method always -returns the empty string. If there are any type-specific attributes set, -this method should return that metadata, formatted as key: value pairs with -the keys right-aligned in the first 15 characters, followed by a space, a -colon, and the value. +Returns a formatted text description of the type-specific attributes of +the object, or undef on error. The default implementation of this method +always returns the empty string. If there are any type-specific +attributes set, this method should return that metadata, formatted as key: +value pairs with the keys right-aligned in the first 15 characters, +followed by a space, a colon, and the value. =item destroy(PRINCIPAL, HOSTNAME [, DATETIME]) Destroys the object by removing all record of it from the database. The -Wallet::Object::Base implementation handles the generic database work, -but any subclass should override this method to do any deletion of files -or entries in external databases and any other database entries and then -call the parent method to handle the generic database cleanup. Returns -true on success and false on failure. The arguments are used for logging -and history and should indicate the user and host from which the change is +Wallet::Object::Base implementation handles the generic database work, but +any subclass should override this method to do any deletion of files or +entries in external databases and any other database entries and then call +the parent method to handle the generic database cleanup. Returns true on +success and false on failure. The arguments are used for logging and +history and should indicate the user and host from which the change is made and the time of the change. =item error([ERROR ...]) @@ -789,47 +796,50 @@ have failed. Callers should call this function to get the error message after an undef return from any other instance method. For the convenience of child classes, this method can also be called with -one or more error strings. If so, those strings are concatenated together, -trailing newlines are removed, any text of the form S> at the end of the message is stripped off, and the result is stored -as the error. Only child classes should call this method with an error -string. +one or more error strings. If so, those strings are concatenated +together, trailing newlines are removed, any text of the form S> at the end of the message is stripped off, and the result is +stored as the error. Only child classes should call this method with an +error string. =item expires([EXPIRES, PRINCIPAL, HOSTNAME [, DATETIME]]) Sets or retrieves the expiration date of an object. If no arguments are -given, returns the current expiration or undef if no expiration is set. If -arguments are given, change the expiration to EXPIRES and return true on -success and false on failure. EXPIRES must be in the format C, although the time portion may be omitted. Pass in the empty -string for EXPIRES to clear the expiration date. - -The other arguments are used for logging and history and should indicate the -user and host from which the change is made and the time of the change. +given, returns the current expiration or undef if no expiration is set. +If arguments are given, change the expiration to EXPIRES and return true +on success and false on failure. EXPIRES must be in the format +C, although the time portion may be omitted. Pass in +the empty string for EXPIRES to clear the expiration date. + +The other arguments are used for logging and history and should indicate +the user and host from which the change is made and the time of the +change. =item flag_check(FLAG) -Check whether the given flag is set on an object. Returns true if set, C<0> -if not set, and undef on error. +Check whether the given flag is set on an object. Returns true if set, +C<0> if not set, and undef on error. =item flag_clear(FLAG, PRINCIPAL, HOSTNAME [, DATETIME]) Clears FLAG on an object. Returns true on success and false on failure. -The other arguments are used for logging and history and should indicate the -user and host from which the change is made and the time of the change. +The other arguments are used for logging and history and should indicate +the user and host from which the change is made and the time of the +change. =item flag_list() List the flags set on an object. If no flags are set, returns the empty -list. On failure, returns an empty list. To distinguish between the empty -response and an error, the caller should call error() after an empty return. -It is guaranteed to return undef if there was no error. +list. On failure, returns an empty list. To distinguish between the +empty response and an error, the caller should call error() after an empty +return. It is guaranteed to return undef if there was no error. =item flag_set(FLAG, PRINCIPAL, HOSTNAME [, DATETIME]) Sets FLAG on an object. Returns true on success and false on failure. -The other arguments are used for logging and history and should indicate the -user and host from which the change is made and the time of the change. +The other arguments are used for logging and history and should indicate +the user and host from which the change is made and the time of the +change. =item get(PRINCIPAL, HOSTNAME [, DATETIME]) @@ -856,9 +866,9 @@ Sets or retrieves the owner of an object as a numeric ACL ID. If no arguments are given, returns the current owner ACL ID or undef if none is set. If arguments are given, change the owner to OWNER and return true on success and false on failure. Pass in the empty string for OWNER to clear -the owner. The other arguments are used for logging and history and should -indicate the user and host from which the change is made and the time of the -change. +the owner. The other arguments are used for logging and history and +should indicate the user and host from which the change is made and the +time of the change. =item show() @@ -866,17 +876,17 @@ Returns a formatted text description of the object suitable for human display, or undef on error. All of the base metadata about the object, formatted as key: value pairs with the keys aligned in the first 15 characters followed by a space, a colon, and the value. The attr_show() -method of the object is also called and any formatted output it returns will -be included. If any ACLs or an owner are set, after this data there is a -blank line and then the information for each unique ACL, separated by blank -lines. +method of the object is also called and any formatted output it returns +will be included. If any ACLs or an owner are set, after this data there +is a blank line and then the information for each unique ACL, separated by +blank lines. =item store(DATA, PRINCIPAL, HOSTNAME [, DATETIME]) Store user-supplied data into the given object. This may not be supported -by all backends (for instance, backends that automatically generate the data -will not support this). The default implementation rejects all store() -calls with an error message saying that the object is immutable. +by all backends (for instance, backends that automatically generate the +data will not support this). The default implementation rejects all +store() calls with an error message saying that the object is immutable. =item type() @@ -894,23 +904,24 @@ provided for subclasses to call to implement some generic actions. =item log_action (ACTION, PRINCIPAL, HOSTNAME, DATETIME) Updates the history tables and trace information appropriately for ACTION, -which should be either C or C. No other changes are made to the -database, just updates of the history table and trace fields with the +which should be either C or C. No other changes are made to +the database, just updates of the history table and trace fields with the provided data about who performed the action and when. -This function commits its transaction when complete and therefore should not -be called inside another transaction. Normally it's called as a separate -transaction after the data is successfully stored or retrieved. +This function commits its transaction when complete and therefore should +not be called inside another transaction. Normally it's called as a +separate transaction after the data is successfully stored or retrieved. =item log_set (FIELD, OLD, NEW, PRINCIPAL, HOSTNAME, DATETIME) -Updates the history tables for the change in a setting value for an object. -FIELD should be one of C, C, C, C, -C, C, C, C, or a value starting with -C followed by a space and a type-specific field name. The last -form is the most common form used by a subclass. OLD is the previous value -of the field or undef if the field was unset, and NEW is the new value of -the field or undef if the field should be unset. +Updates the history tables for the change in a setting value for an +object. FIELD should be one of C, C, C, +C, C, C, C, C, or a +value starting with C followed by a space and a type-specific +field name. The last form is the most common form used by a subclass. +OLD is the previous value of the field or undef if the field was unset, +and NEW is the new value of the field or undef if the field should be +unset. This function does not commit and does not catch database exceptions. It should normally be called as part of a larger transaction that implements @@ -922,8 +933,8 @@ the change in the setting. wallet-backend(8) -This module is part of the wallet system. The current version is available -from L. +This module is part of the wallet system. The current version is +available from L. =head1 AUTHOR diff --git a/perl/Wallet/Object/File.pm b/perl/Wallet/Object/File.pm index be72d7f..69262f6 100644 --- a/perl/Wallet/Object/File.pm +++ b/perl/Wallet/Object/File.pm @@ -1,7 +1,7 @@ # Wallet::Object::File -- File object implementation for the wallet. # # Written by Russ Allbery -# Copyright 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008, 2010 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -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.01'; +$VERSION = '0.02'; ############################################################################## # File naming @@ -136,6 +136,9 @@ __END__ Wallet::Object::File - File object implementation for wallet +=for stopwords +API HOSTNAME DATETIME keytab remctld backend nul Allbery wallet-backend + =head1 SYNOPSIS my @name = qw(file mysql-lsdb) @@ -163,17 +166,18 @@ set wallet configuration. =head1 METHODS This object mostly inherits from Wallet::Object::Base. See the -documentation for that class for all generic methods. Below are only those -methods that are overridden or behave specially for this implementation. +documentation for that class for all generic methods. Below are only +those methods that are overridden or behave specially for this +implementation. =over 4 =item destroy(PRINCIPAL, HOSTNAME [, DATETIME]) Destroys a file object by removing it from the database and deleting the -corresonding file on the wallet server. Returns true on success and false -on failure. The caller should call error() to get the error message after -a failure. PRINCIPAL, HOSTNAME, and DATETIME are stored as history +corresponding file on the wallet server. Returns true on success and +false on failure. The caller should call error() to get the error message +after a failure. PRINCIPAL, HOSTNAME, and DATETIME are stored as history information. PRINCIPAL should be the user who is destroying the object. If DATETIME isn't given, the current time is used. diff --git a/perl/Wallet/Object/Keytab.pm b/perl/Wallet/Object/Keytab.pm index b604907..760280f 100644 --- a/perl/Wallet/Object/Keytab.pm +++ b/perl/Wallet/Object/Keytab.pm @@ -382,6 +382,10 @@ __END__ # Documentation ############################################################################## +=for stopwords +keytab API KDC keytabs HOSTNAME DATETIME enctypes enctype DBH metadata +unmanaged kadmin Allbery + =head1 NAME Wallet::Object::Keytab - Keytab object implementation for wallet @@ -396,17 +400,17 @@ Wallet::Object::Keytab - Keytab object implementation for wallet =head1 DESCRIPTION -Wallet::Object::Keytab is a representation of Kerberos keytab objects in the -wallet. It implements the wallet object API and provides the necessary -glue to create principals in a Kerberos KDC, create and return keytabs for -those principals, and delete them out of Kerberos when the wallet object is -destroyed. +Wallet::Object::Keytab is a representation of Kerberos keytab objects in +the wallet. It implements the wallet object API and provides the +necessary glue to create principals in a Kerberos KDC, create and return +keytabs for those principals, and delete them out of Kerberos when the +wallet object is destroyed. A keytab is an on-disk store for the key or keys for a Kerberos principal. -Keytabs are used by services to verify incoming authentication from clients -or by automated processes that need to authenticate to Kerberos. To create -a keytab, the principal has to be created in Kerberos and then a keytab is -generated and stored in a file on disk. +Keytabs are used by services to verify incoming authentication from +clients or by automated processes that need to authenticate to Kerberos. +To create a keytab, the principal has to be created in Kerberos and then a +keytab is generated and stored in a file on disk. This implementation generates a new random key (and hence invalidates all existing keytabs) each time the keytab is retrieved with the get() method. @@ -418,8 +422,9 @@ information about how to set wallet configuration. =head1 METHODS This object mostly inherits from Wallet::Object::Base. See the -documentation for that class for all generic methods. Below are only those -methods that are overridden or behave specially for this implementation. +documentation for that class for all generic methods. Below are only +those methods that are overridden or behave specially for this +implementation. =over 4 @@ -453,12 +458,12 @@ enctypes than those requested by this attribute. If no other arguments besides ATTRIBUTE are given, returns the values of that attribute, if any, as a list. On error, returns the empty list. To -distinguish between an error and an empty return, call error() afterwards. +distinguish between an error and an empty return, call error() afterward. It is guaranteed to return undef unless there was an error. If other arguments are given, sets the given ATTRIBUTE values to VALUES, -which must be a reference to an array (even if only one value is being set). -Pass a reference to an empty array to clear the attribute values. +which must be a reference to an array (even if only one value is being +set). Pass a reference to an empty array to clear the attribute values. PRINCIPAL, HOSTNAME, and DATETIME are stored as history information. PRINCIPAL should be the user who is destroying the object. If DATETIME isn't given, the current time is used. @@ -467,12 +472,12 @@ isn't given, the current time is used. This is a class method and should be called on the Wallet::Object::Keytab class. It creates a new object with the given TYPE and NAME (TYPE is -normally C and must be for the rest of the wallet system to use the -right class, but this module doesn't check for ease of subclassing), using -DBH as the handle to the wallet metadata database. PRINCIPAL, HOSTNAME, and -DATETIME are stored as history information. PRINCIPAL should be the user -who is creating the object. If DATETIME isn't given, the current time is -used. +normally C and must be for the rest of the wallet system to use +the right class, but this module doesn't check for ease of subclassing), +using DBH as the handle to the wallet metadata database. PRINCIPAL, +HOSTNAME, and DATETIME are stored as history information. PRINCIPAL +should be the user who is creating the object. If DATETIME isn't given, +the current time is used. When a new keytab object is created, the Kerberos principal designated by NAME is also created in the Kerberos realm determined from the wallet @@ -515,9 +520,9 @@ used. =item KEYTAB_TMP/keytab. -The keytab is created in this file using C and then read into memory. -KEYTAB_TMP is set in the wallet configuration, and is the process ID -of the current process. The file is unlinked after being read. +The keytab is created in this file using C and then read into +memory. KEYTAB_TMP is set in the wallet configuration, and is the +process ID of the current process. The file is unlinked after being read. =back @@ -536,8 +541,8 @@ wallet database do not have realm information. kadmin(8), Wallet::Config(3), Wallet::Object::Base(3), wallet-backend(8) -This module is part of the wallet system. The current version is available -from L. +This module is part of the wallet system. The current version is +available from L. =head1 AUTHOR diff --git a/perl/Wallet/Schema.pm b/perl/Wallet/Schema.pm index 252da03..589a15d 100644 --- a/perl/Wallet/Schema.pm +++ b/perl/Wallet/Schema.pm @@ -133,6 +133,10 @@ __DATA__ Wallet::Schema - Database schema for the wallet system +=for stopwords +SQL ACL API APIs enums Enums Keytab Backend keytab backend enctypes +enctype Allbery + =head1 SYNOPSIS use Wallet::Schema; @@ -157,30 +161,30 @@ MySQL and may require some modifications for other databases. =item new() -Instantiates a new Wallet::Schema object. This parses the documentation and -extracts the schema, but otherwise doesn't do anything. +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. +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. +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. +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. =back @@ -188,8 +192,8 @@ database. =head2 Normalization Tables -The following are normalization tables used to constrain the values in other -tables. +The following are normalization tables used to constrain the values in +other tables. Holds the supported flag names: @@ -221,16 +225,16 @@ Holds the supported ACL schemes and their corresponding Perl classes: values ('netdb-root', 'Wallet::ACL::NetDB::Root'); If you have extended the wallet to support additional object types or -additional ACL schemes, you will want to add additional rows to these tables -mapping those types or schemes to Perl classes that implement the object or -ACL verifier APIs. +additional ACL schemes, you will want to add additional rows to these +tables mapping those types or schemes to Perl classes that implement the +object or ACL verifier APIs. =head2 ACL Tables -A wallet ACL consists of zero or more ACL entries, each of which is a scheme -and an identifier. The scheme identifies the check that should be performed -and the identifier is additional scheme-specific information. Each ACL -references entries in the following table: +A wallet ACL consists of zero or more ACL entries, each of which is a +scheme and an identifier. The scheme identifies the check that should be +performed and the identifier is additional scheme-specific information. +Each ACL references entries in the following table: create table acls (ac_id integer auto_increment primary key, @@ -249,8 +253,9 @@ in: create index ae_id on acl_entries (ae_id); ACLs may be referred to in the API via either the numeric ID or the -human-readable name, but internally ACLs are always referenced by numeric ID -so that they can be renamed without requiring complex data modifications. +human-readable name, but internally ACLs are always referenced by numeric +ID so that they can be renamed without requiring complex data +modifications. Currently, the ACL named C (case-sensitive) is special-cased in the Wallet::Server code and granted global access. @@ -269,17 +274,18 @@ table. ah_on datetime not null); create index ah_acl on acl_history (ah_acl); -ah_action must be one of C, C, C, or C (enums -aren't used for compatibility with databases other than MySQL). For a -change of type create or destroy, only the action and the trace records (by, -from, and on) are stored. For a change to the lines of an ACL, the scheme -and identifier of the line that was added or removed is included. Note that -changes to the ACL name are not recorded; ACLs are always tracked by -system-generated ID, so name changes are purely cosmetic. +ah_action must be one of C, C, C, or C +(enums aren't used for compatibility with databases other than MySQL). +For a change of type create or destroy, only the action and the trace +records (by, from, and on) are stored. For a change to the lines of an +ACL, the scheme and identifier of the line that was added or removed is +included. Note that changes to the ACL name are not recorded; ACLs are +always tracked by system-generated ID, so name changes are purely +cosmetic. -ah_by stores the authenticated identity that made the change, ah_from stores -the host from which they made the change, and ah_on stores the time the -change was made. +ah_by stores the authenticated identity that made the change, ah_from +stores the host from which they made the change, and ah_on stores the time +the change was made. =head2 Object Tables @@ -311,13 +317,13 @@ table: create index ob_expires on objects (ob_expires); Object names are not globally unique but only unique within their type, so -the table has a joint primary key. Each object has an owner and then up to -five more specific ACLs. The owner provides permission for get, store, and -show operations if no more specific ACL is set. It does not provide +the table has a joint primary key. Each object has an owner and then up +to five more specific ACLs. The owner provides permission for get, store, +and show operations if no more specific ACL is set. It does not provide permission for destroy or flags. -The ob_acl_flags ACL controls who can set flags on this object. Each object -may have zero or more flags associated with it: +The ob_acl_flags ACL controls who can set flags on this object. Each +object may have zero or more flags associated with it: create table flags (fl_type varchar(16) @@ -348,27 +354,28 @@ this table: oh_on datetime not null); create index oh_object on object_history (oh_type, oh_name); -oh_action must be one of C, C, C, C, or C. -oh_field must be one of C, C, C, C, -C, C, C, C, or C. Enums -aren't used for compatibility with databases other than MySQL. - -For a change of type create, get, store, or destroy, only the action and the -trace records (by, from, and on) are stored. For changes to columns or to -the flags table, oh_field takes what attribute is changed, oh_from takes the -previous value converted to a string and oh_to takes the next value -similarly converted to a string. The special field value "type_data" is -used when type-specific data is changed, and in that case (and only that -case) some type-specific name for the data being changed is stored in -oh_type_field. +oh_action must be one of C, C, C, C, or +C. oh_field must be one of C, C, C, +C, C, C, C, C, or +C. Enums aren't used for compatibility with databases other +than MySQL. + +For a change of type create, get, store, or destroy, only the action and +the trace records (by, from, and on) are stored. For changes to columns +or to the flags table, oh_field takes what attribute is changed, oh_from +takes the previous value converted to a string and oh_to takes the next +value similarly converted to a string. The special field value +"type_data" is used when type-specific data is changed, and in that case +(and only that case) some type-specific name for the data being changed is +stored in oh_type_field. When clearing a flag, oh_old will have the name of the flag and oh_new will be null. When setting a flag, oh_old will be null and oh_new will have the name of the flag. -oh_by stores the authenticated identity that made the change, oh_from stores -the host from which they made the change, and oh_on stores the time the -change was made. +oh_by stores the authenticated identity that made the change, oh_from +stores the host from which they made the change, and oh_on stores the time +the change was made. =head2 Keytab Backend Data @@ -406,16 +413,16 @@ and then the restrictions for a given keytab are stored in this table: primary key (ke_name, ke_enctype)); create index ke_name on keytab_enctypes (ke_name); -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. +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 SEE ALSO wallet-backend(8) -This module is part of the wallet system. The current version is available -from L. +This module is part of the wallet system. The current version is +available from L. =head1 AUTHOR diff --git a/perl/Wallet/Server.pm b/perl/Wallet/Server.pm index 40e48a3..dd596c4 100644 --- a/perl/Wallet/Server.pm +++ b/perl/Wallet/Server.pm @@ -1,7 +1,7 @@ # Wallet::Server -- Wallet system server implementation. # # Written by Russ Allbery -# Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2008, 2010 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -23,7 +23,7 @@ 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.07'; +$VERSION = '0.08'; ############################################################################## # Utility methods @@ -714,6 +714,10 @@ __END__ Wallet::Server - Wallet system server implementation +=for stopwords +keytabs metadata backend HOSTNAME ACL timestamp ACL's nul Allbery +backend-specific wallet-backend + =head1 SYNOPSIS use Wallet::Server; @@ -725,8 +729,8 @@ Wallet::Server - Wallet system server implementation Wallet::Server is the top-level class that implements the wallet server. The wallet is a system for storing, generating, and retrieving secure information such as Kerberos keytabs. The server maintains metadata about -the objects, checks access against ACLs, and dispatches requests for objects -to backend implementations for that object type. +the objects, checks access against ACLs, and dispatches requests for +objects to backend implementations for that object type. Wallet::Server is normally instantiated and used by B, a thin wrapper around this object that determines the authenticated remote @@ -734,8 +738,8 @@ user and gets user input and then calls the appropriate method of this 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). +the database configuration). For information on those variables and how +to set them, see Wallet::Config(3). =head1 CLASS METHODS @@ -765,11 +769,12 @@ failure to get the error message. Gets or sets the ACL type ACL to ID for the object identified by TYPE and NAME. ACL should be one of C, C, C, C, or -C. If ID is not given, returns the current setting of that ACL as a -numeric ACL ID or undef if that ACL isn't set or on failure. To distinguish -between an ACL that isn't set and a failure to retrieve the ACL, the caller -should call error() after an undef return. If error() also returns undef, -that ACL wasn't set; otherwise, error() will return the error message. +C. If ID is not given, returns the current setting of that ACL as +a numeric ACL ID or undef if that ACL isn't set or on failure. To +distinguish between an ACL that isn't set and a failure to retrieve the +ACL, the caller should call error() after an undef return. If error() +also returns undef, that ACL wasn't set; otherwise, error() will return +the error message. If ID is given, sets the specified ACL to ID, which can be either the name of an ACL or a numeric ACL ID. To set an ACL, the current user must be @@ -798,64 +803,65 @@ failure. Destroys the ACL identified by ID, which may be either the ACL name or its numeric ID. This call will fail if the ACL is still referenced by any -object. The ADMIN ACL may not be destroyed. To destroy an ACL, the current -user must be authorized by the ADMIN ACL. Returns true on success and false -on failure. +object. The ADMIN ACL may not be destroyed. To destroy an ACL, the +current user must be authorized by the ADMIN ACL. Returns true on success +and false on failure. =item acl_history(ID) -Returns the history of the ACL identified by ID, which may be either the ACL -name or its numeric ID. To see the history of an ACL, the current user must -be authorized by the ADMIN ACL. Each change that modifies the ACL (not -counting changes in the name of the ACL) will be represented by two lines. -The first line will have a timestamp of the change followed by a description -of the change, and the second line will give the user who made the change -and the host from which the change was made. Returns undef on failure. +Returns the history of the ACL identified by ID, which may be either the +ACL name or its numeric ID. To see the history of an ACL, the current +user must be authorized by the ADMIN ACL. Each change that modifies the +ACL (not counting changes in the name of the ACL) will be represented by +two lines. The first line will have a timestamp of the change followed by +a description of the change, and the second line will give the user who +made the change and the host from which the change was made. Returns +undef on failure. =item acl_remove(ID, SCHEME, IDENTIFIER) Removes from the ACL identified by ID the entry matching SCHEME and IDENTIFIER. ID may be either the name of the ACL or its numeric ID. The last entry in the ADMIN ACL cannot be removed. To remove an entry from an -ACL, the current user must be authorized by the ADMIN ACL. Returns true on -success and false on failure. +ACL, the current user must be authorized by the ADMIN ACL. Returns true +on success and false on failure. =item acl_rename(OLD, NEW) Renames the ACL identified by OLD to NEW. This changes the human-readable -name, not the underlying numeric ID, so the ACL's associations with objects -will be unchanged. The ADMIN ACL may not be renamed. OLD may be either the -current name or the numeric ID. NEW must not be all-numeric. To rename an -ACL, the current user must be authorized by the ADMIN ACL. Returns true on -success and false on failure. +name, not the underlying numeric ID, so the ACL's associations with +objects will be unchanged. The ADMIN ACL may not be renamed. OLD may be +either the current name or the numeric ID. NEW must not be all-numeric. +To rename an ACL, the current user must be authorized by the ADMIN ACL. +Returns true on success and false on failure. =item acl_show(ID) Returns a human-readable description, including membership, of the ACL identified by ID, which may be either the ACL name or its numeric ID. To -show an ACL, the current user must be authorized by the ADMIN ACL (although -be aware that anyone with show access to an object can see the membership of -ACLs associated with that object through the show() method). Returns the -human-readable description on success and undef on failure. +show an ACL, the current user must be authorized by the ADMIN ACL +(although be aware that anyone with show access to an object can see the +membership of ACLs associated with that object through the show() method). +Returns the human-readable description on success and undef on failure. =item attr(TYPE, NAME, ATTRIBUTE [, VALUE ...]) Sets or retrieves a given object attribute. Attributes are used to store -backend-specific information for a particular object type and ATTRIBUTE must -be an attribute type known to the underlying object implementation. +backend-specific information for a particular object type and ATTRIBUTE +must be an attribute type known to the underlying object implementation. If VALUE is not given, returns the values of that attribute, if any, as a list. On error, returns the empty list. To distinguish between an error -and an empty return, call error() afterwards. It is guaranteed to return -undef unless there was an error. To retrieve an attribute setting, the user -must be authorized by the ADMIN ACL, the show ACL if set, or the owner ACL -if the show ACL is not set. +and an empty return, call error() afterward. It is guaranteed to return +undef unless there was an error. To retrieve an attribute setting, the +user must be authorized by the ADMIN ACL, the show ACL if set, or the +owner ACL if the show ACL is not set. -If VALUE is given, sets the given ATTRIBUTE values to VALUE, which is one or -more attribute values. Pass the empty string as the only VALUE to clear the -attribute values. Returns true on success and false on failure. To set an -attribute value, the user must be authorized by the ADMIN ACL, the store ACL -if set, or the owner ACL if the store ACL is not set. +If VALUE is given, sets the given ATTRIBUTE values to VALUE, which is one +or more attribute values. Pass the empty string as the only VALUE to +clear the attribute values. Returns true on success and false on failure. +To set an attribute value, the user must be authorized by the ADMIN ACL, +the store ACL if set, or the owner ACL if the store ACL is not set. =item autocreate(TYPE, NAME) @@ -877,9 +883,9 @@ for the existence of the object. =item create(TYPE, NAME) -Creates a new object of type TYPE and name NAME. TYPE must be a recognized -type for which the wallet system has a backend implementation. Returns true -on success and false on failure. +Creates a new object of type TYPE and name NAME. TYPE must be a +recognized type for which the wallet system has a backend implementation. +Returns true on success and false on failure. To create an object using this method, the current user must be authorized by the ADMIN ACL. Use autocreate() to create objects based on the default @@ -888,18 +894,18 @@ owner as determined by the wallet configuration. =item destroy(TYPE, NAME) Destroys the object identified by TYPE and NAME. This destroys any data -that the wallet had saved about the object, may remove the underlying object -from other external systems, and destroys the wallet database entry for the -object. To destroy an object, the current user must be authorized by the -ADMIN ACL or the destroy ACL on the object; the owner ACL is not sufficient. -Returns true on success and false on failure. +that the wallet had saved about the object, may remove the underlying +object from other external systems, and destroys the wallet database entry +for the object. To destroy an object, the current user must be authorized +by the ADMIN ACL or the destroy ACL on the object; the owner ACL is not +sufficient. Returns true on success and false on failure. =item dbh() -Returns the database handle of a Wallet::Server object. This is used mostly -for testing; normally, clients should perform all actions through the -Wallet::Server object to ensure that authorization and history logging is -done properly. +Returns the database handle of a Wallet::Server object. This is used +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 error() @@ -909,12 +915,12 @@ after an undef return from any other instance method. =item expires(TYPE, NAME [, EXPIRES]) -Gets or sets the expiration for the object identified by TYPE and NAME. If -EXPIRES is not given, returns the current expiration or undef if no -expiration is set or on an error. To distinguish between an expiration that -isn't set and a failure to retrieve the expiration, the caller should call -error() after an undef return. If error() also returns undef, that ACL -wasn't set; otherwise, error() will return the error message. +Gets or sets the expiration for the object identified by TYPE and NAME. +If EXPIRES is not given, returns the current expiration or undef if no +expiration is set or on an error. To distinguish between an expiration +that isn't set and a failure to retrieve the expiration, the caller should +call error() after an undef return. If error() also returns undef, that +ACL wasn't set; otherwise, error() will return the error message. If EXPIRES is given, sets the expiration to EXPIRES. EXPIRES must be in the format C, although the time portion may be @@ -924,23 +930,23 @@ ADMIN ACL. Returns true for success and false for failure. =item flag_clear(TYPE, NAME, FLAG) -Clears the flag FLAG on the object identified by TYPE and NAME. To clear a -flag, the current user must be authorized by the ADMIN ACL or the flags ACL -on the object. +Clears the flag FLAG on the object identified by TYPE and NAME. To clear +a flag, the current user must be authorized by the ADMIN ACL or the flags +ACL on the object. =item flag_set(TYPE, NAME, FLAG) Sets the flag FLAG on the object identified by TYPE and NAME. To set a -flag, the current user must be authorized by the ADMIN ACL or the flags ACL -on the object. +flag, the current user must be authorized by the ADMIN ACL or the flags +ACL on the object. =item get(TYPE, NAME) Returns the data associated with the object identified by TYPE and NAME. -Depending on the object TYPE, this may generate new data and invalidate any -existing data or it may return data previously stored or generated. Note -that this data may be binary and may contain nul characters. To get an -object, the current user must either be authorized by the owner ACL or +Depending on the object TYPE, this may generate new data and invalidate +any existing data or it may return data previously stored or generated. +Note that this data may be binary and may contain nul characters. To get +an object, the current user must either be authorized by the owner ACL or authorized by the get ACL; however, if the get ACL is set, the owner ACL will not be checked. Being a member of the ADMIN ACL does not provide any special privileges to get objects. @@ -950,48 +956,49 @@ between undef and the empty string, which is valid object data. =item history(TYPE, NAME) -Returns (as a string) the human-readable history of the object identified by -TYPE and NAME, or undef on error. To see the object history, the current -user must be a member of the ADMIN ACL, authorized by the show ACL, or -authorized by the owner ACL; however, if the show ACL is set, the owner ACL -will not be checked. +Returns (as a string) the human-readable history of the object identified +by TYPE and NAME, or undef on error. To see the object history, the +current user must be a member of the ADMIN ACL, authorized by the show +ACL, or authorized by the owner ACL; however, if the show ACL is set, the +owner ACL will not be checked. =item owner(TYPE, NAME [, OWNER]) -Gets or sets the owner for the object identified by TYPE and NAME. If OWNER -is not given, returns the current owner as a numeric ACL ID or undef if no -owner is set or on an error. To distinguish between an owner that isn't set -and a failure to retrieve the owner, the caller should call error() after an -undef return. If error() also returns undef, that ACL wasn't set; -otherwise, error() will return the error message. +Gets or sets the owner for the object identified by TYPE and NAME. If +OWNER is not given, returns the current owner as a numeric ACL ID or undef +if no owner is set or on an error. To distinguish between an owner that +isn't set and a failure to retrieve the owner, the caller should call +error() after an undef return. If error() also returns undef, that ACL +wasn't set; otherwise, error() will return the error message. -If OWNER is given, sets the owner to OWNER, which may be either the name of -an ACL or a numeric ACL ID. To set an owner, the current user must be +If OWNER is given, sets the owner to OWNER, which may be either the name +of an ACL or a numeric ACL ID. To set an owner, the current user must be authorized by the ADMIN ACL. Returns true for success and false for failure. -The owner of an object is permitted to get, store, and show that object, but -cannot destroy or set flags on that object without being listed on those -ACLs as well. +The owner of an object is permitted to get, store, and show that object, +but cannot destroy or set flags on that object without being listed on +those ACLs as well. =item show(TYPE, NAME) -Returns (as a string) a human-readable representation of the metadata stored -for the object identified by TYPE and NAME, or undef on error. Included is -the metadata and entries of any ACLs associated with the object. To show an -object, the current user must be a member of the ADMIN ACL, authorized by -the show ACL, or authorized by the owner ACL; however, if the show ACL is -set, the owner ACL will not be checked. +Returns (as a string) a human-readable representation of the metadata +stored for the object identified by TYPE and NAME, or undef on error. +Included is the metadata and entries of any ACLs associated with the +object. To show an object, the current user must be a member of the ADMIN +ACL, authorized by the show ACL, or authorized by the owner ACL; however, +if the show ACL is set, the owner ACL will not be checked. =item store(TYPE, NAME, DATA) -Stores DATA for the object identified with TYPE and NAME for later retrieval -with get. Not all object types support this. Note that DATA may be binary -and may contain nul characters. To store an object, the current user must -either be authorized by the owner ACL or authorized by the store ACL; -however, if the store ACL is set, the owner ACL is not checked. Being a -member of the ADMIN ACL does not provide any special privileges to store -objects. Returns true on success and false on failure. +Stores DATA for the object identified with TYPE and NAME for later +retrieval with get. Not all object types support this. Note that DATA +may be binary and may contain nul characters. To store an object, the +current user must either be authorized by the owner ACL or authorized by +the store ACL; however, if the store ACL is set, the owner ACL is not +checked. Being a member of the ADMIN ACL does not provide any special +privileges to store objects. Returns true on success and false on +failure. =back @@ -999,8 +1006,8 @@ objects. Returns true on success and false on failure. wallet-backend(8) -This module is part of the wallet system. The current version is available -from L. +This module is part of the wallet system. The current version is +available from L. =head1 AUTHOR diff --git a/perl/t/pod-spelling.t b/perl/t/pod-spelling.t new file mode 100755 index 0000000..d3ab858 --- /dev/null +++ b/perl/t/pod-spelling.t @@ -0,0 +1,75 @@ +#!/usr/bin/perl -w +# +# Check for spelling errors in POD documentation +# +# Checks all POD files in the tree for spelling problems using Pod::Spell and +# either aspell or ispell. aspell is preferred. This test is disabled unless +# RRA_MAINTAINER_TESTS is set, since spelling dictionaries vary too much +# between environments. +# +# Copyright 2008, 2009 Russ Allbery +# +# This program is free software; you may redistribute it and/or modify it +# under the same terms as Perl itself. + +use strict; +use Test::More; + +# Skip all spelling tests unless the maintainer environment variable is set. +plan skip_all => 'Spelling tests only run for maintainer' + unless $ENV{RRA_MAINTAINER_TESTS}; + +# Load required Perl modules. +eval 'use Test::Pod 1.00'; +plan skip_all => 'Test::Pod 1.00 required for testing POD' if $@; +eval 'use Pod::Spell'; +plan skip_all => 'Pod::Spell required to test POD spelling' if $@; + +# Locate a spell-checker. hunspell is not currently supported due to its lack +# of support for contractions (at least in the version in Debian). +my @spell; +my %options = (aspell => [ qw(-d en_US --home-dir=./ list) ], + ispell => [ qw(-d american -l -p /dev/null) ]); +SEARCH: for my $program (qw/aspell ispell/) { + for my $dir (split ':', $ENV{PATH}) { + if (-x "$dir/$program") { + @spell = ("$dir/$program", @{ $options{$program} }); + } + last SEARCH if @spell; + } +} +plan skip_all => 'aspell or ispell required to test POD spelling' + unless @spell; + +# Prerequisites are satisfied, so we're going to do some testing. Figure out +# what POD files we have and from that develop our plan. +$| = 1; +my @pod = all_pod_files (); +plan tests => scalar @pod; + +# Finally, do the checks. +for my $pod (@pod) { + my $child = open (CHILD, '-|'); + if (not defined $child) { + die "Cannot fork: $!\n"; + } elsif ($child == 0) { + my $pid = open (SPELL, '|-', @spell) or die "Cannot run @spell: $!\n"; + open (POD, '<', $pod) or die "Cannot open $pod: $!\n"; + my $parser = Pod::Spell->new; + $parser->parse_from_filehandle (\*POD, \*SPELL); + close POD; + close SPELL; + exit ($? >> 8); + } else { + my @words = ; + close CHILD; + SKIP: { + skip "@spell failed for $pod", 1 unless $? == 0; + for (@words) { + s/^\s+//; + s/\s+$//; + } + is ("@words", '', $pod); + } + } +} diff --git a/perl/t/pod.t b/perl/t/pod.t index e9aa0a8..c467b82 100755 --- a/perl/t/pod.t +++ b/perl/t/pod.t @@ -1,16 +1,14 @@ -#!/usr/bin/perl +#!/usr/bin/perl -w # -# t/pod.t -- Test POD formatting for the wallet Perl modules. +# Test POD formatting for the wallet Perl modules. # # Written by Russ Allbery -# Copyright 2007 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2010 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. +use strict; +use Test::More; eval 'use Test::Pod 1.00'; -if ($@) { - print "1..1\n"; - print "ok 1 # skip - Test::Pod 1.00 required for testing POD\n"; - exit; -} +plan skip_all => 'Test::Pod 1.00 required for testing POD' if $@; all_pod_files_ok (); -- cgit v1.2.3 From 74ed6945f9c7839603764327f0187897525db453 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Mon, 20 Jun 2011 16:15:35 -0700 Subject: Add a comment field to objects Add a comment field to objects and corresponding commands to wallet-backend and wallet to set and retrieve it. The comment field can only be set by the owner or wallet administrators but can be seen by anyone on the show ACL. --- NEWS | 5 ++++ TODO | 2 -- client/wallet.pod | 25 ++++++++++++++------ perl/Wallet/Object/Base.pm | 39 +++++++++++++++++++++++++++++-- perl/Wallet/Schema.pm | 5 +++- perl/Wallet/Server.pm | 53 +++++++++++++++++++++++++++++++++++------- perl/t/object.t | 32 +++++++++++++++++++++++-- perl/t/schema.t | 31 +++++++++++++++++++++---- perl/t/server.t | 58 +++++++++++++++++++++++++++++++++++++++++++--- server/wallet-backend | 45 +++++++++++++++++++++++++++-------- tests/server/backend-t | 32 +++++++++++++++++++------ 11 files changed, 280 insertions(+), 47 deletions(-) (limited to 'perl/Wallet/Object/Base.pm') diff --git a/NEWS b/NEWS index 9e2fa3b..42fb3e7 100644 --- a/NEWS +++ b/NEWS @@ -6,6 +6,11 @@ wallet 1.0 (unreleased) database to the latest schema version. This command should be run when deploying any new version of the wallet server. + Add a comment field to objects and corresponding commands to + wallet-backend and wallet to set and retrieve it. The comment field + can only be set by the owner or wallet administrators but can be seen + by anyone on the show ACL. + wallet 0.12 (2010-08-25) New client program wallet-rekey that, given a list of keytabs on the diff --git a/TODO b/TODO index 361d242..0323cc9 100644 --- a/TODO +++ b/TODO @@ -45,8 +45,6 @@ Server Interface: * Support limiting returned history information by timestamp. - * Add a comment field for objects that can be set by the owner. - * Provide a REST implementation of the wallet server. * Provide a CGI implementation of the wallet server. diff --git a/client/wallet.pod b/client/wallet.pod index 45969b2..fdfe37f 100644 --- a/client/wallet.pod +++ b/client/wallet.pod @@ -154,11 +154,13 @@ As mentioned above, most commands are only available to wallet administrators. The exceptions are C, C, C, C, C, C, C, C, and C. All of those commands have their own ACLs except C and C, -which use the C ACL, and C, which uses the C ACL. -If the appropriate ACL is set, it alone is checked to see if the user has -access. Otherwise, C, C, C, C, C, and -C access is permitted if the user is authorized by the owner ACL -of the object. +which use the C ACL, C, which uses the C ACL, and +C, which uses the owner or C ACL depending on whether one +is setting or retrieving the comment. If the appropriate ACL is set, it +alone is checked to see if the user has access. Otherwise, C, +C, C, C, C, C, and C +access is permitted if the user is authorized by the owner ACL of the +object. Administrators can run any command on any object or ACL except for C and C. For C and C, they must still be authorized by @@ -167,8 +169,8 @@ either the appropriate specific ACL or the owner ACL. If the locked flag is set on an object, no commands can be run on that object that change data except the C commands, nor can the C command be used on that object. C, C, C, -C, and C or C without an argument can still be -used on that object. +C, and C, C, or C without an argument +can still be used on that object. For more information on attributes, see L. @@ -238,6 +240,15 @@ already exist. Check whether an object of type and name already exists. If it does, prints C; if not, prints C. +=item comment [] + +If is not given, displays the current comment for the object +identified by and , or C if none is set. + +If is given, sets the comment on the object identified by + and to . If is the empty string, clears +the comment. + =item create Create a new object of type with name . With some backends, diff --git a/perl/Wallet/Object/Base.pm b/perl/Wallet/Object/Base.pm index 5097729..28ec6b9 100644 --- a/perl/Wallet/Object/Base.pm +++ b/perl/Wallet/Object/Base.pm @@ -1,7 +1,8 @@ # Wallet::Object::Base -- Parent class for any object stored in the wallet. # # Written by Russ Allbery -# Copyright 2007, 2008, 2010 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2008, 2010, 2011 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -17,6 +18,7 @@ use vars qw($VERSION); use DBI; use POSIX qw(strftime); +use Text::Wrap qw(wrap); use Wallet::ACL; # This version should be increased on any code change to this module. Always @@ -169,7 +171,7 @@ sub log_set { } my %fields = map { $_ => 1 } qw(owner acl_get acl_store acl_show acl_destroy acl_flags expires - flags type_data); + comment flags type_data); unless ($fields{$field}) { die "invalid history field $field"; } @@ -291,6 +293,19 @@ sub attr_show { return ''; } +# Get or set the comment value of an object. If setting it, trace information +# must also be provided. +sub comment { + my ($self, $comment, $user, $host, $time) = @_; + if ($comment) { + return $self->_set_internal ('comment', $comment, $user, $host, $time); + } elsif (defined $comment) { + return $self->_set_internal ('comment', undef, $user, $host, $time); + } else { + return $self->_get_internal ('comment'); + } +} + # Get or set the expires value of an object. Expects an expiration time in # seconds since epoch. If setting the expiration, trace information must also # be provided. @@ -565,6 +580,7 @@ sub show { [ ob_acl_destroy => 'Destroy ACL' ], [ ob_acl_flags => 'Flags ACL' ], [ ob_expires => 'Expires' ], + [ ob_comment => 'Comment' ], [ ob_created_by => 'Created by' ], [ ob_created_from => 'Created from' ], [ ob_created_on => 'Created on' ], @@ -592,7 +608,14 @@ 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) { + if ($attrs[$i][0] eq 'ob_comment' && length ($data[$i]) > 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}//; + } if ($attrs[$i][0] eq 'ob_created_by') { my @flags = $self->flag_list; if (not @flags and $self->error) { @@ -778,6 +801,18 @@ attributes set, this method should return that metadata, formatted as key: value pairs with the keys right-aligned in the first 15 characters, followed by a space, a colon, and the value. +=item comment([COMMENT, PRINCIPAL, HOSTNAME [, DATETIME]]) + +Sets or retrieves the comment associated with an object. If no arguments +are given, returns the current comment or undef if no comment is set. If +arguments are given, change the comment to COMMENT and return true on +success and false on failure. Pass in the empty string for COMMENT to +clear the comment. + +The other arguments are used for logging and history and should indicate +the user and host from which the change is made and the time of the +change. + =item destroy(PRINCIPAL, HOSTNAME [, DATETIME]) Destroys the object by removing all record of it from the database. The diff --git a/perl/Wallet/Schema.pm b/perl/Wallet/Schema.pm index 0f6c53f..7400776 100644 --- a/perl/Wallet/Schema.pm +++ b/perl/Wallet/Schema.pm @@ -145,7 +145,9 @@ sub upgrade { return; } elsif ($version == 0) { @sql = ('create table metadata (md_version integer)', - 'insert into metadata (md_version) values (1)'); + 'insert into metadata (md_version) values (1)', + 'alter table objects add ob_comment varchar(255) default null' + ); } else { die "unknown database version $version\n"; } @@ -367,6 +369,7 @@ table: ob_downloaded_by varchar(255) default null, ob_downloaded_from varchar(255) default null, ob_downloaded_on datetime default null, + ob_comment varchar(255) default null, primary key (ob_name, ob_type)); create index ob_owner on objects (ob_owner); create index ob_expires on objects (ob_expires); diff --git a/perl/Wallet/Server.pm b/perl/Wallet/Server.pm index 185bf23..7b3fb8f 100644 --- a/perl/Wallet/Server.pm +++ b/perl/Wallet/Server.pm @@ -1,7 +1,8 @@ # Wallet::Server -- Wallet system server implementation. # # Written by Russ Allbery -# Copyright 2007, 2008, 2010 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2008, 2010, 2011 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -23,7 +24,7 @@ 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.09'; +$VERSION = '0.10'; ############################################################################## # Utility methods @@ -276,7 +277,9 @@ sub object_error { # set the ACL accordingly. sub acl_check { my ($self, $object, $action) = @_; - unless ($action =~ /^(get|store|show|destroy|flags|setattr|getattr)\z/) { + my %actions = map { $_ => 1 } + qw(get store show destroy flags setattr getattr comment); + unless ($actions{$action}) { $self->error ("unknown action $action"); return; } @@ -288,10 +291,10 @@ sub acl_check { $id = $object->acl ('show'); } elsif ($action eq 'setattr') { $id = $object->acl ('store'); - } else { + } elsif ($action ne 'comment') { $id = $object->acl ($action); } - if (! defined ($id) and $action =~ /^(get|(get|set)attr|store|show)\z/) { + if (! defined ($id) and $action ne 'flags' and $action ne 'destroy') { $id = $object->owner; } unless (defined $id) { @@ -365,6 +368,26 @@ sub attr { } } +# Retrieves or sets the comment of an object. +sub comment { + my ($self, $type, $name, $comment) = @_; + undef $self->{error}; + my $object = $self->retrieve ($type, $name); + return unless defined $object; + my $result; + if (defined $comment) { + return unless $self->acl_check ($object, 'comment'); + $result = $object->comment ($comment, $self->{user}, $self->{host}); + } else { + return unless $self->acl_check ($object, 'show'); + $result = $object->comment; + } + if (not defined ($result) and $object->error) { + $self->error ($object->error); + } + return $result; +} + # Retrieves or sets the expiration of an object. sub expires { my ($self, $type, $name, $expires) = @_; @@ -895,6 +918,20 @@ Check whether an object of type TYPE and name NAME exists. Returns 1 if it does, 0 if it doesn't, and undef if some error occurred while checking for the existence of the object. +=item comment(TYPE, NAME, [COMMENT]) + +Gets or sets the comment for the object identified by TYPE and NAME. If +COMMENT is not given, returns the current comment or undef if no comment +is set or on an error. To distinguish between an expiration that isn't +set and a failure to retrieve the expiration, the caller should call +error() after an undef return. If error() also returns undef, no comment +was set; otherwise, error() will return the error message. + +If COMMENT is given, sets the comment to COMMENT. Pass in the empty +string for COMMENT to clear the comment. To set a comment, the current +user must be the object owner or be on the ADMIN ACL. Returns true for +success and false for failure. + =item create(TYPE, NAME) Creates a new object of type TYPE and name NAME. TYPE must be a @@ -933,12 +970,12 @@ Gets or sets the expiration for the object identified by TYPE and NAME. If EXPIRES is not given, returns the current expiration or undef if no expiration is set or on an error. To distinguish between an expiration that isn't set and a failure to retrieve the expiration, the caller should -call error() after an undef return. If error() also returns undef, that -ACL wasn't set; otherwise, error() will return the error message. +call error() after an undef return. If error() also returns undef, the +expiration wasn't set; otherwise, error() will return the error message. If EXPIRES is given, sets the expiration to EXPIRES. EXPIRES must be in the format C, although the time portion may be -omitted. Pass in the empty +string for EXPIRES to clear the expiration +omitted. Pass in the empty string for EXPIRES to clear the expiration date. To set an expiration, the current user must be authorized by the ADMIN ACL. Returns true for success and false for failure. diff --git a/perl/t/object.t b/perl/t/object.t index 3949786..2d60dd2 100755 --- a/perl/t/object.t +++ b/perl/t/object.t @@ -3,12 +3,13 @@ # Tests for the basic object implementation. # # Written by Russ Allbery -# Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2008, 2011 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. use POSIX qw(strftime); -use Test::More tests => 131; +use Test::More tests => 137; use Wallet::ACL; use Wallet::Admin; @@ -99,6 +100,23 @@ if ($object->expires ('', @trace)) { is ($object->expires, undef, ' at which point it is cleared'); is ($object->expires ($now, @trace), 1, ' and setting it again works'); +# Comment. +is ($object->comment, undef, 'Comment is not set to start'); +if ($object->comment ('this is a comment', @trace)) { + ok (1, ' and setting it works'); +} else { + is ($object->error, '', ' and setting it works'); +} +is ($object->comment, 'this is a comment', ' at which point it matches'); +if ($object->comment ('', @trace)) { + ok (1, ' and clearing it works'); +} else { + is ($object->error, '', ' and clearing it works'); +} +is ($object->comment, undef, ' at which point it is cleared'); +is ($object->comment (join (' ', ('this is a comment') x 5), @trace), 1, + ' and setting it again works'); + # ACLs. for my $type (qw/get store show destroy flags/) { is ($object->acl ($type), undef, "ACL $type is not set to start"); @@ -203,6 +221,8 @@ my $output = <<"EOO"; Destroy ACL: ADMIN Flags ACL: ADMIN Expires: $now + Comment: this is a comment this is a comment this is a comment this is + a comment this is a comment Flags: unchanging Created by: $user Created from: $host @@ -223,6 +243,8 @@ $output = <<"EOO"; Destroy ACL: ADMIN Flags ACL: ADMIN Expires: $now + Comment: this is a comment this is a comment this is a comment this is + a comment this is a comment Flags: locked unchanging Created by: $user Created from: $host @@ -267,6 +289,12 @@ $date unset expires (was $now) by $user from $host $date set expires to $now by $user from $host +$date set comment to this is a comment + by $user from $host +$date unset comment (was this is a comment) + by $user from $host +$date set comment to this is a comment this is a comment this is a comment this is a comment this is a comment + by $user from $host $date set acl_get to ADMIN (1) by $user from $host $date unset acl_get (was ADMIN (1)) diff --git a/perl/t/schema.t b/perl/t/schema.t index c66ad59..ce8a62a 100755 --- a/perl/t/schema.t +++ b/perl/t/schema.t @@ -8,11 +8,12 @@ # # See LICENSE for licensing terms. -use Test::More tests => 15; +use Test::More tests => 16; -use DBI; -use Wallet::Config; -use Wallet::Schema; +use DBI (); +use POSIX qw(strftime); +use Wallet::Config (); +use Wallet::Schema (); use lib 't/lib'; use Util; @@ -45,14 +46,34 @@ 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. +# 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) }; diff --git a/perl/t/server.t b/perl/t/server.t index ed92d6e..ad16151 100755 --- a/perl/t/server.t +++ b/perl/t/server.t @@ -3,11 +3,12 @@ # Tests for the wallet server API. # # Written by Russ Allbery -# Copyright 2007, 2008, 2010 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2008, 2010, 2011 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. -use Test::More tests => 355; +use Test::More tests => 377; use POSIX qw(strftime); use Wallet::Admin; @@ -199,6 +200,24 @@ is ($server->check ('base', 'service/test'), 0, is ($server->destroy ('base', 'service/test'), undef, ' but not twice'); is ($server->error, 'cannot find base:service/test', ' with the right error'); +# Test manipulating comments. +is ($server->comment ('base', 'service/test'), undef, + 'Retrieving comment on an unknown object fails'); +is ($server->error, 'cannot find base:service/test', ' with the right error'); +is ($server->comment ('base', 'service/test', 'this is a comment'), undef, + ' and setting it also fails'); +is ($server->error, 'cannot find base:service/test', ' with the right error'); +is ($server->comment ('base', 'service/admin'), undef, + 'Retrieving comment for the right object returns undef'); +is ($server->error, undef, ' but there is no error'); +is ($server->comment ('base', 'service/admin', 'this is a comment'), 1, + ' and we can set it'); +is ($server->comment ('base', 'service/admin'), 'this is a comment', + ' and get the value back'); +is ($server->comment ('base', 'service/admin', ''), 1, ' and clear it'); +is ($server->comment ('base', 'service/admin'), undef, ' and now it is gone'); +is ($server->error, undef, ' and still no error'); + # Test manipulating expires. my $now = strftime ('%Y-%m-%d %T', localtime time); is ($server->expires ('base', 'service/test'), undef, @@ -393,6 +412,10 @@ is ($server->flag_clear ('base', 'service/admin', 'unchanging'), 1, $history = <<"EOO"; DATE create by $admin from $host +DATE set comment to this is a comment + by $admin from $host +DATE unset comment (was this is a comment) + by $admin from $host DATE set expires to $now by $admin from $host DATE unset expires (was $now) @@ -510,12 +533,15 @@ is ($server->store ('base', 'service/user1', 'stuff'), undef, is ($server->error, "cannot store base:service/user1: object type is immutable", ' and the method is called'); +is ($server->comment ('base', 'service/user1', 'this is a comment'), 1, + ' and set a comment'); $show = $server->show ('base', 'service/user1'); $show =~ s/(Created on:) [\d-]+ [\d:]+$/$1 0/m; $expected = <<"EOO"; Type: base Name: service/user1 Owner: user1 + Comment: this is a comment Created by: $admin Created from: $host Created on: 0 @@ -529,6 +555,8 @@ DATE create by $admin from $host DATE set owner to user1 (2) by $admin from $host +DATE set comment to this is a comment + by $user1 from $host EOO $seen = $server->history ('base', 'service/user1'); $seen =~ s/^\d{4}-\d\d-\d\d \d\d:\d\d:\d\d/DATE/gm; @@ -566,6 +594,11 @@ is ($server->attr ('base', 'service/user2', 'foo', ''), undef, is ($server->error, "$user1 not authorized to set attributes for base:service/user2", ' with the right error'); +is ($server->comment ('base', 'service/user2', 'this is a comment'), undef, + ' and set comment'); +is ($server->error, + "$user1 not authorized to set comment for base:service/user2", + ' with the right error'); # And only some things on an object we own with some ACLs. $result = eval { $server->get ('base', 'service/both') }; @@ -702,8 +735,27 @@ is ($server->history ('base', 'service/user1'), undef, ' or see history for it'); is ($server->error, "$user2 not authorized to show base:service/user1", ' with the right error'); +is ($server->comment ('base', 'service/user1', 'this is a comment'), undef, + ' or set a comment for it'); +is ($server->error, + "$user2 not authorized to set comment for base:service/user1", + ' with the right error'); -# And only some things on an object we own with some ACLs. +# Test that setting a comment is controlled by the owner but retrieving it is +# controlled by the show ACL. +$result = eval { $server->get ('base', 'service/both') }; +is ($result, undef, 'We can get an object we jointly own'); +is ($@, "Do not instantiate Wallet::Object::Base directly\n", + ' and the method is called'); +is ($server->comment ('base', 'service/both', 'this is a comment'), 1, + ' and can set a comment on it'); +is ($server->error, undef, ' with no error'); +is ($server->comment ('base', 'service/both'), undef, + ' but cannot see the comment on it'); +is ($server->error, "$user2 not authorized to show base:service/both", + ' with the right error'); + +# And can only do some things on an object we own with some ACLs. $result = eval { $server->get ('base', 'service/both') }; is ($result, undef, 'We can get an object we jointly own'); is ($@, "Do not instantiate Wallet::Object::Base directly\n", diff --git a/server/wallet-backend b/server/wallet-backend index 52e9857..9850c0e 100755 --- a/server/wallet-backend +++ b/server/wallet-backend @@ -3,7 +3,8 @@ # wallet-backend -- Wallet server for storing and retrieving secure data. # # Written by Russ Allbery -# Copyright 2007, 2008, 2010 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2008, 2010, 2011 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -191,6 +192,20 @@ sub command { } else { print $status ? "yes\n" : "no\n"; } + } elsif ($command eq 'comment') { + check_args (2, 3, [], @args); + if (@args > 2) { + $server->comment (@args) or failure ($server->error, @_); + } else { + my $output = $server->comment (@args); + if (defined $output) { + print $output, "\n"; + } elsif (not $server->error) { + print "No comment set\n"; + } else { + failure ($server->error, @_); + } + } } elsif ($command eq 'create') { check_args (2, 2, [], @args); $server->create (@args) or failure ($server->error, @_); @@ -364,13 +379,14 @@ Most commands are only available to wallet administrators (users on the C ACL). The exceptions are C, C, C, C, C, C, C, C, C, and C. All of those commands have their own ACLs except -C and C, which use the C ACL, and C, -which uses the C ACL. If the appropriate ACL is set, it alone is -checked to see if the user has access. Otherwise, C, C, -C, C, C, and C access is permitted if the -user is authorized by the owner ACL of the object. C is -permitted if the user is listed in the default ACL for an object for that -name. +C and C, which use the C ACL, C, which +uses the C ACL, and C, which uses the owner or C +ACL depending on whether one is setting or retrieving the comment. If the +appropriate ACL is set, it alone is checked to see if the user has access. +Otherwise, C, C, C, C, C, C, +and C access is permitted if the user is authorized by the owner +ACL of the object. C is permitted if the user is listed in +the default ACL for an object for that name. Administrators can run any command on any object or ACL except for C and C. For C and C, they must still be authorized by @@ -379,8 +395,8 @@ either the appropriate specific ACL or the owner ACL. If the locked flag is set on an object, no commands can be run on that object that change data except the C commands, nor can the C command be used on that object. C, C, C, -C, and C or C without an argument can still be -used on that object. +C, and C, C, or C without an argument +can still be used on that object. For more information on attributes, see L. @@ -437,6 +453,15 @@ object will be created with that default ACL set as the object owner. Check whether an object of type and name already exists. If it does, prints C; if not, prints C. +=item comment [] + +If is not given, displays the current comment for the object +identified by and , or C if none is set. + +If is given, sets the comment on the object identified by + and to . If is the empty string, clears +the comment. + =item create Create a new object of type with name . With some backends, diff --git a/tests/server/backend-t b/tests/server/backend-t index a618391..3e377a1 100755 --- a/tests/server/backend-t +++ b/tests/server/backend-t @@ -3,13 +3,13 @@ # Tests for the wallet-backend dispatch code. # # Written by Russ Allbery -# Copyright 2006, 2007, 2008, 2009, 2010 -# Board of Trustees, Leland Stanford Jr. University +# Copyright 2006, 2007, 2008, 2009, 2010, 2011 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. use strict; -use Test::More tests => 1269; +use Test::More tests => 1296; # Create a dummy class for Wallet::Server that prints what method was called # with its arguments and returns data for testing. @@ -110,6 +110,19 @@ sub check { } } +sub comment { + shift; + print "comment @_\n"; + if ($_[0] eq 'error') { + return; + } elsif ($_[1] eq 'empty') { + $okay = 1; + return; + } else { + return 'comment'; + } +} + sub expires { shift; print "expires @_\n"; @@ -216,6 +229,7 @@ is ($out, "$new\n", ' and nothing ran'); # Check too few, too many, and bad arguments for every command. my %commands = (autocreate => [2, 2], check => [2, 2], + comment => [2, 3], create => [2, 2], destroy => [2, 2], expires => [2, 4], @@ -363,7 +377,8 @@ for my $command (qw/autocreate create destroy setacl setattr store/) { ' and ran the right method'); $error++; } -for my $command (qw/check expires get getacl getattr history owner show/) { +for my $command (qw/check comment expires get getacl getattr history owner + show/) { my $method = { getacl => 'acl', getattr => 'attr' }->{$command}; $method ||= $command; my @extra = ('foo') x ($commands{$command}[0] - 2); @@ -384,7 +399,8 @@ for my $command (qw/check expires get getacl getattr history owner show/) { is ($out, "$new\n$method type name$extra\n$method$newline", ' and ran the right method with output'); } - if ($command eq 'expires' or $command eq 'owner') { + if ($command eq 'expires' or $command eq 'owner' + or $command eq 'comment') { ($out, $err) = run_backend ($command, 'type', 'name', @extra, 'foo'); my $ran = "$command type name" . (@extra ? " @extra" : '') . ' foo'; is ($err, '', "Command $command ran with no errors (setting)"); @@ -393,14 +409,16 @@ for my $command (qw/check expires get getacl getattr history owner show/) { is ($out, "$new\n$method type name$extra foo\n", ' and ran the right method'); } - if ($command eq 'expires' or $command eq 'getacl' or $command eq 'owner') { + if ($command eq 'expires' or $command eq 'getacl' + or $command eq 'owner' or $command eq 'comment') { ($out, $err) = run_backend ($command, 'type', 'empty', @extra); my $ran = "$command type empty" . (@extra ? " @extra" : ''); is ($err, '', "Command $command ran with no errors (empty)"); is ($OUTPUT, "command $ran from admin (1.2.3.4) succeeded\n", ' and success logged'); my $desc; - if ($command eq 'expires') { $desc = 'expiration' } + if ($command eq 'comment') { $desc = 'comment' } + elsif ($command eq 'expires') { $desc = 'expiration' } elsif ($command eq 'getacl') { $desc = 'ACL' } elsif ($command eq 'owner') { $desc = 'owner' } is ($out, "$new\n$method type empty$extra\nNo $desc set\n", -- cgit v1.2.3 From 0d6c9d3b1c0d63fb22588e0e461912a7e00bec25 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Thu, 30 Aug 2012 14:47:15 -0700 Subject: In show, handle undefined columns Some database drivers, such as current SQLite, will return undef for a data column that is set to NULL instead of the empty string. Skip past those data columns without attempting to examine the length of the resulting data. --- perl/Wallet/Object/Base.pm | 1 + 1 file changed, 1 insertion(+) (limited to 'perl/Wallet/Object/Base.pm') diff --git a/perl/Wallet/Object/Base.pm b/perl/Wallet/Object/Base.pm index 28ec6b9..556cb27 100644 --- a/perl/Wallet/Object/Base.pm +++ b/perl/Wallet/Object/Base.pm @@ -610,6 +610,7 @@ sub show { # 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) { local $Text::Wrap::columns = 80; local $Text::Wrap::unexpand = 0; -- cgit v1.2.3 From fef66a4c6ca0c452ce9af641469c831e36399c19 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Thu, 30 Aug 2012 14:57:10 -0700 Subject: Fix POD stopwords and formatting Fix a formatting error in Wallet::ACL::LDAP::Attribute and add new stopwords required by the latest aspell. --- perl/Wallet/ACL.pm | 2 +- perl/Wallet/ACL/Base.pm | 2 +- perl/Wallet/ACL/Krb5.pm | 2 +- perl/Wallet/ACL/Krb5/Regex.pm | 2 +- perl/Wallet/ACL/LDAP/Attribute.pm | 6 +++++- perl/Wallet/ACL/NetDB.pm | 2 +- perl/Wallet/ACL/NetDB/Root.pm | 2 +- perl/Wallet/Admin.pm | 2 +- perl/Wallet/Config.pm | 2 +- perl/Wallet/Kadmin/Heimdal.pm | 2 +- perl/Wallet/Kadmin/MIT.pm | 1 + perl/Wallet/Object/Base.pm | 2 +- perl/Wallet/Object/Keytab.pm | 2 +- perl/Wallet/Schema.pm | 2 +- perl/Wallet/Server.pm | 2 +- 15 files changed, 19 insertions(+), 14 deletions(-) (limited to 'perl/Wallet/Object/Base.pm') diff --git a/perl/Wallet/ACL.pm b/perl/Wallet/ACL.pm index 44a82b2..2a06442 100644 --- a/perl/Wallet/ACL.pm +++ b/perl/Wallet/ACL.pm @@ -442,7 +442,7 @@ __END__ Wallet::ACL - Implementation of ACLs in the wallet system =for stopwords -ACL DBH metadata HOSTNAME DATETIME timestamp Allbery +ACL DBH metadata HOSTNAME DATETIME timestamp Allbery verifier verifiers =head1 SYNOPSIS diff --git a/perl/Wallet/ACL/Base.pm b/perl/Wallet/ACL/Base.pm index 9a8a3cb..85eaefa 100644 --- a/perl/Wallet/ACL/Base.pm +++ b/perl/Wallet/ACL/Base.pm @@ -60,7 +60,7 @@ __END__ ############################################################################## =for stopwords -ACL Allbery +ACL Allbery verifier verifiers =head1 NAME diff --git a/perl/Wallet/ACL/Krb5.pm b/perl/Wallet/ACL/Krb5.pm index 496fcf0..12be141 100644 --- a/perl/Wallet/ACL/Krb5.pm +++ b/perl/Wallet/ACL/Krb5.pm @@ -51,7 +51,7 @@ __END__ ############################################################################## =for stopwords -ACL krb5 Allbery +ACL krb5 Allbery verifier =head1 NAME diff --git a/perl/Wallet/ACL/Krb5/Regex.pm b/perl/Wallet/ACL/Krb5/Regex.pm index 52f4bf5..8f9702e 100644 --- a/perl/Wallet/ACL/Krb5/Regex.pm +++ b/perl/Wallet/ACL/Krb5/Regex.pm @@ -56,7 +56,7 @@ __END__ ############################################################################## =for stopwords -ACL krb5-regex Durkacz Allbery +ACL krb5-regex Durkacz Allbery verifier =head1 NAME diff --git a/perl/Wallet/ACL/LDAP/Attribute.pm b/perl/Wallet/ACL/LDAP/Attribute.pm index 7a54546..802c710 100644 --- a/perl/Wallet/ACL/LDAP/Attribute.pm +++ b/perl/Wallet/ACL/LDAP/Attribute.pm @@ -141,7 +141,7 @@ sub check { ############################################################################## =for stopwords -ACL Allbery +ACL Allbery verifier LDAP PRINCIPAL's DN ldap-attr =head1 NAME @@ -174,6 +174,8 @@ information about how to set wallet configuration. =head1 METHODS +=over 4 + =item new() Creates a new ACL verifier. Opens and binds the connection to the LDAP @@ -197,6 +199,8 @@ Returns the error if check() returned undef. The new() method may fail with one of the following exceptions: +=over 4 + =item LDAP attribute ACL support not available: %s Attempting to connect or bind to the LDAP server failed. diff --git a/perl/Wallet/ACL/NetDB.pm b/perl/Wallet/ACL/NetDB.pm index 0fb5a2c..0aa8958 100644 --- a/perl/Wallet/ACL/NetDB.pm +++ b/perl/Wallet/ACL/NetDB.pm @@ -136,7 +136,7 @@ __END__ ############################################################################## =for stopwords -ACL NetDB remctl DNS DHCP Allbery netdb +ACL NetDB remctl DNS DHCP Allbery netdb verifier =head1 NAME diff --git a/perl/Wallet/ACL/NetDB/Root.pm b/perl/Wallet/ACL/NetDB/Root.pm index 3aeebda..c28bb1e 100644 --- a/perl/Wallet/ACL/NetDB/Root.pm +++ b/perl/Wallet/ACL/NetDB/Root.pm @@ -49,7 +49,7 @@ sub check { ############################################################################## =for stopwords -ACL NetDB DNS DHCP Allbery +ACL NetDB DNS DHCP Allbery verifier =head1 NAME diff --git a/perl/Wallet/Admin.pm b/perl/Wallet/Admin.pm index 8fb49af..a1aef83 100644 --- a/perl/Wallet/Admin.pm +++ b/perl/Wallet/Admin.pm @@ -178,7 +178,7 @@ __DATA__ Wallet::Admin - Wallet system administrative interface =for stopwords -ACL hostname Allbery +ACL hostname Allbery verifier =head1 SYNOPSIS diff --git a/perl/Wallet/Config.pm b/perl/Wallet/Config.pm index 1a74506..cd4e569 100644 --- a/perl/Wallet/Config.pm +++ b/perl/Wallet/Config.pm @@ -27,7 +27,7 @@ Wallet::Config - Configuration handling for the wallet server DBI DSN SQLite subdirectories KEYTAB keytab kadmind KDC add-ons kadmin DNS SRV kadmin keytabs remctl backend lowercased NETDB ACL NetDB unscoped usernames rekey hostnames Allbery wallet-backend keytab-backend Heimdal -rekeys +rekeys WebAuth WEBAUTH keyring LDAP DN GSS-API =head1 SYNOPSIS diff --git a/perl/Wallet/Kadmin/Heimdal.pm b/perl/Wallet/Kadmin/Heimdal.pm index 658ac04..6c91b1d 100644 --- a/perl/Wallet/Kadmin/Heimdal.pm +++ b/perl/Wallet/Kadmin/Heimdal.pm @@ -234,7 +234,7 @@ __END__ ############################################################################## =for stopwords -keytabs keytab kadmin KDC API Allbery Heimdal +keytabs keytab kadmin KDC API Allbery Heimdal unlinked =head1 NAME diff --git a/perl/Wallet/Kadmin/MIT.pm b/perl/Wallet/Kadmin/MIT.pm index fc4d271..c191bc9 100644 --- a/perl/Wallet/Kadmin/MIT.pm +++ b/perl/Wallet/Kadmin/MIT.pm @@ -256,6 +256,7 @@ __END__ =for stopwords rekeying rekeys remctl backend keytabs keytab kadmin KDC API Allbery +unlinked =head1 NAME diff --git a/perl/Wallet/Object/Base.pm b/perl/Wallet/Object/Base.pm index 556cb27..87506f4 100644 --- a/perl/Wallet/Object/Base.pm +++ b/perl/Wallet/Object/Base.pm @@ -695,7 +695,7 @@ Wallet::Object::Base - Generic parent class for wallet objects =for stopwords DBH HOSTNAME DATETIME ACL backend metadata timestamp Allbery wallet-backend -backend-specific +backend-specific subclasses =head1 SYNOPSIS diff --git a/perl/Wallet/Object/Keytab.pm b/perl/Wallet/Object/Keytab.pm index b7c2805..fd3001f 100644 --- a/perl/Wallet/Object/Keytab.pm +++ b/perl/Wallet/Object/Keytab.pm @@ -347,7 +347,7 @@ __END__ =for stopwords keytab API KDC keytabs HOSTNAME DATETIME enctypes enctype DBH metadata -unmanaged kadmin Allbery +unmanaged kadmin Allbery unlinked =head1 NAME diff --git a/perl/Wallet/Schema.pm b/perl/Wallet/Schema.pm index 5c6b9ca..9a7fe44 100644 --- a/perl/Wallet/Schema.pm +++ b/perl/Wallet/Schema.pm @@ -171,7 +171,7 @@ 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 +enctype Allbery Metadata metadata verifier =head1 SYNOPSIS diff --git a/perl/Wallet/Server.pm b/perl/Wallet/Server.pm index 7b3fb8f..b2bae2c 100644 --- a/perl/Wallet/Server.pm +++ b/perl/Wallet/Server.pm @@ -753,7 +753,7 @@ Wallet::Server - Wallet system server implementation =for stopwords keytabs metadata backend HOSTNAME ACL timestamp ACL's nul Allbery -backend-specific wallet-backend +backend-specific wallet-backend verifier =head1 SYNOPSIS -- 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/Object/Base.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/Object/Base.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