summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRuss Allbery <rra@stanford.edu>2010-03-08 10:57:43 -0800
committerRuss Allbery <rra@stanford.edu>2010-03-08 10:57:43 -0800
commitbc74e98546f6d291c8b4fde55d2d3b62ac876831 (patch)
tree4810b8a40368d84cc11e18a07fb2401c85314b7c
parent98ba541f3b5e3d63604d29412847ec4d807e8e16 (diff)
parent602ff7584d3668c36b1bf5fd43988e6f45eceb48 (diff)
Merge commit 'upstream/0.11' into debian
-rw-r--r--NEWS30
-rw-r--r--README5
-rw-r--r--TODO10
-rw-r--r--client/krb5.c3
-rw-r--r--client/wallet.12
-rwxr-xr-xconfigure20
-rw-r--r--configure.ac2
-rw-r--r--contrib/wallet-summary.82
-rw-r--r--perl/Wallet/ACL.pm32
-rw-r--r--perl/Wallet/ACL/NetDB.pm4
-rw-r--r--perl/Wallet/Admin.pm4
-rw-r--r--perl/Wallet/Config.pm72
-rw-r--r--perl/Wallet/Database.pm4
-rw-r--r--perl/Wallet/Kadmin/Heimdal.pm4
-rw-r--r--perl/Wallet/Kadmin/MIT.pm4
-rw-r--r--perl/Wallet/Object/File.pm4
-rw-r--r--perl/Wallet/Object/Keytab.pm6
-rw-r--r--perl/Wallet/Report.pm97
-rw-r--r--perl/Wallet/Server.pm26
-rwxr-xr-xperl/t/acl.t2
-rwxr-xr-xperl/t/admin.t2
-rwxr-xr-xperl/t/config.t2
-rwxr-xr-xperl/t/data/keytab-fake2
-rwxr-xr-xperl/t/data/netdb-fake2
-rwxr-xr-xperl/t/file.t2
-rwxr-xr-xperl/t/init.t2
-rwxr-xr-xperl/t/kadmin.t5
-rwxr-xr-xperl/t/keytab.t2
-rw-r--r--perl/t/lib/Util.pm4
-rwxr-xr-xperl/t/object.t2
-rwxr-xr-xperl/t/pod-spelling.t3
-rwxr-xr-xperl/t/report.t77
-rwxr-xr-xperl/t/schema.t2
-rwxr-xr-xperl/t/server.t41
-rwxr-xr-xperl/t/verifier-netdb.t10
-rwxr-xr-xperl/t/verifier.t6
-rw-r--r--portable/krb5-extra.c2
-rw-r--r--server/keytab-backend.82
-rwxr-xr-xserver/wallet-admin122
-rw-r--r--server/wallet-admin.878
-rw-r--r--server/wallet-backend.82
-rwxr-xr-xserver/wallet-report46
-rw-r--r--server/wallet-report.846
-rwxr-xr-xtests/data/fake-kadmin3
-rw-r--r--tests/data/wallet.conf2
-rwxr-xr-xtests/server/report-t42
46 files changed, 519 insertions, 323 deletions
diff --git a/NEWS b/NEWS
index 4c8bda6..f9d4a9a 100644
--- a/NEWS
+++ b/NEWS
@@ -1,5 +1,35 @@
User-Visible wallet Changes
+wallet 0.11 (2010-03-08)
+
+ When deleting an ACL on the server, verify that the ACL is not
+ referenced by any object first. Database referential integrity should
+ also catch this, but not all database backends may enforce referential
+ integrity. This also allows us to return a better error message
+ naming an object that's still using that ACL.
+
+ Wallet::Config now supports an additional local function,
+ verify_acl_name, which can be used to enforce ACL naming policies. If
+ set, it is called for any ACL creation or rename and can reject the
+ new ACL name.
+
+ Add an audit command to wallet-report and two audits: acls name, which
+ returns all ACLs that do not pass the local naming policy, and objects
+ name, which does the same for objects. The corresponding
+ Wallet::Report method is audit().
+
+ Add the acls unused report to wallet-report and Wallet::Report,
+ returning all ACLs not referenced by any database objects.
+
+ Wallet::Config::verify_name may now be called with an undefined third
+ argument (normally the user attempting to create an object). This
+ calling convention is used when auditing, and the local policy
+ function should select the correct policy to apply for useful audit
+ results.
+
+ Fix portability to older Kerberos libraries without
+ krb5_free_error_message.
+
wallet 0.10 (2010-02-21)
Add support for Heimdal KDCs as well as MIT Kerberos KDCs. There is
diff --git a/README b/README
index cb8942c..4879f97 100644
--- a/README
+++ b/README
@@ -1,4 +1,4 @@
- wallet release 0.10
+ wallet release 0.11
(secure data management system)
Written by Russ Allbery <rra@stanford.edu>
@@ -64,8 +64,7 @@ REQUIREMENTS
http://www.eyrie.org/~eagle/software/remctl/
- The wallet client currently requires MIT Kerberos and will need some
- minor portability modifications to build with Heimdal.
+ The wallet client will build with either MIT Kerberos or Heimdal.
The wallet server is written in Perl and requires Perl 5.6.0 or later.
It uses the Perl DBI layer to talk to a database, and therefore the DBI
diff --git a/TODO b/TODO
index 670a1c7..8370210 100644
--- a/TODO
+++ b/TODO
@@ -38,7 +38,8 @@ Server Interface:
* Provide an interface to mass-change all instances of one ACL to another.
- * Add a help function to wallet-backend listing the commands.
+ * Add help functions to wallet-backend, wallet-report, and wallet-admin
+ listing the commands.
* Catch exceptions on object creation in wallet-backend so that we can
log those as well.
@@ -76,8 +77,6 @@ ACLs:
an ACL without having to write it into the database. Redo default ACL
creation using that functionality.
- * Add a hook to enforce ACL naming standards.
-
* Pass a reference to the object for which the ACL is interpreted to the
ACL API so that ACL APIs can make more complex decisions.
@@ -131,7 +130,7 @@ Objects:
Reports:
- * Make contrib/wallet-summary generic and include it in wallet-admin,
+ * Make contrib/wallet-summary generic and include it in wallet-report,
with additional configuration in Wallet::Config. Enhance it to report
on any sort of object, not just on keytabs, and to give numbers on
downloaded versus not downloaded objects.
@@ -149,9 +148,6 @@ Documentation:
* Write a future design and roadmap document to collect notes about how
unimplemented features should be handled.
- * Add details to design-api on how to write one's own ACL verifiers and
- object implementations and register them.
-
* Document using the wallet system over something other than remctl.
* Document all diagnostics for all wallet APIs.
diff --git a/client/krb5.c b/client/krb5.c
index 38172ae..aad39f6 100644
--- a/client/krb5.c
+++ b/client/krb5.c
@@ -10,10 +10,9 @@
*/
#include <config.h>
+#include <portable/krb5.h>
#include <portable/system.h>
-#include <krb5.h>
-
#include <client/internal.h>
#include <util/messages-krb5.h>
#include <util/messages.h>
diff --git a/client/wallet.1 b/client/wallet.1
index 5d5a8bf..7d7004f 100644
--- a/client/wallet.1
+++ b/client/wallet.1
@@ -124,7 +124,7 @@
.\" ========================================================================
.\"
.IX Title "WALLET 1"
-.TH WALLET 1 "2010-02-21" "0.10" "wallet"
+.TH WALLET 1 "2010-03-08" "0.11" "wallet"
.\" For nroff, turn off justification. Always turn off hyphenation; it makes
.\" way too many mistakes in technical documents.
.if n .ad l
diff --git a/configure b/configure
index 0c7ae3d..88ec851 100755
--- a/configure
+++ b/configure
@@ -1,6 +1,6 @@
#! /bin/sh
# Guess values for system-dependent variables and create Makefiles.
-# Generated by GNU Autoconf 2.65 for wallet 0.10.
+# Generated by GNU Autoconf 2.65 for wallet 0.11.
#
# Report bugs to <rra@stanford.edu>.
#
@@ -552,8 +552,8 @@ MAKEFLAGS=
# Identity of this package.
PACKAGE_NAME='wallet'
PACKAGE_TARNAME='wallet'
-PACKAGE_VERSION='0.10'
-PACKAGE_STRING='wallet 0.10'
+PACKAGE_VERSION='0.11'
+PACKAGE_STRING='wallet 0.11'
PACKAGE_BUGREPORT='rra@stanford.edu'
PACKAGE_URL=''
@@ -1268,7 +1268,7 @@ if test "$ac_init_help" = "long"; then
# Omit some internal or obsolete options to make the list less imposing.
# This message is too long to be a string in the A/UX 3.1 sh.
cat <<_ACEOF
-\`configure' configures wallet 0.10 to adapt to many kinds of systems.
+\`configure' configures wallet 0.11 to adapt to many kinds of systems.
Usage: $0 [OPTION]... [VAR=VALUE]...
@@ -1334,7 +1334,7 @@ fi
if test -n "$ac_init_help"; then
case $ac_init_help in
- short | recursive ) echo "Configuration of wallet 0.10:";;
+ short | recursive ) echo "Configuration of wallet 0.11:";;
esac
cat <<\_ACEOF
@@ -1447,7 +1447,7 @@ fi
test -n "$ac_init_help" && exit $ac_status
if $ac_init_version; then
cat <<\_ACEOF
-wallet configure 0.10
+wallet configure 0.11
generated by GNU Autoconf 2.65
Copyright (C) 2009 Free Software Foundation, Inc.
@@ -2146,7 +2146,7 @@ cat >config.log <<_ACEOF
This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.
-It was created by wallet $as_me 0.10, which was
+It was created by wallet $as_me 0.11, which was
generated by GNU Autoconf 2.65. Invocation command line was
$ $0 $@
@@ -2968,7 +2968,7 @@ fi
# Define the identity of the package.
PACKAGE='wallet'
- VERSION='0.10'
+ VERSION='0.11'
cat >>confdefs.h <<_ACEOF
@@ -9823,7 +9823,7 @@ cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
# report actual input values of CONFIG_FILES etc. instead of their
# values after options handling.
ac_log="
-This file was extended by wallet $as_me 0.10, which was
+This file was extended by wallet $as_me 0.11, which was
generated by GNU Autoconf 2.65. Invocation command line was
CONFIG_FILES = $CONFIG_FILES
@@ -9889,7 +9889,7 @@ _ACEOF
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`"
ac_cs_version="\\
-wallet config.status 0.10
+wallet config.status 0.11
configured by $0, generated by GNU Autoconf 2.65,
with options \\"\$ac_cs_config\\"
diff --git a/configure.ac b/configure.ac
index c4dc7eb..df97861 100644
--- a/configure.ac
+++ b/configure.ac
@@ -9,7 +9,7 @@ dnl See LICENSE for licensing terms.
dnl We cannot use -Wall -Werror with AM_INIT_AUTOMAKE since we override
dnl distuninstallcheck (not supported by Perl).
AC_PREREQ([2.64])
-AC_INIT([wallet], [0.10], [rra@stanford.edu])
+AC_INIT([wallet], [0.11], [rra@stanford.edu])
AC_CONFIG_AUX_DIR([build-aux])
AC_CONFIG_LIBOBJ_DIR([portable])
AC_CONFIG_MACRO_DIR([m4])
diff --git a/contrib/wallet-summary.8 b/contrib/wallet-summary.8
index b857d48..2974dd0 100644
--- a/contrib/wallet-summary.8
+++ b/contrib/wallet-summary.8
@@ -124,7 +124,7 @@
.\" ========================================================================
.\"
.IX Title "WALLET-SUMMARY 8"
-.TH WALLET-SUMMARY 8 "2010-02-21" "0.10" "wallet"
+.TH WALLET-SUMMARY 8 "2010-03-08" "0.11" "wallet"
.\" For nroff, turn off justification. Always turn off hyphenation; it makes
.\" way too many mistakes in technical documents.
.if n .ad l
diff --git a/perl/Wallet/ACL.pm b/perl/Wallet/ACL.pm
index 76e7354..44a82b2 100644
--- a/perl/Wallet/ACL.pm
+++ b/perl/Wallet/ACL.pm
@@ -21,7 +21,7 @@ use POSIX qw(strftime);
# This version should be increased on any code change to this module. Always
# use two digits for the minor version with a leading zero if necessary so
# that it will sort properly.
-$VERSION = '0.06';
+$VERSION = '0.07';
##############################################################################
# Constructors
@@ -191,11 +191,25 @@ sub rename {
# Destroy the ACL, deleting it out of the database. Returns true on success,
# false on failure.
+#
+# Checks to ensure that the ACL is not referenced anywhere in the database,
+# since we may not have referential integrity enforcement. It's not clear
+# that this is the right place to do this; it's a bit of an abstraction
+# violation, since it's a query against the object table.
sub destroy {
my ($self, $user, $host, $time) = @_;
$time ||= time;
eval {
- my $sql = 'delete from acl_entries where ae_id = ?';
+ my $sql = 'select ob_type, ob_name from objects where ob_owner = ?
+ or ob_acl_get = ? or ob_acl_store = ? or ob_acl_show = ? or
+ ob_acl_destroy = ? or ob_acl_flags = ?';
+ my $sth = $self->{dbh}->prepare ($sql);
+ $sth->execute (($self->{id}) x 6);
+ my $entry = $sth->fetchrow_arrayref;
+ if (defined $entry) {
+ die "ACL in use by $entry->[0]:$entry->[1]";
+ }
+ $sql = 'delete from acl_entries where ae_id = ?';
$self->{dbh}->do ($sql, undef, $self->{id});
$sql = 'delete from acls where ac_id = ?';
$self->{dbh}->do ($sql, undef, $self->{id});
@@ -525,13 +539,13 @@ array context and undef in scalar context.
=item destroy(PRINCIPAL, HOSTNAME [, DATETIME])
-Destroys this ACL from the database. Note that this will fail due to
-integrity constraint errors if the ACL is still referenced by any object;
-the ACL must be removed from all objects first. Returns true on success
-and false on failure. On failure, the caller should call error() to get
-the error message. PRINCIPAL, HOSTNAME, and DATETIME are stored as
-history information. PRINCIPAL should be the user who is destroying the
-ACL. If DATETIME isn't given, the current time is used.
+Destroys this ACL from the database. Note that this will fail if the ACL
+is still referenced by any object; the ACL must be removed from all
+objects first. Returns true on success and false on failure. On failure,
+the caller should call error() to get the error message. PRINCIPAL,
+HOSTNAME, and DATETIME are stored as history information. PRINCIPAL
+should be the user who is destroying the ACL. If DATETIME isn't given,
+the current time is used.
=item error()
diff --git a/perl/Wallet/ACL/NetDB.pm b/perl/Wallet/ACL/NetDB.pm
index 2096ba8..0fb5a2c 100644
--- a/perl/Wallet/ACL/NetDB.pm
+++ b/perl/Wallet/ACL/NetDB.pm
@@ -23,7 +23,7 @@ use Wallet::Config;
# 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.04';
+$VERSION = '0.05';
##############################################################################
# Interface
@@ -163,7 +163,7 @@ only if that principal has one of the roles user, admin, or team for that
node.
To use this object, several configuration parameters must be set. See
-Wallet::Config(3) for details on those configuration parameters and
+L<Wallet::Config> for details on those configuration parameters and
information about how to set wallet configuration.
=head1 METHODS
diff --git a/perl/Wallet/Admin.pm b/perl/Wallet/Admin.pm
index e835713..f208e13 100644
--- a/perl/Wallet/Admin.pm
+++ b/perl/Wallet/Admin.pm
@@ -183,8 +183,8 @@ its actions.
To use this object, several configuration variables must be set (at least
the database configuration). For information on those variables and how
-to set them, see Wallet::Config(3). For more information on the normal
-user interface to the wallet server, see Wallet::Server(3).
+to set them, see L<Wallet::Config>. For more information on the normal
+user interface to the wallet server, see L<Wallet::Server>.
=head1 CLASS METHODS
diff --git a/perl/Wallet/Config.pm b/perl/Wallet/Config.pm
index 396bf7d..23a051d 100644
--- a/perl/Wallet/Config.pm
+++ b/perl/Wallet/Config.pm
@@ -14,7 +14,7 @@ use vars qw($PATH $VERSION);
# 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.04';
+$VERSION = '0.05';
# Path to the config file to load.
$PATH = $ENV{WALLET_CONFIG} || '/etc/wallet/wallet.conf';
@@ -90,7 +90,7 @@ Sets the Perl database driver to use for the wallet database. Common
values would be C<SQLite> or C<MySQL>. Less common values would be
C<Oracle>, C<Sybase>, or C<ODBC>. The appropriate DBD::* Perl module for
the chosen driver must be installed and will be dynamically loaded by the
-wallet. For more information, see DBI(3).
+wallet. For more information, see L<DBI>.
This variable must be set.
@@ -104,7 +104,7 @@ Sets the remaining contents for the DBI DSN (everything after the driver).
Using this variable provides full control over the connect string passed
to DBI. When using SQLite, set this variable to the path to the SQLite
database. If this variable is set, DB_NAME, DB_HOST, and DB_PORT are
-ignored. For more information, see DBI(3) and the documentation for the
+ignored. For more information, see L<DBI> and the documentation for the
database driver you're using.
Either DB_INFO or DB_NAME must be set. If you don't need to pass any
@@ -119,7 +119,7 @@ our $DB_INFO;
If DB_INFO is not set, specifies the database name. The third part of the
DBI connect string will be set to C<database=DB_NAME>, possibly with a
host and port appended if DB_HOST and DB_PORT are set. For more
-information, see DBI(3) and the documentation for the database driver
+information, see L<DBI> and the documentation for the database driver
you're using.
Either DB_INFO or DB_NAME must be set.
@@ -131,7 +131,7 @@ our $DB_NAME;
=item DB_HOST
If DB_INFO is not set, specifies the database host. C<;host=DB_HOST> will
-be appended to the DBI connect string. For more information, see DBI(3)
+be appended to the DBI connect string. For more information, see L<DBI>
and the documentation for the database driver you're using.
=cut
@@ -142,7 +142,7 @@ our $DB_HOST;
If DB_PORT is not set, specifies the database port. C<;port=DB_PORT> will
be appended to the DBI connect string. If this variable is set, DB_HOST
-should also be set. For more information, see DBI(3) and the
+should also be set. For more information, see L<DBI> and the
documentation for the database driver you're using.
=cut
@@ -179,7 +179,7 @@ C<file> object type (the Wallet::Object::File class).
=item FILE_BUCKET
The directory into which to store file objects. File objects will be
-stored in subdirectories of this directory. See Wallet::Object::File(3)
+stored in subdirectories of this directory. See L<Wallet::Object::File>
for the full details of the naming scheme. This directory must be
writable by the wallet server and the wallet server must be able to create
subdirectories of it.
@@ -513,12 +513,21 @@ By default, wallet permits administrators to create objects of any name
(unless the object backend rejects the name). However, naming standards
for objects can be enforced, even for administrators, by defining a Perl
function in the configuration file named verify_name. If such a function
-exists, it will be called for any object creation and given the type of
-object, the object name, and the identity of the person doing the
+exists, it will be called for any object creation and will be passed the
+type of object, the object name, and the identity of the person doing the
creation. If it returns undef or the empty string, object creation will
be allowed. If it returns anything else, object creation is rejected and
the return value is used as the error message.
+This function is also called for naming audits done via Wallet::Report
+to find any existing objects that violate a (possibly updated) naming
+policy. In this case, the third argument (the identity of the person
+creating the object) will be undef. As a general rule, if the third
+argument is undef, the function should apply the most liberal accepted
+naming policy so that the audit returns only objects that violate all
+naming policies, but some sites may wish different results for their audit
+reports.
+
Please note that this return status is backwards from what one would
normally expect. A false value is success; a true value is failure with
an error message.
@@ -540,7 +549,50 @@ keytab objects for particular principals have fully-qualified hostnames:
}
Objects that aren't of type C<keytab> or which aren't for a host-based key
-have no naming requirements enforced.
+have no naming requirements enforced by this example.
+
+=head1 ACL NAMING ENFORCEMENT
+
+Similar to object names, by default wallet permits administrators to
+create ACLs with any name. However, naming standards for ACLs can be
+enforced by defining a Perl function in the configuration file named
+verify_acl_name. If such a function exists, it will be called for any ACL
+creation or rename and will be passed given the new ACL name and the
+identity of the person doing the creation. If it returns undef or the
+empty string, object creation will be allowed. If it returns anything
+else, object creation is rejected and the return value is used as the
+error message.
+
+This function is also called for naming audits done via Wallet::Report to
+find any existing objects that violate a (possibly updated) naming policy.
+In this case, the second argument (the identity of the person creating the
+ACL) will be undef. As a general rule, if the second argument is undef,
+the function should apply the most liberal accepted naming policy so that
+the audit returns only ACLs that violate all naming policies, but some
+sites may wish different results for their audit reports.
+
+Please note that this return status is backwards from what one would
+normally expect. A false value is success; a true value is failure with
+an error message.
+
+For example, the following verify_acl_name function would ensure that any
+ACLs created contain a slash and the part before the slash be one of
+C<host>, C<group>, C<user>, or C<service>.
+
+ sub verify_acl_name {
+ my ($name, $user) = @_;
+ return 'ACL names must contain a slash' unless $name =~ m,/,;
+ my ($first, $rest) = split ('/', $name, 2);
+ my %types = map { $_ => 1 } qw(host group user service);
+ unless ($types{$first}) {
+ return "unknown ACL type $first";
+ }
+ return;
+ }
+
+Obvious improvements could be made, such as checking that the part after
+the slash for a C<host/> ACL looked like a host name and the part after a
+slash for a C<user/> ACL look like a user name.
=head1 ENVIRONMENT
diff --git a/perl/Wallet/Database.pm b/perl/Wallet/Database.pm
index 7b3474a..7daab9f 100644
--- a/perl/Wallet/Database.pm
+++ b/perl/Wallet/Database.pm
@@ -39,7 +39,7 @@ use Wallet::Config;
# 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.02';
+$VERSION = '0.03';
##############################################################################
# Core overrides
@@ -101,7 +101,7 @@ methods should work the same as in DBI and Wallet::Database objects should
be usable exactly as if they were DBI objects.
connect() will obtain the database connection information from the wallet
-configuration; see Wallet::Config(3) for more details. It will also
+configuration; see L<Wallet::Config> for more details. It will also
automatically set the RaiseError attribute to true and the PrintError and
AutoCommit attributes to false, matching the assumptions made by the
wallet database code.
diff --git a/perl/Wallet/Kadmin/Heimdal.pm b/perl/Wallet/Kadmin/Heimdal.pm
index d1eecda..658ac04 100644
--- a/perl/Wallet/Kadmin/Heimdal.pm
+++ b/perl/Wallet/Kadmin/Heimdal.pm
@@ -24,7 +24,7 @@ use Wallet::Kadmin ();
# 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.03';
+$VERSION = '0.04';
##############################################################################
# Utility functions
@@ -254,7 +254,7 @@ Wallet::Kadmin::Heimdal - Wallet Kerberos administration API for Heimdal
Wallet::Kadmin::Heimdal implements the Wallet::Kadmin API for Heimdal,
providing an interface to create and delete principals and create keytabs.
-It provides the API documented in Wallet::Kadmin(3) for a Heimdal KDC.
+It provides the API documented in L<Wallet::Kadmin> for a Heimdal KDC.
To use this class, several configuration parameters must be set. See
L<Wallet::Config/"KEYTAB OBJECT CONFIGURATION"> for details.
diff --git a/perl/Wallet/Kadmin/MIT.pm b/perl/Wallet/Kadmin/MIT.pm
index 434e93d..fc4d271 100644
--- a/perl/Wallet/Kadmin/MIT.pm
+++ b/perl/Wallet/Kadmin/MIT.pm
@@ -25,7 +25,7 @@ use Wallet::Kadmin ();
# 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.02';
+$VERSION = '0.03';
##############################################################################
# kadmin Interaction
@@ -275,7 +275,7 @@ Wallet::Kadmin::MIT - Wallet Kerberos administration API for MIT
Wallet::Kadmin::MIT implements the Wallet::Kadmin API for MIT Kerberos,
providing an interface to create and delete principals and create keytabs.
-It provides the API documented in Wallet::Kadmin(3) for an MIT Kerberos
+It provides the API documented in L<Wallet::Kadmin> for an MIT Kerberos
KDC.
MIT Kerberos does not provide any method via the kadmin network protocol
diff --git a/perl/Wallet/Object/File.pm b/perl/Wallet/Object/File.pm
index c655b44..47c8ac2 100644
--- a/perl/Wallet/Object/File.pm
+++ b/perl/Wallet/Object/File.pm
@@ -24,7 +24,7 @@ use Wallet::Object::Base;
# 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.02';
+$VERSION = '0.03';
##############################################################################
# File naming
@@ -159,7 +159,7 @@ it when the file object is deleted. A file object must be stored before
it can be retrieved with get.
To use this object, the configuration option specifying where on the
-wallet server to store file objects must be set. See Wallet::Config(3)
+wallet server to store file objects must be set. See L<Wallet::Config>
for details on this configuration parameter and information about how to
set wallet configuration.
diff --git a/perl/Wallet/Object/Keytab.pm b/perl/Wallet/Object/Keytab.pm
index edb26b3..b7c2805 100644
--- a/perl/Wallet/Object/Keytab.pm
+++ b/perl/Wallet/Object/Keytab.pm
@@ -25,7 +25,7 @@ use Wallet::Kadmin;
# 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.08';
+$VERSION = '0.09';
##############################################################################
# Enctype restriction
@@ -379,7 +379,7 @@ This implementation generates a new random key (and hence invalidates all
existing keytabs) each time the keytab is retrieved with the get() method.
To use this object, several configuration parameters must be set. See
-Wallet::Config(3) for details on those configuration parameters and
+L<Wallet::Config> for details on those configuration parameters and
information about how to set wallet configuration.
=head1 METHODS
@@ -456,7 +456,7 @@ configuration. If the principal already exists, create() still succeeds
wallet). Otherwise, if the Kerberos principal could not be created,
create() fails. The principal is created with the randomized keys. NAME
must not contain the realm; instead, the KEYTAB_REALM configuration
-variable should be set. See Wallet::Config(3) for more information.
+variable should be set. See L<Wallet::Config> for more information.
If create() fails, it throws an exception.
diff --git a/perl/Wallet/Report.pm b/perl/Wallet/Report.pm
index 7cd8653..c743060 100644
--- a/perl/Wallet/Report.pm
+++ b/perl/Wallet/Report.pm
@@ -20,7 +20,7 @@ use Wallet::Database;
# 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';
+$VERSION = '0.02';
##############################################################################
# Constructor, destructor, and accessors
@@ -195,7 +195,8 @@ sub acls_all {
sub acls_empty {
my ($self) = @_;
my $sql = 'select ac_id, ac_name from acls left join acl_entries
- on (acls.ac_id = acl_entries.ae_id) where ae_id is null';
+ on (acls.ac_id = acl_entries.ae_id) where ae_id is null order by
+ ac_id';
return ($sql);
}
@@ -210,6 +211,18 @@ sub acls_entry {
return ($sql, $type, '%' . $identifier . '%');
}
+# Returns the SQL statement required to find unused ACLs.
+sub acls_unused {
+ my ($self) = @_;
+ my $sql = 'select ac_id, ac_name from acls where not ac_id in (select
+ ob_owner from objects where ob_owner = ac_id)';
+ for my $acl (qw/get store show destroy flags/) {
+ $sql .= " and not ac_id in (select ob_acl_$acl from objects where
+ ob_acl_$acl = ac_id)";
+ }
+ return ($sql);
+}
+
# Returns a list of all ACLs stored in the wallet database as a list of pairs
# of ACL IDs and ACL names, possibly limited by some criteria. On error and
# for an empty database, the empty list will be returned. To distinguish
@@ -234,8 +247,10 @@ sub acls {
}
} elsif ($type eq 'empty') {
($sql) = $self->acls_empty;
+ } elsif ($type eq 'unused') {
+ ($sql) = $self->acls_unused;
} else {
- $self->error ("do not know search type: $type");
+ $self->error ("unknown search type: $type");
return;
}
}
@@ -290,6 +305,57 @@ sub owners {
return @lines;
}
+##############################################################################
+# Auditing
+##############################################################################
+
+# Audit the database for violations of local policy. Returns a list of
+# objects (as type and name pairs) or a list of ACLs (as ID and name pairs).
+# On error and for no matching entries, the empty list will be returned. To
+# distinguish between an empty return and an error, call error(), which will
+# return undef if there was no error.
+sub audit {
+ my ($self, $type, $audit) = @_;
+ undef $self->{error};
+ unless (defined ($type) and defined ($audit)) {
+ $self->error ("type and audit not specified");
+ return;
+ }
+ if ($type eq 'objects') {
+ if ($audit eq 'name') {
+ return unless defined &Wallet::Config::verify_name;
+ my @objects = $self->objects;
+ my @results;
+ for my $object (@objects) {
+ my ($type, $name) = @$object;
+ my $error = Wallet::Config::verify_name ($type, $name);
+ push (@results, $object) if $error;
+ }
+ return @results;
+ } else {
+ $self->error ("unknown object audit: $audit");
+ return;
+ }
+ } elsif ($type eq 'acls') {
+ if ($audit eq 'name') {
+ return unless defined &Wallet::Config::verify_acl_name;
+ my @acls = $self->acls;
+ my @results;
+ for my $acl (@acls) {
+ my $error = Wallet::Config::verify_acl_name ($acl->[1]);
+ push (@results, $acl) if $error;
+ }
+ return @results;
+ } else {
+ $self->error ("unknown acl audit: $audit");
+ return;
+ }
+ } else {
+ $self->error ("unknown audit type: $type");
+ return;
+ }
+}
+
1;
__DATA__
@@ -312,6 +378,7 @@ ACL ACLs wildcard Allbery SQL tuples
for my $object (@objects) {
print "@$object\n";
}
+ @objects = $report->audit ('objects', 'name');
=head1 DESCRIPTION
@@ -322,8 +389,8 @@ tuples identifying objects, ACLs, or ACL entries.
To use this object, several configuration variables must be set (at least
the database configuration). For information on those variables and how
-to set them, see Wallet::Config(3). For more information on the normal
-user interface to the wallet server, see Wallet::Server(3).
+to set them, see L<Wallet::Config>. For more information on the normal
+user interface to the wallet server, see L<Wallet::Server>.
=head1 CLASS METHODS
@@ -349,11 +416,12 @@ between an empty report and an error.
Returns a list of all ACLs matching a search type and string in the
database, or all ACLs if no search information is given. There are
-currently two search types. C<empty> takes no arguments and will return
+currently three search types. C<empty> takes no arguments and will return
only those ACLs that have no entries within them. C<entry> takes two
arguments, an entry scheme and a (possibly partial) entry identifier, and
will return any ACLs containing an entry with that scheme and with an
-identifier containing that value.
+identifier containing that value. C<unused> returns all ACLs that are not
+referenced by any object.
The return value is a list of references to pairs of ACL ID and name. For
example, if there are two ACLs in the database, one with name C<ADMIN> and
@@ -366,6 +434,21 @@ Returns the empty list on failure. An error can be distinguished from
empty search results by calling error(). error() is guaranteed to return
the error message if there was an error and undef if there was no error.
+=item audit(TYPE, AUDIT)
+
+Audits the wallet database for violations of local policy. TYPE is the
+general class of thing to audit, and AUDIT is the specific audit to
+perform. TYPE may be either C<objects> or C<acls>. Currently, the only
+implemented audit is C<name>. This returns a list of all objects, as
+references to pairs of type and name, or ACLs, as references to pairs of
+ID and name, that are not accepted by the verify_name() or
+verify_acl_name() function defined in the wallet configuration. See
+L<Wallet::Config> for more information.
+
+Returns the empty list on failure. An error can be distinguished from
+empty search results by calling error(). error() is guaranteed to return
+the error message if there was an error and undef if there was no error.
+
=item error()
Returns the error of the last failing operation or undef if no operations
diff --git a/perl/Wallet/Server.pm b/perl/Wallet/Server.pm
index dd596c4..185bf23 100644
--- a/perl/Wallet/Server.pm
+++ b/perl/Wallet/Server.pm
@@ -23,7 +23,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.08';
+$VERSION = '0.09';
##############################################################################
# Utility methods
@@ -536,9 +536,16 @@ sub acl_create {
$self->error ("$self->{user} not authorized to create ACL");
return;
}
- my $dbh = $self->{dbh};
my $user = $self->{user};
my $host = $self->{host};
+ if (defined (&Wallet::Config::verify_acl_name)) {
+ my $error = Wallet::Config::verify_acl_name ($name, $user);
+ if ($error) {
+ $self->error ("$name rejected: $error");
+ return;
+ }
+ }
+ my $dbh = $self->{dbh};
my $acl = eval { Wallet::ACL->create ($name, $dbh, $user, $host) };
if ($@) {
$self->error ($@);
@@ -620,6 +627,13 @@ sub acl_rename {
$self->error ('cannot rename the ADMIN ACL');
return;
}
+ if (defined (&Wallet::Config::verify_acl_name)) {
+ my $error = Wallet::Config::verify_acl_name ($name, $self->{user});
+ if ($error) {
+ $self->error ("$name rejected: $error");
+ return;
+ }
+ }
unless ($acl->rename ($name)) {
$self->error ($acl->error);
return;
@@ -739,7 +753,7 @@ object.
To use this object, several configuration variables must be set (at least
the database configuration). For information on those variables and how
-to set them, see Wallet::Config(3).
+to set them, see L<Wallet::Config>.
=head1 CLASS METHODS
@@ -777,9 +791,9 @@ also returns undef, that ACL wasn't set; otherwise, error() will return
the error message.
If ID is given, sets the specified ACL to ID, which can be either the name
-of an ACL or a numeric ACL ID. To set an ACL, the current user must be
-authorized by the ADMIN ACL. Returns true for success and false for
-failure.
+of an ACL or a numeric ACL ID. To clear the ACL, pass in an empty string
+as the ID. To set or clear an ACL, the current user must be authorized by
+the ADMIN ACL. Returns true for success and false for failure.
ACL settings are checked before the owner and override the owner setting.
diff --git a/perl/t/acl.t b/perl/t/acl.t
index 95aa763..f169eb5 100755
--- a/perl/t/acl.t
+++ b/perl/t/acl.t
@@ -1,6 +1,6 @@
#!/usr/bin/perl -w
#
-# t/api.t -- Tests for the wallet ACL API.
+# Tests for the wallet ACL API.
#
# Written by Russ Allbery <rra@stanford.edu>
# Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University
diff --git a/perl/t/admin.t b/perl/t/admin.t
index e22088e..074dbc6 100755
--- a/perl/t/admin.t
+++ b/perl/t/admin.t
@@ -1,6 +1,6 @@
#!/usr/bin/perl -w
#
-# t/admin.t -- Tests for wallet administrative interface.
+# Tests for wallet administrative interface.
#
# Written by Russ Allbery <rra@stanford.edu>
# Copyright 2008, 2009, 2010 Board of Trustees, Leland Stanford Jr. University
diff --git a/perl/t/config.t b/perl/t/config.t
index 1377cb8..6b9f226 100755
--- a/perl/t/config.t
+++ b/perl/t/config.t
@@ -1,6 +1,6 @@
#!/usr/bin/perl -w
#
-# t/config.t -- Tests for the wallet server configuration.
+# Tests for the wallet server configuration.
#
# Written by Russ Allbery <rra@stanford.edu>
# Copyright 2008, 2010 Board of Trustees, Leland Stanford Jr. University
diff --git a/perl/t/data/keytab-fake b/perl/t/data/keytab-fake
index 0ecf264..f4f0fb3 100755
--- a/perl/t/data/keytab-fake
+++ b/perl/t/data/keytab-fake
@@ -1,6 +1,6 @@
#!/bin/sh
#
-# keytab-fake -- Fake keytab-backend implementation.
+# Fake keytab-backend implementation.
#
# This keytab-fake script is meant to be run by remctld during testing of
# the keytab object implementation. It returns a fixed string for
diff --git a/perl/t/data/netdb-fake b/perl/t/data/netdb-fake
index ae5be18..9624102 100755
--- a/perl/t/data/netdb-fake
+++ b/perl/t/data/netdb-fake
@@ -1,6 +1,6 @@
#!/bin/sh
#
-# netdb-fake -- Fake NetDB remctl interface.
+# Fake NetDB remctl interface.
#
# This netdb-fake script is meant to be run by remctld during testing of
# the NetDB ACL verifier. It returns known roles or errors for different
diff --git a/perl/t/file.t b/perl/t/file.t
index 7ab5d75..a821c4f 100755
--- a/perl/t/file.t
+++ b/perl/t/file.t
@@ -1,6 +1,6 @@
#!/usr/bin/perl -w
#
-# t/file.t -- Tests for the file object implementation.
+# Tests for the file object implementation.
#
# Written by Russ Allbery <rra@stanford.edu>
# Copyright 2008 Board of Trustees, Leland Stanford Jr. University
diff --git a/perl/t/init.t b/perl/t/init.t
index d0fae9f..213aedf 100755
--- a/perl/t/init.t
+++ b/perl/t/init.t
@@ -1,6 +1,6 @@
#!/usr/bin/perl -w
#
-# t/init.t -- Tests for database initialization.
+# Tests for database initialization.
#
# Written by Russ Allbery <rra@stanford.edu>
# Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University
diff --git a/perl/t/kadmin.t b/perl/t/kadmin.t
index 6365ce5..e5fb2fa 100755
--- a/perl/t/kadmin.t
+++ b/perl/t/kadmin.t
@@ -1,6 +1,6 @@
#!/usr/bin/perl -w
#
-# t/kadmin.t -- Tests for the kadmin object implementation.
+# Tests for the kadmin object implementation.
#
# Written by Jon Robertson <jonrober@stanford.edu>
# Copyright 2009, 2010 Board of Trustees, Leland Stanford Jr. University
@@ -81,6 +81,9 @@ SKIP: {
$Wallet::Config::KEYTAB_KRBTYPE = contents ('t/data/test.krbtype');
$Wallet::Config::KEYTAB_TMP = '.';
+ # Don't destroy the user's Kerberos ticket cache.
+ $ENV{KRB5CCNAME} = 'krb5cc_test';
+
# Create the object and clean up the principal we're going to use.
$kadmin = eval { Wallet::Kadmin->new };
ok (defined $kadmin, 'Creating Wallet::Kadmin object succeeds');
diff --git a/perl/t/keytab.t b/perl/t/keytab.t
index 046da9c..b16cea5 100755
--- a/perl/t/keytab.t
+++ b/perl/t/keytab.t
@@ -1,6 +1,6 @@
#!/usr/bin/perl -w
#
-# t/keytab.t -- Tests for the keytab object implementation.
+# Tests for the keytab object implementation.
#
# Written by Russ Allbery <rra@stanford.edu>
# Copyright 2007, 2008, 2009, 2010
diff --git a/perl/t/lib/Util.pm b/perl/t/lib/Util.pm
index ab88b39..44a4d21 100644
--- a/perl/t/lib/Util.pm
+++ b/perl/t/lib/Util.pm
@@ -1,4 +1,4 @@
-# Util -- Utility class for wallet tests.
+# Utility class for wallet tests.
#
# Written by Russ Allbery <rra@stanford.edu>
# Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University
@@ -16,7 +16,7 @@ use Wallet::Config;
# 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.02';
+$VERSION = '0.03';
use Exporter ();
@ISA = qw(Exporter);
diff --git a/perl/t/object.t b/perl/t/object.t
index 46e67e5..3949786 100755
--- a/perl/t/object.t
+++ b/perl/t/object.t
@@ -1,6 +1,6 @@
#!/usr/bin/perl -w
#
-# t/object.t -- Tests for the basic object implementation.
+# Tests for the basic object implementation.
#
# Written by Russ Allbery <rra@stanford.edu>
# Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University
diff --git a/perl/t/pod-spelling.t b/perl/t/pod-spelling.t
index d3ab858..6d9f7b0 100755
--- a/perl/t/pod-spelling.t
+++ b/perl/t/pod-spelling.t
@@ -9,8 +9,7 @@
#
# Copyright 2008, 2009 Russ Allbery <rra@stanford.edu>
#
-# This program is free software; you may redistribute it and/or modify it
-# under the same terms as Perl itself.
+# See LICENSE for licensing terms.
use strict;
use Test::More;
diff --git a/perl/t/report.t b/perl/t/report.t
index a18b995..1dc69f7 100755
--- a/perl/t/report.t
+++ b/perl/t/report.t
@@ -1,13 +1,13 @@
#!/usr/bin/perl -w
#
-# t/report.t -- Tests for the wallet reporting interface.
+# Tests for the wallet reporting interface.
#
# Written by Russ Allbery <rra@stanford.edu>
# Copyright 2008, 2009, 2010 Board of Trustees, Leland Stanford Jr. University
#
# See LICENSE for licensing terms.
-use Test::More tests => 83;
+use Test::More tests => 151;
use Wallet::Admin;
use Wallet::Report;
@@ -166,6 +166,79 @@ is ($server->flag_clear ('base', 'service/admin', 'unchanging'), 1,
is (scalar (@lines), 0, ' and now there are no objects in the report');
is ($report->error, undef, ' with no error');
+# All of our ACLs should be in use.
+@lines = $report->acls ('unused');
+is (scalar (@lines), 0, 'Searching for unused ACLs returns nothing');
+is ($report->error, undef, ' with no error');
+
+# Create some unused ACLs that should show up in the report.
+is ($server->acl_create ('third'), 1, 'Creating an empty ACL succeeds');
+is ($server->acl_create ('fourth'), 1, ' and creating another succeeds');
+@lines = $report->acls ('unused');
+is (scalar (@lines), 2, ' and now we see two unused ACLs');
+is ($server->error, undef, ' with no error');
+is ($lines[0][0], 4, ' and the first has the right ID');
+is ($lines[0][1], 'third', ' and the right name');
+is ($lines[1][0], 5, ' and the second has the right ID');
+is ($lines[1][1], 'fourth', ' and the right name');
+
+# Use one of those ACLs and ensure it drops out of the report. Test that we
+# try all of the possible ACL types.
+for my $type (qw/get store show destroy flags/) {
+ is ($server->acl ('base', 'service/admin', $type, 'fourth'), 1,
+ "Setting ACL $type to fourth succeeds");
+ @lines = $report->acls ('unused');
+ is (scalar (@lines), 1, ' and now we see only one unused ACL');
+ is ($lines[0][0], 4, ' with the right ID');
+ is ($lines[0][1], 'third', ' and the right name');
+ is ($server->acl ('base', 'service/admin', $type, ''), 1,
+ ' and clearing the ACL succeeds');
+ @lines = $report->acls ('unused');
+ is (scalar (@lines), 2, ' and now we see two unused ACLs');
+ is ($lines[0][0], 4, ' and the first has the right ID');
+ is ($lines[0][1], 'third', ' and the right name');
+ is ($lines[1][0], 5, ' and the second has the right ID');
+ is ($lines[1][1], 'fourth', ' and the right name');
+}
+
+# The naming audit returns nothing if there's no naming policy.
+@lines = $report->audit ('objects', 'name');
+is (scalar (@lines), 0, 'Searching for naming violations finds none');
+is ($report->error, undef, ' with no error');
+
+# Set a naming policy and then look for objects that fail that policy. We
+# have to deactivate this policy until now so that it doesn't prevent the
+# creation of that name originally, which is the reason for the variable
+# reference.
+our $naming_active = 1;
+package Wallet::Config;
+sub verify_name {
+ my ($type, $name) = @_;
+ return unless $naming_active;
+ return 'admin not allowed' if $name eq 'service/admin';
+ return;
+}
+package main;
+@lines = $report->audit ('objects', 'name');
+is (scalar (@lines), 1, 'Searching for naming violations finds one');
+is ($lines[0][0], 'base', ' and the first has the right type');
+is ($lines[0][1], 'service/admin', ' and the right name');
+
+# Set an ACL naming policy and then look for objects that fail that policy.
+# Use the same deactivation trick as above.
+package Wallet::Config;
+sub verify_acl_name {
+ my ($name) = @_;
+ return unless $naming_active;
+ return 'second not allowed' if $name eq 'second';
+ return;
+}
+package main;
+@lines = $report->audit ('acls', 'name');
+is (scalar (@lines), 1, 'Searching for ACL naming violations finds one');
+is ($lines[0][0], 3, ' and the first has the right ID');
+is ($lines[0][1], 'second', ' and the right name');
+
# Clean up.
$admin->destroy;
unlink 'wallet-db';
diff --git a/perl/t/schema.t b/perl/t/schema.t
index 559ece4..7f0aea4 100755
--- a/perl/t/schema.t
+++ b/perl/t/schema.t
@@ -1,6 +1,6 @@
#!/usr/bin/perl -w
#
-# t/schema.t -- Tests for the wallet schema class.
+# Tests for the wallet schema class.
#
# Written by Russ Allbery <rra@stanford.edu>
# Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University
diff --git a/perl/t/server.t b/perl/t/server.t
index 090387b..ed92d6e 100755
--- a/perl/t/server.t
+++ b/perl/t/server.t
@@ -1,13 +1,13 @@
#!/usr/bin/perl -w
#
-# t/server.t -- Tests for the wallet server API.
+# Tests for the wallet server API.
#
# 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.
-use Test::More tests => 341;
+use Test::More tests => 355;
use POSIX qw(strftime);
use Wallet::Admin;
@@ -923,6 +923,41 @@ is ($server->error, 'base:host/default.stanford.edu rejected: host'
. ' default.stanford.edu not in .example.edu domain',
' with the right error');
+# Ensure that we can't destroy an ACL that's in use.
+is ($server->acl_create ('test-destroy'), 1, 'Creating an ACL works');
+is ($server->create ('base', 'service/acl-user'), 1, 'Creating object works');
+is ($server->owner ('base', 'service/acl-user', 'test-destroy'), 1,
+ ' and setting owner');
+is ($server->acl_destroy ('test-destroy'), undef,
+ ' and now we cannot destroy that ACL');
+is ($server->error,
+ 'cannot destroy ACL 9: ACL in use by base:service/acl-user',
+ ' with the right error');
+is ($server->owner ('base', 'service/acl-user', ''), 1,
+ ' but after we clear the owner');
+is ($server->acl_destroy ('test-destroy'), 1, ' now we can destroy the ACL');
+is ($server->destroy ('base', 'service/acl-user'), 1, ' and the object');
+
+# Test ACL naming enforcement. Require that ACL names not contain a slash.
+package Wallet::Config;
+sub verify_acl_name {
+ my ($name, $user) = @_;
+ return 'ACL names may not contain slash' if $name =~ m,/,;
+ return;
+}
+package main;
+is ($server->acl_create ('test/naming'), undef,
+ 'Creating an ACL with a disallowed name fails');
+is ($server->error, 'test/naming rejected: ACL names may not contain slash',
+ ' with the right error message');
+is ($server->acl_create ('test-naming'), 1,
+ 'Creating test-naming succeeds');
+is ($server->acl_rename ('test-naming', 'test/naming'), undef,
+ ' but renaming it fails');
+is ($server->error, 'test/naming rejected: ACL names may not contain slash',
+ ' with the right error message');
+is ($server->acl_destroy ('test-naming'), 1, 'Destroying it succeeds');
+
# Clean up.
$setup->destroy;
unlink 'wallet-db';
diff --git a/perl/t/verifier-netdb.t b/perl/t/verifier-netdb.t
index dcbbdd8..6bd4e73 100755
--- a/perl/t/verifier-netdb.t
+++ b/perl/t/verifier-netdb.t
@@ -1,15 +1,15 @@
#!/usr/bin/perl -w
#
-# t/verifier-netdb.t -- Tests for the NetDB wallet ACL verifiers.
+# Tests for the NetDB wallet ACL verifiers.
+#
+# This test can only be run by someone local to Stanford with appropriate
+# access to the NetDB role server and will be skipped in all other
+# environments.
#
# Written by Russ Allbery <rra@stanford.edu>
# Copyright 2008 Board of Trustees, Leland Stanford Jr. University
#
# See LICENSE for licensing terms.
-#
-# This test can only be run by someone local to Stanford with appropriate
-# access to the NetDB role server and will be skipped in all other
-# environments.
use Test::More tests => 4;
diff --git a/perl/t/verifier.t b/perl/t/verifier.t
index 3243d9c..74d7ba8 100755
--- a/perl/t/verifier.t
+++ b/perl/t/verifier.t
@@ -1,6 +1,6 @@
#!/usr/bin/perl -w
#
-# t/verifier.t -- Tests for the basic wallet ACL verifiers.
+# Tests for the basic wallet ACL verifiers.
#
# Written by Russ Allbery <rra@stanford.edu>
# Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University
@@ -39,8 +39,8 @@ is ($verifier->error, 'no principal specified', ' and right error');
is ($verifier->check ('rra@stanford.edu', ''), undef, 'Empty ACL');
is ($verifier->error, 'malformed krb5 ACL', ' and right error');
-# Tests for unchanging support. Skip these if we don't have a keytab or if we
-# can't find remctld.
+# Tests for the NetDB verifiers. Skip these if we don't have a keytab or if
+# we can't find remctld.
SKIP: {
skip 'no keytab configuration', 34 unless -f 't/data/test.keytab';
my @path = (split (':', $ENV{PATH}), '/usr/local/sbin', '/usr/sbin');
diff --git a/portable/krb5-extra.c b/portable/krb5-extra.c
index afd00e8..dcddbe4 100644
--- a/portable/krb5-extra.c
+++ b/portable/krb5-extra.c
@@ -77,7 +77,7 @@ krb5_get_error_message(krb5_context ctx UNUSED, krb5_error_code code UNUSED)
* krb5_free_error_message is a subset of those with krb5_get_error_message.
* If this assumption ever breaks, we may call the wrong free function.
*/
-static void
+void
krb5_free_error_message(krb5_context ctx UNUSED, const char *msg)
{
if (msg == error_unknown)
diff --git a/server/keytab-backend.8 b/server/keytab-backend.8
index 41f9a89..7a08ede 100644
--- a/server/keytab-backend.8
+++ b/server/keytab-backend.8
@@ -124,7 +124,7 @@
.\" ========================================================================
.\"
.IX Title "KEYTAB-BACKEND 8"
-.TH KEYTAB-BACKEND 8 "2010-02-21" "0.10" "wallet"
+.TH KEYTAB-BACKEND 8 "2010-03-08" "0.11" "wallet"
.\" For nroff, turn off justification. Always turn off hyphenation; it makes
.\" way too many mistakes in technical documents.
.if n .ad l
diff --git a/server/wallet-admin b/server/wallet-admin
index 828cfc5..f81c195 100755
--- a/server/wallet-admin
+++ b/server/wallet-admin
@@ -1,6 +1,6 @@
#!/usr/bin/perl -w
#
-# wallet-backend -- Wallet server administrative commands.
+# wallet-admin -- Wallet server administrative commands.
#
# Written by Russ Allbery <rra@stanford.edu>
# Copyright 2008, 2009, 2010 Board of Trustees, Leland Stanford Jr. University
@@ -41,45 +41,6 @@ sub command {
die "invalid admin principal $args[0]\n"
unless $args[0] =~ /^[^\@\s]+\@\S+$/;
$admin->initialize (@args) or die $admin->error, "\n";
- } elsif ($command eq 'list') {
- die "too many arguments to list\n" if @args > 4;
- die "too few arguments to list\n" if @args < 1;
- my ($type, $subtype, @search) = @args;
- if ($type eq 'objects') {
- my @objects = $admin->list_objects ($subtype, @search);
- if (!@objects and $admin->error) {
- die $admin->error, "\n";
- }
- for my $object (@objects) {
- print join (' ', @$object), "\n";
- }
- } elsif ($type eq 'acls') {
- my @acls = $admin->list_acls ($subtype, @search);
- if (!@acls and $admin->error) {
- die $admin->error, "\n";
- }
- for my $acl (sort { $$a[1] cmp $$b[1] } @acls) {
- print "$$acl[1] (ACL ID: $$acl[0])\n";
- }
- } else {
- die "only objects or acls are supported for list\n";
- }
- } elsif ($command eq 'report') {
- die "too few arguments to report\n" if @args < 1;
- my $report = shift @args;
- if ($report eq 'owners') {
- die "too many arguments to report owners\n" if @args > 2;
- die "too few arguments to report owners\n" if @args < 2;
- my @lines = $admin->report_owners (@args);
- if (!@lines and $admin->error) {
- die $admin->error, "\n";
- }
- for my $line (@lines) {
- print join (' ', @$line), "\n";
- }
- } else {
- die "unknown report type $report\n";
- }
} elsif ($command eq 'register') {
die "too many arguments to register\n" if @args > 3;
die "too few arguments to register\n" if @args < 3;
@@ -159,66 +120,6 @@ Before running C<initialize>, the wallet system has to be configured. See
Wallet::Config(3) for more details. Depending on the database backend
used, the database may also have to be created in advance.
-=item list (acls | objects) [ <searchtype> [ <arg> ... ] ]
-
-Returns a list of ACLs or objects in the database. ACLs will be listed
-in the form:
-
- <name> (ACL ID: <id>)
-
-where <name> is the human-readable name and <id> is the numeric ID. The
-numeric ID is what's used internally by the wallet system. Objects will
-be listed in the form:
-
- <type> <name>
-
-In both cases, there will be one line per ACL or object.
-
-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:
-
-=over 4
-
-=item list objects type <type>
-
-Returns all objects of the given type.
-
-=item list objects flag <flag>
-
-Returns all objects which have the given flag set.
-
-=item list objects owner <acl name>
-
-Returns all objects owned by the given ACL name.
-
-=item list objects acl <acl name>
-
-Returns all objects for which the given ACL name has any permissions.
-This includes those objects owned by the ACL, but also those for which the
-ACL has get permissions, for example.
-
-=back
-
-The currently supported ACL search types are:
-
-=over 4
-
-=item list acls empty
-
-Returns all ACLs which have no entries, generally so that abandoned ACLs
-can be destroyed.
-
-=item list acls entry <schema> <identifier>
-
-Returns all ACLs containing an entry with given schema and identifier.
-The schema is used for an exact search, while the identifier given will
-match any identifier containing that text, for flexibility.
-
-=back
-
=item register (object | verifier) <type> <class>
Registers an implementation of a wallet object or ACL verifier in the
@@ -232,27 +133,6 @@ default as part of database initialization, so this command is used
primarily to register local implementations of additional object types or
ACL schemes.
-=item report <type> [ <arg> ... ]
-
-Runs a wallet report. The currently supported report types are:
-
-=over 4
-
-=item report owners <type-pattern> <name-pattern>
-
-Returns a list of all ACL lines in owner ACLs for all objects matching
-both <type-pattern> and <name-pattern>. These can be the type or name of
-objects or they can be patterns using C<%> as the wildcard character
-following the normal rules of SQL patterns.
-
-The output will be one line per ACL line in the form:
-
- <scheme> <identifier>
-
-with duplicates suppressed.
-
-=back
-
=back
=head1 SEE ALSO
diff --git a/server/wallet-admin.8 b/server/wallet-admin.8
index 8e1ad12..bc5c7ea 100644
--- a/server/wallet-admin.8
+++ b/server/wallet-admin.8
@@ -124,7 +124,7 @@
.\" ========================================================================
.\"
.IX Title "WALLET-ADMIN 8"
-.TH WALLET-ADMIN 8 "2010-02-21" "0.10" "wallet"
+.TH WALLET-ADMIN 8 "2010-03-08" "0.11" "wallet"
.\" For nroff, turn off justification. Always turn off hyphenation; it makes
.\" way too many mistakes in technical documents.
.if n .ad l
@@ -170,61 +170,6 @@ and for any subsequent actions required to initialize the database.
Before running \f(CW\*(C`initialize\*(C'\fR, the wallet system has to be configured. See
\&\fIWallet::Config\fR\|(3) for more details. Depending on the database backend
used, the database may also have to be created in advance.
-.IP "list (acls | objects) [ <searchtype> [ <arg> ... ] ]" 4
-.IX Item "list (acls | objects) [ <searchtype> [ <arg> ... ] ]"
-Returns a list of ACLs or objects in the database. ACLs will be listed
-in the form:
-.Sp
-.Vb 1
-\& <name> (ACL ID: <id>)
-.Ve
-.Sp
-where <name> is the human-readable name and <id> is the numeric \s-1ID\s0. The
-numeric \s-1ID\s0 is what's used internally by the wallet system. Objects will
-be listed in the form:
-.Sp
-.Vb 1
-\& <type> <name>
-.Ve
-.Sp
-In both cases, there will be one line per \s-1ACL\s0 or object.
-.Sp
-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.
-.Sp
-The currently supported object search types are:
-.RS 4
-.IP "list objects type <type>" 4
-.IX Item "list objects type <type>"
-Returns all objects of the given type.
-.IP "list objects flag <flag>" 4
-.IX Item "list objects flag <flag>"
-Returns all objects which have the given flag set.
-.IP "list objects owner <acl name>" 4
-.IX Item "list objects owner <acl name>"
-Returns all objects owned by the given \s-1ACL\s0 name.
-.IP "list objects acl <acl name>" 4
-.IX Item "list objects acl <acl name>"
-Returns all objects for which the given \s-1ACL\s0 name has any permissions.
-This includes those objects owned by the \s-1ACL\s0, but also those for which the
-\&\s-1ACL\s0 has get permissions, for example.
-.RE
-.RS 4
-.Sp
-The currently supported \s-1ACL\s0 search types are:
-.IP "list acls empty" 4
-.IX Item "list acls empty"
-Returns all ACLs which have no entries, generally so that abandoned ACLs
-can be destroyed.
-.IP "list acls entry <schema> <identifier>" 4
-.IX Item "list acls entry <schema> <identifier>"
-Returns all ACLs containing an entry with given schema and identifier.
-The schema is used for an exact search, while the identifier given will
-match any identifier containing that text, for flexibility.
-.RE
-.RS 4
-.RE
.IP "register (object | verifier) <type> <class>" 4
.IX Item "register (object | verifier) <type> <class>"
Registers an implementation of a wallet object or \s-1ACL\s0 verifier in the
@@ -237,27 +182,6 @@ All object and \s-1ACL\s0 implementations that come with wallet are registered b
default as part of database initialization, so this command is used
primarily to register local implementations of additional object types or
\&\s-1ACL\s0 schemes.
-.IP "report <type> [ <arg> ... ]" 4
-.IX Item "report <type> [ <arg> ... ]"
-Runs a wallet report. The currently supported report types are:
-.RS 4
-.IP "report owners <type\-pattern> <name\-pattern>" 4
-.IX Item "report owners <type-pattern> <name-pattern>"
-Returns a list of all \s-1ACL\s0 lines in owner ACLs for all objects matching
-both <type\-pattern> and <name\-pattern>. These can be the type or name of
-objects or they can be patterns using \f(CW\*(C`%\*(C'\fR as the wildcard character
-following the normal rules of \s-1SQL\s0 patterns.
-.Sp
-The output will be one line per \s-1ACL\s0 line in the form:
-.Sp
-.Vb 1
-\& <scheme> <identifier>
-.Ve
-.Sp
-with duplicates suppressed.
-.RE
-.RS 4
-.RE
.SH "SEE ALSO"
.IX Header "SEE ALSO"
\&\fIWallet::Admin\fR\|(3), \fIWallet::Config\fR\|(3), \fIwallet\-backend\fR\|(8)
diff --git a/server/wallet-backend.8 b/server/wallet-backend.8
index 2283da0..47b3e3b 100644
--- a/server/wallet-backend.8
+++ b/server/wallet-backend.8
@@ -124,7 +124,7 @@
.\" ========================================================================
.\"
.IX Title "WALLET-BACKEND 8"
-.TH WALLET-BACKEND 8 "2010-02-21" "0.10" "wallet"
+.TH WALLET-BACKEND 8 "2010-03-08" "0.11" "wallet"
.\" For nroff, turn off justification. Always turn off hyphenation; it makes
.\" way too many mistakes in technical documents.
.if n .ad l
diff --git a/server/wallet-report b/server/wallet-report
index a6b3b8d..435fb73 100755
--- a/server/wallet-report
+++ b/server/wallet-report
@@ -35,6 +35,20 @@ sub command {
for my $acl (sort { $$a[1] cmp $$b[1] } @acls) {
print "$$acl[1] (ACL ID: $$acl[0])\n";
}
+ } elsif ($command eq 'audit') {
+ die "too many arguments to audit\n" if @args > 2;
+ die "too few arguments to audit\n" if @args < 2;
+ my @result = $report->audit (@args);
+ if (!@result and $report->error) {
+ die $report->error, "\n";
+ }
+ for my $item (@result) {
+ if ($args[0] eq 'acls') {
+ print "$$item[1] (ACL ID: $$item[0])\n";
+ } else {
+ print join (' ', @$item), "\n";
+ }
+ }
} elsif ($command eq 'objects') {
die "too many arguments to objects\n" if @args > 2;
my @objects = $report->objects (@args);
@@ -100,6 +114,8 @@ B<wallet-report> takes no traditional options.
=item acls entry <scheme> <identifier>
+=item acls unused
+
Returns a list of ACLs in the database. ACLs will be listed in the form:
<name> (ACL ID: <id>)
@@ -127,8 +143,30 @@ Returns all ACLs containing an entry with given scheme and identifier.
The scheme must be an exact match, but the <identifier> string will match
any identifier containing that string.
+=item acls unused
+
+Returns all ACLs that are not referenced by any of the objects in the
+wallet database, either as an owner or on one of the more specific ACLs.
+
=back
+=item audit acls name
+
+=item audit objects name
+
+Returns all ACLs or objects that violate the current site naming policy.
+Objects will be listed in the form:
+
+ <type> <name>
+
+and ACLs in the form:
+
+ <name> (ACL ID: <id>)
+
+where <name> is the human-readable name and <id> is the numeric ID. The
+numeric ID is what's used internally by the wallet system. There will be
+one line per object or ACL.
+
=item objects
=item objects acl <acl>
@@ -154,21 +192,21 @@ The currently supported object search types are:
=over 4
-=item list objects acl <acl>
+=item objects acl <acl>
Returns all objects for which the given ACL name or ID has any
permissions. This includes those objects owned by the ACL as well as
those where that ACL has any other, more limited permissions.
-=item list objects flag <flag>
+=item objects flag <flag>
Returns all objects which have the given flag set.
-=item list objects owner <acl>
+=item objects owner <acl>
Returns all objects owned by the given ACL name or ID.
-=item list objects type <type>
+=item objects type <type>
Returns all objects of the given type.
diff --git a/server/wallet-report.8 b/server/wallet-report.8
index 106f47d..cd56501 100644
--- a/server/wallet-report.8
+++ b/server/wallet-report.8
@@ -124,7 +124,7 @@
.\" ========================================================================
.\"
.IX Title "WALLET-REPORT 8"
-.TH WALLET-REPORT 8 "2010-02-21" "0.10" "wallet"
+.TH WALLET-REPORT 8 "2010-03-08" "0.11" "wallet"
.\" For nroff, turn off justification. Always turn off hyphenation; it makes
.\" way too many mistakes in technical documents.
.if n .ad l
@@ -155,6 +155,8 @@ translates command strings into method calls and returns the results.
.IX Item "acls empty"
.IP "acls entry <scheme> <identifier>" 4
.IX Item "acls entry <scheme> <identifier>"
+.IP "acls unused" 4
+.IX Item "acls unused"
.PD
Returns a list of ACLs in the database. ACLs will be listed in the form:
.Sp
@@ -181,9 +183,35 @@ can be destroyed.
Returns all ACLs containing an entry with given scheme and identifier.
The scheme must be an exact match, but the <identifier> string will match
any identifier containing that string.
+.IP "acls unused" 4
+.IX Item "acls unused"
+Returns all ACLs that are not referenced by any of the objects in the
+wallet database, either as an owner or on one of the more specific ACLs.
.RE
.RS 4
.RE
+.IP "audit acls name" 4
+.IX Item "audit acls name"
+.PD 0
+.IP "audit objects name" 4
+.IX Item "audit objects name"
+.PD
+Returns all ACLs or objects that violate the current site naming policy.
+Objects will be listed in the form:
+.Sp
+.Vb 1
+\& <type> <name>
+.Ve
+.Sp
+and ACLs in the form:
+.Sp
+.Vb 1
+\& <name> (ACL ID: <id>)
+.Ve
+.Sp
+where <name> is the human-readable name and <id> is the numeric \s-1ID\s0. The
+numeric \s-1ID\s0 is what's used internally by the wallet system. There will be
+one line per object or \s-1ACL\s0.
.IP "objects" 4
.IX Item "objects"
.PD 0
@@ -211,19 +239,19 @@ will be limited to those that match the search.
.Sp
The currently supported object search types are:
.RS 4
-.IP "list objects acl <acl>" 4
-.IX Item "list objects acl <acl>"
+.IP "objects acl <acl>" 4
+.IX Item "objects acl <acl>"
Returns all objects for which the given \s-1ACL\s0 name or \s-1ID\s0 has any
permissions. This includes those objects owned by the \s-1ACL\s0 as well as
those where that \s-1ACL\s0 has any other, more limited permissions.
-.IP "list objects flag <flag>" 4
-.IX Item "list objects flag <flag>"
+.IP "objects flag <flag>" 4
+.IX Item "objects flag <flag>"
Returns all objects which have the given flag set.
-.IP "list objects owner <acl>" 4
-.IX Item "list objects owner <acl>"
+.IP "objects owner <acl>" 4
+.IX Item "objects owner <acl>"
Returns all objects owned by the given \s-1ACL\s0 name or \s-1ID\s0.
-.IP "list objects type <type>" 4
-.IX Item "list objects type <type>"
+.IP "objects type <type>" 4
+.IX Item "objects type <type>"
Returns all objects of the given type.
.RE
.RS 4
diff --git a/tests/data/fake-kadmin b/tests/data/fake-kadmin
index 61906a4..4c0ceac 100755
--- a/tests/data/fake-kadmin
+++ b/tests/data/fake-kadmin
@@ -1,9 +1,10 @@
#!/usr/bin/perl -w
#
-# fake-kadmin -- Fake kadmin.local used to test the keytab backend.
+# Fake kadmin.local used to test the keytab backend.
#
# Written by Russ Allbery <rra@stanford.edu>
# Copyright 2007 Board of Trustees, Leland Stanford Jr. University
+#
# See LICENSE for licensing terms.
unless ($ARGV[0] eq '-q' && @ARGV == 2) {
diff --git a/tests/data/wallet.conf b/tests/data/wallet.conf
index 0a232dd..877a16f 100644
--- a/tests/data/wallet.conf
+++ b/tests/data/wallet.conf
@@ -1,4 +1,4 @@
-# wallet.conf -- Test wallet server configuration. -*- perl -*-
+# Test wallet server configuration. -*- perl -*-
# Always test with SQLite.
$DB_DRIVER = 'SQLite';
diff --git a/tests/server/report-t b/tests/server/report-t
index 285ee5a..394a869 100755
--- a/tests/server/report-t
+++ b/tests/server/report-t
@@ -8,7 +8,7 @@
# See LICENSE for licensing terms.
use strict;
-use Test::More tests => 32;
+use Test::More tests => 44;
# Create a dummy class for Wallet::Report that prints what method was called
# with its arguments and returns data for testing.
@@ -38,6 +38,19 @@ sub acls {
return ([ 1, 'ADMIN' ], [ 2, 'group/admins' ], [ 4, 'group/users' ]);
}
+sub audit {
+ shift;
+ print "audit @_\n";
+ return if ($error or $empty);
+ if ($_[0] eq 'objects') {
+ return ([ file => 'unix-wallet-password' ]);
+ } elsif ($_[0] eq 'acls') {
+ return ([ 2, 'group/admins' ]);
+ } else {
+ return;
+ }
+}
+
sub objects {
shift;
print "objects @_\n";
@@ -81,6 +94,7 @@ is ($out, "new\n", ' and nothing ran');
# Check too few and too many arguments for every command.
my %commands = (acls => [0, 3],
+ audit => [2, 2],
objects => [0, 2],
owners => [2, 2]);
for my $command (sort keys %commands) {
@@ -110,6 +124,14 @@ is ($err, '', 'List succeeds for ACLs');
is ($out, "new\nacls entry foo foo\n"
. "ADMIN (ACL ID: 1)\ngroup/admins (ACL ID: 2)\ngroup/users (ACL ID: 4)\n",
' and returns the right output');
+($out, $err) = run_report ('audit', 'objects', 'name');
+is ($err, '', 'Object audit report succeeds');
+is ($out, "new\naudit objects name\nfile unix-wallet-password\n",
+ ' and returns the right output');
+($out, $err) = run_report ('audit', 'acls', 'name');
+is ($err, '', 'ACL audit report succeeds');
+is ($out, "new\naudit acls name\ngroup/admins (ACL ID: 2)\n",
+ ' and returns the right output');
($out, $err) = run_report ('objects');
is ($err, '', 'List succeeds for objects');
is ($out, "new\nobjects \n"
@@ -128,24 +150,30 @@ is ($out, "new\nowners % %\nkrb5 admin\@EXAMPLE.COM\n",
# Test error handling.
$Wallet::Report::error = 1;
($out, $err) = run_report ('acls');
-is ($err, "some error\n", 'Error handling succeeds for list acls');
+is ($err, "some error\n", 'Error handling succeeds for acls');
is ($out, "new\nacls \n", ' and calls the right methods');
+($out, $err) = run_report ('audit', 'objects', 'name');
+is ($err, "some error\n", 'Error handling succeeds for audit');
+is ($out, "new\naudit objects name\n", ' and calls the right methods');
($out, $err) = run_report ('objects');
-is ($err, "some error\n", 'Error handling succeeds for list objects');
+is ($err, "some error\n", 'Error handling succeeds for objects');
is ($out, "new\nobjects \n", ' and calls the right methods');
($out, $err) = run_report ('owners', 'foo', 'bar');
-is ($err, "some error\n", 'Error handling succeeds for report owners');
+is ($err, "some error\n", 'Error handling succeeds for owners');
is ($out, "new\nowners foo bar\n", ' and calls the right methods');
# Test empty lists.
$Wallet::Report::error = 0;
$Wallet::Report::empty = 1;
($out, $err) = run_report ('acls');
-is ($err, '', 'list acls runs with an empty list and no errors');
+is ($err, '', 'acls runs with an empty list and no errors');
is ($out, "new\nacls \n", ' and calls the right methods');
+($out, $err) = run_report ('audit', 'objects', 'name');
+is ($err, '', 'audit runs with an empty list and no errors');
+is ($out, "new\naudit objects name\n", ' and calls the right methods');
($out, $err) = run_report ('objects');
-is ($err, '', 'list objects runs with an empty list with no errors');
+is ($err, '', 'objects runs with an empty list with no errors');
is ($out, "new\nobjects \n", ' and calls the right methods');
($out, $err) = run_report ('owners', 'foo', 'bar');
-is ($err, '', 'report owners runs with an empty list and no errors');
+is ($err, '', 'owners runs with an empty list and no errors');
is ($out, "new\nowners foo bar\n", ' and calls the right methods');