diff options
Diffstat (limited to 'perl/Wallet')
| -rw-r--r-- | perl/Wallet/ACL.pm | 196 | ||||
| -rw-r--r-- | perl/Wallet/Admin.pm | 102 | ||||
| -rw-r--r-- | perl/Wallet/Config.pm | 10 | ||||
| -rw-r--r-- | perl/Wallet/Database.pm | 27 | ||||
| -rw-r--r-- | perl/Wallet/Object/Base.pm | 318 | ||||
| -rw-r--r-- | perl/Wallet/Object/Keytab.pm | 116 | ||||
| -rw-r--r-- | perl/Wallet/Report.pm | 298 | ||||
| -rw-r--r-- | perl/Wallet/Schema.pm | 282 | ||||
| -rw-r--r-- | perl/Wallet/Schema/Result/Acl.pm | 99 | ||||
| -rw-r--r-- | perl/Wallet/Schema/Result/AclEntry.pm | 63 | ||||
| -rw-r--r-- | perl/Wallet/Schema/Result/AclHistory.pm | 101 | ||||
| -rw-r--r-- | perl/Wallet/Schema/Result/AclScheme.pm | 73 | ||||
| -rw-r--r-- | perl/Wallet/Schema/Result/Enctype.pm | 34 | ||||
| -rw-r--r-- | perl/Wallet/Schema/Result/Flag.pm | 54 | ||||
| -rw-r--r-- | perl/Wallet/Schema/Result/KeytabEnctype.pm | 42 | ||||
| -rw-r--r-- | perl/Wallet/Schema/Result/KeytabSync.pm | 42 | ||||
| -rw-r--r-- | perl/Wallet/Schema/Result/Object.pm | 258 | ||||
| -rw-r--r-- | perl/Wallet/Schema/Result/ObjectHistory.pm | 127 | ||||
| -rw-r--r-- | perl/Wallet/Schema/Result/SyncTarget.pm | 40 | ||||
| -rw-r--r-- | perl/Wallet/Schema/Result/Type.pm | 64 | ||||
| -rw-r--r-- | perl/Wallet/Server.pm | 19 |
21 files changed, 1705 insertions, 660 deletions
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 <rra@stanford.edu> -# 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 <rra@stanford.edu> -# 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 <rra@stanford.edu> -# 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 (<DATA>) { - 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<Wallet::Config> 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<http://www.eyrie.org/~eagle/software/wallet/>. 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) { |