Clean up all exception output when storing it in the error variable to

remove the " at line" stuff added by Perl and the newlines so that the
errors stored in objects are consistent.

Fix various bugs in the base object, including a few more type vs. name
inversions and use of object instead of name.  Allow owners to be
specified as ACL names instead of IDs, and change the ID to a name in
show.

Add a new test suite for the base object implementation.

5 files changed, 189 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};
diff --git a/perl/t/object.t b/perl/t/object.t
new file mode 100755
index 0000000..0ce184f
--- /dev/null
+++ b/perl/t/object.t
@@ -0,0 +1,127 @@
+#!/usr/bin/perl -w
+# $Id$
+#
+# t/object.t -- Tests for the basic object implementation.
+
+use Test::More tests => 51;
+
+use DBD::SQLite;
+use Wallet::Config;
+use Wallet::Object::Base;
+use Wallet::Server;
+
+# Use a local SQLite database for testing.
+$Wallet::Config::DB_DRIVER = 'SQLite';
+$Wallet::Config::DB_INFO = 'wallet-db';
+
+# Some global defaults to use.
+my $user = 'admin@EXAMPLE.COM';
+my $host = 'localhost';
+my @trace = ($user, $host);
+my $princ = 'service/test@EXAMPLE.COM';
+
+# Use Wallet::Server to set up the database.
+my $server = eval { Wallet::Server->initialize ($user) };
+is ($@, '', 'Database initialization did not die');
+ok ($server->isa ('Wallet::Server'), ' and returned the right class');
+my $dbh = $server->dbh;
+
+# 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 $created = time;
+my $object = eval { Wallet::Object::Base->create ('keytab', $princ, $dbh,
+                                                  @trace, $created) };
+is ($@, '', 'Object creation did not die');
+ok ($object->isa ('Wallet::Object::Base'), ' and returned the right class');
+my $repeat =
+    eval { Wallet::Object::Base->create ('keytab', $princ, $dbh, @trace) };
+like ($@, qr/^cannot create object \Qkeytab:$princ: /, 'Repeating fails');
+$object = eval { Wallet::Object::Base->new ('keytab', "a$princ", $dbh) };
+is ($@, "cannot find keytab:a$princ\n", 'Searching for unknown object fails');
+$object = eval { Wallet::Object::Base->new ('keytab', $princ, $dbh) };
+is ($@, '', 'Object new did not die');
+ok ($object->isa ('Wallet::Object::Base'), ' and returned the right class');
+
+# Simple accessor tests.
+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);
+
+# Owner.
+is ($object->owner, undef, 'Owner is not set to start');
+if ($object->owner ('ADMIN', @trace)) {
+    ok (1, ' and setting it to ADMIN works');
+} else {
+    is ($object->error, '', ' and setting it to ADMIN works');
+}
+is ($object->owner, $acl->id, ' at which point it is ADMIN');
+ok (! $object->owner ('unknown', @trace),
+    ' but setting it to something bogus fails');
+is ($object->error, 'ACL unknown not found', ' with the right error');
+
+# Expires.
+is ($object->expires, undef, 'Expires is not set to start');
+my $now = time;
+if ($object->expires ($now, @trace)) {
+    ok (1, ' and setting it works');
+} else {
+    is ($object->error, '', ' and setting it works');
+}
+is ($object->expires, $now, ' at which point it matches');
+ok (! $object->expires ('13/13/13 13:13:13', @trace),
+    ' but setting it to something bogus fails');
+is ($object->error, 'malformed expiration time 13/13/13 13:13:13',
+    ' with the right error');
+
+# ACLs.
+for my $type (qw/get store show destroy flags/) {
+    is ($object->acl ($type), undef, "ACL $type is not set to start");
+    if ($object->acl ($type, $acl->id, @trace)) {
+        ok (1, ' and setting it to ADMIN (numeric) works');
+    } else {
+        is ($object->error, '', ' and setting it to ADMIN (numeric) works');
+    }
+    is ($object->acl ($type), $acl->id, ' at which point it is ADMIN');
+    ok (! $object->acl ($type, 22, @trace),
+        ' but setting it to something bogus fails');
+    is ($object->error, 'ACL 22 not found', ' with the right error');
+}
+
+# Test stub methods.
+eval { $object->get };
+is ($@, "Do not instantiate Wallet::Object::Base directly\n",
+    'Get fails with the right error');
+ok (! $object->store ("Some data", @trace), 'Store fails');
+is ($object->error, "cannot store keytab:$princ: object type is immutable",
+    ' with the right error');
+
+# Test show.
+my $output = <<"EOO";
+           Type: keytab
+           Name: $princ
+          Owner: ADMIN
+        Get ACL: ADMIN
+      Store ACL: ADMIN
+       Show ACL: ADMIN
+    Destroy ACL: ADMIN
+      Flags ACL: ADMIN
+        Expires: $now
+     Created by: $user
+   Created from: $host
+     Created on: $created
+EOO
+is ($object->show, $output, 'Show output is correct');
+
+# Test destroy.
+if ($object->destroy (@trace)) {
+    ok (1, 'Destroy is successful');
+} else {
+    is ($object->error, '', 'Destroy is successful');
+}
+$object = eval { Wallet::Object::Base->new ('keytab', $princ, $dbh) };
+is ($@, "cannot find keytab:$princ\n", ' and object is all gone');
+
+# Clean up.
+unlink 'wallet-db';