From 574a9c0456c182831b3d01a4d7ee0c737b91b107 Mon Sep 17 00:00:00 2001
From: Russ Allbery <rra@stanford.edu>
Date: Tue, 9 Jun 2009 14:39:39 -0700
Subject: Remove Subversion Id strings

---
 server/wallet-backend | 1 -
 1 file changed, 1 deletion(-)

(limited to 'server/wallet-backend')

diff --git a/server/wallet-backend b/server/wallet-backend
index 74e0eb0..448f175 100755
--- a/server/wallet-backend
+++ b/server/wallet-backend
@@ -1,5 +1,4 @@
 #!/usr/bin/perl
-our $ID = q$Id$;
 #
 # wallet-backend -- Wallet server for storing and retrieving secure data.
 #
-- 
cgit v1.2.3


From cbdc17af5f7a772188638f0057fffd357acbbd38 Mon Sep 17 00:00:00 2001
From: Russ Allbery <rra@stanford.edu>
Date: Tue, 9 Feb 2010 13:41:11 -0800
Subject: Use the long enctype name for aes256-cts-hmac-sha1-96

Heimdal requires the full name and doesn't support the short name that
MIT has as an alias.  Change the documentation to use the long name
uniformly.
---
 client/wallet.pod             |  6 +++---
 perl/Wallet/Kadmin.pm         |  2 +-
 perl/Wallet/Kadmin/Heimdal.pm | 16 ++++++++--------
 perl/Wallet/Kadmin/MIT.pm     | 14 ++++++++------
 server/wallet-backend         |  6 +++---
 5 files changed, 23 insertions(+), 21 deletions(-)

(limited to 'server/wallet-backend')

diff --git a/client/wallet.pod b/client/wallet.pod
index 6451e72..9908bb1 100644
--- a/client/wallet.pod
+++ b/client/wallet.pod
@@ -374,9 +374,9 @@ Keytab objects support the following attributes:
 
 Restricts the generated keytab to a specific set of encryption types.  The
 values of this attribute must be enctype strings recognized by Kerberos
-(strings like C<aes256-cts> or C<des-cbc-crc>).  Note that the salt should
-not be included; since the salt is irrelevant for keytab keys, it will
-always be set to C<normal> by the wallet.
+(strings like C<aes256-cts-hmac-sha1-96> or C<des-cbc-crc>).  Note that
+the salt should not be included; since the salt is irrelevant for keytab
+keys, it will always be set to C<normal> by the wallet.
 
 If this attribute is set, the specified enctype list will be passed to ktadd
 when get() is called for that keytab.  If it is not set, the default set in
diff --git a/perl/Wallet/Kadmin.pm b/perl/Wallet/Kadmin.pm
index 5c01ee3..65ddf4b 100644
--- a/perl/Wallet/Kadmin.pm
+++ b/perl/Wallet/Kadmin.pm
@@ -63,7 +63,7 @@ Wallet::Kadmin - Kadmin module wrapper for wallet keytabs
 
     my $kadmin = Wallet::Kadmin->new ();
     $kadmin->addprinc ("host/shell.example.com");
-    $kadmin->ktadd ("host/shell.example.com", "aes256-cts");
+    $kadmin->ktadd ("host/shell.example.com", "aes256-cts-hmac-sha1-96");
     my $exists = $kadmin->exists ("host/oldshell.example.com");
     $kadmin->delprinc ("host/oldshell.example.com") if $exists;
 
diff --git a/perl/Wallet/Kadmin/Heimdal.pm b/perl/Wallet/Kadmin/Heimdal.pm
index 2ca8dcd..428202b 100644
--- a/perl/Wallet/Kadmin/Heimdal.pm
+++ b/perl/Wallet/Kadmin/Heimdal.pm
@@ -1,7 +1,7 @@
 # Wallet::Kadmin::Heimdal -- Heimdal Kadmin interactions for the wallet.
 #
 # Written by Jon Robertson <jonrober@stanford.edu>
-# Copyright 2009 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2009, 2010 Board of Trustees, Leland Stanford Jr. University
 #
 # See LICENSE for licensing terms.
 
@@ -238,7 +238,7 @@ Wallet::Kadmin::MIT - MIT admin interactions for wallet keytabs
 
     my $kadmin = Wallet::Kadmin::MIT->new ();
     $kadmin->addprinc ("host/shell.example.com");
-    $kadmin->ktadd ("host/shell.example.com", "aes256-cts");
+    $kadmin->ktadd ("host/shell.example.com", "aes256-cts-hmac-sha1-96");
     my $exists = $kadmin->exists ("host/oldshell.example.com");
     $kadmin->delprinc ("host/oldshell.example.com") if $exists;
 
@@ -282,10 +282,11 @@ reality.
 
 =item ktadd(PRINCIPAL, FILE, ENCTYPES)
 
-Creates a new keytab for the given principal, as the given file, limited to
-the enctypes supplied.  The enctype values must be enctype strings recognized
-by Kerberos (strings like C<aes256-cts> or C<des-cbc-crc>).  An error is
-thrown on failure or if the creation fails, otherwise true is returned.
+Creates a new keytab for the given principal, as the given file, limited
+to the enctypes supplied.  The enctype values must be enctype strings
+recognized by Kerberos (strings like C<aes256-cts-hmac-sha1-96> or
+C<des-cbc-crc>).  An error is thrown on failure or if the creation fails,
+otherwise true is returned.
 
 =back
 
@@ -305,7 +306,6 @@ from L<http://www.eyrie.org/~eagle/software/wallet/>.
 
 =head1 AUTHORS
 
-Russ Allbery <rra@stanford.edu>
-Jon Robertson <jonrober@stanford.edu>
+Russ Allbery <rra@stanford.edu> and Jon Robertson <jonrober@stanford.edu>.
 
 =cut
diff --git a/perl/Wallet/Kadmin/MIT.pm b/perl/Wallet/Kadmin/MIT.pm
index c3ad901..49691b0 100644
--- a/perl/Wallet/Kadmin/MIT.pm
+++ b/perl/Wallet/Kadmin/MIT.pm
@@ -2,7 +2,8 @@
 #
 # Written by Russ Allbery <rra@stanford.edu>
 # Pulled into a module by Jon Robertson <jonrober@stanford.edu>
-# Copyright 2007, 2008, 2009 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2007, 2008, 2009, 2010
+#     Board of Trustees, Leland Stanford Jr. University
 #
 # See LICENSE for licensing terms.
 
@@ -233,7 +234,7 @@ Wallet::Kadmin::MIT - MIT admin interactions for wallet keytabs
 
     my $kadmin = Wallet::Kadmin::MIT->new ();
     $kadmin->addprinc ("host/shell.example.com");
-    $kadmin->ktadd ("host/shell.example.com", "aes256-cts");
+    $kadmin->ktadd ("host/shell.example.com", "aes256-cts-hmac-sha1-96");
     my $exists = $kadmin->exists ("host/oldshell.example.com");
     $kadmin->delprinc ("host/oldshell.example.com") if $exists;
 
@@ -277,10 +278,11 @@ reality.
 
 =item ktadd(PRINCIPAL, FILE, ENCTYPES)
 
-Creates a new keytab for the given principal, as the given file, limited to
-the enctypes supplied.  The enctype values must be enctype strings recognized
-by Kerberos (strings like C<aes256-cts> or C<des-cbc-crc>).  An error is
-thrown on failure or if the creation fails, otherwise true is returned.
+Creates a new keytab for the given principal, as the given file, limited
+to the enctypes supplied.  The enctype values must be enctype strings
+recognized by Kerberos (strings like C<aes256-cts-hmac-sha1-96> or
+C<des-cbc-crc>).  An error is thrown on failure or if the creation fails,
+otherwise true is returned.
 
 =back
 
diff --git a/server/wallet-backend b/server/wallet-backend
index 448f175..2b58255 100755
--- a/server/wallet-backend
+++ b/server/wallet-backend
@@ -558,9 +558,9 @@ Keytab objects support the following attributes:
 
 Restricts the generated keytab to a specific set of encryption types.  The
 values of this attribute must be enctype strings recognized by Kerberos
-(strings like C<aes256-cts> or C<des-cbc-crc>).  Note that the salt should
-not be included; since the salt is irrelevant for keytab keys, it will
-always be set to C<normal> by the wallet.
+(strings like C<aes256-cts-hmac-sha1-96> or C<des-cbc-crc>).  Note that
+the salt should not be included; since the salt is irrelevant for keytab
+keys, it will always be set to C<normal> by the wallet.
 
 If this attribute is set, the specified enctype list will be passed to ktadd
 when get() is called for that keytab.  If it is not set, the default set in
-- 
cgit v1.2.3


From 1ec1398452733d861b1b68253e6de0b8cb9f757f Mon Sep 17 00:00:00 2001
From: Russ Allbery <rra@stanford.edu>
Date: Tue, 9 Feb 2010 13:42:01 -0800
Subject: Remove the sync documentation from wallet-backend

The code to support the attribute is still present in case we add a
system with which to synchronize later on.
---
 server/wallet-backend | 20 --------------------
 1 file changed, 20 deletions(-)

(limited to 'server/wallet-backend')

diff --git a/server/wallet-backend b/server/wallet-backend
index 2b58255..0770f97 100755
--- a/server/wallet-backend
+++ b/server/wallet-backend
@@ -571,26 +571,6 @@ Keytabs retrieved with C<unchanging> set will contain all keys present in
 the KDC for that Kerberos principal and therefore may contain different
 enctypes than those requested by this attribute.
 
-=item sync
-
-Sets the external systems to which the key of a given principal is
-synchronized.  The only supported value for this attribute is C<kaserver>,
-which says to synchronize the key with an AFS Kerberos v4 kaserver.
-
-If this attribute is set on a keytab, whenever the C<get> command is run for
-that keytab, the DES key will be extracted from that keytab and set in the
-configured AFS kaserver.  The Kerberos v4 principal name will be the same as
-the Kerberos v5 principal name except that the components are separated by
-C<.> instead of C</>; the second component is truncated after the first C<.>
-if the first component is one of C<host>, C<ident>, C<imap>, C<pop>, or
-C<smtp>; and the first component is C<rcmd> if the Kerberos v5 principal
-component is C<host>.  The principal name must not contain more than two
-components.
-
-If this attribute is set, calling C<destroy> will also destroy the
-principal from the AFS kaserver, with a principal mapping determined as
-above.
-
 =back
 
 =head1 SEE ALSO
-- 
cgit v1.2.3


