summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--NEWS5
-rw-r--r--TODO2
-rw-r--r--client/wallet.pod25
-rw-r--r--perl/Wallet/Object/Base.pm39
-rw-r--r--perl/Wallet/Schema.pm5
-rw-r--r--perl/Wallet/Server.pm53
-rwxr-xr-xperl/t/object.t32
-rwxr-xr-xperl/t/schema.t31
-rwxr-xr-xperl/t/server.t58
-rwxr-xr-xserver/wallet-backend45
-rwxr-xr-xtests/server/backend-t32
11 files changed, 280 insertions, 47 deletions
diff --git a/NEWS b/NEWS
index 9e2fa3b..42fb3e7 100644
--- a/NEWS
+++ b/NEWS
@@ -6,6 +6,11 @@ wallet 1.0 (unreleased)
database to the latest schema version. This command should be run
when deploying any new version of the wallet server.
+ Add a comment field to objects and corresponding commands to
+ wallet-backend and wallet to set and retrieve it. The comment field
+ can only be set by the owner or wallet administrators but can be seen
+ by anyone on the show ACL.
+
wallet 0.12 (2010-08-25)
New client program wallet-rekey that, given a list of keytabs on the
diff --git a/TODO b/TODO
index 361d242..0323cc9 100644
--- a/TODO
+++ b/TODO
@@ -45,8 +45,6 @@ Server Interface:
* Support limiting returned history information by timestamp.
- * Add a comment field for objects that can be set by the owner.
-
* Provide a REST implementation of the wallet server.
* Provide a CGI implementation of the wallet server.
diff --git a/client/wallet.pod b/client/wallet.pod
index 45969b2..fdfe37f 100644
--- a/client/wallet.pod
+++ b/client/wallet.pod
@@ -154,11 +154,13 @@ As mentioned above, most commands are only available to wallet
administrators. The exceptions are C<get>, C<store>, C<show>, C<destroy>,
C<flag clear>, C<flag set>, C<getattr>, C<setattr>, and C<history>. All
of those commands have their own ACLs except C<getattr> and C<history>,
-which use the C<show> ACL, and C<setattr>, which uses the C<store> ACL.
-If the appropriate ACL is set, it alone is checked to see if the user has
-access. Otherwise, C<get>, C<store>, C<show>, C<getattr>, C<setattr>, and
-C<history> access is permitted if the user is authorized by the owner ACL
-of the object.
+which use the C<show> ACL, C<setattr>, which uses the C<store> ACL, and
+C<comment>, which uses the owner or C<show> ACL depending on whether one
+is setting or retrieving the comment. If the appropriate ACL is set, it
+alone is checked to see if the user has access. Otherwise, C<get>,
+C<store>, C<show>, C<getattr>, C<setattr>, C<history>, and C<comment>
+access is permitted if the user is authorized by the owner ACL of the
+object.
Administrators can run any command on any object or ACL except for C<get>
and C<store>. For C<get> and C<show>, they must still be authorized by
@@ -167,8 +169,8 @@ either the appropriate specific ACL or the owner ACL.
If the locked flag is set on an object, no commands can be run on that
object that change data except the C<flags> commands, nor can the C<get>
command be used on that object. C<show>, C<history>, C<getacl>,
-C<getattr>, and C<owner> or C<expires> without an argument can still be
-used on that object.
+C<getattr>, and C<owner>, C<expires>, or C<comment> without an argument
+can still be used on that object.
For more information on attributes, see L<ATTRIBUTES>.
@@ -238,6 +240,15 @@ already exist.
Check whether an object of type <type> and name <name> already exists. If
it does, prints C<yes>; if not, prints C<no>.
+=item comment <type> <name> [<comment>]
+
+If <comment> is not given, displays the current comment for the object
+identified by <type> and <name>, or C<No comment set> if none is set.
+
+If <comment> is given, sets the comment on the object identified by
+<type> and <name> to <comment>. If <comment> is the empty string, clears
+the comment.
+
=item create <type> <name>
Create a new object of type <type> with name <name>. With some backends,
diff --git a/perl/Wallet/Object/Base.pm b/perl/Wallet/Object/Base.pm
index 5097729..28ec6b9 100644
--- a/perl/Wallet/Object/Base.pm
+++ b/perl/Wallet/Object/Base.pm
@@ -1,7 +1,8 @@
# Wallet::Object::Base -- Parent class for any object stored in the wallet.
#
# Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2007, 2008, 2010 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2007, 2008, 2010, 2011
+# The Board of Trustees of the Leland Stanford Junior University
#
# See LICENSE for licensing terms.
@@ -17,6 +18,7 @@ use vars qw($VERSION);
use DBI;
use POSIX qw(strftime);
+use Text::Wrap qw(wrap);
use Wallet::ACL;
# This version should be increased on any code change to this module. Always
@@ -169,7 +171,7 @@ sub log_set {
}
my %fields = map { $_ => 1 }
qw(owner acl_get acl_store acl_show acl_destroy acl_flags expires
- flags type_data);
+ comment flags type_data);
unless ($fields{$field}) {
die "invalid history field $field";
}
@@ -291,6 +293,19 @@ sub attr_show {
return '';
}
+# Get or set the comment value of an object. If setting it, trace information
+# must also be provided.
+sub comment {
+ my ($self, $comment, $user, $host, $time) = @_;
+ if ($comment) {
+ return $self->_set_internal ('comment', $comment, $user, $host, $time);
+ } elsif (defined $comment) {
+ return $self->_set_internal ('comment', undef, $user, $host, $time);
+ } else {
+ return $self->_get_internal ('comment');
+ }
+}
+
# Get or set the expires value of an object. Expects an expiration time in
# seconds since epoch. If setting the expiration, trace information must also
# be provided.
@@ -565,6 +580,7 @@ sub show {
[ ob_acl_destroy => 'Destroy ACL' ],
[ ob_acl_flags => 'Flags ACL' ],
[ ob_expires => 'Expires' ],
+ [ ob_comment => 'Comment' ],
[ ob_created_by => 'Created by' ],
[ ob_created_from => 'Created from' ],
[ ob_created_on => 'Created on' ],
@@ -592,7 +608,14 @@ sub show {
# Format the results. We use a hack to insert the flags before the first
# trace field since they're not a field in the object in their own right.
+ # The comment should be word-wrapped at 80 columns.
for my $i (0 .. $#data) {
+ if ($attrs[$i][0] eq 'ob_comment' && length ($data[$i]) > 79 - 17) {
+ local $Text::Wrap::columns = 80;
+ local $Text::Wrap::unexpand = 0;
+ $data[$i] = wrap (' ' x 17, ' ' x 17, $data[$i]);
+ $data[$i] =~ s/^ {17}//;
+ }
if ($attrs[$i][0] eq 'ob_created_by') {
my @flags = $self->flag_list;
if (not @flags and $self->error) {
@@ -778,6 +801,18 @@ attributes set, this method should return that metadata, formatted as key:
value pairs with the keys right-aligned in the first 15 characters,
followed by a space, a colon, and the value.
+=item comment([COMMENT, PRINCIPAL, HOSTNAME [, DATETIME]])
+
+Sets or retrieves the comment associated with an object. If no arguments
+are given, returns the current comment or undef if no comment is set. If
+arguments are given, change the comment to COMMENT and return true on
+success and false on failure. Pass in the empty string for COMMENT to
+clear the comment.
+
+The other arguments are used for logging and history and should indicate
+the user and host from which the change is made and the time of the
+change.
+
=item destroy(PRINCIPAL, HOSTNAME [, DATETIME])
Destroys the object by removing all record of it from the database. The
diff --git a/perl/Wallet/Schema.pm b/perl/Wallet/Schema.pm
index 0f6c53f..7400776 100644
--- a/perl/Wallet/Schema.pm
+++ b/perl/Wallet/Schema.pm
@@ -145,7 +145,9 @@ sub upgrade {
return;
} elsif ($version == 0) {
@sql = ('create table metadata (md_version integer)',
- 'insert into metadata (md_version) values (1)');
+ 'insert into metadata (md_version) values (1)',
+ 'alter table objects add ob_comment varchar(255) default null'
+ );
} else {
die "unknown database version $version\n";
}
@@ -367,6 +369,7 @@ table:
ob_downloaded_by varchar(255) default null,
ob_downloaded_from varchar(255) default null,
ob_downloaded_on datetime default null,
+ ob_comment varchar(255) default null,
primary key (ob_name, ob_type));
create index ob_owner on objects (ob_owner);
create index ob_expires on objects (ob_expires);
diff --git a/perl/Wallet/Server.pm b/perl/Wallet/Server.pm
index 185bf23..7b3fb8f 100644
--- a/perl/Wallet/Server.pm
+++ b/perl/Wallet/Server.pm
@@ -1,7 +1,8 @@
# Wallet::Server -- Wallet system server implementation.
#
# Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2007, 2008, 2010 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2007, 2008, 2010, 2011
+# The Board of Trustees of the Leland Stanford Junior University
#
# See LICENSE for licensing terms.
@@ -23,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.09';
+$VERSION = '0.10';
##############################################################################
# Utility methods
@@ -276,7 +277,9 @@ sub object_error {
# set the ACL accordingly.
sub acl_check {
my ($self, $object, $action) = @_;
- unless ($action =~ /^(get|store|show|destroy|flags|setattr|getattr)\z/) {
+ my %actions = map { $_ => 1 }
+ qw(get store show destroy flags setattr getattr comment);
+ unless ($actions{$action}) {
$self->error ("unknown action $action");
return;
}
@@ -288,10 +291,10 @@ sub acl_check {
$id = $object->acl ('show');
} elsif ($action eq 'setattr') {
$id = $object->acl ('store');
- } else {
+ } elsif ($action ne 'comment') {
$id = $object->acl ($action);
}
- if (! defined ($id) and $action =~ /^(get|(get|set)attr|store|show)\z/) {
+ if (! defined ($id) and $action ne 'flags' and $action ne 'destroy') {
$id = $object->owner;
}
unless (defined $id) {
@@ -365,6 +368,26 @@ sub attr {
}
}
+# Retrieves or sets the comment of an object.
+sub comment {
+ my ($self, $type, $name, $comment) = @_;
+ undef $self->{error};
+ my $object = $self->retrieve ($type, $name);
+ return unless defined $object;
+ my $result;
+ if (defined $comment) {
+ return unless $self->acl_check ($object, 'comment');
+ $result = $object->comment ($comment, $self->{user}, $self->{host});
+ } else {
+ return unless $self->acl_check ($object, 'show');
+ $result = $object->comment;
+ }
+ if (not defined ($result) and $object->error) {
+ $self->error ($object->error);
+ }
+ return $result;
+}
+
# Retrieves or sets the expiration of an object.
sub expires {
my ($self, $type, $name, $expires) = @_;
@@ -895,6 +918,20 @@ 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 comment(TYPE, NAME, [COMMENT])
+
+Gets or sets the comment for the object identified by TYPE and NAME. If
+COMMENT is not given, returns the current comment or undef if no comment
+is set or on an error. To distinguish between an expiration that isn't
+set and a failure to retrieve the expiration, the caller should call
+error() after an undef return. If error() also returns undef, no comment
+was set; otherwise, error() will return the error message.
+
+If COMMENT is given, sets the comment to COMMENT. Pass in the empty
+string for COMMENT to clear the comment. To set a comment, the current
+user must be the object owner or be on the ADMIN ACL. Returns true for
+success and false for failure.
+
=item create(TYPE, NAME)
Creates a new object of type TYPE and name NAME. TYPE must be a
@@ -933,12 +970,12 @@ Gets or sets the expiration for the object identified by TYPE and NAME.
If EXPIRES is not given, returns the current expiration or undef if no
expiration is set or on an error. To distinguish between an expiration
that isn't set and a failure to retrieve the expiration, the caller should
-call error() after an undef return. If error() also returns undef, that
-ACL wasn't set; otherwise, error() will return the error message.
+call error() after an undef return. If error() also returns undef, the
+expiration wasn't set; otherwise, error() will return the error message.
If EXPIRES is given, sets the expiration to EXPIRES. EXPIRES must be in
the format C<YYYY-MM-DD +HH:MM:SS>, although the time portion may be
-omitted. Pass in the empty +string for EXPIRES to clear the expiration
+omitted. Pass in the empty string for EXPIRES to clear the expiration
date. To set an expiration, the current user must be authorized by the
ADMIN ACL. Returns true for success and false for failure.
diff --git a/perl/t/object.t b/perl/t/object.t
index 3949786..2d60dd2 100755
--- a/perl/t/object.t
+++ b/perl/t/object.t
@@ -3,12 +3,13 @@
# Tests for the basic object implementation.
#
# Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2007, 2008, 2011
+# The Board of Trustees of the Leland Stanford Junior University
#
# See LICENSE for licensing terms.
use POSIX qw(strftime);
-use Test::More tests => 131;
+use Test::More tests => 137;
use Wallet::ACL;
use Wallet::Admin;
@@ -99,6 +100,23 @@ if ($object->expires ('', @trace)) {
is ($object->expires, undef, ' at which point it is cleared');
is ($object->expires ($now, @trace), 1, ' and setting it again works');
+# Comment.
+is ($object->comment, undef, 'Comment is not set to start');
+if ($object->comment ('this is a comment', @trace)) {
+ ok (1, ' and setting it works');
+} else {
+ is ($object->error, '', ' and setting it works');
+}
+is ($object->comment, 'this is a comment', ' at which point it matches');
+if ($object->comment ('', @trace)) {
+ ok (1, ' and clearing it works');
+} else {
+ is ($object->error, '', ' and clearing it works');
+}
+is ($object->comment, undef, ' at which point it is cleared');
+is ($object->comment (join (' ', ('this is a comment') x 5), @trace), 1,
+ ' and setting it again works');
+
# ACLs.
for my $type (qw/get store show destroy flags/) {
is ($object->acl ($type), undef, "ACL $type is not set to start");
@@ -203,6 +221,8 @@ my $output = <<"EOO";
Destroy ACL: ADMIN
Flags ACL: ADMIN
Expires: $now
+ Comment: this is a comment this is a comment this is a comment this is
+ a comment this is a comment
Flags: unchanging
Created by: $user
Created from: $host
@@ -223,6 +243,8 @@ $output = <<"EOO";
Destroy ACL: ADMIN
Flags ACL: ADMIN
Expires: $now
+ Comment: this is a comment this is a comment this is a comment this is
+ a comment this is a comment
Flags: locked unchanging
Created by: $user
Created from: $host
@@ -267,6 +289,12 @@ $date unset expires (was $now)
by $user from $host
$date set expires to $now
by $user from $host
+$date set comment to this is a comment
+ by $user from $host
+$date unset comment (was this is a comment)
+ by $user from $host
+$date set comment to this is a comment this is a comment this is a comment this is a comment this is a comment
+ by $user from $host
$date set acl_get to ADMIN (1)
by $user from $host
$date unset acl_get (was ADMIN (1))
diff --git a/perl/t/schema.t b/perl/t/schema.t
index c66ad59..ce8a62a 100755
--- a/perl/t/schema.t
+++ b/perl/t/schema.t
@@ -8,11 +8,12 @@
#
# See LICENSE for licensing terms.
-use Test::More tests => 15;
+use Test::More tests => 16;
-use DBI;
-use Wallet::Config;
-use Wallet::Schema;
+use DBI ();
+use POSIX qw(strftime);
+use Wallet::Config ();
+use Wallet::Schema ();
use lib 't/lib';
use Util;
@@ -45,14 +46,34 @@ is (@$version, 1, 'metadata has correct number of rows');
is (@{ $version->[0] }, 1, ' and correct number of columns');
is ($version->[0][0], 1, ' and the schema version is correct');
-# Test upgrading the database from version 0.
+# Test upgrading the database from version 0. SQLite cannot drop table
+# columns, so we have to kill the table and then recreate it.
$dbh->do ("drop table metadata");
+if (lc ($Wallet::Config::DB_DRIVER) eq 'sqlite') {
+ ($sql) = grep { /create table objects/ } $schema->sql;
+ $sql =~ s/ob_comment .*,//;
+ $dbh->do ("drop table objects")
+ or die "cannot drop objects table: $DBI::errstr\n";
+ $dbh->do ($sql)
+ or die "cannot recreate objects table: $DBI::errstr\n";
+} else {
+ $dbh->do ("alter table objects drop column ob_comment")
+ or die "cannot drop ob_comment column: $DBI::errstr\n";
+}
eval { $schema->upgrade ($dbh) };
is ($@, '', "upgrade() doesn't die");
+$sql = "select md_version from metadata";
$version = $dbh->selectall_arrayref ($sql);
is (@$version, 1, ' and metadata has correct number of rows');
is (@{ $version->[0] }, 1, ' and correct number of columns');
is ($version->[0][0], 1, ' and the schema version is correct');
+$sql = "insert into objects (ob_type, ob_name, ob_created_by, ob_created_from,
+ ob_created_on, ob_comment) values ('file', 'test', 'test',
+ 'test.example.org', ?, 'a test comment')";
+$dbh->do ($sql, undef, strftime ('%Y-%m-%d %T', localtime time));
+$sql = "select ob_comment from objects where ob_name = 'test'";
+my ($comment) = $dbh->selectrow_array ($sql);
+is ($comment, 'a test comment', ' and ob_comment was added to objects');
# Test dropping the database.
eval { $schema->drop ($dbh) };
diff --git a/perl/t/server.t b/perl/t/server.t
index ed92d6e..ad16151 100755
--- a/perl/t/server.t
+++ b/perl/t/server.t
@@ -3,11 +3,12 @@
# Tests for the wallet server API.
#
# Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2007, 2008, 2010 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2007, 2008, 2010, 2011
+# The Board of Trustees of the Leland Stanford Junior University
#
# See LICENSE for licensing terms.
-use Test::More tests => 355;
+use Test::More tests => 377;
use POSIX qw(strftime);
use Wallet::Admin;
@@ -199,6 +200,24 @@ is ($server->check ('base', 'service/test'), 0,
is ($server->destroy ('base', 'service/test'), undef, ' but not twice');
is ($server->error, 'cannot find base:service/test', ' with the right error');
+# Test manipulating comments.
+is ($server->comment ('base', 'service/test'), undef,
+ 'Retrieving comment on an unknown object fails');
+is ($server->error, 'cannot find base:service/test', ' with the right error');
+is ($server->comment ('base', 'service/test', 'this is a comment'), undef,
+ ' and setting it also fails');
+is ($server->error, 'cannot find base:service/test', ' with the right error');
+is ($server->comment ('base', 'service/admin'), undef,
+ 'Retrieving comment for the right object returns undef');
+is ($server->error, undef, ' but there is no error');
+is ($server->comment ('base', 'service/admin', 'this is a comment'), 1,
+ ' and we can set it');
+is ($server->comment ('base', 'service/admin'), 'this is a comment',
+ ' and get the value back');
+is ($server->comment ('base', 'service/admin', ''), 1, ' and clear it');
+is ($server->comment ('base', 'service/admin'), undef, ' and now it is gone');
+is ($server->error, undef, ' and still no error');
+
# Test manipulating expires.
my $now = strftime ('%Y-%m-%d %T', localtime time);
is ($server->expires ('base', 'service/test'), undef,
@@ -393,6 +412,10 @@ is ($server->flag_clear ('base', 'service/admin', 'unchanging'), 1,
$history = <<"EOO";
DATE create
by $admin from $host
+DATE set comment to this is a comment
+ by $admin from $host
+DATE unset comment (was this is a comment)
+ by $admin from $host
DATE set expires to $now
by $admin from $host
DATE unset expires (was $now)
@@ -510,12 +533,15 @@ is ($server->store ('base', 'service/user1', 'stuff'), undef,
is ($server->error,
"cannot store base:service/user1: object type is immutable",
' and the method is called');
+is ($server->comment ('base', 'service/user1', 'this is a comment'), 1,
+ ' and set a comment');
$show = $server->show ('base', 'service/user1');
$show =~ s/(Created on:) [\d-]+ [\d:]+$/$1 0/m;
$expected = <<"EOO";
Type: base
Name: service/user1
Owner: user1
+ Comment: this is a comment
Created by: $admin
Created from: $host
Created on: 0
@@ -529,6 +555,8 @@ DATE create
by $admin from $host
DATE set owner to user1 (2)
by $admin from $host
+DATE set comment to this is a comment
+ by $user1 from $host
EOO
$seen = $server->history ('base', 'service/user1');
$seen =~ s/^\d{4}-\d\d-\d\d \d\d:\d\d:\d\d/DATE/gm;
@@ -566,6 +594,11 @@ is ($server->attr ('base', 'service/user2', 'foo', ''), undef,
is ($server->error,
"$user1 not authorized to set attributes for base:service/user2",
' with the right error');
+is ($server->comment ('base', 'service/user2', 'this is a comment'), undef,
+ ' and set comment');
+is ($server->error,
+ "$user1 not authorized to set comment for base:service/user2",
+ ' with the right error');
# And only some things on an object we own with some ACLs.
$result = eval { $server->get ('base', 'service/both') };
@@ -702,8 +735,27 @@ is ($server->history ('base', 'service/user1'), undef,
' or see history for it');
is ($server->error, "$user2 not authorized to show base:service/user1",
' with the right error');
+is ($server->comment ('base', 'service/user1', 'this is a comment'), undef,
+ ' or set a comment for it');
+is ($server->error,
+ "$user2 not authorized to set comment for base:service/user1",
+ ' with the right error');
-# And only some things on an object we own with some ACLs.
+# Test that setting a comment is controlled by the owner but retrieving it is
+# controlled by the show ACL.
+$result = eval { $server->get ('base', 'service/both') };
+is ($result, undef, 'We can get an object we jointly own');
+is ($@, "Do not instantiate Wallet::Object::Base directly\n",
+ ' and the method is called');
+is ($server->comment ('base', 'service/both', 'this is a comment'), 1,
+ ' and can set a comment on it');
+is ($server->error, undef, ' with no error');
+is ($server->comment ('base', 'service/both'), undef,
+ ' but cannot see the comment on it');
+is ($server->error, "$user2 not authorized to show base:service/both",
+ ' with the right error');
+
+# And can only do some things on an object we own with some ACLs.
$result = eval { $server->get ('base', 'service/both') };
is ($result, undef, 'We can get an object we jointly own');
is ($@, "Do not instantiate Wallet::Object::Base directly\n",
diff --git a/server/wallet-backend b/server/wallet-backend
index 52e9857..9850c0e 100755
--- a/server/wallet-backend
+++ b/server/wallet-backend
@@ -3,7 +3,8 @@
# wallet-backend -- Wallet server for storing and retrieving secure data.
#
# Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2007, 2008, 2010 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2007, 2008, 2010, 2011
+# The Board of Trustees of the Leland Stanford Junior University
#
# See LICENSE for licensing terms.
@@ -191,6 +192,20 @@ sub command {
} else {
print $status ? "yes\n" : "no\n";
}
+ } elsif ($command eq 'comment') {
+ check_args (2, 3, [], @args);
+ if (@args > 2) {
+ $server->comment (@args) or failure ($server->error, @_);
+ } else {
+ my $output = $server->comment (@args);
+ if (defined $output) {
+ print $output, "\n";
+ } elsif (not $server->error) {
+ print "No comment set\n";
+ } else {
+ failure ($server->error, @_);
+ }
+ }
} elsif ($command eq 'create') {
check_args (2, 2, [], @args);
$server->create (@args) or failure ($server->error, @_);
@@ -364,13 +379,14 @@ Most commands are only available to wallet administrators (users on the
C<ADMIN> ACL). The exceptions are C<autocreate>, C<get>, C<store>,
C<show>, C<destroy>, C<flag clear>, C<flag set>, C<getattr>, C<setattr>,
and C<history>. All of those commands have their own ACLs except
-C<getattr> and C<history>, which use the C<show> ACL, and C<setattr>,
-which uses the C<store> ACL. If the appropriate ACL is set, it alone is
-checked to see if the user has access. Otherwise, C<get>, C<store>,
-C<show>, C<getattr>, C<setattr>, and C<history> access is permitted if the
-user is authorized by the owner ACL of the object. C<autocreate> is
-permitted if the user is listed in the default ACL for an object for that
-name.
+C<getattr> and C<history>, which use the C<show> ACL, C<setattr>, which
+uses the C<store> ACL, and C<comment>, which uses the owner or C<show>
+ACL depending on whether one is setting or retrieving the comment. If the
+appropriate ACL is set, it alone is checked to see if the user has access.
+Otherwise, C<get>, C<store>, C<show>, C<getattr>, C<setattr>, C<history>,
+and C<comment> access is permitted if the user is authorized by the owner
+ACL of the object. C<autocreate> is permitted if the user is listed in
+the default ACL for an object for that name.
Administrators can run any command on any object or ACL except for C<get>
and C<store>. For C<get> and C<store>, they must still be authorized by
@@ -379,8 +395,8 @@ either the appropriate specific ACL or the owner ACL.
If the locked flag is set on an object, no commands can be run on that
object that change data except the C<flags> commands, nor can the C<get>
command be used on that object. C<show>, C<history>, C<getacl>,
-C<getattr>, and C<owner> or C<expires> without an argument can still be
-used on that object.
+C<getattr>, and C<owner>, C<comment>, or C<expires> without an argument
+can still be used on that object.
For more information on attributes, see L<ATTRIBUTES>.
@@ -437,6 +453,15 @@ object will be created with that default ACL set as the object owner.
Check whether an object of type <type> and name <name> already exists. If
it does, prints C<yes>; if not, prints C<no>.
+=item comment <type> <name> [<comment>]
+
+If <comment> is not given, displays the current comment for the object
+identified by <type> and <name>, or C<No comment set> if none is set.
+
+If <comment> is given, sets the comment on the object identified by
+<type> and <name> to <comment>. If <comment> is the empty string, clears
+the comment.
+
=item create <type> <name>
Create a new object of type <type> with name <name>. With some backends,
diff --git a/tests/server/backend-t b/tests/server/backend-t
index a618391..3e377a1 100755
--- a/tests/server/backend-t
+++ b/tests/server/backend-t
@@ -3,13 +3,13 @@
# Tests for the wallet-backend dispatch code.
#
# Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2006, 2007, 2008, 2009, 2010
-# Board of Trustees, Leland Stanford Jr. University
+# Copyright 2006, 2007, 2008, 2009, 2010, 2011
+# The Board of Trustees of the Leland Stanford Junior University
#
# See LICENSE for licensing terms.
use strict;
-use Test::More tests => 1269;
+use Test::More tests => 1296;
# Create a dummy class for Wallet::Server that prints what method was called
# with its arguments and returns data for testing.
@@ -110,6 +110,19 @@ sub check {
}
}
+sub comment {
+ shift;
+ print "comment @_\n";
+ if ($_[0] eq 'error') {
+ return;
+ } elsif ($_[1] eq 'empty') {
+ $okay = 1;
+ return;
+ } else {
+ return 'comment';
+ }
+}
+
sub expires {
shift;
print "expires @_\n";
@@ -216,6 +229,7 @@ is ($out, "$new\n", ' and nothing ran');
# Check too few, too many, and bad arguments for every command.
my %commands = (autocreate => [2, 2],
check => [2, 2],
+ comment => [2, 3],
create => [2, 2],
destroy => [2, 2],
expires => [2, 4],
@@ -363,7 +377,8 @@ for my $command (qw/autocreate create destroy setacl setattr store/) {
' and ran the right method');
$error++;
}
-for my $command (qw/check expires get getacl getattr history owner show/) {
+for my $command (qw/check comment expires get getacl getattr history owner
+ show/) {
my $method = { getacl => 'acl', getattr => 'attr' }->{$command};
$method ||= $command;
my @extra = ('foo') x ($commands{$command}[0] - 2);
@@ -384,7 +399,8 @@ for my $command (qw/check expires get getacl getattr history owner show/) {
is ($out, "$new\n$method type name$extra\n$method$newline",
' and ran the right method with output');
}
- if ($command eq 'expires' or $command eq 'owner') {
+ if ($command eq 'expires' or $command eq 'owner'
+ or $command eq 'comment') {
($out, $err) = run_backend ($command, 'type', 'name', @extra, 'foo');
my $ran = "$command type name" . (@extra ? " @extra" : '') . ' foo';
is ($err, '', "Command $command ran with no errors (setting)");
@@ -393,14 +409,16 @@ for my $command (qw/check expires get getacl getattr history owner show/) {
is ($out, "$new\n$method type name$extra foo\n",
' and ran the right method');
}
- if ($command eq 'expires' or $command eq 'getacl' or $command eq 'owner') {
+ if ($command eq 'expires' or $command eq 'getacl'
+ or $command eq 'owner' or $command eq 'comment') {
($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');
my $desc;
- if ($command eq 'expires') { $desc = 'expiration' }
+ if ($command eq 'comment') { $desc = 'comment' }
+ elsif ($command eq 'expires') { $desc = 'expiration' }
elsif ($command eq 'getacl') { $desc = 'ACL' }
elsif ($command eq 'owner') { $desc = 'owner' }
is ($out, "$new\n$method type empty$extra\nNo $desc set\n",