aboutsummaryrefslogtreecommitdiff
path: root/perl/Wallet
diff options
context:
space:
mode:
Diffstat (limited to 'perl/Wallet')
-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
5 files changed, 99 insertions, 19 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
generated by cgit v1.2.3 (git 2.39.1) at 2025-02-06 11:10:30 +0000