From 5d7f614e88bac459a693f1dcc91aad36ed3d00dd Mon Sep 17 00:00:00 2001
From: Russ Allbery <rra@stanford.edu>
Date: Tue, 9 Feb 2010 23:57:10 -0800
Subject: Reorganize main POD tests and add a spelling check

Add a POD spelling test to the non-Perl-module part of the code and
move the documentation tests into a separate directory.  Merge the
POD syntax tests between client and server into one test.

Reformat all of the POD documentation to use 74 columns.  Fix a few
revealed spelling errors or weird wordings.
---
 client/wallet.pod         | 11 ++++---
 server/keytab-backend     | 64 +++++++++++++++++++-----------------
 server/wallet-admin       | 17 ++++++----
 server/wallet-backend     | 83 +++++++++++++++++++++++++----------------------
 tests/TESTS               |  4 +--
 tests/client/pod-t        | 22 -------------
 tests/docs/pod-spelling-t | 80 +++++++++++++++++++++++++++++++++++++++++++++
 tests/docs/pod-t          | 21 ++++++++++++
 tests/server/pod-t        | 22 -------------
 9 files changed, 200 insertions(+), 124 deletions(-)
 delete mode 100755 tests/client/pod-t
 create mode 100755 tests/docs/pod-spelling-t
 create mode 100755 tests/docs/pod-t
 delete mode 100755 tests/server/pod-t

(limited to 'server/wallet-backend')

diff --git a/client/wallet.pod b/client/wallet.pod
index 9908bb1..09fb571 100644
--- a/client/wallet.pod
+++ b/client/wallet.pod
@@ -2,6 +2,11 @@
 
 wallet - Client for retrieving secure data from a central server
 
+=for stopwords
+-hv srvtab arg keytabs metadata keytab ACL PTS kinit klist remctl PKINIT
+acl timestamp autocreate backend-specific setacl enctypes enctype ktadd
+KDC appdefaults remctld Allbery nul uuencode getacl backend
+
 =head1 SYNOPSIS
 
 B<wallet> [B<-hv>] [B<-c> I<command>] [B<-f> I<file>]
@@ -44,9 +49,7 @@ entries, each of which is a scheme and an identifier.  A scheme specifies
 a way of checking whether a user is authorized.  An identifier is some
 data specific to the scheme that specifies which users are authorized.
 For example, for the C<krb5> scheme, the identifier is a principal name
-and only that principal is authorized by that ACL entry.  For the C<pts>
-scheme, the identifier is a PTS group name, and all members of that PTS
-group are authorized by that ACL entry.
+and only that principal is authorized by that ACL entry.
 
 To run the wallet command-line client, you must already have a Kerberos
 ticket.  You can obtain a Kerberos ticket with B<kinit> and see your
@@ -201,7 +204,7 @@ Display the history of the ACL <id>.  Each change to the ACL (not
 including changes to the name of the ACL) will be represented by two
 lines.  The first line will have a timestamp of the change followed by a
 description of the change, and the second line will give the user who made
-the change and the host from which the change was mde.
+the change and the host from which the change was made.
 
 =item acl remove <id> <scheme> <identifier>
 
diff --git a/server/keytab-backend b/server/keytab-backend
index b37fb3a..7b6adb4 100755
--- a/server/keytab-backend
+++ b/server/keytab-backend
@@ -17,7 +17,8 @@
 # The keytab for the extracted principal will be printed to standard output.
 #
 # Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2006, 2007, 2008 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2006, 2007, 2008, 2010
+#     Board of Trustees, Leland Stanford Jr. University
 #
 # See LICENSE for licensing terms.
 
@@ -155,6 +156,10 @@ __END__
 # Documentation
 ##############################################################################
 
+=for stopwords
+keytab-backend keytabs KDC keytab kadmin.local -norandkey ktadd remctld
+auth Allbery rekeying
+
 =head1 NAME
 
 keytab-backend - Extract keytabs from the KDC without changing the key
@@ -165,27 +170,28 @@ B<keytab-backend> retrieve I<principal>
 
 =head1 DESCRIPTION
 
-B<keytab-backend> retrieves a keytab for an existing principal from the KDC
-database without changing the current key.  It allows generation of a keytab
-for a service without rekeying that service.  It requires a B<kadmin.local>
-patched to support the B<-norandkey> option to B<ktadd>.
+B<keytab-backend> retrieves a keytab for an existing principal from the
+KDC database without changing the current key.  It allows generation of a
+keytab for a service without rekeying that service.  It requires a
+B<kadmin.local> patched to support the B<-norandkey> option to B<ktadd>.
 
-This script is intended to run under B<remctld>.  On success, it prints the
-keytab to standard output, logs a success message to syslog (facility auth,
-priority info), and exits with status 0.  On failure, it prints out an error
-message, logs an error to syslog (facility auth, priority err), and exits
-with a non-zero status.
+This script is intended to run under B<remctld>.  On success, it prints
+the keytab to standard output, logs a success message to syslog (facility
+auth, priority info), and exits with status 0.  On failure, it prints out
+an error message, logs an error to syslog (facility auth, priority err),
+and exits with a non-zero status.
 
 The principal is checked for basic sanity (only accepting alphanumerics,
-C<_>, and C<-> with an optional instance and then only alphanumerics, C<_>,
-C<->, and C<.> in the realm) and then checked against a configuration file
-that lists regexes of principals that can be retrieved.  When deploying this
-software, limit as tightly as possible which principals can be downloaded in
-this fashion.  Generally only shared service principals used on multiple
-systems should be made available in this way.
+C<_>, and C<-> with an optional instance and then only alphanumerics,
+C<_>, C<->, and C<.> in the realm) and then checked against a
+configuration file that lists regexes of principals that can be retrieved.
+When deploying this software, limit as tightly as possible which
+principals can be downloaded in this fashion.  Generally only shared
+service principals used on multiple systems should be made available in
+this way.
 
-B<keytab-backend> does not do any authorization checks.  Those should be done
-by B<remctld> before it is called.
+B<keytab-backend> does not do any authorization checks.  Those should be
+done by B<remctld> before it is called.
 
 =head1 FILES
 
@@ -193,19 +199,19 @@ by B<remctld> before it is called.
 
 =item F</etc/krb5kdc/allow-extract>
 
-The configuration file that controls which principals can have their keytabs
-retrieved.  Blank lines and lines starting with C<#>, as well as anything
-after C<#> on a line, are ignored.  All other lines should be Perl regular
-expressions, one per line, that match principals whose keytabs can be
-retrieved by B<keytab-backend>.  Any principal that does not match one of
-those regular expressions cannot be retrieved.
+The configuration file that controls which principals can have their
+keytabs retrieved.  Blank lines and lines starting with C<#>, as well as
+anything after C<#> on a line, are ignored.  All other lines should be
+Perl regular expressions, one per line, that match principals whose
+keytabs can be retrieved by B<keytab-backend>.  Any principal that does
+not match one of those regular expressions cannot be retrieved.
 
 =item F</var/lib/keytabs>
 
 The temporary directory used for creating keytabs.  B<keytab-backend> will
-create the keytab in this directory, make sure that was successful, and then
-delete the temporary file after the results have been sent to standard
-output.
+create the keytab in this directory, make sure that was successful, and
+then delete the temporary file after the results have been sent to
+standard output.
 
 =back
 
@@ -213,8 +219,8 @@ output.
 
 kadmin.local(8), remctld(8)
 
-This program is part of the wallet system.  The current version is available
-from L<http://www.eyrie.org/~eagle/software/wallet/>.
+This program is part of the wallet system.  The current version is
+available from L<http://www.eyrie.org/~eagle/software/wallet/>.
 
 =head1 AUTHOR
 
diff --git a/server/wallet-admin b/server/wallet-admin
index cd775b6..828cfc5 100755
--- a/server/wallet-admin
+++ b/server/wallet-admin
@@ -1,9 +1,9 @@
 #!/usr/bin/perl -w
 #
-# wallet-admin -- Wallet server administrative commands.
+# wallet-backend -- Wallet server administrative commands.
 #
 # Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2008, 2009 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2008, 2009, 2010 Board of Trustees, Leland Stanford Jr. University
 #
 # See LICENSE for licensing terms.
 
@@ -110,6 +110,9 @@ __END__
 
 wallet-admin - Wallet server administrative commands
 
+=for stopwords
+metadata ACL hostname backend acl acls wildcard SQL Allbery
+
 =head1 SYNOPSIS
 
 B<wallet-admin> I<command> [I<args> ...]
@@ -171,8 +174,8 @@ be listed in the form:
 
 In both cases, there will be one line per ACL or object.
 
-If no searchtype is given, all the ACLs or objects in the database will
-be returned.  If a searchtype (and possible search arguments) are given,
+If no search type is given, all the ACLs or objects in the database will
+be returned.  If a search type (and possible search arguments) are given,
 then the ACLs or objects will be limited to those that match the search.
 
 The currently supported object search types are:
@@ -206,7 +209,7 @@ The currently supported ACL search types are:
 =item list acls empty
 
 Returns all ACLs which have no entries, generally so that abandoned ACLs
-can be housekept.
+can be destroyed.
 
 =item list acls entry <schema> <identifier>
 
@@ -256,8 +259,8 @@ with duplicates suppressed.
 
 Wallet::Admin(3), Wallet::Config(3), wallet-backend(8)
 
-This program is part of the wallet system.  The current version is available
-from L<http://www.eyrie.org/~eagle/software/wallet/>.
+This program is part of the wallet system.  The current version is
+available from L<http://www.eyrie.org/~eagle/software/wallet/>.
 
 =head1 AUTHOR
 
diff --git a/server/wallet-backend b/server/wallet-backend
index 0770f97..7780758 100755
--- a/server/wallet-backend
+++ b/server/wallet-backend
@@ -3,7 +3,7 @@
 # wallet-backend -- Wallet server for storing and retrieving secure data.
 #
 # Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2007, 2008, 2010 Board of Trustees, Leland Stanford Jr. University
 #
 # See LICENSE for licensing terms.
 
@@ -311,6 +311,11 @@ __END__
 # The commands section of this document is duplicated from the documentation
 # for wallet and should be kept in sync.
 
+=for stopwords
+wallet-backend backend backend-specific remctld ACL acl timestamp getacl
+setacl metadata nul keytab keytabs enctypes enctype ktadd KDC Allbery
+autocreate
+
 =head1 NAME
 
 wallet-backend - Wallet server for storing and retrieving secure data
@@ -321,20 +326,22 @@ B<wallet-backend> [B<-q>] I<command> [I<args> ...]
 
 =head1 DESCRIPTION
 
