summaryrefslogtreecommitdiff
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.pm51
-rw-r--r--perl/Wallet/Object/Keytab.pm4
-rw-r--r--perl/Wallet/Server.pm16
4 files changed, 62 insertions, 19 deletions
diff --git a/perl/Wallet/ACL.pm b/perl/Wallet/ACL.pm
index 0d4685d..5a56c5c 100644
--- a/perl/Wallet/ACL.pm
+++ b/perl/Wallet/ACL.pm
@@ -151,6 +151,8 @@ sub rename {
};
if ($@) {
$self->{error} = "cannot rename ACL $self->{id} to $name: $@";
+ chomp $self->{error};
+ $self->{error} =~ / at .*$/;
$self->{dbh}->rollback;
return undef;
}
@@ -174,6 +176,8 @@ sub destroy {
};
if ($@) {
$self->{error} = "cannot destroy ACL $self->{id}: $@";
+ chomp $self->{error};
+ $self->{error} =~ / at .*$/;
$self->{dbh}->rollback;
return undef;
}
@@ -201,6 +205,8 @@ sub add {
};
if ($@) {
$self->{error} = "cannot add $scheme:$identifier to $self->{id}: $@";
+ chomp $self->{error};
+ $self->{error} =~ / at .*$/;
$self->{dbh}->rollback;
return undef;
}
@@ -230,6 +236,8 @@ sub remove {
if ($@) {
my $entry = "$scheme:$identifier";
$self->{error} = "cannot remove $entry from $self->{id}: $@";
+ chomp $self->{error};
+ $self->{error} =~ / at .*$/;
$self->{dbh}->rollback;
return undef;
}
@@ -258,6 +266,8 @@ sub list {
};
if ($@) {
$self->{error} = "cannot retrieve ACL $self->{id}: $@";
+ chomp $self->{error};
+ $self->{error} =~ / at .*$/;
return (undef);
} else {
return @entries;
diff --git a/perl/Wallet/Object/Base.pm b/perl/Wallet/Object/Base.pm
index 59aee9f..389bbef 100644
--- a/perl/Wallet/Object/Base.pm
+++ b/perl/Wallet/Object/Base.pm
@@ -34,7 +34,7 @@ $VERSION = '0.01';
# 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) = shift;
+ my ($class, $type, $name, $dbh) = @_;
$dbh->{AutoCommit} = 0;
$dbh->{RaiseError} = 1;
$dbh->{PrintError} = 0;
@@ -121,27 +121,29 @@ sub log_action {
# the object record itself. Commit both changes as a transaction. We
# assume that AutoCommit is turned off.
eval {
- my $sql = 'insert into object_history (oh_object, oh_type, oh_action,
+ 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->{name}, $self->{type}, $action,
+ $self->{dbh}->do ($sql, undef, $self->{type}, $self->{name}, $action,
$user, $host, $time);
if ($action eq 'get') {
$sql = 'update objects set ob_downloaded_by = ?,
ob_downloaded_from = ?, ob_downloaded_on = ? where
- ob_name = ? and ob_type = ?';
- $self->{dbh}->do ($sql, undef, $user, $host, $time, $self->{name},
- $self->{type});
+ ob_type = ? and ob_name = ?';
+ $self->{dbh}->do ($sql, undef, $user, $host, $time, $self->{type},
+ $self->{name});
} elsif ($action eq 'store') {
$sql = 'update objects set ob_stored_by = ?, ob_stored_from = ?,
- ob_stored_on = ? where ob_name = ? and ob_type = ?';
- $self->{dbh}->do ($sql, undef, $user, $host, $time, $self->{name},
- $self->{type});
+ ob_stored_on = ? where ob_type = ? and ob_name = ?';
+ $self->{dbh}->do ($sql, undef, $user, $host, $time, $self->{type},
+ $self->{name});
}
$self->{dbh}->commit;
};
if ($@) {
my $id = $self->{type} . ':' . $self->{name};
$self->{error} = "cannot update history for $id: $@";
+ chomp $self->{error};
+ $self->{error} =~ / at .*$/;
$self->{dbh}->rollback;
return undef;
}
@@ -168,10 +170,10 @@ sub log_set {
unless ($fields{$field}) {
die "invalid history field $field";
}
- my $sql = "insert into object_history (oh_object, oh_type, oh_action,
+ 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->{name}, $self->{type}, $field,
+ $self->{dbh}->do ($sql, undef, $self->{type}, $self->{name}, $field,
$type_field, $old, $new, $user, $host, $time);
}
@@ -203,6 +205,8 @@ sub _set_internal {
if ($@) {
my $id = $self->{type} . ':' . $self->{name};
$self->{error} = "cannot set $attr on $id: $@";
+ chomp $self->{error};
+ $self->{error} =~ s/ at .*//;
$self->{dbh}->rollback;
return;
}
@@ -216,6 +220,7 @@ sub _get_internal {
$self->{error} = "invalid attribute $attr";
return;
}
+ $attr = 'ob_' . $attr;
my $name = $self->{name};
my $type = $self->{type};
my $sql = "select $attr from objects where ob_type = ? and ob_name = ?";
@@ -228,11 +233,15 @@ sub _get_internal {
sub owner {
my ($self, $owner, $user, $host, $time) = @_;
if ($owner) {
- if ($owner !~ /^\d+\z/) {
- $self->{error} = "malformed owner ACL id $owner";
- return;
+ my $acl;
+ eval { $acl = Wallet::ACL->new ($owner, $self->{dbh}) };
+ if ($@) {
+ $self->{error} = $@;
+ chomp $self->{error};
+ $self->{error} =~ / at .*$/;
+ return undef;
}
- return $self->_set_internal ('owner', $owner, $user, $host, $time);
+ return $self->_set_internal ('owner', $acl->id, $user, $host, $time);
} else {
return $self->_get_internal ('owner');
}
@@ -244,14 +253,18 @@ sub acl {
my ($self, $type, $id, $user, $host, $time) = @_;
if ($type !~ /^(get|store|show|destroy|flags)\z/) {
$self->{error} = "invalid ACL type $type";
+ chomp $self->{error};
+ $self->{error} =~ / at .*$/;
return;
}
my $attr = "acl_$type";
if ($id) {
my $acl;
- eval { $acl = Wallet::ACL->new ($id) };
+ eval { $acl = Wallet::ACL->new ($id, $self->{dbh}) };
if ($@) {
$self->{error} = $@;
+ chomp $self->{error};
+ $self->{error} =~ / at .*$/;
return undef;
}
return $self->_set_internal ($attr, $acl->id, $user, $host, $time);
@@ -326,12 +339,14 @@ sub show {
};
if ($@) {
$self->{error} = "cannot retrieve data for ${type}:${name}: $@";
+ chomp $self->{error};
+ $self->{error} =~ / at .*$/;
return undef;
}
my $output = '';
for (my $i = 0; $i < @data; $i++) {
next unless defined $data[$i];
- if ($attrs[$i][0] =~ /^ob_acl_/) {
+ if ($attrs[$i][0] =~ /^ob_(owner|acl_)/) {
my $acl = eval { Wallet::ACL->new ($data[$i], $self->{dbh}) };
if ($acl and not $@) {
$data[$i] = $acl->name || $data[$i];
@@ -362,6 +377,8 @@ sub destroy {
};
if ($@) {
$self->{error} = "cannot destroy ${type}:${name}: $@";
+ chomp $self->{error};
+ $self->{error} =~ / at .*$/;
$self->{dbh}->rollback;
return undef;
}
diff --git a/perl/Wallet/Object/Keytab.pm b/perl/Wallet/Object/Keytab.pm
index f83949c..8635bee 100644
--- a/perl/Wallet/Object/Keytab.pm
+++ b/perl/Wallet/Object/Keytab.pm
@@ -166,7 +166,7 @@ sub get {
local *KEYTAB;
unless (open (KEYTAB, '<', $file)) {
my $princ = $self->{name};
- $self->{error} = "error creating keytab for principal $princ: $!";
+ $self->{error} = "error opening keytab for principal $princ: $!";
return undef;
}
local $/;
@@ -174,7 +174,7 @@ sub get {
my $data = <KEYTAB>;
if ($!) {
my $princ = $self->{name};
- $self->{error} = "error creating keytab for principal $princ: $!";
+ $self->{error} = "error reading keytab for principal $princ: $!";
return undef;
}
close KEYTAB;
diff --git a/perl/Wallet/Server.pm b/perl/Wallet/Server.pm
index dbf19bb..7c1443c 100644
--- a/perl/Wallet/Server.pm
+++ b/perl/Wallet/Server.pm
@@ -147,6 +147,8 @@ sub create {
my $object = eval { $class->create ($type, $name, $dbh, $user, $host) };
if ($@) {
$self->{error} = $@;
+ chomp $self->{error};
+ $self->{error} =~ / at .*$/;
return undef;
} else {
return $object;
@@ -165,6 +167,8 @@ sub retrieve {
my $object = eval { $class->new ($type, $name, $self->{dbh}) };
if ($@) {
$self->{error} = $@;
+ chomp $self->{error};
+ $self->{error} =~ / at .*$/;
return undef;
} else {
return $object;
@@ -204,6 +208,8 @@ sub acl_check {
my $acl = eval { Wallet::ACL->new ($id) };
if ($@) {
$self->{error} = $@;
+ chomp $self->{error};
+ $self->{error} =~ / at .*$/;
return undef;
}
my $status = $acl->check ($self->{user});
@@ -329,6 +335,8 @@ sub acl_create {
my $acl = eval { Wallet::ACL->create ($name, $dbh, $user, $host) };
if ($@) {
$self->{error} = $@;
+ chomp $self->{error};
+ $self->{error} =~ / at .*$/;
return undef;
} else {
return $acl;
@@ -359,6 +367,8 @@ sub acl_rename {
my $acl = { Wallet::ACL->new ($id, $self->{dbh}) };
if ($@) {
$self->{error} = $@;
+ chomp $self->{error};
+ $self->{error} =~ / at .*$/;
return undef;
}
unless ($acl->rename ($name)) {
@@ -379,6 +389,8 @@ sub acl_destroy {
my $acl = { Wallet::ACL->new ($id, $self->{dbh}) };
if ($@) {
$self->{error} = $@;
+ chomp $self->{error};
+ $self->{error} =~ / at .*$/;
return undef;
}
unless ($acl->destroy ($self->{user}, $self->{host})) {
@@ -399,6 +411,8 @@ sub acl_add {
my $acl = { Wallet::ACL->new ($id, $self->{dbh}) };
if ($@) {
$self->{error} = $@;
+ chomp $self->{error};
+ $self->{error} =~ / at .*$/;
return undef;
}
unless ($acl->add ($scheme, $identifier, $self->{user}, $self->{host})) {
@@ -419,6 +433,8 @@ sub acl_remove {
my $acl = { Wallet::ACL->new ($id, $self->{dbh}) };
if ($@) {
$self->{error} = $@;
+ chomp $self->{error};
+ $self->{error} =~ / at .*$/;
return undef;
}
my $user = $self->{user};
generated by cgit v1.2.3 (git 2.39.1) at 2025-10-31 02:49:12 +0000