aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--client/wallet.pod5
-rw-r--r--perl/Wallet/Server.pm24
-rwxr-xr-xperl/t/server.t7
-rwxr-xr-xserver/wallet-backend15
-rw-r--r--tests/server/backend-t.in47
5 files changed, 81 insertions, 17 deletions
diff --git a/client/wallet.pod b/client/wallet.pod
index de20586..8d117e2 100644
--- a/client/wallet.pod
+++ b/client/wallet.pod
@@ -200,6 +200,11 @@ caution when removing entries from the C<ADMIN> ACL.
Display the name, numeric ID, and entries of the ACL <id>.
+=item check <type> <name>
+
+Check whether an object of type <type> and name <name> already exists. If
+it does, prints C<yes>; if not, prints C<no>.
+
=item create <type> <name>
Create a new object of type <type> with name <name>. With some backends,
diff --git a/perl/Wallet/Server.pm b/perl/Wallet/Server.pm
index b5b76fe..b52f1aa 100644
--- a/perl/Wallet/Server.pm
+++ b/perl/Wallet/Server.pm
@@ -24,7 +24,7 @@ use Wallet::Schema;
# This version should be increased on any code change to this module. Always
# use two digits for the minor version with a leading zero if necessary so
# that it will sort properly.
-$VERSION = '0.06';
+$VERSION = '0.07';
##############################################################################
# Utility methods
@@ -384,6 +384,22 @@ sub owner {
return $result;
}
+# Checks for the existence of an object. Returns 1 if it does, 0 if it
+# doesn't, and undef if there was an error in checking the existence of the
+# object.
+sub check {
+ my ($self, $type, $name) = @_;
+ my $object = $self->retrieve ($type, $name);
+ if (not defined $object) {
+ if ($self->error =~ /^cannot find/) {
+ return 0;
+ } else {
+ return;
+ }
+ }
+ return 1;
+}
+
# Retrieve the information associated with an object, or returns undef and
# sets the internal error if the retrieval fails or if the user isn't
# authorized. If the object doesn't exist, attempts dynamic creation of the
@@ -826,6 +842,12 @@ attribute values. Returns true on success and false on failure. To set an
attribute value, the user must be authorized by the ADMIN ACL, the store ACL
if set, or the owner ACL if the store ACL is not set.
+=item check(TYPE, NAME)
+
+Check whether an object of type TYPE and name NAME exists. Returns 1 if
+it does, 0 if it doesn't, and undef if some error occurred while checking
+for the existence of the object.
+
=item create(TYPE, NAME)
Creates a new object of type TYPE and name NAME. TYPE must be a recognized
diff --git a/perl/t/server.t b/perl/t/server.t
index 39e1090..f732af3 100755
--- a/perl/t/server.t
+++ b/perl/t/server.t
@@ -8,7 +8,7 @@
#
# See LICENSE for licensing terms.
-use Test::More tests => 334;
+use Test::More tests => 338;
use POSIX qw(strftime);
use Wallet::Admin;
@@ -172,9 +172,12 @@ is ($server->create ('base', 'service/admin'), 1,
is ($server->create ('base', 'service/admin'), undef, ' but not twice');
like ($server->error, qr{^cannot create object base:service/admin: },
' and returns the right error');
+is ($server->check ('base', 'service/admin'), 1, ' and check works');
is ($server->create ('srvtab', 'service.admin'), undef,
'Creating an unknown object fails');
is ($server->error, 'unknown object type srvtab', ' with the right error');
+is ($server->check ('srvtab', 'service.admin'), undef, ' and check fails');
+is ($server->error, 'unknown object type srvtab', ' with the right error');
is ($server->create ('', 'service.admin'), undef,
' and likewise with an empty type');
is ($server->error, 'unknown object type ', ' with the right error');
@@ -193,6 +196,8 @@ is ($server->destroy ('srvtab', 'service/test'), undef,
is ($server->error, 'unknown object type srvtab', ' with a different error');
is ($server->destroy ('base', 'service/test'), 1,
' but destroying a good object works');
+is ($server->check ('base', 'service/test'), 0,
+ ' and now check says it is not there');
is ($server->destroy ('base', 'service/test'), undef, ' but not twice');
is ($server->error, 'cannot find base:service/test', ' with the right error');
diff --git a/server/wallet-backend b/server/wallet-backend
index fe319e1..967f9b4 100755
--- a/server/wallet-backend
+++ b/server/wallet-backend
@@ -4,7 +4,7 @@ our $ID = q$Id$;
# wallet-backend -- Wallet server for storing and retrieving secure data.
#
# Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2007 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University
#
# See LICENSE for licensing terms.
@@ -178,6 +178,14 @@ sub command {
} else {
error "unknown command acl $action";
}
+ } elsif ($command eq 'check') {
+ check_args (2, 2, [], @args);
+ my $status = $server->check (@args);
+ if (!defined ($status)) {
+ failure ($server->error, @_);
+ } else {
+ print $status ? "yes\n" : "no\n";
+ }
} elsif ($command eq 'create') {
check_args (2, 2, [], @args);
$server->create (@args) or failure ($server->error, @_);
@@ -383,6 +391,11 @@ caution when removing entries from the C<ADMIN> ACL.
Display the name, numeric ID, and entries of the ACL <id>.
+=item check <type> <name>
+
+Check whether an object of type <type> and name <name> already exists. If
+it does, prints C<yes>; if not, prints C<no>.
+
=item create <type> <name>
Create a new object of type <type> with name <name>. With some backends,
diff --git a/tests/server/backend-t.in b/tests/server/backend-t.in
index 88cbd1a..3047ebd 100644
--- a/tests/server/backend-t.in
+++ b/tests/server/backend-t.in
@@ -4,13 +4,13 @@
# Tests for the wallet-backend dispatch code.
#
# Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2006, 2007 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2006, 2007, 2008 Board of Trustees, Leland Stanford Jr. University
#
# See LICENSE for licensing terms.
use strict;
use IO::String;
-use Test::More tests => 1224;
+use Test::More tests => 1245;
# Create a dummy class for Wallet::Server that prints what method was called
# with its arguments and returns data for testing.
@@ -93,6 +93,18 @@ sub attr {
}
}
+sub check {
+ shift;
+ print "check @_\n";
+ if ($_[0] eq 'error') {
+ return;
+ } elsif ($_[1] eq 'empty') {
+ return 0;
+ } else {
+ return 1;
+ }
+}
+
sub expires {
shift;
print "expires @_\n";
@@ -194,7 +206,8 @@ is ($OUTPUT, "error for admin (1.2.3.4): unknown command flag foo\n",
is ($out, "$new\n", ' and nothing ran');
# Check too few, too many, and bad arguments for every command.
-my %commands = (create => [2, 2],
+my %commands = (check => [2, 2],
+ create => [2, 2],
destroy => [2, 2],
expires => [2, 4],
get => [2, 2],
@@ -323,26 +336,24 @@ for my $command (qw/create destroy setacl setattr store/) {
' and ran the right method');
$error++;
}
-for my $command (qw/expires get getacl getattr history owner show/) {
+for my $command (qw/check expires get getacl getattr history owner show/) {
my $method = { getacl => 'acl', getattr => 'attr' }->{$command};
$method ||= $command;
my @extra = ('foo') x ($commands{$command}[0] - 2);
my $extra = @extra ? join (' ', '', @extra) : '';
+ ($out, $err) = run_backend ($command, 'type', 'name', @extra);
+ my $ran = "$command type name" . (@extra ? " @extra" : '');
+ is ($err, '', "Command $command ran with no errors");
+ is ($OUTPUT, "command $ran from admin (1.2.3.4) succeeded\n",
+ ' and success logged');
if ($command eq 'getattr') {
- ($out, $err) = run_backend ($command, 'type', 'name', @extra);
- my $ran = "$command type name" . (@extra ? " @extra" : '');
- is ($err, '', "Command $command ran with no errors");
- is ($OUTPUT, "command $ran from admin (1.2.3.4) succeeded\n",
- ' and success logged');
is ($out, "$new\n$method type name$extra\nattr1\nattr2\n",
' and ran the right method with output');
+ } elsif ($command eq 'check') {
+ is ($out, "$new\n$method type name$extra\nyes\n",
+ ' and ran the right method with output');
} else {
my $newline = ($command =~ /^(get|history|show)\z/) ? '' : "\n";
- ($out, $err) = run_backend ($command, 'type', 'name', @extra);
- my $ran = "$command type name" . (@extra ? " @extra" : '');
- is ($err, '', "Command $command ran with no errors");
- is ($OUTPUT, "command $ran from admin (1.2.3.4) succeeded\n",
- ' and success logged');
is ($out, "$new\n$method type name$extra\n$method$newline",
' and ran the right method with output');
}
@@ -377,6 +388,14 @@ for my $command (qw/expires get getacl getattr history owner show/) {
is ($out, "$new\n$method type empty$extra\n",
' and ran the right method with output');
$error++;
+ } elsif ($command eq 'check') {
+ ($out, $err) = run_backend ($command, 'type', 'empty', @extra);
+ my $ran = "$command type empty" . (@extra ? " @extra" : '');
+ is ($err, '', "Command $command ran with no errors (empty)");
+ is ($OUTPUT, "command $ran from admin (1.2.3.4) succeeded\n",
+ ' and success logged');
+ is ($out, "$new\n$method type empty$extra\nno\n",
+ ' and ran the right method with output');
}
($out, $err) = run_backend ($command, 'error', 'name', @extra);
my $ran = "$command error name" . (@extra ? " @extra" : '');
generated by cgit v1.2.3 (git 2.39.1) at 2025-02-06 22:13:43 +0000