aboutsummaryrefslogtreecommitdiff
path: root/perl
diff options
context:
space:
mode:
Diffstat (limited to 'perl')
-rw-r--r--perl/Wallet/ACL.pm64
-rw-r--r--perl/Wallet/Admin.pm49
-rw-r--r--perl/Wallet/Object/Base.pm80
-rw-r--r--perl/Wallet/Object/File.pm2
-rw-r--r--perl/Wallet/Object/Keytab.pm43
-rw-r--r--perl/Wallet/Object/WAKeyring.pm2
-rw-r--r--perl/Wallet/Report.pm50
-rw-r--r--perl/Wallet/Schema.pm6
-rw-r--r--perl/Wallet/Server.pm64
-rwxr-xr-xperl/t/acl.t26
-rwxr-xr-xperl/t/admin.t4
-rwxr-xr-xperl/t/file.t14
-rwxr-xr-xperl/t/init.t6
-rwxr-xr-xperl/t/keytab.t4
-rwxr-xr-xperl/t/object.t20
-rwxr-xr-xperl/t/server.t4
-rwxr-xr-xperl/t/wa-keyring.t10
17 files changed, 236 insertions, 212 deletions
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');
generated by cgit v1.2.3 (git 2.39.1) at 2025-02-06 08:43:14 +0000