-B<wallet-backend> implements the interface between B<remctld> and the wallet
-system.  It is written to run under B<remctld> and expects the authenticated
-identity of the remote user in the REMOTE_USER environment variable.  It
-uses REMOTE_HOST or REMOTE_ADDR if REMOTE_HOST isn't set for additional
-trace information.  It accepts the command from B<remctld> on the command
-line, creates a Wallet::Server object, and calls the appropriate methods.
-
-This program is a fairly thin wrapper around Wallet::Server that translates
-command strings into method calls and returns the results.  It does check
-all arguments except for the <data> argument to the store command and
-rejects any argument not matching C<^[\w_/.-]+\z>; in other words, only
-alphanumerics, underscore (C<_>), slash (C</>), period (C<.>), and hyphen
-(C<->) are permitted in arguments.  This provides some additional security
-over and above the checking already done by the rest of the wallet code.
+B<wallet-backend> implements the interface between B<remctld> and the
+wallet system.  It is written to run under B<remctld> and expects the
+authenticated identity of the remote user in the REMOTE_USER environment
+variable.  It uses REMOTE_HOST or REMOTE_ADDR if REMOTE_HOST isn't set for
+additional trace information.  It accepts the command from B<remctld> on
+the command line, creates a Wallet::Server object, and calls the
+appropriate methods.
+
+This program is a fairly thin wrapper around Wallet::Server that
+translates command strings into method calls and returns the results.  It
+does check all arguments except for the <data> argument to the store
+command and rejects any argument not matching C<^[\w_/.-]+\z>; in other
+words, only alphanumerics, underscore (C<_>), slash (C</>), period (C<.>),
+and hyphen (C<->) are permitted in arguments.  This provides some
+additional security over and above the checking already done by the rest
+of the wallet code.
 
 =head1 OPTIONS
 
@@ -400,7 +407,7 @@ Display the history of the ACL <id>.  Each change to the ACL (not
 including changes to the name of the ACL) will be represented by two
 lines.  The first line will have a timestamp of the change followed by a
 description of the change, and the second line will give the user who made
-the change and the host from which the change was mde.
+the change and the host from which the change was made.
 
 =item acl remove <id> <scheme> <identifier>
 
@@ -447,8 +454,8 @@ The expiration will be displayed in seconds since epoch.
 
 If <date> is given, sets the expiration on the object identified by <type>
 and <name> to <date> and (if given) <time>.  <date> must be in the format
-C<YYYY-MM-DD> and <time> in the format C<HH:MM:SS>.  If <date> is the empty
-string, clears the expiration of the object.
+C<YYYY-MM-DD> and <time> in the format C<HH:MM:SS>.  If <date> is the
+empty string, clears the expiration of the object.
 
 Currently, the expiration of an object is not used.
 
@@ -460,16 +467,16 @@ Clears the flag <flag> on the object identified by <type> and <name>.
 
 Sets the flag <flag> on the object identified by <type> and <name>.
 Recognized flags are C<locked>, which prevents all further actions on that
-object until the flag is cleared, and C<unchanging>, which tells the object
-backend to not generate new data on get but instead return the same data as
-previously returned.  The C<unchanging> flag is not meaningful for objects
-that do not generate new data on the fly.
+object until the flag is cleared, and C<unchanging>, which tells the
+object backend to not generate new data on get but instead return the same
+data as previously returned.  The C<unchanging> flag is not meaningful for
+objects that do not generate new data on the fly.
 
 =item get <type> <name>
 
-Prints to standard output the data associated with the object identified by
-<type> and <name>.  This may trigger generation of new data and invalidate
-old data for that object depending on the object type.
+Prints to standard output the data associated with the object identified
+by <type> and <name>.  This may trigger generation of new data and
+invalidate old data for that object depending on the object type.
 
 =item getacl <type> <name> <acl>
 
@@ -485,17 +492,17 @@ or setting it.
 Prints the object attribute <attr> for the object identified by <type> and
 <name>.  Attributes are used to store backend-specific information for a
 particular object type, and <attr> must be an attribute type known to the
-underlying object implementation.  The attribute values, if any, are printed
-one per line.  If the attribute is not set on this object, nothing is
-printed.
+underlying object implementation.  The attribute values, if any, are
+printed one per line.  If the attribute is not set on this object, nothing
+is printed.
 
 =item history <type> <name>
 
-Displays the history for the object identified by <type> and <name>.
-This human-readable output will have two lines for each action that
-changes the object, plus for any get action.  The first line has the
-timestamp of the action and the action, and the second line gives the user
-who performed the action and the host from which they performed it.
+Displays the history for the object identified by <type> and <name>.  This
+human-readable output will have two lines for each action that changes the
+object, plus for any get action.  The first line has the timestamp of the
+action and the action, and the second line gives the user who performed
+the action and the host from which they performed it.
 
 =item owner <type> <name> [<owner>]
 
@@ -562,9 +569,9 @@ values of this attribute must be enctype strings recognized by Kerberos
 the salt should not be included; since the salt is irrelevant for keytab
 keys, it will always be set to C<normal> by the wallet.
 
-If this attribute is set, the specified enctype list will be passed to ktadd
-when get() is called for that keytab.  If it is not set, the default set in
-the KDC will be used.
+If this attribute is set, the specified enctype list will be passed to
+ktadd when get() is called for that keytab.  If it is not set, the default
+set in the KDC will be used.
 
 This attribute is ignored if the C<unchanging> flag is set on a keytab.
 Keytabs retrieved with C<unchanging> set will contain all keys present in
@@ -577,8 +584,8 @@ enctypes than those requested by this attribute.
 
 Wallet::Server(3), remctld(8)
 
-This program is part of the wallet system.  The current version is available
-from L<http://www.eyrie.org/~eagle/software/wallet/>.
+This program is part of the wallet system.  The current version is
+available from L<http://www.eyrie.org/~eagle/software/wallet/>.
 
 =head1 AUTHOR
 
diff --git a/tests/TESTS b/tests/TESTS
index ac6fd82..161941c 100644
--- a/tests/TESTS
+++ b/tests/TESTS
@@ -1,7 +1,8 @@
 client/basic
 client/full
-client/pod
 client/prompt
+docs/pod
+docs/pod-spelling
 portable/asprintf
 portable/mkstemp
 portable/setenv
@@ -11,7 +12,6 @@ portable/strlcpy
 server/admin
 server/backend
 server/keytab
-server/pod
 util/concat
 util/messages
 util/messages-krb5
diff --git a/tests/client/pod-t b/tests/client/pod-t
deleted file mode 100755
index 9963567..0000000
--- a/tests/client/pod-t
+++ /dev/null
@@ -1,22 +0,0 @@
-#!/usr/bin/perl
-#
-# Test POD formatting for client documentation.
-#
-# Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2008, 2010 Board of Trustees, Leland Stanford Jr. University
-#
-# See LICENSE for licensing terms.
-
-use Test::More;
-
-my @files = qw(wallet.pod);
-my $total = scalar (@files);
-plan tests => $total;
-
-eval 'use Test::Pod 1.00';
-SKIP: {
-    skip $total, 'Test::Pod 1.00 required for testing POD' if $@;
-    for my $file (@files) {
-        pod_file_ok ("$ENV{SOURCE}/../client/$file", "client/$file");
-    }
-}
diff --git a/tests/docs/pod-spelling-t b/tests/docs/pod-spelling-t
new file mode 100755
index 0000000..433d841
--- /dev/null
+++ b/tests/docs/pod-spelling-t
@@ -0,0 +1,80 @@
+#!/usr/bin/perl
+#
+# Check for spelling errors in POD documentation
+#
+# Checks all POD files in the tree for spelling problems using Pod::Spell and
+# either aspell or ispell.  aspell is preferred.  This test is disabled unless
+# RRA_MAINTAINER_TESTS is set, since spelling dictionaries vary too much
+# between environments.
+#
+# Copyright 2008, 2009 Russ Allbery <rra@stanford.edu>
+#
+# See LICENSE for licensing terms.
+
+use strict;
+use Test::More;
+
+# Skip all spelling tests unless the maintainer environment variable is set.
+plan skip_all => 'spelling tests only run for maintainer'
+    unless $ENV{RRA_MAINTAINER_TESTS};
+
+# Load required Perl modules.
+eval 'use Test::Pod 1.00';
+plan skip_all => 'Test::Pod 1.00 required for testing POD' if $@;
+eval 'use Pod::Spell';
+plan skip_all => 'Pod::Spell required to test POD spelling' if $@;
+
+# Locate a spell-checker.  hunspell is not currently supported due to its lack
+# of support for contractions (at least in the version in Debian).
+my @spell;
+my %options = (aspell => [ qw(-d en_US --home-dir=./ list) ],
+               ispell => [ qw(-d american -l -p /dev/null) ]);
+SEARCH: for my $program (qw/aspell ispell/) {
+    for my $dir (split ':', $ENV{PATH}) {
+        if (-x "$dir/$program") {
+            @spell = ("$dir/$program", @{ $options{$program} });
+        }
+        last SEARCH if @spell;
+    }
+}
+plan skip_all => 'aspell or ispell required to test POD spelling'
+    unless @spell;
+
+# Prerequisites are satisfied, so we're going to do some testing.  Figure out
+# what POD files we have and from that develop our plan.
+$| = 1;
+my @pod = map {
+    my $pod = "$ENV{SOURCE}/../" . $_;
+    $pod =~ s,[^/.][^/]*/../,,g;
+    $pod;
+} qw(client/wallet.pod server/keytab-backend server/wallet-admin
+     server/wallet-backend);
+plan tests => scalar @pod;
+
+# Finally, do the checks.
+for my $pod (@pod) {
+    my $child = open (CHILD, '-|');
+    if (not defined $child) {
+        BAIL_OUT ("cannot fork: $!");
+    } elsif ($child == 0) {
+        my $pid = open (SPELL, '|-', @spell)
+            or BAIL_OUT ("cannot run @spell: $!");
+        open (POD, '<', $pod) or BAIL_OUT ("cannot open $pod: $!");
+        my $parser = Pod::Spell->new;
+        $parser->parse_from_filehandle (\*POD, \*SPELL);
+        close POD;
+        close SPELL;
+        exit ($? >> 8);
+    } else {
+        my @words = <CHILD>;
+        close CHILD;
+      SKIP: {
+            skip "@spell failed for $pod", 1 unless $? == 0;
+            for (@words) {
+                s/^\s+//;
+                s/\s+$//;
+            }
+            is ("@words", '', $pod);
+        }
+    }
+}
diff --git a/tests/docs/pod-t b/tests/docs/pod-t
new file mode 100755
index 0000000..9b6c5d1
--- /dev/null
+++ b/tests/docs/pod-t
@@ -0,0 +1,21 @@
+#!/usr/bin/perl -w
+#
+# Test POD formatting for documentation.
+#
+# Written by Russ Allbery <rra@stanford.edu>
+# Copyright 2008, 2010 Board of Trustees, Leland Stanford Jr. University
+#
+# See LICENSE for licensing terms.
+
+use strict;
+use Test::More;
+eval 'use Test::Pod 1.00';
+plan skip_all => 'Test::Pod 1.00 required for testing POD' if $@;
+
+my @files = qw(client/wallet.pod server/keytab-backend server/wallet-admin
+               server/wallet-backend);
+my $total = scalar (@files);
+plan tests => $total;
+for my $file (@files) {
+    pod_file_ok ("$ENV{SOURCE}/../$file", $file);
+}
diff --git a/tests/server/pod-t b/tests/server/pod-t
deleted file mode 100755
index 52d81eb..0000000
--- a/tests/server/pod-t
+++ /dev/null
@@ -1,22 +0,0 @@
-#!/usr/bin/perl
-#
-# Test POD formatting for client documentation.
-#
-# Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2008, 2010 Board of Trustees, Leland Stanford Jr. University
-#
-# See LICENSE for licensing terms.
-
-use Test::More;
-
-my @files = qw(keytab-backend wallet-admin wallet-backend);
-my $total = scalar (@files);
-plan tests => $total;
-
-eval 'use Test::Pod 1.00';
-SKIP: {
-    skip 'Test::Pod 1.00 required for testing POD', $total if $@;
-    for my $file (@files) {
-        pod_file_ok ("$ENV{SOURCE}/../server/$file", "server/$file");
-    }
-}
-- 
cgit v1.2.3


