summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--perl/Wallet/ACL.pm10
-rw-r--r--perl/Wallet/Object/Base.pm11
-rw-r--r--perl/Wallet/Object/Keytab.pm4
-rw-r--r--perl/Wallet/Schema.pm72
-rw-r--r--perl/Wallet/Server.pm21
-rwxr-xr-xperl/t/init.t19
-rwxr-xr-xperl/t/keytab.t4
-rwxr-xr-xperl/t/object.t4
-rwxr-xr-xperl/t/schema.t17
-rwxr-xr-xperl/t/server.t8
10 files changed, 144 insertions, 26 deletions
diff --git a/perl/Wallet/ACL.pm b/perl/Wallet/ACL.pm
index 6a07366..f04217e 100644
--- a/perl/Wallet/ACL.pm
+++ b/perl/Wallet/ACL.pm
@@ -50,8 +50,12 @@ sub new {
} else {
$sql = 'select ac_id, ac_name from acls where ac_name = ?';
}
- ($data, $name) = eval { $dbh->selectrow_array ($sql, undef, $id) };
+ eval {
+ ($data, $name) = $dbh->selectrow_array ($sql, undef, $id);
+ $dbh->commit;
+ };
if ($@) {
+ $dbh->rollback;
die "cannot search for ACL $id: $@\n";
} elsif (not defined $data) {
die "ACL $id not found\n";
@@ -271,9 +275,11 @@ sub list {
while (defined ($entry = $sth->fetchrow_arrayref)) {
push (@entries, [ @$entry ]);
}
+ $self->{dbh}->commit;
};
if ($@) {
$self->error ("cannot retrieve ACL $self->{id}: $@");
+ $self->{dbh}->rollback;
return;
} else {
return @entries;
@@ -320,9 +326,11 @@ sub history {
}
$output .= "\n by $data[3] from $data[4]\n";
}
+ $self->{dbh}->commit;
};
if ($@) {
$self->error ("cannot read history for $self->{id}: $@");
+ $self->{dbh}->rollback;
return undef;
}
return $output;
diff --git a/perl/Wallet/Object/Base.pm b/perl/Wallet/Object/Base.pm
index ada211c..1371f7f 100644
--- a/perl/Wallet/Object/Base.pm
+++ b/perl/Wallet/Object/Base.pm
@@ -41,6 +41,7 @@ sub new {
$dbh->{PrintError} = 0;
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 $self = {
dbh => $dbh,
@@ -240,9 +241,11 @@ sub _get_internal {
my $sql = "select $attr from objects where ob_type = ? and
ob_name = ?";
$value = $self->{dbh}->selectrow_array ($sql, undef, $type, $name);
+ $self->{dbh}->commit;
};
if ($@) {
$self->error ($@);
+ $self->{dbh}->rollback;
return;
}
return $value;
@@ -345,9 +348,11 @@ sub flag_check {
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;
};
if ($@) {
$self->error ("cannot check flag $flag for ${type}:${name}: $@");
+ $dbh->rollback;
return;
} elsif ($value) {
return 1;
@@ -401,10 +406,12 @@ sub flag_list {
while (defined ($flag = $sth->fetchrow_array)) {
push (@flags, $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;
@@ -490,10 +497,12 @@ sub history {
}
$output .= "\n by $data[5] from $data[6]\n";
}
+ $self->{dbh}->commit;
};
if ($@) {
my $id = $self->{type} . ':' . $self->{name};
$self->error ("cannot read history for $id: $@");
+ $self->{dbh}->rollback;
return undef;
}
return $output;
@@ -550,9 +559,11 @@ sub show {
my $sql = "select $fields from objects where ob_type = ? and
ob_name = ?";
@data = $self->{dbh}->selectrow_array ($sql, undef, $type, $name);
+ $self->{dbh}->commit;
};
if ($@) {
$self->error ("cannot retrieve data for ${type}:${name}: $@");
+ $self->{dbh}->rollback;
return undef;
}
my $output = '';
diff --git a/perl/Wallet/Object/Keytab.pm b/perl/Wallet/Object/Keytab.pm
index f91abff..025c9e1 100644
--- a/perl/Wallet/Object/Keytab.pm
+++ b/perl/Wallet/Object/Keytab.pm
@@ -467,9 +467,11 @@ sub enctypes_list {
while (defined ($entry = $sth->fetchrow_arrayref)) {
push (@enctypes, @$entry);
}
+ $self->{dbh}->commit;
};
if ($@) {
$self->error ($@);
+ $self->{dbh}->rollback;
return;
}
return @enctypes;
@@ -562,9 +564,11 @@ sub attr {
while (defined ($target = $sth->fetchrow_array)) {
push (@targets, $target);
}
+ $self->{dbh}->commit;
};
if ($@) {
$self->error ($@);
+ $self->{dbh}->rollback;
return;
}
return @targets;
diff --git a/perl/Wallet/Schema.pm b/perl/Wallet/Schema.pm
index ec690e1..030905e 100644
--- a/perl/Wallet/Schema.pm
+++ b/perl/Wallet/Schema.pm
@@ -14,7 +14,7 @@ package Wallet::Schema;
require 5.006;
use strict;
-use vars qw(@TABLES $VERSION);
+use vars qw(@SQL @TABLES $VERSION);
use DBI;
@@ -28,28 +28,31 @@ $VERSION = '0.02';
##############################################################################
# Create a new Wallet::Schema object, parse the SQL out of the documentation,
-# and store it in the object.
+# 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 {
my ($class) = @_;
- local $_;
- my ($found, @sql);
- 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 = '';
+ 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;
}
- close DATA;
- my $self = { sql => [ @sql ] };
+ my $self = { sql => [ @SQL ] };
bless ($self, $class);
return $self;
}
@@ -84,6 +87,31 @@ sub 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} };
+ eval {
+ $dbh->begin_work if $dbh->{AutoCommit};
+ for my $sql (@drop) {
+ $dbh->do ($sql, { RaiseError => 1, PrintError => 0 });
+ }
+ $dbh->commit;
+ };
+ if ($@) {
+ $dbh->rollback;
+ die "$@\n";
+ }
+}
+
##############################################################################
# Schema
##############################################################################
@@ -134,6 +162,14 @@ 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
diff --git a/perl/Wallet/Server.pm b/perl/Wallet/Server.pm
index 429b3fb..04e8fd9 100644
--- a/perl/Wallet/Server.pm
+++ b/perl/Wallet/Server.pm
@@ -85,6 +85,18 @@ sub initialize {
return $class->new ($user, 'localhost');
}
+# The same as initialize, but also drops any existing tables first before
+# creating the schema. Takes the same arguments and throws an exception on
+# failure.
+sub reinitialize {
+ my ($class, $user) = @_;
+ my $dbh = $class->_open_db;
+ my $schema = Wallet::Schema->new;
+ $schema->drop ($dbh);
+ $dbh->disconnect;
+ return $class->initialize ($user);
+}
+
# Create a new wallet server object. A new server should be created for each
# user who is making changes to the wallet. Takes the principal and host who
# are sending wallet requests. Opens a connection to the database that will
@@ -752,6 +764,15 @@ privileged operations.
On any error, this method throws an exception.
+=item reinitialize(PRINCIPAL)
+
+Performs the same actions as initialize(), but first drops any existing
+wallet database tables from the database, allowing this function to be
+called on a prior wallet database. All data stored in the database will be
+deleted and a fresh set of wallet database tables will be created.
+
+On any error, this method throws an exception.
+
=back
=head1 INSTANCE METHODS
diff --git a/perl/t/init.t b/perl/t/init.t
index 3fa026f..81c034d 100755
--- a/perl/t/init.t
+++ b/perl/t/init.t
@@ -8,7 +8,7 @@
#
# See LICENSE for licensing terms.
-use Test::More tests => 8;
+use Test::More tests => 16;
use Wallet::ACL;
use Wallet::Config;
@@ -34,5 +34,22 @@ isnt ($entries[0], undef, ' which is a valid entry');
is ($entries[0][0], 'krb5', ' of krb5 scheme');
is ($entries[0][1], 'admin@EXAMPLE.COM', ' with the right user');
+# Test reinitialization.
+$server = eval { Wallet::Server->reinitialize ('admin@EXAMPLE.COM') };
+is ($@, '', 'Reinitialization did not die');
+ok ($server->isa ('Wallet::Server'), ' and returned the right class');
+
+# Now repeat the database content checks.
+$acl = eval { Wallet::ACL->new ('ADMIN', $server->dbh) };
+is ($@, '', 'Retrieving ADMIN ACL successful');
+ok ($acl->isa ('Wallet::ACL'), ' and is the right class');
+@entries = $acl->list;
+is (scalar (@entries), 1, ' and has only one entry');
+isnt ($entries[0], undef, ' which is a valid entry');
+is ($entries[0][0], 'krb5', ' of krb5 scheme');
+is ($entries[0][1], 'admin@EXAMPLE.COM', ' with the right user');
+
# Clean up.
+my $schema = Wallet::Schema->new;
+$schema->drop ($server->dbh);
unlink 'wallet-db';
diff --git a/perl/t/keytab.t b/perl/t/keytab.t
index d7c2a02..f08bd31 100755
--- a/perl/t/keytab.t
+++ b/perl/t/keytab.t
@@ -200,7 +200,7 @@ sub stop_remctld {
}
# Use Wallet::Server to set up the database.
-my $server = eval { Wallet::Server->initialize ($user) };
+my $server = eval { Wallet::Server->reinitialize ($user) };
is ($@, '', 'Database initialization did not die');
ok ($server->isa ('Wallet::Server'), ' and returned the right class');
my $dbh = $server->dbh;
@@ -861,4 +861,6 @@ EOO
}
# Clean up.
+my $schema = Wallet::Schema->new;
+$schema->drop ($dbh);
unlink ('wallet-db', 'krb5cc_temp', 'krb5cc_test', 'test-acl', 'test-pid');
diff --git a/perl/t/object.t b/perl/t/object.t
index bf100ea..42700d0 100755
--- a/perl/t/object.t
+++ b/perl/t/object.t
@@ -28,7 +28,7 @@ my @trace = ($user, $host, time);
my $princ = 'service/test@EXAMPLE.COM';
# Use Wallet::Server to set up the database.
-my $server = eval { Wallet::Server->initialize ($user) };
+my $server = eval { Wallet::Server->reinitialize ($user) };
is ($@, '', 'Database initialization did not die');
ok ($server->isa ('Wallet::Server'), ' and returned the right class');
my $dbh = $server->dbh;
@@ -321,4 +321,6 @@ EOO
is ($object->history, $output, ' and the history is correct');
# Clean up.
+my $schema = Wallet::Schema->new;
+$schema->drop ($dbh);
unlink 'wallet-db';
diff --git a/perl/t/schema.t b/perl/t/schema.t
index 01b2b88..9e2d84f 100755
--- a/perl/t/schema.t
+++ b/perl/t/schema.t
@@ -8,7 +8,7 @@
#
# See LICENSE for licensing terms.
-use Test::More tests => 5;
+use Test::More tests => 8;
use DBI;
use Wallet::Schema;
@@ -31,5 +31,20 @@ $dbh->{PrintError} = 0;
eval { $schema->create ($dbh) };
is ($@, '', "create() doesn't die");
+# Test dropping the database.
+eval { $schema->drop ($dbh) };
+is ($@, '', "drop() doesn't die");
+my $sql = "select name from sqlite_master where type = 'table'";
+my $sth = $dbh->prepare ($sql);
+$sth->execute;
+my ($table, @tables);
+while (defined ($table = $sth->fetchrow_array)) {
+ push (@tables, $table) unless $table =~ /^sqlite_/;
+}
+is ("@tables", '', ' and there are no tables in the database');
+eval { $schema->create ($dbh) };
+is ($@, '', ' and we can run create again');
+
# Clean up.
+eval { $schema->drop ($dbh) };
unlink 'wallet-db';
diff --git a/perl/t/server.t b/perl/t/server.t
index b0c196b..2520e62 100755
--- a/perl/t/server.t
+++ b/perl/t/server.t
@@ -866,6 +866,11 @@ is ($server->store ('base', 'service/foo', 'stuff'), undef,
is ($server->error, "$user2 not authorized to create base:service/foo",
' with the right error');
+# Clean up.
+my $schema = Wallet::Schema->new;
+$schema->drop ($server->dbh);
+unlink 'wallet-db';
+
# Now test handling of some configuration errors.
undef $Wallet::Config::DB_DRIVER;
$server = eval { Wallet::Server->new ($user2, $host) };
@@ -880,6 +885,3 @@ $Wallet::Config::DB_INFO = 't';
$server = eval { Wallet::Server->new ($user2, $host) };
like ($@, qr/^cannot connect to database: /,
' or if the database connection fails');
-
-# Clean up.
-unlink 'wallet-db';
generated by cgit v1.2.3 (git 2.39.1) at 2025-10-31 16:45:00 +0000