Add new acl check command

Add a new acl check command which, given an ACL ID, prints yes if that
ACL already exists and no otherwise.  This is parallel to the check
command for objects.

Also fix some documentation errors in the wallet client documentation,
saying that the check command doesn't require any ACL and fixing one
place where "show" was used instead of "store".

2 files changed, 35 insertions, 15 deletions

diff --git a/perl/Wallet/Server.pm b/perl/Wallet/Server.pm
index b2bae2c..dfb7dbb 100644
--- a/perl/Wallet/Server.pm
+++ b/perl/Wallet/Server.pm
@@ -275,7 +275,7 @@ sub object_error {
 # the internal error message.  Note that we do not allow any special access to
 # admins for get and store; if they want to do that with objects, they need to
 # set the ACL accordingly.
-sub acl_check {
+sub acl_verify {
     my ($self, $object, $action) = @_;
     my %actions = map { $_ => 1 }
         qw(get store show destroy flags setattr getattr comment);
@@ -349,7 +349,7 @@ sub attr {
     my $user = $self->{user};
     my $host = $self->{host};
     if (@values) {
-        return unless $self->acl_check ($object, 'setattr');
+        return unless $self->acl_verify ($object, 'setattr');
         if (@values == 1 and $values[0] eq '') {
             @values = ();
         }
@@ -357,7 +357,7 @@ sub attr {
         $self->error ($object->error) unless $result;
         return $result;
     } else {
-        return unless $self->acl_check ($object, 'getattr');
+        return unless $self->acl_verify ($object, 'getattr');
         my @result = $object->attr ($attr);
         if (not @result and $object->error) {
             $self->error ($object->error);
@@ -376,10 +376,10 @@ sub comment {
     return unless defined $object;
     my $result;
     if (defined $comment) {
-        return unless $self->acl_check ($object, 'comment');
+        return unless $self->acl_verify ($object, 'comment');
         $result = $object->comment ($comment, $self->{user}, $self->{host});
     } else {
-        return unless $self->acl_check ($object, 'show');
+        return unless $self->acl_verify ($object, 'show');
         $result = $object->comment;
     }
     if (not defined ($result) and $object->error) {
@@ -456,7 +456,7 @@ sub get {
     my ($self, $type, $name) = @_;
     my $object = $self->retrieve ($type, $name);
     return unless defined $object;
-    return unless $self->acl_check ($object, 'get');
+    return unless $self->acl_verify ($object, 'get');
     my $result = $object->get ($self->{user}, $self->{host});
     $self->error ($object->error) unless defined $result;
     return $result;
@@ -471,7 +471,7 @@ sub store {
     my ($self, $type, $name, $data) = @_;
     my $object = $self->retrieve ($type, $name);
     return unless defined $object;
-    return unless $self->acl_check ($object, 'store');
+    return unless $self->acl_verify ($object, 'store');
     if (not defined ($data)) {
         $self->{error} = "no data supplied to store";
         return;
@@ -488,7 +488,7 @@ sub show {
     my ($self, $type, $name) = @_;
     my $object = $self->retrieve ($type, $name);
     return unless defined $object;
-    return unless $self->acl_check ($object, 'show');
+    return unless $self->acl_verify ($object, 'show');
     my $result = $object->show;
     $self->error ($object->error) unless defined $result;
     return $result;
@@ -501,7 +501,7 @@ sub history {
     my ($self, $type, $name) = @_;
     my $object = $self->retrieve ($type, $name);
     return unless defined $object;
-    return unless $self->acl_check ($object, 'show');
+    return unless $self->acl_verify ($object, 'show');
     my $result = $object->history;
     $self->error ($object->error) unless defined $result;
     return $result;
@@ -513,7 +513,7 @@ sub destroy {
     my ($self, $type, $name) = @_;
     my $object = $self->retrieve ($type, $name);
     return unless defined $object;
-    return unless $self->acl_check ($object, 'destroy');
+    return unless $self->acl_verify ($object, 'destroy');
     my $result = $object->destroy ($self->{user}, $self->{host});
     $self->error ($object->error) unless defined $result;
     return $result;
@@ -529,7 +529,7 @@ sub flag_clear {
     my ($self, $type, $name, $flag) = @_;
     my $object = $self->retrieve ($type, $name);
     return unless defined $object;
-    return unless $self->acl_check ($object, 'flags');
+    return unless $self->acl_verify ($object, 'flags');
     my $result = $object->flag_clear ($flag, $self->{user}, $self->{host});
     $self->error ($object->error) unless defined $result;
     return $result;
@@ -541,7 +541,7 @@ sub flag_set {
     my ($self, $type, $name, $flag) = @_;
     my $object = $self->retrieve ($type, $name);
     return unless defined $object;
-    return unless $self->acl_check ($object, 'flags');
+    return unless $self->acl_verify ($object, 'flags');
     my $result = $object->flag_set ($flag, $self->{user}, $self->{host});
     $self->error ($object->error) unless defined $result;
     return $result;
@@ -551,6 +551,22 @@ sub flag_set {
 # ACL methods
 ##############################################################################
 
+# Checks for the existence of an ACL.  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 acl_check {
+    my ($self, $id) = @_;
+    my $acl = eval { Wallet::ACL->new ($id, $self->{dbh}) };
+    if ($@) {
+        if ($@ =~ /^ACL .* not found/) {
+            return 0;
+        } else {
+            $self->error ($@);
+            return;
+        }
+    }
+    return 1;
+}
+
 # Create a new empty ACL in the database.  Returns true on success and undef
 # on failure, setting the internal error.
 sub acl_create {
diff --git a/perl/t/server.t b/perl/t/server.t
index ad16151..8e0a30d 100755
--- a/perl/t/server.t
+++ b/perl/t/server.t
@@ -3,12 +3,12 @@
 # Tests for the wallet server API.
 #
 # Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2007, 2008, 2010, 2011
+# Copyright 2007, 2008, 2010, 2011, 2012
 #     The Board of Trustees of the Leland Stanford Junior University
 #
 # See LICENSE for licensing terms.
 
-use Test::More tests => 377;
+use Test::More tests => 381;
 
 use POSIX qw(strftime);
 use Wallet::Admin;
@@ -66,7 +66,9 @@ is ($result, $history, ' including by number');
 is ($server->acl_create (3), undef, 'Cannot create ACL with a numeric name');
 is ($server->error, 'ACL name may not be all numbers',
     ' and returns the right error');
+is ($server->acl_check ('user1'), 0, 'user1 ACL does not exist');
 is ($server->acl_create ('user1'), 1, 'Can create regular ACL');
+is ($server->acl_check ('user1'), 1, 'user1 now exists');
 is ($server->acl_show ('user1'), "Members of ACL user1 (id: 2) are:\n",
     ' and show works');
 is ($server->acl_create ('user1'), undef, ' but not twice');
@@ -95,8 +97,10 @@ is ($server->acl_history ('test'), undef, ' and history fails');
 is ($server->error, 'ACL test not found', ' and returns the right error');
 is ($server->acl_destroy ('test'), undef, 'Destroying the old name fails');
 is ($server->error, 'ACL test not found', ' and returns the right error');
-is ($server->acl_destroy ('test2'), 1, ' but destroying another one works');
+is ($server->acl_check ('test2'), 1, ' but the other ACL exists');
+is ($server->acl_destroy ('test2'), 1, ' and destroying it works');
 is ($server->acl_destroy ('test2'), undef, ' but not twice');
+is ($server->acl_check ('test2'), 0, ' and now it does not exist');
 is ($server->error, 'ACL test2 not found', ' and returns the right error');
 is ($server->acl_add ('user1', 'krb4', $user1), undef,
     'Adding with a bad scheme fails');