From 4f863ccc9531130be3f4aecea341a0e8a66c6f8c Mon Sep 17 00:00:00 2001
From: Russ Allbery <rra@stanford.edu>
Date: Sat, 20 Feb 2010 20:30:37 -0800
Subject: wallet-backend gets the third store argument from stdin if missing

If there is no third argument to store, read it from standard input
instead.  This is the preferred way of running wallet-backend, using
stdin=last support from remctl 2.14 and later.  Receiving the third
argument as a regular argument continues to be supported for backward
compatibility.
---
 config/wallet          |  2 +-
 docs/setup             |  8 ++++----
 server/wallet-backend  | 11 ++++++++---
 tests/server/backend-t | 26 +++++++++++++++++++++++---
 4 files changed, 36 insertions(+), 11 deletions(-)

(limited to 'server/wallet-backend')

diff --git a/config/wallet b/config/wallet
index 2e0b142..06dc39d 100644
--- a/config/wallet
+++ b/config/wallet
@@ -3,5 +3,5 @@
 # This is a remctld configuration fragment to run wallet-backend, which
 # implements the server side of the wallet system.
 
-wallet store /usr/sbin/wallet-backend logmask=4 ANYUSER
+wallet store /usr/sbin/wallet-backend stdin=4 ANYUSER
 wallet ALL /usr/sbin/wallet-backend ANYUSER
diff --git a/docs/setup b/docs/setup
index ac83949..5a0036f 100644
--- a/docs/setup
+++ b/docs/setup
@@ -64,10 +64,10 @@ Wallet Configuration
 
     On the wallet server, install remctld.  Then, install the
     configuration fragment in config/wallet in the remctld configuration.
-    You can do this either by adding the one non-comment line of that file
-    to your remctl.conf or, if your remctl.conf includes a directory of
-    configuration fragments, drop config/wallet into that directory.  You
-    may need to change the path to wallet-backend.
+    You can do this either by adding the two non-comment lines of that
+    file to your remctl.conf or, if your remctl.conf includes a directory
+    of configuration fragments, drop config/wallet into that directory.
+    You may need to change the path to wallet-backend.
 
     Note that the default wallet configuration allows any authenticated
     user to run the wallet backend and relies on the wallet's ACLs for all
diff --git a/server/wallet-backend b/server/wallet-backend
index 7780758..453aa79 100755
--- a/server/wallet-backend
+++ b/server/wallet-backend
@@ -284,7 +284,11 @@ sub command {
             failure ($server->error, @_);
         }
     } elsif ($command eq 'store') {
-        check_args (3, 3, [3], @args);
+        check_args (2, 3, [3], @args);
+        if (@args == 2) {
+            local $/;
+            $args[2] = <STDIN>;
+        }
         splice (@_, 3);
         $server->store (@args) or failure ($server->error, @_);
     } else {
@@ -536,10 +540,11 @@ name, the owner, any specific ACLs set on the object, the expiration if
 any, and the user, remote host, and time when the object was created, last
 stored, and last downloaded.
 
-=item store <type> <name> <data>
+=item store <type> <name> [<data>]
 
 Stores <data> for the object identified by <type> and <name> for later
-retrieval with C<get>.  Not all object types support this.
+retrieval with C<get>.  Not all object types support this.  If <data> is
+not given as an argument, it will be read from standard input.
 
 Currently, <data> is limited to not containing nul characters and may
 therefore not be binary data, and is limited by the maximum command line
diff --git a/tests/server/backend-t b/tests/server/backend-t
index 2fc6a53..b58d02c 100755
--- a/tests/server/backend-t
+++ b/tests/server/backend-t
@@ -9,7 +9,7 @@
 # See LICENSE for licensing terms.
 
 use strict;
-use Test::More tests => 1263;
+use Test::More tests => 1269;
 
 # Create a dummy class for Wallet::Server that prints what method was called
 # with its arguments and returns data for testing.
@@ -163,6 +163,7 @@ package main;
 $INC{'Wallet/Server.pm'} = 'FAKE';
 my $OUTPUT;
 our $SYSLOG = \$OUTPUT;
+my $INPUT = '';
 eval { do "$ENV{SOURCE}/../server/wallet-backend" };
 
 # Run the wallet backend.  This fun hack takes advantage of the fact that the
@@ -173,6 +174,8 @@ sub run_backend {
     my $result = '';
     open (OUTPUT, '>', \$result) or die "cannot create output string: $!\n";
     select OUTPUT;
+    close STDIN;
+    open (STDIN, '<', \$INPUT) or die "cannot change stdin: $!\n";
     local $| = 1;
     eval { command (@args) };
     my $error = $@;
@@ -224,7 +227,7 @@ my %commands = (autocreate => [2, 2],
                 setacl     => [4, 4],
                 setattr    => [4, 9],
                 show       => [2, 2],
-                store      => [3, 3]);
+                store      => [2, 3]);
 my %acl_commands = (add     => [3, 3],
                     create  => [1, 1],
                     destroy => [1, 1],
@@ -326,6 +329,7 @@ for my $command (qw/autocreate create destroy setacl setattr store/) {
     $method ||= $command;
     my @extra = ('foo') x ($commands{$command}[0] - 2);
     my $extra = @extra ? join (' ', '', @extra) : '';
+    $extra = ' ' if $command eq 'store';
     ($out, $err) = run_backend ($command, 'type', 'name', @extra);
     my $ran;
     if ($command eq 'store') {
@@ -413,7 +417,7 @@ for my $command (qw/check expires get getacl getattr history owner show/) {
             ' and ran the right method with output');
     }
     ($out, $err) = run_backend ($command, 'error', 'name', @extra);
-    my $ran = "$command error name" . (@extra ? " @extra" : '');
+    $ran = "$command error name" . (@extra ? " @extra" : '');
     is ($err, "error count $error\n", "Command $command ran with errors");
     is ($OUTPUT, "command $ran from admin (1.2.3.4) failed: error count"
         . " $error\n", ' and syslog correct');
@@ -468,6 +472,22 @@ for my $command (sort keys %flag_commands) {
     $error++;
 }
 
+# Special check for store allowing nul characters on standard input.
+$INPUT = "Some data\000with a nul character";
+($out, $err) = run_backend ('store', 'type', 'name');
+is ($err, '', 'store with nul data ran with no errors');
+is ($OUTPUT, "command store type name from admin (1.2.3.4) succeeded\n",
+    ' and success logged');
+is ($out, "$new\nstore type name $INPUT\n",
+    ' and ran the right method');
+$INPUT = '';
+($out, $err) = run_backend ('store', 'type', 'name');
+is ($err, '', 'store with empty stdin data ran with no errors');
+is ($OUTPUT, "command store type name from admin (1.2.3.4) succeeded\n",
+    ' and success logged');
+is ($out, "$new\nstore type name \n",
+    ' and ran the right method');
+
 # Almost done.  All that remains is to test the robustness of the bad
 # character checks against every possible character and test permitting the
 # empty argument.
-- 
cgit v1.2.3


From 3b3e387b6bca35a00a86ad41e39874eeadcb78b9 Mon Sep 17 00:00:00 2001
From: Russ Allbery <rra@stanford.edu>
Date: Sat, 20 Feb 2010 21:52:38 -0800
Subject: Update documentation for support for storing nul data

Update the wallet client, wallet-backend, and Wallet::Object::File
documentation for the support for storing data containing nul
characters using the new stdin support in remctld.  Add this to NEWS.
---
 NEWS                       |  6 ++++++
 client/wallet.pod          | 12 +-----------
 perl/Wallet/Object/File.pm | 11 +++++------
 server/wallet-backend      |  7 +------
 4 files changed, 13 insertions(+), 23 deletions(-)

(limited to 'server/wallet-backend')

diff --git a/NEWS b/NEWS
index a87ae2f..b4c31d4 100644
--- a/NEWS
+++ b/NEWS
@@ -26,6 +26,12 @@ wallet 0.10 (unreleased)
     right thing for sites that use a KDC that serves both Kerberos v4 and
     Kerberos v5 from the same database.
 
+    The wallet client can now store data containing nul characters and
+    wallet-backend will accept it if passed on standard input instead of
+    as a command-line argument.  See config/wallet for the new required
+    remctld configuration.  Storing data containing nul characters
+    requires remctl 2.14 or later.
+
     Correctly handle storing of data that begins with a dash and don't
     parse it as an argument to wallet-backend.
 
diff --git a/client/wallet.pod b/client/wallet.pod
index 885b77e..db93700 100644
--- a/client/wallet.pod
+++ b/client/wallet.pod
@@ -5,7 +5,7 @@ wallet - Client for retrieving secure data from a central server
 =for stopwords
 -hv srvtab arg keytabs metadata keytab ACL PTS kinit klist remctl PKINIT
 acl timestamp autocreate backend-specific setacl enctypes enctype ktadd
-KDC appdefaults remctld Allbery nul uuencode getacl backend
+KDC appdefaults remctld Allbery uuencode getacl backend
 
 =head1 SYNOPSIS
 
@@ -87,11 +87,6 @@ ktremove> or an equivalent later to clean up old keys.  F<I<output>.new>
 is still used as a temporary file and any existing file with that name
 will be deleted.
 
-C<store> does not yet support nul bytes in I<file> (or in any other way of
-specifying the data to be stored).  To store binary files in the wallet,
-you will need to encode them with uuencode, base64, or some similar scheme
-and then decode them after retrieval.
-
 =item B<-k> I<principal>
 
 The service principal of the wallet server.  The default is to use the
@@ -349,11 +344,6 @@ retrieval with C<get>.  Not all object types support this.  If <data> is
 not specified on the command line, it will be read from the file specified
 with B<-f> (if given) or from standard input.
 
-Currently, the stored data must not contain nul characters and may
-therefore not be binary data.  Its length is also limited by the maximum
-command line length of the operating system of the wallet server.  These
-restrictions will be lifted in the future.
-
 If an object with type <type> and name <name> does not already exist when
 this command is issued (as checked with the check interface), B<wallet>
 will attempt to automatically create it (using autocreate).
diff --git a/perl/Wallet/Object/File.pm b/perl/Wallet/Object/File.pm
index 69262f6..c655b44 100644
--- a/perl/Wallet/Object/File.pm
+++ b/perl/Wallet/Object/File.pm
@@ -221,12 +221,11 @@ dashes replaced by C<%> and the hex code of the character.
 
 =head1 LIMITATIONS
 
-The wallet implementation itself can handle arbitrary file object names
-and arbitrary content.  However, due to limitations in the B<remctld>
-server usually used to run B<wallet-backend>, file object names and
-contents containing nul characters (ASCII 0) may not be permitted.  The
-file system used for storing file objects may impose a length limitation
-on the file object name.
+The wallet implementation itself can handle arbitrary file object names.
+However, due to limitations in the B<remctld> server usually used to run
+B<wallet-backend>, file object names containing nul characters (ASCII 0)
+may not be permitted.  The file system used for storing file objects may
+impose a length limitation on the file object name.
 
 =head1 SEE ALSO
 
diff --git a/server/wallet-backend b/server/wallet-backend
index 453aa79..0a611db 100755
--- a/server/wallet-backend
+++ b/server/wallet-backend
@@ -317,7 +317,7 @@ __END__
 
 =for stopwords
 wallet-backend backend backend-specific remctld ACL acl timestamp getacl
-setacl metadata nul keytab keytabs enctypes enctype ktadd KDC Allbery
+setacl metadata keytab keytabs enctypes enctype ktadd KDC Allbery
 autocreate
 
 =head1 NAME
@@ -546,11 +546,6 @@ Stores <data> for the object identified by <type> and <name> for later
 retrieval with C<get>.  Not all object types support this.  If <data> is
 not given as an argument, it will be read from standard input.
 
-Currently, <data> is limited to not containing nul characters and may
-therefore not be binary data, and is limited by the maximum command line
-length of the operating system of the wallet server.  These restrictions
-will be lifted in the future.
-
 =back
 
 =head1 ATTRIBUTES
-- 
cgit v1.2.3


From b573d6f433725afda0e4238f63a5b3485d1d56f4 Mon Sep 17 00:00:00 2001
From: Ian Durkacz <idurkacz@inf.ed.ac.uk>
Date: Tue, 29 Jun 2010 15:30:51 -0700
Subject: Add a krb5-regex ACL type

Add the krb5-regex ACL type and corresponding Wallet::ACL::Krb5::Regex
module.  This ACL is identical to krb5 except that it takes a regular
expression matching principals instead of a string that must match
exactly.
---
 perl/Wallet/ACL/Krb5/Regex.pm | 132 ++++++++++++++++++++++++++++++++++++++++++
 perl/Wallet/Schema.pm         |   2 +
 server/wallet-backend         |   4 +-
 3 files changed, 136 insertions(+), 2 deletions(-)
 create mode 100644 perl/Wallet/ACL/Krb5/Regex.pm

(limited to 'server/wallet-backend')

diff --git a/perl/Wallet/ACL/Krb5/Regex.pm b/perl/Wallet/ACL/Krb5/Regex.pm
new file mode 100644
index 0000000..4e59834
--- /dev/null
+++ b/perl/Wallet/ACL/Krb5/Regex.pm
@@ -0,0 +1,132 @@
+# Wallet::ACL::Krb5::Regex -- Wallet Kerberos v5 principal regex ACL verifier
+#
+# Written by Russ Allbery <rra@stanford.edu>
+# Copyright 2007, 2010 Board of Trustees, Leland Stanford Jr. University
+#
+# See LICENSE for licensing terms.
+
+##############################################################################
+# Modules and declarations
+##############################################################################
+
+package Wallet::ACL::Krb5::Regex;
+require 5.006;
+
+use strict;
+use vars qw(@ISA $VERSION);
+
+use Wallet::ACL::Krb5;
+
+@ISA = qw(Wallet::ACL::Krb5);
+
+# 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.01';
+
+##############################################################################
+# Interface
+##############################################################################
+
+# Returns true if the Perl regular expression specified by the ACL matches
+# the provided Kerberos principal.
+sub check {
+    my ($self, $principal, $acl) = @_;
+    unless ($principal) {
+        $self->error ('no principal specified');
+        return;
+    }
+    unless ($acl) {
+        $self->error ('no ACL specified');
+        return;
+    }
+    my $regex = eval { qr/$acl/ };
+    if ($@) {
+        $self->error ('malformed krb5-regex ACL');
+        return;
+    }
+    return ($principal =~ m/$regex/) ? 1 : 0;
+}
+
+1;
+__END__
+
+##############################################################################
+# Documentation
+##############################################################################
+
+=for stopwords
+ACL krb5-regex Allbery
+
+=head1 NAME
+
+Wallet::ACL::Krb5::Regex - Regex wallet ACL verifier for Kerberos principals
+
+=head1 SYNOPSIS
+
+    my $verifier = Wallet::ACL::Krb5::Regex->new;
+    my $status = $verifier->check ($principal, $acl);
+    if (not defined $status) {
+        die "Something failed: ", $verifier->error, "\n";
+    } elsif ($status) {
+        print "Access granted\n";
+    } else {
+        print "Access denied\n";
+    }
+
+=head1 DESCRIPTION
+
+Wallet::ACL::Krb5::Regex is the wallet ACL verifier used to verify ACL
+lines of type C<krb5-regex>.  The value of such an ACL is a Perl regular
+expression, and the ACL grants access to a given Kerberos principal if and
+only if the regular expression matches that principal.
+
+=head1 METHODS
+
+=over 4
+
+=item new()
+
+Creates a new ACL verifier.  For this verifier, there is no setup work.
+
+=item check(PRINCIPAL, ACL)
+
+Returns true if the Perl regular expression specified by the ACL matches the
+PRINCIPAL, false if not, and undef on an error (see L<"DIAGNOSTICS"> below).
+
+=item error()
+
+Returns the error if check() returned undef.
+
+=back
+
+=head1 DIAGNOSTICS
+
+=over 4
+
+=item malformed krb5-regex ACL
+
+The ACL parameter to check() was a malformed Perl regular expression.
+
+=item no principal specified
+
+The PRINCIPAL parameter to check() was undefined or the empty string.
+
+=item no ACL specified
+
+The ACL parameter to check() was undefined or the empty string.
+
+=back
+
+=head1 SEE ALSO
+
+Wallet::ACL(3), Wallet::ACL::Base(3), Wallet::ACL::Krb5(3), wallet-backend(8)
+
+This module is part of the wallet system.  The current version is
+available from L<http://www.eyrie.org/~eagle/software/wallet/>.
+
+=head1 AUTHOR
+
+Russ Allbery <rra@stanford.edu>
+
+=cut
diff --git a/perl/Wallet/Schema.pm b/perl/Wallet/Schema.pm
index 589a15d..25d48cf 100644
--- a/perl/Wallet/Schema.pm
+++ b/perl/Wallet/Schema.pm
@@ -219,6 +219,8 @@ Holds the supported ACL schemes and their corresponding Perl classes:
       as_class            varchar(64));
   insert into acl_schemes (as_name, as_class)
       values ('krb5', 'Wallet::ACL::Krb5');
+  insert into acl_schemes (as_name, as_class)
+      values ('krb5-regex', 'Wallet::ACL::Krb5::Regex');
   insert into acl_schemes (as_name, as_class)
       values ('netdb', 'Wallet::ACL::NetDB');
   insert into acl_schemes (as_name, as_class)
diff --git a/server/wallet-backend b/server/wallet-backend
index 0a611db..52e9857 100755
--- a/server/wallet-backend
+++ b/server/wallet-backend
@@ -147,7 +147,7 @@ sub command {
     if ($command eq 'acl') {
         my $action = shift @args;
         if ($action eq 'add') {
-            check_args (3, 3, [], @args);
+            check_args (3, 3, [3], @args);
             $server->acl_add (@args) or failure ($server->error, @_);
         } elsif ($action eq 'create') {
             check_args (1, 1, [], @args);
@@ -164,7 +164,7 @@ sub command {
                 failure ($server->error, @_);
             }
         } elsif ($action eq 'remove') {
-            check_args (3, 3, [], @args);
+            check_args (3, 3, [3], @args);
             $server->acl_remove (@args) or failure ($server->error, @_);
         } elsif ($action eq 'rename') {
             check_args (2, 2, [], @args);
-- 
cgit v1.2.3


From 74ed6945f9c7839603764327f0187897525db453 Mon Sep 17 00:00:00 2001
From: Russ Allbery <rra@stanford.edu>
Date: Mon, 20 Jun 2011 16:15:35 -0700
Subject: Add a comment field to objects

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.
---
 NEWS                       |  5 ++++
 TODO                       |  2 --
 client/wallet.pod          | 25 ++++++++++++++------
 perl/Wallet/Object/Base.pm | 39 +++++++++++++++++++++++++++++--
 perl/Wallet/Schema.pm      |  5 +++-
 perl/Wallet/Server.pm      | 53 +++++++++++++++++++++++++++++++++++-------
 perl/t/object.t            | 32 +++++++++++++++++++++++--
 perl/t/schema.t            | 31 +++++++++++++++++++++----
 perl/t/server.t            | 58 +++++++++++++++++++++++++++++++++++++++++++---
 server/wallet-backend      | 45 +++++++++++++++++++++++++++--------
 tests/server/backend-t     | 32 +++++++++++++++++++------
 11 files changed, 280 insertions(+), 47 deletions(-)

(limited to 'server/wallet-backend')

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",
-- 
cgit v1.2.3


From 357532f312aea30ab5b3e459ccf19f1580b29262 Mon Sep 17 00:00:00 2001
From: Russ Allbery <rra@stanford.edu>
Date: Sun, 4 Nov 2012 10:38:29 -0800
Subject: 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".
---
 NEWS                   |  4 ++++
 TODO                   |  3 ---
 client/wallet.pod      | 30 ++++++++++++++++++------------
 perl/Wallet/Server.pm  | 40 ++++++++++++++++++++++++++++------------
 perl/t/server.t        | 10 +++++++---
 server/wallet-backend  | 31 ++++++++++++++++++++++---------
 tests/server/backend-t | 30 +++++++++++++++++++++++++++---
 7 files changed, 106 insertions(+), 42 deletions(-)

(limited to 'server/wallet-backend')

diff --git a/NEWS b/NEWS
index 6f20133..b948d91 100644
--- a/NEWS
+++ b/NEWS
@@ -15,6 +15,10 @@ wallet 1.0 (unreleased)
     this ACL type for an existing wallet database, use wallet-admin to
     register the new verifier.
 
+    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.
+
     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
diff --git a/TODO b/TODO
index fd49abc..2fc17b5 100644
--- a/TODO
+++ b/TODO
@@ -29,9 +29,6 @@ Client:
 
 Server Interface:
 
- * WALLET-12: Add check command for ACLs similar to the check command for
-   objects.
-
  * WALLET-13: Provide a way to get history for deleted objects and ACLs.
 
  * WALLET-14: Provide an interface to mass-change all instances of one ACL
diff --git a/client/wallet.pod b/client/wallet.pod
index a0785a5..23e4e7c 100644
--- a/client/wallet.pod
+++ b/client/wallet.pod
@@ -151,19 +151,20 @@ options and commands are ignored.
 =head1 COMMANDS
 
 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, 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.  The exceptions are C<acl check>, C<check>, C<get>,
+C<store>, C<show>, C<destroy>, C<flag clear>, C<flag set>, C<getattr>,
+C<setattr>, and C<history>.  C<acl check> and C<check> can be run by
+anyone.  All of the rest of those commands have their own ACLs except
+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.
 
 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
+and C<store>.  For C<get> and C<store>, they must still be authorized by
 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
@@ -178,9 +179,14 @@ For more information on attributes, see L<ATTRIBUTES>.
 
 =item acl add <id> <scheme> <identifier>
 
-Adds an entry with <scheme> and <identifier> to the ACL <id>.  <id> may be
+Add an entry with <scheme> and <identifier> to the ACL <id>.  <id> may be
 either the name of an ACL or its numeric identifier.
 
+=item acl check <id>
+
+Check whether an ACL with the ID <id> already exists.  If it does, prints
+C<yes>; if not, prints C<no>.
+
 =item acl create <name>
 
 Create a new, empty ACL with name <name>.  When setting an ACL on an
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');
diff --git a/server/wallet-backend b/server/wallet-backend
index 9850c0e..948b47c 100755
--- a/server/wallet-backend
+++ b/server/wallet-backend
@@ -3,7 +3,7 @@
 # wallet-backend -- Wallet server for storing and retrieving secure data.
 #
 # 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.
@@ -150,6 +150,14 @@ sub command {
         if ($action eq 'add') {
             check_args (3, 3, [3], @args);
             $server->acl_add (@args) or failure ($server->error, @_);
+        } elsif ($action eq 'check') {
+            check_args (1, 1, [], @args);
+            my $status = $server->acl_check (@args);
+            if (!defined ($status)) {
+                failure ($server->error, @_);
+            } else {
+                print $status ? "yes\n" : "no\n";
+            }
         } elsif ($action eq 'create') {
             check_args (1, 1, [], @args);
             $server->acl_create (@args) or failure ($server->error, @_);
@@ -376,17 +384,17 @@ syslog.
 =head1 COMMANDS
 
 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<ADMIN> ACL).  The exceptions are C<acl check>, C<check>, C<get>,
+C<store>, C<show>, C<destroy>, C<flag clear>, C<flag set>, C<getattr>,
+C<setattr>, and C<history>.  C<acl check> and C<check> can be run by
+anyone.  All of the rest of those commands have their own ACLs except
 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
+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.
+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<store>, they must still be authorized by
@@ -404,9 +412,14 @@ For more information on attributes, see L<ATTRIBUTES>.
 
 =item acl add <id> <scheme> <identifier>
 
-Adds an entry with <scheme> and <identifier> to the ACL <id>.  <id> may be
+Add an entry with <scheme> and <identifier> to the ACL <id>.  <id> may be
 either the name of an ACL or its numeric identifier.
 
+=item acl check <id>
+
+Check whether an ACL with the ID <id> already exists.  If it does, prints
+C<yes>; if not, prints C<no>.
+
 =item acl create <name>
 
 Create a new, empty ACL with name <name>.  When setting an ACL on an
diff --git a/tests/server/backend-t b/tests/server/backend-t
index 3e377a1..50131b7 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, 2011
+# Copyright 2006, 2007, 2008, 2009, 2010, 2011, 2012
 #     The Board of Trustees of the Leland Stanford Junior University
 #
 # See LICENSE for licensing terms.
 
 use strict;
-use Test::More tests => 1296;
+use Test::More tests => 1314;
 
 # Create a dummy class for Wallet::Server that prints what method was called
 # with its arguments and returns data for testing.
@@ -45,6 +45,18 @@ sub acl_remove
 sub acl_rename
     { shift; print "acl_rename @_\n"; ($_[0] eq 'error') ? undef : 1 }
 
+sub acl_check {
+    shift;
+    print "acl_check @_\n";
+    if ($_[0] eq 'error') {
+        return;
+    } elsif ($_[0] eq 'unknown') {
+        return 0;
+    } else {
+        return 1;
+    }
+}
+
 sub acl_history {
     shift;
     print "acl_history @_\n";
@@ -243,6 +255,7 @@ my %commands = (autocreate => [2, 2],
                 show       => [2, 2],
                 store      => [2, 3]);
 my %acl_commands = (add     => [3, 3],
+                    check   => [1, 1],
                     create  => [1, 1],
                     destroy => [1, 1],
                     history => [1, 1],
@@ -460,7 +473,9 @@ for my $command (sort keys %acl_commands) {
     is ($OUTPUT, "command $ran from admin (1.2.3.4) succeeded\n",
         ' and success logged');
     my $expected;
-    if ($command eq 'show') {
+    if ($command eq 'check') {
+        $expected = "$new\nacl_$command name$extra\nyes\n";
+    } elsif ($command eq 'show') {
         $expected = "$new\nacl_$command name$extra\nacl_show";
     } elsif ($command eq 'history') {
         $expected = "$new\nacl_$command name$extra\nacl_history";
@@ -476,6 +491,15 @@ for my $command (sort keys %acl_commands) {
     is ($out, "$new\nacl_$command error$extra\n",
         ' and ran the right method');
     $error++;
+    if ($command eq 'check') {
+        ($out, $err) = run_backend ('acl', $command, 'unknown');
+        my $ran = "acl $command unknown";
+        is ($err, '', "Command $command ran with no errors (unknown)");
+        is ($OUTPUT, "command $ran from admin (1.2.3.4) succeeded\n",
+            ' and success logged');
+        is ($out, "$new\nacl_$command unknown\nno\n",
+            ' and ran the right method with output');
+    }
 }
 for my $command (sort keys %flag_commands) {
     my @extra = ('foo') x ($flag_commands{$command}[0] - 2);
-- 
cgit v1.2.3


From 1a4ec451eb04fabe9039fd9a13f63865f6b32e01 Mon Sep 17 00:00:00 2001
From: Russ Allbery <rra@stanford.edu>
Date: Wed, 27 Feb 2013 15:49:46 -0800
Subject: Add explicit license statements to all POD documentation

For scripts, do this by moving the copyright and license statement
from the top of the script into the POD documentation.

Also try to uniformly put the SEE ALSO section last.

Change-Id: Id31a5c0d5e6f6831a689deec41a13d35bb40465a
Reviewed-on: https://gerrit.stanford.edu/850
Reviewed-by: Russ Allbery <rra@stanford.edu>
Tested-by: Russ Allbery <rra@stanford.edu>
---
 client/wallet-rekey.pod      | 18 ++++++++++++++----
 client/wallet.pod            | 26 ++++++++++++++++++--------
 contrib/wallet-summary       | 31 ++++++++++++++++++++++++-------
 contrib/wallet-unknown-hosts | 31 ++++++++++++++++++++++++-------
 server/keytab-backend        | 39 ++++++++++++++++++++++++++++-----------
 server/wallet-admin          | 39 ++++++++++++++++++++++++++++-----------
 server/wallet-backend        | 39 ++++++++++++++++++++++++++++-----------
 server/wallet-report         | 39 ++++++++++++++++++++++++++++-----------
 8 files changed, 192 insertions(+), 70 deletions(-)

(limited to 'server/wallet-backend')

diff --git a/client/wallet-rekey.pod b/client/wallet-rekey.pod
index efe9a0b..47413ad 100644
--- a/client/wallet-rekey.pod
+++ b/client/wallet-rekey.pod
@@ -148,6 +148,20 @@ overrides this setting.
 
 =back
 
+=head1 AUTHOR
+
+Russ Allbery <rra@stanford.edu>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2010, 2013 The Board of Trustees of the Leland Stanford Junior
+University
+
+Copying and distribution of this file, with or without modification, are
+permitted in any medium without royalty provided the copyright notice and
+this notice are preserved.  This file is offered as-is, without any
+warranty.
+
 =head1 SEE ALSO
 
 kadmin(8), kinit(1), krb5.conf(5), remctl(1), remctld(8), wallet(1)
@@ -158,8 +172,4 @@ from L<http://www.eyrie.org/~eagle/software/wallet/>.
 B<wallet-rekey> uses the remctl protocol.  For more information about
 remctl, see L<http://www.eyrie.org/~eagle/software/remctl/>.
 
-=head1 AUTHOR
-
-Russ Allbery <rra@stanford.edu>
-
 =cut
diff --git a/client/wallet.pod b/client/wallet.pod
index 23e4e7c..32d81ad 100644
--- a/client/wallet.pod
+++ b/client/wallet.pod
@@ -1,12 +1,12 @@
-=head1 NAME
-
-wallet - Client for retrieving secure data from a central server
-
 =for stopwords
 -hv srvtab arg keytabs metadata keytab ACL PTS kinit klist remctl PKINIT
 acl timestamp autocreate backend-specific setacl enctypes enctype ktadd
 KDC appdefaults remctld Allbery uuencode getacl backend ACL's DES
 
+=head1 NAME
+
+wallet - Client for retrieving secure data from a central server
+
 =head1 SYNOPSIS
 
 B<wallet> [B<-hv>] [B<-c> I<command>] [B<-f> I<file>]
@@ -457,6 +457,20 @@ overrides this setting.
 
 =back
 
+=head1 AUTHOR
+
+Russ Allbery <rra@stanford.edu>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2007, 2008, 2010, 2011, 2012, 2013 The Board of Trustees of the
+Leland Stanford Junior University
+
+Copying and distribution of this file, with or without modification, are
+permitted in any medium without royalty provided the copyright notice and
+this notice are preserved.  This file is offered as-is, without any
+warranty.
+
 =head1 SEE ALSO
 
 kadmin(8), kinit(1), krb5.conf(5), remctl(1), remctld(8)
@@ -467,8 +481,4 @@ from L<http://www.eyrie.org/~eagle/software/wallet/>.
 B<wallet> uses the remctl protocol.  For more information about remctl,
 see L<http://www.eyrie.org/~eagle/software/remctl/>.
 
-=head1 AUTHOR
-
-Russ Allbery <rra@stanford.edu>
-
 =cut
diff --git a/contrib/wallet-summary b/contrib/wallet-summary
index 2237351..4dee7f3 100755
--- a/contrib/wallet-summary
+++ b/contrib/wallet-summary
@@ -1,12 +1,6 @@
 #!/usr/bin/perl -w
 #
-# wallet-summary -- Summarize keytabs in the wallet database.
-#
-# Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2003, 2008, 2010
-#     The Board of Trustees of the Leland Stanford Junior University
-#
-# See LICENSE for licensing terms.
+# Summarize keytabs in the wallet database.
 
 ##############################################################################
 # Site configuration
@@ -241,4 +235,27 @@ future development.
 
 Russ Allbery <rra@stanford.edu>
 
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2003, 2008, 2010, 2013 The Board of Trustees of the Leland
+Stanford Junior University
+
+Permission is hereby granted, free of charge, to any person obtaining a
+copy of this software and associated documentation files (the "Software"),
+to deal in the Software without restriction, including without limitation
+the rights to use, copy, modify, merge, publish, distribute, sublicense,
+and/or sell copies of the Software, and to permit persons to whom the
+Software is furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in
+all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+DEALINGS IN THE SOFTWARE.
+
 =cut
diff --git a/contrib/wallet-unknown-hosts b/contrib/wallet-unknown-hosts
index e19dcf0..4d9f739 100755
--- a/contrib/wallet-unknown-hosts
+++ b/contrib/wallet-unknown-hosts
@@ -1,12 +1,6 @@
 #!/usr/bin/perl -w
 #
-# wallet-unknown-hosts -- Report host keytabs in wallet for unknown hosts.
-#
-# Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2010
-#     The Board of Trustees of the Leland Stanford Junior University
-#
-# See LICENSE for licensing terms.
+# Report host keytabs in wallet for unknown hosts.
 
 ##############################################################################
 # Site configuration
@@ -258,4 +252,27 @@ actions as a local administrator.
 
 Russ Allbery <rra@stanford.edu>
 
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2010, 2013 The Board of Trustees of the Leland Stanford Junior
+University
+
+Permission is hereby granted, free of charge, to any person obtaining a
+copy of this software and associated documentation files (the "Software"),
+to deal in the Software without restriction, including without limitation
+the rights to use, copy, modify, merge, publish, distribute, sublicense,
+and/or sell copies of the Software, and to permit persons to whom the
+Software is furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in
+all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+DEALINGS IN THE SOFTWARE.
+
 =cut
diff --git a/server/keytab-backend b/server/keytab-backend
index 3ea3df0..e45aba2 100755
--- a/server/keytab-backend
+++ b/server/keytab-backend
@@ -1,6 +1,6 @@
 #!/usr/bin/perl
 #
-# keytab-backend -- Extract keytabs from the KDC without changing the key.
+# Extract keytabs from the KDC without changing the key.
 #
 # This is a remctl backend that extracts existing keys from a KDC database
 # using kadmin.local.  It requires a patched version of kadmin.local that
@@ -15,12 +15,6 @@
 # do any additional authorization checks itself.
 #
 # The keytab for the extracted principal will be printed to standard output.
-#
-# Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2006, 2007, 2008, 2010
-#     The Board of Trustees of the Leland Stanford Junior University
-#
-# See LICENSE for licensing terms.
 
 ##############################################################################
 # Declarations and site configuration
@@ -215,6 +209,33 @@ standard output.
 
 =back
 
+=head1 AUTHOR
+
+Russ Allbery <rra@stanford.edu>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2006, 2007, 2008, 2010, 2013 The Board of Trustees of the Leland
+Stanford Junior University
+
+Permission is hereby granted, free of charge, to any person obtaining a
+copy of this software and associated documentation files (the "Software"),
+to deal in the Software without restriction, including without limitation
+the rights to use, copy, modify, merge, publish, distribute, sublicense,
+and/or sell copies of the Software, and to permit persons to whom the
+Software is furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in
+all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+DEALINGS IN THE SOFTWARE.
+
 =head1 SEE ALSO
 
 kadmin.local(8), remctld(8)
@@ -222,8 +243,4 @@ kadmin.local(8), remctld(8)
 This program is part of the wallet system.  The current version is
 available from L<http://www.eyrie.org/~eagle/software/wallet/>.
 
-=head1 AUTHOR
-
-Russ Allbery <rra@stanford.edu>
-
 =cut
diff --git a/server/wallet-admin b/server/wallet-admin
index 516423b..b021a63 100755
--- a/server/wallet-admin
+++ b/server/wallet-admin
@@ -1,12 +1,6 @@
 #!/usr/bin/perl -w
 #
-# wallet-admin -- Wallet server administrative commands.
-#
-# Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2008, 2009, 2010, 2011, 2013
-#     The Board of Trustees of the Leland Stanford Junior University
-#
-# See LICENSE for licensing terms.
+# Wallet server administrative commands.
 
 ##############################################################################
 # Declarations and site configuration
@@ -144,6 +138,33 @@ much as possible.
 
 =back
 
+=head1 AUTHOR
+
+Russ Allbery <rra@stanford.edu>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2008, 2009, 2010, 2011, 2013 The Board of Trustees of the Leland
+Stanford Junior University
+
+Permission is hereby granted, free of charge, to any person obtaining a
+copy of this software and associated documentation files (the "Software"),
+to deal in the Software without restriction, including without limitation
+the rights to use, copy, modify, merge, publish, distribute, sublicense,
+and/or sell copies of the Software, and to permit persons to whom the
+Software is furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in
+all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+DEALINGS IN THE SOFTWARE.
+
 =head1 SEE ALSO
 
 Wallet::Admin(3), Wallet::Config(3), wallet-backend(8)
@@ -151,8 +172,4 @@ Wallet::Admin(3), Wallet::Config(3), wallet-backend(8)
 This program is part of the wallet system.  The current version is
 available from L<http://www.eyrie.org/~eagle/software/wallet/>.
 
-=head1 AUTHOR
-
-Russ Allbery <rra@stanford.edu>
-
 =cut
diff --git a/server/wallet-backend b/server/wallet-backend
index 948b47c..9d45982 100755
--- a/server/wallet-backend
+++ b/server/wallet-backend
@@ -1,12 +1,6 @@
 #!/usr/bin/perl
 #
-# wallet-backend -- Wallet server for storing and retrieving secure data.
-#
-# Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2007, 2008, 2010, 2011, 2012
-#     The Board of Trustees of the Leland Stanford Junior University
-#
-# See LICENSE for licensing terms.
+# Wallet server for storing and retrieving secure data.
 
 ##############################################################################
 # Declarations and site configuration
@@ -618,6 +612,33 @@ enctypes than those requested by this attribute.
 
 =back
 
+=head1 AUTHOR
+
+Russ Allbery <rra@stanford.edu>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2007, 2008, 2010, 2011, 2012, 2013 The Board of Trustees of the
+Leland Stanford Junior University
+
+Permission is hereby granted, free of charge, to any person obtaining a
+copy of this software and associated documentation files (the "Software"),
+to deal in the Software without restriction, including without limitation
+the rights to use, copy, modify, merge, publish, distribute, sublicense,
+and/or sell copies of the Software, and to permit persons to whom the
+Software is furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in
+all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+DEALINGS IN THE SOFTWARE.
+
 =head1 SEE ALSO
 
 Wallet::Server(3), remctld(8)
@@ -625,8 +646,4 @@ Wallet::Server(3), remctld(8)
 This program is part of the wallet system.  The current version is
 available from L<http://www.eyrie.org/~eagle/software/wallet/>.
 
-=head1 AUTHOR
-
-Russ Allbery <rra@stanford.edu>
-
 =cut
diff --git a/server/wallet-report b/server/wallet-report
index 0fd8aa9..5af289c 100755
--- a/server/wallet-report
+++ b/server/wallet-report
@@ -1,12 +1,6 @@
 #!/usr/bin/perl -w
 #
-# wallet-report -- Wallet server reporting interface.
-#
-# Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2008, 2009, 2010
-#     The Board of Trustees of the Leland Stanford Junior University
-#
-# See LICENSE for licensing terms.
+# Wallet server reporting interface.
 
 ##############################################################################
 # Declarations and globals
@@ -280,6 +274,33 @@ with duplicates suppressed.
 
 =back
 
+=head1 AUTHOR
+
+Russ Allbery <rra@stanford.edu>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2008, 2009, 2010, 2013 The Board of Trustees of the Leland
+Stanford Junior University
+
+Permission is hereby granted, free of charge, to any person obtaining a
+copy of this software and associated documentation files (the "Software"),
+to deal in the Software without restriction, including without limitation
+the rights to use, copy, modify, merge, publish, distribute, sublicense,
+and/or sell copies of the Software, and to permit persons to whom the
+Software is furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in
+all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+DEALINGS IN THE SOFTWARE.
+
 =head1 SEE ALSO
 
 Wallet::Config(3), Wallet::Report(3), wallet-backend(8)
@@ -287,8 +308,4 @@ Wallet::Config(3), Wallet::Report(3), wallet-backend(8)
 This program is part of the wallet system.  The current version is
 available from L<http://www.eyrie.org/~eagle/software/wallet/>.
 
-=head1 AUTHOR
-
-Russ Allbery <rra@stanford.edu>
-
 =cut
-- 
cgit v1.2.3


From f6c63bdb2be5ccc0c6133bf87025d37805579005 Mon Sep 17 00:00:00 2001
From: Russ Allbery <rra@stanford.edu>
Date: Wed, 27 Mar 2013 12:51:46 -0700
Subject: Allow owners of objects to destroy them by default

Owners of wallet objects are now allowed to destroy them.  In previous
versions, a special destroy ACL had to be set and the owner ACL wasn't
used for destroy actions, but operational experience at Stanford has
shown that letting owners destroy their own objects is a better model.

Change-Id: I0e97d7a000e62cf5321add7b44140db6edc6769f
Reviewed-on: https://gerrit.stanford.edu/973
Reviewed-by: Russ Allbery <rra@stanford.edu>
Tested-by: Russ Allbery <rra@stanford.edu>
---
 NEWS                  |  5 +++++
 client/wallet.pod     |  6 +++---
 docs/design           |  6 +++---
 docs/notes            | 12 ++++++------
 perl/Wallet/Server.pm | 19 ++++++++++---------
 perl/t/server.t       | 20 ++++++++++++--------
 server/keytab-backend |  2 +-
 server/wallet-backend |  8 ++++----
 8 files changed, 44 insertions(+), 34 deletions(-)

(limited to 'server/wallet-backend')

diff --git a/NEWS b/NEWS
index 0d98220..d236f6a 100644
--- a/NEWS
+++ b/NEWS
@@ -2,6 +2,11 @@
 
 wallet 1.0 (unreleased)
 
+    Owners of wallet objects are now allowed to destroy them.  In previous
+    versions, a special destroy ACL had to be set and the owner ACL wasn't
+    used for destroy actions, but operational experience at Stanford has
+    shown that letting owners destroy their own objects is a better model.
+
     wallet-admin has a new sub-command, upgrade, which upgrades the wallet
     database to the latest schema version.  This command should be run
     when deploying any new version of the wallet server.
diff --git a/client/wallet.pod b/client/wallet.pod
index 32d81ad..214a157 100644
--- a/client/wallet.pod
+++ b/client/wallet.pod
@@ -159,9 +159,9 @@ 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.
+Otherwise, C<destroy>, 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<store>, they must still be authorized by
diff --git a/docs/design b/docs/design
index 4bb5587..8f4b20d 100644
--- a/docs/design
+++ b/docs/design
@@ -148,9 +148,9 @@ Server Design
 
     * Optional ACLs for get, store, show, destroy, and flag operations.
       If there is an ACL for get, store, or show, that overrides the
-      normal permissions of the owner.  In the absence of an ACL for
-      destroy or flag, only wallet administrators can destroy an object or
-      set flags on that object.  This entry would need no special ACLs.
+      normal permissions of the owner.  In the absence of an ACL for flag,
+      only wallet administrators can set flags on that object.  This entry
+      would need no special ACLs.
 
     * Trace fields storing the user, remote host, and timestamp for when
       this object was last created, stored, and downloaded.
diff --git a/docs/notes b/docs/notes
index 84a82d1..5a7d3bc 100644
--- a/docs/notes
+++ b/docs/notes
@@ -46,7 +46,7 @@ Server Issues
 
   ACL Management
 
-    Supported operations are:  get, store, create (possibly triggered by a
+    Supported operations are: get, store, create (possibly triggered by a
     get or store of something that didn't already exist), destroy, show,
     and setting or clearing flags.  Each of these need a separate ACL
     potentially.  Not sure if we're going to need separate ACLs for each
@@ -62,10 +62,9 @@ Server Issues
     that returns a default ACL given the object type and name if the
     object doesn't already exist.
 
-    Owner rights provides get, store, and show, but not destroy or setting
-    or clearing flags (not destroy because it's too destructive and we
-    don't want it done accidentally).  This can be overridden by more
-    precise ACL settings.  So the ACL logic would go like this:
+    Owner rights provides get, store, show, and destroy, but not setting
+    or clearing flags.  This can be overridden by more precise ACL
+    settings.  So the ACL logic would go like this:
 
      * If the user is an administrator and the operation isn't get or
        store, operation is permitted.
@@ -74,7 +73,8 @@ Server Issues
        that specific ACL, apply that ACL.
 
      * If the object exists but with no specific ACL setting and the
-       operation is one of get, store, or show, apply the owner ACL.
+       operation is one of get, store, show, or destroy, apply the owner
+       ACL.
 
      * If the object doesn't exist and the action is get, store, or
        create, punt to a local policy if it exists and see if it returns a
diff --git a/perl/Wallet/Server.pm b/perl/Wallet/Server.pm
index db53f6c..6d67e17 100644
--- a/perl/Wallet/Server.pm
+++ b/perl/Wallet/Server.pm
@@ -1,7 +1,7 @@
 # Wallet::Server -- Wallet system server implementation.
 #
 # Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2007, 2008, 2010, 2011
+# Copyright 2007, 2008, 2010, 2011, 2013
 #     The Board of Trustees of the Leland Stanford Junior University
 #
 # See LICENSE for licensing terms.
@@ -301,7 +301,7 @@ sub acl_verify {
     } elsif ($action ne 'comment') {
         $id = $object->acl ($action);
     }
-    if (! defined ($id) and $action ne 'flags' and $action ne 'destroy') {
+    if (! defined ($id) and $action ne 'flags') {
         $id = $object->owner;
     }
     unless (defined $id) {
@@ -970,9 +970,10 @@ owner as determined by the wallet configuration.
 Destroys the object identified by TYPE and NAME.  This destroys any data
 that the wallet had saved about the object, may remove the underlying
 object from other external systems, and destroys the wallet database entry
-for the object.  To destroy an object, the current user must be authorized
-by the ADMIN ACL or the destroy ACL on the object; the owner ACL is not
-sufficient.  Returns true on success and false on failure.
+for the object.  To destroy an object, the current user must be a member
+of the ADMIN ACL, authorized by the destroy ACL, or authorized by the
+owner ACL; however, if the destroy ACL is set, the owner ACL will not be
+checked.  Returns true on success and false on failure.
 
 =item dbh()
 
@@ -981,10 +982,6 @@ mostly for testing; normally, clients should perform all actions through
 the Wallet::Server object to ensure that authorization and history logging
 is done properly.
 
-=item schema()
-
-Returns the DBIx::Class schema object.
-
 =item error()
 
 Returns the error of the last failing operation or undef if no operations
@@ -1058,6 +1055,10 @@ The owner of an object is permitted to get, store, and show that object,
 but cannot destroy or set flags on that object without being listed on
 those ACLs as well.
 
+=item schema()
+
+Returns the DBIx::Class schema object.
+
 =item show(TYPE, NAME)
 
 Returns (as a string) a human-readable representation of the metadata
diff --git a/perl/t/server.t b/perl/t/server.t
index 8474989..4afda51 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, 2012
+# Copyright 2007, 2008, 2010, 2011, 2012, 2013
 #     The Board of Trustees of the Leland Stanford Junior University
 #
 # See LICENSE for licensing terms.
 
-use Test::More tests => 381;
+use Test::More tests => 382;
 
 use POSIX qw(strftime);
 use Wallet::Admin;
@@ -497,10 +497,6 @@ is ($server->create ('base', 'service/test'), undef,
     ' nor can we create objects');
 is ($server->error, "$user1 not authorized to create base:service/test",
     ' with error');
-is ($server->destroy ('base', 'service/user1'), undef,
-    ' or destroy objects');
-is ($server->error, "$user1 not authorized to destroy base:service/user1",
-    ' with error');
 is ($server->owner ('base', 'service/user1', 'user2'), undef,
     ' or set the owner');
 is ($server->error,
@@ -801,6 +797,12 @@ is ($server->store ('base', 'service/both', 'stuff'), undef,
     ' or store it');
 is ($server->error, 'cannot find base:service/both', ' because it is gone');
 
+# Switch back to user1 and test destroy.
+$server = eval { Wallet::Server->new ($user1, $host) };
+is ($@, '', 'Switching users works');
+is ($server->destroy ('base', 'service/user1'), 1,
+    'Destroy of an object we own with no destroy ACLs works');
+
 # Test default ACLs on object creation.
 #
 # Create a default_acl sub that permits $user2 to create service/default with
@@ -836,8 +838,10 @@ sub default_owner {
 }
 package main;
 
-# We're still user2, so we should now be able to create service/default.  Make
-# sure we can and that the ACLs all look good.
+# Switch back to user2, so we should now be able to create service/default.
+# Make sure we can and that the ACLs all look good.
+$server = eval { Wallet::Server->new ($user2, $host) };
+is ($@, '', 'Switching users works');
 is ($server->create ('base', 'service/default'), undef,
     'Creating an object with the default ACL fails');
 is ($server->error, "$user2 not authorized to create base:service/default",
diff --git a/server/keytab-backend b/server/keytab-backend
index e45aba2..b0116c7 100755
--- a/server/keytab-backend
+++ b/server/keytab-backend
@@ -152,7 +152,7 @@ __END__
 
 =for stopwords
 keytab-backend keytabs KDC keytab kadmin.local -norandkey ktadd remctld
-auth Allbery rekeying
+auth Allbery rekeying MERCHANTABILITY NONINFRINGEMENT sublicense
 
 =head1 NAME
 
diff --git a/server/wallet-backend b/server/wallet-backend
index 9d45982..fc3434e 100755
--- a/server/wallet-backend
+++ b/server/wallet-backend
@@ -335,7 +335,7 @@ __END__
 =for stopwords
 wallet-backend backend backend-specific remctld ACL acl timestamp getacl
 setacl metadata keytab keytabs enctypes enctype ktadd KDC Allbery
-autocreate
+autocreate MERCHANTABILITY NONINFRINGEMENT sublicense
 
 =head1 NAME
 
@@ -386,9 +386,9 @@ 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.
+Otherwise, C<destroy>, 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<store>, they must still be authorized by
-- 
cgit v1.2.3