From 574a9c0456c182831b3d01a4d7ee0c737b91b107 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 9 Jun 2009 14:39:39 -0700 Subject: Remove Subversion Id strings --- Makefile.am | 1 - autogen | 1 - client/file.c | 3 +-- client/internal.h | 3 +-- client/keytab.c | 3 +-- client/krb5.c | 3 +-- client/remctl.c | 3 +-- client/srvtab.c | 3 +-- client/wallet.c | 3 +-- configure.ac | 1 - contrib/convert-srvtab-db | 1 - contrib/used-principals | 1 - contrib/wallet-report | 3 +-- examples/stanford.conf | 1 - kasetkey/README | 2 -- kasetkey/kasetkey.c | 3 +-- m4/gssapi.m4 | 1 - m4/kaserver.m4 | 1 - m4/krb4.m4 | 1 - m4/krb5.m4 | 1 - m4/lib-depends.m4 | 1 - m4/remctl.m4 | 1 - m4/snprintf.m4 | 1 - m4/vamacros.m4 | 1 - perl/Makefile.PL.in | 1 - perl/Wallet/ACL.pm | 1 - perl/Wallet/ACL/Base.pm | 1 - perl/Wallet/ACL/Krb5.pm | 1 - perl/Wallet/ACL/NetDB.pm | 1 - perl/Wallet/ACL/NetDB/Root.pm | 1 - perl/Wallet/Admin.pm | 1 - perl/Wallet/Config.pm | 1 - perl/Wallet/Database.pm | 1 - perl/Wallet/Object/Base.pm | 1 - perl/Wallet/Object/File.pm | 1 - perl/Wallet/Object/Keytab.pm | 1 - perl/Wallet/Schema.pm | 1 - perl/Wallet/Server.pm | 1 - perl/t/acl.t | 1 - perl/t/admin.t | 1 - perl/t/config.t | 1 - perl/t/data/keytab-fake | 1 - perl/t/data/keytab.conf | 2 -- perl/t/data/netdb-fake | 1 - perl/t/data/netdb.conf | 2 -- perl/t/file.t | 1 - perl/t/init.t | 1 - perl/t/keytab.t | 1 - perl/t/lib/Util.pm | 1 - perl/t/object.t | 1 - perl/t/pod.t | 1 - perl/t/schema.t | 1 - perl/t/server.t | 1 - perl/t/verifier-netdb.t | 1 - perl/t/verifier.t | 1 - portable/asprintf.c | 3 +-- portable/dummy.c | 3 +-- portable/macros.h | 3 +-- portable/snprintf.c | 3 +-- portable/stdbool.h | 3 +-- portable/strlcat.c | 3 +-- portable/strlcpy.c | 3 +-- portable/system.h | 3 +-- server/keytab-backend | 1 - server/wallet-admin | 1 - server/wallet-backend | 1 - tests/client/basic-t.in | 1 - tests/client/full-t.in | 1 - tests/client/pod-t.in | 1 - tests/client/prompt-t.in | 1 - tests/data/basic.conf | 1 - tests/data/cmd-fake | 1 - tests/data/cmd-wrapper.in | 1 - tests/data/fake-kadmin | 1 - tests/data/full.conf.in | 1 - tests/data/wallet.conf | 1 - tests/kasetkey/basic-t.in | 1 - tests/libtest.c | 3 +-- tests/libtest.h | 3 +-- tests/libtest.sh | 2 -- tests/portable/asprintf-t.c | 3 +-- tests/portable/snprintf-t.c | 3 +-- tests/portable/strlcat-t.c | 3 +-- tests/portable/strlcpy-t.c | 3 +-- tests/runtests.c | 3 +-- tests/server/admin-t.in | 1 - tests/server/backend-t.in | 1 - tests/server/pod-t.in | 1 - tests/util/concat-t.c | 3 +-- tests/util/messages-t.c | 3 +-- tests/util/xmalloc-t.in | 1 - tests/util/xmalloc.c | 3 +-- util/concat.c | 3 +-- util/messages-krb5.c | 3 +-- util/messages.c | 3 +-- util/util.h | 3 +-- util/xmalloc.c | 3 +-- 97 files changed, 32 insertions(+), 133 deletions(-) diff --git a/Makefile.am b/Makefile.am index 05f7b8c..1465a9b 100644 --- a/Makefile.am +++ b/Makefile.am @@ -1,5 +1,4 @@ # Makefile.am -- Automake makefile for wallet. -# $Id$ # # Written by Russ Allbery # Copyright 2006, 2007, 2008 Board of Trustees, Leland Stanford Jr. University diff --git a/autogen b/autogen index 9564115..15ab3a6 100755 --- a/autogen +++ b/autogen @@ -1,5 +1,4 @@ #!/bin/sh -# $Id$ # # Run this shell script to bootstrap as necessary after a fresh checkout # from Subversion. diff --git a/client/file.c b/client/file.c index c109bd5..670a30d 100644 --- a/client/file.c +++ b/client/file.c @@ -1,5 +1,4 @@ -/* $Id$ - * +/* * File handling for the wallet client. * * Written by Russ Allbery diff --git a/client/internal.h b/client/internal.h index e55f2b8..860ef54 100644 --- a/client/internal.h +++ b/client/internal.h @@ -1,5 +1,4 @@ -/* $Id$ - * +/* * Internal support functions for the wallet client. * * Written by Russ Allbery diff --git a/client/keytab.c b/client/keytab.c index eb37ec1..2d31a27 100644 --- a/client/keytab.c +++ b/client/keytab.c @@ -1,5 +1,4 @@ -/* $Id$ - * +/* * Implementation of keytab handling for the wallet client. * * Written by Russ Allbery diff --git a/client/krb5.c b/client/krb5.c index fd600da..3338f8a 100644 --- a/client/krb5.c +++ b/client/krb5.c @@ -1,5 +1,4 @@ -/* $Id$ - * +/* * Kerberos support functions for the wallet client. * * Currently, the only function here is one to obtain a ticket cache for a diff --git a/client/remctl.c b/client/remctl.c index 8b9702a..8dfeb0a 100644 --- a/client/remctl.c +++ b/client/remctl.c @@ -1,5 +1,4 @@ -/* $Id$ - * +/* * remctl interface for the wallet client. * * Written by Russ Allbery diff --git a/client/srvtab.c b/client/srvtab.c index 2e4ea2d..0cca70d 100644 --- a/client/srvtab.c +++ b/client/srvtab.c @@ -1,5 +1,4 @@ -/* $Id$ - * +/* * Implementation of srvtab handling for the wallet client. * * Written by Russ Allbery diff --git a/client/wallet.c b/client/wallet.c index 5ee24f5..89135dd 100644 --- a/client/wallet.c +++ b/client/wallet.c @@ -1,5 +1,4 @@ -/* $Id$ - * +/* * The client program for the wallet system. * * Written by Russ Allbery diff --git a/configure.ac b/configure.ac index eb772a6..bada657 100644 --- a/configure.ac +++ b/configure.ac @@ -1,5 +1,4 @@ dnl Process this file with Autoconf to produce a configure script. -dnl $Id$ dnl dnl Written by Russ Allbery dnl Copyright 2006, 2007, 2008 diff --git a/contrib/convert-srvtab-db b/contrib/convert-srvtab-db index 74b19a7..8d3b31e 100755 --- a/contrib/convert-srvtab-db +++ b/contrib/convert-srvtab-db @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -our $ID = q$Id$; # # convert-srvtab-db -- Converts a leland_srvtab database to wallet # diff --git a/contrib/used-principals b/contrib/used-principals index f5abaf0..c4a6c07 100755 --- a/contrib/used-principals +++ b/contrib/used-principals @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -our $ID = q$Id$; # # used-principals -- Report which Kerberos v5 principals are in use. # diff --git a/contrib/wallet-report b/contrib/wallet-report index 6f09914..1abe1f8 100755 --- a/contrib/wallet-report +++ b/contrib/wallet-report @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -$ID = q$Id$; # # wallet-report -- Report on keytabs in the wallet database. # @@ -41,7 +40,7 @@ $ADDRESS = 'nobody@example.com'; require 5.005; use strict; -use vars qw($ADDRESS $DUMPFILE $ID @PATTERNS $REPORTS); +use vars qw($ADDRESS $DUMPFILE @PATTERNS $REPORTS); use Getopt::Long qw(GetOptions); use File::Path qw(mkpath); diff --git a/examples/stanford.conf b/examples/stanford.conf index 05ca861..108b932 100644 --- a/examples/stanford.conf +++ b/examples/stanford.conf @@ -1,5 +1,4 @@ # /etc/wallet/wallet.conf -- Wallet system configuration. -*- perl -*- -# $Id$ # # Configuration for the wallet system as used at Stanford University. # Interesting features to note are loading the database password from an diff --git a/kasetkey/README b/kasetkey/README index 033caff..3ead85d 100644 --- a/kasetkey/README +++ b/kasetkey/README @@ -1,5 +1,3 @@ -$Id$ - This program used to be called gen_srvtab and was the backend used by the old sysctl-based srvtab distribution system. It can either load a key from a srvtab and push it into the AFS kaserver or generate a random key, diff --git a/kasetkey/kasetkey.c b/kasetkey/kasetkey.c index d40a9bb..b798680 100644 --- a/kasetkey/kasetkey.c +++ b/kasetkey/kasetkey.c @@ -1,5 +1,4 @@ -/* $Id$ - * +/* * Create or change a principal and/or generate a srvtab. * * Sets the key of a principal in the AFS kaserver given a srvtab, enables or diff --git a/m4/gssapi.m4 b/m4/gssapi.m4 index 5c0d9e7..a352e38 100644 --- a/m4/gssapi.m4 +++ b/m4/gssapi.m4 @@ -1,5 +1,4 @@ dnl gssapi.m4 -- Find the compiler and linker flags for GSS-API. -dnl $Id$ dnl dnl Finds the compiler and linker flags for linking with GSS-API libraries dnl and sets the substitution variables GSSAPI_CPPFLAGS, GSSAPI_LDFLAGS, and diff --git a/m4/kaserver.m4 b/m4/kaserver.m4 index 6a41bd4..707a113 100644 --- a/m4/kaserver.m4 +++ b/m4/kaserver.m4 @@ -1,5 +1,4 @@ dnl kaserver.m4 -- Find the compiler and linker flags for OpenAFS kaserver. -dnl $Id$ dnl dnl If --with-kaserver is given, finds the compiler and linker flags for dnl building with OpenAFS libraries; sets AFS_CPPFLAGS, AFS_LDFLAGS, and diff --git a/m4/krb4.m4 b/m4/krb4.m4 index 321b0bf..75ca505 100644 --- a/m4/krb4.m4 +++ b/m4/krb4.m4 @@ -1,5 +1,4 @@ dnl krb4.m4 -- Find the compiler and linker flags for Kerberos v4. -dnl $Id$ dnl dnl Finds the compiler and linker flags for linking with Kerberos v4 libraries dnl and sets the substitution variables KRB4_CPPFLAGS, KRB4_LDFLAGS, and diff --git a/m4/krb5.m4 b/m4/krb5.m4 index 934be0c..12d97f8 100644 --- a/m4/krb5.m4 +++ b/m4/krb5.m4 @@ -1,5 +1,4 @@ dnl krb5.m4 -- Find the compiler and linker flags for Kerberos v5. -dnl $Id$ dnl dnl Finds the compiler and linker flags for linking with Kerberos v5 libraries dnl and sets the substitution variables KRB5_CPPFLAGS, KRB5_LDFLAGS, and diff --git a/m4/lib-depends.m4 b/m4/lib-depends.m4 index 5f4c284..1d7e769 100644 --- a/m4/lib-depends.m4 +++ b/m4/lib-depends.m4 @@ -1,5 +1,4 @@ dnl lib-depends.m4 -- Provides option to change library probes. -dnl $Id$ dnl dnl This file provides RRA_ENABLE_REDUCED_DEPENDS, which adds the configure dnl option --enable-reduced-depends to request that library probes assume diff --git a/m4/remctl.m4 b/m4/remctl.m4 index 5cebc68..5705a26 100644 --- a/m4/remctl.m4 +++ b/m4/remctl.m4 @@ -1,5 +1,4 @@ dnl remctl.m4 -- Find the compiler and linker flags for remctl. -dnl $Id$ dnl dnl This file provides RRA_LIB_REMCTL, which finds the compiler and linker dnl flags for linking with remctl libraries and sets the substitution diff --git a/m4/snprintf.m4 b/m4/snprintf.m4 index 8ab3689..79c0089 100644 --- a/m4/snprintf.m4 +++ b/m4/snprintf.m4 @@ -1,5 +1,4 @@ dnl snprintf.m4 -- Test for a working C99 snprintf. -dnl $Id$ dnl dnl Check for a working snprintf. Some systems have an snprintf that doesn't dnl nul-terminate if the buffer isn't large enough. Others return -1 if the diff --git a/m4/vamacros.m4 b/m4/vamacros.m4 index 8946d8b..6740d77 100644 --- a/m4/vamacros.m4 +++ b/m4/vamacros.m4 @@ -1,5 +1,4 @@ dnl vamacros.m4 -- Check for support for variadic macros. -dnl $Id$ dnl dnl This file defines two macros for probing for compiler support for variadic dnl macros. Provided are RRA_C_C99_VAMACROS, which checks for support for the diff --git a/perl/Makefile.PL.in b/perl/Makefile.PL.in index 1ba6004..5804d9b 100644 --- a/perl/Makefile.PL.in +++ b/perl/Makefile.PL.in @@ -1,5 +1,4 @@ # Makefile.PL for the Wallet Perl library. -*- perl -*- -# $Id$ use ExtUtils::MakeMaker; diff --git a/perl/Wallet/ACL.pm b/perl/Wallet/ACL.pm index b96d2ac..9136fc2 100644 --- a/perl/Wallet/ACL.pm +++ b/perl/Wallet/ACL.pm @@ -1,5 +1,4 @@ # Wallet::ACL -- Implementation of ACLs in the wallet system. -# $Id$ # # Written by Russ Allbery # Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University diff --git a/perl/Wallet/ACL/Base.pm b/perl/Wallet/ACL/Base.pm index 87df824..004de75 100644 --- a/perl/Wallet/ACL/Base.pm +++ b/perl/Wallet/ACL/Base.pm @@ -1,5 +1,4 @@ # Wallet::ACL::Base -- Parent class for wallet ACL verifiers. -# $Id$ # # Written by Russ Allbery # Copyright 2007 Board of Trustees, Leland Stanford Jr. University diff --git a/perl/Wallet/ACL/Krb5.pm b/perl/Wallet/ACL/Krb5.pm index f94475f..1c584c5 100644 --- a/perl/Wallet/ACL/Krb5.pm +++ b/perl/Wallet/ACL/Krb5.pm @@ -1,5 +1,4 @@ # Wallet::ACL::Krb5 -- Wallet Kerberos v5 principal ACL verifier. -# $Id$ # # Written by Russ Allbery # Copyright 2007 Board of Trustees, Leland Stanford Jr. University diff --git a/perl/Wallet/ACL/NetDB.pm b/perl/Wallet/ACL/NetDB.pm index cc7121b..6775c62 100644 --- a/perl/Wallet/ACL/NetDB.pm +++ b/perl/Wallet/ACL/NetDB.pm @@ -1,5 +1,4 @@ # Wallet::ACL::NetDB -- Wallet NetDB role ACL verifier. -# $Id$ # # Written by Russ Allbery # Copyright 2007 Board of Trustees, Leland Stanford Jr. University diff --git a/perl/Wallet/ACL/NetDB/Root.pm b/perl/Wallet/ACL/NetDB/Root.pm index 8c2c6b2..cbd1387 100644 --- a/perl/Wallet/ACL/NetDB/Root.pm +++ b/perl/Wallet/ACL/NetDB/Root.pm @@ -1,5 +1,4 @@ # Wallet::ACL::NetDB::Root -- Wallet NetDB role ACL verifier (root instances). -# $Id$ # # Written by Russ Allbery # Copyright 2007 Board of Trustees, Leland Stanford Jr. University diff --git a/perl/Wallet/Admin.pm b/perl/Wallet/Admin.pm index 37d538e..3a2f687 100644 --- a/perl/Wallet/Admin.pm +++ b/perl/Wallet/Admin.pm @@ -1,5 +1,4 @@ # Wallet::Admin -- Wallet system administrative interface. -# $Id$ # # Written by Russ Allbery # Copyright 2008 Board of Trustees, Leland Stanford Jr. University diff --git a/perl/Wallet/Config.pm b/perl/Wallet/Config.pm index 6c72781..3f52cf0 100644 --- a/perl/Wallet/Config.pm +++ b/perl/Wallet/Config.pm @@ -1,5 +1,4 @@ # Wallet::Config -- Configuration handling for the wallet server. -# $Id$ # # Written by Russ Allbery # Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University diff --git a/perl/Wallet/Database.pm b/perl/Wallet/Database.pm index 3edf059..68fb6bb 100644 --- a/perl/Wallet/Database.pm +++ b/perl/Wallet/Database.pm @@ -1,5 +1,4 @@ # Wallet::Database -- Wallet system database connection management. -# $Id$ # # This module is a thin wrapper around DBI to handle determination of the # database driver and configuration settings automatically on connect. The diff --git a/perl/Wallet/Object/Base.pm b/perl/Wallet/Object/Base.pm index bc4f096..0f40028 100644 --- a/perl/Wallet/Object/Base.pm +++ b/perl/Wallet/Object/Base.pm @@ -1,5 +1,4 @@ # Wallet::Object::Base -- Parent class for any object stored in the wallet. -# $Id$ # # Written by Russ Allbery # Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University diff --git a/perl/Wallet/Object/File.pm b/perl/Wallet/Object/File.pm index b4e23f8..be72d7f 100644 --- a/perl/Wallet/Object/File.pm +++ b/perl/Wallet/Object/File.pm @@ -1,5 +1,4 @@ # Wallet::Object::File -- File object implementation for the wallet. -# $Id$ # # Written by Russ Allbery # Copyright 2008 Board of Trustees, Leland Stanford Jr. University diff --git a/perl/Wallet/Object/Keytab.pm b/perl/Wallet/Object/Keytab.pm index 8739f89..4cb8dff 100644 --- a/perl/Wallet/Object/Keytab.pm +++ b/perl/Wallet/Object/Keytab.pm @@ -1,5 +1,4 @@ # Wallet::Object::Keytab -- Keytab object implementation for the wallet. -# $Id$ # # Written by Russ Allbery # Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University diff --git a/perl/Wallet/Schema.pm b/perl/Wallet/Schema.pm index 2fb3d64..2b256a2 100644 --- a/perl/Wallet/Schema.pm +++ b/perl/Wallet/Schema.pm @@ -1,5 +1,4 @@ # Wallet::Schema -- Database schema for the wallet system. -# $Id$ # # Written by Russ Allbery # Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University diff --git a/perl/Wallet/Server.pm b/perl/Wallet/Server.pm index d4e6a91..40e48a3 100644 --- a/perl/Wallet/Server.pm +++ b/perl/Wallet/Server.pm @@ -1,5 +1,4 @@ # Wallet::Server -- Wallet system server implementation. -# $Id$ # # Written by Russ Allbery # Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University diff --git a/perl/t/acl.t b/perl/t/acl.t index e46b7f8..95aa763 100755 --- a/perl/t/acl.t +++ b/perl/t/acl.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ # # t/api.t -- Tests for the wallet ACL API. # diff --git a/perl/t/admin.t b/perl/t/admin.t index 4b8302d..7a8b8ae 100755 --- a/perl/t/admin.t +++ b/perl/t/admin.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ # # t/admin.t -- Tests for wallet administrative interface. # diff --git a/perl/t/config.t b/perl/t/config.t index 0d159dc..d60d7e7 100755 --- a/perl/t/config.t +++ b/perl/t/config.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ # # t/config.t -- Tests for the wallet server configuration. # diff --git a/perl/t/data/keytab-fake b/perl/t/data/keytab-fake index df21294..0ecf264 100755 --- a/perl/t/data/keytab-fake +++ b/perl/t/data/keytab-fake @@ -1,5 +1,4 @@ #!/bin/sh -# $Id$ # # keytab-fake -- Fake keytab-backend implementation. # diff --git a/perl/t/data/keytab.conf b/perl/t/data/keytab.conf index eb105e2..484443f 100644 --- a/perl/t/data/keytab.conf +++ b/perl/t/data/keytab.conf @@ -1,5 +1,3 @@ -# $Id$ -# # This is the remctl configuration used for testing the keytab backend's # ability to retrieve existing keytabs through remctl. Currently the only # supported and used command is keytab retrieve. The ACL is written on diff --git a/perl/t/data/netdb-fake b/perl/t/data/netdb-fake index 56744a7..ae5be18 100755 --- a/perl/t/data/netdb-fake +++ b/perl/t/data/netdb-fake @@ -1,5 +1,4 @@ #!/bin/sh -# $Id$ # # netdb-fake -- Fake NetDB remctl interface. # diff --git a/perl/t/data/netdb.conf b/perl/t/data/netdb.conf index e7908ed..f08bfaa 100644 --- a/perl/t/data/netdb.conf +++ b/perl/t/data/netdb.conf @@ -1,5 +1,3 @@ -# $Id$ -# # This is the remctl configuration used for testing the NetDB ACL verifier. # The ACL is written on the fly by the test program. diff --git a/perl/t/file.t b/perl/t/file.t index 8eaa0f1..7ab5d75 100755 --- a/perl/t/file.t +++ b/perl/t/file.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ # # t/file.t -- Tests for the file object implementation. # diff --git a/perl/t/init.t b/perl/t/init.t index 70085c9..d0fae9f 100755 --- a/perl/t/init.t +++ b/perl/t/init.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ # # t/init.t -- Tests for database initialization. # diff --git a/perl/t/keytab.t b/perl/t/keytab.t index c1348d4..1803e53 100755 --- a/perl/t/keytab.t +++ b/perl/t/keytab.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ # # t/keytab.t -- Tests for the keytab object implementation. # diff --git a/perl/t/lib/Util.pm b/perl/t/lib/Util.pm index a1bacbd..ac0f530 100644 --- a/perl/t/lib/Util.pm +++ b/perl/t/lib/Util.pm @@ -1,5 +1,4 @@ # Util -- Utility class for wallet tests. -# $Id$ # # Written by Russ Allbery # Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University diff --git a/perl/t/object.t b/perl/t/object.t index 94fe22b..a40a412 100755 --- a/perl/t/object.t +++ b/perl/t/object.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ # # t/object.t -- Tests for the basic object implementation. # diff --git a/perl/t/pod.t b/perl/t/pod.t index da4d0d3..e9aa0a8 100755 --- a/perl/t/pod.t +++ b/perl/t/pod.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -# $Id$ # # t/pod.t -- Test POD formatting for the wallet Perl modules. # diff --git a/perl/t/schema.t b/perl/t/schema.t index c7e9133..01d5dac 100755 --- a/perl/t/schema.t +++ b/perl/t/schema.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ # # t/schema.t -- Tests for the wallet schema class. # diff --git a/perl/t/server.t b/perl/t/server.t index 08edd56..d4fd068 100755 --- a/perl/t/server.t +++ b/perl/t/server.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ # # t/server.t -- Tests for the wallet server API. # diff --git a/perl/t/verifier-netdb.t b/perl/t/verifier-netdb.t index 6a77e3c..dcbbdd8 100755 --- a/perl/t/verifier-netdb.t +++ b/perl/t/verifier-netdb.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ # # t/verifier-netdb.t -- Tests for the NetDB wallet ACL verifiers. # diff --git a/perl/t/verifier.t b/perl/t/verifier.t index 96e641d..3243d9c 100755 --- a/perl/t/verifier.t +++ b/perl/t/verifier.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ # # t/verifier.t -- Tests for the basic wallet ACL verifiers. # diff --git a/portable/asprintf.c b/portable/asprintf.c index 9cae827..9451795 100644 --- a/portable/asprintf.c +++ b/portable/asprintf.c @@ -1,5 +1,4 @@ -/* $Id$ - * +/* * Replacement for a missing asprintf and vasprintf. * * Provides the same functionality as the standard GNU library routines diff --git a/portable/dummy.c b/portable/dummy.c index 66341c3..8a0d54d 100644 --- a/portable/dummy.c +++ b/portable/dummy.c @@ -1,5 +1,4 @@ -/* $Id$ - * +/* * Dummy symbol to prevent an empty library. * * On platforms that already have all of the functions that libportable would diff --git a/portable/macros.h b/portable/macros.h index dcffa59..8d5adbd 100644 --- a/portable/macros.h +++ b/portable/macros.h @@ -1,5 +1,4 @@ -/* $Id$ - * +/* * Portability macros used in include files. * * Written by Russ Allbery diff --git a/portable/snprintf.c b/portable/snprintf.c index 3c39de8..3775b8a 100644 --- a/portable/snprintf.c +++ b/portable/snprintf.c @@ -1,5 +1,4 @@ -/* $Id$ - * +/* * Replacement for a missing snprintf or vsnprintf. * * The following implementation of snprintf was taken mostly verbatim from diff --git a/portable/stdbool.h b/portable/stdbool.h index 61dd8a1..01a2ff2 100644 --- a/portable/stdbool.h +++ b/portable/stdbool.h @@ -1,5 +1,4 @@ -/* $Id$ - * +/* * Portability wrapper around . * * Provides the bool and _Bool types and the true and false constants, diff --git a/portable/strlcat.c b/portable/strlcat.c index 4816f90..f696db3 100644 --- a/portable/strlcat.c +++ b/portable/strlcat.c @@ -1,5 +1,4 @@ -/* $Id$ - * +/* * Replacement for a missing strlcat. * * Provides the same functionality as the *BSD function strlcat, originally diff --git a/portable/strlcpy.c b/portable/strlcpy.c index d281645..596e968 100644 --- a/portable/strlcpy.c +++ b/portable/strlcpy.c @@ -1,5 +1,4 @@ -/* $Id$ - * +/* * Replacement for a missing strlcpy. * * Provides the same functionality as the *BSD function strlcpy, originally diff --git a/portable/system.h b/portable/system.h index 1408ba7..b899d08 100644 --- a/portable/system.h +++ b/portable/system.h @@ -1,5 +1,4 @@ -/* $Id$ - * +/* * Declarations of routines and variables in the C library. Including this * file is the equivalent of including all of the following headers, portably: * diff --git a/server/keytab-backend b/server/keytab-backend index 06fed3d..b37fb3a 100755 --- a/server/keytab-backend +++ b/server/keytab-backend @@ -1,5 +1,4 @@ #!/usr/bin/perl -our $ID = q$Id$; # # keytab-backend -- Extract keytabs from the KDC without changing the key. # diff --git a/server/wallet-admin b/server/wallet-admin index 4c27e9b..0daa986 100755 --- a/server/wallet-admin +++ b/server/wallet-admin @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -our $ID = q$Id$; # # wallet-admin -- Wallet server administrative commands. # 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. # diff --git a/tests/client/basic-t.in b/tests/client/basic-t.in index f18c28e..05a7abe 100644 --- a/tests/client/basic-t.in +++ b/tests/client/basic-t.in @@ -1,5 +1,4 @@ #! /bin/sh -# $Id$ # # Test suite for the wallet command-line client. # diff --git a/tests/client/full-t.in b/tests/client/full-t.in index f4ef1d3..3240563 100644 --- a/tests/client/full-t.in +++ b/tests/client/full-t.in @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ # # tests/client/full-t -- End-to-end tests for the wallet client. # diff --git a/tests/client/pod-t.in b/tests/client/pod-t.in index 98c34c7..db995f7 100644 --- a/tests/client/pod-t.in +++ b/tests/client/pod-t.in @@ -1,5 +1,4 @@ #!/usr/bin/perl -# $Id$ # # Test POD formatting for client documentation. # diff --git a/tests/client/prompt-t.in b/tests/client/prompt-t.in index 2d6097d..7988fc9 100644 --- a/tests/client/prompt-t.in +++ b/tests/client/prompt-t.in @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ # # tests/client/prompt-t -- Password prompting tests for the wallet client. # diff --git a/tests/data/basic.conf b/tests/data/basic.conf index 7ad998f..3280ce9 100644 --- a/tests/data/basic.conf +++ b/tests/data/basic.conf @@ -1,4 +1,3 @@ # remctl configuration for wallet client tests. -# $Id$ fake-wallet ALL data/cmd-fake ANYUSER diff --git a/tests/data/cmd-fake b/tests/data/cmd-fake index 3ffd9cc..9c9e38c 100755 --- a/tests/data/cmd-fake +++ b/tests/data/cmd-fake @@ -1,5 +1,4 @@ #!/bin/sh -# $Id$ # # This is a fake wallet backend that returns bogus data for verification by # the client test suite. It doesn't test any of the wallet server code. diff --git a/tests/data/cmd-wrapper.in b/tests/data/cmd-wrapper.in index e119002..7c7b342 100644 --- a/tests/data/cmd-wrapper.in +++ b/tests/data/cmd-wrapper.in @@ -1,5 +1,4 @@ #!/bin/sh -# $Id$ # # Wrapper around the standard wallet-backend script that sets the Perl INC # path and the WALLET_CONFIG environment variable appropriately. diff --git a/tests/data/fake-kadmin b/tests/data/fake-kadmin index 81dc999..61906a4 100755 --- a/tests/data/fake-kadmin +++ b/tests/data/fake-kadmin @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ # # fake-kadmin -- Fake kadmin.local used to test the keytab backend. # diff --git a/tests/data/full.conf.in b/tests/data/full.conf.in index b97a4bc..25aef9e 100644 --- a/tests/data/full.conf.in +++ b/tests/data/full.conf.in @@ -1,4 +1,3 @@ # remctl configuration for full wallet client tests. -# $Id$ wallet ALL @abs_top_builddir@/tests/data/cmd-wrapper ANYUSER diff --git a/tests/data/wallet.conf b/tests/data/wallet.conf index b864e5e..0a232dd 100644 --- a/tests/data/wallet.conf +++ b/tests/data/wallet.conf @@ -1,5 +1,4 @@ # wallet.conf -- Test wallet server configuration. -*- perl -*- -# $Id$ # Always test with SQLite. $DB_DRIVER = 'SQLite'; diff --git a/tests/kasetkey/basic-t.in b/tests/kasetkey/basic-t.in index afc6747..bb086d6 100644 --- a/tests/kasetkey/basic-t.in +++ b/tests/kasetkey/basic-t.in @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ # # Tests for basic kasetkey functionality. # diff --git a/tests/libtest.c b/tests/libtest.c index 76d5207..bddaf91 100644 --- a/tests/libtest.c +++ b/tests/libtest.c @@ -1,5 +1,4 @@ -/* $Id$ - * +/* * Some utility routines for writing tests. * * Herein are a variety of utility routines for writing tests. All routines diff --git a/tests/libtest.h b/tests/libtest.h index ac2b083..ad4f591 100644 --- a/tests/libtest.h +++ b/tests/libtest.h @@ -1,5 +1,4 @@ -/* $Id$ - * +/* * Some utility routines for writing tests. * * Copyright 2006, 2007 Board of Trustees, Leland Stanford Jr. University diff --git a/tests/libtest.sh b/tests/libtest.sh index ed46d0e..74f5ee6 100644 --- a/tests/libtest.sh +++ b/tests/libtest.sh @@ -1,5 +1,3 @@ -# $Id$ -# # Shell function library for test cases. # # Written by Russ Allbery diff --git a/tests/portable/asprintf-t.c b/tests/portable/asprintf-t.c index d42e740..689e7c7 100644 --- a/tests/portable/asprintf-t.c +++ b/tests/portable/asprintf-t.c @@ -1,5 +1,4 @@ -/* $Id$ - * +/* * asprintf and vasprintf test suite. * * Written by Russ Allbery diff --git a/tests/portable/snprintf-t.c b/tests/portable/snprintf-t.c index c33e0e7..18c2326 100644 --- a/tests/portable/snprintf-t.c +++ b/tests/portable/snprintf-t.c @@ -1,5 +1,4 @@ -/* $Id$ - * +/* * snprintf test suite. * * Copyright (c) 2004, 2005, 2006 diff --git a/tests/portable/strlcat-t.c b/tests/portable/strlcat-t.c index c860803..2f39925 100644 --- a/tests/portable/strlcat-t.c +++ b/tests/portable/strlcat-t.c @@ -1,5 +1,4 @@ -/* $Id$ - * +/* * strlcat test suite. * * Copyright (c) 2004, 2005, 2006 diff --git a/tests/portable/strlcpy-t.c b/tests/portable/strlcpy-t.c index 8fb1f9c..74c9ecd 100644 --- a/tests/portable/strlcpy-t.c +++ b/tests/portable/strlcpy-t.c @@ -1,5 +1,4 @@ -/* $Id$ - * +/* * strlcpy test suite. * * Copyright (c) 2004, 2005, 2006 diff --git a/tests/runtests.c b/tests/runtests.c index abad3b6..060c8ad 100644 --- a/tests/runtests.c +++ b/tests/runtests.c @@ -1,5 +1,4 @@ -/* $Id$ - * +/* * Run a set of tests, reporting results. * * Usage: diff --git a/tests/server/admin-t.in b/tests/server/admin-t.in index be40880..44ea1fe 100644 --- a/tests/server/admin-t.in +++ b/tests/server/admin-t.in @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ # # Tests for the wallet-admin dispatch code. # diff --git a/tests/server/backend-t.in b/tests/server/backend-t.in index e1518d8..773a002 100644 --- a/tests/server/backend-t.in +++ b/tests/server/backend-t.in @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ # # Tests for the wallet-backend dispatch code. # diff --git a/tests/server/pod-t.in b/tests/server/pod-t.in index fd939a5..4973d23 100644 --- a/tests/server/pod-t.in +++ b/tests/server/pod-t.in @@ -1,5 +1,4 @@ #!/usr/bin/perl -# $Id$ # # tests/server/pod-t -- Test POD formatting for client documentation. # diff --git a/tests/util/concat-t.c b/tests/util/concat-t.c index 2428d71..81824c8 100644 --- a/tests/util/concat-t.c +++ b/tests/util/concat-t.c @@ -1,5 +1,4 @@ -/* $Id$ - * +/* * concat test suite. * * Copyright 2004, 2005, 2006 diff --git a/tests/util/messages-t.c b/tests/util/messages-t.c index 434ef56..3f7860e 100644 --- a/tests/util/messages-t.c +++ b/tests/util/messages-t.c @@ -1,5 +1,4 @@ -/* $Id$ - * +/* * Test suite for error handling routines. * * Copyright 2004, 2005, 2006 diff --git a/tests/util/xmalloc-t.in b/tests/util/xmalloc-t.in index f721822..5c18512 100644 --- a/tests/util/xmalloc-t.in +++ b/tests/util/xmalloc-t.in @@ -1,5 +1,4 @@ #! /bin/sh -# $Id$ # # Test suite for xmalloc and friends. # diff --git a/tests/util/xmalloc.c b/tests/util/xmalloc.c index 699d0c4..bd0ab62 100644 --- a/tests/util/xmalloc.c +++ b/tests/util/xmalloc.c @@ -1,5 +1,4 @@ -/* $Id$ - * +/* * Test suite for xmalloc and family. * * Copyright 2004, 2005, 2006 diff --git a/util/concat.c b/util/concat.c index 1d08e08..bef67db 100644 --- a/util/concat.c +++ b/util/concat.c @@ -1,5 +1,4 @@ -/* $Id$ - * +/* * Concatenate strings with dynamic memory allocation. * * Usage: diff --git a/util/messages-krb5.c b/util/messages-krb5.c index caf29b9..00f4a2e 100644 --- a/util/messages-krb5.c +++ b/util/messages-krb5.c @@ -1,5 +1,4 @@ -/* $Id$ - * +/* * Error handling for Kerberos v5. * * Provides versions of die and warn that take a Kerberos context and a diff --git a/util/messages.c b/util/messages.c index 7714c2b..0a106f6 100644 --- a/util/messages.c +++ b/util/messages.c @@ -1,5 +1,4 @@ -/* $Id$ - * +/* * Message and error reporting (possibly fatal). * * Usage: diff --git a/util/util.h b/util/util.h index 0a45c73..6ac7fa7 100644 --- a/util/util.h +++ b/util/util.h @@ -1,5 +1,4 @@ -/* $Id$ - * +/* * Utility functions. * * This is a variety of utility functions that are used internally by pieces diff --git a/util/xmalloc.c b/util/xmalloc.c index 927372d..412890e 100644 --- a/util/xmalloc.c +++ b/util/xmalloc.c @@ -1,5 +1,4 @@ -/* $Id$ - * +/* * malloc routines with failure handling. * * Usage: -- cgit v1.2.3 From e32837ee826e4be5e8dfbefc7d87fedc0e5de8cf Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 9 Jun 2009 16:37:33 -0700 Subject: Add a .gitignore file --- .gitignore | 50 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 50 insertions(+) create mode 100644 .gitignore diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..d41b1a0 --- /dev/null +++ b/.gitignore @@ -0,0 +1,50 @@ +/Makefile.in +/aclocal.m4 +/build-aux/ +/client/wallet +/config.h +/config.h.in +/config.h.in~ +/config.log +/config.status +/configure +/perl/Makefile.PL +/perl/Makefile.old +/perl/blib/ +/perl/pm_to_blib +/perl/t/data/test.keytab +/perl/t/data/test.principal +/perl/t/data/test.realm +/tests/client/basic-t +/tests/client/full-t +/tests/client/pod-t +/tests/client/prompt-t +/tests/data/cmd-wrapper +/tests/data/full.conf +/tests/data/test.keytab +/tests/data/test.password +/tests/data/test.principal +/tests/kasetkey/basic-t +/tests/portable/asprintf-t +/tests/portable/snprintf-t +/tests/portable/strlcat-t +/tests/portable/strlcpy-t +/tests/runtests +/tests/server/admin-t +/tests/server/backend-t +/tests/server/keytab-t +/tests/server/pod-t +/tests/util/concat-t +/tests/util/messages-t +/tests/util/xmalloc +/tests/util/xmalloc-t +/wallet-*.tar.gz +/stamp-h1 +.deps +.dirstamp +.libs/ +Makefile +*.1 +*.8 +*.a +*.o -- cgit v1.2.3 From e455057f2fe19dd27ee1b03083454eceb07d3043 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 9 Jun 2009 16:37:52 -0700 Subject: Update tests to reflect suppression of store data in logging --- tests/server/backend-t.in | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/tests/server/backend-t.in b/tests/server/backend-t.in index 773a002..0c6ac60 100644 --- a/tests/server/backend-t.in +++ b/tests/server/backend-t.in @@ -3,7 +3,8 @@ # Tests for the wallet-backend dispatch code. # # Written by Russ Allbery -# Copyright 2006, 2007, 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2006, 2007, 2008, 2009 +# Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -338,7 +339,11 @@ for my $command (qw/autocreate create destroy setacl setattr store/) { is ($out, "$new\n$method type name$extra\n", ' and ran the right method'); ($out, $err) = run_backend ($command, 'error', 'name', @extra); - $ran = "$command error name" . (@extra ? " @extra" : ''); + if ($command eq 'store') { + $ran = "$command error name"; + } else { + $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'); -- cgit v1.2.3 From c2cde5918af1882ee63324fd9e09f07c8e6e5cc9 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 9 Jun 2009 16:39:08 -0700 Subject: Add owners report Add a new report owners command to wallet-admin and corresponding report_owners() method to Wallet::Admin, which returns all ACL lines on owner ACLs for matching objects. --- NEWS | 4 ++++ perl/Wallet/Admin.pm | 47 ++++++++++++++++++++++++++++++++++++++++-- perl/t/admin.t | 55 +++++++++++++++++++++++++++++++++++++++++++++++-- server/wallet-admin | 39 ++++++++++++++++++++++++++++++++++- tests/server/admin-t.in | 45 +++++++++++++++++++++++++++++++--------- 5 files changed, 175 insertions(+), 15 deletions(-) diff --git a/NEWS b/NEWS index e16c630..ab0828b 100644 --- a/NEWS +++ b/NEWS @@ -8,6 +8,10 @@ wallet 0.10 (unreleased) Fix logging in wallet-backend and the remctl configuration to not log the data passed to store. + Add a new report owners command to wallet-admin and corresponding + report_owners() method to Wallet::Admin, which returns all ACL lines + on owner ACLs for matching objects. + wallet 0.9 (2008-04-24) The wallet command-line client now reads the data for store from a diff --git a/perl/Wallet/Admin.pm b/perl/Wallet/Admin.pm index 3a2f687..c11c3d4 100644 --- a/perl/Wallet/Admin.pm +++ b/perl/Wallet/Admin.pm @@ -1,7 +1,7 @@ # Wallet::Admin -- Wallet system administrative interface. # # Written by Russ Allbery -# Copyright 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008, 2009 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -22,7 +22,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.02'; +$VERSION = '0.03'; ############################################################################## # Constructor, destructor, and accessors @@ -171,6 +171,38 @@ sub list_acls { } } +# Returns a report of all ACL lines contained in owner ACLs for matching +# objects. Objects are specified by type and name, which may be SQL wildcard +# expressions. Each list member will be a pair of ACL scheme and ACL +# identifier, with duplicates removed. 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 report_owners { + my ($self, $type, $name) = @_; + undef $self->{error}; + my @lines; + eval { + my $sql = 'select distinct ae_scheme, ae_identifier from acl_entries, + acls, objects where ae_id = ac_id and ac_id = ob_owner and + ob_type like ? and ob_name like ? order by ae_scheme, + ae_identifier'; + my $sth = $self->{dbh}->prepare ($sql); + $sth->execute ($type, $name); + my $object; + while (defined ($object = $sth->fetchrow_arrayref)) { + push (@lines, [ @$object ]); + } + $self->{dbh}->commit; + }; + if ($@) { + $self->error ("cannot report on owners: $@"); + $self->{dbh}->rollback; + return; + } else { + return @lines; + } +} + ############################################################################## # Object registration ############################################################################## @@ -335,6 +367,17 @@ be deleted and a fresh set of wallet database tables will be created. This method is equivalent to calling destroy() followed by initialize(). Returns true on success and false on failure. +=item report_owners(TYPE, NAME) + +Returns a list of all ACL lines contained in owner ACLs for objects +matching TYPE and NAME, which are interpreted as SQL patterns using C<%> +as a wildcard. The return value is a list of references to pairs of +schema and identifier, with duplicates removed. + +Returns the empty list on failure. To distinguish between this and no +matches, the caller should call error(). error() is guaranteed to return +the error message if there was an error and undef if there was no error. + =back =head1 SEE ALSO diff --git a/perl/t/admin.t b/perl/t/admin.t index 7a8b8ae..8804f34 100755 --- a/perl/t/admin.t +++ b/perl/t/admin.t @@ -3,11 +3,11 @@ # t/admin.t -- Tests for wallet administrative interface. # # Written by Russ Allbery -# Copyright 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008, 2009 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. -use Test::More tests => 29; +use Test::More tests => 57; use Wallet::Admin; use Wallet::Schema; @@ -73,6 +73,57 @@ is ($acls[0][1], 'ADMIN', ' and the first name is still the same'); is ($acls[1][0], 3, ' but the second ID has changed'); is ($acls[1][1], 'second', ' and the second name is correct'); +# Currently, we have no owners, so we should get an empty owner report. +my @lines = $admin->report_owners ('%', '%'); +is (scalar (@lines), 0, 'Owner report is currently empty'); +is ($admin->error, undef, ' and there is no error'); + +# Set an owner and make sure we now see something in the report. +is ($server->owner ('base', 'service/admin', 'ADMIN'), 1, + 'Setting an owner works'); +@lines = $admin->report_owners ('%', '%'); +is (scalar (@lines), 1, ' and now there is one owner in the report'); +is ($lines[0][0], 'krb5', ' with the right scheme'); +is ($lines[0][1], 'admin@EXAMPLE.COM', ' and the right identifier'); +@lines = $admin->report_owners ('keytab', '%'); +is (scalar (@lines), 0, 'Owners of keytabs is empty'); +is ($admin->error, undef, ' with no error'); +@lines = $admin->report_owners ('base', 'foo/%'); +is (scalar (@lines), 0, 'Owners of base foo/* objects is empty'); +is ($admin->error, undef, ' with no error'); + +# Create a second object with the same owner. +is ($server->create ('base', 'service/foo'), 1, + 'Creating base:service/foo succeeds'); +is ($server->owner ('base', 'service/foo', 'ADMIN'), 1, + ' and setting the owner to the same value works'); +@lines = $admin->report_owners ('base', 'service/%'); +is (scalar (@lines), 1, ' and there is still owner in the report'); +is ($lines[0][0], 'krb5', ' with the right scheme'); +is ($lines[0][1], 'admin@EXAMPLE.COM', ' and the right identifier'); + +# Change the owner of the second object to an empty ACL. +is ($server->owner ('base', 'service/foo', 'second'), 1, + ' and changing the owner to an empty ACL works'); +@lines = $admin->report_owners ('base', '%'); +is (scalar (@lines), 1, ' and there is still owner in the report'); +is ($lines[0][0], 'krb5', ' with the right scheme'); +is ($lines[0][1], 'admin@EXAMPLE.COM', ' and the right identifier'); + +# Add a few things to the second ACL to see what happens. +is ($server->acl_add ('second', 'base', 'foo'), 1, + 'Adding an ACL line to the new ACL works'); +is ($server->acl_add ('second', 'base', 'bar'), 1, + ' and adding another ACL line to the new ACL works'); +@lines = $admin->report_owners ('base', '%'); +is (scalar (@lines), 3, ' and now there are three owners in the report'); +is ($lines[0][0], 'base', ' first has the right scheme'); +is ($lines[0][1], 'bar', ' and the right identifier'); +is ($lines[1][0], 'base', ' second has the right scheme'); +is ($lines[1][1], 'foo', ' and the right identifier'); +is ($lines[2][0], 'krb5', ' third has the right scheme'); +is ($lines[2][1], 'admin@EXAMPLE.COM', ' and the right identifier'); + # Clean up. is ($admin->destroy, 1, 'Destruction succeeds'); unlink 'wallet-db'; diff --git a/server/wallet-admin b/server/wallet-admin index 0daa986..b5674c5 100755 --- a/server/wallet-admin +++ b/server/wallet-admin @@ -3,7 +3,7 @@ # wallet-admin -- Wallet server administrative commands. # # Written by Russ Allbery -# Copyright 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008, 2009 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -64,6 +64,22 @@ sub command { } 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; @@ -168,6 +184,27 @@ 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 [ ... ] + +Runs a wallet report. The currently supported report types are: + +=over 4 + +=item report owners + +Returns a list of all ACL lines in owner ACLs for all objects matching +both and . 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: + + + +with duplicates suppressed. + +=back + =back =head1 SEE ALSO diff --git a/tests/server/admin-t.in b/tests/server/admin-t.in index 44ea1fe..3e84022 100644 --- a/tests/server/admin-t.in +++ b/tests/server/admin-t.in @@ -3,12 +3,12 @@ # Tests for the wallet-admin dispatch code. # # Written by Russ Allbery -# Copyright 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008, 2009 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. use strict; -use Test::More tests => 54; +use Test::More tests => 64; # Create a dummy class for Wallet::Admin that prints what method was called # with its arguments and returns data for testing. @@ -71,6 +71,13 @@ sub register_verifier { return 1; } +sub report_owners { + shift; + print "report_owners @_\n"; + return if ($error or $empty); + return ([ krb5 => 'admin@EXAMPLE.COM' ]); +} + # Back to the main package and the actual test suite. Lie about whether the # Wallet::Admin package has already been loaded. package main; @@ -98,10 +105,11 @@ is ($err, "unknown command foo\n", 'Unknown command'); is ($out, "new\n", ' and nothing ran'); # Check too few and too many arguments for every command. -my %commands = (destroy => [0, 0], - initialize => [1, 1], - list => [1, 1], - register => [3, 3]); +my %commands = (destroy => [0, 0], + initialize => [1, 1], + list => [1, 1], + register => [3, 3], + report => [1, -1]); for my $command (sort keys %commands) { my ($min, $max) = @{ $commands{$command} }; if ($min > 0) { @@ -110,10 +118,12 @@ for my $command (sort keys %commands) { "Too few arguments for $command"); is ($out, "new\n", ' and nothing ran'); } - ($out, $err) = run_admin ($command, ('foo') x ($max + 1)); - is ($err, "too many arguments to $command\n", - "Too many arguments for $command"); - is ($out, "new\n", ' and nothing ran'); + if ($max >= 0) { + ($out, $err) = run_admin ($command, ('foo') x ($max + 1)); + is ($err, "too many arguments to $command\n", + "Too many arguments for $command"); + is ($out, "new\n", ' and nothing ran'); + } } # Test destroy. @@ -179,6 +189,15 @@ is ($err, '', 'Register succeeds for verifier'); is ($out, "new\nregister_verifier foo Foo::Verifier\n", ' and returns the right outout'); +# Test report. +($out, $err) = run_admin ('report', 'foo'); +is ($err, "unknown report type foo\n", 'Report requires a known report'); +is ($out, "new\n", ' and nothing was run'); +($out, $err) = run_admin ('report', 'owners', '%', '%'); +is ($err, '', 'Report succeeds for owners'); +is ($out, "new\nreport_owners % %\nkrb5 admin\@EXAMPLE.COM\n", + ' and returns the right output'); + # Test error handling. $Wallet::Admin::error = 1; ($out, $err) = run_admin ('destroy'); @@ -204,6 +223,9 @@ is ($out, "new\nregister_object foo Foo::Object\n", is ($err, "some error\n", 'Error handling succeeds for register verifier'); is ($out, "new\nregister_verifier foo Foo::Verifier\n", ' and calls the right methods'); +($out, $err) = run_admin ('report', 'owners', 'foo', 'bar'); +is ($err, "some error\n", 'Error handling succeeds for report owners'); +is ($out, "new\nreport_owners foo bar\n", ' and calls the right methods'); # Test empty lists. $Wallet::Admin::error = 0; @@ -214,3 +236,6 @@ is ($out, "new\nlist_objects\n", ' and calls the right methods'); ($out, $err) = run_admin ('list', 'acls'); is ($err, '', 'list acls runs with an empty list and no errors'); is ($out, "new\nlist_acls\n", ' and calls the right methods'); +($out, $err) = run_admin ('report', 'owners', 'foo', 'bar'); +is ($err, '', 'report owners runs with an empty list and no errors'); +is ($out, "new\nreport_owners foo bar\n", ' and calls the right methods'); -- cgit v1.2.3 From a8345026b34c53156d6d38e93eccb8c2cafeb646 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 9 Jun 2009 17:44:25 -0700 Subject: Add contrib script to map ACLs to contact e-mail addresses --- contrib/wallet-contacts | 193 ++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 193 insertions(+) create mode 100755 contrib/wallet-contacts diff --git a/contrib/wallet-contacts b/contrib/wallet-contacts new file mode 100755 index 0000000..a7bccf3 --- /dev/null +++ b/contrib/wallet-contacts @@ -0,0 +1,193 @@ +#!/usr/bin/perl -w +# +# wallet-contacts -- Report contact addresses for matching wallet objects. +# +# Written by Russ Allbery +# Copyright 2009 Board of Trustees, Leland Stanford Jr. University +# +# See LICENSE for licensing terms. + +############################################################################## +# Modules and declarations +############################################################################## + +require 5.006; + +use strict; + +use Getopt::Long qw(GetOptions); +use Wallet::Admin (); + +# Used to cache lookups of e-mail addresses by identifiers. +our %EMAIL; + +############################################################################## +# whois lookups +############################################################################## + +# Given the directory handle of a user, look up their e-mail address. This +# assumes the Stanford-specific swhois program. +sub person_email { + my ($identifier) = @_; + return $EMAIL{$identifier} if exists $EMAIL{$identifier}; + my @output = `swhois '$identifier'`; + for my $line (@output) { + if ($line =~ /^\s*Email:\s*(\S+)/i) { + $EMAIL{$identifier} = $1; + return $1; + } elsif ($line =~ /^\s*SUNet IDs:\s*(\S+)/) { + my $email = $1 . '@stanford.edu'; + $EMAIL{$identifier} = $email; + return $email; + } + } + warn "$0: unable to find email address for identifier $identifier\n"; + $EMAIL{$identifier} = undef; + return; +} + +# Look up a system in whois and return the e-mail address or addresses of the +# administrator. +sub whois_lookup { + my ($system) = @_; + my @output = `swhois '$system'`; + my ($inadmin, @users, @admins); + for (@output) { + if (/^\s*administrator:\s*(?:\S+\s+)+\((d\S+)\)\s*$/i) { + push (@admins, person_email ($1)); + $inadmin = 1; + } elsif (/^\s*administrator:/i) { + $inadmin = 1; + } elsif (/^\s*group:/i) { + $inadmin = 0; + } elsif ($inadmin and /^\s*e-?mail: (\S+)/i) { + push (@admins, $1); + } elsif ($inadmin and /^\s*(?:\S+\s+)+\((d\S+)\)\s*$/i) { + push (@admins, person_email ($1)); + } elsif (/^\s*user:\s*(?:\S+\s+)+\((d\S+)\)\s*$/i) { + push (@users, person_email ($1)); + } + } + @admins = @users if !@admins; + warn "$0: unable to find administrator for $system\n" unless @admins; + return @admins; +} + +############################################################################## +# Main routine +############################################################################## + +# Read in command-line options. +my ($help); +Getopt::Long::config ('no_ignore_case', 'bundling'); +GetOptions ('help|h' => \$help) or exit 1; +if ($help) { + print "Feeding myself to perldoc, please wait....\n"; + exec ('perldoc', '-t', $0); +} +my ($type, $name) = @ARGV; +if (@ARGV > 2 or not defined $name) { + die "Usage: wallet-contacts \n"; +} + +# Clean up $0 for error reporting. +$0 =~ s%.*/%%; + +# Gather the list of ACL lines. +my $admin = Wallet::Admin->new; +my @lines = $admin->report_owners ($type, $name); +if (!@lines and $admin->error) { + die $admin->error, "\n"; +} + +# Now, for each line, turn it into an e-mail address. krb5 ACLs go as-is if +# they are regular user principals. If they're other principals, ignore them +# unless they're of the form host/*, in which case extract the host and treat +# it the same as a netdb ACL. netdb and netdb-root ACLs result in a whois +# lookup on that host, extracting the e-mail address of the administrator +# group. If there is no e-mail address, extract the user and look up their +# e-mail address. +my @email; +for (@lines) { + my ($scheme, $identifier) = @$_; + my $machine; + if ($scheme eq 'krb5') { + if ($identifier =~ m,^[^/]+\@,) { + push (@email, $identifier); + } elsif ($identifier =~ m,^host/([^/]+)\@,) { + $machine = $1; + } + } elsif ($scheme eq 'netdb' or $scheme eq 'netdb-root') { + $machine = $identifier; + } + if ($machine) { + push (@email, whois_lookup ($machine)); + } +} + +# We now have a list of e-mail addresses. De-duplicate and then print them +# out. +my %seen; +@email = grep { !$seen{$_}++ } sort @email; +print join ("\n", @email, ''); + +############################################################################## +# Documentation +############################################################################## + +=head1 NAME + +wallet-contacts - Report contact addresses for matching wallet objects + +=head1 SYNOPSIS + +B [B<-h>] I I + +=head1 DESCRIPTION + +B returns a list of e-mail addresses corresponding to +members of owner ACLs for all objects in the wallet database matching +I and I. The patterns can be wallet object +types or names, or they can be SQL patterns using C<%> as a wildcard. + +C ACL schemes will return the corresponding identifier as an e-mail +address unless it contains a C. If it contains C, it will be +ignored except for principals of the form C>, which will +have I treated as if it were the identifier in a C ACL. + +C and C ACL schemes will return the e-mail address from +a whois lookup of the corresponding NetDB object. B will +run B on the system name and search the output for users and +administrators. E-mail addresses for admin groups will be returned as-is. +Administrators will result in a second lookup via B for their +directory handle, returning the corresponding e-mail address if found in +their whois record. If there are no administrators or admin teams with +e-mail addresses, the value of the user key, if any, will be looked up +similar to an administrator. + +If B is unable to find any contact for a host or any +e-mail address for an administrator or user, it will warn but continue. + +=head1 OPTIONS + +=over 4 + +=item B<-h>, B<--help> + +Print out this documentation (which is done simply by feeding the script +to C). + +=back + +=head1 CAVEATS + +Many of the assumptions made by this script are Stanford-specific, such as +the ability to use Kerberos principals as-is as e-mail addresses, the +B program for looking up people, and the parsing of the B +output format. + +=head1 AUTHOR + +Russ Allbery + +=cut -- cgit v1.2.3 From ac639ee085c464a0098bd85b9cba9ab7155f27c7 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Fri, 7 Aug 2009 14:21:52 -0700 Subject: Update Stanford naming documentation for puppet.conf Add a naming convention for puppet.conf files containing secure data and reorganize the naming convention documentation to group all service objects together. --- docs/stanford-naming | 21 ++++++++++++++------- 1 file changed, 14 insertions(+), 7 deletions(-) diff --git a/docs/stanford-naming b/docs/stanford-naming index f887a69..3c6330b 100644 --- a/docs/stanford-naming +++ b/docs/stanford-naming @@ -70,13 +70,6 @@ Object Naming Then, we use the following naming conventions for different types of objects: - --db- - - Stores the database password for the database named . This - may be a file containing only the database password or a Perl - AppConfig configuration file with the database connection - information including the password. - --htpasswd- An .htpasswd file for HTTP Basic Authentication for special-case @@ -109,6 +102,13 @@ Object Naming The public certificate we manage external to wallet since it doesn't need to be protected or encrypted. + --db- + + Stores the database password for the database named . This + may be a file containing only the database password or a Perl + AppConfig configuration file with the database connection + information including the password. + --gpg-key Stores the GnuPG private key for a service that needs to do GnuPG @@ -122,6 +122,13 @@ Object Naming sometimes it's too hard to separate out chunks of a properties file. + --puppetconf + + A puppet.conf configuration file for Puppet that contains some + secure data (such as SSL key passwords or database passwords). + Ideally the secure data should be stored in separate files, but + Puppet likes to use a single configuration file. + --shibboleth The shibboleth.xml configuration file for a service, when it -- cgit v1.2.3 From b87c38cb69f9b43894c377cd9370ec3e8c42d4cc Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Sat, 15 Aug 2009 15:42:26 -0700 Subject: Add a naming convention for general config files We have some general configuration files that contain database passwords. Add a general naming convention to avoid creating new ones with each new type of config file. --- docs/stanford-naming | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/docs/stanford-naming b/docs/stanford-naming index 3c6330b..94537bb 100644 --- a/docs/stanford-naming +++ b/docs/stanford-naming @@ -102,6 +102,15 @@ Object Naming The public certificate we manage external to wallet since it doesn't need to be protected or encrypted. + --config- + + A configuration file named that contains some secure + information, such as a database password. Ideally, the secure + data should be stored in a separate file and assembled into the + configuration file, but that isn't always the path of least + resistance. Only use this naming convention if there is not a + more specific one below. + --db- Stores the database password for the database named . This -- cgit v1.2.3 From 2c5bd71125d411639b4a61116957879eebae21ad Mon Sep 17 00:00:00 2001 From: Jon Robertson Date: Thu, 3 Dec 2009 08:52:19 -0800 Subject: Improved wallet-admin list command with searches wallet-admin's list command now has additional searches added for objects and acls that match certain specifiers. For objects these include searching for objects owned by a specific ACL, objects owned by no one, objects of a specific type, objects with a specific flag, and objects for which a specific ACL has any privileges at all. For acls, this includes the ability to search for any ACL with an entry with given type and identifier. --- perl/Wallet/Admin.pm | 167 ++++++++++++++++++++++++++++++++++++++++++++++++--- perl/t/admin.t | 55 ++++++++++++++--- server/wallet-admin | 8 +-- 3 files changed, 206 insertions(+), 24 deletions(-) diff --git a/perl/Wallet/Admin.pm b/perl/Wallet/Admin.pm index c11c3d4..91f1bfb 100644 --- a/perl/Wallet/Admin.pm +++ b/perl/Wallet/Admin.pm @@ -22,7 +22,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.03'; +$VERSION = '0.04'; ############################################################################## # Constructor, destructor, and accessors @@ -114,20 +114,132 @@ sub destroy { # Reporting ############################################################################## +# Given an ACL name, translate it to the ID for that ACL and return it. +# Often this is unneeded and could be done with a join, but by doing it in a +# separate step, we can give an error for the specific case of someone +# searching for a non-existant ACL. +sub acl_name_to_id { + my ($self, $acl) = @_; + my ($id); + eval { + my $sql = 'select ac_id from acls where ac_name=?'; + my $sth = $self->{dbh}->prepare ($sql); + $sth->execute ($acl); + while (defined (my $row = $sth->fetchrow_hashref)) { + $id = $row->{'ac_id'}; + } + $self->{dbh}->commit; + }; + + if (!defined $id || $id !~ /^\d+$/) { + $self->error ("could not find the acl $acl"); + return ''; + } + return $id; +} + +# Return the SQL statement to find every object in the database. +sub list_objects_all { + my ($self) = @_; + my $sql = 'select ob_type, ob_name from objects order by ob_type, + ob_name'; + return $sql; +} + +# Return the SQL statement and the search field required to find all objects +# matching a specific type. +sub list_objects_type { + my ($self, $type) = @_; + my $sql = 'select ob_type, ob_name from objects where ob_type=? order + by ob_type, ob_name'; + return ($sql, $type); +} + +# Return the SQL statement and search field required to find all objects +# owned by a given ACL. If the requested owner is 'null', then we ignore +# this and do a different search for IS NULL. If the requested owner does +# not actually match any ACLs, set an error and return the empty string. +sub list_objects_owner { + my ($self, $owner) = @_; + my ($sth); + if ($owner =~ /^null$/i) { + my $sql = 'select ob_type, ob_name from objects where ob_owner is null + order by objects.ob_type, objects.ob_name'; + return ($sql); + } else { + my $id = $self->acl_name_to_id ($owner); + return '' unless $id; + my $sql = 'select ob_type, ob_name from objects where ob_owner=? + order by objects.ob_type, objects.ob_name'; + return ($sql, $id); + } +} + +# Return the SQL statement and search field required to find all objects +# that have a specific flag set. +sub list_objects_flag { + my ($self, $flag) = @_; + my $sql = 'select ob_type, ob_name from objects left join flags on + (objects.ob_type=flags.fl_type AND objects.ob_name=flags.fl_name) + where flags.fl_flag=? order by objects.ob_type, objects.ob_name'; + return ($sql, $flag); +} + +# Return the SQL statement and search field required to find all objects +# that a given ACL has any permissions on. This expands from +# list_objects_owner in that it will also match any records that have the ACL +# set for get, store, show, destroy, or flags. If the requested owner does +# not actually match any ACLs, set an error and return the empty string. +sub list_objects_acl { + my ($self, $acl) = @_; + + my $id = $self->acl_name_to_id ($acl); + return '' unless $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=? + order by objects.ob_type, objects.ob_name'; + return ($sql, $id, $id, $id, $id, $id, $id); +} + # Returns a list of all objects stored in the wallet database in the form of # type and name pairs. On error and for an empty database, the empty list # will be returned. To distinguish between an empty list and an error, call -# error(), which will return undef if there was no error. +# error(), which will return undef if there was no error. Farms out specific +# statement to another subroutine for specific search types, but each case +# should return ob_type and ob_name in that order. sub list_objects { - my ($self) = @_; + my ($self, $type, @args) = @_; undef $self->{error}; + + # Find the SQL statement and the arguments to use. + my $sql = ''; + my @search = (); + if (!defined $type || $type eq '') { + ($sql) = $self->list_objects_all (); + } else { + if (@args != 1) { + $self->error ("object searches require an argument to search"); + } elsif ($type eq 'type') { + ($sql, @search) = $self->list_objects_type (@args); + } elsif ($type eq 'owner') { + ($sql, @search) = $self->list_objects_owner (@args); + } elsif ($type eq 'flag') { + ($sql, @search) = $self->list_objects_flag (@args); + } elsif ($type eq 'acl') { + ($sql, @search) = $self->list_objects_acl (@args); + } else { + $self->error ("do not know search type: $type"); + } + return unless $sql; + } + my @objects; eval { - my $sql = 'select ob_type, ob_name from objects order by ob_type, - ob_name'; - my $sth = $self->{dbh}->prepare ($sql); - $sth->execute; my $object; + my $sth = $self->{dbh}->prepare ($sql); + $sth->execute (@search); while (defined ($object = $sth->fetchrow_arrayref)) { push (@objects, [ @$object ]); } @@ -142,6 +254,25 @@ sub list_objects { } } +# Returns the SQL statement required to find and return all ACLs in the db. +sub list_acls_all { + my ($self) = @_; + my $sql = 'select ac_id, ac_name from acls order by ac_id'; + return ($sql); +} + +# Returns the SQL statement and the field required to search the ACLs and +# return only those entries which contain a entries with identifiers +# matching a particular given string. +sub list_acls_entry { + my ($self, $type, $identifier) = @_; + my $sql = 'select distinct ac_id, ac_name from acl_entries + left join acls on (ae_id=ac_id) where ae_scheme=? and + ae_identifier like ? order by ac_id'; + $identifier = '%'.$identifier.'%'; + return ($sql, $type, $identifier); +} + # Returns a list of all ACLs stored in the wallet database as a list of pairs # of ACL IDs and ACL names. On error and for an empty database, the empty # list will be returned; however, this is unlikely since any valid database @@ -149,13 +280,29 @@ sub list_objects { # list and an error, call error(), which will return undef if there was no # error. sub list_acls { - my ($self) = @_; + my ($self, $type, @args) = @_; undef $self->{error}; + + # Find the SQL statement and the arguments to use. + my $sql = ''; + my @search = (); + if (!defined $type || $type eq '') { + ($sql) = $self->list_acls_all (); + } else { + if (@args == 0) { + $self->error ("acl searches require an argument to search"); + } elsif ($type eq 'entry') { + ($sql, @search) = $self->list_acls_entry (@args); + } else { + $self->error ("do not know search type: $type"); + } + return unless $sql; + } + my @acls; eval { - my $sql = 'select ac_id, ac_name from acls order by ac_id'; my $sth = $self->{dbh}->prepare ($sql); - $sth->execute; + $sth->execute (@search); my $object; while (defined ($object = $sth->fetchrow_arrayref)) { push (@acls, [ @$object ]); diff --git a/perl/t/admin.t b/perl/t/admin.t index 8804f34..77c786d 100755 --- a/perl/t/admin.t +++ b/perl/t/admin.t @@ -7,7 +7,7 @@ # # See LICENSE for licensing terms. -use Test::More tests => 57; +use Test::More tests => 77; use Wallet::Admin; use Wallet::Schema; @@ -54,15 +54,6 @@ is ($objects[0][1], 'service/admin', ' and the right name'); is ($admin->register_verifier ('base', 'Wallet::ACL::Base'), 1, 'Registering Wallet::ACL::Base works'); -# Create another ACL. -is ($server->acl_create ('first'), 1, 'ACL creation succeeds'); -@acls = $admin->list_acls; -is (scalar (@acls), 2, ' and now there are two ACLs'); -is ($acls[0][0], 1, ' and the first ID is correct'); -is ($acls[0][1], 'ADMIN', ' and the first name is correct'); -is ($acls[1][0], 2, ' and the second ID is correct'); -is ($acls[1][1], 'first', ' and the second name is correct'); - # Delete that ACL and create another. is ($server->acl_create ('second'), 1, 'Second ACL creation succeeds'); is ($server->acl_destroy ('first'), 1, ' and deletion of the first succeeds'); @@ -124,6 +115,50 @@ is ($lines[1][1], 'foo', ' and the right identifier'); is ($lines[2][0], 'krb5', ' third has the right scheme'); is ($lines[2][1], 'admin@EXAMPLE.COM', ' and the right identifier'); +# Test ownership and other ACL values. Change one keytab to be not owned by +# ADMIN, but have group permission on it. We'll need a third object neither +# owned by ADMIN or with any permissions from it. +is ($server->create ('base', 'service/null'), 1, + 'Creating base:service/null succeeds'); +is ($server->acl ('base', 'service/foo', 'get', 'ADMIN'), 1, + 'Changing the get ACL for the search also does'); +@lines = $admin->list_objects ('owner', 'ADMIN'); +is (scalar (@lines), 1, 'Searching for objects owned by ADMIN finds one'); +is ($lines[0][0], 'base', ' and it has the right type'); +is ($lines[0][1], 'service/admin', ' and the right name'); +@lines = $admin->list_objects ('owner', 'null'); +is (scalar (@lines), 1, 'Searching for objects with no set ownerfinds one'); +is ($lines[0][0], 'base', ' and it has the right type'); +is ($lines[0][1], 'service/null', ' and the right name'); +@lines = $admin->list_objects ('acl', 'ADMIN'); +is (scalar (@lines), 2, 'ADMIN has any rights at all on two objects'); +is ($lines[0][0], 'base', ' and the first has the right type'); +is ($lines[0][1], 'service/admin', ' and the right name'); +is ($lines[1][0], 'base', ' and the second has the right type'); +is ($lines[1][1], 'service/foo', ' and the right name'); + +# Listing objects of a specific type. +@lines = $admin->list_objects ('type', 'base'); +is (scalar (@lines), 3, 'Searching for all objects of type base finds three'); +is ($lines[0][0], 'base', ' and the first has the right type'); +is ($lines[0][1], 'service/admin', ' and the right name'); +is ($lines[1][0], 'base', ' and the second has the right type'); +is ($lines[1][1], 'service/foo', ' and the right name'); +is ($lines[2][0], 'base', ' and the third has the right type'); +is ($lines[2][1], 'service/null', ' and the right name'); +@lines = $admin->list_objects ('type', 'keytab'); +is (scalar (@lines), 0, 'Searching for all objects of type keytab finds none'); + +# Test setting a flag, searching for objects with it, and then clearing it. +is ($server->flag_set ('base', 'service/admin', 'unchanging'), 1, + 'Setting a flag works'); +@lines = $admin->list_objects ('flag', 'unchanging'); +is (scalar (@lines), 1, 'Searching for all objects with that flag finds one'); +is ($lines[0][0], 'base', ' and it has the right type'); +is ($lines[0][1], 'service/admin', ' and the right name'); +is ($server->flag_clear ('base', 'service/admin', 'unchanging'), 1, + 'Clearing the flag works'); + # Clean up. is ($admin->destroy, 1, 'Destruction succeeds'); unlink 'wallet-db'; diff --git a/server/wallet-admin b/server/wallet-admin index b5674c5..01fea5c 100755 --- a/server/wallet-admin +++ b/server/wallet-admin @@ -42,11 +42,11 @@ sub command { 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 > 1; + die "too many arguments to list\n" if @args > 4; die "too few arguments to list\n" if @args < 1; - my ($type) = @args; + my ($type, $subtype, @search) = @args; if ($type eq 'objects') { - my @objects = $admin->list_objects; + my @objects = $admin->list_objects ($subtype, @search); if (!@objects and $admin->error) { die $admin->error, "\n"; } @@ -54,7 +54,7 @@ sub command { print join (' ', @$object), "\n"; } } elsif ($type eq 'acls') { - my @acls = $admin->list_acls; + my @acls = $admin->list_acls ($subtype, @search); if (!@acls and $admin->error) { die $admin->error, "\n"; } -- cgit v1.2.3 From 0e6b6e3be0d1c544871445a580de7da502fec8c0 Mon Sep 17 00:00:00 2001 From: Jon Robertson Date: Thu, 10 Dec 2009 14:40:59 -0800 Subject: Added support for Heimdal KDC Added support for Heimdal as an alternative to MIT Kerberos. This involved separating out the kadmin-specific code into its own set of modules, and changing the existing Wallet::Object::Keytab code to branch based on which module is loaded. --- perl/Wallet/Kadmin.pm | 110 +++++++++++++++++ perl/Wallet/Kadmin/Heimdal.pm | 278 ++++++++++++++++++++++++++++++++++++++++++ perl/Wallet/Kadmin/MIT.pm | 275 +++++++++++++++++++++++++++++++++++++++++ perl/Wallet/Object/Keytab.pm | 192 +++++------------------------ 4 files changed, 696 insertions(+), 159 deletions(-) create mode 100644 perl/Wallet/Kadmin.pm create mode 100644 perl/Wallet/Kadmin/Heimdal.pm create mode 100644 perl/Wallet/Kadmin/MIT.pm diff --git a/perl/Wallet/Kadmin.pm b/perl/Wallet/Kadmin.pm new file mode 100644 index 0000000..b804861 --- /dev/null +++ b/perl/Wallet/Kadmin.pm @@ -0,0 +1,110 @@ +# Wallet::Kadmin -- Kadmin module wrapper for the wallet. +# +# Written by Jon Robertson +# Copyright 2009 Board of Trustees, Leland Stanford Jr. University +# +# See LICENSE for licensing terms. + +############################################################################## +# Modules and declarations +############################################################################## + +package Wallet::Kadmin; +require 5.006; + +use strict; +use vars qw($VERSION); + +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.01'; + +############################################################################## +# Constructor +############################################################################## + +# Create a new kadmin object, by finding the type requested in the wallet +# config and passing off to the proper module. Returns the object directly +# from the specific Wallet::Kadmin::* module. +sub new { + my ($class) = @_; + my ($kadmin); + if ($Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') { + require Wallet::Kadmin::MIT; + $kadmin = Wallet::Kadmin::MIT->new (); + } elsif ($Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal') { + require Wallet::Kadmin::Heimdal; + $kadmin = Wallet::Kadmin::Heimdal->new (); + } else { + die "keytab krb server type not set to a valid value\n"; + } + + return $kadmin; +} + +1; +__END__ + +############################################################################## +# Documentation +############################################################################## + +=head1 NAME + +Wallet::Kadmin - Kadmin module wrapper for wallet keytabs + +=head1 SYNOPSIS + + my $kadmin = Wallet::Kadmin->new (); + $kadmin->addprinc ("host/shell.example.com"); + $kadmin->ktadd ("host/shell.example.com", "aes256-cts"); + my $exists = $kadmin->exists ("host/oldshell.example.com"); + $kadmin->delprinc ("host/oldshell.example.com") if $exists; + +=head1 DESCRIPTION + +Wallet::Kadmin is a wrapper to modules that provide an interface for keytab +integration with the wallet. Each module is meant to interface with a +specific type of Kerberos implementation, such as MIT Kerberos or Heimdal +Kerberos, and provide a standndard set of API calls used to interact with +that implementation's kadmind. + +The class simply uses Wallet::Config to find which type of kadmind we have +requested to use, and then returns an object to use for interacting with +that kadmind. + +A keytab is an on-disk store for the key or keys for a Kerberos principal. +Keytabs are used by services to verify incoming authentication from clients +or by automated processes that need to authenticate to Kerberos. To create +a keytab, the principal has to be created in Kerberos and then a keytab is +generated and stored in a file on disk. + +To use this object, several configuration parameters must be set. See +Wallet::Config(3) for details on those configuration parameters and +information about how to set wallet configuration. + +=head1 METHODS + +=over 4 + +=item new() + +Finds the proper Kerberos implementation and calls the new() constructor for +that implementation's module, returning the result. If the implementation +is not recognized or set, die with an error message. + +=head1 SEE ALSO + +kadmin(8), Wallet::Config(3), Wallet::Object::Keytab(3), wallet-backend(8) + +This module is part of the wallet system. The current version is available +from L. + +=head1 AUTHORS + +Jon Robertson + +=cut diff --git a/perl/Wallet/Kadmin/Heimdal.pm b/perl/Wallet/Kadmin/Heimdal.pm new file mode 100644 index 0000000..06564d2 --- /dev/null +++ b/perl/Wallet/Kadmin/Heimdal.pm @@ -0,0 +1,278 @@ +# Wallet::Kadmin::Heimdal -- Heimdal Kadmin interactions for the wallet. +# +# Written by Jon Robertson +# Copyright 2009 Board of Trustees, Leland Stanford Jr. University +# +# See LICENSE for licensing terms. + +############################################################################## +# Modules and declarations +############################################################################## + +package Wallet::Kadmin::Heimdal; +require 5.006; + +use strict; +use vars qw($VERSION); + +use Heimdal::Kadm5 qw (KRB5_KDB_DISALLOW_ALL_TIX); + +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.01'; + +############################################################################## +# kadmin Interaction +############################################################################## + +# Make sure that principals are well-formed and don't contain characters that +# will cause us problems when talking to kadmin. Takes a principal and +# returns true if it's okay, false otherwise. Note that we do not permit +# realm information here. +sub valid_principal { + my ($self, $principal) = @_; + return scalar ($principal =~ m,^[\w-]+(/[\w_.-]+)?\z,); +} + +# Create a Heimdal::Kadm5 client object and return it. It should load +# configuration from Wallet::Config. +sub kadmin_client { + unless (defined ($Wallet::Config::KEYTAB_PRINCIPAL) + and defined ($Wallet::Config::KEYTAB_FILE) + and defined ($Wallet::Config::KEYTAB_REALM)) { + die "keytab object implementation not configured\n"; + } + + my $server = $Wallet::Config::KEYTAB_HOST || 'localhost'; + my $client = Heimdal::Kadm5::Client->new( + RaiseErrors => 1, + Server => $server, + Principal => $Wallet::Config::KEYTAB_PRINCIPAL, + Realm => $Wallet::Config::KEYTAB_REALM, + Keytab => $Wallet::Config::KEYTAB_FILE, + ); + return $client; +} + +############################################################################## +# Public interfaces +############################################################################## + +# Check whether a given principal already exists in Kerberos. Returns true if +# so, false otherwise. Throws an exception if kadmin fails. +sub exists { + my ($self, $principal) = @_; + return unless $self->valid_principal ($principal); + if ($Wallet::Config::KEYTAB_REALM) { + $principal .= '@' . $Wallet::Config::KEYTAB_REALM; + } + my $kadmin = $self->{client}; + my @names = $kadmin->getPrincipals ($principal); + if (@names) { + return 1; + } else { + return 0; + } +} + +# Create a principal in Kerberos. Since this is only called by create, it +# throws an exception on failure rather than setting the error and returning +# undef. +sub addprinc { + my ($self, $principal) = @_; + unless ($self->valid_principal ($principal)) { + die "invalid principal name $principal\n"; + } + return 1 if $self->exists ($principal); + if ($Wallet::Config::KEYTAB_REALM) { + $principal .= '@' . $Wallet::Config::KEYTAB_REALM; + } + + # The way Heimdal::Kadm5 works, we create a principal object, create the + # actual principal set inactive, then randomize it and activate it. + # TODO - Paranoia makes me want to set the password to something random + # on creation even if it is inactive until after randomized by + # module. + my $kadmin = $self->{client}; + my $princdata = $kadmin->makePrincipal ($principal); + + # Disable the principal before creating, until we've randomized the + # password. + my $attrs = $princdata->getAttributes; + $attrs |= KRB5_KDB_DISALLOW_ALL_TIX; + $princdata->setAttributes ($attrs); + + my $password = 'inactive'; + my $retval = eval { $kadmin->createPrincipal ($princdata, $password, 0) }; + die "error adding principal $principal: $@" if $@; + $retval = eval { $kadmin->randKeyPrincipal ($principal) }; + die "error adding principal $principal: $@" if $@; + $retval = eval { $kadmin->enablePrincipal ($principal) }; + die "error adding principal $principal: $@" if $@; + + return 1; +} + +# Create a keytab from a principal. Takes the principal, the file, and +# optionally a list of encryption types to which to limit the keytab. Return +# true if successful, false otherwise. If the keytab creation fails, sets the +# error. +sub ktadd { + my ($self, $principal, $file, @enctypes) = @_; + unless ($self->valid_principal ($principal)) { + die ("invalid principal name: $principal"); + } + if ($Wallet::Config::KEYTAB_REALM) { + $principal .= '@' . $Wallet::Config::KEYTAB_REALM; + } + + my $kadmin = $self->{client}; + my $princdata = eval { $kadmin->getPrincipal ($principal) }; + + # Remove enctypes we don't want in this keytab. Must find all current + # keytypes, then remove those that do not match. + my (%wanted); + my $alltypes = $princdata->getKeytypes (); + foreach (@enctypes) { $wanted{$_} = 1 } + foreach my $key (@{$alltypes}) { + my $keytype = ${$key}[0]; + next if exists $wanted{$keytype}; + eval { $princdata->delKeytypes ($keytype) }; + die "error removing keytype $keytype from the keytab: $@" if $@; + } + eval { $kadmin->modifyPrincipal ($princdata) }; + + my $retval = eval { $kadmin->extractKeytab ($princdata, $file) }; + die "error creating keytab for principal: $@" if $@; + + return 1; +} + +# Delete a principal from Kerberos. Return true if successful, false +# otherwise. If the deletion fails, sets the error. If the principal doesn't +# exist, return success; we're bringing reality in line with our expectations. +sub delprinc { + my ($self, $principal) = @_; + unless ($self->valid_principal ($principal)) { + die ("invalid principal name: $principal"); + } + my $exists = eval { $self->exists ($principal) }; + die $@ if $@; + if (not $exists) { + return 1; + } + if ($Wallet::Config::KEYTAB_REALM) { + $principal .= '@' . $Wallet::Config::KEYTAB_REALM; + } + + my $kadmin = $self->{client}; + my $retval = eval { $kadmin->deletePrincipal ($principal) }; + die "error deleting $principal: $@" if $@; + return 1; +} + +############################################################################## +# Documentation +############################################################################## + +# Create a new MIT kadmin object. Very empty for the moment, but later it +# will probably fill out if we go to using a module rather than calling +# kadmin directly. +sub new { + my ($class) = @_; + my $self = { + client => kadmin_client (), + }; + bless ($self, $class); + return $self; +} + +1; +__END__ + +############################################################################## +# Documentation +############################################################################## + +=head1 NAME + +Wallet::Kadmin::MIT - MIT admin interactions for wallet keytabs + +=head1 SYNOPSIS + + my $kadmin = Wallet::Kadmin::MIT->new (); + $kadmin->addprinc ("host/shell.example.com"); + $kadmin->ktadd ("host/shell.example.com", "aes256-cts"); + my $exists = $kadmin->exists ("host/oldshell.example.com"); + $kadmin->delprinc ("host/oldshell.example.com") if $exists; + +=head1 DESCRIPTION + +Wallet::Kadmin::MIT is an interface for keytab integration with the wallet, +specifically for using kadmin to create, delete, and add enctypes to keytabs. +It implments the wallet kadmin API and provides the necessary glue to MIT +Kerberos installs for each of these functions, while allowing the wallet +to keep the details of what type of Kerberos installation is being used +abstracted. + +A keytab is an on-disk store for the key or keys for a Kerberos principal. +Keytabs are used by services to verify incoming authentication from clients +or by automated processes that need to authenticate to Kerberos. To create +a keytab, the principal has to be created in Kerberos and then a keytab is +generated and stored in a file on disk. + +To use this object, several configuration parameters must be set. See +Wallet::Config(3) for details on those configuration parameters and +information about how to set wallet configuration. + +=head1 METHODS + +=over 4 + +=item addprinc(PRINCIPAL) + +Adds a new principal with a given name. The principal is created with a +random password, and any other flags set by Wallet::Config. Returns true on +success, or throws an error if there was a failure in adding the principal. +If the principal already exists, return true as we are bringing our +expectations in line with reality. + +=item addprinc(PRINCIPAL) + +Removes a principal with the given name. Returns true on success, or throws +an error if there was a failure in removing the principal. If the principal +does not exist, return true as we are bringing our expectations in line with +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 or C). An error is +thrown on failure or if the creation fails, otherwise true is returned. + +=back + +=head1 LIMITATIONS + +Currently, this implementation calls an external B program rather + than using a native Perl module and therefore requires B be +installed and parses its output. It may miss some error conditions if the +output of B ever changes. + +=head1 SEE ALSO + +kadmin(8), Wallet::Config(3), Wallet::Object::Keytab(3), wallet-backend(8) + +This module is part of the wallet system. The current version is available +from L. + +=head1 AUTHORS + +Russ Allbery +Jon Robertson + +=cut diff --git a/perl/Wallet/Kadmin/MIT.pm b/perl/Wallet/Kadmin/MIT.pm new file mode 100644 index 0000000..b7d4913 --- /dev/null +++ b/perl/Wallet/Kadmin/MIT.pm @@ -0,0 +1,275 @@ +# Wallet::Kadmin::MIT -- MIT Kadmin interactions for the wallet. +# +# Written by Russ Allbery +# Pulled into a module by Jon Robertson +# Copyright 2007, 2008, 2009 Board of Trustees, Leland Stanford Jr. University +# +# See LICENSE for licensing terms. + +############################################################################## +# Modules and declarations +############################################################################## + +package Wallet::Kadmin::MIT; +require 5.006; + +use strict; +use vars qw($VERSION); + +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.01'; + +############################################################################## +# kadmin Interaction +############################################################################## + +# Make sure that principals are well-formed and don't contain characters that +# will cause us problems when talking to kadmin. Takes a principal and +# returns true if it's okay, false otherwise. Note that we do not permit +# realm information here. +sub valid_principal { + my ($self, $principal) = @_; + return scalar ($principal =~ m,^[\w-]+(/[\w_.-]+)?\z,); +} + +# Run a kadmin command and capture the output. Returns the output, either as +# a list of lines or, in scalar context, as one string. The exit status of +# kadmin is often worthless. +sub kadmin { + my ($self, $command) = @_; + unless (defined ($Wallet::Config::KEYTAB_PRINCIPAL) + and defined ($Wallet::Config::KEYTAB_FILE) + and defined ($Wallet::Config::KEYTAB_REALM)) { + die "keytab object implementation not configured\n"; + } + my @args = ('-p', $Wallet::Config::KEYTAB_PRINCIPAL, '-k', '-t', + $Wallet::Config::KEYTAB_FILE, '-q', $command); + push (@args, '-s', $Wallet::Config::KEYTAB_HOST) + if $Wallet::Config::KEYTAB_HOST; + push (@args, '-r', $Wallet::Config::KEYTAB_REALM) + if $Wallet::Config::KEYTAB_REALM; + my $pid = open (KADMIN, '-|'); + if (not defined $pid) { + die "cannot fork: $!\n"; + } elsif ($pid == 0) { + # TODO - How should I handle the db handle? + # Don't use die here; it will get trapped as an exception. Also be + # careful about our database handles. (We still lose if there's some + # other database handle open we don't know about.) + #$object->{dbh}->{InactiveDestroy} = 1; + unless (open (STDERR, '>&STDOUT')) { + warn "wallet: cannot dup stdout: $!\n"; + exit 1; + } + unless (exec ($Wallet::Config::KEYTAB_KADMIN, @args)) { + warn "wallet: cannot run $Wallet::Config::KEYTAB_KADMIN: $!\n"; + exit 1; + } + } + local $_; + my @output; + while () { + if (/^wallet: cannot /) { + s/^wallet: //; + die $_; + } + push (@output, $_) unless /Authenticating as principal/; + } + close KADMIN; + return wantarray ? @output : join ('', @output); +} + +############################################################################## +# Public interfaces +############################################################################## + +# Check whether a given principal already exists in Kerberos. Returns true if +# so, false otherwise. Throws an exception if kadmin fails. +sub exists { + my ($self, $principal) = @_; + return unless $self->valid_principal ($principal); + if ($Wallet::Config::KEYTAB_REALM) { + $principal .= '@' . $Wallet::Config::KEYTAB_REALM; + } + my $output = $self->kadmin ("getprinc $principal"); + if ($output =~ /^get_principal: /) { + return; + } else { + return 1; + } +} + +# Create a principal in Kerberos. Since this is only called by create, it +# throws an exception on failure rather than setting the error and returning +# undef. +sub addprinc { + my ($self, $principal) = @_; + unless ($self->valid_principal ($principal)) { + die "invalid principal name $principal\n"; + } + return 1 if $self->exists ($principal); + if ($Wallet::Config::KEYTAB_REALM) { + $principal .= '@' . $Wallet::Config::KEYTAB_REALM; + } + my $flags = $Wallet::Config::KEYTAB_FLAGS || ''; + my $output = $self->kadmin ("addprinc -randkey $flags $principal"); + if ($output =~ /^add_principal: (.*)/m) { + die "error adding principal $principal: $1\n"; + } + return 1; +} + +# Create a keytab from a principal. Takes the principal, the file, and +# optionally a list of encryption types to which to limit the keytab. Return +# true if successful, false otherwise. If the keytab creation fails, sets the +# error. +sub ktadd { + my ($self, $principal, $file, @enctypes) = @_; + unless ($self->valid_principal ($principal)) { + die ("invalid principal name: $principal"); + } + if ($Wallet::Config::KEYTAB_REALM) { + $principal .= '@' . $Wallet::Config::KEYTAB_REALM; + } + my $command = "ktadd -q -k $file"; + if (@enctypes) { + @enctypes = map { /:/ ? $_ : "$_:normal" } @enctypes; + $command .= ' -e "' . join (' ', @enctypes) . '"'; + } + my $output = eval { $self->kadmin ("$command $principal") }; + die ($@) if ($@); + if ($output =~ /^(?:kadmin|ktadd): (.*)/m) { + die ("error creating keytab for $principal: $1"); + } + return 1; +} + +# Delete a principal from Kerberos. Return true if successful, false +# otherwise. If the deletion fails, sets the error. If the principal doesn't +# exist, return success; we're bringing reality in line with our expectations. +sub delprinc { + my ($self, $principal) = @_; + unless ($self->valid_principal ($principal)) { + die ("invalid principal name: $principal"); + } + my $exists = eval { $self->exists ($principal) }; + die $@ if $@; + if (not $exists) { + return 1; + } + if ($Wallet::Config::KEYTAB_REALM) { + $principal .= '@' . $Wallet::Config::KEYTAB_REALM; + } + my $output = eval { $self->kadmin ("delprinc -force $principal") }; + die $@ if $@; + if ($output =~ /^delete_principal: (.*)/m) { + die ("error deleting $principal: $1"); + } + return 1; +} + +############################################################################## +# Documentation +############################################################################## + +# Create a new MIT kadmin object. Very empty for the moment, but later it +# will probably fill out if we go to using a module rather than calling +# kadmin directly. +sub new { + my ($class) = @_; + my $self = { + }; + bless ($self, $class); + return $self; +} + +1; +__END__ + +############################################################################## +# Documentation +############################################################################## + +=head1 NAME + +Wallet::Kadmin::MIT - MIT admin interactions for wallet keytabs + +=head1 SYNOPSIS + + my $kadmin = Wallet::Kadmin::MIT->new (); + $kadmin->addprinc ("host/shell.example.com"); + $kadmin->ktadd ("host/shell.example.com", "aes256-cts"); + my $exists = $kadmin->exists ("host/oldshell.example.com"); + $kadmin->delprinc ("host/oldshell.example.com") if $exists; + +=head1 DESCRIPTION + +Wallet::Kadmin::MIT is an interface for keytab integration with the wallet, +specifically for using kadmin to create, delete, and add enctypes to keytabs. +It implments the wallet kadmin API and provides the necessary glue to MIT +Kerberos installs for each of these functions, while allowing the wallet +to keep the details of what type of Kerberos installation is being used +abstracted. + +A keytab is an on-disk store for the key or keys for a Kerberos principal. +Keytabs are used by services to verify incoming authentication from clients +or by automated processes that need to authenticate to Kerberos. To create +a keytab, the principal has to be created in Kerberos and then a keytab is +generated and stored in a file on disk. + +To use this object, several configuration parameters must be set. See +Wallet::Config(3) for details on those configuration parameters and +information about how to set wallet configuration. + +=head1 METHODS + +=over 4 + +=item addprinc(PRINCIPAL) + +Adds a new principal with a given name. The principal is created with a +random password, and any other flags set by Wallet::Config. Returns true on +success, or throws an error if there was a failure in adding the principal. +If the principal already exists, return true as we are bringing our +expectations in line with reality. + +=item addprinc(PRINCIPAL) + +Removes a principal with the given name. Returns true on success, or throws +an error if there was a failure in removing the principal. If the principal +does not exist, return true as we are bringing our expectations in line with +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 or C). An error is +thrown on failure or if the creation fails, otherwise true is returned. + +=back + +=head1 LIMITATIONS + +Currently, this implementation calls an external B program rather + than using a native Perl module and therefore requires B be +installed and parses its output. It may miss some error conditions if the +output of B ever changes. + +=head1 SEE ALSO + +kadmin(8), Wallet::Config(3), Wallet::Object::Keytab(3), wallet-backend(8) + +This module is part of the wallet system. The current version is available +from L. + +=head1 AUTHORS + +Russ Allbery +Jon Robertson + +=cut diff --git a/perl/Wallet/Object/Keytab.pm b/perl/Wallet/Object/Keytab.pm index 4cb8dff..1732070 100644 --- a/perl/Wallet/Object/Keytab.pm +++ b/perl/Wallet/Object/Keytab.pm @@ -17,6 +17,7 @@ use vars qw(@ISA $VERSION); use Wallet::Config (); use Wallet::Object::Base; +use Wallet::Kadmin; @ISA = qw(Wallet::Object::Base); @@ -25,160 +26,6 @@ use Wallet::Object::Base; # that it will sort properly. $VERSION = '0.06'; -############################################################################## -# kadmin Interaction -############################################################################## - -# Make sure that principals are well-formed and don't contain characters that -# will cause us problems when talking to kadmin. Takes a principal and -# returns true if it's okay, false otherwise. Note that we do not permit -# realm information here. -sub valid_principal { - my ($self, $principal) = @_; - return scalar ($principal =~ m,^[\w-]+(/[\w_.-]+)?\z,); -} - -# Run a kadmin command and capture the output. Returns the output, either as -# a list of lines or, in scalar context, as one string. The exit status of -# kadmin is often worthless. -sub kadmin { - my ($self, $command) = @_; - unless (defined ($Wallet::Config::KEYTAB_PRINCIPAL) - and defined ($Wallet::Config::KEYTAB_FILE) - and defined ($Wallet::Config::KEYTAB_REALM)) { - die "keytab object implementation not configured\n"; - } - my @args = ('-p', $Wallet::Config::KEYTAB_PRINCIPAL, '-k', '-t', - $Wallet::Config::KEYTAB_FILE, '-q', $command); - push (@args, '-s', $Wallet::Config::KEYTAB_HOST) - if $Wallet::Config::KEYTAB_HOST; - push (@args, '-r', $Wallet::Config::KEYTAB_REALM) - if $Wallet::Config::KEYTAB_REALM; - my $pid = open (KADMIN, '-|'); - if (not defined $pid) { - die "cannot fork: $!\n"; - } elsif ($pid == 0) { - # Don't use die here; it will get trapped as an exception. Also be - # careful about our database handles. (We still lose if there's some - # other database handle open we don't know about.) - $self->{dbh}->{InactiveDestroy} = 1; - unless (open (STDERR, '>&STDOUT')) { - warn "wallet: cannot dup stdout: $!\n"; - exit 1; - } - unless (exec ($Wallet::Config::KEYTAB_KADMIN, @args)) { - warn "wallet: cannot run $Wallet::Config::KEYTAB_KADMIN: $!\n"; - exit 1; - } - } - local $_; - my @output; - while () { - if (/^wallet: cannot /) { - s/^wallet: //; - die $_; - } - push (@output, $_) unless /Authenticating as principal/; - } - close KADMIN; - return wantarray ? @output : join ('', @output); -} - -# Check whether a given principal already exists in Kerberos. Returns true if -# so, false otherwise. Throws an exception if kadmin fails. -sub kadmin_exists { - my ($self, $principal) = @_; - return unless $self->valid_principal ($principal); - if ($Wallet::Config::KEYTAB_REALM) { - $principal .= '@' . $Wallet::Config::KEYTAB_REALM; - } - my $output = $self->kadmin ("getprinc $principal"); - if ($output =~ /^get_principal: /) { - return; - } else { - return 1; - } -} - -# Create a principal in Kerberos. Since this is only called by create, it -# throws an exception on failure rather than setting the error and returning -# undef. -sub kadmin_addprinc { - my ($self, $principal) = @_; - unless ($self->valid_principal ($principal)) { - die "invalid principal name $principal\n"; - } - return 1 if $self->kadmin_exists ($principal); - if ($Wallet::Config::KEYTAB_REALM) { - $principal .= '@' . $Wallet::Config::KEYTAB_REALM; - } - my $flags = $Wallet::Config::KEYTAB_FLAGS || ''; - my $output = $self->kadmin ("addprinc -randkey $flags $principal"); - if ($output =~ /^add_principal: (.*)/m) { - die "error adding principal $principal: $1\n"; - } - return 1; -} - -# Create a keytab from a principal. Takes the principal, the file, and -# optionally a list of encryption types to which to limit the keytab. Return -# true if successful, false otherwise. If the keytab creation fails, sets the -# error. -sub kadmin_ktadd { - my ($self, $principal, $file, @enctypes) = @_; - unless ($self->valid_principal ($principal)) { - $self->error ("invalid principal name: $principal"); - return; - } - if ($Wallet::Config::KEYTAB_REALM) { - $principal .= '@' . $Wallet::Config::KEYTAB_REALM; - } - my $command = "ktadd -q -k $file"; - if (@enctypes) { - @enctypes = map { /:/ ? $_ : "$_:normal" } @enctypes; - $command .= ' -e "' . join (' ', @enctypes) . '"'; - } - my $output = eval { $self->kadmin ("$command $principal") }; - if ($@) { - $self->error ($@); - return; - } elsif ($output =~ /^(?:kadmin|ktadd): (.*)/m) { - $self->error ("error creating keytab for $principal: $1"); - return; - } - return 1; -} - -# Delete a principal from Kerberos. Return true if successful, false -# otherwise. If the deletion fails, sets the error. If the principal doesn't -# exist, return success; we're bringing reality in line with our expectations. -sub kadmin_delprinc { - my ($self, $principal) = @_; - unless ($self->valid_principal ($principal)) { - $self->error ("invalid principal name: $principal"); - return; - } - my $exists = eval { $self->kadmin_exists ($principal) }; - if ($@) { - $self->error ($@); - return; - } elsif (not $exists) { - return 1; - } - if ($Wallet::Config::KEYTAB_REALM) { - $principal .= '@' . $Wallet::Config::KEYTAB_REALM; - } - my $output = eval { $self->kadmin ("delprinc -force $principal") }; - if ($@) { - $self->error ($@); - return; - } elsif ($output =~ /^delete_principal: (.*)/m) { - $self->error ("error deleting $principal: $1"); - return; - } - return 1; -} - ############################################################################## # AFS kaserver synchronization ############################################################################## @@ -607,16 +454,41 @@ sub attr_show { return $output; } +# Override new to start by creating a handle for the kadmin module we're +# using. +sub new { + my ($class, $type, $name, $dbh) = @_; + my $self = { + dbh => $dbh, + kadmin => undef, + }; + bless $self, $class; + my $kadmin = Wallet::Kadmin->new (); + $self->{kadmin} = $kadmin; + + $self = $class->SUPER::new ($type, $name, $dbh); + $self->{kadmin} = $kadmin; + return $self; +} + # Override create to start by creating the principal in Kerberos and only # create the entry in the database if that succeeds. Error handling isn't # great here since we don't have a way to communicate the error back to the # caller. sub create { my ($class, $type, $name, $dbh, $creator, $host, $time) = @_; - my $self = { dbh => $dbh }; + my $self = { + dbh => $dbh, + kadmin => undef, + }; bless $self, $class; - $self->kadmin_addprinc ($name); - return $class->SUPER::create ($type, $name, $dbh, $creator, $host, $time); + my $kadmin = Wallet::Kadmin->new (); + $self->{kadmin} = $kadmin; + $kadmin->addprinc ($name); + + $self = $class->SUPER::create ($type, $name, $dbh, $creator, $host, $time); + $self->{kadmin} = $kadmin; + return $self; } # Override destroy to delete the principal out of Kerberos as well. @@ -645,7 +517,8 @@ sub destroy { $self->{dbh}->rollback; return; } - return if not $self->kadmin_delprinc ($self->{name}); + my $kadmin = $self->{kadmin}; + return if not $kadmin->delprinc ($self->{name}); return $self->SUPER::destroy ($user, $host, $time); } @@ -673,7 +546,8 @@ sub get { my $file = $Wallet::Config::KEYTAB_TMP . "/keytab.$$"; unlink $file; my @enctypes = $self->attr ('enctypes'); - return if not $self->kadmin_ktadd ($self->{name}, $file, @enctypes); + my $kadmin = $self->{kadmin}; + return if not $kadmin->ktadd ($self->{name}, $file, @enctypes); local *KEYTAB; unless (open (KEYTAB, '<', $file)) { my $princ = $self->{name}; -- cgit v1.2.3 From 189bad7b6cfdfa9254a66deedb894b8fd3b79197 Mon Sep 17 00:00:00 2001 From: Jon Robertson Date: Thu, 10 Dec 2009 14:40:59 -0800 Subject: Added support for Heimdal KDC Added support for Heimdal as an alternative to MIT Kerberos. This involved separating out the kadmin-specific code into its own set of modules, and changing the existing Wallet::Object::Keytab code to branch based on which module is loaded. --- examples/stanford.conf | 1 + 1 file changed, 1 insertion(+) diff --git a/examples/stanford.conf b/examples/stanford.conf index 108b932..becfc6e 100644 --- a/examples/stanford.conf +++ b/examples/stanford.conf @@ -26,6 +26,7 @@ $DB_PASSWORD = ; close PASS; chomp $DB_PASSWORD; +$KEYTAB_KRBTYPE = 'MIT'; $KEYTAB_FILE = '/etc/wallet/keytab'; $KEYTAB_FLAGS = '-clearpolicy'; $KEYTAB_HOST = 'krb5-admin.stanford.edu'; -- cgit v1.2.3 From 2c4bd7c22d5c530e74421c2e353e0356920ccb9a Mon Sep 17 00:00:00 2001 From: Jon Robertson Date: Thu, 10 Dec 2009 14:40:59 -0800 Subject: Added support for Heimdal KDC Added support for Heimdal as an alternative to MIT Kerberos. This involved separating out the kadmin-specific code into its own set of modules, and changing the existing Wallet::Object::Keytab code to branch based on which module is loaded. --- .gitignore | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.gitignore b/.gitignore index d41b1a0..4599484 100644 --- a/.gitignore +++ b/.gitignore @@ -15,6 +15,7 @@ /perl/t/data/test.keytab /perl/t/data/test.principal /perl/t/data/test.realm +/perl/t/data/test.krbtype /tests/client/basic-t /tests/client/full-t /tests/client/pod-t @@ -24,6 +25,7 @@ /tests/data/test.keytab /tests/data/test.password /tests/data/test.principal +/tests/data/test.krbtype /tests/kasetkey/basic-t /tests/portable/asprintf-t /tests/portable/snprintf-t -- cgit v1.2.3 From 362ee72bcf4a1aea83c17c24ab7bd4f4936b479d Mon Sep 17 00:00:00 2001 From: Jon Robertson Date: Wed, 16 Dec 2009 20:19:16 -0800 Subject: Improvements for keytab existance checks and keytab creation * Fixed keytab existence check to avoid failures when called by a principal with permissions only on specific principals. * Better error cases for non-existant keytabs in several places. * Skipped limiting keytabs to certain enctypes when no enctypes are given. --- perl/Wallet/Kadmin/Heimdal.pm | 46 ++++++++++++++++++++++++++++--------------- 1 file changed, 30 insertions(+), 16 deletions(-) diff --git a/perl/Wallet/Kadmin/Heimdal.pm b/perl/Wallet/Kadmin/Heimdal.pm index 06564d2..a9c83a2 100644 --- a/perl/Wallet/Kadmin/Heimdal.pm +++ b/perl/Wallet/Kadmin/Heimdal.pm @@ -62,7 +62,7 @@ sub kadmin_client { ############################################################################## # Check whether a given principal already exists in Kerberos. Returns true if -# so, false otherwise. Throws an exception if kadmin fails. +# so, false otherwise. Throws an exception if an error. sub exists { my ($self, $principal) = @_; return unless $self->valid_principal ($principal); @@ -70,11 +70,15 @@ sub exists { $principal .= '@' . $Wallet::Config::KEYTAB_REALM; } my $kadmin = $self->{client}; - my @names = $kadmin->getPrincipals ($principal); - if (@names) { - return 1; + my $princdata = eval { $kadmin->getPrincipal ($principal) }; + + if ($@) { + die $@; + return 0; + } elsif ($princdata) { + return 1; } else { - return 0; + return 0; } } @@ -86,10 +90,13 @@ sub addprinc { unless ($self->valid_principal ($principal)) { die "invalid principal name $principal\n"; } - return 1 if $self->exists ($principal); + + my $exists = eval { $self->exists ($principal) }; if ($Wallet::Config::KEYTAB_REALM) { $principal .= '@' . $Wallet::Config::KEYTAB_REALM; } + die "error adding principal $principal: $@" if $@; + return 1 if $exists; # The way Heimdal::Kadm5 works, we create a principal object, create the # actual principal set inactive, then randomize it and activate it. @@ -131,21 +138,28 @@ sub ktadd { my $kadmin = $self->{client}; my $princdata = eval { $kadmin->getPrincipal ($principal) }; + if ($@) { + die "error creating keytab for $principal: $@"; + } elsif (!$princdata) { + die "error creating keytab for $principal: principal does not exist"; + } # Remove enctypes we don't want in this keytab. Must find all current # keytypes, then remove those that do not match. - my (%wanted); - my $alltypes = $princdata->getKeytypes (); - foreach (@enctypes) { $wanted{$_} = 1 } - foreach my $key (@{$alltypes}) { - my $keytype = ${$key}[0]; - next if exists $wanted{$keytype}; - eval { $princdata->delKeytypes ($keytype) }; - die "error removing keytype $keytype from the keytab: $@" if $@; + if (@enctypes) { + my (%wanted); + my $alltypes = $princdata->getKeytypes (); + foreach (@enctypes) { $wanted{$_} = 1 } + foreach my $key (@{$alltypes}) { + my $keytype = ${$key}[0]; + next if exists $wanted{$keytype}; + eval { $princdata->delKeytypes ($keytype) }; + die "error removing keytype $keytype from the keytab: $@" if $@; + } + eval { $kadmin->modifyPrincipal ($princdata) }; } - eval { $kadmin->modifyPrincipal ($princdata) }; - my $retval = eval { $kadmin->extractKeytab ($princdata, $file) }; + eval { $kadmin->extractKeytab ($princdata, $file) }; die "error creating keytab for principal: $@" if $@; return 1; -- cgit v1.2.3 From 236e209c3fefa0a56784ec3cd810a0bb5383b86d Mon Sep 17 00:00:00 2001 From: Jon Robertson Date: Wed, 16 Dec 2009 20:32:37 -0800 Subject: Provided path to call valid_principal directly valid_principal used to reside in Wallet::Object::Keytab, but was moved to the individual Wallet::Kadmin::* modules. This isn't necessary currently and may not ever be, but it's there just in case we do ever need to differentiate. To simplify testing, a way to still call it directly from Wallet::Object::Keytab has been added. --- perl/Wallet/Kadmin.pm | 28 ++++++++++++++++++++++++++-- perl/Wallet/Object/Keytab.pm | 14 +++++++++++++- 2 files changed, 39 insertions(+), 3 deletions(-) diff --git a/perl/Wallet/Kadmin.pm b/perl/Wallet/Kadmin.pm index b804861..33c84a1 100644 --- a/perl/Wallet/Kadmin.pm +++ b/perl/Wallet/Kadmin.pm @@ -20,12 +20,27 @@ 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.01'; +$VERSION = '0.02'; ############################################################################## -# Constructor +# Public methods ############################################################################## +# Validate a principal with a submodule's validator. We can also do this via +# creating an object with new and then running valid_principal from that, +# but there are times we might wish to run it without going through the +# object creation. +sub valid_principal { + my ($class, $principal) = @_; + if ($Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') { + require Wallet::Kadmin::MIT; + return Wallet::Kadmin::MIT->valid_principal ($principal); + } elsif ($Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal') { + require Wallet::Kadmin::Heimdal; + return Wallet::Kadmin::Heimdal->valid_principal ($principal); + } +} + # Create a new kadmin object, by finding the type requested in the wallet # config and passing off to the proper module. Returns the object directly # from the specific Wallet::Kadmin::* module. @@ -96,6 +111,15 @@ Finds the proper Kerberos implementation and calls the new() constructor for that implementation's module, returning the result. If the implementation is not recognized or set, die with an error message. +=item valid_principal(PRINCIPAL) + +Finds the proper Kerberos implementation and calls its own valid_principal +method, returning the result. This tells whether a principal is valid for +that implementation. This can be achieved by using new() and then directly +calling valid_principal on the returned object -- this method is a shortcut +in case we want to check validity without creating the object and worrying +about proper setup. + =head1 SEE ALSO kadmin(8), Wallet::Config(3), Wallet::Object::Keytab(3), wallet-backend(8) diff --git a/perl/Wallet/Object/Keytab.pm b/perl/Wallet/Object/Keytab.pm index 1732070..b1c9d6d 100644 --- a/perl/Wallet/Object/Keytab.pm +++ b/perl/Wallet/Object/Keytab.pm @@ -491,6 +491,13 @@ sub create { return $self; } +# Provides wrapper to individual Kadmin class's valid_principal. Here only +# to help expose for testing. +sub valid_principal { + my ($self, $principal) = @_; + return Wallet::Kadmin->valid_principal ($principal); +} + # Override destroy to delete the principal out of Kerberos as well. sub destroy { my ($self, $user, $host, $time) = @_; @@ -547,7 +554,12 @@ sub get { unlink $file; my @enctypes = $self->attr ('enctypes'); my $kadmin = $self->{kadmin}; - return if not $kadmin->ktadd ($self->{name}, $file, @enctypes); + my $retval = eval { $kadmin->ktadd ($self->{name}, $file, @enctypes) }; + if ($@) { + $self->error ($@); + return; + } + return unless $retval; local *KEYTAB; unless (open (KEYTAB, '<', $file)) { my $princ = $self->{name}; -- cgit v1.2.3 From e0f69c0b3f41684079762f843c37888d1017d576 Mon Sep 17 00:00:00 2001 From: Jon Robertson Date: Thu, 17 Dec 2009 11:26:28 -0800 Subject: Added keytab testing cases for Heimdal KDC Added cases to handle the Wallet::Object::Keytab module using a Heimdal KDC as well as an MIT KDC. In most cases this is transparent, but some tests are skipped for Heimdal, and the commands run to test that the created principals and keytabs are correct are different for Heimdal. The code now branches based on the value of $Wallet::Config::KEYTAB_KRBTYPE. --- perl/t/data/README | 1 + perl/t/keytab.t | 139 ++++++++++++++++++++++++++++++++++++----------------- 2 files changed, 95 insertions(+), 45 deletions(-) diff --git a/perl/t/data/README b/perl/t/data/README index 4abbaeb..d250d33 100644 --- a/perl/t/data/README +++ b/perl/t/data/README @@ -21,6 +21,7 @@ following files: test.keytab Keytab for an authorized user test.principal Principal of the authorized user test.realm Kerberos realm in which to do testing + test.krbtype Type of Kerberos server (Heimdal or MIT) This realm will also need to be configured in your local krb5.conf, including the admin_server for the realm. diff --git a/perl/t/keytab.t b/perl/t/keytab.t index 1803e53..8a11ad4 100755 --- a/perl/t/keytab.t +++ b/perl/t/keytab.t @@ -8,7 +8,7 @@ # See LICENSE for licensing terms. use POSIX qw(strftime); -use Test::More tests => 223; +use Test::More tests => 225; use Wallet::Admin; use Wallet::Config; @@ -56,10 +56,17 @@ sub system_quiet { # been set up. sub create { my ($principal) = @_; - my @args = ('-p', $Wallet::Config::KEYTAB_PRINCIPAL, '-k', - '-t', $Wallet::Config::KEYTAB_FILE, - '-r', $Wallet::Config::KEYTAB_REALM, - '-q', "addprinc -clearpolicy -randkey $principal"); + if ($Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') { + my @args = ('-p', $Wallet::Config::KEYTAB_PRINCIPAL, '-k', + '-t', $Wallet::Config::KEYTAB_FILE, + '-r', $Wallet::Config::KEYTAB_REALM, + '-q', "addprinc -clearpolicy -randkey $principal"); + } elsif ($Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal') { + @args = ('-p', $Wallet::Config::KEYTAB_PRINCIPAL, + '-K', $Wallet::Config::KEYTAB_FILE, + '-r', $Wallet::Config::KEYTAB_REALM, + 'add', $principal); + } system_quiet ($Wallet::Config::KEYTAB_KADMIN, @args); } @@ -67,20 +74,37 @@ sub create { # been set up. sub destroy { my ($principal) = @_; - my @args = ('-p', $Wallet::Config::KEYTAB_PRINCIPAL, '-k', - '-t', $Wallet::Config::KEYTAB_FILE, - '-r', $Wallet::Config::KEYTAB_REALM, - '-q', "delprinc -force $principal"); + my (@args); + if ($Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') { + @args = ('-p', $Wallet::Config::KEYTAB_PRINCIPAL, '-k', + '-t', $Wallet::Config::KEYTAB_FILE, + '-r', $Wallet::Config::KEYTAB_REALM, + '-q', "delprinc -force $principal"); + } elsif ($Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal') { + @args = ('-p', $Wallet::Config::KEYTAB_PRINCIPAL, + '-K', $Wallet::Config::KEYTAB_FILE, + '-r', $Wallet::Config::KEYTAB_REALM, + 'delete', $principal); + } system_quiet ($Wallet::Config::KEYTAB_KADMIN, @args); } -# Check whether a principal exists. +# Check whether a principal exists. kvno works for MIT, but isn't in the +# Heimdal dist. sub created { my ($principal) = @_; $principal .= '@' . $Wallet::Config::KEYTAB_REALM; - local $ENV{KRB5CCNAME} = 'krb5cc_temp'; - getcreds ('t/data/test.keytab', $Wallet::Config::KEYTAB_PRINCIPAL); - return (system_quiet ('kvno', $principal) == 0); + if ($Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') { + local $ENV{KRB5CCNAME} = 'krb5cc_temp'; + getcreds ('t/data/test.keytab', $Wallet::Config::KEYTAB_PRINCIPAL); + return (system_quiet ('kvno', $principal) == 0); + } elsif ($Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal') { + @args = ('-p', $Wallet::Config::KEYTAB_PRINCIPAL, + '-K', $Wallet::Config::KEYTAB_FILE, + '-r', $Wallet::Config::KEYTAB_REALM, + 'get', $principal); + return (system_quiet ($Wallet::Config::KEYTAB_KADMIN, @args) == 0); + } } # Given keytab data and the principal, write it to a file and try @@ -101,24 +125,41 @@ sub valid { # Given keytab data, write it to a file and try to determine the enctypes of # the keys present in that file. Returns the enctypes as a list, with UNKNOWN # for encryption types that weren't recognized. This is an ugly way of doing -# this. +# this for MIT. Heimdal is much more straightforward, but MIT ktutil doesn't +# have the needed abilities. sub enctypes { my ($keytab) = @_; open (KEYTAB, '>', 'keytab') or die "cannot create keytab: $!\n"; print KEYTAB $keytab; close KEYTAB; - open (KLIST, '-|', 'klist', '-ke', 'keytab') - or die "cannot run klist: $!\n"; + my @enctypes; - local $_; - while () { - next unless /^ *\d+ /; - my ($string) = /\((.*)\)\s*$/; - next unless $string; - $enctype = $enctype{lc $string} || 'UNKNOWN'; - push (@enctypes, $enctype); + if ($Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') { + open (KLIST, '-|', 'klist', '-ke', 'keytab') + or die "cannot run klist: $!\n"; + local $_; + while () { + next unless /^ *\d+ /; + my ($string) = /\((.*)\)\s*$/; + next unless $string; + $enctype = $enctype{lc $string} || 'UNKNOWN'; + push (@enctypes, $enctype); + } + close KLIST; + } elsif ($Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal') { + open (KTUTIL, '-|', 'ktutil', '-k', 'keytab', 'list') + or die "cannot run ktutil: $!\n"; + local $_; + while () { + next unless /^ *\d+ /; + my ($string) = /^\s*\d+\s+(\S+)/; + next unless $string; + #$enctype = $enctype{lc $string} || 'UNKNOWN'; + #push (@enctypes, $enctype); + push (@enctypes, $string); + } + close KTUTIL; } - close KLIST; unlink 'keytab'; return sort @enctypes; } @@ -173,6 +214,7 @@ SKIP: { $Wallet::Config::KEYTAB_FILE = 't/data/test.keytab'; $Wallet::Config::KEYTAB_PRINCIPAL = contents ('t/data/test.principal'); $Wallet::Config::KEYTAB_REALM = contents ('t/data/test.realm'); + $Wallet::Config::KEYTAB_KRBTYPE = contents ('t/data/test.krbtype'); $Wallet::Config::KEYTAB_TMP = '.'; my $realm = $Wallet::Config::KEYTAB_REALM; @@ -258,12 +300,17 @@ EOO is ($object->error, 'KEYTAB_TMP configuration variable not set', ' with the right error'); $Wallet::Config::KEYTAB_TMP = '.'; - $Wallet::Config::KEYTAB_KADMIN = '/some/nonexistent/file'; - $data = $object->get (@trace); - is ($data, undef, 'Cope with a failure to run kadmin'); - like ($object->error, qr{^cannot run /some/nonexistent/file: }, - ' with the right error'); - $Wallet::Config::KEYTAB_KADMIN = 'kadmin'; + SKIP: { + skip ' no kadmin program test for Heimdal', 2 + if $Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal'; + + $Wallet::Config::KEYTAB_KADMIN = '/some/nonexistent/file'; + $data = $object->get (@trace); + is ($data, undef, 'Cope with a failure to run kadmin'); + like ($object->error, qr{^cannot run /some/nonexistent/file: }, + ' with the right error'); + $Wallet::Config::KEYTAB_KADMIN = 'kadmin'; + } destroy ('wallet/one'); $data = $object->get (@trace); is ($data, undef, 'Getting a keytab for a nonexistent principal fails'); @@ -278,12 +325,19 @@ EOO }; ok (defined ($object), 'Creating good principal succeeds'); ok (created ('wallet/one'), ' and the principal was created'); - $Wallet::Config::KEYTAB_KADMIN = '/some/nonexistent/file'; - is ($object->destroy (@trace), undef, - ' and destroying it with bad kadmin fails'); - like ($object->error, qr{^cannot run /some/nonexistent/file: }, - ' with the right error'); - $Wallet::Config::KEYTAB_KADMIN = 'kadmin'; + + SKIP: { + skip ' no kadmin program test for Heimdal', 2 + if $Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal'; + + $Wallet::Config::KEYTAB_KADMIN = '/some/nonexistent/file'; + is ($object->destroy (@trace), undef, + ' and destroying it with bad kadmin fails'); + like ($object->error, qr{^cannot run /some/nonexistent/file: }, + ' with the right error'); + $Wallet::Config::KEYTAB_KADMIN = 'kadmin'; + } + is ($object->flag_set ('locked', @trace), 1, ' and setting locked works'); is ($object->destroy (@trace), undef, ' and destroying it fails'); is ($object->error, "cannot destroy keytab:wallet/one: object is locked", @@ -341,14 +395,6 @@ EOO is ($@, "keytab object implementation not configured\n", ' with the right error'); $Wallet::Config::KEYTAB_REALM = contents ('t/data/test.realm'); - $Wallet::Config::KEYTAB_KADMIN = '/some/nonexistent/file'; - $object = eval { - Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace) - }; - is ($object, undef, 'Cope with a failure to run kadmin'); - like ($@, qr{^cannot run /some/nonexistent/file: }, - ' with the right error'); - $Wallet::Config::KEYTAB_KADMIN = 'kadmin'; } # Tests for unchanging support. Skip these if we don't have a keytab or if we @@ -669,7 +715,8 @@ EOO # Tests for enctype restriction. SKIP: { - skip 'no keytab configuration', 36 unless -f 't/data/test.keytab'; + skip 'no keytab configuration', 36 unless (-f 't/data/test.keytab' + && $Wallet::Config::KEYTAB_KRBTYPE eq 'MIT'); # Set up our configuration. $Wallet::Config::KEYTAB_FILE = 't/data/test.keytab'; @@ -765,6 +812,7 @@ EOO ok (defined ($keytab), ' and retrieving the keytab still works'); @values = enctypes ($keytab); is ("@values", $enctypes[0], ' and it has the right enctype'); + ok (defined ($one), ' and recreating it succeeds'); is ($one->attr ('enctypes', [ $enctypes[1] ], @trace), 1, 'Setting a different single enctype works'); @values = $one->attr ('enctypes'); @@ -773,6 +821,7 @@ EOO ok (defined ($keytab), ' and retrieving the keytab still works'); @values = enctypes ($keytab); is ("@values", $enctypes[1], ' and it has the right enctype'); + ok (defined ($one), ' and recreating it succeeds'); is ($one->attr ('enctypes', [ @enctypes[0..1] ], @trace), 1, 'Setting two enctypes works'); @values = $one->attr ('enctypes'); -- cgit v1.2.3 From fc1dd4f5988c4ae932e26e92f0e7935e0fcaf2eb Mon Sep 17 00:00:00 2001 From: Jon Robertson Date: Thu, 17 Dec 2009 11:26:28 -0800 Subject: Added keytab testing cases for Heimdal KDC Added cases to handle the Wallet::Object::Keytab module using a Heimdal KDC as well as an MIT KDC. In most cases this is transparent, but some tests are skipped for Heimdal, and the commands run to test that the created principals and keytabs are correct are different for Heimdal. The code now branches based on the value of $Wallet::Config::KEYTAB_KRBTYPE. --- perl/t/keytab.t | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/perl/t/keytab.t b/perl/t/keytab.t index 8a11ad4..5c9ee68 100755 --- a/perl/t/keytab.t +++ b/perl/t/keytab.t @@ -8,7 +8,7 @@ # See LICENSE for licensing terms. use POSIX qw(strftime); -use Test::More tests => 225; +use Test::More tests => 221; use Wallet::Admin; use Wallet::Config; @@ -154,8 +154,6 @@ sub enctypes { next unless /^ *\d+ /; my ($string) = /^\s*\d+\s+(\S+)/; next unless $string; - #$enctype = $enctype{lc $string} || 'UNKNOWN'; - #push (@enctypes, $enctype); push (@enctypes, $string); } close KTUTIL; -- cgit v1.2.3 From 4ad367b4269811dd0b9abfa9c0e69a1a7490e4e9 Mon Sep 17 00:00:00 2001 From: Jon Robertson Date: Tue, 5 Jan 2010 14:42:29 -0800 Subject: Added randKeyPrincipal to the keytab creation process randKeyPrincipal was added to the keytab file creation process, in order to reset a principal to first have all possible enctypes. There is no way for us to specify that we only want a specific number of fresh enctypes, so we must reset to have all enctypes first, and then pare down from there each time we create the keytab. --- perl/Wallet/Kadmin/Heimdal.pm | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/perl/Wallet/Kadmin/Heimdal.pm b/perl/Wallet/Kadmin/Heimdal.pm index a9c83a2..e4d175b 100644 --- a/perl/Wallet/Kadmin/Heimdal.pm +++ b/perl/Wallet/Kadmin/Heimdal.pm @@ -136,7 +136,14 @@ sub ktadd { $principal .= '@' . $Wallet::Config::KEYTAB_REALM; } + # The way Heimdal works, you can only remove enctypes from a principal, + # not add them back in. So we need to run randkeyPrincipal first each + # time to restore all possible enctypes and then whittle them back down + # to those we have been asked for this time. my $kadmin = $self->{client}; + eval { $kadmin->randKeyPrincipal ($principal) }; + die "error creating keytab for $principal: could not reinit enctypes: $@" + if $@; my $princdata = eval { $kadmin->getPrincipal ($principal) }; if ($@) { die "error creating keytab for $principal: $@"; @@ -144,8 +151,7 @@ sub ktadd { die "error creating keytab for $principal: principal does not exist"; } - # Remove enctypes we don't want in this keytab. Must find all current - # keytypes, then remove those that do not match. + # Now actually remove any non-requested enctypes, if we requested any. if (@enctypes) { my (%wanted); my $alltypes = $princdata->getKeytypes (); -- cgit v1.2.3 From 17b515f76c5774e3bc45906d3e679edcfe2b529b Mon Sep 17 00:00:00 2001 From: Jon Robertson Date: Thu, 7 Jan 2010 08:02:26 -0800 Subject: Added ability to list only ACLs with no members Added new option to the 'wallet-admin list acls' command, 'empty', which will only return those ACLs which have no members. This will help maintenance in the long term by pointing out ACLs in error or no longer needed. --- perl/Wallet/Admin.pm | 21 +++++++++++++++++---- 1 file changed, 17 insertions(+), 4 deletions(-) diff --git a/perl/Wallet/Admin.pm b/perl/Wallet/Admin.pm index 91f1bfb..0e437ec 100644 --- a/perl/Wallet/Admin.pm +++ b/perl/Wallet/Admin.pm @@ -261,6 +261,15 @@ sub list_acls_all { return ($sql); } +# Returns the SQL statement required to find and returned all empty ACLs in +# the db. +sub list_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;'; + return ($sql); +} + # Returns the SQL statement and the field required to search the ACLs and # return only those entries which contain a entries with identifiers # matching a particular given string. @@ -289,10 +298,14 @@ sub list_acls { if (!defined $type || $type eq '') { ($sql) = $self->list_acls_all (); } else { - if (@args == 0) { - $self->error ("acl searches require an argument to search"); - } elsif ($type eq 'entry') { - ($sql, @search) = $self->list_acls_entry (@args); + if ($type eq 'entry') { + if (@args == 0) { + $self->error ("acl searches require an argument to search"); + } else { + ($sql, @search) = $self->list_acls_entry (@args); + } + } elsif ($type eq 'empty') { + ($sql) = $self->list_acls_empty (); } else { $self->error ("do not know search type: $type"); } -- cgit v1.2.3 From 99e39ac2639d99acdfd74acc05c25b5a95189860 Mon Sep 17 00:00:00 2001 From: Jon Robertson Date: Thu, 7 Jan 2010 09:33:50 -0800 Subject: Added ACL name to object history entries When listing an object history, ACLs were only shown as the ACL id. This changes that behavior to show the ACL name as well as ID. Where before it might say "set owner to 1", now it would say "set owner to ADMIN (1)". --- perl/Wallet/Object/Base.pm | 28 ++++++++++++++++++++++++++++ perl/t/server.t | 34 +++++++++++++++++----------------- 2 files changed, 45 insertions(+), 17 deletions(-) diff --git a/perl/Wallet/Object/Base.pm b/perl/Wallet/Object/Base.pm index 0f40028..f2568eb 100644 --- a/perl/Wallet/Object/Base.pm +++ b/perl/Wallet/Object/Base.pm @@ -445,6 +445,22 @@ sub flag_set { # History ############################################################################## +# Expand a given ACL id to add its name, for readability. Returns the +# original id alone if there was a problem finding the name. +sub format_acl_id { + my ($self, $id) = @_; + my $name = $id; + + my $sql = 'select ac_name from acls where ac_id = ?'; + my $sth = $self->{dbh}->prepare ($sql); + $sth->execute ($id); + if (my @ref = $sth->fetchrow_array) { + $name = $ref[0] . " ($id)"; + } + + return $name; +} + # Return the formatted history for a given object or undef on error. # Currently always returns the complete history, but eventually will need to # provide some way of showing only recent entries. @@ -476,6 +492,18 @@ sub history { } elsif (defined ($new)) { $output .= "add $new to attribute $attr"; } + } elsif ($data[0] eq 'set' + and ($data[1] eq 'owner' or $data[1] =~ /^acl_/)) { + my $field = $data[1]; + $old = $self->format_acl_id ($old) if defined ($old); + $new = $self->format_acl_id ($new) if defined ($new); + if (defined ($old) and defined ($new)) { + $output .= "set $field to $new (was $old)"; + } elsif (defined ($new)) { + $output .= "set $field to $new"; + } elsif (defined ($old)) { + $output .= "unset $field (was $old)"; + } } elsif ($data[0] eq 'set') { my $field = $data[1]; if (defined ($old) and defined ($new)) { diff --git a/perl/t/server.t b/perl/t/server.t index d4fd068..090387b 100755 --- a/perl/t/server.t +++ b/perl/t/server.t @@ -397,31 +397,31 @@ DATE set expires to $now by $admin from $host DATE unset expires (was $now) by $admin from $host -DATE set acl_get to 1 +DATE set acl_get to ADMIN (1) by $admin from $host -DATE unset acl_get (was 1) +DATE unset acl_get (was ADMIN (1)) by $admin from $host -DATE set acl_store to 1 +DATE set acl_store to ADMIN (1) by $admin from $host -DATE unset acl_store (was 1) +DATE unset acl_store (was ADMIN (1)) by $admin from $host -DATE set owner to 1 +DATE set owner to ADMIN (1) by $admin from $host -DATE set acl_get to 5 +DATE set acl_get to empty (5) by $admin from $host -DATE set acl_store to 5 +DATE set acl_store to empty (5) by $admin from $host -DATE unset acl_store (was 5) +DATE unset acl_store (was empty (5)) by $admin from $host -DATE unset owner (was 1) +DATE unset owner (was ADMIN (1)) by $admin from $host -DATE set owner to 1 +DATE set owner to ADMIN (1) by $admin from $host DATE set flag locked by $admin from $host DATE clear flag locked by $admin from $host -DATE unset owner (was 1) +DATE unset owner (was ADMIN (1)) by $admin from $host DATE set flag unchanging by $admin from $host @@ -527,7 +527,7 @@ is ($show, $expected, ' and show an object we own'); $history = <<"EOO"; DATE create by $admin from $host -DATE set owner to 2 +DATE set owner to user1 (2) by $admin from $host EOO $seen = $server->history ('base', 'service/user1'); @@ -608,13 +608,13 @@ is ($show, $expected, ' and show an object we jointly own'); $history = <<"EOO"; DATE create by $admin from $host -DATE set owner to 4 +DATE set owner to both (4) by $admin from $host -DATE set acl_show to 2 +DATE set acl_show to user1 (2) by $admin from $host -DATE set acl_destroy to 3 +DATE set acl_destroy to user2 (3) by $admin from $host -DATE set acl_flags to 2 +DATE set acl_flags to user1 (2) by $admin from $host DATE set flag unchanging by $user1 from $host @@ -679,7 +679,7 @@ is ($show, $expected, ' and show an object we own'); $history = <<"EOO"; DATE create by $admin from $host -DATE set owner to 3 +DATE set owner to user2 (3) by $admin from $host EOO $seen = $server->history ('base', 'service/user2'); -- cgit v1.2.3 From 56b95aca27c49538a3c306ac0fe5cf537c3441f0 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 15 Sep 2009 17:44:58 -0700 Subject: Add Tivoli encryption keys to the Stanford naming guide --- docs/stanford-naming | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/docs/stanford-naming b/docs/stanford-naming index 94537bb..f2a45a7 100644 --- a/docs/stanford-naming +++ b/docs/stanford-naming @@ -102,6 +102,14 @@ Object Naming The public certificate we manage external to wallet since it doesn't need to be protected or encrypted. + --tivoli-key + + The Tivoli backup encryption key for this server. This is stored + in the same file as the password used to connect to the Tivoli + server, so both are stored together. This file is found at + /etc/adsm/TSM.PWD. It must be base64-encoded before being stored + in the wallet. + --config- A configuration file named that contains some secure -- cgit v1.2.3 From b7aedd9b7290d51dc5e46c4b123cd5f0f080f9c7 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 19 Jan 2010 22:02:49 -0800 Subject: Update NEWS and TODO for recent changes --- NEWS | 10 ++++++++++ TODO | 18 ------------------ 2 files changed, 10 insertions(+), 18 deletions(-) diff --git a/NEWS b/NEWS index ab0828b..04942ea 100644 --- a/NEWS +++ b/NEWS @@ -8,10 +8,20 @@ wallet 0.10 (unreleased) Fix logging in wallet-backend and the remctl configuration to not log the data passed to store. + Add additional reports for wallet-admin list: objects owned by a + specific ACL, objects owned by no one, objects of a specific type, + objects with a specific flag, objects for which a specific ACL has + privileges, ACLs with an entry with a given type and identifier, and + ACLs with no members. + Add a new report owners command to wallet-admin and corresponding report_owners() method to Wallet::Admin, which returns all ACL lines on owner ACLs for matching objects. + Report ACL names as well as numbers in object history. + + Add support for Heimdal KDCs as well as MIT Kerberos KDCs. + wallet 0.9 (2008-04-24) The wallet command-line client now reads the data for store from a diff --git a/TODO b/TODO index 9f11867..beb123d 100644 --- a/TODO +++ b/TODO @@ -9,16 +9,6 @@ Release 1.0: * Provide a way to get history for deleted objects and ACLs. -* Display ACL names rather than index numbers when displaying history of - owner and acl_* settings. - -* Provide a way to list all objects by type, by owner (including null), or - by all uses of an ACL. - -* Provide an interface to list all empty ACLs. - -* Provide an interface to find all ACLs with a particular line. - * Provide an interface to mass-change all instances of one ACL to another. * Add a help function to wallet-backend listing the commands. @@ -36,9 +26,6 @@ Release 1.0: * Error messages from ACL operations should refer to the ACLs by name instead of by ID. -* History records should list both ACL ID and ACL name if the name is - still found in the database. - * Add the database schema version to a global table so that we can use it to support schema upgrades in the future. @@ -111,11 +98,6 @@ Future work: * Add a comment field for objects that can be set by the owner. -* The keytab backend currently only supports MIT Kerberos. Add support - for Heimdal. This should probably be done by writing a separate class - that handles the kadmin operations that can be subclassed and that - dynamically chooses its implementation based on run-time configuration. - * Use the Perl Authen::Krb5::Admin module instead of rolling our own kadmin code with Expect now that MIT Kerberos has made the kadmin API public. -- cgit v1.2.3 From d684049761db4eb88cd936c530196ea89a524c07 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 19 Jan 2010 22:48:01 -0800 Subject: Coding style fixes for Perl wallet code Strip trailing whitespace, convert tabs to spaces, add newlines to exceptions, and remove a few stray blank lines and a few other minor coding style oddities. Make the SQL style consistent. --- perl/Wallet/Admin.pm | 105 +++++++++++++++---------------- perl/Wallet/Kadmin.pm | 10 +-- perl/Wallet/Kadmin/Heimdal.pm | 102 ++++++++++++++---------------- perl/Wallet/Kadmin/MIT.pm | 32 +++++----- perl/Wallet/Object/Base.pm | 12 ++-- perl/Wallet/Object/Keytab.pm | 13 ++-- perl/t/admin.t | 4 +- perl/t/keytab.t | 140 ++++++++++++++++++++---------------------- 8 files changed, 198 insertions(+), 220 deletions(-) diff --git a/perl/Wallet/Admin.pm b/perl/Wallet/Admin.pm index 0e437ec..701c813 100644 --- a/perl/Wallet/Admin.pm +++ b/perl/Wallet/Admin.pm @@ -114,23 +114,22 @@ sub destroy { # Reporting ############################################################################## -# Given an ACL name, translate it to the ID for that ACL and return it. +# Given an ACL name, translate it to the ID for that ACL and return it. # Often this is unneeded and could be done with a join, but by doing it in a -# separate step, we can give an error for the specific case of someone +# separate step, we can give an error for the specific case of someone # searching for a non-existant ACL. sub acl_name_to_id { my ($self, $acl) = @_; my ($id); eval { - my $sql = 'select ac_id from acls where ac_name=?'; - my $sth = $self->{dbh}->prepare ($sql); - $sth->execute ($acl); - while (defined (my $row = $sth->fetchrow_hashref)) { - $id = $row->{'ac_id'}; - } - $self->{dbh}->commit; + my $sql = 'select ac_id from acls where ac_name = ?'; + my $sth = $self->{dbh}->prepare ($sql); + $sth->execute ($acl); + while (defined (my $row = $sth->fetchrow_hashref)) { + $id = $row->{ac_id}; + } + $self->{dbh}->commit; }; - if (!defined $id || $id !~ /^\d+$/) { $self->error ("could not find the acl $acl"); return ''; @@ -155,7 +154,7 @@ sub list_objects_type { return ($sql, $type); } -# Return the SQL statement and search field required to find all objects +# Return the SQL statement and search field required to find all objects # owned by a given ACL. If the requested owner is 'null', then we ignore # this and do a different search for IS NULL. If the requested owner does # not actually match any ACLs, set an error and return the empty string. @@ -163,15 +162,15 @@ sub list_objects_owner { my ($self, $owner) = @_; my ($sth); if ($owner =~ /^null$/i) { - my $sql = 'select ob_type, ob_name from objects where ob_owner is null + my $sql = 'select ob_type, ob_name from objects where ob_owner is null order by objects.ob_type, objects.ob_name'; - return ($sql); + return ($sql); } else { - my $id = $self->acl_name_to_id ($owner); - return '' unless $id; - my $sql = 'select ob_type, ob_name from objects where ob_owner=? + my $id = $self->acl_name_to_id ($owner); + return '' unless $id; + my $sql = 'select ob_type, ob_name from objects where ob_owner = ? order by objects.ob_type, objects.ob_name'; - return ($sql, $id); + return ($sql, $id); } } @@ -180,26 +179,24 @@ sub list_objects_owner { sub list_objects_flag { my ($self, $flag) = @_; my $sql = 'select ob_type, ob_name from objects left join flags on - (objects.ob_type=flags.fl_type AND objects.ob_name=flags.fl_name) - where flags.fl_flag=? order by objects.ob_type, objects.ob_name'; + (objects.ob_type = flags.fl_type and objects.ob_name = flags.fl_name) + where flags.fl_flag = ? order by objects.ob_type, objects.ob_name'; return ($sql, $flag); } -# Return the SQL statement and search field required to find all objects +# Return the SQL statement and search field required to find all objects # that a given ACL has any permissions on. This expands from # list_objects_owner in that it will also match any records that have the ACL # set for get, store, show, destroy, or flags. If the requested owner does # not actually match any ACLs, set an error and return the empty string. sub list_objects_acl { my ($self, $acl) = @_; - my $id = $self->acl_name_to_id ($acl); return '' unless $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=? - order by objects.ob_type, objects.ob_name'; + 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 = ? order by objects.ob_type, + objects.ob_name'; return ($sql, $id, $id, $id, $id, $id, $id); } @@ -217,29 +214,29 @@ sub list_objects { my $sql = ''; my @search = (); if (!defined $type || $type eq '') { - ($sql) = $self->list_objects_all (); + ($sql) = $self->list_objects_all (); } else { - if (@args != 1) { - $self->error ("object searches require an argument to search"); - } elsif ($type eq 'type') { - ($sql, @search) = $self->list_objects_type (@args); - } elsif ($type eq 'owner') { - ($sql, @search) = $self->list_objects_owner (@args); - } elsif ($type eq 'flag') { - ($sql, @search) = $self->list_objects_flag (@args); - } elsif ($type eq 'acl') { - ($sql, @search) = $self->list_objects_acl (@args); - } else { - $self->error ("do not know search type: $type"); - } - return unless $sql; + if (@args != 1) { + $self->error ("object searches require an argument to search"); + } elsif ($type eq 'type') { + ($sql, @search) = $self->list_objects_type (@args); + } elsif ($type eq 'owner') { + ($sql, @search) = $self->list_objects_owner (@args); + } elsif ($type eq 'flag') { + ($sql, @search) = $self->list_objects_flag (@args); + } elsif ($type eq 'acl') { + ($sql, @search) = $self->list_objects_acl (@args); + } else { + $self->error ("do not know search type: $type"); + } + return unless $sql; } my @objects; eval { my $object; - my $sth = $self->{dbh}->prepare ($sql); - $sth->execute (@search); + my $sth = $self->{dbh}->prepare ($sql); + $sth->execute (@search); while (defined ($object = $sth->fetchrow_arrayref)) { push (@objects, [ @$object ]); } @@ -265,19 +262,19 @@ sub list_acls_all { # the db. sub list_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;'; + 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'; return ($sql); } # Returns the SQL statement and the field required to search the ACLs and -# return only those entries which contain a entries with identifiers +# return only those entries which contain a entries with identifiers # matching a particular given string. sub list_acls_entry { my ($self, $type, $identifier) = @_; - my $sql = 'select distinct ac_id, ac_name from acl_entries - left join acls on (ae_id=ac_id) where ae_scheme=? and - ae_identifier like ? order by ac_id'; + my $sql = 'select distinct ac_id, ac_name from acl_entries left join acls + on (ae_id = ac_id) where ae_scheme = ? and ae_identifier like ? order + by ac_id'; $identifier = '%'.$identifier.'%'; return ($sql, $type, $identifier); } @@ -299,11 +296,11 @@ sub list_acls { ($sql) = $self->list_acls_all (); } else { if ($type eq 'entry') { - if (@args == 0) { - $self->error ("acl searches require an argument to search"); - } else { - ($sql, @search) = $self->list_acls_entry (@args); - } + if (@args == 0) { + $self->error ("acl searches require an argument to search"); + } else { + ($sql, @search) = $self->list_acls_entry (@args); + } } elsif ($type eq 'empty') { ($sql) = $self->list_acls_empty (); } else { diff --git a/perl/Wallet/Kadmin.pm b/perl/Wallet/Kadmin.pm index 33c84a1..200136c 100644 --- a/perl/Wallet/Kadmin.pm +++ b/perl/Wallet/Kadmin.pm @@ -27,8 +27,8 @@ $VERSION = '0.02'; ############################################################################## # Validate a principal with a submodule's validator. We can also do this via -# creating an object with new and then running valid_principal from that, -# but there are times we might wish to run it without going through the +# creating an object with new and then running valid_principal from that, +# but there are times we might wish to run it without going through the # object creation. sub valid_principal { my ($class, $principal) = @_; @@ -48,10 +48,10 @@ sub new { my ($class) = @_; my ($kadmin); if ($Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') { - require Wallet::Kadmin::MIT; + require Wallet::Kadmin::MIT; $kadmin = Wallet::Kadmin::MIT->new (); } elsif ($Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal') { - require Wallet::Kadmin::Heimdal; + require Wallet::Kadmin::Heimdal; $kadmin = Wallet::Kadmin::Heimdal->new (); } else { die "keytab krb server type not set to a valid value\n"; @@ -82,7 +82,7 @@ Wallet::Kadmin - Kadmin module wrapper for wallet keytabs =head1 DESCRIPTION Wallet::Kadmin is a wrapper to modules that provide an interface for keytab -integration with the wallet. Each module is meant to interface with a +integration with the wallet. Each module is meant to interface with a specific type of Kerberos implementation, such as MIT Kerberos or Heimdal Kerberos, and provide a standndard set of API calls used to interact with that implementation's kadmind. diff --git a/perl/Wallet/Kadmin/Heimdal.pm b/perl/Wallet/Kadmin/Heimdal.pm index e4d175b..a8859bf 100644 --- a/perl/Wallet/Kadmin/Heimdal.pm +++ b/perl/Wallet/Kadmin/Heimdal.pm @@ -15,8 +15,7 @@ require 5.006; use strict; use vars qw($VERSION); -use Heimdal::Kadm5 qw (KRB5_KDB_DISALLOW_ALL_TIX); - +use Heimdal::Kadm5 qw(KRB5_KDB_DISALLOW_ALL_TIX); use Wallet::Config (); # This version should be increased on any code change to this module. Always @@ -37,7 +36,7 @@ sub valid_principal { return scalar ($principal =~ m,^[\w-]+(/[\w_.-]+)?\z,); } -# Create a Heimdal::Kadm5 client object and return it. It should load +# Create a Heimdal::Kadm5 client object and return it. It should load # configuration from Wallet::Config. sub kadmin_client { unless (defined ($Wallet::Config::KEYTAB_PRINCIPAL) @@ -45,15 +44,13 @@ sub kadmin_client { and defined ($Wallet::Config::KEYTAB_REALM)) { die "keytab object implementation not configured\n"; } - my $server = $Wallet::Config::KEYTAB_HOST || 'localhost'; - my $client = Heimdal::Kadm5::Client->new( - RaiseErrors => 1, - Server => $server, - Principal => $Wallet::Config::KEYTAB_PRINCIPAL, - Realm => $Wallet::Config::KEYTAB_REALM, - Keytab => $Wallet::Config::KEYTAB_FILE, - ); + my @options = (RaiseErrors => 1, + Server => $server, + Principal => $Wallet::Config::KEYTAB_PRINCIPAL, + Realm => $Wallet::Config::KEYTAB_REALM, + Keytab => $Wallet::Config::KEYTAB_FILE); + my $client = Heimdal::Kadm5::Client->new (@options); return $client; } @@ -70,16 +67,8 @@ sub exists { $principal .= '@' . $Wallet::Config::KEYTAB_REALM; } my $kadmin = $self->{client}; - my $princdata = eval { $kadmin->getPrincipal ($principal) }; - - if ($@) { - die $@; - return 0; - } elsif ($princdata) { - return 1; - } else { - return 0; - } + my $princdata = $kadmin->getPrincipal ($principal); + return $princdata ? 1 : 0; } # Create a principal in Kerberos. Since this is only called by create, it @@ -95,7 +84,7 @@ sub addprinc { if ($Wallet::Config::KEYTAB_REALM) { $principal .= '@' . $Wallet::Config::KEYTAB_REALM; } - die "error adding principal $principal: $@" if $@; + die "error adding principal $principal: $@\n" if $@; return 1 if $exists; # The way Heimdal::Kadm5 works, we create a principal object, create the @@ -106,20 +95,19 @@ sub addprinc { my $kadmin = $self->{client}; my $princdata = $kadmin->makePrincipal ($principal); - # Disable the principal before creating, until we've randomized the + # Disable the principal before creating, until we've randomized the # password. my $attrs = $princdata->getAttributes; $attrs |= KRB5_KDB_DISALLOW_ALL_TIX; $princdata->setAttributes ($attrs); my $password = 'inactive'; - my $retval = eval { $kadmin->createPrincipal ($princdata, $password, 0) }; - die "error adding principal $principal: $@" if $@; - $retval = eval { $kadmin->randKeyPrincipal ($principal) }; - die "error adding principal $principal: $@" if $@; - $retval = eval { $kadmin->enablePrincipal ($principal) }; + eval { + $kadmin->createPrincipal ($princdata, $password, 0); + $kadmin->randKeyPrincipal ($principal); + $kadmin->enablePrincipal ($principal); + }; die "error adding principal $principal: $@" if $@; - return 1; } @@ -130,7 +118,7 @@ sub addprinc { sub ktadd { my ($self, $principal, $file, @enctypes) = @_; unless ($self->valid_principal ($principal)) { - die ("invalid principal name: $principal"); + die "invalid principal name: $principal\n"; } if ($Wallet::Config::KEYTAB_REALM) { $principal .= '@' . $Wallet::Config::KEYTAB_REALM; @@ -138,35 +126,35 @@ sub ktadd { # The way Heimdal works, you can only remove enctypes from a principal, # not add them back in. So we need to run randkeyPrincipal first each - # time to restore all possible enctypes and then whittle them back down + # time to restore all possible enctypes and then whittle them back down # to those we have been asked for this time. my $kadmin = $self->{client}; eval { $kadmin->randKeyPrincipal ($principal) }; - die "error creating keytab for $principal: could not reinit enctypes: $@" + die "error creating keytab for $principal: could not reinit enctypes: $@\n" if $@; my $princdata = eval { $kadmin->getPrincipal ($principal) }; if ($@) { - die "error creating keytab for $principal: $@"; + die "error creating keytab for $principal: $@\n"; } elsif (!$princdata) { - die "error creating keytab for $principal: principal does not exist"; + die "error creating keytab for $principal: principal does not exist\n"; } # Now actually remove any non-requested enctypes, if we requested any. if (@enctypes) { - my (%wanted); - my $alltypes = $princdata->getKeytypes (); - foreach (@enctypes) { $wanted{$_} = 1 } - foreach my $key (@{$alltypes}) { - my $keytype = ${$key}[0]; - next if exists $wanted{$keytype}; - eval { $princdata->delKeytypes ($keytype) }; - die "error removing keytype $keytype from the keytab: $@" if $@; - } - eval { $kadmin->modifyPrincipal ($princdata) }; + my (%wanted); + my $alltypes = $princdata->getKeytypes (); + foreach (@enctypes) { $wanted{$_} = 1 } + foreach my $key (@{$alltypes}) { + my $keytype = ${$key}[0]; + next if exists $wanted{$keytype}; + eval { $princdata->delKeytypes ($keytype) }; + die "error removing keytype $keytype from the keytab: $@\n" if $@; + } + eval { $kadmin->modifyPrincipal ($princdata) }; } eval { $kadmin->extractKeytab ($princdata, $file) }; - die "error creating keytab for principal: $@" if $@; + die "error creating keytab for principal: $@\n" if $@; return 1; } @@ -177,7 +165,7 @@ sub ktadd { sub delprinc { my ($self, $principal) = @_; unless ($self->valid_principal ($principal)) { - die ("invalid principal name: $principal"); + die "invalid principal name: $principal\n"; } my $exists = eval { $self->exists ($principal) }; die $@ if $@; @@ -190,7 +178,7 @@ sub delprinc { my $kadmin = $self->{client}; my $retval = eval { $kadmin->deletePrincipal ($principal) }; - die "error deleting $principal: $@" if $@; + die "error deleting $principal: $@\n" if $@; return 1; } @@ -199,12 +187,12 @@ sub delprinc { ############################################################################## # Create a new MIT kadmin object. Very empty for the moment, but later it -# will probably fill out if we go to using a module rather than calling +# will probably fill out if we go to using a module rather than calling # kadmin directly. sub new { my ($class) = @_; my $self = { - client => kadmin_client (), + client => kadmin_client (), }; bless ($self, $class); return $self; @@ -235,7 +223,7 @@ Wallet::Kadmin::MIT is an interface for keytab integration with the wallet, specifically for using kadmin to create, delete, and add enctypes to keytabs. It implments the wallet kadmin API and provides the necessary glue to MIT Kerberos installs for each of these functions, while allowing the wallet -to keep the details of what type of Kerberos installation is being used +to keep the details of what type of Kerberos installation is being used abstracted. A keytab is an on-disk store for the key or keys for a Kerberos principal. @@ -254,15 +242,15 @@ information about how to set wallet configuration. =item addprinc(PRINCIPAL) -Adds a new principal with a given name. The principal is created with a -random password, and any other flags set by Wallet::Config. Returns true on +Adds a new principal with a given name. The principal is created with a +random password, and any other flags set by Wallet::Config. Returns true on success, or throws an error if there was a failure in adding the principal. -If the principal already exists, return true as we are bringing our +If the principal already exists, return true as we are bringing our expectations in line with reality. =item addprinc(PRINCIPAL) -Removes a principal with the given name. Returns true on success, or throws +Removes a principal with the given name. Returns true on success, or throws an error if there was a failure in removing the principal. If the principal does not exist, return true as we are bringing our expectations in line with reality. @@ -270,8 +258,8 @@ 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 or C). An error is +the enctypes supplied. The enctype values must be enctype strings recognized +by Kerberos (strings like C or C). An error is thrown on failure or if the creation fails, otherwise true is returned. =back @@ -279,7 +267,7 @@ thrown on failure or if the creation fails, otherwise true is returned. =head1 LIMITATIONS Currently, this implementation calls an external B program rather - than using a native Perl module and therefore requires B be + than using a native Perl module and therefore requires B be installed and parses its output. It may miss some error conditions if the output of B ever changes. diff --git a/perl/Wallet/Kadmin/MIT.pm b/perl/Wallet/Kadmin/MIT.pm index b7d4913..7bbb248 100644 --- a/perl/Wallet/Kadmin/MIT.pm +++ b/perl/Wallet/Kadmin/MIT.pm @@ -130,7 +130,7 @@ sub addprinc { sub ktadd { my ($self, $principal, $file, @enctypes) = @_; unless ($self->valid_principal ($principal)) { - die ("invalid principal name: $principal"); + die "invalid principal name: $principal\n"; } if ($Wallet::Config::KEYTAB_REALM) { $principal .= '@' . $Wallet::Config::KEYTAB_REALM; @@ -143,7 +143,7 @@ sub ktadd { my $output = eval { $self->kadmin ("$command $principal") }; die ($@) if ($@); if ($output =~ /^(?:kadmin|ktadd): (.*)/m) { - die ("error creating keytab for $principal: $1"); + die "error creating keytab for $principal: $1\n"; } return 1; } @@ -154,7 +154,7 @@ sub ktadd { sub delprinc { my ($self, $principal) = @_; unless ($self->valid_principal ($principal)) { - die ("invalid principal name: $principal"); + die "invalid principal name: $principal\n"; } my $exists = eval { $self->exists ($principal) }; die $@ if $@; @@ -167,7 +167,7 @@ sub delprinc { my $output = eval { $self->kadmin ("delprinc -force $principal") }; die $@ if $@; if ($output =~ /^delete_principal: (.*)/m) { - die ("error deleting $principal: $1"); + die "error deleting $principal: $1\n"; } return 1; } @@ -177,12 +177,11 @@ sub delprinc { ############################################################################## # Create a new MIT kadmin object. Very empty for the moment, but later it -# will probably fill out if we go to using a module rather than calling +# will probably fill out if we go to using a module rather than calling # kadmin directly. sub new { my ($class) = @_; - my $self = { - }; + my $self = {}; bless ($self, $class); return $self; } @@ -212,7 +211,7 @@ Wallet::Kadmin::MIT is an interface for keytab integration with the wallet, specifically for using kadmin to create, delete, and add enctypes to keytabs. It implments the wallet kadmin API and provides the necessary glue to MIT Kerberos installs for each of these functions, while allowing the wallet -to keep the details of what type of Kerberos installation is being used +to keep the details of what type of Kerberos installation is being used abstracted. A keytab is an on-disk store for the key or keys for a Kerberos principal. @@ -231,15 +230,15 @@ information about how to set wallet configuration. =item addprinc(PRINCIPAL) -Adds a new principal with a given name. The principal is created with a -random password, and any other flags set by Wallet::Config. Returns true on +Adds a new principal with a given name. The principal is created with a +random password, and any other flags set by Wallet::Config. Returns true on success, or throws an error if there was a failure in adding the principal. -If the principal already exists, return true as we are bringing our +If the principal already exists, return true as we are bringing our expectations in line with reality. =item addprinc(PRINCIPAL) -Removes a principal with the given name. Returns true on success, or throws +Removes a principal with the given name. Returns true on success, or throws an error if there was a failure in removing the principal. If the principal does not exist, return true as we are bringing our expectations in line with reality. @@ -247,8 +246,8 @@ 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 or C). An error is +the enctypes supplied. The enctype values must be enctype strings recognized +by Kerberos (strings like C or C). An error is thrown on failure or if the creation fails, otherwise true is returned. =back @@ -256,7 +255,7 @@ thrown on failure or if the creation fails, otherwise true is returned. =head1 LIMITATIONS Currently, this implementation calls an external B program rather - than using a native Perl module and therefore requires B be +than using a native Perl module and therefore requires B be installed and parses its output. It may miss some error conditions if the output of B ever changes. @@ -269,7 +268,6 @@ from L. =head1 AUTHORS -Russ Allbery -Jon Robertson +Russ Allbery and Jon Robertson . =cut diff --git a/perl/Wallet/Object/Base.pm b/perl/Wallet/Object/Base.pm index f2568eb..fea0320 100644 --- a/perl/Wallet/Object/Base.pm +++ b/perl/Wallet/Object/Base.pm @@ -445,7 +445,7 @@ sub flag_set { # History ############################################################################## -# Expand a given ACL id to add its name, for readability. Returns the +# Expand a given ACL id to add its name, for readability. Returns the # original id alone if there was a problem finding the name. sub format_acl_id { my ($self, $id) = @_; @@ -455,7 +455,7 @@ sub format_acl_id { my $sth = $self->{dbh}->prepare ($sql); $sth->execute ($id); if (my @ref = $sth->fetchrow_array) { - $name = $ref[0] . " ($id)"; + $name = $ref[0] . " ($id)"; } return $name; @@ -492,11 +492,11 @@ sub history { } elsif (defined ($new)) { $output .= "add $new to attribute $attr"; } - } elsif ($data[0] eq 'set' - and ($data[1] eq 'owner' or $data[1] =~ /^acl_/)) { + } elsif ($data[0] eq 'set' + and ($data[1] eq 'owner' or $data[1] =~ /^acl_/)) { my $field = $data[1]; - $old = $self->format_acl_id ($old) if defined ($old); - $new = $self->format_acl_id ($new) if defined ($new); + $old = $self->format_acl_id ($old) if defined ($old); + $new = $self->format_acl_id ($new) if defined ($new); if (defined ($old) and defined ($new)) { $output .= "set $field to $new (was $old)"; } elsif (defined ($new)) { diff --git a/perl/Wallet/Object/Keytab.pm b/perl/Wallet/Object/Keytab.pm index b1c9d6d..a361599 100644 --- a/perl/Wallet/Object/Keytab.pm +++ b/perl/Wallet/Object/Keytab.pm @@ -1,7 +1,7 @@ # Wallet::Object::Keytab -- Keytab object implementation for the wallet. # # Written by Russ Allbery -# Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2008, 2009 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -477,15 +477,14 @@ sub new { # caller. sub create { my ($class, $type, $name, $dbh, $creator, $host, $time) = @_; - my $self = { - dbh => $dbh, - kadmin => undef, + my $self = { + dbh => $dbh, + kadmin => undef, }; bless $self, $class; my $kadmin = Wallet::Kadmin->new (); $self->{kadmin} = $kadmin; $kadmin->addprinc ($name); - $self = $class->SUPER::create ($type, $name, $dbh, $creator, $host, $time); $self->{kadmin} = $kadmin; return $self; @@ -556,8 +555,8 @@ sub get { my $kadmin = $self->{kadmin}; my $retval = eval { $kadmin->ktadd ($self->{name}, $file, @enctypes) }; if ($@) { - $self->error ($@); - return; + $self->error ($@); + return; } return unless $retval; local *KEYTAB; diff --git a/perl/t/admin.t b/perl/t/admin.t index 77c786d..e963857 100755 --- a/perl/t/admin.t +++ b/perl/t/admin.t @@ -120,7 +120,7 @@ is ($lines[2][1], 'admin@EXAMPLE.COM', ' and the right identifier'); # owned by ADMIN or with any permissions from it. is ($server->create ('base', 'service/null'), 1, 'Creating base:service/null succeeds'); -is ($server->acl ('base', 'service/foo', 'get', 'ADMIN'), 1, +is ($server->acl ('base', 'service/foo', 'get', 'ADMIN'), 1, 'Changing the get ACL for the search also does'); @lines = $admin->list_objects ('owner', 'ADMIN'); is (scalar (@lines), 1, 'Searching for objects owned by ADMIN finds one'); @@ -150,7 +150,7 @@ is ($lines[2][1], 'service/null', ' and the right name'); is (scalar (@lines), 0, 'Searching for all objects of type keytab finds none'); # Test setting a flag, searching for objects with it, and then clearing it. -is ($server->flag_set ('base', 'service/admin', 'unchanging'), 1, +is ($server->flag_set ('base', 'service/admin', 'unchanging'), 1, 'Setting a flag works'); @lines = $admin->list_objects ('flag', 'unchanging'); is (scalar (@lines), 1, 'Searching for all objects with that flag finds one'); diff --git a/perl/t/keytab.t b/perl/t/keytab.t index 5c9ee68..3cd77d8 100755 --- a/perl/t/keytab.t +++ b/perl/t/keytab.t @@ -8,7 +8,7 @@ # See LICENSE for licensing terms. use POSIX qw(strftime); -use Test::More tests => 221; +use Test::More tests => 219; use Wallet::Admin; use Wallet::Config; @@ -57,15 +57,15 @@ sub system_quiet { sub create { my ($principal) = @_; if ($Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') { - my @args = ('-p', $Wallet::Config::KEYTAB_PRINCIPAL, '-k', - '-t', $Wallet::Config::KEYTAB_FILE, - '-r', $Wallet::Config::KEYTAB_REALM, - '-q', "addprinc -clearpolicy -randkey $principal"); + my @args = ('-p', $Wallet::Config::KEYTAB_PRINCIPAL, '-k', + '-t', $Wallet::Config::KEYTAB_FILE, + '-r', $Wallet::Config::KEYTAB_REALM, + '-q', "addprinc -clearpolicy -randkey $principal"); } elsif ($Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal') { - @args = ('-p', $Wallet::Config::KEYTAB_PRINCIPAL, - '-K', $Wallet::Config::KEYTAB_FILE, - '-r', $Wallet::Config::KEYTAB_REALM, - 'add', $principal); + @args = ('-p', $Wallet::Config::KEYTAB_PRINCIPAL, + '-K', $Wallet::Config::KEYTAB_FILE, + '-r', $Wallet::Config::KEYTAB_REALM, + 'add', $principal); } system_quiet ($Wallet::Config::KEYTAB_KADMIN, @args); } @@ -76,15 +76,15 @@ sub destroy { my ($principal) = @_; my (@args); if ($Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') { - @args = ('-p', $Wallet::Config::KEYTAB_PRINCIPAL, '-k', - '-t', $Wallet::Config::KEYTAB_FILE, - '-r', $Wallet::Config::KEYTAB_REALM, - '-q', "delprinc -force $principal"); + @args = ('-p', $Wallet::Config::KEYTAB_PRINCIPAL, '-k', + '-t', $Wallet::Config::KEYTAB_FILE, + '-r', $Wallet::Config::KEYTAB_REALM, + '-q', "delprinc -force $principal"); } elsif ($Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal') { - @args = ('-p', $Wallet::Config::KEYTAB_PRINCIPAL, - '-K', $Wallet::Config::KEYTAB_FILE, - '-r', $Wallet::Config::KEYTAB_REALM, - 'delete', $principal); + @args = ('-p', $Wallet::Config::KEYTAB_PRINCIPAL, + '-K', $Wallet::Config::KEYTAB_FILE, + '-r', $Wallet::Config::KEYTAB_REALM, + 'delete', $principal); } system_quiet ($Wallet::Config::KEYTAB_KADMIN, @args); } @@ -95,15 +95,15 @@ sub created { my ($principal) = @_; $principal .= '@' . $Wallet::Config::KEYTAB_REALM; if ($Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') { - local $ENV{KRB5CCNAME} = 'krb5cc_temp'; - getcreds ('t/data/test.keytab', $Wallet::Config::KEYTAB_PRINCIPAL); - return (system_quiet ('kvno', $principal) == 0); + local $ENV{KRB5CCNAME} = 'krb5cc_temp'; + getcreds ('t/data/test.keytab', $Wallet::Config::KEYTAB_PRINCIPAL); + return (system_quiet ('kvno', $principal) == 0); } elsif ($Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal') { - @args = ('-p', $Wallet::Config::KEYTAB_PRINCIPAL, - '-K', $Wallet::Config::KEYTAB_FILE, - '-r', $Wallet::Config::KEYTAB_REALM, - 'get', $principal); - return (system_quiet ($Wallet::Config::KEYTAB_KADMIN, @args) == 0); + @args = ('-p', $Wallet::Config::KEYTAB_PRINCIPAL, + '-K', $Wallet::Config::KEYTAB_FILE, + '-r', $Wallet::Config::KEYTAB_REALM, + 'get', $principal); + return (system_quiet ($Wallet::Config::KEYTAB_KADMIN, @args) == 0); } } @@ -135,28 +135,28 @@ sub enctypes { my @enctypes; if ($Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') { - open (KLIST, '-|', 'klist', '-ke', 'keytab') - or die "cannot run klist: $!\n"; - local $_; - while () { - next unless /^ *\d+ /; - my ($string) = /\((.*)\)\s*$/; - next unless $string; - $enctype = $enctype{lc $string} || 'UNKNOWN'; - push (@enctypes, $enctype); - } - close KLIST; + open (KLIST, '-|', 'klist', '-ke', 'keytab') + or die "cannot run klist: $!\n"; + local $_; + while () { + next unless /^ *\d+ /; + my ($string) = /\((.*)\)\s*$/; + next unless $string; + $enctype = $enctype{lc $string} || 'UNKNOWN'; + push (@enctypes, $enctype); + } + close KLIST; } elsif ($Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal') { - open (KTUTIL, '-|', 'ktutil', '-k', 'keytab', 'list') - or die "cannot run ktutil: $!\n"; - local $_; - while () { - next unless /^ *\d+ /; - my ($string) = /^\s*\d+\s+(\S+)/; - next unless $string; - push (@enctypes, $string); - } - close KTUTIL; + open (KTUTIL, '-|', 'ktutil', '-k', 'keytab', 'list') + or die "cannot run ktutil: $!\n"; + local $_; + while () { + next unless /^ *\d+ /; + my ($string) = /^\s*\d+\s+(\S+)/; + next unless $string; + push (@enctypes, $string); + } + close KTUTIL; } unlink 'keytab'; return sort @enctypes; @@ -298,16 +298,15 @@ EOO is ($object->error, 'KEYTAB_TMP configuration variable not set', ' with the right error'); $Wallet::Config::KEYTAB_TMP = '.'; - SKIP: { - skip ' no kadmin program test for Heimdal', 2 - if $Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal'; - - $Wallet::Config::KEYTAB_KADMIN = '/some/nonexistent/file'; - $data = $object->get (@trace); - is ($data, undef, 'Cope with a failure to run kadmin'); - like ($object->error, qr{^cannot run /some/nonexistent/file: }, - ' with the right error'); - $Wallet::Config::KEYTAB_KADMIN = 'kadmin'; + SKIP: { + skip 'no kadmin program test for Heimdal', 2 + if $Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal'; + $Wallet::Config::KEYTAB_KADMIN = '/some/nonexistent/file'; + $data = $object->get (@trace); + is ($data, undef, 'Cope with a failure to run kadmin'); + like ($object->error, qr{^cannot run /some/nonexistent/file: }, + ' with the right error'); + $Wallet::Config::KEYTAB_KADMIN = 'kadmin'; } destroy ('wallet/one'); $data = $object->get (@trace); @@ -323,19 +322,16 @@ EOO }; ok (defined ($object), 'Creating good principal succeeds'); ok (created ('wallet/one'), ' and the principal was created'); - - SKIP: { - skip ' no kadmin program test for Heimdal', 2 - if $Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal'; - - $Wallet::Config::KEYTAB_KADMIN = '/some/nonexistent/file'; - is ($object->destroy (@trace), undef, - ' and destroying it with bad kadmin fails'); - like ($object->error, qr{^cannot run /some/nonexistent/file: }, - ' with the right error'); - $Wallet::Config::KEYTAB_KADMIN = 'kadmin'; + SKIP: { + skip 'no kadmin program test for Heimdal', 2 + if $Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal'; + $Wallet::Config::KEYTAB_KADMIN = '/some/nonexistent/file'; + is ($object->destroy (@trace), undef, + ' and destroying it with bad kadmin fails'); + like ($object->error, qr{^cannot run /some/nonexistent/file: }, + ' with the right error'); + $Wallet::Config::KEYTAB_KADMIN = 'kadmin'; } - is ($object->flag_set ('locked', @trace), 1, ' and setting locked works'); is ($object->destroy (@trace), undef, ' and destroying it fails'); is ($object->error, "cannot destroy keytab:wallet/one: object is locked", @@ -713,8 +709,10 @@ EOO # Tests for enctype restriction. SKIP: { - skip 'no keytab configuration', 36 unless (-f 't/data/test.keytab' - && $Wallet::Config::KEYTAB_KRBTYPE eq 'MIT'); + unless (-f 't/data/test.keytab' + && $Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') { + skip 'no keytab configuration', 36; + } # Set up our configuration. $Wallet::Config::KEYTAB_FILE = 't/data/test.keytab'; @@ -810,7 +808,6 @@ EOO ok (defined ($keytab), ' and retrieving the keytab still works'); @values = enctypes ($keytab); is ("@values", $enctypes[0], ' and it has the right enctype'); - ok (defined ($one), ' and recreating it succeeds'); is ($one->attr ('enctypes', [ $enctypes[1] ], @trace), 1, 'Setting a different single enctype works'); @values = $one->attr ('enctypes'); @@ -819,7 +816,6 @@ EOO ok (defined ($keytab), ' and retrieving the keytab still works'); @values = enctypes ($keytab); is ("@values", $enctypes[1], ' and it has the right enctype'); - ok (defined ($one), ' and recreating it succeeds'); is ($one->attr ('enctypes', [ @enctypes[0..1] ], @trace), 1, 'Setting two enctypes works'); @values = $one->attr ('enctypes'); -- cgit v1.2.3 From 865a91bebe112076965b823e32a853d9b0b20181 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 19 Jan 2010 22:48:48 -0800 Subject: Adjust server/admin test for the new list arguments --- tests/server/admin-t.in | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/server/admin-t.in b/tests/server/admin-t.in index 3e84022..11d2883 100644 --- a/tests/server/admin-t.in +++ b/tests/server/admin-t.in @@ -107,7 +107,7 @@ is ($out, "new\n", ' and nothing ran'); # Check too few and too many arguments for every command. my %commands = (destroy => [0, 0], initialize => [1, 1], - list => [1, 1], + list => [1, 4], register => [3, 3], report => [1, -1]); for my $command (sort keys %commands) { -- cgit v1.2.3 From aca12f7b67b987c4392d85b4aa9d2dc1861b7556 Mon Sep 17 00:00:00 2001 From: Jon Robertson Date: Thu, 21 Jan 2010 19:06:54 -0800 Subject: Replaced perl/t/admin.t tests removed earlier Several tests were removed in an earlier edit that should not have been. As far as I can tell, they were removed completely by accident. These missing tests were causing the test suite to fail. --- perl/t/admin.t | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/perl/t/admin.t b/perl/t/admin.t index e963857..f94b39b 100755 --- a/perl/t/admin.t +++ b/perl/t/admin.t @@ -7,7 +7,7 @@ # # See LICENSE for licensing terms. -use Test::More tests => 77; +use Test::More tests => 83; use Wallet::Admin; use Wallet::Schema; @@ -54,6 +54,15 @@ is ($objects[0][1], 'service/admin', ' and the right name'); is ($admin->register_verifier ('base', 'Wallet::ACL::Base'), 1, 'Registering Wallet::ACL::Base works'); +# Create another ACL. +is ($server->acl_create ('first'), 1, 'ACL creation succeeds'); +@acls = $admin->list_acls; +is (scalar (@acls), 2, ' and now there are two ACLs'); +is ($acls[0][0], 1, ' and the first ID is correct'); +is ($acls[0][1], 'ADMIN', ' and the first name is correct'); +is ($acls[1][0], 2, ' and the second ID is correct'); +is ($acls[1][1], 'first', ' and the second name is correct'); + # Delete that ACL and create another. is ($server->acl_create ('second'), 1, 'Second ACL creation succeeds'); is ($server->acl_destroy ('first'), 1, ' and deletion of the first succeeds'); -- cgit v1.2.3 From 43c1420d37df58fdfc8b7e5ae229afd34a8bf070 Mon Sep 17 00:00:00 2001 From: Jon Robertson Date: Thu, 21 Jan 2010 19:08:48 -0800 Subject: Documentation additions and fixes Added documentation for the new object and acl list searches to perl/Wallet/Admin.pm and server/wallet-admin. Also fixed a POD error in perl/Wallet/Kadmin.pm's docs. --- perl/Wallet/Admin.pm | 38 ++++++++++++++++++++++++++++---------- perl/Wallet/Kadmin.pm | 2 ++ server/wallet-admin | 51 ++++++++++++++++++++++++++++++++++++++++++++++++--- 3 files changed, 78 insertions(+), 13 deletions(-) diff --git a/perl/Wallet/Admin.pm b/perl/Wallet/Admin.pm index 701c813..c86cbba 100644 --- a/perl/Wallet/Admin.pm +++ b/perl/Wallet/Admin.pm @@ -475,12 +475,14 @@ initialize() uses C as the hostname and PRINCIPAL as the user when logging the history of the ADMIN ACL creation and for any subsequent actions on the object it returns. -=item list_acls() +=item list_acls(TYPE, SEARCH) -Returns a list of all ACLs in the database. 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 "ADMIN" and ID 1 and one with name -"group/admins" and ID 3, list_acls() would return: +Returns a list of all ACLs matching a search type and string in the +database, or all ACLs if no search information is given. 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 "ADMIN" and ID 1 and one +with name "group/admins" and ID 3, list_acls() with no arguments would +return: ([ 1, 'ADMIN' ], [ 3, 'group/admins' ]) @@ -489,12 +491,20 @@ at least one ACL, but an error can be distinguished from the odd case of a database with no ACLs by calling error(). error() is guaranteed to return the error message if there was an error and undef if there was no error. -=item list_objects() +There are currently two search types. 'empty' takes no arguments, and will +return only those acls that have no entries within them. 'entry' takes two +arguments -- an entry scheme and an entry identifier -- and will return +any ACLs with an entry that matches the given scheme and contains the +given identifier. -Returns a list of all objects in the database. The return value is a list -of references to pairs of type and name. For example, if two objects -existed in the database, both of type "keytab" and with values -"host/example.com" and "foo", list_objects() would return: +=item list_objects(TYPE, SEARCH) + +Returns a list of all objects matching a search type and string in the +database, or all objects in the database if no search information is +given. The return value is a list of references to pairs of type and +name. For example, if two objects existed in the database, both of type +"keytab" and with values "host/example.com" and "foo", list_objects() +with no arguments would return: ([ 'keytab', 'host/example.com' ], [ 'keytab', 'foo' ]) @@ -503,6 +513,14 @@ database containing no objects, the caller should call error(). error() is guaranteed to return the error message if there was an error and undef if there was no error. +There are four types of searches currently. 'type' (with a given type) +will return only those entries where the type matches the given type. +'owner', with a given owner, will only return those objects owned by the +given acl name. 'flag', with a given flag name, will only return those +items with a flag set to the given value. 'acl' operates like 'owner', +but will return only those objects that have the given acl name on any +of the possible acl settings, not just owner. + =item register_object (TYPE, CLASS) Register in the database a mapping from the object type TYPE to the class diff --git a/perl/Wallet/Kadmin.pm b/perl/Wallet/Kadmin.pm index 200136c..0a9bd43 100644 --- a/perl/Wallet/Kadmin.pm +++ b/perl/Wallet/Kadmin.pm @@ -120,6 +120,8 @@ calling valid_principal on the returned object -- this method is a shortcut in case we want to check validity without creating the object and worrying about proper setup. +=back + =head1 SEE ALSO kadmin(8), Wallet::Config(3), Wallet::Object::Keytab(3), wallet-backend(8) diff --git a/server/wallet-admin b/server/wallet-admin index 01fea5c..761288d 100755 --- a/server/wallet-admin +++ b/server/wallet-admin @@ -156,10 +156,10 @@ Before running C, 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) +=item list (acls | objects) [ [ ... ] ] -Returns a list of all ACLs or objects in the database. ACLs will be -listed in the form: +Returns a list of ACLs or objects in the database. ACLs will be listed +in the form: (ACL ID: ) @@ -171,6 +171,51 @@ 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, +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 + +Returns all objects of the given type. + +=item list objects flag + +Returns all objects which have the given flag set. + +=item list objects owner + +Returns all objects owned by the given ACL name. + +=item list objects acl + +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 housekept. + +=item list acls entry + +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) Registers an implementation of a wallet object or ACL verifier in the -- cgit v1.2.3 From 42ff8edd0059988c5fa9af98ead4c19b3b52b37a Mon Sep 17 00:00:00 2001 From: Jon Robertson Date: Thu, 21 Jan 2010 19:24:59 -0800 Subject: Added new ACL format to the object tests Added the new ACL format to perl/t/object.t's idea of what an object's history was meant to be. This involved switching from acl id to acl name plus id -- ie: '1' to 'ADMIN (1)'. --- perl/t/object.t | 36 ++++++++++++++++++------------------ 1 file changed, 18 insertions(+), 18 deletions(-) diff --git a/perl/t/object.t b/perl/t/object.t index a40a412..46e67e5 100755 --- a/perl/t/object.t +++ b/perl/t/object.t @@ -255,11 +255,11 @@ ok (defined ($object), 'Recreating the object succeeds'); $output = <<"EOO"; $date create by $user from $host -$date set owner to 1 +$date set owner to ADMIN (1) by $user from $host -$date unset owner (was 1) +$date unset owner (was ADMIN (1)) by $user from $host -$date set owner to 1 +$date set owner to ADMIN (1) by $user from $host $date set expires to $now by $user from $host @@ -267,35 +267,35 @@ $date unset expires (was $now) by $user from $host $date set expires to $now by $user from $host -$date set acl_get to 1 +$date set acl_get to ADMIN (1) by $user from $host -$date unset acl_get (was 1) +$date unset acl_get (was ADMIN (1)) by $user from $host -$date set acl_get to 1 +$date set acl_get to ADMIN (1) by $user from $host -$date set acl_store to 1 +$date set acl_store to ADMIN (1) by $user from $host -$date unset acl_store (was 1) +$date unset acl_store (was ADMIN (1)) by $user from $host -$date set acl_store to 1 +$date set acl_store to ADMIN (1) by $user from $host -$date set acl_show to 1 +$date set acl_show to ADMIN (1) by $user from $host -$date unset acl_show (was 1) +$date unset acl_show (was ADMIN (1)) by $user from $host -$date set acl_show to 1 +$date set acl_show to ADMIN (1) by $user from $host -$date set acl_destroy to 1 +$date set acl_destroy to ADMIN (1) by $user from $host -$date unset acl_destroy (was 1) +$date unset acl_destroy (was ADMIN (1)) by $user from $host -$date set acl_destroy to 1 +$date set acl_destroy to ADMIN (1) by $user from $host -$date set acl_flags to 1 +$date set acl_flags to ADMIN (1) by $user from $host -$date unset acl_flags (was 1) +$date unset acl_flags (was ADMIN (1)) by $user from $host -$date set acl_flags to 1 +$date set acl_flags to ADMIN (1) by $user from $host $date set flag locked by $user from $host -- cgit v1.2.3 From 854063db2095fac8079260b414714d239221fdff Mon Sep 17 00:00:00 2001 From: Jon Robertson Date: Thu, 21 Jan 2010 20:53:20 -0800 Subject: Removed valid_principal as a Kadmin API function valid_principal has been removed from Wallet::Kadmin and Wallet::Kadmin::Heimdal. An accessor for it in Wallet::Object::Keytab has also been removed, as have the tests in perl/t/keytab.t for the function. It still remains within Wallet::Kadmin::MIT and is used there, but only as a private method for flagging what the kadmin command-line interface cannot handle. --- perl/Wallet/Kadmin.pm | 26 +------------------------- perl/Wallet/Kadmin/Heimdal.pm | 21 +-------------------- perl/Wallet/Object/Keytab.pm | 9 +-------- perl/t/keytab.t | 28 +++++++++++++--------------- 4 files changed, 16 insertions(+), 68 deletions(-) diff --git a/perl/Wallet/Kadmin.pm b/perl/Wallet/Kadmin.pm index 0a9bd43..95859a9 100644 --- a/perl/Wallet/Kadmin.pm +++ b/perl/Wallet/Kadmin.pm @@ -20,27 +20,12 @@ 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'; ############################################################################## # Public methods ############################################################################## -# Validate a principal with a submodule's validator. We can also do this via -# creating an object with new and then running valid_principal from that, -# but there are times we might wish to run it without going through the -# object creation. -sub valid_principal { - my ($class, $principal) = @_; - if ($Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') { - require Wallet::Kadmin::MIT; - return Wallet::Kadmin::MIT->valid_principal ($principal); - } elsif ($Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal') { - require Wallet::Kadmin::Heimdal; - return Wallet::Kadmin::Heimdal->valid_principal ($principal); - } -} - # Create a new kadmin object, by finding the type requested in the wallet # config and passing off to the proper module. Returns the object directly # from the specific Wallet::Kadmin::* module. @@ -111,15 +96,6 @@ Finds the proper Kerberos implementation and calls the new() constructor for that implementation's module, returning the result. If the implementation is not recognized or set, die with an error message. -=item valid_principal(PRINCIPAL) - -Finds the proper Kerberos implementation and calls its own valid_principal -method, returning the result. This tells whether a principal is valid for -that implementation. This can be achieved by using new() and then directly -calling valid_principal on the returned object -- this method is a shortcut -in case we want to check validity without creating the object and worrying -about proper setup. - =back =head1 SEE ALSO diff --git a/perl/Wallet/Kadmin/Heimdal.pm b/perl/Wallet/Kadmin/Heimdal.pm index a8859bf..a05362e 100644 --- a/perl/Wallet/Kadmin/Heimdal.pm +++ b/perl/Wallet/Kadmin/Heimdal.pm @@ -21,21 +21,12 @@ 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.01'; +$VERSION = '0.02'; ############################################################################## # kadmin Interaction ############################################################################## -# Make sure that principals are well-formed and don't contain characters that -# will cause us problems when talking to kadmin. Takes a principal and -# returns true if it's okay, false otherwise. Note that we do not permit -# realm information here. -sub valid_principal { - my ($self, $principal) = @_; - return scalar ($principal =~ m,^[\w-]+(/[\w_.-]+)?\z,); -} - # Create a Heimdal::Kadm5 client object and return it. It should load # configuration from Wallet::Config. sub kadmin_client { @@ -62,7 +53,6 @@ sub kadmin_client { # so, false otherwise. Throws an exception if an error. sub exists { my ($self, $principal) = @_; - return unless $self->valid_principal ($principal); if ($Wallet::Config::KEYTAB_REALM) { $principal .= '@' . $Wallet::Config::KEYTAB_REALM; } @@ -76,9 +66,6 @@ sub exists { # undef. sub addprinc { my ($self, $principal) = @_; - unless ($self->valid_principal ($principal)) { - die "invalid principal name $principal\n"; - } my $exists = eval { $self->exists ($principal) }; if ($Wallet::Config::KEYTAB_REALM) { @@ -117,9 +104,6 @@ sub addprinc { # error. sub ktadd { my ($self, $principal, $file, @enctypes) = @_; - unless ($self->valid_principal ($principal)) { - die "invalid principal name: $principal\n"; - } if ($Wallet::Config::KEYTAB_REALM) { $principal .= '@' . $Wallet::Config::KEYTAB_REALM; } @@ -164,9 +148,6 @@ sub ktadd { # exist, return success; we're bringing reality in line with our expectations. sub delprinc { my ($self, $principal) = @_; - unless ($self->valid_principal ($principal)) { - die "invalid principal name: $principal\n"; - } my $exists = eval { $self->exists ($principal) }; die $@ if $@; if (not $exists) { diff --git a/perl/Wallet/Object/Keytab.pm b/perl/Wallet/Object/Keytab.pm index a361599..092e973 100644 --- a/perl/Wallet/Object/Keytab.pm +++ b/perl/Wallet/Object/Keytab.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.06'; +$VERSION = '0.07'; ############################################################################## # AFS kaserver synchronization @@ -490,13 +490,6 @@ sub create { return $self; } -# Provides wrapper to individual Kadmin class's valid_principal. Here only -# to help expose for testing. -sub valid_principal { - my ($self, $principal) = @_; - return Wallet::Kadmin->valid_principal ($principal); -} - # Override destroy to delete the principal out of Kerberos as well. sub destroy { my ($self, $user, $host, $time) = @_; diff --git a/perl/t/keytab.t b/perl/t/keytab.t index 3cd77d8..7745290 100755 --- a/perl/t/keytab.t +++ b/perl/t/keytab.t @@ -8,7 +8,8 @@ # See LICENSE for licensing terms. use POSIX qw(strftime); -use Test::More tests => 219; +use Test::More tests => 208 +; use Wallet::Admin; use Wallet::Config; @@ -192,18 +193,6 @@ my $dbh = $admin->dbh; my $history = ''; my $date = strftime ('%Y-%m-%d %H:%M:%S', localtime $trace[2]); -# Do some white-box testing of the principal validation regex. -for my $bad (qw{service\* = host/foo+bar host/foo/bar /bar bar/ - rcmd.foo}) { - ok (! Wallet::Object::Keytab->valid_principal ($bad), - "Invalid principal name $bad"); -} -for my $good (qw{service service/foo bar foo/bar host/example.org - aservice/foo}) { - ok (Wallet::Object::Keytab->valid_principal ($good), - "Valid principal name $good"); -} - # Basic keytab creation and manipulation tests. SKIP: { skip 'no keytab configuration', 49 unless -f 't/data/test.keytab'; @@ -228,12 +217,21 @@ SKIP: { Wallet::Object::Keytab->create ('keytab', "wallet\nf", $dbh, @trace) }; is ($object, undef, 'Creating malformed principal fails'); - is ($@, "invalid principal name wallet\nf\n", ' with the right error'); + if ($Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') { + is ($@, "invalid principal name wallet\nf\n", ' with the right error'); + } elsif ($Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal') { + like ($@, qr/^error adding principal wallet\nf/, + ' with the right error'); + } $object = eval { Wallet::Object::Keytab->create ('keytab', '', $dbh, @trace) }; is ($object, undef, 'Creating empty principal fails'); - is ($@, "invalid principal name \n", ' with the right error'); + if ($Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') { + is ($@, "invalid principal name \n", ' with the right error'); + } elsif ($Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal') { + like ($@, qr/^error adding principal \@/, ' with the right error'); + } $object = eval { Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace) }; -- cgit v1.2.3 From 9347a25fdb92bae16a205da218fa153279765fbc Mon Sep 17 00:00:00 2001 From: Jon Robertson Date: Thu, 21 Jan 2010 22:24:43 -0800 Subject: Added test for Wallet::Kadmin basic function Created perl/t/kadmin.t, which performs tests against the Wallet::Kadmin basic API. We only test that Wallet::Kadmin->new () works for both MIT and Heimdal (though doesn't make a connection), and the MIT valid_principal private method. --- perl/t/kadmin.t | 53 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 53 insertions(+) create mode 100755 perl/t/kadmin.t diff --git a/perl/t/kadmin.t b/perl/t/kadmin.t new file mode 100755 index 0000000..7423ed1 --- /dev/null +++ b/perl/t/kadmin.t @@ -0,0 +1,53 @@ +#!/usr/bin/perl -w +# +# t/kadmin.t -- Tests for the kadmin object implementation. +# +# Written by Jon Robertson +# Copyright 2009 Board of Trustees, Leland Stanford Jr. University +# +# See LICENSE for licensing terms. + +use POSIX qw(strftime); +use Test::More tests => 15; + +use Wallet::Admin; +use Wallet::Config; +use Wallet::Kadmin; +use Wallet::Kadmin::Heimdal; +use Wallet::Kadmin::MIT; + +use lib 't/lib'; +use Util; + +# We test a Wallet::Kadmin::* module's actual workings in the keytab.t tests. +# The only things we want to test here are that each module is found, that +# Wallet::Kadmin itself delegates to them, and that the private MIT principal +# validation works as it should. +for my $bad (qw{service\* = host/foo+bar host/foo/bar /bar bar/ + rcmd.foo}) { + ok (! Wallet::Kadmin::MIT->valid_principal ($bad), + "Invalid principal name $bad"); +} +for my $good (qw{service service/foo bar foo/bar host/example.org + aservice/foo}) { + ok (Wallet::Kadmin::MIT->valid_principal ($good), + "Valid principal name $good"); +} + +# Test creating an MIT object. We don't care about anything but correctly +# creating it -- testing operations is for the keytab tests. +$Wallet::Config::KEYTAB_KRBTYPE = 'MIT'; +my $kadmin = Wallet::Kadmin->new (); +ok (defined ($kadmin), 'MIT kadmin object created'); + +# Test creating a Heimdal object. For us to test a working Heimdal object, +# we need a properly configured Heimdal KDC. So instead, we deliberately +# connect without configuration to get the error. That at least tests that +# we can find the Heimdal module and it dies how it should. +undef $Wallet::Config::KEYTAB_PRINCIPAL; +undef $Wallet::Config::KEYTAB_FILE; +undef $Wallet::Config::KEYTAB_REALM; +undef $kadmin; +$Wallet::Config::KEYTAB_KRBTYPE = 'Heimdal'; +$kadmin = eval { Wallet::Kadmin->new () }; +is ($kadmin, undef, 'Heimdal fails properly.'); -- cgit v1.2.3 From 364f19c6200dfa7e96e5236a538b4092154b28e8 Mon Sep 17 00:00:00 2001 From: Jon Robertson Date: Tue, 26 Jan 2010 11:19:01 -0800 Subject: Improved error handling for Kadmin sub-modules Improved error handling by adding an error function to the Kadmin sub-modules which will copy errors down to the Wallet::Object::Keytab error function rather than relying on too many dies and evals. There still needs to be more cleanup here, but that will rely on work on Heimdal::Kadm5 as well, to clean up its own error handling to not spam warnings when called without RaiseError. Also caught a few more un-evaled error cases where Heimdal::Kadm5 was called, and fixed an error where RaiseErrors was being set rather than RaiseError due to an error in Heimdal::Kadm5 docs. --- perl/Wallet/Kadmin/Heimdal.pm | 123 +++++++++++++++++++++++++++++++----------- perl/Wallet/Kadmin/MIT.pm | 78 ++++++++++++++++++--------- perl/Wallet/Object/Keytab.pm | 15 +++--- 3 files changed, 154 insertions(+), 62 deletions(-) diff --git a/perl/Wallet/Kadmin/Heimdal.pm b/perl/Wallet/Kadmin/Heimdal.pm index a05362e..9c2805b 100644 --- a/perl/Wallet/Kadmin/Heimdal.pm +++ b/perl/Wallet/Kadmin/Heimdal.pm @@ -21,7 +21,23 @@ 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'; + +############################################################################## +# Utility functions +############################################################################## + +# Set or return the error stashed in the object. +sub error { + my ($self, @error) = @_; + if (@error) { + my $error = join ('', @error); + chomp $error; + 1 while ($error =~ s/ at \S+ line \d+\.?\z//); + $self->{error} = $error; + } + return $self->{error}; +} ############################################################################## # kadmin Interaction @@ -30,17 +46,18 @@ $VERSION = '0.02'; # Create a Heimdal::Kadm5 client object and return it. It should load # configuration from Wallet::Config. sub kadmin_client { + my ($self) = @_; unless (defined ($Wallet::Config::KEYTAB_PRINCIPAL) and defined ($Wallet::Config::KEYTAB_FILE) and defined ($Wallet::Config::KEYTAB_REALM)) { die "keytab object implementation not configured\n"; } my $server = $Wallet::Config::KEYTAB_HOST || 'localhost'; - my @options = (RaiseErrors => 1, - Server => $server, - Principal => $Wallet::Config::KEYTAB_PRINCIPAL, - Realm => $Wallet::Config::KEYTAB_REALM, - Keytab => $Wallet::Config::KEYTAB_FILE); + my @options = (RaiseError => 1, + Server => $server, + Principal => $Wallet::Config::KEYTAB_PRINCIPAL, + Realm => $Wallet::Config::KEYTAB_REALM, + Keytab => $Wallet::Config::KEYTAB_FILE); my $client = Heimdal::Kadm5::Client->new (@options); return $client; } @@ -50,28 +67,34 @@ sub kadmin_client { ############################################################################## # Check whether a given principal already exists in Kerberos. Returns true if -# so, false otherwise. Throws an exception if an error. +# so, false otherwise. sub exists { my ($self, $principal) = @_; if ($Wallet::Config::KEYTAB_REALM) { $principal .= '@' . $Wallet::Config::KEYTAB_REALM; } my $kadmin = $self->{client}; - my $princdata = $kadmin->getPrincipal ($principal); + my $princdata = eval { $kadmin->getPrincipal ($principal) }; + if ($@) { + $self->error ("error getting principal: $@"); + return; + } return $princdata ? 1 : 0; } -# Create a principal in Kerberos. Since this is only called by create, it -# throws an exception on failure rather than setting the error and returning -# undef. +# Create a principal in Kerberos. If there is an error, return undef and set +# the error. Return 1 on success or the principal already existing. sub addprinc { my ($self, $principal) = @_; - my $exists = eval { $self->exists ($principal) }; if ($Wallet::Config::KEYTAB_REALM) { $principal .= '@' . $Wallet::Config::KEYTAB_REALM; } - die "error adding principal $principal: $@\n" if $@; + my $exists = eval { $self->exists ($principal) }; + if ($@) { + $self->error ("error adding principal $principal: $@"); + return undef; + } return 1 if $exists; # The way Heimdal::Kadm5 works, we create a principal object, create the @@ -80,21 +103,34 @@ sub addprinc { # on creation even if it is inactive until after randomized by # module. my $kadmin = $self->{client}; - my $princdata = $kadmin->makePrincipal ($principal); + my $princdata = eval { $kadmin->makePrincipal ($principal) }; + if ($@) { + $self->error ("error adding principal $principal: $@"); + return; + } # Disable the principal before creating, until we've randomized the # password. - my $attrs = $princdata->getAttributes; + my $attrs = eval { $princdata->getAttributes }; + if ($@) { + $self->error ("error adding principal $principal: $@"); + return; + } $attrs |= KRB5_KDB_DISALLOW_ALL_TIX; - $princdata->setAttributes ($attrs); + eval { $princdata->setAttributes ($attrs) }; + if ($@) { + $self->error ("error adding principal $principal: $@"); + return; + } my $password = 'inactive'; - eval { - $kadmin->createPrincipal ($princdata, $password, 0); - $kadmin->randKeyPrincipal ($principal); - $kadmin->enablePrincipal ($principal); - }; - die "error adding principal $principal: $@" if $@; + my $test = eval { $kadmin->createPrincipal ($princdata, $password, 0) }; + eval { $kadmin->randKeyPrincipal ($principal) } unless $@; + eval { $kadmin->enablePrincipal ($principal) } unless $@; + if ($@) { + $self->error ("error adding principal $principal: $@"); + return; + } return 1; } @@ -114,13 +150,19 @@ sub ktadd { # to those we have been asked for this time. my $kadmin = $self->{client}; eval { $kadmin->randKeyPrincipal ($principal) }; - die "error creating keytab for $principal: could not reinit enctypes: $@\n" - if $@; + if ($@) { + $self->error ("error creating keytab for $principal: could not " + ."reinit enctypes: $@"); + return; + } my $princdata = eval { $kadmin->getPrincipal ($principal) }; if ($@) { - die "error creating keytab for $principal: $@\n"; + $self->error ("error creating keytab for $principal: $@"); + return; } elsif (!$princdata) { - die "error creating keytab for $principal: principal does not exist\n"; + $self->error ("error creating keytab for $principal: principal does " + ."not exist"); + return; } # Now actually remove any non-requested enctypes, if we requested any. @@ -132,13 +174,24 @@ sub ktadd { my $keytype = ${$key}[0]; next if exists $wanted{$keytype}; eval { $princdata->delKeytypes ($keytype) }; - die "error removing keytype $keytype from the keytab: $@\n" if $@; + if ($@) { + $self->error ("error removing keytype $keytype from the ". + "keytab: $@"); + return; + } } eval { $kadmin->modifyPrincipal ($princdata) }; + if ($@) { + $self->error ("error saving principal modifications: $@"); + return; + } } eval { $kadmin->extractKeytab ($princdata, $file) }; - die "error creating keytab for principal: $@\n" if $@; + if ($@) { + $self->error ("error creating keytab for principal: $@"); + return; + } return 1; } @@ -149,8 +202,10 @@ sub ktadd { sub delprinc { my ($self, $principal) = @_; my $exists = eval { $self->exists ($principal) }; - die $@ if $@; - if (not $exists) { + if ($@) { + $self->error ("error checking principal existance: $@"); + return; + } elsif (not $exists) { return 1; } if ($Wallet::Config::KEYTAB_REALM) { @@ -159,7 +214,10 @@ sub delprinc { my $kadmin = $self->{client}; my $retval = eval { $kadmin->deletePrincipal ($principal) }; - die "error deleting $principal: $@\n" if $@; + if ($@) { + $self->error ("error deleting $principal: $@"); + return; + } return 1; } @@ -173,9 +231,10 @@ sub delprinc { sub new { my ($class) = @_; my $self = { - client => kadmin_client (), + client => undef, }; bless ($self, $class); + $self->{client} = kadmin_client (); return $self; } diff --git a/perl/Wallet/Kadmin/MIT.pm b/perl/Wallet/Kadmin/MIT.pm index 7bbb248..2e9b0b4 100644 --- a/perl/Wallet/Kadmin/MIT.pm +++ b/perl/Wallet/Kadmin/MIT.pm @@ -21,7 +21,23 @@ 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.01'; +$VERSION = '0.02'; + +############################################################################## +# Utility functions +############################################################################## + +# Set or return the error stashed in the object. +sub error { + my ($self, @error) = @_; + if (@error) { + my $error = join ('', @error); + chomp $error; + 1 while ($error =~ s/ at \S+ line \d+\.?\z//); + $self->{error} = $error; + } + return $self->{error}; +} ############################################################################## # kadmin Interaction @@ -54,7 +70,8 @@ sub kadmin { if $Wallet::Config::KEYTAB_REALM; my $pid = open (KADMIN, '-|'); if (not defined $pid) { - die "cannot fork: $!\n"; + $self->error ("cannot fork: $!"); + return; } elsif ($pid == 0) { # TODO - How should I handle the db handle? # Don't use die here; it will get trapped as an exception. Also be @@ -75,7 +92,8 @@ sub kadmin { while () { if (/^wallet: cannot /) { s/^wallet: //; - die $_; + $self->error ($_); + return; } push (@output, $_) unless /Authenticating as principal/; } @@ -88,7 +106,8 @@ sub kadmin { ############################################################################## # Check whether a given principal already exists in Kerberos. Returns true if -# so, false otherwise. Throws an exception if kadmin fails. +# so, false otherwise. Returns undef if kadmin fails, with the error already +# set by kadmin. sub exists { my ($self, $principal) = @_; return unless $self->valid_principal ($principal); @@ -96,20 +115,22 @@ sub exists { $principal .= '@' . $Wallet::Config::KEYTAB_REALM; } my $output = $self->kadmin ("getprinc $principal"); - if ($output =~ /^get_principal: /) { + if (!defined $output) { return; + } elsif ($output =~ /^get_principal: /) { + return 0; } else { return 1; } } -# Create a principal in Kerberos. Since this is only called by create, it -# throws an exception on failure rather than setting the error and returning -# undef. +# Create a principal in Kerberos. Sets the error and returns undef on failure, +# and returns 1 on either success or the principal already existing. sub addprinc { my ($self, $principal) = @_; unless ($self->valid_principal ($principal)) { - die "invalid principal name $principal\n"; + $self->error ("invalid principal name $principal"); + return; } return 1 if $self->exists ($principal); if ($Wallet::Config::KEYTAB_REALM) { @@ -117,8 +138,11 @@ sub addprinc { } my $flags = $Wallet::Config::KEYTAB_FLAGS || ''; my $output = $self->kadmin ("addprinc -randkey $flags $principal"); - if ($output =~ /^add_principal: (.*)/m) { - die "error adding principal $principal: $1\n"; + if (!defined $output) { + return; + } elsif ($output =~ /^add_principal: (.*)/m) { + $self->error ("error adding principal $principal: $1"); + return; } return 1; } @@ -130,7 +154,8 @@ sub addprinc { sub ktadd { my ($self, $principal, $file, @enctypes) = @_; unless ($self->valid_principal ($principal)) { - die "invalid principal name: $principal\n"; + $self->error ("invalid principal name: $principal"); + return; } if ($Wallet::Config::KEYTAB_REALM) { $principal .= '@' . $Wallet::Config::KEYTAB_REALM; @@ -140,10 +165,12 @@ sub ktadd { @enctypes = map { /:/ ? $_ : "$_:normal" } @enctypes; $command .= ' -e "' . join (' ', @enctypes) . '"'; } - my $output = eval { $self->kadmin ("$command $principal") }; - die ($@) if ($@); - if ($output =~ /^(?:kadmin|ktadd): (.*)/m) { - die "error creating keytab for $principal: $1\n"; + my $output = $self->kadmin ("$command $principal"); + if (!defined $output) { + return; + } elsif ($output =~ /^(?:kadmin|ktadd): (.*)/m) { + $self->error ("error creating keytab for $principal: $1"); + return; } return 1; } @@ -154,20 +181,23 @@ sub ktadd { sub delprinc { my ($self, $principal) = @_; unless ($self->valid_principal ($principal)) { - die "invalid principal name: $principal\n"; + $self->error ("invalid principal name: $principal"); } - my $exists = eval { $self->exists ($principal) }; - die $@ if $@; - if (not $exists) { + my $exists = $self->exists ($principal); + if (!defined $exists) { + return; + } elsif (not $exists) { return 1; } if ($Wallet::Config::KEYTAB_REALM) { $principal .= '@' . $Wallet::Config::KEYTAB_REALM; } - my $output = eval { $self->kadmin ("delprinc -force $principal") }; - die $@ if $@; - if ($output =~ /^delete_principal: (.*)/m) { - die "error deleting $principal: $1\n"; + my $output = $self->kadmin ("delprinc -force $principal"); + if (!defined $output) { + return; + } elsif ($output =~ /^delete_principal: (.*)/m) { + $self->error ("error deleting $principal: $1"); + return; } return 1; } diff --git a/perl/Wallet/Object/Keytab.pm b/perl/Wallet/Object/Keytab.pm index 092e973..6733cf0 100644 --- a/perl/Wallet/Object/Keytab.pm +++ b/perl/Wallet/Object/Keytab.pm @@ -484,7 +484,9 @@ sub create { bless $self, $class; my $kadmin = Wallet::Kadmin->new (); $self->{kadmin} = $kadmin; - $kadmin->addprinc ($name); + if (not $kadmin->addprinc ($name)) { + die $kadmin->error; + } $self = $class->SUPER::create ($type, $name, $dbh, $creator, $host, $time); $self->{kadmin} = $kadmin; return $self; @@ -517,7 +519,10 @@ sub destroy { return; } my $kadmin = $self->{kadmin}; - return if not $kadmin->delprinc ($self->{name}); + if (not $kadmin->delprinc ($self->{name})) { + $self->error ($kadmin->error); + return; + } return $self->SUPER::destroy ($user, $host, $time); } @@ -546,12 +551,10 @@ sub get { unlink $file; my @enctypes = $self->attr ('enctypes'); my $kadmin = $self->{kadmin}; - my $retval = eval { $kadmin->ktadd ($self->{name}, $file, @enctypes) }; - if ($@) { - $self->error ($@); + if (not $kadmin->ktadd ($self->{name}, $file, @enctypes)) { + $self->error ($kadmin->error); return; } - return unless $retval; local *KEYTAB; unless (open (KEYTAB, '<', $file)) { my $princ = $self->{name}; -- cgit v1.2.3 From dad764bc84d371ffc775e66b942ecbbc59f05c8e Mon Sep 17 00:00:00 2001 From: Jon Robertson Date: Tue, 26 Jan 2010 14:45:40 -0800 Subject: Added way to clean things during a fork for kadmin The MIT kadmin module currently directly runs the MIT kadmin program. Some data needs to be cleaned during the forks for this. This provides a callback that can be registered and is called during the fork process, currently just to mark database handles inactive. It was added to both the MIT and Heimdal modules, though it's only a stub in the Heimdal module. Heimdal is not forking kadmin, but the stub is there in order to allow the caller to not care which module is being used and just always register the callbacks. --- perl/Wallet/Kadmin/Heimdal.pm | 5 +++++ perl/Wallet/Kadmin/MIT.pm | 12 +++++++----- perl/Wallet/Object/Keytab.pm | 13 ++++++++++++- perl/t/kadmin.t | 11 ++++++++--- 4 files changed, 32 insertions(+), 9 deletions(-) diff --git a/perl/Wallet/Kadmin/Heimdal.pm b/perl/Wallet/Kadmin/Heimdal.pm index 9c2805b..b0010a5 100644 --- a/perl/Wallet/Kadmin/Heimdal.pm +++ b/perl/Wallet/Kadmin/Heimdal.pm @@ -39,6 +39,11 @@ sub error { return $self->{error}; } +# Set a callback to be called for forked kadmin processes. This does nothing +# for Heimdal, as we're not forking anything, but remains for compatibility +# with the MIT kadmin module. +sub fork_callback { } + ############################################################################## # kadmin Interaction ############################################################################## diff --git a/perl/Wallet/Kadmin/MIT.pm b/perl/Wallet/Kadmin/MIT.pm index 2e9b0b4..c3ad901 100644 --- a/perl/Wallet/Kadmin/MIT.pm +++ b/perl/Wallet/Kadmin/MIT.pm @@ -39,6 +39,12 @@ sub error { return $self->{error}; } +# Set a callback to be called for forked kadmin processes. +sub fork_callback { + my ($self, $callback) = @_; + $self->{fork_callback} = $callback; +} + ############################################################################## # kadmin Interaction ############################################################################## @@ -73,11 +79,7 @@ sub kadmin { $self->error ("cannot fork: $!"); return; } elsif ($pid == 0) { - # TODO - How should I handle the db handle? - # Don't use die here; it will get trapped as an exception. Also be - # careful about our database handles. (We still lose if there's some - # other database handle open we don't know about.) - #$object->{dbh}->{InactiveDestroy} = 1; + $self->{fork_callback} (); unless (open (STDERR, '>&STDOUT')) { warn "wallet: cannot dup stdout: $!\n"; exit 1; diff --git a/perl/Wallet/Object/Keytab.pm b/perl/Wallet/Object/Keytab.pm index 6733cf0..22598f1 100644 --- a/perl/Wallet/Object/Keytab.pm +++ b/perl/Wallet/Object/Keytab.pm @@ -466,6 +466,11 @@ sub new { my $kadmin = Wallet::Kadmin->new (); $self->{kadmin} = $kadmin; + # Set a callback for things to do after a fork, specifically for the MIT + # kadmin module which forks to kadmin. + my $callback = sub { $self->{dbh}->{InactiveDestroy} = 1 }; + $kadmin->fork_callback ($callback); + $self = $class->SUPER::new ($type, $name, $dbh); $self->{kadmin} = $kadmin; return $self; @@ -484,8 +489,14 @@ sub create { bless $self, $class; my $kadmin = Wallet::Kadmin->new (); $self->{kadmin} = $kadmin; + + # Set a callback for things to do after a fork, specifically for the MIT + # kadmin module which forks to kadmin. + my $callback = sub { $self->{dbh}->{InactiveDestroy} = 1 }; + $kadmin->fork_callback ($callback); + if (not $kadmin->addprinc ($name)) { - die $kadmin->error; + die $kadmin->error, "\n"; } $self = $class->SUPER::create ($type, $name, $dbh, $creator, $host, $time); $self->{kadmin} = $kadmin; diff --git a/perl/t/kadmin.t b/perl/t/kadmin.t index 7423ed1..8ecc2c1 100755 --- a/perl/t/kadmin.t +++ b/perl/t/kadmin.t @@ -8,7 +8,7 @@ # See LICENSE for licensing terms. use POSIX qw(strftime); -use Test::More tests => 15; +use Test::More tests => 17; use Wallet::Admin; use Wallet::Config; @@ -34,11 +34,16 @@ for my $good (qw{service service/foo bar foo/bar host/example.org "Valid principal name $good"); } -# Test creating an MIT object. We don't care about anything but correctly -# creating it -- testing operations is for the keytab tests. +# Test creating an MIT object and seeing if the callback works. $Wallet::Config::KEYTAB_KRBTYPE = 'MIT'; my $kadmin = Wallet::Kadmin->new (); ok (defined ($kadmin), 'MIT kadmin object created'); +my $callback = sub { return 1 }; +$kadmin->fork_callback ($callback); +is ($kadmin->{fork_callback} (), 1, ' and callback works.'); +my $callback = sub { return 2 }; +$kadmin->fork_callback ($callback); +is ($kadmin->{fork_callback} (), 2, ' and changing it works.'); # Test creating a Heimdal object. For us to test a working Heimdal object, # we need a properly configured Heimdal KDC. So instead, we deliberately -- cgit v1.2.3 From 8d4899825cf723ef6a975306f146a06388ed4547 Mon Sep 17 00:00:00 2001 From: Jon Robertson Date: Tue, 26 Jan 2010 15:16:36 -0800 Subject: Skip tests in kadmin.t if module requirements are missing Made kadmin.t skip loading the Wallet::Kadmin::Heimdal module if its requirement, Heimdal::Kadm5, is not installed on the system. --- perl/t/kadmin.t | 29 ++++++++++++++++++++--------- 1 file changed, 20 insertions(+), 9 deletions(-) diff --git a/perl/t/kadmin.t b/perl/t/kadmin.t index 8ecc2c1..96b249b 100755 --- a/perl/t/kadmin.t +++ b/perl/t/kadmin.t @@ -13,9 +13,17 @@ use Test::More tests => 17; use Wallet::Admin; use Wallet::Config; use Wallet::Kadmin; -use Wallet::Kadmin::Heimdal; use Wallet::Kadmin::MIT; +# Only load Wallet::Kadmin::Heimdal if a required module is found. +my $heimdal_kadm5 = 0; +eval 'use Heimdal::Kadm5'; +if (!$@) { + print "No error...\n"; + $heimdal_kadm5 = 1; + require Wallet::Kadmin::Heimdal; +} + use lib 't/lib'; use Util; @@ -41,7 +49,7 @@ ok (defined ($kadmin), 'MIT kadmin object created'); my $callback = sub { return 1 }; $kadmin->fork_callback ($callback); is ($kadmin->{fork_callback} (), 1, ' and callback works.'); -my $callback = sub { return 2 }; +$callback = sub { return 2 }; $kadmin->fork_callback ($callback); is ($kadmin->{fork_callback} (), 2, ' and changing it works.'); @@ -49,10 +57,13 @@ is ($kadmin->{fork_callback} (), 2, ' and changing it works.'); # we need a properly configured Heimdal KDC. So instead, we deliberately # connect without configuration to get the error. That at least tests that # we can find the Heimdal module and it dies how it should. -undef $Wallet::Config::KEYTAB_PRINCIPAL; -undef $Wallet::Config::KEYTAB_FILE; -undef $Wallet::Config::KEYTAB_REALM; -undef $kadmin; -$Wallet::Config::KEYTAB_KRBTYPE = 'Heimdal'; -$kadmin = eval { Wallet::Kadmin->new () }; -is ($kadmin, undef, 'Heimdal fails properly.'); +SKIP: { + skip 'Heimdal::Kadm5 not installed', 1 unless $heimdal_kadm5; + undef $Wallet::Config::KEYTAB_PRINCIPAL; + undef $Wallet::Config::KEYTAB_FILE; + undef $Wallet::Config::KEYTAB_REALM; + undef $kadmin; + $Wallet::Config::KEYTAB_KRBTYPE = 'Heimdal'; + $kadmin = eval { Wallet::Kadmin->new () }; + is ($kadmin, undef, 'Heimdal fails properly.'); +} -- cgit v1.2.3 From 04b875599b1d4559dbcd356726035416081c6b48 Mon Sep 17 00:00:00 2001 From: Jon Robertson Date: Thu, 28 Jan 2010 00:07:16 -0800 Subject: Improved and fixed tests related to Pod and KDC type Added a fix to the Pod tests to change the order of the arguments in a skip statement to the correct order. Also added tests for the KEYTAB_KRBTYPE value in the keytab tests, and changed the Wallet::Kadmin module to standardize the errors returned with no keytab set and add new error for keytab set but not a valid value. --- perl/Wallet/Kadmin.pm | 5 ++++- perl/t/keytab.t | 23 ++++++++++++++++++++--- tests/server/pod-t.in | 2 +- 3 files changed, 25 insertions(+), 5 deletions(-) diff --git a/perl/Wallet/Kadmin.pm b/perl/Wallet/Kadmin.pm index 95859a9..501bc37 100644 --- a/perl/Wallet/Kadmin.pm +++ b/perl/Wallet/Kadmin.pm @@ -32,7 +32,10 @@ $VERSION = '0.03'; sub new { my ($class) = @_; my ($kadmin); - if ($Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') { + if (!defined $Wallet::Config::KEYTAB_KRBTYPE + || !$Wallet::Config::KEYTAB_KRBTYPE) { + die "keytab object implementation not configured\n"; + } elsif ($Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') { require Wallet::Kadmin::MIT; $kadmin = Wallet::Kadmin::MIT->new (); } elsif ($Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal') { diff --git a/perl/t/keytab.t b/perl/t/keytab.t index 7745290..ab5b19d 100755 --- a/perl/t/keytab.t +++ b/perl/t/keytab.t @@ -8,7 +8,7 @@ # See LICENSE for licensing terms. use POSIX qw(strftime); -use Test::More tests => 208 +use Test::More tests => 212 ; use Wallet::Admin; @@ -387,6 +387,21 @@ EOO is ($@, "keytab object implementation not configured\n", ' with the right error'); $Wallet::Config::KEYTAB_REALM = contents ('t/data/test.realm'); + undef $Wallet::Config::KEYTAB_KRBTYPE; + $object = eval { + Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace) + }; + is ($object, undef, ' and another'); + is ($@, "keytab object implementation not configured\n", + ' with the right error'); + $Wallet::Config::KEYTAB_KRBTYPE = 'Active Directory'; + $object = eval { + Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace) + }; + is ($object, undef, ' and one set to an invalid value'); + is ($@, "keytab krb server type not set to a valid value\n", + ' with the right error'); + $Wallet::Config::KEYTAB_KRBTYPE = contents ('t/data/test.krbtype'); } # Tests for unchanging support. Skip these if we don't have a keytab or if we @@ -403,6 +418,7 @@ SKIP: { $Wallet::Config::KEYTAB_FILE = 't/data/test.keytab'; $Wallet::Config::KEYTAB_PRINCIPAL = contents ('t/data/test.principal'); $Wallet::Config::KEYTAB_REALM = contents ('t/data/test.realm'); + $Wallet::Config::KEYTAB_KRBTYPE = contents ('t/data/test.krbtype'); $Wallet::Config::KEYTAB_TMP = '.'; my $realm = $Wallet::Config::KEYTAB_REALM; my $principal = $Wallet::Config::KEYTAB_PRINCIPAL; @@ -581,6 +597,7 @@ EOO $Wallet::Config::KEYTAB_FILE = 't/data/test.keytab'; $Wallet::Config::KEYTAB_PRINCIPAL = contents ('t/data/test.principal'); $Wallet::Config::KEYTAB_REALM = contents ('t/data/test.realm'); + $Wallet::Config::KEYTAB_KRBTYPE = contents ('t/data/test.krbtype'); $Wallet::Config::KEYTAB_TMP = '.'; $Wallet::Config::KEYTAB_AFS_KASETKEY = '../kasetkey/kasetkey'; my $realm = $Wallet::Config::KEYTAB_REALM; @@ -707,8 +724,7 @@ EOO # Tests for enctype restriction. SKIP: { - unless (-f 't/data/test.keytab' - && $Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') { + unless (-f 't/data/test.keytab') { skip 'no keytab configuration', 36; } @@ -716,6 +732,7 @@ SKIP: { $Wallet::Config::KEYTAB_FILE = 't/data/test.keytab'; $Wallet::Config::KEYTAB_PRINCIPAL = contents ('t/data/test.principal'); $Wallet::Config::KEYTAB_REALM = contents ('t/data/test.realm'); + $Wallet::Config::KEYTAB_KRBTYPE = contents ('t/data/test.krbtype'); $Wallet::Config::KEYTAB_TMP = '.'; my $realm = $Wallet::Config::KEYTAB_REALM; my $principal = $Wallet::Config::KEYTAB_PRINCIPAL; diff --git a/tests/server/pod-t.in b/tests/server/pod-t.in index 4973d23..4575ecb 100644 --- a/tests/server/pod-t.in +++ b/tests/server/pod-t.in @@ -15,7 +15,7 @@ plan tests => $total; eval 'use Test::Pod 1.00'; SKIP: { - skip $total, 'Test::Pod 1.00 required for testing POD' if $@; + skip 'Test::Pod 1.00 required for testing POD', $total if $@; for my $file (@files) { pod_file_ok ("@abs_top_srcdir@/server/$file", "server/$file"); } -- cgit v1.2.3 From 346660359be7666e8629c14b2d12cebf794f6f26 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Mon, 8 Feb 2010 15:47:04 -0800 Subject: Coding style and whitespace fixes Combine a long series of eval blocks into a single block and a single error check. Remove trailing whitespace, and in some cases remove trailing () on method calls where the parens aren't useful. --- perl/Wallet/Admin.pm | 28 +++++++++--------- perl/Wallet/Kadmin.pm | 7 ++--- perl/Wallet/Kadmin/Heimdal.pm | 68 +++++++++++++++---------------------------- perl/Wallet/Object/Keytab.pm | 2 +- perl/t/kadmin.t | 6 ++-- perl/t/keytab.t | 2 +- server/wallet-admin | 6 ++-- 7 files changed, 49 insertions(+), 70 deletions(-) diff --git a/perl/Wallet/Admin.pm b/perl/Wallet/Admin.pm index c86cbba..ff87b94 100644 --- a/perl/Wallet/Admin.pm +++ b/perl/Wallet/Admin.pm @@ -477,11 +477,11 @@ actions on the object it returns. =item list_acls(TYPE, SEARCH) -Returns a list of all ACLs matching a search type and string in the -database, or all ACLs if no search information is given. 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 "ADMIN" and ID 1 and one -with name "group/admins" and ID 3, list_acls() with no arguments would +Returns a list of all ACLs matching a search type and string in the +database, or all ACLs if no search information is given. 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 "ADMIN" and ID 1 and one +with name "group/admins" and ID 3, list_acls() with no arguments would return: ([ 1, 'ADMIN' ], [ 3, 'group/admins' ]) @@ -492,18 +492,18 @@ database with no ACLs by calling error(). error() is guaranteed to return the error message if there was an error and undef if there was no error. There are currently two search types. 'empty' takes no arguments, and will -return only those acls that have no entries within them. 'entry' takes two -arguments -- an entry scheme and an entry identifier -- and will return +return only those acls that have no entries within them. 'entry' takes two +arguments -- an entry scheme and an entry identifier -- and will return any ACLs with an entry that matches the given scheme and contains the given identifier. =item list_objects(TYPE, SEARCH) -Returns a list of all objects matching a search type and string in the -database, or all objects in the database if no search information is -given. The return value is a list of references to pairs of type and -name. For example, if two objects existed in the database, both of type -"keytab" and with values "host/example.com" and "foo", list_objects() +Returns a list of all objects matching a search type and string in the +database, or all objects in the database if no search information is +given. The return value is a list of references to pairs of type and +name. For example, if two objects existed in the database, both of type +"keytab" and with values "host/example.com" and "foo", list_objects() with no arguments would return: ([ 'keytab', 'host/example.com' ], [ 'keytab', 'foo' ]) @@ -516,8 +516,8 @@ if there was no error. There are four types of searches currently. 'type' (with a given type) will return only those entries where the type matches the given type. 'owner', with a given owner, will only return those objects owned by the -given acl name. 'flag', with a given flag name, will only return those -items with a flag set to the given value. 'acl' operates like 'owner', +given acl name. 'flag', with a given flag name, will only return those +items with a flag set to the given value. 'acl' operates like 'owner', but will return only those objects that have the given acl name on any of the possible acl settings, not just owner. diff --git a/perl/Wallet/Kadmin.pm b/perl/Wallet/Kadmin.pm index 501bc37..b3a630e 100644 --- a/perl/Wallet/Kadmin.pm +++ b/perl/Wallet/Kadmin.pm @@ -32,15 +32,14 @@ $VERSION = '0.03'; sub new { my ($class) = @_; my ($kadmin); - if (!defined $Wallet::Config::KEYTAB_KRBTYPE - || !$Wallet::Config::KEYTAB_KRBTYPE) { + if (not $Wallet::Config::KEYTAB_KRBTYPE) { die "keytab object implementation not configured\n"; } elsif ($Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') { require Wallet::Kadmin::MIT; - $kadmin = Wallet::Kadmin::MIT->new (); + $kadmin = Wallet::Kadmin::MIT->new; } elsif ($Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal') { require Wallet::Kadmin::Heimdal; - $kadmin = Wallet::Kadmin::Heimdal->new (); + $kadmin = Wallet::Kadmin::Heimdal->new; } else { die "keytab krb server type not set to a valid value\n"; } diff --git a/perl/Wallet/Kadmin/Heimdal.pm b/perl/Wallet/Kadmin/Heimdal.pm index b0010a5..d046162 100644 --- a/perl/Wallet/Kadmin/Heimdal.pm +++ b/perl/Wallet/Kadmin/Heimdal.pm @@ -98,40 +98,27 @@ sub addprinc { my $exists = eval { $self->exists ($principal) }; if ($@) { $self->error ("error adding principal $principal: $@"); - return undef; + return; } return 1 if $exists; # The way Heimdal::Kadm5 works, we create a principal object, create the # actual principal set inactive, then randomize it and activate it. + # # TODO - Paranoia makes me want to set the password to something random # on creation even if it is inactive until after randomized by # module. my $kadmin = $self->{client}; - my $princdata = eval { $kadmin->makePrincipal ($principal) }; - if ($@) { - $self->error ("error adding principal $principal: $@"); - return; - } - - # Disable the principal before creating, until we've randomized the - # password. - my $attrs = eval { $princdata->getAttributes }; - if ($@) { - $self->error ("error adding principal $principal: $@"); - return; + eval { + my $princdata = $kadmin->makePrincipal ($principal); + my $attrs = $princdata->getAttributes; + $attrs |= KRB5_KDB_DISALLOW_ALL_TIX; + $princdata->setAttributes ($attrs); + my $password = 'inactive'; + $kadmin->createPrincipal ($princdata, $password, 0); + $kadmin->randKeyPrincipal ($principal); + $kadmin->enablePrincipal ($principal); } - $attrs |= KRB5_KDB_DISALLOW_ALL_TIX; - eval { $princdata->setAttributes ($attrs) }; - if ($@) { - $self->error ("error adding principal $principal: $@"); - return; - } - - my $password = 'inactive'; - my $test = eval { $kadmin->createPrincipal ($princdata, $password, 0) }; - eval { $kadmin->randKeyPrincipal ($principal) } unless $@; - eval { $kadmin->enablePrincipal ($principal) } unless $@; if ($@) { $self->error ("error adding principal $principal: $@"); return; @@ -156,8 +143,8 @@ sub ktadd { my $kadmin = $self->{client}; eval { $kadmin->randKeyPrincipal ($principal) }; if ($@) { - $self->error ("error creating keytab for $principal: could not " - ."reinit enctypes: $@"); + $self->error ("error creating keytab for $principal: could not" + . " reinit enctypes: $@"); return; } my $princdata = eval { $kadmin->getPrincipal ($principal) }; @@ -165,23 +152,22 @@ sub ktadd { $self->error ("error creating keytab for $principal: $@"); return; } elsif (!$princdata) { - $self->error ("error creating keytab for $principal: principal does " - ."not exist"); + $self->error ("error creating keytab for $principal: principal does" + . " not exist"); return; } # Now actually remove any non-requested enctypes, if we requested any. if (@enctypes) { - my (%wanted); - my $alltypes = $princdata->getKeytypes (); - foreach (@enctypes) { $wanted{$_} = 1 } - foreach my $key (@{$alltypes}) { - my $keytype = ${$key}[0]; + my $alltypes = $princdata->getKeytypes; + my %wanted = map { $_ => 1 } @enctypes; + for my $key (@{ $alltypes }) { + my $keytype = $key->[0]; next if exists $wanted{$keytype}; eval { $princdata->delKeytypes ($keytype) }; if ($@) { - $self->error ("error removing keytype $keytype from the ". - "keytab: $@"); + $self->error ("error removing keytype $keytype from the" + . " keytab: $@"); return; } } @@ -192,12 +178,12 @@ sub ktadd { } } + # Create the keytab. eval { $kadmin->extractKeytab ($princdata, $file) }; if ($@) { $self->error ("error creating keytab for principal: $@"); return; } - return 1; } @@ -226,20 +212,14 @@ sub delprinc { return 1; } -############################################################################## -# Documentation -############################################################################## - -# Create a new MIT kadmin object. Very empty for the moment, but later it -# will probably fill out if we go to using a module rather than calling -# kadmin directly. +# Create a new Heimdal kadmin object. sub new { my ($class) = @_; my $self = { client => undef, }; bless ($self, $class); - $self->{client} = kadmin_client (); + $self->{client} = $self->kadmin_client; return $self; } diff --git a/perl/Wallet/Object/Keytab.pm b/perl/Wallet/Object/Keytab.pm index 22598f1..9fece80 100644 --- a/perl/Wallet/Object/Keytab.pm +++ b/perl/Wallet/Object/Keytab.pm @@ -497,7 +497,7 @@ sub create { if (not $kadmin->addprinc ($name)) { die $kadmin->error, "\n"; - } + } $self = $class->SUPER::create ($type, $name, $dbh, $creator, $host, $time); $self->{kadmin} = $kadmin; return $self; diff --git a/perl/t/kadmin.t b/perl/t/kadmin.t index 96b249b..18d452e 100755 --- a/perl/t/kadmin.t +++ b/perl/t/kadmin.t @@ -29,7 +29,7 @@ use Util; # We test a Wallet::Kadmin::* module's actual workings in the keytab.t tests. # The only things we want to test here are that each module is found, that -# Wallet::Kadmin itself delegates to them, and that the private MIT principal +# Wallet::Kadmin itself delegates to them, and that the private MIT principal # validation works as it should. for my $bad (qw{service\* = host/foo+bar host/foo/bar /bar bar/ rcmd.foo}) { @@ -44,7 +44,7 @@ for my $good (qw{service service/foo bar foo/bar host/example.org # Test creating an MIT object and seeing if the callback works. $Wallet::Config::KEYTAB_KRBTYPE = 'MIT'; -my $kadmin = Wallet::Kadmin->new (); +my $kadmin = Wallet::Kadmin->new; ok (defined ($kadmin), 'MIT kadmin object created'); my $callback = sub { return 1 }; $kadmin->fork_callback ($callback); @@ -64,6 +64,6 @@ SKIP: { undef $Wallet::Config::KEYTAB_REALM; undef $kadmin; $Wallet::Config::KEYTAB_KRBTYPE = 'Heimdal'; - $kadmin = eval { Wallet::Kadmin->new () }; + $kadmin = eval { Wallet::Kadmin->new }; is ($kadmin, undef, 'Heimdal fails properly.'); } diff --git a/perl/t/keytab.t b/perl/t/keytab.t index ab5b19d..d1d5ba6 100755 --- a/perl/t/keytab.t +++ b/perl/t/keytab.t @@ -220,7 +220,7 @@ SKIP: { if ($Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') { is ($@, "invalid principal name wallet\nf\n", ' with the right error'); } elsif ($Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal') { - like ($@, qr/^error adding principal wallet\nf/, + like ($@, qr/^error adding principal wallet\nf/, ' with the right error'); } $object = eval { diff --git a/server/wallet-admin b/server/wallet-admin index 761288d..cd775b6 100755 --- a/server/wallet-admin +++ b/server/wallet-admin @@ -158,7 +158,7 @@ used, the database may also have to be created in advance. =item list (acls | objects) [ [ ... ] ] -Returns a list of ACLs or objects in the database. ACLs will be listed +Returns a list of ACLs or objects in the database. ACLs will be listed in the form: (ACL ID: ) @@ -210,8 +210,8 @@ can be housekept. =item list acls entry -Returns all ACLs containing an entry with given schema and identifier. -The schema is used for an exact search, while the identifier given will +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 -- cgit v1.2.3 From db131dd8fd9fa2438c2f66b4cf52ce6b26076c1d Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Mon, 8 Feb 2010 19:31:44 -0800 Subject: Fix syntax error in Wallet::Kadmin::Heimdal Introduced accidentally during the coding style cleanup. --- perl/Wallet/Kadmin/Heimdal.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/perl/Wallet/Kadmin/Heimdal.pm b/perl/Wallet/Kadmin/Heimdal.pm index d046162..b619ba6 100644 --- a/perl/Wallet/Kadmin/Heimdal.pm +++ b/perl/Wallet/Kadmin/Heimdal.pm @@ -118,7 +118,7 @@ sub addprinc { $kadmin->createPrincipal ($princdata, $password, 0); $kadmin->randKeyPrincipal ($principal); $kadmin->enablePrincipal ($principal); - } + }; if ($@) { $self->error ("error adding principal $principal: $@"); return; -- cgit v1.2.3 From b895ba0ae2baab93badb6d3f59dac14a7443f0b9 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Mon, 8 Feb 2010 19:34:33 -0800 Subject: Don't default the Heimdal kadmin server to localhost If there is no kadmin host set in the configuration, it's supposed to fall back on the krb5.conf setting, not hard-code localhost. --- perl/Wallet/Kadmin/Heimdal.pm | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/perl/Wallet/Kadmin/Heimdal.pm b/perl/Wallet/Kadmin/Heimdal.pm index b619ba6..893be65 100644 --- a/perl/Wallet/Kadmin/Heimdal.pm +++ b/perl/Wallet/Kadmin/Heimdal.pm @@ -57,12 +57,13 @@ sub kadmin_client { and defined ($Wallet::Config::KEYTAB_REALM)) { die "keytab object implementation not configured\n"; } - my $server = $Wallet::Config::KEYTAB_HOST || 'localhost'; my @options = (RaiseError => 1, - Server => $server, Principal => $Wallet::Config::KEYTAB_PRINCIPAL, Realm => $Wallet::Config::KEYTAB_REALM, Keytab => $Wallet::Config::KEYTAB_FILE); + if ($Wallet::Config::KEYTAB_HOST) { + push (@options, Server => $Wallet::Config::KEYTAB_HOST); + } my $client = Heimdal::Kadm5::Client->new (@options); return $client; } -- cgit v1.2.3 From b6cf2f78636970900015e74b03160e7280164e47 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Mon, 8 Feb 2010 19:40:17 -0800 Subject: Use kvno or kgetcred to check principal existance Don't use kadmin to check for principal existence. We want to verify that we can get tickets, not just look at kadmin. Use whatever is found on the user's PATH, not something based on the Kerberos type, since our userspace may not match the server implementation. --- perl/t/keytab.t | 23 ++++++++++++----------- 1 file changed, 12 insertions(+), 11 deletions(-) diff --git a/perl/t/keytab.t b/perl/t/keytab.t index d1d5ba6..5488e28 100755 --- a/perl/t/keytab.t +++ b/perl/t/keytab.t @@ -90,21 +90,22 @@ sub destroy { system_quiet ($Wallet::Config::KEYTAB_KADMIN, @args); } -# Check whether a principal exists. kvno works for MIT, but isn't in the -# Heimdal dist. +# Check whether a principal exists. MIT uses kvno and Heimdal uses kgetcred. +# Note that the Kerberos type may be different than our local userspace, so +# don't use the Kerberos type to decide here. Instead, check for which +# program is available on the path. sub created { my ($principal) = @_; $principal .= '@' . $Wallet::Config::KEYTAB_REALM; - if ($Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') { - local $ENV{KRB5CCNAME} = 'krb5cc_temp'; - getcreds ('t/data/test.keytab', $Wallet::Config::KEYTAB_PRINCIPAL); + local $ENV{KRB5CCNAME} = 'krb5cc_temp'; + getcreds ('t/data/test.keytab', $Wallet::Config::KEYTAB_PRINCIPAL); + if (grep { -x "$_/kvno" } split (':', $ENV{PATH})) { return (system_quiet ('kvno', $principal) == 0); - } elsif ($Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal') { - @args = ('-p', $Wallet::Config::KEYTAB_PRINCIPAL, - '-K', $Wallet::Config::KEYTAB_FILE, - '-r', $Wallet::Config::KEYTAB_REALM, - 'get', $principal); - return (system_quiet ($Wallet::Config::KEYTAB_KADMIN, @args) == 0); + } elsif (grep { -x "$_/kgetcred" } split (':', $ENV{PATH})) { + return (system_quiet ('kgetcred', $principal) == 0); + } else { + warn "# No kvno or kgetcred found\n"; + return; } } -- cgit v1.2.3 From 9578292176bef1e1d71cdecd9c2b8d797f6586de Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Mon, 8 Feb 2010 19:41:17 -0800 Subject: Add to-do items for the next release --- TODO | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/TODO b/TODO index beb123d..8fdbfe5 100644 --- a/TODO +++ b/TODO @@ -1,5 +1,14 @@ wallet To-Do List +Release 0.10: + +* Switch to using a disk cache in case the wallet client and libremctl are + built against different versions of Kerberos. + +* Remove stub fork hook from Wallet::Kadmin::MIT. + +* Move reporting code from Wallet::Admin to Wallet::Report. + Release 1.0: * Fix case-insensitivity bug in unique keys with MySQL for objects. -- cgit v1.2.3 From b093893870d56cd460b16645496ec6c30c62a02f Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Mon, 8 Feb 2010 19:41:27 -0800 Subject: Initial port to Heimdal Just get the client code to compile with Heimdal. This will need more work later to use my regular Kerberos portability layer. --- client/keytab.c | 4 ++++ client/srvtab.c | 13 +++++++++++++ configure.ac | 4 ++++ 3 files changed, 21 insertions(+) diff --git a/client/keytab.c b/client/keytab.c index 2d31a27..bdd0134 100644 --- a/client/keytab.c +++ b/client/keytab.c @@ -47,7 +47,11 @@ merge_keytab(krb5_context ctx, const char *newfile, const char *file) status = krb5_kt_add_entry(ctx, old, &entry); if (status != 0) die_krb5(ctx, status, "cannot write to keytab %s", file); +#ifdef HAVE_KRB5_KT_FREE_ENTRY + krb5_kt_free_entry(ctx, &entry); +#else krb5_free_keytab_entry_contents(ctx, &entry); +#endif } if (status != KRB5_KT_END) die_krb5(ctx, status, "error reading temporary keytab %s", newfile); diff --git a/client/srvtab.c b/client/srvtab.c index 0cca70d..a01026e 100644 --- a/client/srvtab.c +++ b/client/srvtab.c @@ -58,8 +58,13 @@ write_srvtab(krb5_context ctx, const char *srvtab, const char *principal, ret = krb5_kt_get_entry(ctx, kt, princ, 0, ENCTYPE_DES_CBC_CRC, &entry); if (ret != 0) die_krb5(ctx, ret, "error reading DES key from keytab %s", keytab); +#ifdef HAVE_KRB5_KEYTAB_ENTRY_KEYBLOCK + if (entry.keyblock.keyvalue.length != 8) + die("invalid DES key length in keytab"); +#else if (entry.key.length != 8) die("invalid DES key length in keytab"); +#endif krb5_kt_close(ctx, kt); /* Convert the principal to a Kerberos v4 principal. */ @@ -80,9 +85,17 @@ write_srvtab(krb5_context ctx, const char *srvtab, const char *principal, length += strlen(realm); data[length++] = '\0'; data[length++] = '\0'; +#ifdef HAVE_KRB5_KEYTAB_ENTRY_KEYBLOCK + memcpy(data + length, entry.keyblock.keyvalue.data, 8); +#else memcpy(data + length, entry.key.contents, 8); +#endif length += 8; +#ifdef HAVE_KRB5_KT_FREE_ENTRY + krb5_kt_free_entry(ctx, &entry); +#else krb5_free_keytab_entry_contents(ctx, &entry); +#endif /* Write out the srvtab file. */ write_file(srvtab, data, length); diff --git a/configure.ac b/configure.ac index bada657..bc55ad0 100644 --- a/configure.ac +++ b/configure.ac @@ -45,6 +45,10 @@ AC_ARG_WITH([wallet-port], RRA_LIB_REMCTL RRA_LIB_KRB5 +RRA_LIB_KRB5_SWITCH +AC_CHECK_FUNCS([krb5_kt_free_entry]) +AC_CHECK_MEMBERS([krb5_keytab_entry.keyblock], , , [#include ]) +RRA_LIB_KRB5_RESTORE RRA_LIB_AFS AS_IF([test x"$rra_afs" = xtrue], [RRA_LIB_KRB4 -- cgit v1.2.3 From a96f4abbbe8176101584e414be5139e244377025 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Mon, 8 Feb 2010 19:46:54 -0800 Subject: Use Wallet::Kadmin to do kadmin operations in the keytab test Now that we have Wallet::Kadmin, use it, rather than running the kadmin client program. We may not have the same kadmin client program as the server that we're testing against. --- perl/t/keytab.t | 36 ++++++++---------------------------- 1 file changed, 8 insertions(+), 28 deletions(-) diff --git a/perl/t/keytab.t b/perl/t/keytab.t index 5488e28..25e946c 100755 --- a/perl/t/keytab.t +++ b/perl/t/keytab.t @@ -3,16 +3,17 @@ # t/keytab.t -- Tests for the keytab object implementation. # # Written by Russ Allbery -# Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2008, 2009, 2010 +# Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. use POSIX qw(strftime); -use Test::More tests => 212 -; +use Test::More tests => 212; use Wallet::Admin; use Wallet::Config; +use Wallet::Kadmin; use Wallet::Object::Keytab; use lib 't/lib'; @@ -57,37 +58,16 @@ sub system_quiet { # been set up. sub create { my ($principal) = @_; - if ($Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') { - my @args = ('-p', $Wallet::Config::KEYTAB_PRINCIPAL, '-k', - '-t', $Wallet::Config::KEYTAB_FILE, - '-r', $Wallet::Config::KEYTAB_REALM, - '-q', "addprinc -clearpolicy -randkey $principal"); - } elsif ($Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal') { - @args = ('-p', $Wallet::Config::KEYTAB_PRINCIPAL, - '-K', $Wallet::Config::KEYTAB_FILE, - '-r', $Wallet::Config::KEYTAB_REALM, - 'add', $principal); - } - system_quiet ($Wallet::Config::KEYTAB_KADMIN, @args); + my $kadmin = Wallet::Kadmin->new; + return $kadmin->addprinc ($principal); } # Destroy a principal out of Kerberos. Only usable once the configuration has # been set up. sub destroy { my ($principal) = @_; - my (@args); - if ($Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') { - @args = ('-p', $Wallet::Config::KEYTAB_PRINCIPAL, '-k', - '-t', $Wallet::Config::KEYTAB_FILE, - '-r', $Wallet::Config::KEYTAB_REALM, - '-q', "delprinc -force $principal"); - } elsif ($Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal') { - @args = ('-p', $Wallet::Config::KEYTAB_PRINCIPAL, - '-K', $Wallet::Config::KEYTAB_FILE, - '-r', $Wallet::Config::KEYTAB_REALM, - 'delete', $principal); - } - system_quiet ($Wallet::Config::KEYTAB_KADMIN, @args); + my $kadmin = Wallet::Kadmin->new; + return $kadmin->delprinc ($principal); } # Check whether a principal exists. MIT uses kvno and Heimdal uses kgetcred. -- cgit v1.2.3 From ab7df231106dc67ba96b4ff7b5483370bfcba969 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Mon, 8 Feb 2010 19:58:20 -0800 Subject: Fix canonicalization of principals for Heimdal All the Wallet::Kadmin::Heimdal functions were canonicalizing principals using duplicate code, and that code assumed that all principal names would be unqualified. Centralize that code in one helper routine and support already-qualified principals so that we can use these functions easily from the test suite. --- perl/Wallet/Kadmin/Heimdal.pm | 27 +++++++++++++-------------- 1 file changed, 13 insertions(+), 14 deletions(-) diff --git a/perl/Wallet/Kadmin/Heimdal.pm b/perl/Wallet/Kadmin/Heimdal.pm index 893be65..2ca8dcd 100644 --- a/perl/Wallet/Kadmin/Heimdal.pm +++ b/perl/Wallet/Kadmin/Heimdal.pm @@ -39,6 +39,15 @@ sub error { return $self->{error}; } +# Add the realm to the end of the principal if no realm is currently present. +sub canonicalize_principal { + my ($self, $principal) = @_; + if ($Wallet::Config::KEYTAB_REALM && $principal !~ /\@/) { + $principal .= '@' . $Wallet::Config::KEYTAB_REALM; + } + return $principal; +} + # Set a callback to be called for forked kadmin processes. This does nothing # for Heimdal, as we're not forking anything, but remains for compatibility # with the MIT kadmin module. @@ -76,9 +85,7 @@ sub kadmin_client { # so, false otherwise. sub exists { my ($self, $principal) = @_; - if ($Wallet::Config::KEYTAB_REALM) { - $principal .= '@' . $Wallet::Config::KEYTAB_REALM; - } + $principal = $self->canonicalize_principal ($principal); my $kadmin = $self->{client}; my $princdata = eval { $kadmin->getPrincipal ($principal) }; if ($@) { @@ -92,10 +99,7 @@ sub exists { # the error. Return 1 on success or the principal already existing. sub addprinc { my ($self, $principal) = @_; - - if ($Wallet::Config::KEYTAB_REALM) { - $principal .= '@' . $Wallet::Config::KEYTAB_REALM; - } + $principal = $self->canonicalize_principal ($principal); my $exists = eval { $self->exists ($principal) }; if ($@) { $self->error ("error adding principal $principal: $@"); @@ -133,9 +137,7 @@ sub addprinc { # error. sub ktadd { my ($self, $principal, $file, @enctypes) = @_; - if ($Wallet::Config::KEYTAB_REALM) { - $principal .= '@' . $Wallet::Config::KEYTAB_REALM; - } + $principal = $self->canonicalize_principal ($principal); # The way Heimdal works, you can only remove enctypes from a principal, # not add them back in. So we need to run randkeyPrincipal first each @@ -193,6 +195,7 @@ sub ktadd { # exist, return success; we're bringing reality in line with our expectations. sub delprinc { my ($self, $principal) = @_; + $principal = $self->canonicalize_principal ($principal); my $exists = eval { $self->exists ($principal) }; if ($@) { $self->error ("error checking principal existance: $@"); @@ -200,10 +203,6 @@ sub delprinc { } elsif (not $exists) { return 1; } - if ($Wallet::Config::KEYTAB_REALM) { - $principal .= '@' . $Wallet::Config::KEYTAB_REALM; - } - my $kadmin = $self->{client}; my $retval = eval { $kadmin->deletePrincipal ($principal) }; if ($@) { -- cgit v1.2.3 From c2422d4f762b5db774c6e0fef2cb2de916904f0e Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Mon, 8 Feb 2010 19:59:26 -0800 Subject: Redo how we find enctypes in the keytab test suite We may have a different userspace than the Kerberos type, so always try klist -ke first and then fall back on ktutil if it fails. Also display the error message in a few more places if things fail, discovered as useful when debugging other problems. --- perl/t/keytab.t | 36 ++++++++++++++++++++++-------------- 1 file changed, 22 insertions(+), 14 deletions(-) diff --git a/perl/t/keytab.t b/perl/t/keytab.t index 25e946c..c3e89d5 100755 --- a/perl/t/keytab.t +++ b/perl/t/keytab.t @@ -116,19 +116,22 @@ sub enctypes { close KEYTAB; my @enctypes; - if ($Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') { - open (KLIST, '-|', 'klist', '-ke', 'keytab') - or die "cannot run klist: $!\n"; - local $_; - while () { - next unless /^ *\d+ /; - my ($string) = /\((.*)\)\s*$/; - next unless $string; - $enctype = $enctype{lc $string} || 'UNKNOWN'; - push (@enctypes, $enctype); - } - close KLIST; - } elsif ($Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal') { + open (KLIST, '-|', 'klist', '-ke', 'keytab') + or die "cannot run klist: $!\n"; + local $_; + while () { + next unless /^ *\d+ /; + my ($string) = /\((.*)\)\s*$/; + next unless $string; + $enctype = $enctype{lc $string} || 'UNKNOWN'; + push (@enctypes, $enctype); + } + close KLIST; + + # If that failed, we may have a Heimdal user space instead, so try ktutil. + # If we try this directly, it will just hang with MIT ktutil. + if ($? != 0) { + @enctypes = (); open (KTUTIL, '-|', 'ktutil', '-k', 'keytab', 'list') or die "cannot run ktutil: $!\n"; local $_; @@ -227,9 +230,14 @@ SKIP: { $object = eval { Wallet::Object::Keytab->create ('keytab', 'wallet/two', $dbh, @trace) }; - ok (defined ($object), 'Creating an existing principal succeeds'); + if (defined ($object)) { + ok (defined ($object), 'Creating an existing principal succeeds'); + } else { + is ($@, '', 'Creating an existing principal succeeds'); + } ok ($object->isa ('Wallet::Object::Keytab'), ' and is the right class'); is ($object->destroy (@trace), 1, ' and destroying it succeeds'); + is ($object->error, undef, ' with no error message'); ok (! created ('wallet/two'), ' and now it does not exist'); my @name = qw(keytab wallet-test/one); $object = eval { Wallet::Object::Keytab->create (@name, $dbh, @trace) }; -- cgit v1.2.3 From 954151bb1aeb8920b0077692db1705c39ff76eda Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Mon, 8 Feb 2010 20:08:32 -0800 Subject: Additional cleanup of the keytab test suite Map the AES enctype to the full enctype name, which will work for both MIT and Heimdal. Fix the test count. Really test rollback from invalid enctypes (what we did before made no sense). Skip tests that will just fail if the enctype stuff is not working, since otherwise it confuses matters. --- perl/t/keytab.t | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/perl/t/keytab.t b/perl/t/keytab.t index c3e89d5..93df51c 100755 --- a/perl/t/keytab.t +++ b/perl/t/keytab.t @@ -9,7 +9,7 @@ # See LICENSE for licensing terms. use POSIX qw(strftime); -use Test::More tests => 212; +use Test::More tests => 213; use Wallet::Admin; use Wallet::Config; @@ -26,7 +26,7 @@ my %enctype = ('triple des cbc mode with hmac/sha1' => 'des3-cbc-sha1', 'des cbc mode with crc-32' => 'des-cbc-crc', 'des cbc mode with rsa-md5' => 'des-cbc-md5', - 'aes-256 cts mode with 96-bit sha-1 hmac' => 'aes256-cts', + 'aes-256 cts mode with 96-bit sha-1 hmac' => 'aes256-cts-hmac-sha1-96', 'arcfour with hmac/md5' => 'rc4-hmac'); # Some global defaults to use. @@ -788,8 +788,7 @@ EOO 'Setting an unrecognized enctype fails'); is ($one->error, 'unknown encryption type foo-bar', ' with the right error message'); - @values = enctypes ($keytab); - is ("@values", "@enctypes", ' and we did rollback properly'); + is ($one->show, $expected, ' and we did rollback properly'); $history .= <<"EOO"; $date get by $user from $host @@ -810,8 +809,12 @@ EOO is ("@values", $enctypes[0], ' and we get back the right value'); $keytab = $one->get (@trace); ok (defined ($keytab), ' and retrieving the keytab still works'); - @values = enctypes ($keytab); - is ("@values", $enctypes[0], ' and it has the right enctype'); + if (defined ($keytab)) { + @values = enctypes ($keytab); + is ("@values", $enctypes[0], ' and it has the right enctype'); + } else { + ok (0, ' and it has the right keytab'); + } is ($one->attr ('enctypes', [ $enctypes[1] ], @trace), 1, 'Setting a different single enctype works'); @values = $one->attr ('enctypes'); -- cgit v1.2.3 From fc8433e3636fd9400d2a3878aa5a93967ee2f3b4 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Mon, 8 Feb 2010 21:58:13 -0800 Subject: More to-do items for the 0.10 release --- TODO | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/TODO b/TODO index 8fdbfe5..31db370 100644 --- a/TODO +++ b/TODO @@ -7,6 +7,10 @@ Release 0.10: * Remove stub fork hook from Wallet::Kadmin::MIT. +* Handle unchanging support for Heimdal. + +* Fix the Wallet::Kadmin API to use more generic function names. + * Move reporting code from Wallet::Admin to Wallet::Report. Release 1.0: -- cgit v1.2.3 From 26619788ec1f818a567bd1eb3208a541ce6a27a5 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 9 Feb 2010 13:04:15 -0800 Subject: Add more to-do items for the next release --- TODO | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/TODO b/TODO index 31db370..7448019 100644 --- a/TODO +++ b/TODO @@ -13,6 +13,14 @@ Release 0.10: * Move reporting code from Wallet::Admin to Wallet::Report. +* Refactor attribute handling code in Wallet::Object::Keytab, move to + Wallet::Object::Base. + +* Check whether we can just drop the realm restriction on keytabs and + allow the name to contain the realm if the Kerberos type is Heimdal. + +* Make MIT and Heimdal case-insensitive in the configuration file. + Release 1.0: * Fix case-insensitivity bug in unique keys with MySQL for objects. -- cgit v1.2.3 From 59455fd5e6a47a66a2a84779f42928fd66ec9747 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 9 Feb 2010 13:06:31 -0800 Subject: Remove kaserver synchronization support from the wallet backend Remove kaserver synchronization support. It is no longer tested, and retaining the code was increasing the complexity of wallet, and some specific requirements (such as different realm names between kaserver and Kerberos v5 and the kvno handling) were Stanford-specific. Rather than using this support, AFS sites running kaserver will probably find deploying Heimdal with its internal kaserver compatibility is probably an easier transition approach. --- NEWS | 8 + perl/Wallet/Config.pm | 83 +--------- perl/Wallet/Object/Keytab.pm | 349 +++++++------------------------------------ perl/Wallet/Schema.pm | 10 +- perl/t/config.t | 6 +- perl/t/keytab.t | 217 ++------------------------- perl/t/schema.t | 2 +- 7 files changed, 86 insertions(+), 589 deletions(-) diff --git a/NEWS b/NEWS index 04942ea..3185db3 100644 --- a/NEWS +++ b/NEWS @@ -2,6 +2,14 @@ wallet 0.10 (unreleased) + Remove kaserver synchronization support. It is no longer tested, and + retaining the code was increasing the complexity of wallet, and some + specific requirements (such as different realm names between kaserver + and Kerberos v5 and the kvno handling) were Stanford-specific. Rather + than using this support, AFS sites running kaserver will probably find + deploying Heimdal with its internal kaserver compatibility is probably + an easier transition approach. + Correctly handle storing of data that begins with a dash and don't parse it as an argument to wallet-backend. diff --git a/perl/Wallet/Config.pm b/perl/Wallet/Config.pm index 3f52cf0..7198c07 100644 --- a/perl/Wallet/Config.pm +++ b/perl/Wallet/Config.pm @@ -1,7 +1,7 @@ # Wallet::Config -- Configuration handling for the wallet server. # # Written by Russ Allbery -# 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. @@ -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.03'; +$VERSION = '0.04'; # Path to the config file to load. $PATH = $ENV{WALLET_CONFIG} || '/etc/wallet/wallet.conf'; @@ -351,85 +351,6 @@ our $KEYTAB_REMCTL_PORT; =back -=head2 Synchronization with AFS kaserver - -The keytab backend optionally supports synchronizing keys between the -Kerberos v5 realm and a Kerberos v4 realm using kaserver. This -synchronization is done using B and is controlled by the C -attribute on keytab objects. To configure that support, set the following -variables. - -=over 4 - -=item KEYTAB_AFS_ADMIN - -The Kerberos v4 principal to use for authentication to the AFS kaserver. If -this principal is not in the default local Kerberos v4 realm, it must be -fully qualified. A srvtab for this principal must be stored in the path set -in $KEYTAB_AFS_SRVTAB. This principal must have the ADMIN flag set in the -AFS kaserver so that it can create and remove principals. This variable -must be set to use the kaserver synchronization support. - -=cut - -our $KEYTAB_AFS_ADMIN; - -=item KEYTAB_AFS_DESTROY - -If this variable, which is false by default, is set to a true value, each -time a keytab object that is not configured to be synchronized with the AFS -kaserver, the corresponding Kerberos v4 principal will be deleted from the -AFS kaserver. Use this with caution; it will cause the AFS kaserver realm -to be slowly stripped of principals. This is intended for use with -migration from Kerberos v4 to Kerberos v5, where the old principals should -be deleted out of Kerberos v4 whenever not requested from the wallet to aid -in tracking down and removing any systems with lingering Kerberos v4 -dependencies. - -Be aware that multiple Kerberos v5 principals map to the same Kerberos v4 -principal since in Kerberos v4 the domain name is stripped from the -principal for machine principals. If you create a keytab named -host/foo.example.com and mark it synchronized, and then create another -keytab named host/foo.example.net and don't mark it synchronized, -downloading the second will destroy the Kerberos v4 principal of the first -if this variable is set. - -=cut - -our $KEYTAB_AFS_DESTROY; - -=item KEYTAB_AFS_KASETKEY - -The path to the B command-line client. The default value is -C, which will cause the wallet to search for B on its -default PATH. - -=cut - -our $KEYTAB_AFS_KASETKEY = 'kasetkey'; - -=item KEYTAB_AFS_REALM - -The name of the Kerberos v4 realm with which to synchronize keys. This is a -realm, not a cell, so it should be in all uppercase. If this variable is -not set, the default is the realm determined from the local cell name. - -=cut - -our $KEYTAB_AFS_REALM; - -=item KEYTAB_AFS_SRVTAB - -The path to a srvtab used to authenticate to the AFS kaserver. This srvtab -should be for the principal set in $KEYTAB_AFS_ADMIN. This variable must be -set to use the kaserver synchronization support. - -=cut - -our $KEYTAB_AFS_SRVTAB; - -=back - =head1 NETDB ACL CONFIGURATION These configuration variables are only needed if you intend to use the diff --git a/perl/Wallet/Object/Keytab.pm b/perl/Wallet/Object/Keytab.pm index 9fece80..b604907 100644 --- a/perl/Wallet/Object/Keytab.pm +++ b/perl/Wallet/Object/Keytab.pm @@ -1,7 +1,8 @@ # Wallet::Object::Keytab -- Keytab object implementation for the wallet. # # Written by Russ Allbery -# 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. @@ -24,230 +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.07'; - -############################################################################## -# AFS kaserver synchronization -############################################################################## - -# Given a Kerberos v5 principal name, convert it to a Kerberos v4 principal -# name. Returns undef if it can't convert the name for some reason (right -# now, only if the principal has more than two parts). Note that this mapping -# does not guarantee a unique result; multiple hosts in different domains can -# be mapped to the same Kerberos v4 principal name using this function. -sub kaserver_name { - my ($self, $k5) = @_; - my %host = map { $_ => 1 } qw(host ident imap pop smtp); - $k5 =~ s/\@.*//; - my @parts = split ('/', $k5); - if (@parts > 2) { - return; - } elsif (@parts == 2 and $host{$parts[0]}) { - $parts[1] =~ s/\..*//; - $parts[0] = 'rcmd' if $parts[0] eq 'host'; - } - my $k4 = join ('.', @parts); - if ($Wallet::Config::KEYTAB_AFS_REALM) { - $k4 .= '@' . $Wallet::Config::KEYTAB_AFS_REALM; - } - return $k4; -} - -# Run kasetkey with the given arguments. Returns true on success and false on -# failure. On failure, sets the internal error to the error from kasetkey. -sub kaserver_kasetkey { - my ($self, @args) = @_; - my $admin = $Wallet::Config::KEYTAB_AFS_ADMIN; - my $admin_srvtab = $Wallet::Config::KEYTAB_AFS_SRVTAB; - my $kasetkey = $Wallet::Config::KEYTAB_AFS_KASETKEY; - unless ($kasetkey and $admin and $admin_srvtab) { - $self->error ('kaserver synchronization not configured'); - return; - } - my $pid = open (KASETKEY, '-|'); - if (not defined $pid) { - $self->error ("cannot fork: $!"); - return; - } elsif ($pid == 0) { - # Don't use die here; it will get trapped as an exception. Also be - # careful about our database handles. (We still lose if there's some - # other database handle open we don't know about.) - $self->{dbh}->{InactiveDestroy} = 1; - unless (open (STDERR, '>&STDOUT')) { - warn "cannot redirect stderr: $!\n"; - exit 1; - } - unless (exec ($kasetkey, '-k', $admin_srvtab, '-a', $admin, @args)) { - warn "cannot exec $kasetkey: $!\n"; - exit 1; - } - } else { - local $/; - my $output = ; - close KASETKEY; - if ($? != 0) { - $output =~ s/\s+\z//; - $output =~ s/\n/, /g; - $output = ': ' . $output if $output; - $self->error ("cannot synchronize key with kaserver$output"); - return; - } - } - return 1; -} - -# Given a keytab file name, the Kerberos v5 principal that's stored in that -# keytab, a srvtab file name, and the corresponding Kerberos v4 principal, -# write out a srvtab file containing the DES key in that keytab. Fails if -# there is no DES key in the keytab. -sub kaserver_srvtab { - my ($self, $keytab, $k5, $srvtab, $k4) = @_; - - # Gah. Someday I will write Perl bindings for Kerberos that are less - # broken. - eval { require Authen::Krb5 }; - if ($@) { - $self->error ("kaserver synchronization support not available: $@"); - return; - } - eval { Authen::Krb5::init_context() }; - if ($@ and not $@ =~ /^Authen::Krb5 already initialized/) { - $self->error ('Kerberos initialization failed'); - return; - } - undef $@; - - # Do the interface dance. We call kt_read_service_key with 0 for the kvno - # to get any kvno, which works with MIT Kerberos at least. Assume a DES - # enctype of 1. This code won't work with any enctype other than - # des-cbc-crc. - my $princ = Authen::Krb5::parse_name ($k5); - unless (defined $princ) { - my $error = Authen::Krb5::error(); - $self->error ("cannot parse $k5: $error"); - return; - } - my $key = Authen::Krb5::kt_read_service_key ($keytab, $princ, 0, 1); - unless (defined $key) { - my $error = Authen::Krb5::error(); - $self->error ("cannot find des-cbc-crc key in $keytab: $error"); - return; - } - unless (open (SRVTAB, '>', $srvtab)) { - $self->error ("cannot create $srvtab: $!"); - return; - } - - # srvtab format is nul-terminated name, nul-terminated instance, - # nul-terminated realm, single character kvno (which we always set to 0), - # and DES keyblock. - my ($principal, $realm) = split ('@', $k4); - $realm ||= ''; - my ($name, $inst) = split (/\./, $principal, 2); - $inst ||= ''; - my $data = join ("\0", $name, $inst, $realm); - $data .= "\0\0" . $key->contents; - print SRVTAB $data; - unless (close SRVTAB) { - unlink $srvtab; - $self->error ("cannot write to $srvtab: $!"); - return; - } - return 1; -} - -# Given a principal name and a path to the keytab, synchronizes the key with a -# principal in an AFS kaserver. Returns true on success and false on failure. -# On failure, sets the internal error. -sub kaserver_sync { - my ($self, $principal, $keytab) = @_; - if ($Wallet::Config::KEYTAB_REALM) { - $principal .= '@' . $Wallet::Config::KEYTAB_REALM; - } - my $k4 = $self->kaserver_name ($principal); - if (not defined $k4) { - $self->error ("cannot convert $principal to Kerberos v4"); - return; - } - my $srvtab = $Wallet::Config::KEYTAB_TMP . "/srvtab.$$"; - unless ($self->kaserver_srvtab ($keytab, $principal, $srvtab, $k4)) { - return; - } - unless ($self->kaserver_kasetkey ('-c', $srvtab, '-s', $k4)) { - unlink $srvtab; - return; - } - unlink $srvtab; - return 1; -} - -# Given a principal name, destroy the corresponding principal in the AFS -# kaserver. Returns true on success and false on failure, setting the object -# error if it fails. -sub kaserver_destroy { - my ($self, $principal) = @_; - my $k4 = $self->kaserver_name ($principal); - if (not defined $k4) { - $self->error ("cannot convert $principal to Kerberos v4"); - return; - } - return $self->kaserver_kasetkey ('-D', $k4); -} - -# Set the kaserver sync attribute. Called by attr(). Returns true on success -# and false on failure, setting the object error if it fails. -sub kaserver_set { - my ($self, $user, $host, $time) = @_; - $time ||= time; - my @trace = ($user, $host, $time); - my $name = $self->{name}; - eval { - my $sql = "select ks_name from keytab_sync where ks_name = ? and - ks_target = 'kaserver'"; - my $result = $self->{dbh}->selectrow_array ($sql, undef, $name); - if ($result) { - die "kaserver synchronization already set\n"; - } - $sql = "insert into keytab_sync (ks_name, ks_target) - values (?, 'kaserver')"; - $self->{dbh}->do ($sql, undef, $name); - $self->log_set ('type_data sync', undef, 'kaserver', @trace); - $self->{dbh}->commit; - }; - if ($@) { - $self->error ($@); - $self->{dbh}->rollback; - return; - } - return 1; -} - -# Clear the kaserver sync attribute. Called by attr(). Returns true on -# success and false on failure, setting the object error if it fails. -sub kaserver_clear { - my ($self, $user, $host, $time) = @_; - $time ||= time; - my @trace = ($user, $host, $time); - my $name = $self->{name}; - eval { - my $sql = "select ks_name from keytab_sync where ks_name = ? and - ks_target = 'kaserver'"; - my $result = $self->{dbh}->selectrow_array ($sql, undef, $name); - unless ($result) { - die "kaserver synchronization not set\n"; - } - $sql = 'delete from keytab_sync where ks_name = ?'; - $self->{dbh}->do ($sql, undef, $name); - $self->log_set ('type_data sync', 'kaserver', undef, @trace); - $self->{dbh}->commit; - }; - if ($@) { - $self->error ($@); - $self->{dbh}->rollback; - return; - } - return 1; -} +$VERSION = '0.08'; ############################################################################## # Enctype restriction @@ -379,9 +157,14 @@ sub keytab_retrieve { # Core methods ############################################################################## -# Override attr to support setting the enctypes and sync attributes. +# Override attr to support setting the enctypes and sync attributes. Note +# that the sync attribute has no supported targets at present and hence will +# always return an error, but the code is still here so that it doesn't have +# to be rewritten once a new sync target is added. sub attr { my ($self, $attribute, $values, $user, $host, $time) = @_; + $time ||= time; + my @trace = ($user, $host, $time); my %known = map { $_ => 1 } qw(enctypes sync); undef $self->{error}; unless ($known{$attribute}) { @@ -395,14 +178,25 @@ sub attr { if (@$values > 1) { $self->error ('only one synchronization target supported'); return; - } elsif (@$values and $values->[0] ne 'kaserver') { + } elsif (@$values) { my $target = $values->[0]; $self->error ("unsupported synchronization target $target"); return; - } elsif (@$values) { - return $self->kaserver_set ($user, $host, $time); } else { - return $self->kaserver_clear ($user, $host, $time); + eval { + my $sql = 'select ks_target from keytab_sync where + ks_name = ?'; + my $dbh = $self->{dbh}; + my $name = $self->{name}; + my ($result) = $dbh->selectrow_array ($sql, undef, $name); + if ($result) { + my $sql = 'delete from keytab_sync where ks_name = ?'; + $self->{dbh}->do ($sql, undef, $name); + $self->log_set ('type_data sync', $result, undef, + @trace); + } + $self->{dbh}->commit; + } } } } else { @@ -511,12 +305,6 @@ sub destroy { $self->error ("cannot destroy $id: object is locked"); return; } - my @sync = $self->attr ('sync'); - if (grep { $_ eq 'kaserver' } @sync) { - unless ($self->kaserver_destroy ($self->{name})) { - return; - } - } eval { my $sql = 'delete from keytab_sync where ks_name = ?'; $self->{dbh}->do ($sql, undef, $self->{name}); @@ -582,15 +370,6 @@ sub get { return; } close KEYTAB; - my @sync = $self->attr ('sync'); - if (grep { $_ eq 'kaserver' } @sync) { - unless ($self->kaserver_sync ($self->{name}, $file)) { - unlink $file; - return; - } - } elsif ($Wallet::Config::KEYTAB_AFS_DESTROY) { - $self->kaserver_destroy ($self->{name}); - } unlink $file; $self->log_action ('get', $user, $host, $time); return $data; @@ -646,7 +425,7 @@ methods that are overridden or behave specially for this implementation. =item attr(ATTRIBUTE [, VALUES, PRINCIPAL, HOSTNAME [, DATETIME]]) -Sets or retrieves a given object attribute. The following attributes are +Sets or retrieves a given object attribute. The following attribute is supported: =over 4 @@ -655,40 +434,21 @@ supported: 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 or C). Encryption types must also -be present in the list of supported enctypes stored in the database database -or the attr() method will reject them. Note that the salt should not be -included; since the salt is irrelevant for keytab keys, it will always be -set to C by the wallet. +(strings like C or C). Encryption +types must also be present in the list of supported enctypes stored in the +database database or the attr() method will reject them. Note that the +salt should not be included; since the salt is irrelevant for keytab keys, +it will always be set to the default 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 principal will be restricted to that +specific enctype list 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 flag is set on a keytab. Keytabs retrieved with C 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, -which says to synchronize the key with an AFS Kerberos v4 kaserver. - -If this attribute is set on a keytab, whenever get() is called for that -keytab, the new 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, C, C, C, or -C; and the first component is C if the Kerberos v5 principal -component is C. The principal name must not contain more than two -components. - -If this attribute is set, calling destroy() will also destroy the principal -from the AFS kaserver, with a principal mapping determined as above. - =back If no other arguments besides ATTRIBUTE are given, returns the values of @@ -716,11 +476,11 @@ used. When a new keytab object is created, the Kerberos principal designated by NAME is also created in the Kerberos realm determined from the wallet -configuration. If the principal already exists, create() still succeeds (so -that a previously unmanaged principal can be imported into the wallet). -Otherwise, if the Kerberos principal could not be created, create() fails. -The principal is created with the C<-randkey> option to randomize its keys. -NAME must not contain the realm; instead, the KEYTAB_REALM configuration +configuration. If the principal already exists, create() still succeeds +(so that a previously unmanaged principal can be imported into the +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. If create() fails, it throws an exception. @@ -738,18 +498,14 @@ destroying the object. If DATETIME isn't given, the current time is used. =item get(PRINCIPAL, HOSTNAME [, DATETIME]) -Retrieves a keytab for this object and returns the keytab data or undef -on error. The caller should call error() to get the error message if -get() returns undef. The keytab is created with C, invalidating -any existing keytabs for that principal, unless the unchanging flag is set -on the object. PRINCIPAL, HOSTNAME, and DATETIME are stored as history -information. PRINCIPAL should be the user who is downloading the keytab. -If DATETIME isn't given, the current time is used. - -If the configuration variable $KEYTAB_AFS_DESTROY is set and the C -attribute is not set to C, calling get() on a keytab object will -cause the corresponding Kerberos v4 principal to be destroyed. This -variable is not set by default. +Retrieves a keytab for this object and returns the keytab data or undef on +error. The caller should call error() to get the error message if get() +returns undef. The keytab is created with new randomized keys, +invalidating any existing keytabs for that principal, unless the +unchanging flag is set on the object. PRINCIPAL, HOSTNAME, and DATETIME +are stored as history information. PRINCIPAL should be the user who is +downloading the keytab. If DATETIME isn't given, the current time is +used. =back @@ -767,15 +523,14 @@ of the current process. The file is unlinked after being read. =head1 LIMITATIONS -Currently, this implementation only supports MIT Kerberos and needs -modifications to support Heimdal. It calls an external B program -rather than using a native Perl module and therefore requires B be -installed and parses its output. It may miss some error conditions if the -output of B ever changes. +Currently, when used with MIT Kerberos, this implementation calls an +external B program rather than using a native Perl module and +therefore requires B be installed and parses its output. It may +miss some error conditions if the output of B ever changes. Only one Kerberos realm is supported for a given wallet implementation and -all keytab objects stored must be in that realm. Keytab names in the wallet -database do not have realm information. +all keytab objects stored must be in that realm. Keytab names in the +wallet database do not have realm information. =head1 SEE ALSO diff --git a/perl/Wallet/Schema.pm b/perl/Wallet/Schema.pm index 2b256a2..252da03 100644 --- a/perl/Wallet/Schema.pm +++ b/perl/Wallet/Schema.pm @@ -1,7 +1,7 @@ # Wallet::Schema -- Database schema for the wallet system. # # Written by Russ Allbery -# 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. @@ -20,7 +20,7 @@ use DBI; # 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.05'; +$VERSION = '0.06'; ############################################################################## # Data manipulation @@ -372,12 +372,12 @@ change was made. =head2 Keytab Backend Data -The keytab backend supports synchronizing keys with an external system. The -permitted external systems are listed in a normalization table: +The keytab backend has stub support for synchronizing keys with an +external system, although no external systems are currently supported. +The permitted external systems are listed in a normalization table: create table sync_targets (st_name varchar(255) primary key); - insert into sync_targets (st_name) values ('kaserver'); and then the synchronization targets for a given keytab are stored in this table: diff --git a/perl/t/config.t b/perl/t/config.t index d60d7e7..1377cb8 100755 --- a/perl/t/config.t +++ b/perl/t/config.t @@ -3,11 +3,11 @@ # t/config.t -- Tests for the wallet server configuration. # # Written by Russ Allbery -# Copyright 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008, 2010 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. -use Test::More tests => 7; +use Test::More tests => 6; # Silence warnings since we're not using use. package Wallet::Config; @@ -25,8 +25,6 @@ is ($Wallet::Config::KEYTAB_FLAGS, '-clearpolicy', ' and KEYTAB_FLAGS is correct'); is ($Wallet::Config::KEYTAB_KADMIN, 'kadmin', ' and KEYTAB_KADMIN is correct'); -is ($Wallet::Config::KEYTAB_AFS_KASETKEY, 'kasetkey', - ' and KEYTAB_AFS_KASETKEY is correct'); is ($Wallet::Config::DB_DRIVER, undef, ' and DB_DRIVER is unset'); # Create a configuration file with a single setting. diff --git a/perl/t/keytab.t b/perl/t/keytab.t index 93df51c..e5a68be 100755 --- a/perl/t/keytab.t +++ b/perl/t/keytab.t @@ -9,7 +9,7 @@ # See LICENSE for licensing terms. use POSIX qw(strftime); -use Test::More tests => 213; +use Test::More tests => 125; use Wallet::Admin; use Wallet::Config; @@ -147,24 +147,6 @@ sub enctypes { return sort @enctypes; } -# Given a Wallet::Object::Keytab object, the keytab data, the Kerberos v5 -# principal, and the Kerberos v4 principal, write the keytab to a file, -# generate a srvtab, and try authenticating using k4start. -sub valid_srvtab { - my ($object, $keytab, $k5, $k4) = @_; - open (KEYTAB, '>', 'keytab') or die "cannot create keytab: $!\n"; - print KEYTAB $keytab; - close KEYTAB; - unless ($object->kaserver_srvtab ('keytab', $k5, 'srvtab', $k4)) { - warn "cannot write srvtab: ", $object->error, "\n"; - return 0; - } - $ENV{KRBTKFILE} = 'krb4cc_temp'; - system ("k4start -f srvtab $k4 2>&1 >/dev/null history, $history, 'History is correct to this point'); } -# Tests for kaserver synchronization support. +# Tests for synchronization support. This code is deactivated at present +# since no synchronization targets are supported, but we want to still test +# the basic stub code. SKIP: { skip 'no keytab configuration', 106 unless -f 't/data/test.keytab'; - # Test the principal mapping. We can do this without having a kaserver - # configuration. We only need a basic keytab object configuration. Do - # this as white-box testing since we don't want to fill the test realm - # with a bunch of random principals. + # Test setting synchronization attributes, which can also be done without + # configuration. my $one = eval { Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace) }; ok (defined ($one), 'Creating wallet/one succeeds'); - my %princs = - (foo => 'foo', - host => 'host', - rcmd => 'rcmd', - 'rcmd.foo' => 'rcmd.foo', - 'host/foo.example.org' => 'rcmd.foo', - 'ident/foo.example.org' => 'ident.foo', - 'imap/foo.example.org' => 'imap.foo', - 'pop/foo.example.org' => 'pop.foo', - 'smtp/foo.example.org' => 'smtp.foo', - 'service/foo' => 'service.foo', - 'foo/bar' => 'foo.bar'); - for my $princ (sort keys %princs) { - my $result = $princs{$princ}; - is ($one->kaserver_name ($princ), $result, "Name mapping: $princ"); - is ($one->kaserver_name ("$princ\@EXAMPLE.ORG"), $result, - ' with K5 realm'); - $Wallet::Config::KEYTAB_AFS_REALM = 'AFS.EXAMPLE.ORG'; - is ($one->kaserver_name ($princ), "$result\@AFS.EXAMPLE.ORG", - ' with K4 realm'); - is ($one->kaserver_name ("$princ\@EXAMPLE.ORG"), - "$result\@AFS.EXAMPLE.ORG", ' with K5 and K4 realm'); - undef $Wallet::Config::KEYTAB_AFS_REALM; - } - for my $princ (qw{service/foo/bar foo/bar/baz}) { - is ($one->kaserver_name ($princ), undef, "Name mapping: $princ"); - is ($one->kaserver_name ("$princ\@EXAMPLE.ORG"), undef, - ' with K5 realm'); - $Wallet::Config::KEYTAB_AFS_REALM = 'AFS.EXAMPLE.ORG'; - is ($one->kaserver_name ($princ), undef, ' with K4 realm'); - is ($one->kaserver_name ("$princ\@EXAMPLE.ORG"), undef, - ' with K5 and K4 realm'); - undef $Wallet::Config::KEYTAB_AFS_REALM; - } - - # Test setting synchronization attributes, which can also be done without - # configuration. my $expected = <<"EOO"; Type: keytab Name: wallet/one @@ -537,16 +482,20 @@ EOO my @targets = $one->attr ('foo'); is (scalar (@targets), 0, ' and getting an unknown attribute fails'); is ($one->error, 'unknown attribute foo', ' with the right error'); - is ($one->attr ('sync', [ 'foo' ], @trace), undef, + is ($one->attr ('sync', [ 'kaserver' ], @trace), undef, ' and setting an unknown sync target fails'); - is ($one->error, 'unsupported synchronization target foo', + is ($one->error, 'unsupported synchronization target kaserver', ' with the right error'); is ($one->attr ('sync', [ 'kaserver', 'bar' ], @trace), undef, ' and setting two targets fails'); is ($one->error, 'only one synchronization target supported', ' with the right error'); - is ($one->attr ('sync', [ 'kaserver' ], @trace), 1, - ' but setting only kaserver works'); + + # Create a synchronization manually so that we can test the display and + # removal code. + my $sql = "insert into keytab_sync (ks_name, ks_target) values + ('wallet/one', 'kaserver')"; + $dbh->do ($sql); @targets = $one->attr ('sync'); is (scalar (@targets), 1, ' and now one target is set'); is ($targets[0], 'kaserver', ' and it is correct'); @@ -563,15 +512,10 @@ EOO $history .= <<"EOO"; $date create by $user from $host -$date add kaserver to attribute sync - by $user from $host EOO is ($one->history, $history, ' and history is correct for attributes'); - is ($one->destroy (@trace), undef, 'Destroying wallet/one fails'); - is ($one->error, 'kaserver synchronization not configured', - ' because kaserver support is not configured'); is ($one->attr ('sync', [], @trace), 1, - ' but removing the kaserver sync attribute works'); + 'Removing the kaserver sync attribute works'); is ($one->destroy (@trace),1, ' and then destroying wallet/one works'); $history .= <<"EOO"; $date remove kaserver from attribute sync @@ -579,136 +523,7 @@ $date remove kaserver from attribute sync $date destroy by $user from $host EOO - - # Set up our configuration. - skip 'no AFS kaserver configuration', 34 unless -f 't/data/test.srvtab'; - skip 'no kaserver support', 34 unless -x '../kasetkey/kasetkey'; - $Wallet::Config::KEYTAB_FILE = 't/data/test.keytab'; - $Wallet::Config::KEYTAB_PRINCIPAL = contents ('t/data/test.principal'); - $Wallet::Config::KEYTAB_REALM = contents ('t/data/test.realm'); - $Wallet::Config::KEYTAB_KRBTYPE = contents ('t/data/test.krbtype'); - $Wallet::Config::KEYTAB_TMP = '.'; - $Wallet::Config::KEYTAB_AFS_KASETKEY = '../kasetkey/kasetkey'; - my $realm = $Wallet::Config::KEYTAB_REALM; - my $k5 = "wallet/one\@$realm"; - - # Recreate and reconfigure the object. - $one = eval { - Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace) - }; - ok (defined ($one), 'Creating wallet/one succeeds'); - is ($one->attr ('sync', [ 'kaserver' ], @trace), 1, - ' and setting the kaserver sync attribute works'); - - # Finally, we can test. - is ($one->get (@trace), undef, 'Get without configuration fails'); - is ($one->error, 'kaserver synchronization not configured', - ' with the right error'); - $Wallet::Config::KEYTAB_AFS_ADMIN = contents ('t/data/test.admin'); - my $k4_realm = $Wallet::Config::KEYTAB_AFS_ADMIN; - $k4_realm =~ s/^[^\@]+\@//; - $Wallet::Config::KEYTAB_AFS_REALM = $k4_realm; - my $k4 = "wallet.one\@$k4_realm"; - is ($one->get (@trace), undef, ' and still fails with just admin'); - is ($one->error, 'kaserver synchronization not configured', - ' with the right error'); - $Wallet::Config::KEYTAB_AFS_SRVTAB = 't/data/test.srvtab'; - my $keytab = $one->get (@trace); - if (defined ($keytab)) { - ok (1, ' and now get works'); - } else { - is ($one->error, '', ' and now get works'); - } - ok (valid_srvtab ($one, $keytab, $k5, $k4), ' and the srvtab is valid'); - ok (! -f "./srvtab.$$", ' and the temporary file was cleaned up'); - - # Now remove the sync attribute and make sure things aren't synced. - is ($one->attr ('sync', [], @trace), 1, 'Clearing sync works'); - @targets = $one->attr ('sync'); - is (scalar (@targets), 0, ' and now there is no attribute'); - is ($one->error, undef, ' and no error'); - my $new_keytab = $one->get (@trace); - ok (defined ($new_keytab), ' and get still works'); - ok (! valid_srvtab ($one, $new_keytab, $k5, $k4), - ' but the srvtab does not'); - ok (valid_srvtab ($one, $keytab, $k5, $k4), ' and the old one does'); - is ($one->destroy (@trace), 1, ' and destroying wallet/one works'); - ok (valid_srvtab ($one, $keytab, $k5, $k4), - ' and the principal is still there'); - - # Test KEYTAB_AFS_DESTROY. - $one = eval { - Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace) - }; - ok (defined ($one), 'Creating wallet/one succeeds'); - $Wallet::Config::KEYTAB_AFS_DESTROY = 1; - $new_keytab = $one->get (@trace); - ok (defined ($new_keytab), ' and get works'); - ok (! valid_srvtab ($one, $new_keytab, $k5, $k4), - ' but the srvtab does not'); - ok (! valid_srvtab ($one, $keytab, $k5, $k4), - ' and now neither does the old one'); - $Wallet::Config::KEYTAB_AFS_DESTROY = 0; - - # Put it back and make sure it works again. - is ($one->attr ('sync', [ 'kaserver' ], @trace), 1, 'Setting sync works'); - $keytab = $one->get (@trace); - ok (defined ($keytab), ' and get works'); - ok (valid_srvtab ($one, $keytab, $k5, $k4), ' and the srvtab is valid'); - $Wallet::Config::KEYTAB_AFS_KASETKEY = '/path/to/nonexistent/file'; - $new_keytab = $one->get (@trace); - ok (! defined ($new_keytab), - ' but it fails if we mess up the kasetkey path'); - like ($one->error, qr{^cannot synchronize key with kaserver: }, - ' with the right error message'); - ok (! -f "keytab.$$", ' and the temporary file was cleaned up'); - $Wallet::Config::KEYTAB_AFS_KASETKEY = '../kasetkey/kasetkey'; - - # Destroy the principal and recreate it and make sure we cleaned up. - is ($one->destroy (@trace), 1, 'Destroying wallet/one works'); - ok (! valid_srvtab ($one, $keytab, $k5, $k4), - ' and the principal is gone'); - $one = eval { - Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace) - }; - ok (defined ($one), ' and recreating it succeeds'); - @targets = $one->attr ('sync'); - is (scalar (@targets), 0, ' and now there is no attribute'); - is ($one->error, undef, ' and no error'); - - # Now destroy it for good. - is ($one->destroy (@trace), 1, 'Destroying wallet/one works'); - - # Check that history is still correct. - $history .= <<"EOO"; -$date create - by $user from $host -$date add kaserver to attribute sync - by $user from $host -$date get - by $user from $host -$date remove kaserver from attribute sync - by $user from $host -$date get - by $user from $host -$date destroy - by $user from $host -$date create - by $user from $host -$date get - by $user from $host -$date add kaserver to attribute sync - by $user from $host -$date get - by $user from $host -$date destroy - by $user from $host -$date create - by $user from $host -$date destroy - by $user from $host -EOO - is ($one->history, $history, 'History is correct to this point'); + is ($one->history, $history, ' and history is correct for removal'); } # Tests for enctype restriction. diff --git a/perl/t/schema.t b/perl/t/schema.t index 01d5dac..559ece4 100755 --- a/perl/t/schema.t +++ b/perl/t/schema.t @@ -21,7 +21,7 @@ ok (defined $schema, 'Wallet::Schema creation'); ok ($schema->isa ('Wallet::Schema'), ' and class verification'); my @sql = $schema->sql; ok (@sql > 0, 'sql() returns something'); -is (scalar (@sql), 29, ' and returns the right number of statements'); +is (scalar (@sql), 28, ' and returns the right number of statements'); # Connect to a database and test create. db_setup; -- cgit v1.2.3 From b037770195ef0bd98d6655a65873b25d90e36032 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 9 Feb 2010 13:14:41 -0800 Subject: Document and make case-insensitive KEYTAB_KRBTYPE KEYTAB_KRBTYPE wasn't documented in Wallet::Config. Add it and the variable declaration. Also document the new mandatory setting in NEWS and add the Heimdal::Kadm5 requirement to README. Remove some of the language in README that implies that only MIT Kerberos is supported. Make the setting case-insensitive and improve the error message from Wallet::Kadmin if it isn't set. --- NEWS | 8 ++++++-- README | 18 +++++++----------- perl/Wallet/Config.pm | 9 +++++++++ perl/Wallet/Kadmin.pm | 9 +++++---- 4 files changed, 27 insertions(+), 17 deletions(-) diff --git a/NEWS b/NEWS index 3185db3..c6b3a9d 100644 --- a/NEWS +++ b/NEWS @@ -2,6 +2,12 @@ wallet 0.10 (unreleased) + Add support for Heimdal KDCs as well as MIT Kerberos KDCs. There is + now a mandatory new setting in Wallet::Config: $KEYTAB_KRBTYPE. It + should be set to either "MIT" or "Heimdal" depending on the Kerberos + KDC implementation used. The Heimdal support requires the + Heimdal::Kadm5 Perl module. + Remove kaserver synchronization support. It is no longer tested, and retaining the code was increasing the complexity of wallet, and some specific requirements (such as different realm names between kaserver @@ -28,8 +34,6 @@ wallet 0.10 (unreleased) Report ACL names as well as numbers in object history. - Add support for Heimdal KDCs as well as MIT Kerberos KDCs. - wallet 0.9 (2008-04-24) The wallet command-line client now reads the data for store from a diff --git a/README b/README index fa99b18..6e165ec 100644 --- a/README +++ b/README @@ -88,12 +88,13 @@ REQUIREMENTS Perl module, which comes with recent versions of Perl and is available on CPAN for older versions. - The keytab support in the wallet server requires the kadmin client - program be installed and currently assumes that it follows the syntax of - the MIT Kerberos kadmin client. It also requires that the wallet server - have a keytab for a principal with appropriate access to create, modify, - and delete principals from the KDC (as configured in kadm5.acl on an MIT - Kerberos KDC). + The keytab support in the wallet server supports either Heimdal or MIT + Kerberos KDCs. The Heimdal support requires the Heimdal::Kadm5 Perl + module. The MIT Kerberos support requires the MIT Kerberos kadmin + client program be installed. In either case, wallet also requires that + the wallet server have a keytab for a principal with appropriate access + to create, modify, and delete principals from the KDC (as configured in + kadm5.acl on an MIT Kerberos KDC). To support the unchanging flag on keytab objects, the Net::Remctl Perl module (shipped with remctl) must be installed on the server and the @@ -106,11 +107,6 @@ REQUIREMENTS to manage DNS), the Net::Remctl Perl module must be installed on the server. - To support synchronization with an AFS kaserver, the server must have - the Authen::Krb5 Perl module installed. AFS kaserver synchronization - support also requires building kasetkey, which requires AFS and Kerberos - v4 libraries. - To run the test suite, you must have Perl 5.8 or later and the Perl DBI module installed. You will also need a DBD module installed for the database backend you want to use (currently, either DBD::SQLite or diff --git a/perl/Wallet/Config.pm b/perl/Wallet/Config.pm index 7198c07..ae8cf9c 100644 --- a/perl/Wallet/Config.pm +++ b/perl/Wallet/Config.pm @@ -250,6 +250,15 @@ default PATH. our $KEYTAB_KADMIN = 'kadmin'; +=item KEYTAB_KRBTYPE + +The Kerberos KDC implementation type, either C or C +(case-insensitive). KEYTAB_KRBTYPE must be set to use keytab objects. + +=cut + +our $KEYTAB_KRBTYPE; + =item KEYTAB_PRINCIPAL The principal whose key is stored in KEYTAB_FILE. The wallet will diff --git a/perl/Wallet/Kadmin.pm b/perl/Wallet/Kadmin.pm index b3a630e..5c01ee3 100644 --- a/perl/Wallet/Kadmin.pm +++ b/perl/Wallet/Kadmin.pm @@ -1,7 +1,7 @@ # Wallet::Kadmin -- Kadmin module wrapper for the wallet. # # Written by Jon Robertson -# Copyright 2009 Board of Trustees, Leland Stanford Jr. University +# Copyright 2009, 2010 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -34,14 +34,15 @@ sub new { my ($kadmin); if (not $Wallet::Config::KEYTAB_KRBTYPE) { die "keytab object implementation not configured\n"; - } elsif ($Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') { + } elsif (lc ($Wallet::Config::KEYTAB_KRBTYPE) eq 'mit') { require Wallet::Kadmin::MIT; $kadmin = Wallet::Kadmin::MIT->new; - } elsif ($Wallet::Config::KEYTAB_KRBTYPE eq 'Heimdal') { + } elsif (lc ($Wallet::Config::KEYTAB_KRBTYPE) eq 'heimdal') { require Wallet::Kadmin::Heimdal; $kadmin = Wallet::Kadmin::Heimdal->new; } else { - die "keytab krb server type not set to a valid value\n"; + my $type = $Wallet::Config::KEYTAB_KRBTYPE; + die "unknown KEYTAB_KRBTYPE setting: $type\n"; } return $kadmin; -- cgit v1.2.3 From 2ecd8da6a7eaab79a9b8d0a5a59d91fc377d9b95 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 9 Feb 2010 13:17:12 -0800 Subject: Remove the kasetkey client for setting keys in an AFS kaserver --- Makefile.am | 24 +-- NEWS | 2 + kasetkey/README | 13 -- kasetkey/kasetkey.c | 582 -------------------------------------------------- kasetkey/kasetkey.pod | 148 ------------- 5 files changed, 7 insertions(+), 762 deletions(-) delete mode 100644 kasetkey/README delete mode 100644 kasetkey/kasetkey.c delete mode 100644 kasetkey/kasetkey.pod diff --git a/Makefile.am b/Makefile.am index 1465a9b..b647349 100644 --- a/Makefile.am +++ b/Makefile.am @@ -34,8 +34,7 @@ EXTRA_DIST = LICENSE autogen client/wallet.pod config/allow-extract \ config/keytab config/keytab.acl config/wallet docs/design \ contrib/README contrib/wallet-report contrib/wallet-report.8 \ docs/design-acl docs/design-api docs/netdb-role-api docs/notes \ - docs/setup examples/stanford.conf kasetkey/README \ - kasetkey/kasetkey.pod $(PERL_FILES) $(TEST_FILES) + docs/setup examples/stanford.conf $(PERL_FILES) $(TEST_FILES) noinst_LIBRARIES = portable/libportable.a util/libutil.a portable_libportable_a_SOURCES = portable/dummy.c portable/macros.h \ @@ -58,15 +57,6 @@ client_wallet_LDADD = util/libutil.a portable/libportable.a $(REMCTL_LIBS) \ dist_man_MANS = client/wallet.1 server/keytab-backend.8 \ server/wallet-admin.8 server/wallet-backend.8 -if AFS -sbin_PROGRAMS = kasetkey/kasetkey -kasetkey_kasetkey_CPPFLAGS = $(AFS_CPPFLAGS) $(KRB4_CPPFLAGS) -kasetkey_kasetkey_LDFLAGS = $(AFS_LDFLAGS) $(KRB4_LDFLAGS) -kasetkey_kasetkey_LDADD = util/libutil.a portable/libportable.a $(AFS_LIBS) \ - $(KRB4_LIBS) -dist_man_MANS += kasetkey/kasetkey.8 -endif - $(srcdir)/client/wallet.1: $(srcdir)/client/wallet.pod pod2man --release=$(VERSION) --center="Administrative Commands" \ --section=1 $(srcdir)/client/wallet.pod > $@ @@ -75,10 +65,6 @@ $(srcdir)/contrib/wallet-report.8: $(srcdir)/contrib/wallet-report pod2man --release=$(VERSION) --center="Administrative Commands" \ --section=8 $(srcdir)/contrib/wallet-report > $@ -$(srcdir)/kasetkey/kasetkey.8: $(srcdir)/kasetkey/kasetkey.pod - pod2man --release=$(VERSION) --center="Administrative Commands" \ - --section=8 $(srcdir)/kasetkey/kasetkey.pod > $@ - $(srcdir)/server/keytab-backend.8: $(srcdir)/server/keytab-backend pod2man --release=$(VERSION) --center="Administrative Commands" \ --section=8 $(srcdir)/server/keytab-backend > $@ @@ -104,10 +90,10 @@ warnings: # Remove some additional files. DISTCLEANFILES = perl/Makefile -MAINTAINERCLEANFILES = Makefile.in aclocal.m4 config.h.in config.h.in~ \ - configure client/wallet.1 kasetkey/kasetkey.8 \ - server/keytab-backend.8 server/wallet-backend.8 tools/compile \ - tools/depcomp tools/install-sh tools/missing +MAINTAINERCLEANFILES = Makefile.in aclocal.m4 config.h.in config.h.in~ \ + configure client/wallet.1 server/keytab-backend.8 \ + server/wallet-backend.8 tools/compile tools/depcomp tools/install-sh \ + tools/missing # Take appropriate actions in the Perl directory as well. We don't want to # always build the Perl directory in all-local, since otherwise Automake does diff --git a/NEWS b/NEWS index c6b3a9d..60c0945 100644 --- a/NEWS +++ b/NEWS @@ -16,6 +16,8 @@ wallet 0.10 (unreleased) deploying Heimdal with its internal kaserver compatibility is probably an easier transition approach. + Remove the kasetkey client for setting keys in an AFS kaserver. + Correctly handle storing of data that begins with a dash and don't parse it as an argument to wallet-backend. diff --git a/kasetkey/README b/kasetkey/README deleted file mode 100644 index 3ead85d..0000000 --- a/kasetkey/README +++ /dev/null @@ -1,13 +0,0 @@ -This program used to be called gen_srvtab and was the backend used by the -old sysctl-based srvtab distribution system. It can either load a key -from a srvtab and push it into the AFS kaserver or generate a random key, -push it into the AFS kaserver, and then write it out as a srvtab. It has -a lot of strange issues (such as deleting and then recreating keys rather -than changing the key and incrementing the kvno), but it works. - -This program only works with the AFS kaserver and requires the AFS -libraries to compile. - -I haven't yet done the work to make compilation optional based on whether -one wants to build kaserver support (or worked out how that will be -configured in general). That's for later. diff --git a/kasetkey/kasetkey.c b/kasetkey/kasetkey.c deleted file mode 100644 index b798680..0000000 --- a/kasetkey/kasetkey.c +++ /dev/null @@ -1,582 +0,0 @@ -/* - * Create or change a principal and/or generate a srvtab. - * - * Sets the key of a principal in the AFS kaserver given a srvtab, enables or - * disables a principal, or displays information about a principal in an AFS - * kaserver. - * - * Written by Roland Schemers - * Updated by Russ Allbery - * Updated again by Anton Ushakov - * Copyright 1994, 1998, 1999, 2000, 2006, 2007, 2008 - * Board of Trustees, Leland Stanford Jr. University - * - * See LICENSE for licensing terms. - */ - -#include -#include - -#include -#include -#include - -#ifdef HAVE_KERBEROSIV_KRB_H -# include -#else -# include -#endif - -#include -#include -#include -#include -#include - -#include - -/* Normally set by the AFS libraries. */ -#ifndef SNAME_SZ -# define SNAME_SZ 40 -# define INST_SZ 40 -# define REALM_SZ 40 -#endif - -/* - * AFS currently doesn't prototype this function. Cheat on the first argument - * since it actually takes a function with a completely variable argument - * list. - */ -#if !HAVE_DECL_UBIK_CALL -afs_int32 ubik_Call(void *, struct ubik_client *, afs_int32, ...); -#endif - -/* The name of the program, for error reporting. */ -static const char *program = NULL; - -/* Some global state information. */ -struct config { - char *local_cell; - int debug; /* Whether to enable debugging. */ - int init; /* Keyfile initialization. */ - int random; /* Randomize the key. */ - int tgs; /* Enable the principal. */ - int notgs; /* Disable the princial. */ - char *keyfile; /* Name of srvtab to use. */ - char *admin; /* Name of ADMIN user to use. */ - char *password; /* Password to use. */ - char *srvtab; /* srvtab file to generate. */ - char *service; /* Principal to create/enable. */ - char *delete; /* Principal to delete. */ - char *examine; /* Principal to examine. */ - char *k5srvtab; /* K5 converted srvtab to read for key. */ -}; - -/* Usage message. Pass in the program name four times. */ -static const char usage_message[] = "\ -Usage: %s [options]\n\ - -a adminuser Admin user\n\ - -c k5srvtab Use the key from the given srvtab (for sync w/ K5)\n\ - -D service Name of service to delete\n\ - -d Turn on debugging\n\ - -e principal Examine the given principal\n\ - -f srvtab Name of srvtab file to create\n\ - -h This help\n\ - -i Initialize DES key file\n\ - -k keyfile File containing srvtab for admin user\n\ - -n Set the principal NOTGS\n\ - -p password Use given password to create key\n\ - -r Use random key\n\ - -s service Name of service to create\n\ - -t Set the principal TGS\n\ - -v Print version\n\ -\n\ -To create a srvtab for rcmd.slapshot and be prompted for the admin\n\ -passowrd:\n\ -\n\ - %s -f srvtab.rcmd.slapshot -s rcmd.slapshot -r\n\ -\n\ -To create a srvtab from within a script you must stash the DES key\n\ -in a srvtab with:\n\ -\n\ - %s -a admin -i -k /.adminkey\n\ -\n\ -and then create a srvtab for rcmd.slapshot with:\n\ -\n\ - %s -k /.adminkey -a admin -r -f srvtab -s rcmd.slapshot\n\ -\n"; - - -/* - * Print out the usage message and then exit with the status given as the only - * argument. If status is zero, the message is printed to standard output; - * otherwise, it is sent to standard error. - */ -static void -usage(int status) -{ - if (program == NULL) - program = ""; - fprintf((status == 0) ? stdout : stderr, usage_message, - program, program, program, program); - exit(status); -} - - -/* - * Parse a principal name into name, inst, and cell, filling in the cell from - * local_cell if none was given. cell here is actually a realm and shouldn't - * need any further conversion. - */ -static void -parse_principal(struct config *config, char *principal, char *name, - char *inst, char *cell) -{ - long code; - int local; - - code = ka_ParseLoginName(principal, name, inst, cell); - if (config->debug) - printf("ka_ParseLoginName %ld\n", code); - if (code != 0) - die("can't parse principal %s", principal); - if (cell[0] == '\0') { - if (ka_CellToRealm(config->local_cell, cell, &local) == KANOCELL) - die("unable to determine realm from local cell"); - } -} - - -/* - * Given a srvtab file name, the principal, the kvno, and the key, write out a - * new srvtab file. Dies on any error. - */ -static void -write_srvtab(const char *filename, const char *name, const char *inst, - char *cell, unsigned char kvno, struct ktc_encryptionKey *key) -{ - int fd; - - fd = open(filename, O_WRONLY | O_CREAT, 0600); - if (fd == -1) - sysdie("can't create srvtab %s", filename); - if (write(fd, name, strlen(name) + 1) != (ssize_t) strlen(name) + 1) - sysdie("can't write to srvtab %s", filename); - if (write(fd, inst, strlen(inst) + 1) != (ssize_t) strlen(inst) + 1) - sysdie("can't write to srvtab %s", filename); - if (write(fd, cell, strlen(cell) + 1) != (ssize_t) strlen(cell) + 1) - sysdie("can't write to srvtab %s", filename); - if (write(fd, &kvno, 1) != 1) - sysdie("can't write to srvtab %s", filename); - if (write(fd, key, sizeof(*key)) != sizeof(*key)) - sysdie("can't write to srvtab %s", filename); - if (close(fd) != 0) - sysdie("can't close srvtab %s", filename); -} - - -/* - * Initialize a DES keyfile from a password. If the password wasn't given via - * a command-line option, prompt for it. - */ -static void -initialize_admin_srvtab(struct config *config) -{ - struct ktc_encryptionKey key; - char name[MAXKTCNAMELEN]; - char inst[MAXKTCNAMELEN]; - char cell[MAXKTCNAMELEN]; - long code; - - if (config->keyfile == NULL || config->admin == NULL) - usage(1); - - /* Get the password, one way or another. */ - parse_principal(config, config->admin, name, inst, cell); - if (config->password != NULL) { - ka_StringToKey(config->password, cell, &key); - memset(config->password, 0, strlen(config->password)); - } else { - char buffer[MAXKTCNAMELEN * 3 + 40]; - - sprintf(buffer,"password for %s: ", config->admin); - code = ka_ReadPassword(buffer, 1, cell, &key); - if (code != 0) - die("can't read password"); - } - - /* Create the admin srvtab, removing any old one if one exists. */ - unlink(config->keyfile); - write_srvtab(config->keyfile, name, inst, cell, 0, &key); - exit(0); -} - - -/* - * Takes the configuration struct and obtains an admin token, which it stores - * in the second parameter. Dies on any failure. - */ -static void -authenticate(struct config *config, struct ktc_token *token) -{ - char name[MAXKTCNAMELEN]; - char inst[MAXKTCNAMELEN]; - char cell[MAXKTCNAMELEN]; - long code; - struct ktc_encryptionKey key; - - /* Get the admin password one way or the other. */ - parse_principal(config, config->admin, name, inst, cell); - if (config->keyfile) { - code = read_service_key(name, inst, cell, 0, config->keyfile, - (char *) &key); - if (config->debug) - printf("read_service_key %ld\n", code); - if (code != 0) - die("can't get key for %s.%s@%s from srvtab %s", name, inst, - cell, config->keyfile); - } else { - char buffer[MAXKTCNAMELEN * 3 + 40]; - - sprintf(buffer, "password for %s: ", config->admin); - code = ka_ReadPassword(buffer, 0, cell, &key); - if (code) - die("can't read password"); - } - - /* Now, get the admin token. */ - code = ka_GetAdminToken(name, inst, cell, &key, 300, token, 1); - memset(&key, 0, sizeof(key)); - if (config->debug) - printf("ka_GetAdminToken %ld\n", code); - if (code != 0) - die("can't get admin token"); -} - - -/* - * Delete a principal out of the AFS kaserver. - */ -static void -delete_principal(struct config *config) -{ - struct ktc_token token; - struct ubik_client *conn; - char name[MAXKTCNAMELEN]; - char inst[MAXKTCNAMELEN]; - char cell[MAXKTCNAMELEN]; - long code; - - /* Make connection to AuthServer. */ - authenticate(config, &token); - parse_principal(config, config->delete, name, inst, cell); - code = ka_AuthServerConn(cell, KA_MAINTENANCE_SERVICE, &token, &conn); - if (config->debug) - printf("ka_AuthServerConn %s %ld\n", cell, code); - if (code != 0) - die("can't make connection to auth server"); - - /* Delete the user. */ - code = ubik_Call(KAM_DeleteUser, conn, 0, name, inst); - if (config->debug) - printf("ubik_Call KAM_DeleteUser %ld\n", code); - if (code != 0 && code != KANOENT) - die("can't delete existing instance"); - code = ubik_ClientDestroy(conn); - exit(0); -} - - -/* - * Format a date. The output format expects ctime-style date formatting, so - * we use that. Takes a buffer into which to put the date. There will be a - * trailing newline. - */ -static void -format_date(char *buffer, size_t size, time_t date) -{ - if (date == (time_t) NEVERDATE) - strlcpy(buffer, "never\n", size); - else - strlcpy(buffer, ctime(&date), size); -} - - -/* - * Enable or disable a principal in the AFS kaserver (by setting or clearing - * the NOTGS flag). The second argument says to enable if it's true, disable - * otherwise. - */ -static void -enable_principal(struct config *config, int enable) -{ - struct ktc_token token; - struct ubik_client *conn; - struct kaentryinfo entry; - char name[MAXKTCNAMELEN]; - char inst[MAXKTCNAMELEN]; - char cell[MAXKTCNAMELEN]; - long code; - - /* Make connection to AuthServer. */ - authenticate(config, &token); - parse_principal(config, config->service, name, inst, cell); - code = ka_AuthServerConn(cell, KA_MAINTENANCE_SERVICE, &token, &conn); - if (config->debug) - printf("ka_AuthServerConn %s %ld\n", cell, code); - if (code != 0) - die("can't make connection to auth server"); - - /* Retrieve the principal information. */ - code = ubik_Call(KAM_GetEntry, conn, 0, name, inst, KAMAJORVERSION, - &entry); - if (config->debug) - printf("ubik_Call KAM_GetEntry %ld\n", code); - if (code != 0) - die("can't retrieve current flags"); - - /* Set the flags. */ - if (enable) - entry.flags &= ~KAFNOTGS; - else - entry.flags |= KAFNOTGS; - code = ubik_Call(KAM_SetFields, conn, 0, name, inst, entry.flags, 0, 0, - -1, 0, 0); - if (config->debug) - printf("ubik_Call KAM_SetFields %ld\n", code); - if (code != 0) - die("can't %s principal", enable ? "enable" : "disable"); - code = ubik_ClientDestroy(conn); - exit(0); -} - - -/* - * Examine a principal. The output format is compatible with the old Stanford - * Kerberos v4 kadmin, which may be compatible with Kerberos v4 kadmin in - * general (I haven't checked). - */ -static void -examine_principal(struct config *config) -{ - struct ktc_token token; - struct ubik_client *conn; - struct kaentryinfo entry; - char name[MAXKTCNAMELEN]; - char inst[MAXKTCNAMELEN]; - char cell[MAXKTCNAMELEN]; - long code; - char edate[64], cdate[64], mdate[64]; - - /* Make connection to AuthServer. */ - authenticate(config, &token); - parse_principal(config, config->examine, name, inst, cell); - code = ka_AuthServerConn(cell, KA_MAINTENANCE_SERVICE, &token, &conn); - if (config->debug) - printf("ka_AuthServerConn %s %ld\n", cell, code); - if (code != 0) - die("can't make connection to auth server"); - - /* Retrieve and format the entry. */ - code = ubik_Call(KAM_GetEntry, conn, 0, name, inst, KAMAJORVERSION, - &entry); - if (config->debug) - printf("ubik_Call KAM_GetEntry %ld\n", code); - if (code != 0) { - if (code == KANOENT) - die("no such entry in the database"); - else - die("can't retrieve principal information"); - } - format_date(edate, sizeof(edate), entry.user_expiration); - format_date(mdate, sizeof(cdate), entry.modification_time); - format_date(cdate, sizeof(mdate), entry.change_password_time); - printf("status: %s\n", (entry.flags & KAFNOTGS) ? "disabled" : "enabled"); - printf("account expiration: %s", edate); - printf("password last changed: %s", cdate); - printf("modification time: %s", mdate); - printf("modified by: %s%s%s\n", entry.modification_user.name, - (entry.modification_user.instance[0] != '\0') ? "." : "", - entry.modification_user.instance); - code = ubik_ClientDestroy(conn); - exit(0); -} - - -/* - * Create a new principal in the AFS kaserver (deleting it and recreating it - * if it already exists) with either the indicated key or with a random key, - * and then write out a srvtab for that principal. Also supported is reading - * the key from an existing srvtab (likely created via Kerberos v5 kadmin from - * a keytab). - */ -static void -generate_srvtab(struct config *config) -{ - struct ktc_token token; - struct ubik_client *conn; - char name[MAXKTCNAMELEN]; - char inst[MAXKTCNAMELEN]; - char cell[MAXKTCNAMELEN]; - long code; - struct ktc_encryptionKey key; - - /* Make connection to AuthServer. */ - authenticate(config, &token); - parse_principal(config, config->service, name, inst, cell); - code = ka_AuthServerConn(cell, KA_MAINTENANCE_SERVICE, &token, &conn); - if (config->debug) - printf("ka_AuthServerConn %s %ld\n", cell, code); - if (code != 0) - die("can't make connection to auth server"); - - /* Get the key for the principal we're creating. */ - if (config->k5srvtab != NULL) { - char buffer[SNAME_SZ * 4]; - char *p; - char sname[SNAME_SZ]; - char sinst[INST_SZ]; - char srealm[REALM_SZ]; - unsigned char kvno; - FILE *srvtab; - - /* Read the whole converted srvtab into memory. */ - srvtab = fopen(config->k5srvtab, "r"); - if (srvtab == NULL) - sysdie("can't open converted srvtab %s", config->k5srvtab); - if (fgets(buffer, sizeof(buffer), srvtab) == NULL) - sysdie("can't read converted srvtab %s", config->k5srvtab); - fclose(srvtab); - - /* Now parse it. Fields are delimited by NUL. */ - p = buffer; - strncpy(sname, p, SNAME_SZ - 1); - sname[sizeof(sname) - 1] = '\0'; - p += strlen(sname) + 1; - strncpy(sinst, p, INST_SZ - 1); - sinst[sizeof(sinst) - 1] = '\0'; - p += strlen(sinst) + 1; - strncpy(srealm, p, REALM_SZ - 1); - srealm[sizeof(srealm) - 1] = '\0'; - p += strlen(srealm) + 1; - memcpy(&kvno, p, sizeof(unsigned char)); - p += sizeof(unsigned char); - memcpy(key.data, p, sizeof(key)); - memset(buffer, 0, sizeof(buffer)); - } else if (config->random) { - code = ubik_Call(KAM_GetRandomKey, conn, 0, &key); - if (config->debug) - printf("ubik_Call KAM_GetRandomKey %ld\n", code); - if (code != 0) - die("can't get random key"); - } else { - code = ka_ReadPassword((char *) "service password: ", 1, cell, &key); - if (code != 0) - die("can't read password"); - } - - /* - * Now, we have the key. Try to create the principal. If it already - * exists, try deleting it first and then creating it again. - */ - code = ubik_Call(KAM_CreateUser, conn, 0, name, inst, key); - if (config->debug) - printf("ubik_Call KAM_CreateUser %ld\n", code); - if (code == KAEXIST) { - code = ubik_Call(KAM_DeleteUser, conn, 0, name, inst); - if (config->debug) - printf("ubik_Call KAM_DeleteUser %ld\n", code); - if (code != 0) - die("can't delete existing instance"); - code = ubik_Call(KAM_CreateUser, conn, 0, name, inst, key); - if (config->debug) - printf("ubik_Call KAM_CreateUser %ld\n", code); - } - if (code != 0) - die("can't create user"); - code = ubik_ClientDestroy (conn); - - /* Create the srvtab file. Don't bother if we have a converted one. */ - if (config->srvtab && !config->k5srvtab) { - unsigned char kvno = 0; - - /* Make a backup copy of any existing one, just in case. */ - if (access(config->srvtab, F_OK) == 0) { - char backup[MAXPATHLEN]; - - snprintf(backup, sizeof(backup), "%s.bak", config->srvtab); - if (rename(config->srvtab, backup) != 0) - sysdie("can't create backup srvtab %s", backup); - } - write_srvtab(config->srvtab, name, inst, cell, kvno, &key); - } - memset(&key, 0, sizeof(key)); - exit(0); -} - - -int -main(int argc, char *argv[]) -{ - long code; - int opt; - struct config config; - - /* Initialize, get our local cell, etc. */ - memset(&config, 0, sizeof(config)); - code = ka_Init(0); - config.local_cell = ka_LocalCell(); - if (config.local_cell == NULL || code != 0) - die("can't initialize"); - - /* Parse options. */ - while ((opt = getopt(argc, argv, "a:c:D:de:f:hik:np:rs:tv")) != EOF) { - switch (opt) { - case 'a': config.admin = optarg; break; - case 'c': config.k5srvtab = optarg; break; - case 'D': config.delete = optarg; break; - case 'd': config.debug = 1; break; - case 'e': config.examine = optarg; break; - case 'f': config.srvtab = optarg; break; - case 'i': config.init = 1; break; - case 'k': config.keyfile = optarg; break; - case 'n': config.notgs = 1; break; - case 'p': config.password = optarg; break; - case 'r': config.random = 1; break; - case 's': config.service = optarg; break; - case 't': config.tgs = 1; break; - - /* Usage doesn't return. */ - case 'h': - usage(0); - case 'v': - printf("kasetkey %s\n", PACKAGE_VERSION); - exit(0); - default: - usage(1); - } - } - - /* Take the right action. */ - if (config.random && config.k5srvtab) - usage(1); - if (config.notgs && config.tgs) - die("cannot set principal both TGS and NOTGS at the same time"); - if ((config.notgs || config.tgs) && config.service == NULL) - die("must specify a principal with -s"); - if (config.debug) - fprintf(stdout, "cell: %s\n", config.local_cell); - if (config.init) - initialize_admin_srvtab(&config); - else if (config.tgs || config.notgs) - enable_principal(&config, config.tgs); - else if (config.examine != NULL) - examine_principal(&config); - else if (config.service != NULL) - generate_srvtab(&config); - else if (config.delete != NULL) - delete_principal(&config); - else - usage(1); - exit(0); -} diff --git a/kasetkey/kasetkey.pod b/kasetkey/kasetkey.pod deleted file mode 100644 index dcaa8b4..0000000 --- a/kasetkey/kasetkey.pod +++ /dev/null @@ -1,148 +0,0 @@ -=head1 NAME - -kasetkey - Manipulate AFS kaserver service principal keys - -=head1 SYNOPSIS - -B [B<-dhv>] B<-a> I B<-i> [B<-p> I] - B<-k> I - -B [B<-dhv>] B<-a> I [B<-k> I] B<-D> I - -B [B<-dhv>] B<-a> I [B<-k> I] - [ B<-c> I | B<-r> ] B<-s> I B<-f> I - -=head1 DESCRIPTION - -B manipulates principals in an AFS kaserver, usually service -principals. It's primarily designed for automatic generation of srvtabs -for keys without regular passwords, but it can be used to do other -automated tasks, authenticating from a srvtab. - -To start using B, obtain a srvtab for a principal with the ADMIN -flag set in the AFS kaserver. Such a srvtab can be created from the -password of that principal using B with the B<-i> flag. Then, -use B<-s> to create a srvtab for a particular principal or B<-D> to delete -a principal from the Kerberos database, passing via B<-k> the path to the -srvtab containing the key for an ADMIN principal. If you don't use B<-k>, -B will prompt you for the password of the given ADMIN principal. - -When generating a srvtab for a particular principal using B<-s>, you have -your choice of ways of setting the key for that principal. The default is -to prompt you for a password, but usually that's not what you want. -Provide the B<-r> flag to set a random key, which is normally what you -want to do for a pure Kerberos v4 principal. When synchronizing Kerberos -v5 with Kerberos v4, generate a keytab in Kerberos v5, convert it to a -srvtab using B, and then provide that srvtab to B with -the B<-c> flag. B will then set the key in the AFS kaserver to -match. - -B uses a simple, brute-force approach to setting keys in the AFS -kaserver. It creates the principal if it doesn't already exist, and if it -does already exist, it deletes it and then recreates it. - -=head1 OPTIONS - -=over 4 - -=item B<-a> I - -The user as whom changes should be performed. This user must have the -ADMIN flag set in the AFS kaserver. - -=item B<-c> I - -When creating a service principal using B<-s>, take the key for that -principal from I. I must contain a DES key and can be -created via B from a Kerberos v5 keytab. - -=item B<-D> I - -Delete the principal I from the AFS kaserver. - -=item B<-d> - -Turn on debugging. This prints out more information about the exit status -of all of the API calls used. - -=item B<-f> I - -Where to write the srvtab for a newly created (or modified) principal. -Used only with B<-s>. - -=item B<-h> - -Display an option summary and a few examples and then exit. - -=item B<-i> - -Initialize a srvtab. Takes the user from B<-a> and either prompts for the -password or takes it from the B<-p> flag. Writes out the srvtab to the -path given to B<-k>. - -=item B<-k> I - -The srvtab to use to authenticate. The key in the srvtab must be the key -for the user given with B<-a>. - -=item B<-p> I - -The password for the user for which a srvtab is being initialized. This -is only used with the B<-i> flag. - -=item B<-r> - -When generating a new srvtab with B<-s>, randomize the key for that user. - -=item B<-s> I - -Create a new srvtab for the principal I. If this principal -already exists, it's deleted and recreated. Takes the key for the -principal from the srvtab specified with B<-c>, randomizes it if B<-r> is -given, or prompts for it. - -=item B<-v> - -Prints the version of B and exits. - -=back - -=head1 EXAMPLES - -To create a srvtab for rcmd.slapshot and be prompted for the admin -passowrd: - - kasetkey -f srvtab.rcmd.slapshot -s rcmd.slapshot -r - -To create a srvtab from within a script you must stash the DES key -in a srvtab with: - - kasetkey -a admin -i -k /.adminkey - -(which will prompt you for the password) and then create a srvtab for -rcmd.slapshot with: - - kasetkey -k /.adminkey -a admin -r -f srvtab -s rcmd.slapshot - -=head1 CAVEATS - -The error reporting of this program is not great. If an action fails, run -it again with the B<-d> flag, which will print out the return status of -every AFS operation. You can then pass the failing error code to the -B program, installed with AFS, to translate the code into an -error message. - -=head1 SEE ALSO - -kas(8), kaserver(8), ktutil(8) - -This program is part of the wallet system. The current version is available -from L. - -=head1 AUTHORS - -Originally written by Roland Schemers. Revised to use srvtabs rather than -simple DES keys and to support principal deletion by Russ Allbery -, who currently maintains it. - -=cut -- cgit v1.2.3 From 03889c8b1b3145e5e79a7f05763a55c788ef8672 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 9 Feb 2010 13:18:18 -0800 Subject: Remove all the configure code for AFS kaserver support --- configure.ac | 7 --- m4/kaserver.m4 | 94 ----------------------------------- m4/krb4.m4 | 152 --------------------------------------------------------- 3 files changed, 253 deletions(-) delete mode 100644 m4/kaserver.m4 delete mode 100644 m4/krb4.m4 diff --git a/configure.ac b/configure.ac index bc55ad0..de998c0 100644 --- a/configure.ac +++ b/configure.ac @@ -49,13 +49,6 @@ RRA_LIB_KRB5_SWITCH AC_CHECK_FUNCS([krb5_kt_free_entry]) AC_CHECK_MEMBERS([krb5_keytab_entry.keyblock], , , [#include ]) RRA_LIB_KRB5_RESTORE -RRA_LIB_AFS -AS_IF([test x"$rra_afs" = xtrue], - [RRA_LIB_KRB4 - RRA_LIB_AFS_SWITCH - AC_CHECK_DECLS([ubik_Call], , , [#include ]) - RRA_LIB_AFS_RESTORE]) -AM_CONDITIONAL([AFS], [test x"$rra_afs" = xtrue]) AC_ARG_VAR([REMCTLD], [Path to the remctld binary]) AC_PATH_PROG([REMCTLD], [remctld], , [$PATH:/usr/sbin:/usr/local/sbin]) diff --git a/m4/kaserver.m4 b/m4/kaserver.m4 deleted file mode 100644 index 707a113..0000000 --- a/m4/kaserver.m4 +++ /dev/null @@ -1,94 +0,0 @@ -dnl kaserver.m4 -- Find the compiler and linker flags for OpenAFS kaserver. -dnl -dnl If --with-kaserver is given, finds the compiler and linker flags for -dnl building with OpenAFS libraries; sets AFS_CPPFLAGS, AFS_LDFLAGS, and -dnl AFS_LIBS as appropriate; and defines HAVE_AFS. Provides the macro -dnl RRA_LIB_AFS, which takes no arguments. -dnl -dnl This function also sets rra_kaserver to true if AFS was requested, which -dnl can be checked to determine if further checks should be done. -dnl -dnl Also provides RRA_LIB_AFS_SET to set CPPFLAGS, LDFLAGS, and LIBS to -dnl include the AFS libraries; RRA_LIB_AFS_SWITCH to do the same but save the -dnl current values first; and RRA_LIB_AFS_RESTORE to restore those settings to -dnl before the last RRA_LIB_AFS_SWITCH. -dnl -dnl Written by Russ Allbery -dnl Based on code developed by Derrick Brashear and Ken Hornstein of Sine -dnl Nomine Associates, on behalf of Stanford University. -dnl Copyright 2006, 2007, 2008 -dnl Board of Trustees, Leland Stanford Jr. University -dnl -dnl See LICENSE for licensing terms. - -dnl Set CPPFLAGS, LDFLAGS, and LIBS to values including the AFS settings. -AC_DEFUN([RRA_LIB_AFS_SET], -[CPPFLAGS="$AFS_CPPFLAGS $CPPFLAGS" - LDFLAGS="$AFS_LDFLAGS $LDFLAGS" - LIBS="$AFS_LIBS $LIBS"]) - -dnl Save the current CPPFLAGS, LDFLAGS, and LIBS settings and switch to -dnl versions that include the AFS flags. Used as a wrapper, with -dnl RRA_LIB_AFS_RESTORE, around tests. -AC_DEFUN([RRA_LIB_AFS_SWITCH], -[rra_afs_save_CPPFLAGS="$CPPFLAGS" - rra_afs_save_LDFLAGS="$LDFLAGS" - rra_afs_save_LIBS="$LIBS" - RRA_LIB_AFS_SET]) - -dnl Restore CPPFLAGS, LDFLAGS, and LIBS to their previous values (before -dnl RRA_LIB_AFS_SWITCH was called). -AC_DEFUN([RRA_LIB_AFS_RESTORE], -[CPPFLAGS="$rra_afs_save_CPPFLAGS" - LDFLAGS="$rra_afs_save_LDFLAGS" - LIBS="$rra_afs_save_LIBS"]) - -dnl The function that does the work checking for the AFS libraries. -AC_DEFUN([_RRA_LIB_AFS_CHECK], -[RRA_LIB_AFS_SET - LIBS= - AC_SEARCH_LIBS([pthread_getspecific], [pthread]) - AC_SEARCH_LIBS([res_search], [resolv], , - [AC_SEARCH_LIBS([__res_search], [resolv])]) - AC_SEARCH_LIBS([gethostbyname], [nsl]) - AC_SEARCH_LIBS([socket], [socket], , - [AC_CHECK_LIB([nsl], [socket], [LIBS="-lnsl -lsocket $LIBS"], , - [-lsocket])]) - AFS_LIBS="$AFS_LIBS $LIBS" - LIBS="$AFS_LIBS" - AC_CACHE_CHECK([whether linking with AFS libraries work], [rra_cv_lib_afs], - [AC_TRY_LINK( -[#include -#include ], -[char cell[256] = "EXAMPLE.COM"; -char realm[256]; -int local; - -ka_CellToRealm(cell, realm, &local);], - [rra_cv_lib_afs=yes], - [rra_cv_lib_afs=no])]) - AS_IF([test "$rra_cv_lib_afs" = no], - [AC_MSG_ERROR([unable to link test AFS program])]) - RRA_LIB_AFS_RESTORE]) - -dnl The public entry point. Sets up the --with option and only does the -dnl library check if AFS linkage was requested. -AC_DEFUN([RRA_LIB_AFS], -[rra_afs=false - AFS_CPPFLAGS= - AFS_LDFLAGS= - AFS_LIBS="-lafsauthent -lafsrpc" - AC_SUBST([AFS_CPPFLAGS]) - AC_SUBST([AFS_LDFLAGS]) - AC_SUBST([AFS_LIBS]) - AC_ARG_WITH([kaserver], - [AC_HELP_STRING([--with-kaserver@<:@=DIR@:>@], - [Compile with AFS kaserver sync support])], - [AS_IF([test x"$withval" != xno], - [rra_afs=true - AS_IF([test x"$withval" != xyes], - [AFS_CPPFLAGS="-I${withval}/include" - AFS_LDFLAGS="-L${withval}/lib"]) - _RRA_LIB_AFS_CHECK - AC_DEFINE([HAVE_AFS], 1, - [Define to enable AFS kaserver support.])])])]) diff --git a/m4/krb4.m4 b/m4/krb4.m4 deleted file mode 100644 index 75ca505..0000000 --- a/m4/krb4.m4 +++ /dev/null @@ -1,152 +0,0 @@ -dnl krb4.m4 -- Find the compiler and linker flags for Kerberos v4. -dnl -dnl Finds the compiler and linker flags for linking with Kerberos v4 libraries -dnl and sets the substitution variables KRB4_CPPFLAGS, KRB4_LDFLAGS, and -dnl KRB4_LIBS. Provides the --with-krb4 configure option to specify a -dnl non-standard path to the Kerberos libraries. Uses krb5-config where -dnl available unless reduced dependencies is requested. -dnl -dnl Provides the macro RRA_LIB_KRB4 and sets the substitution variables -dnl KRB4_CPPFLAGS, KRB4_LDFLAGS, and KRB4_LIBS. Also provides -dnl RRA_LIB_KRB4_SET to set CPPFLAGS, LDFLAGS, and LIBS to include the -dnl Kerberos libraries; RRA_LIB_KRB4_SWITCH to do the same but save the -dnl current values first; and RRA_LIB_KRB4_RESTORE to restore those settings -dnl to before the last RRA_LIB_KRB4_SWITCH. -dnl -dnl Written by Russ Allbery -dnl Copyright 2005, 2006, 2007, 2008 -dnl Board of Trustees, Leland Stanford Jr. University -dnl -dnl See LICENSE for licensing terms. - -dnl Set CPPFLAGS, LDFLAGS, and LIBS to values including the Kerberos v4 -dnl settings. -AC_DEFUN([RRA_LIB_KRB4_SET], -[CPPFLAGS="$KRB4_CPPFLAGS $CPPFLAGS" - LDFLAGS="$KRB4_LDFLAGS $LDFLAGS" - LIBS="$KRB4_LIBS $LIBS"]) - -dnl Save the current CPPFLAGS, LDFLAGS, and LIBS settings and switch to -dnl versions that include the Kerberos v4 flags. Used as a wrapper, with -dnl RRA_LIB_KRB4_RESTORE, around tests. -AC_DEFUN([RRA_LIB_KRB4_SWITCH], -[rra_krb4_save_CPPFLAGS="$CPPFLAGS" - rra_krb4_save_LDFLAGS="$LDFLAGS" - rra_krb4_save_LIBS="$LIBS" - RRA_LIB_KRB4_SET]) - -dnl Restore CPPFLAGS, LDFLAGS, and LIBS to their previous values (before -dnl RRA_LIB_KRB4_SWITCH was called). -AC_DEFUN([RRA_LIB_KRB4_RESTORE], -[CPPFLAGS="$rra_krb4_save_CPPFLAGS" - LDFLAGS="$rra_krb4_save_LDFLAGS" - LIBS="$rra_krb4_save_LIBS"]) - -dnl Set KRB4_CPPFLAGS and KRB4_LDFLAGS based on rra_krb4_root. -AC_DEFUN([_RRA_LIB_KRB4_PATHS], -[AS_IF([test x"$rra_krb4_root" != x], - [AS_IF([test x"$rra_krb4_root" != x/usr], - [KRB4_CPPFLAGS="-I${rra_krb4_root}/include"]) - KRB4_LDFLAGS="-L${rra_krb4_root}/lib"])]) - -dnl Does the appropriate library checks for reduced-dependency Kerberos v4 -dnl linkage. -AC_DEFUN([_RRA_LIB_KRB4_REDUCED], -[RRA_LIB_KRB4_SWITCH - AC_CHECK_LIB([krb4], [krb_get_svc_in_tkt], [KRB4_LIBS="-lkrb4"], - [AC_CHECK_LIB([krb], [krb_get_svc_in_tkt], [KRB4_LIBS="-lkrb"], - [AC_MSG_ERROR([cannot find usable Kerberos v4 library])])]) - RRA_LIB_KRB4_RESTORE]) - -dnl Does the appropriate library checks for Kerberos v4 linkage when we don't -dnl have krb5-config or reduced dependencies. -AC_DEFUN([_RRA_LIB_KRB4_MANUAL], -[RRA_LIB_KRB4_SWITCH - rra_krb4_extra= - LIBS= - AC_SEARCH_LIBS([res_search], [resolv], , - [AC_SEARCH_LIBS([__res_search], [resolv])]) - AC_SEARCH_LIBS([gethostbyname], [nsl]) - AC_SEARCH_LIBS([socket], [socket], , - [AC_CHECK_LIB([nsl], [socket], [LIBS="-lnsl -lsocket $LIBS"], , - [-lsocket])]) - AC_SEARCH_LIBS([crypt], [crypt]) - rra_krb4_extra="$LIBS" - LIBS="$rra_krb4_save_LIBS" - AC_CHECK_LIB([crypto], [des_set_key], - [rra_krb4_extra="-lcrypto $rra_krb4_extra"], - [AC_CHECK_LIB([des], [des_set_key], - [rra_krb4_extra="-ldes $rra_krb4_extra"])]) - AC_CHECK_LIB([krb], [krb_get_svc_in_tkt], - [KRB4_LIBS="-lkrb $rra_krb4_extra"], - [rra_krb4_extra="-ldes425 -lkrb5 -lk5crypto -lcom_err $rra_krb4_extra" - AC_CHECK_LIB([krb5support], [krb5int_getspecific], - [rra_krb4_extra="$rra_krb4_extra -lkrb5support"], - [AC_CHECK_LIB([pthreads], [pthread_setspecific], - [rra_krb4_pthread="-lpthreads"], - [AC_CHECK_LIB([pthread], [pthread_setspecific], - [rra_krb4_pthread="-lpthread"])]) - AC_CHECK_LIB([krb5support], [krb5int_setspecific], - [rra_krb4_extra="-lkrb5support $rra_krb4_pthread"], , - [$rra_krb4_pthread])]) - AC_CHECK_LIB([krb4], [krb_get_svc_in_tkt], - [KRB4_LIBS="-lkrb4 $rra_krb4_extra"], - [AC_MSG_ERROR([cannot find usable Kerberos v4 library])], - [$rra_krb4_extra])], - [$rra_krb4_extra]) - RRA_LIB_KRB4_RESTORE]) - -dnl Additional checks for portability that apply to either way that we find -dnl the right libraries. -AC_DEFUN([_RRA_LIB_KRB4_EXTRA], -[RRA_LIB_KRB4_SWITCH - AC_CHECK_HEADERS([kerberosIV/krb.h]) - RRA_LIB_KRB4_RESTORE]) - -dnl Sanity-check the results of krb5-config and be sure we can really link a -dnl Kerberos program. -AC_DEFUN([_RRA_LIB_KRB4_CHECK], -[RRA_LIB_KRB4_SWITCH - AC_CHECK_FUNC([krb_get_svc_in_tkt], , - [AC_MSG_FAILURE([krb5-config results fail for Kerberos v4])]) - RRA_LIB_KRB4_RESTORE]) - -dnl The main macro. -AC_DEFUN([RRA_LIB_KRB4], -[AC_REQUIRE([RRA_ENABLE_REDUCED_DEPENDS]) -rra_krb4_root= -KRB4_CPPFLAGS= -KRB4_LDFLAGS= -KRB4_LIBS= -AC_SUBST([KRB4_CPPFLAGS]) -AC_SUBST([KRB4_LDFLAGS]) -AC_SUBST([KRB4_LIBS]) -AC_ARG_WITH([krb4], - [AC_HELP_STRING([--with-krb4=DIR], - [Location of Kerberos v4 headers and libraries])], - [AS_IF([test x"$withval" != xyes && test x"$withval" != xno], - [rra_krb4_root="$withval"])]) -AS_IF([test x"$rra_reduced_depends" = xtrue], - [_RRA_LIB_KRB4_PATHS - _RRA_LIB_KRB4_REDUCED], - [AC_ARG_VAR([KRB5_CONFIG], [Path to krb5-config]) - AS_IF([test x"$rra_krb4_root" != x && test -z "$KRB5_CONFIG"], - [AS_IF([test -x "${rra_krb4_root}/bin/krb5-config"], - [KRB5_CONFIG="${rra_krb4_root}/bin/krb5-config"])], - [AC_PATH_PROG([KRB5_CONFIG], [krb5-config])]) - AS_IF([test x"$KRB5_CONFIG" != x && test -x "$KRB5_CONFIG"], - [AC_CACHE_CHECK([for krb4 support in krb5-config], - [rra_cv_lib_krb4_config], - [AS_IF(["$KRB5_CONFIG" | grep krb4 > /dev/null 2>&1], - [rra_cv_lib_krb4_config=yes], - [rra_cv_lib_krb4_config=no])]) - AS_IF([test "$rra_cv_lib_krb4_config" = yes], - [KRB4_CPPFLAGS=`"$KRB5_CONFIG" --cflags krb4` - KRB4_LIBS=`"$KRB5_CONFIG" --libs krb4`], - [_RRA_LIB_KRB4_PATHS - _RRA_LIB_KRB4_MANUAL]) - KRB4_CPPFLAGS=`echo "$KRB5_CPPFLAGS" | sed 's%-I/usr/include ?%%'` - _RRA_LIB_KRB4_CHECK], - [_RRA_LIB_KRB4_PATHS - _RRA_LIB_KRB4_MANUAL])]) - _RRA_LIB_KRB4_EXTRA]) -- cgit v1.2.3 From 2d33440272200cad20a5a4c58e5d8aa0dfad9a1f Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 9 Feb 2010 13:37:58 -0800 Subject: Remove kaserver synchronization support from the wallet client The wallet client no longer enables kaserver synchronization when a srvtab is requested with -S. Instead, it just extracts the DES key from the keytab and writes it to a srvtab. It no longer forces the kvno of the srvtab to 0 (a Stanford-specific action) and instead preserves the kvno from the key in the keytab. This should now do the right thing for sites that use a KDC that serves both Kerberos v4 and Kerberos v5 from the same database. --- NEWS | 8 ++++++++ TODO | 10 ---------- client/keytab.c | 38 +----------------------------------- client/srvtab.c | 8 ++------ client/wallet.pod | 44 ++++++++++++----------------------------- tests/client/basic-t.in | 38 ++++++++---------------------------- tests/data/cmd-fake | 51 +----------------------------------------------- tests/data/fake-srvtab | Bin 47 -> 50 bytes 8 files changed, 33 insertions(+), 164 deletions(-) diff --git a/NEWS b/NEWS index 60c0945..f8bc57b 100644 --- a/NEWS +++ b/NEWS @@ -18,6 +18,14 @@ wallet 0.10 (unreleased) Remove the kasetkey client for setting keys in an AFS kaserver. + The wallet client no longer enables kaserver synchronization when a + srvtab is requested with -S. Instead, it just extracts the DES key + from the keytab and writes it to a srvtab. It no longer forces the + kvno of the srvtab to 0 (a Stanford-specific action) and instead + preserves the kvno from the key in the keytab. This should now do the + right thing for sites that use a KDC that serves both Kerberos v4 and + Kerberos v5 from the same database. + Correctly handle storing of data that begins with a dash and don't parse it as an argument to wallet-backend. diff --git a/TODO b/TODO index 7448019..1b1bd78 100644 --- a/TODO +++ b/TODO @@ -67,16 +67,6 @@ Release 1.0: an ACL without having to write it into the database. Redo default ACL creation using that functionality. -* The wallet client currently sets sync kaserver whenever writing a keytab - to a srvtab. This is correct for sites using kaserver and wrong for - everyone else. Remove or rethink this once Stanford's kaserver - migration is over. - -* The wallet client currently hard-codes a kvno of 0 in srvtabs, which is - correct for how kasetkey works but probably isn't correct for people - using Heimdal or MIT to serve both K4 and K5 from the same KDC. Rethink - once Stanford's kaserver migration is over. - * Add a hook to enforce ACL naming standards. Future work: diff --git a/client/keytab.c b/client/keytab.c index bdd0134..393ce3c 100644 --- a/client/keytab.c +++ b/client/keytab.c @@ -2,7 +2,7 @@ * Implementation of keytab handling for the wallet client. * * Written by Russ Allbery - * 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. */ @@ -63,39 +63,6 @@ merge_keytab(krb5_context ctx, const char *newfile, const char *file) } -/* - * Configure a given keytab to be synchronized with an AFS kaserver if it - * isn't already. Returns true on success, false on failure. - */ -static int -set_sync(struct remctl *r, const char *type, const char *name) -{ - const char *command[7]; - char *data = NULL; - size_t length = 0; - int status; - - command[0] = type; - command[1] = "getattr"; - command[2] = "keytab"; - command[3] = name; - command[4] = "sync"; - command[5] = NULL; - status = run_command(r, command, &data, &length); - if (status != 0) - return 0; - if (data == NULL || strstr(data, "kaserver\n") == NULL) { - command[1] = "setattr"; - command[5] = "kaserver"; - command[6] = NULL; - status = run_command(r, command, NULL, NULL); - if (status != 0) - return 0; - } - return 1; -} - - /* * Given a remctl object, the Kerberos context, the name of a keytab object, * and a file name, call the correct wallet commands to download a keytab and @@ -111,9 +78,6 @@ get_keytab(struct remctl *r, krb5_context ctx, const char *type, size_t length = 0; int status; - if (srvtab != NULL) - if (!set_sync(r, type, name)) - return 255; command[0] = type; command[1] = "get"; command[2] = "keytab"; diff --git a/client/srvtab.c b/client/srvtab.c index a01026e..5b52955 100644 --- a/client/srvtab.c +++ b/client/srvtab.c @@ -2,7 +2,7 @@ * Implementation of srvtab handling for the wallet client. * * Written by Russ Allbery - * 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. */ @@ -28,10 +28,6 @@ * keytab and write it to the newly created srvtab file as a srvtab. Convert * the principal from Kerberos v5 form to Kerberos v4 form. * - * We always force the kvno to 0 for the srvtab. This works with how the - * wallet synchronizes keys with kasetkey, even though it's not particularly - * correct. - * * On any failure, print an error message to standard error and then exit. */ void @@ -84,7 +80,7 @@ write_srvtab(krb5_context ctx, const char *srvtab, const char *principal, strcpy(data + length, realm); length += strlen(realm); data[length++] = '\0'; - data[length++] = '\0'; + data[length++] = (unsigned char) entry.vno; #ifdef HAVE_KRB5_KEYTAB_ENTRY_KEYBLOCK memcpy(data + length, entry.keyblock.keyvalue.data, 8); #else diff --git a/client/wallet.pod b/client/wallet.pod index 657929b..6451e72 100644 --- a/client/wallet.pod +++ b/client/wallet.pod @@ -114,9 +114,19 @@ C object, and must be used in conjunction with the B<-f> flag. After the keytab is saved to the file specified by B<-f>, the DES key for that principal will be extracted and written as a Kerberos v4 srvtab to the file I. Any existing contents of I will be -destroyed. For more information on how the principal is converted to -Kerberos v4, see the description of the B attribute under -L. +destroyed. + +The Kerberos v4 principal name will be generated from the Kerberos v5 +principal name using the krb5_524_conv_principal() function of the +Kerberos libraries. See its documentation for more information, but +briefly (and in the absence of special configuration), 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 the recognized host-based principals (generally C, C, +C, or C); and the first component is C if the Kerberos v5 +principal component is C. The principal name must not contain more +than two components. =item B<-s> I @@ -377,34 +387,6 @@ Keytabs retrieved with C 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, -which says to synchronize the key with an AFS Kerberos v4 kaserver. - -If this attribute is set on a keytab, whenever the C command is run -for that keytab, the DES key will be extracted from that keytab and set in -the configured AFS kaserver. If the B<-S> option is given to the -B client, the srvtab corresponding to the keytab will be written -to the file specified with that option. 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, -C, C, C, or C; and the first component is C -if the Kerberos v5 principal component is C. The principal name -must not contain more than two components. - -If this attribute is set, calling C will also destroy the -principal from the AFS kaserver, with a principal mapping determined as -above. - -The realm of the srvtab defaults to the same realm as the keytab. You can -change this by setting the v4_realm configuration option in the [realms] -section of krb5.conf for the local realm. The keytab must be for a -principal in the default local realm for the B<-S> option to work -correctly. - =back =head1 CONFIGURATION diff --git a/tests/client/basic-t.in b/tests/client/basic-t.in index 05a7abe..752e5d9 100644 --- a/tests/client/basic-t.in +++ b/tests/client/basic-t.in @@ -3,7 +3,8 @@ # Test suite for the wallet command-line client. # # Written by Russ Allbery -# 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. @@ -46,10 +47,10 @@ if [ ! -f data/pid ] ; then exit 1 fi -# We need a modified krb5.conf file for the srvtab test to work, since we need -# to add a v4_realm setting for the test-k5.stanford.edu realm that the keytab -# is for. Despite all the Stanford hard-coding, this test isn't -# Stanford-specific. It just matches the data files shipped with the package. +# We need a modified krb5.conf file to test wallet configuration settings in +# krb5.conf. Despite the hard-coding of test-k5.stanford.edu, this test isn't +# Stanford-specific; it just matches the files that are distributed with the +# package. krb5conf= for p in /etc/krb5.conf /usr/local/etc/krb5.conf data/krb5.conf ; do if [ -r "$p" ] ; then @@ -63,7 +64,7 @@ for p in /etc/krb5.conf /usr/local/etc/krb5.conf data/krb5.conf ; do [realms] test-k5.stanford.edu = { - v4_realm = TEST.STANFORD.EDU + v4_realm = test-k5.stanford.edu } EOF KRB5_CONFIG="./krb5.conf" @@ -77,8 +78,7 @@ if [ -z "$krb5conf" ] ; then fi # Make sure everything's clean. -rm -f output output.bak keytab keytab.bak srvtab srvtab.bak sync-kaserver \ - autocreated +rm -f output output.bak keytab keytab.bak srvtab srvtab.bak autocreated # Now, we can finally run our tests. First, basic operations. runsuccess "" "$wallet" -k "$principal" -p 14373 -s localhost -c fake-wallet \ @@ -139,11 +139,6 @@ if cmp keytab data/fake-keytab >/dev/null 2>&1 ; then else printcount "not ok" fi -if [ ! -f sync-kaserver ] ; then - printcount "ok" -else - printcount "not ok" -fi # Test srvtab support. runsuccess "" "$wallet" -f keytab -S srvtab get keytab service/fake-srvtab @@ -153,23 +148,12 @@ else printcount "not ok" fi rm keytab -if [ -f sync-kaserver ] ; then - printcount "ok" -else - printcount "not ok" -fi runsuccess "" "$wallet" -f keytab -S srvtab get keytab service/fake-srvtab if cmp keytab data/fake-keytab >/dev/null 2>&1 ; then printcount "ok" else printcount "not ok" fi -if [ -f sync-kaserver ] ; then - printcount "ok" - rm sync-kaserver -else - printcount "not ok" -fi if cmp srvtab data/fake-srvtab >/dev/null 2>&1 ; then printcount "ok" else @@ -196,12 +180,6 @@ fi # Test srvtab download into a merged keytab with an older version. cp data/fake-keytab-old keytab runsuccess "" "$wallet" -f keytab -S srvtab get keytab service/fake-srvtab -if [ -f sync-kaserver ] ; then - printcount "ok" - rm sync-kaserver -else - printcount "not ok" -fi if cmp srvtab data/fake-srvtab >/dev/null 2>&1 ; then printcount "ok" else diff --git a/tests/data/cmd-fake b/tests/data/cmd-fake index 9c9e38c..199bd57 100755 --- a/tests/data/cmd-fake +++ b/tests/data/cmd-fake @@ -4,7 +4,7 @@ # the client test suite. It doesn't test any of the wallet server code. # # Written by Russ Allbery -# 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. command="$1" @@ -17,55 +17,6 @@ if [ "$type" != "keytab" ] && [ "$type" != "file" ] ; then fi case "$command" in -getattr) - if [ -n "$3" ] ; then - echo "Too many arguments" >&2 - exit 1 - fi - if [ "$type" != "keytab" ] || [ "$2" != sync ] ; then - echo "Unknown attribute $2" >&2 - exit 1 - fi - case "$1" in - service/fake-srvtab) - if [ -f sync-kaserver ] ; then - echo "kaserver" - fi - ;; - *) - echo "Looking at sync attribute of wrong keytab" >&2 - exit 1 - ;; - esac - ;; -setattr) - if [ -n "$4" ] ; then - echo "Too many arguments" >&2 - exit 1 - fi - if [ "$type" != "keytab" ] || [ "$2" != sync ] ; then - echo "Unknown attribute $2" >&2 - exit 1 - fi - case "$1" in - service/fake-srvtab) - if [ "$3" = "kaserver" ] ; then - touch sync-kaserver - else - if [ "$3" = "" ] ; then - rm sync-kaserver - else - echo "Invalid attribute value $3" >&2 - exit 1 - fi - fi - ;; - *) - echo "Looking at sync attribute of wrong keytab" >&2 - exit 1 - ;; - esac - ;; check) if [ -n "$2" ] ; then echo "Too many arguments" >&2 diff --git a/tests/data/fake-srvtab b/tests/data/fake-srvtab index 3c0ec65..f454af2 100644 Binary files a/tests/data/fake-srvtab and b/tests/data/fake-srvtab differ -- cgit v1.2.3 From cbdc17af5f7a772188638f0057fffd357acbbd38 Mon Sep 17 00:00:00 2001 From: Russ Allbery 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(-) 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 or C). Note that the salt should -not be included; since the salt is irrelevant for keytab keys, it will -always be set to C by the wallet. +(strings like C or C). Note that +the salt should not be included; since the salt is irrelevant for keytab +keys, it will always be set to C 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 -# 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 or C). 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 or +C). An error is thrown on failure or if the creation fails, +otherwise true is returned. =back @@ -305,7 +306,6 @@ from L. =head1 AUTHORS -Russ Allbery -Jon Robertson +Russ Allbery and Jon Robertson . =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 # Pulled into a module by Jon Robertson -# 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 or C). 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 or +C). 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 or C). Note that the salt should -not be included; since the salt is irrelevant for keytab keys, it will -always be set to C by the wallet. +(strings like C or C). Note that +the salt should not be included; since the salt is irrelevant for keytab +keys, it will always be set to C 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 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(-) 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 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, -which says to synchronize the key with an AFS Kerberos v4 kaserver. - -If this attribute is set on a keytab, whenever the C 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, C, C, C, or -C; and the first component is C if the Kerberos v5 principal -component is C. The principal name must not contain more than two -components. - -If this attribute is set, calling C 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 fecab76139894250a57fa3761b3b90944c8cfa9d Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 9 Feb 2010 13:43:18 -0800 Subject: Remove the test suite for kasetkey --- configure.ac | 1 - tests/TESTS | 1 - tests/kasetkey/basic-t.in | 127 ---------------------------------------------- 3 files changed, 129 deletions(-) delete mode 100644 tests/kasetkey/basic-t.in diff --git a/configure.ac b/configure.ac index de998c0..8d00229 100644 --- a/configure.ac +++ b/configure.ac @@ -63,7 +63,6 @@ AC_CONFIG_FILES([tests/client/full-t], [chmod +x tests/client/full-t]) AC_CONFIG_FILES([tests/client/pod-t], [chmod +x tests/client/pod-t]) AC_CONFIG_FILES([tests/client/prompt-t], [chmod +x tests/client/prompt-t]) AC_CONFIG_FILES([tests/data/cmd-wrapper], [chmod +x tests/data/cmd-wrapper]) -AC_CONFIG_FILES([tests/kasetkey/basic-t], [chmod +x tests/kasetkey/basic-t]) AC_CONFIG_FILES([tests/server/admin-t], [chmod +x tests/server/admin-t]) AC_CONFIG_FILES([tests/server/backend-t], [chmod +x tests/server/backend-t]) AC_CONFIG_FILES([tests/server/keytab-t], [chmod +x tests/server/keytab-t]) diff --git a/tests/TESTS b/tests/TESTS index c94cce0..a446643 100644 --- a/tests/TESTS +++ b/tests/TESTS @@ -2,7 +2,6 @@ client/basic client/full client/pod client/prompt -kasetkey/basic portable/asprintf portable/snprintf portable/strlcat diff --git a/tests/kasetkey/basic-t.in b/tests/kasetkey/basic-t.in deleted file mode 100644 index bb086d6..0000000 --- a/tests/kasetkey/basic-t.in +++ /dev/null @@ -1,127 +0,0 @@ -#!/usr/bin/perl -w -# -# Tests for basic kasetkey functionality. -# -# We only test creation (with a random key), deletion, enable, disable, and -# examine. That's enough to verify that kasetkey is basically working, and -# since AFS kaservers are becoming scarce, it's probably not worth the effort -# to do anything more comprehensive. -# -# We do test creation of a principal with a known key given a srvtab from -# inside the wallet server test suite already. -# -# Written by Russ Allbery -# Copyright 2008 Board of Trustees, Leland Stanford Jr. University -# -# See LICENSE for licensing terms. - -BEGIN { our $total = 27 } -use Test::More tests => $total; - -use lib '@abs_top_builddir@/perl/blib/lib'; -use lib '@abs_top_srcdir@/perl/t/lib'; -use Util; - -# Global variables used for the kasetkey configuration. -our $ADMIN; -our $SRVTAB; - -# Make a call to the kasetkey client and returns the standard output, the -# standard error, and the exit status as a list. -sub kasetkey { - my @command = @_; - my $pid = fork; - if (not defined $pid) { - die "cannot fork: $!\n"; - } elsif ($pid == 0) { - open (STDOUT, '>', 'kasetkey.out') - or die "cannot create kasetkey.out: $!\n"; - open (STDERR, '>', 'kasetkey.err') - or die "cannot create kasetkey.err: $!\n"; - exec ('@abs_top_builddir@/kasetkey/kasetkey', '-a', $ADMIN, - '-k', $SRVTAB, @command) - or die "cannot run @abs_top_builddir@/kasetkey/kasetky: $!\n"; - } else { - waitpid ($pid, 0); - } - my $status = ($? >> 8); - local $/; - open (OUT, '<', 'kasetkey.out') or die "cannot open kasetkey.out: $!\n"; - my $output = ; - close OUT; - open (ERR, '<', 'kasetkey.err') or die "cannot open kasetkey.err: $!\n"; - my $error = ; - close ERR; - unlink ('kasetkey.out', 'kasetkey.err'); - return ($output, $error, $status); -} - -SKIP: { - skip 'no AFS kaserver configuration', $total - unless -f '@abs_top_builddir@/tests/data/test.srvtab'; - skip 'no AFS kaserver support', $total, - unless -x '@abs_top_builddir@/kasetkey/kasetkey'; - - # Set up the configuration. - $ADMIN = contents ('@abs_top_builddir@/tests/data/test.admin'); - $SRVTAB = '@abs_top_builddir@/tests/data/test.srvtab'; - my $realm = $ADMIN; - $realm =~ s/^[^\@]+\@//; - my $principal = "wallet.one\@$realm"; - - # Now we can start manipulating principals. Test examine and create. - my ($out, $err, $status) = kasetkey ('-e', $principal); - is ($status, 1, 'Examining a non-existent principal fails'); - is ($out, '', ' with no output'); - is ($err, "no such entry in the database\n", ' and the right error'); - ($out, $err, $status) = kasetkey ('-s', $principal, '-r'); - is ($status, 0, 'Creating a principal succeeds'); - is ($out, '', ' with no output'); - is ($err, '', ' and no error'); - ($out, $err, $status) = kasetkey ('-e', $principal); - is ($status, 0, 'Examining a principal succeeds'); - $out =~ s/: (Sun|Mon|Tue|Wed|Thu|Fri|Sat).*/: DATE/g; - my $shortadmin = $ADMIN; - $shortadmin =~ s/\@.*//; - my $enabled = <<"EOE"; -status: enabled -account expiration: never -password last changed: DATE -modification time: DATE -modified by: $shortadmin -EOE - is ($out, $enabled, ' with the right output'); - is ($err, '', ' and no error'); - - # Test enable and disable. - ($out, $err, $status) = kasetkey ('-s', $principal, '-n'); - is ($status, 0, 'Disabling a principal succeeds'); - is ($out, '', ' with no output'); - is ($err, '', ' and no error'); - ($out, $err, $status) = kasetkey ('-e', $principal); - is ($status, 0, ' and examining it still succeeds'); - $out =~ s/: (Sun|Mon|Tue|Wed|Thu|Fri|Sat).*/: DATE/g; - my $disabled = $enabled; - $disabled =~ s/enabled/disabled/; - is ($out, $disabled, ' with the right output'); - is ($err, '', ' and no error'); - ($out, $err, $status) = kasetkey ('-s', $principal, '-t'); - is ($status, 0, 'Enabling a principal succeeds'); - is ($out, '', ' with no output'); - is ($err, '', ' and no error'); - ($out, $err, $status) = kasetkey ('-e', $principal); - is ($status, 0, ' and examining it still succeeds'); - $out =~ s/: (Sun|Mon|Tue|Wed|Thu|Fri|Sat).*/: DATE/g; - is ($out, $enabled, ' with the right output'); - is ($err, '', ' and no error'); - - # Test deletion. - ($out, $err, $status) = kasetkey ('-D', $principal); - is ($status, 0, 'Deleting the principal succeeds'); - is ($out, '', ' with no output'); - is ($err, '', ' and no error'); - ($out, $err, $status) = kasetkey ('-e', $principal); - is ($status, 1, ' and now examining it fails'); - is ($out, '', ' with no output'); - is ($err, "no such entry in the database\n", ' and the right error'); -} -- cgit v1.2.3 From b7af0beced6e891a652d4caf36a2ec498090a955 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 9 Feb 2010 13:51:59 -0800 Subject: Update test count for tests/client/basic --- tests/client/basic-t.in | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/client/basic-t.in b/tests/client/basic-t.in index 752e5d9..96b165e 100644 --- a/tests/client/basic-t.in +++ b/tests/client/basic-t.in @@ -12,7 +12,7 @@ . "@abs_top_srcdir@/tests/libtest.sh" # Print the number of tests. -total=35 +total=31 count=1 echo "$total" -- cgit v1.2.3 From 3b7b000d2d2423a578c0ddfa63773764417aec9e Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 9 Feb 2010 14:00:35 -0800 Subject: Use a temporary disk cache in the wallet client instead of memory The wallet client now uses a temporary disk ticket cache when obtaining tickets with the -u option rather than an in-memory cache, allowing for a libremctl built against a different Kerberos implementation than the wallet client. This primarily helps with testing. --- NEWS | 6 ++++++ TODO | 3 --- client/internal.h | 5 +++-- client/krb5.c | 37 ++++++++++++++++++++++++++++--------- client/wallet.c | 2 ++ 5 files changed, 39 insertions(+), 14 deletions(-) diff --git a/NEWS b/NEWS index f8bc57b..5b821f2 100644 --- a/NEWS +++ b/NEWS @@ -44,6 +44,12 @@ wallet 0.10 (unreleased) Report ACL names as well as numbers in object history. + The wallet client now uses a temporary disk ticket cache when + obtaining tickets with the -u option rather than an in-memory cache, + allowing for a libremctl built against a different Kerberos + implementation than the wallet client. This primarily helps with + testing. + wallet 0.9 (2008-04-24) The wallet command-line client now reads the data for store from a diff --git a/TODO b/TODO index 1b1bd78..bfc7910 100644 --- a/TODO +++ b/TODO @@ -2,9 +2,6 @@ Release 0.10: -* Switch to using a disk cache in case the wallet client and libremctl are - built against different versions of Kerberos. - * Remove stub fork hook from Wallet::Kadmin::MIT. * Handle unchanging support for Heimdal. diff --git a/client/internal.h b/client/internal.h index 860ef54..e48616a 100644 --- a/client/internal.h +++ b/client/internal.h @@ -22,10 +22,11 @@ BEGIN_DECLS /* * Given a Kerberos context and a principal name, obtain Kerberos credentials - * for that principal and store them in a memory cache for use by later - * operations. + * for that principal and store them in a temporary ticket cache for use by + * later operations. kdestroy() then cleans up that cache. */ void kinit(krb5_context, const char *principal); +void kdestroy(void); /* * Given a remctl object, run a remctl command. If data is non-NULL, saves diff --git a/client/krb5.c b/client/krb5.c index 3338f8a..3698dd3 100644 --- a/client/krb5.c +++ b/client/krb5.c @@ -6,7 +6,7 @@ * client. * * Written by Russ Allbery - * Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University + * Copyright 2007, 2008, 2010 Board of Trustees, Leland Stanford Jr. University */ #include @@ -17,9 +17,6 @@ #include #include -/* The memory cache used for wallet authentication. */ -#define CACHE_NAME "MEMORY:wallet" - /* * Given a Kerberos context and a principal name, authenticate as that user @@ -34,6 +31,8 @@ kinit(krb5_context ctx, const char *principal) krb5_creds creds; krb5_get_init_creds_opt opts; krb5_error_code status; + char cache_name[] = "/tmp/krb5cc_wallet_XXXXXX"; + int fd; /* Obtain a TGT. */ status = krb5_parse_name(ctx, principal, &princ); @@ -46,18 +45,38 @@ kinit(krb5_context ctx, const char *principal) if (status != 0) die_krb5(ctx, status, "authentication failed"); - /* Put the new credentials into a memory cache. */ - status = krb5_cc_resolve(ctx, CACHE_NAME, &ccache); + /* Put the new credentials into a ticket cache. */ + fd = mkstemp(cache_name); + if (fd < 0) + sysdie("cannot create temporary ticket cache", cache_name); + status = krb5_cc_resolve(ctx, cache_name, &ccache); if (status != 0) - die_krb5(ctx, status, "cannot create cache %s", CACHE_NAME); + die_krb5(ctx, status, "cannot create cache %s", cache_name); status = krb5_cc_initialize(ctx, ccache, princ); if (status != 0) - die_krb5(ctx, status, "cannot initialize cache %s", CACHE_NAME); + die_krb5(ctx, status, "cannot initialize cache %s", cache_name); krb5_free_principal(ctx, princ); status = krb5_cc_store_cred(ctx, ccache, &creds); if (status != 0) die_krb5(ctx, status, "cannot store credentials"); krb5_cc_close(ctx, ccache); - if (putenv((char *) "KRB5CCNAME=" CACHE_NAME) != 0) + close(fd); + if (setenv("KRB5CCNAME", cache_name, 1) < 0) sysdie("cannot set KRB5CCNAME"); } + + +/* + * Clean up the temporary ticket cache created by kinit(). + */ +void +kdestroy(void) +{ + const char *cache; + + cache = getenv("KRB5CCNAME"); + if (cache == NULL) + die("cannot destroy temporary ticket cache: KRB5CCNAME is not set"); + if (unlink(cache) < 0) + sysdie("cannot destroy temporary ticket cache"); +} diff --git a/client/wallet.c b/client/wallet.c index 89135dd..4225d45 100644 --- a/client/wallet.c +++ b/client/wallet.c @@ -260,5 +260,7 @@ main(int argc, char *argv[]) } remctl_close(r); krb5_free_context(ctx); + if (options.user != NULL) + kdestroy(); exit(status); } -- cgit v1.2.3 From 838a73223d19e64a6556047791006f068b779307 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 9 Feb 2010 15:21:12 -0800 Subject: Update the Autoconf code to rra-c-util 3.0 * Sanity-check the results of krb5-config before proceeding. * Fall back on manual probing if krb5-config results don't work. * Add --with-krb5-include and --with-krb5-lib configure options. * Add --with-remctl-include and --with-remctl-lib configure options. * Add --with-gssapi-include and --with-gssapi-lib configure options. * Don't break if the user clobbers CPPFLAGS at build time. * Suppress error output from krb5-config probes. * Prefer KRB5_CONFIG over a path constructed from --with-*. * Update GSS-API probes for Solaris 10's native implementation. * Change AC_TRY_* to AC_*_IFELSE as recommended by Autoconf. Also strip out more outdated AFS kaserver instructions from README. --- NEWS | 13 +++++ README | 41 ++++++------- configure.ac | 31 +++++----- m4/gssapi.m4 | 101 ++++++++++++++++++++------------ m4/krb5.m4 | 164 +++++++++++++++++++++++++++++++--------------------- m4/lib-depends.m4 | 4 +- m4/lib-pathname.m4 | 55 ++++++++++++++++++ m4/remctl.m4 | 79 +++++++++++++++++-------- m4/snprintf.m4 | 17 +++--- m4/vamacros.m4 | 55 ++++++++++++------ portable/snprintf.c | 7 +-- 11 files changed, 368 insertions(+), 199 deletions(-) create mode 100644 m4/lib-pathname.m4 diff --git a/NEWS b/NEWS index 5b821f2..661771a 100644 --- a/NEWS +++ b/NEWS @@ -50,6 +50,19 @@ wallet 0.10 (unreleased) implementation than the wallet client. This primarily helps with testing. + Update to rra-c-util 3.0: + + * Sanity-check the results of krb5-config before proceeding. + * Fall back on manual probing if krb5-config results don't work. + * Add --with-krb5-include and --with-krb5-lib configure options. + * Add --with-remctl-include and --with-remctl-lib configure options. + * Add --with-gssapi-include and --with-gssapi-lib configure options. + * Don't break if the user clobbers CPPFLAGS at build time. + * Suppress error output from krb5-config probes. + * Prefer KRB5_CONFIG over a path constructed from --with-*. + * Update GSS-API probes for Solaris 10's native implementation. + * Change AC_TRY_* to AC_*_IFELSE as recommended by Autoconf. + wallet 0.9 (2008-04-24) The wallet command-line client now reads the data for store from a diff --git a/README b/README index 6e165ec..6c00234 100644 --- a/README +++ b/README @@ -3,9 +3,10 @@ Written by Russ Allbery - Copyright 2006, 2007, 2008 Board of Trustees, Leland Stanford Jr. - University. This software is distributed under a BSD-style license. - Please see the file LICENSE in the distribution for more information. + Copyright 2006, 2007, 2008, 2009, 2010 Board of Trustees, Leland + Stanford Jr. University. This software is distributed under a BSD-style + license. Please see the file LICENSE in the distribution for more + information. This software is beta-quality and should be treated with caution. It is currently being tested for production deployment at Stanford. @@ -159,9 +160,9 @@ BUILD AND INSTALLATION If remctl was installed in a path not normally searched by your compiler, you must specify its installation prefix to configure with the - --with-remctl=DIR option. If the GSS-API libraries used by remctl - aren't in a path normally searched by your compiler, you must generally - also specify its installation prefix with the --with-gssapi=DIR option. + --with-remctl=DIR option, or alternately set the path to the include + files and libraries separately with --with-remctl-include=DIR and + --with-remctl-lib=DIR. Normally, configure will use krb5-config to determine the flags to use to compile with your Kerberos libraries. If krb5-config isn't found, it @@ -170,9 +171,16 @@ BUILD AND INSTALLATION path is not the one corresponding to the Kerberos libraries you want to use or if your Kerberos libraries and includes aren't in a location searched by default by your compiler, you need to specify - --with-krb5=PATH: + --with-krb5=PATH and --with-gssapi=PATH: - ./configure --with-krb5=/usr/pubsw + ./configure --with-krb5=/usr/pubsw --with-gssapi=/usr/pubsw + + You can also individually set the paths to the include directory and the + library directory with --with-krb5-include, --with-krb5-lib, + --with-gssapi-include, and --with-gssapi-lib. You may need to do this + if Autoconf can't figure out whether to use lib, lib32, or lib64 on your + platform. Note that these settings aren't used if a krb5-config script + is found. To specify a particular krb5-config script to use, either set the KRB5_CONFIG environment variable or pass it to configure like: @@ -184,18 +192,6 @@ BUILD AND INSTALLATION ./configure KRB5_CONFIG=/nonexistent - To build with AFS kaserver synchronization support, pass --with-kaserver - to configure. You may need to include the path to the AFS include files - and libraries, such as: - - ./configure --with-kaserver=/usr/afsws - - The AFS kaserver support also requires Kerberos v4 libraries and tries - to use krb5-config to find such libraries. If your Kerberos v4 - libraries aren't somewhere found by your compiler and the krb5-config - script doesn't produce correct results, you need to specify - --with-krb4=PATH giving the root path of the Kerberos v4 installation. - You can build wallet in a different directory from the source if you wish. To do this, create a new empty directory, cd to that directory, and then give the path to configure when running configure. Everything @@ -228,10 +224,7 @@ TESTING perl/t/data/README and follow the instructions in those files to enable the full test - suite. Note that testing the AFS kaserver requires creating a srvtab - with ADMIN access to a running AFS kaserver; if you don't care about AFS - kaserver synchronization, you may want to skip that part of the test - suite configuration. + suite. The test suite also requires some additional software be installed that isn't otherwise used by the wallet. See REQUIREMENTS above for the full diff --git a/configure.ac b/configure.ac index 8d00229..78fecea 100644 --- a/configure.ac +++ b/configure.ac @@ -1,32 +1,40 @@ -dnl Process this file with Autoconf to produce a configure script. +dnl Autoconf configuration for wallet. dnl dnl Written by Russ Allbery -dnl Copyright 2006, 2007, 2008 +dnl Copyright 2006, 2007, 2008, 2010 dnl Board of Trustees, Leland Stanford Jr. University dnl dnl See LICENSE for licensing terms. -AC_REVISION([$Revision$]) -AC_PREREQ([2.61]) +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.9], [rra@stanford.edu]) AC_CONFIG_AUX_DIR([build-aux]) AC_CONFIG_LIBOBJ_DIR([portable]) -AM_INIT_AUTOMAKE([1.10]) +AC_CONFIG_MACRO_DIR([m4]) +AM_INIT_AUTOMAKE([1.11 check-news]) AM_MAINTAINER_MODE AC_PROG_CC +AC_USE_SYSTEM_EXTENSIONS AM_PROG_CC_C_O AC_PROG_INSTALL AC_PROG_RANLIB -AC_AIX -AC_GNU_SOURCE + +RRA_LIB_REMCTL +RRA_LIB_KRB5 +RRA_LIB_KRB5_SWITCH +AC_CHECK_FUNCS([krb5_kt_free_entry]) +AC_CHECK_MEMBERS([krb5_keytab_entry.keyblock], , , [#include ]) +RRA_LIB_KRB5_RESTORE AC_HEADER_STDBOOL AC_CHECK_HEADERS([sys/bitypes.h syslog.h]) AC_CHECK_DECLS([snprintf, vsnprintf]) RRA_C_C99_VAMACROS RRA_C_GNU_VAMACROS -AC_CHECK_TYPES([long long]) +AC_TYPE_LONG_LONG_INT RRA_FUNC_SNPRINTF AC_CHECK_FUNCS([setrlimit]) AC_REPLACE_FUNCS([asprintf strlcat strlcpy]) @@ -43,13 +51,6 @@ AC_ARG_WITH([wallet-port], [AC_DEFINE_UNQUOTED([WALLET_PORT], [$withval], [Define to the default server port.])])]) -RRA_LIB_REMCTL -RRA_LIB_KRB5 -RRA_LIB_KRB5_SWITCH -AC_CHECK_FUNCS([krb5_kt_free_entry]) -AC_CHECK_MEMBERS([krb5_keytab_entry.keyblock], , , [#include ]) -RRA_LIB_KRB5_RESTORE - AC_ARG_VAR([REMCTLD], [Path to the remctld binary]) AC_PATH_PROG([REMCTLD], [remctld], , [$PATH:/usr/sbin:/usr/local/sbin]) AS_IF([test x"$REMCTLD" != x], diff --git a/m4/gssapi.m4 b/m4/gssapi.m4 index a352e38..4b08569 100644 --- a/m4/gssapi.m4 +++ b/m4/gssapi.m4 @@ -1,30 +1,24 @@ -dnl gssapi.m4 -- Find the compiler and linker flags for GSS-API. +dnl Find the compiler and linker flags for GSS-API. dnl -dnl Finds the compiler and linker flags for linking with GSS-API libraries -dnl and sets the substitution variables GSSAPI_CPPFLAGS, GSSAPI_LDFLAGS, and -dnl GSSAPI_LIBS. Provides the --with-gssapi configure option to specify a -dnl non-standard path to the GSS-API libraries. Uses krb5-config where -dnl available unless reduced dependencies is requested. +dnl Finds the compiler and linker flags for linking with GSS-API libraries. +dnl Provides the --with-gssapi, --with-gssapi-include, and --with-gssapi-lib +dnl configure option to specify a non-standard path to the GSS-API libraries. +dnl Uses krb5-config where available unless reduced dependencies is requested. dnl dnl Provides the macro RRA_LIB_GSSAPI and sets the substitution variables dnl GSSAPI_CPPFLAGS, GSSAPI_LDFLAGS, and GSSAPI_LIBS. Also provides -dnl RRA_LIB_GSSAPI_SET to set CPPFLAGS, LDFLAGS, and LIBS to include the -dnl GSS-API libraries; RRA_LIB_GSSAPI_SWITCH to do the same but save the -dnl current values first; and RRA_LIB_GSSAPI_RESTORE to restore those settings -dnl to before the last RRA_LIB_GSSAPI_SWITCH. +dnl RRA_LIB_GSSAPI_SWITCH to set CPPFLAGS, LDFLAGS, and LIBS to include the +dnl GSS-API libraries, saving the ecurrent values, and RRA_LIB_GSSAPI_RESTORE +dnl to restore those settings to before the last RRA_LIB_GSSAPI_SWITCH. +dnl +dnl Depends on RRA_ENABLE_REDUCED_DEPENDS and RRA_SET_LDFLAGS. dnl dnl Written by Russ Allbery -dnl Copyright 2005, 2006, 2007, 2008 +dnl Copyright 2005, 2006, 2007, 2008, 2009 dnl Board of Trustees, Leland Stanford Jr. University dnl dnl See LICENSE for licensing terms. -dnl Set CPPFLAGS, LDFLAGS, and LIBS to values including the GSS-API settings. -AC_DEFUN([RRA_LIB_GSSAPI_SET], -[CPPFLAGS="$GSSAPI_CPPFLAGS $CPPFLAGS" - LDFLAGS="$GSSAPI_LDFLAGS $LDFLAGS" - LIBS="$GSSAPI_LIBS $LIBS"]) - dnl Save the current CPPFLAGS, LDFLAGS, and LIBS settings and switch to dnl versions that include the GSS-API flags. Used as a wrapper, with dnl RRA_LIB_GSSAPI_RESTORE, around tests. @@ -32,7 +26,9 @@ AC_DEFUN([RRA_LIB_GSSAPI_SWITCH], [rra_gssapi_save_CPPFLAGS="$CPPFLAGS" rra_gssapi_save_LDFLAGS="$LDFLAGS" rra_gssapi_save_LIBS="$LIBS" - RRA_LIB_GSSAPI_SET]) + CPPFLAGS="$GSSAPI_CPPFLAGS $CPPFLAGS" + LDFLAGS="$GSSAPI_LDFLAGS $LDFLAGS" + LIBS="$GSSAPI_LIBS $LIBS"]) dnl Restore CPPFLAGS, LDFLAGS, and LIBS to their previous values (before dnl RRA_LIB_GSSAPI_SWITCH was called). @@ -41,12 +37,18 @@ AC_DEFUN([RRA_LIB_GSSAPI_RESTORE], LDFLAGS="$rra_gssapi_save_LDFLAGS" LIBS="$rra_gssapi_save_LIBS"]) -dnl Set GSSAPI_CPPFLAGS and GSSAPI_LDFLAGS based on rra_gssapi_root. +dnl Set GSSAPI_CPPFLAGS and GSSAPI_LDFLAGS based on rra_gssapi_root, +dnl rra_gssapi_libdir, and rra_gssapi_includedir. AC_DEFUN([_RRA_LIB_GSSAPI_PATHS], -[AS_IF([test x"$rra_gssapi_root" != x], - [AS_IF([test x"$rra_gssapi_root" != x/usr], - [GSSAPI_CPPFLAGS="-I${rra_gssapi_root}/include"]) - GSSAPI_LDFLAGS="-L${rra_gssapi_root}/lib"])]) +[AS_IF([test x"$rra_gssapi_libdir" != x], + [GSSAPI_LDFLAGS="-L$rra_gssapi_libdir"], + [AS_IF([test x"$rra_gssapi_root" != x], + [RRA_SET_LDFLAGS([GSSAPI_LDFLAGS], [$rra_gssapi_root])])]) + AS_IF([test x"$rra_gssapi_includedir" != x], + [GSSAPI_CPPFLAGS="-I$rra_gssapi_includedir"], + [AS_IF([test x"$rra_gssapi_root" != x], + [AS_IF([test x"$rra_gssapi_root" != x/usr], + [GSSAPI_CPPFLAGS="-I${rra_gssapi_root}/include"])])])]) dnl Does the appropriate library checks for reduced-dependency GSS-API dnl linkage. @@ -54,10 +56,13 @@ AC_DEFUN([_RRA_LIB_GSSAPI_REDUCED], [RRA_LIB_GSSAPI_SWITCH AC_CHECK_LIB([gssapi_krb5], [gss_import_name], [GSSAPI_LIBS="-lgssapi_krb5"], [AC_CHECK_LIB([gssapi], [gss_import_name], [GSSAPI_LIBS="-lgssapi"], - [AC_MSG_ERROR([cannot find usable GSS-API library])])])]) + [AC_CHECK_LIB([gss], [gss_import_name], [GSSAPI_LIBS="-lgss"], + [AC_MSG_ERROR([cannot find usable GSS-API library])])])])]) dnl Does the appropriate library checks for GSS-API linkage when we don't -dnl have krb5-config or reduced dependencies. +dnl have krb5-config or reduced dependencies. libgss is used as a last +dnl resort, since it may be a non-functional mech-independent wrapper, but +dnl it's the right choice on Solaris 10. AC_DEFUN([_RRA_LIB_GSSAPI_MANUAL], [RRA_LIB_GSSAPI_SWITCH rra_gssapi_extra= @@ -91,53 +96,73 @@ AC_DEFUN([_RRA_LIB_GSSAPI_MANUAL], rra_gssapi_extra="-lkrb5 $rra_gssapi_extra" AC_CHECK_LIB([gssapi_krb5], [gss_import_name], [GSSAPI_LIBS="-lgssapi_krb5 $rra_gssapi_extra"], - [AC_MSG_ERROR([cannot find usable GSS-API library])], + [AC_CHECK_LIB([gss], [gss_import_name], + [GSSAPI_LIBS="-lgss"], + [AC_MSG_ERROR([cannot find usable GSS-API library])])], [$rra_gssapi_extra])], [-lkrb5 -lasn1 -lroken -lcrypto -lcom_err $rra_gssapi_extra]) RRA_LIB_GSSAPI_RESTORE]) dnl Sanity-check the results of krb5-config and be sure we can really link a -dnl GSS-API program. +dnl GSS-API program. If not, fall back on the manual check. AC_DEFUN([_RRA_LIB_GSSAPI_CHECK], [RRA_LIB_GSSAPI_SWITCH - AC_CHECK_FUNC([gss_import_name], , - [AC_MSG_FAILURE([krb5-config results fail for GSS-API])]) - RRA_LIB_GSSAPI_RESTORE]) + AC_CHECK_FUNC([gss_import_name], + [RRA_LIB_GSSAPI_RESTORE], + [RRA_LIB_GSSAPI_RESTORE + GSSAPI_CPPFLAGS= + GSSAPI_LIBS= + _RRA_LIB_GSSAPI_PATHS + _RRA_LIB_GSSAPI_MANUAL])]) dnl The main macro. AC_DEFUN([RRA_LIB_GSSAPI], [AC_REQUIRE([RRA_ENABLE_REDUCED_DEPENDS]) rra_gssapi_root= + rra_gssapi_libdir= + rra_gssapi_includedir= GSSAPI_CPPFLAGS= GSSAPI_LDFLAGS= GSSAPI_LIBS= AC_SUBST([GSSAPI_CPPFLAGS]) AC_SUBST([GSSAPI_LDFLAGS]) AC_SUBST([GSSAPI_LIBS]) + AC_ARG_WITH([gssapi], - [AC_HELP_STRING([--with-gssapi=DIR], + [AS_HELP_STRING([--with-gssapi=DIR], [Location of GSS-API headers and libraries])], [AS_IF([test x"$withval" != xyes && test x"$withval" != xno], [rra_gssapi_root="$withval"])]) + AC_ARG_WITH([gssapi-include], + [AS_HELP_STRING([--with-gssapi-include=DIR], + [Location of GSS-API headers])], + [AS_IF([test x"$withval" != xyes && test x"$withval" != xno], + [rra_gssapi_includedir="$withval"])]) + AC_ARG_WITH([gssapi-lib], + [AS_HELP_STRING([--with-gssapi-lib=DIR], + [Location of GSS-API libraries])], + [AS_IF([test x"$withval" != xyes && test x"$withval" != xno], + [rra_gssapi_libdir="$withval"])]) + AS_IF([test x"$rra_reduced_depends" = xtrue], [_RRA_LIB_GSSAPI_PATHS _RRA_LIB_GSSAPI_REDUCED], [AC_ARG_VAR([KRB5_CONFIG], [Path to krb5-config]) - AS_IF([test x"$rra_gssapi_root" != x], + AS_IF([test x"$rra_gssapi_root" != x && test -z "$KRB5_CONFIG"], [AS_IF([test -x "${rra_gssapi_root}/bin/krb5-config"], [KRB5_CONFIG="${rra_gssapi_root}/bin/krb5-config"])], [AC_PATH_PROG([KRB5_CONFIG], [krb5-config])]) - AS_IF([test x"$KRB5_CONFIG" != x], + AS_IF([test x"$KRB5_CONFIG" != x && test -x "$KRB5_CONFIG"], [AC_CACHE_CHECK([for gssapi support in krb5-config], [rra_cv_lib_gssapi_config], - [AS_IF(["$KRB5_CONFIG" | grep gssapi > /dev/null 2>&1], + [AS_IF(["$KRB5_CONFIG" 2>&1 | grep gssapi >/dev/null 2>&1], [rra_cv_lib_gssapi_config=yes], [rra_cv_lib_gssapi_config=no])]) AS_IF([test "$rra_cv_lib_gssapi_config" = yes], - [GSSAPI_CPPFLAGS=`"$KRB5_CONFIG" --cflags gssapi` - GSSAPI_LIBS=`"$KRB5_CONFIG" --libs gssapi`], - [GSSAPI_CPPFLAGS=`"$KRB5_CONFIG" --cflags` - GSSAPI_LIBS=`"$KRB5_CONFIG" --libs`]) + [GSSAPI_CPPFLAGS=`"$KRB5_CONFIG" --cflags gssapi 2>/dev/null` + GSSAPI_LIBS=`"$KRB5_CONFIG" --libs gssapi 2>/dev/null`], + [GSSAPI_CPPFLAGS=`"$KRB5_CONFIG" --cflags 2>/dev/null` + GSSAPI_LIBS=`"$KRB5_CONFIG" --libs 2>/dev/null`]) GSSAPI_CPPFLAGS=`echo "$GSSAPI_CPPFLAGS" \ | sed 's%-I/usr/include ?%%'` _RRA_LIB_GSSAPI_CHECK], diff --git a/m4/krb5.m4 b/m4/krb5.m4 index 12d97f8..bba9694 100644 --- a/m4/krb5.m4 +++ b/m4/krb5.m4 @@ -1,41 +1,36 @@ -dnl krb5.m4 -- Find the compiler and linker flags for Kerberos v5. +dnl Find the compiler and linker flags for Kerberos v5. dnl -dnl Finds the compiler and linker flags for linking with Kerberos v5 libraries -dnl and sets the substitution variables KRB5_CPPFLAGS, KRB5_LDFLAGS, and -dnl KRB5_LIBS. Provides the --with-krb5 configure option to specify a -dnl non-standard path to the Kerberos libraries. Uses krb5-config where -dnl available unless reduced dependencies is requested. -dnl -dnl Sets an Automake conditional saying whether we use com_err, since if we're -dnl also linking with AFS libraries, we may have to change library ordering in -dnl that case. +dnl Finds the compiler and linker flags for linking with Kerberos v5 +dnl libraries. Provides the --with-krb5, --with-krb5-include, and +dnl --with-krb5-lib configure options to specify non-standards paths to the +dnl Kerberos libraries. Uses krb5-config where available unless reduced +dnl dependencies is requested. dnl dnl Provides the macro RRA_LIB_KRB5 and sets the substitution variables dnl KRB5_CPPFLAGS, KRB5_LDFLAGS, and KRB5_LIBS. Also provides -dnl RRA_LIB_KRB5_SET to set CPPFLAGS, LDFLAGS, and LIBS to include the -dnl Kerberos libraries; RRA_LIB_KRB5_SWITCH to do the same but save the -dnl current values first; and RRA_LIB_KRB5_RESTORE to restore those settings -dnl to before the last RRA_LIB_KRB5_SWITCH. +dnl RRA_LIB_KRB5_SWITCH to set CPPFLAGS, LDFLAGS, and LIBS to include the +dnl Kerberos libraries, saving the current values first, and +dnl RRA_LIB_KRB5_RESTORE to restore those settings to before the last +dnl RRA_LIB_KRB5_SWITCH. dnl -dnl Also provides the RRA_LIB_KRB5_OPTIONAL macro, which should be used if -dnl Kerberos support is optional. This macro will still always set the -dnl substitution variables, but they'll be empty unless --with-krb5 is used. -dnl Also, HAVE_KERBEROS will be defined if --with-krb5 is given and +dnl Provides the RRA_LIB_KRB5_OPTIONAL macro, which should be used if Kerberos +dnl support is optional. This macro will still always set the substitution +dnl variables, but they'll be empty unless --with-krb5 is given. Also, +dnl HAVE_KERBEROS will be defined if --with-krb5 is given and dnl $rra_use_kerberos will be set to "true". dnl +dnl Sets the Automake conditional KRB5_USES_COM_ERR saying whether we use +dnl com_err, since if we're also linking with AFS libraries, we may have to +dnl change library ordering in that case. +dnl +dnl Depends on RRA_ENABLE_REDUCED_DEPENDS and RRA_SET_LDFLAGS. +dnl dnl Written by Russ Allbery -dnl Copyright 2005, 2006, 2007, 2008 +dnl Copyright 2005, 2006, 2007, 2008, 2009 dnl Board of Trustees, Leland Stanford Jr. University dnl dnl See LICENSE for licensing terms. -dnl Set CPPFLAGS, LDFLAGS, and LIBS to values including the Kerberos v5 -dnl settings. -AC_DEFUN([RRA_LIB_KRB5_SET], -[CPPFLAGS="$KRB5_CPPFLAGS $CPPFLAGS" - LDFLAGS="$KRB5_LDFLAGS $LDFLAGS" - LIBS="$KRB5_LIBS $LIBS"]) - dnl Save the current CPPFLAGS, LDFLAGS, and LIBS settings and switch to dnl versions that include the Kerberos v5 flags. Used as a wrapper, with dnl RRA_LIB_KRB5_RESTORE, around tests. @@ -43,7 +38,9 @@ AC_DEFUN([RRA_LIB_KRB5_SWITCH], [rra_krb5_save_CPPFLAGS="$CPPFLAGS" rra_krb5_save_LDFLAGS="$LDFLAGS" rra_krb5_save_LIBS="$LIBS" - RRA_LIB_KRB5_SET]) + CPPFLAGS="$KRB5_CPPFLAGS $CPPFLAGS" + LDFLAGS="$KRB5_LDFLAGS $LDFLAGS" + LIBS="$KRB5_LIBS $LIBS"]) dnl Restore CPPFLAGS, LDFLAGS, and LIBS to their previous values (before dnl RRA_LIB_KRB5_SWITCH was called). @@ -52,12 +49,18 @@ AC_DEFUN([RRA_LIB_KRB5_RESTORE], LDFLAGS="$rra_krb5_save_LDFLAGS" LIBS="$rra_krb5_save_LIBS"]) -dnl Set KRB5_CPPFLAGS and KRB5_LDFLAGS based on rra_krb5_root. +dnl Set KRB5_CPPFLAGS and KRB5_LDFLAGS based on rra_krb5_root, +dnl rra_krb5_libdir, and rra_krb5_includedir. AC_DEFUN([_RRA_LIB_KRB5_PATHS], -[AS_IF([test x"$rra_krb5_root" != x], - [AS_IF([test x"$rra_krb5_root" != x/usr], - [KRB5_CPPFLAGS="-I${rra_krb5_root}/include"]) - KRB5_LDFLAGS="-L${rra_krb5_root}/lib"])]) +[AS_IF([test x"$rra_krb5_libdir" != x], + [KRB5_LDFLAGS="-L$rra_krb5_libdir"], + [AS_IF([test x"$rra_krb5_root" != x], + [RRA_SET_LDFLAGS([KRB5_LDFLAGS], [$rra_krb5_root])])]) + AS_IF([test x"$rra_krb5_includedir" != x], + [KRB5_CPPFLAGS="-I$rra_krb5_includedir"], + [AS_IF([test x"$rra_krb5_root" != x], + [AS_IF([test x"$rra_krb5_root" != x/usr], + [KRB5_CPPFLAGS="-I${rra_krb5_root}/include"])])])]) dnl Does the appropriate library checks for reduced-dependency Kerberos v5 dnl linkage. The single argument, if true, says to fail if Kerberos could not @@ -70,15 +73,16 @@ AC_DEFUN([_RRA_LIB_KRB5_REDUCED], LIBS="$KRB5_LIBS $LIBS" AC_CHECK_FUNCS([krb5_get_error_message], [AC_CHECK_FUNCS([krb5_free_error_message])], - [AC_CHECK_FUNCS([krb5_get_err_txt], , - [AC_CHECK_LIB([ksvc], [krb5_svc_get_msg], - [KRB5_LIBS="$KRB5_LIBS -lksvc" - AC_DEFINE([HAVE_KRB5_SVC_GET_MSG], [1]) - AC_CHECK_HEADERS([ibm_svc/krb5_svc.h])], - [AC_CHECK_LIB([com_err], [com_err], - [KRB5_LIBS="$KRB5_LIBS -lcom_err"], - [AC_MSG_ERROR([cannot find usable com_err library])]) - AC_CHECK_HEADERS([et/com_err.h])])])]) + [AC_CHECK_FUNCS([krb5_get_error_string], , + [AC_CHECK_FUNCS([krb5_get_err_txt], , + [AC_CHECK_LIB([ksvc], [krb5_svc_get_msg], + [KRB5_LIBS="$KRB5_LIBS -lksvc" + AC_DEFINE([HAVE_KRB5_SVC_GET_MSG], [1]) + AC_CHECK_HEADERS([ibm_svc/krb5_svc.h])], + [AC_CHECK_LIB([com_err], [com_err], + [KRB5_LIBS="$KRB5_LIBS -lcom_err"], + [AC_MSG_ERROR([cannot find usable com_err library])]) + AC_CHECK_HEADERS([et/com_err.h])])])])]) RRA_LIB_KRB5_RESTORE]) dnl Does the appropriate library checks for Kerberos v5 linkage when we don't @@ -125,24 +129,26 @@ AC_DEFUN([_RRA_LIB_KRB5_MANUAL], LIBS="$KRB5_LIBS $LIBS" AC_CHECK_FUNCS([krb5_get_error_message], [AC_CHECK_FUNCS([krb5_free_error_message])], - [AC_CHECK_FUNCS([krb5_get_err_txt], , - [AC_CHECK_FUNCS([krb5_svc_get_msg], - [AC_CHECK_HEADERS([ibm_svc/krb5_svc.h])], - [AC_CHECK_HEADERS([et/com_err.h])])])]) + [AC_CHECK_FUNCS([krb5_get_error_string], , + [AC_CHECK_FUNCS([krb5_get_err_txt], , + [AC_CHECK_FUNCS([krb5_svc_get_msg], + [AC_CHECK_HEADERS([ibm_svc/krb5_svc.h])], + [AC_CHECK_HEADERS([et/com_err.h])])])])]) RRA_LIB_KRB5_RESTORE]) dnl Sanity-check the results of krb5-config and be sure we can really link a -dnl Kerberos program. The first option says whether to fail if Kerberos was -dnl not found. If we shouldn't fail, clear KRB5_CPPFLAGS and KRB5_LIBS so -dnl that we know we don't have usable flags. +dnl Kerberos program. If that fails, clear KRB5_CPPFLAGS and KRB5_LIBS so +dnl that we know we don't have usable flags and fall back on the manual +dnl check. AC_DEFUN([_RRA_LIB_KRB5_CHECK], [RRA_LIB_KRB5_SWITCH - AC_CHECK_FUNC([krb5_init_context], , - [AS_IF([test x"$1" = xtrue], - [AC_MSG_FAILURE([krb5-config results fail for Kerberos v5])]) + AC_CHECK_FUNC([krb5_init_context], + [RRA_LIB_KRB5_RESTORE], + [RRA_LIB_KRB5_RESTORE KRB5_CPPFLAGS= - KRB5_LIBS=]) - RRA_LIB_KRB5_RESTORE]) + KRB5_LIBS= + _RRA_LIB_KRB5_PATHS + _RRA_LIB_KRB5_MANUAL([$1])])]) dnl The core of the library checking, shared between RRA_LIB_KRB5 and dnl RRA_LIB_KRB5_OPTIONAL. The single argument, if "true", says to fail if @@ -160,23 +166,24 @@ AC_DEFUN([_RRA_LIB_KRB5_INTERNAL], AS_IF([test x"$KRB5_CONFIG" != x && test -x "$KRB5_CONFIG"], [AC_CACHE_CHECK([for krb5 support in krb5-config], [rra_cv_lib_krb5_config], - [AS_IF(["$KRB5_CONFIG" | grep krb5 > /dev/null 2>&1], + [AS_IF(["$KRB5_CONFIG" 2>&1 | grep krb5 >/dev/null 2>&1], [rra_cv_lib_krb5_config=yes], [rra_cv_lib_krb5_config=no])]) - AS_IF([test "$rra_cv_lib_krb5_config" = yes], - [KRB5_CPPFLAGS=`"$KRB5_CONFIG" --cflags krb5` - KRB5_LIBS=`"$KRB5_CONFIG" --libs krb5`], - [KRB5_CPPFLAGS=`"$KRB5_CONFIG" --cflags` - KRB5_LIBS=`"$KRB5_CONFIG" --libs`]) + AS_IF([test x"$rra_cv_lib_krb5_config" = xyes], + [KRB5_CPPFLAGS=`"$KRB5_CONFIG" --cflags krb5 2>/dev/null` + KRB5_LIBS=`"$KRB5_CONFIG" --libs krb5 2>/dev/null`], + [KRB5_CPPFLAGS=`"$KRB5_CONFIG" --cflags 2>/dev/null` + KRB5_LIBS=`"$KRB5_CONFIG" --libs 2>/dev/null`]) KRB5_CPPFLAGS=`echo "$KRB5_CPPFLAGS" | sed 's%-I/usr/include ?%%'` _RRA_LIB_KRB5_CHECK([$1]) RRA_LIB_KRB5_SWITCH AC_CHECK_FUNCS([krb5_get_error_message], [AC_CHECK_FUNCS([krb5_free_error_message])], - [AC_CHECK_FUNCS([krb5_get_err_txt], , - [AC_CHECK_FUNCS([krb5_svc_get_msg], - [AC_CHECK_HEADERS([ibm_svc/krb5_svc.h])], - [AC_CHECK_HEADERS([et/com_err.h])])])]) + [AC_CHECK_FUNCS([krb5_get_error_string], , + [AC_CHECK_FUNCS([krb5_get_err_txt], , + [AC_CHECK_FUNCS([krb5_svc_get_msg], + [AC_CHECK_HEADERS([ibm_svc/krb5_svc.h])], + [AC_CHECK_HEADERS([et/com_err.h])])])])]) RRA_LIB_KRB5_RESTORE], [_RRA_LIB_KRB5_PATHS _RRA_LIB_KRB5_MANUAL([$1])])]) @@ -191,22 +198,37 @@ AC_DEFUN([_RRA_LIB_KRB5_INTERNAL], dnl The main macro for packages with mandatory Kerberos support. AC_DEFUN([RRA_LIB_KRB5], [rra_krb5_root= + rra_krb5_libdir= + rra_krb5_includedir= KRB5_CPPFLAGS= KRB5_LDFLAGS= KRB5_LIBS= AC_SUBST([KRB5_CPPFLAGS]) AC_SUBST([KRB5_LDFLAGS]) AC_SUBST([KRB5_LIBS]) + AC_ARG_WITH([krb5], - [AC_HELP_STRING([--with-krb5=DIR], + [AS_HELP_STRING([--with-krb5=DIR], [Location of Kerberos v5 headers and libraries])], [AS_IF([test x"$withval" != xyes && test x"$withval" != xno], [rra_krb5_root="$withval"])]) + AC_ARG_WITH([krb5-include], + [AS_HELP_STRING([--with-krb5-include=DIR], + [Location of Kerberos v5 headers])], + [AS_IF([test x"$withval" != xyes && test x"$withval" != xno], + [rra_krb5_includedir="$withval"])]) + AC_ARG_WITH([krb5-lib], + [AS_HELP_STRING([--with-krb5-lib=DIR], + [Location of Kerberos v5 libraries])], + [AS_IF([test x"$withval" != xyes && test x"$withval" != xno], + [rra_krb5_libdir="$withval"])]) _RRA_LIB_KRB5_INTERNAL([true])]) dnl The main macro for packages with optional Kerberos support. AC_DEFUN([RRA_LIB_KRB5_OPTIONAL], [rra_krb5_root= + rra_krb5_libdir= + rra_krb5_includedir= rra_use_kerberos= KRB5_CPPFLAGS= KRB5_LDFLAGS= @@ -214,13 +236,25 @@ AC_DEFUN([RRA_LIB_KRB5_OPTIONAL], AC_SUBST([KRB5_CPPFLAGS]) AC_SUBST([KRB5_LDFLAGS]) AC_SUBST([KRB5_LIBS]) + AC_ARG_WITH([krb5], - [AC_HELP_STRING([--with-krb5@<:@=DIR@:>@], + [AS_HELP_STRING([--with-krb5@<:@=DIR@:>@], [Location of Kerberos v5 headers and libraries])], [AS_IF([test x"$withval" = xno], [rra_use_kerberos=false], [AS_IF([test x"$withval" != xyes], [rra_krb5_root="$withval"]) rra_use_kerberos=true])]) + AC_ARG_WITH([krb5-include], + [AS_HELP_STRING([--with-krb5-include=DIR], + [Location of Kerberos v5 headers])], + [AS_IF([test x"$withval" != xyes && test x"$withval" != xno], + [rra_krb5_includedir="$withval"])]) + AC_ARG_WITH([krb5-lib], + [AS_HELP_STRING([--with-krb5-lib=DIR], + [Location of Kerberos v5 libraries])], + [AS_IF([test x"$withval" != xyes && test x"$withval" != xno], + [rra_krb5_libdir="$withval"])]) + AS_IF([test x"$rra_use_kerberos" != xfalse], [AS_IF([test x"$rra_use_kerberos" = xtrue], [_RRA_LIB_KRB5_INTERNAL([true])], diff --git a/m4/lib-depends.m4 b/m4/lib-depends.m4 index 1d7e769..039e245 100644 --- a/m4/lib-depends.m4 +++ b/m4/lib-depends.m4 @@ -1,4 +1,4 @@ -dnl lib-depends.m4 -- Provides option to change library probes. +dnl Provides option to change library probes. dnl dnl This file provides RRA_ENABLE_REDUCED_DEPENDS, which adds the configure dnl option --enable-reduced-depends to request that library probes assume @@ -18,6 +18,6 @@ dnl See LICENSE for licensing terms. AC_DEFUN([RRA_ENABLE_REDUCED_DEPENDS], [rra_reduced_depends=false AC_ARG_ENABLE([reduced-depends], - [AC_HELP_STRING([--enable-reduced-depends], + [AS_HELP_STRING([--enable-reduced-depends], [Try to minimize shared library dependencies])], [AS_IF([test x"$enableval" = xyes], [rra_reduced_depends=true])])]) diff --git a/m4/lib-pathname.m4 b/m4/lib-pathname.m4 new file mode 100644 index 0000000..fc326a0 --- /dev/null +++ b/m4/lib-pathname.m4 @@ -0,0 +1,55 @@ +dnl Determine the library path name. +dnl +dnl Red Hat systems and some other Linux systems use lib64 and lib32 rather +dnl than just lib in some circumstances. This file provides an Autoconf +dnl macro, RRA_SET_LDFLAGS, which given a variable, a prefix, and an optional +dnl suffix, adds -Lprefix/lib, -Lprefix/lib32, or -Lprefix/lib64 to the +dnl variable depending on which directories exist and the size of a long in +dnl the compilation environment. If a suffix is given, a slash and that +dnl suffix will be appended, to allow for adding a subdirectory of the library +dnl directory. +dnl +dnl This file also provides the Autoconf macro RRA_SET_LIBDIR, which sets the +dnl libdir variable to PREFIX/lib{,32,64} as appropriate. +dnl +dnl Written by Russ Allbery +dnl Copyright 2008, 2009 Board of Trustees, Leland Stanford Jr. University +dnl +dnl See LICENSE for licensing terms. + +dnl Probe for the alternate library name that we should attempt on this +dnl architecture, given the size of an int, and set rra_lib_arch_name to that +dnl name. Separated out so that it can be AC_REQUIRE'd and not run multiple +dnl times. +dnl +dnl There is an unfortunate abstraction violation here where we assume we know +dnl the cache variable name used by Autoconf. Unfortunately, Autoconf doesn't +dnl provide any other way of getting at that information in shell that I can +dnl see. +AC_DEFUN([_RRA_LIB_ARCH_NAME], +[rra_lib_arch_name=lib + AC_CHECK_SIZEOF([long]) + AS_IF([test "$ac_cv_sizeof_long" -eq 4 && test -d /usr/lib32], + [rra_lib_arch_name=lib32], + [AS_IF([test "$ac_cv_sizeof_long" -eq 8 && test -d /usr/lib64], + [rra_lib_arch_name=lib64])])]) + +dnl Set VARIABLE to -LPREFIX/lib{,32,64} or -LPREFIX/lib{,32,64}/SUFFIX as +dnl appropriate. +AC_DEFUN([RRA_SET_LDFLAGS], +[AC_REQUIRE([_RRA_LIB_ARCH_NAME]) + AS_IF([test -d "$2/$rra_lib_arch_name"], + [AS_IF([test x"$3" = x], + [$1="[$]$1 -L$2/${rra_lib_arch_name}"], + [$1="[$]$1 -L$2/${rra_lib_arch_name}/$3"])], + [AS_IF([test x"$3" = x], + [$1="[$]$1 -L$2/lib"], + [$1="[$]$1 -L$2/lib/$3"])]) + $1=`echo "[$]$1" | sed -e 's/^ *//'`]) + +dnl Set libdir to PREFIX/lib{,32,64} as appropriate. +AC_DEFUN([RRA_SET_LIBDIR], +[AC_REQUIRE([_RRA_LIB_ARCH_NAME]) + AS_IF([test -d "$1/$rra_lib_arch_name"], + [libdir="$1/${rra_lib_arch_name}"], + [libdir="$1/lib"])]) diff --git a/m4/remctl.m4 b/m4/remctl.m4 index 5705a26..8ee3c16 100644 --- a/m4/remctl.m4 +++ b/m4/remctl.m4 @@ -1,27 +1,25 @@ -dnl remctl.m4 -- Find the compiler and linker flags for remctl. +dnl Find the compiler and linker flags for remctl. dnl -dnl This file provides RRA_LIB_REMCTL, which finds the compiler and linker -dnl flags for linking with remctl libraries and sets the substitution -dnl variables REMCTL_CPPFLAGS, REMCTL_LDFLAGS, and REMCTL_LIBS. Also provides -dnl RRA_LIB_REMCTL_SET to set CPPFLAGS, LDFLAGS, and LIBS to include the -dnl remctl libraries; RRA_LIB_REMCTL_SWITCH to do the same but save the -dnl current values first; and RRA_LIB_REMCTL_RESTORE to restore those settings -dnl to before the last RRA_LIB_REMCTL_SWITCH. +dnl Finds the compiler and linker flags for linking with remctl libraries. +dnl Provides the --with-remctl, --with-remctl-include, and --with-remctl-lib +dnl configure options to specify non-standard paths to the remctl headers and +dnl libraries. dnl -dnl This macro depends on RRA_ENABLE_REDUCED_DEPENDS and RRA_LIB_GSSAPI. +dnl Provides the macro RRA_LIB_REMCTL and sets the substitution variables +dnl REMCTL_CPPFLAGS, REMCTL_LDFLAGS, and REMCTL_LIBS. Also provides +dnl RRA_LIB_REMCTL_SWITCH to set CPPFLAGS, LDFLAGS, and LIBS to include the +dnl remctl libraries, saving the current values first, and +dnl RRA_LIB_REMCTL_RESTORE to restore those settings to before the last +dnl RRA_LIB_REMCTL_SWITCH. +dnl +dnl Depends on RRA_ENABLE_REDUCED_DEPENDS, RRA_SET_LDFLAGS, and +dnl RRA_LIB_GSSAPI. dnl dnl Written by Russ Allbery -dnl Copyright 2008 Board of Trustees, Leland Stanford Jr. University +dnl Copyright 2008, 2009 Board of Trustees, Leland Stanford Jr. University dnl dnl See LICENSE for licensing terms. -dnl Set CPPFLAGS, LDFLAGS, and LIBS to values including the Kerberos v5 -dnl settings. -AC_DEFUN([RRA_LIB_REMCTL_SET], -[CPPFLAGS="$REMCTL_CPPFLAGS $CPPFLAGS" - LDFLAGS="$REMCTL_LDFLAGS $LDFLAGS" - LIBS="$REMCTL_LIBS $LIBS"]) - dnl Save the current CPPFLAGS, LDFLAGS, and LIBS settings and switch to dnl versions that include the Kerberos v5 flags. Used as a wrapper, with dnl RRA_LIB_REMCTL_RESTORE, around tests. @@ -29,7 +27,9 @@ AC_DEFUN([RRA_LIB_REMCTL_SWITCH], [rra_remctl_save_CPPFLAGS="$CPPFLAGS" rra_remctl_save_LDFLAGS="$LDFLAGS" rra_remctl_save_LIBS="$LIBS" - RRA_LIB_REMCTL_SET]) + CPPFLAGS="$REMCTL_CPPFLAGS $CPPFLAGS" + LDFLAGS="$REMCTL_LDFLAGS $LDFLAGS" + LIBS="$REMCTL_LIBS $LIBS"]) dnl Restore CPPFLAGS, LDFLAGS, and LIBS to their previous values (before dnl RRA_LIB_REMCTL_SWITCH was called). @@ -38,32 +38,61 @@ AC_DEFUN([RRA_LIB_REMCTL_RESTORE], LDFLAGS="$rra_remctl_save_LDFLAGS" LIBS="$rra_remctl_save_LIBS"]) -dnl Set REMCTL_CPPFLAGS and REMCTL_LDFLAGS based on rra_remctl_root. +dnl Set REMCTL_CPPFLAGS and REMCTL_LDFLAGS based on rra_remctl_root, +dnl rra_remctl_libdir, and rra_remctl_includedir. AC_DEFUN([_RRA_LIB_REMCTL_PATHS], -[AS_IF([test x"$rra_remctl_root" != x], - [AS_IF([test x"$rra_remctl_root" != x/usr], - [REMCTL_CPPFLAGS="-I${rra_remctl_root}/include"]) - REMCTL_LDFLAGS="-L${rra_remctl_root}/lib"])]) +[AS_IF([test x"$rra_remctl_libdir" != x], + [REMCTL_LDFLAGS="-L$rra_remctl_libdir"], + [AS_IF([test x"$rra_remctl_root" != x], + [RRA_SET_LDFLAGS([REMCTL_LDFLAGS], [$rra_remctl_root])])]) + AS_IF([test x"$rra_remctl_includedir" != x], + [REMCTL_CPPFLAGS="-I$rra_remctl_includedir"], + [AS_IF([test x"$rra_remctl_root" != x], + [AS_IF([test x"$rra_remctl_root" != x/usr], + [REMCTL_CPPFLAGS="-I${rra_remctl_root}/include"])])])]) + +dnl Sanity-check the results of the remctl library search to be sure we can +dnl really link a remctl program. +AC_DEFUN([_RRA_LIB_REMCTL_CHECK], +[RRA_LIB_REMCTL_SWITCH + AC_CHECK_FUNC([remctl_open], , + [AC_MSG_FAILURE([unable to link with remctl library])]) + RRA_LIB_REMCTL_RESTORE]) dnl The main macro. AC_DEFUN([RRA_LIB_REMCTL], [AC_REQUIRE([RRA_ENABLE_REDUCED_DEPENDS]) rra_remctl_root= + rra_remctl_libdir= + rra_remctl_includedir= REMCTL_CPPFLAGS= REMCTL_LDFLAGS= REMCTL_LIBS= AC_SUBST([REMCTL_CPPFLAGS]) AC_SUBST([REMCTL_LDFLAGS]) AC_SUBST([REMCTL_LIBS]) + AC_ARG_WITH([remctl], - [AC_HELP_STRING([--with-remctl=DIR], + [AS_HELP_STRING([--with-remctl=DIR], [Location of remctl headers and libraries])], [AS_IF([test x"$withval" != xyes && test x"$withval" != xno], [rra_remctl_root="$withval"])]) + AC_ARG_WITH([remctl-include], + [AS_HELP_STRING([--with-remctl-include=DIR], + [Location of remctl headers])], + [AS_IF([test x"$withval" != xyes && test x"$withval" != xno], + [rra_remctl_includedir="$withval"])]) + AC_ARG_WITH([remctl-lib], + [AS_HELP_STRING([--with-remctl-lib=DIR], + [Location of remctl libraries])], + [AS_IF([test x"$withval" != xyes && test x"$withval" != xno], + [rra_remctl_libdir="$withval"])]) + _RRA_LIB_REMCTL_PATHS AS_IF([test x"$rra_reduced_depends" = xtrue], [REMCTL_LIBS="-lremctl"], [RRA_LIB_GSSAPI REMCTL_CPPFLAGS="$REMCTL_CPPFLAGS $GSSAPI_CPPFLAGS" REMCTL_LDFLAGS="$REMCTL_LDFLAGS $GSSAPI_LDFLAGS" - REMCTL_LIBS="-lremctl $GSSAPI_LIBS"])]) + REMCTL_LIBS="-lremctl $GSSAPI_LIBS"]) + _RRA_LIB_REMCTL_CHECK]) diff --git a/m4/snprintf.m4 b/m4/snprintf.m4 index 79c0089..d933f55 100644 --- a/m4/snprintf.m4 +++ b/m4/snprintf.m4 @@ -1,4 +1,4 @@ -dnl snprintf.m4 -- Test for a working C99 snprintf. +dnl Test for a working C99 snprintf. dnl dnl Check for a working snprintf. Some systems have an snprintf that doesn't dnl nul-terminate if the buffer isn't large enough. Others return -1 if the @@ -10,12 +10,14 @@ dnl Provides RRA_FUNC_SNPRINTF, which adds snprintf.o to LIBOBJS unless a dnl fully working snprintf is found. dnl dnl Written by Russ Allbery -dnl Copyright 2006, 2008 Board of Trustees, Leland Stanford Jr. University +dnl Copyright 2006, 2008, 2009 +dnl Board of Trustees, Leland Stanford Jr. University +dnl dnl See LICENSE for licensing terms. dnl Source used by RRA_FUNC_SNPRINTF. -define([_RRA_FUNC_SNPRINTF_SOURCE], -[[#include +AC_DEFUN([_RRA_FUNC_SNPRINTF_SOURCE], [[ +#include #include char buf[2]; @@ -37,16 +39,17 @@ main() { return ((test("%s", "abcd") == 4 && buf[0] == 'a' && buf[1] == '\0' && snprintf(NULL, 0, "%s", "abcd") == 4) ? 0 : 1); -}]]) +} +]]) dnl The user-callable test. AC_DEFUN([RRA_FUNC_SNPRINTF], [AC_CACHE_CHECK([for working snprintf], [rra_cv_func_snprintf_works], - [AC_TRY_RUN(_RRA_FUNC_SNPRINTF_SOURCE(), + [AC_RUN_IFELSE([AC_LANG_SOURCE([_RRA_FUNC_SNPRINTF_SOURCE])], [rra_cv_func_snprintf_works=yes], [rra_cv_func_snprintf_works=no], [rra_cv_func_snprintf_works=no])]) -AS_IF([test "$rra_cv_func_snprintf_works" = yes], + AS_IF([test x"$rra_cv_func_snprintf_works" = xyes], [AC_DEFINE([HAVE_SNPRINTF], 1, [Define if your system has a working snprintf function.])], [AC_LIBOBJ([snprintf])])]) diff --git a/m4/vamacros.m4 b/m4/vamacros.m4 index 6740d77..855bb40 100644 --- a/m4/vamacros.m4 +++ b/m4/vamacros.m4 @@ -1,4 +1,4 @@ -dnl vamacros.m4 -- Check for support for variadic macros. +dnl Check for support for variadic macros. dnl dnl This file defines two macros for probing for compiler support for variadic dnl macros. Provided are RRA_C_C99_VAMACROS, which checks for support for the @@ -14,30 +14,49 @@ dnl dnl They set HAVE_C99_VAMACROS or HAVE_GNU_VAMACROS as appropriate. dnl dnl Written by Russ Allbery -dnl Copyright 2006, 2008 Board of Trustees, Leland Stanford Jr. University +dnl Copyright 2006, 2008, 2009 +dnl Board of Trustees, Leland Stanford Jr. University dnl dnl See LICENSE for licensing terms. +AC_DEFUN([_RRA_C_C99_VAMACROS_SOURCE], [[ +#include +#define error(...) fprintf(stderr, __VA_ARGS__) + +int +main(void) { + error("foo"); + error("foo %d", 0); + return 0; +} +]]) + AC_DEFUN([RRA_C_C99_VAMACROS], [AC_CACHE_CHECK([for C99 variadic macros], [rra_cv_c_c99_vamacros], -[AC_TRY_COMPILE( -[#include -#define error(...) fprintf(stderr, __VA_ARGS__)], - [error("foo"); error("foo %d", 0); return 0;], - [rra_cv_c_c99_vamacros=yes], - [rra_cv_c_c99_vamacros=no])]) -AS_IF([test $rra_cv_c_c99_vamacros = yes], + [AC_COMPILE_IFELSE([AC_LANG_SOURCE([_RRA_C_C99_VAMACROS_SOURCE])], + [rra_cv_c_c99_vamacros=yes], + [rra_cv_c_c99_vamacros=no])]) + AS_IF([test x"$rra_cv_c_c99_vamacros" = xyes], [AC_DEFINE([HAVE_C99_VAMACROS], 1, - [Define if the compiler supports C99 variadic macros.])])]) + [Define if the compiler supports C99 variadic macros.])])]) + +AC_DEFUN([_RRA_C_GNU_VAMACROS_SOURCE], [[ +#include +#define error(args...) fprintf(stderr, args) + +int +main(void) { + error("foo"); + error("foo %d", 0); + return 0; +} +]]) AC_DEFUN([RRA_C_GNU_VAMACROS], [AC_CACHE_CHECK([for GNU-style variadic macros], [rra_cv_c_gnu_vamacros], -[AC_TRY_COMPILE( -[#include -#define error(args...) fprintf(stderr, args)], - [error("foo"); error("foo %d", 0); return 0;], - [rra_cv_c_gnu_vamacros=yes], - [rra_cv_c_gnu_vamacros=no])]) -AS_IF([test $rra_cv_c_gnu_vamacros = yes], + [AC_COMPILE_IFELSE([AC_LANG_SOURCE([_RRA_C_GNU_VAMACROS_SOURCE])], + [rra_cv_c_gnu_vamacros=yes], + [rra_cv_c_gnu_vamacros=no])]) + AS_IF([test x"$rra_cv_c_gnu_vamacros" = xyes], [AC_DEFINE([HAVE_GNU_VAMACROS], 1, - [Define if the compiler supports GNU-style variadic macros.])])]) + [Define if the compiler supports GNU-style variadic macros.])])]) diff --git a/portable/snprintf.c b/portable/snprintf.c index 3775b8a..ab3121c 100644 --- a/portable/snprintf.c +++ b/portable/snprintf.c @@ -109,13 +109,10 @@ #define VA_SHIFT(v,t) ; /* no-op for ANSI */ #define VA_END va_end(ap) -#ifdef HAVE_LONG_DOUBLE +/* Assume all compilers support long double, per Autoconf documentation. */ #define LDOUBLE long double -#else -#define LDOUBLE double -#endif -#ifdef HAVE_LONG_LONG +#ifdef HAVE_LONG_LONG_INT # define LLONG long long #else # define LLONG long -- cgit v1.2.3 From 562431885d24ee828c4b7b0995fdd200987db872 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 9 Feb 2010 15:22:23 -0800 Subject: Add thanks to Jon Robertson to README --- README | 3 +++ 1 file changed, 3 insertions(+) diff --git a/README b/README index 6c00234..7302c06 100644 --- a/README +++ b/README @@ -272,3 +272,6 @@ THANKS To Huaqing Zheng, Paul Pavelko, David Hoffman, and Paul Keser for their reviews of the wallet system design and comments on design decisions and security models. + + To Jon Robertson for the refactoring of Wallet::Kadmin, Heimdal support, + and many of the wallet server-side reports. -- cgit v1.2.3 From ba73a9bdff8aebb9fcb0f9ad622be56bf6fd3320 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 9 Feb 2010 15:26:25 -0800 Subject: Move man page generation to autogen Also use set -e in autogen and add --force to autoreconf. --- Makefile.am | 20 -------------------- autogen | 20 +++++++++++++++++--- 2 files changed, 17 insertions(+), 23 deletions(-) diff --git a/Makefile.am b/Makefile.am index b647349..8777720 100644 --- a/Makefile.am +++ b/Makefile.am @@ -57,26 +57,6 @@ client_wallet_LDADD = util/libutil.a portable/libportable.a $(REMCTL_LIBS) \ dist_man_MANS = client/wallet.1 server/keytab-backend.8 \ server/wallet-admin.8 server/wallet-backend.8 -$(srcdir)/client/wallet.1: $(srcdir)/client/wallet.pod - pod2man --release=$(VERSION) --center="Administrative Commands" \ - --section=1 $(srcdir)/client/wallet.pod > $@ - -$(srcdir)/contrib/wallet-report.8: $(srcdir)/contrib/wallet-report - pod2man --release=$(VERSION) --center="Administrative Commands" \ - --section=8 $(srcdir)/contrib/wallet-report > $@ - -$(srcdir)/server/keytab-backend.8: $(srcdir)/server/keytab-backend - pod2man --release=$(VERSION) --center="Administrative Commands" \ - --section=8 $(srcdir)/server/keytab-backend > $@ - -$(srcdir)/server/wallet-admin.8: $(srcdir)/server/wallet-admin - pod2man --release=$(VERSION) --center="Administrative Commands" \ - --section=8 $(srcdir)/server/wallet-admin > $@ - -$(srcdir)/server/wallet-backend.8: $(srcdir)/server/wallet-backend - pod2man --release=$(VERSION) --center="Administrative Commands" \ - --section=8 $(srcdir)/server/wallet-backend > $@ - # A set of flags for warnings. Add -O because gcc won't find some warnings # without optimization turned on, and add -DDEBUG=1 so we'll also compile all # debugging code and test it. diff --git a/autogen b/autogen index 15ab3a6..aeb4339 100755 --- a/autogen +++ b/autogen @@ -1,7 +1,21 @@ #!/bin/sh # -# Run this shell script to bootstrap as necessary after a fresh checkout -# from Subversion. +# Run this shell script to bootstrap as necessary after a fresh checkout. -autoreconf -i +set -e + +autoreconf -i --force rm -rf autom4te.cache + +# Generate manual pages. +version=`grep '^wallet' NEWS | head -1 | cut -d' ' -f2` +pod2man --release="$version" --center=wallet client/wallet.pod \ + > client/wallet.1 +pod2man --release="$version" --center=wallet -s 8 contrib/wallet-report \ + > contrib/wallet-report.8 +pod2man --release="$version" --center=wallet -s 8 server/keytab-backend \ + > server/keytab-backend.8 +pod2man --release="$version" --center=wallet -s 8 server/wallet-admin \ + > server/wallet-admin.8 +pod2man --release="$version" --center=wallet -s 8 server/wallet-backend \ + > server/wallet-backend.8 -- cgit v1.2.3 From ce6c27ef04783e21baf44549ff9e361e0c0f148e Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 9 Feb 2010 15:27:16 -0800 Subject: Add Wallet::Kadmin files to PERL_FILES in Makefile.am --- Makefile.am | 23 ++++++++++++----------- 1 file changed, 12 insertions(+), 11 deletions(-) diff --git a/Makefile.am b/Makefile.am index 8777720..439b4c1 100644 --- a/Makefile.am +++ b/Makefile.am @@ -9,17 +9,18 @@ # and are not generated or touched by configure. They're listed here to be # added to EXTRA_DIST and so that they can be copied over properly for # builddir != srcdir builds. -PERL_FILES = perl/Wallet/ACL.pm perl/Wallet/ACL/Base.pm \ - perl/Wallet/ACL/Krb5.pm perl/Wallet/ACL/NetDB.pm \ - perl/Wallet/ACL/NetDB/Root.pm perl/Wallet/Admin.pm \ - perl/Wallet/Config.pm perl/Wallet/Database.pm \ - perl/Wallet/Object/Base.pm perl/Wallet/Object/File.pm \ - perl/Wallet/Object/Keytab.pm perl/Wallet/Schema.pm \ - perl/Wallet/Server.pm perl/t/acl.t perl/t/admin.t perl/t/config.t \ - perl/t/data/README perl/t/data/keytab-fake perl/t/data/keytab.conf \ - perl/t/data/netdb.conf perl/t/data/netdb-fake perl/t/init.t \ - perl/t/keytab.t perl/t/lib/Util.pm perl/t/object.t perl/t/pod.t \ - perl/t/schema.t perl/t/server.t perl/t/verifier-netdb.t \ +PERL_FILES = perl/Wallet/ACL.pm perl/Wallet/ACL/Base.pm \ + perl/Wallet/ACL/Krb5.pm perl/Wallet/ACL/NetDB.pm \ + perl/Wallet/ACL/NetDB/Root.pm perl/Wallet/Admin.pm \ + perl/Wallet/Config.pm perl/Wallet/Database.pm perl/Wallet/Kadmin.pm \ + perl/Wallet/Kadmin/Heimdal.pm perl/Wallet/Kadmin/MIT.pm \ + perl/Wallet/Object/Base.pm perl/Wallet/Object/File.pm \ + perl/Wallet/Object/Keytab.pm perl/Wallet/Schema.pm \ + perl/Wallet/Server.pm perl/t/acl.t perl/t/admin.t perl/t/config.t \ + perl/t/data/README perl/t/data/keytab-fake perl/t/data/keytab.conf \ + perl/t/data/netdb.conf perl/t/data/netdb-fake perl/t/init.t \ + perl/t/keytab.t perl/t/lib/Util.pm perl/t/object.t perl/t/pod.t \ + perl/t/schema.t perl/t/server.t perl/t/verifier-netdb.t \ perl/t/verifier.t TEST_FILES = tests/TESTS tests/data/README tests/data/allow-extract \ tests/data/basic.conf tests/data/cmd-fake tests/data/fake-data \ -- cgit v1.2.3 From ccf1cd7efa90bdcbe834e0d4ca144289cca97fd7 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 9 Feb 2010 15:32:54 -0800 Subject: Update portability code to rra-c-util 3.0 Add replacements for mkstemp and setenv, since we now use them when obtaining credentials in the client. Fix the bool type with Sun Studio 12 on Solaris 10. --- Makefile.am | 5 +-- NEWS | 2 ++ configure.ac | 2 +- portable/asprintf.c | 3 +- portable/mkstemp.c | 87 +++++++++++++++++++++++++++++++++++++++++++++++++++++ portable/setenv.c | 61 +++++++++++++++++++++++++++++++++++++ portable/stdbool.h | 4 ++- portable/system.h | 38 ++++++++++++++++------- 8 files changed, 186 insertions(+), 16 deletions(-) create mode 100644 portable/mkstemp.c create mode 100644 portable/setenv.c diff --git a/Makefile.am b/Makefile.am index 439b4c1..57fb6eb 100644 --- a/Makefile.am +++ b/Makefile.am @@ -1,7 +1,8 @@ -# Makefile.am -- Automake makefile for wallet. +# Automake makefile for wallet. # # Written by Russ Allbery -# 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. diff --git a/NEWS b/NEWS index 661771a..e7931dd 100644 --- a/NEWS +++ b/NEWS @@ -62,6 +62,8 @@ wallet 0.10 (unreleased) * Prefer KRB5_CONFIG over a path constructed from --with-*. * Update GSS-API probes for Solaris 10's native implementation. * Change AC_TRY_* to AC_*_IFELSE as recommended by Autoconf. + * Use AC_TYPE_LONG_LONG_INT instead of AC_CHECK_TYPES([long long]). + * Provide a proper bool type with Sun Studio 12 on Solaris 10. wallet 0.9 (2008-04-24) diff --git a/configure.ac b/configure.ac index 78fecea..1b91ff0 100644 --- a/configure.ac +++ b/configure.ac @@ -37,7 +37,7 @@ RRA_C_GNU_VAMACROS AC_TYPE_LONG_LONG_INT RRA_FUNC_SNPRINTF AC_CHECK_FUNCS([setrlimit]) -AC_REPLACE_FUNCS([asprintf strlcat strlcpy]) +AC_REPLACE_FUNCS([asprintf mkstemp setenv strlcat strlcpy]) AC_ARG_WITH([wallet-server], [AC_HELP_STRING([--with-wallet-server=HOST], [Default wallet server])], diff --git a/portable/asprintf.c b/portable/asprintf.c index 9451795..4219a19 100644 --- a/portable/asprintf.c +++ b/portable/asprintf.c @@ -18,7 +18,8 @@ #if TESTING # define asprintf test_asprintf # define vasprintf test_vasprintf -int test_asprintf(char **, const char *, ...); +int test_asprintf(char **, const char *, ...) + __attribute__((__format__(printf, 2, 3))); int test_vasprintf(char **, const char *, va_list); #endif diff --git a/portable/mkstemp.c b/portable/mkstemp.c new file mode 100644 index 0000000..dd2a485 --- /dev/null +++ b/portable/mkstemp.c @@ -0,0 +1,87 @@ +/* + * Replacement for a missing mkstemp. + * + * Provides the same functionality as the library function mkstemp for those + * systems that don't have it. + * + * Written by Russ Allbery + * This work is hereby placed in the public domain by its author. + */ + +#include +#include + +#include +#include +#include + +/* + * If we're running the test suite, rename mkstemp to avoid conflicts with the + * system version. #undef it first because some systems may define it to + * another name. + */ +#if TESTING +# undef mkstemp +# define mkstemp test_mkstemp +int test_mkstemp(char *); +#endif + +/* Pick the longest available integer type. */ +#if HAVE_LONG_LONG +typedef unsigned long long long_int_type; +#else +typedef unsigned long long_int_type; +#endif + +int +mkstemp(char *template) +{ + static const char letters[] = + "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"; + size_t length; + char *XXXXXX; + struct timeval tv; + long_int_type randnum, working; + int i, tries, fd; + + /* + * Make sure we have a valid template and initialize p to point at the + * beginning of the template portion of the string. + */ + length = strlen(template); + if (length < 6) { + errno = EINVAL; + return -1; + } + XXXXXX = template + length - 6; + if (strcmp(XXXXXX, "XXXXXX") != 0) { + errno = EINVAL; + return -1; + } + + /* Get some more-or-less random information. */ + gettimeofday(&tv, NULL); + randnum = ((long_int_type) tv.tv_usec << 16) ^ tv.tv_sec ^ getpid(); + + /* + * Now, try to find a working file name. We try no more than TMP_MAX file + * names. + */ + for (tries = 0; tries < TMP_MAX; tries++) { + for (working = randnum, i = 0; i < 6; i++) { + XXXXXX[i] = letters[working % 62]; + working /= 62; + } + fd = open(template, O_RDWR | O_CREAT | O_EXCL, 0600); + if (fd >= 0 || (errno != EEXIST && errno != EISDIR)) + return fd; + + /* + * This is a relatively random increment. Cut off the tail end of + * tv_usec since it's often predictable. + */ + randnum += (tv.tv_usec >> 10) & 0xfff; + } + errno = EEXIST; + return -1; +} diff --git a/portable/setenv.c b/portable/setenv.c new file mode 100644 index 0000000..d66ddcd --- /dev/null +++ b/portable/setenv.c @@ -0,0 +1,61 @@ +/* + * Replacement for a missing setenv. + * + * Provides the same functionality as the standard library routine setenv for + * those platforms that don't have it. + * + * Written by Russ Allbery + * This work is hereby placed in the public domain by its author. + */ + +#include +#include + +/* + * If we're running the test suite, rename setenv to avoid conflicts with + * the system version. + */ +#if TESTING +# define setenv test_setenv +int test_setenv(const char *, const char *, int); +#endif + +int +setenv(const char *name, const char *value, int overwrite) +{ + char *envstring; + size_t size; + + if (!overwrite && getenv(name) != NULL) + return 0; + + /* + * Allocate memory for the environment string. We intentionally don't use + * concat here, or the xmalloc family of allocation routines, since the + * intention is to provide a replacement for the standard library function + * which sets errno and returns in the event of a memory allocation + * failure. + */ + size = strlen(name) + 1 + strlen(value) + 1; + envstring = malloc(size); + if (envstring == NULL) + return -1; + + /* + * Build the environment string and add it to the environment using + * putenv. Systems without putenv lose, but XPG4 requires it. + */ + strlcpy(envstring, name, size); + strlcat(envstring, "=", size); + strlcat(envstring, value, size); + return putenv(envstring); + + /* + * Note that the memory allocated is not freed. This is intentional; many + * implementations of putenv assume that the string passed to putenv will + * never be freed and don't make a copy of it. Repeated use of this + * function will therefore leak memory, since most implementations of + * putenv also don't free strings removed from the environment (due to + * being overwritten). + */ +} diff --git a/portable/stdbool.h b/portable/stdbool.h index 01a2ff2..bfbf4c4 100644 --- a/portable/stdbool.h +++ b/portable/stdbool.h @@ -15,7 +15,9 @@ #if HAVE_STDBOOL_H # include #else -# if !HAVE__BOOL +# if HAVE__BOOL +# define bool _Bool +# else # ifdef __cplusplus typedef bool _Bool; # elif _WIN32 diff --git a/portable/system.h b/portable/system.h index b899d08..461601b 100644 --- a/portable/system.h +++ b/portable/system.h @@ -1,6 +1,9 @@ /* + * Standard system includes and portability adjustments. + * * Declarations of routines and variables in the C library. Including this - * file is the equivalent of including all of the following headers, portably: + * file is the equivalent of including all of the following headers, + * portably: * * #include * #include @@ -12,8 +15,8 @@ * #include * #include * - * Missing functions are provided via #define or prototyped if available. - * Also provides some standard #defines. + * Missing functions are provided via #define or prototyped if available from + * the portable helper library. Also provides some standard #defines. * * Written by Russ Allbery * This work is hereby placed in the public domain by its author. @@ -55,13 +58,17 @@ BEGIN_DECLS +/* Default to a hidden visibility for all portability functions. */ +#pragma GCC visibility push(hidden) + /* * Provide prototypes for functions not declared in system headers. Use the - * HAVE_DECL macros for those functions that may be prototyped but - * implemented incorrectly or implemented without a prototype. + * HAVE_DECL macros for those functions that may be prototyped but implemented + * incorrectly or implemented without a prototype. */ #if !HAVE_ASPRINTF -extern int asprintf(char **, const char *, ...); +extern int asprintf(char **, const char *, ...) + __attribute__((__format__(printf, 2, 3))); extern int vasprintf(char **, const char *, va_list); #endif #if !HAVE_DECL_SNPRINTF @@ -71,6 +78,12 @@ extern int snprintf(char *, size_t, const char *, ...) #if !HAVE_DECL_VSNPRINTF extern int vsnprintf(char *, size_t, const char *, va_list); #endif +#if !HAVE_MKSTEMP +extern int mkstemp(char *); +#endif +#if !HAVE_SETENV +extern int setenv(const char *, const char *, int); +#endif #if !HAVE_STRLCAT extern size_t strlcat(char *, const char *, size_t); #endif @@ -78,6 +91,9 @@ extern size_t strlcat(char *, const char *, size_t); extern size_t strlcpy(char *, const char *, size_t); #endif +/* Undo default visibility change. */ +#pragma GCC visibility pop + END_DECLS /* Windows provides snprintf under a different name. */ @@ -90,9 +106,9 @@ END_DECLS * been defined, all the rest almost certainly have. */ #ifndef STDIN_FILENO -# define STDIN_FILENO 0 -# define STDOUT_FILENO 1 -# define STDERR_FILENO 2 +# define STDIN_FILENO 0 +# define STDOUT_FILENO 1 +# define STDERR_FILENO 2 #endif /* @@ -101,9 +117,9 @@ END_DECLS */ #ifndef va_copy # ifdef __va_copy -# define va_copy(d, s) __va_copy((d), (s)) +# define va_copy(d, s) __va_copy((d), (s)) # else -# define va_copy(d, s) memcpy(&(d), &(s), sizeof(va_list)) +# define va_copy(d, s) memcpy(&(d), &(s), sizeof(va_list)) # endif #endif -- cgit v1.2.3 From d05f66dbff10b525d37f60ee01d5b9f94bf5192e Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 9 Feb 2010 16:00:04 -0800 Subject: Update util code and import Kerberos portability glue Use the Kerberos portability layer from rra-c-util 3.0 and avoid Kerberos API calls deprecated on Heimdal. Break util/util.h into separate header files and update all source files accordingly. The test suite is not yet updated. That will come in subsequent commits. --- Makefile.am | 11 ++-- NEWS | 3 + client/file.c | 6 +- client/internal.h | 4 +- client/keytab.c | 9 ++- client/krb5.c | 15 +++-- client/remctl.c | 5 +- client/srvtab.c | 10 +-- client/wallet.c | 8 ++- configure.ac | 4 +- portable/krb5-extra.c | 108 +++++++++++++++++++++++++++++++ portable/krb5.h | 74 ++++++++++++++++++++++ util/concat.c | 3 +- util/concat.h | 36 +++++++++++ util/macros.h | 17 +++++ util/messages-krb5.c | 74 +++------------------- util/messages-krb5.h | 39 ++++++++++++ util/messages.c | 29 +++------ util/messages.h | 96 ++++++++++++++++++++++++++++ util/util.h | 171 -------------------------------------------------- util/xmalloc.c | 24 ++----- util/xmalloc.h | 100 +++++++++++++++++++++++++++++ 22 files changed, 540 insertions(+), 306 deletions(-) create mode 100644 portable/krb5-extra.c create mode 100644 portable/krb5.h create mode 100644 util/concat.h create mode 100644 util/macros.h create mode 100644 util/messages-krb5.h create mode 100644 util/messages.h delete mode 100644 util/util.h create mode 100644 util/xmalloc.h diff --git a/Makefile.am b/Makefile.am index 57fb6eb..27a6e39 100644 --- a/Makefile.am +++ b/Makefile.am @@ -39,11 +39,14 @@ EXTRA_DIST = LICENSE autogen client/wallet.pod config/allow-extract \ docs/setup examples/stanford.conf $(PERL_FILES) $(TEST_FILES) noinst_LIBRARIES = portable/libportable.a util/libutil.a -portable_libportable_a_SOURCES = portable/dummy.c portable/macros.h \ - portable/stdbool.h portable/system.h +portable_libportable_a_SOURCES = portable/dummy.c portable/krb5-extra.c \ + portable/krb5.h portable/macros.h portable/stdbool.h \ + portable/system.h +portable_libportable_a_CPPFLAGS = $(KRB5_CPPFLAGS) portable_libportable_a_LIBADD = $(LIBOBJS) -util_libutil_a_SOURCES = util/concat.c util/messages.c util/messages-krb5.c \ - util/util.h util/xmalloc.c +util_libutil_a_SOURCES = util/concat.c util/concat.h util/macros.h \ + util/messages-krb5.c util/messages-krb5.h util/messages.c \ + util/messages.h util/xmalloc.c util/xmalloc.h util_libutil_a_CPPFLAGS = $(KRB5_CPPFLAGS) bin_PROGRAMS = client/wallet diff --git a/NEWS b/NEWS index e7931dd..1d3a5e3 100644 --- a/NEWS +++ b/NEWS @@ -52,6 +52,8 @@ wallet 0.10 (unreleased) Update to rra-c-util 3.0: + * Use Kerberos portability layer to support Heimdal. + * Avoid Kerberos API calls deprecated on Heimdal. * Sanity-check the results of krb5-config before proceeding. * Fall back on manual probing if krb5-config results don't work. * Add --with-krb5-include and --with-krb5-lib configure options. @@ -64,6 +66,7 @@ wallet 0.10 (unreleased) * Change AC_TRY_* to AC_*_IFELSE as recommended by Autoconf. * Use AC_TYPE_LONG_LONG_INT instead of AC_CHECK_TYPES([long long]). * Provide a proper bool type with Sun Studio 12 on Solaris 10. + * Break util/util.h into separate header files per module. wallet 0.9 (2008-04-24) diff --git a/client/file.c b/client/file.c index 670a30d..c9edf3a 100644 --- a/client/file.c +++ b/client/file.c @@ -2,7 +2,7 @@ * File handling for the wallet client. * * Written by Russ Allbery - * 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. */ @@ -15,7 +15,9 @@ #include #include -#include +#include +#include +#include /* * Given a filename, some data, and a length, write that data to the given diff --git a/client/internal.h b/client/internal.h index e48616a..7fe962b 100644 --- a/client/internal.h +++ b/client/internal.h @@ -2,7 +2,7 @@ * Internal support functions for the wallet client. * * Written by Russ Allbery - * 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. */ @@ -11,8 +11,8 @@ #define CLIENT_INTERNAL_H 1 #include +#include -#include #include /* Forward declarations to avoid unnecessary includes. */ diff --git a/client/keytab.c b/client/keytab.c index 393ce3c..5f2076f 100644 --- a/client/keytab.c +++ b/client/keytab.c @@ -8,12 +8,15 @@ */ #include +#include #include #include #include -#include +#include +#include +#include /* @@ -47,11 +50,7 @@ merge_keytab(krb5_context ctx, const char *newfile, const char *file) status = krb5_kt_add_entry(ctx, old, &entry); if (status != 0) die_krb5(ctx, status, "cannot write to keytab %s", file); -#ifdef HAVE_KRB5_KT_FREE_ENTRY krb5_kt_free_entry(ctx, &entry); -#else - krb5_free_keytab_entry_contents(ctx, &entry); -#endif } if (status != KRB5_KT_END) die_krb5(ctx, status, "error reading temporary keytab %s", newfile); diff --git a/client/krb5.c b/client/krb5.c index 3698dd3..38172ae 100644 --- a/client/krb5.c +++ b/client/krb5.c @@ -15,7 +15,8 @@ #include #include -#include +#include +#include /* @@ -29,7 +30,7 @@ kinit(krb5_context ctx, const char *principal) krb5_principal princ; krb5_ccache ccache; krb5_creds creds; - krb5_get_init_creds_opt opts; + krb5_get_init_creds_opt *opts; krb5_error_code status; char cache_name[] = "/tmp/krb5cc_wallet_XXXXXX"; int fd; @@ -38,17 +39,21 @@ kinit(krb5_context ctx, const char *principal) status = krb5_parse_name(ctx, principal, &princ); if (status != 0) die_krb5(ctx, status, "invalid Kerberos principal %s", principal); - krb5_get_init_creds_opt_init(&opts); + status = krb5_get_init_creds_opt_alloc(ctx, &opts); + if (status != 0) + die_krb5(ctx, status, "cannot allocate credential options"); + krb5_get_init_creds_opt_set_default_flags(ctx, "wallet", princ->realm, + opts); memset(&creds, 0, sizeof(creds)); status = krb5_get_init_creds_password(ctx, &creds, princ, NULL, - krb5_prompter_posix, NULL, 0, NULL, &opts); + krb5_prompter_posix, NULL, 0, NULL, opts); if (status != 0) die_krb5(ctx, status, "authentication failed"); /* Put the new credentials into a ticket cache. */ fd = mkstemp(cache_name); if (fd < 0) - sysdie("cannot create temporary ticket cache", cache_name); + sysdie("cannot create temporary ticket cache %s", cache_name); status = krb5_cc_resolve(ctx, cache_name, &ccache); if (status != 0) die_krb5(ctx, status, "cannot create cache %s", cache_name); diff --git a/client/remctl.c b/client/remctl.c index 8dfeb0a..a4ff097 100644 --- a/client/remctl.c +++ b/client/remctl.c @@ -2,7 +2,7 @@ * remctl interface for the wallet client. * * Written by Russ Allbery - * Copyright 2007 Board of Trustees, Leland Stanford Jr. University + * Copyright 2007, 2010 Board of Trustees, Leland Stanford Jr. University * * See LICENSE for licensing terms. */ @@ -13,7 +13,8 @@ #include #include -#include +#include +#include /* diff --git a/client/srvtab.c b/client/srvtab.c index 5b52955..b26e6fc 100644 --- a/client/srvtab.c +++ b/client/srvtab.c @@ -8,12 +8,12 @@ */ #include +#include #include -#include - #include -#include +#include +#include #ifndef KRB5_KRB4_COMPAT # define ANAME_SZ 40 @@ -87,11 +87,7 @@ write_srvtab(krb5_context ctx, const char *srvtab, const char *principal, memcpy(data + length, entry.key.contents, 8); #endif length += 8; -#ifdef HAVE_KRB5_KT_FREE_ENTRY krb5_kt_free_entry(ctx, &entry); -#else - krb5_free_keytab_entry_contents(ctx, &entry); -#endif /* Write out the srvtab file. */ write_file(srvtab, data, length); diff --git a/client/wallet.c b/client/wallet.c index 4225d45..ce0f4e7 100644 --- a/client/wallet.c +++ b/client/wallet.c @@ -2,21 +2,23 @@ * The client program for the wallet system. * * Written by Russ Allbery - * Copyright 2006, 2007, 2008 + * Copyright 2006, 2007, 2008, 2010 * Board of Trustees, Leland Stanford Jr. University * * See LICENSE for licensing terms. */ #include +#include #include #include -#include #include #include -#include +#include +#include +#include /* * Basic wallet behavior options set either on the command line or via diff --git a/configure.ac b/configure.ac index 1b91ff0..f66a682 100644 --- a/configure.ac +++ b/configure.ac @@ -25,7 +25,9 @@ AC_PROG_RANLIB RRA_LIB_REMCTL RRA_LIB_KRB5 RRA_LIB_KRB5_SWITCH -AC_CHECK_FUNCS([krb5_kt_free_entry]) +AC_CHECK_FUNCS([krb5_get_init_creds_opt_alloc \ + krb5_get_init_creds_opt_set_default_flags \ + krb5_kt_free_entry]) AC_CHECK_MEMBERS([krb5_keytab_entry.keyblock], , , [#include ]) RRA_LIB_KRB5_RESTORE diff --git a/portable/krb5-extra.c b/portable/krb5-extra.c new file mode 100644 index 0000000..09a717b --- /dev/null +++ b/portable/krb5-extra.c @@ -0,0 +1,108 @@ +/* + * Portability glue functions for Kerberos. + * + * This file provides definitions of the interfaces that portable/krb5.h + * ensures exist if the function wasn't available in the Kerberos libraries. + * Everything in this file will be protected by #ifndef. If the native + * Kerberos libraries are fully capable, this file will be skipped. + * + * Written by Russ Allbery + * This work is hereby placed in the public domain by its author. + */ + +#include +#include +#include + +#include + +/* Figure out what header files to include for error reporting. */ +#if !defined(HAVE_KRB5_GET_ERROR_MESSAGE) && !defined(HAVE_KRB5_GET_ERR_TEXT) +# if !defined(HAVE_KRB5_GET_ERROR_STRING) +# if defined(HAVE_IBM_SVC_KRB5_SVC_H) +# include +# elif defined(HAVE_ET_COM_ERR_H) +# include +# else +# include +# endif +# endif +#endif + +/* Used for unused parameters to silence gcc warnings. */ +#define UNUSED __attribute__((__unused__)) + +/* + * This string is returned for unknown error messages. We use a static + * variable so that we can be sure not to free it. + */ +static const char error_unknown[] = "unknown error"; + + +#ifndef HAVE_KRB5_GET_ERROR_MESSAGE +/* + * Given a Kerberos error code, return the corresponding error. Prefer the + * Kerberos interface if available since it will provide context-specific + * error information, whereas the error_message() call will only provide a + * fixed message. + */ +const char * +krb5_get_error_message(krb5_context ctx UNUSED, krb5_error_code code UNUSED) +{ + const char *msg = NULL; + +# if defined(HAVE_KRB5_GET_ERROR_STRING) + msg = krb5_get_error_string(ctx); +# elif defined(HAVE_KRB5_GET_ERR_TEXT) + msg = krb5_get_err_text(ctx, code); +# elif defined(HAVE_KRB5_SVC_GET_MSG) + krb5_svc_get_msg(code, (char **) &msg); +# else + msg = error_message(code); +# endif + if (msg == NULL) + return error_unknown; + else + return msg; +} +#endif /* !HAVE_KRB5_GET_ERROR_MESSAGE */ + + +#ifndef HAVE_KRB5_FREE_ERROR_MESSAGE +/* + * Free an error string if necessary. If we returned a static string, make + * sure we don't free it. + * + * This code assumes that the set of implementations that have + * 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 +krb5_free_error_message(krb5_context ctx UNUSED, const char *msg) +{ + if (msg == error_unknown) + return; +# if defined(HAVE_KRB5_GET_ERROR_STRING) + krb5_free_error_string(ctx, (char *) msg); +# elif defined(HAVE_KRB5_SVC_GET_MSG) + krb5_free_string(ctx, (char *) msg); +# endif +} +#endif /* !HAVE_KRB5_FREE_ERROR_MESSAGE */ + + +#ifndef HAVE_KRB5_GET_INIT_CREDS_OPT_ALLOC +/* + * Allocate and initialize a krb5_get_init_creds_opt struct. This code + * assumes that an all-zero bit pattern will create a NULL pointer. + */ +krb5_error_code +krb5_get_init_creds_opt_alloc(krb5_context ctx, krb5_get_init_creds_opt **opts) +{ + *opts = calloc(1, sizeof(krb5_get_init_creds_opt)); + if (*opts == NULL) + return errno; + krb5_get_init_creds_opt_init(*opts); + return 0; +} +#endif /* !HAVE_KRB5_GET_INIT_CREDS_OPT_ALLOC */ diff --git a/portable/krb5.h b/portable/krb5.h new file mode 100644 index 0000000..117f5ce --- /dev/null +++ b/portable/krb5.h @@ -0,0 +1,74 @@ +/* + * Portability wrapper around krb5.h. + * + * This header includes krb5.h and then adjusts for various portability + * issues, primarily between MIT Kerberos and Heimdal, so that code can be + * written to a consistent API. + * + * Unfortunately, due to the nature of the differences between MIT Kerberos + * and Heimdal, it's not possible to write code to either one of the APIs and + * adjust for the other one. In general, this header tries to make available + * the Heimdal API and fix it for MIT Kerberos, but there are places where MIT + * Kerberos requires a more specific call. For those cases, it provides the + * most specific interface. + * + * For example, MIT Kerberos has krb5_free_unparsed_name() whereas Heimdal + * prefers the generic krb5_xfree(). In this case, this header provides + * krb5_free_unparsed_name() for both APIs since it's the most specific call. + * + * Written by Russ Allbery + * This work is hereby placed in the public domain by its author. + */ + +#ifndef PORTABLE_KRB5_H +#define PORTABLE_KRB5_H 1 + +#include +#include + +#include + +BEGIN_DECLS + +/* Default to a hidden visibility for all portability functions. */ +#pragma GCC visibility push(hidden) + +/* + * krb5_{get,free}_error_message are the preferred APIs for both current MIT + * and current Heimdal, but there are tons of older APIs we may have to fall + * back on for earlier versions. + * + * This function should be called immediately after the corresponding error + * without any intervening Kerberos calls. Otherwise, the correct error + * message and supporting information may not be returned. + */ +#ifndef HAVE_KRB5_GET_ERROR_MESSAGE +const char *krb5_get_error_message(krb5_context, krb5_error_code); +#endif +#ifndef HAVE_KRB5_FREE_ERROR_MESSAGE +void krb5_free_error_message(krb5_context, const char *); +#endif + +/* + * Both current MIT and current Heimdal prefer _opt_alloc, but older versions + * of both require allocating your own struct and calling _opt_init. + */ +#ifndef HAVE_KRB5_GET_INIT_CREDS_OPT_ALLOC +krb5_error_code krb5_get_init_creds_opt_alloc(krb5_context, + krb5_get_init_creds_opt **); +#endif + +/* Heimdal-specific. */ +#ifndef HAVE_KRB5_GET_INIT_CREDS_OPT_SET_DEFAULT_FLAGS +#define krb5_get_init_creds_opt_set_default_flags(c, p, r, o) /* empty */ +#endif + +/* Heimdal: krb5_kt_free_entry, MIT: krb5_free_keytab_entry_contents. */ +#ifndef HAVE_KRB5_KT_FREE_ENTRY +# define krb5_kt_free_entry(c, e) krb5_free_keytab_entry_contents((c), (e)) +#endif + +/* Undo default visibility change. */ +#pragma GCC visibility pop + +#endif /* !PORTABLE_KRB5_H */ diff --git a/util/concat.c b/util/concat.c index bef67db..bdbd836 100644 --- a/util/concat.c +++ b/util/concat.c @@ -25,7 +25,8 @@ #include #include -#include +#include +#include /* Abbreviation for cleaner code. */ #define VA_NEXT(var, type) ((var) = (type) va_arg(args, type)) diff --git a/util/concat.h b/util/concat.h new file mode 100644 index 0000000..ef8b38d --- /dev/null +++ b/util/concat.h @@ -0,0 +1,36 @@ +/* + * Prototypes for string concatenation with dynamic memory allocation. + * + * Written by Russ Allbery + * This work is hereby placed in the public domain by its author. + */ + +#ifndef UTIL_CONCAT_H +#define UTIL_CONCAT_H 1 + +#include +#include + +BEGIN_DECLS + +/* Default to a hidden visibility for all util functions. */ +#pragma GCC visibility push(hidden) + +/* Concatenate NULL-terminated strings into a newly allocated string. */ +char *concat(const char *first, ...) + __attribute__((__malloc__, __nonnull__(1))); + +/* + * Given a base path and a file name, create a newly allocated path string. + * The name will be appended to base with a / between them. Exceptionally, if + * name begins with a slash, it will be strdup'd and returned as-is. + */ +char *concatpath(const char *base, const char *name) + __attribute__((__malloc__, __nonnull__(2))); + +/* Undo default visibility change. */ +#pragma GCC visibility pop + +END_DECLS + +#endif /* UTIL_CONCAT_H */ diff --git a/util/macros.h b/util/macros.h new file mode 100644 index 0000000..97b2c2b --- /dev/null +++ b/util/macros.h @@ -0,0 +1,17 @@ +/* + * Some standard helpful macros. + * + * Written by Russ Allbery + * This work is hereby placed in the public domain by its author. + */ + +#ifndef UTIL_MACROS_H +#define UTIL_MACROS_H 1 + +#include +#include + +/* Used for unused parameters to silence gcc warnings. */ +#define UNUSED __attribute__((__unused__)) + +#endif /* UTIL_MACROS_H */ diff --git a/util/messages-krb5.c b/util/messages-krb5.c index 00f4a2e..7f35d29 100644 --- a/util/messages-krb5.c +++ b/util/messages-krb5.c @@ -6,76 +6,20 @@ * formatted message. * * Written by Russ Allbery - * Copyright 2006, 2007, 2008 + * Copyright 2006, 2007, 2008, 2009, 2010 * Board of Trustees, Leland Stanford Jr. University * * See LICENSE for licensing terms. */ #include +#include #include -#include -#if !defined(HAVE_KRB5_GET_ERROR_MESSAGE) && !defined(HAVE_KRB5_GET_ERR_TEXT) -# if defined(HAVE_IBM_SVC_KRB5_SVC_H) -# include -# elif defined(HAVE_ET_COM_ERR_H) -# include -# else -# include -# endif -#endif - -#include - -/* - * This string is returned for unknown error messages. We use a static - * variable so that we can be sure not to free it. - */ -static const char error_unknown[] = "unknown error"; - - -/* - * Given a Kerberos error code, return the corresponding error. Prefer the - * Kerberos interface if available since it will provide context-specific - * error information, whereas the error_message() call will only provide a - * fixed message. - */ -static const char * -get_error(krb5_context ctx UNUSED, krb5_error_code code) -{ - const char *msg = NULL; - -#if defined(HAVE_KRB5_GET_ERROR_MESSAGE) - msg = krb5_get_error_message(ctx, code); -#elif defined(HAVE_KRB5_GET_ERR_TEXT) - msg = krb5_get_err_text(ctx, code); -#elif defined(HAVE_KRB5_SVC_GET_MSG) - krb5_svc_get_msg(code, &msg); -#else - msg = error_message(code); -#endif - if (msg == NULL) - return error_unknown; - else - return msg; -} - - -/* - * Free an error string if necessary. - */ -static void -free_error(krb5_context ctx UNUSED, const char *msg) -{ - if (msg == error_unknown) - return; -#if defined(HAVE_KRB5_FREE_ERROR_MESSAGE) - krb5_free_error_message(ctx, msg); -#elif defined(HAVE_KRB5_SVC_GET_MSG) - krb5_free_string((char *) msg); -#endif -} +#include +#include +#include +#include /* @@ -88,7 +32,7 @@ die_krb5(krb5_context ctx, krb5_error_code code, const char *format, ...) char *message; va_list args; - k5_msg = get_error(ctx, code); + k5_msg = krb5_get_error_message(ctx, code); va_start(args, format); if (xvasprintf(&message, format, args) < 0) die("internal error: unable to format error message"); @@ -107,12 +51,12 @@ warn_krb5(krb5_context ctx, krb5_error_code code, const char *format, ...) char *message; va_list args; - k5_msg = get_error(ctx, code); + k5_msg = krb5_get_error_message(ctx, code); va_start(args, format); if (xvasprintf(&message, format, args) < 0) die("internal error: unable to format error message"); va_end(args); warn("%s: %s", message, k5_msg); free(message); - free_error(ctx, k5_msg); + krb5_free_error_message(ctx, k5_msg); } diff --git a/util/messages-krb5.h b/util/messages-krb5.h new file mode 100644 index 0000000..3b763c8 --- /dev/null +++ b/util/messages-krb5.h @@ -0,0 +1,39 @@ +/* + * Prototypes for error handling for Kerberos. + * + * Written by Russ Allbery + * Copyright 2006, 2007, 2008, 2009, 2010 + * Board of Trustees, Leland Stanford Jr. University + * + * See LICENSE for licensing terms. + */ + +#ifndef UTIL_MESSAGES_KRB5_H +#define UTIL_MESSAGES_KRB5_H 1 + +#include +#include + +#include +#include + +BEGIN_DECLS + +/* Default to a hidden visibility for all util functions. */ +#pragma GCC visibility push(hidden) + +/* + * The Kerberos versions of the reporting functions. These take a context and + * an error code to get the Kerberos error. + */ +void die_krb5(krb5_context, krb5_error_code, const char *, ...) + __attribute__((__nonnull__, __noreturn__, __format__(printf, 3, 4))); +void warn_krb5(krb5_context, krb5_error_code, const char *, ...) + __attribute__((__nonnull__, __format__(printf, 3, 4))); + +/* Undo default visibility change. */ +#pragma GCC visibility pop + +END_DECLS + +#endif /* UTIL_MESSAGES_KRB5_H */ diff --git a/util/messages.c b/util/messages.c index 0a106f6..ef920b2 100644 --- a/util/messages.c +++ b/util/messages.c @@ -51,26 +51,13 @@ * va_list, and the applicable errno value (if any). * * Copyright 2008 Board of Trustees, Leland Stanford Jr. University - * Copyright 2004, 2005, 2006 + * Copyright (c) 2004, 2005, 2006 * by Internet Systems Consortium, Inc. ("ISC") - * Copyright 1991, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, - * 2003 by The Internet Software Consortium and Rich Salz + * Copyright (c) 1991, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, + * 2002, 2003 by The Internet Software Consortium and Rich Salz * - * This code is derived from software contributed to the Internet Software - * Consortium by Rich Salz. - * - * Permission to use, copy, modify, and distribute this software for any - * purpose with or without fee is hereby granted, provided that the above - * copyright notice and this permission notice appear in all copies. - * - * THE SOFTWARE IS PROVIDED "AS IS" AND ISC DISCLAIMS ALL WARRANTIES WITH - * REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY - * AND FITNESS. IN NO EVENT SHALL ISC BE LIABLE FOR ANY SPECIAL, DIRECT, - * INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM - * LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE - * OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR - * PERFORMANCE OF THIS SOFTWARE. -*/ + * See LICENSE for licensing terms. + */ #include #include @@ -90,7 +77,9 @@ # define LOG_CRIT EVENTLOG_ERROR_TYPE #endif -#include +#include +#include +#include /* The default handler lists. */ static message_handler_func stdout_handlers[2] = { @@ -211,7 +200,7 @@ message_log_syslog(int pri, int len, const char *fmt, va_list args, int err) eventlog = RegisterEventSource(NULL, message_program_name); if (eventlog != NULL) { - ReportEvent(eventlog, pri, 0, 0, NULL, 1, 0, &buffer, NULL); + ReportEvent(eventlog, (WORD) pri, 0, 0, NULL, 1, 0, &buffer, NULL); CloseEventLog(eventlog); } } diff --git a/util/messages.h b/util/messages.h new file mode 100644 index 0000000..ff86f39 --- /dev/null +++ b/util/messages.h @@ -0,0 +1,96 @@ +/* + * Prototypes for message and error reporting (possibly fatal). + * + * Copyright 2008, 2010 Board of Trustees, Leland Stanford Jr. University + * Copyright (c) 2004, 2005, 2006 + * by Internet Systems Consortium, Inc. ("ISC") + * Copyright (c) 1991, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, + * 2002, 2003 by The Internet Software Consortium and Rich Salz + * + * See LICENSE for licensing terms. + */ + +#ifndef UTIL_MESSAGES_H +#define UTIL_MESSAGES_H 1 + +#include +#include + +#include + +BEGIN_DECLS + +/* Default to a hidden visibility for all util functions. */ +#pragma GCC visibility push(hidden) + +/* + * The reporting functions. The ones prefaced by "sys" add a colon, a space, + * and the results of strerror(errno) to the output and are intended for + * reporting failures of system calls. + */ +void debug(const char *, ...) + __attribute__((__nonnull__, __format__(printf, 1, 2))); +void notice(const char *, ...) + __attribute__((__nonnull__, __format__(printf, 1, 2))); +void sysnotice(const char *, ...) + __attribute__((__nonnull__, __format__(printf, 1, 2))); +void warn(const char *, ...) + __attribute__((__nonnull__, __format__(printf, 1, 2))); +void syswarn(const char *, ...) + __attribute__((__nonnull__, __format__(printf, 1, 2))); +void die(const char *, ...) + __attribute__((__nonnull__, __noreturn__, __format__(printf, 1, 2))); +void sysdie(const char *, ...) + __attribute__((__nonnull__, __noreturn__, __format__(printf, 1, 2))); + +/* + * Set the handlers for various message functions. All of these functions + * take a count of the number of handlers and then function pointers for each + * of those handlers. These functions are not thread-safe; they set global + * variables. + */ +void message_handlers_debug(int count, ...); +void message_handlers_notice(int count, ...); +void message_handlers_warn(int count, ...); +void message_handlers_die(int count, ...); + +/* + * Some useful handlers, intended to be passed to message_handlers_*. All + * handlers take the length of the formatted message, the format, a variadic + * argument list, and the errno setting if any. + */ +void message_log_stdout(int, const char *, va_list, int) + __attribute((__nonnull__)); +void message_log_stderr(int, const char *, va_list, int) + __attribute((__nonnull__)); +void message_log_syslog_debug(int, const char *, va_list, int) + __attribute((__nonnull__)); +void message_log_syslog_info(int, const char *, va_list, int) + __attribute((__nonnull__)); +void message_log_syslog_notice(int, const char *, va_list, int) + __attribute((__nonnull__)); +void message_log_syslog_warning(int, const char *, va_list, int) + __attribute((__nonnull__)); +void message_log_syslog_err(int, const char *, va_list, int) + __attribute((__nonnull__)); +void message_log_syslog_crit(int, const char *, va_list, int) + __attribute((__nonnull__)); + +/* The type of a message handler. */ +typedef void (*message_handler_func)(int, const char *, va_list, int); + +/* If non-NULL, called before exit and its return value passed to exit. */ +extern int (*message_fatal_cleanup)(void); + +/* + * If non-NULL, prepended (followed by ": ") to all messages printed by either + * message_log_stdout or message_log_stderr. + */ +extern const char *message_program_name; + +/* Undo default visibility change. */ +#pragma GCC visibility pop + +END_DECLS + +#endif /* UTIL_MESSAGES_H */ diff --git a/util/util.h b/util/util.h deleted file mode 100644 index 6ac7fa7..0000000 --- a/util/util.h +++ /dev/null @@ -1,171 +0,0 @@ -/* - * Utility functions. - * - * This is a variety of utility functions that are used internally by pieces - * of remctl. Many of them came originally from INN. - * - * Written by Russ Allbery - * Copyright 2005, 2006, 2007, 2008 - * Board of Trustees, Leland Stanford Jr. University - * Copyright 2004, 2005, 2006, 2007 - * by Internet Systems Consortium, Inc. ("ISC") - * Copyright 1991, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, - * 2003 by The Internet Software Consortium and Rich Salz - * - * See LICENSE for licensing terms. - */ - -#ifndef UTIL_UTIL_H -#define UTIL_UTIL_H 1 - -#include -#include - -#include -#include -#include - -/* Used for unused parameters to silence gcc warnings. */ -#define UNUSED __attribute__((__unused__)) - -BEGIN_DECLS - -/* Concatenate NULL-terminated strings into a newly allocated string. */ -extern char *concat(const char *first, ...); - -/* - * Given a base path and a file name, create a newly allocated path string. - * The name will be appended to base with a / between them. Exceptionally, if - * name begins with a slash, it will be strdup'd and returned as-is. - */ -extern char *concatpath(const char *base, const char *name); - -/* - * The reporting functions. The ones prefaced by "sys" add a colon, a space, - * and the results of strerror(errno) to the output and are intended for - * reporting failures of system calls. - */ -extern void debug(const char *, ...) - __attribute__((__format__(printf, 1, 2))); -extern void notice(const char *, ...) - __attribute__((__format__(printf, 1, 2))); -extern void sysnotice(const char *, ...) - __attribute__((__format__(printf, 1, 2))); -extern void warn(const char *, ...) - __attribute__((__format__(printf, 1, 2))); -extern void syswarn(const char *, ...) - __attribute__((__format__(printf, 1, 2))); -extern void die(const char *, ...) - __attribute__((__noreturn__, __format__(printf, 1, 2))); -extern void sysdie(const char *, ...) - __attribute__((__noreturn__, __format__(printf, 1, 2))); - -/* - * The Kerberos versions of the reporting functions. These take a context and - * an error code to get the Kerberos error. - */ -void die_krb5(krb5_context, krb5_error_code, const char *, ...) - __attribute__((__noreturn__, __format__(printf, 3, 4))); -void warn_krb5(krb5_context, krb5_error_code, const char *, ...) - __attribute__((__format__(printf, 3, 4))); - -/* - * Set the handlers for various message functions. All of these functions - * take a count of the number of handlers and then function pointers for each - * of those handlers. These functions are not thread-safe; they set global - * variables. - */ -extern void message_handlers_debug(int count, ...); -extern void message_handlers_notice(int count, ...); -extern void message_handlers_warn(int count, ...); -extern void message_handlers_die(int count, ...); - -/* - * Some useful handlers, intended to be passed to message_handlers_*. All - * handlers take the length of the formatted message, the format, a variadic - * argument list, and the errno setting if any. - */ -extern void message_log_stdout(int, const char *, va_list, int); -extern void message_log_stderr(int, const char *, va_list, int); -extern void message_log_syslog_debug(int, const char *, va_list, int); -extern void message_log_syslog_info(int, const char *, va_list, int); -extern void message_log_syslog_notice(int, const char *, va_list, int); -extern void message_log_syslog_warning(int, const char *, va_list, int); -extern void message_log_syslog_err(int, const char *, va_list, int); -extern void message_log_syslog_crit(int, const char *, va_list, int); - -/* The type of a message handler. */ -typedef void (*message_handler_func)(int, const char *, va_list, int); - -/* If non-NULL, called before exit and its return value passed to exit. */ -extern int (*message_fatal_cleanup)(void); - -/* - * If non-NULL, prepended (followed by ": ") to all messages printed by either - * message_log_stdout or message_log_stderr. - */ -extern const char *message_program_name; - -/* - * The functions are actually macros so that we can pick up the file and line - * number information for debugging error messages without the user having to - * pass those in every time. - */ -#define xcalloc(n, size) x_calloc((n), (size), __FILE__, __LINE__) -#define xmalloc(size) x_malloc((size), __FILE__, __LINE__) -#define xrealloc(p, size) x_realloc((p), (size), __FILE__, __LINE__) -#define xstrdup(p) x_strdup((p), __FILE__, __LINE__) -#define xstrndup(p, size) x_strndup((p), (size), __FILE__, __LINE__) -#define xvasprintf(p, f, a) x_vasprintf((p), (f), (a), __FILE__, __LINE__) - -/* - * asprintf is a special case since it takes variable arguments. If we have - * support for variadic macros, we can still pass in the file and line and - * just need to put them somewhere else in the argument list than last. - * Otherwise, just call x_asprintf directly. This means that the number of - * arguments x_asprintf takes must vary depending on whether variadic macros - * are supported. - */ -#ifdef HAVE_C99_VAMACROS -# define xasprintf(p, f, ...) \ - x_asprintf((p), __FILE__, __LINE__, (f), __VA_ARGS__) -#elif HAVE_GNU_VAMACROS -# define xasprintf(p, f, args...) \ - x_asprintf((p), __FILE__, __LINE__, (f), args) -#else -# define xasprintf x_asprintf -#endif - -/* - * Last two arguments are always file and line number. These are internal - * implementations that should not be called directly. - */ -extern void *x_calloc(size_t, size_t, const char *, int); -extern void *x_malloc(size_t, const char *, int); -extern void *x_realloc(void *, size_t, const char *, int); -extern char *x_strdup(const char *, const char *, int); -extern char *x_strndup(const char *, size_t, const char *, int); -extern int x_vasprintf(char **, const char *, va_list, const char *, int); - -/* asprintf special case. */ -#if HAVE_C99_VAMACROS || HAVE_GNU_VAMACROS -extern int x_asprintf(char **, const char *, int, const char *, ...); -#else -extern int x_asprintf(char **, const char *, ...); -#endif - -/* Failure handler takes the function, the size, the file, and the line. */ -typedef void (*xmalloc_handler_type)(const char *, size_t, const char *, int); - -/* The default error handler. */ -void xmalloc_fail(const char *, size_t, const char *, int); - -/* - * Assign to this variable to choose a handler other than the default, which - * just calls sysdie. - */ -extern xmalloc_handler_type xmalloc_error_handler; - -END_DECLS - -#endif /* UTIL_UTIL_H */ diff --git a/util/xmalloc.c b/util/xmalloc.c index 412890e..4e05f96 100644 --- a/util/xmalloc.c +++ b/util/xmalloc.c @@ -55,25 +55,12 @@ * header file defines macros named xmalloc, etc. that pass the file name and * line number to these functions. * - * Copyright 2004, 2005, 2006 + * Copyright (c) 2004, 2005, 2006 * by Internet Systems Consortium, Inc. ("ISC") - * Copyright 1991, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, - * 2003 by The Internet Software Consortium and Rich Salz + * Copyright (c) 1991, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, + * 2002, 2003 by The Internet Software Consortium and Rich Salz * - * This code is derived from software contributed to the Internet Software - * Consortium by Rich Salz. - * - * Permission to use, copy, modify, and distribute this software for any - * purpose with or without fee is hereby granted, provided that the above - * copyright notice and this permission notice appear in all copies. - * - * THE SOFTWARE IS PROVIDED "AS IS" AND ISC DISCLAIMS ALL WARRANTIES WITH - * REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY - * AND FITNESS. IN NO EVENT SHALL ISC BE LIABLE FOR ANY SPECIAL, DIRECT, - * INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM - * LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE - * OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR - * PERFORMANCE OF THIS SOFTWARE. + * See LICENSE for licensing terms. */ #include @@ -81,7 +68,8 @@ #include -#include +#include +#include /* diff --git a/util/xmalloc.h b/util/xmalloc.h new file mode 100644 index 0000000..657a6bb --- /dev/null +++ b/util/xmalloc.h @@ -0,0 +1,100 @@ +/* + * Prototypes for malloc routines with failure handling. + * + * Copyright 2010 Board of Trustees, Leland Stanford Jr. University + * Copyright (c) 2004, 2005, 2006 + * by Internet Systems Consortium, Inc. ("ISC") + * Copyright (c) 1991, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, + * 2002, 2003 by The Internet Software Consortium and Rich Salz + * + * See LICENSE for licensing terms. + */ + +#ifndef UTIL_XMALLOC_H +#define UTIL_XMALLOC_H 1 + +#include +#include + +#include + +/* + * The functions are actually macros so that we can pick up the file and line + * number information for debugging error messages without the user having to + * pass those in every time. + */ +#define xcalloc(n, size) x_calloc((n), (size), __FILE__, __LINE__) +#define xmalloc(size) x_malloc((size), __FILE__, __LINE__) +#define xrealloc(p, size) x_realloc((p), (size), __FILE__, __LINE__) +#define xstrdup(p) x_strdup((p), __FILE__, __LINE__) +#define xstrndup(p, size) x_strndup((p), (size), __FILE__, __LINE__) +#define xvasprintf(p, f, a) x_vasprintf((p), (f), (a), __FILE__, __LINE__) + +/* + * asprintf is a special case since it takes variable arguments. If we have + * support for variadic macros, we can still pass in the file and line and + * just need to put them somewhere else in the argument list than last. + * Otherwise, just call x_asprintf directly. This means that the number of + * arguments x_asprintf takes must vary depending on whether variadic macros + * are supported. + */ +#ifdef HAVE_C99_VAMACROS +# define xasprintf(p, f, ...) \ + x_asprintf((p), __FILE__, __LINE__, (f), __VA_ARGS__) +#elif HAVE_GNU_VAMACROS +# define xasprintf(p, f, args...) \ + x_asprintf((p), __FILE__, __LINE__, (f), args) +#else +# define xasprintf x_asprintf +#endif + +BEGIN_DECLS + +/* Default to a hidden visibility for all util functions. */ +#pragma GCC visibility push(hidden) + +/* + * Last two arguments are always file and line number. These are internal + * implementations that should not be called directly. + */ +void *x_calloc(size_t, size_t, const char *, int) + __attribute__((__alloc_size__(1, 2), __malloc__, __nonnull__)); +void *x_malloc(size_t, const char *, int) + __attribute__((__alloc_size__(1), __malloc__, __nonnull__)); +void *x_realloc(void *, size_t, const char *, int) + __attribute__((__alloc_size__(2), __malloc__, __nonnull__(3))); +char *x_strdup(const char *, const char *, int) + __attribute__((__malloc__, __nonnull__)); +char *x_strndup(const char *, size_t, const char *, int) + __attribute__((__malloc__, __nonnull__)); +int x_vasprintf(char **, const char *, va_list, const char *, int) + __attribute__((__nonnull__)); + +/* asprintf special case. */ +#if HAVE_C99_VAMACROS || HAVE_GNU_VAMACROS +int x_asprintf(char **, const char *, int, const char *, ...) + __attribute__((__nonnull__, __format__(printf, 4, 5))); +#else +int x_asprintf(char **, const char *, ...) + __attribute__((__nonnull__, __format__(printf, 2, 3))); +#endif + +/* Failure handler takes the function, the size, the file, and the line. */ +typedef void (*xmalloc_handler_type)(const char *, size_t, const char *, int); + +/* The default error handler. */ +void xmalloc_fail(const char *, size_t, const char *, int) + __attribute__((__nonnull__)); + +/* + * Assign to this variable to choose a handler other than the default, which + * just calls sysdie. + */ +extern xmalloc_handler_type xmalloc_error_handler; + +/* Undo default visibility change. */ +#pragma GCC visibility pop + +END_DECLS + +#endif /* UTIL_XMALLOC_H */ -- cgit v1.2.3 From c02942ddc12408f0e5b9d828cddf240519d1fe93 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 9 Feb 2010 18:40:22 -0800 Subject: Update to C TAP Harness 1.1 and rra-c-util 3.0 tests * Update portable and util tests for C TAP Harness 1.1. * Remove the need for Autoconf substitution in test programs. * Support running a single test program with runtests -o. * Properly handle test cases that are skipped in their entirety. * Much improved C TAP library more closely matching Test::More. Rewrite client/basic-t to use the new test library functions and my current test case coding style. --- .gitignore | 4 +- Makefile.am | 52 ++++--- NEWS | 8 + README | 8 +- configure.ac | 1 - tests/TESTS | 3 + tests/client/basic-t.in | 220 +++++++++----------------- tests/libtest.c | 203 ------------------------ tests/libtest.h | 69 --------- tests/libtest.sh | 80 ---------- tests/portable/asprintf-t.c | 34 +++-- tests/portable/mkstemp-t.c | 73 +++++++++ tests/portable/mkstemp.c | 2 + tests/portable/setenv-t.c | 46 ++++++ tests/portable/setenv.c | 2 + tests/portable/snprintf-t.c | 123 +++++++-------- tests/portable/strlcat-t.c | 84 +++++----- tests/portable/strlcpy-t.c | 73 +++++---- tests/runtests.c | 327 ++++++++++++++++++++++++++++++--------- tests/tap/basic.c | 356 +++++++++++++++++++++++++++++++++++++++++++ tests/tap/basic.h | 98 ++++++++++++ tests/tap/kerberos.c | 164 ++++++++++++++++++++ tests/tap/kerberos.h | 32 ++++ tests/tap/kerberos.sh | 48 ++++++ tests/tap/libtap.sh | 148 ++++++++++++++++++ tests/tap/messages.c | 80 ++++++++++ tests/tap/messages.h | 35 +++++ tests/tap/process.c | 100 ++++++++++++ tests/tap/process.h | 37 +++++ tests/tap/remctl.sh | 46 ++++++ tests/util/concat-t.c | 60 +++----- tests/util/messages-krb5-t.c | 99 ++++++++++++ tests/util/messages-t.c | 201 +++++++----------------- tests/util/xmalloc-t | 127 +++++++++++++++ tests/util/xmalloc-t.in | 126 --------------- tests/util/xmalloc.c | 85 ++++++----- 36 files changed, 2138 insertions(+), 1116 deletions(-) delete mode 100644 tests/libtest.c delete mode 100644 tests/libtest.h delete mode 100644 tests/libtest.sh create mode 100644 tests/portable/mkstemp-t.c create mode 100644 tests/portable/mkstemp.c create mode 100644 tests/portable/setenv-t.c create mode 100644 tests/portable/setenv.c create mode 100644 tests/tap/basic.c create mode 100644 tests/tap/basic.h create mode 100644 tests/tap/kerberos.c create mode 100644 tests/tap/kerberos.h create mode 100644 tests/tap/kerberos.sh create mode 100644 tests/tap/libtap.sh create mode 100644 tests/tap/messages.c create mode 100644 tests/tap/messages.h create mode 100644 tests/tap/process.c create mode 100644 tests/tap/process.h create mode 100644 tests/tap/remctl.sh create mode 100644 tests/util/messages-krb5-t.c create mode 100755 tests/util/xmalloc-t delete mode 100644 tests/util/xmalloc-t.in diff --git a/.gitignore b/.gitignore index 4599484..09ae109 100644 --- a/.gitignore +++ b/.gitignore @@ -28,6 +28,8 @@ /tests/data/test.krbtype /tests/kasetkey/basic-t /tests/portable/asprintf-t +/tests/portable/mkstemp-t +/tests/portable/setenv-t /tests/portable/snprintf-t /tests/portable/strlcat-t /tests/portable/strlcpy-t @@ -37,9 +39,9 @@ /tests/server/keytab-t /tests/server/pod-t /tests/util/concat-t +/tests/util/messages-krb5-t /tests/util/messages-t /tests/util/xmalloc -/tests/util/xmalloc-t /wallet-*.tar.gz /stamp-h1 .deps diff --git a/Makefile.am b/Makefile.am index 27a6e39..056229b 100644 --- a/Makefile.am +++ b/Makefile.am @@ -117,33 +117,45 @@ distclean-local: fi # The bits below are for the test suite, not for the main package. -check_PROGRAMS = tests/runtests tests/portable/asprintf-t \ - tests/portable/snprintf-t tests/portable/strlcat-t \ - tests/portable/strlcpy-t tests/util/concat-t tests/util/messages-t \ - tests/util/xmalloc -check_LIBRARIES = tests/libtest.a -tests_libtest_a_SOURCES = tests/libtest.c tests/libtest.h +check_PROGRAMS = tests/runtests tests/portable/asprintf-t \ + tests/portable/mkstemp-t tests/portable/setenv-t \ + tests/portable/snprintf-t tests/portable/strlcat-t \ + tests/portable/strlcpy-t tests/util/concat-t \ + tests/util/messages-krb5-t tests/util/messages-t tests/util/xmalloc +tests_runtests_CPPFLAGS = -DSOURCE='"$(abs_top_srcdir)/tests"' \ + -DBUILD='"$(abs_top_builddir)/tests"' +check_LIBRARIES = tests/tap/libtap.a +tests_tap_libtap_a_CPPFLAGS = -I$(abs_top_srcdir)/tests $(KRB5_CPPFLAGS) +tests_tap_libtap_a_SOURCES = tests/tap/basic.c tests/tap/basic.h \ + tests/tap/kerberos.c tests/tap/kerberos.h tests/tap/messages.c \ + tests/tap/messages.h tests/tap/process.c tests/tap/process.h # All of the test programs. tests_portable_asprintf_t_SOURCES = tests/portable/asprintf-t.c \ - tests/portable/asprintf.c -tests_portable_asprintf_t_LDADD = tests/libtest.a util/libutil.a \ - portable/libportable.a + tests/portable/asprintf.c +tests_portable_asprintf_t_LDADD = tests/tap/libtap.a portable/libportable.a +tests_portable_mkstemp_t_SOURCES = tests/portable/mkstemp-t.c \ + tests/portable/mkstemp.c +tests_portable_mkstemp_t_LDADD = tests/tap/libtap.a portable/libportable.a +tests_portable_setenv_t_SOURCES = tests/portable/setenv-t.c \ + tests/portable/setenv.c +tests_portable_setenv_t_LDADD = tests/tap/libtap.a portable/libportable.a tests_portable_snprintf_t_SOURCES = tests/portable/snprintf-t.c \ - tests/portable/snprintf.c -tests_portable_snprintf_t_LDADD = tests/libtest.a util/libutil.a \ - portable/libportable.a + tests/portable/snprintf.c +tests_portable_snprintf_t_LDADD = tests/tap/libtap.a portable/libportable.a tests_portable_strlcat_t_SOURCES = tests/portable/strlcat-t.c \ - tests/portable/strlcat.c -tests_portable_strlcat_t_LDADD = tests/libtest.a util/libutil.a \ - portable/libportable.a + tests/portable/strlcat.c +tests_portable_strlcat_t_LDADD = tests/tap/libtap.a portable/libportable.a tests_portable_strlcpy_t_SOURCES = tests/portable/strlcpy-t.c \ - tests/portable/strlcpy.c -tests_portable_strlcpy_t_LDADD = tests/libtest.a util/libutil.a \ - portable/libportable.a -tests_util_concat_t_LDADD = tests/libtest.a util/libutil.a \ + tests/portable/strlcpy.c +tests_portable_strlcpy_t_LDADD = tests/tap/libtap.a portable/libportable.a +tests_util_concat_t_LDADD = tests/tap/libtap.a util/libutil.a \ portable/libportable.a -tests_util_messages_t_LDADD = tests/libtest.a util/libutil.a \ +tests_util_messages_krb5_t_CPPFLAGS = $(KRB5_CPPFLAGS) +tests_util_messages_krb5_t_LDFLAGS = $(KRB5_LDFLAGS) +tests_util_messages_krb5_t_LDADD = tests/tap/libtap.a util/libutil.a \ + portable/libportable.a $(KRB5_LIBS) +tests_util_messages_t_LDADD = tests/tap/libtap.a util/libutil.a \ portable/libportable.a tests_util_xmalloc_LDADD = util/libutil.a portable/libportable.a diff --git a/NEWS b/NEWS index 1d3a5e3..96962f8 100644 --- a/NEWS +++ b/NEWS @@ -67,6 +67,14 @@ wallet 0.10 (unreleased) * Use AC_TYPE_LONG_LONG_INT instead of AC_CHECK_TYPES([long long]). * Provide a proper bool type with Sun Studio 12 on Solaris 10. * Break util/util.h into separate header files per module. + * Update portable and util tests for C TAP Harness 1.1. + + Update to C TAP Harness 1.1: + + * Remove the need for Autoconf substitution in test programs. + * Support running a single test program with runtests -o. + * Properly handle test cases that are skipped in their entirety. + * Much improved C TAP library more closely matching Test::More. wallet 0.9 (2008-04-24) diff --git a/README b/README index 7302c06..eb9b39c 100644 --- a/README +++ b/README @@ -233,8 +233,12 @@ TESTING not available, but this has not yet been fully tested in all of its possible permutations. - If a test case fails, please run that individual test program directly - and send me the output when reporting the problem. + If a test fails, you can run a single test with verbose output via: + + tests/runtests -o + + Do this instead of running the test program directly since it will + ensure that necessary environment variables are set up. CONFIGURATION diff --git a/configure.ac b/configure.ac index f66a682..0330aa9 100644 --- a/configure.ac +++ b/configure.ac @@ -70,5 +70,4 @@ AC_CONFIG_FILES([tests/server/admin-t], [chmod +x tests/server/admin-t]) AC_CONFIG_FILES([tests/server/backend-t], [chmod +x tests/server/backend-t]) AC_CONFIG_FILES([tests/server/keytab-t], [chmod +x tests/server/keytab-t]) AC_CONFIG_FILES([tests/server/pod-t], [chmod +x tests/server/pod-t]) -AC_CONFIG_FILES([tests/util/xmalloc-t], [chmod +x tests/util/xmalloc-t]) AC_OUTPUT diff --git a/tests/TESTS b/tests/TESTS index a446643..ac6fd82 100644 --- a/tests/TESTS +++ b/tests/TESTS @@ -3,6 +3,8 @@ client/full client/pod client/prompt portable/asprintf +portable/mkstemp +portable/setenv portable/snprintf portable/strlcat portable/strlcpy @@ -12,4 +14,5 @@ server/keytab server/pod util/concat util/messages +util/messages-krb5 util/xmalloc diff --git a/tests/client/basic-t.in b/tests/client/basic-t.in index 96b165e..1dbc0b9 100644 --- a/tests/client/basic-t.in +++ b/tests/client/basic-t.in @@ -9,43 +9,10 @@ # See LICENSE for licensing terms. # Load the test library. -. "@abs_top_srcdir@/tests/libtest.sh" - -# Print the number of tests. -total=31 -count=1 -echo "$total" - -# Find the client program. -chdir_data '../client/wallet' -if [ ! -f 'data/test.keytab' ] || [ -z '@REMCTLD@' ] ; then - skip 1 "$total" 'no Kerberos configuration' - exit 0 -fi -wallet='../client/wallet' - -# Start the remctld daemon and wait for it to start. -principal=`cat data/test.principal` -rm -f data/pid -( @REMCTLD@ -m -p 14373 -s "$principal" -P data/pid -f data/basic.conf \ - -S -F -k data/test.keytab &) -KRB5CCNAME=data/test.cache; export KRB5CCNAME -kinit -k -t data/test.keytab "$principal" > /dev/null 2>&1 -if [ $? != 0 ] ; then - kinit -t data/test.keytab "$principal" > /dev/null 2>&1 -fi -if [ $? != 0 ] ; then - kinit -T /bin/true -k -K data/test.keytab "$principal" > /dev/null 2>&1 -fi -if [ $? != 0 ] ; then - echo 'Unable to obtain Kerberos tickets' >&2 - exit 1 -fi -[ -f data/pid ] || sleep 1 -if [ ! -f data/pid ] ; then - echo 'remctld did not start' >&2 - exit 1 -fi +. "$SOURCE/tap/libtap.sh" +. "$SOURCE/tap/kerberos.sh" +. "$SOURCE/tap/remctl.sh" +cd "$BUILD" # We need a modified krb5.conf file to test wallet configuration settings in # krb5.conf. Despite the hard-coding of test-k5.stanford.edu, this test isn't @@ -73,43 +40,39 @@ EOF fi done if [ -z "$krb5conf" ] ; then - echo 'No krb5.conf found -- put one in tests/data/krb5.conf' >&2 - exit 1 + skip_all 'no krb5.conf found, put one in tests/data/krb5.conf' +fi + +# Test setup. +kerberos_setup +if [ $? != 0 ] ; then + skip_all 'Kerberos tests not configured' +elif [ -z '@REMCTLD@' ] ; then + skip_all 'No remctld found' +else + plan 34 fi +remctld_start '@REMCTLD@' "$SOURCE/data/basic.conf" +wallet="$BUILD/../client/wallet" # Make sure everything's clean. rm -f output output.bak keytab keytab.bak srvtab srvtab.bak autocreated # Now, we can finally run our tests. First, basic operations. -runsuccess "" "$wallet" -k "$principal" -p 14373 -s localhost -c fake-wallet \ - -f output get file fake-test -if cmp output data/fake-data >/dev/null 2>&1 ; then - printcount "ok" -else - printcount "not ok" -fi -if [ -f output.bak ] || [ -f output.new ] ; then - printcount "not ok" -else - printcount "ok" -fi -if [ -f autocreated ] ; then - printcount "ok" -else - printcount "not ok" -fi -runsuccess "" "$wallet" -k "$principal" -p 14373 -s localhost -c fake-wallet \ - -f output get file fake-test -if cmp output data/fake-data >/dev/null 2>&1 ; then - printcount "ok" -else - printcount "not ok" -fi -if [ -f output.new ] || [ ! -f output.bak ] ; then - printcount "not ok" -else - printcount "ok" -fi +ok_program 'get file' 0 '' \ + "$wallet" -k "$principal" -p 14373 -s localhost -c fake-wallet -f output \ + get file fake-test +ok '...and file is correct' cmp output data/fake-data +ok '...and no backup files' [ ! -f output.bak ] +ok '...and no new files' [ ! -f output.new ] +ok '...and we tried autocreation' [ -f autocreated ] +ok_program 'get file again' 0 '' \ + "$wallet" -k "$principal" -p 14373 -s localhost -c fake-wallet -f output \ + get file fake-test +ok '...and file is correct' cmp output data/fake-data +ok '...and now there is a backup file' [ -f output.bak ] +ok '...which has the right contents' cmp output.bak data/fake-data +ok '...but there is no new file' [ ! -f output.new ] # Now, append configuration to krb5.conf and test getting configuration from # there. @@ -123,116 +86,79 @@ cat >> krb5.conf </dev/null 2>&1 ; then - printcount "ok" -else - printcount "not ok" -fi +ok_program 'get file with configuration' 0 '' \ + "$wallet" -f output get file fake-test +ok '...and file is correct' cmp output data/fake-data rm -f output output.bak # Test keytab support. -runsuccess "" "$wallet" -f keytab get keytab service/fake-srvtab -if cmp keytab data/fake-keytab >/dev/null 2>&1 ; then - printcount "ok" - rm keytab -else - printcount "not ok" -fi +ok_program 'get keytab' 0 '' \ + "$wallet" -f keytab get keytab service/fake-srvtab +ok '...and keytab is correct' cmp keytab data/fake-keytab +rm -f keytab # Test srvtab support. -runsuccess "" "$wallet" -f keytab -S srvtab get keytab service/fake-srvtab -if cmp keytab data/fake-keytab >/dev/null 2>&1 ; then - printcount "ok" -else - printcount "not ok" -fi -rm keytab -runsuccess "" "$wallet" -f keytab -S srvtab get keytab service/fake-srvtab -if cmp keytab data/fake-keytab >/dev/null 2>&1 ; then - printcount "ok" -else - printcount "not ok" -fi -if cmp srvtab data/fake-srvtab >/dev/null 2>&1 ; then - printcount "ok" -else - printcount "not ok" -fi -if cmp srvtab.bak data/fake-srvtab >/dev/null 2>&1 ; then - printcount "ok" -else - printcount "not ok" -fi +ok_program 'get srvtab' 0 '' \ + "$wallet" -f keytab -S srvtab get keytab service/fake-srvtab +ok '...and keytab is correct' cmp keytab data/fake-keytab +rm -f keytab +ok_program 'get srvtab again' 0 '' \ + "$wallet" -f keytab -S srvtab get keytab service/fake-srvtab +ok '...and keytab is correct' cmp keytab data/fake-keytab +ok '...and srvtab is correct' cmp srvtab data/fake-srvtab +ok '...and srvtab backup is correct' cmp srvtab.bak data/fake-srvtab rm -f srvtab srvtab.bak # Test keytab merging. -runsuccess "" "$wallet" -f keytab get keytab service/fake-keytab +ok_program 'keytab merging' 0 '' \ + "$wallet" -f keytab get keytab service/fake-keytab (klist -keK keytab 2>&1) | sed '/Keytab name:/d' > klist-seen (klist -keK data/fake-keytab-merge 2>&1) | sed '/Keytab name:/d' > klist-good -if cmp klist-seen klist-good >/dev/null 2>&1 ; then - printcount "ok" - rm -f keytab klist-seen klist-good -else - printcount "not ok" -fi +ok '...and the merged keytab is correct' cmp klist-seen klist-good +rm -f keytab klist-seen klist-good # Test srvtab download into a merged keytab with an older version. cp data/fake-keytab-old keytab -runsuccess "" "$wallet" -f keytab -S srvtab get keytab service/fake-srvtab -if cmp srvtab data/fake-srvtab >/dev/null 2>&1 ; then - printcount "ok" -else - printcount "not ok" -fi +ok_program 'keytab merging with srvtab creation' 0 '' \ + "$wallet" -f keytab -S srvtab get keytab service/fake-srvtab +ok '...and the srvtab is correct' cmp srvtab data/fake-srvtab rm -f keytab srvtab # Test store from standard input. -echo "This is a test of store" | runsuccess "" "$wallet" store file fake-test -count=`expr $count + 1` +echo "This is a test of store" > input +ok_program 'store from stdin' 0 '' "$wallet" store file fake-test < input +rm -f input echo "file fake-test" > store-correct echo "This is a test of store" >> store-correct -if cmp store-output store-correct >/dev/null 2>&1 ; then - printcount "ok" -else - printcount "not ok" - echo == store-output == - cat store-output - echo == store-correct == - cat store-correct -fi +ok '...and the correct data was stored' diff store-output store-correct rm -f store-output store-correct # Test store with -f. echo "This is more store input" > store-input echo "file fake-test" > store-correct cat store-input >> store-correct -runsuccess "" "$wallet" -f store-input store file fake-test -if cmp store-output store-correct >/dev/null 2>&1 ; then - printcount "ok" -else - printcount "not ok" -fi +ok_program 'store from a file' 0 '' \ + "$wallet" -f store-input store file fake-test +ok '...and the correct data was stored' cmp store-output store-correct rm -f store-input store-output store-correct # Test various other client functions and errors. -runsuccess "This is a fake keytab." "$wallet" get keytab service/fake-output -runsuccess "Some stuff about file fake-test" \ +ok_program 'get output to stdout' 0 'This is a fake keytab.' \ + "$wallet" get keytab service/fake-output +ok_program 'show output' 0 'Some stuff about file fake-test' \ "$wallet" show file fake-test -runfailure 1 "wallet: Unknown object type srvtab" \ +ok_program 'unknown object type' 1 'wallet: Unknown object type srvtab' \ "$wallet" get srvtab service/fake-test -runfailure 1 "wallet: Unknown keytab service/unknown" \ +ok_program 'unknown keytab name in show' 1 \ + 'wallet: Unknown keytab service/unknown' \ "$wallet" show keytab service/unknown -runfailure 1 "wallet: Unknown keytab service/unknown" \ +ok_program 'unknown keytab name in get' 1 \ + 'wallet: Unknown keytab service/unknown' \ "$wallet" get keytab service/unknown -runsuccess "Expiration date of keytab service/fake-test" \ +ok_program 'expiration date' 0 'Expiration date of keytab service/fake-test' \ "$wallet" expires keytab service/fake-test # Clean up. -KRB5_CONFIG= -rm krb5.conf -rm -f autocreated data/test.cache -if [ -f data/pid ] ; then - kill `cat data/pid` - rm -f data/pid -fi +rm -f autocreated krb5.conf +remctld_stop +kerberos_cleanup diff --git a/tests/libtest.c b/tests/libtest.c deleted file mode 100644 index bddaf91..0000000 --- a/tests/libtest.c +++ /dev/null @@ -1,203 +0,0 @@ -/* - * Some utility routines for writing tests. - * - * Herein are a variety of utility routines for writing tests. All routines - * of the form ok*() take a test number and some number of appropriate - * arguments, check to be sure the results match the expected output using the - * arguments, and print out something appropriate for that test number. Other - * utility routines help in constructing more complex tests. - * - * Copyright 2006, 2007 Board of Trustees, Leland Stanford Jr. University - * Copyright (c) 2004, 2005, 2006 - * by Internet Systems Consortium, Inc. ("ISC") - * Copyright (c) 1991, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, - * 2002, 2003 by The Internet Software Consortium and Rich Salz - * - * This code is derived from software contributed to the Internet Software - * Consortium by Rich Salz. - * - * Permission to use, copy, modify, and distribute this software for any - * purpose with or without fee is hereby granted, provided that the above - * copyright notice and this permission notice appear in all copies. - * - * THE SOFTWARE IS PROVIDED "AS IS" AND ISC DISCLAIMS ALL WARRANTIES WITH - * REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY - * AND FITNESS. IN NO EVENT SHALL ISC BE LIABLE FOR ANY SPECIAL, DIRECT, - * INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM - * LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE - * OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR - * PERFORMANCE OF THIS SOFTWARE. - */ - -#include -#include - -#include -#include - -#include -#include - -/* A global buffer into which message_log_buffer stores error messages. */ -char *errors = NULL; - - -/* - * Initialize things. Turns on line buffering on stdout and then prints out - * the number of tests in the test suite. - */ -void -test_init(int count) -{ - if (setvbuf(stdout, NULL, _IOLBF, BUFSIZ) != 0) - syswarn("cannot set stdout to line buffered"); - printf("%d\n", count); -} - - -/* - * Takes a boolean success value and assumes the test passes if that value - * is true and fails if that value is false. - */ -void -ok(int n, int success) -{ - printf("%sok %d\n", success ? "" : "not ", n); -} - - -/* - * Takes an expected integer and a seen integer and assumes the test passes - * if those two numbers match. - */ -void -ok_int(int n, int wanted, int seen) -{ - if (wanted == seen) - printf("ok %d\n", n); - else - printf("not ok %d\n wanted: %d\n seen: %d\n", n, wanted, seen); -} - - -/* - * Takes a string and what the string should be, and assumes the test passes - * if those strings match (using strcmp). - */ -void -ok_string(int n, const char *wanted, const char *seen) -{ - if (wanted == NULL) - wanted = "(null)"; - if (seen == NULL) - seen = "(null)"; - if (strcmp(wanted, seen) != 0) - printf("not ok %d\n wanted: %s\n seen: %s\n", n, wanted, seen); - else - printf("ok %d\n", n); -} - - -/* - * Takes an expected integer and a seen integer and assumes the test passes if - * those two numbers match. - */ -void -ok_double(int n, double wanted, double seen) -{ - if (wanted == seen) - printf("ok %d\n", n); - else - printf("not ok %d\n wanted: %g\n seen: %g\n", n, wanted, seen); -} - - -/* - * Skip a test. - */ -void -skip(int n, const char *reason) -{ - printf("ok %d # skip", n); - if (reason != NULL) - printf(" - %s", reason); - putchar('\n'); -} - - -/* - * Report the same status on the next count tests. - */ -void -ok_block(int n, int count, int status) -{ - int i; - - for (i = 0; i < count; i++) - ok(n++, status); -} - - -/* - * Skip the next count tests. - */ -void -skip_block(int n, int count, const char *reason) -{ - int i; - - for (i = 0; i < count; i++) - skip(n++, reason); -} - - -/* - * An error handler that appends all errors to the errors global. Used by - * error_capture. - */ -static void -message_log_buffer(int len, const char *fmt, va_list args, int error UNUSED) -{ - char *message; - - message = xmalloc(len + 1); - vsnprintf(message, len + 1, fmt, args); - if (errors == NULL) { - errors = concat(message, "\n", (char *) 0); - } else { - char *new_errors; - - new_errors = concat(errors, message, "\n", (char *) 0); - free(errors); - errors = new_errors; - } - free(message); -} - - -/* - * Turn on the capturing of errors. Errors will be stored in the global - * errors variable where they can be checked by the test suite. Capturing is - * turned off with errors_uncapture. - */ -void -errors_capture(void) -{ - if (errors != NULL) { - free(errors); - errors = NULL; - } - message_handlers_warn(1, message_log_buffer); - message_handlers_notice(1, message_log_buffer); -} - - -/* - * Turn off the capturing of errors again. - */ -void -errors_uncapture(void) -{ - message_handlers_warn(1, message_log_stderr); - message_handlers_notice(1, message_log_stdout); -} diff --git a/tests/libtest.h b/tests/libtest.h deleted file mode 100644 index ad4f591..0000000 --- a/tests/libtest.h +++ /dev/null @@ -1,69 +0,0 @@ -/* - * Some utility routines for writing tests. - * - * Copyright 2006, 2007 Board of Trustees, Leland Stanford Jr. University - * Copyright (c) 2004, 2005, 2006 - * by Internet Systems Consortium, Inc. ("ISC") - * Copyright (c) 1991, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, - * 2002, 2003 by The Internet Software Consortium and Rich Salz - * - * This code is derived from software contributed to the Internet Software - * Consortium by Rich Salz. - * - * Permission to use, copy, modify, and distribute this software for any - * purpose with or without fee is hereby granted, provided that the above - * copyright notice and this permission notice appear in all copies. - * - * THE SOFTWARE IS PROVIDED "AS IS" AND ISC DISCLAIMS ALL WARRANTIES WITH - * REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY - * AND FITNESS. IN NO EVENT SHALL ISC BE LIABLE FOR ANY SPECIAL, DIRECT, - * INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM - * LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE - * OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR - * PERFORMANCE OF THIS SOFTWARE. - */ - -#ifndef LIBTEST_H -#define LIBTEST_H 1 - -#include -#include - -/* - * Used for iterating through arrays. ARRAY_SIZE returns the number of - * elements in the array (useful for a < upper bound in a for loop) and - * ARRAY_END returns a pointer to the element past the end (ISO C99 makes it - * legal to refer to such a pointer as long as it's never dereferenced). - */ -#define ARRAY_SIZE(array) (sizeof(array) / sizeof((array)[0])) -#define ARRAY_END(array) (&(array)[ARRAY_SIZE(array)]) - -/* A global buffer into which errors_capture stores errors. */ -extern char *errors; - -BEGIN_DECLS - -void ok(int n, int success); -void ok_int(int n, int wanted, int seen); -void ok_double(int n, double wanted, double seen); -void ok_string(int n, const char *wanted, const char *seen); -void skip(int n, const char *reason); - -/* Report the same status on, or skip, the next count tests. */ -void ok_block(int n, int count, int success); -void skip_block(int n, int count, const char *reason); - -/* Print out the number of tests and set standard output to line buffered. */ -void test_init(int count); - -/* - * Turn on capturing of errors with errors_capture. Errors reported by warn - * will be stored in the global errors variable. Turn this off again with - * errors_uncapture. Caller is responsible for freeing errors when done. - */ -void errors_capture(void); -void errors_uncapture(void); - -END_DECLS - -#endif /* LIBTEST_H */ diff --git a/tests/libtest.sh b/tests/libtest.sh deleted file mode 100644 index 74f5ee6..0000000 --- a/tests/libtest.sh +++ /dev/null @@ -1,80 +0,0 @@ -# Shell function library for test cases. -# -# Written by Russ Allbery -# Copyright 2006, 2007, 2008 Board of Trustees, Leland Stanford Jr. University -# -# See LICENSE for licensing terms. - -# The count starts at 1 and is updated each time ok is printed. printcount -# takes "ok" or "not ok". -count=1 -printcount () { - echo "$1 $count $2" - count=`expr $count + 1` -} - -# Run a program expected to succeed, and print ok if it does and produces -# the correct output. Takes the output as the first argument, the command to -# run as the second argument, and then all subsequent arguments are arguments -# to the command. -runsuccess () { - w_output="$1" - shift - output=`"$@" 2>&1` - status=$? - if [ $status = 0 ] && [ x"$output" = x"$w_output" ] ; then - printcount 'ok' - else - printcount 'not ok' - echo " saw: $output" - echo " not: $w_output" - fi -} - -# Run a program expected to fail and make sure it fails with the correct exit -# status and the correct failure message. Takes the expected status, the -# expected output, and then everything else is the command and arguments. -# Strip the second colon and everything after it off the error message since -# it's system-specific. -runfailure () { - w_status="$1" - shift - w_output="$1" - shift - output=`"$@" 2>&1` - status=$? - output=`echo "$output" | sed 's/\(:[^:]*\):.*/\1/'` - if [ $status = $w_status ] && [ x"$output" = x"$w_output" ] ; then - printcount 'ok' - else - printcount 'not ok' - echo " saw: ($status) $output" - echo " not: ($w_status) $w_output" - fi -} - -# Skip tests from $1 to $2 inclusive with reason $3. -skip () { - n="$1" - while [ "$n" -le "$2" ] ; do - echo ok "$n # skip $3" - n=`expr "$n" + 1` - done -} - -# Given a file name or relative file path, try to cd to the correct directory -# so that the relative file path is valid. Exits with an error if that isn't -# possible. -chdir_data () { - if [ -f "../$1" ] ; then - cd .. - else - if [ -f "tests/$1" ] ; then - cd tests - fi - fi - if [ ! -f "$1" ] ; then - echo "Cannot locate $1" >&2 - exit 1 - fi -} diff --git a/tests/portable/asprintf-t.c b/tests/portable/asprintf-t.c index 689e7c7..04fbd1b 100644 --- a/tests/portable/asprintf-t.c +++ b/tests/portable/asprintf-t.c @@ -2,7 +2,8 @@ * asprintf and vasprintf test suite. * * Written by Russ Allbery - * Copyright 2006, 2008 Board of Trustees, Leland Stanford Jr. University + * Copyright 2006, 2008, 2009 + * Board of Trustees, Leland Stanford Jr. University * * See LICENSE for licensing terms. */ @@ -10,9 +11,10 @@ #include #include -#include +#include -int test_asprintf(char **, const char *, ...); +int test_asprintf(char **, const char *, ...) + __attribute__((__format__(printf, 2, 3))); int test_vasprintf(char **, const char *, va_list); static int @@ -32,25 +34,25 @@ main(void) { char *result = NULL; - test_init(12); + plan(12); - ok_int(1, 7, test_asprintf(&result, "%s", "testing")); - ok_string(2, "testing", result); + is_int(7, test_asprintf(&result, "%s", "testing"), "asprintf length"); + is_string("testing", result, "asprintf result"); free(result); - ok(3, 1); - ok_int(4, 0, test_asprintf(&result, "%s", "")); - ok_string(5, "", result); + ok(3, "free asprintf"); + is_int(0, test_asprintf(&result, "%s", ""), "asprintf empty length"); + is_string("", result, "asprintf empty string"); free(result); - ok(6, 1); + ok(6, "free asprintf of empty string"); - ok_int(7, 6, vatest(&result, "%d %s", 2, "test")); - ok_string(8, "2 test", result); + is_int(6, vatest(&result, "%d %s", 2, "test"), "vasprintf length"); + is_string("2 test", result, "vasprintf result"); free(result); - ok(9, 1); - ok_int(10, 0, vatest(&result, "%s", "")); - ok_string(11, "", result); + ok(9, "free vasprintf"); + is_int(0, vatest(&result, "%s", ""), "vasprintf empty length"); + is_string("", result, "vasprintf empty string"); free(result); - ok(12, 1); + ok(12, "free vasprintf of empty string"); return 0; } diff --git a/tests/portable/mkstemp-t.c b/tests/portable/mkstemp-t.c new file mode 100644 index 0000000..54701f7 --- /dev/null +++ b/tests/portable/mkstemp-t.c @@ -0,0 +1,73 @@ +/* + * mkstemp test suite. + * + * Written by Russ Allbery + * Copyright 2002, 2004, 2008, 2009 + * Board of Trustees, Leland Stanford Jr. University + * + * See LICENSE for licensing terms. + */ + +#include +#include + +#include +#include + +#include + +int test_mkstemp(char *template); + +int +main(void) +{ + int fd; + char template[] = "tsXXXXXXX"; + char tooshort[] = "XXXXX"; + char bad1[] = "/foo/barXXXXX"; + char bad2[] = "/foo/barXXXXXX.out"; + char buffer[256]; + struct stat st1, st2; + ssize_t length; + + plan(20); + + /* First, test a few error messages. */ + errno = 0; + is_int(-1, test_mkstemp(tooshort), "too short of template"); + is_int(EINVAL, errno, "...with correct errno"); + is_string("XXXXX", tooshort, "...and template didn't change"); + errno = 0; + is_int(-1, test_mkstemp(bad1), "bad template"); + is_int(EINVAL, errno, "...with correct errno"); + is_string("/foo/barXXXXX", bad1, "...and template didn't change"); + errno = 0; + is_int(-1, test_mkstemp(bad2), "template doesn't end in XXXXXX"); + is_int(EINVAL, errno, "...with correct errno"); + is_string("/foo/barXXXXXX.out", bad2, "...and template didn't change"); + errno = 0; + + /* Now try creating a real file. */ + fd = test_mkstemp(template); + ok(fd >= 0, "mkstemp works with valid template"); + ok(strcmp(template, "tsXXXXXXX") != 0, "...and template changed"); + ok(strncmp(template, "tsX", 3) == 0, "...and didn't touch first X"); + ok(access(template, F_OK) == 0, "...and the file exists"); + + /* Make sure that it's the same file as template refers to now. */ + ok(stat(template, &st1) == 0, "...and stat of template works"); + ok(fstat(fd, &st2) == 0, "...and stat of open file descriptor works"); + ok(st1.st_ino == st2.st_ino, "...and they're the same file"); + unlink(template); + + /* Make sure the open mode is correct. */ + length = strlen(template); + is_int(length, write(fd, template, length), "write to open file works"); + ok(lseek(fd, 0, SEEK_SET) == 0, "...and rewind works"); + is_int(length, read(fd, buffer, length), "...and the data is there"); + buffer[length] = '\0'; + is_string(template, buffer, "...and matches what we wrote"); + close(fd); + + return 0; +} diff --git a/tests/portable/mkstemp.c b/tests/portable/mkstemp.c new file mode 100644 index 0000000..4632d3d --- /dev/null +++ b/tests/portable/mkstemp.c @@ -0,0 +1,2 @@ +#define TESTING 1 +#include diff --git a/tests/portable/setenv-t.c b/tests/portable/setenv-t.c new file mode 100644 index 0000000..5bc59ce --- /dev/null +++ b/tests/portable/setenv-t.c @@ -0,0 +1,46 @@ +/* + * setenv test suite. + * + * Written by Russ Allbery + * Copyright 2009 Board of Trustees, Leland Stanford Jr. University + * Copyright (c) 2004, 2005, 2006 + * by Internet Systems Consortium, Inc. ("ISC") + * Copyright (c) 1991, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, + * 2002, 2003 by The Internet Software Consortium and Rich Salz + * + * See LICENSE for licensing terms. + */ + +#include +#include + +#include + +#include + +int test_setenv(const char *name, const char *value, int overwrite); + +static const char test_var[] = "SETENV_TEST"; +static const char test_value1[] = "Do not taunt Happy Fun Ball."; +static const char test_value2[] = "Do not use Happy Fun Ball on concrete."; + + +int +main(void) +{ + plan(8); + + if (getenv(test_var)) + bail("%s already in the environment!", test_var); + + ok(test_setenv(test_var, test_value1, 0) == 0, "set string 1"); + is_string(test_value1, getenv(test_var), "...and getenv correct"); + ok(test_setenv(test_var, test_value2, 0) == 0, "set string 2"); + is_string(test_value1, getenv(test_var), "...and getenv unchanged"); + ok(test_setenv(test_var, test_value2, 1) == 0, "overwrite string 2"); + is_string(test_value2, getenv(test_var), "...and getenv changed"); + ok(test_setenv(test_var, "", 1) == 0, "overwrite with empty string"); + is_string("", getenv(test_var), "...and getenv correct"); + + return 0; +} diff --git a/tests/portable/setenv.c b/tests/portable/setenv.c new file mode 100644 index 0000000..79a7efd --- /dev/null +++ b/tests/portable/setenv.c @@ -0,0 +1,2 @@ +#define TESTING 1 +#include diff --git a/tests/portable/snprintf-t.c b/tests/portable/snprintf-t.c index 18c2326..ca6ae61 100644 --- a/tests/portable/snprintf-t.c +++ b/tests/portable/snprintf-t.c @@ -1,32 +1,25 @@ /* * snprintf test suite. * + * Written by Russ Allbery + * Copyright 2009 Board of Trustees, Leland Stanford Jr. University * Copyright (c) 2004, 2005, 2006 * by Internet Systems Consortium, Inc. ("ISC") * Copyright (c) 1991, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, * 2002, 2003 by The Internet Software Consortium and Rich Salz * - * This code is derived from software contributed to the Internet Software - * Consortium by Rich Salz. - * - * Permission to use, copy, modify, and distribute this software for any - * purpose with or without fee is hereby granted, provided that the above - * copyright notice and this permission notice appear in all copies. - * - * THE SOFTWARE IS PROVIDED "AS IS" AND ISC DISCLAIMS ALL WARRANTIES WITH - * REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY - * AND FITNESS. IN NO EVENT SHALL ISC BE LIABLE FOR ANY SPECIAL, DIRECT, - * INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM - * LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE - * OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR - * PERFORMANCE OF THIS SOFTWARE. + * See LICENSE for licensing terms. */ #include #include -#include +#include +/* + * Intentionally don't add the printf attribute here since we pass a + * zero-length printf format during testing and don't want warnings. + */ int test_snprintf(char *str, size_t count, const char *fmt, ...); int test_vsnprintf(char *str, size_t count, const char *fmt, va_list args); @@ -93,7 +86,7 @@ static unsigned long long ullong_nums[] = { static void -test_format(int n, int truncate, const char *expected, int count, +test_format(bool truncate, const char *expected, int count, const char *format, ...) { char buf[128]; @@ -103,16 +96,8 @@ test_format(int n, int truncate, const char *expected, int count, va_start(args, format); result = test_vsnprintf(buf, truncate ? 32 : sizeof(buf), format, args); va_end(args); - if (!strcmp(buf, expected) && result == count) { - printf("ok %d\n", n); - } else { - printf("not ok %d\n", n); - printf(" format: %s\n", format); - if (strcmp(buf, expected)) - printf(" saw: %s\n want: %s\n", buf, expected); - if (result != count) - printf(" %d != %d\n", result, count); - } + is_string(expected, buf, "format %s, wanted %s", format, expected); + is_int(count, result, "...and output length correct"); } @@ -124,75 +109,69 @@ main(void) long lcount; char lgbuf[128]; - test_init((26 + (ARRAY_SIZE(fp_formats) - 1) * ARRAY_SIZE(fp_nums) - + (ARRAY_SIZE(int_formats) - 1) * ARRAY_SIZE(int_nums) - + (ARRAY_SIZE(uint_formats) - 1) * ARRAY_SIZE(uint_nums) - + (ARRAY_SIZE(llong_formats) - 1) * ARRAY_SIZE(llong_nums) - + (ARRAY_SIZE(ullong_formats) - 1) * ARRAY_SIZE(ullong_nums))); - - ok(1, test_snprintf(NULL, 0, "%s", "abcd") == 4); - ok(2, test_snprintf(NULL, 0, "%d", 20) == 2); - ok(3, test_snprintf(NULL, 0, "Test %.2s", "abcd") == 7); - ok(4, test_snprintf(NULL, 0, "%c", 'a') == 1); - ok(5, test_snprintf(NULL, 0, "") == 0); - - test_format(6, 1, "abcd", 4, "%s", "abcd"); - test_format(7, 1, "20", 2, "%d", 20); - test_format(8, 1, "Test ab", 7, "Test %.2s", "abcd"); - test_format(9, 1, "a", 1, "%c", 'a'); - test_format(10, 1, "", 0, ""); - test_format(11, 1, "abcdefghijklmnopqrstuvwxyz01234", 36, "%s", - string); - test_format(12, 1, "abcdefghij", 10, "%.10s", string); - test_format(13, 1, " abcdefghij", 12, "%12.10s", string); - test_format(14, 1, " abcdefghijklmnopqrstuvwxyz0", 40, "%40s", - string); - test_format(15, 1, "abcdefghij ", 14, "%-14.10s", string); - test_format(16, 1, " abcdefghijklmnopq", 50, "%50s", - string); - test_format(17, 1, "%abcd%", 6, "%%%0s%%", "abcd"); - test_format(18, 1, "", 0, "%.0s", string); - test_format(19, 1, "abcdefghijklmnopqrstuvwxyz 444", 32, "%.26s %d", + plan(8 + + (18 + (ARRAY_SIZE(fp_formats) - 1) * ARRAY_SIZE(fp_nums) + + (ARRAY_SIZE(int_formats) - 1) * ARRAY_SIZE(int_nums) + + (ARRAY_SIZE(uint_formats) - 1) * ARRAY_SIZE(uint_nums) + + (ARRAY_SIZE(llong_formats) - 1) * ARRAY_SIZE(llong_nums) + + (ARRAY_SIZE(ullong_formats) - 1) * ARRAY_SIZE(ullong_nums)) * 2); + + is_int(4, test_snprintf(NULL, 0, "%s", "abcd"), "simple string length"); + is_int(2, test_snprintf(NULL, 0, "%d", 20), "number length"); + is_int(7, test_snprintf(NULL, 0, "Test %.2s", "abcd"), "limited string"); + is_int(1, test_snprintf(NULL, 0, "%c", 'a'), "character length"); + is_int(0, test_snprintf(NULL, 0, ""), "empty format length"); + + test_format(true, "abcd", 4, "%s", "abcd"); + test_format(true, "20", 2, "%d", 20); + test_format(true, "Test ab", 7, "Test %.2s", "abcd"); + test_format(true, "a", 1, "%c", 'a'); + test_format(true, "", 0, ""); + test_format(true, "abcdefghijklmnopqrstuvwxyz01234", 36, "%s", string); + test_format(true, "abcdefghij", 10, "%.10s", string); + test_format(true, " abcdefghij", 12, "%12.10s", string); + test_format(true, " abcdefghijklmnopqrstuvwxyz0", 40, "%40s", string); + test_format(true, "abcdefghij ", 14, "%-14.10s", string); + test_format(true, " abcdefghijklmnopq", 50, "%50s", string); + test_format(true, "%abcd%", 6, "%%%0s%%", "abcd"); + test_format(true, "", 0, "%.0s", string); + test_format(true, "abcdefghijklmnopqrstuvwxyz 444", 32, "%.26s %d", string, 4444); - test_format(20, 1, "abcdefghijklmnopqrstuvwxyz -2.", 32, - "%.26s %.1f", string, -2.5); - test_format(21, 1, "abcdefghij4444", 14, "%.10s%n%d", string, &count, - 4444); - ok(22, count == 10); - test_format(23, 1, "abcdefghijklmnopqrstuvwxyz01234", 36, "%n%s%ln", + test_format(true, "abcdefghijklmnopqrstuvwxyz -2.", 32, "%.26s %.1f", + string, -2.5); + test_format(true, "abcdefghij4444", 14, "%.10s%n%d", string, &count, 4444); + is_int(10, count, "correct output from %%n"); + test_format(true, "abcdefghijklmnopqrstuvwxyz01234", 36, "%n%s%ln", &count, string, &lcount); - ok(24, count == 0); - ok(25, lcount == 31); - test_format(26, 1, "(null)", 6, "%s", NULL); + is_int(0, count, "correct output from two %%n"); + is_int(31, lcount, "correct output from long %%ln"); + test_format(true, "(null)", 6, "%s", NULL); n = 26; for (i = 0; fp_formats[i] != NULL; i++) for (j = 0; j < ARRAY_SIZE(fp_nums); j++) { count = sprintf(lgbuf, fp_formats[i], fp_nums[j]); - test_format(++n, 0, lgbuf, count, fp_formats[i], fp_nums[j]); + test_format(false, lgbuf, count, fp_formats[i], fp_nums[j]); } for (i = 0; int_formats[i] != NULL; i++) for (j = 0; j < ARRAY_SIZE(int_nums); j++) { count = sprintf(lgbuf, int_formats[i], int_nums[j]); - test_format(++n, 0, lgbuf, count, int_formats[i], - int_nums[j]); + test_format(false, lgbuf, count, int_formats[i], int_nums[j]); } for (i = 0; uint_formats[i] != NULL; i++) for (j = 0; j < ARRAY_SIZE(uint_nums); j++) { count = sprintf(lgbuf, uint_formats[i], uint_nums[j]); - test_format(++n, 0, lgbuf, count, uint_formats[i], - uint_nums[j]); + test_format(false, lgbuf, count, uint_formats[i], uint_nums[j]); } for (i = 0; llong_formats[i] != NULL; i++) for (j = 0; j < ARRAY_SIZE(llong_nums); j++) { count = sprintf(lgbuf, llong_formats[i], llong_nums[j]); - test_format(++n, 0, lgbuf, count, llong_formats[i], - llong_nums[j]); + test_format(false, lgbuf, count, llong_formats[i], llong_nums[j]); } for (i = 0; ullong_formats[i] != NULL; i++) for (j = 0; j < ARRAY_SIZE(ullong_nums); j++) { count = sprintf(lgbuf, ullong_formats[i], ullong_nums[j]); - test_format(++n, 0, lgbuf, count, ullong_formats[i], + test_format(false, lgbuf, count, ullong_formats[i], ullong_nums[j]); } diff --git a/tests/portable/strlcat-t.c b/tests/portable/strlcat-t.c index 2f39925..e02c277 100644 --- a/tests/portable/strlcat-t.c +++ b/tests/portable/strlcat-t.c @@ -1,31 +1,20 @@ /* * strlcat test suite. * + * Written by Russ Allbery + * Copyright 2009 Board of Trustees, Leland Stanford Jr. University * Copyright (c) 2004, 2005, 2006 * by Internet Systems Consortium, Inc. ("ISC") * Copyright (c) 1991, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, * 2002, 2003 by The Internet Software Consortium and Rich Salz * - * This code is derived from software contributed to the Internet Software - * Consortium by Rich Salz. - * - * Permission to use, copy, modify, and distribute this software for any - * purpose with or without fee is hereby granted, provided that the above - * copyright notice and this permission notice appear in all copies. - * - * THE SOFTWARE IS PROVIDED "AS IS" AND ISC DISCLAIMS ALL WARRANTIES WITH - * REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY - * AND FITNESS. IN NO EVENT SHALL ISC BE LIABLE FOR ANY SPECIAL, DIRECT, - * INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM - * LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE - * OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR - * PERFORMANCE OF THIS SOFTWARE. + * See LICENSE for licensing terms. */ #include #include -#include +#include size_t test_strlcat(char *, const char *, size_t); @@ -35,42 +24,51 @@ main(void) { char buffer[10] = ""; - test_init(27); + plan(27); - ok_int(1, 3, test_strlcat(buffer, "foo", sizeof(buffer))); - ok_string(2, "foo", buffer); - ok_int(3, 7, test_strlcat(buffer, " bar", sizeof(buffer))); - ok_string(4, "foo bar", buffer); - ok_int(5, 9, test_strlcat(buffer, "!!", sizeof(buffer))); - ok_string(6, "foo bar!!", buffer); - ok_int(7, 10, test_strlcat(buffer, "!", sizeof(buffer))); - ok_string(8, "foo bar!!", buffer); - ok(9, buffer[9] == '\0'); + is_int(3, test_strlcat(buffer, "foo", sizeof(buffer)), + "strlcat into empty buffer"); + is_string("foo", buffer, "...with right output"); + is_int(7, test_strlcat(buffer, " bar", sizeof(buffer)), + "...and append more"); + is_string("foo bar", buffer, "...and output is still correct"); + is_int(9, test_strlcat(buffer, "!!", sizeof(buffer)), + "...and append to buffer limit"); + is_string("foo bar!!", buffer, "...output is still correct"); + is_int(10, test_strlcat(buffer, "!", sizeof(buffer)), + "...append one more character"); + is_string("foo bar!!", buffer, "...and output didn't change"); + ok(buffer[9] == '\0', "...buffer still nul-terminated"); buffer[0] = '\0'; - ok_int(10, 11, test_strlcat(buffer, "hello world", sizeof(buffer))); - ok_string(11, "hello wor", buffer); - ok(12, buffer[9] == '\0'); + is_int(11, test_strlcat(buffer, "hello world", sizeof(buffer)), + "append single long string"); + is_string("hello wor", buffer, "...string truncates properly"); + ok(buffer[9] == '\0', "...buffer still nul-terminated"); buffer[0] = '\0'; - ok_int(13, 7, test_strlcat(buffer, "sausage", 5)); - ok_string(14, "saus", buffer); - ok_int(15, 14, test_strlcat(buffer, "bacon eggs", sizeof(buffer))); - ok_string(16, "sausbacon", buffer); + is_int(7, test_strlcat(buffer, "sausage", 5), "lie about buffer length"); + is_string("saus", buffer, "...contents are correct"); + is_int(14, test_strlcat(buffer, "bacon eggs", sizeof(buffer)), + "...add more up to real size"); + is_string("sausbacon", buffer, "...and result is correct"); /* Make sure that with a size of 0, the destination isn't changed. */ - ok_int(17, 11, test_strlcat(buffer, "!!", 0)); - ok_string(18, "sausbacon", buffer); + is_int(11, test_strlcat(buffer, "!!", 0), "no change with size of 0"); + is_string("sausbacon", buffer, "...and content is the same"); /* Now play with empty strings. */ - ok_int(19, 9, test_strlcat(buffer, "", 0)); - ok_string(20, "sausbacon", buffer); + is_int(9, test_strlcat(buffer, "", 0), + "correct count when appending empty string"); + is_string("sausbacon", buffer, "...and contents are unchanged"); buffer[0] = '\0'; - ok_int(21, 0, test_strlcat(buffer, "", sizeof(buffer))); - ok_string(22, "", buffer); - ok_int(23, 3, test_strlcat(buffer, "foo", 2)); - ok_string(24, "f", buffer); - ok(25, buffer[1] == '\0'); - ok_int(26, 1, test_strlcat(buffer, "", sizeof(buffer))); - ok(27, buffer[1] == '\0'); + is_int(0, test_strlcat(buffer, "", sizeof(buffer)), + "correct count when appending empty string to empty buffer"); + is_string("", buffer, "...and buffer content is correct"); + is_int(3, test_strlcat(buffer, "foo", 2), "append to length 2 buffer"); + is_string("f", buffer, "...and got only a single character"); + ok(buffer[1] == '\0', "...and buffer is still nul-terminated"); + is_int(1, test_strlcat(buffer, "", sizeof(buffer)), + "append an empty string"); + ok(buffer[1] == '\0', "...and buffer is still nul-terminated"); return 0; } diff --git a/tests/portable/strlcpy-t.c b/tests/portable/strlcpy-t.c index 74c9ecd..ba224ba 100644 --- a/tests/portable/strlcpy-t.c +++ b/tests/portable/strlcpy-t.c @@ -1,31 +1,20 @@ /* * strlcpy test suite. * + * Written by Russ Allbery + * Copyright 2009 Board of Trustees, Leland Stanford Jr. University * Copyright (c) 2004, 2005, 2006 * by Internet Systems Consortium, Inc. ("ISC") * Copyright (c) 1991, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, * 2002, 2003 by The Internet Software Consortium and Rich Salz * - * This code is derived from software contributed to the Internet Software - * Consortium by Rich Salz. - * - * Permission to use, copy, modify, and distribute this software for any - * purpose with or without fee is hereby granted, provided that the above - * copyright notice and this permission notice appear in all copies. - * - * THE SOFTWARE IS PROVIDED "AS IS" AND ISC DISCLAIMS ALL WARRANTIES WITH - * REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY - * AND FITNESS. IN NO EVENT SHALL ISC BE LIABLE FOR ANY SPECIAL, DIRECT, - * INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM - * LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE - * OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR - * PERFORMANCE OF THIS SOFTWARE. + * See LICENSE for licensing terms. */ #include #include -#include +#include size_t test_strlcpy(char *, const char *, size_t); @@ -35,37 +24,43 @@ main(void) { char buffer[10]; - test_init(23); + plan(23); - ok_int(1, 3, test_strlcpy(buffer, "foo", sizeof(buffer))); - ok_string(2, "foo", buffer); - ok_int(3, 9, test_strlcpy(buffer, "hello wor", sizeof(buffer))); - ok_string(4, "hello wor", buffer); - ok_int(5, 10, test_strlcpy(buffer, "world hell", sizeof(buffer))); - ok_string(6, "world hel", buffer); - ok(7, buffer[9] == '\0'); - ok_int(8, 11, test_strlcpy(buffer, "hello world", sizeof(buffer))); - ok_string(9, "hello wor", buffer); - ok(10, buffer[9] == '\0'); + is_int(3, test_strlcpy(buffer, "foo", sizeof(buffer)), "simple strlcpy"); + is_string("foo", buffer, "...result is correct"); + is_int(9, test_strlcpy(buffer, "hello wor", sizeof(buffer)), + "strlcpy exact length of buffer"); + is_string("hello wor", buffer, "...result is correct"); + is_int(10, test_strlcpy(buffer, "world hell", sizeof(buffer)), + "strlcpy one more than buffer length"); + is_string("world hel", buffer, "...result is correct"); + ok(buffer[9] == '\0', "...buffer is nul-terminated"); + is_int(11, test_strlcpy(buffer, "hello world", sizeof(buffer)), + "strlcpy more than buffer length"); + is_string("hello wor", buffer, "...result is correct"); + ok(buffer[9] == '\0', "...buffer is nul-terminated"); /* Make sure that with a size of 0, the destination isn't changed. */ - ok_int(11, 3, test_strlcpy(buffer, "foo", 0)); - ok_string(12, "hello wor", buffer); + is_int(3, test_strlcpy(buffer, "foo", 0), "buffer unchanged if size 0"); + is_string("hello wor", buffer, "...contents still the same"); /* Now play with empty strings. */ - ok_int(13, 0, test_strlcpy(buffer, "", 0)); - ok_string(14, "hello wor", buffer); - ok_int(15, 0, test_strlcpy(buffer, "", sizeof(buffer))); - ok_string(16, "", buffer); - ok_int(17, 3, test_strlcpy(buffer, "foo", 2)); - ok_string(18, "f", buffer); - ok(19, buffer[1] == '\0'); - ok_int(20, 0, test_strlcpy(buffer, "", 1)); - ok(21, buffer[0] == '\0'); + is_int(0, test_strlcpy(buffer, "", 0), "copy empty string with size 0"); + is_string("hello wor", buffer, "...buffer unchanged"); + is_int(0, test_strlcpy(buffer, "", sizeof(buffer)), + "copy empty string into full buffer"); + is_string("", buffer, "...buffer now empty string"); + is_int(3, test_strlcpy(buffer, "foo", 2), + "copy string into buffer of size 2"); + is_string("f", buffer, "...got one character"); + ok(buffer[1] == '\0', "...buffer is nul-terminated"); + is_int(0, test_strlcpy(buffer, "", 1), + "copy empty string into buffer of size 1"); + ok(buffer[0] == '\0', "...buffer is empty string"); /* Finally, check using strlcpy as strlen. */ - ok_int(22, 3, test_strlcpy(NULL, "foo", 0)); - ok_int(23, 11, test_strlcpy(NULL, "hello world", 0)); + is_int(3, test_strlcpy(NULL, "foo", 0), "use strlcpy as strlen"); + is_int(11, test_strlcpy(NULL, "hello world", 0), "...again"); return 0; } diff --git a/tests/runtests.c b/tests/runtests.c index 060c8ad..1670012 100644 --- a/tests/runtests.c +++ b/tests/runtests.c @@ -17,12 +17,13 @@ * * where is the number of the test. ok indicates success, not ok * indicates failure, and "# skip" indicates the test was skipped for some - * reason (maybe because it doesn't apply to this platform). + * reason (maybe because it doesn't apply to this platform). This is a subset + * of TAP as documented in Test::Harness::TAP, which comes with Perl. * * Any bug reports, bug fixes, and improvements are very much welcome and * should be sent to the e-mail address below. * - * Copyright 2000, 2001, 2004, 2006, 2007, 2008 + * Copyright 2000, 2001, 2004, 2006, 2007, 2008, 2009 * Russ Allbery * * Permission is hereby granted, free of charge, to any person obtaining a @@ -44,16 +45,19 @@ * DEALINGS IN THE SOFTWARE. */ -#include -#include - #include #include #include +#include +#include +#include +#include #include #include +#include #include #include +#include /* sys/time.h must be included before sys/resource.h on some platforms. */ #include @@ -63,6 +67,19 @@ # define WCOREDUMP(status) ((unsigned)(status) & 0x80) #endif +/* + * The source and build versions of the tests directory. This is used to set + * the SOURCE and BUILD environment variables and find test programs, if set. + * Normally, this should be set as part of the build process to the test + * subdirectories of $(abs_top_srcdir) and $(abs_top_builddir) respectively. + */ +#ifndef SOURCE +# define SOURCE NULL +#endif +#ifndef BUILD +# define BUILD NULL +#endif + /* Test status codes. */ enum test_status { TEST_FAIL, @@ -78,7 +95,8 @@ enum test_status { /* Structure to hold data for a set of tests. */ struct testset { - const char *file; /* The file name of the test. */ + char *file; /* The file name of the test. */ + char *path; /* The path to the test program. */ int count; /* Expected count of tests. */ int current; /* The last seen test number. */ int length; /* The length of the last status message. */ @@ -89,6 +107,8 @@ struct testset { int aborted; /* Whether the set as aborted. */ int reported; /* Whether the results were reported. */ int status; /* The exit status of the test. */ + int all_skipped; /* Whether all tests were skipped. */ + char *reason; /* Why all tests were skipped. */ }; /* Structure to hold a linked list of test sets. */ @@ -103,8 +123,7 @@ struct testlist { */ static const char banner[] = "\n\ Running all tests listed in %s. If any tests fail, run the failing\n\ -test program by hand to see more details. The test program will have the\n\ -same name as the test set but with \"-t\" appended.\n\n"; +test program with runtests -o to see more details.\n\n"; /* Header for reports of failed tests. */ static const char header[] = "\n\ @@ -115,22 +134,6 @@ Failed Set Fail/Total (%) Skip Stat Failing Tests\n\ #define xmalloc(size) x_malloc((size), __FILE__, __LINE__) #define xstrdup(p) x_strdup((p), __FILE__, __LINE__) -/* Internal prototypes. */ -static void sysdie(const char *format, ...); -static void *x_malloc(size_t, const char *file, int line); -static char *x_strdup(const char *, const char *file, int line); -static int test_analyze(struct testset *); -static int test_batch(const char *testlist); -static void test_checkline(const char *line, struct testset *); -static void test_fail_summary(const struct testlist *); -static int test_init(const char *line, struct testset *); -static int test_print_range(int first, int last, int chars, int limit); -static void test_summarize(struct testset *, int status); -static pid_t test_start(const char *path, int *fd); -static double tv_diff(const struct timeval *, const struct timeval *); -static double tv_seconds(const struct timeval *); -static double tv_sum(const struct timeval *, const struct timeval *); - /* * Report a fatal error, including the results of strerror, and exit. @@ -218,6 +221,19 @@ tv_sum(const struct timeval *tv1, const struct timeval *tv2) } +/* + * Given a pointer to a string, skip any leading whitespace and return a + * pointer to the first non-whitespace character. + */ +static const char * +skip_whitespace(const char *p) +{ + while (isspace((unsigned char)(*p))) + p++; + return p; +} + + /* * Read the first line of test output, which should contain the range of * test numbers, and initialize the testset structure. Assume it was zeroed @@ -234,15 +250,34 @@ test_init(const char *line, struct testset *ts) * such as 1..10, accept that too for compatibility with Perl's * Test::Harness. */ - while (isspace((unsigned char)(*line))) - line++; + line = skip_whitespace(line); if (strncmp(line, "1..", 3) == 0) line += 3; - /* Get the count, check it for validity, and initialize the struct. */ - i = atoi(line); + /* + * Get the count, check it for validity, and initialize the struct. If we + * have something of the form "1..0 # skip foo", the whole file was + * skipped; record that. + */ + i = strtol(line, (char **) &line, 10); + if (i == 0) { + line = skip_whitespace(line); + if (*line == '#') { + line = skip_whitespace(line + 1); + if (strncasecmp(line, "skip", 4) == 0) { + line = skip_whitespace(line + 4); + if (*line != '\0') { + ts->reason = xstrdup(line); + ts->reason[strlen(ts->reason) - 1] = '\0'; + } + ts->all_skipped = 1; + ts->aborted = 1; + return 0; + } + } + } if (i <= 0) { - puts("invalid test count"); + puts("ABORTED (invalid test count)"); ts->aborted = 1; ts->reported = 1; return 0; @@ -329,8 +364,28 @@ static void test_checkline(const char *line, struct testset *ts) { enum test_status status = TEST_PASS; + const char *bail; + char *end; int current; + /* Before anything, check for a test abort. */ + bail = strstr(line, "Bail out!"); + if (bail != NULL) { + bail = skip_whitespace(bail + strlen("Bail out!")); + if (*bail != '\0') { + int length; + + length = strlen(bail); + if (bail[length - 1] == '\n') + length--; + test_backspace(ts); + printf("ABORTED (%.*s)\n", length, bail); + ts->reported = 1; + } + ts->aborted = 1; + return; + } + /* * If the given line isn't newline-terminated, it was too big for an * fgets(), which means ignore it. @@ -343,37 +398,40 @@ test_checkline(const char *line, struct testset *ts) status = TEST_FAIL; line += 4; } - if (strncmp(line, "ok ", 3) != 0) + if (strncmp(line, "ok", 2) != 0) return; - line += 3; - current = atoi(line); - if (current == 0) - return; - if (current < 0 || current > ts->count) { + line = skip_whitespace(line + 2); + errno = 0; + current = strtol(line, &end, 10); + if (errno != 0 || end == line) + current = ts->current + 1; + if (current <= 0 || current > ts->count) { test_backspace(ts); - printf("invalid test number %d\n", current); + printf("ABORTED (invalid test number %d)\n", current); ts->aborted = 1; ts->reported = 1; return; } - while (isspace((unsigned char)(*line))) - line++; + + /* + * Handle directives. We should probably do something more interesting + * with unexpected passes of todo tests. + */ while (isdigit((unsigned char)(*line))) line++; - while (isspace((unsigned char)(*line))) - line++; + line = skip_whitespace(line); if (*line == '#') { - line++; - while (isspace((unsigned char)(*line))) - line++; - if (strncmp(line, "skip", 4) == 0) + line = skip_whitespace(line + 1); + if (strncasecmp(line, "skip", 4) == 0) status = TEST_SKIP; + if (strncasecmp(line, "todo", 4) == 0) + status = (status == TEST_FAIL) ? TEST_SKIP : TEST_FAIL; } /* Make sure that the test number is in range and not a duplicate. */ if (ts->results[current - 1] != TEST_INVALID) { test_backspace(ts); - printf("duplicate test number %d\n", current); + printf("ABORTED (duplicate test number %d)\n", current); ts->aborted = 1; ts->reported = 1; return; @@ -449,9 +507,9 @@ test_summarize(struct testset *ts, int status) int last = 0; if (ts->aborted) { - fputs("aborted", stdout); + fputs("ABORTED", stdout); if (ts->count > 0) - printf(", passed %d/%d", ts->passed, ts->count - ts->skipped); + printf(" (passed %d/%d)", ts->passed, ts->count - ts->skipped); } else { for (i = 0; i < ts->count; i++) { if (ts->results[i] == TEST_INVALID) { @@ -520,19 +578,25 @@ test_analyze(struct testset *ts) { if (ts->reported) return 0; - if (WIFEXITED(ts->status) && WEXITSTATUS(ts->status) != 0) { + if (ts->all_skipped) { + if (ts->reason == NULL) + puts("skipped"); + else + printf("skipped (%s)\n", ts->reason); + return 1; + } else if (WIFEXITED(ts->status) && WEXITSTATUS(ts->status) != 0) { switch (WEXITSTATUS(ts->status)) { case CHILDERR_DUP: if (!ts->reported) - puts("can't dup file descriptors"); + puts("ABORTED (can't dup file descriptors)"); break; case CHILDERR_EXEC: if (!ts->reported) - puts("execution failed (not found?)"); + puts("ABORTED (execution failed -- not found?)"); break; case CHILDERR_STDERR: if (!ts->reported) - puts("can't open /dev/null"); + puts("ABORTED (can't open /dev/null)"); break; default: test_summarize(ts, WEXITSTATUS(ts->status)); @@ -561,17 +625,12 @@ test_run(struct testset *ts) int outfd, i, status; FILE *output; char buffer[BUFSIZ]; - char *file; /* * Initialize the test and our data structures, flagging this set in error * if the initialization fails. */ - file = xmalloc(strlen(ts->file) + 3); - strcpy(file, ts->file); - strcat(file, "-t"); - testpid = test_start(file, &outfd); - free(file); + testpid = test_start(ts->path, &outfd); output = fdopen(outfd, "r"); if (!output) { puts("ABORTED"); @@ -580,11 +639,8 @@ test_run(struct testset *ts) } if (!fgets(buffer, sizeof(buffer), output)) ts->aborted = 1; - if (!ts->aborted && !test_init(buffer, ts)) { - while (fgets(buffer, sizeof(buffer), output)) - ; + if (!ts->aborted && !test_init(buffer, ts)) ts->aborted = 1; - } /* Pass each line of output to test_checkline(). */ while (!ts->aborted && fgets(buffer, sizeof(buffer), output)) @@ -594,16 +650,23 @@ test_run(struct testset *ts) test_backspace(ts); /* - * Close the output descriptor, retrieve the exit status, and pass that - * information to test_analyze() for eventual output. + * Consume the rest of the test output, close the output descriptor, + * retrieve the exit status, and pass that information to test_analyze() + * for eventual output. */ + while (fgets(buffer, sizeof(buffer), output)) + ; fclose(output); child = waitpid(testpid, &ts->status, 0); if (child == (pid_t) -1) { - puts("ABORTED"); - fflush(stdout); + if (!ts->reported) { + puts("ABORTED"); + fflush(stdout); + } sysdie("waitpid for %u failed", (unsigned int) testpid); } + if (ts->all_skipped) + ts->aborted = 0; status = test_analyze(ts); /* Convert missing tests to failed tests. */ @@ -665,13 +728,54 @@ test_fail_summary(const struct testlist *fails) } +/* + * Given the name of a test, a pointer to the testset struct, and the source + * and build directories, find the test. We try first relative to the current + * directory, then in the build directory (if not NULL), then in the source + * directory. In each of those directories, we first try a "-t" extension and + * then a ".t" extension. When we find an executable program, we fill in the + * path member of the testset struct. If none of those paths are executable, + * just fill in the name of the test with "-t" appended. + * + * The caller is responsible for freeing the path member of the testset + * struct. + */ +static void +find_test(const char *name, struct testset *ts, const char *source, + const char *build) +{ + char *path; + const char *bases[] = { ".", build, source, NULL }; + int i; + + for (i = 0; bases[i] != NULL; i++) { + path = xmalloc(strlen(bases[i]) + strlen(name) + 4); + sprintf(path, "%s/%s-t", bases[i], name); + if (access(path, X_OK) != 0) + path[strlen(path) - 2] = '.'; + if (access(path, X_OK) == 0) + break; + free(path); + path = NULL; + } + if (path == NULL) { + path = xmalloc(strlen(name) + 3); + sprintf(path, "%s-t", name); + } + ts->path = path; +} + + /* * Run a batch of tests from a given file listing each test on a line by - * itself. The file must be rewindable. Returns true iff all tests + * itself. Takes two additional parameters: the root of the source directory + * and the root of the build directory. Test programs will be first searched + * for in the current directory, then the build directory, then the source + * directory. The file must be rewindable. Returns true iff all tests * passed. */ static int -test_batch(const char *testlist) +test_batch(const char *testlist, const char *source, const char *build) { FILE *tests; size_t length, i; @@ -741,7 +845,14 @@ test_batch(const char *testlist) fflush(stdout); memset(&ts, 0, sizeof(ts)); ts.file = xstrdup(buffer); - if (!test_run(&ts)) { + find_test(buffer, &ts, source, build); + ts.reason = NULL; + if (test_run(&ts)) { + free(ts.file); + free(ts.path); + if (ts.reason != NULL) + free(ts.reason); + } else { tmp = xmalloc(sizeof(struct testset)); memcpy(tmp, &ts, sizeof(struct testset)); if (!failhead) { @@ -757,9 +868,9 @@ test_batch(const char *testlist) } } aborted += ts.aborted; - total += ts.count; + total += ts.count + ts.all_skipped; passed += ts.passed; - skipped += ts.skipped; + skipped += ts.skipped + ts.all_skipped; failed += ts.failed; } total -= skipped; @@ -769,7 +880,8 @@ test_batch(const char *testlist) getrusage(RUSAGE_CHILDREN, &stats); /* Print out our final results. */ - if (failhead) test_fail_summary(failhead); + if (failhead) + test_fail_summary(failhead); putchar('\n'); if (aborted != 0) { if (aborted == 1) @@ -800,15 +912,80 @@ test_batch(const char *testlist) /* - * Main routine. Given a file listing tests, run each test listed. + * Run a single test case. This involves just running the test program after + * having done the environment setup and finding the test program. + */ +static void +test_single(const char *program, const char *source, const char *build) +{ + struct testset ts; + + memset(&ts, 0, sizeof(ts)); + find_test(program, &ts, source, build); + if (execl(ts.path, ts.path, (char *) 0) == -1) + sysdie("cannot exec %s", ts.path); +} + + +/* + * Main routine. Set the SOURCE and BUILD environment variables and then, + * given a file listing tests, run each test listed. */ int main(int argc, char *argv[]) { - if (argc != 2) { + int option; + int single = 0; + char *setting; + const char *list; + const char *source = SOURCE; + const char *build = BUILD; + + while ((option = getopt(argc, argv, "b:os:")) != EOF) { + switch (option) { + case 'b': + build = optarg; + break; + case 'o': + single = 1; + break; + case 's': + source = optarg; + break; + default: + exit(1); + } + } + argc -= optind; + argv += optind; + if (argc != 1) { fprintf(stderr, "Usage: runtests \n"); exit(1); } - printf(banner, argv[1]); - exit(test_batch(argv[1]) ? 0 : 1); + + if (source != NULL) { + setting = xmalloc(strlen("SOURCE=") + strlen(source) + 1); + sprintf(setting, "SOURCE=%s", source); + if (putenv(setting) != 0) + sysdie("cannot set SOURCE in the environment"); + } + if (build != NULL) { + setting = xmalloc(strlen("BUILD=") + strlen(build) + 1); + sprintf(setting, "BUILD=%s", build); + if (putenv(setting) != 0) + sysdie("cannot set BUILD in the environment"); + } + + if (single) { + test_single(argv[0], source, build); + exit(0); + } else { + list = strrchr(argv[0], '/'); + if (list == NULL) + list = argv[0]; + else + list++; + printf(banner, list); + exit(test_batch(argv[0], source, build) ? 0 : 1); + } } diff --git a/tests/tap/basic.c b/tests/tap/basic.c new file mode 100644 index 0000000..5ca9ff4 --- /dev/null +++ b/tests/tap/basic.c @@ -0,0 +1,356 @@ +/* + * Some utility routines for writing tests. + * + * Herein are a variety of utility routines for writing tests. All routines + * of the form ok*() take a test number and some number of appropriate + * arguments, check to be sure the results match the expected output using the + * arguments, and print out something appropriate for that test number. Other + * utility routines help in constructing more complex tests. + * + * Copyright 2009 Russ Allbery + * Copyright 2006, 2007, 2008 + * Board of Trustees, Leland Stanford Jr. University + * Copyright (c) 2004, 2005, 2006 + * by Internet Systems Consortium, Inc. ("ISC") + * Copyright (c) 1991, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, + * 2002, 2003 by The Internet Software Consortium and Rich Salz + * + * See LICENSE for licensing terms. + */ + +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#include + +/* + * The test count. Always contains the number that will be used for the next + * test status. + */ +int testnum = 1; + +/* + * Status information stored so that we can give a test summary at the end of + * the test case. We store the planned final test and the count of failures. + * We can get the highest test count from testnum. + * + * We also store the PID of the process that called plan() and only summarize + * results when that process exits, so as to not misreport results in forked + * processes. + */ +static int _planned = 0; +static int _failed = 0; +static pid_t _process = 0; + + +/* + * Our exit handler. Called on completion of the test to report a summary of + * results provided we're still in the original process. + */ +static void +finish(void) +{ + int highest = testnum - 1; + + if (_process != 0 && getpid() == _process && _planned > 0) { + if (_planned > highest) + printf("# Looks like you planned %d test%s but only ran %d\n", + _planned, (_planned > 1 ? "s" : ""), highest); + else if (_planned < highest) + printf("# Looks like you planned %d test%s but ran %d extra\n", + _planned, (_planned > 1 ? "s" : ""), highest - _planned); + else if (_failed > 0) + printf("# Looks like you failed %d test%s of %d\n", _failed, + (_failed > 1 ? "s" : ""), _planned); + else if (_planned > 1) + printf("# All %d tests successful or skipped\n", _planned); + else + printf("# %d test successful or skipped\n", _planned); + } +} + + +/* + * Initialize things. Turns on line buffering on stdout and then prints out + * the number of tests in the test suite. + */ +void +plan(int count) +{ + if (setvbuf(stdout, NULL, _IOLBF, BUFSIZ) != 0) + fprintf(stderr, "# cannot set stdout to line buffered: %s\n", + strerror(errno)); + printf("1..%d\n", count); + testnum = 1; + _planned = count; + _process = getpid(); + atexit(finish); +} + + +/* + * Skip the entire test suite and exits. Should be called instead of plan(), + * not after it, since it prints out a special plan line. + */ +void +skip_all(const char *format, ...) +{ + printf("1..0 # skip"); + if (format != NULL) { + va_list args; + + putchar(' '); + va_start(args, format); + vprintf(format, args); + va_end(args); + } + putchar('\n'); + exit(0); +} + + +/* + * Print the test description. + */ +static void +print_desc(const char *format, va_list args) +{ + printf(" - "); + vprintf(format, args); +} + + +/* + * Takes a boolean success value and assumes the test passes if that value + * is true and fails if that value is false. + */ +void +ok(int success, const char *format, ...) +{ + printf("%sok %d", success ? "" : "not ", testnum++); + if (!success) + _failed++; + if (format != NULL) { + va_list args; + + va_start(args, format); + print_desc(format, args); + va_end(args); + } + putchar('\n'); +} + + +/* + * Skip a test. + */ +void +skip(const char *reason, ...) +{ + printf("ok %d # skip", testnum++); + if (reason != NULL) { + va_list args; + + va_start(args, reason); + putchar(' '); + vprintf(reason, args); + va_end(args); + } + putchar('\n'); +} + + +/* + * Report the same status on the next count tests. + */ +void +ok_block(int count, int status, const char *format, ...) +{ + int i; + + for (i = 0; i < count; i++) { + printf("%sok %d", status ? "" : "not ", testnum++); + if (!status) + _failed++; + if (format != NULL) { + va_list args; + + va_start(args, format); + print_desc(format, args); + va_end(args); + } + putchar('\n'); + } +} + + +/* + * Skip the next count tests. + */ +void +skip_block(int count, const char *reason, ...) +{ + int i; + + for (i = 0; i < count; i++) { + printf("ok %d # skip", testnum++); + if (reason != NULL) { + va_list args; + + va_start(args, reason); + putchar(' '); + vprintf(reason, args); + va_end(args); + } + putchar('\n'); + } +} + + +/* + * Takes an expected integer and a seen integer and assumes the test passes + * if those two numbers match. + */ +void +is_int(int wanted, int seen, const char *format, ...) +{ + if (wanted == seen) + printf("ok %d", testnum++); + else { + printf("# wanted: %d\n# seen: %d\n", wanted, seen); + printf("not ok %d", testnum++); + _failed++; + } + if (format != NULL) { + va_list args; + + va_start(args, format); + print_desc(format, args); + va_end(args); + } + putchar('\n'); +} + + +/* + * Takes a string and what the string should be, and assumes the test passes + * if those strings match (using strcmp). + */ +void +is_string(const char *wanted, const char *seen, const char *format, ...) +{ + if (wanted == NULL) + wanted = "(null)"; + if (seen == NULL) + seen = "(null)"; + if (strcmp(wanted, seen) == 0) + printf("ok %d", testnum++); + else { + printf("# wanted: %s\n# seen: %s\n", wanted, seen); + printf("not ok %d", testnum++); + _failed++; + } + if (format != NULL) { + va_list args; + + va_start(args, format); + print_desc(format, args); + va_end(args); + } + putchar('\n'); +} + + +/* + * Takes an expected double and a seen double and assumes the test passes if + * those two numbers match. + */ +void +is_double(double wanted, double seen, const char *format, ...) +{ + if (wanted == seen) + printf("ok %d", testnum++); + else { + printf("# wanted: %g\n# seen: %g\n", wanted, seen); + printf("not ok %d", testnum++); + _failed++; + } + if (format != NULL) { + va_list args; + + va_start(args, format); + print_desc(format, args); + va_end(args); + } + putchar('\n'); +} + + +/* + * Takes an expected unsigned long and a seen unsigned long and assumes the + * test passes if the two numbers match. Otherwise, reports them in hex. + */ +void +is_hex(unsigned long wanted, unsigned long seen, const char *format, ...) +{ + if (wanted == seen) + printf("ok %d", testnum++); + else { + printf("# wanted: %lx\n# seen: %lx\n", (unsigned long) wanted, + (unsigned long) seen); + printf("not ok %d", testnum++); + _failed++; + } + if (format != NULL) { + va_list args; + + va_start(args, format); + print_desc(format, args); + va_end(args); + } + putchar('\n'); +} + + +/* + * Bail out with an error. + */ +void +bail(const char *format, ...) +{ + va_list args; + + fflush(stdout); + printf("Bail out! "); + va_start(args, format); + vprintf(format, args); + va_end(args); + printf("\n"); + exit(1); +} + + +/* + * Bail out with an error, appending strerror(errno). + */ +void +sysbail(const char *format, ...) +{ + va_list args; + int oerrno = errno; + + fflush(stdout); + printf("Bail out! "); + va_start(args, format); + vprintf(format, args); + va_end(args); + printf(": %s\n", strerror(oerrno)); + exit(1); +} diff --git a/tests/tap/basic.h b/tests/tap/basic.h new file mode 100644 index 0000000..efe94ba --- /dev/null +++ b/tests/tap/basic.h @@ -0,0 +1,98 @@ +/* + * Basic utility routines for the TAP protocol. + * + * Copyright 2006, 2007, 2008 + * Board of Trustees, Leland Stanford Jr. University + * Copyright (c) 2004, 2005, 2006 + * by Internet Systems Consortium, Inc. ("ISC") + * Copyright (c) 1991, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, + * 2002, 2003 by The Internet Software Consortium and Rich Salz + * + * See LICENSE for licensing terms. + */ + +#ifndef TAP_BASIC_H +#define TAP_BASIC_H 1 + +#include /* pid_t */ + +/* + * __attribute__ is available in gcc 2.5 and later, but only with gcc 2.7 + * could you use the __format__ form of the attributes, which is what we use + * (to avoid confusion with other macros). + */ +#ifndef __attribute__ +# if __GNUC__ < 2 || (__GNUC__ == 2 && __GNUC_MINOR__ < 7) +# define __attribute__(spec) /* empty */ +# endif +#endif + +/* + * BEGIN_DECLS is used at the beginning of declarations so that C++ + * compilers don't mangle their names. END_DECLS is used at the end. + */ +#undef BEGIN_DECLS +#undef END_DECLS +#ifdef __cplusplus +# define BEGIN_DECLS extern "C" { +# define END_DECLS } +#else +# define BEGIN_DECLS /* empty */ +# define END_DECLS /* empty */ +#endif + +/* + * Used for iterating through arrays. ARRAY_SIZE returns the number of + * elements in the array (useful for a < upper bound in a for loop) and + * ARRAY_END returns a pointer to the element past the end (ISO C99 makes it + * legal to refer to such a pointer as long as it's never dereferenced). + */ +#define ARRAY_SIZE(array) (sizeof(array) / sizeof((array)[0])) +#define ARRAY_END(array) (&(array)[ARRAY_SIZE(array)]) + +BEGIN_DECLS + +/* + * The test count. Always contains the number that will be used for the next + * test status. + */ +extern int testnum; + +/* Print out the number of tests and set standard output to line buffered. */ +void plan(int count); + +/* Skip the entire test suite. Call instead of plan. */ +void skip_all(const char *format, ...) + __attribute__((__noreturn__, __format__(printf, 1, 2))); + +/* Basic reporting functions. */ +void ok(int success, const char *format, ...) + __attribute__((__format__(printf, 2, 3))); +void skip(const char *reason, ...) + __attribute__((__format__(printf, 1, 2))); + +/* Report the same status on, or skip, the next count tests. */ +void ok_block(int count, int success, const char *format, ...) + __attribute__((__format__(printf, 3, 4))); +void skip_block(int count, const char *reason, ...) + __attribute__((__format__(printf, 2, 3))); + +/* Check an expected value against a seen value. */ +void is_int(int wanted, int seen, const char *format, ...) + __attribute__((__format__(printf, 3, 4))); +void is_double(double wanted, double seen, const char *format, ...) + __attribute__((__format__(printf, 3, 4))); +void is_string(const char *wanted, const char *seen, const char *format, ...) + __attribute__((__format__(printf, 3, 4))); +void is_hex(unsigned long wanted, unsigned long seen, const char *format, ...) + __attribute__((__format__(printf, 3, 4))); + +/* Bail out with an error. sysbail appends strerror(errno). */ +void bail(const char *format, ...) + __attribute__((__noreturn__, __nonnull__, __format__(printf, 1, 2))); +void sysbail(const char *format, ...) + __attribute__((__noreturn__, __nonnull__, __format__(printf, 1, 2))); + +END_DECLS + +#endif /* LIBTEST_H */ diff --git a/tests/tap/kerberos.c b/tests/tap/kerberos.c new file mode 100644 index 0000000..700212e --- /dev/null +++ b/tests/tap/kerberos.c @@ -0,0 +1,164 @@ +/* + * Utility functions for tests that use Kerberos. + * + * Currently only provides kerberos_setup(), which assumes a particular set of + * data files in either the SOURCE or BUILD directories and, using those, + * obtains Kerberos credentials, sets up a ticket cache, and sets the + * environment variable pointing to the Kerberos keytab to use for testing. + * + * Copyright 2006, 2007, 2009, 2010 + * Board of Trustees, Leland Stanford Jr. University + * + * See LICENSE for licensing terms. + */ + +#include +#include +#include + +#include +#include +#include +#include + + +/* + * Given the partial path to a file, look under BUILD and then SOURCE for the + * file and return the full path to the file in newly-allocated memory. + * Returns NULL if the file doesn't exist. + */ +static char * +find_file(const char *file) +{ + char *base; + char *path = NULL; + const char *envs[] = { "BUILD", "SOURCE", NULL }; + int i; + + for (i = 0; envs[i] != NULL; i++) { + base = getenv(envs[i]); + if (base == NULL) + continue; + path = concatpath(base, file); + if (access(path, R_OK) == 0) + break; + free(path); + path = NULL; + } + return path; +} + + +/* + * Obtain Kerberos tickets for the principal specified in test.principal using + * the keytab specified in test.keytab, both of which are presumed to be in + * tests/data in either the build or the source tree. + * + * Returns the contents of test.principal in newly allocated memory or NULL if + * Kerberos tests are apparently not configured. If Kerberos tests are + * configured but something else fails, calls bail(). + * + * The error handling here is not great. We should have a bail_krb5 that uses + * the same logic as messages-krb5.c, which hasn't yet been imported into + * rra-c-util. + */ +char * +kerberos_setup(void) +{ + char *path, *krbtgt; + const char *build, *realm; + FILE *file; + char principal[BUFSIZ]; + krb5_error_code code; + krb5_context ctx; + krb5_ccache ccache; + krb5_principal kprinc; + krb5_keytab keytab; + krb5_get_init_creds_opt *opts; + krb5_creds creds; + + /* Read the principal name and find the keytab file. */ + path = find_file("data/test.principal"); + if (path == NULL) + return NULL; + file = fopen(path, "r"); + if (file == NULL) { + free(path); + return NULL; + } + if (fgets(principal, sizeof(principal), file) == NULL) { + fclose(file); + bail("cannot read %s", path); + } + fclose(file); + if (principal[strlen(principal) - 1] != '\n') + bail("no newline in %s", path); + free(path); + principal[strlen(principal) - 1] = '\0'; + path = find_file("data/test.keytab"); + if (path == NULL) + return NULL; + + /* Set the KRB5CCNAME and KRB5_KTNAME environment variables. */ + build = getenv("BUILD"); + if (build == NULL) + build = "."; + putenv(concat("KRB5CCNAME=", build, "/data/test.cache", (char *) 0)); + putenv(concat("KRB5_KTNAME=", path, (char *) 0)); + + /* Now do the Kerberos initialization. */ + code = krb5_init_context(&ctx); + if (code != 0) + bail("error initializing Kerberos"); + code = krb5_cc_default(ctx, &ccache); + if (code != 0) + bail("error setting ticket cache"); + code = krb5_parse_name(ctx, principal, &kprinc); + if (code != 0) + bail("error parsing principal %s", principal); + realm = krb5_principal_get_realm(ctx, kprinc); + krbtgt = concat("krbtgt/", realm, "@", realm, (char *) 0); + code = krb5_kt_resolve(ctx, path, &keytab); + if (code != 0) + bail("cannot open keytab %s", path); + code = krb5_get_init_creds_opt_alloc(ctx, &opts); + if (code != 0) + bail("cannot allocate credential options"); + krb5_get_init_creds_opt_set_default_flags(ctx, NULL, realm, opts); + krb5_get_init_creds_opt_set_forwardable(opts, 0); + krb5_get_init_creds_opt_set_proxiable(opts, 0); + code = krb5_get_init_creds_keytab(ctx, &creds, kprinc, keytab, 0, krbtgt, + opts); + if (code != 0) + bail("cannot get Kerberos tickets"); + code = krb5_cc_initialize(ctx, ccache, kprinc); + if (code != 0) + bail("error initializing ticket cache"); + code = krb5_cc_store_cred(ctx, ccache, &creds); + if (code != 0) + bail("error storing credentials"); + krb5_cc_close(ctx, ccache); + krb5_free_cred_contents(ctx, &creds); + krb5_kt_close(ctx, keytab); + krb5_free_principal(ctx, kprinc); + krb5_free_context(ctx); + free(krbtgt); + free(path); + + return xstrdup(principal); +} + + +/* + * Clean up at the end of a test. Currently, all this does is remove the + * ticket cache. + */ +void +kerberos_cleanup(void) +{ + char *path; + + path = concatpath(getenv("BUILD"), "data/test.cache"); + unlink(path); + free(path); +} diff --git a/tests/tap/kerberos.h b/tests/tap/kerberos.h new file mode 100644 index 0000000..1c64f70 --- /dev/null +++ b/tests/tap/kerberos.h @@ -0,0 +1,32 @@ +/* + * Utility functions for tests that use Kerberos. + * + * Copyright 2006, 2007, 2009 + * Board of Trustees, Leland Stanford Jr. University + * + * See LICENSE for licensing terms. + */ + +#ifndef TAP_KERBEROS_H +#define TAP_KERBEROS_H 1 + +#include +#include + +BEGIN_DECLS + +/* + * Set up Kerberos, returning the test principal in newly allocated memory if + * we were successful. If there is no principal in tests/data/test.principal + * or no keytab in tests/data/test.keytab, return NULL. Otherwise, on + * failure, calls bail(). + */ +char *kerberos_setup(void) + __attribute__((__malloc__)); + +/* Clean up at the end of a test. */ +void kerberos_cleanup(void); + +END_DECLS + +#endif /* !TAP_MESSAGES_H */ diff --git a/tests/tap/kerberos.sh b/tests/tap/kerberos.sh new file mode 100644 index 0000000..da07e66 --- /dev/null +++ b/tests/tap/kerberos.sh @@ -0,0 +1,48 @@ +# Shell function library to initialize Kerberos credentials +# +# Written by Russ Allbery +# Copyright 2009 Board of Trustees, Leland Stanford Jr. University +# +# See LICENSE for licensing terms. + +# Set up Kerberos, including the ticket cache environment variable. Bail out +# if not successful, return 0 if successful, and return 1 if Kerberos is not +# configured. Sets the global principal variable to the principal to use. +kerberos_setup () { + local keytab + keytab='' + for f in "$BUILD/data/test.keytab" "$SOURCE/data/test.keytab" ; do + if [ -r "$f" ] ; then + keytab="$f" + fi + done + principal='' + for f in "$BUILD/data/test.principal" "$SOURCE/data/test.principal" ; do + if [ -r "$f" ] ; then + principal=`cat "$BUILD/data/test.principal"` + fi + done + if [ -z "$keytab" ] || [ -z "$principal" ] ; then + return 1 + fi + KRB5CCNAME="$BUILD/data/test.cache"; export KRB5CCNAME + kinit -k -t "$keytab" "$principal" >/dev/null /dev/null /dev/null +# Copyright 2009 Russ Allbery +# Copyright 2006, 2007, 2008 Board of Trustees, Leland Stanford Jr. University +# +# See LICENSE for licensing terms. + +# Print out the number of test cases we expect to run. +plan () { + count=1 + planned="$1" + failed=0 + echo "1..$1" + trap finish 0 +} + +# Report the test status on exit. +finish () { + local highest looks + highest=`expr "$count" - 1` + looks='# Looks like you' + if [ "$planned" -gt 0 ] ; then + if [ "$planned" -gt "$highest" ] ; then + if [ "$planned" -gt 1 ] ; then + echo "$looks planned $planned tests but only ran $highest" + else + echo "$looks planned $planned test but only ran $highest" + fi + elif [ "$planned" -lt "$highest" ] ; then + local extra + extra=`expr "$highest" - "$planned"` + if [ "$planned" -gt 1 ] ; then + echo "$looks planned $planned tests but ran $extra extra" + else + echo "$looks planned $planned test but ran $extra extra" + fi + elif [ "$failed" -gt 0 ] ; then + if [ "$failed" -gt 1 ] ; then + echo "$looks failed $failed tests of $planned" + else + echo "$looks failed $failed test of $planned" + fi + elif [ "$planned" -gt 1 ] ; then + echo "# All $planned tests successful or skipped" + else + echo "# $planned test successful or skipped" + fi + fi +} + +# Skip the entire test suite. Should be run instead of plan. +skip_all () { + local desc + desc="$1" + if [ -n "$desc" ] ; then + echo "1..0 # skip $desc" + else + echo "1..0 # skip" + fi + exit 0 +} + +# ok takes a test description and a command to run and prints success if that +# command is successful, false otherwise. The count starts at 1 and is +# updated each time ok is printed. +ok () { + local desc + desc="$1" + if [ -n "$desc" ] ; then + desc=" - $desc" + fi + shift + if "$@" ; then + echo ok $count$desc + else + echo not ok $count$desc + failed=`expr $failed + 1` + fi + count=`expr $count + 1` +} + +# Skip the next test. Takes the reason why the test is skipped. +skip () { + echo "ok $count # skip $*" + count=`expr $count + 1` +} + +# Report the same status on a whole set of tests. Takes the count of tests, +# the description, and then the command to run to determine the status. +ok_block () { + local end i desc + i=$count + end=`expr $count + $1` + shift + desc="$1" + shift + while [ "$i" -lt "$end" ] ; do + ok "$desc" "$@" + i=`expr $i + 1` + done +} + +# Skip a whole set of tests. Takes the count and then the reason for skipping +# the test. +skip_block () { + local i end + i=$count + end=`expr $count + $1` + shift + while [ "$i" -lt "$end" ] ; do + skip "$@" + i=`expr $i + 1` + done +} + +# Run a program expected to succeed, and print ok if it does and produces the +# correct output. Takes the description, expected exit status, the expected +# output, the command to run, and then any arguments for that command. Strip +# a colon and everything after it off the output if the expected status is +# non-zero, since this is probably a system-specific error message. +ok_program () { + local desc w_status w_output output status + desc="$1" + shift + w_status="$1" + shift + w_output="$1" + shift + output=`"$@" 2>&1` + status=$? + if [ "$w_status" -ne 0 ] ; then + output=`echo "$output" | sed 's/^\([^:]* [^:]*\):.*/\1/'` + fi + if [ $status = $w_status ] && [ x"$output" = x"$w_output" ] ; then + ok "$desc" true + else + echo "# saw: ($status) $output" + echo "# not: ($w_status) $w_output" + ok "$desc" false + fi +} + +# Bail out with an error message. +bail () { + echo 'Bail out!' "$@" + exit 1 +} diff --git a/tests/tap/messages.c b/tests/tap/messages.c new file mode 100644 index 0000000..3bb9a1a --- /dev/null +++ b/tests/tap/messages.c @@ -0,0 +1,80 @@ +/* + * Utility functions to test message handling. + * + * These functions set up a message handler to trap warn and notice output + * into a buffer that can be inspected later, allowing testing of error + * handling. + * + * Copyright 2006, 2007, 2009 + * Board of Trustees, Leland Stanford Jr. University + * Copyright (c) 2004, 2005, 2006 + * by Internet Systems Consortium, Inc. ("ISC") + * Copyright (c) 1991, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, + * 2002, 2003 by The Internet Software Consortium and Rich Salz + * + * See LICENSE for licensing terms. + */ + +#include +#include + +#include +#include +#include +#include +#include + +/* A global buffer into which message_log_buffer stores error messages. */ +char *errors = NULL; + + +/* + * An error handler that appends all errors to the errors global. Used by + * error_capture. + */ +static void +message_log_buffer(int len, const char *fmt, va_list args, int error UNUSED) +{ + char *message; + + message = xmalloc(len + 1); + vsnprintf(message, len + 1, fmt, args); + if (errors == NULL) { + errors = concat(message, "\n", (char *) 0); + } else { + char *new_errors; + + new_errors = concat(errors, message, "\n", (char *) 0); + free(errors); + errors = new_errors; + } + free(message); +} + + +/* + * Turn on the capturing of errors. Errors will be stored in the global + * errors variable where they can be checked by the test suite. Capturing is + * turned off with errors_uncapture. + */ +void +errors_capture(void) +{ + if (errors != NULL) { + free(errors); + errors = NULL; + } + message_handlers_warn(1, message_log_buffer); + message_handlers_notice(1, message_log_buffer); +} + + +/* + * Turn off the capturing of errors again. + */ +void +errors_uncapture(void) +{ + message_handlers_warn(1, message_log_stderr); + message_handlers_notice(1, message_log_stdout); +} diff --git a/tests/tap/messages.h b/tests/tap/messages.h new file mode 100644 index 0000000..2b9a7db --- /dev/null +++ b/tests/tap/messages.h @@ -0,0 +1,35 @@ +/* + * Utility functions to test message handling. + * + * Copyright 2006, 2007, 2009 + * Board of Trustees, Leland Stanford Jr. University + * Copyright (c) 2004, 2005, 2006 + * by Internet Systems Consortium, Inc. ("ISC") + * Copyright (c) 1991, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, + * 2002, 2003 by The Internet Software Consortium and Rich Salz + * + * See LICENSE for licensing terms. + */ + +#ifndef TAP_MESSAGES_H +#define TAP_MESSAGES_H 1 + +#include +#include + +/* A global buffer into which errors_capture stores errors. */ +extern char *errors; + +BEGIN_DECLS + +/* + * Turn on capturing of errors with errors_capture. Errors reported by warn + * will be stored in the global errors variable. Turn this off again with + * errors_uncapture. Caller is responsible for freeing errors when done. + */ +void errors_capture(void); +void errors_uncapture(void); + +END_DECLS + +#endif /* !TAP_MESSAGES_H */ diff --git a/tests/tap/process.c b/tests/tap/process.c new file mode 100644 index 0000000..16154c7 --- /dev/null +++ b/tests/tap/process.c @@ -0,0 +1,100 @@ +/* + * Utility functions for tests that use subprocesses. + * + * Provides utility functions for subprocess manipulation. Currently, only + * one utility function is provided: is_function_output, which runs a function + * in a subprocess and checks its output and exit status against expected + * values. + * + * Copyright 2009, 2010 Board of Trustees, Leland Stanford Jr. University + * Copyright (c) 2004, 2005, 2006 + * by Internet Systems Consortium, Inc. ("ISC") + * Copyright (c) 1991, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, + * 2002, 2003 by The Internet Software Consortium and Rich Salz + * + * See LICENSE for licensing terms. + */ + +#include +#include + +#include + +#include +#include +#include + + +/* + * Given a function, an expected exit status, and expected output, runs that + * function in a subprocess, capturing stdout and stderr via a pipe, and + * compare the combination of stdout and stderr with the expected output and + * the exit status with the expected status. Expects the function to always + * exit (not die from a signal). + */ +void +is_function_output(test_function_type function, int status, const char *output, + const char *format, ...) +{ + int fds[2]; + pid_t child; + char *buf, *msg; + ssize_t count, ret, buflen; + int rval; + va_list args; + + /* Flush stdout before we start to avoid odd forking issues. */ + fflush(stdout); + + /* Set up the pipe and call the function, collecting its output. */ + if (pipe(fds) == -1) + sysbail("can't create pipe"); + child = fork(); + if (child == (pid_t) -1) { + sysbail("can't fork"); + } else if (child == 0) { + /* In child. Set up our stdout and stderr. */ + close(fds[0]); + if (dup2(fds[1], 1) == -1) + _exit(255); + if (dup2(fds[1], 2) == -1) + _exit(255); + + /* Now, run the function and exit successfully if it returns. */ + (*function)(); + fflush(stdout); + _exit(0); + } else { + /* + * In the parent; close the extra file descriptor, read the output if + * any, and then collect the exit status. + */ + close(fds[1]); + buflen = BUFSIZ; + buf = xmalloc(buflen); + count = 0; + do { + ret = read(fds[0], buf + count, buflen - count - 1); + if (ret > 0) + count += ret; + if (count >= buflen - 1) { + buflen += BUFSIZ; + buf = xrealloc(buf, buflen); + } + } while (ret > 0); + buf[count < 0 ? 0 : count] = '\0'; + if (waitpid(child, &rval, 0) == (pid_t) -1) + sysbail("waitpid failed"); + } + + /* Now, check the results against what we expected. */ + va_start(args, format); + if (xvasprintf(&msg, format, args) < 0) + bail("cannot format test description"); + va_end(args); + ok(WIFEXITED(rval), "%s (exited)", msg); + is_int(status, WEXITSTATUS(rval), "%s (status)", msg); + is_string(output, buf, "%s (output)", msg); + free(buf); + free(msg); +} diff --git a/tests/tap/process.h b/tests/tap/process.h new file mode 100644 index 0000000..b7d3b11 --- /dev/null +++ b/tests/tap/process.h @@ -0,0 +1,37 @@ +/* + * Utility functions for tests that use subprocesses. + * + * Copyright 2009, 2010 Board of Trustees, Leland Stanford Jr. University + * Copyright (c) 2004, 2005, 2006 + * by Internet Systems Consortium, Inc. ("ISC") + * Copyright (c) 1991, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, + * 2002, 2003 by The Internet Software Consortium and Rich Salz + * + * See LICENSE for licensing terms. + */ + +#ifndef TAP_PROCESS_H +#define TAP_PROCESS_H 1 + +#include +#include + +BEGIN_DECLS + +/* + * Run a function in a subprocess and check the exit status and expected + * output (stdout and stderr combined) against the provided values. Expects + * the function to always exit (not die from a signal). + * + * This reports as three separate tests: whether the function exited rather + * than was killed, whether the exit status was correct, and whether the + * output was correct. + */ +typedef void (*test_function_type)(void); +void is_function_output(test_function_type, int status, const char *output, + const char *format, ...) + __attribute__((__format__(printf, 4, 5))); + +END_DECLS + +#endif /* TAP_PROCESS_H */ diff --git a/tests/tap/remctl.sh b/tests/tap/remctl.sh new file mode 100644 index 0000000..b9667ef --- /dev/null +++ b/tests/tap/remctl.sh @@ -0,0 +1,46 @@ +# Shell function library to start and stop remctld +# +# Written by Russ Allbery +# Copyright 2009 Board of Trustees, Leland Stanford Jr. University +# +# See LICENSE for licensing terms. + +# Start remctld. Takes the path to remctld, which may be found via configure, +# and the path to the configuration file. +remctld_start () { + local keytab principal + rm -f "$BUILD/data/remctld.pid" + keytab='' + for f in "$BUILD/data/test.keytab" "$SOURCE/data/test.keytab" ; do + if [ -r "$f" ] ; then + keytab="$f" + fi + done + principal='' + for f in "$BUILD/data/test.principal" "$SOURCE/data/test.principal" ; do + if [ -r "$f" ] ; then + principal=`cat "$BUILD/data/test.principal"` + fi + done + if [ -n "$VALGRIND" ] ; then + ( "$VALGRIND" --log-file=valgrind.%p --leak-check=full "$1" -m \ + -p 14373 -s "$principal" -P "$BUILD/data/remctld.pid" -f "$2" -d \ + -S -F -k "$keytab" &) + [ -f "$BUILD/data/remctld.pid" ] || sleep 5 + else + ( "$1" -m -p 14373 -s "$principal" -P "$BUILD/data/remctld.pid" \ + -f "$2" -d -S -F -k "$keytab" &) + fi + [ -f "$BUILD/data/remctld.pid" ] || sleep 1 + if [ ! -f "$BUILD/data/remctld.pid" ] ; then + bail 'remctld did not start' + fi +} + +# Stop remctld and clean up. +remctld_stop () { + if [ -f "$BUILD/data/remctld.pid" ] ; then + kill -TERM `cat "$BUILD/data/remctld.pid"` + rm -f "$BUILD/data/remctld.pid" + fi +} diff --git a/tests/util/concat-t.c b/tests/util/concat-t.c index 81824c8..ca7de2c 100644 --- a/tests/util/concat-t.c +++ b/tests/util/concat-t.c @@ -1,58 +1,46 @@ /* * concat test suite. * - * Copyright 2004, 2005, 2006 + * Written by Russ Allbery + * Copyright 2009 Board of Trustees, Leland Stanford Jr. University + * Copyright (c) 2004, 2005, 2006 * by Internet Systems Consortium, Inc. ("ISC") - * Copyright 1991, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, - * 2003 by The Internet Software Consortium and Rich Salz + * Copyright (c) 1991, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, + * 2002, 2003 by The Internet Software Consortium and Rich Salz * - * This code is derived from software contributed to the Internet Software - * Consortium by Rich Salz. - * - * Permission to use, copy, modify, and distribute this software for any - * purpose with or without fee is hereby granted, provided that the above - * copyright notice and this permission notice appear in all copies. - * - * THE SOFTWARE IS PROVIDED "AS IS" AND ISC DISCLAIMS ALL WARRANTIES WITH - * REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY - * AND FITNESS. IN NO EVENT SHALL ISC BE LIABLE FOR ANY SPECIAL, DIRECT, - * INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM - * LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE - * OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR - * PERFORMANCE OF THIS SOFTWARE. + * See LICENSE for licensing terms. */ #include #include -#include -#include +#include +#include #define END (char *) 0 - /* * Memory leaks everywhere! Whoo-hoo! */ int main(void) { - test_init(13); - - ok_string( 1, "a", concat("a", END)); - ok_string( 2, "ab", concat("a", "b", END)); - ok_string( 3, "ab", concat("ab", "", END)); - ok_string( 4, "ab", concat("", "ab", END)); - ok_string( 5, "", concat("", END)); - ok_string( 6, "abcde", concat("ab", "c", "", "de", END)); - ok_string( 7, "abcde", concat("abc", "de", END, "f", END)); - - ok_string( 8, "/foo", concatpath("/bar", "/foo")); - ok_string( 9, "/foo/bar", concatpath("/foo", "bar")); - ok_string(10, "./bar", concatpath("/foo", "./bar")); - ok_string(11, "/bar/baz/foo/bar", concatpath("/bar/baz", "foo/bar")); - ok_string(12, "./foo", concatpath(NULL, "foo")); - ok_string(13, "/foo/bar", concatpath(NULL, "/foo/bar")); + plan(13); + + is_string("a", concat("a", END), "concat 1"); + is_string("ab", concat("a", "b", END), "concat 2"); + is_string("ab", concat("ab", "", END), "concat 3"); + is_string("ab", concat("", "ab", END), "concat 4"); + is_string("", concat("", END), "concat 5"); + is_string("abcde", concat("ab", "c", "", "de", END), "concat 6"); + is_string("abcde", concat("abc", "de", END, "f", END), "concat 7"); + + is_string("/foo", concatpath("/bar", "/foo"), "path 1"); + is_string("/foo/bar", concatpath("/foo", "bar"), "path 2"); + is_string("./bar", concatpath("/foo", "./bar"), "path 3"); + is_string("/bar/baz/foo/bar", concatpath("/bar/baz", "foo/bar"), "path 4"); + is_string("./foo", concatpath(NULL, "foo"), "path 5"); + is_string("/foo/bar", concatpath(NULL, "/foo/bar"), "path 6"); return 0; } diff --git a/tests/util/messages-krb5-t.c b/tests/util/messages-krb5-t.c new file mode 100644 index 0000000..02d8f92 --- /dev/null +++ b/tests/util/messages-krb5-t.c @@ -0,0 +1,99 @@ +/* + * Test suite for Kerberos error handling routines. + * + * Written by Russ Allbery + * Copyright 2010 Board of Trustees, Leland Stanford Jr. University + * + * See LICENSE for licensing terms. + */ + +#include +#include +#include + +#include +#include +#include +#include +#include + + +/* + * Test functions. + */ +static void +test_warn(void) +{ + krb5_context ctx; + krb5_error_code code; + krb5_principal princ; + + code = krb5_init_context(&ctx); + if (code < 0) + die_krb5(ctx, code, "cannot create context"); + code = krb5_parse_name(ctx, "foo@bar@EXAMPLE.COM", &princ); + if (code < 0) + warn_krb5(ctx, code, "principal parse failed"); + else + die("unexpected success parsing principal"); + exit(0); +} + +static void +test_die(void) +{ + krb5_context ctx; + krb5_error_code code; + krb5_principal princ; + + code = krb5_init_context(&ctx); + if (code < 0) + die_krb5(ctx, code, "cannot create context"); + code = krb5_parse_name(ctx, "foo@bar@EXAMPLE.COM", &princ); + if (code < 0) + die_krb5(ctx, code, "principal parse failed"); + else + die("unexpected success parsing principal"); + exit(0); +} + + +/* + * Run the tests. + */ +int +main(void) +{ + krb5_context ctx; + krb5_error_code code; + krb5_principal princ; + const char *message; + char *wanted; + + plan(6 * 3); + + /* First, we have to get what the correct error message is. */ + code = krb5_init_context(&ctx); + if (code < 0) + bail("cannot create context"); + code = krb5_parse_name(ctx, "foo@bar@EXAMPLE.COM", &princ); + message = krb5_get_error_message(ctx, code); + + xasprintf(&wanted, "principal parse failed: %s\n", message); + is_function_output(test_warn, 0, wanted, "warn_krb5"); + is_function_output(test_die, 1, wanted, "die_krb5"); + free(wanted); + + message_program_name = "msg-test"; + xasprintf(&wanted, "msg-test: principal parse failed: %s\n", message); + is_function_output(test_warn, 0, wanted, "warn_krb5 with name"); + is_function_output(test_die, 1, wanted, "die_krb5 with name"); + free(wanted); + + message_handlers_warn(0); + is_function_output(test_warn, 0, "", "warn_krb5 with no handlers"); + message_handlers_die(0); + is_function_output(test_die, 1, "", "warn_krb5 with no handlers"); + + return 0; +} diff --git a/tests/util/messages-t.c b/tests/util/messages-t.c index 3f7860e..fb82a42 100644 --- a/tests/util/messages-t.c +++ b/tests/util/messages-t.c @@ -1,25 +1,14 @@ /* * Test suite for error handling routines. * - * Copyright 2004, 2005, 2006 + * Written by Russ Allbery + * Copyright 2009, 2010 Board of Trustees, Leland Stanford Jr. University + * Copyright (c) 2004, 2005, 2006 * by Internet Systems Consortium, Inc. ("ISC") - * Copyright 1991, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, - * 2003 by The Internet Software Consortium and Rich Salz + * Copyright (c) 1991, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, + * 2002, 2003 by The Internet Software Consortium and Rich Salz * - * This code is derived from software contributed to the Internet Software - * Consortium by Rich Salz. - * - * Permission to use, copy, modify, and distribute this software for any - * purpose with or without fee is hereby granted, provided that the above - * copyright notice and this permission notice appear in all copies. - * - * THE SOFTWARE IS PROVIDED "AS IS" AND ISC DISCLAIMS ALL WARRANTIES WITH - * REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY - * AND FITNESS. IN NO EVENT SHALL ISC BE LIABLE FOR ANY SPECIAL, DIRECT, - * INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM - * LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE - * OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR - * PERFORMANCE OF THIS SOFTWARE. + * See LICENSE for licensing terms. */ #include @@ -30,67 +19,11 @@ #include #include -#include -#include - -#define END (char *) 0 - -/* Test function type. */ -typedef void (*test_function_t)(void); - - -/* - * Fork and execute the provided function, connecting stdout and stderr to a - * pipe. Captures the output into the provided buffer and returns the exit - * status as a waitpid status value. - */ -static int -run_test(test_function_t function, char *buf, size_t buflen) -{ - int fds[2]; - pid_t child; - ssize_t count, status; - int rval; - - /* Flush stdout before we start to avoid odd forking issues. */ - fflush(stdout); - - /* Set up the pipe and call the function, collecting its output. */ - if (pipe(fds) == -1) - sysdie("can't create pipe"); - child = fork(); - if (child == (pid_t) -1) { - sysdie("can't fork"); - } else if (child == 0) { - /* In child. Set up our stdout and stderr. */ - close(fds[0]); - if (dup2(fds[1], 1) == -1) - _exit(255); - if (dup2(fds[1], 2) == -1) - _exit(255); - - /* Now, run the function and exit successfully if it returns. */ - (*function)(); - fflush(stdout); - _exit(0); - } else { - /* - * In the parent; close the extra file descriptor, read the output if - * any, and then collect the exit status. - */ - close(fds[1]); - count = 0; - do { - status = read(fds[0], buf + count, buflen - count - 1); - if (status > 0) - count += status; - } while (status > 0); - buf[count < 0 ? 0 : count] = '\0'; - if (waitpid(child, &rval, 0) == (pid_t) -1) - sysdie("waitpid failed"); - } - return rval; -} +#include +#include +#include +#include +#include /* @@ -203,43 +136,20 @@ static void test24(void) { /* - * Given the test number, intended exit status and message, and the function - * to run, print ok or not ok. - */ -static void -test_error(int n, int status, const char *output, test_function_t function) -{ - int real_status; - char buf[256]; - int succeeded = 1; - - real_status = run_test(function, buf, sizeof(buf)); - if (!WIFEXITED(real_status) || status != WEXITSTATUS(real_status)) { - printf(" unexpected exit status %d\n", real_status); - succeeded = 0; - } - if (strcmp(output, buf)) { - printf(" unexpected output: %s", buf); - printf(" expected output: %s", output); - succeeded = 0; - } - printf("%sok %d\n", succeeded ? "" : "not ", n); -} - - -/* - * Given the test number, intended status, intended message sans the appended - * strerror output, errno, and the function to run, print ok or not ok. + * Given the intended status, intended message sans the appended strerror + * output, errno, and the function to run, check the output. */ static void -test_strerror(int n, int status, const char *output, int error, - test_function_t function) +test_strerror(int status, const char *output, int error, + test_function_type function) { - char *full_output; + char *full_output, *name; - full_output = concat(output, ": ", strerror(error), "\n", END); - test_error(n, status, full_output, function); + full_output = concat(output, ": ", strerror(error), "\n", (char *) NULL); + xasprintf(&name, "strerror %d", testnum / 3 + 1); + is_function_output(function, status, full_output, name); free(full_output); + free(name); } @@ -250,46 +160,47 @@ int main(void) { char buff[32]; - - test_init(24); - - test_error(1, 0, "warning\n", test1); - test_error(2, 1, "fatal\n", test2); - test_strerror(3, 0, "permissions", EPERM, test3); - test_strerror(4, 1, "fatal access", EACCES, test4); - test_error(5, 0, "test5: warning\n", test5); - test_error(6, 1, "test6: fatal\n", test6); - test_strerror(7, 0, "test7: perms 7", EPERM, test7); - test_strerror(8, 1, "test8: fatal", EACCES, test8); - test_error(9, 10, "fatal\n", test9); - test_strerror(10, 10, "fatal perm", EPERM, test10); - test_strerror(11, 10, "1st test11: fatal", EPERM, test11); - test_error(12, 0, "7 0 warning\n", test12); - test_error(13, 1, "5 0 fatal\n", test13); + char *output; + + plan(24 * 3); + + is_function_output(test1, 0, "warning\n", "test1"); + is_function_output(test2, 1, "fatal\n", "test2"); + test_strerror(0, "permissions", EPERM, test3); + test_strerror(1, "fatal access", EACCES, test4); + is_function_output(test5, 0, "test5: warning\n", "test5"); + is_function_output(test6, 1, "test6: fatal\n", "test6"); + test_strerror(0, "test7: perms 7", EPERM, test7); + test_strerror(1, "test8: fatal", EACCES, test8); + is_function_output(test9, 10, "fatal\n", "test9"); + test_strerror(10, "fatal perm", EPERM, test10); + test_strerror(10, "1st test11: fatal", EPERM, test11); + is_function_output(test12, 0, "7 0 warning\n", "test12"); + is_function_output(test13, 1, "5 0 fatal\n", "test13"); sprintf(buff, "%d", EPERM); - test_error(14, 0, - concat("7 ", buff, " warning\n7 ", buff, " warning\n", END), - test14); - test_error(15, 10, - concat("5 ", buff, " fatal\n5 ", buff, " fatal\n", END), - test15); - test_error(16, 0, - concat("test16: warning: ", strerror(EPERM), "\n7 ", buff, - " warning\n", END), - test16); - - test_error(17, 0, "notice\n", test17); - test_error(18, 0, "test18: notice\n", test18); - test_error(19, 0, "", test19); - test_error(20, 0, "3 0 foo\n", test20); - test_error(21, 0, "test23: baz\n", test21); + xasprintf(&output, "7 %d warning\n7 %d warning\n", EPERM, EPERM); + is_function_output(test14, 0, output, "test14"); + free(output); + xasprintf(&output, "5 %d fatal\n5 %d fatal\n", EPERM, EPERM); + is_function_output(test15, 10, output, "test15"); + free(output); + xasprintf(&output, "test16: warning: %s\n7 %d warning\n", strerror(EPERM), + EPERM); + is_function_output(test16, 0, output, "test16"); + free(output); + + is_function_output(test17, 0, "notice\n", "test17"); + is_function_output(test18, 0, "test18: notice\n", "test18"); + is_function_output(test19, 0, "", "test19"); + is_function_output(test20, 0, "3 0 foo\n", "test20"); + is_function_output(test21, 0, "test23: baz\n", "test21"); /* Make sure that it's possible to turn off a message type entirely. */ - test_error(22, 1, "", test22); - test_error(23, 0, "", test23); - test_error(24, 0, "first\nthird\n", test24); + is_function_output(test22, 1, "", "test22"); + is_function_output(test23, 0, "", "test23"); + is_function_output(test24, 0, "first\nthird\n", "test24"); return 0; } diff --git a/tests/util/xmalloc-t b/tests/util/xmalloc-t new file mode 100755 index 0000000..02f54b5 --- /dev/null +++ b/tests/util/xmalloc-t @@ -0,0 +1,127 @@ +#! /bin/sh +# +# Test suite for xmalloc and friends. +# +# Written by Russ Allbery +# Copyright 2008, 2009, 2010 Board of Trustees, Leland Stanford Jr. University +# Copyright 2004, 2005, 2006 +# by Internet Systems Consortium, Inc. ("ISC") +# Copyright 1991, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, +# 2003 by The Internet Software Consortium and Rich Salz +# +# See LICENSE for licensing terms. + +. "$SOURCE/tap/libtap.sh" +cd "$BUILD/util" + +# Run an xmalloc test. Takes the description, the expectd exit status, the +# output, and the arguments. +ok_xmalloc () { + local desc w_status w_output output status + desc="$1" + shift + w_status="$1" + shift + w_output="$1" + shift + output=`./xmalloc "$@" 2>&1` + status=$? + if [ "$w_status" -ne 0 ] ; then + output=`echo "$output" | sed 's/:.*//'` + fi + if [ $status = $w_status ] && [ x"$output" = x"$w_output" ] ; then + ok "$desc" true + elif [ $status = 2 ] ; then + skip "no data limit support" + else + echo "# saw: ($status) $output" + echo "# not: ($w_status) $w_output" + ok "$desc" false + fi +} + +# Skip this test suite unless maintainer-mode tests are enabled. All of the +# failures in automated testing have been problems with the assumptions around +# memory allocation or problems with the test suite, not problems with the +# underlying xmalloc code. +if [ -z "$RRA_MAINTAINER_TESTS" ] ; then + skip_all 'xmalloc tests only run for maintainer' +fi + +# Total tests. +plan 36 + +# First run the tests expected to succeed. +ok_xmalloc "malloc small" 0 "" "m" "21" "0" +ok_xmalloc "malloc large" 0 "" "m" "3500000" "0" +ok_xmalloc "malloc zero" 0 "" "m" "0" "0" +ok_xmalloc "realloc small" 0 "" "r" "21" "0" +ok_xmalloc "realloc large" 0 "" "r" "3500000" "0" +ok_xmalloc "strdup small" 0 "" "s" "21" "0" +ok_xmalloc "strdup large" 0 "" "s" "3500000" "0" +ok_xmalloc "strndup small" 0 "" "n" "21" "0" +ok_xmalloc "strndup large" 0 "" "n" "3500000" "0" +ok_xmalloc "calloc small" 0 "" "c" "24" "0" +ok_xmalloc "calloc large" 0 "" "c" "3500000" "0" +ok_xmalloc "asprintf small" 0 "" "a" "24" "0" +ok_xmalloc "asprintf large" 0 "" "a" "3500000" "0" +ok_xmalloc "vasprintf small" 0 "" "v" "24" "0" +ok_xmalloc "vasprintf large" 0 "" "v" "3500000" "0" + +# Now limit our memory to 3.5MB and then try the large ones again, all of +# which should fail. +# +# The exact memory limits used here are essentially black magic. They need to +# be large enough to allow the program to be loaded and do small allocations, +# but not so large that we can't reasonably expect to allocate that much +# memory normally. 3.5MB seems to work reasonably well on both Solaris and +# Linux. +# +# We assume that there are enough miscellaneous allocations that an allocation +# exactly as large as the limit will always fail. +ok_xmalloc "malloc fail" 1 \ + "failed to malloc 3500000 bytes at xmalloc.c line 38" \ + "m" "3500000" "3500000" +ok_xmalloc "realloc fail" 1 \ + "failed to realloc 3500000 bytes at xmalloc.c line 66" \ + "r" "3500000" "3500000" +ok_xmalloc "strdup fail" 1 \ + "failed to strdup 3500000 bytes at xmalloc.c line 97" \ + "s" "3500000" "3500000" +ok_xmalloc "strndup fail" 1 \ + "failed to strndup 3500000 bytes at xmalloc.c line 124" \ + "n" "3500000" "3500000" +ok_xmalloc "calloc fail" 1 \ + "failed to calloc 3500000 bytes at xmalloc.c line 148" \ + "c" "3500000" "3500000" +ok_xmalloc "asprintf fail" 1 \ + "failed to asprintf 3500000 bytes at xmalloc.c line 173" \ + "a" "3500000" "3500000" +ok_xmalloc "vasprintf fail" 1 \ + "failed to vasprintf 3500000 bytes at xmalloc.c line 193" \ + "v" "3500000" "3500000" + +# Check our custom error handler. +ok_xmalloc "malloc custom" 1 "malloc 3500000 xmalloc.c 38" \ + "M" "3500000" "3500000" +ok_xmalloc "realloc custom" 1 "realloc 3500000 xmalloc.c 66" \ + "R" "3500000" "3500000" +ok_xmalloc "strdup custom" 1 "strdup 3500000 xmalloc.c 97" \ + "S" "3500000" "3500000" +ok_xmalloc "strndup custom" 1 "strndup 3500000 xmalloc.c 124" \ + "N" "3500000" "3500000" +ok_xmalloc "calloc custom" 1 "calloc 3500000 xmalloc.c 148" \ + "C" "3500000" "3500000" +ok_xmalloc "asprintf custom" 1 "asprintf 3500000 xmalloc.c 173" \ + "A" "3500000" "3500000" +ok_xmalloc "vasprintf custom" 1 "vasprintf 3500000 xmalloc.c 193" \ + "V" "3500000" "3500000" + +# Check the smaller ones again just for grins. +ok_xmalloc "malloc retry" 0 "" "m" "21" "3500000" +ok_xmalloc "realloc retry" 0 "" "r" "32" "3500000" +ok_xmalloc "strdup retry" 0 "" "s" "64" "3500000" +ok_xmalloc "strndup retry" 0 "" "n" "20" "3500000" +ok_xmalloc "calloc retry" 0 "" "c" "24" "3500000" +ok_xmalloc "asprintf retry" 0 "" "a" "30" "3500000" +ok_xmalloc "vasprintf retry" 0 "" "v" "35" "3500000" diff --git a/tests/util/xmalloc-t.in b/tests/util/xmalloc-t.in deleted file mode 100644 index 5c18512..0000000 --- a/tests/util/xmalloc-t.in +++ /dev/null @@ -1,126 +0,0 @@ -#! /bin/sh -# -# Test suite for xmalloc and friends. -# -# Copyright 2004, 2005, 2006 -# by Internet Systems Consortium, Inc. ("ISC") -# Copyright 1991, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, -# 2003 by The Internet Software Consortium and Rich Salz -# -# This code is derived from software contributed to the Internet Software -# Consortium by Rich Salz. -# -# Permission to use, copy, modify, and distribute this software for any -# purpose with or without fee is hereby granted, provided that the above -# copyright notice and this permission notice appear in all copies. -# -# THE SOFTWARE IS PROVIDED "AS IS" AND ISC DISCLAIMS ALL WARRANTIES WITH -# REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY -# AND FITNESS. IN NO EVENT SHALL ISC BE LIABLE FOR ANY SPECIAL, DIRECT, -# INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM -# LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE -# OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR -# PERFORMANCE OF THIS SOFTWARE. - -# The count starts at 1 and is updated each time ok is printed. printcount -# takes "ok" or "not ok". -count=1 -printcount () { - echo "$1 $count $2" - count=`expr $count + 1` -} - -# Run a program expected to succeed, and print ok if it does. -runsuccess () { - output=`$xmalloc "$1" "$2" "$3" 2>&1 >/dev/null` - status=$? - if test $status = 0 && test -z "$output" ; then - printcount "ok" - else - if test $status = 2 ; then - printcount "ok" "# skip - no data limit support" - else - printcount "not ok" - echo " $output" - fi - fi -} - -# Run a program expected to fail and make sure it fails with an exit status -# of 2 and the right failure message. Strip the colon and everything after -# it off the error message since it's system-specific. -runfailure () { - output=`$xmalloc "$1" "$2" "$3" 2>&1 >/dev/null` - status=$? - output=`echo "$output" | sed 's/:.*//' \ - | sed 's% [^ ]*/xmalloc.c% xmalloc.c%'` - if test $status = 1 && test x"$output" = x"$4" ; then - printcount "ok" - else - if test $status = 2 ; then - printcount "ok" "# skip - no data limit support" - else - printcount "not ok" - echo " saw: $output" - echo " not: $4" - fi - fi -} - -# Find where the helper program is. -xmalloc="@abs_top_builddir@/tests/util/xmalloc" - -# Total tests. -echo 36 - -# First run the tests expected to succeed. -runsuccess "m" "21" "0" -runsuccess "m" "128000" "0" -runsuccess "m" "0" "0" -runsuccess "r" "21" "0" -runsuccess "r" "128000" "0" -runsuccess "s" "21" "0" -runsuccess "s" "128000" "0" -runsuccess "n" "21" "0" -runsuccess "n" "128000" "0" -runsuccess "c" "24" "0" -runsuccess "c" "128000" "0" -runsuccess "a" "24" "0" -runsuccess "a" "128000" "0" -runsuccess "v" "24" "0" -runsuccess "v" "128000" "0" - -# Now limit our memory to 120KB and then try the large ones again, all of -# which should fail. -runfailure "m" "128000" "120000" \ - "failed to malloc 128000 bytes at xmalloc.c line 61" -runfailure "r" "128000" "120000" \ - "failed to realloc 128000 bytes at xmalloc.c line 90" -runfailure "s" "64000" "120000" \ - "failed to strdup 64000 bytes at xmalloc.c line 121" -runfailure "n" "64000" "120000" \ - "failed to strndup 64000 bytes at xmalloc.c line 148" -runfailure "c" "128000" "120000" \ - "failed to calloc 128000 bytes at xmalloc.c line 172" -runfailure "a" "64000" "120000" \ - "failed to asprintf 64000 bytes at xmalloc.c line 241" -runfailure "v" "64000" "120000" \ - "failed to vasprintf 64000 bytes at xmalloc.c line 217" - -# Check our custom error handler. -runfailure "M" "128000" "120000" "malloc 128000 xmalloc.c 61" -runfailure "R" "128000" "120000" "realloc 128000 xmalloc.c 90" -runfailure "S" "64000" "120000" "strdup 64000 xmalloc.c 121" -runfailure "N" "64000" "120000" "strndup 64000 xmalloc.c 148" -runfailure "C" "128000" "120000" "calloc 128000 xmalloc.c 172" -runfailure "A" "64000" "120000" "asprintf 64000 xmalloc.c 241" -runfailure "V" "64000" "120000" "vasprintf 64000 xmalloc.c 217" - -# Check the smaller ones again just for grins. -runsuccess "m" "21" "96000" -runsuccess "r" "32" "96000" -runsuccess "s" "64" "96000" -runsuccess "n" "20" "96000" -runsuccess "c" "24" "96000" -runsuccess "a" "30" "96000" -runsuccess "v" "35" "96000" diff --git a/tests/util/xmalloc.c b/tests/util/xmalloc.c index bd0ab62..3bd5588 100644 --- a/tests/util/xmalloc.c +++ b/tests/util/xmalloc.c @@ -1,27 +1,17 @@ /* * Test suite for xmalloc and family. * + * Copyright 2008 Board of Trustees, Leland Stanford Jr. University * Copyright 2004, 2005, 2006 * by Internet Systems Consortium, Inc. ("ISC") * Copyright 1991, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, * 2003 by The Internet Software Consortium and Rich Salz * - * This code is derived from software contributed to the Internet Software - * Consortium by Rich Salz. - * - * Permission to use, copy, modify, and distribute this software for any - * purpose with or without fee is hereby granted, provided that the above - * copyright notice and this permission notice appear in all copies. - * - * THE SOFTWARE IS PROVIDED "AS IS" AND ISC DISCLAIMS ALL WARRANTIES WITH - * REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY - * AND FITNESS. IN NO EVENT SHALL ISC BE LIABLE FOR ANY SPECIAL, DIRECT, - * INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM - * LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE - * OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR - * PERFORMANCE OF THIS SOFTWARE. + * See LICENSE for licensing terms. */ +#line 1 "xmalloc.c" + #include #include @@ -32,7 +22,8 @@ /* Linux requires sys/time.h be included before sys/resource.h. */ #include -#include +#include +#include /* @@ -81,20 +72,19 @@ test_realloc(size_t size) char *buffer; size_t i; - buffer = xmalloc(size / 2); + buffer = xmalloc(10); if (buffer == NULL) return 0; - if (size / 2 > 0) - memset(buffer, 1, size / 2); + memset(buffer, 1, 10); buffer = xrealloc(buffer, size); if (buffer == NULL) return 0; if (size > 0) - memset(buffer + size / 2, 2, size - size / 2); - for (i = 0; i < size / 2; i++) + memset(buffer + 10, 2, size - 10); + for (i = 0; i < 10; i++) if (buffer[i] != 1) return 0; - for (i = size / 2; i < size; i++) + for (i = 10; i < size; i++) if (buffer[i] != 2) return 0; free(buffer); @@ -257,6 +247,7 @@ main(int argc, char *argv[]) int willfail = 0; unsigned char code; struct rlimit rl; + void *tmp; if (argc < 3) die("Usage error. Type, size, and limit must be given."); @@ -269,6 +260,27 @@ main(int argc, char *argv[]) if (limit == 0 && errno != 0) sysdie("Invalid limit"); + /* If the code is capitalized, install our customized error handler. */ + code = argv[1][0]; + if (isupper(code)) { + xmalloc_error_handler = test_handler; + code = tolower(code); + } + + /* + * Decide if the allocation should fail. If it should, set willfail to 2, + * so that if it unexpectedly succeeds, we exit with a status indicating + * that the test should be skipped. + */ + max = size; + if (code == 's' || code == 'n' || code == 'a' || code == 'v') { + max += size; + if (limit > 0) + limit += size; + } + if (limit > 0 && max > limit) + willfail = 2; + /* * If a memory limit was given and we can set memory limits, set it. * Otherwise, exit 2, signalling to the driver that the test should be @@ -277,37 +289,28 @@ main(int argc, char *argv[]) * the shell to die). */ if (limit > 0) { -#if HAVE_SETRLIMIT && defined(RLIMIT_DATA) +#if HAVE_SETRLIMIT && defined(RLIMIT_AS) rl.rlim_cur = limit; rl.rlim_max = limit; - if (setrlimit(RLIMIT_DATA, &rl) < 0) { + if (setrlimit(RLIMIT_AS, &rl) < 0) { syswarn("Can't set data limit to %lu", (unsigned long) limit); exit(2); } + if (size < limit || code == 'r') { + tmp = malloc(code == 'r' ? 10 : size); + if (tmp == NULL) { + syswarn("Can't allocate initial memory of %lu", + (unsigned long) size); + exit(2); + } + free(tmp); + } #else warn("Data limits aren't supported."); exit(2); #endif } - /* If the code is capitalized, install our customized error handler. */ - code = argv[1][0]; - if (isupper(code)) { - xmalloc_error_handler = test_handler; - code = tolower(code); - } - - /* - * Decide if the allocation should fail. If it should, set willfail to 2, - * so that if it unexpectedly succeeds, we exit with a status indicating - * that the test should be skipped. - */ - max = size; - if (code == 's' || code == 'n' || code == 'a' || code == 'v') - max *= 2; - if (limit > 0 && max > limit) - willfail = 2; - switch (code) { case 'c': exit(test_calloc(size) ? willfail : 1); case 'm': exit(test_malloc(size) ? willfail : 1); -- cgit v1.2.3 From 31c47c6f5efde6df930b11be281470f75e685324 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 9 Feb 2010 18:42:26 -0800 Subject: Update keytab test for new KRBTYPE error message --- perl/t/keytab.t | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/perl/t/keytab.t b/perl/t/keytab.t index e5a68be..39be547 100755 --- a/perl/t/keytab.t +++ b/perl/t/keytab.t @@ -370,7 +370,7 @@ EOO Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace) }; is ($object, undef, ' and one set to an invalid value'); - is ($@, "keytab krb server type not set to a valid value\n", + is ($@, "unknown KEYTAB_KRBTYPE setting: Active Directory\n", ' with the right error'); $Wallet::Config::KEYTAB_KRBTYPE = contents ('t/data/test.krbtype'); } -- cgit v1.2.3 From 77d967fb11a4e63967ad1e80929b7096f9d58c05 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 9 Feb 2010 19:43:15 -0800 Subject: Enable silent rule support and use it for make warnings --- Makefile.am | 4 ++-- README | 13 +++++++++---- configure.ac | 2 +- 3 files changed, 12 insertions(+), 7 deletions(-) diff --git a/Makefile.am b/Makefile.am index 056229b..77514a7 100644 --- a/Makefile.am +++ b/Makefile.am @@ -70,8 +70,8 @@ WARNINGS = -g -O -DDEBUG=1 -Wall -W -Wendif-labels -Wpointer-arith \ -Wmissing-prototypes -Wnested-externs -Werror warnings: - $(MAKE) CFLAGS='$(WARNINGS)' - $(MAKE) CFLAGS='$(WARNINGS)' $(check_PROGRAMS) + $(MAKE) V=0 CFLAGS='$(WARNINGS)' + $(MAKE) V=0 CFLAGS='$(WARNINGS)' $(check_PROGRAMS) # Remove some additional files. DISTCLEANFILES = perl/Makefile diff --git a/README b/README index eb9b39c..abc02fb 100644 --- a/README +++ b/README @@ -127,10 +127,11 @@ REQUIREMENTS srvtab with ADMIN access to a test AFS kaserver, and some additional configuration. - If you change the Automake files and need to regenerate Makefile.in, you - will need Automake 1.10 or later. If you change configure.ac or any of - the m4 files it includes and need to regenerate configure or - config.h.in, you will need Autoconf 2.61 or later. + To bootstrap from a Git checkout, or if you change the Automake files + and need to regenerate Makefile.in, you will need Automake 1.11 or + later. For bootstrap or if you change configure.ac or any of the m4 + files it includes and need to regenerate configure or config.h.in, you + will need Autoconf 2.64 or later. BUILD AND INSTALLATION @@ -140,6 +141,10 @@ BUILD AND INSTALLATION make make install + Pass --enable-silent-rules to configure for a quieter build (similar to + the Linux kernel). Use make warnings instead of make to build with full + GCC compiler warnings (requires a relatively current version of GCC). + The last step will probably have to be done as root. Currently, this always installs both the client and the server. diff --git a/configure.ac b/configure.ac index 0330aa9..0597859 100644 --- a/configure.ac +++ b/configure.ac @@ -13,7 +13,7 @@ AC_INIT([wallet], [0.9], [rra@stanford.edu]) AC_CONFIG_AUX_DIR([build-aux]) AC_CONFIG_LIBOBJ_DIR([portable]) AC_CONFIG_MACRO_DIR([m4]) -AM_INIT_AUTOMAKE([1.11 check-news]) +AM_INIT_AUTOMAKE([1.11 check-news silent-rules]) AM_MAINTAINER_MODE AC_PROG_CC -- cgit v1.2.3 From 99448954f4f9504796226bf05e76df22231d51ca Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 9 Feb 2010 19:43:27 -0800 Subject: Add additional Kerberos portability needed for the test suite --- configure.ac | 3 ++- portable/krb5-extra.c | 17 +++++++++++++++++ portable/krb5.h | 9 +++++++++ 3 files changed, 28 insertions(+), 1 deletion(-) diff --git a/configure.ac b/configure.ac index 0597859..c897775 100644 --- a/configure.ac +++ b/configure.ac @@ -27,7 +27,8 @@ RRA_LIB_KRB5 RRA_LIB_KRB5_SWITCH AC_CHECK_FUNCS([krb5_get_init_creds_opt_alloc \ krb5_get_init_creds_opt_set_default_flags \ - krb5_kt_free_entry]) + krb5_kt_free_entry \ + krb5_principal_get_realm]) AC_CHECK_MEMBERS([krb5_keytab_entry.keyblock], , , [#include ]) RRA_LIB_KRB5_RESTORE diff --git a/portable/krb5-extra.c b/portable/krb5-extra.c index 09a717b..afd00e8 100644 --- a/portable/krb5-extra.c +++ b/portable/krb5-extra.c @@ -106,3 +106,20 @@ krb5_get_init_creds_opt_alloc(krb5_context ctx, krb5_get_init_creds_opt **opts) return 0; } #endif /* !HAVE_KRB5_GET_INIT_CREDS_OPT_ALLOC */ + + +#ifndef HAVE_KRB5_PRINCIPAL_GET_REALM +/* + * Return the realm of a principal as a const char *. + */ +const char * +krb5_principal_get_realm(krb5_context ctx UNUSED, krb5_const_principal princ) +{ + const krb5_data *data; + + data = krb5_princ_realm(ctx, princ); + if (data == NULL || data->data == NULL) + return NULL; + return data->data; +} +#endif /* !HAVE_KRB5_PRINCIPAL_GET_REALM */ diff --git a/portable/krb5.h b/portable/krb5.h index 117f5ce..d9ef283 100644 --- a/portable/krb5.h +++ b/portable/krb5.h @@ -68,6 +68,15 @@ krb5_error_code krb5_get_init_creds_opt_alloc(krb5_context, # define krb5_kt_free_entry(c, e) krb5_free_keytab_entry_contents((c), (e)) #endif +/* + * Heimdal provides a nice function that just returns a const char *. On MIT, + * there's an accessor macro that returns the krb5_data pointer, wihch + * requires more work to get at the underlying char *. + */ +#ifndef HAVE_KRB5_PRINCIPAL_GET_REALM +const char *krb5_principal_get_realm(krb5_context, krb5_const_principal); +#endif + /* Undo default visibility change. */ #pragma GCC visibility pop -- cgit v1.2.3 From ff2d5ac3c63af9833d884d4840c772e60e45da7d Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 9 Feb 2010 19:55:12 -0800 Subject: Use the $SOURCE and $BUILD test suite variables Now that runtests has been updated to a version that sets $SOURCE and $BUILD, use that in the test cases rather than Autoconf substitutions. --- tests/client/full-t.in | 20 ++++++++++---------- tests/client/pod-t.in | 4 ++-- tests/client/prompt-t.in | 28 +++++++++++++--------------- tests/server/admin-t.in | 4 ++-- tests/server/backend-t.in | 4 ++-- tests/server/keytab-t.in | 9 ++++----- tests/server/pod-t.in | 6 +++--- 7 files changed, 36 insertions(+), 39 deletions(-) diff --git a/tests/client/full-t.in b/tests/client/full-t.in index 3240563..a4ca19d 100644 --- a/tests/client/full-t.in +++ b/tests/client/full-t.in @@ -1,23 +1,23 @@ #!/usr/bin/perl -w # -# tests/client/full-t -- End-to-end tests for the wallet client. +# End-to-end tests for the wallet client. # # Written by Russ Allbery -# Copyright 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008, 2010 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. # Point to our server configuration. This must be done before Wallet::Config # is loaded, and it's pulled in as a prerequisite for Wallet::Admin. -BEGIN { $ENV{WALLET_CONFIG} = '@abs_top_srcdir@/tests/data/wallet.conf' } +BEGIN { $ENV{WALLET_CONFIG} = "$ENV{SOURCE}/data/wallet.conf" } BEGIN { our $total = 53 } use Test::More tests => $total; -use lib '@abs_top_srcdir@/perl'; +use lib "$ENV{SOURCE}/../perl"; use Wallet::Admin; -use lib '@abs_top_srcdir@/perl/t/lib'; +use lib "$ENV{SOURCE}/../perl/t/lib"; use Util; # Make a call to the wallet client. Takes the principal used by the server @@ -33,9 +33,9 @@ sub wallet { or die "cannot create wallet.out: $!\n"; open (STDERR, '>', 'wallet.err') or die "cannot create wallet.err: $!\n"; - exec ('@abs_top_builddir@/client/wallet', '-k', $principal, '-p', + exec ("$ENV{BUILD}/../client/wallet", '-k', $principal, '-p', '14373', '-s', 'localhost', @command) - or die "cannot run @abs_top_builddir@/client/wallet: $!\n"; + or die "cannot run $ENV{BUILD}/client/wallet: $!\n"; } else { waitpid ($pid, 0); } @@ -53,19 +53,19 @@ sub wallet { SKIP: { skip 'no keytab configuration', $total - unless -f '@abs_top_builddir@/tests/data/test.keytab'; + unless -f "$ENV{BUILD}/data/test.keytab"; my $remctld = '@REMCTLD@'; skip 'remctld not found', $total unless $remctld; # Spawn remctld and get local tickets. Don't destroy the user's Kerberos # ticket cache. unlink ('krb5cc_test', 'test-pid'); - my $principal = contents ('@abs_top_builddir@/tests/data/test.principal'); + my $principal = contents ("$ENV{BUILD}/data/test.principal"); remctld_spawn ($remctld, $principal, '@abs_top_builddir@/tests/data/test.keytab', '@abs_top_builddir@/tests/data/full.conf'); $ENV{KRB5CCNAME} = 'krb5cc_test'; - getcreds ('@abs_top_builddir@/tests/data/test.keytab', $principal); + getcreds ("$ENV{BUILD}/data/test.keytab", $principal); # Use Wallet::Admin to set up the database. db_setup; diff --git a/tests/client/pod-t.in b/tests/client/pod-t.in index db995f7..9963567 100644 --- a/tests/client/pod-t.in +++ b/tests/client/pod-t.in @@ -3,7 +3,7 @@ # Test POD formatting for client documentation. # # Written by Russ Allbery -# Copyright 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008, 2010 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -17,6 +17,6 @@ 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 ("@abs_top_srcdir@/client/$file", "client/$file"); + pod_file_ok ("$ENV{SOURCE}/../client/$file", "client/$file"); } } diff --git a/tests/client/prompt-t.in b/tests/client/prompt-t.in index 7988fc9..e037b3f 100644 --- a/tests/client/prompt-t.in +++ b/tests/client/prompt-t.in @@ -1,28 +1,27 @@ #!/usr/bin/perl -w # -# tests/client/prompt-t -- Password prompting tests for the wallet client. +# Password prompting tests for the wallet client. # # Written by Russ Allbery -# Copyright 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008, 2010 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. BEGIN { our $total = 5 } use Test::More tests => $total; -use lib '@abs_top_srcdir@/perl'; +use lib "$ENV{SOURCE}/..//perl"; use Wallet::Admin; -use lib '@abs_top_srcdir@/perl/t/lib'; +use lib "$ENV{SOURCE}/../perl/t/lib"; use Util; # cd to the correct directory. -chdir '@abs_top_srcdir@/tests' - or die "Cannot chdir to @abs_top_srcdir@/tests: $!\n"; +chdir "$ENV{SOURCE}" or die "Cannot chdir to $ENV{SOURCE}: $!\n"; SKIP: { skip 'no password configuration', $total - unless -f '@abs_top_builddir@/tests/data/test.password'; + unless -f "$ENV{BUILD}/data/test.password"; my $remctld = '@REMCTLD@'; skip 'remctld not found', $total unless $remctld; eval { require Expect }; @@ -35,22 +34,21 @@ SKIP: { # Spawn remctld and set up with a different ticket cache. unlink ('krb5cc_test', 'test-pid'); - my $principal = contents ('@abs_top_builddir@/tests/data/test.principal'); - remctld_spawn ($remctld, $principal, - '@abs_top_builddir@/tests/data/test.keytab', - '@abs_top_builddir@/tests/data/basic.conf'); + my $principal = contents ("$ENV{BUILD}/data/test.principal"); + remctld_spawn ($remctld, $principal, "$ENV{BUILD}/data/test.keytab", + "$ENV{BUILD}/data/basic.conf"); $ENV{KRB5CCNAME} = 'krb5cc_test'; # Read in the principal and password. - open (PASS, '<', '@abs_top_builddir@/tests/data/test.password') - or die "Cannot open @abs_top_builddir@/tests/data/test.password: $!\n"; + open (PASS, '<', "$ENV{BUILD}/data/test.password") + or die "Cannot open $ENV{BUILD}/data/test.password: $!\n"; my $user = ; my $password = ; close PASS; chomp ($user, $password); # Spawn wallet and check an invalid password. - my $wallet = Expect->spawn ('@abs_top_builddir@/client/wallet', '-k', + my $wallet = Expect->spawn ("$ENV{BUILD}/../client/wallet", '-k', $principal, '-p', 14373, '-s', 'localhost', '-c', 'fake-wallet', '-u', $user, 'get', 'keytab', 'service/fake-output'); @@ -61,7 +59,7 @@ SKIP: { $wallet->soft_close; # Now check a valid password. - $wallet = Expect->spawn ('@abs_top_builddir@/client/wallet', '-k', + $wallet = Expect->spawn ("$ENV{BUILD}/../client/wallet", '-k', $principal, '-p', 14373, '-s', 'localhost', '-c', 'fake-wallet', '-u', $user, 'get', 'keytab', 'service/fake-output'); diff --git a/tests/server/admin-t.in b/tests/server/admin-t.in index 11d2883..570dc52 100644 --- a/tests/server/admin-t.in +++ b/tests/server/admin-t.in @@ -3,7 +3,7 @@ # Tests for the wallet-admin dispatch code. # # Written by Russ Allbery -# 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. @@ -82,7 +82,7 @@ sub report_owners { # Wallet::Admin package has already been loaded. package main; $INC{'Wallet/Admin.pm'} = 'FAKE'; -eval { do '@abs_top_srcdir@/server/wallet-admin' }; +eval { do "$ENV{SOURCE}/../server/wallet-admin" }; # Run the wallet admin client. This fun hack takes advantage of the fact that # the wallet admin client is written in Perl so that we can substitute our own diff --git a/tests/server/backend-t.in b/tests/server/backend-t.in index 0c6ac60..2fc6a53 100644 --- a/tests/server/backend-t.in +++ b/tests/server/backend-t.in @@ -3,7 +3,7 @@ # Tests for the wallet-backend dispatch code. # # Written by Russ Allbery -# Copyright 2006, 2007, 2008, 2009 +# Copyright 2006, 2007, 2008, 2009, 2010 # Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -163,7 +163,7 @@ package main; $INC{'Wallet/Server.pm'} = 'FAKE'; my $OUTPUT; our $SYSLOG = \$OUTPUT; -eval { do '@abs_top_srcdir@/server/wallet-backend' }; +eval { do "$ENV{SOURCE}/../server/wallet-backend" }; # Run the wallet backend. This fun hack takes advantage of the fact that the # wallet backend is written in Perl so that we can substitute our own diff --git a/tests/server/keytab-t.in b/tests/server/keytab-t.in index f74267d..2a0ceed 100644 --- a/tests/server/keytab-t.in +++ b/tests/server/keytab-t.in @@ -1,10 +1,9 @@ #!/usr/bin/perl -w -# $Id: backend-t.in 3547 2007-09-14 23:18:48Z rra $ # # Tests for the keytab-backend dispatch code. # # Written by Russ Allbery -# Copyright 2006, 2007 Board of Trustees, Leland Stanford Jr. University +# Copyright 2006, 2007, 2010 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -16,9 +15,9 @@ use Test::More tests => 63; # Load the keytab-backend code and override various settings. my $OUTPUT; $SYSLOG = \$OUTPUT; -eval { do '@abs_top_srcdir@/server/keytab-backend' }; -$CONFIG = '@abs_top_srcdir@/tests/data/allow-extract'; -$KADMIN = '@abs_top_srcdir@/tests/data/fake-kadmin'; +eval { do "$ENV{SOURCE}/../server/keytab-backend" }; +$CONFIG = "$ENV{SOURCE}/data/allow-extract"; +$KADMIN = "$ENV{SOURCE}/data/fake-kadmin"; $TMP = '.'; # Run the keytab backend. diff --git a/tests/server/pod-t.in b/tests/server/pod-t.in index 4575ecb..52d81eb 100644 --- a/tests/server/pod-t.in +++ b/tests/server/pod-t.in @@ -1,9 +1,9 @@ #!/usr/bin/perl # -# tests/server/pod-t -- Test POD formatting for client documentation. +# Test POD formatting for client documentation. # # Written by Russ Allbery -# Copyright 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008, 2010 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -17,6 +17,6 @@ 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 ("@abs_top_srcdir@/server/$file", "server/$file"); + pod_file_ok ("$ENV{SOURCE}/../server/$file", "server/$file"); } } -- cgit v1.2.3 From a556c732806da87d06bb787565e12240ea39b553 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 9 Feb 2010 21:01:33 -0800 Subject: Stop doing Autoconf substitution on some test suite code Anything that only was using substitution for the paths to the build tree now uses $SOURCE and $BUILD instead. Stop doing substitution. Also fix tests/data/cmd-wrapper to use the environment variables. --- .gitignore | 7 - configure.ac | 6 - tests/client/pod-t | 22 ++ tests/client/pod-t.in | 22 -- tests/data/cmd-wrapper | 8 + tests/data/cmd-wrapper.in | 9 - tests/server/admin-t | 241 ++++++++++++++++++++++ tests/server/admin-t.in | 241 ---------------------- tests/server/backend-t | 502 ++++++++++++++++++++++++++++++++++++++++++++++ tests/server/backend-t.in | 502 ---------------------------------------------- tests/server/keytab-t | 88 ++++++++ tests/server/keytab-t.in | 88 -------- tests/server/pod-t | 22 ++ tests/server/pod-t.in | 22 -- 14 files changed, 883 insertions(+), 897 deletions(-) create mode 100755 tests/client/pod-t delete mode 100644 tests/client/pod-t.in create mode 100755 tests/data/cmd-wrapper delete mode 100644 tests/data/cmd-wrapper.in create mode 100755 tests/server/admin-t delete mode 100644 tests/server/admin-t.in create mode 100755 tests/server/backend-t delete mode 100644 tests/server/backend-t.in create mode 100755 tests/server/keytab-t delete mode 100644 tests/server/keytab-t.in create mode 100755 tests/server/pod-t delete mode 100644 tests/server/pod-t.in diff --git a/.gitignore b/.gitignore index 09ae109..b0a49df 100644 --- a/.gitignore +++ b/.gitignore @@ -18,15 +18,12 @@ /perl/t/data/test.krbtype /tests/client/basic-t /tests/client/full-t -/tests/client/pod-t /tests/client/prompt-t -/tests/data/cmd-wrapper /tests/data/full.conf /tests/data/test.keytab /tests/data/test.password /tests/data/test.principal /tests/data/test.krbtype -/tests/kasetkey/basic-t /tests/portable/asprintf-t /tests/portable/mkstemp-t /tests/portable/setenv-t @@ -34,10 +31,6 @@ /tests/portable/strlcat-t /tests/portable/strlcpy-t /tests/runtests -/tests/server/admin-t -/tests/server/backend-t -/tests/server/keytab-t -/tests/server/pod-t /tests/util/concat-t /tests/util/messages-krb5-t /tests/util/messages-t diff --git a/configure.ac b/configure.ac index c897775..664c6f7 100644 --- a/configure.ac +++ b/configure.ac @@ -64,11 +64,5 @@ AC_CONFIG_HEADER([config.h]) AC_CONFIG_FILES([Makefile perl/Makefile.PL tests/data/full.conf]) AC_CONFIG_FILES([tests/client/basic-t], [chmod +x tests/client/basic-t]) AC_CONFIG_FILES([tests/client/full-t], [chmod +x tests/client/full-t]) -AC_CONFIG_FILES([tests/client/pod-t], [chmod +x tests/client/pod-t]) AC_CONFIG_FILES([tests/client/prompt-t], [chmod +x tests/client/prompt-t]) -AC_CONFIG_FILES([tests/data/cmd-wrapper], [chmod +x tests/data/cmd-wrapper]) -AC_CONFIG_FILES([tests/server/admin-t], [chmod +x tests/server/admin-t]) -AC_CONFIG_FILES([tests/server/backend-t], [chmod +x tests/server/backend-t]) -AC_CONFIG_FILES([tests/server/keytab-t], [chmod +x tests/server/keytab-t]) -AC_CONFIG_FILES([tests/server/pod-t], [chmod +x tests/server/pod-t]) AC_OUTPUT diff --git a/tests/client/pod-t b/tests/client/pod-t new file mode 100755 index 0000000..9963567 --- /dev/null +++ b/tests/client/pod-t @@ -0,0 +1,22 @@ +#!/usr/bin/perl +# +# Test POD formatting for client documentation. +# +# Written by Russ Allbery +# 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/client/pod-t.in b/tests/client/pod-t.in deleted file mode 100644 index 9963567..0000000 --- a/tests/client/pod-t.in +++ /dev/null @@ -1,22 +0,0 @@ -#!/usr/bin/perl -# -# Test POD formatting for client documentation. -# -# Written by Russ Allbery -# 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/data/cmd-wrapper b/tests/data/cmd-wrapper new file mode 100755 index 0000000..79b1943 --- /dev/null +++ b/tests/data/cmd-wrapper @@ -0,0 +1,8 @@ +#!/bin/sh +# +# Wrapper around the standard wallet-backend script that sets the Perl INC +# path and the WALLET_CONFIG environment variable appropriately. + +WALLET_CONFIG="$SOURCE/data/wallet.conf" +export WALLET_CONFIG +exec perl -I"$SOURCE/../perl" "$SOURCE/../server/wallet-backend" -q "$@" diff --git a/tests/data/cmd-wrapper.in b/tests/data/cmd-wrapper.in deleted file mode 100644 index 7c7b342..0000000 --- a/tests/data/cmd-wrapper.in +++ /dev/null @@ -1,9 +0,0 @@ -#!/bin/sh -# -# Wrapper around the standard wallet-backend script that sets the Perl INC -# path and the WALLET_CONFIG environment variable appropriately. - -WALLET_CONFIG='@abs_top_srcdir@/tests/data/wallet.conf' -export WALLET_CONFIG -exec perl -I'@abs_top_srcdir@/perl' '@abs_top_srcdir@/server/wallet-backend' \ - -q "$@" diff --git a/tests/server/admin-t b/tests/server/admin-t new file mode 100755 index 0000000..570dc52 --- /dev/null +++ b/tests/server/admin-t @@ -0,0 +1,241 @@ +#!/usr/bin/perl -w +# +# Tests for the wallet-admin dispatch code. +# +# Written by Russ Allbery +# Copyright 2008, 2009, 2010 Board of Trustees, Leland Stanford Jr. University +# +# See LICENSE for licensing terms. + +use strict; +use Test::More tests => 64; + +# Create a dummy class for Wallet::Admin that prints what method was called +# with its arguments and returns data for testing. +package Wallet::Admin; + +use vars qw($empty $error); +$error = 0; +$empty = 0; + +sub error { + if ($error) { + return "some error"; + } else { + return; + } +} + +sub new { + print "new\n"; + return bless ({}, 'Wallet::Admin'); +} + +sub destroy { + print "destroy\n"; + return if $error; + return 1; +} + +sub initialize { + shift; + print "initialize @_\n"; + return if $error; + return 1; +} + +sub list_objects { + print "list_objects\n"; + return if ($error or $empty); + return ([ keytab => 'host/windlord.stanford.edu' ], + [ file => 'unix-wallet-password' ]); +} + +sub list_acls { + print "list_acls\n"; + return if ($error or $empty); + return ([ 1, 'ADMIN' ], [ 2, 'group/admins' ], [ 4, 'group/users' ]); +} + +sub register_object { + shift; + print "register_object @_\n"; + return if $error; + return 1; +} + +sub register_verifier { + shift; + print "register_verifier @_\n"; + return if $error; + return 1; +} + +sub report_owners { + shift; + print "report_owners @_\n"; + return if ($error or $empty); + return ([ krb5 => 'admin@EXAMPLE.COM' ]); +} + +# Back to the main package and the actual test suite. Lie about whether the +# Wallet::Admin package has already been loaded. +package main; +$INC{'Wallet/Admin.pm'} = 'FAKE'; +eval { do "$ENV{SOURCE}/../server/wallet-admin" }; + +# Run the wallet admin client. This fun hack takes advantage of the fact that +# the wallet admin client is written in Perl so that we can substitute our own +# Wallet::Admin class. +sub run_admin { + my (@args) = @_; + my $result = ''; + open (OUTPUT, '>', \$result) or die "cannot create output string: $!\n"; + select OUTPUT; + local $| = 1; + eval { command (@args) }; + my $error = $@; + select STDOUT; + return ($result, $error); +} + +# Now for the actual tests. First check for unknown commands. +my ($out, $err) = run_admin ('foo'); +is ($err, "unknown command foo\n", 'Unknown command'); +is ($out, "new\n", ' and nothing ran'); + +# Check too few and too many arguments for every command. +my %commands = (destroy => [0, 0], + initialize => [1, 1], + list => [1, 4], + register => [3, 3], + report => [1, -1]); +for my $command (sort keys %commands) { + my ($min, $max) = @{ $commands{$command} }; + if ($min > 0) { + ($out, $err) = run_admin ($command, ('foo') x ($min - 1)); + is ($err, "too few arguments to $command\n", + "Too few arguments for $command"); + is ($out, "new\n", ' and nothing ran'); + } + if ($max >= 0) { + ($out, $err) = run_admin ($command, ('foo') x ($max + 1)); + is ($err, "too many arguments to $command\n", + "Too many arguments for $command"); + is ($out, "new\n", ' and nothing ran'); + } +} + +# Test destroy. +my $answer = ''; +close STDIN; +open (STDIN, '<', \$answer) or die "cannot reopen standard input: $!\n"; +($out, $err) = run_admin ('destroy'); +is ($err, "Aborted\n", 'Destroy with no answer aborts'); +is ($out, "new\n" . + 'This will delete all data in the wallet database. Are you sure (N/y)? ', + ' and prints the right prompt'); +seek (STDIN, 0, 0); +$answer = 'n'; +($out, $err) = run_admin ('destroy'); +is ($err, "Aborted\n", 'Destroy with negative answer answer aborts'); +is ($out, "new\n" . + 'This will delete all data in the wallet database. Are you sure (N/y)? ', + ' and prints the right prompt'); +seek (STDIN, 0, 0); +$answer = 'y'; +($out, $err) = run_admin ('destroy'); +is ($err, '', 'Destroy succeeds with a positive answer'); +is ($out, "new\n" + . 'This will delete all data in the wallet database.' + . ' Are you sure (N/y)? ' . "destroy\n", ' and destroy was run'); +seek (STDIN, 0, 0); + +# Test initialize. +($out, $err) = run_admin ('initialize', 'rra'); +is ($err, "invalid admin principal rra\n", 'Initialize requires a principal'); +is ($out, "new\n", ' and nothing was run'); +($out, $err) = run_admin ('initialize', 'rra@stanford.edu'); +is ($err, '', 'Initialize succeeds with a principal'); +is ($out, "new\ninitialize rra\@stanford.edu\n", ' and runs the right code'); + +# Test list. +($out, $err) = run_admin ('list', 'foo'); +is ($err, "only objects or acls are supported for list\n", + 'List requires a known object'); +is ($out, "new\n", ' and nothing was run'); +($out, $err) = run_admin ('list', 'objects'); +is ($err, '', 'List succeeds for objects'); +is ($out, "new\nlist_objects\n" + . "keytab host/windlord.stanford.edu\nfile unix-wallet-password\n", + ' and returns the right output'); +($out, $err) = run_admin ('list', 'acls'); +is ($err, '', 'List succeeds for ACLs'); +is ($out, "new\nlist_acls\n" + . "ADMIN (ACL ID: 1)\ngroup/admins (ACL ID: 2)\ngroup/users (ACL ID: 4)\n", + ' and returns the right output'); + +# Test register. +($out, $err) = run_admin ('register', 'foo', 'foo', 'Foo::Bar'); +is ($err, "only object or verifier is supported for register\n", + 'Register requires object or verifier'); +is ($out, "new\n", ' and nothing was run'); +($out, $err) = run_admin ('register', 'object', 'foo', 'Foo::Object'); +is ($err, '', 'Register succeeds for object'); +is ($out, "new\nregister_object foo Foo::Object\n", + ' and returns the right outout'); +($out, $err) = run_admin ('register', 'verifier', 'foo', 'Foo::Verifier'); +is ($err, '', 'Register succeeds for verifier'); +is ($out, "new\nregister_verifier foo Foo::Verifier\n", + ' and returns the right outout'); + +# Test report. +($out, $err) = run_admin ('report', 'foo'); +is ($err, "unknown report type foo\n", 'Report requires a known report'); +is ($out, "new\n", ' and nothing was run'); +($out, $err) = run_admin ('report', 'owners', '%', '%'); +is ($err, '', 'Report succeeds for owners'); +is ($out, "new\nreport_owners % %\nkrb5 admin\@EXAMPLE.COM\n", + ' and returns the right output'); + +# Test error handling. +$Wallet::Admin::error = 1; +($out, $err) = run_admin ('destroy'); +is ($err, "some error\n", 'Error handling succeeds for destroy'); +is ($out, "new\n" + . 'This will delete all data in the wallet database.' + . ' Are you sure (N/y)? ' . "destroy\n", ' and calls the right methods'); +($out, $err) = run_admin ('initialize', 'rra@stanford.edu'); +is ($err, "some error\n", 'Error handling succeeds for initialize'); +is ($out, "new\ninitialize rra\@stanford.edu\n", + ' and calls the right methods'); +($out, $err) = run_admin ('list', 'objects'); +is ($err, "some error\n", 'Error handling succeeds for list objects'); +is ($out, "new\nlist_objects\n", ' and calls the right methods'); +($out, $err) = run_admin ('list', 'acls'); +is ($err, "some error\n", 'Error handling succeeds for list acls'); +is ($out, "new\nlist_acls\n", ' and calls the right methods'); +($out, $err) = run_admin ('register', 'object', 'foo', 'Foo::Object'); +is ($err, "some error\n", 'Error handling succeeds for register object'); +is ($out, "new\nregister_object foo Foo::Object\n", + ' and calls the right methods'); +($out, $err) = run_admin ('register', 'verifier', 'foo', 'Foo::Verifier'); +is ($err, "some error\n", 'Error handling succeeds for register verifier'); +is ($out, "new\nregister_verifier foo Foo::Verifier\n", + ' and calls the right methods'); +($out, $err) = run_admin ('report', 'owners', 'foo', 'bar'); +is ($err, "some error\n", 'Error handling succeeds for report owners'); +is ($out, "new\nreport_owners foo bar\n", ' and calls the right methods'); + +# Test empty lists. +$Wallet::Admin::error = 0; +$Wallet::Admin::empty = 1; +($out, $err) = run_admin ('list', 'objects'); +is ($err, '', 'list objects runs with an empty list with no errors'); +is ($out, "new\nlist_objects\n", ' and calls the right methods'); +($out, $err) = run_admin ('list', 'acls'); +is ($err, '', 'list acls runs with an empty list and no errors'); +is ($out, "new\nlist_acls\n", ' and calls the right methods'); +($out, $err) = run_admin ('report', 'owners', 'foo', 'bar'); +is ($err, '', 'report owners runs with an empty list and no errors'); +is ($out, "new\nreport_owners foo bar\n", ' and calls the right methods'); diff --git a/tests/server/admin-t.in b/tests/server/admin-t.in deleted file mode 100644 index 570dc52..0000000 --- a/tests/server/admin-t.in +++ /dev/null @@ -1,241 +0,0 @@ -#!/usr/bin/perl -w -# -# Tests for the wallet-admin dispatch code. -# -# Written by Russ Allbery -# Copyright 2008, 2009, 2010 Board of Trustees, Leland Stanford Jr. University -# -# See LICENSE for licensing terms. - -use strict; -use Test::More tests => 64; - -# Create a dummy class for Wallet::Admin that prints what method was called -# with its arguments and returns data for testing. -package Wallet::Admin; - -use vars qw($empty $error); -$error = 0; -$empty = 0; - -sub error { - if ($error) { - return "some error"; - } else { - return; - } -} - -sub new { - print "new\n"; - return bless ({}, 'Wallet::Admin'); -} - -sub destroy { - print "destroy\n"; - return if $error; - return 1; -} - -sub initialize { - shift; - print "initialize @_\n"; - return if $error; - return 1; -} - -sub list_objects { - print "list_objects\n"; - return if ($error or $empty); - return ([ keytab => 'host/windlord.stanford.edu' ], - [ file => 'unix-wallet-password' ]); -} - -sub list_acls { - print "list_acls\n"; - return if ($error or $empty); - return ([ 1, 'ADMIN' ], [ 2, 'group/admins' ], [ 4, 'group/users' ]); -} - -sub register_object { - shift; - print "register_object @_\n"; - return if $error; - return 1; -} - -sub register_verifier { - shift; - print "register_verifier @_\n"; - return if $error; - return 1; -} - -sub report_owners { - shift; - print "report_owners @_\n"; - return if ($error or $empty); - return ([ krb5 => 'admin@EXAMPLE.COM' ]); -} - -# Back to the main package and the actual test suite. Lie about whether the -# Wallet::Admin package has already been loaded. -package main; -$INC{'Wallet/Admin.pm'} = 'FAKE'; -eval { do "$ENV{SOURCE}/../server/wallet-admin" }; - -# Run the wallet admin client. This fun hack takes advantage of the fact that -# the wallet admin client is written in Perl so that we can substitute our own -# Wallet::Admin class. -sub run_admin { - my (@args) = @_; - my $result = ''; - open (OUTPUT, '>', \$result) or die "cannot create output string: $!\n"; - select OUTPUT; - local $| = 1; - eval { command (@args) }; - my $error = $@; - select STDOUT; - return ($result, $error); -} - -# Now for the actual tests. First check for unknown commands. -my ($out, $err) = run_admin ('foo'); -is ($err, "unknown command foo\n", 'Unknown command'); -is ($out, "new\n", ' and nothing ran'); - -# Check too few and too many arguments for every command. -my %commands = (destroy => [0, 0], - initialize => [1, 1], - list => [1, 4], - register => [3, 3], - report => [1, -1]); -for my $command (sort keys %commands) { - my ($min, $max) = @{ $commands{$command} }; - if ($min > 0) { - ($out, $err) = run_admin ($command, ('foo') x ($min - 1)); - is ($err, "too few arguments to $command\n", - "Too few arguments for $command"); - is ($out, "new\n", ' and nothing ran'); - } - if ($max >= 0) { - ($out, $err) = run_admin ($command, ('foo') x ($max + 1)); - is ($err, "too many arguments to $command\n", - "Too many arguments for $command"); - is ($out, "new\n", ' and nothing ran'); - } -} - -# Test destroy. -my $answer = ''; -close STDIN; -open (STDIN, '<', \$answer) or die "cannot reopen standard input: $!\n"; -($out, $err) = run_admin ('destroy'); -is ($err, "Aborted\n", 'Destroy with no answer aborts'); -is ($out, "new\n" . - 'This will delete all data in the wallet database. Are you sure (N/y)? ', - ' and prints the right prompt'); -seek (STDIN, 0, 0); -$answer = 'n'; -($out, $err) = run_admin ('destroy'); -is ($err, "Aborted\n", 'Destroy with negative answer answer aborts'); -is ($out, "new\n" . - 'This will delete all data in the wallet database. Are you sure (N/y)? ', - ' and prints the right prompt'); -seek (STDIN, 0, 0); -$answer = 'y'; -($out, $err) = run_admin ('destroy'); -is ($err, '', 'Destroy succeeds with a positive answer'); -is ($out, "new\n" - . 'This will delete all data in the wallet database.' - . ' Are you sure (N/y)? ' . "destroy\n", ' and destroy was run'); -seek (STDIN, 0, 0); - -# Test initialize. -($out, $err) = run_admin ('initialize', 'rra'); -is ($err, "invalid admin principal rra\n", 'Initialize requires a principal'); -is ($out, "new\n", ' and nothing was run'); -($out, $err) = run_admin ('initialize', 'rra@stanford.edu'); -is ($err, '', 'Initialize succeeds with a principal'); -is ($out, "new\ninitialize rra\@stanford.edu\n", ' and runs the right code'); - -# Test list. -($out, $err) = run_admin ('list', 'foo'); -is ($err, "only objects or acls are supported for list\n", - 'List requires a known object'); -is ($out, "new\n", ' and nothing was run'); -($out, $err) = run_admin ('list', 'objects'); -is ($err, '', 'List succeeds for objects'); -is ($out, "new\nlist_objects\n" - . "keytab host/windlord.stanford.edu\nfile unix-wallet-password\n", - ' and returns the right output'); -($out, $err) = run_admin ('list', 'acls'); -is ($err, '', 'List succeeds for ACLs'); -is ($out, "new\nlist_acls\n" - . "ADMIN (ACL ID: 1)\ngroup/admins (ACL ID: 2)\ngroup/users (ACL ID: 4)\n", - ' and returns the right output'); - -# Test register. -($out, $err) = run_admin ('register', 'foo', 'foo', 'Foo::Bar'); -is ($err, "only object or verifier is supported for register\n", - 'Register requires object or verifier'); -is ($out, "new\n", ' and nothing was run'); -($out, $err) = run_admin ('register', 'object', 'foo', 'Foo::Object'); -is ($err, '', 'Register succeeds for object'); -is ($out, "new\nregister_object foo Foo::Object\n", - ' and returns the right outout'); -($out, $err) = run_admin ('register', 'verifier', 'foo', 'Foo::Verifier'); -is ($err, '', 'Register succeeds for verifier'); -is ($out, "new\nregister_verifier foo Foo::Verifier\n", - ' and returns the right outout'); - -# Test report. -($out, $err) = run_admin ('report', 'foo'); -is ($err, "unknown report type foo\n", 'Report requires a known report'); -is ($out, "new\n", ' and nothing was run'); -($out, $err) = run_admin ('report', 'owners', '%', '%'); -is ($err, '', 'Report succeeds for owners'); -is ($out, "new\nreport_owners % %\nkrb5 admin\@EXAMPLE.COM\n", - ' and returns the right output'); - -# Test error handling. -$Wallet::Admin::error = 1; -($out, $err) = run_admin ('destroy'); -is ($err, "some error\n", 'Error handling succeeds for destroy'); -is ($out, "new\n" - . 'This will delete all data in the wallet database.' - . ' Are you sure (N/y)? ' . "destroy\n", ' and calls the right methods'); -($out, $err) = run_admin ('initialize', 'rra@stanford.edu'); -is ($err, "some error\n", 'Error handling succeeds for initialize'); -is ($out, "new\ninitialize rra\@stanford.edu\n", - ' and calls the right methods'); -($out, $err) = run_admin ('list', 'objects'); -is ($err, "some error\n", 'Error handling succeeds for list objects'); -is ($out, "new\nlist_objects\n", ' and calls the right methods'); -($out, $err) = run_admin ('list', 'acls'); -is ($err, "some error\n", 'Error handling succeeds for list acls'); -is ($out, "new\nlist_acls\n", ' and calls the right methods'); -($out, $err) = run_admin ('register', 'object', 'foo', 'Foo::Object'); -is ($err, "some error\n", 'Error handling succeeds for register object'); -is ($out, "new\nregister_object foo Foo::Object\n", - ' and calls the right methods'); -($out, $err) = run_admin ('register', 'verifier', 'foo', 'Foo::Verifier'); -is ($err, "some error\n", 'Error handling succeeds for register verifier'); -is ($out, "new\nregister_verifier foo Foo::Verifier\n", - ' and calls the right methods'); -($out, $err) = run_admin ('report', 'owners', 'foo', 'bar'); -is ($err, "some error\n", 'Error handling succeeds for report owners'); -is ($out, "new\nreport_owners foo bar\n", ' and calls the right methods'); - -# Test empty lists. -$Wallet::Admin::error = 0; -$Wallet::Admin::empty = 1; -($out, $err) = run_admin ('list', 'objects'); -is ($err, '', 'list objects runs with an empty list with no errors'); -is ($out, "new\nlist_objects\n", ' and calls the right methods'); -($out, $err) = run_admin ('list', 'acls'); -is ($err, '', 'list acls runs with an empty list and no errors'); -is ($out, "new\nlist_acls\n", ' and calls the right methods'); -($out, $err) = run_admin ('report', 'owners', 'foo', 'bar'); -is ($err, '', 'report owners runs with an empty list and no errors'); -is ($out, "new\nreport_owners foo bar\n", ' and calls the right methods'); diff --git a/tests/server/backend-t b/tests/server/backend-t new file mode 100755 index 0000000..2fc6a53 --- /dev/null +++ b/tests/server/backend-t @@ -0,0 +1,502 @@ +#!/usr/bin/perl -w +# +# Tests for the wallet-backend dispatch code. +# +# Written by Russ Allbery +# Copyright 2006, 2007, 2008, 2009, 2010 +# Board of Trustees, Leland Stanford Jr. University +# +# See LICENSE for licensing terms. + +use strict; +use Test::More tests => 1263; + +# Create a dummy class for Wallet::Server that prints what method was called +# with its arguments and returns data for testing. +package Wallet::Server; + +use vars qw($error $okay); +$error = 0; +$okay = 0; + +sub error { + if ($okay) { + $okay = 0; + return; + } else { + $error++; + return "error count $error"; + } +} + +sub new { shift; print "new @_\n"; return bless ({}, 'Wallet::Server') } +sub create { shift; print "create @_\n"; ($_[0] eq 'error') ? undef : 1 } +sub destroy { shift; print "destroy @_\n"; ($_[0] eq 'error') ? undef : 1 } +sub store { shift; print "store @_\n"; ($_[0] eq 'error') ? undef : 1 } + +sub acl_add + { shift; print "acl_add @_\n"; ($_[0] eq 'error') ? undef : 1 } +sub acl_create + { shift; print "acl_create @_\n"; ($_[0] eq 'error') ? undef : 1 } +sub acl_destroy + { shift; print "acl_destroy @_\n"; ($_[0] eq 'error') ? undef : 1 } +sub acl_remove + { shift; print "acl_remove @_\n"; ($_[0] eq 'error') ? undef : 1 } +sub acl_rename + { shift; print "acl_rename @_\n"; ($_[0] eq 'error') ? undef : 1 } + +sub acl_history { + shift; + print "acl_history @_\n"; + return if $_[0] eq 'error'; + return 'acl_history'; +} + +sub acl_show { + shift; + print "acl_show @_\n"; + return if $_[0] eq 'error'; + return 'acl_show'; +} + +sub flag_clear + { shift; print "flag_clear @_\n"; ($_[0] eq 'error') ? undef : 1 } +sub flag_set + { shift; print "flag_set @_\n"; ($_[0] eq 'error') ? undef : 1 } + +sub acl { + shift; + print "acl @_\n"; + if ($_[0] eq 'error') { + return; + } elsif ($_[1] eq 'empty') { + $okay = 1; + return; + } else { + return 'acl'; + } +} + +sub attr { + shift; + print "attr @_\n"; + if ($_[0] eq 'error') { + return; + } elsif ($_[1] eq 'empty') { + $okay = 1; + return; + } elsif (@_ == 3) { + return ('attr1', 'attr2'); + } else { + return 'attr'; + } +} + +sub autocreate { + shift; + print "autocreate @_\n"; + return ($_[0] eq 'error') ? undef : 1 +} + +sub check { + shift; + print "check @_\n"; + if ($_[0] eq 'error') { + return; + } elsif ($_[1] eq 'empty') { + return 0; + } else { + return 1; + } +} + +sub expires { + shift; + print "expires @_\n"; + if ($_[0] eq 'error') { + return; + } elsif ($_[1] eq 'empty') { + $okay = 1; + return; + } else { + return 'expires'; + } +} + +sub get { + shift; + print "get @_\n"; + return if $_[0] eq 'error'; + return 'get'; +} + +sub history { + shift; + print "history @_\n"; + return if $_[0] eq 'error'; + return 'history'; +} + +sub owner { + shift; + print "owner @_\n"; + if ($_[0] eq 'error') { + return; + } elsif ($_[1] eq 'empty') { + $okay = 1; + return; + } else { + return 'owner'; + } +} + +sub show { + shift; + print "show @_\n"; + return if $_[0] eq 'error'; + return 'show'; +} + +# Back to the main package and the actual test suite. Lie about whether the +# Wallet::Server package has already been loaded. +package main; +$INC{'Wallet/Server.pm'} = 'FAKE'; +my $OUTPUT; +our $SYSLOG = \$OUTPUT; +eval { do "$ENV{SOURCE}/../server/wallet-backend" }; + +# Run the wallet backend. This fun hack takes advantage of the fact that the +# wallet backend is written in Perl so that we can substitute our own +# Wallet::Server class. +sub run_backend { + my (@args) = @_; + my $result = ''; + open (OUTPUT, '>', \$result) or die "cannot create output string: $!\n"; + select OUTPUT; + local $| = 1; + eval { command (@args) }; + my $error = $@; + select STDOUT; + return ($result, $error); +} + +# Now for the actual tests. First, check for lack of trace information. +my ($out, $err) = run_backend; +is ($err, "REMOTE_USER not set\n", 'REMOTE_USER required'); +is ($OUTPUT, "error: REMOTE_USER not set\n", ' and syslog correct'); +$ENV{REMOTE_USER} = 'admin'; +($out, $err) = run_backend; +is ($err, "neither REMOTE_HOST nor REMOTE_ADDR set\n", + 'REMOTE_HOST or _ADDR required'); +is ($OUTPUT, "error for admin: neither REMOTE_HOST nor REMOTE_ADDR set\n", + ' and syslog correct'); +$ENV{REMOTE_ADDR} = '1.2.3.4'; +my $new = 'new admin 1.2.3.4'; + +# Check unknown commands. +($out, $err) = run_backend ('foo'); +is ($err, "unknown command foo\n", 'Unknown command'); +is ($OUTPUT, "error for admin (1.2.3.4): unknown command foo\n", + ' and syslog correct'); +is ($out, "$new\n", ' and nothing ran'); +($out, $err) = run_backend ('acl', 'foo'); +is ($err, "unknown command acl foo\n", 'Unknown ACL command'); +is ($OUTPUT, "error for admin (1.2.3.4): unknown command acl foo\n", + ' and syslog correct'); +is ($out, "$new\n", ' and nothing ran'); +($out, $err) = run_backend ('flag', 'foo', 'service', 'foo', 'foo'); +is ($err, "unknown command flag foo\n", 'Unknown flag command'); +is ($OUTPUT, "error for admin (1.2.3.4): unknown command flag foo\n", + ' and syslog correct'); +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], + create => [2, 2], + destroy => [2, 2], + expires => [2, 4], + get => [2, 2], + getacl => [3, 3], + getattr => [3, 3], + history => [2, 2], + owner => [2, 3], + setacl => [4, 4], + setattr => [4, 9], + show => [2, 2], + store => [3, 3]); +my %acl_commands = (add => [3, 3], + create => [1, 1], + destroy => [1, 1], + history => [1, 1], + remove => [3, 3], + rename => [2, 2], + show => [1, 1]); +my %flag_commands = (clear => [3, 3], + set => [3, 3]); +for my $command (sort keys %commands) { + my ($min, $max) = @{ $commands{$command} }; + ($out, $err) = run_backend ($command, ('foo') x ($min - 1)); + is ($err, "insufficient arguments\n", "Too few arguments for $command"); + is ($OUTPUT, "error for admin (1.2.3.4): insufficient arguments\n", + ' and syslog correct'); + is ($out, "$new\n", ' and nothing ran'); + unless ($max >= 9) { + ($out, $err) = run_backend ($command, ('foo') x ($max + 1)); + is ($err, "too many arguments\n", "Too many arguments for $command"); + is ($OUTPUT, "error for admin (1.2.3.4): too many arguments\n", + ' and syslog correct'); + is ($out, "$new\n", ' and nothing ran'); + } + my @base = ('foobar') x $max; + for my $arg (0 .. ($max - 1)) { + my @args = @base; + $args[$arg] = 'foo;bar'; + ($out, $err) = run_backend ($command, @args); + if ($command eq 'store' and $arg == 2) { + is ($err, '', 'Store allows any characters'); + is ($OUTPUT, "command $command @args[0,1] from admin (1.2.3.4)" + . " succeeded\n", ' and success logged'); + is ($out, "$new\nstore foobar foobar foo;bar\n", + ' and calls the right method'); + } else { + is ($err, "invalid characters in argument: foo;bar\n", + "Invalid arguments for $command $arg"); + is ($OUTPUT, "error for admin (1.2.3.4): invalid characters in" + . " argument: foo;bar\n", ' and syslog correct'); + is ($out, "$new\n", ' and nothing ran'); + } + } +} +for my $command (sort keys %acl_commands) { + my ($min, $max) = @{ $acl_commands{$command} }; + ($out, $err) = run_backend ('acl', $command, ('foo') x ($min - 1)); + is ($err, "insufficient arguments\n", + "Too few arguments for acl $command"); + is ($OUTPUT, "error for admin (1.2.3.4): insufficient arguments\n", + ' and syslog correct'); + is ($out, "$new\n", ' and nothing ran'); + ($out, $err) = run_backend ('acl', $command, ('foo') x ($max + 1)); + is ($err, "too many arguments\n", "Too many arguments for acl $command"); + is ($OUTPUT, "error for admin (1.2.3.4): too many arguments\n", + ' and syslog correct'); + is ($out, "$new\n", ' and nothing ran'); + my @base = ('foobar') x $max; + for my $arg (0 .. ($max - 1)) { + my @args = @base; + $args[$arg] = 'foo;bar'; + ($out, $err) = run_backend ('acl', $command, @args); + is ($err, "invalid characters in argument: foo;bar\n", + "Invalid arguments for acl $command $arg"); + is ($OUTPUT, "error for admin (1.2.3.4): invalid characters in" + . " argument: foo;bar\n", ' and syslog correct'); + is ($out, "$new\n", ' and nothing ran'); + } +} +for my $command (sort keys %flag_commands) { + my ($min, $max) = @{ $flag_commands{$command} }; + ($out, $err) = run_backend ('flag', $command, ('foo') x ($min - 1)); + is ($err, "insufficient arguments\n", + "Too few arguments for flag $command"); + is ($OUTPUT, "error for admin (1.2.3.4): insufficient arguments\n", + ' and syslog correct'); + is ($out, "$new\n", ' and nothing ran'); + ($out, $err) = run_backend ('flag', $command, ('foo') x ($max + 1)); + is ($err, "too many arguments\n", "Too many arguments for flag $command"); + is ($OUTPUT, "error for admin (1.2.3.4): too many arguments\n", + ' and syslog correct'); + is ($out, "$new\n", ' and nothing ran'); + my @base = ('foobar') x $max; + for my $arg (0 .. ($max - 1)) { + my @args = @base; + $args[$arg] = 'foo;bar'; + ($out, $err) = run_backend ('flag', $command, @args); + is ($err, "invalid characters in argument: foo;bar\n", + "Invalid arguments for flag $command $arg"); + is ($OUTPUT, "error for admin (1.2.3.4): invalid characters in" + . " argument: foo;bar\n", ' and syslog correct'); + is ($out, "$new\n", ' and nothing ran'); + } +} + +# Now, test that we ran the right functions and passed the correct arguments. +my $error = 1; +for my $command (qw/autocreate create destroy setacl setattr store/) { + my $method = { setacl => 'acl', setattr => 'attr' }->{$command}; + $method ||= $command; + my @extra = ('foo') x ($commands{$command}[0] - 2); + my $extra = @extra ? join (' ', '', @extra) : ''; + ($out, $err) = run_backend ($command, 'type', 'name', @extra); + my $ran; + if ($command eq 'store') { + $ran = "$command type name"; + } else { + $ran = "$command type name" . (@extra ? " @extra" : ''); + } + is ($err, '', "Command $command ran with no errors"); + is ($OUTPUT, "command $ran from admin (1.2.3.4) succeeded\n", + ' and success logged'); + is ($out, "$new\n$method type name$extra\n", + ' and ran the right method'); + ($out, $err) = run_backend ($command, 'error', 'name', @extra); + if ($command eq 'store') { + $ran = "$command error name"; + } else { + $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'); + is ($out, "$new\n$method error name$extra\n", + ' and ran the right method'); + $error++; +} +for my $command (qw/check expires get getacl getattr history owner show/) { + my $method = { getacl => 'acl', getattr => 'attr' }->{$command}; + $method ||= $command; + my @extra = ('foo') x ($commands{$command}[0] - 2); + my $extra = @extra ? join (' ', '', @extra) : ''; + ($out, $err) = run_backend ($command, 'type', 'name', @extra); + my $ran = "$command type name" . (@extra ? " @extra" : ''); + is ($err, '', "Command $command ran with no errors"); + is ($OUTPUT, "command $ran from admin (1.2.3.4) succeeded\n", + ' and success logged'); + if ($command eq 'getattr') { + is ($out, "$new\n$method type name$extra\nattr1\nattr2\n", + ' and ran the right method with output'); + } elsif ($command eq 'check') { + is ($out, "$new\n$method type name$extra\nyes\n", + ' and ran the right method with output'); + } else { + my $newline = ($command =~ /^(get|history|show)\z/) ? '' : "\n"; + 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') { + ($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)"); + is ($OUTPUT, "command $ran from admin (1.2.3.4) succeeded\n", + ' and success logged'); + 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') { + ($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' } + elsif ($command eq 'getacl') { $desc = 'ACL' } + elsif ($command eq 'owner') { $desc = 'owner' } + is ($out, "$new\n$method type empty$extra\nNo $desc set\n", + ' and ran the right method with output'); + $error++; + } elsif ($command eq 'getattr') { + ($out, $err) = run_backend ($command, 'type', 'empty', @extra); + my $ran = "$command type empty" . (@extra ? " @extra" : ''); + is ($err, '', "Command $command ran with no errors (empty)"); + is ($OUTPUT, "command $ran from admin (1.2.3.4) succeeded\n", + ' and success logged'); + is ($out, "$new\n$method type empty$extra\n", + ' and ran the right method with output'); + $error++; + } elsif ($command eq 'check') { + ($out, $err) = run_backend ($command, 'type', 'empty', @extra); + my $ran = "$command type empty" . (@extra ? " @extra" : ''); + is ($err, '', "Command $command ran with no errors (empty)"); + is ($OUTPUT, "command $ran from admin (1.2.3.4) succeeded\n", + ' and success logged'); + is ($out, "$new\n$method type empty$extra\nno\n", + ' and ran the right method with output'); + } + ($out, $err) = run_backend ($command, 'error', 'name', @extra); + my $ran = "$command error name" . (@extra ? " @extra" : ''); + 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'); + is ($out, "$new\n$method error name$extra\n", + ' and ran the right method'); + $error++; +} +for my $command (sort keys %acl_commands) { + my @extra = ('foo') x ($acl_commands{$command}[0] - 1); + my $extra = @extra ? join (' ', '', @extra) : ''; + ($out, $err) = run_backend ('acl', $command, 'name', @extra); + my $ran = "acl $command name" . (@extra ? " @extra" : ''); + is ($err, '', "Command acl $command ran with no errors"); + is ($OUTPUT, "command $ran from admin (1.2.3.4) succeeded\n", + ' and success logged'); + my $expected; + if ($command eq 'show') { + $expected = "$new\nacl_$command name$extra\nacl_show"; + } elsif ($command eq 'history') { + $expected = "$new\nacl_$command name$extra\nacl_history"; + } else { + $expected = "$new\nacl_$command name$extra\n"; + } + is ($out, $expected, ' and ran the right method'); + ($out, $err) = run_backend ('acl', $command, 'error', @extra); + $ran = "acl $command error" . (@extra ? " @extra" : ''); + is ($err, "error count $error\n", "Command acl $command ran with errors"); + is ($OUTPUT, "command $ran from admin (1.2.3.4) failed: error count" + . " $error\n", ' and syslog correct'); + is ($out, "$new\nacl_$command error$extra\n", + ' and ran the right method'); + $error++; +} +for my $command (sort keys %flag_commands) { + my @extra = ('foo') x ($flag_commands{$command}[0] - 2); + my $extra = @extra ? join (' ', '', @extra) : ''; + ($out, $err) = run_backend ('flag', $command, 'type', 'name', @extra); + my $ran = "flag $command type name" . (@extra ? " @extra" : ''); + is ($err, '', "Command flag $command ran with no errors"); + is ($OUTPUT, "command $ran from admin (1.2.3.4) succeeded\n", + ' and success logged'); + is ($out, "$new\nflag_$command type name$extra\n", + ' and ran the right method'); + ($out, $err) = run_backend ('flag', $command, 'error', 'name', @extra); + $ran = "flag $command error name" . (@extra ? " @extra" : ''); + is ($err, "error count $error\n", + "Command flag $command ran with errors"); + is ($OUTPUT, "command $ran from admin (1.2.3.4) failed: error count" + . " $error\n", ' and syslog correct'); + is ($out, "$new\nflag_$command error name$extra\n", + ' and ran the right method'); + $error++; +} + +# 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. +($out, $err) = run_backend ('show', 'type', ''); +is ($err, '', 'Allowed the empty argument'); +is ($OUTPUT, "command show type from admin (1.2.3.4) succeeded\n", + ' and success logged'); +my $ok = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_/.@-'; +($out, $err) = run_backend ('show', 'type', $ok); +is ($err, '', 'Allowed all valid characters'); +is ($OUTPUT, "command show type $ok from admin (1.2.3.4) succeeded\n", + ' and success logged'); +is ($out, "$new\nshow type $ok\nshow", ' and returned the right output'); +for my $n (0 .. 255) { + my $c = chr ($n); + my $name = $ok . $c; + ($out, $err) = run_backend ('show', 'type', $name); + if (index ($ok, $c) == -1) { + is ($err, "invalid characters in argument: $name\n", + "Rejected invalid character $n"); + my $stripped = $name; + $stripped =~ s/[^\x20-\x7e]/_/g; + is ($OUTPUT, "error for admin (1.2.3.4): invalid characters in" + . " argument: $stripped\n", ' and syslog correct'); + is ($out, "$new\n", ' and did nothing'); + } else { + is ($err, '', "Accepted valid character $n"); + is ($OUTPUT, "command show type $name from admin (1.2.3.4)" + . " succeeded\n", ' and success logged'); + is ($out, "$new\nshow type $name\nshow", ' and ran the method'); + } +} diff --git a/tests/server/backend-t.in b/tests/server/backend-t.in deleted file mode 100644 index 2fc6a53..0000000 --- a/tests/server/backend-t.in +++ /dev/null @@ -1,502 +0,0 @@ -#!/usr/bin/perl -w -# -# Tests for the wallet-backend dispatch code. -# -# Written by Russ Allbery -# Copyright 2006, 2007, 2008, 2009, 2010 -# Board of Trustees, Leland Stanford Jr. University -# -# See LICENSE for licensing terms. - -use strict; -use Test::More tests => 1263; - -# Create a dummy class for Wallet::Server that prints what method was called -# with its arguments and returns data for testing. -package Wallet::Server; - -use vars qw($error $okay); -$error = 0; -$okay = 0; - -sub error { - if ($okay) { - $okay = 0; - return; - } else { - $error++; - return "error count $error"; - } -} - -sub new { shift; print "new @_\n"; return bless ({}, 'Wallet::Server') } -sub create { shift; print "create @_\n"; ($_[0] eq 'error') ? undef : 1 } -sub destroy { shift; print "destroy @_\n"; ($_[0] eq 'error') ? undef : 1 } -sub store { shift; print "store @_\n"; ($_[0] eq 'error') ? undef : 1 } - -sub acl_add - { shift; print "acl_add @_\n"; ($_[0] eq 'error') ? undef : 1 } -sub acl_create - { shift; print "acl_create @_\n"; ($_[0] eq 'error') ? undef : 1 } -sub acl_destroy - { shift; print "acl_destroy @_\n"; ($_[0] eq 'error') ? undef : 1 } -sub acl_remove - { shift; print "acl_remove @_\n"; ($_[0] eq 'error') ? undef : 1 } -sub acl_rename - { shift; print "acl_rename @_\n"; ($_[0] eq 'error') ? undef : 1 } - -sub acl_history { - shift; - print "acl_history @_\n"; - return if $_[0] eq 'error'; - return 'acl_history'; -} - -sub acl_show { - shift; - print "acl_show @_\n"; - return if $_[0] eq 'error'; - return 'acl_show'; -} - -sub flag_clear - { shift; print "flag_clear @_\n"; ($_[0] eq 'error') ? undef : 1 } -sub flag_set - { shift; print "flag_set @_\n"; ($_[0] eq 'error') ? undef : 1 } - -sub acl { - shift; - print "acl @_\n"; - if ($_[0] eq 'error') { - return; - } elsif ($_[1] eq 'empty') { - $okay = 1; - return; - } else { - return 'acl'; - } -} - -sub attr { - shift; - print "attr @_\n"; - if ($_[0] eq 'error') { - return; - } elsif ($_[1] eq 'empty') { - $okay = 1; - return; - } elsif (@_ == 3) { - return ('attr1', 'attr2'); - } else { - return 'attr'; - } -} - -sub autocreate { - shift; - print "autocreate @_\n"; - return ($_[0] eq 'error') ? undef : 1 -} - -sub check { - shift; - print "check @_\n"; - if ($_[0] eq 'error') { - return; - } elsif ($_[1] eq 'empty') { - return 0; - } else { - return 1; - } -} - -sub expires { - shift; - print "expires @_\n"; - if ($_[0] eq 'error') { - return; - } elsif ($_[1] eq 'empty') { - $okay = 1; - return; - } else { - return 'expires'; - } -} - -sub get { - shift; - print "get @_\n"; - return if $_[0] eq 'error'; - return 'get'; -} - -sub history { - shift; - print "history @_\n"; - return if $_[0] eq 'error'; - return 'history'; -} - -sub owner { - shift; - print "owner @_\n"; - if ($_[0] eq 'error') { - return; - } elsif ($_[1] eq 'empty') { - $okay = 1; - return; - } else { - return 'owner'; - } -} - -sub show { - shift; - print "show @_\n"; - return if $_[0] eq 'error'; - return 'show'; -} - -# Back to the main package and the actual test suite. Lie about whether the -# Wallet::Server package has already been loaded. -package main; -$INC{'Wallet/Server.pm'} = 'FAKE'; -my $OUTPUT; -our $SYSLOG = \$OUTPUT; -eval { do "$ENV{SOURCE}/../server/wallet-backend" }; - -# Run the wallet backend. This fun hack takes advantage of the fact that the -# wallet backend is written in Perl so that we can substitute our own -# Wallet::Server class. -sub run_backend { - my (@args) = @_; - my $result = ''; - open (OUTPUT, '>', \$result) or die "cannot create output string: $!\n"; - select OUTPUT; - local $| = 1; - eval { command (@args) }; - my $error = $@; - select STDOUT; - return ($result, $error); -} - -# Now for the actual tests. First, check for lack of trace information. -my ($out, $err) = run_backend; -is ($err, "REMOTE_USER not set\n", 'REMOTE_USER required'); -is ($OUTPUT, "error: REMOTE_USER not set\n", ' and syslog correct'); -$ENV{REMOTE_USER} = 'admin'; -($out, $err) = run_backend; -is ($err, "neither REMOTE_HOST nor REMOTE_ADDR set\n", - 'REMOTE_HOST or _ADDR required'); -is ($OUTPUT, "error for admin: neither REMOTE_HOST nor REMOTE_ADDR set\n", - ' and syslog correct'); -$ENV{REMOTE_ADDR} = '1.2.3.4'; -my $new = 'new admin 1.2.3.4'; - -# Check unknown commands. -($out, $err) = run_backend ('foo'); -is ($err, "unknown command foo\n", 'Unknown command'); -is ($OUTPUT, "error for admin (1.2.3.4): unknown command foo\n", - ' and syslog correct'); -is ($out, "$new\n", ' and nothing ran'); -($out, $err) = run_backend ('acl', 'foo'); -is ($err, "unknown command acl foo\n", 'Unknown ACL command'); -is ($OUTPUT, "error for admin (1.2.3.4): unknown command acl foo\n", - ' and syslog correct'); -is ($out, "$new\n", ' and nothing ran'); -($out, $err) = run_backend ('flag', 'foo', 'service', 'foo', 'foo'); -is ($err, "unknown command flag foo\n", 'Unknown flag command'); -is ($OUTPUT, "error for admin (1.2.3.4): unknown command flag foo\n", - ' and syslog correct'); -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], - create => [2, 2], - destroy => [2, 2], - expires => [2, 4], - get => [2, 2], - getacl => [3, 3], - getattr => [3, 3], - history => [2, 2], - owner => [2, 3], - setacl => [4, 4], - setattr => [4, 9], - show => [2, 2], - store => [3, 3]); -my %acl_commands = (add => [3, 3], - create => [1, 1], - destroy => [1, 1], - history => [1, 1], - remove => [3, 3], - rename => [2, 2], - show => [1, 1]); -my %flag_commands = (clear => [3, 3], - set => [3, 3]); -for my $command (sort keys %commands) { - my ($min, $max) = @{ $commands{$command} }; - ($out, $err) = run_backend ($command, ('foo') x ($min - 1)); - is ($err, "insufficient arguments\n", "Too few arguments for $command"); - is ($OUTPUT, "error for admin (1.2.3.4): insufficient arguments\n", - ' and syslog correct'); - is ($out, "$new\n", ' and nothing ran'); - unless ($max >= 9) { - ($out, $err) = run_backend ($command, ('foo') x ($max + 1)); - is ($err, "too many arguments\n", "Too many arguments for $command"); - is ($OUTPUT, "error for admin (1.2.3.4): too many arguments\n", - ' and syslog correct'); - is ($out, "$new\n", ' and nothing ran'); - } - my @base = ('foobar') x $max; - for my $arg (0 .. ($max - 1)) { - my @args = @base; - $args[$arg] = 'foo;bar'; - ($out, $err) = run_backend ($command, @args); - if ($command eq 'store' and $arg == 2) { - is ($err, '', 'Store allows any characters'); - is ($OUTPUT, "command $command @args[0,1] from admin (1.2.3.4)" - . " succeeded\n", ' and success logged'); - is ($out, "$new\nstore foobar foobar foo;bar\n", - ' and calls the right method'); - } else { - is ($err, "invalid characters in argument: foo;bar\n", - "Invalid arguments for $command $arg"); - is ($OUTPUT, "error for admin (1.2.3.4): invalid characters in" - . " argument: foo;bar\n", ' and syslog correct'); - is ($out, "$new\n", ' and nothing ran'); - } - } -} -for my $command (sort keys %acl_commands) { - my ($min, $max) = @{ $acl_commands{$command} }; - ($out, $err) = run_backend ('acl', $command, ('foo') x ($min - 1)); - is ($err, "insufficient arguments\n", - "Too few arguments for acl $command"); - is ($OUTPUT, "error for admin (1.2.3.4): insufficient arguments\n", - ' and syslog correct'); - is ($out, "$new\n", ' and nothing ran'); - ($out, $err) = run_backend ('acl', $command, ('foo') x ($max + 1)); - is ($err, "too many arguments\n", "Too many arguments for acl $command"); - is ($OUTPUT, "error for admin (1.2.3.4): too many arguments\n", - ' and syslog correct'); - is ($out, "$new\n", ' and nothing ran'); - my @base = ('foobar') x $max; - for my $arg (0 .. ($max - 1)) { - my @args = @base; - $args[$arg] = 'foo;bar'; - ($out, $err) = run_backend ('acl', $command, @args); - is ($err, "invalid characters in argument: foo;bar\n", - "Invalid arguments for acl $command $arg"); - is ($OUTPUT, "error for admin (1.2.3.4): invalid characters in" - . " argument: foo;bar\n", ' and syslog correct'); - is ($out, "$new\n", ' and nothing ran'); - } -} -for my $command (sort keys %flag_commands) { - my ($min, $max) = @{ $flag_commands{$command} }; - ($out, $err) = run_backend ('flag', $command, ('foo') x ($min - 1)); - is ($err, "insufficient arguments\n", - "Too few arguments for flag $command"); - is ($OUTPUT, "error for admin (1.2.3.4): insufficient arguments\n", - ' and syslog correct'); - is ($out, "$new\n", ' and nothing ran'); - ($out, $err) = run_backend ('flag', $command, ('foo') x ($max + 1)); - is ($err, "too many arguments\n", "Too many arguments for flag $command"); - is ($OUTPUT, "error for admin (1.2.3.4): too many arguments\n", - ' and syslog correct'); - is ($out, "$new\n", ' and nothing ran'); - my @base = ('foobar') x $max; - for my $arg (0 .. ($max - 1)) { - my @args = @base; - $args[$arg] = 'foo;bar'; - ($out, $err) = run_backend ('flag', $command, @args); - is ($err, "invalid characters in argument: foo;bar\n", - "Invalid arguments for flag $command $arg"); - is ($OUTPUT, "error for admin (1.2.3.4): invalid characters in" - . " argument: foo;bar\n", ' and syslog correct'); - is ($out, "$new\n", ' and nothing ran'); - } -} - -# Now, test that we ran the right functions and passed the correct arguments. -my $error = 1; -for my $command (qw/autocreate create destroy setacl setattr store/) { - my $method = { setacl => 'acl', setattr => 'attr' }->{$command}; - $method ||= $command; - my @extra = ('foo') x ($commands{$command}[0] - 2); - my $extra = @extra ? join (' ', '', @extra) : ''; - ($out, $err) = run_backend ($command, 'type', 'name', @extra); - my $ran; - if ($command eq 'store') { - $ran = "$command type name"; - } else { - $ran = "$command type name" . (@extra ? " @extra" : ''); - } - is ($err, '', "Command $command ran with no errors"); - is ($OUTPUT, "command $ran from admin (1.2.3.4) succeeded\n", - ' and success logged'); - is ($out, "$new\n$method type name$extra\n", - ' and ran the right method'); - ($out, $err) = run_backend ($command, 'error', 'name', @extra); - if ($command eq 'store') { - $ran = "$command error name"; - } else { - $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'); - is ($out, "$new\n$method error name$extra\n", - ' and ran the right method'); - $error++; -} -for my $command (qw/check expires get getacl getattr history owner show/) { - my $method = { getacl => 'acl', getattr => 'attr' }->{$command}; - $method ||= $command; - my @extra = ('foo') x ($commands{$command}[0] - 2); - my $extra = @extra ? join (' ', '', @extra) : ''; - ($out, $err) = run_backend ($command, 'type', 'name', @extra); - my $ran = "$command type name" . (@extra ? " @extra" : ''); - is ($err, '', "Command $command ran with no errors"); - is ($OUTPUT, "command $ran from admin (1.2.3.4) succeeded\n", - ' and success logged'); - if ($command eq 'getattr') { - is ($out, "$new\n$method type name$extra\nattr1\nattr2\n", - ' and ran the right method with output'); - } elsif ($command eq 'check') { - is ($out, "$new\n$method type name$extra\nyes\n", - ' and ran the right method with output'); - } else { - my $newline = ($command =~ /^(get|history|show)\z/) ? '' : "\n"; - 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') { - ($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)"); - is ($OUTPUT, "command $ran from admin (1.2.3.4) succeeded\n", - ' and success logged'); - 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') { - ($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' } - elsif ($command eq 'getacl') { $desc = 'ACL' } - elsif ($command eq 'owner') { $desc = 'owner' } - is ($out, "$new\n$method type empty$extra\nNo $desc set\n", - ' and ran the right method with output'); - $error++; - } elsif ($command eq 'getattr') { - ($out, $err) = run_backend ($command, 'type', 'empty', @extra); - my $ran = "$command type empty" . (@extra ? " @extra" : ''); - is ($err, '', "Command $command ran with no errors (empty)"); - is ($OUTPUT, "command $ran from admin (1.2.3.4) succeeded\n", - ' and success logged'); - is ($out, "$new\n$method type empty$extra\n", - ' and ran the right method with output'); - $error++; - } elsif ($command eq 'check') { - ($out, $err) = run_backend ($command, 'type', 'empty', @extra); - my $ran = "$command type empty" . (@extra ? " @extra" : ''); - is ($err, '', "Command $command ran with no errors (empty)"); - is ($OUTPUT, "command $ran from admin (1.2.3.4) succeeded\n", - ' and success logged'); - is ($out, "$new\n$method type empty$extra\nno\n", - ' and ran the right method with output'); - } - ($out, $err) = run_backend ($command, 'error', 'name', @extra); - my $ran = "$command error name" . (@extra ? " @extra" : ''); - 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'); - is ($out, "$new\n$method error name$extra\n", - ' and ran the right method'); - $error++; -} -for my $command (sort keys %acl_commands) { - my @extra = ('foo') x ($acl_commands{$command}[0] - 1); - my $extra = @extra ? join (' ', '', @extra) : ''; - ($out, $err) = run_backend ('acl', $command, 'name', @extra); - my $ran = "acl $command name" . (@extra ? " @extra" : ''); - is ($err, '', "Command acl $command ran with no errors"); - is ($OUTPUT, "command $ran from admin (1.2.3.4) succeeded\n", - ' and success logged'); - my $expected; - if ($command eq 'show') { - $expected = "$new\nacl_$command name$extra\nacl_show"; - } elsif ($command eq 'history') { - $expected = "$new\nacl_$command name$extra\nacl_history"; - } else { - $expected = "$new\nacl_$command name$extra\n"; - } - is ($out, $expected, ' and ran the right method'); - ($out, $err) = run_backend ('acl', $command, 'error', @extra); - $ran = "acl $command error" . (@extra ? " @extra" : ''); - is ($err, "error count $error\n", "Command acl $command ran with errors"); - is ($OUTPUT, "command $ran from admin (1.2.3.4) failed: error count" - . " $error\n", ' and syslog correct'); - is ($out, "$new\nacl_$command error$extra\n", - ' and ran the right method'); - $error++; -} -for my $command (sort keys %flag_commands) { - my @extra = ('foo') x ($flag_commands{$command}[0] - 2); - my $extra = @extra ? join (' ', '', @extra) : ''; - ($out, $err) = run_backend ('flag', $command, 'type', 'name', @extra); - my $ran = "flag $command type name" . (@extra ? " @extra" : ''); - is ($err, '', "Command flag $command ran with no errors"); - is ($OUTPUT, "command $ran from admin (1.2.3.4) succeeded\n", - ' and success logged'); - is ($out, "$new\nflag_$command type name$extra\n", - ' and ran the right method'); - ($out, $err) = run_backend ('flag', $command, 'error', 'name', @extra); - $ran = "flag $command error name" . (@extra ? " @extra" : ''); - is ($err, "error count $error\n", - "Command flag $command ran with errors"); - is ($OUTPUT, "command $ran from admin (1.2.3.4) failed: error count" - . " $error\n", ' and syslog correct'); - is ($out, "$new\nflag_$command error name$extra\n", - ' and ran the right method'); - $error++; -} - -# 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. -($out, $err) = run_backend ('show', 'type', ''); -is ($err, '', 'Allowed the empty argument'); -is ($OUTPUT, "command show type from admin (1.2.3.4) succeeded\n", - ' and success logged'); -my $ok = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_/.@-'; -($out, $err) = run_backend ('show', 'type', $ok); -is ($err, '', 'Allowed all valid characters'); -is ($OUTPUT, "command show type $ok from admin (1.2.3.4) succeeded\n", - ' and success logged'); -is ($out, "$new\nshow type $ok\nshow", ' and returned the right output'); -for my $n (0 .. 255) { - my $c = chr ($n); - my $name = $ok . $c; - ($out, $err) = run_backend ('show', 'type', $name); - if (index ($ok, $c) == -1) { - is ($err, "invalid characters in argument: $name\n", - "Rejected invalid character $n"); - my $stripped = $name; - $stripped =~ s/[^\x20-\x7e]/_/g; - is ($OUTPUT, "error for admin (1.2.3.4): invalid characters in" - . " argument: $stripped\n", ' and syslog correct'); - is ($out, "$new\n", ' and did nothing'); - } else { - is ($err, '', "Accepted valid character $n"); - is ($OUTPUT, "command show type $name from admin (1.2.3.4)" - . " succeeded\n", ' and success logged'); - is ($out, "$new\nshow type $name\nshow", ' and ran the method'); - } -} diff --git a/tests/server/keytab-t b/tests/server/keytab-t new file mode 100755 index 0000000..2a0ceed --- /dev/null +++ b/tests/server/keytab-t @@ -0,0 +1,88 @@ +#!/usr/bin/perl -w +# +# Tests for the keytab-backend dispatch code. +# +# Written by Russ Allbery +# Copyright 2006, 2007, 2010 Board of Trustees, Leland Stanford Jr. University +# +# See LICENSE for licensing terms. + +use strict; +use vars qw($CONFIG $KADMIN $SYSLOG $TMP); + +use Test::More tests => 63; + +# Load the keytab-backend code and override various settings. +my $OUTPUT; +$SYSLOG = \$OUTPUT; +eval { do "$ENV{SOURCE}/../server/keytab-backend" }; +$CONFIG = "$ENV{SOURCE}/data/allow-extract"; +$KADMIN = "$ENV{SOURCE}/data/fake-kadmin"; +$TMP = '.'; + +# Run the keytab backend. +sub run_backend { + my (@args) = @_; + my $result = ''; + open (OUTPUT, '>', \$result) or die "cannot create output string: $!\n"; + select OUTPUT; + local $| = 1; + eval { download (@args) }; + my $error = $@; + select STDOUT; + return ($result, $error); +} + +# The actual tests. +$ENV{REMOTE_USER} = 'admin'; +my ($out, $err) = run_backend (); +is ($err, "keytab-backend: invalid arguments: \n", 'Fails with no arguments'); +is ($OUTPUT, "invalid arguments: \n", ' and syslog matches'); +is ($out, '', ' and produces no output'); +($out, $err) = run_backend ('foo', 'bar', 'baz'); +is ($err, "keytab-backend: invalid arguments: foo bar baz\n", + 'Fails with three arguments'); +is ($OUTPUT, "invalid arguments: foo bar baz\n", ' and syslog matches'); +is ($out, '', ' and produces no output'); +for my $bad (qw{service service\*@example =@example host/foo+bar@example + rcmd.foo@EXAMPLE host/foo/bar@EXAMPLE /bar@EXAMPLE.NET + bar/@EXAMPLE.NET bar/bar@}) { + ($out, $err) = run_backend ('keytab', $bad); + is ($err, "keytab-backend: bad principal name $bad\n", + "Invalid principal $bad"); + is ($OUTPUT, "bad principal name $bad\n", ' and syslog matches'); + is ($out, '', ' and produces no output'); +} +for my $bad (qw{service/foo@EXAMPLE.ORGA bar@EXAMPLE.NET + host/example.net@EXAMPLE.ORG aservice/foo@EXAMPLE.ORG}) { + ($out, $err) = run_backend ('keytab', $bad); + is ($err, + "keytab-backend: permission denied: admin may not retrieve $bad\n", + "Permission denied for $bad"); + is ($OUTPUT, "permission denied: admin may not retrieve $bad\n", + ' and syslog matches'); + is ($out, '', ' and produces no output'); +} +for my $good (qw{service/foo@EXAMPLE.ORG foo/bar@EXAMPLE.NET + host/example.org@EXAMPLE.ORG}) { + ($out, $err) = run_backend ($good); + is ($err, '', "Success for good keytab $good"); + is ($out, "$good\n", ' and the right output'); + is ($OUTPUT, "keytab $good retrieved by admin\n", ' and syslog is right'); + ok (! -f "$TMP/keytab$$", ' and the file is gone'); +} +($out, $err) = run_backend ('keytab', 'error@EXAMPLE.ORG'); +is ($err, "keytab-backend: retrieve of error\@EXAMPLE.ORG failed for" + . " admin: kadmin.local exited with status 1\n", + 'Good error on kadmin failure'); +is ($OUTPUT, "retrieve of error\@EXAMPLE.ORG failed for admin: kadmin.local" + . " exited with status 1\n", ' and syslog matches'); +is ($out, '', ' and no output'); + +# Test a configuration failure. +$CONFIG = '/path/to/bad/file'; +($out, $err) = run_backend ('get', 'service/foo@EXAMPLE.ORG'); +like ($err, qr{^keytab-backend: cannot open /path/to/bad/file: }, + 'Fails with bad configuration file'); +like ($OUTPUT, qr{^cannot open /path/to/bad/file: }, ' and syslog matches'); +is ($out, '', ' and produces no output'); diff --git a/tests/server/keytab-t.in b/tests/server/keytab-t.in deleted file mode 100644 index 2a0ceed..0000000 --- a/tests/server/keytab-t.in +++ /dev/null @@ -1,88 +0,0 @@ -#!/usr/bin/perl -w -# -# Tests for the keytab-backend dispatch code. -# -# Written by Russ Allbery -# Copyright 2006, 2007, 2010 Board of Trustees, Leland Stanford Jr. University -# -# See LICENSE for licensing terms. - -use strict; -use vars qw($CONFIG $KADMIN $SYSLOG $TMP); - -use Test::More tests => 63; - -# Load the keytab-backend code and override various settings. -my $OUTPUT; -$SYSLOG = \$OUTPUT; -eval { do "$ENV{SOURCE}/../server/keytab-backend" }; -$CONFIG = "$ENV{SOURCE}/data/allow-extract"; -$KADMIN = "$ENV{SOURCE}/data/fake-kadmin"; -$TMP = '.'; - -# Run the keytab backend. -sub run_backend { - my (@args) = @_; - my $result = ''; - open (OUTPUT, '>', \$result) or die "cannot create output string: $!\n"; - select OUTPUT; - local $| = 1; - eval { download (@args) }; - my $error = $@; - select STDOUT; - return ($result, $error); -} - -# The actual tests. -$ENV{REMOTE_USER} = 'admin'; -my ($out, $err) = run_backend (); -is ($err, "keytab-backend: invalid arguments: \n", 'Fails with no arguments'); -is ($OUTPUT, "invalid arguments: \n", ' and syslog matches'); -is ($out, '', ' and produces no output'); -($out, $err) = run_backend ('foo', 'bar', 'baz'); -is ($err, "keytab-backend: invalid arguments: foo bar baz\n", - 'Fails with three arguments'); -is ($OUTPUT, "invalid arguments: foo bar baz\n", ' and syslog matches'); -is ($out, '', ' and produces no output'); -for my $bad (qw{service service\*@example =@example host/foo+bar@example - rcmd.foo@EXAMPLE host/foo/bar@EXAMPLE /bar@EXAMPLE.NET - bar/@EXAMPLE.NET bar/bar@}) { - ($out, $err) = run_backend ('keytab', $bad); - is ($err, "keytab-backend: bad principal name $bad\n", - "Invalid principal $bad"); - is ($OUTPUT, "bad principal name $bad\n", ' and syslog matches'); - is ($out, '', ' and produces no output'); -} -for my $bad (qw{service/foo@EXAMPLE.ORGA bar@EXAMPLE.NET - host/example.net@EXAMPLE.ORG aservice/foo@EXAMPLE.ORG}) { - ($out, $err) = run_backend ('keytab', $bad); - is ($err, - "keytab-backend: permission denied: admin may not retrieve $bad\n", - "Permission denied for $bad"); - is ($OUTPUT, "permission denied: admin may not retrieve $bad\n", - ' and syslog matches'); - is ($out, '', ' and produces no output'); -} -for my $good (qw{service/foo@EXAMPLE.ORG foo/bar@EXAMPLE.NET - host/example.org@EXAMPLE.ORG}) { - ($out, $err) = run_backend ($good); - is ($err, '', "Success for good keytab $good"); - is ($out, "$good\n", ' and the right output'); - is ($OUTPUT, "keytab $good retrieved by admin\n", ' and syslog is right'); - ok (! -f "$TMP/keytab$$", ' and the file is gone'); -} -($out, $err) = run_backend ('keytab', 'error@EXAMPLE.ORG'); -is ($err, "keytab-backend: retrieve of error\@EXAMPLE.ORG failed for" - . " admin: kadmin.local exited with status 1\n", - 'Good error on kadmin failure'); -is ($OUTPUT, "retrieve of error\@EXAMPLE.ORG failed for admin: kadmin.local" - . " exited with status 1\n", ' and syslog matches'); -is ($out, '', ' and no output'); - -# Test a configuration failure. -$CONFIG = '/path/to/bad/file'; -($out, $err) = run_backend ('get', 'service/foo@EXAMPLE.ORG'); -like ($err, qr{^keytab-backend: cannot open /path/to/bad/file: }, - 'Fails with bad configuration file'); -like ($OUTPUT, qr{^cannot open /path/to/bad/file: }, ' and syslog matches'); -is ($out, '', ' and produces no output'); diff --git a/tests/server/pod-t b/tests/server/pod-t new file mode 100755 index 0000000..52d81eb --- /dev/null +++ b/tests/server/pod-t @@ -0,0 +1,22 @@ +#!/usr/bin/perl +# +# Test POD formatting for client documentation. +# +# Written by Russ Allbery +# 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"); + } +} diff --git a/tests/server/pod-t.in b/tests/server/pod-t.in deleted file mode 100644 index 52d81eb..0000000 --- a/tests/server/pod-t.in +++ /dev/null @@ -1,22 +0,0 @@ -#!/usr/bin/perl -# -# Test POD formatting for client documentation. -# -# Written by Russ Allbery -# 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 0f81ba24e021a63d42c51ee9bec6e521fc540251 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 9 Feb 2010 22:13:53 -0800 Subject: Fix multiple builddir != srcdir issues with test suite Simplify the build rules for the test suite to take advantage of the improved runtests support for builddir != srcdir. Stop doing Autoconf substitution on full.conf now that we have that support. --- .gitignore | 1 - Makefile.am | 34 +++++++++++++--------------------- configure.ac | 5 ++++- tests/client/basic-t.in | 2 +- tests/client/full-t.in | 7 +++++-- tests/client/prompt-t.in | 2 +- tests/data/full.conf | 3 +++ tests/data/full.conf.in | 3 --- 8 files changed, 27 insertions(+), 30 deletions(-) create mode 100644 tests/data/full.conf delete mode 100644 tests/data/full.conf.in diff --git a/.gitignore b/.gitignore index b0a49df..3778ee8 100644 --- a/.gitignore +++ b/.gitignore @@ -19,7 +19,6 @@ /tests/client/basic-t /tests/client/full-t /tests/client/prompt-t -/tests/data/full.conf /tests/data/test.keytab /tests/data/test.password /tests/data/test.principal diff --git a/Makefile.am b/Makefile.am index 77514a7..d4dc8a5 100644 --- a/Makefile.am +++ b/Makefile.am @@ -23,20 +23,19 @@ PERL_FILES = perl/Wallet/ACL.pm perl/Wallet/ACL/Base.pm \ perl/t/keytab.t perl/t/lib/Util.pm perl/t/object.t perl/t/pod.t \ perl/t/schema.t perl/t/server.t perl/t/verifier-netdb.t \ perl/t/verifier.t -TEST_FILES = tests/TESTS tests/data/README tests/data/allow-extract \ - tests/data/basic.conf tests/data/cmd-fake tests/data/fake-data \ - tests/data/fake-kadmin tests/data/fake-keytab \ - tests/data/fake-keytab-2 tests/data/fake-keytab-merge \ - tests/data/fake-keytab-old tests/data/fake-srvtab \ - tests/data/wallet.conf tests/libtest.sh AUTOMAKE_OPTIONS = foreign subdir-objects ACLOCAL_AMFLAGS = -I m4 -EXTRA_DIST = LICENSE autogen client/wallet.pod config/allow-extract \ - config/keytab config/keytab.acl config/wallet docs/design \ - contrib/README contrib/wallet-report contrib/wallet-report.8 \ - docs/design-acl docs/design-api docs/netdb-role-api docs/notes \ - docs/setup examples/stanford.conf $(PERL_FILES) $(TEST_FILES) +EXTRA_DIST = LICENSE autogen client/wallet.pod config/allow-extract \ + config/keytab config/keytab.acl config/wallet docs/design \ + contrib/README contrib/wallet-report contrib/wallet-report.8 \ + docs/design-acl docs/design-api docs/netdb-role-api docs/notes \ + docs/setup examples/stanford.conf tests/TESTS tests/data/README \ + tests/data/allow-extract tests/data/basic.conf tests/data/cmd-fake \ + tests/data/cmd-wrapper tests/data/fake-data tests/data/fake-kadmin \ + tests/data/fake-keytab tests/data/fake-keytab-2 \ + tests/data/fake-keytab-merge tests/data/fake-keytab-old \ + tests/data/fake-srvtab tests/data/wallet.conf $(PERL_FILES) noinst_LIBRARIES = portable/libportable.a util/libutil.a portable_libportable_a_SOURCES = portable/dummy.c portable/krb5-extra.c \ @@ -89,8 +88,8 @@ all-local: perl/blib/lib/Wallet/Config.pm perl/blib/lib/Wallet/Config.pm: set -e; if [ x"$(builddir)" != x"$(srcdir)" ] ; then \ mkdir perl/Wallet perl/Wallet/ACL perl/Wallet/ACL/NetDB \ - perl/Wallet/Object perl/t perl/t/data perl/t/lib \ - 2>/dev/null || true ; \ + perl/Wallet/Kadmin perl/Wallet/Object perl/t perl/t/data \ + perl/t/lib 2>/dev/null || true ; \ for f in $(PERL_FILES) ; do \ cp "$(srcdir)/$$f" "$(builddir)/$$f" ; \ done \ @@ -160,14 +159,7 @@ tests_util_messages_t_LDADD = tests/tap/libtap.a util/libutil.a \ tests_util_xmalloc_LDADD = util/libutil.a portable/libportable.a check-local: $(check_PROGRAMS) - set -e; if [ x"$(builddir)" != x"$(srcdir)" ] ; then \ - mkdir tests/data/acls 2>/dev/null || true ; \ - for f in $(TEST_FILES) ; do \ - cp "$(srcdir)/$$f" "$(builddir)/$$f" ; \ - done \ - fi - cd tests && ./runtests TESTS - @echo '' + cd tests && ./runtests $(abs_top_srcdir)/tests/TESTS @echo '' cd perl && $(MAKE) test diff --git a/configure.ac b/configure.ac index 664c6f7..78201c1 100644 --- a/configure.ac +++ b/configure.ac @@ -60,8 +60,11 @@ AS_IF([test x"$REMCTLD" != x], [AC_DEFINE_UNQUOTED([PATH_REMCTLD], ["$REMCTLD"], [Define to the full path to remctld to run remctl tests.])]) +dnl Create the tests/data directory for builds outside the source directory. +AC_CONFIG_COMMANDS([tests/data/.placeholder], [touch tests/data/.placeholder]) + AC_CONFIG_HEADER([config.h]) -AC_CONFIG_FILES([Makefile perl/Makefile.PL tests/data/full.conf]) +AC_CONFIG_FILES([Makefile perl/Makefile.PL]) AC_CONFIG_FILES([tests/client/basic-t], [chmod +x tests/client/basic-t]) AC_CONFIG_FILES([tests/client/full-t], [chmod +x tests/client/full-t]) AC_CONFIG_FILES([tests/client/prompt-t], [chmod +x tests/client/prompt-t]) diff --git a/tests/client/basic-t.in b/tests/client/basic-t.in index 1dbc0b9..30bc004 100644 --- a/tests/client/basic-t.in +++ b/tests/client/basic-t.in @@ -12,7 +12,7 @@ . "$SOURCE/tap/libtap.sh" . "$SOURCE/tap/kerberos.sh" . "$SOURCE/tap/remctl.sh" -cd "$BUILD" +cd "$SOURCE" # We need a modified krb5.conf file to test wallet configuration settings in # krb5.conf. Despite the hard-coding of test-k5.stanford.edu, this test isn't diff --git a/tests/client/full-t.in b/tests/client/full-t.in index a4ca19d..8acc360 100644 --- a/tests/client/full-t.in +++ b/tests/client/full-t.in @@ -51,6 +51,9 @@ sub wallet { return ($output, $error, $status); } +# cd to the correct directory. +chdir "$ENV{SOURCE}" or die "Cannot chdir to $ENV{SOURCE}: $!\n"; + SKIP: { skip 'no keytab configuration', $total unless -f "$ENV{BUILD}/data/test.keytab"; @@ -62,8 +65,8 @@ SKIP: { unlink ('krb5cc_test', 'test-pid'); my $principal = contents ("$ENV{BUILD}/data/test.principal"); remctld_spawn ($remctld, $principal, - '@abs_top_builddir@/tests/data/test.keytab', - '@abs_top_builddir@/tests/data/full.conf'); + "$ENV{BUILD}/data/test.keytab", + "$ENV{SOURCE}/data/full.conf"); $ENV{KRB5CCNAME} = 'krb5cc_test'; getcreds ("$ENV{BUILD}/data/test.keytab", $principal); diff --git a/tests/client/prompt-t.in b/tests/client/prompt-t.in index e037b3f..1d8b079 100644 --- a/tests/client/prompt-t.in +++ b/tests/client/prompt-t.in @@ -36,7 +36,7 @@ SKIP: { unlink ('krb5cc_test', 'test-pid'); my $principal = contents ("$ENV{BUILD}/data/test.principal"); remctld_spawn ($remctld, $principal, "$ENV{BUILD}/data/test.keytab", - "$ENV{BUILD}/data/basic.conf"); + "$ENV{SOURCE}/data/basic.conf"); $ENV{KRB5CCNAME} = 'krb5cc_test'; # Read in the principal and password. diff --git a/tests/data/full.conf b/tests/data/full.conf new file mode 100644 index 0000000..4c0f435 --- /dev/null +++ b/tests/data/full.conf @@ -0,0 +1,3 @@ +# remctl configuration for full wallet client tests. + +wallet ALL data/cmd-wrapper ANYUSER diff --git a/tests/data/full.conf.in b/tests/data/full.conf.in deleted file mode 100644 index 25aef9e..0000000 --- a/tests/data/full.conf.in +++ /dev/null @@ -1,3 +0,0 @@ -# remctl configuration for full wallet client tests. - -wallet ALL @abs_top_builddir@/tests/data/cmd-wrapper ANYUSER -- cgit v1.2.3 From ae02de1488068b84371b05842c81a9aecc5f24c4 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 9 Feb 2010 23:19:27 -0800 Subject: Check spelling of server API POD and tweak server docs Also update the POD syntax check to the current version of that check I use elsewhere. Since I'm touching all the POD anyway, also rewrap all of the POD to 74 columns. Fix some references to MIT in the Wallet::Kadmin::Heimdal module documentation. --- perl/Wallet/ACL.pm | 110 +++++++++++----------- perl/Wallet/ACL/Base.pm | 31 ++++--- perl/Wallet/ACL/Krb5.pm | 13 ++- perl/Wallet/ACL/NetDB.pm | 26 +++--- perl/Wallet/ACL/NetDB/Root.pm | 46 +++++----- perl/Wallet/Admin.pm | 39 ++++---- perl/Wallet/Config.pm | 196 ++++++++++++++++++++------------------- perl/Wallet/Database.pm | 17 ++-- perl/Wallet/Kadmin.pm | 31 ++++--- perl/Wallet/Kadmin/Heimdal.pm | 52 +++++------ perl/Wallet/Kadmin/MIT.pm | 45 ++++----- perl/Wallet/Object/Base.pm | 209 ++++++++++++++++++++++-------------------- perl/Wallet/Object/File.pm | 18 ++-- perl/Wallet/Object/Keytab.pm | 55 ++++++----- perl/Wallet/Schema.pm | 129 ++++++++++++++------------ perl/Wallet/Server.pm | 209 ++++++++++++++++++++++-------------------- perl/t/pod-spelling.t | 75 +++++++++++++++ perl/t/pod.t | 14 ++- 18 files changed, 731 insertions(+), 584 deletions(-) create mode 100755 perl/t/pod-spelling.t diff --git a/perl/Wallet/ACL.pm b/perl/Wallet/ACL.pm index 9136fc2..76e7354 100644 --- a/perl/Wallet/ACL.pm +++ b/perl/Wallet/ACL.pm @@ -1,7 +1,7 @@ # Wallet::ACL -- Implementation of ACLs in the wallet system. # # Written by Russ Allbery -# 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. @@ -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.05'; +$VERSION = '0.06'; ############################################################################## # Constructors @@ -427,6 +427,9 @@ __END__ Wallet::ACL - Implementation of ACLs in the wallet system +=for stopwords +ACL DBH metadata HOSTNAME DATETIME timestamp Allbery + =head1 SYNOPSIS my $acl = Wallet::ACL->create ('group:sysadmin'); @@ -445,22 +448,22 @@ Wallet::ACL - Implementation of ACLs in the wallet system =head1 DESCRIPTION -Wallet::ACL implements the ACL system for the wallet: the methods to create, -find, rename, and destroy ACLs; the methods to add and remove entries from -an ACL; and the methods to list the contents of an ACL and check a principal -against it. +Wallet::ACL implements the ACL system for the wallet: the methods to +create, find, rename, and destroy ACLs; the methods to add and remove +entries from an ACL; and the methods to list the contents of an ACL and +check a principal against it. An ACL is a list of zero or more ACL entries, each of which consists of a -scheme and an identifier. Each scheme is associated with a verifier module -that checks Kerberos principals against identifiers for that scheme and -returns whether the principal should be permitted access by that identifier. -The interpretation of the identifier is entirely left to the scheme. This -module maintains the ACLs and dispatches check operations to the appropriate -verifier module. - -Each ACL is identified by a human-readable name and a persistant unique -numeric identifier. The numeric identifier (ID) should be used to refer to -the ACL so that it can be renamed as needed without breaking external +scheme and an identifier. Each scheme is associated with a verifier +module that checks Kerberos principals against identifiers for that scheme +and returns whether the principal should be permitted access by that +identifier. The interpretation of the identifier is entirely left to the +scheme. This module maintains the ACLs and dispatches check operations to +the appropriate verifier module. + +Each ACL is identified by a human-readable name and a persistent unique +numeric identifier. The numeric identifier (ID) should be used to refer +to the ACL so that it can be renamed as needed without breaking external references. =head1 CLASS METHODS @@ -481,8 +484,8 @@ finding an existing one, creates a new ACL record in the database with the given NAME. NAME must not be all-numeric, since that would conflict with the automatically assigned IDs. Returns the new object on success and throws an exception on failure. PRINCIPAL, HOSTNAME, and DATETIME are -stored as history information. PRINCIPAL should be the user who is creating -the ACL. If DATETIME isn't given, the current time is used. +stored as history information. PRINCIPAL should be the user who is +creating the ACL. If DATETIME isn't given, the current time is used. =back @@ -492,42 +495,43 @@ the ACL. If DATETIME isn't given, the current time is used. =item add(SCHEME, INSTANCE, PRINCIPAL, HOSTNAME [, DATETIME]) -Add the given ACL entry (given by SCHEME and INSTANCE) to this ACL. 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 adding -the ACL entry. If DATETIME isn't given, the current time is used. +Add the given ACL entry (given by SCHEME and INSTANCE) to this ACL. +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 adding the ACL entry. If DATETIME isn't given, the current time is +used. =item check(PRINCIPAL) Checks whether the given PRINCIPAL should be allowed access given ACL. Returns 1 if access was granted, 0 if access is declined, and undef on -error. On error, the caller should call error() to get the error text. Any -errors found by the individual ACL verifiers can be retrieved by calling -check_errors(). Errors from individual ACL verifiers will not result in an -error return from check(); instead, the check will continue with the next -entry in the ACL. +error. On error, the caller should call error() to get the error text. +Any errors found by the individual ACL verifiers can be retrieved by +calling check_errors(). Errors from individual ACL verifiers will not +result in an error return from check(); instead, the check will continue +with the next entry in the ACL. check() returns success as soon as an entry in the ACL grants access to PRINCIPAL. There is no provision for negative ACLs or exceptions. =item check_errors() -Return (as a list in array context and a string with newlines between errors -and at the end of the last error in scalar context) the errors, if any, -returned by ACL verifiers for the last check operation. If there were no -errors from the last check() operation, returns the empty list in array -context and undef in scalar context. +Return (as a list in array context and a string with newlines between +errors and at the end of the last error in scalar context) the errors, if +any, returned by ACL verifiers for the last check operation. If there +were no errors from the last check() operation, returns the empty list in +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. +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() @@ -542,7 +546,8 @@ 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 made. On failure, -returns undef, and the caller should call error() to get the error message. +returns undef, and the caller should call error() to get the error +message. =item id() @@ -569,28 +574,29 @@ Returns the human-readable name of this ACL. =item remove(SCHEME, INSTANCE, PRINCIPAL, HOSTNAME [, DATETIME]) Remove the given ACL line (given by SCHEME and INSTANCE) from this ACL. -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 -removing the ACL entry. If DATETIME isn't given, the current time is used. +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 removing the ACL entry. If DATETIME isn't given, the current time +is used. =item rename(NAME) Rename this ACL. This changes the name used for human convenience but not the system-generated ACL ID that is used to reference this ACL. The new NAME must not be all-numeric, since that would conflict with -system-generated ACL IDs. Returns true on success and false on failure. On -failure, the caller should call error() to get the error message. +system-generated ACL IDs. Returns true on success and false on failure. +On failure, the caller should call error() to get the error message. Note that rename() operations are not logged in the ACL history. =item show() -Returns a human-readable description of this ACL, including its membership. -This method should only be used for display of the ACL to humans. Use the -list(), name(), and id() methods instead to get ACL information for use in -other code. On failure, returns undef, and the caller should call error() -to get the error message. +Returns a human-readable description of this ACL, including its +membership. This method should only be used for display of the ACL to +humans. Use the list(), name(), and id() methods instead to get ACL +information for use in other code. On failure, returns undef, and the +caller should call error() to get the error message. =back @@ -598,8 +604,8 @@ to get the error message. Wallet::ACL::Base(3), wallet-backend(8) -This module is part of the wallet system. The current version is available -from L. +This module is part of the wallet system. The current version is +available from L. =head1 AUTHOR diff --git a/perl/Wallet/ACL/Base.pm b/perl/Wallet/ACL/Base.pm index 004de75..9a8a3cb 100644 --- a/perl/Wallet/ACL/Base.pm +++ b/perl/Wallet/ACL/Base.pm @@ -1,7 +1,7 @@ # Wallet::ACL::Base -- Parent class for wallet ACL verifiers. # # Written by Russ Allbery -# Copyright 2007 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2010 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -18,7 +18,7 @@ use vars qw($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.01'; +$VERSION = '0.02'; ############################################################################## # Interface @@ -59,6 +59,9 @@ __END__ # Documentation ############################################################################## +=for stopwords +ACL Allbery + =head1 NAME Wallet::ACL::Base - Generic parent class for wallet ACL verifiers @@ -74,9 +77,9 @@ Wallet::ACL::Base - Generic parent class for wallet ACL verifiers =head1 DESCRIPTION -Wallet::ACL::Base is the generic parent class for wallet ACL verifiers. It -provides default functions and behavior and all ACL verifiers should inherit -from it. It is not used directly. +Wallet::ACL::Base is the generic parent class for wallet ACL verifiers. +It provides default functions and behavior and all ACL verifiers should +inherit from it. It is not used directly. =head1 METHODS @@ -84,8 +87,8 @@ from it. It is not used directly. =item new() -Creates a new ACL verifier. The generic function provided here just creates -and blesses an object. +Creates a new ACL verifier. The generic function provided here just +creates and blesses an object. =item check(PRINCIPAL, ACL) @@ -99,11 +102,11 @@ have failed. Callers should call this function to get the error message after an undef return from any other instance method. For the convenience of child classes, this method can also be called with -one or more error strings. If so, those strings are concatenated together, -trailing newlines are removed, any text of the form S> at the end of the message is stripped off, and the result is stored -as the error. Only child classes should call this method with an error -string. +one or more error strings. If so, those strings are concatenated +together, trailing newlines are removed, any text of the form S> at the end of the message is stripped off, and the result is +stored as the error. Only child classes should call this method with an +error string. =back @@ -111,8 +114,8 @@ string. Wallet::ACL(3), wallet-backend(8) -This module is part of the wallet system. The current version is available -from L. +This module is part of the wallet system. The current version is +available from L. =head1 AUTHOR diff --git a/perl/Wallet/ACL/Krb5.pm b/perl/Wallet/ACL/Krb5.pm index 1c584c5..496fcf0 100644 --- a/perl/Wallet/ACL/Krb5.pm +++ b/perl/Wallet/ACL/Krb5.pm @@ -1,7 +1,7 @@ # Wallet::ACL::Krb5 -- Wallet Kerberos v5 principal ACL verifier. # # Written by Russ Allbery -# Copyright 2007 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2010 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -22,7 +22,7 @@ use Wallet::ACL::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.01'; +$VERSION = '0.02'; ############################################################################## # Interface @@ -50,6 +50,9 @@ __END__ # Documentation ############################################################################## +=for stopwords +ACL krb5 Allbery + =head1 NAME Wallet::ACL::Krb5 - Simple wallet ACL verifier for Kerberos principals @@ -69,7 +72,7 @@ Wallet::ACL::Krb5 - Simple wallet ACL verifier for Kerberos principals =head1 DESCRIPTION Wallet::ACL::Krb5 is the simplest wallet ACL verifier, used to verify ACL -lines of type krb5. The value of such an ACL is a simple Kerberos +lines of type C. The value of such an ACL is a simple Kerberos principal in its text display form, and the ACL grants access to a given principal if and only if the principal exactly matches the ACL. @@ -111,8 +114,8 @@ The PRINCIPAL parameter to check() was undefined or the empty string. Wallet::ACL(3), Wallet::ACL::Base(3), wallet-backend(8) -This module is part of the wallet system. The current version is available -from L. +This module is part of the wallet system. The current version is +available from L. =head1 AUTHOR diff --git a/perl/Wallet/ACL/NetDB.pm b/perl/Wallet/ACL/NetDB.pm index 6775c62..2096ba8 100644 --- a/perl/Wallet/ACL/NetDB.pm +++ b/perl/Wallet/ACL/NetDB.pm @@ -1,7 +1,7 @@ # Wallet::ACL::NetDB -- Wallet NetDB role ACL verifier. # # Written by Russ Allbery -# Copyright 2007 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2010 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -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.03'; +$VERSION = '0.04'; ############################################################################## # Interface @@ -135,6 +135,9 @@ __END__ # Documentation ############################################################################## +=for stopwords +ACL NetDB remctl DNS DHCP Allbery netdb + =head1 NAME Wallet::ACL::NetDB - Wallet ACL verifier for NetDB roles @@ -154,9 +157,10 @@ Wallet::ACL::NetDB - Wallet ACL verifier for NetDB roles =head1 DESCRIPTION Wallet::ACL::NetDB checks a principal against the NetDB roles for a given -host. It is used to verify ACL lines of type netdb. The value of such an -ACL is a node, and the ACL grants access to a given principal if and only -if that principal has one of the roles user, admin, or team for that node. +host. It is used to verify ACL lines of type C. The value of such +an ACL is a node, and the ACL grants access to a given principal if and +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 @@ -227,7 +231,7 @@ error message or otherwise returned failure. The ACL parameter to check() was malformed. Currently, this error is only given if ACL is undefined or the empty string. -=item malformed NetDBL remctl token: %s +=item malformed NetDB remctl token: %s The Net::Remctl Perl library returned a malformed token. This should never happen and indicates a bug in Net::Remctl. @@ -248,12 +252,12 @@ grant access is not currently configurable. Net::Remctl(3), Wallet::ACL(3), Wallet::ACL::Base(3), Wallet::Config(3), wallet-backend(8) -NetDB is a free software system for managing DNS, DHCP, and related machine -information for large organizations. For more information on NetDB, see -L. +NetDB is a free software system for managing DNS, DHCP, and related +machine information for large organizations. For more information on +NetDB, see L. -This module is part of the wallet system. The current version is available -from L. +This module is part of the wallet system. The current version is +available from L. =head1 AUTHOR diff --git a/perl/Wallet/ACL/NetDB/Root.pm b/perl/Wallet/ACL/NetDB/Root.pm index cbd1387..3aeebda 100644 --- a/perl/Wallet/ACL/NetDB/Root.pm +++ b/perl/Wallet/ACL/NetDB/Root.pm @@ -1,7 +1,7 @@ # Wallet::ACL::NetDB::Root -- Wallet NetDB role ACL verifier (root instances). # # Written by Russ Allbery -# Copyright 2007 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2010 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -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.01'; +$VERSION = '0.02'; ############################################################################## # Interface @@ -48,6 +48,9 @@ sub check { # Documentation ############################################################################## +=for stopwords +ACL NetDB DNS DHCP Allbery + =head1 NAME Wallet::ACL::NetDB::Root - Wallet ACL verifier for NetDB roles (root instances) @@ -66,13 +69,14 @@ Wallet::ACL::NetDB::Root - Wallet ACL verifier for NetDB roles (root instances) =head1 DESCRIPTION -Wallet::ACL::NetDB::Root works identically to Wallet::ACL::NetDB except that -it requires the principal to be a root instance (in other words, to be in -the form /root@) and strips the C portion from the -principal before checking against NetDB roles. As with the base NetDB ACL -verifier, the value of a netdb-root ACL is a node, and the ACL grants access -to a given principal if and only if the that principal (with C -stripped) has one of the roles user, admin, or team for that node. +Wallet::ACL::NetDB::Root works identically to Wallet::ACL::NetDB except +that it requires the principal to be a root instance (in other words, to +be in the form /root@) and strips the C portion +from the principal before checking against NetDB roles. As with the base +NetDB ACL verifier, the value of a C ACL is a node, and the +ACL grants access to a given principal if and only if the that principal +(with C stripped) has one of the roles user, admin, or team for +that node. To use this object, the same configuration parameters must be set as for Wallet::ACL::NetDB. See Wallet::Config(3) for details on those @@ -85,11 +89,11 @@ configuration. =item check(PRINCIPAL, ACL) -Returns true if PRINCIPAL is granted access according to ACL, false if not, -and undef on an error (see L<"DIAGNOSTICS"> below). ACL is a node, and -PRINCIPAL will be granted access if it has an instance of C and if -(with C stripped off and the realm stripped off if configured) has -the user, admin, or team role for that node. +Returns true if PRINCIPAL is granted access according to ACL, false if +not, and undef on an error (see L<"DIAGNOSTICS"> below). ACL is a node, +and PRINCIPAL will be granted access if it has an instance of C and +if (with C stripped off and the realm stripped off if configured) +has the user, admin, or team role for that node. =back @@ -106,15 +110,15 @@ grant access is not currently configurable. =head1 SEE ALSO -Net::Remctl(3), Wallet::ACL(3), Wallet::ACL::Base(3), Wallet::ACL::NetDB(3), -Wallet::Config(3), wallet-backend(8) +Net::Remctl(3), Wallet::ACL(3), Wallet::ACL::Base(3), +Wallet::ACL::NetDB(3), Wallet::Config(3), wallet-backend(8) -NetDB is a free software system for managing DNS, DHCP, and related machine -information for large organizations. For more information on NetDB, see -L. +NetDB is a free software system for managing DNS, DHCP, and related +machine information for large organizations. For more information on +NetDB, see L. -This module is part of the wallet system. The current version is available -from L. +This module is part of the wallet system. The current version is +available from L. =head1 AUTHOR diff --git a/perl/Wallet/Admin.pm b/perl/Wallet/Admin.pm index ff87b94..b4b3d86 100644 --- a/perl/Wallet/Admin.pm +++ b/perl/Wallet/Admin.pm @@ -1,7 +1,7 @@ # Wallet::Admin -- Wallet system administrative interface. # # Written by Russ Allbery -# 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. @@ -413,6 +413,9 @@ __DATA__ Wallet::Admin - Wallet system administrative interface +=for stopwords +ACL hostname ACLs SQL wildcard Allbery + =head1 SYNOPSIS use Wallet::Admin; @@ -429,9 +432,9 @@ thin wrapper around this object that provides a command-line interface to 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). +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). =head1 CLASS METHODS @@ -491,11 +494,11 @@ at least one ACL, but an error can be distinguished from the odd case of a database with no ACLs by calling error(). error() is guaranteed to return the error message if there was an error and undef if there was no error. -There are currently two search types. 'empty' takes no arguments, and will -return only those acls that have no entries within them. 'entry' takes two -arguments -- an entry scheme and an entry identifier -- and will return -any ACLs with an entry that matches the given scheme and contains the -given identifier. +There are currently two search types. C takes no arguments and +will return only those ACLs that have no entries within them. C +takes two arguments, an entry scheme and an entry identifier, and will +return any ACLs with an entry that matches the given scheme and contains +the given identifier. =item list_objects(TYPE, SEARCH) @@ -503,7 +506,7 @@ Returns a list of all objects matching a search type and string in the database, or all objects in the database if no search information is given. The return value is a list of references to pairs of type and name. For example, if two objects existed in the database, both of type -"keytab" and with values "host/example.com" and "foo", list_objects() +C and with values C and C, list_objects() with no arguments would return: ([ 'keytab', 'host/example.com' ], [ 'keytab', 'foo' ]) @@ -513,13 +516,13 @@ database containing no objects, the caller should call error(). error() is guaranteed to return the error message if there was an error and undef if there was no error. -There are four types of searches currently. 'type' (with a given type) +There are four types of searches currently. C (with a given type) will return only those entries where the type matches the given type. -'owner', with a given owner, will only return those objects owned by the -given acl name. 'flag', with a given flag name, will only return those -items with a flag set to the given value. 'acl' operates like 'owner', -but will return only those objects that have the given acl name on any -of the possible acl settings, not just owner. +C, with a given owner, will only return those objects owned by the +given ACL name. C, with a given flag name, will only return those +items with a flag set to the given value. C operates like C, +but will return only those objects that have the given ACL name on any of +the possible ACL settings, not just owner. =item register_object (TYPE, CLASS) @@ -559,8 +562,8 @@ the error message if there was an error and undef if there was no error. wallet-admin(8) -This module is part of the wallet system. The current version is available -from L. +This module is part of the wallet system. The current version is +available from L. =head1 AUTHOR diff --git a/perl/Wallet/Config.pm b/perl/Wallet/Config.pm index ae8cf9c..c59d3e3 100644 --- a/perl/Wallet/Config.pm +++ b/perl/Wallet/Config.pm @@ -23,6 +23,11 @@ $PATH = $ENV{WALLET_CONFIG} || '/etc/wallet/wallet.conf'; Wallet::Config - Configuration handling for the wallet server +=for stopwords +DBI DSN SQLite subdirectories KEYTAB keytab kadmind KDC add-ons kadmin DNS +SRV kadmin keytabs remctl backend lowercased NETDB ACL NetDB unscoped +usernames rekey hostnames Allbery wallet-backend keytab-backend + =head1 SYNOPSIS use Wallet::Config; @@ -63,9 +68,9 @@ variable DB_DRIVER to C, use: $DB_DRIVER = 'MySQL'; -Always remember the initial dollar sign (C<$>) and ending semicolon (C<;>). -Those familiar with Perl syntax can of course use the full range of Perl -expressions. +Always remember the initial dollar sign (C<$>) and ending semicolon +(C<;>). Those familiar with Perl syntax can of course use the full range +of Perl expressions. This configuration file should end with the line: @@ -80,11 +85,11 @@ file. =item DB_DRIVER -Sets the Perl database driver to use for the wallet database. Common values -would be C or C. Less common values would be C, -C, or C. 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). +Sets the Perl database driver to use for the wallet database. Common +values would be C or C. Less common values would be +C, C, or C. 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). This variable must be set. @@ -95,8 +100,8 @@ our $DB_DRIVER; =item DB_INFO 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 +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 database driver you're using. @@ -111,9 +116,10 @@ our $DB_INFO; =item DB_NAME If DB_INFO is not set, specifies the database name. The third part of the -DBI connect string will be set to C, 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 you're using. +DBI connect string will be set to C, 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 +you're using. Either DB_INFO or DB_NAME must be set. @@ -124,8 +130,8 @@ 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) and -the documentation for the database driver you're using. +be appended to the DBI connect string. For more information, see DBI(3) +and the documentation for the database driver you're using. =cut @@ -135,8 +141,8 @@ 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 documentation -for the database driver you're using. +should also be set. For more information, see DBI(3) and the +documentation for the database driver you're using. =cut @@ -153,8 +159,8 @@ our $DB_USER; =item DB_PASSWORD -Specifies the password for database authentication. Some database backends, -particularly SQLite, do not need this. +Specifies the password for database authentication. Some database +backends, particularly SQLite, do not need this. =cut @@ -205,9 +211,10 @@ C object type (the Wallet::Object::Keytab class). =item KEYTAB_FILE Specifies the keytab to use to authenticate to B. The principal -whose key is stored in this keytab must have the ability to create, modify, -inspect, and delete any principals that should be managed by the wallet. -(In MIT Kerberos F parlance, this is C privileges.) +whose key is stored in this keytab must have the ability to create, +modify, inspect, and delete any principals that should be managed by the +wallet. (In MIT Kerberos F parlance, this is C +privileges.) KEYTAB_FILE must be set to use keytab objects. @@ -218,12 +225,13 @@ our $KEYTAB_FILE; =item KEYTAB_FLAGS These flags, if any, are passed to the C command when creating a -new principal in the Kerberos KDC. To not pass any flags, set KEYTAB_FLAGS -to the empty string. The default value is C<-clearpolicy>, which clears any -password strength policy from principals created by the wallet. (Since the -wallet randomizes the keys, password strength checking is generally -pointless and may interact poorly with the way C works -when third-party add-ons for password strength checking are used.) +new principal in the Kerberos KDC. To not pass any flags, set +KEYTAB_FLAGS to the empty string. The default value is C<-clearpolicy>, +which clears any password strength policy from principals created by the +wallet. (Since the wallet randomizes the keys, password strength checking +is generally pointless and may interact poorly with the way C works when third-party add-ons for password strength checking +are used.) =cut @@ -264,9 +272,9 @@ our $KEYTAB_KRBTYPE; The principal whose key is stored in KEYTAB_FILE. The wallet will authenticate as this principal to the kadmin service. -KEYTAB_PRINCIPAL must be set to use keytab objects, at least until B -is smart enough to use the first principal found in the keytab it's using -for authentication. +KEYTAB_PRINCIPAL must be set to use keytab objects, at least until +B is smart enough to use the first principal found in the keytab +it's using for authentication. =cut @@ -289,11 +297,11 @@ our $KEYTAB_REALM; =item KEYTAB_TMP A directory into which the wallet can write keytabs temporarily while -processing C commands from clients. The keytabs are written into this -directory with predictable names, so this should not be a system temporary -directory such as F or F. It's best to create a directory -solely for this purpose that's owned by the user the wallet server will run -as. +processing C commands from clients. The keytabs are written into +this directory with predictable names, so this should not be a system +temporary directory such as F or F. It's best to create a +directory solely for this purpose that's owned by the user the wallet +server will run as. KEYTAB_TMP must be set to use keytab objects. @@ -305,20 +313,20 @@ our $KEYTAB_TMP; =head2 Retrieving Existing Keytabs -The keytab object backend optionally supports retrieving existing keys, and -hence keytabs, for Kerberos principals by contacting the KDC via remctl and -talking to B. This is enabled by setting the C -flag on keytab objects. To configure that support, set the following -variables. +The keytab object backend optionally supports retrieving existing keys, +and hence keytabs, for Kerberos principals by contacting the KDC via +remctl and talking to B. This is enabled by setting the +C flag on keytab objects. To configure that support, set the +following variables. =over 4 =item KEYTAB_REMCTL_CACHE -Specifies the ticket cache to use when retrieving existing keytabs from the -KDC. This is only used to implement support for the C flag. -The ticket cache must be for a principal with access to run C via remctl on KEYTAB_REMCTL_HOST. +Specifies the ticket cache to use when retrieving existing keytabs from +the KDC. This is only used to implement support for the C +flag. The ticket cache must be for a principal with access to run +C via remctl on KEYTAB_REMCTL_HOST. =cut @@ -326,10 +334,10 @@ our $KEYTAB_REMCTL_CACHE; =item KEYTAB_REMCTL_HOST -The host to which to connect with remctl to retrieve existing keytabs. This -is only used to implement support for the C flag. This host -must provide the C command and KEYTAB_REMCTL_CACHE must -also be set to a ticket cache for a principal with access to run that +The host to which to connect with remctl to retrieve existing keytabs. +This is only used to implement support for the C flag. This +host must provide the C command and KEYTAB_REMCTL_CACHE +must also be set to a ticket cache for a principal with access to run that command. =cut @@ -339,9 +347,10 @@ our $KEYTAB_REMCTL_HOST; =item KEYTAB_REMCTL_PRINCIPAL The service principal to which to authenticate when retrieving existing -keytabs. This is only used to implement support for the C flag. -If this variable is not set, the default is formed by prepending C to -KEYTAB_REMCTL_HOST. (Note that KEYTAB_REMCTL_HOST is not lowercased first.) +keytabs. This is only used to implement support for the C +flag. If this variable is not set, the default is formed by prepending +C to KEYTAB_REMCTL_HOST. (Note that KEYTAB_REMCTL_HOST is not +lowercased first.) =cut @@ -365,18 +374,18 @@ our $KEYTAB_REMCTL_PORT; These configuration variables are only needed if you intend to use the C ACL type (the Wallet::ACL::NetDB class). They specify the remctl connection information for retrieving user roles from NetDB and the local -realm to remove from principals (since NetDB normally expects unscoped local -usernames). +realm to remove from principals (since NetDB normally expects unscoped +local usernames). =over 4 =item NETDB_REALM The wallet uses fully-qualified principal names (including the realm), but -NetDB normally expects local usernames without the realm. If this variable -is set, the given realm will be stripped from any principal names before -passing them to NetDB. Principals in other realms will be passed to NetDB -without modification. +NetDB normally expects local usernames without the realm. If this +variable is set, the given realm will be stripped from any principal names +before passing them to NetDB. Principals in other realms will be passed +to NetDB without modification. =cut @@ -385,9 +394,9 @@ our $NETDB_REALM; =item NETDB_REMCTL_CACHE Specifies the ticket cache to use when querying the NetDB remctl interface -for user roles. The ticket cache must be for a principal with access to run -C via remctl on KEYTAB_REMCTL_HOST. This variable must be -set to use NetDB ACLs. +for user roles. The ticket cache must be for a principal with access to +run C via remctl on KEYTAB_REMCTL_HOST. This variable +must be set to use NetDB ACLs. =cut @@ -406,10 +415,10 @@ our $NETDB_REMCTL_HOST; =item NETDB_REMCTL_PRINCIPAL -The service principal to which to authenticate when querying NetDB for user -roles. If this variable is not set, the default is formed by prepending -C to NETDB_REMCTL_HOST. (Note that NETDB_REMCTL_HOST is not -lowercased first.) +The service principal to which to authenticate when querying NetDB for +user roles. If this variable is not set, the default is formed by +prepending C to NETDB_REMCTL_HOST. (Note that NETDB_REMCTL_HOST is +not lowercased first.) =cut @@ -417,9 +426,9 @@ our $NETDB_REMCTL_PRINCIPAL; =item NETDB_REMCTL_PORT -The port on NETDB_REMCTL_HOST to which to connect with remctl to query NetDB -for user roles. If this variable is not set, the default remctl port will -be used. +The port on NETDB_REMCTL_HOST to which to connect with remctl to query +NetDB for user roles. If this variable is not set, the default remctl +port will be used. =cut @@ -430,17 +439,18 @@ our $NETDB_REMCTL_PORT; =head1 DEFAULT OWNERS By default, only users in the ADMIN ACL can create new objects in the -wallet. To allow other users to create new objects, define a Perl function -named default_owner. This function will be called whenever a non-ADMIN user -tries to create a new object and will be passed the type and name of the -object. It should return undef if there is no default owner for that -object. If there is, it should return a list containing the name to use for -the ACL and then zero or more anonymous arrays of two elements each giving -the type and identifier for each ACL entry. - -For example, the following simple function says to use a default owner named -C with one entry of type C and identifier C -for the object with type C and name C: +wallet. To allow other users to create new objects, define a Perl +function named default_owner. This function will be called whenever a +non-ADMIN user tries to create a new object and will be passed the type +and name of the object. It should return undef if there is no default +owner for that object. If there is, it should return a list containing +the name to use for the ACL and then zero or more anonymous arrays of two +elements each giving the type and identifier for each ACL entry. + +For example, the following simple function says to use a default owner +named C with one entry of type C and identifier +C for the object with type C and name +C: sub default_owner { my ($type, $name) = @_; @@ -453,8 +463,8 @@ for the object with type C and name C: Of course, normally this function is used for more complex mappings. Here is a more complete example. For objects of type keytab corresponding to -various types of per-machine principals, return a default owner that sets as -owner anyone with a NetDB role for that system and the system's host +various types of per-machine principals, return a default owner that sets +as owner anyone with a NetDB role for that system and the system's host principal. This permits authorization management using NetDB while also allowing the system to bootstrap itself once the host principal has been downloaded and rekey itself using the old host principal. @@ -474,17 +484,19 @@ downloaded and rekey itself using the old host principal. return ($acl_name, @acl); } -The auto-created ACL used for the owner of the new object will, in the above -example, be named C> where I is the fully-qualified -name of the system as derived from the keytab being requested. - -If the name of the ACL returned by the default_owner function matches an ACL -that already exists in the wallet database, the existing ACL will be -compared to the default ACL returned by the default_owner function. If the -existing ACL has the same entries as the one returned by default_owner, -creation continues if the user is authorized by that ACL. If they don't -match, creation of the object is rejected, since the presence of an existing -ACL may indicate that something different is being done with this object. +The auto-created ACL used for the owner of the new object will, in the +above example, be named C> where I is the +fully-qualified name of the system as derived from the keytab being +requested. + +If the name of the ACL returned by the default_owner function matches an +ACL that already exists in the wallet database, the existing ACL will be +compared to the default ACL returned by the default_owner function. If +the existing ACL has the same entries as the one returned by +default_owner, creation continues if the user is authorized by that ACL. +If they don't match, creation of the object is rejected, since the +presence of an existing ACL may indicate that something different is being +done with this object. =head1 NAMING ENFORCEMENT diff --git a/perl/Wallet/Database.pm b/perl/Wallet/Database.pm index 68fb6bb..7b3474a 100644 --- a/perl/Wallet/Database.pm +++ b/perl/Wallet/Database.pm @@ -6,7 +6,7 @@ # like DBI objects in the rest of the code. # # Written by Russ Allbery -# Copyright 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008, 2010 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -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.01'; +$VERSION = '0.02'; ############################################################################## # Core overrides @@ -84,6 +84,9 @@ __END__ Wallet::Dabase - Wrapper module for wallet database connections +=for stopwords +DBI RaiseError PrintError AutoCommit Allbery + =head1 SYNOPSIS use Wallet::Database; @@ -93,9 +96,9 @@ Wallet::Dabase - Wrapper module for wallet database connections Wallet::Database is a thin wrapper module around DBI that takes care of building a connect string and setting database options based on wallet -configuration. The only overriden method is connect(). All other methods -should work the same as in DBI and Wallet::Database objects should be -usable exactly as if they were DBI objects. +configuration. The only overridden method is connect(). All other +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 @@ -120,8 +123,8 @@ configuration. DBI(3), Wallet::Config(3) -This module is part of the wallet system. The current version is available -from L. +This module is part of the wallet system. The current version is +available from L. =head1 AUTHOR diff --git a/perl/Wallet/Kadmin.pm b/perl/Wallet/Kadmin.pm index 65ddf4b..b653f87 100644 --- a/perl/Wallet/Kadmin.pm +++ b/perl/Wallet/Kadmin.pm @@ -55,6 +55,9 @@ __END__ # Documentation ############################################################################## +=for stopwords +Kadmin keytabs keytab Heimdal API kadmind kadmin + =head1 NAME Wallet::Kadmin - Kadmin module wrapper for wallet keytabs @@ -69,21 +72,21 @@ Wallet::Kadmin - Kadmin module wrapper for wallet keytabs =head1 DESCRIPTION -Wallet::Kadmin is a wrapper to modules that provide an interface for keytab -integration with the wallet. Each module is meant to interface with a -specific type of Kerberos implementation, such as MIT Kerberos or Heimdal -Kerberos, and provide a standndard set of API calls used to interact with -that implementation's kadmind. +Wallet::Kadmin is a wrapper to modules that provide an interface for +keytab integration with wallet. Each module is meant to interface with a +specific type of Kerberos implementation, such as MIT Kerberos or Heimdal, +and provide a standard set of API calls used to interact with that +implementation's kadmin interface. The class simply uses Wallet::Config to find which type of kadmind we have requested to use, and then returns an object to use for interacting with that kadmind. A keytab is an on-disk store for the key or keys for a Kerberos principal. -Keytabs are used by services to verify incoming authentication from clients -or by automated processes that need to authenticate to Kerberos. To create -a keytab, the principal has to be created in Kerberos and then a keytab is -generated and stored in a file on disk. +Keytabs are used by services to verify incoming authentication from +clients or by automated processes that need to authenticate to Kerberos. +To create a keytab, the principal has to be created in Kerberos and then a +keytab is generated and stored in a file on disk. To use this object, several configuration parameters must be set. See Wallet::Config(3) for details on those configuration parameters and @@ -95,9 +98,9 @@ information about how to set wallet configuration. =item new() -Finds the proper Kerberos implementation and calls the new() constructor for -that implementation's module, returning the result. If the implementation -is not recognized or set, die with an error message. +Finds the proper Kerberos implementation and calls the new() constructor +for that implementation's module, returning the result. If the +implementation is not recognized or set, die with an error message. =back @@ -105,8 +108,8 @@ is not recognized or set, die with an error message. kadmin(8), Wallet::Config(3), Wallet::Object::Keytab(3), wallet-backend(8) -This module is part of the wallet system. The current version is available -from L. +This module is part of the wallet system. The current version is +available from L. =head1 AUTHORS diff --git a/perl/Wallet/Kadmin/Heimdal.pm b/perl/Wallet/Kadmin/Heimdal.pm index 428202b..2ad35e3 100644 --- a/perl/Wallet/Kadmin/Heimdal.pm +++ b/perl/Wallet/Kadmin/Heimdal.pm @@ -230,9 +230,12 @@ __END__ # Documentation ############################################################################## +=for stopwords +keytabs keytab kadmin enctypes API ENCTYPES enctype Allbery Heimdal + =head1 NAME -Wallet::Kadmin::MIT - MIT admin interactions for wallet keytabs +Wallet::Kadmin::Heimdal - Heimdal admin interactions for wallet keytabs =head1 SYNOPSIS @@ -244,18 +247,18 @@ Wallet::Kadmin::MIT - MIT admin interactions for wallet keytabs =head1 DESCRIPTION -Wallet::Kadmin::MIT is an interface for keytab integration with the wallet, -specifically for using kadmin to create, delete, and add enctypes to keytabs. -It implments the wallet kadmin API and provides the necessary glue to MIT -Kerberos installs for each of these functions, while allowing the wallet -to keep the details of what type of Kerberos installation is being used -abstracted. +Wallet::Kadmin::Heimdal is an interface for keytab integration with the +wallet, specifically for using kadmin to create, delete, and add enctypes +to keytabs. It implements the wallet kadmin API and provides the +necessary glue to Heimdal installs for each of these functions, while +allowing the wallet to keep the details of what type of Kerberos +installation is being used abstracted. A keytab is an on-disk store for the key or keys for a Kerberos principal. -Keytabs are used by services to verify incoming authentication from clients -or by automated processes that need to authenticate to Kerberos. To create -a keytab, the principal has to be created in Kerberos and then a keytab is -generated and stored in a file on disk. +Keytabs are used by services to verify incoming authentication from +clients or by automated processes that need to authenticate to Kerberos. +To create a keytab, the principal has to be created in Kerberos and then a +keytab is generated and stored in a file on disk. To use this object, several configuration parameters must be set. See Wallet::Config(3) for details on those configuration parameters and @@ -268,17 +271,17 @@ information about how to set wallet configuration. =item addprinc(PRINCIPAL) Adds a new principal with a given name. The principal is created with a -random password, and any other flags set by Wallet::Config. Returns true on -success, or throws an error if there was a failure in adding the principal. -If the principal already exists, return true as we are bringing our -expectations in line with reality. +random password, and any other flags set by Wallet::Config. Returns true +on success, or throws an error if there was a failure in adding the +principal. If the principal already exists, return true as we are +bringing our expectations in line with reality. =item addprinc(PRINCIPAL) -Removes a principal with the given name. Returns true on success, or throws -an error if there was a failure in removing the principal. If the principal -does not exist, return true as we are bringing our expectations in line with -reality. +Removes a principal with the given name. Returns true on success, or +throws an error if there was a failure in removing the principal. If the +principal does not exist, return true as we are bringing our expectations +in line with reality. =item ktadd(PRINCIPAL, FILE, ENCTYPES) @@ -290,19 +293,12 @@ otherwise true is returned. =back -=head1 LIMITATIONS - -Currently, this implementation calls an external B program rather - than using a native Perl module and therefore requires B be -installed and parses its output. It may miss some error conditions if the -output of B ever changes. - =head1 SEE ALSO kadmin(8), Wallet::Config(3), Wallet::Object::Keytab(3), wallet-backend(8) -This module is part of the wallet system. The current version is available -from L. +This module is part of the wallet system. The current version is +available from L. =head1 AUTHORS diff --git a/perl/Wallet/Kadmin/MIT.pm b/perl/Wallet/Kadmin/MIT.pm index 49691b0..8449868 100644 --- a/perl/Wallet/Kadmin/MIT.pm +++ b/perl/Wallet/Kadmin/MIT.pm @@ -226,6 +226,9 @@ __END__ # Documentation ############################################################################## +=for stopwords +keytabs keytab kadmin enctype enctypes API ENCTYPES Allbery + =head1 NAME Wallet::Kadmin::MIT - MIT admin interactions for wallet keytabs @@ -240,18 +243,18 @@ Wallet::Kadmin::MIT - MIT admin interactions for wallet keytabs =head1 DESCRIPTION -Wallet::Kadmin::MIT is an interface for keytab integration with the wallet, -specifically for using kadmin to create, delete, and add enctypes to keytabs. -It implments the wallet kadmin API and provides the necessary glue to MIT -Kerberos installs for each of these functions, while allowing the wallet -to keep the details of what type of Kerberos installation is being used -abstracted. +Wallet::Kadmin::MIT is an interface for keytab integration with the +wallet, specifically for using kadmin to create, delete, and add enctypes +to keytabs. It implements the wallet kadmin API and provides the +necessary glue to MIT Kerberos installs for each of these functions, while +allowing the wallet to keep the details of what type of Kerberos +installation is being used abstracted. A keytab is an on-disk store for the key or keys for a Kerberos principal. -Keytabs are used by services to verify incoming authentication from clients -or by automated processes that need to authenticate to Kerberos. To create -a keytab, the principal has to be created in Kerberos and then a keytab is -generated and stored in a file on disk. +Keytabs are used by services to verify incoming authentication from +clients or by automated processes that need to authenticate to Kerberos. +To create a keytab, the principal has to be created in Kerberos and then a +keytab is generated and stored in a file on disk. To use this object, several configuration parameters must be set. See Wallet::Config(3) for details on those configuration parameters and @@ -264,17 +267,17 @@ information about how to set wallet configuration. =item addprinc(PRINCIPAL) Adds a new principal with a given name. The principal is created with a -random password, and any other flags set by Wallet::Config. Returns true on -success, or throws an error if there was a failure in adding the principal. -If the principal already exists, return true as we are bringing our -expectations in line with reality. +random password, and any other flags set by Wallet::Config. Returns true +on success, or throws an error if there was a failure in adding the +principal. If the principal already exists, return true as we are +bringing our expectations in line with reality. -=item addprinc(PRINCIPAL) +=item delprinc(PRINCIPAL) -Removes a principal with the given name. Returns true on success, or throws -an error if there was a failure in removing the principal. If the principal -does not exist, return true as we are bringing our expectations in line with -reality. +Removes a principal with the given name. Returns true on success, or +throws an error if there was a failure in removing the principal. If the +principal does not exist, return true as we are bringing our expectations +in line with reality. =item ktadd(PRINCIPAL, FILE, ENCTYPES) @@ -297,8 +300,8 @@ output of B ever changes. kadmin(8), Wallet::Config(3), Wallet::Object::Keytab(3), wallet-backend(8) -This module is part of the wallet system. The current version is available -from L. +This module is part of the wallet system. The current version is +available from L. =head1 AUTHORS diff --git a/perl/Wallet/Object/Base.pm b/perl/Wallet/Object/Base.pm index fea0320..5097729 100644 --- a/perl/Wallet/Object/Base.pm +++ b/perl/Wallet/Object/Base.pm @@ -1,7 +1,7 @@ # Wallet::Object::Base -- Parent class for any object stored in the wallet. # # Written by Russ Allbery -# 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. @@ -22,7 +22,7 @@ use Wallet::ACL; # 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'; ############################################################################## # Constructors @@ -669,6 +669,10 @@ __END__ Wallet::Object::Base - Generic parent class for wallet objects +=for stopwords +DBH HOSTNAME DATETIME ACL backend metadata timestamp Allbery wallet-backend +backend-specific + =head1 SYNOPSIS package Wallet::Object::Simple; @@ -682,104 +686,107 @@ Wallet::Object::Base - Generic parent class for wallet objects =head1 DESCRIPTION Wallet::Object::Base is the generic parent class for wallet objects (data -types that can be stored in the wallet system). It provides defualt +types that can be stored in the wallet system). It provides default functions and behavior, including handling generic object settings. All handlers for objects stored in the wallet should inherit from it. It is not used directly. =head1 PUBLIC CLASS METHODS -The following methods are called by the rest of the wallet system and should -be implemented by all objects stored in the wallet. They should be called -with the desired wallet object class as the first argument (generally using -the Wallet::Object::Type->new syntax). +The following methods are called by the rest of the wallet system and +should be implemented by all objects stored in the wallet. They should be +called with the desired wallet object class as the first argument +(generally using the Wallet::Object::Type->new syntax). =over 4 =item new(TYPE, NAME, DBH) Creates a new object with the given object type and name, based on data -already in the database. This method will only succeed if an object of the -given TYPE and NAME is already present in the wallet database. If no such -object exits, throws an exception. Otherwise, returns an object blessed -into the class used for the new() call (so subclasses can leave this method -alone and not override it). +already in the database. This method will only succeed if an object of +the given TYPE and NAME is already present in the wallet database. If no +such object exits, throws an exception. Otherwise, returns an object +blessed into the class used for the new() call (so subclasses can leave +this method alone and not override it). -Takes a Wallet::Database object, which is stored in the object and used for -any further operations. +Takes a Wallet::Database object, which is stored in the object and used +for any further operations. =item create(TYPE, NAME, DBH, PRINCIPAL, HOSTNAME [, DATETIME]) Similar to new() but instead creates a new entry in the database. This method will throw an exception if an entry for that type and name already -exists in the database or if creating the database record fails. Otherwise, -a new database entry will be created with that type and name, no owner, no -ACLs, no expiration, no flags, and with created by, from, and on set to the -PRINCIPAL, HOSTNAME, and DATETIME parameters. If DATETIME isn't given, the -current time is used. The database handle is treated as with new(). +exists in the database or if creating the database record fails. +Otherwise, a new database entry will be created with that type and name, +no owner, no ACLs, no expiration, no flags, and with created by, from, and +on set to the PRINCIPAL, HOSTNAME, and DATETIME parameters. If DATETIME +isn't given, the current time is used. The database handle is treated as +with new(). =back =head1 PUBLIC INSTANCE METHODS The following methods may be called on instantiated wallet objects. -Normally, the only methods that a subclass will need to override are get(), -store(), show(), and destroy(). +Normally, the only methods that a subclass will need to override are +get(), store(), show(), and destroy(). -If the locked flag is set on an object, no actions may be performed on that -object except for the flag methods and show(). All other actions will be -rejected with an error saying the object is locked. +If the locked flag is set on an object, no actions may be performed on +that object except for the flag methods and show(). All other actions +will be rejected with an error saying the object is locked. =over 4 =item acl(TYPE [, ACL, PRINCIPAL, HOSTNAME [, DATETIME]]) -Sets or retrieves a given object ACL as a numeric ACL ID. TYPE must be one -of C, C, C, C, or C, corresponding to the -ACLs kept on an object. If no other arguments are given, returns the -current ACL setting as an ACL ID or undef if that ACL isn't set. If other -arguments are given, change that ACL to ACL and return true on success and -false on failure. Pass in the empty string for ACL to clear the ACL. 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. +Sets or retrieves a given object ACL as a numeric ACL ID. TYPE must be +one of C, C, C, C, or C, corresponding +to the ACLs kept on an object. If no other arguments are given, returns +the current ACL setting as an ACL ID or undef if that ACL isn't set. If +other arguments are given, change that ACL to ACL and return true on +success and false on failure. Pass in the empty string for ACL to clear +the ACL. 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 attr(ATTRIBUTE [, VALUES, PRINCIPAL, HOSTNAME [, DATETIME]]) Sets or retrieves a given object attribute. Attributes are used to store -backend-specific information for a particular object type and ATTRIBUTE must -be an attribute type known to the underlying object implementation. The -default implementation of this method rejects all attributes as unknown. +backend-specific information for a particular object type and ATTRIBUTE +must be an attribute type known to the underlying object implementation. +The default implementation of this method rejects all attributes as +unknown. If no other arguments besides ATTRIBUTE are given, returns the values of that attribute, if any, as a list. On error, returns the empty list. To -distinguish between an error and an empty return, call error() afterwards. +distinguish between an error and an empty return, call error() afterward. It is guaranteed to return undef unless there was an error. If other arguments are given, sets the given ATTRIBUTE values to VALUES, -which must be a reference to an array (even if only one value is being set). -Pass a reference to an empty array to clear the attribute values. 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. Returns true -on success and false on failure. +which must be a reference to an array (even if only one value is being +set). Pass a reference to an empty array to clear the attribute values. +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. Returns true on success and false on failure. =item attr_show() -Returns a formatted text description of the type-specific attributes of the -object, or undef on error. The default implementation of this method always -returns the empty string. If there are any type-specific 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. +Returns a formatted text description of the type-specific attributes of +the object, or undef on error. The default implementation of this method +always returns the empty string. If there are any type-specific +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 destroy(PRINCIPAL, HOSTNAME [, DATETIME]) Destroys the object by removing all record of it from the database. The -Wallet::Object::Base implementation handles the generic database work, -but any subclass should override this method to do any deletion of files -or entries in external databases and any other database entries and then -call the parent method to handle the generic database cleanup. Returns -true on success and false on failure. The arguments are used for logging -and history and should indicate the user and host from which the change is +Wallet::Object::Base implementation handles the generic database work, but +any subclass should override this method to do any deletion of files or +entries in external databases and any other database entries and then call +the parent method to handle the generic database cleanup. Returns true on +success and false on failure. The 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 error([ERROR ...]) @@ -789,47 +796,50 @@ have failed. Callers should call this function to get the error message after an undef return from any other instance method. For the convenience of child classes, this method can also be called with -one or more error strings. If so, those strings are concatenated together, -trailing newlines are removed, any text of the form S> at the end of the message is stripped off, and the result is stored -as the error. Only child classes should call this method with an error -string. +one or more error strings. If so, those strings are concatenated +together, trailing newlines are removed, any text of the form S> at the end of the message is stripped off, and the result is +stored as the error. Only child classes should call this method with an +error string. =item expires([EXPIRES, PRINCIPAL, HOSTNAME [, DATETIME]]) Sets or retrieves the expiration date of an object. If no arguments are -given, returns the current expiration or undef if no expiration is set. If -arguments are given, change the expiration to EXPIRES and return true on -success and false on failure. EXPIRES must be in the format C, although the time portion may be omitted. Pass in the empty -string for EXPIRES to clear the expiration date. - -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. +given, returns the current expiration or undef if no expiration is set. +If arguments are given, change the expiration to EXPIRES and return true +on success and false on failure. EXPIRES must be in the format +C, although the time portion may be omitted. Pass in +the empty string for EXPIRES to clear the expiration date. + +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 flag_check(FLAG) -Check whether the given flag is set on an object. Returns true if set, C<0> -if not set, and undef on error. +Check whether the given flag is set on an object. Returns true if set, +C<0> if not set, and undef on error. =item flag_clear(FLAG, PRINCIPAL, HOSTNAME [, DATETIME]) Clears FLAG on an object. Returns true on success and false on failure. -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. +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 flag_list() List the flags set on an object. If no flags are set, returns the empty -list. On failure, returns an empty list. To distinguish between the empty -response and an error, the caller should call error() after an empty return. -It is guaranteed to return undef if there was no error. +list. On failure, returns an empty list. To distinguish between the +empty response and an error, the caller should call error() after an empty +return. It is guaranteed to return undef if there was no error. =item flag_set(FLAG, PRINCIPAL, HOSTNAME [, DATETIME]) Sets FLAG on an object. Returns true on success and false on failure. -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. +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 get(PRINCIPAL, HOSTNAME [, DATETIME]) @@ -856,9 +866,9 @@ Sets or retrieves the owner of an object as a numeric ACL ID. If no arguments are given, returns the current owner ACL ID or undef if none is set. If arguments are given, change the owner to OWNER and return true on success and false on failure. Pass in the empty string for OWNER to clear -the owner. 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. +the owner. 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 show() @@ -866,17 +876,17 @@ Returns a formatted text description of the object suitable for human display, or undef on error. All of the base metadata about the object, formatted as key: value pairs with the keys aligned in the first 15 characters followed by a space, a colon, and the value. The attr_show() -method of the object is also called and any formatted output it returns will -be included. If any ACLs or an owner are set, after this data there is a -blank line and then the information for each unique ACL, separated by blank -lines. +method of the object is also called and any formatted output it returns +will be included. If any ACLs or an owner are set, after this data there +is a blank line and then the information for each unique ACL, separated by +blank lines. =item store(DATA, PRINCIPAL, HOSTNAME [, DATETIME]) Store user-supplied data into the given object. This may not be supported -by all backends (for instance, backends that automatically generate the data -will not support this). The default implementation rejects all store() -calls with an error message saying that the object is immutable. +by all backends (for instance, backends that automatically generate the +data will not support this). The default implementation rejects all +store() calls with an error message saying that the object is immutable. =item type() @@ -894,23 +904,24 @@ provided for subclasses to call to implement some generic actions. =item log_action (ACTION, PRINCIPAL, HOSTNAME, DATETIME) Updates the history tables and trace information appropriately for ACTION, -which should be either C or C. No other changes are made to the -database, just updates of the history table and trace fields with the +which should be either C or C. No other changes are made to +the database, just updates of the history table and trace fields with the provided data about who performed the action and when. -This function commits its transaction when complete and therefore should not -be called inside another transaction. Normally it's called as a separate -transaction after the data is successfully stored or retrieved. +This function commits its transaction when complete and therefore should +not be called inside another transaction. Normally it's called as a +separate transaction after the data is successfully stored or retrieved. =item log_set (FIELD, OLD, NEW, PRINCIPAL, HOSTNAME, DATETIME) -Updates the history tables for the change in a setting value for an object. -FIELD should be one of C, C, C, C, -C, C, C, C, or a value starting with -C followed by a space and a type-specific field name. The last -form is the most common form used by a subclass. OLD is the previous value -of the field or undef if the field was unset, and NEW is the new value of -the field or undef if the field should be unset. +Updates the history tables for the change in a setting value for an +object. FIELD should be one of C, C, C, +C, C, C, C, C, or a +value starting with C followed by a space and a type-specific +field name. The last form is the most common form used by a subclass. +OLD is the previous value of the field or undef if the field was unset, +and NEW is the new value of the field or undef if the field should be +unset. This function does not commit and does not catch database exceptions. It should normally be called as part of a larger transaction that implements @@ -922,8 +933,8 @@ the change in the setting. wallet-backend(8) -This module is part of the wallet system. The current version is available -from L. +This module is part of the wallet system. The current version is +available from L. =head1 AUTHOR diff --git a/perl/Wallet/Object/File.pm b/perl/Wallet/Object/File.pm index be72d7f..69262f6 100644 --- a/perl/Wallet/Object/File.pm +++ b/perl/Wallet/Object/File.pm @@ -1,7 +1,7 @@ # Wallet::Object::File -- File object implementation for the wallet. # # Written by Russ Allbery -# Copyright 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008, 2010 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -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.01'; +$VERSION = '0.02'; ############################################################################## # File naming @@ -136,6 +136,9 @@ __END__ Wallet::Object::File - File object implementation for wallet +=for stopwords +API HOSTNAME DATETIME keytab remctld backend nul Allbery wallet-backend + =head1 SYNOPSIS my @name = qw(file mysql-lsdb) @@ -163,17 +166,18 @@ set wallet configuration. =head1 METHODS This object mostly inherits from Wallet::Object::Base. See the -documentation for that class for all generic methods. Below are only those -methods that are overridden or behave specially for this implementation. +documentation for that class for all generic methods. Below are only +those methods that are overridden or behave specially for this +implementation. =over 4 =item destroy(PRINCIPAL, HOSTNAME [, DATETIME]) Destroys a file object by removing it from the database and deleting the -corresonding file on the wallet server. Returns true on success and false -on failure. The caller should call error() to get the error message after -a failure. PRINCIPAL, HOSTNAME, and DATETIME are stored as history +corresponding file on the wallet server. Returns true on success and +false on failure. The caller should call error() to get the error message +after a failure. PRINCIPAL, HOSTNAME, and DATETIME are stored as history information. PRINCIPAL should be the user who is destroying the object. If DATETIME isn't given, the current time is used. diff --git a/perl/Wallet/Object/Keytab.pm b/perl/Wallet/Object/Keytab.pm index b604907..760280f 100644 --- a/perl/Wallet/Object/Keytab.pm +++ b/perl/Wallet/Object/Keytab.pm @@ -382,6 +382,10 @@ __END__ # Documentation ############################################################################## +=for stopwords +keytab API KDC keytabs HOSTNAME DATETIME enctypes enctype DBH metadata +unmanaged kadmin Allbery + =head1 NAME Wallet::Object::Keytab - Keytab object implementation for wallet @@ -396,17 +400,17 @@ Wallet::Object::Keytab - Keytab object implementation for wallet =head1 DESCRIPTION -Wallet::Object::Keytab is a representation of Kerberos keytab objects in the -wallet. It implements the wallet object API and provides the necessary -glue to create principals in a Kerberos KDC, create and return keytabs for -those principals, and delete them out of Kerberos when the wallet object is -destroyed. +Wallet::Object::Keytab is a representation of Kerberos keytab objects in +the wallet. It implements the wallet object API and provides the +necessary glue to create principals in a Kerberos KDC, create and return +keytabs for those principals, and delete them out of Kerberos when the +wallet object is destroyed. A keytab is an on-disk store for the key or keys for a Kerberos principal. -Keytabs are used by services to verify incoming authentication from clients -or by automated processes that need to authenticate to Kerberos. To create -a keytab, the principal has to be created in Kerberos and then a keytab is -generated and stored in a file on disk. +Keytabs are used by services to verify incoming authentication from +clients or by automated processes that need to authenticate to Kerberos. +To create a keytab, the principal has to be created in Kerberos and then a +keytab is generated and stored in a file on disk. This implementation generates a new random key (and hence invalidates all existing keytabs) each time the keytab is retrieved with the get() method. @@ -418,8 +422,9 @@ information about how to set wallet configuration. =head1 METHODS This object mostly inherits from Wallet::Object::Base. See the -documentation for that class for all generic methods. Below are only those -methods that are overridden or behave specially for this implementation. +documentation for that class for all generic methods. Below are only +those methods that are overridden or behave specially for this +implementation. =over 4 @@ -453,12 +458,12 @@ enctypes than those requested by this attribute. If no other arguments besides ATTRIBUTE are given, returns the values of that attribute, if any, as a list. On error, returns the empty list. To -distinguish between an error and an empty return, call error() afterwards. +distinguish between an error and an empty return, call error() afterward. It is guaranteed to return undef unless there was an error. If other arguments are given, sets the given ATTRIBUTE values to VALUES, -which must be a reference to an array (even if only one value is being set). -Pass a reference to an empty array to clear the attribute values. +which must be a reference to an array (even if only one value is being +set). Pass a reference to an empty array to clear the attribute values. PRINCIPAL, HOSTNAME, and DATETIME are stored as history information. PRINCIPAL should be the user who is destroying the object. If DATETIME isn't given, the current time is used. @@ -467,12 +472,12 @@ isn't given, the current time is used. This is a class method and should be called on the Wallet::Object::Keytab class. It creates a new object with the given TYPE and NAME (TYPE is -normally C and must be for the rest of the wallet system to use the -right class, but this module doesn't check for ease of subclassing), using -DBH as the handle to the wallet metadata database. PRINCIPAL, HOSTNAME, and -DATETIME are stored as history information. PRINCIPAL should be the user -who is creating the object. If DATETIME isn't given, the current time is -used. +normally C and must be for the rest of the wallet system to use +the right class, but this module doesn't check for ease of subclassing), +using DBH as the handle to the wallet metadata database. PRINCIPAL, +HOSTNAME, and DATETIME are stored as history information. PRINCIPAL +should be the user who is creating the object. If DATETIME isn't given, +the current time is used. When a new keytab object is created, the Kerberos principal designated by NAME is also created in the Kerberos realm determined from the wallet @@ -515,9 +520,9 @@ used. =item KEYTAB_TMP/keytab. -The keytab is created in this file using C and then read into memory. -KEYTAB_TMP is set in the wallet configuration, and is the process ID -of the current process. The file is unlinked after being read. +The keytab is created in this file using C and then read into +memory. KEYTAB_TMP is set in the wallet configuration, and is the +process ID of the current process. The file is unlinked after being read. =back @@ -536,8 +541,8 @@ wallet database do not have realm information. kadmin(8), Wallet::Config(3), Wallet::Object::Base(3), wallet-backend(8) -This module is part of the wallet system. The current version is available -from L. +This module is part of the wallet system. The current version is +available from L. =head1 AUTHOR diff --git a/perl/Wallet/Schema.pm b/perl/Wallet/Schema.pm index 252da03..589a15d 100644 --- a/perl/Wallet/Schema.pm +++ b/perl/Wallet/Schema.pm @@ -133,6 +133,10 @@ __DATA__ Wallet::Schema - Database schema for the wallet system +=for stopwords +SQL ACL API APIs enums Enums Keytab Backend keytab backend enctypes +enctype Allbery + =head1 SYNOPSIS use Wallet::Schema; @@ -157,30 +161,30 @@ MySQL and may require some modifications for other databases. =item new() -Instantiates a new Wallet::Schema object. This parses the documentation and -extracts the schema, but otherwise doesn't do anything. +Instantiates a new Wallet::Schema object. This parses the documentation +and extracts the schema, but otherwise doesn't do anything. =item create(DBH) -Given a connected database handle, runs the SQL commands necessary to create -the wallet database in an otherwise empty database. This method will not -drop any existing tables and will therefore fail if a wallet database has -already been created. On any error, this method will throw a database -exception. +Given a connected database handle, runs the SQL commands necessary to +create the wallet database in an otherwise empty database. This method +will not drop any existing tables and will therefore fail if a wallet +database has already been created. On any error, this method will throw a +database exception. =item drop(DBH) Given a connected database handle, drop all of the wallet tables from that -database if any of those tables exist. This method will only remove tables -that are part of the current schema or one of the previous known schema and -won't remove other tables. On any error, this method will throw a database -exception. +database if any of those tables exist. This method will only remove +tables that are part of the current schema or one of the previous known +schema and won't remove other tables. On any error, this method will +throw a database exception. =item sql() -Returns the schema and the population of the normalization tables as a list -of SQL commands to run to create the wallet database in an otherwise empty -database. +Returns the schema and the population of the normalization tables as a +list of SQL commands to run to create the wallet database in an otherwise +empty database. =back @@ -188,8 +192,8 @@ database. =head2 Normalization Tables -The following are normalization tables used to constrain the values in other -tables. +The following are normalization tables used to constrain the values in +other tables. Holds the supported flag names: @@ -221,16 +225,16 @@ Holds the supported ACL schemes and their corresponding Perl classes: values ('netdb-root', 'Wallet::ACL::NetDB::Root'); If you have extended the wallet to support additional object types or -additional ACL schemes, you will want to add additional rows to these tables -mapping those types or schemes to Perl classes that implement the object or -ACL verifier APIs. +additional ACL schemes, you will want to add additional rows to these +tables mapping those types or schemes to Perl classes that implement the +object or ACL verifier APIs. =head2 ACL Tables -A wallet ACL consists of zero or more ACL entries, each of which is a scheme -and an identifier. The scheme identifies the check that should be performed -and the identifier is additional scheme-specific information. Each ACL -references entries in the following table: +A wallet ACL consists of zero or more ACL entries, each of which is a +scheme and an identifier. The scheme identifies the check that should be +performed and the identifier is additional scheme-specific information. +Each ACL references entries in the following table: create table acls (ac_id integer auto_increment primary key, @@ -249,8 +253,9 @@ in: create index ae_id on acl_entries (ae_id); ACLs may be referred to in the API via either the numeric ID or the -human-readable name, but internally ACLs are always referenced by numeric ID -so that they can be renamed without requiring complex data modifications. +human-readable name, but internally ACLs are always referenced by numeric +ID so that they can be renamed without requiring complex data +modifications. Currently, the ACL named C (case-sensitive) is special-cased in the Wallet::Server code and granted global access. @@ -269,17 +274,18 @@ table. ah_on datetime not null); create index ah_acl on acl_history (ah_acl); -ah_action must be one of C, C, C, or C (enums -aren't used for compatibility with databases other than MySQL). For a -change of type create or destroy, only the action and the trace records (by, -from, and on) are stored. For a change to the lines of an ACL, the scheme -and identifier of the line that was added or removed is included. Note that -changes to the ACL name are not recorded; ACLs are always tracked by -system-generated ID, so name changes are purely cosmetic. +ah_action must be one of C, C, C, or C +(enums aren't used for compatibility with databases other than MySQL). +For a change of type create or destroy, only the action and the trace +records (by, from, and on) are stored. For a change to the lines of an +ACL, the scheme and identifier of the line that was added or removed is +included. Note that changes to the ACL name are not recorded; ACLs are +always tracked by system-generated ID, so name changes are purely +cosmetic. -ah_by stores the authenticated identity that made the change, ah_from stores -the host from which they made the change, and ah_on stores the time the -change was made. +ah_by stores the authenticated identity that made the change, ah_from +stores the host from which they made the change, and ah_on stores the time +the change was made. =head2 Object Tables @@ -311,13 +317,13 @@ table: create index ob_expires on objects (ob_expires); Object names are not globally unique but only unique within their type, so -the table has a joint primary key. Each object has an owner and then up to -five more specific ACLs. The owner provides permission for get, store, and -show operations if no more specific ACL is set. It does not provide +the table has a joint primary key. Each object has an owner and then up +to five more specific ACLs. The owner provides permission for get, store, +and show operations if no more specific ACL is set. It does not provide permission for destroy or flags. -The ob_acl_flags ACL controls who can set flags on this object. Each object -may have zero or more flags associated with it: +The ob_acl_flags ACL controls who can set flags on this object. Each +object may have zero or more flags associated with it: create table flags (fl_type varchar(16) @@ -348,27 +354,28 @@ this table: oh_on datetime not null); create index oh_object on object_history (oh_type, oh_name); -oh_action must be one of C, C, C, C, or C. -oh_field must be one of C, C, C, C, -C, C, C, C, or C. Enums -aren't used for compatibility with databases other than MySQL. - -For a change of type create, get, store, or destroy, only the action and the -trace records (by, from, and on) are stored. For changes to columns or to -the flags table, oh_field takes what attribute is changed, oh_from takes the -previous value converted to a string and oh_to takes the next value -similarly converted to a string. The special field value "type_data" is -used when type-specific data is changed, and in that case (and only that -case) some type-specific name for the data being changed is stored in -oh_type_field. +oh_action must be one of C, C, C, C, or +C. oh_field must be one of C, C, C, +C, C, C, C, C, or +C. Enums aren't used for compatibility with databases other +than MySQL. + +For a change of type create, get, store, or destroy, only the action and +the trace records (by, from, and on) are stored. For changes to columns +or to the flags table, oh_field takes what attribute is changed, oh_from +takes the previous value converted to a string and oh_to takes the next +value similarly converted to a string. The special field value +"type_data" is used when type-specific data is changed, and in that case +(and only that case) some type-specific name for the data being changed is +stored in oh_type_field. When clearing a flag, oh_old will have the name of the flag and oh_new will be null. When setting a flag, oh_old will be null and oh_new will have the name of the flag. -oh_by stores the authenticated identity that made the change, oh_from stores -the host from which they made the change, and oh_on stores the time the -change was made. +oh_by stores the authenticated identity that made the change, oh_from +stores the host from which they made the change, and oh_on stores the time +the change was made. =head2 Keytab Backend Data @@ -406,16 +413,16 @@ and then the restrictions for a given keytab are stored in this table: primary key (ke_name, ke_enctype)); create index ke_name on keytab_enctypes (ke_name); -To use this functionality, you will need to populate the enctypes table with -the enctypes that a keytab may be restricted to. Currently, there is no -automated mechanism to do this. +To use this functionality, you will need to populate the enctypes table +with the enctypes that a keytab may be restricted to. Currently, there is +no automated mechanism to do this. =head1 SEE ALSO wallet-backend(8) -This module is part of the wallet system. The current version is available -from L. +This module is part of the wallet system. The current version is +available from L. =head1 AUTHOR diff --git a/perl/Wallet/Server.pm b/perl/Wallet/Server.pm index 40e48a3..dd596c4 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 -# 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. @@ -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.07'; +$VERSION = '0.08'; ############################################################################## # Utility methods @@ -714,6 +714,10 @@ __END__ Wallet::Server - Wallet system server implementation +=for stopwords +keytabs metadata backend HOSTNAME ACL timestamp ACL's nul Allbery +backend-specific wallet-backend + =head1 SYNOPSIS use Wallet::Server; @@ -725,8 +729,8 @@ Wallet::Server - Wallet system server implementation Wallet::Server is the top-level class that implements the wallet server. The wallet is a system for storing, generating, and retrieving secure information such as Kerberos keytabs. The server maintains metadata about -the objects, checks access against ACLs, and dispatches requests for objects -to backend implementations for that object type. +the objects, checks access against ACLs, and dispatches requests for +objects to backend implementations for that object type. Wallet::Server is normally instantiated and used by B, a thin wrapper around this object that determines the authenticated remote @@ -734,8 +738,8 @@ user and gets user input and then calls the appropriate method of this 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). +the database configuration). For information on those variables and how +to set them, see Wallet::Config(3). =head1 CLASS METHODS @@ -765,11 +769,12 @@ failure to get the error message. Gets or sets the ACL type ACL to ID for the object identified by TYPE and NAME. ACL should be one of C, C, C, C, or -C. If ID is not given, returns the current setting of that ACL as a -numeric ACL ID or undef if that ACL isn't set or on failure. To distinguish -between an ACL that isn't set and a failure to retrieve the ACL, 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. +C. If ID is not given, returns the current setting of that ACL as +a numeric ACL ID or undef if that ACL isn't set or on failure. To +distinguish between an ACL that isn't set and a failure to retrieve the +ACL, 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. 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 @@ -798,64 +803,65 @@ failure. Destroys the ACL identified by ID, which may be either the ACL name or its numeric ID. This call will fail if the ACL is still referenced by any -object. The ADMIN ACL may not be destroyed. To destroy an ACL, the current -user must be authorized by the ADMIN ACL. Returns true on success and false -on failure. +object. The ADMIN ACL may not be destroyed. To destroy an ACL, the +current user must be authorized by the ADMIN ACL. Returns true on success +and false on failure. =item acl_history(ID) -Returns the history of the ACL identified by ID, which may be either the ACL -name or its numeric ID. To see the history of an ACL, the current user must -be authorized by the ADMIN ACL. Each change that modifies the ACL (not -counting changes in 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 made. Returns undef on failure. +Returns the history of the ACL identified by ID, which may be either the +ACL name or its numeric ID. To see the history of an ACL, the current +user must be authorized by the ADMIN ACL. Each change that modifies the +ACL (not counting changes in 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 made. Returns +undef on failure. =item acl_remove(ID, SCHEME, IDENTIFIER) Removes from the ACL identified by ID the entry matching SCHEME and IDENTIFIER. ID may be either the name of the ACL or its numeric ID. The last entry in the ADMIN ACL cannot be removed. To remove an entry from an -ACL, the current user must be authorized by the ADMIN ACL. Returns true on -success and false on failure. +ACL, the current user must be authorized by the ADMIN ACL. Returns true +on success and false on failure. =item acl_rename(OLD, NEW) Renames the ACL identified by OLD to NEW. This changes the human-readable -name, not the underlying numeric ID, so the ACL's associations with objects -will be unchanged. The ADMIN ACL may not be renamed. OLD may be either the -current name or the numeric ID. NEW must not be all-numeric. To rename an -ACL, the current user must be authorized by the ADMIN ACL. Returns true on -success and false on failure. +name, not the underlying numeric ID, so the ACL's associations with +objects will be unchanged. The ADMIN ACL may not be renamed. OLD may be +either the current name or the numeric ID. NEW must not be all-numeric. +To rename an ACL, the current user must be authorized by the ADMIN ACL. +Returns true on success and false on failure. =item acl_show(ID) Returns a human-readable description, including membership, of the ACL identified by ID, which may be either the ACL name or its numeric ID. To -show an ACL, the current user must be authorized by the ADMIN ACL (although -be aware that anyone with show access to an object can see the membership of -ACLs associated with that object through the show() method). Returns the -human-readable description on success and undef on failure. +show an ACL, the current user must be authorized by the ADMIN ACL +(although be aware that anyone with show access to an object can see the +membership of ACLs associated with that object through the show() method). +Returns the human-readable description on success and undef on failure. =item attr(TYPE, NAME, ATTRIBUTE [, VALUE ...]) Sets or retrieves a given object attribute. Attributes are used to store -backend-specific information for a particular object type and ATTRIBUTE must -be an attribute type known to the underlying object implementation. +backend-specific information for a particular object type and ATTRIBUTE +must be an attribute type known to the underlying object implementation. If VALUE is not given, returns the values of that attribute, if any, as a list. On error, returns the empty list. To distinguish between an error -and an empty return, call error() afterwards. It is guaranteed to return -undef unless there was an error. To retrieve an attribute setting, the user -must be authorized by the ADMIN ACL, the show ACL if set, or the owner ACL -if the show ACL is not set. +and an empty return, call error() afterward. It is guaranteed to return +undef unless there was an error. To retrieve an attribute setting, the +user must be authorized by the ADMIN ACL, the show ACL if set, or the +owner ACL if the show ACL is not set. -If VALUE is given, sets the given ATTRIBUTE values to VALUE, which is one or -more attribute values. Pass the empty string as the only VALUE to clear the -attribute values. Returns true on success and false on failure. To set an -attribute value, the user must be authorized by the ADMIN ACL, the store ACL -if set, or the owner ACL if the store ACL is not set. +If VALUE is given, sets the given ATTRIBUTE values to VALUE, which is one +or more attribute values. Pass the empty string as the only VALUE to +clear the attribute values. Returns true on success and false on failure. +To set an attribute value, the user must be authorized by the ADMIN ACL, +the store ACL if set, or the owner ACL if the store ACL is not set. =item autocreate(TYPE, NAME) @@ -877,9 +883,9 @@ for the existence of the object. =item create(TYPE, NAME) -Creates a new object of type TYPE and name NAME. TYPE must be a recognized -type for which the wallet system has a backend implementation. Returns true -on success and false on failure. +Creates a new object of type TYPE and name NAME. TYPE must be a +recognized type for which the wallet system has a backend implementation. +Returns true on success and false on failure. To create an object using this method, the current user must be authorized by the ADMIN ACL. Use autocreate() to create objects based on the default @@ -888,18 +894,18 @@ owner as determined by the wallet configuration. =item destroy(TYPE, NAME) 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. +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. =item dbh() -Returns the database handle of a Wallet::Server object. This is used mostly -for testing; normally, clients should perform all actions through the -Wallet::Server object to ensure that authorization and history logging is -done properly. +Returns the database handle of a Wallet::Server object. This is used +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 error() @@ -909,12 +915,12 @@ after an undef return from any other instance method. =item expires(TYPE, NAME [, EXPIRES]) -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. +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. If EXPIRES is given, sets the expiration to EXPIRES. EXPIRES must be in the format C, although the time portion may be @@ -924,23 +930,23 @@ ADMIN ACL. Returns true for success and false for failure. =item flag_clear(TYPE, NAME, FLAG) -Clears the flag FLAG on the object identified by TYPE and NAME. To clear a -flag, the current user must be authorized by the ADMIN ACL or the flags ACL -on the object. +Clears the flag FLAG on the object identified by TYPE and NAME. To clear +a flag, the current user must be authorized by the ADMIN ACL or the flags +ACL on the object. =item flag_set(TYPE, NAME, FLAG) Sets the flag FLAG on the object identified by TYPE and NAME. To set a -flag, the current user must be authorized by the ADMIN ACL or the flags ACL -on the object. +flag, the current user must be authorized by the ADMIN ACL or the flags +ACL on the object. =item get(TYPE, NAME) Returns the data associated with the object identified by TYPE and NAME. -Depending on the object TYPE, this may generate new data and invalidate any -existing data or it may return data previously stored or generated. Note -that this data may be binary and may contain nul characters. To get an -object, the current user must either be authorized by the owner ACL or +Depending on the object TYPE, this may generate new data and invalidate +any existing data or it may return data previously stored or generated. +Note that this data may be binary and may contain nul characters. To get +an object, the current user must either be authorized by the owner ACL or authorized by the get ACL; however, if the get ACL is set, the owner ACL will not be checked. Being a member of the ADMIN ACL does not provide any special privileges to get objects. @@ -950,48 +956,49 @@ between undef and the empty string, which is valid object data. =item history(TYPE, NAME) -Returns (as a string) the human-readable history of the object identified by -TYPE and NAME, or undef on error. To see the object history, the current -user must be a member of the ADMIN ACL, authorized by the show ACL, or -authorized by the owner ACL; however, if the show ACL is set, the owner ACL -will not be checked. +Returns (as a string) the human-readable history of the object identified +by TYPE and NAME, or undef on error. To see the object history, the +current user must be a member of the ADMIN ACL, authorized by the show +ACL, or authorized by the owner ACL; however, if the show ACL is set, the +owner ACL will not be checked. =item owner(TYPE, NAME [, OWNER]) -Gets or sets the owner for the object identified by TYPE and NAME. If OWNER -is not given, returns the current owner as a numeric ACL ID or undef if no -owner is set or on an error. To distinguish between an owner that isn't set -and a failure to retrieve the owner, 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. +Gets or sets the owner for the object identified by TYPE and NAME. If +OWNER is not given, returns the current owner as a numeric ACL ID or undef +if no owner is set or on an error. To distinguish between an owner that +isn't set and a failure to retrieve the owner, 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. -If OWNER is given, sets the owner to OWNER, which may be either the name of -an ACL or a numeric ACL ID. To set an owner, the current user must be +If OWNER is given, sets the owner to OWNER, which may be either the name +of an ACL or a numeric ACL ID. To set an owner, the current user must be authorized by the ADMIN ACL. Returns true for success and false for failure. -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. +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 show(TYPE, NAME) -Returns (as a string) a human-readable representation of the metadata stored -for the object identified by TYPE and NAME, or undef on error. Included is -the metadata and entries of any ACLs associated with the object. To show an -object, the current user must be a member of the ADMIN ACL, authorized by -the show ACL, or authorized by the owner ACL; however, if the show ACL is -set, the owner ACL will not be checked. +Returns (as a string) a human-readable representation of the metadata +stored for the object identified by TYPE and NAME, or undef on error. +Included is the metadata and entries of any ACLs associated with the +object. To show an object, the current user must be a member of the ADMIN +ACL, authorized by the show ACL, or authorized by the owner ACL; however, +if the show ACL is set, the owner ACL will not be checked. =item store(TYPE, NAME, DATA) -Stores DATA for the object identified with TYPE and NAME for later retrieval -with get. Not all object types support this. Note that DATA may be binary -and may contain nul characters. To store an object, the current user must -either be authorized by the owner ACL or authorized by the store ACL; -however, if the store ACL is set, the owner ACL is not checked. Being a -member of the ADMIN ACL does not provide any special privileges to store -objects. Returns true on success and false on failure. +Stores DATA for the object identified with TYPE and NAME for later +retrieval with get. Not all object types support this. Note that DATA +may be binary and may contain nul characters. To store an object, the +current user must either be authorized by the owner ACL or authorized by +the store ACL; however, if the store ACL is set, the owner ACL is not +checked. Being a member of the ADMIN ACL does not provide any special +privileges to store objects. Returns true on success and false on +failure. =back @@ -999,8 +1006,8 @@ objects. Returns true on success and false on failure. wallet-backend(8) -This module is part of the wallet system. The current version is available -from L. +This module is part of the wallet system. The current version is +available from L. =head1 AUTHOR diff --git a/perl/t/pod-spelling.t b/perl/t/pod-spelling.t new file mode 100755 index 0000000..d3ab858 --- /dev/null +++ b/perl/t/pod-spelling.t @@ -0,0 +1,75 @@ +#!/usr/bin/perl -w +# +# 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 +# +# This program is free software; you may redistribute it and/or modify it +# under the same terms as Perl itself. + +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 = all_pod_files (); +plan tests => scalar @pod; + +# Finally, do the checks. +for my $pod (@pod) { + my $child = open (CHILD, '-|'); + if (not defined $child) { + die "Cannot fork: $!\n"; + } elsif ($child == 0) { + my $pid = open (SPELL, '|-', @spell) or die "Cannot run @spell: $!\n"; + open (POD, '<', $pod) or die "Cannot open $pod: $!\n"; + my $parser = Pod::Spell->new; + $parser->parse_from_filehandle (\*POD, \*SPELL); + close POD; + close SPELL; + exit ($? >> 8); + } else { + my @words = ; + close CHILD; + SKIP: { + skip "@spell failed for $pod", 1 unless $? == 0; + for (@words) { + s/^\s+//; + s/\s+$//; + } + is ("@words", '', $pod); + } + } +} diff --git a/perl/t/pod.t b/perl/t/pod.t index e9aa0a8..c467b82 100755 --- a/perl/t/pod.t +++ b/perl/t/pod.t @@ -1,16 +1,14 @@ -#!/usr/bin/perl +#!/usr/bin/perl -w # -# t/pod.t -- Test POD formatting for the wallet Perl modules. +# Test POD formatting for the wallet Perl modules. # # Written by Russ Allbery -# Copyright 2007 Board of Trustees, Leland Stanford Jr. University +# Copyright 2007, 2010 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. +use strict; +use Test::More; eval 'use Test::Pod 1.00'; -if ($@) { - print "1..1\n"; - print "ok 1 # skip - Test::Pod 1.00 required for testing POD\n"; - exit; -} +plan skip_all => 'Test::Pod 1.00 required for testing POD' if $@; all_pod_files_ok (); -- cgit v1.2.3 From 2520a17a1def8d9bae5e6a2e1a63ceff0734bede Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 9 Feb 2010 23:28:00 -0800 Subject: Add tests/data/.placeholder to .gitignore --- .gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitignore b/.gitignore index 3778ee8..10cfbf8 100644 --- a/.gitignore +++ b/.gitignore @@ -19,6 +19,7 @@ /tests/client/basic-t /tests/client/full-t /tests/client/prompt-t +/tests/data/.placeholder /tests/data/test.keytab /tests/data/test.password /tests/data/test.principal -- cgit v1.2.3 From afcc4aba6708d37379ae70bab5ddc38592185e8b Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 9 Feb 2010 23:31:19 -0800 Subject: Fix up the distclean and maintainerclean rules Add .placeholder to the file list, fix the location of the Automake support files that are now in build-aux, and remove an old reference to TEST_FILES. --- Makefile.am | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/Makefile.am b/Makefile.am index d4dc8a5..db6738a 100644 --- a/Makefile.am +++ b/Makefile.am @@ -73,11 +73,12 @@ warnings: $(MAKE) V=0 CFLAGS='$(WARNINGS)' $(check_PROGRAMS) # Remove some additional files. -DISTCLEANFILES = perl/Makefile -MAINTAINERCLEANFILES = Makefile.in aclocal.m4 config.h.in config.h.in~ \ - configure client/wallet.1 server/keytab-backend.8 \ - server/wallet-backend.8 tools/compile tools/depcomp tools/install-sh \ - tools/missing +DISTCLEANFILES = perl/Makefile tests/data/.placeholder +MAINTAINERCLEANFILES = Makefile.in aclocal.m4 build-aux/compile \ + build-aux/depcomp build-aux/install-sh build-aux/missing \ + client/wallet.1 config.h.in config.h.in~ configure \ + contrib/wallet-report.8 server/keytab-backend.8 \ + server/wallet-backend.8 # Take appropriate actions in the Perl directory as well. We don't want to # always build the Perl directory in all-local, since otherwise Automake does @@ -112,7 +113,7 @@ clean-local: # Remove the files that we copy over if and only if builddir != srcdir. distclean-local: set -e; if [ x"$(builddir)" != x"$(srcdir)" ] ; then \ - rm -f $(PERL_FILES) $(TEST_FILES) ; \ + rm -f $(PERL_FILES) ; \ fi # The bits below are for the test suite, not for the main package. -- cgit v1.2.3 From 5d7f614e88bac459a693f1dcc91aad36ed3d00dd Mon Sep 17 00:00:00 2001 From: Russ Allbery 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 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 [B<-hv>] [B<-c> I] [B<-f> I] @@ -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 scheme, the identifier is a principal name -and only that principal is authorized by that ACL entry. For the C -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 and see your @@ -201,7 +204,7 @@ Display the history of the ACL . 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 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 -# 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 retrieve I =head1 DESCRIPTION -B 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 -patched to support the B<-norandkey> option to B. +B 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 patched to support the B<-norandkey> option to B. -This script is intended to run under B. 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. 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 does not do any authorization checks. Those should be done -by B before it is called. +B does not do any authorization checks. Those should be +done by B before it is called. =head1 FILES @@ -193,19 +199,19 @@ by B before it is called. =item F -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. 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. Any principal that does +not match one of those regular expressions cannot be retrieved. =item F The temporary directory used for creating keytabs. B 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. +This program is part of the wallet system. The current version is +available from L. =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 -# 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 I [I ...] @@ -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 @@ -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. +This program is part of the wallet system. The current version is +available from L. =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 -# 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 [B<-q>] I [I ...] =head1 DESCRIPTION -B implements the interface between B and the wallet -system. It is written to run under B 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 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 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 implements the interface between B and the +wallet system. It is written to run under B 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 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 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 . 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 @@ -447,8 +454,8 @@ The expiration will be displayed in seconds since epoch. If is given, sets the expiration on the object identified by and to and (if given) . - -=back - -=head1 FILES - -=over 4 - -=item F - -The root directory for archived reports. Archived reports will be saved -under this directory in a subdirectory for the year, the month, and -C, under the name C. In other words, for a report run -in March of 2003, the report will be saved in the file: - - /afs/ir/dept/itss/infrastructure/reports/2003/03/kerberos/srvtabs - -=back - -=head1 NOTES - -Considerably more information could potentially be reported than is -currently here. In particular, keytabs that have never been downloaded -are not distinguished from those that have, the number of keytabs -downloaded is not separately reported, and there aren't any statistics on -how recently the keytabs were downloaded. These could be useful areas of -future development. - -=head1 AUTHOR - -Russ Allbery - -=cut diff --git a/contrib/wallet-summary b/contrib/wallet-summary new file mode 100755 index 0000000..7a51f9e --- /dev/null +++ b/contrib/wallet-summary @@ -0,0 +1,240 @@ +#!/usr/bin/perl -w +# +# wallet-summarize -- Summarize keytabs in the wallet database. +# +# Written by Russ Allbery +# Copyright 2003, 2008, 2010 Board of Trustees, Leland Stanford Jr. University +# +# See LICENSE for licensing terms. + +############################################################################## +# Site configuration +############################################################################## + +# Path to the infrastructure reports directory. +$REPORTS = '/afs/ir/dept/itss/infrastructure/reports'; + +# Address to which to mail the report. +$ADDRESS = 'nobody@example.com'; + +# The various classification patterns for srvtabs. +@PATTERNS + = ([qr(/cgi\z), '*/cgi', 'CGI users'], + [qr(^(?i)http/), 'HTTP/*', 'HTTP Negotiate-Auth'], + [qr(^cifs/), 'cifs/*', 'CIFS'], + [qr(^host/), 'host/*', 'Host login'], + [qr(^ident/), 'ident/*', 'S/Ident'], + [qr(^imap/), 'imap/*', 'IMAP'], + [qr(^ldap/), 'ldap/*', 'LDAP'], + [qr(^nfs/), 'nfs/*', 'NFS'], + [qr(^pop/), 'pop/*', 'Kerberized POP'], + [qr(^sieve/), 'sieve/*', 'Sieve mail sorting'], + [qr(^smtp/), 'smtp/*', 'SMTP'], + [qr(^webauth/), 'webauth/*', 'WebAuth v3'], + [qr(^service/), 'service/*', 'Service principals']); + +############################################################################## +# Modules and declarations +############################################################################## + +require 5.005; + +use strict; +use vars qw($ADDRESS $DUMPFILE @PATTERNS $REPORTS); + +use Getopt::Long qw(GetOptions); +use File::Path qw(mkpath); +use POSIX qw(strftime); +use Wallet::Admin (); + +############################################################################## +# Database queries +############################################################################## + +# Return a list of keytab objects in the wallet database. Currently, we only +# report on keytab objects; reports for other objects will be added later. +sub list_keytabs { + my $report = Wallet::Report->new; + my @objects = $report->objects; + if (!@objects and $report->error) { + die $report->error; + } + return map { $$_[1] } grep { $$_[0] eq 'keytab' } @objects; +} + +############################################################################## +# Reporting +############################################################################## + +# Used to make heredocs look pretty. +sub unquote { my ($string) = @_; $string =~ s/^:( {0,7}|\t)//gm; $string } + +# Given an array of principal names, classify them into various interesting +# groups and then report on the total number of principals, broken down by the +# individual groups. +sub report_principals { + my @principals = @_; + my (%count, $found); + + # Count the principals in each category. + for (@principals) { + $found = 0; + for my $mapping (@PATTERNS) { + if (/$$mapping[0]/) { + $count{$$mapping[1]}++; + $found = 1; + last; + } + } + $count{OTHER}++ unless $found; + } + my $total = scalar @principals; + + # Find the longest label for any principal type. + my ($taglen, $desclen) = (0, 0); + for (@PATTERNS) { + next unless $count{$$_[1]}; + $taglen = length ($$_[1]) if length ($$_[1]) > $taglen; + $desclen = length ($$_[2]) if length ($$_[2]) > $desclen; + } + $taglen = 6 if $taglen < 6; + + # Print the report. + print unquote (<<"EOM"); +: This is a summary of the current keytab entries in the wallet database, +: which contain entries for every principal that is managed by our +: Kerberos keytab management system. Not all of these principals may +: necessarily be in active use. Principals corresponding to hosts which +: are no longer registered in NetDB are purged periodically. +: +EOM + printf ("%-${taglen}s Count %-${desclen}s\n", 'Type', 'Description'); + print '-' x $taglen, ' ----- ', '-' x $desclen, "\n"; + for (@PATTERNS) { + next unless $count{$$_[1]}; + printf ("%-${taglen}s %5d %s\n", $$_[1], $count{$$_[1]}, $$_[2]); + } + if ($count{OTHER}) { + print "\n"; + printf ("%-${taglen}s %5d %s\n", '', $count{OTHER}, 'Other'); + } + print ' ' x $taglen, ' ', '=====', "\n"; + printf ("%${taglen}s %5d\n", 'Total:', $total); +} + +############################################################################## +# Main routine +############################################################################## + +# Read in command-line options. +my ($help, $mail); +Getopt::Long::config ('no_ignore_case', 'bundling'); +GetOptions ('help|h' => \$help, + 'mail|m' => \$mail) or exit 1; +if ($help) { + print "Feeding myself to perldoc, please wait....\n"; + exec ('perldoc', '-t', $0); +} + +# Clean up $0 for error reporting. +$0 =~ s%.*/%%; + +# If -m was given, save the report into the infrastructure area. +if ($mail) { + my $date = strftime ('%Y/%m', localtime); + mkpath ("$REPORTS/$date/kerberos"); + open (REPORT, "+> $REPORTS/$date/kerberos/wallet") + or die "$0: cannot create $REPORTS/$date/kerberos/wallet: $!\n"; + select REPORT; +} + +# Run the report. +my @principals = read_dump; +report_principals (@principals); + +# If -m was given, take the saved report and mail it as well. +if ($mail) { + seek (REPORT, 0, 0) + or die "$0: cannot rewind generated report: $!\n"; + my $date = strftime ('%Y-%m-%d', localtime); + open (MAIL, '| /usr/lib/sendmail -t -oi -oem') + or die "$0: cannot fork sendmail: $!\n"; + print MAIL "From: root\n"; + print MAIL "To: $ADDRESS\n"; + print MAIL "Subject: wallet keytab report ($date)\n\n"; + print MAIL ; + close MAIL; + if ($? != 0) { + warn "$0: sendmail exited with status ", ($? >> 8), "\n"; + } +} +close REPORT; + +############################################################################## +# Documentation +############################################################################## + +=head1 NAME + +wallet-summary - Report on keytabs in the wallet database + +=head1 SYNOPSIS + +B [B<-hm>] + +=head1 DESCRIPTION + +Obtains a list of keytab objects in the wallet database and produces a +report of the types of principals contained therein and the total number +of principals registered. This report is sent to standard output by +default, but see B<-m> below. + +The classifications of principals are determined by a set of patterns at +the beginning of this script. Modify it to add new classifications. + +=head1 OPTIONS + +=over 4 + +=item B<-h>, B<--help> + +Print out this documentation (which is done simply by feeding the script to +C). + +=item B<-m>, B<--mail> + +Rather than printing the report to standard output, send the report via +e-mail to the address set at the beginning of this script and also archive +a copy under F. + +=back + +=head1 FILES + +=over 4 + +=item F + +The root directory for archived reports. Archived reports will be saved +under this directory in a subdirectory for the year, the month, and +C, under the name C. In other words, for a report run +in March of 2003, the report will be saved in the file: + + /afs/ir/dept/itss/infrastructure/reports/2003/03/kerberos/srvtabs + +=back + +=head1 NOTES + +Considerably more information could potentially be reported than is +currently here. In particular, keytabs that have never been downloaded +are not distinguished from those that have, the number of keytabs +downloaded is not separately reported, and there aren't any statistics on +how recently the keytabs were downloaded. These could be useful areas of +future development. + +=head1 AUTHOR + +Russ Allbery + +=cut diff --git a/perl/Wallet/Admin.pm b/perl/Wallet/Admin.pm index b4b3d86..e835713 100644 --- a/perl/Wallet/Admin.pm +++ b/perl/Wallet/Admin.pm @@ -22,7 +22,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.04'; +$VERSION = '0.05'; ############################################################################## # Constructor, destructor, and accessors @@ -110,256 +110,6 @@ sub destroy { return 1; } -############################################################################## -# Reporting -############################################################################## - -# Given an ACL name, translate it to the ID for that ACL and return it. -# Often this is unneeded and could be done with a join, but by doing it in a -# separate step, we can give an error for the specific case of someone -# searching for a non-existant ACL. -sub acl_name_to_id { - my ($self, $acl) = @_; - my ($id); - eval { - my $sql = 'select ac_id from acls where ac_name = ?'; - my $sth = $self->{dbh}->prepare ($sql); - $sth->execute ($acl); - while (defined (my $row = $sth->fetchrow_hashref)) { - $id = $row->{ac_id}; - } - $self->{dbh}->commit; - }; - if (!defined $id || $id !~ /^\d+$/) { - $self->error ("could not find the acl $acl"); - return ''; - } - return $id; -} - -# Return the SQL statement to find every object in the database. -sub list_objects_all { - my ($self) = @_; - my $sql = 'select ob_type, ob_name from objects order by ob_type, - ob_name'; - return $sql; -} - -# Return the SQL statement and the search field required to find all objects -# matching a specific type. -sub list_objects_type { - my ($self, $type) = @_; - my $sql = 'select ob_type, ob_name from objects where ob_type=? order - by ob_type, ob_name'; - return ($sql, $type); -} - -# Return the SQL statement and search field required to find all objects -# owned by a given ACL. If the requested owner is 'null', then we ignore -# this and do a different search for IS NULL. If the requested owner does -# not actually match any ACLs, set an error and return the empty string. -sub list_objects_owner { - my ($self, $owner) = @_; - my ($sth); - if ($owner =~ /^null$/i) { - my $sql = 'select ob_type, ob_name from objects where ob_owner is null - order by objects.ob_type, objects.ob_name'; - return ($sql); - } else { - my $id = $self->acl_name_to_id ($owner); - return '' unless $id; - my $sql = 'select ob_type, ob_name from objects where ob_owner = ? - order by objects.ob_type, objects.ob_name'; - return ($sql, $id); - } -} - -# Return the SQL statement and search field required to find all objects -# that have a specific flag set. -sub list_objects_flag { - my ($self, $flag) = @_; - my $sql = 'select ob_type, ob_name from objects left join flags on - (objects.ob_type = flags.fl_type and objects.ob_name = flags.fl_name) - where flags.fl_flag = ? order by objects.ob_type, objects.ob_name'; - return ($sql, $flag); -} - -# Return the SQL statement and search field required to find all objects -# that a given ACL has any permissions on. This expands from -# list_objects_owner in that it will also match any records that have the ACL -# set for get, store, show, destroy, or flags. If the requested owner does -# not actually match any ACLs, set an error and return the empty string. -sub list_objects_acl { - my ($self, $acl) = @_; - my $id = $self->acl_name_to_id ($acl); - return '' unless $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 = ? order by objects.ob_type, - objects.ob_name'; - return ($sql, $id, $id, $id, $id, $id, $id); -} - -# Returns a list of all objects stored in the wallet database in the form of -# type and name pairs. On error and for an empty database, the empty list -# will be returned. To distinguish between an empty list and an error, call -# error(), which will return undef if there was no error. Farms out specific -# statement to another subroutine for specific search types, but each case -# should return ob_type and ob_name in that order. -sub list_objects { - my ($self, $type, @args) = @_; - undef $self->{error}; - - # Find the SQL statement and the arguments to use. - my $sql = ''; - my @search = (); - if (!defined $type || $type eq '') { - ($sql) = $self->list_objects_all (); - } else { - if (@args != 1) { - $self->error ("object searches require an argument to search"); - } elsif ($type eq 'type') { - ($sql, @search) = $self->list_objects_type (@args); - } elsif ($type eq 'owner') { - ($sql, @search) = $self->list_objects_owner (@args); - } elsif ($type eq 'flag') { - ($sql, @search) = $self->list_objects_flag (@args); - } elsif ($type eq 'acl') { - ($sql, @search) = $self->list_objects_acl (@args); - } else { - $self->error ("do not know search type: $type"); - } - return unless $sql; - } - - my @objects; - eval { - my $object; - my $sth = $self->{dbh}->prepare ($sql); - $sth->execute (@search); - while (defined ($object = $sth->fetchrow_arrayref)) { - push (@objects, [ @$object ]); - } - $self->{dbh}->commit; - }; - if ($@) { - $self->error ("cannot list objects: $@"); - $self->{dbh}->rollback; - return; - } else { - return @objects; - } -} - -# Returns the SQL statement required to find and return all ACLs in the db. -sub list_acls_all { - my ($self) = @_; - my $sql = 'select ac_id, ac_name from acls order by ac_id'; - return ($sql); -} - -# Returns the SQL statement required to find and returned all empty ACLs in -# the db. -sub list_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'; - return ($sql); -} - -# Returns the SQL statement and the field required to search the ACLs and -# return only those entries which contain a entries with identifiers -# matching a particular given string. -sub list_acls_entry { - my ($self, $type, $identifier) = @_; - my $sql = 'select distinct ac_id, ac_name from acl_entries left join acls - on (ae_id = ac_id) where ae_scheme = ? and ae_identifier like ? order - by ac_id'; - $identifier = '%'.$identifier.'%'; - return ($sql, $type, $identifier); -} - -# Returns a list of all ACLs stored in the wallet database as a list of pairs -# of ACL IDs and ACL names. On error and for an empty database, the empty -# list will be returned; however, this is unlikely since any valid database -# will have at least an ADMIN ACL. Still, to distinguish between an empty -# list and an error, call error(), which will return undef if there was no -# error. -sub list_acls { - my ($self, $type, @args) = @_; - undef $self->{error}; - - # Find the SQL statement and the arguments to use. - my $sql = ''; - my @search = (); - if (!defined $type || $type eq '') { - ($sql) = $self->list_acls_all (); - } else { - if ($type eq 'entry') { - if (@args == 0) { - $self->error ("acl searches require an argument to search"); - } else { - ($sql, @search) = $self->list_acls_entry (@args); - } - } elsif ($type eq 'empty') { - ($sql) = $self->list_acls_empty (); - } else { - $self->error ("do not know search type: $type"); - } - return unless $sql; - } - - my @acls; - eval { - my $sth = $self->{dbh}->prepare ($sql); - $sth->execute (@search); - my $object; - while (defined ($object = $sth->fetchrow_arrayref)) { - push (@acls, [ @$object ]); - } - $self->{dbh}->commit; - }; - if ($@) { - $self->error ("cannot list ACLs: $@"); - $self->{dbh}->rollback; - return; - } else { - return @acls; - } -} - -# Returns a report of all ACL lines contained in owner ACLs for matching -# objects. Objects are specified by type and name, which may be SQL wildcard -# expressions. Each list member will be a pair of ACL scheme and ACL -# identifier, with duplicates removed. 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 report_owners { - my ($self, $type, $name) = @_; - undef $self->{error}; - my @lines; - eval { - my $sql = 'select distinct ae_scheme, ae_identifier from acl_entries, - acls, objects where ae_id = ac_id and ac_id = ob_owner and - ob_type like ? and ob_name like ? order by ae_scheme, - ae_identifier'; - my $sth = $self->{dbh}->prepare ($sql); - $sth->execute ($type, $name); - my $object; - while (defined ($object = $sth->fetchrow_arrayref)) { - push (@lines, [ @$object ]); - } - $self->{dbh}->commit; - }; - if ($@) { - $self->error ("cannot report on owners: $@"); - $self->{dbh}->rollback; - return; - } else { - return @lines; - } -} - ############################################################################## # Object registration ############################################################################## @@ -414,7 +164,7 @@ __DATA__ Wallet::Admin - Wallet system administrative interface =for stopwords -ACL hostname ACLs SQL wildcard Allbery +ACL hostname Allbery =head1 SYNOPSIS @@ -478,52 +228,6 @@ initialize() uses C as the hostname and PRINCIPAL as the user when logging the history of the ADMIN ACL creation and for any subsequent actions on the object it returns. -=item list_acls(TYPE, SEARCH) - -Returns a list of all ACLs matching a search type and string in the -database, or all ACLs if no search information is given. 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 "ADMIN" and ID 1 and one -with name "group/admins" and ID 3, list_acls() with no arguments would -return: - - ([ 1, 'ADMIN' ], [ 3, 'group/admins' ]) - -Returns the empty list on failure. Any valid wallet database should have -at least one ACL, but an error can be distinguished from the odd case of a -database with no ACLs by calling error(). error() is guaranteed to return -the error message if there was an error and undef if there was no error. - -There are currently two search types. C takes no arguments and -will return only those ACLs that have no entries within them. C -takes two arguments, an entry scheme and an entry identifier, and will -return any ACLs with an entry that matches the given scheme and contains -the given identifier. - -=item list_objects(TYPE, SEARCH) - -Returns a list of all objects matching a search type and string in the -database, or all objects in the database if no search information is -given. The return value is a list of references to pairs of type and -name. For example, if two objects existed in the database, both of type -C and with values C and C, list_objects() -with no arguments would return: - - ([ 'keytab', 'host/example.com' ], [ 'keytab', 'foo' ]) - -Returns the empty list on failure. To distinguish between this and a -database containing no objects, the caller should call error(). error() -is guaranteed to return the error message if there was an error and undef -if there was no error. - -There are four types of searches currently. C (with a given type) -will return only those entries where the type matches the given type. -C, with a given owner, will only return those objects owned by the -given ACL name. C, with a given flag name, will only return those -items with a flag set to the given value. C operates like C, -but will return only those objects that have the given ACL name on any of -the possible ACL settings, not just owner. - =item register_object (TYPE, CLASS) Register in the database a mapping from the object type TYPE to the class @@ -545,17 +249,6 @@ be deleted and a fresh set of wallet database tables will be created. This method is equivalent to calling destroy() followed by initialize(). Returns true on success and false on failure. -=item report_owners(TYPE, NAME) - -Returns a list of all ACL lines contained in owner ACLs for objects -matching TYPE and NAME, which are interpreted as SQL patterns using C<%> -as a wildcard. The return value is a list of references to pairs of -schema and identifier, with duplicates removed. - -Returns the empty list on failure. To distinguish between this and no -matches, the caller should call error(). error() is guaranteed to return -the error message if there was an error and undef if there was no error. - =back =head1 SEE ALSO diff --git a/perl/Wallet/Report.pm b/perl/Wallet/Report.pm new file mode 100644 index 0000000..7cd8653 --- /dev/null +++ b/perl/Wallet/Report.pm @@ -0,0 +1,425 @@ +# Wallet::Report -- Wallet system reporting interface. +# +# Written by Russ Allbery +# Copyright 2008, 2009, 2010 Board of Trustees, Leland Stanford Jr. University +# +# See LICENSE for licensing terms. + +############################################################################## +# Modules and declarations +############################################################################## + +package Wallet::Report; +require 5.006; + +use strict; +use vars qw($VERSION); + +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'; + +############################################################################## +# Constructor, destructor, and accessors +############################################################################## + +# Create a new wallet report object. Opens a connection to the database that +# will be used for all of the wallet configuration information. Throw an +# exception if anything goes wrong. +sub new { + my ($class) = @_; + my $dbh = Wallet::Database->connect; + my $self = { dbh => $dbh }; + bless ($self, $class); + return $self; +} + +# Returns the database handle (used mostly for testing). +sub dbh { + my ($self) = @_; + return $self->{dbh}; +} + +# Set or return the error stashed in the object. +sub error { + my ($self, @error) = @_; + if (@error) { + my $error = join ('', @error); + chomp $error; + 1 while ($error =~ s/ at \S+ line \d+\.?\z//); + $self->{error} = $error; + } + return $self->{error}; +} + +# Disconnect the database handle on object destruction to avoid warnings. +sub DESTROY { + my ($self) = @_; + $self->{dbh}->disconnect unless $self->{dbh}->{InactiveDestroy}; +} + +############################################################################## +# Object reports +############################################################################## + +# Return the SQL statement to find every object in the database. +sub objects_all { + my ($self) = @_; + my $sql = 'select ob_type, ob_name from objects order by ob_type, + ob_name'; + return $sql; +} + +# Return the SQL statement and the search field required to find all objects +# matching a specific type. +sub objects_type { + my ($self, $type) = @_; + my $sql = 'select ob_type, ob_name from objects where ob_type=? order + by ob_type, ob_name'; + return ($sql, $type); +} + +# Return the SQL statement and search field required to find all objects owned +# by a given ACL. If the requested owner is null, we ignore this and do a +# different search for IS NULL. If the requested owner does not actually +# match any ACLs, set an error and return undef. +sub objects_owner { + my ($self, $owner) = @_; + my ($sth); + if (lc ($owner) eq 'null') { + my $sql = 'select ob_type, ob_name from objects where ob_owner is null + order by objects.ob_type, objects.ob_name'; + return ($sql); + } else { + my $acl = eval { Wallet::ACL->new ($owner, $self->{dbh}) }; + return unless $acl; + my $sql = 'select ob_type, ob_name from objects where ob_owner = ? + order by objects.ob_type, objects.ob_name'; + return ($sql, $acl->id); + } +} + +# Return the SQL statement and search field required to find all objects that +# have a specific flag set. +sub objects_flag { + my ($self, $flag) = @_; + my $sql = 'select ob_type, ob_name from objects left join flags on + (objects.ob_type = flags.fl_type and objects.ob_name = flags.fl_name) + where flags.fl_flag = ? order by objects.ob_type, objects.ob_name'; + return ($sql, $flag); +} + +# Return the SQL statement and search field required to find all objects that +# a given ACL has any permissions on. This expands from objects_owner in that +# it will also match any records that have the ACL set for get, store, show, +# destroy, or flags. If the requested owner does not actually match any ACLs, +# set an error and return the empty string. +sub objects_acl { + my ($self, $search) = @_; + my $acl = eval { Wallet::ACL->new ($search, $self->{dbh}) }; + return unless $acl; + 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 = ? order by objects.ob_type, + objects.ob_name'; + return ($sql, ($acl->id) x 6); +} + +# Returns a list of all objects stored in the wallet database in the form of +# type and name pairs. On error and for an empty database, the empty list +# will be returned. To distinguish between an empty list and an error, call +# error(), which will return undef if there was no error. Farms out specific +# statement to another subroutine for specific search types, but each case +# should return ob_type and ob_name in that order. +sub objects { + my ($self, $type, @args) = @_; + undef $self->{error}; + + # Find the SQL statement and the arguments to use. + my $sql = ''; + my @search = (); + if (!defined $type || $type eq '') { + ($sql) = $self->objects_all; + } else { + if (@args != 1) { + $self->error ("object searches require one argument to search"); + } elsif ($type eq 'type') { + ($sql, @search) = $self->objects_type (@args); + } elsif ($type eq 'owner') { + ($sql, @search) = $self->objects_owner (@args); + } elsif ($type eq 'flag') { + ($sql, @search) = $self->objects_flag (@args); + } elsif ($type eq 'acl') { + ($sql, @search) = $self->objects_acl (@args); + } else { + $self->error ("do not know search type: $type"); + } + return unless $sql; + } + + # Do the search. + my @objects; + eval { + my $sth = $self->{dbh}->prepare ($sql); + $sth->execute (@search); + my $object; + while (defined ($object = $sth->fetchrow_arrayref)) { + push (@objects, [ @$object ]); + } + $self->{dbh}->commit; + }; + if ($@) { + $self->error ("cannot list objects: $@"); + $self->{dbh}->rollback; + return; + } + return @objects; +} + +############################################################################## +# ACL reports +############################################################################## + +# Returns the SQL statement required to find and return all ACLs in the +# database. +sub acls_all { + my ($self) = @_; + my $sql = 'select ac_id, ac_name from acls order by ac_id'; + return ($sql); +} + +# Returns the SQL statement required to find all empty ACLs in the database. +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'; + return ($sql); +} + +# Returns the SQL statement and the field required to find ACLs containing the +# specified entry. The identifier is automatically surrounded by wildcards to +# do a substring search. +sub acls_entry { + my ($self, $type, $identifier) = @_; + my $sql = 'select distinct ac_id, ac_name from acl_entries left join acls + on (ae_id = ac_id) where ae_scheme = ? and ae_identifier like ? order + by ac_id'; + return ($sql, $type, '%' . $identifier . '%'); +} + +# 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 +# between an empty list and an error, call error(), which will return undef if +# there was no error. +sub acls { + my ($self, $type, @args) = @_; + undef $self->{error}; + + # Find the SQL statement and the arguments to use. + my $sql; + my @search = (); + if (!defined $type || $type eq '') { + ($sql) = $self->acls_all; + } else { + if ($type eq 'entry') { + if (@args == 0) { + $self->error ('ACL searches require an argument to search'); + return; + } else { + ($sql, @search) = $self->acls_entry (@args); + } + } elsif ($type eq 'empty') { + ($sql) = $self->acls_empty; + } else { + $self->error ("do not know search type: $type"); + return; + } + } + + # Do the search. + my @acls; + eval { + my $sth = $self->{dbh}->prepare ($sql); + $sth->execute (@search); + my $object; + while (defined ($object = $sth->fetchrow_arrayref)) { + push (@acls, [ @$object ]); + } + $self->{dbh}->commit; + }; + if ($@) { + $self->error ("cannot list ACLs: $@"); + $self->{dbh}->rollback; + return; + } + return @acls; +} + +# Returns all ACL entries contained in owner ACLs for matching objects. +# Objects are specified by type and name, which may be SQL wildcard +# expressions. Each list member will be a pair of ACL scheme and ACL +# identifier, with duplicates removed. 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 owners { + my ($self, $type, $name) = @_; + undef $self->{error}; + my @lines; + eval { + my $sql = 'select distinct ae_scheme, ae_identifier from acl_entries, + acls, objects where ae_id = ac_id and ac_id = ob_owner and + ob_type like ? and ob_name like ? order by ae_scheme, + ae_identifier'; + my $sth = $self->{dbh}->prepare ($sql); + $sth->execute ($type, $name); + my $object; + while (defined ($object = $sth->fetchrow_arrayref)) { + push (@lines, [ @$object ]); + } + $self->{dbh}->commit; + }; + if ($@) { + $self->error ("cannot report on owners: $@"); + $self->{dbh}->rollback; + return; + } + return @lines; +} + +1; +__DATA__ + +############################################################################## +# Documentation +############################################################################## + +=head1 NAME + +Wallet::Report - Wallet system reporting interface + +=for stopwords +ACL ACLs wildcard Allbery SQL tuples + +=head1 SYNOPSIS + + use Wallet::Report; + my $report = Wallet::Report->new; + my @objects = $report->objects ('type', 'keytab'); + for my $object (@objects) { + print "@$object\n"; + } + +=head1 DESCRIPTION + +Wallet::Report provides a mechanism to generate lists and reports on the +contents of the wallet database. The format of the results returned +depend on the type of search, but will generally be returned as a list of +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). + +=head1 CLASS METHODS + +=over 4 + +=item new() + +Creates a new wallet report object and connects to the database. On any +error, this method throws an exception. + +=back + +=head1 INSTANCE METHODS + +For all methods that can fail, the caller should call error() after a +failure to get the error message. For all methods that return lists, if +they return an empty list, the caller should call error() to distinguish +between an empty report and an error. + +=over 4 + +=item acls([ TYPE [, SEARCH ... ]]) + +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 takes no arguments and will return +only those ACLs that have no entries within them. C 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. + +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 and +ID 1 and one with name C and ID 3, acls() with no arguments +would return: + + ([ 1, 'ADMIN' ], [ 3, 'group/admins' ]) + +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 +have failed. Callers should call this function to get the error message +after an undef return from any other instance method. + +=item objects([ TYPE [, SEARCH ... ]]) + +Returns a list of all objects matching a search type and string in the +database, or all objects in the database if no search information is +given. + +There are four types of searches currently. C, with a given type, +will return only those entries where the type matches the given type. +C, with a given owner, will only return those objects owned by the +given ACL name or ID. C, with a given flag name, will only return +those items with a flag set to the given value. C operates like +C, but will return only those objects that have the given ACL name +or ID on any of the possible ACL settings, not just owner. + +The return value is a list of references to pairs of type and name. For +example, if two objects existed in the database, both of type C +and with values C and C, objects() with no +arguments would return: + + ([ 'keytab', 'host/example.com' ], [ 'keytab', 'foo' ]) + +Returns the empty list on failure. To distinguish between this and an +empty search result, the caller should call error(). error() is +guaranteed to return the error message if there was an error and undef if +there was no error. + +=item owners(TYPE, NAME) + +Returns a list of all ACL lines contained in owner ACLs for objects +matching TYPE and NAME, which are interpreted as SQL patterns using C<%> +as a wildcard. The return value is a list of references to pairs of +schema and identifier, with duplicates removed. + +Returns the empty list on failure. To distinguish between this and no +matches, the caller should call error(). error() is guaranteed to return +the error message if there was an error and undef if there was no error. + +=back + +=head1 SEE ALSO + +Wallet::Config(3), Wallet::Server(3) + +This module is part of the wallet system. The current version is +available from L. + +=head1 AUTHOR + +Russ Allbery and Jon Robertson . + +=cut diff --git a/perl/t/admin.t b/perl/t/admin.t index f94b39b..e22088e 100755 --- a/perl/t/admin.t +++ b/perl/t/admin.t @@ -3,13 +3,14 @@ # t/admin.t -- Tests for wallet administrative interface. # # Written by Russ Allbery -# 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. -use Test::More tests => 83; +use Test::More tests => 16; use Wallet::Admin; +use Wallet::Report; use Wallet::Schema; use Wallet::Server; @@ -25,10 +26,11 @@ is ($admin->initialize ('admin@EXAMPLE.COM'), 1, ' and initialization succeeds'); # We have an empty database, so we should see no objects and one ACL. -my @objects = $admin->list_objects; +my $report = Wallet::Report->new; +my @objects = $report->objects; is (scalar (@objects), 0, 'No objects in the database'); -is ($admin->error, undef, ' and no error'); -my @acls = $admin->list_acls; +is ($report->error, undef, ' and no error'); +my @acls = $report->acls; is (scalar (@acls), 1, 'One ACL in the database'); is ($acls[0][0], 1, ' and that is ACL ID 1'); is ($acls[0][1], 'ADMIN', ' with the right name'); @@ -36,137 +38,20 @@ is ($acls[0][1], 'ADMIN', ' with the right name'); # Register a base object so that we can create a simple object. is ($admin->register_object ('base', 'Wallet::Object::Base'), 1, 'Registering Wallet::Object::Base works'); - -# Create an object. +is ($admin->register_object ('base', 'Wallet::Object::Base'), undef, + ' and cannot be registered twice'); $server = eval { Wallet::Server->new ('admin@EXAMPLE.COM', 'localhost') }; is ($@, '', 'Creating a server instance did not die'); is ($server->create ('base', 'service/admin'), 1, ' and creating base:service/admin succeeds'); -# Now, we should see one object. -@objects = $admin->list_objects; -is (scalar (@objects), 1, ' and now there is one object'); -is ($objects[0][0], 'base', ' with the right type'); -is ($objects[0][1], 'service/admin', ' and the right name'); - -# Test registering a new ACL type. We don't have a good way of really using -# this right now. +# Test registering a new ACL type. is ($admin->register_verifier ('base', 'Wallet::ACL::Base'), 1, 'Registering Wallet::ACL::Base works'); - -# Create another ACL. -is ($server->acl_create ('first'), 1, 'ACL creation succeeds'); -@acls = $admin->list_acls; -is (scalar (@acls), 2, ' and now there are two ACLs'); -is ($acls[0][0], 1, ' and the first ID is correct'); -is ($acls[0][1], 'ADMIN', ' and the first name is correct'); -is ($acls[1][0], 2, ' and the second ID is correct'); -is ($acls[1][1], 'first', ' and the second name is correct'); - -# Delete that ACL and create another. -is ($server->acl_create ('second'), 1, 'Second ACL creation succeeds'); -is ($server->acl_destroy ('first'), 1, ' and deletion of the first succeeds'); -@acls = $admin->list_acls; -is (scalar (@acls), 2, ' and there are still two ACLs'); -is ($acls[0][0], 1, ' and the first ID is still the same'); -is ($acls[0][1], 'ADMIN', ' and the first name is still the same'); -is ($acls[1][0], 3, ' but the second ID has changed'); -is ($acls[1][1], 'second', ' and the second name is correct'); - -# Currently, we have no owners, so we should get an empty owner report. -my @lines = $admin->report_owners ('%', '%'); -is (scalar (@lines), 0, 'Owner report is currently empty'); -is ($admin->error, undef, ' and there is no error'); - -# Set an owner and make sure we now see something in the report. -is ($server->owner ('base', 'service/admin', 'ADMIN'), 1, - 'Setting an owner works'); -@lines = $admin->report_owners ('%', '%'); -is (scalar (@lines), 1, ' and now there is one owner in the report'); -is ($lines[0][0], 'krb5', ' with the right scheme'); -is ($lines[0][1], 'admin@EXAMPLE.COM', ' and the right identifier'); -@lines = $admin->report_owners ('keytab', '%'); -is (scalar (@lines), 0, 'Owners of keytabs is empty'); -is ($admin->error, undef, ' with no error'); -@lines = $admin->report_owners ('base', 'foo/%'); -is (scalar (@lines), 0, 'Owners of base foo/* objects is empty'); -is ($admin->error, undef, ' with no error'); - -# Create a second object with the same owner. -is ($server->create ('base', 'service/foo'), 1, - 'Creating base:service/foo succeeds'); -is ($server->owner ('base', 'service/foo', 'ADMIN'), 1, - ' and setting the owner to the same value works'); -@lines = $admin->report_owners ('base', 'service/%'); -is (scalar (@lines), 1, ' and there is still owner in the report'); -is ($lines[0][0], 'krb5', ' with the right scheme'); -is ($lines[0][1], 'admin@EXAMPLE.COM', ' and the right identifier'); - -# Change the owner of the second object to an empty ACL. -is ($server->owner ('base', 'service/foo', 'second'), 1, - ' and changing the owner to an empty ACL works'); -@lines = $admin->report_owners ('base', '%'); -is (scalar (@lines), 1, ' and there is still owner in the report'); -is ($lines[0][0], 'krb5', ' with the right scheme'); -is ($lines[0][1], 'admin@EXAMPLE.COM', ' and the right identifier'); - -# Add a few things to the second ACL to see what happens. -is ($server->acl_add ('second', 'base', 'foo'), 1, - 'Adding an ACL line to the new ACL works'); -is ($server->acl_add ('second', 'base', 'bar'), 1, - ' and adding another ACL line to the new ACL works'); -@lines = $admin->report_owners ('base', '%'); -is (scalar (@lines), 3, ' and now there are three owners in the report'); -is ($lines[0][0], 'base', ' first has the right scheme'); -is ($lines[0][1], 'bar', ' and the right identifier'); -is ($lines[1][0], 'base', ' second has the right scheme'); -is ($lines[1][1], 'foo', ' and the right identifier'); -is ($lines[2][0], 'krb5', ' third has the right scheme'); -is ($lines[2][1], 'admin@EXAMPLE.COM', ' and the right identifier'); - -# Test ownership and other ACL values. Change one keytab to be not owned by -# ADMIN, but have group permission on it. We'll need a third object neither -# owned by ADMIN or with any permissions from it. -is ($server->create ('base', 'service/null'), 1, - 'Creating base:service/null succeeds'); -is ($server->acl ('base', 'service/foo', 'get', 'ADMIN'), 1, - 'Changing the get ACL for the search also does'); -@lines = $admin->list_objects ('owner', 'ADMIN'); -is (scalar (@lines), 1, 'Searching for objects owned by ADMIN finds one'); -is ($lines[0][0], 'base', ' and it has the right type'); -is ($lines[0][1], 'service/admin', ' and the right name'); -@lines = $admin->list_objects ('owner', 'null'); -is (scalar (@lines), 1, 'Searching for objects with no set ownerfinds one'); -is ($lines[0][0], 'base', ' and it has the right type'); -is ($lines[0][1], 'service/null', ' and the right name'); -@lines = $admin->list_objects ('acl', 'ADMIN'); -is (scalar (@lines), 2, 'ADMIN has any rights at all on two objects'); -is ($lines[0][0], 'base', ' and the first has the right type'); -is ($lines[0][1], 'service/admin', ' and the right name'); -is ($lines[1][0], 'base', ' and the second has the right type'); -is ($lines[1][1], 'service/foo', ' and the right name'); - -# Listing objects of a specific type. -@lines = $admin->list_objects ('type', 'base'); -is (scalar (@lines), 3, 'Searching for all objects of type base finds three'); -is ($lines[0][0], 'base', ' and the first has the right type'); -is ($lines[0][1], 'service/admin', ' and the right name'); -is ($lines[1][0], 'base', ' and the second has the right type'); -is ($lines[1][1], 'service/foo', ' and the right name'); -is ($lines[2][0], 'base', ' and the third has the right type'); -is ($lines[2][1], 'service/null', ' and the right name'); -@lines = $admin->list_objects ('type', 'keytab'); -is (scalar (@lines), 0, 'Searching for all objects of type keytab finds none'); - -# Test setting a flag, searching for objects with it, and then clearing it. -is ($server->flag_set ('base', 'service/admin', 'unchanging'), 1, - 'Setting a flag works'); -@lines = $admin->list_objects ('flag', 'unchanging'); -is (scalar (@lines), 1, 'Searching for all objects with that flag finds one'); -is ($lines[0][0], 'base', ' and it has the right type'); -is ($lines[0][1], 'service/admin', ' and the right name'); -is ($server->flag_clear ('base', 'service/admin', 'unchanging'), 1, - 'Clearing the flag works'); +is ($admin->register_verifier ('base', 'Wallet::ACL::Base'), undef, + ' and cannot be registered twice'); +is ($server->acl_add ('ADMIN', 'base', 'foo'), 1, + ' and adding a base ACL now works'); # Clean up. is ($admin->destroy, 1, 'Destruction succeeds'); diff --git a/perl/t/report.t b/perl/t/report.t new file mode 100755 index 0000000..a18b995 --- /dev/null +++ b/perl/t/report.t @@ -0,0 +1,171 @@ +#!/usr/bin/perl -w +# +# t/report.t -- Tests for the wallet reporting interface. +# +# Written by Russ Allbery +# Copyright 2008, 2009, 2010 Board of Trustees, Leland Stanford Jr. University +# +# See LICENSE for licensing terms. + +use Test::More tests => 83; + +use Wallet::Admin; +use Wallet::Report; +use Wallet::Server; + +use lib 't/lib'; +use Util; + +# Use Wallet::Admin to set up the database. +db_setup; +my $admin = eval { Wallet::Admin->new }; +is ($@, '', 'Wallet::Admin creation did not die'); +is ($admin->reinitialize ('admin@EXAMPLE.COM'), 1, + 'Database initialization succeeded'); +$admin->register_object ('base', 'Wallet::Object::Base'); +$admin->register_verifier ('base', 'Wallet::ACL::Base'); + +# We have an empty database, so we should see no objects and one ACL. +my $report = eval { Wallet::Report->new }; +is ($@, '', 'Wallet::Report creation did not die'); +ok ($report->isa ('Wallet::Report'), ' and returned the right class'); +my @objects = $report->objects; +is (scalar (@objects), 0, 'No objects in the database'); +is ($report->error, undef, ' and no error'); +my @acls = $report->acls; +is (scalar (@acls), 1, 'One ACL in the database'); +is ($acls[0][0], 1, ' and that is ACL ID 1'); +is ($acls[0][1], 'ADMIN', ' with the right name'); + +# Create an object. +$server = eval { Wallet::Server->new ('admin@EXAMPLE.COM', 'localhost') }; +is ($@, '', 'Creating a server instance did not die'); +is ($server->create ('base', 'service/admin'), 1, + ' and creating base:service/admin succeeds'); + +# Now, we should see one object. +@objects = $report->objects; +is (scalar (@objects), 1, ' and now there is one object'); +is ($objects[0][0], 'base', ' with the right type'); +is ($objects[0][1], 'service/admin', ' and the right name'); + +# Create another ACL. +is ($server->acl_create ('first'), 1, 'ACL creation succeeds'); +@acls = $report->acls; +is (scalar (@acls), 2, ' and now there are two ACLs'); +is ($acls[0][0], 1, ' and the first ID is correct'); +is ($acls[0][1], 'ADMIN', ' and the first name is correct'); +is ($acls[1][0], 2, ' and the second ID is correct'); +is ($acls[1][1], 'first', ' and the second name is correct'); + +# Delete that ACL and create another. +is ($server->acl_create ('second'), 1, 'Second ACL creation succeeds'); +is ($server->acl_destroy ('first'), 1, ' and deletion of the first succeeds'); +@acls = $report->acls; +is (scalar (@acls), 2, ' and there are still two ACLs'); +is ($acls[0][0], 1, ' and the first ID is still the same'); +is ($acls[0][1], 'ADMIN', ' and the first name is still the same'); +is ($acls[1][0], 3, ' but the second ID has changed'); +is ($acls[1][1], 'second', ' and the second name is correct'); + +# Currently, we have no owners, so we should get an empty owner report. +my @lines = $report->owners ('%', '%'); +is (scalar (@lines), 0, 'Owner report is currently empty'); +is ($report->error, undef, ' and there is no error'); + +# Set an owner and make sure we now see something in the report. +is ($server->owner ('base', 'service/admin', 'ADMIN'), 1, + 'Setting an owner works'); +@lines = $report->owners ('%', '%'); +is (scalar (@lines), 1, ' and now there is one owner in the report'); +is ($lines[0][0], 'krb5', ' with the right scheme'); +is ($lines[0][1], 'admin@EXAMPLE.COM', ' and the right identifier'); +@lines = $report->owners ('keytab', '%'); +is (scalar (@lines), 0, 'Owners of keytabs is empty'); +is ($report->error, undef, ' with no error'); +@lines = $report->owners ('base', 'foo/%'); +is (scalar (@lines), 0, 'Owners of base foo/* objects is empty'); +is ($report->error, undef, ' with no error'); + +# Create a second object with the same owner. +is ($server->create ('base', 'service/foo'), 1, + 'Creating base:service/foo succeeds'); +is ($server->owner ('base', 'service/foo', 'ADMIN'), 1, + ' and setting the owner to the same value works'); +@lines = $report->owners ('base', 'service/%'); +is (scalar (@lines), 1, ' and there is still owner in the report'); +is ($lines[0][0], 'krb5', ' with the right scheme'); +is ($lines[0][1], 'admin@EXAMPLE.COM', ' and the right identifier'); + +# Change the owner of the second object to an empty ACL. +is ($server->owner ('base', 'service/foo', 'second'), 1, + ' and changing the owner to an empty ACL works'); +@lines = $report->owners ('base', '%'); +is (scalar (@lines), 1, ' and there is still owner in the report'); +is ($lines[0][0], 'krb5', ' with the right scheme'); +is ($lines[0][1], 'admin@EXAMPLE.COM', ' and the right identifier'); + +# Add a few things to the second ACL to see what happens. +is ($server->acl_add ('second', 'base', 'foo'), 1, + 'Adding an ACL line to the new ACL works'); +is ($server->acl_add ('second', 'base', 'bar'), 1, + ' and adding another ACL line to the new ACL works'); +@lines = $report->owners ('base', '%'); +is (scalar (@lines), 3, ' and now there are three owners in the report'); +is ($lines[0][0], 'base', ' first has the right scheme'); +is ($lines[0][1], 'bar', ' and the right identifier'); +is ($lines[1][0], 'base', ' second has the right scheme'); +is ($lines[1][1], 'foo', ' and the right identifier'); +is ($lines[2][0], 'krb5', ' third has the right scheme'); +is ($lines[2][1], 'admin@EXAMPLE.COM', ' and the right identifier'); + +# Test ownership and other ACL values. Change one keytab to be not owned by +# ADMIN, but have group permission on it. We'll need a third object neither +# owned by ADMIN or with any permissions from it. +is ($server->create ('base', 'service/null'), 1, + 'Creating base:service/null succeeds'); +is ($server->acl ('base', 'service/foo', 'get', 'ADMIN'), 1, + 'Changing the get ACL for the search also does'); +@lines = $report->objects ('owner', 'ADMIN'); +is (scalar (@lines), 1, 'Searching for objects owned by ADMIN finds one'); +is ($lines[0][0], 'base', ' and it has the right type'); +is ($lines[0][1], 'service/admin', ' and the right name'); +@lines = $report->objects ('owner', 'null'); +is (scalar (@lines), 1, 'Searching for objects with no set ownerfinds one'); +is ($lines[0][0], 'base', ' and it has the right type'); +is ($lines[0][1], 'service/null', ' and the right name'); +@lines = $report->objects ('acl', 'ADMIN'); +is (scalar (@lines), 2, 'ADMIN has any rights at all on two objects'); +is ($lines[0][0], 'base', ' and the first has the right type'); +is ($lines[0][1], 'service/admin', ' and the right name'); +is ($lines[1][0], 'base', ' and the second has the right type'); +is ($lines[1][1], 'service/foo', ' and the right name'); + +# Listing objects of a specific type. +@lines = $report->objects ('type', 'base'); +is (scalar (@lines), 3, 'Searching for all objects of type base finds three'); +is ($lines[0][0], 'base', ' and the first has the right type'); +is ($lines[0][1], 'service/admin', ' and the right name'); +is ($lines[1][0], 'base', ' and the second has the right type'); +is ($lines[1][1], 'service/foo', ' and the right name'); +is ($lines[2][0], 'base', ' and the third has the right type'); +is ($lines[2][1], 'service/null', ' and the right name'); +@lines = $report->objects ('type', 'keytab'); +is (scalar (@lines), 0, 'Searching for all objects of type keytab finds none'); + +# Test setting a flag, searching for objects with it, and then clearing it. +is ($server->flag_set ('base', 'service/admin', 'unchanging'), 1, + 'Setting a flag works'); +@lines = $report->objects ('flag', 'unchanging'); +is (scalar (@lines), 1, 'Searching for all objects with that flag finds one'); +is ($lines[0][0], 'base', ' and it has the right type'); +is ($lines[0][1], 'service/admin', ' and the right name'); +is ($server->flag_clear ('base', 'service/admin', 'unchanging'), 1, + 'Clearing the flag works'); +@lines = $report->objects ('flag', 'unchanging'); +is (scalar (@lines), 0, ' and now there are no objects in the report'); +is ($report->error, undef, ' with no error'); + +# Clean up. +$admin->destroy; +unlink 'wallet-db'; diff --git a/server/wallet-report b/server/wallet-report new file mode 100755 index 0000000..a6b3b8d --- /dev/null +++ b/server/wallet-report @@ -0,0 +1,203 @@ +#!/usr/bin/perl -w +# +# wallet-report -- Wallet server reporting interface. +# +# Written by Russ Allbery +# Copyright 2008, 2009, 2010 Board of Trustees, Leland Stanford Jr. University +# +# See LICENSE for licensing terms. + +############################################################################## +# Declarations and site configuration +############################################################################## + +use strict; +use Wallet::Report; + +############################################################################## +# Implementation +############################################################################## + +# Parse and execute a command. We wrap this in a subroutine call for easier +# testing. +sub command { + die "Usage: wallet-report [ ...]\n" unless @_; + my $report = Wallet::Report->new; + + # Parse command-line options and dispatch to the appropriate calls. + my ($command, @args) = @_; + if ($command eq 'acls') { + die "too many arguments to acls\n" if @args > 3; + my @acls = $report->acls (@args); + if (!@acls and $report->error) { + die $report->error, "\n"; + } + for my $acl (sort { $$a[1] cmp $$b[1] } @acls) { + print "$$acl[1] (ACL ID: $$acl[0])\n"; + } + } elsif ($command eq 'objects') { + die "too many arguments to objects\n" if @args > 2; + my @objects = $report->objects (@args); + if (!@objects and $report->error) { + die $report->error, "\n"; + } + for my $object (@objects) { + print join (' ', @$object), "\n"; + } + } elsif ($command eq 'owners') { + die "too many arguments to owners\n" if @args > 2; + die "too few arguments to owners\n" if @args < 2; + my @entries = $report->owners (@args); + if (!@entries and $report->error) { + die $report->error, "\n"; + } + for my $entry (@entries) { + print join (' ', @$entry), "\n"; + } + } else { + die "unknown command $command\n"; + } +} +command (@ARGV); +__END__ + +############################################################################## +# Documentation +############################################################################## + +=head1 NAME + +wallet-report - Wallet server reporting interface + +=for stopwords +metadata ACL hostname backend acl acls wildcard SQL Allbery remctl + +=head1 SYNOPSIS + +B I [I ...] + +=head1 DESCRIPTION + +B provides a command-line interface for running reports on +the wallet database. It is intended to be run on the wallet server as a +user with access to the wallet database and configuration, but can also be +made available via remctl to users who should have reporting privileges. + +This program is a fairly thin wrapper around Wallet::Report that +translates command strings into method calls and returns the results. + +=head1 OPTIONS + +B takes no traditional options. + +=head1 COMMANDS + +=over 4 + +=item acls + +=item acls empty + +=item acls entry + +Returns a list of ACLs in the database. ACLs will be listed in the form: + + (ACL ID: ) + +where is the human-readable name and is the numeric ID. The +numeric ID is what's used internally by the wallet system. There will be +one line per ACL. + +If no search type is given, all the ACLs in the database will be returned. +If a search type (and possible search arguments) are given, then the ACLs +will be limited to those that match the search. + +The currently supported ACL search types are: + +=over 4 + +=item acls empty + +Returns all ACLs which have no entries, generally so that abandoned ACLs +can be destroyed. + +=item acls entry + +Returns all ACLs containing an entry with given scheme and identifier. +The scheme must be an exact match, but the string will match +any identifier containing that string. + +=back + +=item objects + +=item objects acl + +=item objects flag + +=item objects owner + +=item objects type + +Returns a list of objects in the database. Objects will be listed in the +form: + + + +There will be one line per object. + +If no search type is given, all objects in the database will be returned. +If a search type (and possible search arguments) are given, the objects +will be limited to those that match the search. + +The currently supported object search types are: + +=over 4 + +=item list objects 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 + +Returns all objects which have the given flag set. + +=item list objects owner + +Returns all objects owned by the given ACL name or ID. + +=item list objects type + +Returns all objects of the given type. + +=back + +=item owners + +Returns a list of all ACL entries in owner ACLs for all objects matching +both and . 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: + + + +with duplicates suppressed. + +=back + +=head1 SEE ALSO + +Wallet::Config(3), Wallet::Report(3), wallet-backend(8) + +This program is part of the wallet system. The current version is +available from L. + +=head1 AUTHOR + +Russ Allbery + +=cut diff --git a/tests/docs/pod-spelling-t b/tests/docs/pod-spelling-t index 433d841..6993e4c 100755 --- a/tests/docs/pod-spelling-t +++ b/tests/docs/pod-spelling-t @@ -48,7 +48,7 @@ my @pod = map { $pod =~ s,[^/.][^/]*/../,,g; $pod; } qw(client/wallet.pod server/keytab-backend server/wallet-admin - server/wallet-backend); + server/wallet-backend server/wallet-report); plan tests => scalar @pod; # Finally, do the checks. diff --git a/tests/docs/pod-t b/tests/docs/pod-t index 9b6c5d1..f92ba2c 100755 --- a/tests/docs/pod-t +++ b/tests/docs/pod-t @@ -13,7 +13,7 @@ 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); + server/wallet-backend server/wallet-report); my $total = scalar (@files); plan tests => $total; for my $file (@files) { diff --git a/tests/server/admin-t b/tests/server/admin-t index 570dc52..5bde104 100755 --- a/tests/server/admin-t +++ b/tests/server/admin-t @@ -8,15 +8,14 @@ # See LICENSE for licensing terms. use strict; -use Test::More tests => 64; +use Test::More tests => 36; # Create a dummy class for Wallet::Admin that prints what method was called # with its arguments and returns data for testing. package Wallet::Admin; -use vars qw($empty $error); +use vars qw($error); $error = 0; -$empty = 0; sub error { if ($error) { @@ -44,19 +43,6 @@ sub initialize { return 1; } -sub list_objects { - print "list_objects\n"; - return if ($error or $empty); - return ([ keytab => 'host/windlord.stanford.edu' ], - [ file => 'unix-wallet-password' ]); -} - -sub list_acls { - print "list_acls\n"; - return if ($error or $empty); - return ([ 1, 'ADMIN' ], [ 2, 'group/admins' ], [ 4, 'group/users' ]); -} - sub register_object { shift; print "register_object @_\n"; @@ -71,13 +57,6 @@ sub register_verifier { return 1; } -sub report_owners { - shift; - print "report_owners @_\n"; - return if ($error or $empty); - return ([ krb5 => 'admin@EXAMPLE.COM' ]); -} - # Back to the main package and the actual test suite. Lie about whether the # Wallet::Admin package has already been loaded. package main; @@ -107,9 +86,7 @@ is ($out, "new\n", ' and nothing ran'); # Check too few and too many arguments for every command. my %commands = (destroy => [0, 0], initialize => [1, 1], - list => [1, 4], - register => [3, 3], - report => [1, -1]); + register => [3, 3]); for my $command (sort keys %commands) { my ($min, $max) = @{ $commands{$command} }; if ($min > 0) { @@ -159,22 +136,6 @@ is ($out, "new\n", ' and nothing was run'); is ($err, '', 'Initialize succeeds with a principal'); is ($out, "new\ninitialize rra\@stanford.edu\n", ' and runs the right code'); -# Test list. -($out, $err) = run_admin ('list', 'foo'); -is ($err, "only objects or acls are supported for list\n", - 'List requires a known object'); -is ($out, "new\n", ' and nothing was run'); -($out, $err) = run_admin ('list', 'objects'); -is ($err, '', 'List succeeds for objects'); -is ($out, "new\nlist_objects\n" - . "keytab host/windlord.stanford.edu\nfile unix-wallet-password\n", - ' and returns the right output'); -($out, $err) = run_admin ('list', 'acls'); -is ($err, '', 'List succeeds for ACLs'); -is ($out, "new\nlist_acls\n" - . "ADMIN (ACL ID: 1)\ngroup/admins (ACL ID: 2)\ngroup/users (ACL ID: 4)\n", - ' and returns the right output'); - # Test register. ($out, $err) = run_admin ('register', 'foo', 'foo', 'Foo::Bar'); is ($err, "only object or verifier is supported for register\n", @@ -189,15 +150,6 @@ is ($err, '', 'Register succeeds for verifier'); is ($out, "new\nregister_verifier foo Foo::Verifier\n", ' and returns the right outout'); -# Test report. -($out, $err) = run_admin ('report', 'foo'); -is ($err, "unknown report type foo\n", 'Report requires a known report'); -is ($out, "new\n", ' and nothing was run'); -($out, $err) = run_admin ('report', 'owners', '%', '%'); -is ($err, '', 'Report succeeds for owners'); -is ($out, "new\nreport_owners % %\nkrb5 admin\@EXAMPLE.COM\n", - ' and returns the right output'); - # Test error handling. $Wallet::Admin::error = 1; ($out, $err) = run_admin ('destroy'); @@ -209,12 +161,6 @@ is ($out, "new\n" is ($err, "some error\n", 'Error handling succeeds for initialize'); is ($out, "new\ninitialize rra\@stanford.edu\n", ' and calls the right methods'); -($out, $err) = run_admin ('list', 'objects'); -is ($err, "some error\n", 'Error handling succeeds for list objects'); -is ($out, "new\nlist_objects\n", ' and calls the right methods'); -($out, $err) = run_admin ('list', 'acls'); -is ($err, "some error\n", 'Error handling succeeds for list acls'); -is ($out, "new\nlist_acls\n", ' and calls the right methods'); ($out, $err) = run_admin ('register', 'object', 'foo', 'Foo::Object'); is ($err, "some error\n", 'Error handling succeeds for register object'); is ($out, "new\nregister_object foo Foo::Object\n", @@ -223,19 +169,3 @@ is ($out, "new\nregister_object foo Foo::Object\n", is ($err, "some error\n", 'Error handling succeeds for register verifier'); is ($out, "new\nregister_verifier foo Foo::Verifier\n", ' and calls the right methods'); -($out, $err) = run_admin ('report', 'owners', 'foo', 'bar'); -is ($err, "some error\n", 'Error handling succeeds for report owners'); -is ($out, "new\nreport_owners foo bar\n", ' and calls the right methods'); - -# Test empty lists. -$Wallet::Admin::error = 0; -$Wallet::Admin::empty = 1; -($out, $err) = run_admin ('list', 'objects'); -is ($err, '', 'list objects runs with an empty list with no errors'); -is ($out, "new\nlist_objects\n", ' and calls the right methods'); -($out, $err) = run_admin ('list', 'acls'); -is ($err, '', 'list acls runs with an empty list and no errors'); -is ($out, "new\nlist_acls\n", ' and calls the right methods'); -($out, $err) = run_admin ('report', 'owners', 'foo', 'bar'); -is ($err, '', 'report owners runs with an empty list and no errors'); -is ($out, "new\nreport_owners foo bar\n", ' and calls the right methods'); diff --git a/tests/server/report-t b/tests/server/report-t new file mode 100755 index 0000000..285ee5a --- /dev/null +++ b/tests/server/report-t @@ -0,0 +1,151 @@ +#!/usr/bin/perl -w +# +# Tests for the wallet-report dispatch code. +# +# Written by Russ Allbery +# Copyright 2008, 2009, 2010 Board of Trustees, Leland Stanford Jr. University +# +# See LICENSE for licensing terms. + +use strict; +use Test::More tests => 32; + +# Create a dummy class for Wallet::Report that prints what method was called +# with its arguments and returns data for testing. +package Wallet::Report; + +use vars qw($empty $error); +$error = 0; +$empty = 0; + +sub error { + if ($error) { + return "some error"; + } else { + return; + } +} + +sub new { + print "new\n"; + return bless ({}, 'Wallet::Report'); +} + +sub acls { + shift; + print "acls @_\n"; + return if ($error or $empty); + return ([ 1, 'ADMIN' ], [ 2, 'group/admins' ], [ 4, 'group/users' ]); +} + +sub objects { + shift; + print "objects @_\n"; + return if ($error or $empty); + return ([ keytab => 'host/windlord.stanford.edu' ], + [ file => 'unix-wallet-password' ]); +} + +sub owners { + shift; + print "owners @_\n"; + return if ($error or $empty); + return ([ krb5 => 'admin@EXAMPLE.COM' ]); +} + +# Back to the main package and the actual test suite. Lie about whether the +# Wallet::Report package has already been loaded. +package main; +$INC{'Wallet/Report.pm'} = 'FAKE'; +eval { do "$ENV{SOURCE}/../server/wallet-report" }; + +# Run the wallet report client. This fun hack takes advantage of the fact +# that the wallet report client is written in Perl so that we can substitute +# our own Wallet::Report class. +sub run_report { + my (@args) = @_; + my $result = ''; + open (OUTPUT, '>', \$result) or die "cannot create output string: $!\n"; + select OUTPUT; + local $| = 1; + eval { command (@args) }; + my $error = $@; + select STDOUT; + return ($result, $error); +} + +# Now for the actual tests. First check for unknown commands. +my ($out, $err) = run_report ('foo'); +is ($err, "unknown command foo\n", 'Unknown command'); +is ($out, "new\n", ' and nothing ran'); + +# Check too few and too many arguments for every command. +my %commands = (acls => [0, 3], + objects => [0, 2], + owners => [2, 2]); +for my $command (sort keys %commands) { + my ($min, $max) = @{ $commands{$command} }; + if ($min > 0) { + ($out, $err) = run_report ($command, ('foo') x ($min - 1)); + is ($err, "too few arguments to $command\n", + "Too few arguments for $command"); + is ($out, "new\n", ' and nothing ran'); + } + if ($max >= 0) { + ($out, $err) = run_report ($command, ('foo') x ($max + 1)); + is ($err, "too many arguments to $command\n", + "Too many arguments for $command"); + is ($out, "new\n", ' and nothing ran'); + } +} + +# Test the report methods. +($out, $err) = run_report ('acls'); +is ($err, '', 'List succeeds for ACLs'); +is ($out, "new\nacls \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 ('acls', 'entry', 'foo', 'foo'); +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 ('objects'); +is ($err, '', 'List succeeds for objects'); +is ($out, "new\nobjects \n" + . "keytab host/windlord.stanford.edu\nfile unix-wallet-password\n", + ' and returns the right output'); +($out, $err) = run_report ('objects', 'type', 'foo'); +is ($err, '', 'List succeeds for objects type foo'); +is ($out, "new\nobjects type foo\n" + . "keytab host/windlord.stanford.edu\nfile unix-wallet-password\n", + ' and returns the right output'); +($out, $err) = run_report ('owners', '%', '%'); +is ($err, '', 'Report succeeds for owners'); +is ($out, "new\nowners % %\nkrb5 admin\@EXAMPLE.COM\n", + ' and returns the right output'); + +# Test error handling. +$Wallet::Report::error = 1; +($out, $err) = run_report ('acls'); +is ($err, "some error\n", 'Error handling succeeds for list acls'); +is ($out, "new\nacls \n", ' and calls the right methods'); +($out, $err) = run_report ('objects'); +is ($err, "some error\n", 'Error handling succeeds for list 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 ($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 ($out, "new\nacls \n", ' and calls the right methods'); +($out, $err) = run_report ('objects'); +is ($err, '', 'list 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 ($out, "new\nowners foo bar\n", ' and calls the right methods'); -- cgit v1.2.3 From c46d99178ef073e23f99c676872b10afd4c15577 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Fri, 19 Feb 2010 13:04:36 -0800 Subject: The client now builds on Heimdal, remove from TODO --- TODO | 4 ---- 1 file changed, 4 deletions(-) diff --git a/TODO b/TODO index cca8780..9491426 100644 --- a/TODO +++ b/TODO @@ -18,10 +18,6 @@ Release 1.0: * Add a help function to wallet-backend listing the commands. -* The client may not compile against Heimdal due to changes in how the - krb5_keyblock structure is laid out, the freeing of keytab entries, - and the use of WRFILE for keytab merging. Check and fix. - * Rewrite the client test suite to use Perl and to make better use of shared code so that it can be broken into function components. -- cgit v1.2.3 From 77581a6a1620118ca17e26ec8b549603ab67b91b Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Sat, 20 Feb 2010 16:39:59 -0800 Subject: Reformat TODO by area instead of time frame Remove some TODO items that are no longer relevant, either because they've been implemented or because we no longer care about Kerberos v4 principal name conversion. --- TODO | 266 +++++++++++++++++++++++++++++++++++-------------------------------- 1 file changed, 138 insertions(+), 128 deletions(-) diff --git a/TODO b/TODO index 9491426..670a1c7 100644 --- a/TODO +++ b/TODO @@ -1,190 +1,200 @@ wallet To-Do List -Release 0.10: +Client: -* Check whether we can just drop the realm restriction on keytabs and - allow the name to contain the realm if the Kerberos type is Heimdal. + * Handle duplicate kvnos in a newly returned keytab and an existing + keytab (such as when downloading an unchanging keytab and merging it + into an existing one) in some reasonable fashion. -Release 1.0: + * Support removing old kvnos from a merged keytab (similar to kadmin + ktremove old). -* Fix case-insensitivity bug in unique keys with MySQL for objects. + * When reading configuration from krb5.conf, we should first try to + determine our principal from any existing K5 ticket cache (after + obtaining tickets if -u was given) and extract the realm from that + principal, using it as the default realm when reading configuration + information. -* Add POD coverage testing using Test::POD::Coverage for the server - modules. + * Add readline support to the wallet client to make it easier to issue + multiple commands. -* Provide a way to get history for deleted objects and ACLs. + * Add support for rekeying in the wallet client. Need to resolve how to + get a list of principals to rekey and which keytabs to work on. This + possibly should be a separate binary from the regular wallet client + binary. -* Provide an interface to mass-change all instances of one ACL to another. + * Support authenticating with a keytab. -* Add a help function to wallet-backend listing the commands. + * Allow store data to contain nuls. Requires rewriting the command + processing for store to use iovecs. -* Rewrite the client test suite to use Perl and to make better use of - shared code so that it can be broken into function components. + * When obtaining tickets in the wallet client with -u, should we get a + TGT as we do now or just directly obtain the service ticket we're going + to use for remctl? -* Catch exceptions on object creation in wallet-backend so that we can log - those as well. +Server Interface: -* Error messages from ACL operations should refer to the ACLs by name - instead of by ID. + * Provide a way to get history for deleted objects and ACLs. -* Add the database schema version to a global table so that we can use it - to support schema upgrades in the future. + * Provide an interface to mass-change all instances of one ACL to another. -* On upgrades, support adding new object types and ACL verifiers to the - class tables. + * Add a help function to wallet-backend listing the commands. -* Write the LDAP entitlement ACL verifier. + * Catch exceptions on object creation in wallet-backend so that we can + log those as well. -* Write the PTS ACL verifier. + * Provide a way to list all objects for which the connecting user has + ACLs. -* Write a WebAuth keyring object store. It should support attributes - saying how long to keep old keys and how far in advance to create new - keys and update the keyring as needed on object download. + * Support limiting returned history information by timestamp. -* Rename Wallet::ACL::* to Wallet::Verifier::*. Add Wallet::ACL as a - generic interface with Wallet::ACL::Database and Wallet::ACL::List - implementations (or some similar name) so that we can create and check - an ACL without having to write it into the database. Redo default ACL - creation using that functionality. + * Add a comment field for objects that can be set by the owner. -* Add a hook to enforce ACL naming standards. + * Provide a REST implementation of the wallet server. -Future work: + * Provide a CGI implementation of the wallet server. -* Provide a way to list all objects for which the connecting user has ACLs. + * Support setting flags and attributes on autocreate. In general, work + out a Wallet::Object::Template Perl object that I can return that + specifies things other than just the ACL. -* Write a conventions document for ACL naming, object naming, and similar - issues. + * Remove the hard-coded ADMIN ACL in the server with something more + configurable, perhaps a global ACL table or something. -* Write a future design and roadmap document to collect notes about how - unimplemented features should be handled. +ACLs: -* Support limiting returned history information by timestamp. + * Error messages from ACL operations should refer to the ACLs by name + instead of by ID. -* Improve the error message for Kerberos authentication failures. + * Write the LDAP entitlement ACL verifier. -* Handle duplicate kvnos in a newly returned keytab and an existing keytab - (such as when downloading an unchanging keytab and merging it into an - existing one) in some reasonable fashion. + * Write the PTS ACL verifier. -* Support removing old kvnos from a merged keytab (similar to kadmin - ktremove old). + * Rename Wallet::ACL::* to Wallet::Verifier::*. Add Wallet::ACL as a + generic interface with Wallet::ACL::Database and Wallet::ACL::List + implementations (or some similar name) so that we can create and check + an ACL without having to write it into the database. Redo default ACL + creation using that functionality. -* There is a lot of duplicate code in wallet-backend. Convert that to - use some sort of data-driven model with argument count and flags so - that the method calls can be written only once. Convert wallet-admin to - use the same code. + * Add a hook to enforce ACL naming standards. -* There's a lot of code duplication in the dispatch functions in the - Wallet::Server class. Find a way to rewrite that so that the dispatch - doesn't duplicate the same code patterns. + * 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. -* Refactor the test suite for the wallet backend to try to reduce the - duplicated code. + * Support for pattern matching in ACLs. -* Pull common test suite code into a Perl library that can be reused. + * A group-in-groups ACL schema. -* Add a function to wallet-admin to purge expired entries. Possibly also - check expiration before allowing anyone to get or store objects. + * Provide an API for verifiers to syntax-check the values before an ACL + is set and implement syntax checking for the Krb5 verifier. -* Add a comment field for objects that can be set by the owner. +Database: -* Use the Perl Authen::Krb5::Admin module instead of rolling our own - kadmin code with Expect now that MIT Kerberos has made the kadmin API - public. + * Fix case-insensitivity bug in unique keys with MySQL for objects. -* When reading configuration from krb5.conf, we should first try to - determine our principal from any existing K5 ticket cache (after - obtaining tickets if -u was given) and extract the realm from that - principal, using it as the default realm when reading configuration - information. + * Add the database schema version to a global table so that we can use it + to support schema upgrades in the future. -* Implement an ssh keypair wallet object. The server can run ssh-keygen - to generate a public/private key pair and return both to the client, - which would split them apart. Used primarily for host keys. May need a - side table to store key types, or a naming convention. + * On upgrades, support adding new object types and ACL verifiers to the + class tables. -* Implement an X.509 certificate object. I expect this would store the - public and private key as a single file in the same format that Apache - can read for combined public and private keys. There were requests for - storing the CSR, but I don't see why you'd want to do that. Start with - store support. +Objects: -* Implement an X.509 CA so that you can get certificate objects without - storing them first. Need to resolve naming conventions if you want to - run multiple CAs on the same wallet server (but why?). Should this be a - different type than stored certificates? + * Check whether we can just drop the realm restriction on keytabs and + allow the name to contain the realm if the Kerberos type is Heimdal. -* Add details to design-api on how to write one's own ACL verifiers and - object implementations and register them. + * Write a WebAuth keyring object store. It should support attributes + saying how long to keep old keys and how far in advance to create new + keys and update the keyring as needed on object download. -* Add readline support to the wallet client to make it easier to issue - multiple commands. + * Use the Perl Authen::Krb5::Admin module instead of rolling our own + kadmin code with Expect now that MIT Kerberos has made the kadmin API + public. -* The wallet-backend and wallet documentation share the COMMANDS section. - Work out some means to assemble the documentation without duplicating - content. + * Implement an ssh keypair wallet object. The server can run ssh-keygen + to generate a public/private key pair and return both to the client, + which would split them apart. Used primarily for host keys. May need + a side table to store key types, or a naming convention. -* Add support for rekeying in the wallet client. Need to resolve how to - get a list of principals to rekey and which keytabs to work on. This - possibly should be a separate binary from the regular wallet client - binary. + * Implement an X.509 certificate object. I expect this would store the + public and private key as a single file in the same format that Apache + can read for combined public and private keys. There were requests for + storing the CSR, but I don't see why you'd want to do that. Start with + store support. The file code is mostly sufficient here, but it would + be nice to automatically support object expiration based on the + expiration time for the certificate. -* Document using the wallet system over something other than remctl. + * Implement an X.509 CA so that you can get certificate objects without + storing them first. Need to resolve naming conventions if you want to + run multiple CAs on the same wallet server (but why?). Should this be + a different type than stored certificates? -* Provide a REST implementation of the wallet server. +Reports: -* Provide a CGI implementation of the wallet server. + * Make contrib/wallet-summary generic and include it in wallet-admin, + 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. -* Document all diagnostics for all wallet APIs. +Administrative Interface: -* Write a test suite to scan all wallet code looking for diagnostics that - aren't in the documentation and warn about them. + * Add a function to wallet-admin to purge expired entries. Possibly also + check expiration before allowing anyone to get or store objects. -* The Wallet::Config class is very ugly and could use some better internal - API to reference the variables in it. +Documentation: -* Use Class::DBI and Class::Trigger to handle the data access layer rather - than writing SQL directly, and implement the logging requirements with - triggers rather than explicit SQL. This may also replace - Wallet::Schema. + * Write a conventions document for ACL naming, object naming, and similar + issues. -* Make contrib/wallet-report generic and include it in wallet-admin, 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. + * Write a future design and roadmap document to collect notes about how + unimplemented features should be handled. -* Support setting flags and attributes on autocreate. In general, work out - a Wallet::Object::Template Perl object that I can return that specifies - things other than just the ACL. + * Add details to design-api on how to write one's own ACL verifiers and + object implementations and register them. -* 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. + * Document using the wallet system over something other than remctl. -* Support for pattern matching in ACLs. + * Document all diagnostics for all wallet APIs. -* A group-in-groups ACL schema. +Code Style and Cleanup: -* Modify Authen::Krb5 to export krb5_524_conv_principal so that I can use - it to determine the K4 equivalent of a K5 principal name. + * There is a lot of duplicate code in wallet-backend. Convert that to + use some sort of data-driven model with argument count and flags so + that the method calls can be written only once. Convert wallet-admin + to use the same code. -* Provide an API for verifiers to syntax-check the values before an - ACL is set and implement syntax checking for the Krb5 verifier. + * There's a lot of code duplication in the dispatch functions in the + Wallet::Server class. Find a way to rewrite that so that the dispatch + doesn't duplicate the same code patterns. -* Support authenticating with a keytab. + * The wallet-backend and wallet documentation share the COMMANDS section. + Work out some means to assemble the documentation without duplicating + content. -* Allow store data to contain nuls. Requires rewriting the command - processing for store to use iovecs. + * The Wallet::Config class is very ugly and could use some better + internal API to reference the variables in it. -May or may not be good ideas: + * Use Class::DBI and Class::Trigger to handle the data access layer + rather than writing SQL directly, and implement the logging + requirements with triggers rather than explicit SQL. This may also + replace Wallet::Schema. -* Consider using Class::Accessor to get rid of the scaffolding code to - access object data, and a Wallet::Base class to handle things like the - error() method common to many classes. + * Consider using Class::Accessor to get rid of the scaffolding code to + access object data, and a Wallet::Base class to handle things like the + error() method common to many classes. -* Remove the hard-coded ADMIN ACL in the server with something more - configurable, perhaps a global ACL table or something. +Test Suite: -* When obtaining tickets in the wallet client with -u, should we get a TGT - as we do now or just directly obtain the service ticket we're going to - use for remctl? + * Add POD coverage testing using Test::POD::Coverage for the server + modules. + + * Rewrite the client test suite to use Perl and to make better use of + shared code so that it can be broken into function components. + + * Refactor the test suite for the wallet backend to try to reduce the + duplicated code. + + * Pull common test suite code into a Perl library that can be reused. + + * Write a test suite to scan all wallet code looking for diagnostics that + aren't in the documentation and warn about them. -- cgit v1.2.3 From a3ee976840e97d37022ec117bae09fef25ac4385 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Sat, 20 Feb 2010 19:55:05 -0800 Subject: Add support in the wallet client for store of binary data Refactor the wallet client code to use remctl_commandv and send stores with data containing nul. --- client/file.c | 20 +++++++++---------- client/internal.h | 25 +++++++++++++---------- client/remctl.c | 53 ++++++++++++++++++++++++++++++++++++++----------- client/wallet.c | 34 +++++++++++++++++-------------- tests/client/basic-t.in | 9 ++++++++- tests/data/basic.conf | 1 + tests/data/cmd-fake | 9 +++++++-- 7 files changed, 100 insertions(+), 51 deletions(-) diff --git a/client/file.c b/client/file.c index c9edf3a..66d5f63 100644 --- a/client/file.c +++ b/client/file.c @@ -115,14 +115,13 @@ get_file(struct remctl *r, const char *prefix, const char *type, /* - * Read all of a file into memory and return the contents as a newly allocated - * string. Handles a file name of "-" to mean standard input. Dies on any - * failure. - * - * This will need modification later when we want to handle nul characters. + * Read all of a file into memory and return the contents in newly allocated + * memory. Returns the size of the file contents in the second argument if + * it's not NULL. Handles a file name of "-" to mean standard input. Dies on + * any failure. */ -char * -read_file(const char *name) +void * +read_file(const char *name, size_t *length) { char *contents; size_t size, offset; @@ -140,7 +139,7 @@ read_file(const char *name) sysdie("cannot open file %s", name); if (fstat(fd, &st) < 0) sysdie("cannot stat file %s", name); - size = st.st_size + 1; + size = st.st_size; contents = xmalloc(size); } offset = 0; @@ -157,8 +156,7 @@ read_file(const char *name) offset += status; } while (status > 0); close(fd); - contents[offset] = '\0'; - if (memchr(contents, '\0', offset) != NULL) - die("cannot yet handle file data containing nul characters"); + if (length != NULL) + *length = offset; return contents; } diff --git a/client/internal.h b/client/internal.h index 7fe962b..d82196c 100644 --- a/client/internal.h +++ b/client/internal.h @@ -17,6 +17,7 @@ /* Forward declarations to avoid unnecessary includes. */ struct remctl; +struct iovec; BEGIN_DECLS @@ -29,14 +30,18 @@ void kinit(krb5_context, const char *principal); void kdestroy(void); /* - * Given a remctl object, run a remctl command. If data is non-NULL, saves - * the standard output from the command into data with the length in length. - * Otherwise, prints it to standard output. Either way, prints standard error - * output and errors to standard error and returns the exit status or 255 for - * a remctl internal error. + * Given a remctl object, either a NULL-terminated array of strings or an + * array of iovecs and the number of elements in the array, and optional data + * and size output variables, run a remctl command. If data is non-NULL, + * saves the standard output from the command into data with the length in + * length. Otherwise, prints it to standard output. Either way, prints + * standard error output and errors to standard error and returns the exit + * status or 255 for a remctl internal error. */ int run_command(struct remctl *, const char **command, char **data, size_t *length); +int run_commandv(struct remctl *, const struct iovec *command, size_t count, + char **data, size_t *length); /* * Check whether an object exists using the exists wallet interface. Returns @@ -91,12 +96,12 @@ void write_srvtab(krb5_context, const char *srvtab, const char *principal, const char *keytab); /* - * Read all of a file into memory and return the contents as a newly allocated - * string. Handles a file name of "-" to mean standard input. Dies on any - * failure. This will need modification later when we want to handle nul - * characters. + * Read all of a file into memory and return the contents in newly allocated + * memory. Handles a file name of "-" to mean standard input. Stores the + * length of the data in the second argument if it isn't NULL. Dies on any + * failure. */ -char *read_file(const char *); +void *read_file(const char *, size_t *); END_DECLS diff --git a/client/remctl.c b/client/remctl.c index a4ff097..5a541d5 100644 --- a/client/remctl.c +++ b/client/remctl.c @@ -18,15 +18,14 @@ /* - * Given a remctl connection and a command, run the command. - * - * If data is non-NULL, save the output in it and return the length in length. - * Otherwise, send any output to stdout. Either way, send error output to - * stderr, and return the exit status (or 255 if there is an error). + * Retrieve the results of a remctl command, which should be issued prior to + * calling this function. If data is non-NULL, save the output in it and + * return the length in length. Otherwise, send any output to stdout. Either + * way, send error output to stderr, and return the exit status (or 255 if + * there is an error). */ -int -run_command(struct remctl *r, const char **command, char **data, - size_t *length) +static int +command_results(struct remctl *r, char **data, size_t *length) { struct remctl_output *output; int status = 255; @@ -35,10 +34,6 @@ run_command(struct remctl *r, const char **command, char **data, *data = NULL; if (length != NULL) *length = 0; - if (!remctl_command(r, command)) { - warn("%s", remctl_error(r)); - return 255; - } do { output = remctl_output(r); switch (output->type) { @@ -73,6 +68,40 @@ run_command(struct remctl *r, const char **command, char **data, } +/* + * Given a remctl connection and a NULL-terminated array of strings, run the + * command and return the results using command_results, optionally putting + * output into the data variable. + */ +int +run_command(struct remctl *r, const char **command, char **data, + size_t *length) +{ + if (!remctl_command(r, command)) { + warn("%s", remctl_error(r)); + return 255; + } + return command_results(r, data, length); +} + + +/* + * Given a remctl connection, an array of iovecs, and the length of the array, + * run the command and return the results using command_results, optionally + * putting output into the data variable. + */ +int +run_commandv(struct remctl *r, const struct iovec *command, size_t count, + char **data, size_t *length) +{ + if (!remctl_commandv(r, command, count)) { + warn("%s", remctl_error(r)); + return 255; + } + return command_results(r, data, length); +} + + /* * Check whether an object exists using the exists wallet interface. Returns * true if it does, false if it doesn't, and dies on remctl errors. diff --git a/client/wallet.c b/client/wallet.c index ce0f4e7..dc4fe18 100644 --- a/client/wallet.c +++ b/client/wallet.c @@ -135,7 +135,8 @@ main(int argc, char *argv[]) krb5_error_code retval; struct options options; int option, i, status; - const char **command; + struct iovec *command; + size_t count, length; const char *file = NULL; const char *srvtab = NULL; struct remctl *r; @@ -241,24 +242,27 @@ main(int argc, char *argv[]) status = get_file(r, options.type, argv[1], argv[2], file); } } else { + count = argc + 1; if (strcmp(argv[0], "store") == 0) { if (argc > 4) die("too many arguments"); - else if (argc == 4) - command = xmalloc(sizeof(char *) * (argc + 2)); - else - command = xmalloc(sizeof(char *) * (argc + 3)); - } else - command = xmalloc(sizeof(char *) * (argc + 2)); - command[0] = options.type; - for (i = 0; i < argc; i++) - command[i + 1] = argv[i]; + else if (argc < 4) + count++; + } + command = xmalloc(sizeof(struct iovec) * count); + command[0].iov_base = (char *) options.type; + command[0].iov_len = strlen(options.type); + for (i = 0; i < argc; i++) { + command[i + 1].iov_base = argv[i]; + command[i + 1].iov_len = strlen(argv[i]); + } if (strcmp(argv[0], "store") == 0 && argc < 4) { - command[argc + 1] = read_file(file == NULL ? "-" : file); - command[argc + 2] = NULL; - } else - command[argc + 1] = NULL; - status = run_command(r, command, NULL, NULL); + if (file == NULL) + file = "-"; + command[argc + 1].iov_base = read_file(file, &length); + command[argc + 1].iov_len = length; + } + status = run_commandv(r, command, count, NULL, NULL); } remctl_close(r); krb5_free_context(ctx); diff --git a/tests/client/basic-t.in b/tests/client/basic-t.in index 30bc004..1ae3a70 100644 --- a/tests/client/basic-t.in +++ b/tests/client/basic-t.in @@ -50,7 +50,7 @@ if [ $? != 0 ] ; then elif [ -z '@REMCTLD@' ] ; then skip_all 'No remctld found' else - plan 34 + plan 36 fi remctld_start '@REMCTLD@' "$SOURCE/data/basic.conf" wallet="$BUILD/../client/wallet" @@ -141,6 +141,13 @@ ok_program 'store from a file' 0 '' \ "$wallet" -f store-input store file fake-test ok '...and the correct data was stored' cmp store-output store-correct rm -f store-input store-output store-correct +printf 'This is store input\000with a nul character' > store-input +echo 'file fake-nul' > store-correct +cat store-input >> store-correct +ok_program 'store from a file with a nul' 0 '' \ + "$wallet" -f store-input store file fake-nul +ok '...and the correct data was stored' cmp store-output store-correct +rm -f store-input store-output store-correct # Test various other client functions and errors. ok_program 'get output to stdout' 0 'This is a fake keytab.' \ diff --git a/tests/data/basic.conf b/tests/data/basic.conf index 3280ce9..5f3c2a3 100644 --- a/tests/data/basic.conf +++ b/tests/data/basic.conf @@ -1,3 +1,4 @@ # remctl configuration for wallet client tests. +fake-wallet store data/cmd-fake stdin=last ANYUSER fake-wallet ALL data/cmd-fake ANYUSER diff --git a/tests/data/cmd-fake b/tests/data/cmd-fake index 199bd57..add72fc 100755 --- a/tests/data/cmd-fake +++ b/tests/data/cmd-fake @@ -82,10 +82,15 @@ get) ;; store) if [ -n "$3" ] ; then - echo "Too many arguments" >&2 + echo 'Too many arguments' >&2 + exit 1 + fi + if [ -n "$2" ] ; then + echo 'stdin remctld configuration not supported' >&2 exit 1 fi - printf "$type $1\n$2" > store-output + printf "$type $1\n" > store-output + cat >> store-output ;; show) if [ -n "$2" ] ; then -- cgit v1.2.3 From 4f863ccc9531130be3f4aecea341a0e8a66c6f8c Mon Sep 17 00:00:00 2001 From: Russ Allbery 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(-) 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] = ; + } 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 +=item store [] Stores for the object identified by and for later -retrieval with C. Not all object types support this. +retrieval with C. Not all object types support this. If is +not given as an argument, it will be read from standard input. Currently, 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 da4a4051085c857c1ee50080309190ea1113b18e Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Sat, 20 Feb 2010 20:47:58 -0800 Subject: Add a check to the full client test suite for storing a nul --- tests/client/full-t.in | 18 +++++++++++++++++- tests/data/full.conf | 1 + 2 files changed, 18 insertions(+), 1 deletion(-) diff --git a/tests/client/full-t.in b/tests/client/full-t.in index 8acc360..ce2789d 100644 --- a/tests/client/full-t.in +++ b/tests/client/full-t.in @@ -11,7 +11,7 @@ # is loaded, and it's pulled in as a prerequisite for Wallet::Admin. BEGIN { $ENV{WALLET_CONFIG} = "$ENV{SOURCE}/data/wallet.conf" } -BEGIN { our $total = 53 } +BEGIN { our $total = 59 } use Test::More tests => $total; use lib "$ENV{SOURCE}/../perl"; @@ -168,6 +168,22 @@ SKIP: { is ($out, '-q', ' with the right output'); is ($err, '', ' and no error'); + # Store data containing nul characters. + my $data = "Some data\000with a nul"; + open (IN, '>', 'tmp-file') or BAIL_OUT ("cannot create tmp-file: $!"); + print IN $data; + close IN; + ($out, $err, $status) = wallet ($principal, '-f', 'tmp-file', 'store', + 'file', 'auto'); + unlink ('tmp-file'); + is ($status, 0, 'Storing data with a nul succeeds'); + is ($out, '', ' with no output'); + is ($err, '', ' and no error'); + ($out, $err, $status) = wallet ($principal, 'get', 'file', 'auto'); + is ($status, 0, 'Object get succeeds'); + is ($out, $data, ' with the right output'); + is ($err, '', ' and no error'); + # All done. remctld_stop; $admin->destroy; diff --git a/tests/data/full.conf b/tests/data/full.conf index 4c0f435..941a9ac 100644 --- a/tests/data/full.conf +++ b/tests/data/full.conf @@ -1,3 +1,4 @@ # remctl configuration for full wallet client tests. +wallet store data/cmd-wrapper stdin=4 ANYUSER wallet ALL data/cmd-wrapper ANYUSER -- cgit v1.2.3 From 78d83f1d2757fbbc36bbb1e5463cb7c263053a22 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Sat, 20 Feb 2010 20:50:57 -0800 Subject: Remove references to AFS kaserver support in README --- README | 17 ++++------------- 1 file changed, 4 insertions(+), 13 deletions(-) diff --git a/README b/README index abc02fb..d3ef5fb 100644 --- a/README +++ b/README @@ -54,13 +54,6 @@ DESCRIPTION interface to retrieve the current key if the unchanging flag is set on a Kerberos keytab object. - The Kerberos keytab object implementation also optionally supports - synchronization of keys with an AFS kaserver to aid in migration from - Kerberos v4 to Kerberos v5. Included in the wallet distribution is the - kasetkey client, which can create, change the keys of, and delete - principals from an AFS kaserver, authenticating from a srvtab. It is a - partial replacement for kas or a Kerberos v4 kadmin. - REQUIREMENTS The wallet client is written in C and builds against the C remctl @@ -123,9 +116,8 @@ REQUIREMENTS user's path or in /usr/local/sbin or /usr/sbin, that test cases can run services on and connect to ports 14373 and 14444 on 127.0.0.1, and that kinit and kvno (which come with Kerberos) be installed and available on - the user's path. The full test suite also requires a local keytab, a - srvtab with ADMIN access to a test AFS kaserver, and some additional - configuration. + the user's path. The full test suite also requires a local keytab and + some additional configuration. To bootstrap from a Git checkout, or if you change the Automake files and need to regenerate Makefile.in, you will need Automake 1.11 or @@ -257,9 +249,8 @@ CONFIGURATION docuemntation (with man Wallet::Config or perldoc Wallet::Config). There are many customization options, some of which must be set. You may also need to create a Kerberos keytab for the keytab object backend - and give it appropriate ACLs, set up keytab-backend and its remctld - configuration on your KDC if you want unchanging flag support, and set - up a srvtab if you want AFS kaserver synchronization support. + and give it appropriate ACLs, and set up keytab-backend and its remctld + configuration on your KDC if you want unchanging flag support. The wallet client supports reading configuration settings from the system krb5.conf file. For more information, see the CONFIGURATION -- cgit v1.2.3 From 3b3e387b6bca35a00a86ad41e39874eeadcb78b9 Mon Sep 17 00:00:00 2001 From: Russ Allbery 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(-) 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.new> is still used as a temporary file and any existing file with that name will be deleted. -C does not yet support nul bytes in I (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 The service principal of the wallet server. The default is to use the @@ -349,11 +344,6 @@ retrieval with C. Not all object types support this. If 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 and name does not already exist when this command is issued (as checked with the check interface), B 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 -server usually used to run B, 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 server usually used to run +B, 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 for the object identified by and for later retrieval with C. Not all object types support this. If is not given as an argument, it will be read from standard input. -Currently, 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 cf79136dd24f39925ddfe5ff4e9388309089bb04 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Sat, 20 Feb 2010 22:51:38 -0800 Subject: Release 0.10 --- NEWS | 2 +- README | 2 +- configure.ac | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/NEWS b/NEWS index b4c31d4..4c8bda6 100644 --- a/NEWS +++ b/NEWS @@ -1,6 +1,6 @@ User-Visible wallet Changes -wallet 0.10 (unreleased) +wallet 0.10 (2010-02-21) Add support for Heimdal KDCs as well as MIT Kerberos KDCs. There is now a mandatory new setting in Wallet::Config: $KEYTAB_KRBTYPE. It diff --git a/README b/README index d3ef5fb..86b0ac4 100644 --- a/README +++ b/README @@ -1,4 +1,4 @@ - wallet release 0.9 + wallet release 0.10 (secure data management system) Written by Russ Allbery diff --git a/configure.ac b/configure.ac index 78201c1..5c3da92 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.9], [rra@stanford.edu]) +AC_INIT([wallet], [0.10], [rra@stanford.edu]) AC_CONFIG_AUX_DIR([build-aux]) AC_CONFIG_LIBOBJ_DIR([portable]) AC_CONFIG_MACRO_DIR([m4]) -- cgit v1.2.3 From 02eedafcb393ef771ab6231d6583c58d12b97837 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Sat, 20 Feb 2010 22:57:40 -0800 Subject: Add portable/uio.h and include it in client/wallet.c Now that the wallet client uses struct iovec, it needs to include the relevant header file. Import the portability layer for possible future Windows support. --- LICENSE | 5 +++-- Makefile.am | 2 +- client/wallet.c | 1 + configure.ac | 2 +- portable/uio.h | 27 +++++++++++++++++++++++++++ 5 files changed, 33 insertions(+), 4 deletions(-) create mode 100644 portable/uio.h diff --git a/LICENSE b/LICENSE index 8eca7ad..bd01ed1 100644 --- a/LICENSE +++ b/LICENSE @@ -74,8 +74,9 @@ license: OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. The files portable/asprintf.c, portable/dummy.c, portable/macros.h, -portable/stdbool.h, portable/strlcat.c, portable/strlcpy.c, and -util/concat.c have been placed in the public domain by their author. +portable/stdbool.h, portable/strlcat.c, portable/strlcpy.c, +portable/uio.h, and util/concat.c have been placed in the public domain by +their author. The file portable/snprintf.c is released under the following license: diff --git a/Makefile.am b/Makefile.am index 05ffe53..162a0f1 100644 --- a/Makefile.am +++ b/Makefile.am @@ -44,7 +44,7 @@ EXTRA_DIST = LICENSE autogen client/wallet.pod config/allow-extract \ noinst_LIBRARIES = portable/libportable.a util/libutil.a portable_libportable_a_SOURCES = portable/dummy.c portable/krb5-extra.c \ portable/krb5.h portable/macros.h portable/stdbool.h \ - portable/system.h + portable/system.h portable/uio.h portable_libportable_a_CPPFLAGS = $(KRB5_CPPFLAGS) portable_libportable_a_LIBADD = $(LIBOBJS) util_libutil_a_SOURCES = util/concat.c util/concat.h util/macros.h \ diff --git a/client/wallet.c b/client/wallet.c index dc4fe18..e6d8eb9 100644 --- a/client/wallet.c +++ b/client/wallet.c @@ -11,6 +11,7 @@ #include #include #include +#include #include #include diff --git a/configure.ac b/configure.ac index 5c3da92..c4dc7eb 100644 --- a/configure.ac +++ b/configure.ac @@ -33,7 +33,7 @@ AC_CHECK_MEMBERS([krb5_keytab_entry.keyblock], , , [#include ]) RRA_LIB_KRB5_RESTORE AC_HEADER_STDBOOL -AC_CHECK_HEADERS([sys/bitypes.h syslog.h]) +AC_CHECK_HEADERS([sys/bitypes.h sys/uio.h syslog.h]) AC_CHECK_DECLS([snprintf, vsnprintf]) RRA_C_C99_VAMACROS RRA_C_GNU_VAMACROS diff --git a/portable/uio.h b/portable/uio.h new file mode 100644 index 0000000..3c9e840 --- /dev/null +++ b/portable/uio.h @@ -0,0 +1,27 @@ +/* + * Portability wrapper around . + * + * Provides a definition of the iovec struct for platforms that don't have it + * (primarily Windows). Currently, the corresponding readv and writev + * functions are not provided or prototyped here. + * + * Written by Russ Allbery + * This work is hereby placed in the public domain by its author. + */ + +#ifndef PORTABLE_UIO_H +#define PORTABLE_UIO_H 1 + +#include + +/* remctl.h provides its own definition of this struct on Windows. */ +#if defined(HAVE_SYS_UIO_H) +# include +#elif !defined(REMCTL_H) +struct iovec { + void *iov_base; + size_t iov_len; +}; +#endif + +#endif /* !PORTABLE_UIO_H */ -- cgit v1.2.3 From aec6da7cd9509a34e8898c6b21da66937e332af3 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Sat, 20 Feb 2010 23:00:52 -0800 Subject: Include the TAP shell library in EXTRA_DIST --- Makefile.am | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Makefile.am b/Makefile.am index 162a0f1..495215c 100644 --- a/Makefile.am +++ b/Makefile.am @@ -39,7 +39,7 @@ EXTRA_DIST = LICENSE autogen client/wallet.pod config/allow-extract \ tests/data/fake-srvtab tests/data/wallet.conf \ tests/docs/pod-spelling-t tests/docs/pod-t tests/server/admin-t \ tests/server/backend-t tests/server/keytab-t tests/server/report-t \ - $(PERL_FILES) + tests/tap/libtap.sh tests/tap/remctl.sh $(PERL_FILES) noinst_LIBRARIES = portable/libportable.a util/libutil.a portable_libportable_a_SOURCES = portable/dummy.c portable/krb5-extra.c \ -- cgit v1.2.3 From 1c0d4ec8d265999891090dff25c707b1d86e988c Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Sat, 20 Feb 2010 23:01:18 -0800 Subject: Include and install wallet-report and its man page --- Makefile.am | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Makefile.am b/Makefile.am index 495215c..c2eb470 100644 --- a/Makefile.am +++ b/Makefile.am @@ -54,7 +54,7 @@ util_libutil_a_CPPFLAGS = $(KRB5_CPPFLAGS) bin_PROGRAMS = client/wallet dist_sbin_SCRIPTS = server/keytab-backend server/wallet-admin \ - server/wallet-backend + server/wallet-backend server/wallet-report client_wallet_SOURCES = client/file.c client/internal.h client/keytab.c \ client/krb5.c client/remctl.c client/srvtab.c client/wallet.c client_wallet_CPPFLAGS = $(REMCTL_CPPFLAGS) $(KRB5_CPPFLAGS) @@ -63,7 +63,7 @@ client_wallet_LDADD = util/libutil.a portable/libportable.a $(REMCTL_LIBS) \ $(KRB5_LIBS) dist_man_MANS = client/wallet.1 server/keytab-backend.8 \ - server/wallet-admin.8 server/wallet-backend.8 + server/wallet-admin.8 server/wallet-backend.8 server/wallet-report.8 # A set of flags for warnings. Add -O because gcc won't find some warnings # without optimization turned on, and add -DDEBUG=1 so we'll also compile all -- cgit v1.2.3 From 3d55468b4660646f047328030cbd425dc99ce3b3 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Sat, 20 Feb 2010 23:03:03 -0800 Subject: Include more missing test suite files in the distribution --- Makefile.am | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/Makefile.am b/Makefile.am index c2eb470..688fead 100644 --- a/Makefile.am +++ b/Makefile.am @@ -39,7 +39,8 @@ EXTRA_DIST = LICENSE autogen client/wallet.pod config/allow-extract \ tests/data/fake-srvtab tests/data/wallet.conf \ tests/docs/pod-spelling-t tests/docs/pod-t tests/server/admin-t \ tests/server/backend-t tests/server/keytab-t tests/server/report-t \ - tests/tap/libtap.sh tests/tap/remctl.sh $(PERL_FILES) + tests/tap/kerberos.sh tests/tap/libtap.sh tests/tap/remctl.sh \ + tests/util/xmalloc-t $(PERL_FILES) noinst_LIBRARIES = portable/libportable.a util/libutil.a portable_libportable_a_SOURCES = portable/dummy.c portable/krb5-extra.c \ -- cgit v1.2.3 From c4234b72a39b25122dbba769e028d1d105a4132e Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Sat, 20 Feb 2010 23:19:50 -0800 Subject: Fix some test numbers in the Perl tests --- perl/t/kadmin.t | 2 +- perl/t/keytab.t | 9 ++++----- 2 files changed, 5 insertions(+), 6 deletions(-) diff --git a/perl/t/kadmin.t b/perl/t/kadmin.t index b9ac769..bbcb15a 100755 --- a/perl/t/kadmin.t +++ b/perl/t/kadmin.t @@ -72,7 +72,7 @@ SKIP: { # implementation is configured. This retests some things that are also tested # by the keytab test, but specifically through the Wallet::Kadmin API. SKIP: { - skip 'no keytab configuration', 15 unless -f 't/data/test.keytab'; + skip 'no keytab configuration', 14 unless -f 't/data/test.keytab'; # Set up our configuration. $Wallet::Config::KEYTAB_FILE = 't/data/test.keytab'; diff --git a/perl/t/keytab.t b/perl/t/keytab.t index 4e253eb..046da9c 100755 --- a/perl/t/keytab.t +++ b/perl/t/keytab.t @@ -148,7 +148,7 @@ my $date = strftime ('%Y-%m-%d %H:%M:%S', localtime $trace[2]); # Basic keytab creation and manipulation tests. SKIP: { - skip 'no keytab configuration', 49 unless -f 't/data/test.keytab'; + skip 'no keytab configuration', 52 unless -f 't/data/test.keytab'; # Set up our configuration. $Wallet::Config::KEYTAB_FILE = 't/data/test.keytab'; @@ -495,7 +495,7 @@ EOO # since no synchronization targets are supported, but we want to still test # the basic stub code. SKIP: { - skip 'no keytab configuration', 106 unless -f 't/data/test.keytab'; + skip 'no keytab configuration', 18 unless -f 't/data/test.keytab'; # Test setting synchronization attributes, which can also be done without # configuration. @@ -563,9 +563,7 @@ EOO # Tests for enctype restriction. SKIP: { - unless (-f 't/data/test.keytab') { - skip 'no keytab configuration', 36; - } + skip 'no keytab configuration', 36 unless -f 't/data/test.keytab'; # Set up our configuration. $Wallet::Config::KEYTAB_FILE = 't/data/test.keytab'; @@ -648,6 +646,7 @@ EOO # Now, try testing limiting the enctypes to just one. SKIP: { skip 'insufficient recognized enctypes', 14 unless @enctypes > 1; + is ($one->attr ('enctypes', [ $enctypes[0] ], @trace), 1, 'Setting a single enctype works'); for my $enctype (@enctypes) { -- cgit v1.2.3 From 1ef59d80f77b4b6df81b77b3beee29824377d1a5 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Sat, 20 Feb 2010 23:22:47 -0800 Subject: Add missing files to the distribution --- Makefile.am | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/Makefile.am b/Makefile.am index 688fead..ee1277a 100644 --- a/Makefile.am +++ b/Makefile.am @@ -20,8 +20,9 @@ PERL_FILES = perl/Wallet/ACL.pm perl/Wallet/ACL/Base.pm \ perl/Wallet/Schema.pm perl/Wallet/Server.pm perl/t/acl.t \ perl/t/admin.t perl/t/config.t perl/t/data/README \ perl/t/data/keytab-fake perl/t/data/keytab.conf \ - perl/t/data/netdb.conf perl/t/data/netdb-fake perl/t/init.t \ - perl/t/keytab.t perl/t/lib/Util.pm perl/t/object.t perl/t/pod.t \ + perl/t/data/netdb.conf perl/t/data/netdb-fake perl/t/file.t \ + perl/t/init.t perl/t/kadmin.t perl/t/keytab.t perl/t/lib/Util.pm \ + perl/t/object.t perl/t/pod-spelling.t perl/t/pod.t perl/t/report.t \ perl/t/schema.t perl/t/server.t perl/t/verifier-netdb.t \ perl/t/verifier.t @@ -29,14 +30,16 @@ AUTOMAKE_OPTIONS = foreign subdir-objects ACLOCAL_AMFLAGS = -I m4 EXTRA_DIST = LICENSE autogen client/wallet.pod config/allow-extract \ config/keytab config/keytab.acl config/wallet docs/design \ - contrib/README contrib/wallet-summary contrib/wallet-summary.8 \ - docs/design-acl docs/design-api docs/netdb-role-api docs/notes \ - docs/setup examples/stanford.conf tests/TESTS tests/data/README \ + contrib/README contrib/convert-srvtab-db contrib/used-principals \ + contrib/wallet-contacts contrib/wallet-summary \ + contrib/wallet-summary.8 docs/design-acl docs/design-api \ + docs/netdb-role-api docs/notes docs/setup docs/stanford-naming \ + examples/stanford.conf tests/TESTS tests/data/README \ tests/data/allow-extract tests/data/basic.conf tests/data/cmd-fake \ tests/data/cmd-wrapper tests/data/fake-data tests/data/fake-kadmin \ tests/data/fake-keytab tests/data/fake-keytab-2 \ tests/data/fake-keytab-merge tests/data/fake-keytab-old \ - tests/data/fake-srvtab tests/data/wallet.conf \ + tests/data/fake-srvtab tests/data/full.conf tests/data/wallet.conf \ tests/docs/pod-spelling-t tests/docs/pod-t tests/server/admin-t \ tests/server/backend-t tests/server/keytab-t tests/server/report-t \ tests/tap/kerberos.sh tests/tap/libtap.sh tests/tap/remctl.sh \ -- cgit v1.2.3 From 5d73d640535587286a344fe7e5980f443f40839c Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Sat, 20 Feb 2010 23:24:18 -0800 Subject: Add .gitignore to the distribution --- Makefile.am | 25 +++++++++++++------------ 1 file changed, 13 insertions(+), 12 deletions(-) diff --git a/Makefile.am b/Makefile.am index ee1277a..d5dccd9 100644 --- a/Makefile.am +++ b/Makefile.am @@ -28,18 +28,19 @@ PERL_FILES = perl/Wallet/ACL.pm perl/Wallet/ACL/Base.pm \ AUTOMAKE_OPTIONS = foreign subdir-objects ACLOCAL_AMFLAGS = -I m4 -EXTRA_DIST = LICENSE autogen client/wallet.pod config/allow-extract \ - config/keytab config/keytab.acl config/wallet docs/design \ - contrib/README contrib/convert-srvtab-db contrib/used-principals \ - contrib/wallet-contacts contrib/wallet-summary \ - contrib/wallet-summary.8 docs/design-acl docs/design-api \ - docs/netdb-role-api docs/notes docs/setup docs/stanford-naming \ - examples/stanford.conf tests/TESTS tests/data/README \ - tests/data/allow-extract tests/data/basic.conf tests/data/cmd-fake \ - tests/data/cmd-wrapper tests/data/fake-data tests/data/fake-kadmin \ - tests/data/fake-keytab tests/data/fake-keytab-2 \ - tests/data/fake-keytab-merge tests/data/fake-keytab-old \ - tests/data/fake-srvtab tests/data/full.conf tests/data/wallet.conf \ +EXTRA_DIST = .gitignore LICENSE autogen client/wallet.pod \ + config/allow-extract config/keytab config/keytab.acl config/wallet \ + docs/design contrib/README contrib/convert-srvtab-db \ + contrib/used-principals contrib/wallet-contacts \ + contrib/wallet-summary contrib/wallet-summary.8 docs/design-acl \ + docs/design-api docs/netdb-role-api docs/notes docs/setup \ + docs/stanford-naming examples/stanford.conf tests/TESTS \ + tests/data/README tests/data/allow-extract tests/data/basic.conf \ + tests/data/cmd-fake tests/data/cmd-wrapper tests/data/fake-data \ + tests/data/fake-kadmin tests/data/fake-keytab \ + tests/data/fake-keytab-2 tests/data/fake-keytab-merge \ + tests/data/fake-keytab-old tests/data/fake-srvtab \ + tests/data/full.conf tests/data/wallet.conf \ tests/docs/pod-spelling-t tests/docs/pod-t tests/server/admin-t \ tests/server/backend-t tests/server/keytab-t tests/server/report-t \ tests/tap/kerberos.sh tests/tap/libtap.sh tests/tap/remctl.sh \ -- cgit v1.2.3 From 0d57013b4ef790e0b428eb41645199434cce2ecd Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Sun, 21 Feb 2010 20:20:14 -0800 Subject: Further README updates for Heimdal support --- README | 40 +++++++++++++++++++++------------------- 1 file changed, 21 insertions(+), 19 deletions(-) diff --git a/README b/README index 86b0ac4..cb8942c 100644 --- a/README +++ b/README @@ -45,14 +45,16 @@ DESCRIPTION infrastructure. Currently, the only ACL type supported matches a single Kerberos principal name, but this will be extended in future releases. - Currently, the only object type supported is a Kerberos keytab. By - default, whenever a Kerberos keytab object is retrieved from the wallet, - the key is changed in the Kerberos KDC and the wallet returns a keytab - for the new key. However, also included in the wallet distribution is a - script that can be run via remctl on the Kerberos KDC to extract the - existing key for a principal, and the wallet system will use that - interface to retrieve the current key if the unchanging flag is set on a - Kerberos keytab object. + Currently, the object types supported are simple files and Kerberos + keytabs. By default, whenever a Kerberos keytab object is retrieved + from the wallet, the key is changed in the Kerberos KDC and the wallet + returns a keytab for the new key. However, a keytab object can also be + configured to preserve the existing keys when retrieved. Included in + the wallet distribution is a script that can be run via remctl on an MIT + Kerberos KDC to extract the existing key for a principal, and the wallet + system will use that interface to retrieve the current key if the + unchanging flag is set on a Kerberos keytab object for MIT Kerberos. + (Heimdal doesn't require any special support.) REQUIREMENTS @@ -90,15 +92,15 @@ REQUIREMENTS to create, modify, and delete principals from the KDC (as configured in kadm5.acl on an MIT Kerberos KDC). - To support the unchanging flag on keytab objects, the Net::Remctl Perl - module (shipped with remctl) must be installed on the server and the - keytab-backend script must be runnable via remctl on the KDC. This - script also requires an MIT Kerberos kadmin.local binary that supports - the -norandkey option to ktadd. This option will be included in MIT - Kerberos 1.7 and later. + To support the unchanging flag on keytab objects with an MIT Kerberos + KDC, the Net::Remctl Perl module (shipped with remctl) must be installed + on the server and the keytab-backend script must be runnable via remctl + on the KDC. This script also requires an MIT Kerberos kadmin.local + binary that supports the -norandkey option to ktadd. This option is + included in MIT Kerberos 1.7 and later. To support the NetDB ACL verifier (only of interest at sites using NetDB - to manage DNS), the Net::Remctl Perl module must be installed on the + to manage DNS), the Net::Remctl Perl module must be installed on the server. To run the test suite, you must have Perl 5.8 or later and the Perl DBI @@ -114,10 +116,10 @@ REQUIREMENTS checked. The full test suite also requires the Test::Pod Perl module (available from CPAN), that remctld be installed and available on the user's path or in /usr/local/sbin or /usr/sbin, that test cases can run - services on and connect to ports 14373 and 14444 on 127.0.0.1, and that - kinit and kvno (which come with Kerberos) be installed and available on - the user's path. The full test suite also requires a local keytab and - some additional configuration. + services on and connect to port 14373 on 127.0.0.1, and that kinit and + either kvno or kgetcred (which come with Kerberos) be installed and + available on the user's path. The full test suite also requires a local + keytab and some additional configuration. To bootstrap from a Git checkout, or if you change the Automake files and need to regenerate Makefile.in, you will need Automake 1.11 or -- cgit v1.2.3 From 4e67a916db978cb515fa174921d78b22d533fab3 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Sun, 21 Feb 2010 20:25:31 -0800 Subject: Clean up krb5.conf in the client/basic test if skipping The test created krb5.conf first thing, but didn't delete it if skipping all of the tests. --- tests/client/basic-t.in | 2 ++ 1 file changed, 2 insertions(+) diff --git a/tests/client/basic-t.in b/tests/client/basic-t.in index 1ae3a70..86e24d5 100644 --- a/tests/client/basic-t.in +++ b/tests/client/basic-t.in @@ -46,8 +46,10 @@ fi # Test setup. kerberos_setup if [ $? != 0 ] ; then + rm krb5.conf skip_all 'Kerberos tests not configured' elif [ -z '@REMCTLD@' ] ; then + rm krb5.conf skip_all 'No remctld found' else plan 36 -- cgit v1.2.3 From 1399be79125d3efef9c46e4a4d4ed4e5c246ab1a Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Sun, 21 Feb 2010 20:30:21 -0800 Subject: Update copyright dates in LICENSE --- LICENSE | 42 ++++++++++++++++++++++-------------------- 1 file changed, 22 insertions(+), 20 deletions(-) diff --git a/LICENSE b/LICENSE index bd01ed1..de9ab39 100644 --- a/LICENSE +++ b/LICENSE @@ -1,7 +1,7 @@ The wallet package as a whole is: - Copyright 2006, 2007, 2008 Board of Trustees, Leland Stanford Jr. - University. All rights reserved. + Copyright 2006, 2007, 2008, 2009, 2010 Board of Trustees, Leland + Stanford Jr. University. All rights reserved. and released under the following license: @@ -28,10 +28,10 @@ files. Collected copyright notices for the entire package: Copyright 1994, 1998, 1999, 2000, 2002, 2003, 2004, 2005, 2006, 2007, - 2008 Board of Trustees, Leland Stanford Jr. University - Copyright 2000, 2001, 2004, 2006, 2007, 2008 + 2008, 2009, 2010 Board of Trustees, Leland Stanford Jr. University + Copyright 2000, 2001, 2004, 2006, 2007, 2008, 2009 Russ Allbery - Copyright 2004, 2005, 2006, 2007 + Copyright 2004, 2005, 2006, 2007, 2008, 2009 by Internet Systems Consortium, Inc. ("ISC") Copyright 1991, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 by The Internet Software Consortium and Rich Salz @@ -42,18 +42,25 @@ Collected copyright notices for the entire package: Copyright 1998 Andrew Tridgell Copyright 2000, 2005 Hrvoje Niksic Copyright 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, - 2002, 2003, 2004, 2005, 2006, 2007, 2008 + 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. Copyright 1994 X Consortium +The files portable/asprintf.c, portable/dummy.c, portable/macros.h, +portable/stdbool.h, portable/strlcat.c, portable/strlcpy.c, +portable/uio.h, and util/concat.c have been placed in the public domain by +their author. + The files tests/libtest.c, tests/libtest.h, tests/portable/snprintf-t.c, tests/portable/strlcat-t.c, tests/portable/strlcpy-t.c, tests/util/concat-t.c, tests/util/messages-t.c, tests/util/xmalloc-t, and tests/util/xmalloc.c are released under the following copyright and license: - Copyright 2008 Board of Trustees, Leland Stanford Jr. University - Copyright (c) 2004, 2005, 2006, 2007 + Copyright 2009 Russ Allbery + Copyright 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 + Board of Trustees, Leland Stanford Jr. University + Copyright (c) 2004, 2005, 2006, 2007, 2008, 2009 by Internet Systems Consortium, Inc. ("ISC") Copyright (c) 1991, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 by The Internet Software Consortium and Rich Salz @@ -73,11 +80,6 @@ license: ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -The files portable/asprintf.c, portable/dummy.c, portable/macros.h, -portable/stdbool.h, portable/strlcat.c, portable/strlcpy.c, -portable/uio.h, and util/concat.c have been placed in the public domain by -their author. - The file portable/snprintf.c is released under the following license: This code is based on code written by Patrick Powell (papowell@astart.com) @@ -87,7 +89,7 @@ The file portable/snprintf.c is released under the following license: The file tests/runtests.c is released under the following copyright and license: - Copyright 2000, 2001, 2004, 2006, 2007, 2008 + Copyright 2000, 2001, 2004, 2006, 2007, 2008, 2009 Russ Allbery Permission is hereby granted, free of charge, to any person obtaining a @@ -113,7 +115,7 @@ The files Makefile.in and aclocal.m4 are generated by GNU Automake and released under the following copyright and license: Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, - 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. + 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. This file is free software; the Free Software Foundation gives unlimited permission to copy and/or distribute it, with or without modifications, as long as this notice is preserved. @@ -127,16 +129,16 @@ The file configure is generated by GNU Autoconf and is released under the following copyright and license: Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, - 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. - This configure script is free software; the Free Software Foundation - gives unlimited permission to copy, distribute and modify it. + 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, + Inc. This configure script is free software; the Free Software + Foundation gives unlimited permission to copy, distribute and modify it. The files build-aux/compile, build-aux/depcomp, and build-aux/missing are taken from GNU Automake and are released under the following copyright and license: - Copyright (C) 1996, 1997, 1999, 2000, 2002, 2003, 2004, 2005, 2006 - Free Software Foundation, Inc. + Copyright (C) 1996, 1997, 1999, 2000, 2002, 2003, 2004, 2005, 2006, + 2007, 2008, 2009 Free Software Foundation, Inc. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the -- cgit v1.2.3 From d04d26c6e447727cd43bd2182182117ec7302dc7 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Sun, 21 Feb 2010 20:58:27 -0800 Subject: Fix test suite skip numbering in the kadmin test --- perl/t/kadmin.t | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/perl/t/kadmin.t b/perl/t/kadmin.t index bbcb15a..6365ce5 100755 --- a/perl/t/kadmin.t +++ b/perl/t/kadmin.t @@ -56,7 +56,7 @@ for my $good (qw{service service/foo bar foo/bar host/example.org # configuration to get the error. That tests that we can find the Heimdal # module and it dies how it should. SKIP: { - skip 'Heimdal::Kadm5 not installed', 3 unless $heimdal_kadm5; + skip 'Heimdal::Kadm5 not installed', 2 unless $heimdal_kadm5; undef $Wallet::Config::KEYTAB_PRINCIPAL; undef $Wallet::Config::KEYTAB_FILE; undef $Wallet::Config::KEYTAB_REALM; -- cgit v1.2.3 From 95df9ad587cb65fb3eb477f4fc981120409ef30d Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Sun, 21 Feb 2010 22:00:07 -0800 Subject: Correct README statement about no Heimdal support for client --- README | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/README b/README index cb8942c..3c8ddbc 100644 --- a/README +++ b/README @@ -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 -- cgit v1.2.3 From 2b8931dedf7daebffbfc0732365bad73014eb4db Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Wed, 3 Mar 2010 19:40:34 -0800 Subject: Fix krb5_free_error_message portability Fix portability to older Kerberos libraries without krb5_free_error_message. --- NEWS | 5 +++++ portable/krb5-extra.c | 2 +- 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/NEWS b/NEWS index 4c8bda6..9800390 100644 --- a/NEWS +++ b/NEWS @@ -1,5 +1,10 @@ User-Visible wallet Changes +wallet 0.11 (unreleased) + + 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/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) -- cgit v1.2.3 From 69289862465a3bfb3488c1b3a674b6b06c9911ee Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Wed, 3 Mar 2010 19:49:46 -0800 Subject: Remove file names from test file headers Coding style update. Don't prefix the file short description with the file name; it's not needed. --- perl/t/acl.t | 2 +- perl/t/admin.t | 2 +- perl/t/config.t | 2 +- perl/t/data/keytab-fake | 2 +- perl/t/data/netdb-fake | 2 +- perl/t/file.t | 2 +- perl/t/init.t | 2 +- perl/t/kadmin.t | 2 +- perl/t/keytab.t | 2 +- perl/t/lib/Util.pm | 4 ++-- perl/t/object.t | 2 +- perl/t/pod-spelling.t | 3 +-- perl/t/report.t | 2 +- perl/t/schema.t | 2 +- perl/t/server.t | 2 +- perl/t/verifier-netdb.t | 10 +++++----- perl/t/verifier.t | 6 +++--- tests/data/fake-kadmin | 3 ++- tests/data/wallet.conf | 2 +- 19 files changed, 27 insertions(+), 27 deletions(-) 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 # 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 # 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 # 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 # 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 # Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University diff --git a/perl/t/kadmin.t b/perl/t/kadmin.t index 6365ce5..0b52528 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 # Copyright 2009, 2010 Board of Trustees, Leland Stanford Jr. University 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 # 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 # 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 # 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 # -# 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..a37681a 100755 --- a/perl/t/report.t +++ b/perl/t/report.t @@ -1,6 +1,6 @@ #!/usr/bin/perl -w # -# t/report.t -- Tests for the wallet reporting interface. +# Tests for the wallet reporting interface. # # Written by Russ Allbery # Copyright 2008, 2009, 2010 Board of Trustees, Leland Stanford Jr. University 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 # Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University diff --git a/perl/t/server.t b/perl/t/server.t index 090387b..7b30053 100755 --- a/perl/t/server.t +++ b/perl/t/server.t @@ -1,6 +1,6 @@ #!/usr/bin/perl -w # -# t/server.t -- Tests for the wallet server API. +# Tests for the wallet server API. # # Written by Russ Allbery # Copyright 2007, 2008 Board of Trustees, Leland Stanford Jr. University 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 # 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 # 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/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 # 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'; -- cgit v1.2.3 From 6c1f7d325239f305b9bf6a4503165cefae1ee3d8 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Wed, 3 Mar 2010 21:06:41 -0800 Subject: Verify that an ACL to be deleted is not referenced 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. --- NEWS | 6 ++++++ perl/Wallet/ACL.pm | 32 +++++++++++++++++++++++--------- perl/t/server.t | 17 ++++++++++++++++- 3 files changed, 45 insertions(+), 10 deletions(-) diff --git a/NEWS b/NEWS index 9800390..e66d1b3 100644 --- a/NEWS +++ b/NEWS @@ -2,6 +2,12 @@ wallet 0.11 (unreleased) + 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. + Fix portability to older Kerberos libraries without krb5_free_error_message. 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/t/server.t b/perl/t/server.t index 7b30053..2a178e8 100755 --- a/perl/t/server.t +++ b/perl/t/server.t @@ -7,7 +7,7 @@ # # See LICENSE for licensing terms. -use Test::More tests => 341; +use Test::More tests => 349; use POSIX qw(strftime); use Wallet::Admin; @@ -923,6 +923,21 @@ 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'); + # Clean up. $setup->destroy; unlink 'wallet-db'; -- cgit v1.2.3 From a131c767d1eee7b98170962f7f9d4063be69e576 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Wed, 3 Mar 2010 22:37:18 -0800 Subject: Add auditing for names that violate the naming policy Add an audit command to wallet-report and one audit: objects name, which returns all objects that do not pass the local naming policy. The corresponding Wallet::Report method is audit(). 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. --- NEWS | 10 ++++++++++ perl/Wallet/Config.pm | 11 ++++++++++- perl/Wallet/Report.pm | 54 ++++++++++++++++++++++++++++++++++++++++++++++++++- perl/t/report.t | 25 +++++++++++++++++++++++- server/wallet-report | 19 ++++++++++++++++++ tests/server/report-t | 32 +++++++++++++++++++++++------- 6 files changed, 141 insertions(+), 10 deletions(-) diff --git a/NEWS b/NEWS index e66d1b3..03fe99b 100644 --- a/NEWS +++ b/NEWS @@ -8,6 +8,16 @@ wallet 0.11 (unreleased) integrity. This also allows us to return a better error message naming an object that's still using that ACL. + Add an audit command to wallet-report and one audit: objects name, + which returns all objects that do not pass the local naming policy. + The corresponding Wallet::Report method is audit(). + + 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. diff --git a/perl/Wallet/Config.pm b/perl/Wallet/Config.pm index 396bf7d..2991361 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'; @@ -519,6 +519,15 @@ 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. diff --git a/perl/Wallet/Report.pm b/perl/Wallet/Report.pm index 7cd8653..ff4fa8b 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 @@ -290,6 +290,43 @@ 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. 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; + } + } else { + $self->error ("unknown audit type: $type"); + return; + } +} + 1; __DATA__ @@ -312,6 +349,7 @@ ACL ACLs wildcard Allbery SQL tuples for my $object (@objects) { print "@$object\n"; } + @objects = $report->audit ('objects', 'name'); =head1 DESCRIPTION @@ -366,6 +404,20 @@ 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. Currently, the only implemented type is C and the only +audit is C. This returns a list of all objects, as references to +pairs of type and name, that are not accepted by the verify_name() +function defined in the wallet configuration. See L 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/t/report.t b/perl/t/report.t index a37681a..3b94d00 100755 --- a/perl/t/report.t +++ b/perl/t/report.t @@ -7,7 +7,7 @@ # # See LICENSE for licensing terms. -use Test::More tests => 83; +use Test::More tests => 88; use Wallet::Admin; use Wallet::Report; @@ -166,6 +166,29 @@ 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'); +# 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'); + # Clean up. $admin->destroy; unlink 'wallet-db'; diff --git a/server/wallet-report b/server/wallet-report index a6b3b8d..caa7e2c 100755 --- a/server/wallet-report +++ b/server/wallet-report @@ -35,6 +35,16 @@ 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 @objects = $report->audit (@args); + if (!@objects and $report->error) { + die $report->error, "\n"; + } + for my $object (@objects) { + print join (' ', @$object), "\n"; + } } elsif ($command eq 'objects') { die "too many arguments to objects\n" if @args > 2; my @objects = $report->objects (@args); @@ -129,6 +139,15 @@ any identifier containing that string. =back +=item audit objects name + +Returns all objects that violate the current site naming policy. Objects +will be listed in the form: + + + +There will be one line per object. + =item objects =item objects acl diff --git a/tests/server/report-t b/tests/server/report-t index 285ee5a..61cfd9b 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 => 42; # Create a dummy class for Wallet::Report that prints what method was called # with its arguments and returns data for testing. @@ -38,6 +38,13 @@ sub acls { return ([ 1, 'ADMIN' ], [ 2, 'group/admins' ], [ 4, 'group/users' ]); } +sub audit { + shift; + print "audit @_\n"; + return if ($error or $empty); + return ([ file => 'unix-wallet-password' ]); +} + sub objects { shift; print "objects @_\n"; @@ -81,6 +88,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 +118,10 @@ 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, '', 'Audit report succeeds'); +is ($out, "new\naudit objects name\nfile unix-wallet-password\n", + ' and returns the right output'); ($out, $err) = run_report ('objects'); is ($err, '', 'List succeeds for objects'); is ($out, "new\nobjects \n" @@ -128,24 +140,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'); -- cgit v1.2.3 From e9fcc6b23337b206e4b2ff810e7ecf5258107604 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Wed, 3 Mar 2010 22:38:53 -0800 Subject: Remove stray list keywords from wallet-report documentation --- server/wallet-report | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/server/wallet-report b/server/wallet-report index caa7e2c..610e278 100755 --- a/server/wallet-report +++ b/server/wallet-report @@ -173,21 +173,21 @@ The currently supported object search types are: =over 4 -=item list objects acl +=item objects 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 +=item objects flag Returns all objects which have the given flag set. -=item list objects owner +=item objects owner Returns all objects owned by the given ACL name or ID. -=item list objects type +=item objects type Returns all objects of the given type. -- cgit v1.2.3 From acc73c988b845448230942de0f07263546763420 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Wed, 3 Mar 2010 22:44:53 -0800 Subject: Use L<> links instead of man page references for modules Do this only in the main text, not in the SEE ALSO section, since the latter is more for conventional man pages. This will produce better results for some POD to HTML converters (although not mine, yet). --- perl/Wallet/ACL/NetDB.pm | 4 ++-- perl/Wallet/Admin.pm | 4 ++-- perl/Wallet/Config.pm | 12 ++++++------ perl/Wallet/Database.pm | 4 ++-- perl/Wallet/Kadmin/Heimdal.pm | 4 ++-- perl/Wallet/Kadmin/MIT.pm | 4 ++-- perl/Wallet/Object/File.pm | 4 ++-- perl/Wallet/Object/Keytab.pm | 6 +++--- perl/Wallet/Report.pm | 4 ++-- perl/Wallet/Server.pm | 2 +- 10 files changed, 24 insertions(+), 24 deletions(-) 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 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. For more information on the normal +user interface to the wallet server, see L. =head1 CLASS METHODS diff --git a/perl/Wallet/Config.pm b/perl/Wallet/Config.pm index 2991361..c86fb80 100644 --- a/perl/Wallet/Config.pm +++ b/perl/Wallet/Config.pm @@ -90,7 +90,7 @@ Sets the Perl database driver to use for the wallet database. Common values would be C or C. Less common values would be C, C, or C. 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. 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 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, 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 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 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 and the documentation for the database driver you're using. =cut @@ -179,7 +179,7 @@ C 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 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. 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 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 for a Heimdal KDC. To use this class, several configuration parameters must be set. See L 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 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 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 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 for more information. If create() fails, it throws an exception. diff --git a/perl/Wallet/Report.pm b/perl/Wallet/Report.pm index ff4fa8b..462cd6f 100644 --- a/perl/Wallet/Report.pm +++ b/perl/Wallet/Report.pm @@ -360,8 +360,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. For more information on the normal +user interface to the wallet server, see L. =head1 CLASS METHODS diff --git a/perl/Wallet/Server.pm b/perl/Wallet/Server.pm index dd596c4..5f36c28 100644 --- a/perl/Wallet/Server.pm +++ b/perl/Wallet/Server.pm @@ -739,7 +739,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. =head1 CLASS METHODS -- cgit v1.2.3 From 63e36dfeb0f33d82b05e5f4ca0b832a610dcf6fd Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Wed, 3 Mar 2010 22:52:36 -0800 Subject: Note that all front-ends need a help function --- TODO | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/TODO b/TODO index 670a1c7..4541f02 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. -- cgit v1.2.3 From 1bdafc116b19fc0573c082b705900e4ad3848dc8 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Fri, 5 Mar 2010 11:30:45 -0800 Subject: Pull the list and report commands from wallet-admin The front-end still had the commands and documentation that had been moved to wallet-report. Pull them out of wallet-admin to avoid being confusing. --- server/wallet-admin | 120 ---------------------------------------------------- 1 file changed, 120 deletions(-) diff --git a/server/wallet-admin b/server/wallet-admin index 828cfc5..99a1f8a 100755 --- a/server/wallet-admin +++ b/server/wallet-admin @@ -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, 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) [ [ ... ] ] - -Returns a list of ACLs or objects in the database. ACLs will be listed -in the form: - - (ACL ID: ) - -where is the human-readable name and is the numeric ID. The -numeric ID is what's used internally by the wallet system. Objects will -be listed in the form: - - - -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 - -Returns all objects of the given type. - -=item list objects flag - -Returns all objects which have the given flag set. - -=item list objects owner - -Returns all objects owned by the given ACL name. - -=item list objects acl - -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 - -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) 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 [ ... ] - -Runs a wallet report. The currently supported report types are: - -=over 4 - -=item report owners - -Returns a list of all ACL lines in owner ACLs for all objects matching -both and . 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: - - - -with duplicates suppressed. - -=back - =back =head1 SEE ALSO -- cgit v1.2.3 From ee90967abe7f9199c173f1e4393484eff91a1ef3 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Fri, 5 Mar 2010 11:31:52 -0800 Subject: Fix leading comment for wallet-admin to use the right script name --- server/wallet-admin | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/server/wallet-admin b/server/wallet-admin index 99a1f8a..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 # Copyright 2008, 2009, 2010 Board of Trustees, Leland Stanford Jr. University -- cgit v1.2.3 From bb9f9d6d57ea09ef8fdcf81bcc77da8f1da5b41d Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Fri, 5 Mar 2010 12:00:31 -0800 Subject: Document how to clear an ACL in Wallet::Server --- perl/Wallet/Server.pm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/perl/Wallet/Server.pm b/perl/Wallet/Server.pm index 5f36c28..d525fe3 100644 --- a/perl/Wallet/Server.pm +++ b/perl/Wallet/Server.pm @@ -777,9 +777,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. -- cgit v1.2.3 From 2948d66c4c074651820004856284faf7d018a3ee Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Fri, 5 Mar 2010 14:18:10 -0800 Subject: Don't clobber the user ticket cache in the kadmin test --- perl/t/kadmin.t | 3 +++ 1 file changed, 3 insertions(+) diff --git a/perl/t/kadmin.t b/perl/t/kadmin.t index 0b52528..e5fb2fa 100755 --- a/perl/t/kadmin.t +++ b/perl/t/kadmin.t @@ -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'); -- cgit v1.2.3 From 0e3df4c4159650e6de7fdcf6a0f0b661f25c03f7 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Fri, 5 Mar 2010 16:56:47 -0800 Subject: Add a report of unused ACLs Add the acls unused report to wallet-report and Wallet::Report, returning all ACLs not referenced by any database objects. --- NEWS | 3 +++ perl/Wallet/Report.pm | 24 ++++++++++++++++++++---- perl/t/report.t | 37 ++++++++++++++++++++++++++++++++++++- server/wallet-report | 7 +++++++ 4 files changed, 66 insertions(+), 5 deletions(-) diff --git a/NEWS b/NEWS index 03fe99b..e41b86e 100644 --- a/NEWS +++ b/NEWS @@ -12,6 +12,9 @@ wallet 0.11 (unreleased) which returns all objects that do not pass the local naming policy. 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 diff --git a/perl/Wallet/Report.pm b/perl/Wallet/Report.pm index 462cd6f..f6e6753 100644 --- a/perl/Wallet/Report.pm +++ b/perl/Wallet/Report.pm @@ -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; } } @@ -387,11 +402,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 takes no arguments and will return +currently three search types. C takes no arguments and will return only those ACLs that have no entries within them. C 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 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 and diff --git a/perl/t/report.t b/perl/t/report.t index 3b94d00..b283576 100755 --- a/perl/t/report.t +++ b/perl/t/report.t @@ -7,7 +7,7 @@ # # See LICENSE for licensing terms. -use Test::More tests => 88; +use Test::More tests => 148; use Wallet::Admin; use Wallet::Report; @@ -166,6 +166,41 @@ 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'); diff --git a/server/wallet-report b/server/wallet-report index 610e278..2b7cd45 100755 --- a/server/wallet-report +++ b/server/wallet-report @@ -110,6 +110,8 @@ B takes no traditional options. =item acls entry +=item acls unused + Returns a list of ACLs in the database. ACLs will be listed in the form: (ACL ID: ) @@ -137,6 +139,11 @@ Returns all ACLs containing an entry with given scheme and identifier. The scheme must be an exact match, but the 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 objects name -- cgit v1.2.3 From fd7f47ed7dccb3ee01ddaa7e24b8bd7bffb6a1c6 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Fri, 5 Mar 2010 17:25:50 -0800 Subject: Allow naming policy enforcement for ACL names 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. --- NEWS | 5 +++++ perl/Wallet/Config.pm | 41 ++++++++++++++++++++++++++++++++++++++--- perl/Wallet/Server.pm | 18 ++++++++++++++++-- perl/t/server.t | 24 ++++++++++++++++++++++-- 4 files changed, 81 insertions(+), 7 deletions(-) diff --git a/NEWS b/NEWS index e41b86e..1f63e07 100644 --- a/NEWS +++ b/NEWS @@ -8,6 +8,11 @@ wallet 0.11 (unreleased) 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 one audit: objects name, which returns all objects that do not pass the local naming policy. The corresponding Wallet::Report method is audit(). diff --git a/perl/Wallet/Config.pm b/perl/Wallet/Config.pm index c86fb80..e4014a1 100644 --- a/perl/Wallet/Config.pm +++ b/perl/Wallet/Config.pm @@ -513,8 +513,8 @@ 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. @@ -549,7 +549,42 @@ keytab objects for particular principals have fully-qualified hostnames: } Objects that aren't of type C 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. + +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, C, C, or C. + + 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 ACL looked like a host name and the part after a +slash for a C ACL look like a user name. =head1 ENVIRONMENT diff --git a/perl/Wallet/Server.pm b/perl/Wallet/Server.pm index d525fe3..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; diff --git a/perl/t/server.t b/perl/t/server.t index 2a178e8..ed92d6e 100755 --- a/perl/t/server.t +++ b/perl/t/server.t @@ -3,11 +3,11 @@ # Tests for the wallet server API. # # Written by Russ Allbery -# 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 => 349; +use Test::More tests => 355; use POSIX qw(strftime); use Wallet::Admin; @@ -938,6 +938,26 @@ is ($server->owner ('base', 'service/acl-user', ''), 1, 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'; -- cgit v1.2.3 From 29452c3daeeb15670322907c53f5db2b43d2559f Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Fri, 5 Mar 2010 17:31:19 -0800 Subject: Update TODO for recent changes --- TODO | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/TODO b/TODO index 4541f02..8370210 100644 --- a/TODO +++ b/TODO @@ -77,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. @@ -132,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. @@ -150,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. -- cgit v1.2.3 From bc105004b8e88e1ede75dae0028d3ef10c15b57a Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Mon, 8 Mar 2010 10:19:03 -0800 Subject: Add an ACL name audit to wallet-report and Wallet::Report Parallel to objects name, add an acls name audit that returns all ACLs that do not follow the site naming standard. --- NEWS | 7 ++++--- perl/Wallet/Config.pm | 8 ++++++++ perl/Wallet/Report.pm | 33 ++++++++++++++++++++++++--------- perl/t/report.t | 17 ++++++++++++++++- server/wallet-report | 26 +++++++++++++++++++------- tests/server/report-t | 16 +++++++++++++--- 6 files changed, 84 insertions(+), 23 deletions(-) diff --git a/NEWS b/NEWS index 1f63e07..6744475 100644 --- a/NEWS +++ b/NEWS @@ -13,9 +13,10 @@ wallet 0.11 (unreleased) 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 one audit: objects name, - which returns all objects that do not pass the local naming policy. - The corresponding Wallet::Report method is audit(). + 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. diff --git a/perl/Wallet/Config.pm b/perl/Wallet/Config.pm index e4014a1..23a051d 100644 --- a/perl/Wallet/Config.pm +++ b/perl/Wallet/Config.pm @@ -563,6 +563,14 @@ 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. diff --git a/perl/Wallet/Report.pm b/perl/Wallet/Report.pm index f6e6753..c743060 100644 --- a/perl/Wallet/Report.pm +++ b/perl/Wallet/Report.pm @@ -310,10 +310,10 @@ sub owners { ############################################################################## # Audit the database for violations of local policy. Returns a list of -# objects (as type and name pairs) or a list of ACLs. 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. +# 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}; @@ -336,6 +336,20 @@ sub audit { $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; @@ -424,11 +438,12 @@ the error message if there was an error and undef if there was no error. 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. Currently, the only implemented type is C and the only -audit is C. This returns a list of all objects, as references to -pairs of type and name, that are not accepted by the verify_name() -function defined in the wallet configuration. See L for -more information. +perform. TYPE may be either C or C. Currently, the only +implemented audit is C. 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 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 diff --git a/perl/t/report.t b/perl/t/report.t index b283576..1dc69f7 100755 --- a/perl/t/report.t +++ b/perl/t/report.t @@ -7,7 +7,7 @@ # # See LICENSE for licensing terms. -use Test::More tests => 148; +use Test::More tests => 151; use Wallet::Admin; use Wallet::Report; @@ -224,6 +224,21 @@ 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/server/wallet-report b/server/wallet-report index 2b7cd45..435fb73 100755 --- a/server/wallet-report +++ b/server/wallet-report @@ -38,12 +38,16 @@ sub command { } 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 @objects = $report->audit (@args); - if (!@objects and $report->error) { + my @result = $report->audit (@args); + if (!@result and $report->error) { die $report->error, "\n"; } - for my $object (@objects) { - print join (' ', @$object), "\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; @@ -146,14 +150,22 @@ 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 objects that violate the current site naming policy. Objects -will be listed in the form: +Returns all ACLs or objects that violate the current site naming policy. +Objects will be listed in the form: -There will be one line per object. +and ACLs in the form: + + (ACL ID: ) + +where is the human-readable name and 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 diff --git a/tests/server/report-t b/tests/server/report-t index 61cfd9b..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 => 42; +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. @@ -42,7 +42,13 @@ sub audit { shift; print "audit @_\n"; return if ($error or $empty); - return ([ file => 'unix-wallet-password' ]); + if ($_[0] eq 'objects') { + return ([ file => 'unix-wallet-password' ]); + } elsif ($_[0] eq 'acls') { + return ([ 2, 'group/admins' ]); + } else { + return; + } } sub objects { @@ -119,9 +125,13 @@ 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, '', 'Audit report succeeds'); +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" -- cgit v1.2.3 From 49f5f195b1615538180055f84f555b62b978fcdf Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Mon, 8 Mar 2010 10:44:07 -0800 Subject: Correctly include portable/krb5.h in wallet/krb5.c We got lucky since client/internal.h includes this anyway, but include the portability layer properly. --- client/krb5.c | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) 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 +#include #include -#include - #include #include #include -- cgit v1.2.3 From 99f8f88be291cf55229e6c2488ff8e916ae901c2 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Mon, 8 Mar 2010 10:55:50 -0800 Subject: Release 0.11 --- NEWS | 2 +- README | 2 +- configure.ac | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/NEWS b/NEWS index 6744475..f9d4a9a 100644 --- a/NEWS +++ b/NEWS @@ -1,6 +1,6 @@ User-Visible wallet Changes -wallet 0.11 (unreleased) +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 diff --git a/README b/README index 3c8ddbc..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 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]) -- cgit v1.2.3 From ae4a9294fb237bd711ab2cab10a8d4726dbf6674 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Mon, 8 Mar 2010 19:14:46 -0800 Subject: Add additional reports needed to TODO --- TODO | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/TODO b/TODO index 8370210..32b307f 100644 --- a/TODO +++ b/TODO @@ -130,6 +130,19 @@ Objects: Reports: + * Add audit for references to unknown ACLs, possibly introduced by + previous versions before ACL deletion was checked with database + backends that don't do referential integrity. + + * Add report for all objects that have never been stored or downloaded. + + * Add report of all ACLs with identical contents. + + * For objects tied to hostnames, report on objects referring to hosts + which do not exist. For the initial pass, this is probably only keytab + objects with names containing a slash where the part after the slash + looks like a hostname. This may need some configuration help. + * 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 -- cgit v1.2.3 From 4fc4ce543c54a4d77293d75d2c50e3aaba98f4bf Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 16 Mar 2010 16:56:08 -0700 Subject: Add TODO to explore anonymous PKINIT --- TODO | 3 +++ 1 file changed, 3 insertions(+) diff --git a/TODO b/TODO index 32b307f..1e9f3c9 100644 --- a/TODO +++ b/TODO @@ -87,6 +87,9 @@ ACLs: * Provide an API for verifiers to syntax-check the values before an ACL is set and implement syntax checking for the Krb5 verifier. + * Investigate how best to support client authentication using anonymous + PKINIT for things like initial system keying. + Database: * Fix case-insensitivity bug in unique keys with MySQL for objects. -- cgit v1.2.3 From 207c46251bc9a6b7c39f5928a65afbc801faceae Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Sat, 3 Apr 2010 20:54:01 -0700 Subject: Remove the beta-quality warning in README --- README | 3 --- 1 file changed, 3 deletions(-) diff --git a/README b/README index 4879f97..ee073f1 100644 --- a/README +++ b/README @@ -8,9 +8,6 @@ license. Please see the file LICENSE in the distribution for more information. - This software is beta-quality and should be treated with caution. It is - currently being tested for production deployment at Stanford. - BLURB The wallet is a system for managing secure data, authorization rules to -- cgit v1.2.3 From ec85907906ede72ffd95164de2726abfc076b719 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Wed, 14 Apr 2010 18:04:52 -0700 Subject: Update Stanford naming for Tivoli keys The previous wording implied that --tivoli-key was only used for encryption keys. Allow for either passwords or encryption keys, and remove the note that it should be base64-encoded since wallet now supports binary files. --- docs/stanford-naming | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/docs/stanford-naming b/docs/stanford-naming index f2a45a7..7315c1e 100644 --- a/docs/stanford-naming +++ b/docs/stanford-naming @@ -104,11 +104,10 @@ Object Naming --tivoli-key - The Tivoli backup encryption key for this server. This is stored - in the same file as the password used to connect to the Tivoli - server, so both are stored together. This file is found at - /etc/adsm/TSM.PWD. It must be base64-encoded before being stored - in the wallet. + The Tivoli password or backup encryption key for this server. + Both the password and the encryption key, if used, are stored in + the same file, so both are stored together. This file is found at + /etc/adsm/TSM.PWD. --config- -- cgit v1.2.3 From 7bed6b6110af7532fc4a49cdb425f7f668e17c21 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Wed, 12 May 2010 11:32:31 -0700 Subject: Add a report of all objects that have never been downloaded Add a objects unused report to wallet-report and Wallet::Report, returning all objects that have never been downloaded (in other words, have never been the target of a get command). --- NEWS | 6 ++++++ TODO | 2 +- perl/Wallet/Report.pm | 20 ++++++++++++++++---- perl/t/report.t | 51 ++++++++++++++++++++++++++++++++++++++++++++++++++- server/wallet-report | 7 +++++++ 5 files changed, 80 insertions(+), 6 deletions(-) diff --git a/NEWS b/NEWS index f9d4a9a..79a24d1 100644 --- a/NEWS +++ b/NEWS @@ -1,5 +1,11 @@ User-Visible wallet Changes +wallet 0.12 (unreleased) + + Add a objects unused report to wallet-report and Wallet::Report, + returning all objects that have never been downloaded (in other words, + have never been the target of a get command). + wallet 0.11 (2010-03-08) When deleting an ACL on the server, verify that the ACL is not diff --git a/TODO b/TODO index 1e9f3c9..06521cd 100644 --- a/TODO +++ b/TODO @@ -137,7 +137,7 @@ Reports: previous versions before ACL deletion was checked with database backends that don't do referential integrity. - * Add report for all objects that have never been stored or downloaded. + * Add report for all objects that have never been stored. * Add report of all ACLs with identical contents. diff --git a/perl/Wallet/Report.pm b/perl/Wallet/Report.pm index c743060..64418ee 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.02'; +$VERSION = '0.03'; ############################################################################## # Constructor, destructor, and accessors @@ -128,6 +128,15 @@ sub objects_acl { return ($sql, ($acl->id) x 6); } +# Return the SQL statement to find all objects that have been created but +# have never been retrieved (via get). +sub objects_unused { + my ($self) = @_; + my $sql = 'select ob_type, ob_name from objects where ob_downloaded_on + is null order by objects.ob_type, objects.ob_name'; + return ($sql); +} + # Returns a list of all objects stored in the wallet database in the form of # type and name pairs. On error and for an empty database, the empty list # will be returned. To distinguish between an empty list and an error, call @@ -144,7 +153,7 @@ sub objects { if (!defined $type || $type eq '') { ($sql) = $self->objects_all; } else { - if (@args != 1) { + if ($type ne 'unused' && @args != 1) { $self->error ("object searches require one argument to search"); } elsif ($type eq 'type') { ($sql, @search) = $self->objects_type (@args); @@ -154,6 +163,8 @@ sub objects { ($sql, @search) = $self->objects_flag (@args); } elsif ($type eq 'acl') { ($sql, @search) = $self->objects_acl (@args); + } elsif ($type eq 'unused') { + ($sql) = $self->objects_unused (@args); } else { $self->error ("do not know search type: $type"); } @@ -461,13 +472,14 @@ Returns a list of all objects matching a search type and string in the database, or all objects in the database if no search information is given. -There are four types of searches currently. C, with a given type, +There are five types of searches currently. C, with a given type, will return only those entries where the type matches the given type. C, with a given owner, will only return those objects owned by the given ACL name or ID. C, with a given flag name, will only return those items with a flag set to the given value. C operates like C, but will return only those objects that have the given ACL name -or ID on any of the possible ACL settings, not just owner. +or ID on any of the possible ACL settings, not just owner. C will +return all entries for which a get command has never been issued. The return value is a list of references to pairs of type and name. For example, if two objects existed in the database, both of type C diff --git a/perl/t/report.t b/perl/t/report.t index 1dc69f7..00636db 100755 --- a/perl/t/report.t +++ b/perl/t/report.t @@ -7,7 +7,7 @@ # # See LICENSE for licensing terms. -use Test::More tests => 151; +use Test::More tests => 179; use Wallet::Admin; use Wallet::Report; @@ -49,6 +49,12 @@ is (scalar (@objects), 1, ' and now there is one object'); is ($objects[0][0], 'base', ' with the right type'); is ($objects[0][1], 'service/admin', ' and the right name'); +# That object should be unused. +@objects = $report->objects ('unused'); +is (scalar (@objects), 1, ' and that object is unused'); +is ($objects[0][0], 'base', ' with the right type'); +is ($objects[0][1], 'service/admin', ' and the right name'); + # Create another ACL. is ($server->acl_create ('first'), 1, 'ACL creation succeeds'); @acls = $report->acls; @@ -97,6 +103,14 @@ is (scalar (@lines), 1, ' and there is still owner in the report'); is ($lines[0][0], 'krb5', ' with the right scheme'); is ($lines[0][1], 'admin@EXAMPLE.COM', ' and the right identifier'); +# Both objects should now show as unused. +@objects = $report->objects ('unused'); +is (scalar (@objects), 2, 'There are now two unused objects'); +is ($objects[0][0], 'base', ' and the first has the right type'); +is ($objects[0][1], 'service/admin', ' and the right name'); +is ($objects[1][0], 'base', ' and the second has the right type'); +is ($objects[1][1], 'service/foo', ' and the right name'); + # Change the owner of the second object to an empty ACL. is ($server->owner ('base', 'service/foo', 'second'), 1, ' and changing the owner to an empty ACL works'); @@ -239,6 +253,41 @@ 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'); +# Set up a file bucket so that we can create an object we can retrieve. +system ('rm -rf test-files') == 0 or die "cannot remove test-files\n"; +mkdir 'test-files' or die "cannot create test-files: $!\n"; +$Wallet::Config::FILE_BUCKET = 'test-files'; + +# Create a file object and ensure that it shows up in the unused list. +is ($server->create ('file', 'test'), 1, 'Creating file:test succeeds'); +is ($server->owner ('file', 'test', 'ADMIN'), 1, + ' and setting its owner works'); +@objects = $report->objects ('unused'); +is (scalar (@objects), 4, 'There are now four unused objects'); +is ($objects[0][0], 'base', ' and the first has the right type'); +is ($objects[0][1], 'service/admin', ' and the right name'); +is ($objects[1][0], 'base', ' and the second has the right type'); +is ($objects[1][1], 'service/foo', ' and the right name'); +is ($objects[2][0], 'base', ' and the third has the right type'); +is ($objects[2][1], 'service/null', ' and the right name'); +is ($objects[3][0], 'file', ' and the fourth has the right type'); +is ($objects[3][1], 'test', ' and the right name'); + +# Store something and retrieve it, and then check that the file object fell +# off of the list. +is ($server->store ('file', 'test', 'Some data'), 1, + 'Storing data in file:test succeeds'); +is ($server->get ('file', 'test'), 'Some data', ' and retrieving it works'); +@objects = $report->objects ('unused'); +is (scalar (@objects), 3, ' and now there are three unused objects'); +is ($objects[0][0], 'base', ' and the first has the right type'); +is ($objects[0][1], 'service/admin', ' and the right name'); +is ($objects[1][0], 'base', ' and the second has the right type'); +is ($objects[1][1], 'service/foo', ' and the right name'); +is ($objects[2][0], 'base', ' and the third has the right type'); +is ($objects[2][1], 'service/null', ' and the right name'); + # Clean up. $admin->destroy; unlink 'wallet-db'; +system ('rm -r test-files') == 0 or die "cannot remove test-files\n"; diff --git a/server/wallet-report b/server/wallet-report index 435fb73..28d5b9a 100755 --- a/server/wallet-report +++ b/server/wallet-report @@ -177,6 +177,8 @@ one line per object or ACL. =item objects type +=item objects unused + Returns a list of objects in the database. Objects will be listed in the form: @@ -210,6 +212,11 @@ Returns all objects owned by the given ACL name or ID. Returns all objects of the given type. +=item objects unused + +Returns all objects that have never been downloaded (have never been the +target of a get command). + =back =item owners -- cgit v1.2.3 From 4dbf126b079d87639d0a463770c3e72b5b53d5d1 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 18 May 2010 16:44:38 -0700 Subject: Add acls duplicate report Add an acls duplicate report to wallet-report and Wallet::Report, returning sets of ACLs that have exactly the same entries. --- NEWS | 3 ++ perl/Wallet/Report.pm | 81 +++++++++++++++++++++++++++++++++++++++++++-------- perl/t/report.t | 36 ++++++++++++++++++++++- server/wallet-report | 25 ++++++++++++++-- tests/server/report-t | 10 ++++++- 5 files changed, 138 insertions(+), 17 deletions(-) diff --git a/NEWS b/NEWS index 79a24d1..738459b 100644 --- a/NEWS +++ b/NEWS @@ -6,6 +6,9 @@ wallet 0.12 (unreleased) returning all objects that have never been downloaded (in other words, have never been the target of a get command). + Add an acls duplicate report to wallet-report and Wallet::Report, + returning sets of ACLs that have exactly the same entries. + wallet 0.11 (2010-03-08) When deleting an ACL on the server, verify that the ACL is not diff --git a/perl/Wallet/Report.pm b/perl/Wallet/Report.pm index 64418ee..5a8dc52 100644 --- a/perl/Wallet/Report.pm +++ b/perl/Wallet/Report.pm @@ -15,6 +15,7 @@ require 5.006; use strict; use vars qw($VERSION); +use Wallet::ACL; use Wallet::Database; # This version should be increased on any code change to this module. Always @@ -234,6 +235,52 @@ sub acls_unused { return ($sql); } +# Obtain a textual representation of the membership of an ACL, returning undef +# on error and setting the internal error. +sub acl_membership { + my ($self, $id) = @_; + my $acl = eval { Wallet::ACL->new ($id, $self->{dbh}) }; + if ($@) { + $self->error ($@); + return; + } + my @members = map { "$_->[0] $_->[1]" } $acl->list; + if (!@members && $acl->error) { + $self->error ($acl->error); + return; + } + return join ("\n", @members); +} + +# Duplicate ACL detection unfortunately needs to do something more complex +# than just return a SQL statement, so it's handled differently than other +# reports. All the work is done here and the results returned as a list of +# sets of duplicates. +sub acls_duplicate { + my ($self) = @_; + my @acls = sort map { $_->[1] } $self->acls; + return if (!@acls && $self->{error}); + return if @acls < 2; + my %result; + for my $i (0 .. ($#acls - 1)) { + my $members = $self->acl_membership ($acls[$i]); + return unless defined $members; + for my $j (($i + 1) .. $#acls) { + my $check = $self->acl_membership ($acls[$j]); + return unless defined $check; + if ($check eq $members) { + $result{$acls[$i]} ||= []; + push (@{ $result{$acls[$i]} }, $acls[$j]); + } + } + } + my @result; + for my $acl (sort keys %result) { + push (@result, [ $acl, sort @{ $result{$acl} } ]); + } + return @result; +} + # 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 @@ -249,7 +296,9 @@ sub acls { if (!defined $type || $type eq '') { ($sql) = $self->acls_all; } else { - if ($type eq 'entry') { + if ($type eq 'duplicate') { + return $self->acls_duplicate; + } elsif ($type eq 'entry') { if (@args == 0) { $self->error ('ACL searches require an argument to search'); return; @@ -427,20 +476,28 @@ 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 three search types. C takes no arguments and will return -only those ACLs that have no entries within them. C 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. C 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 and -ID 1 and one with name C and ID 3, acls() with no arguments -would return: +currently four search types. C returns sets of duplicate ACLs +(ones with exactly the same entries). C takes no arguments and +will return only those ACLs that have no entries within them. C +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. C returns all ACLs +that are not referenced by any object. + +The return value for everything except C 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 and ID 1 and one with name +C and ID 3, acls() with no arguments would return: ([ 1, 'ADMIN' ], [ 3, 'group/admins' ]) +The return value for the C search is sets of ACL names that are +duplicates (have the same entries). For example, if C, C, and +C are all duplicates, and C and C are also duplicates, the +result would be: + + ([ 'd1', 'd2', 'd3' ], [ 'o1', 'o2' ]) + 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. diff --git a/perl/t/report.t b/perl/t/report.t index 00636db..363db20 100755 --- a/perl/t/report.t +++ b/perl/t/report.t @@ -7,7 +7,7 @@ # # See LICENSE for licensing terms. -use Test::More tests => 179; +use Test::More tests => 197; use Wallet::Admin; use Wallet::Report; @@ -287,6 +287,40 @@ is ($objects[1][1], 'service/foo', ' and the right name'); is ($objects[2][0], 'base', ' and the third has the right type'); is ($objects[2][1], 'service/null', ' and the right name'); +# The third and fourth ACLs are both empty and should show up as duplicate. +@acls = $report->acls ('duplicate'); +is (scalar (@acls), 1, 'There is one set of duplicate ACLs'); +is (scalar (@{ $acls[0] }), 2, ' with two members'); +is ($acls[0][0], 'fourth', ' and the first member is correct'); +is ($acls[0][1], 'third', ' and the second member is correct'); + +# Add the same line to both ACLs. They should still show up as duplicate. +is ($server->acl_add ('fourth', 'base', 'bar'), 1, + 'Adding a line to the fourth ACL works'); +is ($server->acl_add ('third', 'base', 'bar'), 1, + ' and adding a line to the third ACL works'); +@acls = $report->acls ('duplicate'); +is (scalar (@acls), 1, 'There is one set of duplicate ACLs'); +is (scalar (@{ $acls[0] }), 2, ' with two members'); +is ($acls[0][0], 'fourth', ' and the first member is correct'); +is ($acls[0][1], 'third', ' and the second member is correct'); + +# Add another line to the third ACL. Now we match second. +is ($server->acl_add ('third', 'base', 'foo'), 1, + 'Adding another line to the third ACL works'); +@acls = $report->acls ('duplicate'); +is (scalar (@acls), 1, 'There is one set of duplicate ACLs'); +is (scalar (@{ $acls[0] }), 2, ' with two members'); +is ($acls[0][0], 'second', ' and the first member is correct'); +is ($acls[0][1], 'third', ' and the second member is correct'); + +# Add yet another line to the third ACL. Now all ACLs are distinct. +is ($server->acl_add ('third', 'base', 'baz'), 1, + 'Adding another line to the third ACL works'); +@acls = $report->acls ('duplicate'); +is (scalar (@acls), 0, 'There are no duplicate ACLs'); +is ($report->error, undef, ' and no error'); + # Clean up. $admin->destroy; unlink 'wallet-db'; diff --git a/server/wallet-report b/server/wallet-report index 28d5b9a..466fe46 100755 --- a/server/wallet-report +++ b/server/wallet-report @@ -32,8 +32,14 @@ sub command { if (!@acls and $report->error) { die $report->error, "\n"; } - for my $acl (sort { $$a[1] cmp $$b[1] } @acls) { - print "$$acl[1] (ACL ID: $$acl[0])\n"; + if (@args && $args[0] eq 'duplicate') { + for my $group (@acls) { + print join (' ', @$group), "\n"; + } + } else { + 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; @@ -110,13 +116,16 @@ B takes no traditional options. =item acls +=item acls duplicate + =item acls empty =item acls entry =item acls unused -Returns a list of ACLs in the database. ACLs will be listed in the form: +Returns a list of ACLs in the database. Except for the C +report, ACLs will be listed in the form: (ACL ID: ) @@ -124,6 +133,10 @@ where is the human-readable name and is the numeric ID. The numeric ID is what's used internally by the wallet system. There will be one line per ACL. +For the C report, the output will instead be one duplicate set +per line. This will be a set of ACLs that all have the same entries. +Only the names will be given, separated by spaces. + If no search type is given, all the ACLs in the database will be returned. If a search type (and possible search arguments) are given, then the ACLs will be limited to those that match the search. @@ -132,6 +145,12 @@ The currently supported ACL search types are: =over 4 +=item acls duplicate + +Returns all sets of ACLs that are duplicates, meaning that they contain +exactly the same entries. Each line will be the names of the ACLs in a +set of duplicates, separated by spaces. + =item acls empty Returns all ACLs which have no entries, generally so that abandoned ACLs diff --git a/tests/server/report-t b/tests/server/report-t index 394a869..0771946 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 => 44; +use Test::More tests => 48; # Create a dummy class for Wallet::Report that prints what method was called # with its arguments and returns data for testing. @@ -35,6 +35,7 @@ sub acls { shift; print "acls @_\n"; return if ($error or $empty); + return ([ qw/d1 d2 d3/ ], [ qw/o1 o2/ ]) if (@_ && $_[0] eq 'duplicate'); return ([ 1, 'ADMIN' ], [ 2, 'group/admins' ], [ 4, 'group/users' ]); } @@ -119,6 +120,10 @@ is ($err, '', 'List succeeds for ACLs'); is ($out, "new\nacls \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 ('acls', 'duplicate'); +is ($err, '', 'Duplicate report succeeds for ACLs'); +is ($out, "new\nacls duplicate\nd1 d2 d3\no1 o2\n", + ' and returns the right output'); ($out, $err) = run_report ('acls', 'entry', 'foo', 'foo'); is ($err, '', 'List succeeds for ACLs'); is ($out, "new\nacls entry foo foo\n" @@ -168,6 +173,9 @@ $Wallet::Report::empty = 1; ($out, $err) = run_report ('acls'); 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 ('acls', 'duplicate'); +is ($err, '', 'acls duplicate runs with an empty list and no errors'); +is ($out, "new\nacls duplicate\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'); -- cgit v1.2.3 From 1e28788f0b0f5cae3dd815f07d39ad70e7da0ce2 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 18 May 2010 16:47:31 -0700 Subject: Fix error handling for klist with Heimdal user space The check for the enctypes of created keytabs tries klist for MIT first and then Heimdal ktutil. The klist options are invalid for Heimdal. Suppress the resulting complaining to standard error. --- perl/t/keytab.t | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/perl/t/keytab.t b/perl/t/keytab.t index b16cea5..fabdc5b 100755 --- a/perl/t/keytab.t +++ b/perl/t/keytab.t @@ -103,8 +103,14 @@ sub enctypes { close KEYTAB; my @enctypes; - open (KLIST, '-|', 'klist', '-ke', 'keytab') - or die "cannot run klist: $!\n"; + my $pid = open (KLIST, '-|'); + if (not defined $pid) { + die "cannot fork: $!\n"; + } elsif ($pid == 0) { + open (STDERR, '>', '/dev/null') or die "cannot reopen stderr: $!\n"; + exec ('klist', '-ke', 'keytab') + or die "cannot run klist: $!\n"; + } local $_; while () { next unless /^ *\d+ /; -- cgit v1.2.3 From e6bbf534bd4195a0330a7cad02f996677a19d4d2 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 18 May 2010 16:48:54 -0700 Subject: Clean up the ticket cache from the kadmin test --- perl/t/kadmin.t | 2 ++ 1 file changed, 2 insertions(+) diff --git a/perl/t/kadmin.t b/perl/t/kadmin.t index e5fb2fa..a1f2876 100755 --- a/perl/t/kadmin.t +++ b/perl/t/kadmin.t @@ -109,4 +109,6 @@ SKIP: { like ($kadmin->error, qr%^error creating keytab for wallet/one%, ' and the right error message is set'); is ($kadmin->destroy ('wallet/one'), 1, ' and deleting it again works'); + + unlink 'krb5cc_test'; } -- cgit v1.2.3 From 1f324f37b95034b0137884f48bde3ed484f7f21c Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Wed, 26 May 2010 07:39:33 -0700 Subject: Document acl rename in the wallet man page --- client/wallet.pod | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/client/wallet.pod b/client/wallet.pod index db93700..cb34761 100644 --- a/client/wallet.pod +++ b/client/wallet.pod @@ -210,6 +210,15 @@ accidental lockout, but administrators can remove themselves from the C ACL and can leave only a non-functioning entry on the ACL. Use caution when removing entries from the C ACL. +=item acl rename + +Renames the ACL identified by to . This changes the +human-readable name, not the underlying numeric ID, so the ACL's +associations with objects will be unchanged. The C ACL may not be +renamed. may be either the current name or the numeric ID. +must not be all-numeric. To rename an ACL, the current user must be +authorized by the C ACL. + =item acl show Display the name, numeric ID, and entries of the ACL . -- cgit v1.2.3 From b573d6f433725afda0e4238f63a5b3485d1d56f4 Mon Sep 17 00:00:00 2001 From: Ian Durkacz 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 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 +# 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. 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. + +=head1 AUTHOR + +Russ Allbery + +=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 d96c6de63ff749474b5675a7078ff0b3513a618c Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 29 Jun 2010 15:33:02 -0700 Subject: Give credit to the right author for krb5-regex --- perl/Wallet/ACL/Krb5/Regex.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/perl/Wallet/ACL/Krb5/Regex.pm b/perl/Wallet/ACL/Krb5/Regex.pm index 4e59834..61a0d04 100644 --- a/perl/Wallet/ACL/Krb5/Regex.pm +++ b/perl/Wallet/ACL/Krb5/Regex.pm @@ -127,6 +127,6 @@ available from L. =head1 AUTHOR -Russ Allbery +Ian Durkacz =cut -- cgit v1.2.3 From cd98777eb7904c30f1ffa792e10472e9b7b5051b Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 29 Jun 2010 15:33:58 -0700 Subject: Add another stopword to the wallet client man page --- client/wallet.pod | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/client/wallet.pod b/client/wallet.pod index cb34761..45969b2 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 uuencode getacl backend +KDC appdefaults remctld Allbery uuencode getacl backend ACL's =head1 SYNOPSIS -- cgit v1.2.3 From 906f0f88d64c4df501c2b84dbf6b7102de36d491 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 29 Jun 2010 15:38:31 -0700 Subject: Update test suite for the addition of krb5-regex --- perl/t/schema.t | 2 +- perl/t/verifier.t | 20 ++++++++++++++++++-- tests/server/backend-t | 18 +++++++++++++----- 3 files changed, 32 insertions(+), 8 deletions(-) diff --git a/perl/t/schema.t b/perl/t/schema.t index 7f0aea4..40759db 100755 --- a/perl/t/schema.t +++ b/perl/t/schema.t @@ -21,7 +21,7 @@ ok (defined $schema, 'Wallet::Schema creation'); ok ($schema->isa ('Wallet::Schema'), ' and class verification'); my @sql = $schema->sql; ok (@sql > 0, 'sql() returns something'); -is (scalar (@sql), 28, ' and returns the right number of statements'); +is (scalar (@sql), 29, ' and returns the right number of statements'); # Connect to a database and test create. db_setup; diff --git a/perl/t/verifier.t b/perl/t/verifier.t index 74d7ba8..f56f5fa 100755 --- a/perl/t/verifier.t +++ b/perl/t/verifier.t @@ -3,14 +3,15 @@ # Tests for the basic wallet ACL verifiers. # # Written by Russ Allbery -# 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 => 47; +use Test::More tests => 57; use Wallet::ACL::Base; use Wallet::ACL::Krb5; +use Wallet::ACL::Krb5::Regex; use Wallet::ACL::NetDB; use Wallet::ACL::NetDB::Root; use Wallet::Config; @@ -39,6 +40,21 @@ 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'); +$verifier = Wallet::ACL::Krb5::Regex->new; +isa_ok ($verifier, 'Wallet::ACL::Krb5::Regex', 'krb5-regex verifier'); +is ($verifier->check ('rra@stanford.edu', '.*@stanford\.edu\z'), 1, + 'Simple check'); +is ($verifier->check ('rra@stanford.edu', '^a.*@stanford\.edu'), 0, + 'Simple failure'); +is ($verifier->error, undef, 'No error set'); +is ($verifier->check (undef, '^rra@stanford\.edu\z'), undef, + 'Undefined principal'); +is ($verifier->error, 'no principal specified', ' and right error'); +is ($verifier->check ('rra@stanford.edu', ''), undef, 'Empty ACL'); +is ($verifier->error, 'no ACL specified', ' and right error'); +is ($verifier->check ('rra@stanford.edu', '(rra'), undef, 'Malformed regex'); +is ($verifier->error, 'malformed krb5-regex ACL', ' and right error'); + # Tests for the NetDB verifiers. Skip these if we don't have a keytab or if # we can't find remctld. SKIP: { diff --git a/tests/server/backend-t b/tests/server/backend-t index b58d02c..a618391 100755 --- a/tests/server/backend-t +++ b/tests/server/backend-t @@ -289,11 +289,19 @@ for my $command (sort keys %acl_commands) { my @args = @base; $args[$arg] = 'foo;bar'; ($out, $err) = run_backend ('acl', $command, @args); - is ($err, "invalid characters in argument: foo;bar\n", - "Invalid arguments for acl $command $arg"); - is ($OUTPUT, "error for admin (1.2.3.4): invalid characters in" - . " argument: foo;bar\n", ' and syslog correct'); - is ($out, "$new\n", ' and nothing ran'); + if (($command eq 'add' or $command eq 'remove') and $arg == 2) { + is ($err, '', 'Add/remove allows any characters'); + is ($OUTPUT, "command acl $command @args[0..2] from admin" + . " (1.2.3.4) succeeded\n", ' and success logged'); + is ($out, "$new\nacl_$command @args[0..2]\n", + ' and calls the right method'); + } else { + is ($err, "invalid characters in argument: foo;bar\n", + "Invalid arguments for acl $command $arg"); + is ($OUTPUT, "error for admin (1.2.3.4): invalid characters in" + . " argument: foo;bar\n", ' and syslog correct'); + is ($out, "$new\n", ' and nothing ran'); + } } } for my $command (sort keys %flag_commands) { -- cgit v1.2.3 From e7b803df6bbd9a5fc45c02b4a9dcf14500283d0d Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Wed, 7 Jul 2010 10:30:55 -0700 Subject: Add a help command to wallet-report Add a help command to wallet-report, which returns a summary of all available commands. --- NEWS | 3 +++ server/wallet-report | 27 ++++++++++++++++++++++++++- 2 files changed, 29 insertions(+), 1 deletion(-) diff --git a/NEWS b/NEWS index 738459b..31bf1cc 100644 --- a/NEWS +++ b/NEWS @@ -9,6 +9,9 @@ wallet 0.12 (unreleased) Add an acls duplicate report to wallet-report and Wallet::Report, returning sets of ACLs that have exactly the same entries. + Add a help command to wallet-report, which returns a summary of all + available commands. + wallet 0.11 (2010-03-08) When deleting an ACL on the server, verify that the ACL is not diff --git a/server/wallet-report b/server/wallet-report index 466fe46..7f7ba4d 100755 --- a/server/wallet-report +++ b/server/wallet-report @@ -8,12 +8,31 @@ # See LICENSE for licensing terms. ############################################################################## -# Declarations and site configuration +# Declarations and globals ############################################################################## use strict; use Wallet::Report; +# The help output, sent in reply to the help command. Lists each supported +# report command with a brief description of what it does. +our $HELP = <<'EOH'; +Wallet reporting help: + acls All ACLs + acls duplicate ACLs that duplicate another + acls empty All empty ACLs + acls ACLs containing this entry (wildcarded) + acls unused ACLs that are not referenced by any object + audit acls name ACLs failing the naming policy + audit objects name Objects failing the naming policy + objects All objects + objects acl Objects granting permissions to that ACL + objects flag Objects with that flag set + objects owner Objects owned by that owner + objects type Objects of that type + objects unused Objects that have never been stored/gotten +EOH + ############################################################################## # Implementation ############################################################################## @@ -55,6 +74,8 @@ sub command { print join (' ', @$item), "\n"; } } + } elsif ($command eq 'help') { + print $HELP; } elsif ($command eq 'objects') { die "too many arguments to objects\n" if @args > 2; my @objects = $report->objects (@args); @@ -186,6 +207,10 @@ where is the human-readable name and 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 help + +Displays a summary of all available commands. + =item objects =item objects acl -- cgit v1.2.3 From 11e4af2938f6b1674329d1daa6e8d702b501ccf4 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Wed, 7 Jul 2010 10:32:39 -0700 Subject: Add NEWS entry for krb5-regex --- NEWS | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/NEWS b/NEWS index 31bf1cc..cd1d633 100644 --- a/NEWS +++ b/NEWS @@ -2,6 +2,11 @@ wallet 0.12 (unreleased) + A new ACL type, krb5-regex, is now supported. This ACL type is the + same as krb5 except that the identifier is interpreted as a Perl + regular expression and matched against the authenticated identity + attempting to run a wallet command. Patch from Ian Durkacz. + Add a objects unused report to wallet-report and Wallet::Report, returning all objects that have never been downloaded (in other words, have never been the target of a get command). -- cgit v1.2.3 From c75eb196a37ce8ca1acd791267cfb36ee30fdcdb Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Wed, 7 Jul 2010 10:36:00 -0700 Subject: Add sample remctl configuration for wallet-report --- config/wallet | 6 ++++-- config/wallet-report.acl | 6 ++++++ 2 files changed, 10 insertions(+), 2 deletions(-) create mode 100644 config/wallet-report.acl diff --git a/config/wallet b/config/wallet index 06dc39d..19b86fa 100644 --- a/config/wallet +++ b/config/wallet @@ -1,7 +1,9 @@ # /etc/remctl/conf.d/wallet -- Run wallet-backend for the wallet system. # -# This is a remctld configuration fragment to run wallet-backend, which -# implements the server side of the wallet system. +# This is a remctld configuration fragment to run wallet-backend and +# wallet-report, which implement the server side of the wallet system. wallet store /usr/sbin/wallet-backend stdin=4 ANYUSER wallet ALL /usr/sbin/wallet-backend ANYUSER + +wallet-report /usr/sbin/wallet-report /etc/remctl/acl/wallet-report diff --git a/config/wallet-report.acl b/config/wallet-report.acl new file mode 100644 index 0000000..d4c1aa6 --- /dev/null +++ b/config/wallet-report.acl @@ -0,0 +1,6 @@ +# /etc/remctl/acl/wallet-report -- ACL for wallet reporting. +# +# This is the ACL controlling who can run reports against the wallet +# database using wallet-report via remctl. This backend doesn't allow any +# modification of data or retrieval of stored data, but does allow +# examination of all of the metadata in the wallet database. -- cgit v1.2.3 From 534f2111ab41ed63024d811a3d8f5b81256d83a9 Mon Sep 17 00:00:00 2001 From: Jon Robertson Date: Tue, 27 Jul 2010 12:40:12 -0700 Subject: Adding wallet rekey capability -- work in progress, testing First, testing version of wallet rekey code, committed in order to get feedback from Russ. This code will eventually take an existing keytab file, and for every principal belonging to our default realm in it, get new versions of that keytab and merge them into the file. This allows for quietly rekeying principals automatically. --- client/file.c | 26 ++++++++ client/keytab.c | 179 +++++++++++++++++++++++++++++++++++++++++++++++++++++++- client/wallet.c | 6 +- 3 files changed, 209 insertions(+), 2 deletions(-) diff --git a/client/file.c b/client/file.c index 66d5f63..f24d3ca 100644 --- a/client/file.c +++ b/client/file.c @@ -46,6 +46,32 @@ overwrite_file(const char *name, const void *data, size_t length) sysdie("close of %s failed (file probably truncated)", name); } +/* + * Given a filename, some data, and a length, write that data to the given + * file safely, but overwrite any existing file by that name. + */ +void +append_file(const char *name, const void *data, size_t length) +{ + int fd; + ssize_t status; + + if (access(name, F_OK) == 0) + if (unlink(name) < 0) + sysdie("unable to delete existing file %s", name); + fd = open(name, O_WRONLY | O_APPEND); + if (fd < 0) + sysdie("open of %s failed", name); + if (length > 0) { + status = write(fd, data, length); + if (status < 0) + sysdie("write to %s failed", name); + else if (status != (ssize_t) length) + die("write to %s truncated", name); + } + if (close(fd) < 0) + sysdie("close of %s failed (file probably truncated)", name); +} /* * Given a filename, some data, and a length, write that data to the given diff --git a/client/keytab.c b/client/keytab.c index 5f2076f..d81079a 100644 --- a/client/keytab.c +++ b/client/keytab.c @@ -17,7 +17,85 @@ #include #include #include +#include +/* List of principals we have already encountered. */ +struct principal_name { + char *princ; + struct principal_name* next; +}; + +/* + * Given a context, a keytab file, and a realm, return a list of all + * principals in that file. + */ +struct principal_name +keytab_principals(krb5_context ctx, const char *file, char *realm) +{ + char *princname = NULL, *princrealm = NULL; + bool found; + krb5_keytab keytab = NULL; + krb5_kt_cursor cursor; + krb5_keytab_entry entry; + krb5_error_code status; + struct principal_name *names_seen = NULL, *current_seen = NULL; + + memset(&entry, 0, sizeof(entry)); + status = krb5_kt_resolve(ctx, file, &keytab); + if (status != 0) + die_krb5(ctx, status, "cannot open keytab %s", file); + status = krb5_kt_start_seq_get(ctx, keytab, &cursor); + if (status != 0) + die_krb5(ctx, status, "cannot read keytab %s", file); + while ((status = krb5_kt_next_entry(ctx, keytab, &entry, &cursor)) == 0) { + status = krb5_unparse_name(ctx, entry.principal, &princname); + if (status != 0) + sysdie("error, cannot unparse name for a principal"); + + found = false; + current_seen = names_seen; + while (current_seen != NULL) { + if (strcmp(current_seen->princ, princname)) { + found = true; + break; + } + current_seen = current_seen->next; + } + + /* Add any new principals in the correct realm to the list. */ + if (found == false) { + princrealm = strchr(princname, '@'); + if (princrealm != NULL) { + *princrealm = '\0'; + princrealm++; + } + if (princrealm != NULL && strcmp(princrealm, realm) == 0) { + current_seen = xmalloc(sizeof(struct principal_name)); + current_seen->princ = xstrdup(princname); + current_seen->next = names_seen; + names_seen = current_seen; + } + } + + krb5_kt_free_entry(ctx, &entry); + free(princname); + } + + if (status != KRB5_KT_END) + die_krb5(ctx, status, "error reading keytab %s", file); + krb5_kt_end_seq_get(ctx, keytab, &cursor); + krb5_kt_close(ctx, keytab); + + /* TODO: Testing the principals correctly made, remove after. */ + warn("Exiting keytab_principals"); + current_seen = names_seen; + while (current_seen != NULL) { + warn("found principal %s", current_seen->princ); + current_seen = current_seen->next; + } + + return *names_seen; +} /* * Given keytab data as a pointer to memory and a length and the path of a @@ -61,11 +139,36 @@ merge_keytab(krb5_context ctx, const char *newfile, const char *file) krb5_kt_close(ctx, temp); } +/* + * Given a remctl object, the type and name of a keytab object, and + * references to keytab data and data length, call the correct wallet + * commands to download a keytab and return the keytab data. Returns the + * status of the remctl command. + */ +int +download_keytab(struct remctl *r, const char *type, const char *name, + char **data, size_t *length) +{ + const char *command[5]; + int status; + + command[0] = type; + command[1] = "get"; + command[2] = "keytab"; + command[3] = name; + command[4] = NULL; + status = run_command(r, command, data, length); + if (*data == NULL) { + warn("no data returned by wallet server"); + return 255; + } + return status; +} /* * Given a remctl object, the Kerberos context, the name of a keytab object, * and a file name, call the correct wallet commands to download a keytab and - * write it to that file. Returns the setatus or 255 on an internal error. + * write it to that file. Returns the status or 255 on an internal error. */ int get_keytab(struct remctl *r, krb5_context ctx, const char *type, @@ -105,3 +208,77 @@ get_keytab(struct remctl *r, krb5_context ctx, const char *type, } return 0; } + +/* + * Given a remctl object, the Kerberos context, the type and name of a keytab + * object, and a file name, iterate through every existing principal in the + * keytab, get fresh keys for those principals, and save the old and new + * keys to that file. Returns the status, or 255 on an internal error. + */ +int +rekey_keytab(struct remctl *r, krb5_context ctx, const char *type, + const char *file) +{ + char *realm = NULL; + char *data = NULL; + char *tempfile, *backupfile; + size_t length = 0; + int status; + bool error = false, rekeyed = false; + struct principal_name *names_seen, *current_seen; + + tempfile = concat(file, ".new", (char *) 0); + + krb5_get_default_realm(ctx, &realm); + *names_seen = keytab_principals(ctx, file, realm); + /* keytab_principals(ctx, file, realm); */ + + /* TODO: Testing we got back the principals correctly, delete. */ + warn("Finished keytab_principals"); + current_seen = names_seen; + while (current_seen != NULL) { + warn("found principal %s", current_seen->princ); + current_seen = current_seen->next; + } + return 0; + + current_seen = names_seen; + while (current_seen != NULL) { + status = download_keytab(r, type, current_seen->princ, &data, + &length); + if (status != 0) { + warn("error rekeying for principal %s", current_seen->princ); + error = true; + } else { + if (data != NULL) { + append_file(tempfile, data, length); + rekeyed = true; + } + } + warn("seen principal %s", current_seen->princ); + current_seen = current_seen->next; + } + + /* If no new keytab data, then leave the keytab as-is. */ + if (rekeyed == false) + sysdie("no rekeyed principals found"); + + /* Now merge the original keytab file with the one containing the new. */ + if (access(file, F_OK) == 0) { + + /* If error, first copy the keytab file to filename.old */ + if (error == true) { + data = read_file(file, &length); + backupfile = concat(file, ".old", (char *) 0); + overwrite_file(backupfile, data, length); + } + merge_keytab(ctx, tempfile, file); + } else { + data = read_file(tempfile, &length); + write_file(file, data, length); + } + if (unlink(tempfile) < 0) + sysdie("unlink of temporary keytab file %s failed", tempfile); + free(tempfile); + return 0; +} diff --git a/client/wallet.c b/client/wallet.c index e6d8eb9..9c1eb09 100644 --- a/client/wallet.c +++ b/client/wallet.c @@ -194,7 +194,7 @@ main(int argc, char *argv[]) } argc -= optind; argv += optind; - if (argc < 3) + if (argc < 3 && strcmp(argv[0], "rekey") != 0) usage(1); /* -f is only supported for get and store and -S with get keytab. */ @@ -242,6 +242,10 @@ main(int argc, char *argv[]) } else { status = get_file(r, options.type, argv[1], argv[2], file); } + } else if (strcmp(argv[0], "rekey") == 0) { + if (argc > 2) + die("too many arguments"); + status = rekey_keytab(r, ctx, "keytab", argv[1]); } else { count = argc + 1; if (strcmp(argv[0], "store") == 0) { -- cgit v1.2.3 From 5047dee97b80e2db2c57a2654a549e87411c1813 Mon Sep 17 00:00:00 2001 From: Jon Robertson Date: Tue, 27 Jul 2010 17:08:56 -0700 Subject: Finished first pass of the rekey command Cleaned up several bugs preventing the rekey command from working (bad calls to variables, matching on version of principal name already stripped of realm), and removed debugging code. --- client/file.c | 3 --- client/keytab.c | 77 ++++++++++++++++++++++----------------------------------- client/wallet.c | 2 +- 3 files changed, 30 insertions(+), 52 deletions(-) diff --git a/client/file.c b/client/file.c index f24d3ca..581d4a7 100644 --- a/client/file.c +++ b/client/file.c @@ -56,9 +56,6 @@ append_file(const char *name, const void *data, size_t length) int fd; ssize_t status; - if (access(name, F_OK) == 0) - if (unlink(name) < 0) - sysdie("unable to delete existing file %s", name); fd = open(name, O_WRONLY | O_APPEND); if (fd < 0) sysdie("open of %s failed", name); diff --git a/client/keytab.c b/client/keytab.c index d81079a..94a7858 100644 --- a/client/keytab.c +++ b/client/keytab.c @@ -29,7 +29,7 @@ struct principal_name { * Given a context, a keytab file, and a realm, return a list of all * principals in that file. */ -struct principal_name +struct principal_name * keytab_principals(krb5_context ctx, const char *file, char *realm) { char *princname = NULL, *princrealm = NULL; @@ -38,7 +38,7 @@ keytab_principals(krb5_context ctx, const char *file, char *realm) krb5_kt_cursor cursor; krb5_keytab_entry entry; krb5_error_code status; - struct principal_name *names_seen = NULL, *current_seen = NULL; + struct principal_name *names = NULL, *current = NULL; memset(&entry, 0, sizeof(entry)); status = krb5_kt_resolve(ctx, file, &keytab); @@ -52,29 +52,29 @@ keytab_principals(krb5_context ctx, const char *file, char *realm) if (status != 0) sysdie("error, cannot unparse name for a principal"); + /* Separate into principal and realm. */ + princrealm = strchr(princname, '@'); + if (princrealm != NULL) { + *princrealm = '\0'; + princrealm++; + } + if (princrealm == NULL || strcmp(princrealm, realm) != 0) + break; + + /* Check to see if the principal has already been listed. */ found = false; - current_seen = names_seen; - while (current_seen != NULL) { - if (strcmp(current_seen->princ, princname)) { + for (current = names; current != NULL; current = current->next) { + if (strcmp(current->princ, princname) == 0) { found = true; break; } - current_seen = current_seen->next; } - /* Add any new principals in the correct realm to the list. */ if (found == false) { - princrealm = strchr(princname, '@'); - if (princrealm != NULL) { - *princrealm = '\0'; - princrealm++; - } - if (princrealm != NULL && strcmp(princrealm, realm) == 0) { - current_seen = xmalloc(sizeof(struct principal_name)); - current_seen->princ = xstrdup(princname); - current_seen->next = names_seen; - names_seen = current_seen; - } + current = xmalloc(sizeof(struct principal_name)); + current->princ = xstrdup(princname); + current->next = names; + names = current; } krb5_kt_free_entry(ctx, &entry); @@ -86,15 +86,7 @@ keytab_principals(krb5_context ctx, const char *file, char *realm) krb5_kt_end_seq_get(ctx, keytab, &cursor); krb5_kt_close(ctx, keytab); - /* TODO: Testing the principals correctly made, remove after. */ - warn("Exiting keytab_principals"); - current_seen = names_seen; - while (current_seen != NULL) { - warn("found principal %s", current_seen->princ); - current_seen = current_seen->next; - } - - return *names_seen; + return names; } /* @@ -225,38 +217,27 @@ rekey_keytab(struct remctl *r, krb5_context ctx, const char *type, size_t length = 0; int status; bool error = false, rekeyed = false; - struct principal_name *names_seen, *current_seen; + struct principal_name *names, *current; tempfile = concat(file, ".new", (char *) 0); krb5_get_default_realm(ctx, &realm); - *names_seen = keytab_principals(ctx, file, realm); - /* keytab_principals(ctx, file, realm); */ - - /* TODO: Testing we got back the principals correctly, delete. */ - warn("Finished keytab_principals"); - current_seen = names_seen; - while (current_seen != NULL) { - warn("found principal %s", current_seen->princ); - current_seen = current_seen->next; - } - return 0; + names = keytab_principals(ctx, file, realm); - current_seen = names_seen; - while (current_seen != NULL) { - status = download_keytab(r, type, current_seen->princ, &data, - &length); + for (current = names; current != NULL; current = current->next) { + status = download_keytab(r, type, current->princ, &data, &length); if (status != 0) { - warn("error rekeying for principal %s", current_seen->princ); + warn("error rekeying for principal %s", current->princ); error = true; } else { if (data != NULL) { - append_file(tempfile, data, length); + if (access(tempfile, F_OK) == 0) + append_file(tempfile, data, length); + else + write_file(tempfile, data, length); rekeyed = true; } } - warn("seen principal %s", current_seen->princ); - current_seen = current_seen->next; } /* If no new keytab data, then leave the keytab as-is. */ @@ -278,7 +259,7 @@ rekey_keytab(struct remctl *r, krb5_context ctx, const char *type, write_file(file, data, length); } if (unlink(tempfile) < 0) - sysdie("unlink of temporary keytab file %s failed", tempfile); + sysdie("unlink of temporary keytab file %s failed", tempfile); free(tempfile); return 0; } diff --git a/client/wallet.c b/client/wallet.c index 9c1eb09..d61fc74 100644 --- a/client/wallet.c +++ b/client/wallet.c @@ -245,7 +245,7 @@ main(int argc, char *argv[]) } else if (strcmp(argv[0], "rekey") == 0) { if (argc > 2) die("too many arguments"); - status = rekey_keytab(r, ctx, "keytab", argv[1]); + status = rekey_keytab(r, ctx, options.type, argv[1]); } else { count = argc + 1; if (strcmp(argv[0], "store") == 0) { -- cgit v1.2.3 From a87062c0c60ba4daa3489966c85233c549a5c477 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Wed, 28 Jul 2010 19:39:47 -0700 Subject: Fix help output for acls entry report --- server/wallet-report | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/server/wallet-report b/server/wallet-report index 7f7ba4d..98fd07a 100755 --- a/server/wallet-report +++ b/server/wallet-report @@ -21,7 +21,7 @@ Wallet reporting help: acls All ACLs acls duplicate ACLs that duplicate another acls empty All empty ACLs - acls ACLs containing this entry (wildcarded) + acls entry ACLs containing this entry (wildcarded) acls unused ACLs that are not referenced by any object audit acls name ACLs failing the naming policy audit objects name Objects failing the naming policy -- cgit v1.2.3 From 5a48a5d5f7f2af72cf84114453748fbd2a337537 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Wed, 28 Jul 2010 22:05:05 -0700 Subject: Break wallet-rekey out into a separate client program Build a separate wallet-rekey client that rekeys every keytab given on the command-line. Fix some coding style issues and add internal prototypes. Build the shared source for both clients into an uninstalled library to save compilation time. --- .gitignore | 1 + Makefile.am | 17 ++++-- client/file.c | 6 ++- client/internal.h | 46 ++++++++++++++++ client/keytab.c | 73 ++++++++++++------------- client/options.c | 71 ++++++++++++++++++++++++ client/wallet-rekey.c | 147 ++++++++++++++++++++++++++++++++++++++++++++++++++ client/wallet.c | 85 +++-------------------------- 8 files changed, 324 insertions(+), 122 deletions(-) create mode 100644 client/options.c create mode 100644 client/wallet-rekey.c diff --git a/.gitignore b/.gitignore index 10cfbf8..67f4760 100644 --- a/.gitignore +++ b/.gitignore @@ -2,6 +2,7 @@ /aclocal.m4 /build-aux/ /client/wallet +/client/wallet-rekey /config.h /config.h.in /config.h.in~ diff --git a/Makefile.am b/Makefile.am index d5dccd9..10f47d9 100644 --- a/Makefile.am +++ b/Makefile.am @@ -57,15 +57,22 @@ util_libutil_a_SOURCES = util/concat.c util/concat.h util/macros.h \ util/messages.h util/xmalloc.c util/xmalloc.h util_libutil_a_CPPFLAGS = $(KRB5_CPPFLAGS) -bin_PROGRAMS = client/wallet +noinst_LIBRARIES += client/libwallet.a +client_libwallet_a_SOURCES = client/file.c client/internal.h client/keytab.c \ + client/krb5.c client/options.c client/remctl.c client/srvtab.c +client_libwallet_a_CPPFLAGS = $(REMCTL_CPPFLAGS) $(KRB5_CPPFLAGS) + +bin_PROGRAMS = client/wallet client/wallet-rekey dist_sbin_SCRIPTS = server/keytab-backend server/wallet-admin \ server/wallet-backend server/wallet-report -client_wallet_SOURCES = client/file.c client/internal.h client/keytab.c \ - client/krb5.c client/remctl.c client/srvtab.c client/wallet.c client_wallet_CPPFLAGS = $(REMCTL_CPPFLAGS) $(KRB5_CPPFLAGS) client_wallet_LDFLAGS = $(REMCTL_LDFLAGS) $(KRB5_LDFLAGS) -client_wallet_LDADD = util/libutil.a portable/libportable.a $(REMCTL_LIBS) \ - $(KRB5_LIBS) +client_wallet_LDADD = client/libwallet.a util/libutil.a \ + portable/libportable.a $(REMCTL_LIBS) $(KRB5_LIBS) +client_wallet_rekey_CPPFLAGS = $(REMCTL_CPPFLAGS) $(KRB5_CPPFLAGS) +client_wallet_rekey_LDFLAGS = $(REMCTL_LDFLAGS) $(KRB5_LDFLAGS) +client_wallet_rekey_LDADD = client/libwallet.a util/libutil.a \ + portable/libportable.a $(REMCTL_LIBS) $(KRB5_LIBS) dist_man_MANS = client/wallet.1 server/keytab-backend.8 \ server/wallet-admin.8 server/wallet-backend.8 server/wallet-report.8 diff --git a/client/file.c b/client/file.c index 581d4a7..861da6a 100644 --- a/client/file.c +++ b/client/file.c @@ -46,9 +46,10 @@ overwrite_file(const char *name, const void *data, size_t length) sysdie("close of %s failed (file probably truncated)", name); } + /* - * Given a filename, some data, and a length, write that data to the given - * file safely, but overwrite any existing file by that name. + * Given a filename, some data, and a length, append that data to an existing + * file. Dies on any failure. */ void append_file(const char *name, const void *data, size_t length) @@ -70,6 +71,7 @@ append_file(const char *name, const void *data, size_t length) sysdie("close of %s failed (file probably truncated)", name); } + /* * Given a filename, some data, and a length, write that data to the given * file safely and atomically by creating file.new, writing the data, linking diff --git a/client/internal.h b/client/internal.h index d82196c..c8e5802 100644 --- a/client/internal.h +++ b/client/internal.h @@ -15,12 +15,42 @@ #include +/* + * Allow defaults to be set for a particular site with configure options if + * people don't want to use krb5.conf for some reason. + */ +#ifndef WALLET_SERVER +# define WALLET_SERVER NULL +#endif +#ifndef WALLET_PORT +# define WALLET_PORT 0 +#endif + /* Forward declarations to avoid unnecessary includes. */ struct remctl; struct iovec; +/* + * Basic wallet behavior options set either on the command line or via + * krb5.conf. If set via krb5.conf, we allocate memory for the strings, but + * we never free them. + */ +struct options { + char *type; + char *server; + char *principal; + char *user; + int port; +}; + BEGIN_DECLS +/* + * Set default options from the system krb5.conf or from compile-time + * defaults. + */ +void default_options(krb5_context ctx, struct options *options); + /* * Given a Kerberos context and a principal name, obtain Kerberos credentials * for that principal and store them in a temporary ticket cache for use by @@ -74,12 +104,28 @@ int get_file(struct remctl *, const char *prefix, const char *type, int get_keytab(struct remctl *, krb5_context, const char *type, const char *name, const char *file, const char *srvtab); +/* + * Given a remctl object, the Kerberos context, the type for the wallet + * interface, and a file name of a keytab, iterate through every existing + * principal in the keytab in the local realm, get fresh keys for those + * principals, and save the old and new keys to that file. Returns true on + * success and false on partial failure to retrieve all the keys. + */ +bool rekey_keytab(struct remctl *, krb5_context, const char *type, + const char *file); + /* * Given a filename, some data, and a length, write that data to the given * file with error checking, overwriting any existing contents. */ void overwrite_file(const char *name, const void *data, size_t length); +/* + * Given a filename, some data, and a length, append that data to an existing + * file. Dies on any failure. + */ +void append_file(const char *name, const void *data, size_t length); + /* * Given a filename, some data, and a length, write that data to the given * file safely and atomically by creating file.new, writing the data, linking diff --git a/client/keytab.c b/client/keytab.c index 94a7858..41baa73 100644 --- a/client/keytab.c +++ b/client/keytab.c @@ -25,11 +25,12 @@ struct principal_name { struct principal_name* next; }; + /* * Given a context, a keytab file, and a realm, return a list of all * principals in that file. */ -struct principal_name * +static struct principal_name * keytab_principals(krb5_context ctx, const char *file, char *realm) { char *princname = NULL, *princrealm = NULL; @@ -69,31 +70,27 @@ keytab_principals(krb5_context ctx, const char *file, char *realm) break; } } - if (found == false) { current = xmalloc(sizeof(struct principal_name)); current->princ = xstrdup(princname); current->next = names; names = current; } - krb5_kt_free_entry(ctx, &entry); free(princname); } - if (status != KRB5_KT_END) die_krb5(ctx, status, "error reading keytab %s", file); krb5_kt_end_seq_get(ctx, keytab, &cursor); krb5_kt_close(ctx, keytab); - return names; } + /* - * Given keytab data as a pointer to memory and a length and the path of a - * second keytab, merge the keys in the memory keytab into the file keytab. - * Currently, this doesn't do any cleanup of old kvnos and doesn't handle - * duplicate kvnos correctly. Dies on any error. + * Given two files containing keytab data, second keytab, merge the keys into + * the new file. Currently, this doesn't do any cleanup of old kvnos and + * doesn't handle duplicate kvnos correctly. Dies on any error. */ static void merge_keytab(krb5_context ctx, const char *newfile, const char *file) @@ -131,13 +128,14 @@ merge_keytab(krb5_context ctx, const char *newfile, const char *file) krb5_kt_close(ctx, temp); } + /* * Given a remctl object, the type and name of a keytab object, and * references to keytab data and data length, call the correct wallet * commands to download a keytab and return the keytab data. Returns the * status of the remctl command. */ -int +static int download_keytab(struct remctl *r, const char *type, const char *name, char **data, size_t *length) { @@ -157,6 +155,7 @@ download_keytab(struct remctl *r, const char *type, const char *name, return status; } + /* * Given a remctl object, the Kerberos context, the name of a keytab object, * and a file name, call the correct wallet commands to download a keytab and @@ -201,13 +200,15 @@ get_keytab(struct remctl *r, krb5_context ctx, const char *type, return 0; } + /* - * Given a remctl object, the Kerberos context, the type and name of a keytab - * object, and a file name, iterate through every existing principal in the - * keytab, get fresh keys for those principals, and save the old and new - * keys to that file. Returns the status, or 255 on an internal error. + * Given a remctl object, the Kerberos context, the type for the wallet + * interface, and a file name of a keytab, iterate through every existing + * principal in the keytab in the local realm, get fresh keys for those + * principals, and save the old and new keys to that file. Returns true on + * success and false on partial failure to retrieve all the keys. */ -int +bool rekey_keytab(struct remctl *r, krb5_context ctx, const char *type, const char *file) { @@ -220,46 +221,46 @@ rekey_keytab(struct remctl *r, krb5_context ctx, const char *type, struct principal_name *names, *current; tempfile = concat(file, ".new", (char *) 0); - krb5_get_default_realm(ctx, &realm); names = keytab_principals(ctx, file, realm); - for (current = names; current != NULL; current = current->next) { status = download_keytab(r, type, current->princ, &data, &length); if (status != 0) { warn("error rekeying for principal %s", current->princ); error = true; - } else { - if (data != NULL) { - if (access(tempfile, F_OK) == 0) - append_file(tempfile, data, length); - else - write_file(tempfile, data, length); - rekeyed = true; - } + } else if (data != NULL) { + if (access(tempfile, F_OK) == 0) + append_file(tempfile, data, length); + else + write_file(tempfile, data, length); + rekeyed = true; } } /* If no new keytab data, then leave the keytab as-is. */ - if (rekeyed == false) - sysdie("no rekeyed principals found"); + if (!rekeyed) + sysdie("no rekeyable principals found"); - /* Now merge the original keytab file with the one containing the new. */ - if (access(file, F_OK) == 0) { - - /* If error, first copy the keytab file to filename.old */ - if (error == true) { + /* + * Now merge the original keytab file with the one containing the new + * keys. If there is an error, first make a backup of the current keytab + * file as keytab.old. + */ + if (access(file, F_OK) != 0) + link(tempfile, file); + else { + if (error) { data = read_file(file, &length); backupfile = concat(file, ".old", (char *) 0); overwrite_file(backupfile, data, length); + warn("partial failure to rekey keytab %s, old keyab left in %s", + file, backupfile); + free(backupfile); } merge_keytab(ctx, tempfile, file); - } else { - data = read_file(tempfile, &length); - write_file(file, data, length); } if (unlink(tempfile) < 0) sysdie("unlink of temporary keytab file %s failed", tempfile); free(tempfile); - return 0; + return !error; } diff --git a/client/options.c b/client/options.c new file mode 100644 index 0000000..2f1de70 --- /dev/null +++ b/client/options.c @@ -0,0 +1,71 @@ +/* + * Set default options for wallet clients. + * + * This file provides the functions to set default options from the krb5.conf + * file for both wallet and wallet-rekey. + * + * Written by Russ Allbery + * Copyright 2006, 2007, 2008, 2010 + * Board of Trustees, Leland Stanford Jr. University + * + * See LICENSE for licensing terms. + */ + +#include +#include +#include + +#include + + +/* + * Load a string option from Kerberos appdefaults. This requires an annoying + * workaround because one cannot specify a default value of NULL. + */ +static void +default_string(krb5_context ctx, const char *opt, const char *defval, + char **result) +{ + if (defval == NULL) + defval = ""; + krb5_appdefault_string(ctx, "wallet", NULL, opt, defval, result); + if (*result != NULL && (*result)[0] == '\0') { + free(*result); + *result = NULL; + } +} + + +/* + * Load a number option from Kerberos appdefaults. The native interface + * doesn't support numbers, so we actually read a string and then convert. + */ +static void +default_number(krb5_context ctx, const char *opt, int defval, int *result) +{ + char *tmp = NULL; + + krb5_appdefault_string(ctx, "wallet", NULL, opt, "", &tmp); + if (tmp != NULL && tmp[0] != '\0') + *result = atoi(tmp); + else + *result = defval; + if (tmp != NULL) + free(tmp); +} + + +/* + * Set option defaults and then get krb5.conf configuration, if any, and + * override the defaults. Later, command-line options will override those + * defaults. + */ +void +default_options(krb5_context ctx, struct options *options) +{ + default_string(ctx, "wallet_type", "wallet", &options->type); + default_string(ctx, "wallet_server", WALLET_SERVER, &options->server); + default_string(ctx, "wallet_principal", NULL, &options->principal); + default_number(ctx, "wallet_port", WALLET_PORT, &options->port); + options->user = NULL; +} diff --git a/client/wallet-rekey.c b/client/wallet-rekey.c new file mode 100644 index 0000000..3a9687c --- /dev/null +++ b/client/wallet-rekey.c @@ -0,0 +1,147 @@ +/* + * A specialized wallet client for rekeying a keytab. + * + * Written by Russ Allbery + * and Jon Robertson + * Copyright 2010 Board of Trustees, Leland Stanford Jr. University + * + * See LICENSE for licensing terms. + */ + +#include +#include +#include + +#include +#include + +#include +#include +#include + +/* + * Usage message. Use as a format and pass the port number and default server + * name. + */ +static const char usage_message[] = "\ +Usage: wallet-rekey [options] [ ...]\n\ +\n\ +Options:\n\ + -c Command prefix to use (default: wallet)\n\ + -k Kerberos principal of the server\n\ + -h Display this help\n\ + -p Port of server (default: %d, if zero, remctl default)\n\ + -s Server hostname (default: %s)\n\ + -u Authenticate as before rekeying\n\ + -v Display the version of wallet\n"; + + +/* + * Display the usage message for wallet-rekey. + */ +static void +usage(int status) +{ + fprintf((status == 0) ? stdout : stderr, usage_message, WALLET_PORT, + (WALLET_SERVER == NULL) ? "" : WALLET_SERVER); + exit(status); +} + + +/* + * Main routine. Parse the arguments and then perform the desired operation. + */ +int +main(int argc, char *argv[]) +{ + krb5_context ctx; + krb5_error_code retval; + struct options options; + int option, i; + bool okay = true; + struct remctl *r; + long tmp; + char *end; + + /* Set up logging and identity. */ + message_program_name = "wallet"; + + /* Initialize default configuration. */ + retval = krb5_init_context(&ctx); + if (retval != 0) + die_krb5(ctx, retval, "cannot initialize Kerberos"); + default_options(ctx, &options); + + while ((option = getopt(argc, argv, "c:k:hp:S:s:u:v")) != EOF) { + switch (option) { + case 'c': + options.type = optarg; + break; + case 'k': + options.principal = optarg; + break; + case 'h': + usage(0); + break; + case 'p': + errno = 0; + tmp = strtol(optarg, &end, 10); + if (tmp <= 0 || tmp > 65535 || *end != '\0') + die("invalid port number %s", optarg); + options.port = tmp; + break; + case 's': + options.server = optarg; + break; + case 'u': + options.user = optarg; + break; + case 'v': + printf("%s\n", PACKAGE_STRING); + exit(0); + break; + default: + usage(1); + break; + } + } + argc -= optind; + argv += optind; + + /* + * If no server was set at configure time and none was set on the command + * line or with krb5.conf settings, we can't continue. + */ + if (options.server == NULL) + die("no server specified in krb5.conf or with -s"); + + /* If a user was specified, obtain Kerberos tickets. */ + if (options.user != NULL) + kinit(ctx, options.user); + + /* Open a remctl connection. */ + r = remctl_new(); + if (r == NULL) + sysdie("cannot allocate memory"); + if (!remctl_open(r, options.server, options.port, options.principal)) + die("%s", remctl_error(r)); + + /* + * Rekey all the keytabs given on the command line, or the system keytab + * if none were given. + */ + if (argc == 0) + okay = rekey_keytab(r, ctx, options.type, "/etc/krb5.keytab"); + else { + for (i = 0; i < argc; i++) { + okay = rekey_keytab(r, ctx, options.type, argv[i]); + if (!okay) + break; + } + } + remctl_close(r); + krb5_free_context(ctx); + if (options.user != NULL) + kdestroy(); + exit(okay ? 0 : 1); +} diff --git a/client/wallet.c b/client/wallet.c index d61fc74..dc04dcd 100644 --- a/client/wallet.c +++ b/client/wallet.c @@ -22,30 +22,9 @@ #include /* - * Basic wallet behavior options set either on the command line or via - * krb5.conf. If set via krb5.conf, we allocate memory for the strings, but - * we never free them. + * Usage message. Use as a format and pass the port number and default server + * name. */ -struct options { - char *type; - char *server; - char *principal; - char *user; - int port; -}; - -/* - * Allow defaults to be set for a particular site with configure options if - * people don't want to use krb5.conf for some reason. - */ -#ifndef WALLET_SERVER -# define WALLET_SERVER NULL -#endif -#ifndef WALLET_PORT -# define WALLET_PORT 0 -#endif - -/* Usage message. Use as a format and pass the port number. */ static const char usage_message[] = "\ Usage: wallet [options] [ ...]\n\ wallet [options] acl [ ...]\n\ @@ -58,11 +37,12 @@ Options:\n\ -p Port of server (default: %d, if zero, remctl default)\n\ -S For the get keytab command, srvtab output file\n\ -s Server hostname (default: %s)\n\ + -u Authenticate as before running command\n\ -v Display the version of wallet\n"; /* - * Display the usage message for remctl. + * Display the usage message for wallet. */ static void usage(int status) @@ -73,59 +53,6 @@ usage(int status) } -/* - * Load a string option from Kerberos appdefaults. This requires an annoying - * workaround because one cannot specify a default value of NULL. - */ -static void -default_string(krb5_context ctx, const char *opt, const char *defval, - char **result) -{ - if (defval == NULL) - defval = ""; - krb5_appdefault_string(ctx, "wallet", NULL, opt, defval, result); - if (*result != NULL && (*result)[0] == '\0') { - free(*result); - *result = NULL; - } -} - - -/* - * Load a number option from Kerberos appdefaults. The native interface - * doesn't support numbers, so we actually read a string and then convert. - */ -static void -default_number(krb5_context ctx, const char *opt, int defval, int *result) -{ - char *tmp = NULL; - - krb5_appdefault_string(ctx, "wallet", NULL, opt, "", &tmp); - if (tmp != NULL && tmp[0] != '\0') - *result = atoi(tmp); - else - *result = defval; - if (tmp != NULL) - free(tmp); -} - - -/* - * Set option defaults and then get krb5.conf configuration, if any, and - * override the defaults. Later, command-line options will override those - * defaults. - */ -static void -set_defaults(krb5_context ctx, struct options *options) -{ - default_string(ctx, "wallet_type", "wallet", &options->type); - default_string(ctx, "wallet_server", WALLET_SERVER, &options->server); - default_string(ctx, "wallet_principal", NULL, &options->principal); - default_number(ctx, "wallet_port", WALLET_PORT, &options->port); - options->user = NULL; -} - - /* * Main routine. Parse the arguments and then perform the desired operation. */ @@ -151,7 +78,7 @@ main(int argc, char *argv[]) retval = krb5_init_context(&ctx); if (retval != 0) die_krb5(ctx, retval, "cannot initialize Kerberos"); - set_defaults(ctx, &options); + default_options(ctx, &options); while ((option = getopt(argc, argv, "c:f:k:hp:S:s:u:v")) != EOF) { switch (option) { @@ -194,7 +121,7 @@ main(int argc, char *argv[]) } argc -= optind; argv += optind; - if (argc < 3 && strcmp(argv[0], "rekey") != 0) + if (argc < 3) usage(1); /* -f is only supported for get and store and -S with get keytab. */ -- cgit v1.2.3 From d6a512c1b8663c2ed4d3aeae93f580f66e65a362 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Thu, 29 Jul 2010 15:23:02 -0700 Subject: Add documentation for wallet-rekey --- Makefile.am | 2 +- autogen | 2 + client/wallet-rekey.pod | 165 ++++++++++++++++++++++++++++++++++++++++++++++ tests/docs/pod-spelling-t | 4 +- tests/docs/pod-t | 5 +- 5 files changed, 173 insertions(+), 5 deletions(-) create mode 100644 client/wallet-rekey.pod diff --git a/Makefile.am b/Makefile.am index 10f47d9..0b5593f 100644 --- a/Makefile.am +++ b/Makefile.am @@ -74,7 +74,7 @@ client_wallet_rekey_LDFLAGS = $(REMCTL_LDFLAGS) $(KRB5_LDFLAGS) client_wallet_rekey_LDADD = client/libwallet.a util/libutil.a \ portable/libportable.a $(REMCTL_LIBS) $(KRB5_LIBS) -dist_man_MANS = client/wallet.1 server/keytab-backend.8 \ +dist_man_MANS = client/wallet.1 client/wallet-rekey.1 server/keytab-backend.8 \ server/wallet-admin.8 server/wallet-backend.8 server/wallet-report.8 # A set of flags for warnings. Add -O because gcc won't find some warnings diff --git a/autogen b/autogen index f7c8055..4ed7e23 100755 --- a/autogen +++ b/autogen @@ -11,6 +11,8 @@ rm -rf autom4te.cache version=`grep '^wallet' NEWS | head -1 | cut -d' ' -f2` pod2man --release="$version" --center=wallet client/wallet.pod \ > client/wallet.1 +pod2man --release="$version" --center=wallet client/wallet-rekey.pod \ + > client/wallet-rekey.1 pod2man --release="$version" --center=wallet -s 8 contrib/wallet-summary \ > contrib/wallet-summary.8 pod2man --release="$version" --center=wallet -s 8 server/keytab-backend \ diff --git a/client/wallet-rekey.pod b/client/wallet-rekey.pod new file mode 100644 index 0000000..efe9a0b --- /dev/null +++ b/client/wallet-rekey.pod @@ -0,0 +1,165 @@ +=for stopwords +wallet-rekey rekey rekeying keytab -hv Heimdal remctl remctld PKINIT kinit +appdefaults Allbery + +=head1 NAME + +wallet-rekey - Client for rekeying a Kerberos keytab using wallet + +=head1 SYNOPSIS + +B [B<-hv>] [B<-c> I] [B<-k> I] + [B<-p> I] [B<-s> I] [B<-u> I] [I ...] + +=head1 DESCRIPTION + +B is a specialized client for the wallet system used to +rekey a Kerberos keytab by downloading new keytab objects from wallet for +each principal found in the keytab. For each keytab file listed on the +command line, it walks through the principals in that keytab, finds all +from the local default realm, requests new wallet keytab objects for each +principal (removing the realm when naming the keytab), and merges the new +keys into the keytab. + +If an error occurs before any new keys were downloaded, B +aborts. If some new keys were successfully downloaded, B +warns about errors but continues to rekey all principals that it can. In +this case, a copy of the existing keytab prior to the rekeying is saved in +a file named by appending C<.old> to the file name. + +If no keytab file name is given on the command line, B +attempts to rekey F, the system default keytab file. + +The new keys are merged into the existing keytab file, but old keys are +not removed. This means that, over time, the keytab will grow and +accumulate old keys, which eventually should no longer be honored. +Administrators may want to run: + + kadmin -q 'ktremove -k old' + +for MIT Kerberos, where is the path to the keytab and +is a principal in the keytab (repeating the command for each principal) +or: + + ktutil -k purge + +for Heimdal. This functionality will eventually be provided by +B directly. + +=head1 OPTIONS + +=over 4 + +=item B<-c> I + +The command prefix (remctl type) to use. Normally this is an internal +implementation detail and the default (C) should be fine. It may +sometimes be useful to use a different prefix for testing a different +version of the wallet code on the server. This option can also be set in +F; see L below. + +=item B<-k> I + +The service principal of the wallet server. The default is to use the +C principal for the wallet server. The principal chosen must match +one of the keys in the keytab used by B on the wallet server. +This option can also be set in F; see L below. + +=item B<-h> + +Display a brief summary of options and exit. All other valid options and +commands are ignored. + +=item B<-p> I + +The port to connect to on the wallet server. The default is the default +remctl port. This option can also be set in F; see +L below. + +=item B<-s> I + +The wallet server to connect to. The default may be set when compiling +the wallet client. If it isn't, either B<-s> must be given or the server +must be set in F. See L below. + +=item B<-u> I + +Rather than using the user's existing ticket cache for authentication, +authenticate as I first and use those credentials for +authentication to the wallet server. B will prompt for the +password for I. Non-password authentication methods such as +PKINIT aren't supported; to use those, run B first and use an +existing ticket cache. + +=item B<-v> + +Display the version of the B client and exit. All other valid +options and commands are ignored. + +=back + +=head1 CONFIGURATION + +The wallet system, including B, can optionally be configured +in the system F. It will read the default F file +for the Kerberos libraries with which it was compiled. To set an option, +put the option in the [appdefaults] section. B will look +for options either at the top level of the [appdefaults] section or in a +subsection named C. For example, the following fragment of a +F file would set the default port to 4373 and the default +server to C. + + [appdefaults] + wallet_port = 4373 + wallet = { + wallet_server = wallet.example.org + } + +The supported options are: + +=over 4 + +=item wallet_principal + +The service principal of the wallet server. The default is to use the +C principal for the wallet server. The principal chosen must match +one of the keys in the keytab used by B on the wallet server. +The B<-k> command-line option overrides this setting. + +=item wallet_port + +The port to connect to on the wallet server. The default is the default +remctl port. The B<-p> command-line option overrides this setting. + +=item wallet_server + +The wallet server to connect to. The B<-s> command-line option overrides +this setting. The default may be set when compiling the wallet client. +If it isn't, either B<-s> must be given or this parameter must be present +in in F. + +=item wallet_type + +The command prefix (remctl type) to use. Normally this is an internal +implementation detail and the default (C) should be fine. It may +sometimes be useful to use a different prefix for testing a different +version of the wallet code on the server. The B<-c> command-line option +overrides this setting. + +=back + +=head1 SEE ALSO + +kadmin(8), kinit(1), krb5.conf(5), remctl(1), remctld(8), wallet(1) + +This program is part of the wallet system. The current version is available +from L. + +B uses the remctl protocol. For more information about +remctl, see L. + +=head1 AUTHOR + +Russ Allbery + +=cut diff --git a/tests/docs/pod-spelling-t b/tests/docs/pod-spelling-t index 6993e4c..eaa7dd6 100755 --- a/tests/docs/pod-spelling-t +++ b/tests/docs/pod-spelling-t @@ -47,8 +47,8 @@ my @pod = map { my $pod = "$ENV{SOURCE}/../" . $_; $pod =~ s,[^/.][^/]*/../,,g; $pod; -} qw(client/wallet.pod server/keytab-backend server/wallet-admin - server/wallet-backend server/wallet-report); +} qw(client/wallet.pod client/wallet-rekey.pod server/keytab-backend + server/wallet-admin server/wallet-backend server/wallet-report); plan tests => scalar @pod; # Finally, do the checks. diff --git a/tests/docs/pod-t b/tests/docs/pod-t index f92ba2c..e25ade2 100755 --- a/tests/docs/pod-t +++ b/tests/docs/pod-t @@ -12,8 +12,9 @@ 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 server/wallet-report); +my @files = qw(client/wallet.pod client/wallet-rekey.pod server/keytab-backend + server/wallet-admin server/wallet-backend + server/wallet-report); my $total = scalar (@files); plan tests => $total; for my $file (@files) { -- cgit v1.2.3 From 5017e47ac6feffbbb5cf0d8f2541a7bb044e6255 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Thu, 29 Jul 2010 15:24:22 -0700 Subject: Add spelling exception for Wallet::ACL::Krb5::Regex --- perl/Wallet/ACL/Krb5/Regex.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/perl/Wallet/ACL/Krb5/Regex.pm b/perl/Wallet/ACL/Krb5/Regex.pm index 61a0d04..52f4bf5 100644 --- a/perl/Wallet/ACL/Krb5/Regex.pm +++ b/perl/Wallet/ACL/Krb5/Regex.pm @@ -56,7 +56,7 @@ __END__ ############################################################################## =for stopwords -ACL krb5-regex Allbery +ACL krb5-regex Durkacz Allbery =head1 NAME -- cgit v1.2.3 From 0c72d75380464dca85749b10244969241863ecf6 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Thu, 29 Jul 2010 16:20:46 -0700 Subject: Update client test to work correctly with Heimdal userspace The check for whether we got the right keytab data was not being done on Heimdal since it only knew how to run klist. Add a new ktutil_list function to kerberos.sh that runs klist or ktutil list as appropriate. --- tests/client/basic-t.in | 6 +++--- tests/tap/kerberos.sh | 19 +++++++++++++++++-- 2 files changed, 20 insertions(+), 5 deletions(-) diff --git a/tests/client/basic-t.in b/tests/client/basic-t.in index 86e24d5..11f0bce 100644 --- a/tests/client/basic-t.in +++ b/tests/client/basic-t.in @@ -114,10 +114,10 @@ rm -f srvtab srvtab.bak # Test keytab merging. ok_program 'keytab merging' 0 '' \ "$wallet" -f keytab get keytab service/fake-keytab -(klist -keK keytab 2>&1) | sed '/Keytab name:/d' > klist-seen -(klist -keK data/fake-keytab-merge 2>&1) | sed '/Keytab name:/d' > klist-good +ktutil_list keytab klist-seen +ktutil_list data/fake-keytab-merge klist-good ok '...and the merged keytab is correct' cmp klist-seen klist-good -rm -f keytab klist-seen klist-good +rm -f keytab klist-good klist-seen # Test srvtab download into a merged keytab with an older version. cp data/fake-keytab-old keytab diff --git a/tests/tap/kerberos.sh b/tests/tap/kerberos.sh index da07e66..fbeaaba 100644 --- a/tests/tap/kerberos.sh +++ b/tests/tap/kerberos.sh @@ -1,7 +1,7 @@ -# Shell function library to initialize Kerberos credentials +# Shell function library for Kerberos test support. # # Written by Russ Allbery -# Copyright 2009 Board of Trustees, Leland Stanford Jr. University +# Copyright 2009, 2010 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -46,3 +46,18 @@ kerberos_setup () { kerberos_cleanup () { rm -f "$BUILD/data/test.cache" } + +# List the contents of a keytab with enctypes and keys. This adjusts for the +# difference between MIT Kerberos (which uses klist) and Heimdal (which uses +# ktutil). Be careful to try klist first, since the ktutil on MIT Kerberos +# may just hang. Takes the keytab to list and the file into which to save the +# output, and strips off the header containing the file name. +ktutil_list () { + if klist -keK "$1" > ktutil-tmp 2>/dev/null ; then + : + else + ktutil -k "$1" list --keys > ktutil-tmp < /dev/null 2>/dev/null + fi + sed -e '/Keytab name:/d' -e "/^[^ ]*:/d" ktutil-tmp > "$2" + rm -f ktutil-tmp +} -- cgit v1.2.3 From ad2639b8eae05c620e212fbd01fb34b728a55cc4 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Thu, 29 Jul 2010 17:35:52 -0700 Subject: Rework fake keytab and srvtab so that kvnos increase fake-keytab-old had a higher kvno than fake-keytab, which is going to confuse matters for future tests. Rework them so that kvnos increase. --- tests/data/fake-keytab | Bin 334 -> 334 bytes tests/data/fake-keytab-old | Bin 334 -> 334 bytes tests/data/fake-srvtab | Bin 50 -> 50 bytes 3 files changed, 0 insertions(+), 0 deletions(-) diff --git a/tests/data/fake-keytab b/tests/data/fake-keytab index 714d9b6..6a13fd6 100644 Binary files a/tests/data/fake-keytab and b/tests/data/fake-keytab differ diff --git a/tests/data/fake-keytab-old b/tests/data/fake-keytab-old index 6a13fd6..714d9b6 100644 Binary files a/tests/data/fake-keytab-old and b/tests/data/fake-keytab-old differ diff --git a/tests/data/fake-srvtab b/tests/data/fake-srvtab index f454af2..0b4af6b 100644 Binary files a/tests/data/fake-srvtab and b/tests/data/fake-srvtab differ -- cgit v1.2.3 From 7a1d4f9e4b96362edef29f71e848458d619cce3b Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Thu, 29 Jul 2010 17:36:30 -0700 Subject: Add an initial test for wallet-rekey This confirms basic functionality, but doesn't test more interesting things like rekeying multiple keys in the same keytab or skipping principals that aren't from the local realm. --- .gitignore | 1 + Makefile.am | 4 +-- configure.ac | 1 + tests/TESTS | 1 + tests/client/rekey-t.in | 65 +++++++++++++++++++++++++++++++++++++++++++ tests/data/fake-keytab-merge | Bin 666 -> 698 bytes tests/data/fake-keytab-rekey | Bin 0 -> 698 bytes 7 files changed, 70 insertions(+), 2 deletions(-) create mode 100644 tests/client/rekey-t.in create mode 100644 tests/data/fake-keytab-rekey diff --git a/.gitignore b/.gitignore index 67f4760..576e160 100644 --- a/.gitignore +++ b/.gitignore @@ -20,6 +20,7 @@ /tests/client/basic-t /tests/client/full-t /tests/client/prompt-t +/tests/client/rekey-t /tests/data/.placeholder /tests/data/test.keytab /tests/data/test.password diff --git a/Makefile.am b/Makefile.am index 0b5593f..af5f25f 100644 --- a/Makefile.am +++ b/Makefile.am @@ -39,8 +39,8 @@ EXTRA_DIST = .gitignore LICENSE autogen client/wallet.pod \ tests/data/cmd-fake tests/data/cmd-wrapper tests/data/fake-data \ tests/data/fake-kadmin tests/data/fake-keytab \ tests/data/fake-keytab-2 tests/data/fake-keytab-merge \ - tests/data/fake-keytab-old tests/data/fake-srvtab \ - tests/data/full.conf tests/data/wallet.conf \ + tests/data/fake-keytab-old tests/data/fake-keytab-rekey \ + tests/data/fake-srvtab tests/data/full.conf tests/data/wallet.conf \ tests/docs/pod-spelling-t tests/docs/pod-t tests/server/admin-t \ tests/server/backend-t tests/server/keytab-t tests/server/report-t \ tests/tap/kerberos.sh tests/tap/libtap.sh tests/tap/remctl.sh \ diff --git a/configure.ac b/configure.ac index df97861..9f2d284 100644 --- a/configure.ac +++ b/configure.ac @@ -68,4 +68,5 @@ AC_CONFIG_FILES([Makefile perl/Makefile.PL]) AC_CONFIG_FILES([tests/client/basic-t], [chmod +x tests/client/basic-t]) AC_CONFIG_FILES([tests/client/full-t], [chmod +x tests/client/full-t]) AC_CONFIG_FILES([tests/client/prompt-t], [chmod +x tests/client/prompt-t]) +AC_CONFIG_FILES([tests/client/rekey-t], [chmod +x tests/client/rekey-t]) AC_OUTPUT diff --git a/tests/TESTS b/tests/TESTS index 161941c..54b8190 100644 --- a/tests/TESTS +++ b/tests/TESTS @@ -1,6 +1,7 @@ client/basic client/full client/prompt +client/rekey docs/pod docs/pod-spelling portable/asprintf diff --git a/tests/client/rekey-t.in b/tests/client/rekey-t.in new file mode 100644 index 0000000..9127f6c --- /dev/null +++ b/tests/client/rekey-t.in @@ -0,0 +1,65 @@ +#! /bin/sh +# +# Test suite for the wallet-rekey command-line client. +# +# Written by Russ Allbery +# Copyright 2006, 2007, 2008, 2010 +# Board of Trustees, Leland Stanford Jr. University +# +# See LICENSE for licensing terms. + +# Load the test library. +. "$SOURCE/tap/libtap.sh" +. "$SOURCE/tap/kerberos.sh" +. "$SOURCE/tap/remctl.sh" +cd "$SOURCE" + +# We need a modified krb5.conf file to test wallet configuration settings in +# krb5.conf. Despite the hard-coding of test-k5.stanford.edu, this test isn't +# Stanford-specific; it just matches the files that are distributed with the +# package. +krb5conf= +for p in /etc/krb5.conf /usr/local/etc/krb5.conf data/krb5.conf ; do + if [ -r "$p" ] ; then + krb5conf="$p" + sed -e '/^[ ]*test-k5.stanford.edu =/,/}/d' \ + -e 's/\(default_realm.*=\) .*/\1 test-k5.stanford.edu/' \ + -e 's/^[ ]*wallet_.*//' \ + -e '/^[ ]*wallet[ ]*=[ ]*{/,/}/d' \ + "$p" > ./krb5.conf + KRB5_CONFIG="./krb5.conf" + export KRB5_CONFIG + break + fi +done +if [ -z "$krb5conf" ] ; then + skip_all 'no krb5.conf found, put one in tests/data/krb5.conf' +fi + +# Test setup. +kerberos_setup +if [ $? != 0 ] ; then + rm krb5.conf + skip_all 'Kerberos tests not configured' +elif [ -z '@REMCTLD@' ] ; then + rm krb5.conf + skip_all 'No remctld found' +else + plan 2 +fi +remctld_start '@REMCTLD@' "$SOURCE/data/basic.conf" +wallet="$BUILD/../client/wallet-rekey" + +# Rekeying should result in a merged keytab with both the old and new keys. +cp data/fake-keytab-old keytab +ok_program '' 0 '' \ + "$wallet" -k "$principal" -p 14373 -s localhost -c fake-wallet keytab +ktutil_list keytab klist-seen +ktutil_list data/fake-keytab-rekey klist-good +ok '...and the rekeyed keytab is correct' cmp klist-seen klist-good +rm -f keytab klist-good klist-seen + +# Clean up. +rm -f autocreated krb5.conf +remctld_stop +kerberos_cleanup diff --git a/tests/data/fake-keytab-merge b/tests/data/fake-keytab-merge index 31ddc49..4858eb4 100644 Binary files a/tests/data/fake-keytab-merge and b/tests/data/fake-keytab-merge differ diff --git a/tests/data/fake-keytab-rekey b/tests/data/fake-keytab-rekey new file mode 100644 index 0000000..6c9c7f2 Binary files /dev/null and b/tests/data/fake-keytab-rekey differ -- cgit v1.2.3 From ec13d7d7530d1229a83204293f28684b7d2eac7b Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Thu, 29 Jul 2010 17:39:50 -0700 Subject: Add NEWS and remove TODO for wallet-rekey --- NEWS | 6 ++++++ README | 3 ++- TODO | 5 ----- 3 files changed, 8 insertions(+), 6 deletions(-) diff --git a/NEWS b/NEWS index cd1d633..6202878 100644 --- a/NEWS +++ b/NEWS @@ -2,6 +2,12 @@ wallet 0.12 (unreleased) + New client program wallet-rekey that, given a list of keytabs on the + command line, requests new keytab objects for each principal in the + local realm and then merges the new objects into that keytab. The + current implementation only acquires new keys and doesn't purge any + old keys. + A new ACL type, krb5-regex, is now supported. This ACL type is the same as krb5 except that the identifier is interpreted as a Perl regular expression and matched against the authenticated identity diff --git a/README b/README index ee073f1..03dbc2c 100644 --- a/README +++ b/README @@ -272,4 +272,5 @@ THANKS security models. To Jon Robertson for the refactoring of Wallet::Kadmin, Heimdal support, - and many of the wallet server-side reports. + many of the wallet server-side reports, and the initial wallet-rekey + implementation. diff --git a/TODO b/TODO index 06521cd..20b75fd 100644 --- a/TODO +++ b/TODO @@ -18,11 +18,6 @@ Client: * Add readline support to the wallet client to make it easier to issue multiple commands. - * Add support for rekeying in the wallet client. Need to resolve how to - get a list of principals to rekey and which keytabs to work on. This - possibly should be a separate binary from the regular wallet client - binary. - * Support authenticating with a keytab. * Allow store data to contain nuls. Requires rewriting the command -- cgit v1.2.3 From 81b7ba2a6503b4bc7199d78adf97d956b1e932a5 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Thu, 29 Jul 2010 19:20:46 -0700 Subject: Fix wallet-rekey with foreign realm keytab entries The loop handling finding principals to rekey was not correctly coping with principals from foreign realms. --- client/keytab.c | 4 ++-- tests/data/fake-keytab-old | Bin 334 -> 785 bytes tests/data/fake-keytab-rekey | Bin 698 -> 1149 bytes 3 files changed, 2 insertions(+), 2 deletions(-) diff --git a/client/keytab.c b/client/keytab.c index 41baa73..e00c2dd 100644 --- a/client/keytab.c +++ b/client/keytab.c @@ -51,7 +51,7 @@ keytab_principals(krb5_context ctx, const char *file, char *realm) while ((status = krb5_kt_next_entry(ctx, keytab, &entry, &cursor)) == 0) { status = krb5_unparse_name(ctx, entry.principal, &princname); if (status != 0) - sysdie("error, cannot unparse name for a principal"); + die_krb5(ctx, status, "cannot unparse name for a principal"); /* Separate into principal and realm. */ princrealm = strchr(princname, '@'); @@ -60,7 +60,7 @@ keytab_principals(krb5_context ctx, const char *file, char *realm) princrealm++; } if (princrealm == NULL || strcmp(princrealm, realm) != 0) - break; + continue; /* Check to see if the principal has already been listed. */ found = false; diff --git a/tests/data/fake-keytab-old b/tests/data/fake-keytab-old index 714d9b6..f7ee9c0 100644 Binary files a/tests/data/fake-keytab-old and b/tests/data/fake-keytab-old differ diff --git a/tests/data/fake-keytab-rekey b/tests/data/fake-keytab-rekey index 6c9c7f2..4e7a507 100644 Binary files a/tests/data/fake-keytab-rekey and b/tests/data/fake-keytab-rekey differ -- cgit v1.2.3 From dacc1c6b8e8d4bdd1daffb84efd58f16e45e3cba Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Thu, 29 Jul 2010 19:25:17 -0700 Subject: Abort rekeying if we fail on the first principal If we get a failure to rekey a principal before we've succeeded with any principal, abort rather than continuing. --- client/keytab.c | 2 ++ 1 file changed, 2 insertions(+) diff --git a/client/keytab.c b/client/keytab.c index e00c2dd..16a94f3 100644 --- a/client/keytab.c +++ b/client/keytab.c @@ -227,6 +227,8 @@ rekey_keytab(struct remctl *r, krb5_context ctx, const char *type, status = download_keytab(r, type, current->princ, &data, &length); if (status != 0) { warn("error rekeying for principal %s", current->princ); + if (!rekeyed) + die("aborting, keytab unchanged"); error = true; } else if (data != NULL) { if (access(tempfile, F_OK) == 0) -- cgit v1.2.3 From 1a57d2409a43623cd1396bff6b22f815dbc9e799 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Fri, 13 Aug 2010 17:46:36 -0700 Subject: Use die instead of sysdie for no rekeyable principals In wallet-rekey, if the keytab we're supposed to rekey has no rekeyable principals, die rather than sysdie since there's no errno error to report. --- client/keytab.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/client/keytab.c b/client/keytab.c index 16a94f3..76c30f7 100644 --- a/client/keytab.c +++ b/client/keytab.c @@ -241,7 +241,7 @@ rekey_keytab(struct remctl *r, krb5_context ctx, const char *type, /* If no new keytab data, then leave the keytab as-is. */ if (!rekeyed) - sysdie("no rekeyable principals found"); + die("no rekeyable principals found"); /* * Now merge the original keytab file with the one containing the new -- cgit v1.2.3 From a0432d103c690119255cbf7d612531d4af616efb Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Fri, 13 Aug 2010 18:32:00 -0700 Subject: Various minor fixes for wallet-rekey Rekey the keytab in the same principal order as what's stored in the keytab rather than reversing it, since that makes it easier to test. Suppress the error message about no data from the server if the server sent an error. Fix some coding style and spelling errors. --- client/keytab.c | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/client/keytab.c b/client/keytab.c index 76c30f7..9a7734e 100644 --- a/client/keytab.c +++ b/client/keytab.c @@ -22,7 +22,7 @@ /* List of principals we have already encountered. */ struct principal_name { char *princ; - struct principal_name* next; + struct principal_name *next; }; @@ -39,7 +39,7 @@ keytab_principals(krb5_context ctx, const char *file, char *realm) krb5_kt_cursor cursor; krb5_keytab_entry entry; krb5_error_code status; - struct principal_name *names = NULL, *current = NULL; + struct principal_name *names = NULL, *current = NULL, *last = NULL; memset(&entry, 0, sizeof(entry)); status = krb5_kt_resolve(ctx, file, &keytab); @@ -69,12 +69,16 @@ keytab_principals(krb5_context ctx, const char *file, char *realm) found = true; break; } + last = current; } if (found == false) { current = xmalloc(sizeof(struct principal_name)); current->princ = xstrdup(princname); - current->next = names; - names = current; + current->next = NULL; + if (last == NULL) + names = current; + else + last->next = current; } krb5_kt_free_entry(ctx, &entry); free(princname); @@ -148,7 +152,7 @@ download_keytab(struct remctl *r, const char *type, const char *name, command[3] = name; command[4] = NULL; status = run_command(r, command, data, length); - if (*data == NULL) { + if (*data == NULL && status == 0) { warn("no data returned by wallet server"); return 255; } @@ -255,7 +259,7 @@ rekey_keytab(struct remctl *r, krb5_context ctx, const char *type, data = read_file(file, &length); backupfile = concat(file, ".old", (char *) 0); overwrite_file(backupfile, data, length); - warn("partial failure to rekey keytab %s, old keyab left in %s", + warn("partial failure to rekey keytab %s, old keytab left in %s", file, backupfile); free(backupfile); } -- cgit v1.2.3 From e19f404c76b13507f982cdd0bad7c483d6a7d3cc Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Fri, 13 Aug 2010 18:32:56 -0700 Subject: Flesh out the wallet-rekey test suite Test partial rekeying, aboring due to failure to rekey, and skipping a keytab because all principals were foreign. --- tests/client/rekey-t.in | 39 ++++++++++++++++++++++++++++++++-- tests/data/fake-keytab-foreign | Bin 0 -> 453 bytes tests/data/fake-keytab-partial | Bin 0 -> 1149 bytes tests/data/fake-keytab-partial-result | Bin 0 -> 1513 bytes tests/data/fake-keytab-unknown | Bin 0 -> 334 bytes 5 files changed, 37 insertions(+), 2 deletions(-) create mode 100644 tests/data/fake-keytab-foreign create mode 100644 tests/data/fake-keytab-partial create mode 100644 tests/data/fake-keytab-partial-result create mode 100644 tests/data/fake-keytab-unknown diff --git a/tests/client/rekey-t.in b/tests/client/rekey-t.in index 9127f6c..390a362 100644 --- a/tests/client/rekey-t.in +++ b/tests/client/rekey-t.in @@ -45,20 +45,55 @@ elif [ -z '@REMCTLD@' ] ; then rm krb5.conf skip_all 'No remctld found' else - plan 2 + plan 9 fi remctld_start '@REMCTLD@' "$SOURCE/data/basic.conf" wallet="$BUILD/../client/wallet-rekey" # Rekeying should result in a merged keytab with both the old and new keys. cp data/fake-keytab-old keytab -ok_program '' 0 '' \ +ok_program 'basic wallet-rekey' 0 '' \ "$wallet" -k "$principal" -p 14373 -s localhost -c fake-wallet keytab ktutil_list keytab klist-seen ktutil_list data/fake-keytab-rekey klist-good ok '...and the rekeyed keytab is correct' cmp klist-seen klist-good rm -f keytab klist-good klist-seen +# Rekeying a keytab that contains no principals in the local domain should +# produce an error message and do nothing. +cp data/fake-keytab-foreign keytab +ok_program 'foreign wallet-rekey' 1 'wallet: no rekeyable principals found' \ + "$wallet" -k "$principal" -p 14373 -s localhost -c fake-wallet keytab +ok '...and the keytab was untouched' cmp keytab data/fake-keytab-foreign +rm -f keytab + +# Rekeying a keytab where we can't retrieve the principal should produce an +# error message and abort when it's the first principal. +cp data/fake-keytab-unknown keytab +ok_program 'unknown wallet-rekey' 1 \ +'wallet: Unknown keytab service/real-keytab +wallet: error rekeying for principal service/real-keytab +wallet: aborting, keytab unchanged' \ + "$wallet" -k "$principal" -p 14373 -s localhost -c fake-wallet keytab +ok '...and the keytab was untouched' cmp keytab data/fake-keytab-unknown +rm -f keytab + +# Rekeying a keytab where we can't retrieve a later principal should leave the +# original keytab as keytab.old and store, in the new keytab, only the things +# that it was able to rekey. +cp data/fake-keytab-partial keytab +ok_program 'partial wallet-rekey' 1 \ +'wallet: Unknown keytab service/real-keytab +wallet: error rekeying for principal service/real-keytab +wallet: partial failure to rekey keytab keytab, old keytab left in keytab.old'\ + "$wallet" -k "$principal" -p 14373 -s localhost -c fake-wallet keytab +ktutil_list keytab klist-seen +ktutil_list data/fake-keytab-partial-result klist-good +ok '...and the rekeyed keytab is correct' cmp klist-seen klist-good +ok '...and the backup keytab is correct' \ + cmp keytab.old data/fake-keytab-partial +rm -f keytab keytab.old klist-seen klist-good + # Clean up. rm -f autocreated krb5.conf remctld_stop diff --git a/tests/data/fake-keytab-foreign b/tests/data/fake-keytab-foreign new file mode 100644 index 0000000..efbc5ed Binary files /dev/null and b/tests/data/fake-keytab-foreign differ diff --git a/tests/data/fake-keytab-partial b/tests/data/fake-keytab-partial new file mode 100644 index 0000000..86587aa Binary files /dev/null and b/tests/data/fake-keytab-partial differ diff --git a/tests/data/fake-keytab-partial-result b/tests/data/fake-keytab-partial-result new file mode 100644 index 0000000..a265ccc Binary files /dev/null and b/tests/data/fake-keytab-partial-result differ diff --git a/tests/data/fake-keytab-unknown b/tests/data/fake-keytab-unknown new file mode 100644 index 0000000..0827e74 Binary files /dev/null and b/tests/data/fake-keytab-unknown differ -- cgit v1.2.3 From 5623ed1520cc916df9c62e137656670c160c7fbb Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Mon, 16 Aug 2010 21:01:03 -0700 Subject: Fix wallet-summary leading comment and module inclusion This script now uses Wallet::Report, not Wallet::Admin. --- contrib/wallet-summary | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/contrib/wallet-summary b/contrib/wallet-summary index 7a51f9e..b782a97 100755 --- a/contrib/wallet-summary +++ b/contrib/wallet-summary @@ -1,6 +1,6 @@ #!/usr/bin/perl -w # -# wallet-summarize -- Summarize keytabs in the wallet database. +# wallet-summary -- Summarize keytabs in the wallet database. # # Written by Russ Allbery # Copyright 2003, 2008, 2010 Board of Trustees, Leland Stanford Jr. University @@ -45,7 +45,7 @@ use vars qw($ADDRESS $DUMPFILE @PATTERNS $REPORTS); use Getopt::Long qw(GetOptions); use File::Path qw(mkpath); use POSIX qw(strftime); -use Wallet::Admin (); +use Wallet::Report (); ############################################################################## # Database queries -- cgit v1.2.3 From 3799716680711302580b698f6d7c5796df8444b2 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Mon, 16 Aug 2010 21:01:25 -0700 Subject: First cut at wallet contrib script to find keytabs for unknown hosts --- contrib/wallet-unknown-hosts | 116 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 116 insertions(+) create mode 100755 contrib/wallet-unknown-hosts diff --git a/contrib/wallet-unknown-hosts b/contrib/wallet-unknown-hosts new file mode 100755 index 0000000..3f94cbe --- /dev/null +++ b/contrib/wallet-unknown-hosts @@ -0,0 +1,116 @@ +#!/usr/bin/perl -w +# +# wallet-unknown-hosts -- Report host keytabs in wallet for unknown hosts. +# +# Written by Russ Allbery +# Copyright 2010 Board of Trustees, Leland Stanford Jr. University +# +# See LICENSE for licensing terms. + +############################################################################## +# Site configuration +############################################################################## + +# The path to the supplemental database used to store last seen times and +# counts. Keys are hostnames, and values are the number of times the hostname +# was not seen in DNS, a comma, and the UNIX seconds since epoch of the first +# run during which the host was not found. +# +# This should probably be in the wallet database, but let's try it here first +# and hammer out the data and then add it there later. +our $HISTORY = '/var/lib/wallet/hosts.db'; + +# Set up a Net::DNS resolver that will be used by local_check_keytab. +BEGIN { + use Net::DNS; + our $DNS = Net::DNS::Resolver->new; +} + +# Pre-filter. This is called for all host-based keytabs and is the place to +# apply local exceptions for keytabs that should be retained even though +# there's no corresponding DNS entry. The first argument is the full +# principal name and the second argument is the extracted host. +# +# This function should return 1 if the host is found or if the keytab should +# otherwise not be a candidate for purging, 0 if the keytab should be a +# candidate for purging, and undef if the normal DNS-based check should be +# done. +sub local_check_keytab { + my ($keytab, $host) = @_; + + # Aliases of proxy.best.stanford.edu and www.best.stanford.edu should not + # have host-based keytabs of their own. + my %purge = map { $_ => 1 } + qw(proxy.best.stanford.edu www.best.stanford.edu); + my $query = $DNS->search ($host); + return unless $query; + for my $rr ($query->answer) { + next unless $rr->type eq 'CNAME'; + return 0 if $purge{$rr->cname}; + } + + # Do normal processing by default. + return; +} + +############################################################################## +# Modules and declarations +############################################################################## + +require 5.006; + +use strict; + +use DB_File (); +use Wallet::Report (); + +############################################################################## +# Database queries +############################################################################## + +# Return a list of host-based keytab objects in the wallet database. The +# current heuristic is to look for any keytab object with a principal name +# that includes a slash and at least one period. This may be refined later. +sub list_keytabs { + my $report = Wallet::Report->new; + my @objects = $report->objects ('type', 'keytab'); + if (!@objects and $report->error) { + die $report->error, "\n"; + } + return grep { m%/.+\..+% } map { $$_[1] } @objects; +} + +############################################################################## +# DNS queries +############################################################################## + +# Given a host, look it up in DNS and see if it exists. Returns true if the +# host exists and false otherwise. +sub check_host { + my ($host) = @_; + my $addr = gethostbyname $host; + return defined ($addr) ? 1 : 0; +} + +############################################################################## +# Main routine +############################################################################## + +tie %history, 'DB_File', $HISTORY; +my @keytabs = list_keytabs; +for my $keytab (@keytabs) { + my ($host) = (split '/', $keytab)[1]; + my $result = local_check_keytab ($keytab, $host); + unless (defined $result) { + $result = check_host ($host); + } + if ($result) { + delete $history{$keytab}; + } elsif ($history{$keytab}) { + my ($count, $time) = split (',', $history{$keytab}); + $count++; + $history{$keytab} = "$count,$time"; + } else { + $history{$keytab} = '1,' . time; + } +} -- cgit v1.2.3 From 107448a9c7eb1e1fbe93e58221f67ae047baed56 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Wed, 18 Aug 2010 23:28:29 -0700 Subject: Add reporting and purge functions to wallet-unknown-hosts Add the report of purge-eligible keytabs and the command to do the purge. The command-line parsing still needs work. --- contrib/wallet-unknown-hosts | 107 +++++++++++++++++++++++++++++++++++-------- 1 file changed, 87 insertions(+), 20 deletions(-) diff --git a/contrib/wallet-unknown-hosts b/contrib/wallet-unknown-hosts index 3f94cbe..5655aed 100755 --- a/contrib/wallet-unknown-hosts +++ b/contrib/wallet-unknown-hosts @@ -20,6 +20,12 @@ # and hammer out the data and then add it there later. our $HISTORY = '/var/lib/wallet/hosts.db'; +# Default thresholds for reporting or purging. $MIN is the number of times we +# see the keytab in a row eligible for purge, and $THRESHOLD is the newest +# that the first time can be and still be eligible. +our $MIN = 3; +our $THRESHOLD = time - 30 * 24 * 60 * 60; + # Set up a Net::DNS resolver that will be used by local_check_keytab. BEGIN { use Net::DNS; @@ -65,7 +71,7 @@ use DB_File (); use Wallet::Report (); ############################################################################## -# Database queries +# Utility functions ############################################################################## # Return a list of host-based keytab objects in the wallet database. The @@ -80,10 +86,6 @@ sub list_keytabs { return grep { m%/.+\..+% } map { $$_[1] } @objects; } -############################################################################## -# DNS queries -############################################################################## - # Given a host, look it up in DNS and see if it exists. Returns true if the # host exists and false otherwise. sub check_host { @@ -93,24 +95,89 @@ sub check_host { } ############################################################################## -# Main routine +# Main functions ############################################################################## -tie %history, 'DB_File', $HISTORY; -my @keytabs = list_keytabs; -for my $keytab (@keytabs) { - my ($host) = (split '/', $keytab)[1]; - my $result = local_check_keytab ($keytab, $host); - unless (defined $result) { - $result = check_host ($host); +# Do a scan of all host-based keytabs in wallet and record those that are not +# found in DNS or which should not be used according to site configuration. +sub check { + tie %history, 'DB_File', $HISTORY; + my @keytabs = list_keytabs; + for my $keytab (@keytabs) { + my ($host) = (split '/', $keytab)[1]; + my $result = local_check_keytab ($keytab, $host); + unless (defined $result) { + $result = check_host ($host); + } + if ($result) { + delete $history{$keytab}; + } elsif ($history{$keytab}) { + my ($count, $time) = split (',', $history{$keytab}); + $count++; + $history{$keytab} = "$count,$time"; + } else { + $history{$keytab} = '1,' . time; + } } - if ($result) { - delete $history{$keytab}; - } elsif ($history{$keytab}) { + untie %history; +} + +# Report on all keytabs that are eligible to be deleted. Takes two values: +# the threshold for the number of times the keytab had to show up as eligible +# for purge, and the threshold for how long the keytab must have been on that +# list (given as a threshold time in seconds since epoch). +sub report { + my ($min, $threshold) = @_; + tie %history, 'DB_File', $HISTORY; + for my $keytab (sort keys %history) { my ($count, $time) = split (',', $history{$keytab}); - $count++; - $history{$keytab} = "$count,$time"; - } else { - $history{$keytab} = '1,' . time; + if ($count > $min && $time < $threshold) { + print $keytab, "\n"; + } } + untie %history; +} + +# Purge eligible keytabs. Takes three values: the user to authenticate as, +# the threshold for the number of times the keytab had to show up as eligible +# for purge, and the threshold for the first date when the keytab was seen +# eligible for purge. Rather than listing the keytabs, this deletes them +# immediately. +sub purge { + my ($user, $min, $threshold) = @_; + my $wallet = Wallet::Server->new ($user, 'localhost'); + tie %history, 'DB_File', $HISTORY; + for my $keytab (sort keys %history) { + my ($count, $time) = split (',', $history{$keytab}); + if ($count > $min && $time < $threshold) { + unless ($wallet->destroy ('keytab', $keytab)) { + warn "$0: cannot destroy keytab $keytab: ", + $wallet->error, "\n"; + } + } + } + untie %history; +} + +############################################################################## +# Main routine +############################################################################## + +my $command = shift or die "Usage: $0 (check | report | purge)\n"; +if ($command eq 'check') { + check; +} elsif ($command eq 'report') { + my ($min, $threshold) = @_; + $min = $MIN unless defined ($min); + die "$0: minimum count must be at least 1\n" if $min < 1; + $threshold = $THRESHOLD unless defined ($threshold); + report ($min, $threshold); +} elsif ($command eq 'purge') { + my $user = $ENV{REMOTE_USER} or die "$0: REMOTE_USER must be set\n"; + $min = $MIN unless defined ($min); + die "$0: minimum count must be at least 1\n" if $min < 1; + $threshold = $THRESHOLD unless defined ($threshold); + purge ($min, $threshold); +} else { + die "$0: unknown command $command\n"; } -- cgit v1.2.3 From 32dc393016f0b6241dbf8d405638e18a33bb9b62 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Wed, 18 Aug 2010 23:28:29 -0700 Subject: wallet-unknown-hosts now uses Wallet::Server --- contrib/wallet-unknown-hosts | 1 + 1 file changed, 1 insertion(+) diff --git a/contrib/wallet-unknown-hosts b/contrib/wallet-unknown-hosts index 5655aed..fec0956 100755 --- a/contrib/wallet-unknown-hosts +++ b/contrib/wallet-unknown-hosts @@ -69,6 +69,7 @@ use strict; use DB_File (); use Wallet::Report (); +use Wallet::Server (); ############################################################################## # Utility functions -- cgit v1.2.3 From 468ded4c2fae05a815bef91bdcb17d52f9cdcb2b Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Wed, 25 Aug 2010 15:08:05 -0700 Subject: Update to rra-c-util 2.6 and C TAP Harness 1.5 Update to C TAP Harness 1.5: * Better reporting of fatal errors in the test suite. * Summarize results at the end of test execution. * Add tests/HOWTO from docs/writing-tests in C TAP Harness. Update to rra-c-util 2.6: * Fix portability to bundled Heimdal on OpenBSD. * Improve checking for krb5_kt_free_entry with older MIT Kerberos. * Fix portability for missing krb5_get_init_creds_opt_free. * Fix header guard for util/xwrite.h. * Restore default compiler configuration after GSS-API library probe. --- NEWS | 14 ++ configure.ac | 4 +- m4/gssapi.m4 | 3 +- m4/krb5.m4 | 39 +++-- m4/remctl.m4 | 2 +- portable/krb5-extra.c | 3 +- portable/krb5.h | 31 +++- tests/portable/snprintf-t.c | 12 +- tests/runtests.c | 403 +++++++++++++++++++++++++++++--------------- tests/tap/basic.c | 196 +++++++++++++++++---- tests/tap/basic.h | 41 ++++- tests/tap/kerberos.c | 31 +--- tests/tap/kerberos.sh | 17 +- tests/tap/libtap.sh | 32 +++- tests/tap/remctl.sh | 18 +- tests/util/messages-t.c | 4 +- tests/util/xmalloc.c | 5 +- util/macros.h | 1 - util/messages.c | 50 +++--- util/messages.h | 26 +-- 20 files changed, 631 insertions(+), 301 deletions(-) diff --git a/NEWS b/NEWS index 6202878..f4e7abb 100644 --- a/NEWS +++ b/NEWS @@ -23,6 +23,20 @@ wallet 0.12 (unreleased) Add a help command to wallet-report, which returns a summary of all available commands. + Update to C TAP Harness 1.5: + + * Better reporting of fatal errors in the test suite. + * Summarize results at the end of test execution. + * Add tests/HOWTO from docs/writing-tests in C TAP Harness. + + Update to rra-c-util 2.6: + + * Fix portability to bundled Heimdal on OpenBSD. + * Improve checking for krb5_kt_free_entry with older MIT Kerberos. + * Fix portability for missing krb5_get_init_creds_opt_free. + * Fix header guard for util/xwrite.h. + * Restore default compiler configuration after GSS-API library probe. + wallet 0.11 (2010-03-08) When deleting an ACL on the server, verify that the ACL is not diff --git a/configure.ac b/configure.ac index 9f2d284..137e6ef 100644 --- a/configure.ac +++ b/configure.ac @@ -27,8 +27,10 @@ RRA_LIB_KRB5 RRA_LIB_KRB5_SWITCH AC_CHECK_FUNCS([krb5_get_init_creds_opt_alloc \ krb5_get_init_creds_opt_set_default_flags \ - krb5_kt_free_entry \ krb5_principal_get_realm]) +AC_CHECK_FUNCS([krb5_get_init_creds_opt_free], + [RRA_FUNC_KRB5_GET_INIT_CREDS_OPT_FREE_ARGS]) +AC_CHECK_DECLS([krb5_kt_free_entry]) AC_CHECK_MEMBERS([krb5_keytab_entry.keyblock], , , [#include ]) RRA_LIB_KRB5_RESTORE diff --git a/m4/gssapi.m4 b/m4/gssapi.m4 index 4b08569..0a657ff 100644 --- a/m4/gssapi.m4 +++ b/m4/gssapi.m4 @@ -57,7 +57,8 @@ AC_DEFUN([_RRA_LIB_GSSAPI_REDUCED], AC_CHECK_LIB([gssapi_krb5], [gss_import_name], [GSSAPI_LIBS="-lgssapi_krb5"], [AC_CHECK_LIB([gssapi], [gss_import_name], [GSSAPI_LIBS="-lgssapi"], [AC_CHECK_LIB([gss], [gss_import_name], [GSSAPI_LIBS="-lgss"], - [AC_MSG_ERROR([cannot find usable GSS-API library])])])])]) + [AC_MSG_ERROR([cannot find usable GSS-API library])])])]) + RRA_LIB_GSSAPI_RESTORE]) dnl Does the appropriate library checks for GSS-API linkage when we don't dnl have krb5-config or reduced dependencies. libgss is used as a last diff --git a/m4/krb5.m4 b/m4/krb5.m4 index bba9694..38a050e 100644 --- a/m4/krb5.m4 +++ b/m4/krb5.m4 @@ -2,7 +2,7 @@ dnl Find the compiler and linker flags for Kerberos v5. dnl dnl Finds the compiler and linker flags for linking with Kerberos v5 dnl libraries. Provides the --with-krb5, --with-krb5-include, and -dnl --with-krb5-lib configure options to specify non-standards paths to the +dnl --with-krb5-lib configure options to specify non-standard paths to the dnl Kerberos libraries. Uses krb5-config where available unless reduced dnl dependencies is requested. dnl @@ -13,6 +13,9 @@ dnl Kerberos libraries, saving the current values first, and dnl RRA_LIB_KRB5_RESTORE to restore those settings to before the last dnl RRA_LIB_KRB5_SWITCH. dnl +dnl If KRB5_CPPFLAGS, KRB5_LDFLAGS, or KRB5_LIBS are set before calling these +dnl macros, their values will be added to whatever the macros discover. +dnl dnl Provides the RRA_LIB_KRB5_OPTIONAL macro, which should be used if Kerberos dnl support is optional. This macro will still always set the substitution dnl variables, but they'll be empty unless --with-krb5 is given. Also, @@ -25,8 +28,12 @@ dnl change library ordering in that case. dnl dnl Depends on RRA_ENABLE_REDUCED_DEPENDS and RRA_SET_LDFLAGS. dnl +dnl Also provides RRA_FUNC_KRB5_GET_INIT_CREDS_OPT_FREE_ARGS, which checks +dnl whether krb5_get_init_creds_opt_free takes one argument or two. Defines +dnl HAVE_KRB5_GET_INIT_CREDS_OPT_FREE_2_ARGS if it takes two arguments. +dnl dnl Written by Russ Allbery -dnl Copyright 2005, 2006, 2007, 2008, 2009 +dnl Copyright 2005, 2006, 2007, 2008, 2009, 2010 dnl Board of Trustees, Leland Stanford Jr. University dnl dnl See LICENSE for licensing terms. @@ -99,10 +106,11 @@ AC_DEFUN([_RRA_LIB_KRB5_MANUAL], [AC_CHECK_LIB([nsl], [socket], [LIBS="-lnsl -lsocket $LIBS"], , [-lsocket])]) AC_SEARCH_LIBS([crypt], [crypt]) + AC_SEARCH_LIBS([rk_simple_execve], [roken]) rra_krb5_extra="$LIBS" LIBS="$rra_krb5_save_LIBS" AC_CHECK_LIB([krb5], [krb5_init_context], - [KRB5_LIBS="-lkrb5 -lasn1 -lroken -lcrypto -lcom_err $rra_krb5_extra"], + [KRB5_LIBS="-lkrb5 -lasn1 -lcom_err -lcrypto $rra_krb5_extra"], [AC_CHECK_LIB([krb5support], [krb5int_getspecific], [rra_krb5_extra="-lkrb5support $rra_krb5_extra"], [AC_CHECK_LIB([pthreads], [pthread_setspecific], @@ -125,7 +133,7 @@ AC_DEFUN([_RRA_LIB_KRB5_MANUAL], [AS_IF([test x"$1" = xtrue], [AC_MSG_ERROR([cannot find usable Kerberos v5 library])])], [$rra_krb5_extra])], - [-lasn1 -lroken -lcrypto -lcom_err $rra_krb5_extra]) + [-lasn1 -lcom_err -lcrypto $rra_krb5_extra]) LIBS="$KRB5_LIBS $LIBS" AC_CHECK_FUNCS([krb5_get_error_message], [AC_CHECK_FUNCS([krb5_free_error_message])], @@ -200,9 +208,6 @@ AC_DEFUN([RRA_LIB_KRB5], [rra_krb5_root= rra_krb5_libdir= rra_krb5_includedir= - KRB5_CPPFLAGS= - KRB5_LDFLAGS= - KRB5_LIBS= AC_SUBST([KRB5_CPPFLAGS]) AC_SUBST([KRB5_LDFLAGS]) AC_SUBST([KRB5_LIBS]) @@ -230,9 +235,6 @@ AC_DEFUN([RRA_LIB_KRB5_OPTIONAL], rra_krb5_libdir= rra_krb5_includedir= rra_use_kerberos= - KRB5_CPPFLAGS= - KRB5_LDFLAGS= - KRB5_LIBS= AC_SUBST([KRB5_CPPFLAGS]) AC_SUBST([KRB5_LDFLAGS]) AC_SUBST([KRB5_LIBS]) @@ -261,3 +263,20 @@ AC_DEFUN([RRA_LIB_KRB5_OPTIONAL], [_RRA_LIB_KRB5_INTERNAL([false])])]) AS_IF([test x"$KRB5_LIBS" != x], [AC_DEFINE([HAVE_KERBEROS], 1, [Define to enable Kerberos features.])])]) + +dnl Check whether krb5_get_init_creds_opt_free takes one argument or two. +dnl Early Heimdal used to take a single argument. Defines +dnl HAVE_KRB5_GET_INIT_CREDS_OPT_FREE_2_ARGS if it takes two arguments. +dnl +dnl Should be called with RRA_LIB_KRB5_SWITCH active. +AC_DEFUN([RRA_FUNC_KRB5_GET_INIT_CREDS_OPT_FREE_ARGS], +[AC_CACHE_CHECK([if krb5_get_init_creds_opt_free takes two arguments], + [rra_cv_func_krb5_get_init_creds_opt_free_args], + [AC_TRY_COMPILE([#include ], + [krb5_get_init_creds_opt *opts; krb5_context c; + krb5_get_init_creds_opt_free(c, opts);], + [rra_cv_func_krb5_get_init_creds_opt_free_args=yes], + [rra_cv_func_krb5_get_init_creds_opt_free_args=no])]) + AS_IF([test $rra_cv_func_krb5_get_init_creds_opt_free_args = yes], + [AC_DEFINE([HAVE_KRB5_GET_INIT_CREDS_OPT_FREE_2_ARGS], 1, + [Define if krb5_get_init_creds_opt_free takes two arguments.])])]) diff --git a/m4/remctl.m4 b/m4/remctl.m4 index 8ee3c16..bb3a56f 100644 --- a/m4/remctl.m4 +++ b/m4/remctl.m4 @@ -21,7 +21,7 @@ dnl dnl See LICENSE for licensing terms. dnl Save the current CPPFLAGS, LDFLAGS, and LIBS settings and switch to -dnl versions that include the Kerberos v5 flags. Used as a wrapper, with +dnl versions that include the remctl flags. Used as a wrapper, with dnl RRA_LIB_REMCTL_RESTORE, around tests. AC_DEFUN([RRA_LIB_REMCTL_SWITCH], [rra_remctl_save_CPPFLAGS="$CPPFLAGS" diff --git a/portable/krb5-extra.c b/portable/krb5-extra.c index dcddbe4..89ccbde 100644 --- a/portable/krb5-extra.c +++ b/portable/krb5-extra.c @@ -97,7 +97,8 @@ krb5_free_error_message(krb5_context ctx UNUSED, const char *msg) * assumes that an all-zero bit pattern will create a NULL pointer. */ krb5_error_code -krb5_get_init_creds_opt_alloc(krb5_context ctx, krb5_get_init_creds_opt **opts) +krb5_get_init_creds_opt_alloc(krb5_context ctx UNUSED, + krb5_get_init_creds_opt **opts) { *opts = calloc(1, sizeof(krb5_get_init_creds_opt)); if (*opts == NULL) diff --git a/portable/krb5.h b/portable/krb5.h index d9ef283..3b5700b 100644 --- a/portable/krb5.h +++ b/portable/krb5.h @@ -23,10 +23,17 @@ #ifndef PORTABLE_KRB5_H #define PORTABLE_KRB5_H 1 -#include +/* + * Allow inclusion of config.h to be skipped, since sometimes we have to use a + * stripped-down version of config.h with a different name. + */ +#ifndef CONFIG_H_INCLUDED +# include +#endif #include #include +#include BEGIN_DECLS @@ -50,27 +57,39 @@ void krb5_free_error_message(krb5_context, const char *); #endif /* - * Both current MIT and current Heimdal prefer _opt_alloc, but older versions - * of both require allocating your own struct and calling _opt_init. + * Both current MIT and current Heimdal prefer _opt_alloc and _opt_free, but + * older versions of both require allocating your own struct and calling + * _opt_init. */ #ifndef HAVE_KRB5_GET_INIT_CREDS_OPT_ALLOC krb5_error_code krb5_get_init_creds_opt_alloc(krb5_context, krb5_get_init_creds_opt **); #endif +#ifdef HAVE_KRB5_GET_INIT_CREDS_OPT_FREE +# ifndef HAVE_KRB5_GET_INIT_CREDS_OPT_FREE_2_ARGS +# define krb5_get_init_creds_opt_free(c, o) krb5_get_init_creds_opt_free(o) +# endif +#else +# define krb5_get_init_creds_opt_free(c, o) free(o) +#endif /* Heimdal-specific. */ #ifndef HAVE_KRB5_GET_INIT_CREDS_OPT_SET_DEFAULT_FLAGS #define krb5_get_init_creds_opt_set_default_flags(c, p, r, o) /* empty */ #endif -/* Heimdal: krb5_kt_free_entry, MIT: krb5_free_keytab_entry_contents. */ -#ifndef HAVE_KRB5_KT_FREE_ENTRY +/* + * Heimdal: krb5_kt_free_entry, MIT: krb5_free_keytab_entry_contents. We + * check for the declaration rather than the function since the function is + * present in older MIT Kerberos libraries but not prototyped. + */ +#if !HAVE_DECL_KRB5_KT_FREE_ENTRY # define krb5_kt_free_entry(c, e) krb5_free_keytab_entry_contents((c), (e)) #endif /* * Heimdal provides a nice function that just returns a const char *. On MIT, - * there's an accessor macro that returns the krb5_data pointer, wihch + * there's an accessor macro that returns the krb5_data pointer, which * requires more work to get at the underlying char *. */ #ifndef HAVE_KRB5_PRINCIPAL_GET_REALM diff --git a/tests/portable/snprintf-t.c b/tests/portable/snprintf-t.c index ca6ae61..fd4c228 100644 --- a/tests/portable/snprintf-t.c +++ b/tests/portable/snprintf-t.c @@ -2,7 +2,7 @@ * snprintf test suite. * * Written by Russ Allbery - * Copyright 2009 Board of Trustees, Leland Stanford Jr. University + * Copyright 2009, 2010 Board of Trustees, Leland Stanford Jr. University * Copyright (c) 2004, 2005, 2006 * by Internet Systems Consortium, Inc. ("ISC") * Copyright (c) 1991, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, @@ -16,6 +16,12 @@ #include +/* + * Disable the requirement that format strings be literals. We need variable + * formats for easy testing. + */ +#pragma GCC diagnostic ignored "-Wformat-nonliteral" + /* * Intentionally don't add the printf attribute here since we pass a * zero-length printf format during testing and don't want warnings. @@ -86,7 +92,7 @@ static unsigned long long ullong_nums[] = { static void -test_format(bool truncate, const char *expected, int count, +test_format(bool trunc, const char *expected, int count, const char *format, ...) { char buf[128]; @@ -94,7 +100,7 @@ test_format(bool truncate, const char *expected, int count, va_list args; va_start(args, format); - result = test_vsnprintf(buf, truncate ? 32 : sizeof(buf), format, args); + result = test_vsnprintf(buf, trunc ? 32 : sizeof(buf), format, args); va_end(args); is_string(expected, buf, "format %s, wanted %s", format, expected); is_int(count, result, "...and output length correct"); diff --git a/tests/runtests.c b/tests/runtests.c index 1670012..ab77629 100644 --- a/tests/runtests.c +++ b/tests/runtests.c @@ -8,22 +8,41 @@ * Expects a list of executables located in the given file, one line per * executable. For each one, runs it as part of a test suite, reporting * results. Test output should start with a line containing the number of - * tests (numbered from 1 to this number), and then each line should be in the - * following format: + * tests (numbered from 1 to this number), optionally preceded by "1..", + * although that line may be given anywhere in the output. Each additional + * line should be in the following format: * * ok * not ok * ok # skip + * not ok # todo * - * where is the number of the test. ok indicates success, not ok - * indicates failure, and "# skip" indicates the test was skipped for some - * reason (maybe because it doesn't apply to this platform). This is a subset - * of TAP as documented in Test::Harness::TAP, which comes with Perl. + * where is the number of the test. An optional comment is permitted + * after the number if preceded by whitespace. ok indicates success, not ok + * indicates failure. "# skip" and "# todo" are a special cases of a comment, + * and must start with exactly that formatting. They indicate the test was + * skipped for some reason (maybe because it doesn't apply to this platform) + * or is testing something known to currently fail. The text following either + * "# skip" or "# todo" and whitespace is the reason. + * + * As a special case, the first line of the output may be in the form: + * + * 1..0 # skip some reason + * + * which indicates that this entire test case should be skipped and gives a + * reason. + * + * Any other lines are ignored, although for compliance with the TAP protocol + * all lines other than the ones in the above format should be sent to + * standard error rather than standard output and start with #. + * + * This is a subset of TAP as documented in Test::Harness::TAP or + * TAP::Parser::Grammar, which comes with Perl. * * Any bug reports, bug fixes, and improvements are very much welcome and * should be sent to the e-mail address below. * - * Copyright 2000, 2001, 2004, 2006, 2007, 2008, 2009 + * Copyright 2000, 2001, 2004, 2006, 2007, 2008, 2009, 2010 * Russ Allbery * * Permission is hereby granted, free of charge, to any person obtaining a @@ -88,6 +107,14 @@ enum test_status { TEST_INVALID }; +/* Indicates the state of our plan. */ +enum plan_status { + PLAN_INIT, /* Nothing seen yet. */ + PLAN_FIRST, /* Plan seen before any tests. */ + PLAN_PENDING, /* Test seen and no plan yet. */ + PLAN_FINAL /* Plan seen after some tests. */ +}; + /* Error exit statuses for test processes. */ #define CHILDERR_DUP 100 /* Couldn't redirect stderr or stdout. */ #define CHILDERR_EXEC 101 /* Couldn't exec child process. */ @@ -97,12 +124,14 @@ enum test_status { struct testset { char *file; /* The file name of the test. */ char *path; /* The path to the test program. */ - int count; /* Expected count of tests. */ - int current; /* The last seen test number. */ - int length; /* The length of the last status message. */ - int passed; /* Count of passing tests. */ - int failed; /* Count of failing lists. */ - int skipped; /* Count of skipped tests (passed). */ + enum plan_status plan; /* The status of our plan. */ + unsigned long count; /* Expected count of tests. */ + unsigned long current; /* The last seen test number. */ + unsigned int length; /* The length of the last status message. */ + unsigned long passed; /* Count of passing tests. */ + unsigned long failed; /* Count of failing lists. */ + unsigned long skipped; /* Count of skipped tests (passed). */ + unsigned long allocated; /* The size of the results table. */ enum test_status *results; /* Table of results by test number. */ int aborted; /* Whether the set as aborted. */ int reported; /* Whether the results were reported. */ @@ -131,8 +160,9 @@ Failed Set Fail/Total (%) Skip Stat Failing Tests\n\ -------------------------- -------------- ---- ---- ------------------------"; /* Include the file name and line number in malloc failures. */ -#define xmalloc(size) x_malloc((size), __FILE__, __LINE__) -#define xstrdup(p) x_strdup((p), __FILE__, __LINE__) +#define xmalloc(size) x_malloc((size), __FILE__, __LINE__) +#define xrealloc(p, size) x_realloc((p), (size), __FILE__, __LINE__) +#define xstrdup(p) x_strdup((p), __FILE__, __LINE__) /* @@ -164,13 +194,27 @@ x_malloc(size_t size, const char *file, int line) void *p; p = malloc(size); - if (!p) + if (p == NULL) sysdie("failed to malloc %lu bytes at %s line %d", (unsigned long) size, file, line); return p; } +/* + * Reallocate memory, reporting a fatal error and exiting on failure. + */ +static void * +x_realloc(void *p, size_t size, const char *file, int line) +{ + p = realloc(p, size); + if (p == NULL) + sysdie("failed to realloc %lu bytes at %s line %d", + (unsigned long) size, file, line); + return p; +} + + /* * Copy a string, reporting a fatal error and exiting on failure. */ @@ -182,7 +226,7 @@ x_strdup(const char *s, const char *file, int line) len = strlen(s) + 1; p = malloc(len); - if (!p) + if (p == NULL) sysdie("failed to strdup %lu bytes at %s line %d", (unsigned long) len, file, line); memcpy(p, s, len); @@ -234,62 +278,6 @@ skip_whitespace(const char *p) } -/* - * Read the first line of test output, which should contain the range of - * test numbers, and initialize the testset structure. Assume it was zeroed - * before being passed in. Return true if initialization succeeds, false - * otherwise. - */ -static int -test_init(const char *line, struct testset *ts) -{ - int i; - - /* - * Prefer a simple number of tests, but if the count is given as a range - * such as 1..10, accept that too for compatibility with Perl's - * Test::Harness. - */ - line = skip_whitespace(line); - if (strncmp(line, "1..", 3) == 0) - line += 3; - - /* - * Get the count, check it for validity, and initialize the struct. If we - * have something of the form "1..0 # skip foo", the whole file was - * skipped; record that. - */ - i = strtol(line, (char **) &line, 10); - if (i == 0) { - line = skip_whitespace(line); - if (*line == '#') { - line = skip_whitespace(line + 1); - if (strncasecmp(line, "skip", 4) == 0) { - line = skip_whitespace(line + 4); - if (*line != '\0') { - ts->reason = xstrdup(line); - ts->reason[strlen(ts->reason) - 1] = '\0'; - } - ts->all_skipped = 1; - ts->aborted = 1; - return 0; - } - } - } - if (i <= 0) { - puts("ABORTED (invalid test count)"); - ts->aborted = 1; - ts->reported = 1; - return 0; - } - ts->count = i; - ts->results = xmalloc(ts->count * sizeof(enum test_status)); - for (i = 0; i < ts->count; i++) - ts->results[i] = TEST_INVALID; - return 1; -} - - /* * Start a program, connecting its stdout to a pipe on our end and its stderr * to /dev/null, and storing the file descriptor to read from in the two @@ -340,7 +328,7 @@ test_start(const char *path, int *fd) static void test_backspace(struct testset *ts) { - int i; + unsigned int i; if (!isatty(STDOUT_FILENO)) return; @@ -354,6 +342,87 @@ test_backspace(struct testset *ts) } +/* + * Read the plan line of test output, which should contain the range of test + * numbers. We may initialize the testset structure here if we haven't yet + * seen a test. Return true if initialization succeeded and the test should + * continue, false otherwise. + */ +static int +test_plan(const char *line, struct testset *ts) +{ + unsigned long i; + long n; + + /* + * Accept a plan without the leading 1.. for compatibility with older + * versions of runtests. This will only be allowed if we've not yet seen + * a test result. + */ + line = skip_whitespace(line); + if (strncmp(line, "1..", 3) == 0) + line += 3; + + /* + * Get the count, check it for validity, and initialize the struct. If we + * have something of the form "1..0 # skip foo", the whole file was + * skipped; record that. If we do skip the whole file, zero out all of + * our statistics, since they're no longer relevant. + */ + n = strtol(line, (char **) &line, 10); + if (n == 0) { + line = skip_whitespace(line); + if (*line == '#') { + line = skip_whitespace(line + 1); + if (strncasecmp(line, "skip", 4) == 0) { + line = skip_whitespace(line + 4); + if (*line != '\0') { + ts->reason = xstrdup(line); + ts->reason[strlen(ts->reason) - 1] = '\0'; + } + ts->all_skipped = 1; + ts->aborted = 1; + ts->count = 0; + ts->passed = 0; + ts->skipped = 0; + ts->failed = 0; + return 0; + } + } + } + if (n <= 0) { + puts("ABORTED (invalid test count)"); + ts->aborted = 1; + ts->reported = 1; + return 0; + } + if (ts->plan == PLAN_INIT && ts->allocated == 0) { + ts->count = n; + ts->allocated = n; + ts->plan = PLAN_FIRST; + ts->results = xmalloc(ts->count * sizeof(enum test_status)); + for (i = 0; i < ts->count; i++) + ts->results[i] = TEST_INVALID; + } else if (ts->plan == PLAN_PENDING) { + if ((unsigned long) n < ts->count) { + printf("ABORTED (invalid test number %lu)\n", ts->count); + ts->aborted = 1; + ts->reported = 1; + return 0; + } + ts->count = n; + if ((unsigned long) n > ts->allocated) { + ts->results = xrealloc(ts->results, n * sizeof(enum test_status)); + for (i = ts->allocated; i < ts->count; i++) + ts->results[i] = TEST_INVALID; + ts->allocated = n; + } + ts->plan = PLAN_FINAL; + } + return 1; +} + + /* * Given a single line of output from a test, parse it and return the success * status of that test. Anything printed to stdout not matching the form @@ -366,20 +435,21 @@ test_checkline(const char *line, struct testset *ts) enum test_status status = TEST_PASS; const char *bail; char *end; - int current; + long number; + unsigned long i, current; /* Before anything, check for a test abort. */ bail = strstr(line, "Bail out!"); if (bail != NULL) { bail = skip_whitespace(bail + strlen("Bail out!")); if (*bail != '\0') { - int length; + size_t length; length = strlen(bail); if (bail[length - 1] == '\n') length--; test_backspace(ts); - printf("ABORTED (%.*s)\n", length, bail); + printf("ABORTED (%.*s)\n", (int) length, bail); ts->reported = 1; } ts->aborted = 1; @@ -393,6 +463,26 @@ test_checkline(const char *line, struct testset *ts) if (line[strlen(line) - 1] != '\n') return; + /* If the line begins with a hash mark, ignore it. */ + if (line[0] == '#') + return; + + /* If we haven't yet seen a plan, look for one. */ + if (ts->plan == PLAN_INIT && isdigit((unsigned char)(*line))) { + if (!test_plan(line, ts)) + return; + } else if (strncmp(line, "1..", 3) == 0) { + if (ts->plan == PLAN_PENDING) { + if (!test_plan(line, ts)) + return; + } else { + puts("ABORTED (multiple plans)"); + ts->aborted = 1; + ts->reported = 1; + return; + } + } + /* Parse the line, ignoring something we can't parse. */ if (strncmp(line, "not ", 4) == 0) { status = TEST_FAIL; @@ -402,17 +492,36 @@ test_checkline(const char *line, struct testset *ts) return; line = skip_whitespace(line + 2); errno = 0; - current = strtol(line, &end, 10); + number = strtol(line, &end, 10); if (errno != 0 || end == line) - current = ts->current + 1; - if (current <= 0 || current > ts->count) { + number = ts->current + 1; + current = number; + if (number <= 0 || (current > ts->count && ts->plan == PLAN_FIRST)) { test_backspace(ts); - printf("ABORTED (invalid test number %d)\n", current); + printf("ABORTED (invalid test number %lu)\n", current); ts->aborted = 1; ts->reported = 1; return; } + /* We have a valid test result. Tweak the results array if needed. */ + if (ts->plan == PLAN_INIT || ts->plan == PLAN_PENDING) { + ts->plan = PLAN_PENDING; + if (current > ts->count) + ts->count = current; + if (current > ts->allocated) { + unsigned long n; + + n = (ts->allocated == 0) ? 32 : ts->allocated * 2; + if (n < current) + n = current; + ts->results = xrealloc(ts->results, n * sizeof(enum test_status)); + for (i = ts->allocated; i < n; i++) + ts->results[i] = TEST_INVALID; + ts->allocated = n; + } + } + /* * Handle directives. We should probably do something more interesting * with unexpected passes of todo tests. @@ -431,7 +540,7 @@ test_checkline(const char *line, struct testset *ts) /* Make sure that the test number is in range and not a duplicate. */ if (ts->results[current - 1] != TEST_INVALID) { test_backspace(ts); - printf("ABORTED (duplicate test number %d)\n", current); + printf("ABORTED (duplicate test number %lu)\n", current); ts->aborted = 1; ts->reported = 1; return; @@ -442,13 +551,13 @@ test_checkline(const char *line, struct testset *ts) case TEST_PASS: ts->passed++; break; case TEST_FAIL: ts->failed++; break; case TEST_SKIP: ts->skipped++; break; - default: break; + case TEST_INVALID: break; } ts->current = current; ts->results[current - 1] = status; test_backspace(ts); if (isatty(STDOUT_FILENO)) { - ts->length = printf("%d/%d", current, ts->count); + ts->length = printf("%lu/%lu", current, ts->count); fflush(stdout); } } @@ -461,12 +570,13 @@ test_checkline(const char *line, struct testset *ts) * chars plus the space needed would go over the limit (use a limit of 0 to * disable this. */ -static int -test_print_range(int first, int last, int chars, int limit) +static unsigned int +test_print_range(unsigned long first, unsigned long last, unsigned int chars, + unsigned int limit) { - int needed = 0; - int out = 0; - int n; + unsigned int needed = 0; + unsigned int out = 0; + unsigned long n; if (chars > 0) { needed += 2; @@ -484,8 +594,8 @@ test_print_range(int first, int last, int chars, int limit) out += printf("..."); } else { if (last > first) - out += printf("%d-", first); - out += printf("%d", last); + out += printf("%lu-", first); + out += printf("%lu", last); } return out; } @@ -500,16 +610,16 @@ test_print_range(int first, int last, int chars, int limit) static void test_summarize(struct testset *ts, int status) { - int i; - int missing = 0; - int failed = 0; - int first = 0; - int last = 0; + unsigned long i; + unsigned long missing = 0; + unsigned long failed = 0; + unsigned long first = 0; + unsigned long last = 0; if (ts->aborted) { fputs("ABORTED", stdout); if (ts->count > 0) - printf(" (passed %d/%d)", ts->passed, ts->count - ts->skipped); + printf(" (passed %lu/%lu)", ts->passed, ts->count - ts->skipped); } else { for (i = 0; i < ts->count; i++) { if (ts->results[i] == TEST_INVALID) { @@ -553,9 +663,9 @@ test_summarize(struct testset *ts, int status) fputs(!status ? "ok" : "dubious", stdout); if (ts->skipped > 0) { if (ts->skipped == 1) - printf(" (skipped %d test)", ts->skipped); + printf(" (skipped %lu test)", ts->skipped); else - printf(" (skipped %d tests)", ts->skipped); + printf(" (skipped %lu tests)", ts->skipped); } } } @@ -570,8 +680,9 @@ test_summarize(struct testset *ts, int status) /* * Given a test set, analyze the results, classify the exit status, handle a - * few special error messages, and then pass it along to test_summarize() - * for the regular output. + * few special error messages, and then pass it along to test_summarize() for + * the regular output. Returns true if the test set ran successfully and all + * tests passed or were skipped, false otherwise. */ static int test_analyze(struct testset *ts) @@ -606,6 +717,10 @@ test_analyze(struct testset *ts) } else if (WIFSIGNALED(ts->status)) { test_summarize(ts, -WTERMSIG(ts->status)); return 0; + } else if (ts->plan != PLAN_FIRST && ts->plan != PLAN_FINAL) { + puts("ABORTED (no valid test plan)"); + ts->aborted = 1; + return 0; } else { test_summarize(ts, 0); return (ts->failed == 0); @@ -622,14 +737,12 @@ static int test_run(struct testset *ts) { pid_t testpid, child; - int outfd, i, status; + int outfd, status; + unsigned long i; FILE *output; char buffer[BUFSIZ]; - /* - * Initialize the test and our data structures, flagging this set in error - * if the initialization fails. - */ + /* Run the test program. */ testpid = test_start(ts->path, &outfd); output = fdopen(outfd, "r"); if (!output) { @@ -637,15 +750,11 @@ test_run(struct testset *ts) fflush(stdout); sysdie("fdopen failed"); } - if (!fgets(buffer, sizeof(buffer), output)) - ts->aborted = 1; - if (!ts->aborted && !test_init(buffer, ts)) - ts->aborted = 1; /* Pass each line of output to test_checkline(). */ while (!ts->aborted && fgets(buffer, sizeof(buffer), output)) test_checkline(buffer, ts); - if (ferror(output)) + if (ferror(output) || ts->plan == PLAN_INIT) ts->aborted = 1; test_backspace(ts); @@ -686,7 +795,8 @@ static void test_fail_summary(const struct testlist *fails) { struct testset *ts; - int i, chars, total, first, last; + unsigned int chars; + unsigned long i, first, last, total; puts(header); @@ -695,7 +805,7 @@ test_fail_summary(const struct testlist *fails) for (; fails; fails = fails->next) { ts = fails->ts; total = ts->count - ts->skipped; - printf("%-26.26s %4d/%-4d %3.0f%% %4d ", ts->file, ts->failed, + printf("%-26.26s %4lu/%-4lu %3.0f%% %4lu ", ts->file, ts->failed, total, total ? (ts->failed * 100.0) / total : 0, ts->skipped); if (WIFEXITED(ts->status)) @@ -711,19 +821,25 @@ test_fail_summary(const struct testlist *fails) last = 0; for (i = 0; i < ts->count; i++) { if (ts->results[i] == TEST_FAIL) { - if (first && i == last) + if (first != 0 && i == last) last = i + 1; else { - if (first) + if (first != 0) chars += test_print_range(first, last, chars, 20); first = i + 1; last = i + 1; } } } - if (first) + if (first != 0) test_print_range(first, last, chars, 20); putchar('\n'); + free(ts->file); + free(ts->path); + free(ts->results); + if (ts->reason != NULL) + free(ts->reason); + free(ts); } } @@ -746,7 +862,7 @@ find_test(const char *name, struct testset *ts, const char *source, { char *path; const char *bases[] = { ".", build, source, NULL }; - int i; + unsigned int i; for (i = 0; bases[i] != NULL; i++) { path = xmalloc(strlen(bases[i]) + strlen(name) + 4); @@ -778,20 +894,21 @@ static int test_batch(const char *testlist, const char *source, const char *build) { FILE *tests; - size_t length, i; - size_t longest = 0; + unsigned int length, i; + unsigned int longest = 0; char buffer[BUFSIZ]; - int line; + unsigned int line; struct testset ts, *tmp; struct timeval start, end; struct rusage stats; - struct testlist *failhead = 0; - struct testlist *failtail = 0; - int total = 0; - int passed = 0; - int skipped = 0; - int failed = 0; - int aborted = 0; + struct testlist *failhead = NULL; + struct testlist *failtail = NULL; + struct testlist *next; + unsigned long total = 0; + unsigned long passed = 0; + unsigned long skipped = 0; + unsigned long failed = 0; + unsigned long aborted = 0; /* * Open our file of tests to run and scan it, checking for lines that @@ -805,7 +922,7 @@ test_batch(const char *testlist, const char *source, const char *build) line++; length = strlen(buffer) - 1; if (buffer[length] != '\n') { - fprintf(stderr, "%s:%d: line too long\n", testlist, line); + fprintf(stderr, "%s:%u: line too long\n", testlist, line); exit(1); } if (length > longest) @@ -834,7 +951,7 @@ test_batch(const char *testlist, const char *source, const char *build) line++; length = strlen(buffer) - 1; if (buffer[length] != '\n') { - fprintf(stderr, "%s:%d: line too long\n", testlist, line); + fprintf(stderr, "%s:%u: line too long\n", testlist, line); exit(1); } buffer[length] = '\0'; @@ -844,12 +961,14 @@ test_batch(const char *testlist, const char *source, const char *build) if (isatty(STDOUT_FILENO)) fflush(stdout); memset(&ts, 0, sizeof(ts)); + ts.plan = PLAN_INIT; ts.file = xstrdup(buffer); find_test(buffer, &ts, source, build); ts.reason = NULL; if (test_run(&ts)) { free(ts.file); free(ts.path); + free(ts.results); if (ts.reason != NULL) free(ts.reason); } else { @@ -858,13 +977,13 @@ test_batch(const char *testlist, const char *source, const char *build) if (!failhead) { failhead = xmalloc(sizeof(struct testset)); failhead->ts = tmp; - failhead->next = 0; + failhead->next = NULL; failtail = failhead; } else { failtail->next = xmalloc(sizeof(struct testset)); failtail = failtail->next; failtail->ts = tmp; - failtail->next = 0; + failtail->next = NULL; } } aborted += ts.aborted; @@ -880,29 +999,35 @@ test_batch(const char *testlist, const char *source, const char *build) getrusage(RUSAGE_CHILDREN, &stats); /* Print out our final results. */ - if (failhead) + if (failhead != NULL) { test_fail_summary(failhead); + while (failhead != NULL) { + next = failhead->next; + free(failhead); + failhead = next; + } + } putchar('\n'); if (aborted != 0) { if (aborted == 1) - printf("Aborted %d test set", aborted); + printf("Aborted %lu test set", aborted); else - printf("Aborted %d test sets", aborted); - printf(", passed %d/%d tests", passed, total); + printf("Aborted %lu test sets", aborted); + printf(", passed %lu/%lu tests", passed, total); } else if (failed == 0) fputs("All tests successful", stdout); else - printf("Failed %d/%d tests, %.2f%% okay", failed, total, + printf("Failed %lu/%lu tests, %.2f%% okay", failed, total, (total - failed) * 100.0 / total); if (skipped != 0) { if (skipped == 1) - printf(", %d test skipped", skipped); + printf(", %lu test skipped", skipped); else - printf(", %d tests skipped", skipped); + printf(", %lu tests skipped", skipped); } puts("."); - printf("Files=%d, Tests=%d", line, total); + printf("Files=%u, Tests=%lu", line, total); printf(", %.2f seconds", tv_diff(&end, &start)); printf(" (%.2f usr + %.2f sys = %.2f CPU)\n", tv_seconds(&stats.ru_utime), tv_seconds(&stats.ru_stime), diff --git a/tests/tap/basic.c b/tests/tap/basic.c index 5ca9ff4..829f91a 100644 --- a/tests/tap/basic.c +++ b/tests/tap/basic.c @@ -2,12 +2,13 @@ * Some utility routines for writing tests. * * Herein are a variety of utility routines for writing tests. All routines - * of the form ok*() take a test number and some number of appropriate + * of the form ok() or is*() take a test number and some number of appropriate * arguments, check to be sure the results match the expected output using the * arguments, and print out something appropriate for that test number. Other - * utility routines help in constructing more complex tests. + * utility routines help in constructing more complex tests, skipping tests, + * or setting up the TAP output format. * - * Copyright 2009 Russ Allbery + * Copyright 2009, 2010 Russ Allbery * Copyright 2006, 2007, 2008 * Board of Trustees, Leland Stanford Jr. University * Copyright (c) 2004, 2005, 2006 @@ -34,7 +35,7 @@ * The test count. Always contains the number that will be used for the next * test status. */ -int testnum = 1; +unsigned long testnum = 1; /* * Status information stored so that we can give a test summary at the end of @@ -44,10 +45,14 @@ int testnum = 1; * We also store the PID of the process that called plan() and only summarize * results when that process exits, so as to not misreport results in forked * processes. + * + * If _lazy is true, we're doing lazy planning and will print out the plan + * based on the last test number at the end of testing. */ -static int _planned = 0; -static int _failed = 0; +static unsigned long _planned = 0; +static unsigned long _failed = 0; static pid_t _process = 0; +static int _lazy = 0; /* @@ -57,22 +62,28 @@ static pid_t _process = 0; static void finish(void) { - int highest = testnum - 1; - - if (_process != 0 && getpid() == _process && _planned > 0) { + unsigned long highest = testnum - 1; + + if (_planned == 0 && !_lazy) + return; + if (_process != 0 && getpid() == _process) { + if (_lazy) { + printf("1..%lu\n", highest); + _planned = highest; + } if (_planned > highest) - printf("# Looks like you planned %d test%s but only ran %d\n", + printf("# Looks like you planned %lu test%s but only ran %lu\n", _planned, (_planned > 1 ? "s" : ""), highest); else if (_planned < highest) - printf("# Looks like you planned %d test%s but ran %d extra\n", + printf("# Looks like you planned %lu test%s but ran %lu extra\n", _planned, (_planned > 1 ? "s" : ""), highest - _planned); else if (_failed > 0) - printf("# Looks like you failed %d test%s of %d\n", _failed, + printf("# Looks like you failed %lu test%s of %lu\n", _failed, (_failed > 1 ? "s" : ""), _planned); else if (_planned > 1) - printf("# All %d tests successful or skipped\n", _planned); + printf("# All %lu tests successful or skipped\n", _planned); else - printf("# %d test successful or skipped\n", _planned); + printf("# %lu test successful or skipped\n", _planned); } } @@ -82,12 +93,12 @@ finish(void) * the number of tests in the test suite. */ void -plan(int count) +plan(unsigned long count) { if (setvbuf(stdout, NULL, _IOLBF, BUFSIZ) != 0) fprintf(stderr, "# cannot set stdout to line buffered: %s\n", strerror(errno)); - printf("1..%d\n", count); + printf("1..%lu\n", count); testnum = 1; _planned = count; _process = getpid(); @@ -95,6 +106,23 @@ plan(int count) } +/* + * Initialize things for lazy planning, where we'll automatically print out a + * plan at the end of the program. Turns on line buffering on stdout as well. + */ +void +plan_lazy(void) +{ + if (setvbuf(stdout, NULL, _IOLBF, BUFSIZ) != 0) + fprintf(stderr, "# cannot set stdout to line buffered: %s\n", + strerror(errno)); + testnum = 1; + _process = getpid(); + _lazy = 1; + atexit(finish); +} + + /* * Skip the entire test suite and exits. Should be called instead of plan(), * not after it, since it prints out a special plan line. @@ -134,7 +162,7 @@ print_desc(const char *format, va_list args) void ok(int success, const char *format, ...) { - printf("%sok %d", success ? "" : "not ", testnum++); + printf("%sok %lu", success ? "" : "not ", testnum++); if (!success) _failed++; if (format != NULL) { @@ -148,13 +176,28 @@ ok(int success, const char *format, ...) } +/* + * Same as ok(), but takes the format arguments as a va_list. + */ +void +okv(int success, const char *format, va_list args) +{ + printf("%sok %lu", success ? "" : "not ", testnum++); + if (!success) + _failed++; + if (format != NULL) + print_desc(format, args); + putchar('\n'); +} + + /* * Skip a test. */ void skip(const char *reason, ...) { - printf("ok %d # skip", testnum++); + printf("ok %lu # skip", testnum++); if (reason != NULL) { va_list args; @@ -171,12 +214,12 @@ skip(const char *reason, ...) * Report the same status on the next count tests. */ void -ok_block(int count, int status, const char *format, ...) +ok_block(unsigned long count, int status, const char *format, ...) { - int i; + unsigned long i; for (i = 0; i < count; i++) { - printf("%sok %d", status ? "" : "not ", testnum++); + printf("%sok %lu", status ? "" : "not ", testnum++); if (!status) _failed++; if (format != NULL) { @@ -195,12 +238,12 @@ ok_block(int count, int status, const char *format, ...) * Skip the next count tests. */ void -skip_block(int count, const char *reason, ...) +skip_block(unsigned long count, const char *reason, ...) { - int i; + unsigned long i; for (i = 0; i < count; i++) { - printf("ok %d # skip", testnum++); + printf("ok %lu # skip", testnum++); if (reason != NULL) { va_list args; @@ -219,13 +262,13 @@ skip_block(int count, const char *reason, ...) * if those two numbers match. */ void -is_int(int wanted, int seen, const char *format, ...) +is_int(long wanted, long seen, const char *format, ...) { if (wanted == seen) - printf("ok %d", testnum++); + printf("ok %lu", testnum++); else { - printf("# wanted: %d\n# seen: %d\n", wanted, seen); - printf("not ok %d", testnum++); + printf("# wanted: %ld\n# seen: %ld\n", wanted, seen); + printf("not ok %lu", testnum++); _failed++; } if (format != NULL) { @@ -251,10 +294,10 @@ is_string(const char *wanted, const char *seen, const char *format, ...) if (seen == NULL) seen = "(null)"; if (strcmp(wanted, seen) == 0) - printf("ok %d", testnum++); + printf("ok %lu", testnum++); else { printf("# wanted: %s\n# seen: %s\n", wanted, seen); - printf("not ok %d", testnum++); + printf("not ok %lu", testnum++); _failed++; } if (format != NULL) { @@ -276,10 +319,10 @@ void is_double(double wanted, double seen, const char *format, ...) { if (wanted == seen) - printf("ok %d", testnum++); + printf("ok %lu", testnum++); else { printf("# wanted: %g\n# seen: %g\n", wanted, seen); - printf("not ok %d", testnum++); + printf("not ok %lu", testnum++); _failed++; } if (format != NULL) { @@ -301,11 +344,11 @@ void is_hex(unsigned long wanted, unsigned long seen, const char *format, ...) { if (wanted == seen) - printf("ok %d", testnum++); + printf("ok %lu", testnum++); else { printf("# wanted: %lx\n# seen: %lx\n", (unsigned long) wanted, (unsigned long) seen); - printf("not ok %d", testnum++); + printf("not ok %lu", testnum++); _failed++; } if (format != NULL) { @@ -354,3 +397,88 @@ sysbail(const char *format, ...) printf(": %s\n", strerror(oerrno)); exit(1); } + + +/* + * Report a diagnostic to stderr. + */ +void +diag(const char *format, ...) +{ + va_list args; + + fflush(stdout); + printf("# "); + va_start(args, format); + vprintf(format, args); + va_end(args); + printf("\n"); +} + + +/* + * Report a diagnostic to stderr, appending strerror(errno). + */ +void +sysdiag(const char *format, ...) +{ + va_list args; + int oerrno = errno; + + fflush(stdout); + printf("# "); + va_start(args, format); + vprintf(format, args); + va_end(args); + printf(": %s\n", strerror(oerrno)); +} + + +/* + * Locate a test file. Given the partial path to a file, look under BUILD and + * then SOURCE for the file and return the full path to the file. Returns + * NULL if the file doesn't exist. A non-NULL return should be freed with + * test_file_path_free(). + * + * This function uses sprintf because it attempts to be independent of all + * other portability layers. The use immediately after a memory allocation + * should be safe without using snprintf or strlcpy/strlcat. + */ +char * +test_file_path(const char *file) +{ + char *base; + char *path = NULL; + size_t length; + const char *envs[] = { "BUILD", "SOURCE", NULL }; + int i; + + for (i = 0; envs[i] != NULL; i++) { + base = getenv(envs[i]); + if (base == NULL) + continue; + length = strlen(base) + 1 + strlen(file) + 1; + path = malloc(length); + if (path == NULL) + sysbail("cannot allocate memory"); + sprintf(path, "%s/%s", base, file); + if (access(path, R_OK) == 0) + break; + free(path); + path = NULL; + } + return path; +} + + +/* + * Free a path returned from test_file_path(). This function exists primarily + * for Windows, where memory must be freed from the same library domain that + * it was allocated from. + */ +void +test_file_path_free(char *path) +{ + if (path != NULL) + free(path); +} diff --git a/tests/tap/basic.h b/tests/tap/basic.h index efe94ba..9602db4 100644 --- a/tests/tap/basic.h +++ b/tests/tap/basic.h @@ -1,6 +1,7 @@ /* * Basic utility routines for the TAP protocol. * + * Copyright 2009, 2010 Russ Allbery * Copyright 2006, 2007, 2008 * Board of Trustees, Leland Stanford Jr. University * Copyright (c) 2004, 2005, 2006 @@ -14,6 +15,7 @@ #ifndef TAP_BASIC_H #define TAP_BASIC_H 1 +#include /* va_list */ #include /* pid_t */ /* @@ -56,29 +58,40 @@ BEGIN_DECLS * The test count. Always contains the number that will be used for the next * test status. */ -extern int testnum; +extern unsigned long testnum; /* Print out the number of tests and set standard output to line buffered. */ -void plan(int count); +void plan(unsigned long count); + +/* + * Prepare for lazy planning, in which the plan will be printed automatically + * at the end of the test program. + */ +void plan_lazy(void); /* Skip the entire test suite. Call instead of plan. */ void skip_all(const char *format, ...) __attribute__((__noreturn__, __format__(printf, 1, 2))); -/* Basic reporting functions. */ +/* + * Basic reporting functions. The okv() function is the same as ok() but + * takes the test description as a va_list to make it easier to reuse the + * reporting infrastructure when writing new tests. + */ void ok(int success, const char *format, ...) __attribute__((__format__(printf, 2, 3))); +void okv(int success, const char *format, va_list args); void skip(const char *reason, ...) __attribute__((__format__(printf, 1, 2))); /* Report the same status on, or skip, the next count tests. */ -void ok_block(int count, int success, const char *format, ...) +void ok_block(unsigned long count, int success, const char *format, ...) __attribute__((__format__(printf, 3, 4))); -void skip_block(int count, const char *reason, ...) +void skip_block(unsigned long count, const char *reason, ...) __attribute__((__format__(printf, 2, 3))); /* Check an expected value against a seen value. */ -void is_int(int wanted, int seen, const char *format, ...) +void is_int(long wanted, long seen, const char *format, ...) __attribute__((__format__(printf, 3, 4))); void is_double(double wanted, double seen, const char *format, ...) __attribute__((__format__(printf, 3, 4))); @@ -93,6 +106,20 @@ void bail(const char *format, ...) void sysbail(const char *format, ...) __attribute__((__noreturn__, __nonnull__, __format__(printf, 1, 2))); +/* Report a diagnostic to stderr prefixed with #. */ +void diag(const char *format, ...) + __attribute__((__nonnull__, __format__(printf, 1, 2))); +void sysdiag(const char *format, ...) + __attribute__((__nonnull__, __format__(printf, 1, 2))); + +/* + * Find a test file under BUILD or SOURCE, returning the full path. The + * returned path should be freed with test_file_path_free(). + */ +char *test_file_path(const char *file) + __attribute__((__malloc__, __nonnull__)); +void test_file_path_free(char *path); + END_DECLS -#endif /* LIBTEST_H */ +#endif /* TAP_BASIC_H */ diff --git a/tests/tap/kerberos.c b/tests/tap/kerberos.c index 700212e..a17d980 100644 --- a/tests/tap/kerberos.c +++ b/tests/tap/kerberos.c @@ -22,33 +22,6 @@ #include -/* - * Given the partial path to a file, look under BUILD and then SOURCE for the - * file and return the full path to the file in newly-allocated memory. - * Returns NULL if the file doesn't exist. - */ -static char * -find_file(const char *file) -{ - char *base; - char *path = NULL; - const char *envs[] = { "BUILD", "SOURCE", NULL }; - int i; - - for (i = 0; envs[i] != NULL; i++) { - base = getenv(envs[i]); - if (base == NULL) - continue; - path = concatpath(base, file); - if (access(path, R_OK) == 0) - break; - free(path); - path = NULL; - } - return path; -} - - /* * Obtain Kerberos tickets for the principal specified in test.principal using * the keytab specified in test.keytab, both of which are presumed to be in @@ -78,7 +51,7 @@ kerberos_setup(void) krb5_creds creds; /* Read the principal name and find the keytab file. */ - path = find_file("data/test.principal"); + path = test_file_path("data/test.principal"); if (path == NULL) return NULL; file = fopen(path, "r"); @@ -95,7 +68,7 @@ kerberos_setup(void) bail("no newline in %s", path); free(path); principal[strlen(principal) - 1] = '\0'; - path = find_file("data/test.keytab"); + path = test_file_path("data/test.keytab"); if (path == NULL) return NULL; diff --git a/tests/tap/kerberos.sh b/tests/tap/kerberos.sh index fbeaaba..904cae5 100644 --- a/tests/tap/kerberos.sh +++ b/tests/tap/kerberos.sh @@ -1,4 +1,4 @@ -# Shell function library for Kerberos test support. +# Shell function library to initialize Kerberos credentials # # Written by Russ Allbery # Copyright 2009, 2010 Board of Trustees, Leland Stanford Jr. University @@ -10,18 +10,9 @@ # configured. Sets the global principal variable to the principal to use. kerberos_setup () { local keytab - keytab='' - for f in "$BUILD/data/test.keytab" "$SOURCE/data/test.keytab" ; do - if [ -r "$f" ] ; then - keytab="$f" - fi - done - principal='' - for f in "$BUILD/data/test.principal" "$SOURCE/data/test.principal" ; do - if [ -r "$f" ] ; then - principal=`cat "$BUILD/data/test.principal"` - fi - done + keytab=`test_file_path data/test.keytab` + principal=`test_file_path data/test.principal` + principal=`cat "$principal" 2>/dev/null` if [ -z "$keytab" ] || [ -z "$principal" ] ; then return 1 fi diff --git a/tests/tap/libtap.sh b/tests/tap/libtap.sh index 1846840..a9b46d4 100644 --- a/tests/tap/libtap.sh +++ b/tests/tap/libtap.sh @@ -1,7 +1,7 @@ # Shell function library for test cases. # # Written by Russ Allbery -# Copyright 2009 Russ Allbery +# Copyright 2009, 2010 Russ Allbery # Copyright 2006, 2007, 2008 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -15,10 +15,22 @@ plan () { trap finish 0 } +# Prepare for lazy planning. +plan_lazy () { + count=1 + planned=0 + failed=0 + trap finish 0 +} + # Report the test status on exit. finish () { local highest looks highest=`expr "$count" - 1` + if [ "$planned" = 0 ] ; then + echo "1..$highest" + planned="$highest" + fi looks='# Looks like you' if [ "$planned" -gt 0 ] ; then if [ "$planned" -gt "$highest" ] ; then @@ -146,3 +158,21 @@ bail () { echo 'Bail out!' "$@" exit 1 } + +# Output a diagnostic on standard error, preceded by the required # mark. +diag () { + echo '#' "$@" +} + +# Search for the given file first in $BUILD and then in $SOURCE and echo the +# path where the file was found, or the empty string if the file wasn't +# found. +test_file_path () { + if [ -f "$BUILD/$1" ] ; then + echo "$BUILD/$1" + elif [ -f "$SOURCE/$1" ] ; then + echo "$SOURCE/$1" + else + echo '' + fi +} diff --git a/tests/tap/remctl.sh b/tests/tap/remctl.sh index b9667ef..9e01bcf 100644 --- a/tests/tap/remctl.sh +++ b/tests/tap/remctl.sh @@ -10,18 +10,12 @@ remctld_start () { local keytab principal rm -f "$BUILD/data/remctld.pid" - keytab='' - for f in "$BUILD/data/test.keytab" "$SOURCE/data/test.keytab" ; do - if [ -r "$f" ] ; then - keytab="$f" - fi - done - principal='' - for f in "$BUILD/data/test.principal" "$SOURCE/data/test.principal" ; do - if [ -r "$f" ] ; then - principal=`cat "$BUILD/data/test.principal"` - fi - done + keytab=`test_file_path data/test.keytab` + principal=`test_file_path data/test.principal` + principal=`cat "$principal" 2>/dev/null` + if [ -z "$keytab" ] || [ -z "$principal" ] ; then + return 1 + fi if [ -n "$VALGRIND" ] ; then ( "$VALGRIND" --log-file=valgrind.%p --leak-check=full "$1" -m \ -p 14373 -s "$principal" -P "$BUILD/data/remctld.pid" -f "$2" -d \ diff --git a/tests/util/messages-t.c b/tests/util/messages-t.c index fb82a42..a58f82c 100644 --- a/tests/util/messages-t.c +++ b/tests/util/messages-t.c @@ -146,8 +146,8 @@ test_strerror(int status, const char *output, int error, char *full_output, *name; full_output = concat(output, ": ", strerror(error), "\n", (char *) NULL); - xasprintf(&name, "strerror %d", testnum / 3 + 1); - is_function_output(function, status, full_output, name); + xasprintf(&name, "strerror %lu", testnum / 3 + 1); + is_function_output(function, status, full_output, "%s", name); free(full_output); free(name); } diff --git a/tests/util/xmalloc.c b/tests/util/xmalloc.c index 3bd5588..b6f4564 100644 --- a/tests/util/xmalloc.c +++ b/tests/util/xmalloc.c @@ -246,8 +246,6 @@ main(int argc, char *argv[]) size_t limit = 0; int willfail = 0; unsigned char code; - struct rlimit rl; - void *tmp; if (argc < 3) die("Usage error. Type, size, and limit must be given."); @@ -290,6 +288,9 @@ main(int argc, char *argv[]) */ if (limit > 0) { #if HAVE_SETRLIMIT && defined(RLIMIT_AS) + struct rlimit rl; + void *tmp; + rl.rlim_cur = limit; rl.rlim_max = limit; if (setrlimit(RLIMIT_AS, &rl) < 0) { diff --git a/util/macros.h b/util/macros.h index 97b2c2b..0104d9f 100644 --- a/util/macros.h +++ b/util/macros.h @@ -8,7 +8,6 @@ #ifndef UTIL_MACROS_H #define UTIL_MACROS_H 1 -#include #include /* Used for unused parameters to silence gcc warnings. */ diff --git a/util/messages.c b/util/messages.c index ef920b2..3592692 100644 --- a/util/messages.c +++ b/util/messages.c @@ -107,9 +107,9 @@ const char *message_program_name = NULL; * handler list, the count of handlers, and the argument list. */ static void -message_handlers(message_handler_func **list, int count, va_list args) +message_handlers(message_handler_func **list, unsigned int count, va_list args) { - int i; + unsigned int i; if (*list != stdout_handlers && *list != stderr_handlers) free(*list); @@ -127,7 +127,7 @@ message_handlers(message_handler_func **list, int count, va_list args) */ #define HANDLER_FUNCTION(type) \ void \ - message_handlers_ ## type(int count, ...) \ + message_handlers_ ## type(unsigned int count, ...) \ { \ va_list args; \ \ @@ -145,7 +145,7 @@ HANDLER_FUNCTION(die) * Print a message to stdout, supporting message_program_name. */ void -message_log_stdout(int len UNUSED, const char *fmt, va_list args, int err) +message_log_stdout(size_t len UNUSED, const char *fmt, va_list args, int err) { if (message_program_name != NULL) fprintf(stdout, "%s: ", message_program_name); @@ -162,7 +162,7 @@ message_log_stdout(int len UNUSED, const char *fmt, va_list args, int err) * stdout so that errors and regular output occur in the right order. */ void -message_log_stderr(int len UNUSED, const char *fmt, va_list args, int err) +message_log_stderr(size_t len UNUSED, const char *fmt, va_list args, int err) { fflush(stdout); if (message_program_name != NULL) @@ -183,7 +183,7 @@ message_log_stderr(int len UNUSED, const char *fmt, va_list args, int err) * log the errno information. */ static void -message_log_syslog(int pri, int len, const char *fmt, va_list args, int err) +message_log_syslog(int pri, size_t len, const char *fmt, va_list args, int err) { char *buffer; @@ -218,11 +218,11 @@ message_log_syslog(int pri, int len, const char *fmt, va_list args, int err) * Do the same sort of wrapper to generate all of the separate syslog logging * functions. */ -#define SYSLOG_FUNCTION(name, type) \ - void \ - message_log_syslog_ ## name(int l, const char *f, va_list a, int e) \ - { \ - message_log_syslog(LOG_ ## type, l, f, a, e); \ +#define SYSLOG_FUNCTION(name, type) \ + void \ + message_log_syslog_ ## name(size_t l, const char *f, va_list a, int e) \ + { \ + message_log_syslog(LOG_ ## type, l, f, a, e); \ } SYSLOG_FUNCTION(debug, DEBUG) SYSLOG_FUNCTION(info, INFO) @@ -243,7 +243,7 @@ debug(const char *format, ...) { va_list args; message_handler_func *log; - int length; + ssize_t length; if (debug_handlers == NULL) return; @@ -254,7 +254,7 @@ debug(const char *format, ...) return; for (log = debug_handlers; *log != NULL; log++) { va_start(args, format); - (**log)(length, format, args, 0); + (**log)((size_t) length, format, args, 0); va_end(args); } } @@ -264,7 +264,7 @@ notice(const char *format, ...) { va_list args; message_handler_func *log; - int length; + ssize_t length; va_start(args, format); length = vsnprintf(NULL, 0, format, args); @@ -273,7 +273,7 @@ notice(const char *format, ...) return; for (log = notice_handlers; *log != NULL; log++) { va_start(args, format); - (**log)(length, format, args, 0); + (**log)((size_t) length, format, args, 0); va_end(args); } } @@ -283,7 +283,7 @@ sysnotice(const char *format, ...) { va_list args; message_handler_func *log; - int length; + ssize_t length; int error = errno; va_start(args, format); @@ -293,7 +293,7 @@ sysnotice(const char *format, ...) return; for (log = notice_handlers; *log != NULL; log++) { va_start(args, format); - (**log)(length, format, args, error); + (**log)((size_t) length, format, args, error); va_end(args); } } @@ -303,7 +303,7 @@ warn(const char *format, ...) { va_list args; message_handler_func *log; - int length; + ssize_t length; va_start(args, format); length = vsnprintf(NULL, 0, format, args); @@ -312,7 +312,7 @@ warn(const char *format, ...) return; for (log = warn_handlers; *log != NULL; log++) { va_start(args, format); - (**log)(length, format, args, 0); + (**log)((size_t) length, format, args, 0); va_end(args); } } @@ -322,7 +322,7 @@ syswarn(const char *format, ...) { va_list args; message_handler_func *log; - int length; + ssize_t length; int error = errno; va_start(args, format); @@ -332,7 +332,7 @@ syswarn(const char *format, ...) return; for (log = warn_handlers; *log != NULL; log++) { va_start(args, format); - (**log)(length, format, args, error); + (**log)((size_t) length, format, args, error); va_end(args); } } @@ -342,7 +342,7 @@ die(const char *format, ...) { va_list args; message_handler_func *log; - int length; + ssize_t length; va_start(args, format); length = vsnprintf(NULL, 0, format, args); @@ -350,7 +350,7 @@ die(const char *format, ...) if (length >= 0) for (log = die_handlers; *log != NULL; log++) { va_start(args, format); - (**log)(length, format, args, 0); + (**log)((size_t) length, format, args, 0); va_end(args); } exit(message_fatal_cleanup ? (*message_fatal_cleanup)() : 1); @@ -361,7 +361,7 @@ sysdie(const char *format, ...) { va_list args; message_handler_func *log; - int length; + ssize_t length; int error = errno; va_start(args, format); @@ -370,7 +370,7 @@ sysdie(const char *format, ...) if (length >= 0) for (log = die_handlers; *log != NULL; log++) { va_start(args, format); - (**log)(length, format, args, error); + (**log)((size_t) length, format, args, error); va_end(args); } exit(message_fatal_cleanup ? (*message_fatal_cleanup)() : 1); diff --git a/util/messages.h b/util/messages.h index ff86f39..dbdb256 100644 --- a/util/messages.h +++ b/util/messages.h @@ -49,35 +49,35 @@ void sysdie(const char *, ...) * of those handlers. These functions are not thread-safe; they set global * variables. */ -void message_handlers_debug(int count, ...); -void message_handlers_notice(int count, ...); -void message_handlers_warn(int count, ...); -void message_handlers_die(int count, ...); +void message_handlers_debug(unsigned int count, ...); +void message_handlers_notice(unsigned int count, ...); +void message_handlers_warn(unsigned int count, ...); +void message_handlers_die(unsigned int count, ...); /* * Some useful handlers, intended to be passed to message_handlers_*. All * handlers take the length of the formatted message, the format, a variadic * argument list, and the errno setting if any. */ -void message_log_stdout(int, const char *, va_list, int) +void message_log_stdout(size_t, const char *, va_list, int) __attribute((__nonnull__)); -void message_log_stderr(int, const char *, va_list, int) +void message_log_stderr(size_t, const char *, va_list, int) __attribute((__nonnull__)); -void message_log_syslog_debug(int, const char *, va_list, int) +void message_log_syslog_debug(size_t, const char *, va_list, int) __attribute((__nonnull__)); -void message_log_syslog_info(int, const char *, va_list, int) +void message_log_syslog_info(size_t, const char *, va_list, int) __attribute((__nonnull__)); -void message_log_syslog_notice(int, const char *, va_list, int) +void message_log_syslog_notice(size_t, const char *, va_list, int) __attribute((__nonnull__)); -void message_log_syslog_warning(int, const char *, va_list, int) +void message_log_syslog_warning(size_t, const char *, va_list, int) __attribute((__nonnull__)); -void message_log_syslog_err(int, const char *, va_list, int) +void message_log_syslog_err(size_t, const char *, va_list, int) __attribute((__nonnull__)); -void message_log_syslog_crit(int, const char *, va_list, int) +void message_log_syslog_crit(size_t, const char *, va_list, int) __attribute((__nonnull__)); /* The type of a message handler. */ -typedef void (*message_handler_func)(int, const char *, va_list, int); +typedef void (*message_handler_func)(size_t, const char *, va_list, int); /* If non-NULL, called before exit and its return value passed to exit. */ extern int (*message_fatal_cleanup)(void); -- cgit v1.2.3 From b374f653006683e1be43556cdff2e050ce04d918 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Wed, 25 Aug 2010 16:03:30 -0700 Subject: Add additional gcc warnings Add -Wformat=2 -Winit-self -Wswitch-enum -Wdeclaration-after-statement -Wshadow to the set of gcc warnings. Stop passing -DDEBUG=1 since I no longer use that define anywhere. Change -W to -Wextra since I'm requiring a fairly new GCC anyway. --- Makefile.am | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/Makefile.am b/Makefile.am index af5f25f..ae7a36d 100644 --- a/Makefile.am +++ b/Makefile.am @@ -78,9 +78,14 @@ dist_man_MANS = client/wallet.1 client/wallet-rekey.1 server/keytab-backend.8 \ server/wallet-admin.8 server/wallet-backend.8 server/wallet-report.8 # A set of flags for warnings. Add -O because gcc won't find some warnings -# without optimization turned on, and add -DDEBUG=1 so we'll also compile all -# debugging code and test it. -WARNINGS = -g -O -DDEBUG=1 -Wall -W -Wendif-labels -Wpointer-arith \ +# without optimization turned on. Desirable warnings that can't be turned +# on due to other problems: +# +# -Wconversion http://bugs.debian.org/488884 (htons warnings) +# +# Last checked against gcc 4.4 (2010-08-15). +WARNINGS = -g -O -Wall -Wextra -Wendif-labels -Wformat=2 -Winit-self \ + -Wswitch-enum -Wdeclaration-after-statement -Wshadow -Wpointer-arith \ -Wbad-function-cast -Wwrite-strings -Wstrict-prototypes \ -Wmissing-prototypes -Wnested-externs -Werror -- cgit v1.2.3 From 7854b3f48bcc63e5fb59f306c8348fa49b3fc9a9 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Wed, 25 Aug 2010 16:35:19 -0700 Subject: Release 0.12 --- NEWS | 2 +- README | 2 +- configure.ac | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/NEWS b/NEWS index f4e7abb..c11bff9 100644 --- a/NEWS +++ b/NEWS @@ -1,6 +1,6 @@ User-Visible wallet Changes -wallet 0.12 (unreleased) +wallet 0.12 (2010-08-25) New client program wallet-rekey that, given a list of keytabs on the command line, requests new keytab objects for each principal in the diff --git a/README b/README index 03dbc2c..5eae7fd 100644 --- a/README +++ b/README @@ -1,4 +1,4 @@ - wallet release 0.11 + wallet release 0.12 (secure data management system) Written by Russ Allbery diff --git a/configure.ac b/configure.ac index 137e6ef..ffd7eeb 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.11], [rra@stanford.edu]) +AC_INIT([wallet], [0.12], [rra@stanford.edu]) AC_CONFIG_AUX_DIR([build-aux]) AC_CONFIG_LIBOBJ_DIR([portable]) AC_CONFIG_MACRO_DIR([m4]) -- cgit v1.2.3 From e47b6f4fb1c4f7b46484c390f8673610d25c355f Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Wed, 25 Aug 2010 16:36:35 -0700 Subject: Add wallet-rekey.pod and Wallet::ACL::Krb5::Regex to EXTRA_DIST Also create the Wallet/ACL/Krb5 directory when copying the Perl files for srcdir != builddir builds. --- Makefile.am | 59 ++++++++++++++++++++++++++++++----------------------------- 1 file changed, 30 insertions(+), 29 deletions(-) diff --git a/Makefile.am b/Makefile.am index ae7a36d..a7bb8f9 100644 --- a/Makefile.am +++ b/Makefile.am @@ -10,37 +10,38 @@ # and are not generated or touched by configure. They're listed here to be # added to EXTRA_DIST and so that they can be copied over properly for # builddir != srcdir builds. -PERL_FILES = perl/Wallet/ACL.pm perl/Wallet/ACL/Base.pm \ - perl/Wallet/ACL/Krb5.pm perl/Wallet/ACL/NetDB.pm \ - perl/Wallet/ACL/NetDB/Root.pm perl/Wallet/Admin.pm \ - perl/Wallet/Config.pm perl/Wallet/Database.pm perl/Wallet/Kadmin.pm \ - perl/Wallet/Kadmin/Heimdal.pm perl/Wallet/Kadmin/MIT.pm \ - perl/Wallet/Object/Base.pm perl/Wallet/Object/File.pm \ - perl/Wallet/Object/Keytab.pm perl/Wallet/Report.pm \ - perl/Wallet/Schema.pm perl/Wallet/Server.pm perl/t/acl.t \ - perl/t/admin.t perl/t/config.t perl/t/data/README \ - perl/t/data/keytab-fake perl/t/data/keytab.conf \ - perl/t/data/netdb.conf perl/t/data/netdb-fake perl/t/file.t \ - perl/t/init.t perl/t/kadmin.t perl/t/keytab.t perl/t/lib/Util.pm \ - perl/t/object.t perl/t/pod-spelling.t perl/t/pod.t perl/t/report.t \ - perl/t/schema.t perl/t/server.t perl/t/verifier-netdb.t \ +PERL_FILES = perl/Wallet/ACL.pm perl/Wallet/ACL/Base.pm \ + perl/Wallet/ACL/Krb5.pm perl/Wallet/ACL/Krb5/Regex.pm \ + perl/Wallet/ACL/NetDB.pm perl/Wallet/ACL/NetDB/Root.pm \ + perl/Wallet/Admin.pm perl/Wallet/Config.pm perl/Wallet/Database.pm \ + perl/Wallet/Kadmin.pm perl/Wallet/Kadmin/Heimdal.pm \ + perl/Wallet/Kadmin/MIT.pm perl/Wallet/Object/Base.pm \ + perl/Wallet/Object/File.pm perl/Wallet/Object/Keytab.pm \ + perl/Wallet/Report.pm perl/Wallet/Schema.pm perl/Wallet/Server.pm \ + perl/t/acl.t perl/t/admin.t perl/t/config.t perl/t/data/README \ + perl/t/data/keytab-fake perl/t/data/keytab.conf \ + perl/t/data/netdb.conf perl/t/data/netdb-fake perl/t/file.t \ + perl/t/init.t perl/t/kadmin.t perl/t/keytab.t perl/t/lib/Util.pm \ + perl/t/object.t perl/t/pod-spelling.t perl/t/pod.t perl/t/report.t \ + perl/t/schema.t perl/t/server.t perl/t/verifier-netdb.t \ perl/t/verifier.t AUTOMAKE_OPTIONS = foreign subdir-objects ACLOCAL_AMFLAGS = -I m4 EXTRA_DIST = .gitignore LICENSE autogen client/wallet.pod \ - config/allow-extract config/keytab config/keytab.acl config/wallet \ - docs/design contrib/README contrib/convert-srvtab-db \ - contrib/used-principals contrib/wallet-contacts \ - contrib/wallet-summary contrib/wallet-summary.8 docs/design-acl \ - docs/design-api docs/netdb-role-api docs/notes docs/setup \ - docs/stanford-naming examples/stanford.conf tests/TESTS \ - tests/data/README tests/data/allow-extract tests/data/basic.conf \ - tests/data/cmd-fake tests/data/cmd-wrapper tests/data/fake-data \ - tests/data/fake-kadmin tests/data/fake-keytab \ - tests/data/fake-keytab-2 tests/data/fake-keytab-merge \ - tests/data/fake-keytab-old tests/data/fake-keytab-rekey \ - tests/data/fake-srvtab tests/data/full.conf tests/data/wallet.conf \ + client/wallet-rekey.pod config/allow-extract config/keytab \ + config/keytab.acl config/wallet docs/design contrib/README \ + contrib/convert-srvtab-db contrib/used-principals \ + contrib/wallet-contacts contrib/wallet-summary \ + contrib/wallet-summary.8 docs/design-acl docs/design-api \ + docs/netdb-role-api docs/notes docs/setup docs/stanford-naming \ + examples/stanford.conf tests/TESTS tests/data/README \ + tests/data/allow-extract tests/data/basic.conf tests/data/cmd-fake \ + tests/data/cmd-wrapper tests/data/fake-data tests/data/fake-kadmin \ + tests/data/fake-keytab tests/data/fake-keytab-2 \ + tests/data/fake-keytab-merge tests/data/fake-keytab-old \ + tests/data/fake-keytab-rekey tests/data/fake-srvtab \ + tests/data/full.conf tests/data/wallet.conf \ tests/docs/pod-spelling-t tests/docs/pod-t tests/server/admin-t \ tests/server/backend-t tests/server/keytab-t tests/server/report-t \ tests/tap/kerberos.sh tests/tap/libtap.sh tests/tap/remctl.sh \ @@ -109,9 +110,9 @@ all-local: perl/blib/lib/Wallet/Config.pm perl/blib/lib/Wallet/Config.pm: set -e; if [ x"$(builddir)" != x"$(srcdir)" ] ; then \ - mkdir perl/Wallet perl/Wallet/ACL perl/Wallet/ACL/NetDB \ - perl/Wallet/Kadmin perl/Wallet/Object perl/t perl/t/data \ - perl/t/lib 2>/dev/null || true ; \ + mkdir perl/Wallet perl/Wallet/ACL perl/Wallet/ACL/Krb5 \ + perl/Wallet/ACL/NetDB perl/Wallet/Kadmin perl/Wallet/Object \ + perl/t perl/t/data perl/t/lib 2>/dev/null || true ; \ for f in $(PERL_FILES) ; do \ cp "$(srcdir)/$$f" "$(builddir)/$$f" ; \ done \ -- cgit v1.2.3 From 846f3b7e862dcc557c845ec37205390a77011541 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Wed, 25 Aug 2010 17:19:34 -0700 Subject: Add more new files to EXTRA_DIST --- Makefile.am | 36 +++++++++++++++++++----------------- 1 file changed, 19 insertions(+), 17 deletions(-) diff --git a/Makefile.am b/Makefile.am index a7bb8f9..444df0b 100644 --- a/Makefile.am +++ b/Makefile.am @@ -28,23 +28,25 @@ PERL_FILES = perl/Wallet/ACL.pm perl/Wallet/ACL/Base.pm \ AUTOMAKE_OPTIONS = foreign subdir-objects ACLOCAL_AMFLAGS = -I m4 -EXTRA_DIST = .gitignore LICENSE autogen client/wallet.pod \ - client/wallet-rekey.pod config/allow-extract config/keytab \ - config/keytab.acl config/wallet docs/design contrib/README \ - contrib/convert-srvtab-db contrib/used-principals \ - contrib/wallet-contacts contrib/wallet-summary \ - contrib/wallet-summary.8 docs/design-acl docs/design-api \ - docs/netdb-role-api docs/notes docs/setup docs/stanford-naming \ - examples/stanford.conf tests/TESTS tests/data/README \ - tests/data/allow-extract tests/data/basic.conf tests/data/cmd-fake \ - tests/data/cmd-wrapper tests/data/fake-data tests/data/fake-kadmin \ - tests/data/fake-keytab tests/data/fake-keytab-2 \ - tests/data/fake-keytab-merge tests/data/fake-keytab-old \ - tests/data/fake-keytab-rekey tests/data/fake-srvtab \ - tests/data/full.conf tests/data/wallet.conf \ - tests/docs/pod-spelling-t tests/docs/pod-t tests/server/admin-t \ - tests/server/backend-t tests/server/keytab-t tests/server/report-t \ - tests/tap/kerberos.sh tests/tap/libtap.sh tests/tap/remctl.sh \ +EXTRA_DIST = .gitignore LICENSE autogen client/wallet.pod \ + client/wallet-rekey.pod config/allow-extract config/keytab \ + config/keytab.acl config/wallet config/wallet-report.acl docs/design \ + contrib/README contrib/convert-srvtab-db contrib/used-principals \ + contrib/wallet-contacts contrib/wallet-summary \ + contrib/wallet-summary.8 contrib/wallet-unknown-hosts \ + docs/design-acl docs/design-api docs/netdb-role-api docs/notes \ + docs/setup docs/stanford-naming examples/stanford.conf tests/TESTS \ + tests/data/README tests/data/allow-extract tests/data/basic.conf \ + tests/data/cmd-fake tests/data/cmd-wrapper tests/data/fake-data \ + tests/data/fake-kadmin tests/data/fake-keytab \ + tests/data/fake-keytab-2 tests/data/fake-keytab-foreign \ + tests/data/fake-keytab-merge tests/data/fake-keytab-old \ + tests/data/fake-keytab-partial tests/data/fake-keytab-partial-result \ + tests/data/fake-keytab-rekey tests/data/fake-keytab-unknown \ + tests/data/fake-srvtab tests/data/full.conf tests/data/wallet.conf \ + tests/docs/pod-spelling-t tests/docs/pod-t tests/server/admin-t \ + tests/server/backend-t tests/server/keytab-t tests/server/report-t \ + tests/tap/kerberos.sh tests/tap/libtap.sh tests/tap/remctl.sh \ tests/util/xmalloc-t $(PERL_FILES) noinst_LIBRARIES = portable/libportable.a util/libutil.a -- cgit v1.2.3 From 3b296d8e65f6f30074cb1046dcf98d2fbd1ede36 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Wed, 25 Aug 2010 18:43:43 -0700 Subject: Add tests/HOWTO from C TAP Harness docs/writing-tests --- tests/HOWTO | 228 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 228 insertions(+) create mode 100644 tests/HOWTO diff --git a/tests/HOWTO b/tests/HOWTO new file mode 100644 index 0000000..bc731b4 --- /dev/null +++ b/tests/HOWTO @@ -0,0 +1,228 @@ + Writing TAP Tests + +Introduction + + This is a guide for users of the C TAP Harness package or similar + TAP-based test harnesses explaining how to write tests. If your + package uses C TAP Harness as the test suite driver, you may want to + copy this document to an appropriate file name in your test suite as + documentation for contributors. + +About TAP + + TAP is the Test Anything Protocol, a protocol for communication + between test cases and a test harness. This is the protocol used by + Perl for its internal test suite and for nearly all Perl modules, + since it's the format used by the build tools for Perl modules to run + tests and report their results. + + A TAP-based test suite works with a somewhat different set of + assumptions than an xUnit test suite. In TAP, each test case is a + separate program. That program, when run, must produce output in the + following format: + + 1..4 + ok 1 - the first test + ok 2 + # a diagnostic, ignored by the harness + not ok 3 - a failing test + ok 4 # skip a skipped test + + The output should all go to standard output. The first line specifies + the number of tests to be run, and then each test produces output that + looks like either "ok " or "not ok " depending on whether the + test succeeded or failed. Additional information about the test can + be provided after the "ok " or "not ok ", but is optional. + Additional diagnostics and information can be provided in lines + beginning with a "#". + + Processing directives are supported after the "ok " or "not ok " + and start with a "#". The main one of interest is "# skip" which says + that the test was skipped rather than successful and optionally gives + the reason. Also supported is "# todo", which normally annotates a + failing test and indicates that test is expected to fail, optionally + providing a reason for why. + + There are three more special cases. First, the initial line stating + the number of tests to run, called the plan, may appear at the end of + the output instead of the beginning. This can be useful if the number + of tests to run is not known in advance. Second, a plan in the form: + + 1..0 # skip entire test case skipped + + can be given instead, which indicates that this entire test case has + been skipped (generally because it depends on facilities or optional + configuration which is not present). Finally, if the test case + encounters a fatal error, it should print the text: + + Bail out! + + on standard output, optionally followed by an error message, and then + exit. This tells the harness that the test aborted unexpectedly. + + The exit status of a successful test case should always be 0. The + harness will report the test as "dubious" if all the tests appeared to + succeed but it exited with a non-zero status. + +Writing TAP Tests + + Environment + + One of the special features of C TAP Harness is the environment that + it sets up for your test cases. If your test program is called under + the runtests driver, the environment variables SOURCE and BUILD will + be set to the top of the test directory in the source tree and the top + of the build tree, respectively. You can use those environment + variables to locate additional test data, programs and libraries built + as part of your software build, and other supporting information + needed by tests. + + The C and shell TAP libraries support a test_file_path() function, + which looks for a file under the build tree and then under the source + tree, using the BUILD and SOURCE environment variables, and return the + full path to the file. This can be used to locate supporting data + files. + + Perl + + Since TAP is the native test framework for Perl, writing TAP tests in + Perl is very easy and extremely well-supported. If you've never + written tests in Perl before, start by reading the documentation for + Test::Tutorial and Test::Simple, which walks you through the basics, + including the TAP output syntax. Then, the best Perl module to use + for serious testing is Test::More, which provides a lot of additional + functions over Test::Simple including support for skipping tests, + bailing out, and not planning tests in advance. See the documentation + of Test::More for all the details and lots of examples. + + C TAP Harness can run Perl test scripts directly and interpret the + results correctly, and similarly the Perl Test::Harness module can run + TAP tests written in other languages using, for example, the TAP + library that comes with C TAP Harness. However, the "prove" tool that + comes with Perl and runs tests makes some Perl-specific assumptions + that aren't always appropriate for packages that aren't written in + Perl. + + C + + C TAP Harness provides a basic TAP library that takes away most of the + pain of writing TAP test cases in C. A C test case should start with + a call to plan(), passing in the number of tests to run. Then, each + test should use is_int(), is_string(), is_double(), or is_hex() as + appropriate to compare expected and seen values, or ok() to do a + simpler boolean test. The is_*() functions take expected and seen + values and then a printf-style format string explaining the test + (which may be NULL). ok() takes a boolean and then the printf-style + string. + + Here's a complete example test program that uses the C TAP library: + + #include + + int + main(void) + { + plan(4); + + ok(1, "the first test"); + is_int(42, 42, NULL); + diag("a diagnostic, ignored by the harness"); + ok(0, "a failing test"); + skip("a skipped test"); + + return 0; + } + + This test program produces the output shown above in the section on + TAP and demonstrates most of the functions. The other functions of + interest are sysdiag() (like diag() but adds strerror() results), + bail() and sysbail() for fatal errors, skip_block() to skip a whole + block of tests, and skip_all() which is called instead of plan() to + skip an entire test case. + + The C TAP library also provides plan_lazy(), which can be called + instead of plan(). If plan_lazy() is called, the library will keep + track of how many test results are reported and will print out the + plan at the end of execution of the program. This should normally be + avoided since the test may appear to be successful even if it exits + prematurely, but it can make writing tests easier in some + circumstances. + + Complete API documentation for the basic C TAP library that comes with + C TAP Harness is available at: + + + + It's common to need additional test functions and utility functions + for your C tests, particularly if you have to set up and tear down a + test environment for your test programs, and it's useful to have them + all in the libtap library so that you only have to link your test + programs with one library. Rather than editing tap/basic.c and + tap/basic.h to add those additional functions, add additional *.c and + *.h files into the tap directory with the function implementations and + prototypes, and then add those additional objects to the library. + That way, you can update tap/basic.c and tap/basic.h from subsequent + releases of C TAP Harness without having to merge changes with your + own code. + + Libraries of additional useful TAP test functions are available in + rra-c-util at: + + + + Some of the code there is particularly useful when testing programs + that require Kerberos keys. + + If you implement new test functions that compare an expected and seen + value, it's best to name them is_ and take the expected + value, the seen value, and then a printf-style format string and + possible arguments to match the calling convention of the functions + provided by C TAP Harness. + + Shell + + C TAP Harness provides a library of shell functions to make it easier + to write TAP tests in shell. That library includes much of the same + functionality as the C TAP library, but takes its parameters in a + somewhat different order to make better use of shell features. + + The libtap.sh file should be installed in a directory named tap in + your test suite area. It can then be loaded by tests written in shell + using the environment set up by runtests with: + + . "$SOURCE"/tap/libtap.sh + + Here is a complete test case written in shell which produces the same + output as the TAP sample above: + + #!/bin/sh + + . "$SOURCE"/tap/libtap.sh + cd "$BUILD" + + plan 4 + ok 'the first test' true + ok '' [ 42 -eq 42 ] + diag a diagnostic, ignored by the harness + ok '' false + skip 'a skipped test' + + The shell framework doesn't provide the is_* functions, so you'll use + the ok function more. It takes a string describing the text and then + treats all of its remaining arguments as a condition, evaluated the + same way as the arguments to the "if" statement. If that condition + evaluates to true, the test passes; otherwise, the test fails. + + The plan, plan_lazy, diag, and bail functions work the same as with + the C library. skip takes a string and skips the next test with that + explanation. skip_block takes a count and a string and skips that + many tests with that explanation. skip_all takes an optional reason + and skips the entire test case. + + Since it's common for shell programs to want to test the output of + commands, there's an additional function ok_program provided by the + shell test library. It takes the test description string, the + expected exit status, the expected program output, and then treats the + rest of its arguments as the program to run. That program is run with + standard error and standard output combined, and then its exit status + and output are tested against the provided values. -- cgit v1.2.3 From a4bf20e6c7bc7fecaf88d2f3d56bde4700c77dc3 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Fri, 27 Aug 2010 13:58:48 -0700 Subject: Add documentation for wallet-unknown-hosts Change how autogen generates man pages to use a loop, which will make it easier to add more documentation in the future. --- autogen | 24 ++++++--------- contrib/wallet-unknown-hosts | 73 ++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 83 insertions(+), 14 deletions(-) diff --git a/autogen b/autogen index 4ed7e23..a34a0b4 100755 --- a/autogen +++ b/autogen @@ -9,17 +9,13 @@ rm -rf autom4te.cache # Generate manual pages. version=`grep '^wallet' NEWS | head -1 | cut -d' ' -f2` -pod2man --release="$version" --center=wallet client/wallet.pod \ - > client/wallet.1 -pod2man --release="$version" --center=wallet client/wallet-rekey.pod \ - > client/wallet-rekey.1 -pod2man --release="$version" --center=wallet -s 8 contrib/wallet-summary \ - > contrib/wallet-summary.8 -pod2man --release="$version" --center=wallet -s 8 server/keytab-backend \ - > server/keytab-backend.8 -pod2man --release="$version" --center=wallet -s 8 server/wallet-admin \ - > server/wallet-admin.8 -pod2man --release="$version" --center=wallet -s 8 server/wallet-backend \ - > server/wallet-backend.8 -pod2man --release="$version" --center=wallet -s 8 server/wallet-report \ - > server/wallet-report.8 +for doc in client/wallet client/wallet-rekey ; do + pod2man --release="$version" --center=wallet \ + --name=`basename "$doc" | tr a-z A-Z` "$doc".pod > "$doc".1 +done +for doc in contrib/wallet-summary contrib/wallet-unknown-hosts \ + server/keytab-backend server/wallet-admin server/wallet-backend \ + server/wallet-report ; do + pod2man --release="$version" --center=wallet --section=8 \ + --name=`basename "$doc" | tr a-z A-Z` "$doc" > "$doc".8 +done diff --git a/contrib/wallet-unknown-hosts b/contrib/wallet-unknown-hosts index fec0956..29efb96 100755 --- a/contrib/wallet-unknown-hosts +++ b/contrib/wallet-unknown-hosts @@ -182,3 +182,76 @@ if ($command eq 'check') { } else { die "$0: unknown command $command\n"; } + +############################################################################## +# Documentation +############################################################################## + +=head1 NAME + +wallet-unknown-hosts - Report host keytabs in wallet for unknown hosts + +=head1 SYNOPSIS + +B check + +B report I I + +env REMOTE_USER=I B purge I I + +=head1 DESCRIPTION + +B constructs a database recording host-based keytabs +in wallet whose corresponding hosts are not found in DNS. It records in +that database the number of times the host wasn't found and the timestamp +of the first time it was not found. It can then generate a report of +host-based keytab objects that have not been found for a minimum number of +consecutive times and which were last found longer ago than a particular +date. Finally, it can purge from wallet all objects that meet those +requirements. + +When run with the C argument, B traverses the +wallet database looking for host-based keytabs, which it recognizes by +looking for keytab objects for principals with at least one period (C<.>) +after a slash (C). It then applies a local check followed by a DNS +check. The DNS check is only successful (only considers the host to be +found) if it resolves to an IP address (possibly through a CNAME). + +For any host that's not found, it records that host in its associated +database. If this is the first time it wasn't found, it records the first +missing time as the current time and the missing count as 1. If it +previously wasn't found, it just increments the missing count. + +For any host that is found, it deletes any record for that keytab from the +database. + +When run with the C argument, B takes two +additional arguments: I and I. I is the minimum number of +times that a host must be found missing for the corresponding keytabs to +show up on the report. I is a cutoff date in seconds since epoch; +keytabs will not be included in the report unless their first missing date +is older than I. The output will be the name component of the +keytab objects in the wallet that correspond to unknown hosts and meet +those thresholds. + +When run with the C argument, B will build a +list of keytab objects the same as with the C argument, using the +same additioanl arguments, but rather than printing them out will instead +delete them from the wallet database. To run C, the environment +variable REMOTE_USER must be set to a principal that's a member of the +C ACL. + +=head1 BUGS + +B doesn't have any facility to purge from its +database all objects that are no longer in the wallet. + +Having to specify an identity for purge mode is an artifact of the +Wallet::Server API and needs to be fixed by providing some way to perform +actions as a local administrator. + +=head1 AUTHOR + +Russ Allbery + +=cut -- cgit v1.2.3 From 92b3dc284e3f11742c10ab10811eaaf2b181666f Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 7 Sep 2010 11:48:43 -0700 Subject: Fix a syntax error in the sample wallet-report remctl configuration --- config/wallet | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/config/wallet b/config/wallet index 19b86fa..61914a1 100644 --- a/config/wallet +++ b/config/wallet @@ -6,4 +6,4 @@ wallet store /usr/sbin/wallet-backend stdin=4 ANYUSER wallet ALL /usr/sbin/wallet-backend ANYUSER -wallet-report /usr/sbin/wallet-report /etc/remctl/acl/wallet-report +wallet-report ALL /usr/sbin/wallet-report /etc/remctl/acl/wallet-report -- cgit v1.2.3 From 2402f8f20e20fea1655b01360a377b86738348a1 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Fri, 17 Sep 2010 19:06:25 -0700 Subject: Add owners command to wallet-report help output --- server/wallet-report | 1 + 1 file changed, 1 insertion(+) diff --git a/server/wallet-report b/server/wallet-report index 98fd07a..992f5b8 100755 --- a/server/wallet-report +++ b/server/wallet-report @@ -31,6 +31,7 @@ Wallet reporting help: objects owner Objects owned by that owner objects type Objects of that type objects unused Objects that have never been stored/gotten + owners All ACL entries owning matching objects EOH ############################################################################## -- cgit v1.2.3 From e29ae427336d50d6109729718f603a8c0ec38095 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Wed, 23 Mar 2011 13:25:36 -0700 Subject: Add -ssl-keystore to the Stanford naming conventions --- docs/stanford-naming | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/docs/stanford-naming b/docs/stanford-naming index 7315c1e..a1855f8 100644 --- a/docs/stanford-naming +++ b/docs/stanford-naming @@ -153,6 +153,13 @@ Object Naming files and assembled into a shibboleth.xml file, but that isn't always the path of least resistance. + --ssl-keystore + + The Java keystore file (containing both public and private key) + used by a service for authentication to other services. If a + given service uses more than one, include the purpose in the + part of the name. + --ssl-pkcs12 The PKCS#12 file (containing both public and private key) used by -- cgit v1.2.3 From 7f1ccd1cb73cc36668821238661ead1004fe1406 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 17 May 2011 15:28:13 -0700 Subject: Add metadata table to the wallet database Add a metadata table whose only column, currently, is a version number. We will store the version of the schema in this table and use that to know what to do during upgrades. --- perl/Wallet/Schema.pm | 20 +++++++++++++++++--- perl/t/schema.t | 14 +++++++++++--- 2 files changed, 28 insertions(+), 6 deletions(-) diff --git a/perl/Wallet/Schema.pm b/perl/Wallet/Schema.pm index 25d48cf..07e5ffe 100644 --- a/perl/Wallet/Schema.pm +++ b/perl/Wallet/Schema.pm @@ -1,7 +1,8 @@ # Wallet::Schema -- Database schema for the wallet system. # # Written by Russ Allbery -# 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. @@ -20,7 +21,7 @@ use DBI; # 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'; ############################################################################## # Data manipulation @@ -135,7 +136,7 @@ Wallet::Schema - Database schema for the wallet system =for stopwords SQL ACL API APIs enums Enums Keytab Backend keytab backend enctypes -enctype Allbery +enctype Allbery Metadata metadata =head1 SYNOPSIS @@ -190,6 +191,19 @@ empty database. =head1 SCHEMA +=head2 Metadata Tables + +This table is used to store metadata about the wallet database, used for +upgrades and in similar situations: + + create table metadata + (md_version integer); + insert into metadata (md_version) values (1); + +This table will normally only have one row. md_version holds the version +number of the schema (which does not necessarily have any relationship to +the version number of wallet itself). + =head2 Normalization Tables The following are normalization tables used to constrain the values in diff --git a/perl/t/schema.t b/perl/t/schema.t index 40759db..11774d6 100755 --- a/perl/t/schema.t +++ b/perl/t/schema.t @@ -3,11 +3,12 @@ # Tests for the wallet schema class. # # Written by Russ Allbery -# 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 Test::More tests => 8; +use Test::More tests => 11; use DBI; use Wallet::Config; @@ -21,7 +22,7 @@ ok (defined $schema, 'Wallet::Schema creation'); ok ($schema->isa ('Wallet::Schema'), ' and class verification'); my @sql = $schema->sql; ok (@sql > 0, 'sql() returns something'); -is (scalar (@sql), 29, ' and returns the right number of statements'); +is (scalar (@sql), 31, ' and returns the right number of statements'); # Connect to a database and test create. db_setup; @@ -37,6 +38,13 @@ $dbh->{PrintError} = 0; eval { $schema->create ($dbh) }; is ($@, '', "create() doesn't die"); +# Check that the version number is correct. +my $sql = "select md_version from metadata"; +my $version = $dbh->selectall_arrayref ($sql); +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 dropping the database. eval { $schema->drop ($dbh) }; is ($@, '', "drop() doesn't die"); -- cgit v1.2.3 From deaa5c140e85d8e1248d910f0721c9e00a46e439 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 17 May 2011 15:53:41 -0700 Subject: Support database upgrades from version 0 Version 0 is the version without the metadata table. Add a new upgrade method to Wallet::Schema and support upgrading the database to version 1. (Version 1 is not yet finalized.) --- perl/Wallet/Schema.pm | 81 ++++++++++++++++++++++++++++++++++++++------------- perl/t/schema.t | 11 ++++++- 2 files changed, 70 insertions(+), 22 deletions(-) diff --git a/perl/Wallet/Schema.pm b/perl/Wallet/Schema.pm index 07e5ffe..911d7a9 100644 --- a/perl/Wallet/Schema.pm +++ b/perl/Wallet/Schema.pm @@ -67,23 +67,13 @@ sub sql { # Initialization and cleanup ############################################################################## -# Given a database handle, try to create our database by running the SQL. Do -# this in a transaction regardless of the database settings and throw an -# exception if this fails. We have to do a bit of fiddling to get syntax that -# works with both MySQL and SQLite. -sub create { - my ($self, $dbh) = @_; - my $driver = $dbh->{Driver}->{Name}; +# Run a set of SQL commands, forcing a transaction, rolling back on error, and +# throwing an exception if anything fails. +sub _run_sql { + my ($self, $dbh, @sql) = @_; eval { $dbh->begin_work if $dbh->{AutoCommit}; - my @sql = @{ $self->{sql} }; for my $sql (@sql) { - if ($driver eq 'SQLite') { - $sql =~ s{auto_increment primary key} - {primary key autoincrement}; - } elsif ($driver eq 'mysql' and $sql =~ /^\s*create\s+table\s/) { - $sql =~ s/;$/ engine=InnoDB;/; - } $dbh->do ($sql, { RaiseError => 1, PrintError => 0 }); } $dbh->commit; @@ -94,6 +84,24 @@ sub create { } } +# Given a database handle, try to create our database by running the SQL. Do +# this in a transaction regardless of the database settings and throw an +# exception if this fails. We have to do a bit of fiddling to get syntax that +# works with both MySQL and SQLite. +sub create { + my ($self, $dbh) = @_; + my $driver = $dbh->{Driver}->{Name}; + my @create = map { + if ($driver eq 'SQLite') { + s/auto_increment primary key/primary key autoincrement/; + } elsif ($driver eq 'mysql' and /^\s*create\s+table\s/) { + s/;$/ engine=InnoDB;/; + } + $_; + } @{ $self->{sql} }; + $self->_run_sql ($dbh, @create); +} + # Given a database handle, try to remove the wallet database tables by # reversing the SQL. Do this in a transaction regardless of the database # settings and throw an exception if this fails. @@ -106,17 +114,42 @@ sub drop { (); } } reverse @{ $self->{sql} }; + $self->_run_sql ($dbh, @drop); +} + +# Given an open database handle, determine the current database schema +# version. If we can't read the version number, we currently assume a version +# 0 database. This will change in the future. +sub _schema_version { + my ($self, $dbh) = @_; + my $version; eval { - $dbh->begin_work if $dbh->{AutoCommit}; - for my $sql (@drop) { - $dbh->do ($sql, { RaiseError => 1, PrintError => 0 }); - } - $dbh->commit; + my $sql = 'select md_version from metadata'; + my $result = $dbh->selectrow_arrayref ($sql); + $version = $result->[0][0]; }; if ($@) { - $dbh->rollback; - die "$@\n"; + $version = 0; + } + return $version; +} + +# Given a database handle, try to upgrade the schema of that database to the +# current version while preserving all data. Do this in a transaction +# regardless of the database settings and throw an exception if this fails. +sub upgrade { + my ($self, $dbh) = @_; + my $version = $self->_schema_version ($dbh); + my @sql; + if ($version == 1) { + return; + } elsif ($version == 0) { + @sql = ('create table metadata (md_version integer)', + 'insert into metadata (md_version) values (1)'); + } else { + die "unknown database version $version\n"; } + $self->_run_sql ($dbh, @sql); } ############################################################################## @@ -187,6 +220,12 @@ Returns the schema and the population of the normalization tables as a list of SQL commands to run to create the wallet database in an otherwise empty database. +=item upgrade(DBH) + +Given a connected database handle, runs the SQL commands necessary to +upgrade that database to the current schema version. On any error, this +method will throw a database exception. + =back =head1 SCHEMA diff --git a/perl/t/schema.t b/perl/t/schema.t index 11774d6..c66ad59 100755 --- a/perl/t/schema.t +++ b/perl/t/schema.t @@ -8,7 +8,7 @@ # # See LICENSE for licensing terms. -use Test::More tests => 11; +use Test::More tests => 15; use DBI; use Wallet::Config; @@ -45,6 +45,15 @@ 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. +$dbh->do ("drop table metadata"); +eval { $schema->upgrade ($dbh) }; +is ($@, '', "upgrade() doesn't die"); +$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'); + # Test dropping the database. eval { $schema->drop ($dbh) }; is ($@, '', "drop() doesn't die"); -- cgit v1.2.3 From 4ee50d93cf99f55a503d0ca788e6c1a468eeacf6 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 17 May 2011 16:11:06 -0700 Subject: Add wallet-admin upgrade command to upgrade the database Hook the new upgrade method of Wallet::Schema into Wallet::Admin and the wallet-admin wrapper script. --- NEWS | 6 ++++++ README | 4 ++++ perl/Wallet/Admin.pm | 29 ++++++++++++++++++++++++----- perl/Wallet/Schema.pm | 2 +- perl/t/admin.t | 7 +++++-- server/wallet-admin | 11 ++++++++++- tests/server/admin-t | 22 +++++++++++++++++++--- 7 files changed, 69 insertions(+), 12 deletions(-) diff --git a/NEWS b/NEWS index c11bff9..9e2fa3b 100644 --- a/NEWS +++ b/NEWS @@ -1,5 +1,11 @@ User-Visible wallet Changes +wallet 1.0 (unreleased) + + 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. + wallet 0.12 (2010-08-25) New client program wallet-rekey that, given a list of keytabs on the diff --git a/README b/README index 5eae7fd..c981272 100644 --- a/README +++ b/README @@ -131,6 +131,10 @@ BUILD AND INSTALLATION make make install + If you are upgrading the wallet server from an earlier installed + version, run wallet-admin upgrade after installation to upgrade the + database schema. See the wallet-admin manual page for more information. + Pass --enable-silent-rules to configure for a quieter build (similar to the Linux kernel). Use make warnings instead of make to build with full GCC compiler warnings (requires a relatively current version of GCC). diff --git a/perl/Wallet/Admin.pm b/perl/Wallet/Admin.pm index f208e13..8fb49af 100644 --- a/perl/Wallet/Admin.pm +++ b/perl/Wallet/Admin.pm @@ -1,7 +1,8 @@ # Wallet::Admin -- Wallet system administrative interface. # # Written by Russ Allbery -# Copyright 2008, 2009, 2010 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008, 2009, 2010, 2011 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -22,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.05'; +$VERSION = '0.06'; ############################################################################## # Constructor, destructor, and accessors @@ -110,6 +111,19 @@ sub destroy { return 1; } +# Upgrade the database to the latest schema version. Returns true on success +# and false on failure. +sub upgrade { + my ($self) = @_; + my $schema = Wallet::Schema->new; + eval { $schema->upgrade ($self->{dbh}) }; + if ($@) { + $self->error ($@); + return; + } + return 1; +} + ############################################################################## # Object registration ############################################################################## @@ -204,12 +218,12 @@ failure to get the error message. =over 4 -=item destroy() +=item destroy () Destroys the database, deleting all of its data and all of the tables used by the wallet server. Returns true on success and false on failure. -=item error() +=item error () Returns the error of the last failing operation or undef if no operations have failed. Callers should call this function to get the error message @@ -240,7 +254,7 @@ Register in the database a mapping from the ACL scheme SCHEME to the class CLASS. Returns true on success and false on failure (including when the verifier is already registered). -=item reinitialize(PRINCIPAL) +=item reinitialize (PRINCIPAL) Performs the same actions as initialize(), but first drops any existing wallet database tables from the database, allowing this function to be @@ -249,6 +263,11 @@ be deleted and a fresh set of wallet database tables will be created. This method is equivalent to calling destroy() followed by initialize(). Returns true on success and false on failure. +=item upgrade () + +Upgrades the database to the latest schema version, preserving data as +much as possible. Returns true on success and false on failure. + =back =head1 SEE ALSO diff --git a/perl/Wallet/Schema.pm b/perl/Wallet/Schema.pm index 911d7a9..0f6c53f 100644 --- a/perl/Wallet/Schema.pm +++ b/perl/Wallet/Schema.pm @@ -126,7 +126,7 @@ sub _schema_version { eval { my $sql = 'select md_version from metadata'; my $result = $dbh->selectrow_arrayref ($sql); - $version = $result->[0][0]; + $version = $result->[0]; }; if ($@) { $version = 0; diff --git a/perl/t/admin.t b/perl/t/admin.t index 074dbc6..6250f8e 100755 --- a/perl/t/admin.t +++ b/perl/t/admin.t @@ -3,11 +3,12 @@ # Tests for wallet administrative interface. # # Written by Russ Allbery -# Copyright 2008, 2009, 2010 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008, 2009, 2010, 2011 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. -use Test::More tests => 16; +use Test::More tests => 18; use Wallet::Admin; use Wallet::Report; @@ -24,6 +25,8 @@ is ($@, '', 'Wallet::Admin creation did not die'); ok ($admin->isa ('Wallet::Admin'), ' and returned the right class'); is ($admin->initialize ('admin@EXAMPLE.COM'), 1, ' and initialization succeeds'); +is ($admin->upgrade, 1, ' and upgrade succeeds (should do nothing)'); +is ($admin->error, undef, ' and there is no error'); # We have an empty database, so we should see no objects and one ACL. my $report = Wallet::Report->new; diff --git a/server/wallet-admin b/server/wallet-admin index f81c195..fbab72b 100755 --- a/server/wallet-admin +++ b/server/wallet-admin @@ -3,7 +3,8 @@ # wallet-admin -- Wallet server administrative commands. # # Written by Russ Allbery -# Copyright 2008, 2009, 2010 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008, 2009, 2010, 2011 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -56,6 +57,9 @@ sub command { } else { die "only object or verifier is supported for register\n"; } + } elsif ($command eq 'upgrade') { + die "too many arguments to upgrade\n" if @args; + $admin->upgrade or die $admin->error, "\n"; } else { die "unknown command $command\n"; } @@ -133,6 +137,11 @@ default as part of database initialization, so this command is used primarily to register local implementations of additional object types or ACL schemes. +=item upgrade + +Upgrades the database to the latest schema version, preserving data as +much as possible. + =back =head1 SEE ALSO diff --git a/tests/server/admin-t b/tests/server/admin-t index 5bde104..6846609 100755 --- a/tests/server/admin-t +++ b/tests/server/admin-t @@ -3,12 +3,13 @@ # Tests for the wallet-admin dispatch code. # # Written by Russ Allbery -# Copyright 2008, 2009, 2010 Board of Trustees, Leland Stanford Jr. University +# Copyright 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 => 36; +use Test::More tests => 42; # Create a dummy class for Wallet::Admin that prints what method was called # with its arguments and returns data for testing. @@ -57,6 +58,12 @@ sub register_verifier { return 1; } +sub upgrade { + print "upgrade\n"; + return if $error; + return 1; +} + # Back to the main package and the actual test suite. Lie about whether the # Wallet::Admin package has already been loaded. package main; @@ -86,7 +93,8 @@ is ($out, "new\n", ' and nothing ran'); # Check too few and too many arguments for every command. my %commands = (destroy => [0, 0], initialize => [1, 1], - register => [3, 3]); + register => [3, 3], + upgrade => [0, 0]); for my $command (sort keys %commands) { my ($min, $max) = @{ $commands{$command} }; if ($min > 0) { @@ -150,6 +158,11 @@ is ($err, '', 'Register succeeds for verifier'); is ($out, "new\nregister_verifier foo Foo::Verifier\n", ' and returns the right outout'); +# Test upgrade. +($out, $err) = run_admin ('upgrade'); +is ($err, '', 'Upgrade succeeds'); +is ($out, "new\nupgrade\n", ' and runs the right code'); + # Test error handling. $Wallet::Admin::error = 1; ($out, $err) = run_admin ('destroy'); @@ -169,3 +182,6 @@ is ($out, "new\nregister_object foo Foo::Object\n", is ($err, "some error\n", 'Error handling succeeds for register verifier'); is ($out, "new\nregister_verifier foo Foo::Verifier\n", ' and calls the right methods'); +($out, $err) = run_admin ('upgrade'); +is ($err, "some error\n", 'Error handling succeeds for initialize'); +is ($out, "new\nupgrade\n", ' and calls the right methods'); -- cgit v1.2.3 From 84e634263f7daf651edec6a39a1e69dfc35b1062 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 17 May 2011 16:52:13 -0700 Subject: Remove completed TODO entries --- TODO | 8 -------- 1 file changed, 8 deletions(-) diff --git a/TODO b/TODO index 20b75fd..fbf27a2 100644 --- a/TODO +++ b/TODO @@ -20,9 +20,6 @@ Client: * Support authenticating with a keytab. - * Allow store data to contain nuls. Requires rewriting the command - processing for store to use iovecs. - * When obtaining tickets in the wallet client with -u, should we get a TGT as we do now or just directly obtain the service ticket we're going to use for remctl? @@ -89,9 +86,6 @@ Database: * Fix case-insensitivity bug in unique keys with MySQL for objects. - * Add the database schema version to a global table so that we can use it - to support schema upgrades in the future. - * On upgrades, support adding new object types and ACL verifiers to the class tables. @@ -134,8 +128,6 @@ Reports: * Add report for all objects that have never been stored. - * Add report of all ACLs with identical contents. - * For objects tied to hostnames, report on objects referring to hosts which do not exist. For the initial pass, this is probably only keytab objects with names containing a slash where the part after the slash -- cgit v1.2.3 From 99423b393c0f64ad657fe4fca7ec9aa2cd2a34be Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Sun, 12 Jun 2011 16:31:53 -0700 Subject: Add checksums of file objects and refreshing to TODO --- TODO | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/TODO b/TODO index fbf27a2..361d242 100644 --- a/TODO +++ b/TODO @@ -24,6 +24,10 @@ Client: TGT as we do now or just directly obtain the service ticket we're going to use for remctl? + * Provide a way to refresh a file object if and only if what's stored on + the server is different than what's on disk. This will require server + support as well for returning the checksum of a file. + Server Interface: * Provide a way to get history for deleted objects and ACLs. @@ -120,6 +124,9 @@ Objects: run multiple CAs on the same wallet server (but why?). Should this be a different type than stored certificates? + * Support returning the checksum of a file object stored in wallet so + that one can determine whether the version stored on disk is identical. + Reports: * Add audit for references to unknown ACLs, possibly introduced by -- cgit v1.2.3 From 74ed6945f9c7839603764327f0187897525db453 Mon Sep 17 00:00:00 2001 From: Russ Allbery 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(-) 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, C, C, C, C, C, C, C, and C. All of those commands have their own ACLs except C and C, -which use the C ACL, and C, which uses the C ACL. -If the appropriate ACL is set, it alone is checked to see if the user has -access. Otherwise, C, C, C, C, C, and -C access is permitted if the user is authorized by the owner ACL -of the object. +which use the C ACL, C, which uses the C ACL, and +C, which uses the owner or C 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, +C, C, C, C, C, and C +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 and C. For C and C, 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 commands, nor can the C command be used on that object. C, C, C, -C, and C or C without an argument can still be -used on that object. +C, and C, C, or C without an argument +can still be used on that object. For more information on attributes, see L. @@ -238,6 +240,15 @@ already exist. Check whether an object of type and name already exists. If it does, prints C; if not, prints C. +=item comment [] + +If is not given, displays the current comment for the object +identified by and , or C if none is set. + +If is given, sets the comment on the object identified by + and to . If is the empty string, clears +the comment. + =item create Create a new object of type with 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 -# 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 -# 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, 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 -# 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 -# 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 -# 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 ACL). The exceptions are C, C, C, C, C, C, C, C, C, and C. All of those commands have their own ACLs except -C and C, which use the C ACL, and C, -which uses the C ACL. If the appropriate ACL is set, it alone is -checked to see if the user has access. Otherwise, C, C, -C, C, C, and C access is permitted if the -user is authorized by the owner ACL of the object. C is -permitted if the user is listed in the default ACL for an object for that -name. +C and C, which use the C ACL, C, which +uses the C ACL, and C, which uses the owner or C +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, C, C, C, C, C, +and C access is permitted if the user is authorized by the owner +ACL of the object. C 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 and C. For C and C, 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 commands, nor can the C command be used on that object. C, C, C, -C, and C or C without an argument can still be -used on that object. +C, and C, C, or C without an argument +can still be used on that object. For more information on attributes, see L. @@ -437,6 +453,15 @@ object will be created with that default ACL set as the object owner. Check whether an object of type and name already exists. If it does, prints C; if not, prints C. +=item comment [] + +If is not given, displays the current comment for the object +identified by and , or C if none is set. + +If is given, sets the comment on the object identified by + and to . If is the empty string, clears +the comment. + =item create Create a new object of type with 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 -# 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 aa1dde03f97b7e8a387bb942c86e084dbb9dbfe6 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Mon, 15 Aug 2011 16:01:20 -0700 Subject: Check command for ACLs to TODO --- TODO | 2 ++ 1 file changed, 2 insertions(+) diff --git a/TODO b/TODO index 0323cc9..40ab9ac 100644 --- a/TODO +++ b/TODO @@ -30,6 +30,8 @@ Client: Server Interface: + * Add check command for ACLs similar to the check command for objects. + * Provide a way to get history for deleted objects and ACLs. * Provide an interface to mass-change all instances of one ACL to another. -- cgit v1.2.3 From 711a55277e28fe7b7358ffeacc51b419f9f66e04 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Sat, 31 Dec 2011 12:00:58 -0800 Subject: Resync with JIRA Add a missing TODO item for purging host-related objects that was filed in JIRA. --- TODO | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/TODO b/TODO index 40ab9ac..3884fea 100644 --- a/TODO +++ b/TODO @@ -150,6 +150,10 @@ Administrative Interface: * Add a function to wallet-admin to purge expired entries. Possibly also check expiration before allowing anyone to get or store objects. + * Add a function or separate script to automate removal of DNS-based + objects for which the hosts no longer exist. Will need to support a + site-specific callout to determine whether the host exists. (WALLET-3) + Documentation: * Write a conventions document for ACL naming, object naming, and similar -- cgit v1.2.3 From d1b8e344838f2f71df028e48e5b2751ba09a3b8b Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Sat, 31 Dec 2011 20:37:34 -0800 Subject: Add IDG JIRA ticket number for one TODO item --- TODO | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/TODO b/TODO index 3884fea..b0b4652 100644 --- a/TODO +++ b/TODO @@ -100,7 +100,7 @@ Objects: * Write a WebAuth keyring object store. It should support attributes saying how long to keep old keys and how far in advance to create new - keys and update the keyring as needed on object download. + keys and update the keyring as needed on object download. (WALLET-4) * Use the Perl Authen::Krb5::Admin module instead of rolling our own kadmin code with Expect now that MIT Kerberos has made the kadmin API -- cgit v1.2.3 From 7b9d4ca1375949349c9be4456a8963c7e85baa9b Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Thu, 29 Mar 2012 13:53:42 -0700 Subject: Fix incorrect wallet.conf path in the setup documentation --- docs/setup | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/setup b/docs/setup index 5a0036f..b8854fc 100644 --- a/docs/setup +++ b/docs/setup @@ -34,7 +34,7 @@ SQLite Database Setup SQLite is very nice in that you don't have to create the database first. You don't even have to create the file. Just create - /etc/wallet.conf with something like: + /etc/wallet/wallet.conf with something like: $DB_DRIVER = 'SQLite'; $DB_INFO = '/path/to/database'; -- cgit v1.2.3 From f265274b66406a524fbef6162dcb642cc0441d23 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 3 Apr 2012 20:25:03 -0700 Subject: Ignore the new MYMETA.yml file generated by ExtUtils::MakeMaker --- .gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitignore b/.gitignore index 576e160..d5ae8a0 100644 --- a/.gitignore +++ b/.gitignore @@ -9,6 +9,7 @@ /config.log /config.status /configure +/perl/MYMETA.yml /perl/Makefile.PL /perl/Makefile.old /perl/blib/ -- cgit v1.2.3 From f1eab726c10be66e94f6984418babfa9d68993b0 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 3 Apr 2012 20:40:01 -0700 Subject: Add initial LDAP attribute ACL verifier A new ACL type, ldap-attr (Wallet::ACL::LDAP::Attribute), is now supported. This ACL type grants access if the LDAP entry corresponding to the principal contains the attribute name and value specified in the ACL. The Net::LDAP and Authen::SASL Perl modules are required to use this ACL type. New configuration settings are required as well; see Wallet::Config for more information. To enable this ACL type for an existing wallet database, use wallet-admin to register the new verifier. --- NEWS | 9 ++ README | 4 + TODO | 10 +- perl/Wallet/ACL/LDAP/Attribute.pm | 258 ++++++++++++++++++++++++++++++++++++++ perl/Wallet/Config.pm | 79 ++++++++++++ perl/Wallet/Schema.pm | 2 + perl/t/schema.t | 2 +- perl/t/verifier-ldap-attr.t | 66 ++++++++++ 8 files changed, 426 insertions(+), 4 deletions(-) create mode 100644 perl/Wallet/ACL/LDAP/Attribute.pm create mode 100755 perl/t/verifier-ldap-attr.t diff --git a/NEWS b/NEWS index 42fb3e7..d08cb14 100644 --- a/NEWS +++ b/NEWS @@ -6,6 +6,15 @@ wallet 1.0 (unreleased) database to the latest schema version. This command should be run when deploying any new version of the wallet server. + A new ACL type, ldap-attr (Wallet::ACL::LDAP::Attribute), is now + supported. This ACL type grants access if the LDAP entry + corresponding to the principal contains the attribute name and value + specified in the ACL. The Net::LDAP and Authen::SASL Perl modules are + required to use this ACL type. New configuration settings are + required as well; see Wallet::Config for more information. To enable + this ACL type for an existing wallet database, use wallet-admin to + register the new verifier. + 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/README b/README index c981272..c440b8c 100644 --- a/README +++ b/README @@ -95,6 +95,10 @@ REQUIREMENTS binary that supports the -norandkey option to ktadd. This option is included in MIT Kerberos 1.7 and later. + To support the LDAP attribute ACL verifier, the Authen::SASL and + Net::LDAP Perl modules must be installed on the server. This verifier + only works with LDAP servers that support GSS-API binds. + To support the NetDB ACL verifier (only of interest at sites using NetDB to manage DNS), the Net::Remctl Perl module must be installed on the server. diff --git a/TODO b/TODO index b0b4652..b019903 100644 --- a/TODO +++ b/TODO @@ -63,8 +63,6 @@ ACLs: * Error messages from ACL operations should refer to the ACLs by name instead of by ID. - * Write the LDAP entitlement ACL verifier. - * Write the PTS ACL verifier. * Rename Wallet::ACL::* to Wallet::Verifier::*. Add Wallet::ACL as a @@ -81,7 +79,8 @@ ACLs: * A group-in-groups ACL schema. * Provide an API for verifiers to syntax-check the values before an ACL - is set and implement syntax checking for the Krb5 verifier. + is set and implement syntax checking for the krb5 and ldap-attr + verifiers. * Investigate how best to support client authentication using anonymous PKINIT for things like initial system keying. @@ -195,6 +194,11 @@ Code Style and Cleanup: Test Suite: + * The ldap-attr verifier test case is awful and completely specific to + people with admin access to the Stanford LDAP tree. Write a real test. + + * Rename the tests to use a subdirectory organization. + * Add POD coverage testing using Test::POD::Coverage for the server modules. diff --git a/perl/Wallet/ACL/LDAP/Attribute.pm b/perl/Wallet/ACL/LDAP/Attribute.pm new file mode 100644 index 0000000..7a54546 --- /dev/null +++ b/perl/Wallet/ACL/LDAP/Attribute.pm @@ -0,0 +1,258 @@ +# Wallet::ACL::LDAP::Attribute -- Wallet LDAP attribute ACL verifier. +# +# Written by Russ Allbery +# Copyright 2012 +# The Board of Trustees of the Leland Stanford Junior University +# +# See LICENSE for licensing terms. + +############################################################################## +# Modules and declarations +############################################################################## + +package Wallet::ACL::LDAP::Attribute; +require 5.006; + +use strict; +use vars qw(@ISA $VERSION); + +use Authen::SASL (); +use Net::LDAP qw(LDAP_COMPARE_TRUE); +use Wallet::ACL::Base; + +@ISA = qw(Wallet::ACL::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.01'; + +############################################################################## +# Interface +############################################################################## + +# Create a new persistant verifier. Load the Net::LDAP module and open a +# persistant LDAP server connection that we'll use for later calls. +sub new { + my $type = shift; + my $host = $Wallet::Config::LDAP_HOST; + my $base = $Wallet::Config::LDAP_BASE; + unless ($host and defined ($base) and $Wallet::Config::LDAP_CACHE) { + die "LDAP attribute ACL support not configured\n"; + } + + # Ensure the required Perl modules are available and bind to the directory + # server. Catch any errors with a try/catch block. + my $ldap; + eval { + local $ENV{KRB5CCNAME} = $Wallet::Config::LDAP_CACHE; + my $sasl = Authen::SASL->new (mechanism => 'GSSAPI'); + $ldap = Net::LDAP->new ($host, onerror => 'die'); + my $mesg = eval { $ldap->bind (undef, sasl => $sasl) }; + }; + if ($@) { + my $error = $@; + chomp $error; + 1 while ($error =~ s/ at \S+ line \d+\.?\z//); + die "LDAP attribute ACL support not available: $error\n"; + } + + # We successfully bound, so create our object and return it. + my $self = { ldap => $ldap }; + bless ($self, $type); + return $self; +} + +# Check whether a given principal has the required LDAP attribute. We first +# map the principal to a DN by doing a search for that principal (and bailing +# if we get more than one entry). Then, we do a compare to see if that DN has +# the desired attribute and value. +# +# If the ldap_map_principal sub is defined in Wallet::Config, call it on the +# principal first to map it to the value for which we'll search. +# +# The connection is configured to die on any error, so we do all the work in a +# try/catch block to report errors. +sub check { + my ($self, $principal, $acl) = @_; + undef $self->{error}; + unless ($principal) { + $self->error ('no principal specified'); + return; + } + my ($attr, $value); + if ($acl) { + ($attr, $value) = split ('=', $acl, 2); + } + unless (defined ($attr) and defined ($value)) { + $self->error ('malformed ldap-attr ACL'); + return; + } + my $ldap = $self->{ldap}; + + # Map the principal name to an attribute value for our search if we're + # doing a custom mapping. + if (defined &Wallet::Config::ldap_map_principal) { + eval { $principal = Wallet::Config::ldap_map_principal ($principal) }; + if ($@) { + $self->error ("mapping principal to LDAP failed: $@"); + return; + } + } + + # Now, map the user to a DN by doing a search. + my $entry; + eval { + my $fattr = $Wallet::Config::LDAP_FILTER_ATTR || 'krb5PrincipalName'; + my $filter = "($fattr=$principal)"; + my $base = $Wallet::Config::LDAP_BASE; + my @options = (base => $base, filter => $filter, attrs => [ 'dn' ]); + my $search = $ldap->search (@options); + if ($search->count == 1) { + $entry = $search->pop_entry; + } elsif ($search->count > 1) { + die $search->count . " LDAP entries found for $principal"; + } + }; + if ($@) { + $self->error ("cannot search for $principal in LDAP: $@"); + return; + } + return 0 unless $entry; + + # We have a user entry. We can now check whether that user has the + # desired attribute and value. + my $result; + eval { + my $mesg = $ldap->compare ($entry, attr => $attr, value => $value); + $result = $mesg->code; + }; + if ($@) { + $self->error ("cannot check LDAP attribute $attr for $principal: $@"); + return; + } + return ($result == LDAP_COMPARE_TRUE) ? 1 : 0; +} + +1; + +############################################################################## +# Documentation +############################################################################## + +=for stopwords +ACL Allbery + +=head1 NAME + +Wallet::ACL::LDAP::Attribute - Wallet ACL verifier for LDAP attribute compares + +=head1 SYNOPSIS + + my $verifier = Wallet::ACL::LDAP::Attribute->new; + my $status = $verifier->check ($principal, "$attr=$value"); + 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::LDAP::Attribute checks whether the LDAP record for the entry +corresponding to a principal contains an attribute with a particular +value. It is used to verify ACL lines of type C. The value of +such an ACL is an attribute followed by an equal sign and a value, and the +ACL grants access to a given principal if and only if the LDAP entry for +that principal has that attribute set to that value. + +To use this object, several configuration parameters must be set. See +L for details on those configuration parameters and +information about how to set wallet configuration. + +=head1 METHODS + +=item new() + +Creates a new ACL verifier. Opens and binds the connection to the LDAP +server. + +=item check(PRINCIPAL, ACL) + +Returns true if PRINCIPAL is granted access according to ACL, false if +not, and undef on an error (see L<"DIAGNOSTICS"> below). ACL must be an +attribute name and a value, separated by an equal sign (with no +whitespace). PRINCIPAL will be granted access if its LDAP entry contains +that attribute with that value. + +=item error() + +Returns the error if check() returned undef. + +=back + +=head1 DIAGNOSTICS + +The new() method may fail with one of the following exceptions: + +=item LDAP attribute ACL support not available: %s + +Attempting to connect or bind to the LDAP server failed. + +=item LDAP attribute ACL support not configured + +The required configuration parameters were not set. See Wallet::Config(3) +for the required configuration parameters and how to set them. + +=back + +Verifying an LDAP attribute ACL may fail with the following errors +(returned by the error() method): + +=over 4 + +=item cannot check LDAP attribute %s for %s: %s + +The LDAP compare to check for the required attribute failed. The +attribute may have been misspelled, or there may be LDAP directory +permission issues. This error indicates that PRINCIPAL's entry was +located in LDAP, but the check failed during the compare to verify the +attribute value. + +=item cannot search for %s in LDAP: %s + +Searching for PRINCIPAL (possibly after ldap_map_principal() mapping) +failed. This is often due to LDAP directory permissions issues. This +indicates a failure during the mapping of PRINCIPAL to an LDAP DN. + +=item malformed ldap-attr ACL + +The ACL parameter to check() was malformed. Usually this means that +either the attribute or the value were empty or the required C<=> sign +separating them was missing. + +=item mapping principal to LDAP failed: %s + +There was an ldap_map_principal() function defined in the wallet +configuration, but calling it for the PRINCIPAL argument failed. + +=item no principal specified + +The PRINCIPAL parameter to check() was undefined or the empty string. + +=back + +=head1 SEE ALSO + +Wallet::ACL(3), Wallet::ACL::Base(3), Wallet::Config(3), wallet-backend(8) + +This module is part of the wallet system. The current version is +available from L. + +=head1 AUTHOR + +Russ Allbery + +=cut diff --git a/perl/Wallet/Config.pm b/perl/Wallet/Config.pm index 23a051d..3f53f74 100644 --- a/perl/Wallet/Config.pm +++ b/perl/Wallet/Config.pm @@ -378,6 +378,85 @@ our $KEYTAB_REMCTL_PORT; =back +=head1 LDAP ACL CONFIGURATION + +These configuration variables are only needed if you intend to use the +C ACL type (the Wallet::ACL::LDAP::Attribute class). They +specify the LDAP server and additional connection and data model +information required for the wallet to check for the existence of +attributes. + +=over 4 + +=item LDAP_HOST + +The LDAP server name to use to verify LDAP ACLs. This variable must be +set to use LDAP ACLs. + +=cut + +our $LDAP_HOST; + +=item LDAP_BASE + +The base DN under which to search for the entry corresponding to a +principal. Currently, the wallet always does a full subtree search under +this base DN. This variable must be set to use LDAP ACLs. + +=cut + +our $LDAP_BASE; + +=item LDAP_FILTER_ATTR + +The attribute used to find the entry corresponding to a principal. The +LDAP entry containing this attribute with a value equal to the principal +will be found and checked for the required attribute and value. If this +variable is not set, the default is C. + +=cut + +our $LDAP_FILTER_ATTR; + +=item LDAP_CACHE + +Specifies the Kerberos ticket cache to use when connecting to the LDAP +server. GSS-API authentication is always used; there is currently no +support for any other type of bind. The ticket cache must be for a +principal with access to verify the values of attributes that will be used +with this ACL type. This variable must be set to use LDAP ACLs. + +=cut + +our $LDAP_CACHE; + +=back + +Finally, depending on the structure of the LDAP directory being queried, +there may not be any attribute in the directory whose value exactly +matches the Kerberos principal. The attribute designated by +LDAP_FILTER_ATTR may instead hold a transformation of the principal name +(such as the principal with the local realm stripped off, or rewritten +into an LDAP DN form). If this is the case, define a Perl function named +ldap_map_attribute. This function will be called whenever an LDAP +attribute ACL is being verified. It will take one argument, the +principal, and is expected to return the value to search for in the LDAP +directory server. + +For example, if the principal name without the local realm is stored in +the C attribute in the directory, set LDAP_FILTER_ATTR to C and +then define ldap_map_attribute as follows: + + sub ldap_map_attribute { + my ($principal) = @_; + $principal =~ s/\@EXAMPLE\.COM$//; + return $principal; + } + +Note that this example only removes the local realm (here, EXAMPLE.COM). +Any principal from some other realm will be left fully qualified, and then +presumably will not be found in the directory. + =head1 NETDB ACL CONFIGURATION These configuration variables are only needed if you intend to use the diff --git a/perl/Wallet/Schema.pm b/perl/Wallet/Schema.pm index 7400776..5c6b9ca 100644 --- a/perl/Wallet/Schema.pm +++ b/perl/Wallet/Schema.pm @@ -276,6 +276,8 @@ Holds the supported ACL schemes and their corresponding Perl classes: 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 ('ldap-attr', 'Wallet::ACL::LDAP::Attribute'); insert into acl_schemes (as_name, as_class) values ('netdb', 'Wallet::ACL::NetDB'); insert into acl_schemes (as_name, as_class) diff --git a/perl/t/schema.t b/perl/t/schema.t index ce8a62a..5dd90d1 100755 --- a/perl/t/schema.t +++ b/perl/t/schema.t @@ -23,7 +23,7 @@ ok (defined $schema, 'Wallet::Schema creation'); ok ($schema->isa ('Wallet::Schema'), ' and class verification'); my @sql = $schema->sql; ok (@sql > 0, 'sql() returns something'); -is (scalar (@sql), 31, ' and returns the right number of statements'); +is (scalar (@sql), 32, ' and returns the right number of statements'); # Connect to a database and test create. db_setup; diff --git a/perl/t/verifier-ldap-attr.t b/perl/t/verifier-ldap-attr.t new file mode 100755 index 0000000..1c84fac --- /dev/null +++ b/perl/t/verifier-ldap-attr.t @@ -0,0 +1,66 @@ +#!/usr/bin/perl -w +# +# Tests for the LDAP attribute ACL verifier. +# +# This test can only be run by someone local to Stanford with appropriate +# access to the LDAP server and will be skipped in all other environments. +# +# Written by Russ Allbery +# Copyright 2012 +# The Board of Trustees of the Leland Stanford Junior University +# +# See LICENSE for licensing terms. + +use Test::More tests => 10; + +use lib 't/lib'; +use Util; + +BEGIN { use_ok ('Wallet::ACL::LDAP::Attribute') }; + +my $host = 'ldap.stanford.edu'; +my $base = 'cn=people,dc=stanford,dc=edu'; +my $filter = 'uid'; +my $user = 'rra@stanford.edu'; +my $attr = 'suPrivilegeGroup'; +my $value = 'stanford:stanford'; + +# Remove the realm from principal names. +package Wallet::Config; +sub ldap_map_principal { + my ($principal) = @_; + $principal =~ s/\@.*//; + return $principal; +} +package main; + +# Determine the local principal. +my $klist = `klist 2>&1` || ''; +SKIP: { + skip "tests useful only with Stanford Kerberos tickets", 4 + unless ($klist =~ /[Pp]rincipal: \S+\@stanford\.edu$/m); + + # Set up our configuration. + $Wallet::Config::LDAP_HOST = $host; + $Wallet::Config::LDAP_CACHE = $ENV{KRB5CCNAME}; + $Wallet::Config::LDAP_BASE = $base; + $Wallet::Config::LDAP_FILTER_ATTR = $filter; + + # Finally, we can test. + my $verifier = eval { Wallet::ACL::LDAP::Attribute->new }; + isa_ok ($verifier, 'Wallet::ACL::LDAP::Attribute'); + is ($verifier->check ($user, "$attr=$value"), 1, + "Checking $attr=$value succeeds"); + is ($verifier->error, undef, '...with no error'); + is ($verifier->check ($user, "$attr=BOGUS"), 0, + "Checking $attr=BOGUS fails"); + is ($verifier->error, undef, '...with no error'); + is ($verifier->check ($user, "BOGUS=$value"), undef, + "Checking BOGUS=$value fails with error"); + is ($verifier->error, + 'cannot check LDAP attribute BOGUS for rra: Undefined attribute type', + '...with correct error'); + is ($verifier->check ('user-does-not-exist', "$attr=$value"), 0, + "Checking for nonexistent user fails"); + is ($verifier->error, undef, '...with no error'); +} -- cgit v1.2.3 From 2d9da56ba9207f211fca5ae033a0015763aa4930 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Wed, 6 Jun 2012 19:28:18 -0700 Subject: Resync TODO with JIRA --- TODO | 276 ++++++++++++++++++++++++++++++++++--------------------------------- 1 file changed, 142 insertions(+), 134 deletions(-) diff --git a/TODO b/TODO index b019903..1a35bbd 100644 --- a/TODO +++ b/TODO @@ -2,213 +2,221 @@ Client: - * Handle duplicate kvnos in a newly returned keytab and an existing - keytab (such as when downloading an unchanging keytab and merging it - into an existing one) in some reasonable fashion. + * WALLET-5: Handle duplicate kvnos in a newly returned keytab and an + existing keytab (such as when downloading an unchanging keytab and + merging it into an existing one) in some reasonable fashion. - * Support removing old kvnos from a merged keytab (similar to kadmin - ktremove old). + * WALLET-6: Support removing old kvnos from a merged keytab (similar to + kadmin ktremove old). - * When reading configuration from krb5.conf, we should first try to - determine our principal from any existing K5 ticket cache (after - obtaining tickets if -u was given) and extract the realm from that - principal, using it as the default realm when reading configuration - information. + * WALLET-7: When reading configuration from krb5.conf, we should first + try to determine our principal from any existing Kerberos ticket cache + (after obtaining tickets if -u was given) and extract the realm from + that principal, using it as the default realm when reading + configuration information. - * Add readline support to the wallet client to make it easier to issue - multiple commands. + * WALLET-8: Add readline support to the wallet client to make it easier + to issue multiple commands. - * Support authenticating with a keytab. + * WALLET-9: Support authenticating with a keytab. - * When obtaining tickets in the wallet client with -u, should we get a - TGT as we do now or just directly obtain the service ticket we're going - to use for remctl? + * WALLET-10: When obtaining tickets in the wallet client with -u, + directly obtain the service ticket we're going to use for remctl. - * Provide a way to refresh a file object if and only if what's stored on - the server is different than what's on disk. This will require server - support as well for returning the checksum of a file. + * WALLET-11: Provide a way to refresh a file object if and only if what's + stored on the server is different than what's on disk. This will + require server support as well for returning the checksum of a file. Server Interface: - * Add check command for ACLs similar to the check command for objects. + * WALLET-12: Add check command for ACLs similar to the check command for + objects. - * Provide a way to get history for deleted objects and ACLs. + * WALLET-13: Provide a way to get history for deleted objects and ACLs. - * Provide an interface to mass-change all instances of one ACL to another. + * WALLET-14: Provide an interface to mass-change all instances of one ACL + to another. - * Add help functions to wallet-backend, wallet-report, and wallet-admin - listing the commands. + * WALLET-15: 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. + * WALLET-16: Catch exceptions on object creation in wallet-backend so + that we can log those as well. - * Provide a way to list all objects for which the connecting user has - ACLs. + * WALLET-17: Provide a way to list all objects for which the connecting + user has ACLs. - * Support limiting returned history information by timestamp. + * WALLET-18: Support limiting returned history information by timestamp. - * Provide a REST implementation of the wallet server. + * WALLET-19: Provide a REST implementation of the wallet server. - * Provide a CGI implementation of the wallet server. + * WALLET-20: Provide a CGI implementation of the wallet server. - * Support setting flags and attributes on autocreate. In general, work - out a Wallet::Object::Template Perl object that I can return that - specifies things other than just the ACL. + * WALLET-21: Support setting flags and attributes on autocreate. In + general, work out a Wallet::Object::Template Perl object that I can + return that specifies things other than just the ACL. - * Remove the hard-coded ADMIN ACL in the server with something more - configurable, perhaps a global ACL table or something. + * WALLET-22: Remove the hard-coded ADMIN ACL in the server with something + more configurable, perhaps a global ACL table or something. ACLs: - * Error messages from ACL operations should refer to the ACLs by name - instead of by ID. + * WALLET-23: Error messages from ACL operations should refer to the ACLs + by name instead of by ID. - * Write the PTS ACL verifier. + * WALLET-24: Write the PTS ACL verifier. - * Rename Wallet::ACL::* to Wallet::Verifier::*. Add Wallet::ACL as a - generic interface with Wallet::ACL::Database and Wallet::ACL::List - implementations (or some similar name) so that we can create and check - an ACL without having to write it into the database. Redo default ACL - creation using that functionality. + * WALLET-25: Rename Wallet::ACL::* to Wallet::Verifier::*. Add + Wallet::ACL as a generic interface with Wallet::ACL::Database and + Wallet::ACL::List implementations (or some similar name) so that we can + create and check an ACL without having to write it into the database. + Redo default ACL creation using that functionality. - * 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. + * WALLET-26: 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. - * Support for pattern matching in ACLs. + * WALLET-27: A group-in-groups ACL schema. - * A group-in-groups ACL schema. + * WALLET-28: Provide an API for verifiers to syntax-check the values + before an ACL is set and implement syntax checking for the krb5 and + ldap-attr verifiers. - * Provide an API for verifiers to syntax-check the values before an ACL - is set and implement syntax checking for the krb5 and ldap-attr - verifiers. - - * Investigate how best to support client authentication using anonymous - PKINIT for things like initial system keying. + * WALLET-29: Investigate how best to support client authentication using + anonymous PKINIT for things like initial system keying. Database: - * Fix case-insensitivity bug in unique keys with MySQL for objects. + * WALLET-30: Fix case-insensitivity bug in unique keys with MySQL for + objects. - * On upgrades, support adding new object types and ACL verifiers to the - class tables. + * WALLET-31: On upgrades, support adding new object types and ACL + verifiers to the class tables. Objects: - * Check whether we can just drop the realm restriction on keytabs and - allow the name to contain the realm if the Kerberos type is Heimdal. + * WALLET-32: Check whether we can just drop the realm restriction on + keytabs and allow the name to contain the realm if the Kerberos type is + Heimdal. - * Write a WebAuth keyring object store. It should support attributes - saying how long to keep old keys and how far in advance to create new - keys and update the keyring as needed on object download. (WALLET-4) + * WALLET-4: Write a WebAuth keyring object store. It should support + attributes saying how long to keep old keys and how far in advance to + create new keys and update the keyring as needed on object download. - * Use the Perl Authen::Krb5::Admin module instead of rolling our own - kadmin code with Expect now that MIT Kerberos has made the kadmin API - public. + * WALLET-33: Use the Perl Authen::Krb5::Admin module instead of rolling + our own kadmin code with Expect now that MIT Kerberos has made the + kadmin API public. - * Implement an ssh keypair wallet object. The server can run ssh-keygen - to generate a public/private key pair and return both to the client, - which would split them apart. Used primarily for host keys. May need - a side table to store key types, or a naming convention. + * WALLET-34: Implement an ssh keypair wallet object. The server can run + ssh-keygen to generate a public/private key pair and return both to the + client, which would split them apart. Used primarily for host keys. + May need a side table to store key types, or a naming convention. - * Implement an X.509 certificate object. I expect this would store the - public and private key as a single file in the same format that Apache - can read for combined public and private keys. There were requests for - storing the CSR, but I don't see why you'd want to do that. Start with - store support. The file code is mostly sufficient here, but it would - be nice to automatically support object expiration based on the - expiration time for the certificate. + * WALLET-35: Implement an X.509 certificate object. I expect this would + store the public and private key as a single file in the same format + that Apache can read for combined public and private keys. There were + requests for storing the CSR, but I don't see why you'd want to do + that. Start with store support. The file code is mostly sufficient + here, but it would be nice to automatically support object expiration + based on the expiration time for the certificate. - * Implement an X.509 CA so that you can get certificate objects without - storing them first. Need to resolve naming conventions if you want to - run multiple CAs on the same wallet server (but why?). Should this be - a different type than stored certificates? + * WALLET-36: Implement an X.509 CA so that you can get certificate + objects without storing them first. Need to resolve naming conventions + if you want to run multiple CAs on the same wallet server (but why?). + Should this be a different type than stored certificates? - * Support returning the checksum of a file object stored in wallet so - that one can determine whether the version stored on disk is identical. + * WALLET-37: Support returning the checksum of a file object stored in + wallet so that one can determine whether the version stored on disk is + identical. Reports: - * Add audit for references to unknown ACLs, possibly introduced by - previous versions before ACL deletion was checked with database - backends that don't do referential integrity. + * WALLET-38: Add audit for references to unknown ACLs, possibly + introduced by previous versions before ACL deletion was checked with + database backends that don't do referential integrity. - * Add report for all objects that have never been stored. + * WALLET-39: Add report for all objects that have never been stored. - * For objects tied to hostnames, report on objects referring to hosts - which do not exist. For the initial pass, this is probably only keytab - objects with names containing a slash where the part after the slash - looks like a hostname. This may need some configuration help. + * WALLET-40: For objects tied to hostnames, report on objects referring + to hosts which do not exist. For the initial pass, this is probably + only keytab objects with names containing a slash where the part after + the slash looks like a hostname. This may need some configuration + help. - * 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. + * WALLET-41: 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. Administrative Interface: - * Add a function to wallet-admin to purge expired entries. Possibly also - check expiration before allowing anyone to get or store objects. + * WALLET-42: Add a function to wallet-admin to purge expired entries. + Possibly also check expiration before allowing anyone to get or store + objects. - * Add a function or separate script to automate removal of DNS-based - objects for which the hosts no longer exist. Will need to support a - site-specific callout to determine whether the host exists. (WALLET-3) + * WALLET-3: Add a function or separate script to automate removal of + DNS-based objects for which the hosts no longer exist. Will need to + support a site-specific callout to determine whether the host exists. Documentation: - * Write a conventions document for ACL naming, object naming, and similar - issues. + * WALLET-43: Write a conventions document for ACL naming, object naming, + and similar issues. - * Write a future design and roadmap document to collect notes about how - unimplemented features should be handled. + * WALLET-44: Write a future design and roadmap document to collect notes + about how unimplemented features should be handled. - * Document using the wallet system over something other than remctl. + * WALLET-45: Document using the wallet system over something other than + remctl. - * Document all diagnostics for all wallet APIs. + * WALLET-46: Document all diagnostics for all wallet APIs. Code Style and Cleanup: - * There is a lot of duplicate code in wallet-backend. Convert that to - use some sort of data-driven model with argument count and flags so - that the method calls can be written only once. Convert wallet-admin - to use the same code. + * WALLET-47: There is a lot of duplicate code in wallet-backend. Convert + that to use some sort of data-driven model with argument count and + flags so that the method calls can be written only once. Convert + wallet-admin to use the same code. - * There's a lot of code duplication in the dispatch functions in the - Wallet::Server class. Find a way to rewrite that so that the dispatch - doesn't duplicate the same code patterns. + * WALLET-48: There's a lot of code duplication in the dispatch functions + in the Wallet::Server class. Find a way to rewrite that so that the + dispatch doesn't duplicate the same code patterns. - * The wallet-backend and wallet documentation share the COMMANDS section. - Work out some means to assemble the documentation without duplicating - content. + * WALLET-49: The wallet-backend and wallet documentation share the + COMMANDS section. Work out some means to assemble the documentation + without duplicating content. - * The Wallet::Config class is very ugly and could use some better - internal API to reference the variables in it. + * WALLET-50: The Wallet::Config class is very ugly and could use some + better internal API to reference the variables in it. - * Use Class::DBI and Class::Trigger to handle the data access layer - rather than writing SQL directly, and implement the logging + * WALLET-51: Use Class::DBI and Class::Trigger to handle the data access + layer rather than writing SQL directly, and implement the logging requirements with triggers rather than explicit SQL. This may also replace Wallet::Schema. - * Consider using Class::Accessor to get rid of the scaffolding code to - access object data, and a Wallet::Base class to handle things like the - error() method common to many classes. + * WALLET-52: Consider using Class::Accessor to get rid of the scaffolding + code to access object data, and a Wallet::Base class to handle things + like the error() method common to many classes. Test Suite: - * The ldap-attr verifier test case is awful and completely specific to - people with admin access to the Stanford LDAP tree. Write a real test. + * WALLET-53: The ldap-attr verifier test case is awful and completely + specific to people with admin access to the Stanford LDAP tree. Write + a real test. - * Rename the tests to use a subdirectory organization. + * WALLET-54: Rename the tests to use a subdirectory organization. - * Add POD coverage testing using Test::POD::Coverage for the server - modules. + * WALLET-55: Add POD coverage testing using Test::POD::Coverage for the + server modules. - * Rewrite the client test suite to use Perl and to make better use of - shared code so that it can be broken into function components. + * WALLET-56: Rewrite the client test suite to use Perl and to make better + use of shared code so that it can be broken into function components. - * Refactor the test suite for the wallet backend to try to reduce the - duplicated code. + * WALLET-57: Refactor the test suite for the wallet backend to try to + reduce the duplicated code. - * Pull common test suite code into a Perl library that can be reused. + * WALLET-58: Pull common test suite code into a Perl library that can be + reused. - * Write a test suite to scan all wallet code looking for diagnostics that - aren't in the documentation and warn about them. + * WALLET-59: Write a test suite to scan all wallet code looking for + diagnostics that aren't in the documentation and warn about them. -- cgit v1.2.3 From 13b905d2921ab6fa17007a914d020f0a7509c689 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 10 Jul 2012 10:23:21 -0700 Subject: Minor TODO update on database layer redesign --- TODO | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/TODO b/TODO index 1a35bbd..32c88d8 100644 --- a/TODO +++ b/TODO @@ -189,10 +189,10 @@ Code Style and Cleanup: * WALLET-50: The Wallet::Config class is very ugly and could use some better internal API to reference the variables in it. - * WALLET-51: Use Class::DBI and Class::Trigger to handle the data access - layer rather than writing SQL directly, and implement the logging - requirements with triggers rather than explicit SQL. This may also - replace Wallet::Schema. + * WALLET-51: Use Class::DBI and Class::Trigger (or DBIx::Class) to handle + the data access layer rather than writing SQL directly, and implement + the logging requirements with triggers rather than explicit SQL. This + may also replace Wallet::Schema. * WALLET-52: Consider using Class::Accessor to get rid of the scaffolding code to access object data, and a Wallet::Base class to handle things -- cgit v1.2.3 From 2f061f0fb15c2def0d57d0be4becdf75d2e3ffde Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Mon, 16 Jul 2012 16:37:13 -0700 Subject: Add a few more wallet ideas to TODO --- TODO | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/TODO b/TODO index 32c88d8..dd4d15e 100644 --- a/TODO +++ b/TODO @@ -129,6 +129,14 @@ Objects: wallet so that one can determine whether the version stored on disk is identical. + * WALLET-60: Implement new password wallet object, which is like file + except that it generates a random, strong password when retrieved the + first time without being stored. + + * WALLET-61: Support interrogating objects to find all host-based objects + for a particular host, allowing cleanup of all of those host's objects + after retiring the host. + Reports: * WALLET-38: Add audit for references to unknown ACLs, possibly -- cgit v1.2.3 From f7df31d3cf7580e8cccdea0110f35202b42b87d1 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Mon, 16 Jul 2012 16:51:14 -0700 Subject: Add documentation of existing wallet objects and ACL schemes --- docs/objects-and-types | 90 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 90 insertions(+) create mode 100644 docs/objects-and-types diff --git a/docs/objects-and-types b/docs/objects-and-types new file mode 100644 index 0000000..9d92c7b --- /dev/null +++ b/docs/objects-and-types @@ -0,0 +1,90 @@ + Supported Object Types and ACL Schemes + +Introduction + + This is a list of all supported wallet object types and ACL schemes in + the current version of wallet, with some brief information about the + properties of each one. For more detailed documentation, see the + documentation of the underlying Wallet::Object::* class or + Wallet::ACL::* class referenced here. + +Object Types + + file + + Stores an arbitrary file and allows retrieval of that file. The file + must be stored before it can be retrieved. All files are stored on + the local file system of the wallet server in a directory organized by + a hash of the name of the file object. The size of file objects is + limited by wallet server configuration. File contents may include nul + characters. + + Implemented via Wallet::Object::File. + + keytab + + Stores a keytab representing private keys for a given Kerberos + principal. The object name is the Kerberos principal (without the + realm). On object creation, the Kerberos principal is created in the + underlying KDC; on object destruction, the Kerberos principal is also + deleted. Normally, any retrieval of the object creates new random + keys for all supported enctypes and then returns a new keytab + containing those keys. Store is not supported. + + Keytab objects with the unchanging flag set will retrieve the existing + keys from the Kerberos KDC instead of randomizing the keys. For MIT + Kerberos, this requires a custom backend be installed on the KDC. + + The enctypes of the returned keys can be restricted by setting the + enctypes attribute on the wallet object. + + Implemented via Wallet::Object::Keytab. + +ACL Schemes + + krb5 + + The value is a string representation of a Kerberos principal name. + This ACL grants access if the authenticated wallet client user (as + determined by remctl or whatever other protocol is used for the wallet + transport) equals the ACL value. + + Implemented via Wallet::ACL::Krb5. + + krb5-regex + + Like krb5, but instead of taking the principal string, takes a regular + expression that is matched against the principal string. Grants + access if the regular expression matches the user identity. + + Implemented via Wallet::ACL::Krb5::Regex. + + ldap-attr + + The value is an LDAP attribute, an equal sign, and the value that + attribute must have. The LDAP entry for the user (determined via + site-local customization in the wallet configuration file) is + retrieved, and the wallet server checks that the user's LDAP entry + contains that attribute with that value. If so, access is granted. + This effectively implements an entitlement check. + + Implemented via Wallet::ACL::LDAP::Attribute. + + netdb + + The value is a hostname. NetDB (a system for managing DNS, DHCP, and + related machine information) is queried to see what roles the client + user has for that hostname. If the user has a role of user, admin, or + team, the ACL grants access. + + Implemented via Wallet::ACL::NetDB. + + netdb-root + + Identical to netdb, except that the user identity is taken as a + Kerberos principal and must be in the form of /root@. + The /root part is stripped before checking NetDB for roles. This + forces users to use /root instances for wallet operations instead of + their normal principals. + + Implemented via Wallet::ACL::NetDB::Root. -- cgit v1.2.3 From 6ab69d850ec27889ebc21da0bacc4aa5adf7ce97 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Mon, 16 Jul 2012 16:54:47 -0700 Subject: Add objects-and-schemes to EXTRA_DIST, rename --- Makefile.am | 40 +++++++++++---------- docs/objects-and-schemes | 90 ++++++++++++++++++++++++++++++++++++++++++++++++ docs/objects-and-types | 90 ------------------------------------------------ 3 files changed, 111 insertions(+), 109 deletions(-) create mode 100644 docs/objects-and-schemes delete mode 100644 docs/objects-and-types diff --git a/Makefile.am b/Makefile.am index 444df0b..1c42b2d 100644 --- a/Makefile.am +++ b/Makefile.am @@ -28,25 +28,27 @@ PERL_FILES = perl/Wallet/ACL.pm perl/Wallet/ACL/Base.pm \ AUTOMAKE_OPTIONS = foreign subdir-objects ACLOCAL_AMFLAGS = -I m4 -EXTRA_DIST = .gitignore LICENSE autogen client/wallet.pod \ - client/wallet-rekey.pod config/allow-extract config/keytab \ - config/keytab.acl config/wallet config/wallet-report.acl docs/design \ - contrib/README contrib/convert-srvtab-db contrib/used-principals \ - contrib/wallet-contacts contrib/wallet-summary \ - contrib/wallet-summary.8 contrib/wallet-unknown-hosts \ - docs/design-acl docs/design-api docs/netdb-role-api docs/notes \ - docs/setup docs/stanford-naming examples/stanford.conf tests/TESTS \ - tests/data/README tests/data/allow-extract tests/data/basic.conf \ - tests/data/cmd-fake tests/data/cmd-wrapper tests/data/fake-data \ - tests/data/fake-kadmin tests/data/fake-keytab \ - tests/data/fake-keytab-2 tests/data/fake-keytab-foreign \ - tests/data/fake-keytab-merge tests/data/fake-keytab-old \ - tests/data/fake-keytab-partial tests/data/fake-keytab-partial-result \ - tests/data/fake-keytab-rekey tests/data/fake-keytab-unknown \ - tests/data/fake-srvtab tests/data/full.conf tests/data/wallet.conf \ - tests/docs/pod-spelling-t tests/docs/pod-t tests/server/admin-t \ - tests/server/backend-t tests/server/keytab-t tests/server/report-t \ - tests/tap/kerberos.sh tests/tap/libtap.sh tests/tap/remctl.sh \ +EXTRA_DIST = .gitignore LICENSE autogen client/wallet.pod \ + client/wallet-rekey.pod config/allow-extract config/keytab \ + config/keytab.acl config/wallet config/wallet-report.acl \ + docs/design contrib/README contrib/convert-srvtab-db \ + contrib/used-principals contrib/wallet-contacts \ + contrib/wallet-summary contrib/wallet-summary.8 \ + contrib/wallet-unknown-hosts docs/design-acl docs/design-api \ + docs/netdb-role-api docs/notes docs/objects-and-schemes docs/setup \ + docs/stanford-naming examples/stanford.conf tests/TESTS \ + tests/data/README tests/data/allow-extract tests/data/basic.conf \ + tests/data/cmd-fake tests/data/cmd-wrapper tests/data/fake-data \ + tests/data/fake-kadmin tests/data/fake-keytab \ + tests/data/fake-keytab-2 tests/data/fake-keytab-foreign \ + tests/data/fake-keytab-merge tests/data/fake-keytab-old \ + tests/data/fake-keytab-partial \ + tests/data/fake-keytab-partial-result tests/data/fake-keytab-rekey \ + tests/data/fake-keytab-unknown tests/data/fake-srvtab \ + tests/data/full.conf tests/data/wallet.conf \ + tests/docs/pod-spelling-t tests/docs/pod-t tests/server/admin-t \ + tests/server/backend-t tests/server/keytab-t tests/server/report-t \ + tests/tap/kerberos.sh tests/tap/libtap.sh tests/tap/remctl.sh \ tests/util/xmalloc-t $(PERL_FILES) noinst_LIBRARIES = portable/libportable.a util/libutil.a diff --git a/docs/objects-and-schemes b/docs/objects-and-schemes new file mode 100644 index 0000000..9d92c7b --- /dev/null +++ b/docs/objects-and-schemes @@ -0,0 +1,90 @@ + Supported Object Types and ACL Schemes + +Introduction + + This is a list of all supported wallet object types and ACL schemes in + the current version of wallet, with some brief information about the + properties of each one. For more detailed documentation, see the + documentation of the underlying Wallet::Object::* class or + Wallet::ACL::* class referenced here. + +Object Types + + file + + Stores an arbitrary file and allows retrieval of that file. The file + must be stored before it can be retrieved. All files are stored on + the local file system of the wallet server in a directory organized by + a hash of the name of the file object. The size of file objects is + limited by wallet server configuration. File contents may include nul + characters. + + Implemented via Wallet::Object::File. + + keytab + + Stores a keytab representing private keys for a given Kerberos + principal. The object name is the Kerberos principal (without the + realm). On object creation, the Kerberos principal is created in the + underlying KDC; on object destruction, the Kerberos principal is also + deleted. Normally, any retrieval of the object creates new random + keys for all supported enctypes and then returns a new keytab + containing those keys. Store is not supported. + + Keytab objects with the unchanging flag set will retrieve the existing + keys from the Kerberos KDC instead of randomizing the keys. For MIT + Kerberos, this requires a custom backend be installed on the KDC. + + The enctypes of the returned keys can be restricted by setting the + enctypes attribute on the wallet object. + + Implemented via Wallet::Object::Keytab. + +ACL Schemes + + krb5 + + The value is a string representation of a Kerberos principal name. + This ACL grants access if the authenticated wallet client user (as + determined by remctl or whatever other protocol is used for the wallet + transport) equals the ACL value. + + Implemented via Wallet::ACL::Krb5. + + krb5-regex + + Like krb5, but instead of taking the principal string, takes a regular + expression that is matched against the principal string. Grants + access if the regular expression matches the user identity. + + Implemented via Wallet::ACL::Krb5::Regex. + + ldap-attr + + The value is an LDAP attribute, an equal sign, and the value that + attribute must have. The LDAP entry for the user (determined via + site-local customization in the wallet configuration file) is + retrieved, and the wallet server checks that the user's LDAP entry + contains that attribute with that value. If so, access is granted. + This effectively implements an entitlement check. + + Implemented via Wallet::ACL::LDAP::Attribute. + + netdb + + The value is a hostname. NetDB (a system for managing DNS, DHCP, and + related machine information) is queried to see what roles the client + user has for that hostname. If the user has a role of user, admin, or + team, the ACL grants access. + + Implemented via Wallet::ACL::NetDB. + + netdb-root + + Identical to netdb, except that the user identity is taken as a + Kerberos principal and must be in the form of /root@. + The /root part is stripped before checking NetDB for roles. This + forces users to use /root instances for wallet operations instead of + their normal principals. + + Implemented via Wallet::ACL::NetDB::Root. diff --git a/docs/objects-and-types b/docs/objects-and-types deleted file mode 100644 index 9d92c7b..0000000 --- a/docs/objects-and-types +++ /dev/null @@ -1,90 +0,0 @@ - Supported Object Types and ACL Schemes - -Introduction - - This is a list of all supported wallet object types and ACL schemes in - the current version of wallet, with some brief information about the - properties of each one. For more detailed documentation, see the - documentation of the underlying Wallet::Object::* class or - Wallet::ACL::* class referenced here. - -Object Types - - file - - Stores an arbitrary file and allows retrieval of that file. The file - must be stored before it can be retrieved. All files are stored on - the local file system of the wallet server in a directory organized by - a hash of the name of the file object. The size of file objects is - limited by wallet server configuration. File contents may include nul - characters. - - Implemented via Wallet::Object::File. - - keytab - - Stores a keytab representing private keys for a given Kerberos - principal. The object name is the Kerberos principal (without the - realm). On object creation, the Kerberos principal is created in the - underlying KDC; on object destruction, the Kerberos principal is also - deleted. Normally, any retrieval of the object creates new random - keys for all supported enctypes and then returns a new keytab - containing those keys. Store is not supported. - - Keytab objects with the unchanging flag set will retrieve the existing - keys from the Kerberos KDC instead of randomizing the keys. For MIT - Kerberos, this requires a custom backend be installed on the KDC. - - The enctypes of the returned keys can be restricted by setting the - enctypes attribute on the wallet object. - - Implemented via Wallet::Object::Keytab. - -ACL Schemes - - krb5 - - The value is a string representation of a Kerberos principal name. - This ACL grants access if the authenticated wallet client user (as - determined by remctl or whatever other protocol is used for the wallet - transport) equals the ACL value. - - Implemented via Wallet::ACL::Krb5. - - krb5-regex - - Like krb5, but instead of taking the principal string, takes a regular - expression that is matched against the principal string. Grants - access if the regular expression matches the user identity. - - Implemented via Wallet::ACL::Krb5::Regex. - - ldap-attr - - The value is an LDAP attribute, an equal sign, and the value that - attribute must have. The LDAP entry for the user (determined via - site-local customization in the wallet configuration file) is - retrieved, and the wallet server checks that the user's LDAP entry - contains that attribute with that value. If so, access is granted. - This effectively implements an entitlement check. - - Implemented via Wallet::ACL::LDAP::Attribute. - - netdb - - The value is a hostname. NetDB (a system for managing DNS, DHCP, and - related machine information) is queried to see what roles the client - user has for that hostname. If the user has a role of user, admin, or - team, the ACL grants access. - - Implemented via Wallet::ACL::NetDB. - - netdb-root - - Identical to netdb, except that the user identity is taken as a - Kerberos principal and must be in the form of /root@. - The /root part is stripped before checking NetDB for roles. This - forces users to use /root instances for wallet operations instead of - their normal principals. - - Implemented via Wallet::ACL::NetDB::Root. -- cgit v1.2.3 From af921c9cdaee72a83512ddf7ccdd269a3ee1473b Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Mon, 16 Jul 2012 16:58:37 -0700 Subject: Add NEWS entry for new object type and ACL scheme documentation --- NEWS | 3 +++ 1 file changed, 3 insertions(+) diff --git a/NEWS b/NEWS index d08cb14..6f20133 100644 --- a/NEWS +++ b/NEWS @@ -20,6 +20,9 @@ wallet 1.0 (unreleased) can only be set by the owner or wallet administrators but can be seen by anyone on the show ACL. + Add docs/objects-and-schemes, which provides a brief summary of the + current supported object types and ACL schemes. + wallet 0.12 (2010-08-25) New client program wallet-rekey that, given a list of keytabs on the -- cgit v1.2.3 From fd4eb6c452bd8b56d2a1db70c99b4828994f39c8 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 7 Aug 2012 19:23:15 -0700 Subject: Add some stopwords for POD spelling checks --- client/wallet.pod | 2 +- server/wallet-admin | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/client/wallet.pod b/client/wallet.pod index fdfe37f..a0785a5 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 uuencode getacl backend ACL's +KDC appdefaults remctld Allbery uuencode getacl backend ACL's DES =head1 SYNOPSIS diff --git a/server/wallet-admin b/server/wallet-admin index fbab72b..94d62c7 100755 --- a/server/wallet-admin +++ b/server/wallet-admin @@ -76,7 +76,7 @@ __END__ wallet-admin - Wallet server administrative commands =for stopwords -metadata ACL hostname backend acl acls wildcard SQL Allbery +metadata ACL hostname backend acl acls wildcard SQL Allbery verifier =head1 SYNOPSIS -- cgit v1.2.3 From 41eb131dc6ae8c8f5aead797703fd12aaa59a9d9 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 7 Aug 2012 19:23:30 -0700 Subject: Initial implementation of WebAuth keyring objects This is very preliminary. There is no test suite yet, no documentation, and the test suite currently doesn't pass for other reasons. --- perl/Wallet/Config.pm | 61 ++++++++++ perl/Wallet/Object/WAKeyring.pm | 249 ++++++++++++++++++++++++++++++++++++++++ 2 files changed, 310 insertions(+) create mode 100644 perl/Wallet/Object/WAKeyring.pm diff --git a/perl/Wallet/Config.pm b/perl/Wallet/Config.pm index 3f53f74..1a74506 100644 --- a/perl/Wallet/Config.pm +++ b/perl/Wallet/Config.pm @@ -378,6 +378,67 @@ our $KEYTAB_REMCTL_PORT; =back +=head1 WEBAUTH KEYRING OBJECT CONFIGURATION + +These configuration variables only need to be set if you intend to use the +C object type (the Wallet::Object::WAKeyring class). + +=over 4 + +=item WAKEYRING_BUCKET + +The directory into which to store WebAuth keyring objects. WebAuth +keyring objects will be stored in subdirectories of this directory. See +L 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. + +WAKEYRING_BUCKET must be set to use file objects. + +=cut + +our $WAKEYRING_BUCKET; + +=item WAKEYRING_REKEY_INTERVAL + +The interval, in seconds, at which new keys are generated in a keyring. +The object implementation will try to arrange for there to be keys added +to the keyring separated by this interval. + +It's useful to provide some interval to install the keyring everywhere +that it's used before the key becomes inactive. Every keyring will +therefore normally have at least three keys: one that's currently active, +one that becomes valid in the future but less than +WAKEYRING_REKEY_INTERVAL from now, and one that becomes valid between one +and two of those intervals into the future. This means that one has twice +this interval to distribute the keyring everywhere it is used. + +Internally, this is implemented by adding a new key that becomes valid in +twice this interval from the current time if the newest key becomes valid +at or less than this interval in the future. + +The default value is 60 * 60 * 24 (one day). + +=cut + +our $WAKEYRING_REKEY_INTERVAL = 60 * 60 * 24; + +=item WAKEYRING_PURGE_INTERVAL + +The interval, in seconds, from the key creation date after which keys are +removed from the keyring. This is used to clean up old keys and finish +key rotation. Keys won't be removed unless there are more than three keys +in the keyring to try to keep a misconfiguration from removing all valid +keys. + +The default value is 60 * 60 * 24 * 90 (90 days). + +=cut + +our $WAKEYRING_PURGE_INTERVAL = 60 * 60 * 24 * 90; + +=back + =head1 LDAP ACL CONFIGURATION These configuration variables are only needed if you intend to use the diff --git a/perl/Wallet/Object/WAKeyring.pm b/perl/Wallet/Object/WAKeyring.pm new file mode 100644 index 0000000..20d3047 --- /dev/null +++ b/perl/Wallet/Object/WAKeyring.pm @@ -0,0 +1,249 @@ +# Wallet::Object::WAKeyring -- WebAuth keyring object implementation. +# +# Written by Russ Allbery +# Copyright 2012 +# The Board of Trustees of the Leland Stanford Junior University +# +# See LICENSE for licensing terms. + +############################################################################## +# Modules and declarations +############################################################################## + +package Wallet::Object::WAKeyring; +require 5.006; + +use strict; +use vars qw(@ISA $VERSION); + +use Digest::MD5 qw(md5_hex); +use Fcntl qw(LOCK_EX); +use Wallet::Config (); +use Wallet::Object::Base; +use WebAuth qw(WA_KEY_AES WA_AES_128); + +@ISA = qw(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.01'; + +############################################################################## +# File naming +############################################################################## + +# Returns the path into which that keyring object will be stored or undef on +# error. On error, sets the internal error. +sub file_path { + my ($self) = @_; + my $name = $self->{name}; + unless ($Wallet::Config::WAKEYRING_BUCKET) { + $self->error ('WebAuth keyring support not configured'); + return; + } + unless ($name) { + $self->error ('WebAuth keyring objects may not have empty names'); + return; + } + my $hash = substr (md5_hex ($name), 0, 2); + $name =~ s/([^\w-])/sprintf ('%%%02X', ord ($1))/ge; + my $parent = "$Wallet::Config::WAKEYRING_BUCKET/$hash"; + unless (-d $parent || mkdir ($parent, 0700)) { + $self->error ("cannot create file bucket $hash: $!"); + return; + } + return "$Wallet::Config::WAKEYRING_BUCKET/$hash/$name"; +} + +############################################################################## +# Core methods +############################################################################## + +# Override destroy to delete the file as well. +sub destroy { + my ($self, $user, $host, $time) = @_; + my $id = $self->{type} . ':' . $self->{name}; + my $path = $self->file_path; + if (defined ($path) && -f $path && !unlink ($path)) { + $self->error ("cannot delete $id: $!"); + return; + } + return $self->SUPER::destroy ($user, $host, $time); +} + +# Update the keyring if needed, and then return the contents of the current +# keyring. +sub get { + my ($self, $user, $host, $time) = @_; + $time ||= time; + my $id = $self->{type} . ':' . $self->{name}; + if ($self->flag_check ('locked')) { + $self->error ("cannot get $id: object is locked"); + return; + } + my $path = $self->file_path; + + # Create a WebAuth context and ensure we can load the relevant modules. + my $wa = eval { WebAuth->new }; + if ($@) { + $self->error ("cannot initialize WebAuth: $@"); + return; + } + + # Check if the keyring already exists. If not, create a new one with a + # single key that's immediately valid and two more that will become valid + # in the future. + # + # If the keyring does already exist, get a lock on the file. At the end + # of this process, we'll do an atomic update and then drop our lock. + # + # FIXME: There are probably better ways to do this. There are some race + # conditions here, particularly with new keyrings. + unless (open (FILE, '+<', $path)) { + my $data; + eval { + my $key = $wa->key_create (WA_KEY_AES, WA_AES_128); + my $ring = $wa->keyring_new ($key); + $key = $wa->key_create (WA_KEY_AES, WA_AES_128); + my $valid = time + $Wallet::Config::WAKEYRING_REKEY_INTERVAL; + $ring->add (time, $valid, $key); + $key = $wa->key_create (WA_KEY_AES, WA_AES_128); + $valid += $Wallet::Config::WAKEYRING_REKEY_INTERVAL; + $ring->add (time, $valid, $key); + $data = $ring->encode; + $ring->write ($path); + }; + if ($@) { + $self->error ("cannot create new keyring"); + return; + }; + $self->log_action ('get', $user, $host, $time); + return $data; + } + unless (flock (FILE, LOCK_EX)) { + $self->error ("cannot get lock on keyring: $!"); + return; + } + + # Read the keyring. + my $ring = eval { WebAuth::Keyring->read ($path) }; + if ($@) { + $self->error ("cannot read keyring: $@"); + return; + } + + # If the most recent key has a valid-after older than now + + # WAKEYRING_REKEY_INTERVAL, we generate a new key with a valid_after of + # now + 2 * WAKEYRING_REKEY_INTERVAL. + my ($count, $newest) = (0, 0); + for my $entry ($ring->entries) { + $count++; + if ($entry->valid_after > $newest) { + $newest = $entry->valid_after; + } + } + eval { + if ($newest <= time + $Wallet::Config::WAKEYRING_REKEY_INTERVAL) { + my $valid = time + 2 * $Wallet::Config::WAKEYRING_REKEY_INTERVAL; + my $key = $wa->key_create (WA_KEY_AES, WA_AES_128); + $ring->add (time, $valid, $key); + } + }; + if ($@) { + $self->error ("cannot add new key: $@"); + return; + } + + # If there are any keys older than the purge interval, remove them, but + # only do so if we have more than three keys (the one that's currently + # active, the one that's going to come active in the rekey interval, and + # the one that's going to come active after that. + my $cutoff = time - $Wallet::Config::WAKEYRING_PURGE_INTERVAL; + my $i = 0; + my @purge; + if ($count > 3) { + for my $entry ($ring->entries) { + if ($entry->creation < $cutoff) { + push (@purge, $i); + } + $i++; + } + } + if (@purge) { + eval { + for my $key (reverse @purge) { + $ring->remove ($key); + } + }; + if ($@) { + $self->error ("cannot remove old keys: $@"); + return; + } + } + + # Encode the key. + my $data = eval { $ring->encode }; + if ($@) { + $self->error ("cannot encode keyring: $@"); + return; + } + + # Write the new keyring to the path. + eval { $ring->write ($path) }; + if ($@) { + $self->error ("cannot store new keyring: $@"); + return; + } + close FILE; + $self->log_action ('get', $user, $host, $time); + return $data; +} + +# Store the file on the wallet server. +sub store { + my ($self, $data, $user, $host, $time) = @_; + $time ||= time; + my $id = $self->{type} . ':' . $self->{name}; + if ($self->flag_check ('locked')) { + $self->error ("cannot store $id: object is locked"); + return; + } + if ($Wallet::Config::FILE_MAX_SIZE) { + my $max = $Wallet::Config::FILE_MAX_SIZE; + if (length ($data) > $max) { + $self->error ("data exceeds maximum of $max bytes"); + return; + } + } + my $path = $self->file_path; + return unless $path; + unless (open (FILE, '>', $path)) { + $self->error ("cannot store $id: $!"); + return; + } + unless (print FILE ($data) and close FILE) { + $self->error ("cannot store $id: $!"); + close FILE; + return; + } + $self->log_action ('store', $user, $host, $time); + return 1; +} + +1; +__END__ + +############################################################################## +# Documentation +############################################################################## + +=head1 NAME + +Wallet::Object::WAKeyring - WebAuth keyring object implementation for wallet + +=head1 DESCRIPTION + +To be written. + +=cut -- cgit v1.2.3 From 1ef5fb36c40daf0439a1c786796fa6e4628bc212 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Thu, 30 Aug 2012 13:28:19 -0700 Subject: Add additional TODOs for initial keying and contacting owners --- TODO | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/TODO b/TODO index dd4d15e..1815d0d 100644 --- a/TODO +++ b/TODO @@ -59,6 +59,11 @@ Server Interface: * WALLET-22: Remove the hard-coded ADMIN ACL in the server with something more configurable, perhaps a global ACL table or something. + * WALLET-63: Support leap-of-faith keying of systems by registering an + object for one-time download (ideally from a specific IP address) and + then allowing that object to be downloaded anonymously from that IP. + Relies on support for Kerberos anonymous authentication. + ACLs: * WALLET-23: Error messages from ACL operations should refer to the ACLs @@ -156,6 +161,11 @@ Reports: Enhance it to report on any sort of object, not just on keytabs, and to give numbers on downloaded versus not downloaded objects. + * WALLET-62: Write a tool to mail the owners of wallet objects, taking + the list of objects and the mail message to send as inputs. This could + possibly use the notification service, although a version that sends + mail directly would be useful external to Stanford. + Administrative Interface: * WALLET-42: Add a function to wallet-admin to purge expired entries. -- cgit v1.2.3 From 47680970fb76105a45ca889a3e98a9664af5eb7a Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Thu, 30 Aug 2012 14:09:26 -0700 Subject: Attempt kinit --no-afslog first in Perl test suite Avoid tromping on the user's AFS credentials if using Heimdal user space. --- perl/t/lib/Util.pm | 1 + 1 file changed, 1 insertion(+) diff --git a/perl/t/lib/Util.pm b/perl/t/lib/Util.pm index 44a4d21..8bbefc4 100644 --- a/perl/t/lib/Util.pm +++ b/perl/t/lib/Util.pm @@ -74,6 +74,7 @@ sub db_setup { sub getcreds { my ($file, $principal) = @_; my @commands = ( + "kinit --no-afslog -k -t $file $principal >/dev/null 2>&1 /dev/null 2>&1 /dev/null 2>&1 /dev/null 2>&1 Date: Thu, 30 Aug 2012 14:44:44 -0700 Subject: Display the error message on the first kadmin test failure --- perl/t/kadmin.t | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/perl/t/kadmin.t b/perl/t/kadmin.t index a1f2876..778bc45 100755 --- a/perl/t/kadmin.t +++ b/perl/t/kadmin.t @@ -3,12 +3,13 @@ # Tests for the kadmin object implementation. # # Written by Jon Robertson -# Copyright 2009, 2010 Board of Trustees, Leland Stanford Jr. University +# Copyright 2009, 2010, 2012 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. use POSIX qw(strftime); -use Test::More tests => 32; +use Test::More tests => 33; BEGIN { $Wallet::Config::KEYTAB_TMP = '.' } @@ -94,6 +95,7 @@ SKIP: { # Create the principal and check that keytab returns something. We'll # check the details of the return in the keytab check. is ($kadmin->create ('wallet/one'), 1, 'Creating wallet/one works'); + is ($kadmin->error, undef, ' with no error message'); is ($kadmin->exists ('wallet/one'), 1, ' and it now exists'); my $data = $kadmin->keytab_rekey ('wallet/one'); ok (defined ($data), ' and retrieving a keytab works'); -- cgit v1.2.3 From 0d6c9d3b1c0d63fb22588e0e461912a7e00bec25 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Thu, 30 Aug 2012 14:47:15 -0700 Subject: In show, handle undefined columns Some database drivers, such as current SQLite, will return undef for a data column that is set to NULL instead of the empty string. Skip past those data columns without attempting to examine the length of the resulting data. --- perl/Wallet/Object/Base.pm | 1 + 1 file changed, 1 insertion(+) diff --git a/perl/Wallet/Object/Base.pm b/perl/Wallet/Object/Base.pm index 28ec6b9..556cb27 100644 --- a/perl/Wallet/Object/Base.pm +++ b/perl/Wallet/Object/Base.pm @@ -610,6 +610,7 @@ sub show { # 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) { + next unless defined $data[$i]; if ($attrs[$i][0] eq 'ob_comment' && length ($data[$i]) > 79 - 17) { local $Text::Wrap::columns = 80; local $Text::Wrap::unexpand = 0; -- cgit v1.2.3 From e43dd833852f40fb6e9356e7ff8904455d1646ea Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Thu, 30 Aug 2012 14:56:08 -0700 Subject: Fix test counts and an error in the MIT keytab test suite --- perl/t/keytab.t | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/perl/t/keytab.t b/perl/t/keytab.t index fabdc5b..68cd2b4 100755 --- a/perl/t/keytab.t +++ b/perl/t/keytab.t @@ -9,7 +9,7 @@ # See LICENSE for licensing terms. use POSIX qw(strftime); -use Test::More tests => 135; +use Test::More tests => 139; BEGIN { $Wallet::Config::KEYTAB_TMP = '.' } @@ -399,15 +399,15 @@ SKIP: { # Finally we can test. First the MIT Kerberos tests. SKIP: { - skip 'skipping MIT unchanging tests for Heimdal', 12 + skip 'skipping MIT unchanging tests for Heimdal', 16 if (lc ($Wallet::Config::KEYTAB_KRBTYPE) eq 'heimdal'); # We need remctld and Net::Remctl. my @path = (split (':', $ENV{PATH}), '/usr/local/sbin', '/usr/sbin'); my ($remctld) = grep { -x $_ } map { "$_/remctld" } @path; - skip 'remctld not found', 12 unless $remctld; + skip 'remctld not found', 16 unless $remctld; eval { require Net::Remctl }; - skip 'Net::Remctl not available', 12 if $@; + skip 'Net::Remctl not available', 16 if $@; # Now spawn our remctld server and get a ticket cache. remctld_spawn ($remctld, $principal, 't/data/test.keytab', @@ -441,7 +441,7 @@ SKIP: { ' and we get the same thing the second time'); is ($one->flag_clear ('unchanging', @trace), 1, 'Clearing the unchanging flag works'); - my $data = $object->get (@trace); + my $data = $one->get (@trace); ok (defined ($data), ' and getting the keytab works'); ok (keytab_valid ($data, 'wallet/one'), ' and the keytab is valid'); is ($two->get (@trace), undef, 'Get for wallet/two does not work'); -- cgit v1.2.3 From fef66a4c6ca0c452ce9af641469c831e36399c19 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Thu, 30 Aug 2012 14:57:10 -0700 Subject: Fix POD stopwords and formatting Fix a formatting error in Wallet::ACL::LDAP::Attribute and add new stopwords required by the latest aspell. --- perl/Wallet/ACL.pm | 2 +- perl/Wallet/ACL/Base.pm | 2 +- perl/Wallet/ACL/Krb5.pm | 2 +- perl/Wallet/ACL/Krb5/Regex.pm | 2 +- perl/Wallet/ACL/LDAP/Attribute.pm | 6 +++++- perl/Wallet/ACL/NetDB.pm | 2 +- perl/Wallet/ACL/NetDB/Root.pm | 2 +- perl/Wallet/Admin.pm | 2 +- perl/Wallet/Config.pm | 2 +- perl/Wallet/Kadmin/Heimdal.pm | 2 +- perl/Wallet/Kadmin/MIT.pm | 1 + perl/Wallet/Object/Base.pm | 2 +- perl/Wallet/Object/Keytab.pm | 2 +- perl/Wallet/Schema.pm | 2 +- perl/Wallet/Server.pm | 2 +- 15 files changed, 19 insertions(+), 14 deletions(-) diff --git a/perl/Wallet/ACL.pm b/perl/Wallet/ACL.pm index 44a82b2..2a06442 100644 --- a/perl/Wallet/ACL.pm +++ b/perl/Wallet/ACL.pm @@ -442,7 +442,7 @@ __END__ Wallet::ACL - Implementation of ACLs in the wallet system =for stopwords -ACL DBH metadata HOSTNAME DATETIME timestamp Allbery +ACL DBH metadata HOSTNAME DATETIME timestamp Allbery verifier verifiers =head1 SYNOPSIS diff --git a/perl/Wallet/ACL/Base.pm b/perl/Wallet/ACL/Base.pm index 9a8a3cb..85eaefa 100644 --- a/perl/Wallet/ACL/Base.pm +++ b/perl/Wallet/ACL/Base.pm @@ -60,7 +60,7 @@ __END__ ############################################################################## =for stopwords -ACL Allbery +ACL Allbery verifier verifiers =head1 NAME diff --git a/perl/Wallet/ACL/Krb5.pm b/perl/Wallet/ACL/Krb5.pm index 496fcf0..12be141 100644 --- a/perl/Wallet/ACL/Krb5.pm +++ b/perl/Wallet/ACL/Krb5.pm @@ -51,7 +51,7 @@ __END__ ############################################################################## =for stopwords -ACL krb5 Allbery +ACL krb5 Allbery verifier =head1 NAME diff --git a/perl/Wallet/ACL/Krb5/Regex.pm b/perl/Wallet/ACL/Krb5/Regex.pm index 52f4bf5..8f9702e 100644 --- a/perl/Wallet/ACL/Krb5/Regex.pm +++ b/perl/Wallet/ACL/Krb5/Regex.pm @@ -56,7 +56,7 @@ __END__ ############################################################################## =for stopwords -ACL krb5-regex Durkacz Allbery +ACL krb5-regex Durkacz Allbery verifier =head1 NAME diff --git a/perl/Wallet/ACL/LDAP/Attribute.pm b/perl/Wallet/ACL/LDAP/Attribute.pm index 7a54546..802c710 100644 --- a/perl/Wallet/ACL/LDAP/Attribute.pm +++ b/perl/Wallet/ACL/LDAP/Attribute.pm @@ -141,7 +141,7 @@ sub check { ############################################################################## =for stopwords -ACL Allbery +ACL Allbery verifier LDAP PRINCIPAL's DN ldap-attr =head1 NAME @@ -174,6 +174,8 @@ information about how to set wallet configuration. =head1 METHODS +=over 4 + =item new() Creates a new ACL verifier. Opens and binds the connection to the LDAP @@ -197,6 +199,8 @@ Returns the error if check() returned undef. The new() method may fail with one of the following exceptions: +=over 4 + =item LDAP attribute ACL support not available: %s Attempting to connect or bind to the LDAP server failed. diff --git a/perl/Wallet/ACL/NetDB.pm b/perl/Wallet/ACL/NetDB.pm index 0fb5a2c..0aa8958 100644 --- a/perl/Wallet/ACL/NetDB.pm +++ b/perl/Wallet/ACL/NetDB.pm @@ -136,7 +136,7 @@ __END__ ############################################################################## =for stopwords -ACL NetDB remctl DNS DHCP Allbery netdb +ACL NetDB remctl DNS DHCP Allbery netdb verifier =head1 NAME diff --git a/perl/Wallet/ACL/NetDB/Root.pm b/perl/Wallet/ACL/NetDB/Root.pm index 3aeebda..c28bb1e 100644 --- a/perl/Wallet/ACL/NetDB/Root.pm +++ b/perl/Wallet/ACL/NetDB/Root.pm @@ -49,7 +49,7 @@ sub check { ############################################################################## =for stopwords -ACL NetDB DNS DHCP Allbery +ACL NetDB DNS DHCP Allbery verifier =head1 NAME diff --git a/perl/Wallet/Admin.pm b/perl/Wallet/Admin.pm index 8fb49af..a1aef83 100644 --- a/perl/Wallet/Admin.pm +++ b/perl/Wallet/Admin.pm @@ -178,7 +178,7 @@ __DATA__ Wallet::Admin - Wallet system administrative interface =for stopwords -ACL hostname Allbery +ACL hostname Allbery verifier =head1 SYNOPSIS diff --git a/perl/Wallet/Config.pm b/perl/Wallet/Config.pm index 1a74506..cd4e569 100644 --- a/perl/Wallet/Config.pm +++ b/perl/Wallet/Config.pm @@ -27,7 +27,7 @@ Wallet::Config - Configuration handling for the wallet server DBI DSN SQLite subdirectories KEYTAB keytab kadmind KDC add-ons kadmin DNS SRV kadmin keytabs remctl backend lowercased NETDB ACL NetDB unscoped usernames rekey hostnames Allbery wallet-backend keytab-backend Heimdal -rekeys +rekeys WebAuth WEBAUTH keyring LDAP DN GSS-API =head1 SYNOPSIS diff --git a/perl/Wallet/Kadmin/Heimdal.pm b/perl/Wallet/Kadmin/Heimdal.pm index 658ac04..6c91b1d 100644 --- a/perl/Wallet/Kadmin/Heimdal.pm +++ b/perl/Wallet/Kadmin/Heimdal.pm @@ -234,7 +234,7 @@ __END__ ############################################################################## =for stopwords -keytabs keytab kadmin KDC API Allbery Heimdal +keytabs keytab kadmin KDC API Allbery Heimdal unlinked =head1 NAME diff --git a/perl/Wallet/Kadmin/MIT.pm b/perl/Wallet/Kadmin/MIT.pm index fc4d271..c191bc9 100644 --- a/perl/Wallet/Kadmin/MIT.pm +++ b/perl/Wallet/Kadmin/MIT.pm @@ -256,6 +256,7 @@ __END__ =for stopwords rekeying rekeys remctl backend keytabs keytab kadmin KDC API Allbery +unlinked =head1 NAME diff --git a/perl/Wallet/Object/Base.pm b/perl/Wallet/Object/Base.pm index 556cb27..87506f4 100644 --- a/perl/Wallet/Object/Base.pm +++ b/perl/Wallet/Object/Base.pm @@ -695,7 +695,7 @@ Wallet::Object::Base - Generic parent class for wallet objects =for stopwords DBH HOSTNAME DATETIME ACL backend metadata timestamp Allbery wallet-backend -backend-specific +backend-specific subclasses =head1 SYNOPSIS diff --git a/perl/Wallet/Object/Keytab.pm b/perl/Wallet/Object/Keytab.pm index b7c2805..fd3001f 100644 --- a/perl/Wallet/Object/Keytab.pm +++ b/perl/Wallet/Object/Keytab.pm @@ -347,7 +347,7 @@ __END__ =for stopwords keytab API KDC keytabs HOSTNAME DATETIME enctypes enctype DBH metadata -unmanaged kadmin Allbery +unmanaged kadmin Allbery unlinked =head1 NAME diff --git a/perl/Wallet/Schema.pm b/perl/Wallet/Schema.pm index 5c6b9ca..9a7fe44 100644 --- a/perl/Wallet/Schema.pm +++ b/perl/Wallet/Schema.pm @@ -171,7 +171,7 @@ Wallet::Schema - Database schema for the wallet system =for stopwords SQL ACL API APIs enums Enums Keytab Backend keytab backend enctypes -enctype Allbery Metadata metadata +enctype Allbery Metadata metadata verifier =head1 SYNOPSIS diff --git a/perl/Wallet/Server.pm b/perl/Wallet/Server.pm index 7b3fb8f..b2bae2c 100644 --- a/perl/Wallet/Server.pm +++ b/perl/Wallet/Server.pm @@ -753,7 +753,7 @@ Wallet::Server - Wallet system server implementation =for stopwords keytabs metadata backend HOSTNAME ACL timestamp ACL's nul Allbery -backend-specific wallet-backend +backend-specific wallet-backend verifier =head1 SYNOPSIS -- cgit v1.2.3 From c82a0a11a1306a805a3db5813e26bef72984db4c Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Thu, 30 Aug 2012 14:57:44 -0700 Subject: Clean up a file created by the MIT keytab tests --- perl/t/keytab.t | 1 + 1 file changed, 1 insertion(+) diff --git a/perl/t/keytab.t b/perl/t/keytab.t index 68cd2b4..01def75 100755 --- a/perl/t/keytab.t +++ b/perl/t/keytab.t @@ -451,6 +451,7 @@ SKIP: { is ($one->destroy (@trace), 1, 'Destroying wallet/one works'); is ($two->destroy (@trace), 1, ' as does destroying wallet/two'); remctld_stop; + unlink 'krb5cc_good'; } # Now Heimdal. Since the keytab contains timestamps, before testing for -- cgit v1.2.3 From 7066c8e0c0ea5ce30311459fb1a857b583e63c06 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Wed, 3 Oct 2012 17:35:09 -0700 Subject: Add splitting get and update to TODO --- TODO | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/TODO b/TODO index 1815d0d..fd49abc 100644 --- a/TODO +++ b/TODO @@ -64,6 +64,12 @@ Server Interface: then allowing that object to be downloaded anonymously from that IP. Relies on support for Kerberos anonymous authentication. + * WALLET-64: Split "get" and "update" in semantics, and only do keytab + rekeying on update. "get" would not be permitted unless the keytab was + flagged as unchanging, and update would still change even an unchanging + keytab (maybe). Or, alternately, maybe we allow get of any keytab? + Requires more thought. + ACLs: * WALLET-23: Error messages from ACL operations should refer to the ACLs -- cgit v1.2.3 From d2b811335137ad10ca9489582f31d2d5c595f7f7 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Sun, 4 Nov 2012 09:30:58 -0800 Subject: Minor improvement to the Wallet::Kadmin test suite --- perl/t/kadmin.t | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/perl/t/kadmin.t b/perl/t/kadmin.t index 778bc45..cefd80d 100755 --- a/perl/t/kadmin.t +++ b/perl/t/kadmin.t @@ -9,7 +9,7 @@ # See LICENSE for licensing terms. use POSIX qw(strftime); -use Test::More tests => 33; +use Test::More tests => 34; BEGIN { $Wallet::Config::KEYTAB_TMP = '.' } @@ -73,7 +73,7 @@ SKIP: { # implementation is configured. This retests some things that are also tested # by the keytab test, but specifically through the Wallet::Kadmin API. SKIP: { - skip 'no keytab configuration', 14 unless -f 't/data/test.keytab'; + skip 'no keytab configuration', 15 unless -f 't/data/test.keytab'; # Set up our configuration. $Wallet::Config::KEYTAB_FILE = 't/data/test.keytab'; @@ -91,6 +91,7 @@ SKIP: { is ($@, '', ' and there is no error'); is ($kadmin->destroy ('wallet/one'), 1, 'Deleting wallet/one works'); is ($kadmin->exists ('wallet/one'), 0, ' and it does not exist'); + is ($kadmin->error, undef, ' with no error message'); # Create the principal and check that keytab returns something. We'll # check the details of the return in the keytab check. -- cgit v1.2.3 From 5af748e6ab1dde5eb48c5316ca572be774fc5b77 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Sun, 4 Nov 2012 09:32:23 -0800 Subject: Adjust test suite to remove unused variables --- tests/portable/snprintf-t.c | 3 +-- tests/util/xmalloc-t | 8 ++++---- tests/util/xmalloc.c | 6 ++---- 3 files changed, 7 insertions(+), 10 deletions(-) diff --git a/tests/portable/snprintf-t.c b/tests/portable/snprintf-t.c index fd4c228..4b64f5b 100644 --- a/tests/portable/snprintf-t.c +++ b/tests/portable/snprintf-t.c @@ -110,7 +110,7 @@ test_format(bool trunc, const char *expected, int count, int main(void) { - int n, i, count; + int i, count; unsigned int j; long lcount; char lgbuf[128]; @@ -153,7 +153,6 @@ main(void) is_int(31, lcount, "correct output from long %%ln"); test_format(true, "(null)", 6, "%s", NULL); - n = 26; for (i = 0; fp_formats[i] != NULL; i++) for (j = 0; j < ARRAY_SIZE(fp_nums); j++) { count = sprintf(lgbuf, fp_formats[i], fp_nums[j]); diff --git a/tests/util/xmalloc-t b/tests/util/xmalloc-t index 02f54b5..67d95f6 100755 --- a/tests/util/xmalloc-t +++ b/tests/util/xmalloc-t @@ -95,10 +95,10 @@ ok_xmalloc "calloc fail" 1 \ "failed to calloc 3500000 bytes at xmalloc.c line 148" \ "c" "3500000" "3500000" ok_xmalloc "asprintf fail" 1 \ - "failed to asprintf 3500000 bytes at xmalloc.c line 173" \ + "failed to asprintf 3500000 bytes at xmalloc.c line 172" \ "a" "3500000" "3500000" ok_xmalloc "vasprintf fail" 1 \ - "failed to vasprintf 3500000 bytes at xmalloc.c line 193" \ + "failed to vasprintf 3500000 bytes at xmalloc.c line 192" \ "v" "3500000" "3500000" # Check our custom error handler. @@ -112,9 +112,9 @@ ok_xmalloc "strndup custom" 1 "strndup 3500000 xmalloc.c 124" \ "N" "3500000" "3500000" ok_xmalloc "calloc custom" 1 "calloc 3500000 xmalloc.c 148" \ "C" "3500000" "3500000" -ok_xmalloc "asprintf custom" 1 "asprintf 3500000 xmalloc.c 173" \ +ok_xmalloc "asprintf custom" 1 "asprintf 3500000 xmalloc.c 172" \ "A" "3500000" "3500000" -ok_xmalloc "vasprintf custom" 1 "vasprintf 3500000 xmalloc.c 193" \ +ok_xmalloc "vasprintf custom" 1 "vasprintf 3500000 xmalloc.c 192" \ "V" "3500000" "3500000" # Check the smaller ones again just for grins. diff --git a/tests/util/xmalloc.c b/tests/util/xmalloc.c index b6f4564..c37396e 100644 --- a/tests/util/xmalloc.c +++ b/tests/util/xmalloc.c @@ -177,13 +177,12 @@ static int test_asprintf(size_t size) { char *copy, *string; - int status; size_t i; string = xmalloc(size); memset(string, 42, size - 1); string[size - 1] = '\0'; - status = xasprintf(©, "%s", string); + xasprintf(©, "%s", string); free(string); for (i = 0; i < size - 1; i++) if (copy[i] != 42) @@ -217,13 +216,12 @@ static int test_vasprintf(size_t size) { char *copy, *string; - int status; size_t i; string = xmalloc(size); memset(string, 42, size - 1); string[size - 1] = '\0'; - status = xvasprintf_wrapper(©, "%s", string); + xvasprintf_wrapper(©, "%s", string); free(string); for (i = 0; i < size - 1; i++) if (copy[i] != 42) -- cgit v1.2.3 From ad0dd8ded5cc0896f6bc41fab435026e75a72eed Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Sun, 4 Nov 2012 09:38:48 -0800 Subject: Add stopwords for the preliminary Wallet::Object::WAKeyring docs --- perl/Wallet/Object/WAKeyring.pm | 3 +++ 1 file changed, 3 insertions(+) diff --git a/perl/Wallet/Object/WAKeyring.pm b/perl/Wallet/Object/WAKeyring.pm index 20d3047..e80df18 100644 --- a/perl/Wallet/Object/WAKeyring.pm +++ b/perl/Wallet/Object/WAKeyring.pm @@ -238,6 +238,9 @@ __END__ # Documentation ############################################################################## +=for stopwords +WebAuth keyring + =head1 NAME Wallet::Object::WAKeyring - WebAuth keyring object implementation for wallet -- cgit v1.2.3 From 357532f312aea30ab5b3e459ccf19f1580b29262 Mon Sep 17 00:00:00 2001 From: Russ Allbery 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(-) 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, C, C, C, -C, C, C, C, and C. All -of those commands have their own ACLs except C and C, -which use the C ACL, C, which uses the C ACL, and -C, which uses the owner or C 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, -C, C, C, C, C, and C -access is permitted if the user is authorized by the owner ACL of the -object. +administrators. The exceptions are C, C, C, +C, C, C, C, C, C, +C, and C. C and C can be run by +anyone. All of the rest of those commands have their own ACLs except +C and C, which use the C ACL, C, which +uses the C ACL, and C, which uses the owner or C 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, C, C, C, C, C, +and C 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 -and C. For C and C, they must still be authorized by +and C. For C and C, 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. =item acl add -Adds an entry with and to the ACL . may be +Add an entry with and to the ACL . may be either the name of an ACL or its numeric identifier. +=item acl check + +Check whether an ACL with the ID already exists. If it does, prints +C; if not, prints C. + =item acl create Create a new, empty ACL with 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 -# 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 -# 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 ACL). The exceptions are C, C, C, -C, C, C, C, C, C, -and C. All of those commands have their own ACLs except +C ACL). The exceptions are C, C, C, +C, C, C, C, C, C, +C, and C. C and C can be run by +anyone. All of the rest of those commands have their own ACLs except C and C, which use the C ACL, C, which -uses the C ACL, and C, which uses the owner or C -ACL depending on whether one is setting or retrieving the comment. If the +uses the C ACL, and C, which uses the owner or C 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, C, C, C, C, C, and C access is permitted if the user is authorized by the owner -ACL of the object. C 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 and C. For C and C, they must still be authorized by @@ -404,9 +412,14 @@ For more information on attributes, see L. =item acl add -Adds an entry with and to the ACL . may be +Add an entry with and to the ACL . may be either the name of an ACL or its numeric identifier. +=item acl check + +Check whether an ACL with the ID already exists. If it does, prints +C; if not, prints C. + =item acl create Create a new, empty ACL with 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 -# 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 4233c32088adef91b7b41143473e54c2810b0767 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 8 Jan 2013 13:15:08 -0800 Subject: Add Wallet::Object::WAKeyring documentation Change-Id: I12e430acd089de5ac50f62ebbdeb869be31eeeec Reviewed-on: https://gerrit.stanford.edu/711 Reviewed-by: Russ Allbery Tested-by: Russ Allbery --- perl/Wallet/Object/WAKeyring.pm | 123 +++++++++++++++++++++++++++++++++++++++- 1 file changed, 120 insertions(+), 3 deletions(-) diff --git a/perl/Wallet/Object/WAKeyring.pm b/perl/Wallet/Object/WAKeyring.pm index e80df18..300bcda 100644 --- a/perl/Wallet/Object/WAKeyring.pm +++ b/perl/Wallet/Object/WAKeyring.pm @@ -1,7 +1,7 @@ # Wallet::Object::WAKeyring -- WebAuth keyring object implementation. # # Written by Russ Allbery -# Copyright 2012 +# Copyright 2012, 2013 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -159,6 +159,8 @@ sub get { # only do so if we have more than three keys (the one that's currently # active, the one that's going to come active in the rekey interval, and # the one that's going to come active after that. + # + # FIXME: Be sure that we don't remove the last currently-valid key. my $cutoff = time - $Wallet::Config::WAKEYRING_PURGE_INTERVAL; my $i = 0; my @purge; @@ -201,6 +203,8 @@ sub get { } # Store the file on the wallet server. +# +# FIXME: Check the provided keyring for validity. sub store { my ($self, $data, $user, $host, $time) = @_; $time ||= time; @@ -239,14 +243,127 @@ __END__ ############################################################################## =for stopwords -WebAuth keyring +WebAuth keyring keyrings API HOSTNAME DATETIME keytab AES rekey Allbery =head1 NAME Wallet::Object::WAKeyring - WebAuth keyring object implementation for wallet +=head1 SYNOPSIS + + my ($user, $host, $time); + my @name = qw(wa-keyring www.stanford.edu); + my @trace = ($user, $host, $time); + my $object = Wallet::Object::WAKeyring->create (@name, $dbh, $trace); + my $keyring = $object->get (@trace); + unless ($object->store ($keyring)) { + die $object->error, "\n"; + } + $object->destroy (@trace); + =head1 DESCRIPTION -To be written. +Wallet::Object::WAKeyring is a representation of a WebAuth keyring in the +wallet. It implements the wallet object API and provides the necessary +glue to store a keyring on the wallet server, retrieve it, update the +keyring with new keys automatically as needed, purge old keys +automatically, and delete the keyring when the object is deleted. + +WebAuth keyrings hold one or more keys. Each key has a creation time and +a validity time. The key cannot be used until its validity time has been +reached. This permits safe key rotation: a new key is added with a +validity time in the future, and then the keyring is updated everywhere it +needs to be before that validity time is reached. This wallet object +automatically handles key rotation by adding keys with validity dates in +the future and removing keys with creation dates substantially in the +past. + +To use this object, various configuration options specifying where to +store the keyrings and how to handle key rotation must be set. See +Wallet::Config for details on these configuration parameters and +information about how to set wallet configuration. + +=head1 METHODS + +This object mostly inherits from Wallet::Object::Base. See the +documentation for that class for all generic methods. Below are only +those methods that are overridden or behave specially for this +implementation. + +=over 4 + +=item destroy(PRINCIPAL, HOSTNAME [, DATETIME]) + +Destroys a WebAuth keyring object by removing it from the database and +deleting the corresponding file on the wallet server. Returns true on +success and false on failure. The caller should call error() to get the +error message after a failure. PRINCIPAL, HOSTNAME, and DATETIME are +stored as history information. PRINCIPAL should be the user who is +destroying the object. If DATETIME isn't given, the current time is used. + +=item get(PRINCIPAL, HOSTNAME [, DATETIME]) + +Either creates a new WebAuth keyring (if this object has not bee stored or +retrieved before) or does any necessary periodic maintenance on the +keyring and then returns its data. The caller should call error() to get +the error message if get() returns undef. PRINCIPAL, HOSTNAME, and +DATETIME are stored as history information. PRINCIPAL should be the user +who is downloading the keytab. If DATETIME isn't given, the current time +is used. + +If this object has never been stored or retrieved before, a new keyring +will be created with three 128-bit AES keys: one that is immediately +valid, one that will become valid after the rekey interval, and one that +will become valid after twice the rekey interval. + +If keyring data for this object already exists, the creation and validity +dates for each key in the keyring will be examined. If the key with the +validity date the farthest into the future has a date that's less than or +equal to the current time plus the rekey interval, a new 128-bit AES key +will be added to the keyring with a validity time of twice the rekey +interval in the future. Finally, all keys with a creation date older than +the configured purge interval will be removed provided that the keyring +has at least three keys + +=item store(DATA, PRINCIPAL, HOSTNAME [, DATETIME]) + +Store DATA as the current contents of the WebAuth keyring object. Note +that this is not checked for validity, just assumed to be a valid keyring. +Any existing data will be overwritten. Returns true on success and false +on failure. The caller should call error() to get the error message after +a failure. PRINCIPAL, HOSTNAME, and DATETIME are stored as history +information. PRINCIPAL should be the user who is destroying the object. +If DATETIME isn't given, the current time is used. + +If FILE_MAX_SIZE is set in the wallet configuration, a store() of DATA +larger than that configuration setting will be rejected. + +=back + +=head1 FILES + +=over 4 + +=item WAKEYRING_BUCKET// + +WebAuth keyrings are stored on the wallet server under the directory +WAKEYRING_BUCKET as set in the wallet configuration. is the first +two characters of the hex-encoded MD5 hash of the wallet file object name, +used to not put too many files in the same directory. is the name +of the file object with all characters other than alphanumerics, +underscores, and dashes replaced by "%" and the hex code of the character. + +=back + +=head1 SEE ALSO + +Wallet::Config(3), Wallet::Object::Base(3), wallet-backend(8), WebAuth(3) + +This module is part of the wallet system. The current version is available +from . + +=head1 AUTHOR + +Russ Allbery =cut -- cgit v1.2.3 From 34138105d0f78c6809ac7111bfed833344d85f7a Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 8 Jan 2013 13:27:27 -0800 Subject: Fix a mistake in the WebAuth keyring section of Wallet::Config A copy/paste error from the file object configuration. Change-Id: Ie3ee48ed7adcf3fa50a510f085e664c5b0c91300 Reviewed-on: https://gerrit.stanford.edu/712 Reviewed-by: Russ Allbery Tested-by: Russ Allbery --- perl/Wallet/Config.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/perl/Wallet/Config.pm b/perl/Wallet/Config.pm index cd4e569..71f6e0f 100644 --- a/perl/Wallet/Config.pm +++ b/perl/Wallet/Config.pm @@ -393,7 +393,7 @@ L 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. -WAKEYRING_BUCKET must be set to use file objects. +WAKEYRING_BUCKET must be set to use WebAuth keyring objects. =cut -- cgit v1.2.3 From 95ed0cf2495e2f88139753a82214e004d8e5ba85 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 8 Jan 2013 13:27:53 -0800 Subject: In Wallet::Object::WAKeyring, require the right version of WebAuth We need at least version 3.06 to have the encode and decode WebAuth::Keyring functions. Change-Id: Ia4e3ed74cc038c06e3ba6ab13b37ea3cdb06c032 Reviewed-on: https://gerrit.stanford.edu/713 Reviewed-by: Russ Allbery Tested-by: Russ Allbery --- perl/Wallet/Object/WAKeyring.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/perl/Wallet/Object/WAKeyring.pm b/perl/Wallet/Object/WAKeyring.pm index 300bcda..97984d3 100644 --- a/perl/Wallet/Object/WAKeyring.pm +++ b/perl/Wallet/Object/WAKeyring.pm @@ -20,7 +20,7 @@ use Digest::MD5 qw(md5_hex); use Fcntl qw(LOCK_EX); use Wallet::Config (); use Wallet::Object::Base; -use WebAuth qw(WA_KEY_AES WA_AES_128); +use WebAuth 3.06 qw(WA_KEY_AES WA_AES_128); @ISA = qw(Wallet::Object::Base); -- cgit v1.2.3 From 91e51afaa435841a55e1c1a3e6fbef2154aec7f5 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 8 Jan 2013 15:06:12 -0800 Subject: Fix a few random errors in the WAKeyring object implementation Be sure that we don't purge keys if that would leave us with fewer than three keys. Fix a few other error reporting issues and one syntax error in a WebAuth call. Change-Id: I9bb75de56da3542f8c26ca8eab0814afea06c16a Reviewed-on: https://gerrit.stanford.edu/714 Reviewed-by: Russ Allbery Tested-by: Russ Allbery --- perl/Wallet/Object/WAKeyring.pm | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/perl/Wallet/Object/WAKeyring.pm b/perl/Wallet/Object/WAKeyring.pm index 97984d3..b26be58 100644 --- a/perl/Wallet/Object/WAKeyring.pm +++ b/perl/Wallet/Object/WAKeyring.pm @@ -50,7 +50,7 @@ sub file_path { $name =~ s/([^\w-])/sprintf ('%%%02X', ord ($1))/ge; my $parent = "$Wallet::Config::WAKEYRING_BUCKET/$hash"; unless (-d $parent || mkdir ($parent, 0700)) { - $self->error ("cannot create file bucket $hash: $!"); + $self->error ("cannot create keyring bucket $hash: $!"); return; } return "$Wallet::Config::WAKEYRING_BUCKET/$hash/$name"; @@ -83,6 +83,7 @@ sub get { return; } my $path = $self->file_path; + return unless defined $path; # Create a WebAuth context and ensure we can load the relevant modules. my $wa = eval { WebAuth->new }; @@ -127,7 +128,7 @@ sub get { } # Read the keyring. - my $ring = eval { WebAuth::Keyring->read ($path) }; + my $ring = eval { WebAuth::Keyring->read ($wa, $path) }; if ($@) { $self->error ("cannot read keyring: $@"); return; @@ -172,7 +173,7 @@ sub get { $i++; } } - if (@purge) { + if (@purge && $count - @purge >= 3) { eval { for my $key (reverse @purge) { $ring->remove ($key); -- cgit v1.2.3 From 355201e953c4476454a322b277a7247320ed036a Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 8 Jan 2013 15:06:55 -0800 Subject: Add a test for WAKeyring objects Change-Id: Id360aebe8f0a3911a7d628feafef9b3110801124 Reviewed-on: https://gerrit.stanford.edu/715 Reviewed-by: Russ Allbery Tested-by: Russ Allbery --- perl/t/wa-keyring.t | 175 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 175 insertions(+) create mode 100755 perl/t/wa-keyring.t diff --git a/perl/t/wa-keyring.t b/perl/t/wa-keyring.t new file mode 100755 index 0000000..703b7fe --- /dev/null +++ b/perl/t/wa-keyring.t @@ -0,0 +1,175 @@ +#!/usr/bin/perl +# +# Tests for the WebAuth keyring object implementation. +# +# Written by Russ Allbery +# Copyright 2013 +# The Board of Trustees of the Leland Stanford Junior University +# +# See LICENSE for licensing terms. + +use strict; +use warnings; + +use POSIX qw(strftime); +use Test::More tests => 68; +use WebAuth 3.06 qw(WA_KEY_AES WA_AES_128); +use WebAuth::Key 1.01 (); +use WebAuth::Keyring 1.02 (); + +BEGIN { + use_ok('Wallet::Admin'); + use_ok('Wallet::Config'); + use_ok('Wallet::Object::WAKeyring'); +} + +use lib 't/lib'; +use Util; + +# Some global defaults to use. +my $user = 'admin@EXAMPLE.COM'; +my $host = 'localhost'; +my @trace = ($user, $host, time); + +# Flush all output immediately. +$| = 1; + +# Use Wallet::Admin to set up the database. +system ('rm -rf test-keyrings') == 0 or die "cannot remove test-keyrings\n"; +db_setup; +my $admin = eval { Wallet::Admin->new }; +is ($@, '', 'Database connection succeeded'); +is ($admin->reinitialize ($user), 1, 'Database initialization succeeded'); +my $dbh = $admin->dbh; + +# Create a WebAuth context to use. +my $wa = WebAuth->new; + +# Test error handling in the absence of configuration. +my $object = eval { + Wallet::Object::WAKeyring->create ('wa-keyring', 'test', $dbh, @trace) + }; +ok (defined ($object), 'Creating a basic WebAuth keyring object succeeds'); +ok ($object->isa ('Wallet::Object::WAKeyring'), ' and is the right class'); +is ($object->get (@trace), undef, ' and get fails'); +is ($object->error, 'WebAuth keyring support not configured', + ' with the right error'); +is ($object->store (@trace), undef, ' and store fails'); +is ($object->error, 'WebAuth keyring support not configured', + ' with the right error'); +is ($object->destroy (@trace), 1, ' but destroy succeeds'); + +# Set up our configuration. +mkdir 'test-keyrings' or die "cannot create test-keyrings: $!\n"; +$Wallet::Config::WAKEYRING_BUCKET = 'test-keyrings'; + +# Okay, now we can test. First, the basic object without store. +$object = eval { + Wallet::Object::WAKeyring->create ('wa-keyring', 'test', $dbh, @trace) + }; +ok (defined ($object), 'Creating a basic WebAuth keyring object succeeds'); +ok ($object->isa ('Wallet::Object::WAKeyring'), ' and is the right class'); +my $data = $object->get (@trace); +ok ($data, ' and get succeeds'); +my $keyring = WebAuth::Keyring->decode ($wa, $data); +ok ($keyring->isa ('WebAuth::Keyring'), ' and resulting keyring decodes'); +my @entries = $keyring->entries; +is (scalar (@entries), 3, ' and has three entries'); +is ($entries[0]->creation, 0, 'First has good creation'); +is ($entries[0]->key->type, WA_KEY_AES, ' and key type'); +is ($entries[0]->key->length, WA_AES_128, ' and key length'); +is ($entries[0]->valid_after, 0, ' and validity'); +ok ((time - $entries[1]->creation) < 2, 'Second has good creation'); +is ($entries[1]->key->type, WA_KEY_AES, ' and key type'); +is ($entries[1]->key->length, WA_AES_128, ' and key length'); +ok (($entries[1]->valid_after - time) <= 60 * 60 * 24, + ' and validity (upper)'); +ok (($entries[1]->valid_after - time) > 60 * 60 * 24 - 2, + ' and validity (lower)'); +ok ((time - $entries[2]->creation) < 2, 'Third has good creation'); +is ($entries[2]->key->type, WA_KEY_AES, ' and key type'); +is ($entries[2]->key->length, WA_AES_128, ' and key length'); +ok (($entries[2]->valid_after - time) <= 2 * 60 * 60 * 24, + ' and validity (upper)'); +ok (($entries[2]->valid_after - time) > 2 * 60 * 60 * 24 - 2, + ' and validity (lower)'); +my $data2 = $object->get (@trace); +is ($data2, $data, 'Getting the object again returns the same data'); +is ($object->error, undef, ' with no error'); +is ($object->destroy (@trace), 1, 'Destroying the object succeeds'); + +# Now store something and be sure that we get something reasonable. +$object = eval { + Wallet::Object::WAKeyring->create ('wa-keyring', 'test', $dbh, @trace) + }; +ok (defined ($object), 'Recreating the object succeeds'); +my $key = WebAuth::Key->new ($wa, WA_KEY_AES, WA_AES_128); +$keyring = WebAuth::Keyring->new ($wa, $key); +$data = $keyring->encode; +is ($object->store ($data, @trace), 1, ' and storing data in it succeeds'); +ok (-d 'test-keyrings/09', ' and the hash bucket was created'); +ok (-f 'test-keyrings/09/test', ' and the file exists'); +is (contents ('test-keyrings/09/test'), $data, ' with the right contents'); +$data = $object->get (@trace); +$keyring = WebAuth::Keyring->decode ($wa, $data); +ok ($keyring->isa ('WebAuth::Keyring'), ' and get returns a valid keyring'); +@entries = $keyring->entries; +is (scalar (@entries), 2, ' and has three entries'); +is ($entries[0]->creation, 0, 'First has good creation'); +is ($entries[0]->key->type, WA_KEY_AES, ' and key type'); +is ($entries[0]->key->length, WA_AES_128, ' and key length'); +is ($entries[0]->valid_after, 0, ' and validity'); +is ($entries[0]->key->data, $key->data, ' and matches the original key'); +ok ((time - $entries[1]->creation) < 2, 'Second has good creation'); +is ($entries[1]->key->type, WA_KEY_AES, ' and key type'); +is ($entries[1]->key->length, WA_AES_128, ' and key length'); +ok (($entries[1]->valid_after - time) <= 2 * 60 * 60 * 24, + ' and validity (upper)'); +ok (($entries[1]->valid_after - time) > 2 * 60 * 60 * 24 - 2, + ' and validity (lower)'); + +# Test pruning. Add another old key and a couple of more current keys to the +# current keyring. +$key = WebAuth::Key->new ($wa, WA_KEY_AES, WA_AES_128); +$keyring->add (0, 0, $key); +$key = WebAuth::Key->new ($wa, WA_KEY_AES, WA_AES_128); +$keyring->add (time - 24 * 60 * 60, time - 24 * 60 * 60, $key); +$key = WebAuth::Key->new ($wa, WA_KEY_AES, WA_AES_128); +$keyring->add (time, time, $key); +$data = $keyring->encode; +is ($object->store ($data, @trace), 1, 'Storing modified keyring succeeds'); +$data = $object->get (@trace); +$keyring = WebAuth::Keyring->decode ($wa, $data); +ok ($keyring->isa ('WebAuth::Keyring'), ' and get returns a valid keyring'); +@entries = $keyring->entries; +is (scalar (@entries), 3, ' and has three entries'); +ok ((time - $entries[0]->creation) < 2, 'First has good creation'); +ok (($entries[0]->valid_after - time) <= 2 * 60 * 60 * 24, + ' and validity (upper)'); +ok (($entries[0]->valid_after - time) > 2 * 60 * 60 * 24 - 2, + ' and validity (lower)'); +ok ((time - $entries[1]->creation) < 24 * 60 * 60 + 2, + 'Second has good creation'); +ok ((time - $entries[1]->valid_after) <= 60 * 60 * 24 + 2, + ' and validity'); +ok ((time - $entries[2]->creation) < 2, 'Third has good creation'); +ok ((time - $entries[2]->valid_after) < 2, ' and validity'); +is ($object->destroy (@trace), 1, 'Destroying the object succeeds'); + +# Test error handling in the file store. +system ('rm -r test-keyrings') == 0 or die "cannot remove test-keyrings\n"; +$object = eval { + Wallet::Object::WAKeyring->create ('wa-keyring', 'test', $dbh, @trace) + }; +ok (defined ($object), 'Recreating the object succeeds'); +is ($object->get (@trace), undef, ' but retrieving it fails'); +like ($object->error, qr/^cannot create keyring bucket 09: /, + ' with the right error'); +is ($object->store ("foo\n", @trace), undef, ' and store fails'); +like ($object->error, qr/^cannot create keyring bucket 09: /, + ' with the right error'); +is ($object->destroy (@trace), 1, ' but destroying the object succeeds'); + +# Clean up. +$admin->destroy; +unlink ('wallet-db'); -- cgit v1.2.3 From b67dd35066a85df0f4c04e9cbde33a20b0492c24 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Thu, 17 Jan 2013 15:50:30 -0800 Subject: Significant revision of the Stanford naming scheme Recommend slash-separated names by default. Remove some obsolete bits and update a lot of the recommendations and wording. Change-Id: I44cbf8116e7529b00a61261248ff9daecacdb910 Reviewed-on: https://gerrit.stanford.edu/723 Reviewed-by: Russ Allbery Tested-by: Russ Allbery --- docs/stanford-naming | 145 ++++++++++++++++++++++++++++++++------------------- 1 file changed, 90 insertions(+), 55 deletions(-) diff --git a/docs/stanford-naming b/docs/stanford-naming index a1855f8..b6e9f63 100644 --- a/docs/stanford-naming +++ b/docs/stanford-naming @@ -63,113 +63,148 @@ Object Naming convention for that type of thing. All file object names start with a short indicator of the responsible - group, a dash, and then either the short, unqualified hostname (if + group, a slash, the type of object, a slash, and then the hostname (if they're only used on a single host) or the service name for which that - object is used. + object is used. The hostname is normally presented without the domain + if it's a normal .stanford.edu host. + + We previously instead used --, but that caused + various problems in parsing because groups, servers, and types all + also contained dashes. Slashes are much less ambiguous. This + document shows both the new and the old form. Then, we use the following naming conventions for different types of - objects: + objects. + + Host-based: - --htpasswd- + /htpasswd// An .htpasswd file for HTTP Basic Authentication for special-case web configurations that require such a thing. - --pam- - - A PAM configuration for that requires secure information, - such as a password for pam_msyql. may be either a - specific server name or a general class of servers (production and - test) that uses that PAM configuration. - - --password- + (OLD: --htpasswd-) - A password for some account that isn't covered by one of the more - specific naming conventions, such as a password used to connect to - a remote ssh service. - - --ssh- + /ssh-/ Stores the SSH private key for . For shared private keys across a pool, should be the name of the pool, or possibly some unambiguous name for the set of systems. is the type of SSH key (RSA or DSA). - --ssl-key + (OLD: --ssh-) + + /ssl-key/ + + Stores the SSL X.509 certificate private key for . Used + for Apache, Postfix, LDAP, and similar cases where the certificate + should match the host name. The public certificate we manage + external to wallet since it doesn't need to be protected or + encrypted. + + Use idg/ssl-key/starYYYY for the key for the *.stanford.edu + certificate, where YYYY is the expiration year. - Stores the SSL X.509 certificate private key for . Use - unix-star-ssl-key for the key for the *.stanford.edu certificate. - The public certificate we manage external to wallet since it - doesn't need to be protected or encrypted. + (OLD: --ssl-key) - --tivoli-key + /tivoli-key/ The Tivoli password or backup encryption key for this server. Both the password and the encryption key, if used, are stored in the same file, so both are stored together. This file is found at /etc/adsm/TSM.PWD. - --config- + (OLD: --tivoli-key) + + In all cases, is the server (or group of servers) on which + the file will be stored, not the server expecting that key material + for authentication. + + Service-based: + + /config/- A configuration file named that contains some secure information, such as a database password. Ideally, the secure data should be stored in a separate file and assembled into the - configuration file, but that isn't always the path of least - resistance. Only use this naming convention if there is not a - more specific one below. + configuration file. This is reserved for configuration files that + hold nothing but authentication information. Only use this naming + convention if there is not a more specific one below. + + (OLD: --config-) - --db- + /db// - Stores the database password for the database named . This - may be a file containing only the database password or a Perl - AppConfig configuration file with the database connection - information including the password. + Stores the database password for access to the database + named . This may be a file containing only the database + password or a Perl AppConfig configuration file with the database + connection information including the password. - --gpg-key + (OLD: --db-) + + /gpg-key/ Stores the GnuPG private key for a service that needs to do GnuPG signing or encryption. - --properties + (OLD: --gpg-key) - The properties file for a Java application that contains some - secure data (such as SSL key passwords or database passwords). - Ideally the secure data should be stored in separate files, but - sometimes it's too hard to separate out chunks of a properties - file. + /password/- - --puppetconf + A password for some account, service, keystore, or something + similar that covered by one of the more specific naming + conventions, such as a password used to connect to a remote ssh + service. is the service that uses this password and + is the thing the password is used for (such as the remote + account name). This may be a file containing only the password, + or a configuration file of some type that includes a field name + and the password. (However, use the db type described above for + database passwords.) - A puppet.conf configuration file for Puppet that contains some - secure data (such as SSL key passwords or database passwords). - Ideally the secure data should be stored in separate files, but - Puppet likes to use a single configuration file. + (OLD: --password-) - --shibboleth + /properties/ - The shibboleth.xml configuration file for a service, when it - contains some secure data (such as database passwords for shared - sessions). Ideally, the secure data should be stored in separate - files and assembled into a shibboleth.xml file, but that isn't - always the path of least resistance. + The properties file for a Java application that contains some + secure data (such as SSL key passwords or database passwords). + This should only be used for a properties file that contains only + the password and closely-related information, such as database + connection information. For anything else, switch to storing the + password separately using the password type above and building the + properties file dynamically from the password and a template. + + (OLD: --properties) - --ssl-keystore + /ssl-keystore/ The Java keystore file (containing both public and private key) used by a service for authentication to other services. If a given service uses more than one, include the purpose in the part of the name. - --ssl-pkcs12 + (OLD: --ssl-keystore) + + /ssl-pkcs12/ The PKCS#12 file (containing both public and private key) used by a service for authentication to other services. If a given service uses more than one, include the purpose in the part of the name. - In all cases, is the server (or group of servers) on which - the file will be stored, not the server expecting that key material - for authentication. + (OLD: --ssl-pkcs12) + + We previously stored a wider variety of configuration files before + developing a way to dynamically substitute the password into a larger + configuration file during deployment. The following file types are + obsolete and should no longer be used; instead, the configuration file + should be constructed by substituting a password (usually stored as a + password or db type) into the configuration file. + + Obsolete: + + --pam- + --puppetconf + --shibboleth ACL Naming -- cgit v1.2.3 From 6530fb472f1c64d3e80c723d3073ca3d256a58ce Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Fri, 18 Jan 2013 11:48:45 -0800 Subject: Further Stanford naming convention changes Remove the group for host-based file object names. Move the group to the second component for non-host-based names so that the first component is always the object type. Add some additional object types and clarify wording based on feedback from Adam. Change-Id: I5db7b23d2b004c69afb869df5624d455b751c0d5 Reviewed-on: https://gerrit.stanford.edu/724 Reviewed-by: Russ Allbery Tested-by: Russ Allbery --- docs/stanford-naming | 103 ++++++++++++++++++++++++++++++++++----------------- 1 file changed, 70 insertions(+), 33 deletions(-) diff --git a/docs/stanford-naming b/docs/stanford-naming index b6e9f63..f88d148 100644 --- a/docs/stanford-naming +++ b/docs/stanford-naming @@ -62,52 +62,80 @@ Object Naming it should get its own object type first and to agree on a naming convention for that type of thing. - All file object names start with a short indicator of the responsible - group, a slash, the type of object, a slash, and then the hostname (if - they're only used on a single host) or the service name for which that - object is used. The hostname is normally presented without the domain - if it's a normal .stanford.edu host. + There are two basic types of file objects: ones that are tied to a + particular system, and ones that are not. For the ones that are tied + to a particular system, we use a naming convention very similar to + host-based Kerberos principals so that we can set up default ACLs + based on the host. For ones that are not, we require an indication of + the repsonsible group in each file object, since the rest of the name + can often be ambiguous. + + File objects are named with two or more slash-separated components + (again, similar to Kerberos principals). The first is the type of + file being stored. The rest vary based on the file type. We previously instead used --, but that caused various problems in parsing because groups, servers, and types all also contained dashes. Slashes are much less ambiguous. This document shows both the new and the old form. - Then, we use the following naming conventions for different types of - objects. - Host-based: - /htpasswd// + htpasswd// An .htpasswd file for HTTP Basic Authentication for special-case - web configurations that require such a thing. + web configurations that require such a thing. is the + server (or group of servers) on which the file will be stored (OLD: --htpasswd-) - /ssh-/ + password-ipmi/ + + Stores the password for remote IPMI/iLO/ILOM access to the + system. + + (OLD: --password-ipmi) + + password-root/ + + Stores the root password for a given server. + + (OLD: --password-root) + + password-tivoli/ + + Stores the Tivoli TSM backup password for a given server. See + also tivoli-key/, but depending on what one wants to do + with the password, this may be a better representation. + + (OLD: --password-tivoli) + + ssh-/ Stores the SSH private key for . For shared private keys across a pool, should be the name of the pool, or possibly some unambiguous name for the set of systems. is - the type of SSH key (RSA or DSA). + the type of SSH key (rsa or dsa, in lowercase). (OLD: --ssh-) - /ssl-key/ + ssl-key/ Stores the SSL X.509 certificate private key for . Used for Apache, Postfix, LDAP, and similar cases where the certificate should match the host name. The public certificate we manage external to wallet since it doesn't need to be protected or - encrypted. + encrypted. here should be the CN of the certificate, + which may be different than the hostname (for hosts with multiple + virtual hosts, for example, or because the certificate is for a + load-balanced name). - Use idg/ssl-key/starYYYY for the key for the *.stanford.edu - certificate, where YYYY is the expiration year. + Use ssl-key/starYYYY.stanford.edu for the key for the + *.stanford.edu certificate, where YYYY is the expiration year. (OLD: --ssl-key) - /tivoli-key/ + tivoli-key/ The Tivoli password or backup encryption key for this server. Both the password and the encryption key, if used, are stored in @@ -116,13 +144,13 @@ Object Naming (OLD: --tivoli-key) - In all cases, is the server (or group of servers) on which - the file will be stored, not the server expecting that key material - for authentication. + In all cases, should be a fully-qualified domain name in the + new naming convention. In the old naming convention, .stanford.edu + was omitted, but this adds unnecessary ambiguity. Service-based: - /config/- + config/// A configuration file named that contains some secure information, such as a database password. Ideally, the secure @@ -133,7 +161,7 @@ Object Naming (OLD: --config-) - /db// + db/// Stores the database password for access to the database named . This may be a file containing only the database @@ -142,17 +170,17 @@ Object Naming (OLD: --db-) - /gpg-key/ + gpg-key// Stores the GnuPG private key for a service that needs to do GnuPG signing or encryption. (OLD: --gpg-key) - /password/- + password/// A password for some account, service, keystore, or something - similar that covered by one of the more specific naming + similar that is not covered by one of the more specific naming conventions, such as a password used to connect to a remote ssh service. is the service that uses this password and is the thing the password is used for (such as the remote @@ -163,7 +191,7 @@ Object Naming (OLD: --password-) - /properties/ + properties//[/] The properties file for a Java application that contains some secure data (such as SSL key passwords or database passwords). @@ -171,28 +199,37 @@ Object Naming the password and closely-related information, such as database connection information. For anything else, switch to storing the password separately using the password type above and building the - properties file dynamically from the password and a template. + properties file dynamically from the password and a template. The + optional component is for when there are multiple files + stored for a particular service. (OLD: --properties) - /ssl-keystore/ + ssl-keystore//[/] The Java keystore file (containing both public and private key) used by a service for authentication to other services. If a - given service uses more than one, include the purpose in the - part of the name. + given service uses more than one, use the optional + component to distinguish. (OLD: --ssl-keystore) - /ssl-pkcs12/ + ssl-pkcs12//[/] The PKCS#12 file (containing both public and private key) used by a service for authentication to other services. If a given - service uses more than one, include the purpose in the - part of the name. + service uses more than one, use the optional component to + distinguish. (OLD: --ssl-pkcs12) + If there are separate objects for different tiers, should be + left unqualified for production and be qualified with a dash and the + tier for non-production. For example, ssl-keystore/idg/accounts would + be the production keystore for the Accounts application, and + ssl-keystore/idg/accounts-uat would be the keystore for the UAT + version. + We previously stored a wider variety of configuration files before developing a way to dynamically substitute the password into a larger configuration file during deployment. The following file types are -- cgit v1.2.3 From 593e9b1e100ace54d1d9da7eb16e60f4e37c34ff Mon Sep 17 00:00:00 2001 From: Jon Robertson Date: Sun, 2 Dec 2012 22:07:16 -0800 Subject: Moved the Perl wallet modules and tests to DBIx::Class Moved all the Perl code to use DBIx::Class for the database interface. This includes updating all database calls, how the schema is generated and maintained, and the tests in places where some output has changed. We also remove the schema.t test, as the tests for it are more covered in the admin.t tests now. Change-Id: Ie5083432d09a0d9fe364a61c31378b77aa7b3cb7 Reviewed-on: https://gerrit.stanford.edu/598 Reviewed-by: Russ Allbery Tested-by: Russ Allbery --- perl/Wallet/ACL.pm | 196 +++++++++-------- perl/Wallet/Admin.pm | 102 +++++++-- perl/Wallet/Config.pm | 10 + perl/Wallet/Database.pm | 27 +-- perl/Wallet/Object/Base.pm | 318 ++++++++++++++++------------ perl/Wallet/Object/Keytab.pm | 116 +++++----- perl/Wallet/Report.pm | 298 +++++++++++++++++--------- perl/Wallet/Schema.pm | 282 ++++++------------------ perl/Wallet/Schema/Result/Acl.pm | 99 +++++++++ perl/Wallet/Schema/Result/AclEntry.pm | 63 ++++++ perl/Wallet/Schema/Result/AclHistory.pm | 101 +++++++++ perl/Wallet/Schema/Result/AclScheme.pm | 73 +++++++ perl/Wallet/Schema/Result/Enctype.pm | 34 +++ perl/Wallet/Schema/Result/Flag.pm | 54 +++++ perl/Wallet/Schema/Result/KeytabEnctype.pm | 42 ++++ perl/Wallet/Schema/Result/KeytabSync.pm | 42 ++++ perl/Wallet/Schema/Result/Object.pm | 258 ++++++++++++++++++++++ perl/Wallet/Schema/Result/ObjectHistory.pm | 127 +++++++++++ perl/Wallet/Schema/Result/SyncTarget.pm | 40 ++++ perl/Wallet/Schema/Result/Type.pm | 64 ++++++ perl/Wallet/Server.pm | 19 +- perl/create-ddl | 93 ++++++++ perl/sql/Wallet-Schema-0.07-0.08-MySQL.sql | 7 + perl/sql/Wallet-Schema-0.07-0.08-SQLite.sql | 6 + perl/sql/Wallet-Schema-0.07-MySQL.sql | 211 ++++++++++++++++++ perl/sql/Wallet-Schema-0.07-SQLite.sql | 219 +++++++++++++++++++ perl/sql/Wallet-Schema-0.08-MySQL.sql | 193 +++++++++++++++++ perl/sql/Wallet-Schema-0.08-PostgreSQL.sql | 201 ++++++++++++++++++ perl/sql/Wallet-Schema-0.08-SQLite.sql | 201 ++++++++++++++++++ perl/t/admin.t | 21 +- perl/t/lib/Util.pm | 5 + perl/t/report.t | 2 +- perl/t/schema.t | 111 ---------- perl/t/server.t | 2 +- server/wallet-admin | 23 ++ 35 files changed, 2886 insertions(+), 774 deletions(-) create mode 100644 perl/Wallet/Schema/Result/Acl.pm create mode 100644 perl/Wallet/Schema/Result/AclEntry.pm create mode 100644 perl/Wallet/Schema/Result/AclHistory.pm create mode 100644 perl/Wallet/Schema/Result/AclScheme.pm create mode 100644 perl/Wallet/Schema/Result/Enctype.pm create mode 100644 perl/Wallet/Schema/Result/Flag.pm create mode 100644 perl/Wallet/Schema/Result/KeytabEnctype.pm create mode 100644 perl/Wallet/Schema/Result/KeytabSync.pm create mode 100644 perl/Wallet/Schema/Result/Object.pm create mode 100644 perl/Wallet/Schema/Result/ObjectHistory.pm create mode 100644 perl/Wallet/Schema/Result/SyncTarget.pm create mode 100644 perl/Wallet/Schema/Result/Type.pm create mode 100755 perl/create-ddl create mode 100644 perl/sql/Wallet-Schema-0.07-0.08-MySQL.sql create mode 100644 perl/sql/Wallet-Schema-0.07-0.08-SQLite.sql create mode 100644 perl/sql/Wallet-Schema-0.07-MySQL.sql create mode 100644 perl/sql/Wallet-Schema-0.07-SQLite.sql create mode 100644 perl/sql/Wallet-Schema-0.08-MySQL.sql create mode 100644 perl/sql/Wallet-Schema-0.08-PostgreSQL.sql create mode 100644 perl/sql/Wallet-Schema-0.08-SQLite.sql delete mode 100755 perl/t/schema.t diff --git a/perl/Wallet/ACL.pm b/perl/Wallet/ACL.pm index 2a06442..4f51c70 100644 --- a/perl/Wallet/ACL.pm +++ b/perl/Wallet/ACL.pm @@ -33,26 +33,24 @@ $VERSION = '0.07'; # doesn't exist, throws an exception. sub new { my ($class, $id, $dbh) = @_; - my ($sql, $data, $name); + my (%search, $data, $name); if ($id =~ /^\d+\z/) { - $sql = 'select ac_id, ac_name from acls where ac_id = ?'; + $search{ac_id} = $id; } else { - $sql = 'select ac_id, ac_name from acls where ac_name = ?'; + $search{ac_name} = $id; } eval { - ($data, $name) = $dbh->selectrow_array ($sql, undef, $id); - $dbh->commit; + $data = $dbh->resultset('Acl')->find (\%search); }; if ($@) { - $dbh->rollback; die "cannot search for ACL $id: $@\n"; } elsif (not defined $data) { die "ACL $id not found\n"; } my $self = { dbh => $dbh, - id => $data, - name => $name, + id => $data->ac_id, + name => $data->ac_name, }; bless ($self, $class); return $self; @@ -69,18 +67,27 @@ sub create { $time ||= time; my $id; eval { - my $sql = 'insert into acls (ac_name) values (?)'; - $dbh->do ($sql, undef, $name); - $id = $dbh->last_insert_id (undef, undef, 'acls', 'ac_id'); + my $guard = $dbh->txn_scope_guard; + + # Create the new record. + my %record = (ac_name => $name); + my $acl = $dbh->resultset('Acl')->create (\%record); + $id = $acl->ac_id; die "unable to retrieve new ACL ID" unless defined $id; + + # Add to the history table. my $date = strftime ('%Y-%m-%d %T', localtime $time); - $sql = "insert into acl_history (ah_acl, ah_action, ah_by, ah_from, - ah_on) values (?, 'create', ?, ?, ?)"; - $dbh->do ($sql, undef, $id, $user, $host, $date); - $dbh->commit; + %record = (ah_acl => $id, + ah_action => 'create', + ah_by => $user, + ah_from => $host, + ah_on => $date); + my $history = $dbh->resultset('AclHistory')->create (\%record); + die "unable to create new history entry" unless defined $history; + + $guard->commit; }; if ($@) { - $dbh->rollback; die "cannot create ACL $name: $@\n"; } my $self = { @@ -126,13 +133,13 @@ sub scheme_mapping { my ($self, $scheme) = @_; my $class; eval { - my $sql = 'select as_class from acl_schemes where as_name = ?'; - ($class) = $self->{dbh}->selectrow_array ($sql, undef, $scheme); - $self->{dbh}->commit; + my %search = (as_name => $scheme); + my $scheme_rec = $self->{dbh}->resultset('AclScheme') + ->find (\%search); + $class = $scheme_rec->as_class; }; if ($@) { $self->error ($@); - $self->{dbh}->rollback; return; } if (defined $class) { @@ -155,11 +162,14 @@ sub log_acl { unless ($action =~ /^(add|remove)\z/) { die "invalid history action $action"; } - my $date = strftime ('%Y-%m-%d %T', localtime $time); - my $sql = 'insert into acl_history (ah_acl, ah_action, ah_scheme, - ah_identifier, ah_by, ah_from, ah_on) values (?, ?, ?, ?, ?, ?, ?)'; - $self->{dbh}->do ($sql, undef, $self->{id}, $action, $scheme, $identifier, - $user, $host, $date); + my %record = (ah_acl => $self->{id}, + ah_action => $action, + ah_scheme => $scheme, + ah_identifier => $identifier, + ah_by => $user, + ah_from => $host, + ah_on => strftime ('%Y-%m-%d %T', localtime $time)); + $self->{dbh}->resultset('AclHistory')->create (\%record); } ############################################################################## @@ -176,13 +186,15 @@ sub rename { return; } eval { - my $sql = 'update acls set ac_name = ? where ac_id = ?'; - $self->{dbh}->do ($sql, undef, $name, $self->{id}); - $self->{dbh}->commit; + my $guard = $self->{dbh}->txn_scope_guard; + my %search = (ac_id => $self->{id}); + my $acls = $self->{dbh}->resultset('Acl')->find (\%search); + $acls->ac_name ($name); + $acls->update; + $guard->commit; }; if ($@) { $self->error ("cannot rename ACL $self->{id} to $name: $@"); - $self->{dbh}->rollback; return; } $self->{name} = $name; @@ -200,27 +212,44 @@ sub destroy { my ($self, $user, $host, $time) = @_; $time ||= time; eval { - 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]"; + my $guard = $self->{dbh}->txn_scope_guard; + + # Make certain no one is using the ACL. + my @search = ({ ob_owner => $self->{id} }, + { ob_acl_get => $self->{id} }, + { ob_acl_store => $self->{id} }, + { ob_acl_show => $self->{id} }, + { ob_acl_destroy => $self->{id} }, + { ob_acl_flags => $self->{id} }); + my @entries = $self->{dbh}->resultset('Object')->search (\@search); + if (@entries) { + my ($entry) = @entries; + die "ACL in use by ".$entry->ob_type.":".$entry->ob_name; } - $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}); - $sql = "insert into acl_history (ah_acl, ah_action, ah_by, ah_from, - ah_on) values (?, 'destroy', ?, ?, ?)"; - $self->{dbh}->do ($sql, undef, $self->{id}, $user, $host, $time); - $self->{dbh}->commit; + + # Delete any entries (there may or may not be any). + my %search = (ae_id => $self->{id}); + @entries = $self->{dbh}->resultset('AclEntry')->search(\%search); + for my $entry (@entries) { + $entry->delete; + } + + # There should definitely be an ACL record to delete. + %search = (ac_id => $self->{id}); + my $entry = $self->{dbh}->resultset('Acl')->find(\%search); + $entry->delete if defined $entry; + + # Create new history line for the deletion. + my %record = (ah_acl => $self->{id}, + ah_action => 'destroy', + ah_by => $user, + ah_from => $host, + ah_on => $time); + $self->{dbh}->resultset('AclHistory')->create (\%record); + $guard->commit; }; if ($@) { $self->error ("cannot destroy ACL $self->{id}: $@"); - $self->{dbh}->rollback; return; } return 1; @@ -239,15 +268,16 @@ sub add { return; } eval { - my $sql = 'insert into acl_entries (ae_id, ae_scheme, ae_identifier) - values (?, ?, ?)'; - $self->{dbh}->do ($sql, undef, $self->{id}, $scheme, $identifier); + my $guard = $self->{dbh}->txn_scope_guard; + my %record = (ae_id => $self->{id}, + ae_scheme => $scheme, + ae_identifier => $identifier); + my $entry = $self->{dbh}->resultset('AclEntry')->create (\%record); $self->log_acl ('add', $scheme, $identifier, $user, $host, $time); - $self->{dbh}->commit; + $guard->commit; }; if ($@) { $self->error ("cannot add $scheme:$identifier to $self->{id}: $@"); - $self->{dbh}->rollback; return; } return 1; @@ -260,23 +290,21 @@ sub remove { my ($self, $scheme, $identifier, $user, $host, $time) = @_; $time ||= time; eval { - my $sql = 'select * from acl_entries where ae_id = ? and ae_scheme = ? - and ae_identifier = ?'; - my ($data) = $self->{dbh}->selectrow_array ($sql, undef, $self->{id}, - $scheme, $identifier); - unless (defined $data) { + my $guard = $self->{dbh}->txn_scope_guard; + my %search = (ae_id => $self->{id}, + ae_scheme => $scheme, + ae_identifier => $identifier); + my $entry = $self->{dbh}->resultset('AclEntry')->find (\%search); + unless (defined $entry) { die "entry not found in ACL\n"; } - $sql = 'delete from acl_entries where ae_id = ? and ae_scheme = ? - and ae_identifier = ?'; - $self->{dbh}->do ($sql, undef, $self->{id}, $scheme, $identifier); + $entry->delete; $self->log_acl ('remove', $scheme, $identifier, $user, $host, $time); - $self->{dbh}->commit; + $guard->commit; }; if ($@) { my $entry = "$scheme:$identifier"; $self->error ("cannot remove $entry from $self->{id}: $@"); - $self->{dbh}->rollback; return; } return 1; @@ -294,19 +322,17 @@ sub list { undef $self->{error}; my @entries; eval { - my $sql = 'select ae_scheme, ae_identifier from acl_entries where - ae_id = ?'; - my $sth = $self->{dbh}->prepare ($sql); - $sth->execute ($self->{id}); - my $entry; - while (defined ($entry = $sth->fetchrow_arrayref)) { - push (@entries, [ @$entry ]); + my $guard = $self->{dbh}->txn_scope_guard; + my %search = (ae_id => $self->{id}); + my @entry_recs = $self->{dbh}->resultset('AclEntry') + ->search (\%search); + for my $entry (@entry_recs) { + push (@entries, [ $entry->ae_scheme, $entry->ae_identifier ]); } - $self->{dbh}->commit; + $guard->commit; }; if ($@) { $self->error ("cannot retrieve ACL $self->{id}: $@"); - $self->{dbh}->rollback; return; } else { return @entries; @@ -338,25 +364,27 @@ sub history { my ($self) = @_; my $output = ''; eval { - my $sql = 'select ah_action, ah_scheme, ah_identifier, ah_by, ah_from, - ah_on from acl_history where ah_acl = ? order by ah_on'; - my $sth = $self->{dbh}->prepare ($sql); - $sth->execute ($self->{id}); - my @data; - while (@data = $sth->fetchrow_array) { - $output .= "$data[5] "; - if ($data[0] eq 'add' or $data[0] eq 'remove') { - $output .= "$data[0] $data[1] $data[2]"; + my $guard = $self->{dbh}->txn_scope_guard; + my %search = (ah_acl => $self->{id}); + my %options = (order_by => 'ah_on'); + my @data = $self->{dbh}->resultset('AclHistory')->search (\%search, + \%options); + for my $data (@data) { + $output .= sprintf ("%s %s ", $data->ah_on->ymd, + $data->ah_on->hms); + if ($data->ah_action eq 'add' || $data->ah_action eq 'remove') { + $output .= sprintf ("%s %s %s", $data->ah_action, + $data->ah_scheme, $data->ah_identifier); } else { - $output .= $data[0]; + $output .= $data->ah_action; } - $output .= "\n by $data[3] from $data[4]\n"; + $output .= sprintf ("\n by %s from %s\n", $data->ah_by, + $data->ah_from); } - $self->{dbh}->commit; + $guard->commit; }; if ($@) { $self->error ("cannot read history for $self->{id}: $@"); - $self->{dbh}->rollback; return; } return $output; @@ -487,7 +515,7 @@ references. =item new(ACL, DBH) Instantiate a new ACL object with the given ACL ID or name. Takes the -Wallet::Database object to use for retrieving metadata from the wallet +Wallet::Schema object to use for retrieving metadata from the wallet database. Returns a new ACL object if the ACL was found and throws an exception if it wasn't or on any other error. diff --git a/perl/Wallet/Admin.pm b/perl/Wallet/Admin.pm index a1aef83..511916d 100644 --- a/perl/Wallet/Admin.pm +++ b/perl/Wallet/Admin.pm @@ -1,7 +1,7 @@ # Wallet::Admin -- Wallet system administrative interface. # # Written by Russ Allbery -# Copyright 2008, 2009, 2010, 2011 +# Copyright 2008, 2009, 2010, 2011, 2012 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -17,13 +17,12 @@ use strict; use vars qw($VERSION); use Wallet::ACL; -use Wallet::Database; use Wallet::Schema; # This version should be increased on any code change to this module. Always # use two digits for the minor version with a leading zero if necessary so # that it will sort properly. -$VERSION = '0.06'; +$VERSION = '0.07'; ############################################################################## # Constructor, destructor, and accessors @@ -34,7 +33,7 @@ $VERSION = '0.06'; # Throw an exception if anything goes wrong. sub new { my ($class) = @_; - my $dbh = Wallet::Database->connect; + my $dbh = Wallet::Schema->connect; my $self = { dbh => $dbh }; bless ($self, $class); return $self; @@ -61,7 +60,7 @@ sub error { # Disconnect the database handle on object destruction to avoid warnings. sub DESTROY { my ($self) = @_; - $self->{dbh}->disconnect unless $self->{dbh}->{InactiveDestroy}; + $self->{dbh}->storage->dbh->disconnect; } ############################################################################## @@ -75,17 +74,49 @@ sub DESTROY { # true on success and false on failure, setting the object error. sub initialize { my ($self, $user) = @_; - my $schema = Wallet::Schema->new; - eval { $schema->create ($self->{dbh}) }; + + # Deploy the database schema from DDL files, if they exist. If not then + # we automatically get the database from the Schema modules. + $self->{dbh}->deploy ({}, $Wallet::Config::DB_DDL_DIRECTORY); if ($@) { $self->error ($@); return; } + $self->default_data; + + # Create a default admin ACL. my $acl = Wallet::ACL->create ('ADMIN', $self->{dbh}, $user, 'localhost'); unless ($acl->add ('krb5', $user, $user, 'localhost')) { $self->error ($acl->error); return; } + + return 1; +} + +# Load default data into various tables. We'd like to do this more directly +# in the schema definitions, but not yet seeing a good way to do that. +sub default_data { + my ($self) = @_; + + # acl_schemes default rows. + my ($r1) = $self->{dbh}->resultset('AclScheme')->populate ([ + [ qw/as_name as_class/ ], + [ 'krb5', 'Wallet::ACL::Krb5' ], + [ 'krb5-regex', 'Wallet::ACL::Krb5::Regex' ], + [ 'ldap-attr', 'Wallet::ACL::LDAP::Attribute' ], + [ 'netdb', 'Wallet::ACL::NetDB' ], + [ 'netdb-root', 'Wallet::ACL::NetDB::Root' ], + ]); + warn "default AclScheme not installed" unless defined $r1; + + # types default rows. + my @record = ([ qw/ty_name ty_class/ ], + [ 'file', 'Wallet::Object::File' ], + [ 'keytab', 'Wallet::Object::Keytab' ]); + ($r1) = $self->{dbh}->resultset('Type')->populate (\@record); + warn "default Type not installed" unless defined $r1; + return 1; } @@ -102,12 +133,31 @@ sub reinitialize { # false on failure. sub destroy { my ($self) = @_; - my $schema = Wallet::Schema->new; - eval { $schema->drop ($self->{dbh}) }; - if ($@) { - $self->error ($@); - return; + + # Get an actual DBI handle and use it to delete all tables. + my $real_dbh = $self->{dbh}->storage->dbh; + my @tables = qw/acls acl_entries acl_history acl_schemes enctypes + flags keytab_enctypes keytab_sync objects object_history + sync_targets types dbix_class_schema_versions/; + for my $table (@tables) { + my $sql = "DROP TABLE IF EXISTS $table"; + $real_dbh->do ($sql); } + + return 1; +} + +# Save a DDL of the database in every supported database server. Returns +# true on success and false on failure. +sub backup { + my ($self, $oldversion) = @_; + + my @dbs = qw/MySQL SQLite PostgreSQL/; + my $version = $Wallet::Schema::VERSION; + $self->{dbh}->create_ddl_dir (\@dbs, $version, + $Wallet::Config::DB_DDL_DIRECTORY, + $oldversion); + return 1; } @@ -115,12 +165,16 @@ sub destroy { # and false on failure. sub upgrade { my ($self) = @_; - my $schema = Wallet::Schema->new; - eval { $schema->upgrade ($self->{dbh}) }; + + if ($self->{dbh}->get_db_version) { + eval { $self->{dbh}->upgrade; }; + } if ($@) { $self->error ($@); + warn $@; return; } + return 1; } @@ -135,13 +189,14 @@ sub upgrade { sub register_object { my ($self, $type, $class) = @_; eval { - my $sql = 'insert into types (ty_name, ty_class) values (?, ?)'; - $self->{dbh}->do ($sql, undef, $type, $class); - $self->{dbh}->commit; + my $guard = $self->{dbh}->txn_scope_guard; + my %record = (ty_name => $type, + ty_class => $class); + $self->{dbh}->resultset('Type')->create (\%record); + $guard->commit; }; if ($@) { $self->error ("cannot register $class for $type: $@"); - $self->{dbh}->rollback; return; } return 1; @@ -154,13 +209,14 @@ sub register_object { sub register_verifier { my ($self, $scheme, $class) = @_; eval { - my $sql = 'insert into acl_schemes (as_name, as_class) values (?, ?)'; - $self->{dbh}->do ($sql, undef, $scheme, $class); - $self->{dbh}->commit; + my $guard = $self->{dbh}->txn_scope_guard; + my %record = (as_name => $scheme, + as_class => $class); + $self->{dbh}->resultset('AclScheme')->create (\%record); + $guard->commit; }; if ($@) { - $self->error ("cannot registery $class for $scheme: $@"); - $self->{dbh}->rollback; + $self->error ("cannot register $class for $scheme: $@"); return; } return 1; diff --git a/perl/Wallet/Config.pm b/perl/Wallet/Config.pm index 71f6e0f..98dae03 100644 --- a/perl/Wallet/Config.pm +++ b/perl/Wallet/Config.pm @@ -167,6 +167,16 @@ backends, particularly SQLite, do not need this. our $DB_PASSWORD; +=item DB_DDL_DIRECTORY + +Specifies the directory used to dump the database schema in formats for +each possible database server. This also includes diffs between schema +versions, for upgrades. + +=cut + +our $DB_DDL_DIRECTORY; + =back =head1 FILE OBJECT CONFIGURATION diff --git a/perl/Wallet/Database.pm b/perl/Wallet/Database.pm index 7daab9f..8df338a 100644 --- a/perl/Wallet/Database.pm +++ b/perl/Wallet/Database.pm @@ -1,12 +1,12 @@ # Wallet::Database -- Wallet system database connection management. # -# This module is a thin wrapper around DBI to handle determination of the -# database driver and configuration settings automatically on connect. The +# This module is a thin wrapper around DBIx::Class to handle determination +# of the database configuration settings automatically on connect. The # intention is that Wallet::Database objects can be treated in all respects -# like DBI objects in the rest of the code. +# like DBIx::Class objects in the rest of the code. # # Written by Russ Allbery -# Copyright 2008, 2010 Board of Trustees, Leland Stanford Jr. University +# Copyright 2008-2012 Board of Trustees, Leland Stanford Jr. University # # See LICENSE for licensing terms. @@ -14,32 +14,21 @@ # Modules and declarations ############################################################################## -# Set up the subclasses. This is required to avoid warnings under DBI 1.40 -# and later, even though we don't actually make use of any overridden -# statement handle or database handle methods. -package Wallet::Database::st; -use vars qw(@ISA); -@ISA = qw(DBI::st); - -package Wallet::Database::db; -use vars qw(@ISA); -@ISA = qw(DBI::db); - package Wallet::Database; require 5.006; use strict; use vars qw(@ISA $VERSION); -use DBI; +use Wallet::Schema; use Wallet::Config; -@ISA = qw(DBI); +@ISA = qw(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.03'; +$VERSION = '0.04'; ############################################################################## # Core overrides @@ -65,7 +54,7 @@ sub connect { } my $user = $Wallet::Config::DB_USER; my $pass = $Wallet::Config::DB_PASSWORD; - my %attrs = (PrintError => 0, RaiseError => 1, AutoCommit => 0); + my %attrs = (PrintError => 0, RaiseError => 1); my $dbh = eval { $class->SUPER::connect ($dsn, $user, $pass, \%attrs) }; if ($@) { die "cannot connect to database: $@\n"; diff --git a/perl/Wallet/Object/Base.pm b/perl/Wallet/Object/Base.pm index 87506f4..5bd89a7 100644 --- a/perl/Wallet/Object/Base.pm +++ b/perl/Wallet/Object/Base.pm @@ -24,7 +24,7 @@ use Wallet::ACL; # 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.05'; +$VERSION = '0.06'; ############################################################################## # Constructors @@ -37,10 +37,11 @@ $VERSION = '0.05'; # probably be usable as-is by most object types. sub new { my ($class, $type, $name, $dbh) = @_; - my $sql = 'select ob_name from objects where ob_type = ? and ob_name = ?'; - my $data = $dbh->selectrow_array ($sql, undef, $type, $name); - $dbh->commit; - die "cannot find ${type}:${name}\n" unless ($data and $data eq $name); + my %search = (ob_type => $type, + ob_name => $name); + my $object = $dbh->resultset('Object')->find (\%search); + die "cannot find ${type}:${name}\n" + unless ($object and $object->ob_name eq $name); my $self = { dbh => $dbh, name => $name, @@ -59,18 +60,27 @@ sub create { $time ||= time; die "invalid object type\n" unless $type; die "invalid object name\n" unless $name; + my $guard = $dbh->txn_scope_guard; eval { - my $date = strftime ('%Y-%m-%d %T', localtime $time); - my $sql = 'insert into objects (ob_type, ob_name, ob_created_by, - ob_created_from, ob_created_on) values (?, ?, ?, ?, ?)'; - $dbh->do ($sql, undef, $type, $name, $user, $host, $date); - $sql = "insert into object_history (oh_type, oh_name, oh_action, - oh_by, oh_from, oh_on) values (?, ?, 'create', ?, ?, ?)"; - $dbh->do ($sql, undef, $type, $name, $user, $host, $date); - $dbh->commit; + my %record = (ob_type => $type, + ob_name => $name, + ob_created_by => $user, + ob_created_from => $host, + ob_created_on => strftime ('%Y-%m-%d %T', + localtime $time)); + $dbh->resultset('Object')->create (\%record); + + %record = (oh_type => $type, + oh_name => $name, + oh_action => 'create', + oh_by => $user, + oh_from => $host, + oh_on => strftime ('%Y-%m-%d %T', localtime $time)); + $dbh->resultset('ObjectHistory')->create (\%record); + + $guard->commit; }; if ($@) { - $dbh->rollback; die "cannot create object ${type}:${name}: $@\n"; } my $self = { @@ -126,30 +136,36 @@ sub log_action { # We have two traces to record, one in the object_history table and one in # the object record itself. Commit both changes as a transaction. We # assume that AutoCommit is turned off. + my $guard = $self->{dbh}->txn_scope_guard; eval { - my $date = strftime ('%Y-%m-%d %T', localtime $time); - my $sql = 'insert into object_history (oh_type, oh_name, oh_action, - oh_by, oh_from, oh_on) values (?, ?, ?, ?, ?, ?)'; - $self->{dbh}->do ($sql, undef, $self->{type}, $self->{name}, $action, - $user, $host, $date); + my %record = (oh_type => $self->{type}, + oh_name => $self->{name}, + oh_action => $action, + oh_by => $user, + oh_from => $host, + oh_on => strftime ('%Y-%m-%d %T', localtime $time)); + $self->{dbh}->resultset('ObjectHistory')->create (\%record); + + my %search = (ob_type => $self->{type}, + ob_name => $self->{name}); + my $object = $self->{dbh}->resultset('Object')->find (\%search); if ($action eq 'get') { - $sql = 'update objects set ob_downloaded_by = ?, - ob_downloaded_from = ?, ob_downloaded_on = ? where - ob_type = ? and ob_name = ?'; - $self->{dbh}->do ($sql, undef, $user, $host, $date, $self->{type}, - $self->{name}); + $object->ob_downloaded_by ($user); + $object->ob_downloaded_from ($host); + $object->ob_downloaded_on (strftime ('%Y-%m-%d %T', + localtime $time)); } elsif ($action eq 'store') { - $sql = 'update objects set ob_stored_by = ?, ob_stored_from = ?, - ob_stored_on = ? where ob_type = ? and ob_name = ?'; - $self->{dbh}->do ($sql, undef, $user, $host, $date, $self->{type}, - $self->{name}); + $object->ob_stored_by ($user); + $object->ob_stored_from ($host); + $object->ob_stored_on (strftime ('%Y-%m-%d %T', + localtime $time)); } - $self->{dbh}->commit; + $object->update; + $guard->commit; }; if ($@) { my $id = $self->{type} . ':' . $self->{name}; $self->error ("cannot update history for $id: $@"); - $self->{dbh}->rollback; return; } return 1; @@ -175,12 +191,18 @@ sub log_set { unless ($fields{$field}) { die "invalid history field $field"; } - my $date = strftime ('%Y-%m-%d %T', localtime $time); - my $sql = "insert into object_history (oh_type, oh_name, oh_action, - oh_field, oh_type_field, oh_old, oh_new, oh_by, oh_from, oh_on) - values (?, ?, 'set', ?, ?, ?, ?, ?, ?, ?)"; - $self->{dbh}->do ($sql, undef, $self->{type}, $self->{name}, $field, - $type_field, $old, $new, $user, $host, $date); + + my %record = (oh_type => $self->{type}, + oh_name => $self->{name}, + oh_action => 'set', + oh_field => $field, + oh_type_field => $type_field, + oh_old => $old, + oh_new => $new, + oh_by => $user, + oh_from => $host, + oh_on => strftime ('%Y-%m-%d %T', localtime $time)); + $self->{dbh}->resultset('ObjectHistory')->create (\%record); } ############################################################################## @@ -202,20 +224,21 @@ sub _set_internal { $self->error ("cannot modify ${type}:${name}: object is locked"); return; } + + my $guard = $self->{dbh}->txn_scope_guard; eval { - my $sql = "select ob_$attr from objects where ob_type = ? and - ob_name = ?"; - my $old = $self->{dbh}->selectrow_array ($sql, undef, $type, $name); - $sql = "update objects set ob_$attr = ? where ob_type = ? and - ob_name = ?"; - $self->{dbh}->do ($sql, undef, $value, $type, $name); + my %search = (ob_type => $type, + ob_name => $name); + my $object = $self->{dbh}->resultset('Object')->find (\%search); + my $old = $object->get_column ("ob_$attr"); + + $object->update ({ "ob_$attr" => $value }); $self->log_set ($attr, $old, $value, $user, $host, $time); - $self->{dbh}->commit; + $guard->commit; }; if ($@) { my $id = $self->{type} . ':' . $self->{name}; $self->error ("cannot set $attr on $id: $@"); - $self->{dbh}->rollback; return; } return 1; @@ -236,14 +259,13 @@ sub _get_internal { my $type = $self->{type}; my $value; eval { - my $sql = "select $attr from objects where ob_type = ? and - ob_name = ?"; - $value = $self->{dbh}->selectrow_array ($sql, undef, $type, $name); - $self->{dbh}->commit; + my %search = (ob_type => $type, + ob_name => $name); + my $object = $self->{dbh}->resultset('Object')->find (\%search); + $value = $object->get_column ($attr); }; if ($@) { $self->error ($@); - $self->{dbh}->rollback; return; } return $value; @@ -356,14 +378,18 @@ sub flag_check { my $dbh = $self->{dbh}; my $value; eval { - my $sql = 'select fl_flag from flags where fl_type = ? and fl_name = ? - and fl_flag = ?'; - $value = $dbh->selectrow_array ($sql, undef, $type, $name, $flag); - $dbh->commit; + my %search = (fl_type => $type, + fl_name => $name, + fl_flag => $flag); + my $flag = $dbh->resultset('Flag')->find (\%search); + if (not defined $flag) { + $value = 0; + } else { + $value = $flag->fl_flag; + } }; if ($@) { $self->error ("cannot check flag $flag for ${type}:${name}: $@"); - $dbh->rollback; return; } else { return ($value) ? 1 : 0; @@ -378,22 +404,21 @@ sub flag_clear { my $name = $self->{name}; my $type = $self->{type}; my $dbh = $self->{dbh}; + my $guard = $dbh->txn_scope_guard; eval { - my $sql = 'select * from flags where fl_type = ? and fl_name = ? and - fl_flag = ?'; - my ($data) = $dbh->selectrow_array ($sql, undef, $type, $name, $flag); - unless (defined $data) { + my %search = (fl_type => $type, + fl_name => $name, + fl_flag => $flag); + my $flag = $dbh->resultset('Flag')->find (\%search); + unless (defined $flag) { die "flag not set\n"; } - $sql = 'delete from flags where fl_type = ? and fl_name = ? and - fl_flag = ?'; - $dbh->do ($sql, undef, $type, $name, $flag); - $self->log_set ('flags', $flag, undef, $user, $host, $time); - $dbh->commit; + $flag->delete; + $self->log_set ('flags', $flag->fl_flag, undef, $user, $host, $time); + $guard->commit; }; if ($@) { $self->error ("cannot clear flag $flag on ${type}:${name}: $@"); - $dbh->rollback; return; } return 1; @@ -407,20 +432,18 @@ sub flag_list { undef $self->{error}; my @flags; eval { - my $sql = 'select fl_flag from flags where fl_type = ? and - fl_name = ? order by fl_flag'; - my $sth = $self->{dbh}->prepare ($sql); - $sth->execute ($self->{type}, $self->{name}); - my $flag; - while (defined ($flag = $sth->fetchrow_array)) { - push (@flags, $flag); + my %search = (fl_type => $self->{type}, + fl_name => $self->{name}); + my %attrs = (order_by => 'fl_flag'); + my @flags_rs = $self->{dbh}->resultset('Flag')->search (\%search, + \%attrs); + for my $flag (@flags_rs) { + push (@flags, $flag->fl_flag); } - $self->{dbh}->commit; }; if ($@) { my $id = $self->{type} . ':' . $self->{name}; $self->error ("cannot retrieve flags for $id: $@"); - $self->{dbh}->rollback; return; } else { return @flags; @@ -435,22 +458,21 @@ sub flag_set { my $name = $self->{name}; my $type = $self->{type}; my $dbh = $self->{dbh}; + my $guard = $dbh->txn_scope_guard; eval { - my $sql = 'select * from flags where fl_type = ? and fl_name = ? and - fl_flag = ?'; - my ($data) = $dbh->selectrow_array ($sql, undef, $type, $name, $flag); - if (defined $data) { + my %search = (fl_type => $type, + fl_name => $name, + fl_flag => $flag); + my $flag = $dbh->resultset('Flag')->find (\%search); + if (defined $flag) { die "flag already set\n"; } - $sql = 'insert into flags (fl_type, fl_name, fl_flag) - values (?, ?, ?)'; - $dbh->do ($sql, undef, $type, $name, $flag); - $self->log_set ('flags', undef, $flag, $user, $host, $time); - $dbh->commit; + $flag = $dbh->resultset('Flag')->create (\%search); + $self->log_set ('flags', undef, $flag->fl_flag, $user, $host, $time); + $guard->commit; }; if ($@) { $self->error ("cannot set flag $flag on ${type}:${name}: $@"); - $dbh->rollback; return; } return 1; @@ -466,11 +488,10 @@ sub format_acl_id { my ($self, $id) = @_; my $name = $id; - my $sql = 'select ac_name from acls where ac_id = ?'; - my $sth = $self->{dbh}->prepare ($sql); - $sth->execute ($id); - if (my @ref = $sth->fetchrow_array) { - $name = $ref[0] . " ($id)"; + my %search = (ac_id => $id); + my $acl_rs = $self->{dbh}->resultset('Acl')->find (\%search); + if (defined $acl_rs) { + $name = $acl_rs->ac_name . " ($id)"; } return $name; @@ -483,23 +504,29 @@ sub history { my ($self) = @_; my $output = ''; eval { - my $sql = 'select oh_action, oh_field, oh_type_field, oh_old, oh_new, - oh_by, oh_from, oh_on from object_history where oh_type = ? and - oh_name = ? order by oh_on'; - my $sth = $self->{dbh}->prepare ($sql); - $sth->execute ($self->{type}, $self->{name}); - my @data; - while (@data = $sth->fetchrow_array) { - $output .= "$data[7] "; - my ($old, $new) = @data[3..4]; - if ($data[0] eq 'set' and $data[1] eq 'flags') { - if (defined ($data[4])) { - $output .= "set flag $data[4]"; - } elsif (defined ($data[3])) { - $output .= "clear flag $data[3]"; + my %search = (oh_type => $self->{type}, + oh_name => $self->{name}); + my %attrs = (order_by => 'oh_on'); + my @history = $self->{dbh}->resultset('ObjectHistory') + ->search (\%search, \%attrs); + + for my $history_rs (@history) { + $output .= sprintf ("%s %s ", $history_rs->oh_on->ymd, + $history_rs->oh_on->hms); + + my $old = $history_rs->oh_old; + my $new = $history_rs->oh_new; + my $action = $history_rs->oh_action; + my $field = $history_rs->oh_field; + + if ($action eq 'set' and $field eq 'flags') { + if (defined ($new)) { + $output .= "set flag $new"; + } elsif (defined ($old)) { + $output .= "clear flag $old"; } - } elsif ($data[0] eq 'set' and $data[1] eq 'type_data') { - my $attr = $data[2]; + } elsif ($action eq 'set' and $field eq 'type_data') { + my $attr = $history_rs->oh_type_field; if (defined ($old) and defined ($new)) { $output .= "set attribute $attr to $new (was $old)"; } elsif (defined ($old)) { @@ -507,9 +534,8 @@ sub history { } elsif (defined ($new)) { $output .= "add $new to attribute $attr"; } - } elsif ($data[0] eq 'set' - and ($data[1] eq 'owner' or $data[1] =~ /^acl_/)) { - my $field = $data[1]; + } elsif ($action eq 'set' + and ($field eq 'owner' or $field =~ /^acl_/)) { $old = $self->format_acl_id ($old) if defined ($old); $new = $self->format_acl_id ($new) if defined ($new); if (defined ($old) and defined ($new)) { @@ -519,8 +545,7 @@ sub history { } elsif (defined ($old)) { $output .= "unset $field (was $old)"; } - } elsif ($data[0] eq 'set') { - my $field = $data[1]; + } elsif ($action eq 'set') { if (defined ($old) and defined ($new)) { $output .= "set $field to $new (was $old)"; } elsif (defined ($new)) { @@ -529,16 +554,15 @@ sub history { $output .= "unset $field (was $old)"; } } else { - $output .= $data[0]; + $output .= $action; } - $output .= "\n by $data[5] from $data[6]\n"; + $output .= sprintf ("\n by %s from %s\n", $history_rs->oh_by, + $history_rs->oh_from); } - $self->{dbh}->commit; }; if ($@) { my $id = $self->{type} . ':' . $self->{name}; $self->error ("cannot read history for $id: $@"); - $self->{dbh}->rollback; return; } return $output; @@ -592,15 +616,14 @@ sub show { [ ob_downloaded_on => 'Downloaded on' ]); my $fields = join (', ', map { $_->[0] } @attrs); my @data; + my $object_rs; eval { - my $sql = "select $fields from objects where ob_type = ? and - ob_name = ?"; - @data = $self->{dbh}->selectrow_array ($sql, undef, $type, $name); - $self->{dbh}->commit; + my %search = (ob_type => $type, + ob_name => $name); + $object_rs = $self->{dbh}->resultset('Object')->find (\%search); }; if ($@) { $self->error ("cannot retrieve data for ${type}:${name}: $@"); - $self->{dbh}->rollback; return; } my $output = ''; @@ -609,15 +632,18 @@ 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) { - next unless defined $data[$i]; - if ($attrs[$i][0] eq 'ob_comment' && length ($data[$i]) > 79 - 17) { + for my $i (0 .. $#attrs) { + my $field = $attrs[$i][0]; + my $fieldtext = $attrs[$i][1]; + next unless my $value = $object_rs->get_column ($field); + + if ($field eq 'ob_comment' && length ($value) > 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}//; + $value = wrap (' ' x 17, ' ' x 17, $value); + $value =~ s/^ {17}//; } - if ($attrs[$i][0] eq 'ob_created_by') { + if ($field eq 'ob_created_by') { my @flags = $self->flag_list; if (not @flags and $self->error) { return; @@ -631,15 +657,14 @@ sub show { } $output .= $attr_output; } - next unless defined $data[$i]; - if ($attrs[$i][0] =~ /^ob_(owner|acl_)/) { - my $acl = eval { Wallet::ACL->new ($data[$i], $self->{dbh}) }; + if ($field =~ /^ob_(owner|acl_)/) { + my $acl = eval { Wallet::ACL->new ($value, $self->{dbh}) }; if ($acl and not $@) { - $data[$i] = $acl->name || $data[$i]; - push (@acls, [ $acl, $data[$i] ]); + $value = $acl->name || $value; + push (@acls, [ $acl, $value ]); } } - $output .= sprintf ("%15s: %s\n", $attrs[$i][1], $data[$i]); + $output .= sprintf ("%15s: %s\n", $fieldtext, $value); } if (@acls) { my %seen; @@ -663,20 +688,31 @@ sub destroy { $self->error ("cannot destroy ${type}:${name}: object is locked"); return; } + my $guard = $self->{dbh}->txn_scope_guard; eval { - my $date = strftime ('%Y-%m-%d %T', localtime $time); - my $sql = 'delete from flags where fl_type = ? and fl_name = ?'; - $self->{dbh}->do ($sql, undef, $type, $name); - $sql = 'delete from objects where ob_type = ? and ob_name = ?'; - $self->{dbh}->do ($sql, undef, $type, $name); - $sql = "insert into object_history (oh_type, oh_name, oh_action, - oh_by, oh_from, oh_on) values (?, ?, 'destroy', ?, ?, ?)"; - $self->{dbh}->do ($sql, undef, $type, $name, $user, $host, $date); - $self->{dbh}->commit; + + # Remove any flags that may exist for the record. + my %search = (fl_type => $type, + fl_name => $name); + $self->{dbh}->resultset('Flag')->search (\%search)->delete; + + # Remove any object records + %search = (ob_type => $type, + ob_name => $name); + $self->{dbh}->resultset('Object')->search (\%search)->delete; + + # And create a new history object for the destroy action. + my %record = (oh_type => $type, + oh_name => $name, + oh_action => 'destroy', + oh_by => $user, + oh_from => $host, + oh_on => strftime ('%Y-%m-%d %T', localtime $time)); + $self->{dbh}->resultset('ObjectHistory')->create (\%record); + $guard->commit; }; if ($@) { $self->error ("cannot destroy ${type}:${name}: $@"); - $self->{dbh}->rollback; return; } return 1; @@ -733,7 +769,7 @@ such object exits, throws an exception. Otherwise, returns an object blessed into the class used for the new() call (so subclasses can leave this method alone and not override it). -Takes a Wallet::Database object, which is stored in the object and used +Takes a Wallet::Schema object, which is stored in the object and used for any further operations. =item create(TYPE, NAME, DBH, PRINCIPAL, HOSTNAME [, DATETIME]) diff --git a/perl/Wallet/Object/Keytab.pm b/perl/Wallet/Object/Keytab.pm index fd3001f..083dae6 100644 --- a/perl/Wallet/Object/Keytab.pm +++ b/perl/Wallet/Object/Keytab.pm @@ -40,21 +40,29 @@ sub enctypes_set { my @trace = ($user, $host, $time); my $name = $self->{name}; my %enctypes = map { $_ => 1 } @$enctypes; + my $guard = $self->{dbh}->txn_scope_guard; eval { - my $sql = 'select ke_enctype from keytab_enctypes where ke_name = ?'; - my $sth = $self->{dbh}->prepare ($sql); - $sth->execute ($name); - my (@current, $entry); - while (defined ($entry = $sth->fetchrow_arrayref)) { - push (@current, @$entry); + + # Find all enctypes for the given keytab. + my %search = (ke_name => $name); + my @enctypes = $self->{dbh}->resultset('KeytabEnctype') + ->search (\%search); + my (@current); + for my $enctype_rs (@enctypes) { + push (@current, $enctype_rs->ke_enctype); } + + # Use the existing enctypes and the enctypes we should have to match + # against ones that need to be removed, and note those that already + # exist. for my $enctype (@current) { if ($enctypes{$enctype}) { delete $enctypes{$enctype}; } else { - $sql = 'delete from keytab_enctypes where ke_name = ? and - ke_enctype = ?'; - $self->{dbh}->do ($sql, undef, $name, $enctype); + %search = (ke_name => $name, + ke_enctype => $enctype); + $self->{dbh}->resultset('KeytabEnctype')->find (\%search) + ->delete; $self->log_set ('type_data enctypes', $enctype, undef, @trace); } } @@ -64,21 +72,20 @@ sub enctypes_set { # doesn't enforce integrity constraints. We do this in sorted order # to make it easier to test. for my $enctype (sort keys %enctypes) { - $sql = 'select en_name from enctypes where en_name = ?'; - my $status = $self->{dbh}->selectrow_array ($sql, undef, $enctype); - unless ($status) { + my %search = (en_name => $enctype); + my $enctype_rs = $self->{dbh}->('Enctype')->find (\%search); + unless (defined $enctype_rs) { die "unknown encryption type $enctype\n"; } - $sql = 'insert into keytab_enctypes (ke_name, ke_enctype) values - (?, ?)'; - $self->{dbh}->do ($sql, undef, $name, $enctype); + my %record = (ke_name => $name, + ke_enctype => $enctype); + $self->{dbh}->resultset('Enctype')->create (\%record); $self->log_set ('type_data enctypes', undef, $enctype, @trace); } - $self->{dbh}->commit; + $guard->commit; }; if ($@) { $self->error ($@); - $self->{dbh}->rollback; return; } return 1; @@ -92,19 +99,16 @@ sub enctypes_list { my ($self) = @_; my @enctypes; eval { - my $sql = 'select ke_enctype from keytab_enctypes where ke_name = ? - order by ke_enctype'; - my $sth = $self->{dbh}->prepare ($sql); - $sth->execute ($self->{name}); - my $entry; - while (defined ($entry = $sth->fetchrow_arrayref)) { - push (@enctypes, @$entry); + my %search = (ke_name => $self->{name}); + my %attrs = (order_by => 'ke_enctype'); + my @enctypes_rs = $self->{dbh}->resultset('KeytabEnctype') + ->search (\%search, \%attrs); + for my $enctype_rs (@enctypes_rs) { + push (@enctypes, $enctype_rs->ke_enctype); } - $self->{dbh}->commit; }; if ($@) { $self->error ($@); - $self->{dbh}->rollback; return; } return @enctypes; @@ -132,21 +136,21 @@ sub sync_set { $self->error ("unsupported synchronization target $target"); return; } else { + my $guard = $self->{dbh}->txn_scope_guard; eval { - my $sql = 'select ks_target from keytab_sync where ks_name = ?'; - my $dbh = $self->{dbh}; my $name = $self->{name}; - my ($result) = $dbh->selectrow_array ($sql, undef, $name); - if ($result) { - my $sql = 'delete from keytab_sync where ks_name = ?'; - $self->{dbh}->do ($sql, undef, $name); - $self->log_set ('type_data sync', $result, undef, @trace); + my %search = (ks_name => $name); + my $sync_rs = $self->dbh->resultset('KeytabSync') + ->search (\%search); + if (defined $sync_rs) { + my $target = $sync_rs->ks_target; + $sync_rs->delete; + $self->log_set ('type_data sync', $target, undef, @trace); } - $self->{dbh}->commit; + $guard->commit; }; if ($@) { $self->error ($@); - $self->{dbh}->rollback; return; } } @@ -161,19 +165,16 @@ sub sync_list { my ($self) = @_; my @targets; eval { - my $sql = 'select ks_target from keytab_sync where ks_name = ? - order by ks_target'; - my $sth = $self->{dbh}->prepare ($sql); - $sth->execute ($self->{name}); - my $target; - while (defined ($target = $sth->fetchrow_array)) { - push (@targets, $target); + my %search = (ks_name => $self->{name}); + my %attrs = (order_by => 'ks_target'); + my @syncs = $self->dbh->resultset('KeytabSync')->search (\%search, + \%attrs); + for my $sync_rs (@syncs) { + push (@targets, $sync_rs->ks_target); } - $self->{dbh}->commit; }; if ($@) { $self->error ($@); - $self->{dbh}->rollback; return; } return @targets; @@ -247,11 +248,6 @@ sub new { my $kadmin = Wallet::Kadmin->new (); $self->{kadmin} = $kadmin; - # Set a callback for things to do after a fork, specifically for the MIT - # kadmin module which forks to kadmin. - my $callback = sub { $self->{dbh}->{InactiveDestroy} = 1 }; - $kadmin->fork_callback ($callback); - $self = $class->SUPER::new ($type, $name, $dbh); $self->{kadmin} = $kadmin; return $self; @@ -271,11 +267,6 @@ sub create { my $kadmin = Wallet::Kadmin->new (); $self->{kadmin} = $kadmin; - # Set a callback for things to do after a fork, specifically for the MIT - # kadmin module which forks to kadmin. - my $callback = sub { $self->{dbh}->{InactiveDestroy} = 1 }; - $kadmin->fork_callback ($callback); - if (not $kadmin->create ($name)) { die $kadmin->error, "\n"; } @@ -292,16 +283,21 @@ sub destroy { $self->error ("cannot destroy $id: object is locked"); return; } + my $dbh = $self->{dbh}; + my $guard = $dbh->txn_scope_guard; eval { - my $sql = 'delete from keytab_sync where ks_name = ?'; - $self->{dbh}->do ($sql, undef, $self->{name}); - $sql = 'delete from keytab_enctypes where ke_name = ?'; - $self->{dbh}->do ($sql, undef, $self->{name}); - $self->{dbh}->commit; + my %search = (ks_name => $self->{name}); + my $sync_rs = $dbh->resultset('KeytabSync')->search (\%search); + $sync_rs->delete_all if defined $sync_rs; + + %search = (ke_name => $self->{name}); + my $enctype_rs = $dbh->resultset('KeytabEnctype')->search (\%search); + $enctype_rs->delete_all if defined $enctype_rs; + + $guard->commit; }; if ($@) { $self->error ($@); - $self->{dbh}->rollback; return; } my $kadmin = $self->{kadmin}; diff --git a/perl/Wallet/Report.pm b/perl/Wallet/Report.pm index 5a8dc52..ea8cd2f 100644 --- a/perl/Wallet/Report.pm +++ b/perl/Wallet/Report.pm @@ -16,12 +16,12 @@ use strict; use vars qw($VERSION); use Wallet::ACL; -use Wallet::Database; +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.03'; +$VERSION = '0.04'; ############################################################################## # Constructor, destructor, and accessors @@ -32,7 +32,7 @@ $VERSION = '0.03'; # exception if anything goes wrong. sub new { my ($class) = @_; - my $dbh = Wallet::Database->connect; + my $dbh = Wallet::Schema->connect; my $self = { dbh => $dbh }; bless ($self, $class); return $self; @@ -59,7 +59,7 @@ sub error { # Disconnect the database handle on object destruction to avoid warnings. sub DESTROY { my ($self) = @_; - $self->{dbh}->disconnect unless $self->{dbh}->{InactiveDestroy}; + $self->{dbh}->storage->dbh->disconnect; } ############################################################################## @@ -69,18 +69,26 @@ sub DESTROY { # Return the SQL statement to find every object in the database. sub objects_all { my ($self) = @_; - my $sql = 'select ob_type, ob_name from objects order by ob_type, - ob_name'; - return $sql; + my @objects; + + my %search = (); + my %options = (order_by => [ qw/ob_type ob_name/ ], + select => [ qw/ob_type ob_name/ ]); + + return (\%search, \%options); } # Return the SQL statement and the search field required to find all objects # matching a specific type. sub objects_type { my ($self, $type) = @_; - my $sql = 'select ob_type, ob_name from objects where ob_type=? order - by ob_type, ob_name'; - return ($sql, $type); + my @objects; + + my %search = (ob_type => $type); + my %options = (order_by => [ qw/ob_type ob_name/ ], + select => [ qw/ob_type ob_name/ ]); + + return (\%search, \%options); } # Return the SQL statement and search field required to find all objects owned @@ -89,28 +97,36 @@ sub objects_type { # match any ACLs, set an error and return undef. sub objects_owner { my ($self, $owner) = @_; - my ($sth); + my @objects; + + my %search; + my %options = (order_by => [ qw/ob_type ob_name/ ], + select => [ qw/ob_type ob_name/ ]); + if (lc ($owner) eq 'null') { - my $sql = 'select ob_type, ob_name from objects where ob_owner is null - order by objects.ob_type, objects.ob_name'; - return ($sql); + %search = (ob_owner => undef); } else { my $acl = eval { Wallet::ACL->new ($owner, $self->{dbh}) }; return unless $acl; - my $sql = 'select ob_type, ob_name from objects where ob_owner = ? - order by objects.ob_type, objects.ob_name'; - return ($sql, $acl->id); + %search = (ob_owner => $acl->id); } + + return (\%search, \%options); } # Return the SQL statement and search field required to find all objects that # have a specific flag set. sub objects_flag { my ($self, $flag) = @_; - my $sql = 'select ob_type, ob_name from objects left join flags on - (objects.ob_type = flags.fl_type and objects.ob_name = flags.fl_name) - where flags.fl_flag = ? order by objects.ob_type, objects.ob_name'; - return ($sql, $flag); + my @objects; + + my %search = ('flags.fl_flag' => $flag); + my %options = (join => 'flags', + prefetch => 'flags', + order_by => [ qw/ob_type ob_name/ ], + select => [ qw/ob_type ob_name/ ]); + + return (\%search, \%options); } # Return the SQL statement and search field required to find all objects that @@ -120,22 +136,35 @@ sub objects_flag { # set an error and return the empty string. sub objects_acl { my ($self, $search) = @_; - my $acl = eval { Wallet::ACL->new ($search, $self->{dbh}) }; + my @objects; + + my $dbh = $self->{dbh}; + my $acl = eval { Wallet::ACL->new ($search, $dbh) }; return unless $acl; - 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 = ? order by objects.ob_type, - objects.ob_name'; - return ($sql, ($acl->id) x 6); + + my @search = ({ ob_owner => $acl->id }, + { ob_acl_get => $acl->id }, + { ob_acl_store => $acl->id }, + { ob_acl_show => $acl->id }, + { ob_acl_destroy => $acl->id }, + { ob_acl_flags => $acl->id }); + my %options = (order_by => [ qw/ob_type ob_name/ ], + select => [ qw/ob_type ob_name/ ]); + + return (\@search, \%options); } # Return the SQL statement to find all objects that have been created but # have never been retrieved (via get). sub objects_unused { my ($self) = @_; - my $sql = 'select ob_type, ob_name from objects where ob_downloaded_on - is null order by objects.ob_type, objects.ob_name'; - return ($sql); + my @objects; + + my %search = (ob_downloaded_on => undef); + my %options = (order_by => [ qw/ob_type ob_name/ ], + select => [ qw/ob_type ob_name/ ]); + + return (\%search, \%options); } # Returns a list of all objects stored in the wallet database in the form of @@ -148,46 +177,44 @@ sub objects { my ($self, $type, @args) = @_; undef $self->{error}; - # Find the SQL statement and the arguments to use. - my $sql = ''; - my @search = (); + # Get the search and options array refs from specific functions. + my ($search_ref, $options_ref); if (!defined $type || $type eq '') { - ($sql) = $self->objects_all; + ($search_ref, $options_ref) = $self->objects_all; } else { if ($type ne 'unused' && @args != 1) { $self->error ("object searches require one argument to search"); } elsif ($type eq 'type') { - ($sql, @search) = $self->objects_type (@args); + ($search_ref, $options_ref) = $self->objects_type (@args); } elsif ($type eq 'owner') { - ($sql, @search) = $self->objects_owner (@args); + ($search_ref, $options_ref) = $self->objects_owner (@args); } elsif ($type eq 'flag') { - ($sql, @search) = $self->objects_flag (@args); + ($search_ref, $options_ref) = $self->objects_flag (@args); } elsif ($type eq 'acl') { - ($sql, @search) = $self->objects_acl (@args); + ($search_ref, $options_ref) = $self->objects_acl (@args); } elsif ($type eq 'unused') { - ($sql) = $self->objects_unused (@args); + ($search_ref, $options_ref) = $self->objects_unused (@args); } else { $self->error ("do not know search type: $type"); } - return unless $sql; + return unless $search_ref; } - # Do the search. + # Perform the search and return on any errors. my @objects; + my $dbh = $self->{dbh}; eval { - my $sth = $self->{dbh}->prepare ($sql); - $sth->execute (@search); - my $object; - while (defined ($object = $sth->fetchrow_arrayref)) { - push (@objects, [ @$object ]); + my @objects_rs = $dbh->resultset('Object')->search ($search_ref, + $options_ref); + for my $object_rs (@objects_rs) { + push (@objects, [ $object_rs->ob_type, $object_rs->ob_name ]); } - $self->{dbh}->commit; }; if ($@) { $self->error ("cannot list objects: $@"); - $self->{dbh}->rollback; return; } + return @objects; } @@ -199,17 +226,51 @@ sub objects { # database. sub acls_all { my ($self) = @_; - my $sql = 'select ac_id, ac_name from acls order by ac_id'; - return ($sql); + my @acls; + + my $dbh = $self->{dbh}; + my %search = (); + my %options = (order_by => [ qw/ac_id/ ], + select => [ qw/ac_id ac_name/ ]); + + eval { + my @acls_rs = $dbh->resultset('Acl')->search (\%search, \%options); + for my $acl_rs (@acls_rs) { + push (@acls, [ $acl_rs->ac_id, $acl_rs->ac_name ]); + } + }; + + if ($@) { + $self->error ("cannot list ACLs: $@"); + return; + } + return (@acls); } # Returns the SQL statement required to find all empty ACLs in the database. 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 order by - ac_id'; - return ($sql); + my @acls; + + my $dbh = $self->{dbh}; + my %search = (ae_id => undef); + my %options = (join => 'acl_entries', + prefetch => 'acl_entries', + order_by => [ qw/ac_id/ ], + select => [ qw/ac_id ac_name/ ]); + + eval { + my @acls_rs = $dbh->resultset('Acl')->search (\%search, \%options); + for my $acl_rs (@acls_rs) { + push (@acls, [ $acl_rs->ac_id, $acl_rs->ac_name ]); + } + }; + + if ($@) { + $self->error ("cannot list ACLs: $@"); + return; + } + return (@acls); } # Returns the SQL statement and the field required to find ACLs containing the @@ -217,22 +278,69 @@ sub acls_empty { # do a substring search. sub acls_entry { my ($self, $type, $identifier) = @_; - my $sql = 'select distinct ac_id, ac_name from acl_entries left join acls - on (ae_id = ac_id) where ae_scheme = ? and ae_identifier like ? order - by ac_id'; - return ($sql, $type, '%' . $identifier . '%'); + my @acls; + + my $dbh = $self->{dbh}; + my %search = (ae_scheme => $type, + ae_identifier => { like => '%'.$identifier.'%' }); + my %options = (join => 'acl_entries', + prefetch => 'acl_entries', + order_by => [ qw/ac_id/ ], + select => [ qw/ac_id ac_name/ ], + distinct => 1); + + eval { + my @acls_rs = $dbh->resultset('Acl')->search (\%search, \%options); + for my $acl_rs (@acls_rs) { + push (@acls, [ $acl_rs->ac_id, $acl_rs->ac_name ]); + } + }; + + if ($@) { + $self->error ("cannot list ACLs: $@"); + return; + } + return (@acls); } # 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)"; + my @acls; + + my $dbh = $self->{dbh}; + my %search = ( + #'acls_owner.ob_owner' => undef, + #'acls_get.ob_owner' => undef, + #'acls_store.ob_owner' => undef, + #'acls_show.ob_owner' => undef, + #'acls_destroy.ob_owner' => undef, + #'acls_flags.ob_owner' => undef, + ); + my %options = (#join => [ qw/acls_owner acls_get acls_store acls_show acls_destroy acls_flags/ ], + order_by => [ qw/ac_id/ ], + select => [ qw/ac_id ac_name/ ]); + + eval { + my @acls_rs = $dbh->resultset('Acl')->search (\%search, \%options); + + # FIXME: Almost certainly a way of doing this with the search itself. + for my $acl_rs (@acls_rs) { + next if $acl_rs->acls_owner->first; + next if $acl_rs->acls_get->first; + next if $acl_rs->acls_store->first; + next if $acl_rs->acls_show->first; + next if $acl_rs->acls_destroy->first; + next if $acl_rs->acls_flags->first; + push (@acls, [ $acl_rs->ac_id, $acl_rs->ac_name ]); + } + }; + + if ($@) { + $self->error ("cannot list ACLs: $@"); + return; } - return ($sql); + return (@acls); } # Obtain a textual representation of the membership of an ACL, returning undef @@ -290,11 +398,10 @@ sub acls { my ($self, $type, @args) = @_; undef $self->{error}; - # Find the SQL statement and the arguments to use. - my $sql; - my @search = (); + # Find the ACLs for any given search. + my @acls; if (!defined $type || $type eq '') { - ($sql) = $self->acls_all; + @acls = $self->acls_all; } else { if ($type eq 'duplicate') { return $self->acls_duplicate; @@ -303,34 +410,17 @@ sub acls { $self->error ('ACL searches require an argument to search'); return; } else { - ($sql, @search) = $self->acls_entry (@args); + @acls = $self->acls_entry (@args); } } elsif ($type eq 'empty') { - ($sql) = $self->acls_empty; + @acls = $self->acls_empty; } elsif ($type eq 'unused') { - ($sql) = $self->acls_unused; + @acls = $self->acls_unused; } else { $self->error ("unknown search type: $type"); return; } } - - # Do the search. - my @acls; - eval { - my $sth = $self->{dbh}->prepare ($sql); - $sth->execute (@search); - my $object; - while (defined ($object = $sth->fetchrow_arrayref)) { - push (@acls, [ @$object ]); - } - $self->{dbh}->commit; - }; - if ($@) { - $self->error ("cannot list ACLs: $@"); - $self->{dbh}->rollback; - return; - } return @acls; } @@ -343,26 +433,32 @@ sub acls { sub owners { my ($self, $type, $name) = @_; undef $self->{error}; - my @lines; + my $dbh = $self->{dbh}; + + my @owners; eval { - my $sql = 'select distinct ae_scheme, ae_identifier from acl_entries, - acls, objects where ae_id = ac_id and ac_id = ob_owner and - ob_type like ? and ob_name like ? order by ae_scheme, - ae_identifier'; - my $sth = $self->{dbh}->prepare ($sql); - $sth->execute ($type, $name); - my $object; - while (defined ($object = $sth->fetchrow_arrayref)) { - push (@lines, [ @$object ]); + my %search = ( + 'acls_owner.ob_type' => { like => $type }, + 'acls_owner.ob_name' => { like => $name }); + my %options = ( + join => { 'acls' => 'acls_owner' }, + order_by => [ qw/ae_scheme ae_identifier/ ], + distinct => 1, + ); + + my @acls_rs = $dbh->resultset('AclEntry')->search (\%search, + \%options); + for my $acl_rs (@acls_rs) { + my $scheme = $acl_rs->ae_scheme; + my $identifier = $acl_rs->ae_identifier; + push (@owners, [ $scheme, $identifier ]); } - $self->{dbh}->commit; }; if ($@) { $self->error ("cannot report on owners: $@"); - $self->{dbh}->rollback; return; } - return @lines; + return @owners; } ############################################################################## diff --git a/perl/Wallet/Schema.pm b/perl/Wallet/Schema.pm index 9a7fe44..d36b7ac 100644 --- a/perl/Wallet/Schema.pm +++ b/perl/Wallet/Schema.pm @@ -1,262 +1,85 @@ -# Wallet::Schema -- Database schema for the wallet system. -# -# Written by Russ Allbery -# Copyright 2007, 2008, 2010, 2011 -# The Board of Trustees of the Leland Stanford Junior University -# -# See LICENSE for licensing terms. - -############################################################################## -# Modules and declarations -############################################################################## - package Wallet::Schema; -require 5.006; use strict; -use vars qw(@SQL @TABLES $VERSION); +use warnings; -use DBI; +use Wallet::Config; + +use base 'DBIx::Class::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.07'; +our $VERSION = '0.08'; + +__PACKAGE__->load_namespaces; +__PACKAGE__->load_components (qw/Schema::Versioned/); ############################################################################## -# Data manipulation +# Core overrides ############################################################################## -# Create a new Wallet::Schema object, parse the SQL out of the documentation, -# and store it in the object. We have to store the SQL in a static variable, -# since we can't read DATA multiple times. -sub new { +# Override DBI::connect to supply our own connect string, username, and +# password and to set some standard options. Takes no arguments other than +# the implicit class argument. +sub connect { my ($class) = @_; - unless (@SQL) { - local $_; - my $found; - my $command = ''; - while () { - if (not $found and /^=head1 SCHEMA/) { - $found = 1; - } elsif ($found and /^=head1 /) { - last; - } elsif ($found and /^ /) { - s/^ //; - $command .= $_; - if (/;$/) { - push (@SQL, $command); - $command = ''; - } - } - } - close DATA; + unless ($Wallet::Config::DB_DRIVER + and (defined ($Wallet::Config::DB_INFO) + or defined ($Wallet::Config::DB_NAME))) { + die "database connection information not configured\n"; } - my $self = { sql => [ @SQL ] }; - bless ($self, $class); - return $self; -} - -# Returns the SQL as a list of commands. -sub sql { - my ($self) = @_; - return @{ $self->{sql} }; -} - -############################################################################## -# Initialization and cleanup -############################################################################## - -# Run a set of SQL commands, forcing a transaction, rolling back on error, and -# throwing an exception if anything fails. -sub _run_sql { - my ($self, $dbh, @sql) = @_; - eval { - $dbh->begin_work if $dbh->{AutoCommit}; - for my $sql (@sql) { - $dbh->do ($sql, { RaiseError => 1, PrintError => 0 }); - } - $dbh->commit; - }; - if ($@) { - $dbh->rollback; - die "$@\n"; + my $dsn = "DBI:$Wallet::Config::DB_DRIVER:"; + if (defined $Wallet::Config::DB_INFO) { + $dsn .= $Wallet::Config::DB_INFO; + } else { + $dsn .= "database=$Wallet::Config::DB_NAME"; + $dsn .= ";host=$Wallet::Config::DB_HOST" if $Wallet::Config::DB_HOST; + $dsn .= ";port=$Wallet::Config::DB_PORT" if $Wallet::Config::DB_PORT; } -} - -# Given a database handle, try to create our database by running the SQL. Do -# this in a transaction regardless of the database settings and throw an -# exception if this fails. We have to do a bit of fiddling to get syntax that -# works with both MySQL and SQLite. -sub create { - my ($self, $dbh) = @_; - my $driver = $dbh->{Driver}->{Name}; - my @create = map { - if ($driver eq 'SQLite') { - s/auto_increment primary key/primary key autoincrement/; - } elsif ($driver eq 'mysql' and /^\s*create\s+table\s/) { - s/;$/ engine=InnoDB;/; - } - $_; - } @{ $self->{sql} }; - $self->_run_sql ($dbh, @create); -} - -# Given a database handle, try to remove the wallet database tables by -# reversing the SQL. Do this in a transaction regardless of the database -# settings and throw an exception if this fails. -sub drop { - my ($self, $dbh) = @_; - my @drop = map { - if (/^\s*create\s+table\s+(\S+)/i) { - "drop table if exists $1;"; - } else { - (); - } - } reverse @{ $self->{sql} }; - $self->_run_sql ($dbh, @drop); -} - -# Given an open database handle, determine the current database schema -# version. If we can't read the version number, we currently assume a version -# 0 database. This will change in the future. -sub _schema_version { - my ($self, $dbh) = @_; - my $version; - eval { - my $sql = 'select md_version from metadata'; - my $result = $dbh->selectrow_arrayref ($sql); - $version = $result->[0]; - }; + my $user = $Wallet::Config::DB_USER; + my $pass = $Wallet::Config::DB_PASSWORD; + my %attrs = (PrintError => 0, RaiseError => 1); + my $dbh = eval { $class->SUPER::connect ($dsn, $user, $pass, \%attrs) }; if ($@) { - $version = 0; + die "cannot connect to database: $@\n"; } - return $version; + return $dbh; } -# Given a database handle, try to upgrade the schema of that database to the -# current version while preserving all data. Do this in a transaction -# regardless of the database settings and throw an exception if this fails. -sub upgrade { - my ($self, $dbh) = @_; - my $version = $self->_schema_version ($dbh); - my @sql; - if ($version == 1) { - return; - } elsif ($version == 0) { - @sql = ('create table metadata (md_version integer)', - 'insert into metadata (md_version) values (1)', - 'alter table objects add ob_comment varchar(255) default null' - ); - } else { - die "unknown database version $version\n"; - } - $self->_run_sql ($dbh, @sql); -} +__END__ + +1; ############################################################################## -# Schema +# Documentation ############################################################################## -# The following POD is also parsed by the code to extract SQL blocks. Don't -# add any verbatim blocks to this documentation in the SCHEMA section that -# aren't intended to be SQL. - -1; -__DATA__ - =head1 NAME -Wallet::Schema - Database schema for the wallet system - -=for stopwords -SQL ACL API APIs enums Enums Keytab Backend keytab backend enctypes -enctype Allbery Metadata metadata verifier +Wallet::Schema - Database schema and connector for the wallet system =head1 SYNOPSIS use Wallet::Schema; - my $schema = Wallet::Schema->new; - my @sql = $schema->sql; - $schema->create ($dbh); + my $dbh = Wallet::Schema->connect; =head1 DESCRIPTION This class encapsulates the database schema for the wallet system. The -documentation you're reading explains and comments the schema. The Perl -object extracts the schema from the documentation and can either return it -as a list of SQL commands to run or run those commands given a connected -database handle. +documentation you're reading explains and comments the schema. The +class runs using the DBIx::Class module. -This schema attempts to be portable SQL, but it is designed for use with -MySQL and may require some modifications for other databases. - -=head1 METHODS - -=over 4 - -=item new() - -Instantiates a new Wallet::Schema object. This parses the documentation -and extracts the schema, but otherwise doesn't do anything. - -=item create(DBH) - -Given a connected database handle, runs the SQL commands necessary to -create the wallet database in an otherwise empty database. This method -will not drop any existing tables and will therefore fail if a wallet -database has already been created. On any error, this method will throw a -database exception. - -=item drop(DBH) - -Given a connected database handle, drop all of the wallet tables from that -database if any of those tables exist. This method will only remove -tables that are part of the current schema or one of the previous known -schema and won't remove other tables. On any error, this method will -throw a database exception. - -=item sql() - -Returns the schema and the population of the normalization tables as a -list of SQL commands to run to create the wallet database in an otherwise -empty database. - -=item upgrade(DBH) - -Given a connected database handle, runs the SQL commands necessary to -upgrade that database to the current schema version. On any error, this -method will throw a database exception. - -=back +connect() will obtain the database connection information from the wallet +configuration; see L 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. =head1 SCHEMA -=head2 Metadata Tables - -This table is used to store metadata about the wallet database, used for -upgrades and in similar situations: - - create table metadata - (md_version integer); - insert into metadata (md_version) values (1); - -This table will normally only have one row. md_version holds the version -number of the schema (which does not necessarily have any relationship to -the version number of wallet itself). - =head2 Normalization Tables -The following are normalization tables used to constrain the values in -other tables. - -Holds the supported flag names: - - create table flag_names - (fn_name varchar(32) primary key); - insert into flag_names (fn_name) values ('locked'); - insert into flag_names (fn_name) values ('unchanging'); - Holds the supported object types and their corresponding Perl classes: create table types @@ -390,8 +213,8 @@ object may have zero or more flags associated with it: not null references objects(ob_type), fl_name varchar(255) not null references objects(ob_name), - fl_flag varchar(32) - not null references flag_names(fn_name), + fl_flag enum('locked', 'unchanging') + not null, primary key (fl_type, fl_name, fl_flag)); create index fl_object on flags (fl_type, fl_name); @@ -477,9 +300,22 @@ To use this functionality, you will need to populate the enctypes table with the enctypes that a keytab may be restricted to. Currently, there is no automated mechanism to do this. +=head1 CLASS METHODS + +=over 4 + +=item connect() + +Opens a new database connection and returns the database object. On any +failure, throws an exception. Unlike the DBI method, connect() takes no +arguments; all database connection information is derived from the wallet +configuration. + +=back + =head1 SEE ALSO -wallet-backend(8) +wallet-backend(8), Wallet::Config(3) This module is part of the wallet system. The current version is available from L. diff --git a/perl/Wallet/Schema/Result/Acl.pm b/perl/Wallet/Schema/Result/Acl.pm new file mode 100644 index 0000000..60a357b --- /dev/null +++ b/perl/Wallet/Schema/Result/Acl.pm @@ -0,0 +1,99 @@ +package Wallet::Schema::Result::Acl; + +use strict; +use warnings; + +use base 'DBIx::Class::Core'; + +=head1 NAME + +Wallet::Schema::Result::Acl + +=head1 DESCRIPTION + +=cut + +__PACKAGE__->table("acls"); + +=head1 ACCESSORS + +=head2 ac_id + + data_type: 'integer' + is_auto_increment: 1 + is_nullable: 0 + +=head2 ac_name + + data_type: 'varchar' + is_nullable: 0 + size: 255 + +=cut + +__PACKAGE__->add_columns( + "ac_id", + { data_type => "integer", is_auto_increment => 1, is_nullable => 0 }, + "ac_name", + { data_type => "varchar", is_nullable => 0, size => 255 }, +); +__PACKAGE__->set_primary_key("ac_id"); +__PACKAGE__->add_unique_constraint("ac_name", ["ac_name"]); + +__PACKAGE__->has_one( + 'acl_entries', + 'Wallet::Schema::Result::AclEntry', + { 'foreign.ae_id' => 'self.ac_id' }, + { cascade_copy => 0, cascade_delete => 0 }, + ); +__PACKAGE__->has_many( + 'acl_history', + 'Wallet::Schema::Result::AclHistory', + { 'foreign.ah_id' => 'self.ac_id' }, + { cascade_copy => 0, cascade_delete => 0 }, + ); + +# References for all of the various potential ACLs in owners. +__PACKAGE__->has_many( + 'acls_owner', + 'Wallet::Schema::Result::Object', + { 'foreign.ob_owner' => 'self.ac_id' }, + ); +__PACKAGE__->has_many( + 'acls_get', + 'Wallet::Schema::Result::Object', + { 'foreign.ob_acl_get' => 'self.ac_id' }, + ); +__PACKAGE__->has_many( + 'acls_store', + 'Wallet::Schema::Result::Object', + { 'foreign.ob_acl_store' => 'self.ac_id' }, + ); +__PACKAGE__->has_many( + 'acls_show', + 'Wallet::Schema::Result::Object', + { 'foreign.ob_acl_show' => 'self.ac_id' }, + ); +__PACKAGE__->has_many( + 'acls_destroy', + 'Wallet::Schema::Result::Object', + { 'foreign.ob_acl_destroy' => 'self.ac_id' }, + ); +__PACKAGE__->has_many( + 'acls_flags', + 'Wallet::Schema::Result::Object', + { 'foreign.ob_acl_flags' => 'self.ac_id' }, + ); + +# Override the insert method so that we can automatically create history +# items. +#sub insert { +# my ($self, @args) = @_; +# my $ret = $self->next::method (@args); +# print "ID: ".$self->ac_id."\n"; +# use Data::Dumper; print Dumper (@args); + +# return $self; +#} + +1; diff --git a/perl/Wallet/Schema/Result/AclEntry.pm b/perl/Wallet/Schema/Result/AclEntry.pm new file mode 100644 index 0000000..99105a0 --- /dev/null +++ b/perl/Wallet/Schema/Result/AclEntry.pm @@ -0,0 +1,63 @@ +package Wallet::Schema::Result::AclEntry; + +use strict; +use warnings; + +use base 'DBIx::Class::Core'; + +=head1 NAME + +Wallet::Schema::Result::AclEntry + +=head1 DESCRIPTION + +=cut + +__PACKAGE__->table("acl_entries"); + +=head1 ACCESSORS + +=head2 ae_id + + data_type: 'integer' + is_nullable: 0 + +=head2 ae_scheme + + data_type: 'varchar' + is_nullable: 0 + size: 32 + +=head2 ae_identifier + + data_type: 'varchar' + is_nullable: 0 + size: 255 + +=cut + +__PACKAGE__->add_columns( + "ae_id", + { data_type => "integer", is_nullable => 0 }, + "ae_scheme", + { data_type => "varchar", is_nullable => 0, size => 32 }, + "ae_identifier", + { data_type => "varchar", is_nullable => 0, size => 255 }, +); +__PACKAGE__->set_primary_key("ae_id", "ae_scheme", "ae_identifier"); + +__PACKAGE__->belongs_to( + 'acls', + 'Wallet::Schema::Result::Acl', + { 'foreign.ac_id' => 'self.ae_id' }, + { is_deferrable => 1, on_delete => 'CASCADE', + on_update => 'CASCADE' }, + ); + +__PACKAGE__->has_one( + 'acl_scheme', + 'Wallet::Schema::Result::AclScheme', + { 'foreign.as_name' => 'self.ae_scheme' }, + { cascade_delete => 0 }, + ); +1; diff --git a/perl/Wallet/Schema/Result/AclHistory.pm b/perl/Wallet/Schema/Result/AclHistory.pm new file mode 100644 index 0000000..2ad56ff --- /dev/null +++ b/perl/Wallet/Schema/Result/AclHistory.pm @@ -0,0 +1,101 @@ +package Wallet::Schema::Result::AclHistory; + +use strict; +use warnings; + +use base 'DBIx::Class::Core'; + +__PACKAGE__->load_components("InflateColumn::DateTime"); + +=head1 NAME + +Wallet::Schema::Result::AclHistory + +=head1 DESCRIPTION + +=cut + +__PACKAGE__->table("acl_history"); + +=head1 ACCESSORS + +=head2 ah_id + + data_type: 'integer' + is_auto_increment: 1 + is_nullable: 0 + +=head2 ah_acl + + data_type: 'integer' + is_nullable: 0 + +=head2 ah_action + + data_type: 'varchar' + is_nullable: 0 + size: 16 + +=head2 ah_scheme + + data_type: 'varchar' + is_nullable: 1 + size: 32 + +=head2 ah_identifier + + data_type: 'varchar' + is_nullable: 1 + size: 255 + +=head2 ah_by + + data_type: 'varchar' + is_nullable: 0 + size: 255 + +=head2 ah_from + + data_type: 'varchar' + is_nullable: 0 + size: 255 + +=head2 ah_on + + data_type: 'datetime' + datetime_undef_if_invalid: 1 + is_nullable: 0 + +=cut + +__PACKAGE__->add_columns( + "ah_id", + { data_type => "integer", is_auto_increment => 1, is_nullable => 0 }, + "ah_acl", + { data_type => "integer", is_nullable => 0 }, + "ah_action", + { data_type => "varchar", is_nullable => 0, size => 16 }, + "ah_scheme", + { data_type => "varchar", is_nullable => 1, size => 32 }, + "ah_identifier", + { data_type => "varchar", is_nullable => 1, size => 255 }, + "ah_by", + { data_type => "varchar", is_nullable => 0, size => 255 }, + "ah_from", + { data_type => "varchar", is_nullable => 0, size => 255 }, + "ah_on", + { + data_type => "datetime", + datetime_undef_if_invalid => 1, + is_nullable => 0, + }, +); +__PACKAGE__->set_primary_key("ah_id"); + +__PACKAGE__->might_have( + 'acls', + 'Wallet::Schema::Result::Acl', + { 'foreign.ac_id' => 'self.ah_id' }, + ); + +1; diff --git a/perl/Wallet/Schema/Result/AclScheme.pm b/perl/Wallet/Schema/Result/AclScheme.pm new file mode 100644 index 0000000..96db79d --- /dev/null +++ b/perl/Wallet/Schema/Result/AclScheme.pm @@ -0,0 +1,73 @@ +package Wallet::Schema::Result::AclScheme; + +use strict; +use warnings; + +use base 'DBIx::Class::Core'; +__PACKAGE__->load_components (qw//); + +=head1 NAME + +Wallet::Schema::Result::AclScheme + +=head1 DESCRIPTION + +This is a normalization table used to constrain the values in other +tables. It contains the types of ACL schemes that Wallet will +recognize, and the modules that govern each of those schemes. + +By default it contains the following entries: + + 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 ('ldap-attr', 'Wallet::ACL::LDAP::Attribute'); + insert into acl_schemes (as_name, as_class) + values ('netdb', 'Wallet::ACL::NetDB'); + insert into acl_schemes (as_name, as_class) + values ('netdb-root', 'Wallet::ACL::NetDB::Root'); + +If you have extended the wallet to support additional ACL schemes, you +will want to add additional rows to this table mapping those schemes +to Perl classes that implement the ACL verifier APIs. + +=cut + +__PACKAGE__->table("acl_schemes"); + +=head1 ACCESSORS + +=head2 as_name + + data_type: 'varchar' + is_nullable: 0 + size: 32 + +=head2 as_class + + data_type: 'varchar' + is_nullable: 1 + size: 64 + +=cut + +__PACKAGE__->add_columns( + "as_name", + { data_type => "varchar", is_nullable => 0, size => 32 }, + "as_class", + { data_type => "varchar", is_nullable => 1, size => 64 }, +); +__PACKAGE__->set_primary_key("as_name"); + +#__PACKAGE__->resultset->populate ([ +# [ qw/as_name as_class/ ], +# [ 'krb5', 'Wallet::ACL::Krb5' ], +# [ 'krb5-regex', 'Wallet::ACL::Krb5::Regex' ], +# [ 'ldap-attr', 'Wallet::ACL::LDAP::Attribute' ], +# [ 'netdb', 'Wallet::ACL::NetDB' ], +# [ 'netdb-root', 'Wallet::ACL::NetDB::Root' ], +# ]); + +1; diff --git a/perl/Wallet/Schema/Result/Enctype.pm b/perl/Wallet/Schema/Result/Enctype.pm new file mode 100644 index 0000000..be41b84 --- /dev/null +++ b/perl/Wallet/Schema/Result/Enctype.pm @@ -0,0 +1,34 @@ +package Wallet::Schema::Result::Enctype; + +use strict; +use warnings; + +use base 'DBIx::Class::Core'; + +=head1 NAME + +Wallet::Schema::Result::Enctype + +=head1 DESCRIPTION + +=cut + +__PACKAGE__->table("enctypes"); + +=head1 ACCESSORS + +=head2 en_name + + data_type: 'varchar' + is_nullable: 0 + size: 255 + +=cut + +__PACKAGE__->add_columns( + "en_name", + { data_type => "varchar", is_nullable => 0, size => 255 }, +); +__PACKAGE__->set_primary_key("en_name"); + +1; diff --git a/perl/Wallet/Schema/Result/Flag.pm b/perl/Wallet/Schema/Result/Flag.pm new file mode 100644 index 0000000..b38e85f --- /dev/null +++ b/perl/Wallet/Schema/Result/Flag.pm @@ -0,0 +1,54 @@ +package Wallet::Schema::Result::Flag; + +use strict; +use warnings; + +use base 'DBIx::Class::Core'; + +=head1 NAME + +Wallet::Schema::Result::Flag + +=head1 DESCRIPTION + +=cut + +__PACKAGE__->table("flags"); + +=head1 ACCESSORS + +=head2 fl_type + + data_type: 'varchar' + is_nullable: 0 + size: 16 + +=head2 fl_name + + data_type: 'varchar' + is_nullable: 0 + size: 255 + +=head2 fl_flag + + data_type: 'varchar' + is_nullable: 0 + size: 32 + +=cut + +__PACKAGE__->add_columns( + "fl_type" => + { data_type => "varchar", is_nullable => 0, size => 16 }, + "fl_name" => + { data_type => "varchar", is_nullable => 0, size => 255 }, + "fl_flag" => { + data_type => 'enum', + is_enum => 1, + extra => { list => [qw/locked unchanging/] }, + }, +); +__PACKAGE__->set_primary_key("fl_type", "fl_name", "fl_flag"); + + +1; diff --git a/perl/Wallet/Schema/Result/KeytabEnctype.pm b/perl/Wallet/Schema/Result/KeytabEnctype.pm new file mode 100644 index 0000000..ae40c52 --- /dev/null +++ b/perl/Wallet/Schema/Result/KeytabEnctype.pm @@ -0,0 +1,42 @@ +package Wallet::Schema::Result::KeytabEnctype; + +use strict; +use warnings; + +use base 'DBIx::Class::Core'; + +=head1 NAME + +Wallet::Schema::Result::KeytabEnctype + +=head1 DESCRIPTION + +=cut + +__PACKAGE__->table("keytab_enctypes"); + +=head1 ACCESSORS + +=head2 ke_name + + data_type: 'varchar' + is_nullable: 0 + size: 255 + +=head2 ke_enctype + + data_type: 'varchar' + is_nullable: 0 + size: 255 + +=cut + +__PACKAGE__->add_columns( + "ke_name", + { data_type => "varchar", is_nullable => 0, size => 255 }, + "ke_enctype", + { data_type => "varchar", is_nullable => 0, size => 255 }, +); +__PACKAGE__->set_primary_key("ke_name", "ke_enctype"); + +1; diff --git a/perl/Wallet/Schema/Result/KeytabSync.pm b/perl/Wallet/Schema/Result/KeytabSync.pm new file mode 100644 index 0000000..92ab6b8 --- /dev/null +++ b/perl/Wallet/Schema/Result/KeytabSync.pm @@ -0,0 +1,42 @@ +package Wallet::Schema::Result::KeytabSync; + +use strict; +use warnings; + +use base 'DBIx::Class::Core'; + +=head1 NAME + +Wallet::Schema::Result::KeytabSync + +=head1 DESCRIPTION + +=cut + +__PACKAGE__->table("keytab_sync"); + +=head1 ACCESSORS + +=head2 ks_name + + data_type: 'varchar' + is_nullable: 0 + size: 255 + +=head2 ks_target + + data_type: 'varchar' + is_nullable: 0 + size: 255 + +=cut + +__PACKAGE__->add_columns( + "ks_name", + { data_type => "varchar", is_nullable => 0, size => 255 }, + "ks_target", + { data_type => "varchar", is_nullable => 0, size => 255 }, +); +__PACKAGE__->set_primary_key("ks_name", "ks_target"); + +1; diff --git a/perl/Wallet/Schema/Result/Object.pm b/perl/Wallet/Schema/Result/Object.pm new file mode 100644 index 0000000..17c51e2 --- /dev/null +++ b/perl/Wallet/Schema/Result/Object.pm @@ -0,0 +1,258 @@ +package Wallet::Schema::Result::Object; + +use strict; +use warnings; + +use base 'DBIx::Class::Core'; + +__PACKAGE__->load_components("InflateColumn::DateTime"); + +=head1 NAME + +Wallet::Schema::Result::Object + +=head1 DESCRIPTION + +=cut + +__PACKAGE__->table("objects"); + +=head1 ACCESSORS + +=head2 ob_type + + data_type: 'varchar' + is_nullable: 0 + size: 16 + +=head2 ob_name + + data_type: 'varchar' + is_nullable: 0 + size: 255 + +=head2 ob_owner + + data_type: 'integer' + is_nullable: 1 + +=head2 ob_acl_get + + data_type: 'integer' + is_nullable: 1 + +=head2 ob_acl_store + + data_type: 'integer' + is_nullable: 1 + +=head2 ob_acl_show + + data_type: 'integer' + is_nullable: 1 + +=head2 ob_acl_destroy + + data_type: 'integer' + is_nullable: 1 + +=head2 ob_acl_flags + + data_type: 'integer' + is_nullable: 1 + +=head2 ob_expires + + data_type: 'datetime' + datetime_undef_if_invalid: 1 + is_nullable: 1 + +=head2 ob_created_by + + data_type: 'varchar' + is_nullable: 0 + size: 255 + +=head2 ob_created_from + + data_type: 'varchar' + is_nullable: 0 + size: 255 + +=head2 ob_created_on + + data_type: 'datetime' + datetime_undef_if_invalid: 1 + is_nullable: 0 + +=head2 ob_stored_by + + data_type: 'varchar' + is_nullable: 1 + size: 255 + +=head2 ob_stored_from + + data_type: 'varchar' + is_nullable: 1 + size: 255 + +=head2 ob_stored_on + + data_type: 'datetime' + datetime_undef_if_invalid: 1 + is_nullable: 1 + +=head2 ob_downloaded_by + + data_type: 'varchar' + is_nullable: 1 + size: 255 + +=head2 ob_downloaded_from + + data_type: 'varchar' + is_nullable: 1 + size: 255 + +=head2 ob_downloaded_on + + data_type: 'datetime' + datetime_undef_if_invalid: 1 + is_nullable: 1 + +=head2 ob_comment + + data_type: 'varchar' + is_nullable: 1 + size: 255 + +=cut + +__PACKAGE__->add_columns( + "ob_type", + { data_type => "varchar", is_nullable => 0, size => 16 }, + "ob_name", + { data_type => "varchar", is_nullable => 0, size => 255 }, + "ob_owner", + { data_type => "integer", is_nullable => 1 }, + "ob_acl_get", + { data_type => "integer", is_nullable => 1 }, + "ob_acl_store", + { data_type => "integer", is_nullable => 1 }, + "ob_acl_show", + { data_type => "integer", is_nullable => 1 }, + "ob_acl_destroy", + { data_type => "integer", is_nullable => 1 }, + "ob_acl_flags", + { data_type => "integer", is_nullable => 1 }, + "ob_expires", + { + data_type => "datetime", + datetime_undef_if_invalid => 1, + is_nullable => 1, + }, + "ob_created_by", + { data_type => "varchar", is_nullable => 0, size => 255 }, + "ob_created_from", + { data_type => "varchar", is_nullable => 0, size => 255 }, + "ob_created_on", + { + data_type => "datetime", + datetime_undef_if_invalid => 1, + is_nullable => 0, + }, + "ob_stored_by", + { data_type => "varchar", is_nullable => 1, size => 255 }, + "ob_stored_from", + { data_type => "varchar", is_nullable => 1, size => 255 }, + "ob_stored_on", + { + data_type => "datetime", + datetime_undef_if_invalid => 1, + is_nullable => 1, + }, + "ob_downloaded_by", + { data_type => "varchar", is_nullable => 1, size => 255 }, + "ob_downloaded_from", + { data_type => "varchar", is_nullable => 1, size => 255 }, + "ob_downloaded_on", + { + data_type => "datetime", + datetime_undef_if_invalid => 1, + is_nullable => 1, + }, + "ob_comment", + { data_type => "varchar", is_nullable => 1, size => 255 }, +); +__PACKAGE__->set_primary_key("ob_name", "ob_type"); + +__PACKAGE__->has_one( + 'types', + 'Wallet::Schema::Result::Type', + { 'foreign.ty_name' => 'self.ob_type' }, + ); + +__PACKAGE__->has_many( + 'flags', + 'Wallet::Schema::Result::Flag', + { 'foreign.fl_type' => 'self.ob_type', + 'foreign.fl_name' => 'self.ob_name' }, + { cascade_copy => 0, cascade_delete => 0 }, + ); + +__PACKAGE__->has_many( + 'object_history', + 'Wallet::Schema::Result::ObjectHistory', + { 'foreign.oh_type' => 'self.ob_type', + 'foreign.oh_name' => 'self.ob_name' }, + { cascade_copy => 0, cascade_delete => 0 }, + ); + +__PACKAGE__->has_many( + 'keytab_enctypes', + 'Wallet::Schema::Result::KeytabEnctype', + { 'foreign.ke_name' => 'self.ob_name' }, + { cascade_copy => 0, cascade_delete => 0 }, + ); + +__PACKAGE__->has_many( + 'keytab_sync', + 'Wallet::Schema::Result::KeytabSync', + { 'foreign.ks_name' => 'self.ob_name' }, + { cascade_copy => 0, cascade_delete => 0 }, + ); + +# References for all of the various potential ACLs. +__PACKAGE__->belongs_to( + 'acls_owner', + 'Wallet::Schema::Result::Acl', + { 'foreign.ac_id' => 'self.ob_owner' }, + ); +__PACKAGE__->belongs_to( + 'acls_get', + 'Wallet::Schema::Result::Acl', + { 'foreign.ac_id' => 'self.ob_acl_get' }, + ); +__PACKAGE__->belongs_to( + 'acls_store', + 'Wallet::Schema::Result::Acl', + { 'foreign.ac_id' => 'self.ob_acl_store' }, + ); +__PACKAGE__->belongs_to( + 'acls_show', + 'Wallet::Schema::Result::Acl', + { 'foreign.ac_id' => 'self.ob_acl_show' }, + ); +__PACKAGE__->belongs_to( + 'acls_destroy', + 'Wallet::Schema::Result::Acl', + { 'foreign.ac_id' => 'self.ob_acl_destroy' }, + ); +__PACKAGE__->belongs_to( + 'acls_flags', + 'Wallet::Schema::Result::Acl', + { 'foreign.ac_id' => 'self.ob_acl_flags' }, + ); + +1; diff --git a/perl/Wallet/Schema/Result/ObjectHistory.pm b/perl/Wallet/Schema/Result/ObjectHistory.pm new file mode 100644 index 0000000..067712f --- /dev/null +++ b/perl/Wallet/Schema/Result/ObjectHistory.pm @@ -0,0 +1,127 @@ +package Wallet::Schema::Result::ObjectHistory; + +use strict; +use warnings; + +use base 'DBIx::Class::Core'; + +__PACKAGE__->load_components("InflateColumn::DateTime"); + +=head1 NAME + +Wallet::Schema::Result::ObjectHistory + +=head1 DESCRIPTION + +=cut + +__PACKAGE__->table("object_history"); + +=head1 ACCESSORS + +=head2 oh_id + + data_type: 'integer' + is_auto_increment: 1 + is_nullable: 0 + +=head2 oh_type + + data_type: 'varchar' + is_nullable: 0 + size: 16 + +=head2 oh_name + + data_type: 'varchar' + is_nullable: 0 + size: 255 + +=head2 oh_action + + data_type: 'varchar' + is_nullable: 0 + size: 16 + +=head2 oh_field + + data_type: 'varchar' + is_nullable: 1 + size: 16 + +=head2 oh_type_field + + data_type: 'varchar' + is_nullable: 1 + size: 255 + +=head2 oh_old + + data_type: 'varchar' + is_nullable: 1 + size: 255 + +=head2 oh_new + + data_type: 'varchar' + is_nullable: 1 + size: 255 + +=head2 oh_by + + data_type: 'varchar' + is_nullable: 0 + size: 255 + +=head2 oh_from + + data_type: 'varchar' + is_nullable: 0 + size: 255 + +=head2 oh_on + + data_type: 'datetime' + datetime_undef_if_invalid: 1 + is_nullable: 0 + +=cut + +__PACKAGE__->add_columns( + "oh_id", + { data_type => "integer", is_auto_increment => 1, is_nullable => 0 }, + "oh_type", + { data_type => "varchar", is_nullable => 0, size => 16 }, + "oh_name", + { data_type => "varchar", is_nullable => 0, size => 255 }, + "oh_action", + { data_type => "varchar", is_nullable => 0, size => 16 }, + "oh_field", + { data_type => "varchar", is_nullable => 1, size => 16 }, + "oh_type_field", + { data_type => "varchar", is_nullable => 1, size => 255 }, + "oh_old", + { data_type => "varchar", is_nullable => 1, size => 255 }, + "oh_new", + { data_type => "varchar", is_nullable => 1, size => 255 }, + "oh_by", + { data_type => "varchar", is_nullable => 0, size => 255 }, + "oh_from", + { data_type => "varchar", is_nullable => 0, size => 255 }, + "oh_on", + { + data_type => "datetime", + datetime_undef_if_invalid => 1, + is_nullable => 0, + }, +); +__PACKAGE__->set_primary_key("oh_id"); + +__PACKAGE__->might_have( + 'objects', + 'Wallet::Schema::Result::Object', + { 'foreign.ob_type' => 'self.oh_type', + 'foreign.ob_name' => 'self.oh_name' }, + ); + +1; diff --git a/perl/Wallet/Schema/Result/SyncTarget.pm b/perl/Wallet/Schema/Result/SyncTarget.pm new file mode 100644 index 0000000..17f4320 --- /dev/null +++ b/perl/Wallet/Schema/Result/SyncTarget.pm @@ -0,0 +1,40 @@ +package Wallet::Schema::Result::SyncTarget; + +use strict; +use warnings; + +use base 'DBIx::Class::Core'; + +=head1 NAME + +Wallet::Schema::Result::SyncTarget + +=head1 DESCRIPTION + +=cut + +__PACKAGE__->table("sync_targets"); + +=head1 ACCESSORS + +=head2 st_name + + data_type: 'varchar' + is_nullable: 0 + size: 255 + +=cut + +__PACKAGE__->add_columns( + "st_name", + { data_type => "varchar", is_nullable => 0, size => 255 }, +); +__PACKAGE__->set_primary_key("st_name"); + +#__PACKAGE__->has_many( +# 'keytab_sync', +# 'Wallet::Schema::Result::KeytabSync', +# { 'foreign.ks_target' => 'self.st_name' }, +# { cascade_copy => 0, cascade_delete => 0 }, +# ); +1; diff --git a/perl/Wallet/Schema/Result/Type.pm b/perl/Wallet/Schema/Result/Type.pm new file mode 100644 index 0000000..89fb4c3 --- /dev/null +++ b/perl/Wallet/Schema/Result/Type.pm @@ -0,0 +1,64 @@ +package Wallet::Schema::Result::Type; + +use strict; +use warnings; + +use base 'DBIx::Class::Core'; + +=head1 NAME + +Wallet::Schema::Result::Type + +=head1 DESCRIPTION + +This is a normalization table used to constrain the values in other +tables. It contains the types of wallet objects that are considered +valid, and the modules that govern each. + +By default it contains the following entries: + + insert into types (ty_name, ty_class) + values ('file', 'Wallet::Object::File'); + insert into types (ty_name, ty_class) + values ('keytab', 'Wallet::Object::Keytab'); + +If you have extended the wallet to support additional object types , +you will want to add additional rows to this table mapping those types +to Perl classes that implement the object APIs. + +=cut + +__PACKAGE__->table("types"); + +=head1 ACCESSORS + +=head2 ty_name + + data_type: 'varchar' + is_nullable: 0 + size: 16 + +=head2 ty_class + + data_type: 'varchar' + is_nullable: 1 + size: 64 + +=cut + +__PACKAGE__->add_columns( + "ty_name", + { data_type => "varchar", is_nullable => 0, size => 16 }, + "ty_class", + { data_type => "varchar", is_nullable => 1, size => 64 }, +); +__PACKAGE__->set_primary_key("ty_name"); + +#__PACKAGE__->has_many( +# 'objects', +# 'Wallet::Schema::Result::Object', +# { 'foreign.ob_type' => 'self.ty_name' }, +# { cascade_copy => 0, cascade_delete => 0 }, +# ); + +1; diff --git a/perl/Wallet/Server.pm b/perl/Wallet/Server.pm index dfb7dbb..402fbe0 100644 --- a/perl/Wallet/Server.pm +++ b/perl/Wallet/Server.pm @@ -18,13 +18,12 @@ use vars qw(%MAPPING $VERSION); use Wallet::ACL; use Wallet::Config; -use Wallet::Database; 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.10'; +$VERSION = '0.11'; ############################################################################## # Utility methods @@ -38,7 +37,7 @@ $VERSION = '0.10'; # for various things. Throw an exception if anything goes wrong. sub new { my ($class, $user, $host) = @_; - my $dbh = Wallet::Database->connect; + my $dbh = Wallet::Schema->connect; my $acl = Wallet::ACL->new ('ADMIN', $dbh); my $self = { dbh => $dbh, @@ -71,8 +70,9 @@ sub error { # Disconnect the database handle on object destruction to avoid warnings. sub DESTROY { my ($self) = @_; - if ($self->{dbh} and not $self->{dbh}->{InactiveDestroy}) { - $self->{dbh}->disconnect; + + if ($self->{dbh}) { + $self->{dbh}->storage->dbh->disconnect; } } @@ -86,13 +86,14 @@ sub type_mapping { my ($self, $type) = @_; my $class; eval { - my $sql = 'select ty_class from types where ty_name = ?'; - ($class) = $self->{dbh}->selectrow_array ($sql, undef, $type); - $self->{dbh}->commit; + my $guard = $self->{dbh}->txn_scope_guard; + my %search = (ty_name => $type); + my $type_rec = $self->{dbh}->resultset('Type')->find (\%search); + $class = $type_rec->ty_class; + $guard->commit; }; if ($@) { $self->error ($@); - $self->{dbh}->rollback; return; } if (defined $class) { diff --git a/perl/create-ddl b/perl/create-ddl new file mode 100755 index 0000000..62deb86 --- /dev/null +++ b/perl/create-ddl @@ -0,0 +1,93 @@ +#!/usr/bin/perl -w +# +# create-ddl - Create DDL files for Wallet +# +# Written by Jon Robertson +# Copyright 2012 Board of Trustees, Leland Stanford Jr. University + +############################################################################# +# Modules and declarations +############################################################################# + +use strict; +use vars qw(); + +use Getopt::Long; +use Wallet::Admin; + +############################################################################# +# Main routine +############################################################################# + +# Get errors and output in the same order. +$| = 0; + +# Clean up the path name. +my $fullpath = $0; +$0 =~ s%^.*/%%; + +# Parse command-line options. +my ($help); +my $oldversion = ''; +Getopt::Long::config ('bundling'); +GetOptions ('h|help' => \$help, + 'o|oldversion=s' => \$oldversion) or exit 1; +if ($help) { + print "Feeding myself to perldoc, please wait....\n"; + exec ('perldoc', '-t', $fullpath); +} + +# Default wallet settings, for Wallet::Admin. +$Wallet::Config::DB_DDL_DIRECTORY = 'sql/'; +$Wallet::Config::DB_DRIVER = 'SQLite'; +$Wallet::Config::DB_INFO = 'wallet-db'; + +# Create a Wallet::Admin object and run the backup. +my $admin = Wallet::Admin->new; +$admin->backup ($oldversion); + +exit(0); + +############################################################################## +# Documentation +############################################################################## + +=head1 NAME + +create-ddl - Create DDL files for Wallet + +=head1 SYNOPSIS + +create-ddl [B<--help>] [B<--oldversion>] + +=head1 DESCRIPTION + +create-ddl is used to create DDL files for the various DBIx::Class +Wallet::Schema modules. It simply is an interface for the backup command +in Wallet::Admin, which does the work via DBIx::Class. The end result +is a number of files that can be used to load the database for each +supported database server. + +These files can be modified after creation to customize the database +load, though should only be done when necessary to prevent confusion +for the schema modules not matching the actual table definitions. This +is currently only done in the case of SQLite databases, due to the +SQLite parser creating keys without AUTOINCREMENT. + +=head1 OPTIONS + +B<--help> + +Prints the perldoc information (this document) for the script. + +B<--oldversion>= + +The version number of the previous version. If there are existing DDL +files for this version, then we will also create diff files to upgrade +a database from the old version to the current. + +=head1 AUTHORS + +Jon Robertson + +=cut diff --git a/perl/sql/Wallet-Schema-0.07-0.08-MySQL.sql b/perl/sql/Wallet-Schema-0.07-0.08-MySQL.sql new file mode 100644 index 0000000..ed0bde1 --- /dev/null +++ b/perl/sql/Wallet-Schema-0.07-0.08-MySQL.sql @@ -0,0 +1,7 @@ +BEGIN; +ALTER TABLE flags MODIFY `fl_flag` enum('locked', 'unchanging') NOT NULL; +DROP TABLE IF EXISTS flag_names; +DROP TABLE IF EXISTS metadata; +ALTER TABLE objects ADD ob_comment varchar(255) default null; +COMMIT; + diff --git a/perl/sql/Wallet-Schema-0.07-0.08-SQLite.sql b/perl/sql/Wallet-Schema-0.07-0.08-SQLite.sql new file mode 100644 index 0000000..3e600b0 --- /dev/null +++ b/perl/sql/Wallet-Schema-0.07-0.08-SQLite.sql @@ -0,0 +1,6 @@ +BEGIN; +DROP TABLE IF EXISTS flag_names; +DROP TABLE IF EXISTS metadata; +ALTER TABLE objects ADD ob_comment varchar(255) default null; +COMMIT; + diff --git a/perl/sql/Wallet-Schema-0.07-MySQL.sql b/perl/sql/Wallet-Schema-0.07-MySQL.sql new file mode 100644 index 0000000..1bd38b3 --- /dev/null +++ b/perl/sql/Wallet-Schema-0.07-MySQL.sql @@ -0,0 +1,211 @@ +-- +-- Created by SQL::Translator::Producer::MySQL +-- Created on Fri Jan 25 14:12:02 2013 +-- +SET foreign_key_checks=0; + +DROP TABLE IF EXISTS `acl_history`; + +-- +-- Table: `acl_history` +-- +CREATE TABLE `acl_history` ( + `ah_id` integer NOT NULL auto_increment, + `ah_acl` integer NOT NULL, + `ah_action` varchar(16) NOT NULL, + `ah_scheme` varchar(32), + `ah_identifier` varchar(255), + `ah_by` varchar(255) NOT NULL, + `ah_from` varchar(255) NOT NULL, + `ah_on` datetime NOT NULL, + PRIMARY KEY (`ah_id`) +); + +DROP TABLE IF EXISTS `acl_schemes`; + +-- +-- Table: `acl_schemes` +-- +CREATE TABLE `acl_schemes` ( + `as_name` varchar(32) NOT NULL, + `as_class` varchar(64), + PRIMARY KEY (`as_name`) +) ENGINE=InnoDB; + +DROP TABLE IF EXISTS `acls`; + +-- +-- Table: `acls` +-- +CREATE TABLE `acls` ( + `ac_id` integer NOT NULL auto_increment, + `ac_name` varchar(255) NOT NULL, + PRIMARY KEY (`ac_id`), + UNIQUE `ac_name` (`ac_name`) +) ENGINE=InnoDB; + +DROP TABLE IF EXISTS `enctypes`; + +-- +-- Table: `enctypes` +-- +CREATE TABLE `enctypes` ( + `en_name` varchar(255) NOT NULL, + PRIMARY KEY (`en_name`) +); + +DROP TABLE IF EXISTS `flags`; + +-- +-- Table: `flags` +-- +CREATE TABLE `flag_names` ( + `fn_name` varchar(32) NOT NULL, + PRIMARY KEY (`fn_name`) +); + +DROP TABLE IF EXISTS `flags`; + +-- +-- Table: `flags` +-- +CREATE TABLE `flags` ( + `fl_type` varchar(16) NOT NULL, + `fl_name` varchar(255) NOT NULL, + `fl_flag` varchar(32) NOT NULL, + PRIMARY KEY (`fl_type`, `fl_name`, `fl_flag`) +); + +DROP TABLE IF EXISTS `keytab_enctypes`; + +-- +-- Table: `keytab_enctypes` +-- +CREATE TABLE `keytab_enctypes` ( + `ke_name` varchar(255) NOT NULL, + `ke_enctype` varchar(255) NOT NULL, + PRIMARY KEY (`ke_name`, `ke_enctype`) +); + +DROP TABLE IF EXISTS `keytab_sync`; + +-- +-- Table: `keytab_sync` +-- +CREATE TABLE `keytab_sync` ( + `ks_name` varchar(255) NOT NULL, + `ks_target` varchar(255) NOT NULL, + PRIMARY KEY (`ks_name`, `ks_target`) +); + +DROP TABLE IF EXISTS `metadata`; + +-- +-- Table: `metadata` +-- +CREATE TABLE `metadata` ( + `md_version` integer +); + +DROP TABLE IF EXISTS `sync_targets`; + +-- +-- Table: `sync_targets` +-- +CREATE TABLE `sync_targets` ( + `st_name` varchar(255) NOT NULL, + PRIMARY KEY (`st_name`) +); + +DROP TABLE IF EXISTS `types`; + +-- +-- Table: `types` +-- +CREATE TABLE `types` ( + `ty_name` varchar(16) NOT NULL, + `ty_class` varchar(64), + PRIMARY KEY (`ty_name`) +) ENGINE=InnoDB; + +DROP TABLE IF EXISTS `acl_entries`; + +-- +-- Table: `acl_entries` +-- +CREATE TABLE `acl_entries` ( + `ae_id` integer NOT NULL, + `ae_scheme` varchar(32) NOT NULL, + `ae_identifier` varchar(255) NOT NULL, + INDEX `acl_entries_idx_ae_scheme` (`ae_scheme`), + INDEX `acl_entries_idx_ae_id` (`ae_id`), + PRIMARY KEY (`ae_id`, `ae_scheme`, `ae_identifier`), + CONSTRAINT `acl_entries_fk_ae_scheme` FOREIGN KEY (`ae_scheme`) REFERENCES `acl_schemes` (`as_name`), + CONSTRAINT `acl_entries_fk_ae_id` FOREIGN KEY (`ae_id`) REFERENCES `acls` (`ac_id`) ON DELETE CASCADE ON UPDATE CASCADE +) ENGINE=InnoDB; + +DROP TABLE IF EXISTS `objects`; + +-- +-- Table: `objects` +-- +CREATE TABLE `objects` ( + `ob_type` varchar(16) NOT NULL, + `ob_name` varchar(255) NOT NULL, + `ob_owner` integer, + `ob_acl_get` integer, + `ob_acl_store` integer, + `ob_acl_show` integer, + `ob_acl_destroy` integer, + `ob_acl_flags` integer, + `ob_expires` datetime, + `ob_created_by` varchar(255) NOT NULL, + `ob_created_from` varchar(255) NOT NULL, + `ob_created_on` datetime NOT NULL, + `ob_stored_by` varchar(255), + `ob_stored_from` varchar(255), + `ob_stored_on` datetime, + `ob_downloaded_by` varchar(255), + `ob_downloaded_from` varchar(255), + `ob_downloaded_on` datetime, + INDEX `objects_idx_ob_acl_destroy` (`ob_acl_destroy`), + INDEX `objects_idx_ob_acl_flags` (`ob_acl_flags`), + INDEX `objects_idx_ob_acl_get` (`ob_acl_get`), + INDEX `objects_idx_ob_owner` (`ob_owner`), + INDEX `objects_idx_ob_acl_show` (`ob_acl_show`), + INDEX `objects_idx_ob_acl_store` (`ob_acl_store`), + INDEX `objects_idx_ob_type` (`ob_type`), + PRIMARY KEY (`ob_name`, `ob_type`), + CONSTRAINT `objects_fk_ob_acl_destroy` FOREIGN KEY (`ob_acl_destroy`) REFERENCES `acls` (`ac_id`) ON DELETE CASCADE ON UPDATE CASCADE, + CONSTRAINT `objects_fk_ob_acl_flags` FOREIGN KEY (`ob_acl_flags`) REFERENCES `acls` (`ac_id`) ON DELETE CASCADE ON UPDATE CASCADE, + CONSTRAINT `objects_fk_ob_acl_get` FOREIGN KEY (`ob_acl_get`) REFERENCES `acls` (`ac_id`) ON DELETE CASCADE ON UPDATE CASCADE, + CONSTRAINT `objects_fk_ob_owner` FOREIGN KEY (`ob_owner`) REFERENCES `acls` (`ac_id`) ON DELETE CASCADE ON UPDATE CASCADE, + CONSTRAINT `objects_fk_ob_acl_show` FOREIGN KEY (`ob_acl_show`) REFERENCES `acls` (`ac_id`) ON DELETE CASCADE ON UPDATE CASCADE, + CONSTRAINT `objects_fk_ob_acl_store` FOREIGN KEY (`ob_acl_store`) REFERENCES `acls` (`ac_id`) ON DELETE CASCADE ON UPDATE CASCADE, + CONSTRAINT `objects_fk_ob_type` FOREIGN KEY (`ob_type`) REFERENCES `types` (`ty_name`) +) ENGINE=InnoDB; + +DROP TABLE IF EXISTS `object_history`; + +-- +-- Table: `object_history` +-- +CREATE TABLE `object_history` ( + `oh_id` integer NOT NULL auto_increment, + `oh_type` varchar(16) NOT NULL, + `oh_name` varchar(255) NOT NULL, + `oh_action` varchar(16) NOT NULL, + `oh_field` varchar(16), + `oh_type_field` varchar(255), + `oh_old` varchar(255), + `oh_new` varchar(255), + `oh_by` varchar(255) NOT NULL, + `oh_from` varchar(255) NOT NULL, + `oh_on` datetime NOT NULL, + INDEX `object_history_idx_oh_type_oh_name` (`oh_type`, `oh_name`), + PRIMARY KEY (`oh_id`), + CONSTRAINT `object_history_fk_oh_type_oh_name` FOREIGN KEY (`oh_type`, `oh_name`) REFERENCES `objects` (`ob_type`, `ob_name`) +) ENGINE=InnoDB; + +SET foreign_key_checks=1; + diff --git a/perl/sql/Wallet-Schema-0.07-SQLite.sql b/perl/sql/Wallet-Schema-0.07-SQLite.sql new file mode 100644 index 0000000..e24ea15 --- /dev/null +++ b/perl/sql/Wallet-Schema-0.07-SQLite.sql @@ -0,0 +1,219 @@ +-- +-- Created by SQL::Translator::Producer::SQLite +-- Created on Fri Jan 25 14:12:02 2013 +-- + +BEGIN TRANSACTION; + +-- +-- Table: acl_history +-- +DROP TABLE IF EXISTS acl_history; + +CREATE TABLE acl_history ( + ah_id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL, + ah_acl integer NOT NULL, + ah_action varchar(16) NOT NULL, + ah_scheme varchar(32), + ah_identifier varchar(255), + ah_by varchar(255) NOT NULL, + ah_from varchar(255) NOT NULL, + ah_on datetime NOT NULL +); + +-- +-- Table: acl_schemes +-- +DROP TABLE IF EXISTS acl_schemes; + +CREATE TABLE acl_schemes ( + as_name varchar(32) NOT NULL, + as_class varchar(64), + PRIMARY KEY (as_name) +); + +-- +-- Table: acls +-- +DROP TABLE IF EXISTS acls; + +CREATE TABLE acls ( + ac_id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL, + ac_name varchar(255) NOT NULL +); + +CREATE UNIQUE INDEX ac_name ON acls (ac_name); + +-- +-- Table: enctypes +-- +DROP TABLE IF EXISTS enctypes; + +CREATE TABLE enctypes ( + en_name varchar(255) NOT NULL, + PRIMARY KEY (en_name) +); + +-- +-- Table: flags +-- +DROP TABLE IF EXISTS flag_names; + +CREATE TABLE flag_names ( + fn_name varchar(32) NOT NULL, + PRIMARY KEY (fn_name) +); + +-- +-- Table: flags +-- +DROP TABLE IF EXISTS flags; + +CREATE TABLE flags ( + fl_type varchar(16) NOT NULL, + fl_name varchar(255) NOT NULL, + fl_flag varchar(32) NOT NULL, + PRIMARY KEY (fl_type, fl_name, fl_flag) +); + +-- +-- Table: keytab_enctypes +-- +DROP TABLE IF EXISTS keytab_enctypes; + +CREATE TABLE keytab_enctypes ( + ke_name varchar(255) NOT NULL, + ke_enctype varchar(255) NOT NULL, + PRIMARY KEY (ke_name, ke_enctype) +); + +-- +-- Table: keytab_sync +-- +DROP TABLE IF EXISTS keytab_sync; + +CREATE TABLE keytab_sync ( + ks_name varchar(255) NOT NULL, + ks_target varchar(255) NOT NULL, + PRIMARY KEY (ks_name, ks_target) +); + +-- +-- Table: metadata +-- +DROP TABLE IF EXISTS metadata; + +CREATE TABLE metadata ( + md_version integer +); + +-- +-- Table: sync_targets +-- +DROP TABLE IF EXISTS sync_targets; + +CREATE TABLE sync_targets ( + st_name varchar(255) NOT NULL, + PRIMARY KEY (st_name) +); + +-- +-- Table: types +-- +DROP TABLE IF EXISTS types; + +CREATE TABLE types ( + ty_name varchar(16) NOT NULL, + ty_class varchar(64), + PRIMARY KEY (ty_name) +); + +-- +-- Table: acl_entries +-- +DROP TABLE IF EXISTS acl_entries; + +CREATE TABLE acl_entries ( + ae_id integer NOT NULL, + ae_scheme varchar(32) NOT NULL, + ae_identifier varchar(255) NOT NULL, + PRIMARY KEY (ae_id, ae_scheme, ae_identifier), + FOREIGN KEY(ae_scheme) REFERENCES acl_schemes(as_name), + FOREIGN KEY(ae_id) REFERENCES acls(ac_id) +); + +CREATE INDEX acl_entries_idx_ae_scheme ON acl_entries (ae_scheme); + +CREATE INDEX acl_entries_idx_ae_id ON acl_entries (ae_id); + +-- +-- Table: objects +-- +DROP TABLE IF EXISTS objects; + +CREATE TABLE objects ( + ob_type varchar(16) NOT NULL, + ob_name varchar(255) NOT NULL, + ob_owner integer, + ob_acl_get integer, + ob_acl_store integer, + ob_acl_show integer, + ob_acl_destroy integer, + ob_acl_flags integer, + ob_expires datetime, + ob_created_by varchar(255) NOT NULL, + ob_created_from varchar(255) NOT NULL, + ob_created_on datetime NOT NULL, + ob_stored_by varchar(255), + ob_stored_from varchar(255), + ob_stored_on datetime, + ob_downloaded_by varchar(255), + ob_downloaded_from varchar(255), + ob_downloaded_on datetime, + PRIMARY KEY (ob_name, ob_type), + FOREIGN KEY(ob_acl_destroy) REFERENCES acls(ac_id), + FOREIGN KEY(ob_acl_flags) REFERENCES acls(ac_id), + FOREIGN KEY(ob_acl_get) REFERENCES acls(ac_id), + FOREIGN KEY(ob_owner) REFERENCES acls(ac_id), + FOREIGN KEY(ob_acl_show) REFERENCES acls(ac_id), + FOREIGN KEY(ob_acl_store) REFERENCES acls(ac_id), + FOREIGN KEY(ob_type) REFERENCES types(ty_name) +); + +CREATE INDEX objects_idx_ob_acl_destroy ON objects (ob_acl_destroy); + +CREATE INDEX objects_idx_ob_acl_flags ON objects (ob_acl_flags); + +CREATE INDEX objects_idx_ob_acl_get ON objects (ob_acl_get); + +CREATE INDEX objects_idx_ob_owner ON objects (ob_owner); + +CREATE INDEX objects_idx_ob_acl_show ON objects (ob_acl_show); + +CREATE INDEX objects_idx_ob_acl_store ON objects (ob_acl_store); + +CREATE INDEX objects_idx_ob_type ON objects (ob_type); + +-- +-- Table: object_history +-- +DROP TABLE IF EXISTS object_history; + +CREATE TABLE object_history ( + oh_id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL, + oh_type varchar(16) NOT NULL, + oh_name varchar(255) NOT NULL, + oh_action varchar(16) NOT NULL, + oh_field varchar(16), + oh_type_field varchar(255), + oh_old varchar(255), + oh_new varchar(255), + oh_by varchar(255) NOT NULL, + oh_from varchar(255) NOT NULL, + oh_on datetime NOT NULL, + FOREIGN KEY(oh_type) REFERENCES objects(ob_type) +); + +CREATE INDEX object_history_idx_oh_type_oh_name ON object_history (oh_type, oh_name); + +COMMIT; diff --git a/perl/sql/Wallet-Schema-0.08-MySQL.sql b/perl/sql/Wallet-Schema-0.08-MySQL.sql new file mode 100644 index 0000000..44b6475 --- /dev/null +++ b/perl/sql/Wallet-Schema-0.08-MySQL.sql @@ -0,0 +1,193 @@ +-- +-- Created by SQL::Translator::Producer::MySQL +-- Created on Fri Jan 25 14:12:02 2013 +-- +SET foreign_key_checks=0; + +DROP TABLE IF EXISTS `acl_history`; + +-- +-- Table: `acl_history` +-- +CREATE TABLE `acl_history` ( + `ah_id` integer NOT NULL auto_increment, + `ah_acl` integer NOT NULL, + `ah_action` varchar(16) NOT NULL, + `ah_scheme` varchar(32), + `ah_identifier` varchar(255), + `ah_by` varchar(255) NOT NULL, + `ah_from` varchar(255) NOT NULL, + `ah_on` datetime NOT NULL, + PRIMARY KEY (`ah_id`) +); + +DROP TABLE IF EXISTS `acl_schemes`; + +-- +-- Table: `acl_schemes` +-- +CREATE TABLE `acl_schemes` ( + `as_name` varchar(32) NOT NULL, + `as_class` varchar(64), + PRIMARY KEY (`as_name`) +) ENGINE=InnoDB; + +DROP TABLE IF EXISTS `acls`; + +-- +-- Table: `acls` +-- +CREATE TABLE `acls` ( + `ac_id` integer NOT NULL auto_increment, + `ac_name` varchar(255) NOT NULL, + PRIMARY KEY (`ac_id`), + UNIQUE `ac_name` (`ac_name`) +) ENGINE=InnoDB; + +DROP TABLE IF EXISTS `enctypes`; + +-- +-- Table: `enctypes` +-- +CREATE TABLE `enctypes` ( + `en_name` varchar(255) NOT NULL, + PRIMARY KEY (`en_name`) +); + +DROP TABLE IF EXISTS `flags`; + +-- +-- Table: `flags` +-- +CREATE TABLE `flags` ( + `fl_type` varchar(16) NOT NULL, + `fl_name` varchar(255) NOT NULL, + `fl_flag` enum('locked', 'unchanging') NOT NULL, + PRIMARY KEY (`fl_type`, `fl_name`, `fl_flag`) +); + +DROP TABLE IF EXISTS `keytab_enctypes`; + +-- +-- Table: `keytab_enctypes` +-- +CREATE TABLE `keytab_enctypes` ( + `ke_name` varchar(255) NOT NULL, + `ke_enctype` varchar(255) NOT NULL, + PRIMARY KEY (`ke_name`, `ke_enctype`) +); + +DROP TABLE IF EXISTS `keytab_sync`; + +-- +-- Table: `keytab_sync` +-- +CREATE TABLE `keytab_sync` ( + `ks_name` varchar(255) NOT NULL, + `ks_target` varchar(255) NOT NULL, + PRIMARY KEY (`ks_name`, `ks_target`) +); + +DROP TABLE IF EXISTS `sync_targets`; + +-- +-- Table: `sync_targets` +-- +CREATE TABLE `sync_targets` ( + `st_name` varchar(255) NOT NULL, + PRIMARY KEY (`st_name`) +); + +DROP TABLE IF EXISTS `types`; + +-- +-- Table: `types` +-- +CREATE TABLE `types` ( + `ty_name` varchar(16) NOT NULL, + `ty_class` varchar(64), + PRIMARY KEY (`ty_name`) +) ENGINE=InnoDB; + +DROP TABLE IF EXISTS `acl_entries`; + +-- +-- Table: `acl_entries` +-- +CREATE TABLE `acl_entries` ( + `ae_id` integer NOT NULL, + `ae_scheme` varchar(32) NOT NULL, + `ae_identifier` varchar(255) NOT NULL, + INDEX `acl_entries_idx_ae_scheme` (`ae_scheme`), + INDEX `acl_entries_idx_ae_id` (`ae_id`), + PRIMARY KEY (`ae_id`, `ae_scheme`, `ae_identifier`), + CONSTRAINT `acl_entries_fk_ae_scheme` FOREIGN KEY (`ae_scheme`) REFERENCES `acl_schemes` (`as_name`), + CONSTRAINT `acl_entries_fk_ae_id` FOREIGN KEY (`ae_id`) REFERENCES `acls` (`ac_id`) ON DELETE CASCADE ON UPDATE CASCADE +) ENGINE=InnoDB; + +DROP TABLE IF EXISTS `objects`; + +-- +-- Table: `objects` +-- +CREATE TABLE `objects` ( + `ob_type` varchar(16) NOT NULL, + `ob_name` varchar(255) NOT NULL, + `ob_owner` integer, + `ob_acl_get` integer, + `ob_acl_store` integer, + `ob_acl_show` integer, + `ob_acl_destroy` integer, + `ob_acl_flags` integer, + `ob_expires` datetime, + `ob_created_by` varchar(255) NOT NULL, + `ob_created_from` varchar(255) NOT NULL, + `ob_created_on` datetime NOT NULL, + `ob_stored_by` varchar(255), + `ob_stored_from` varchar(255), + `ob_stored_on` datetime, + `ob_downloaded_by` varchar(255), + `ob_downloaded_from` varchar(255), + `ob_downloaded_on` datetime, + `ob_comment` varchar(255), + INDEX `objects_idx_ob_acl_destroy` (`ob_acl_destroy`), + INDEX `objects_idx_ob_acl_flags` (`ob_acl_flags`), + INDEX `objects_idx_ob_acl_get` (`ob_acl_get`), + INDEX `objects_idx_ob_owner` (`ob_owner`), + INDEX `objects_idx_ob_acl_show` (`ob_acl_show`), + INDEX `objects_idx_ob_acl_store` (`ob_acl_store`), + INDEX `objects_idx_ob_type` (`ob_type`), + PRIMARY KEY (`ob_name`, `ob_type`), + CONSTRAINT `objects_fk_ob_acl_destroy` FOREIGN KEY (`ob_acl_destroy`) REFERENCES `acls` (`ac_id`) ON DELETE CASCADE ON UPDATE CASCADE, + CONSTRAINT `objects_fk_ob_acl_flags` FOREIGN KEY (`ob_acl_flags`) REFERENCES `acls` (`ac_id`) ON DELETE CASCADE ON UPDATE CASCADE, + CONSTRAINT `objects_fk_ob_acl_get` FOREIGN KEY (`ob_acl_get`) REFERENCES `acls` (`ac_id`) ON DELETE CASCADE ON UPDATE CASCADE, + CONSTRAINT `objects_fk_ob_owner` FOREIGN KEY (`ob_owner`) REFERENCES `acls` (`ac_id`) ON DELETE CASCADE ON UPDATE CASCADE, + CONSTRAINT `objects_fk_ob_acl_show` FOREIGN KEY (`ob_acl_show`) REFERENCES `acls` (`ac_id`) ON DELETE CASCADE ON UPDATE CASCADE, + CONSTRAINT `objects_fk_ob_acl_store` FOREIGN KEY (`ob_acl_store`) REFERENCES `acls` (`ac_id`) ON DELETE CASCADE ON UPDATE CASCADE, + CONSTRAINT `objects_fk_ob_type` FOREIGN KEY (`ob_type`) REFERENCES `types` (`ty_name`) +) ENGINE=InnoDB; + +DROP TABLE IF EXISTS `object_history`; + +-- +-- Table: `object_history` +-- +CREATE TABLE `object_history` ( + `oh_id` integer NOT NULL auto_increment, + `oh_type` varchar(16) NOT NULL, + `oh_name` varchar(255) NOT NULL, + `oh_action` varchar(16) NOT NULL, + `oh_field` varchar(16), + `oh_type_field` varchar(255), + `oh_old` varchar(255), + `oh_new` varchar(255), + `oh_by` varchar(255) NOT NULL, + `oh_from` varchar(255) NOT NULL, + `oh_on` datetime NOT NULL, + INDEX `object_history_idx_oh_type_oh_name` (`oh_type`, `oh_name`), + PRIMARY KEY (`oh_id`), + CONSTRAINT `object_history_fk_oh_type_oh_name` FOREIGN KEY (`oh_type`, `oh_name`) REFERENCES `objects` (`ob_type`, `ob_name`) +) ENGINE=InnoDB; + +SET foreign_key_checks=1; + diff --git a/perl/sql/Wallet-Schema-0.08-PostgreSQL.sql b/perl/sql/Wallet-Schema-0.08-PostgreSQL.sql new file mode 100644 index 0000000..2f79147 --- /dev/null +++ b/perl/sql/Wallet-Schema-0.08-PostgreSQL.sql @@ -0,0 +1,201 @@ +-- +-- Created by SQL::Translator::Producer::PostgreSQL +-- Created on Fri Jan 25 14:12:02 2013 +-- +-- +-- Table: acl_history +-- +DROP TABLE "acl_history" CASCADE; +CREATE TABLE "acl_history" ( + "ah_id" serial NOT NULL, + "ah_acl" integer NOT NULL, + "ah_action" character varying(16) NOT NULL, + "ah_scheme" character varying(32), + "ah_identifier" character varying(255), + "ah_by" character varying(255) NOT NULL, + "ah_from" character varying(255) NOT NULL, + "ah_on" timestamp NOT NULL, + PRIMARY KEY ("ah_id") +); + +-- +-- Table: acl_schemes +-- +DROP TABLE "acl_schemes" CASCADE; +CREATE TABLE "acl_schemes" ( + "as_name" character varying(32) NOT NULL, + "as_class" character varying(64), + PRIMARY KEY ("as_name") +); + +-- +-- Table: acls +-- +DROP TABLE "acls" CASCADE; +CREATE TABLE "acls" ( + "ac_id" serial NOT NULL, + "ac_name" character varying(255) NOT NULL, + PRIMARY KEY ("ac_id"), + CONSTRAINT "ac_name" UNIQUE ("ac_name") +); + +-- +-- Table: enctypes +-- +DROP TABLE "enctypes" CASCADE; +CREATE TABLE "enctypes" ( + "en_name" character varying(255) NOT NULL, + PRIMARY KEY ("en_name") +); + +-- +-- Table: flags +-- +DROP TABLE "flags" CASCADE; +CREATE TABLE "flags" ( + "fl_type" character varying(16) NOT NULL, + "fl_name" character varying(255) NOT NULL, + "fl_flag" character varying NOT NULL, + PRIMARY KEY ("fl_type", "fl_name", "fl_flag") +); + +-- +-- Table: keytab_enctypes +-- +DROP TABLE "keytab_enctypes" CASCADE; +CREATE TABLE "keytab_enctypes" ( + "ke_name" character varying(255) NOT NULL, + "ke_enctype" character varying(255) NOT NULL, + PRIMARY KEY ("ke_name", "ke_enctype") +); + +-- +-- Table: keytab_sync +-- +DROP TABLE "keytab_sync" CASCADE; +CREATE TABLE "keytab_sync" ( + "ks_name" character varying(255) NOT NULL, + "ks_target" character varying(255) NOT NULL, + PRIMARY KEY ("ks_name", "ks_target") +); + +-- +-- Table: sync_targets +-- +DROP TABLE "sync_targets" CASCADE; +CREATE TABLE "sync_targets" ( + "st_name" character varying(255) NOT NULL, + PRIMARY KEY ("st_name") +); + +-- +-- Table: types +-- +DROP TABLE "types" CASCADE; +CREATE TABLE "types" ( + "ty_name" character varying(16) NOT NULL, + "ty_class" character varying(64), + PRIMARY KEY ("ty_name") +); + +-- +-- Table: acl_entries +-- +DROP TABLE "acl_entries" CASCADE; +CREATE TABLE "acl_entries" ( + "ae_id" integer NOT NULL, + "ae_scheme" character varying(32) NOT NULL, + "ae_identifier" character varying(255) NOT NULL, + PRIMARY KEY ("ae_id", "ae_scheme", "ae_identifier") +); +CREATE INDEX "acl_entries_idx_ae_scheme" on "acl_entries" ("ae_scheme"); +CREATE INDEX "acl_entries_idx_ae_id" on "acl_entries" ("ae_id"); + +-- +-- Table: objects +-- +DROP TABLE "objects" CASCADE; +CREATE TABLE "objects" ( + "ob_type" character varying(16) NOT NULL, + "ob_name" character varying(255) NOT NULL, + "ob_owner" integer, + "ob_acl_get" integer, + "ob_acl_store" integer, + "ob_acl_show" integer, + "ob_acl_destroy" integer, + "ob_acl_flags" integer, + "ob_expires" timestamp, + "ob_created_by" character varying(255) NOT NULL, + "ob_created_from" character varying(255) NOT NULL, + "ob_created_on" timestamp NOT NULL, + "ob_stored_by" character varying(255), + "ob_stored_from" character varying(255), + "ob_stored_on" timestamp, + "ob_downloaded_by" character varying(255), + "ob_downloaded_from" character varying(255), + "ob_downloaded_on" timestamp, + "ob_comment" character varying(255), + PRIMARY KEY ("ob_name", "ob_type") +); +CREATE INDEX "objects_idx_ob_acl_destroy" on "objects" ("ob_acl_destroy"); +CREATE INDEX "objects_idx_ob_acl_flags" on "objects" ("ob_acl_flags"); +CREATE INDEX "objects_idx_ob_acl_get" on "objects" ("ob_acl_get"); +CREATE INDEX "objects_idx_ob_owner" on "objects" ("ob_owner"); +CREATE INDEX "objects_idx_ob_acl_show" on "objects" ("ob_acl_show"); +CREATE INDEX "objects_idx_ob_acl_store" on "objects" ("ob_acl_store"); +CREATE INDEX "objects_idx_ob_type" on "objects" ("ob_type"); + +-- +-- Table: object_history +-- +DROP TABLE "object_history" CASCADE; +CREATE TABLE "object_history" ( + "oh_id" serial NOT NULL, + "oh_type" character varying(16) NOT NULL, + "oh_name" character varying(255) NOT NULL, + "oh_action" character varying(16) NOT NULL, + "oh_field" character varying(16), + "oh_type_field" character varying(255), + "oh_old" character varying(255), + "oh_new" character varying(255), + "oh_by" character varying(255) NOT NULL, + "oh_from" character varying(255) NOT NULL, + "oh_on" timestamp NOT NULL, + PRIMARY KEY ("oh_id") +); +CREATE INDEX "object_history_idx_oh_type_oh_name" on "object_history" ("oh_type", "oh_name"); + +-- +-- Foreign Key Definitions +-- + +ALTER TABLE "acl_entries" ADD FOREIGN KEY ("ae_scheme") + REFERENCES "acl_schemes" ("as_name") DEFERRABLE; + +ALTER TABLE "acl_entries" ADD FOREIGN KEY ("ae_id") + REFERENCES "acls" ("ac_id") ON DELETE CASCADE ON UPDATE CASCADE DEFERRABLE; + +ALTER TABLE "objects" ADD FOREIGN KEY ("ob_acl_destroy") + REFERENCES "acls" ("ac_id") ON DELETE CASCADE ON UPDATE CASCADE DEFERRABLE; + +ALTER TABLE "objects" ADD FOREIGN KEY ("ob_acl_flags") + REFERENCES "acls" ("ac_id") ON DELETE CASCADE ON UPDATE CASCADE DEFERRABLE; + +ALTER TABLE "objects" ADD FOREIGN KEY ("ob_acl_get") + REFERENCES "acls" ("ac_id") ON DELETE CASCADE ON UPDATE CASCADE DEFERRABLE; + +ALTER TABLE "objects" ADD FOREIGN KEY ("ob_owner") + REFERENCES "acls" ("ac_id") ON DELETE CASCADE ON UPDATE CASCADE DEFERRABLE; + +ALTER TABLE "objects" ADD FOREIGN KEY ("ob_acl_show") + REFERENCES "acls" ("ac_id") ON DELETE CASCADE ON UPDATE CASCADE DEFERRABLE; + +ALTER TABLE "objects" ADD FOREIGN KEY ("ob_acl_store") + REFERENCES "acls" ("ac_id") ON DELETE CASCADE ON UPDATE CASCADE DEFERRABLE; + +ALTER TABLE "objects" ADD FOREIGN KEY ("ob_type") + REFERENCES "types" ("ty_name") DEFERRABLE; + +ALTER TABLE "object_history" ADD FOREIGN KEY ("oh_type", "oh_name") + REFERENCES "objects" ("ob_type", "ob_name") DEFERRABLE; + diff --git a/perl/sql/Wallet-Schema-0.08-SQLite.sql b/perl/sql/Wallet-Schema-0.08-SQLite.sql new file mode 100644 index 0000000..9936c20 --- /dev/null +++ b/perl/sql/Wallet-Schema-0.08-SQLite.sql @@ -0,0 +1,201 @@ +-- +-- Created by SQL::Translator::Producer::SQLite +-- Created on Fri Jan 25 14:12:02 2013 +-- + +BEGIN TRANSACTION; + +-- +-- Table: acl_history +-- +DROP TABLE IF EXISTS acl_history; + +CREATE TABLE acl_history ( + ah_id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL, + ah_acl integer NOT NULL, + ah_action varchar(16) NOT NULL, + ah_scheme varchar(32), + ah_identifier varchar(255), + ah_by varchar(255) NOT NULL, + ah_from varchar(255) NOT NULL, + ah_on datetime NOT NULL +); + +-- +-- Table: acl_schemes +-- +DROP TABLE IF EXISTS acl_schemes; + +CREATE TABLE acl_schemes ( + as_name varchar(32) NOT NULL, + as_class varchar(64), + PRIMARY KEY (as_name) +); + +-- +-- Table: acls +-- +DROP TABLE IF EXISTS acls; + +CREATE TABLE acls ( + ac_id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL, + ac_name varchar(255) NOT NULL +); + +CREATE UNIQUE INDEX ac_name ON acls (ac_name); + +-- +-- Table: enctypes +-- +DROP TABLE IF EXISTS enctypes; + +CREATE TABLE enctypes ( + en_name varchar(255) NOT NULL, + PRIMARY KEY (en_name) +); + +-- +-- Table: flags +-- +DROP TABLE IF EXISTS flags; + +CREATE TABLE flags ( + fl_type varchar(16) NOT NULL, + fl_name varchar(255) NOT NULL, + fl_flag varchar(32) NOT NULL, + PRIMARY KEY (fl_type, fl_name, fl_flag) +); + +-- +-- Table: keytab_enctypes +-- +DROP TABLE IF EXISTS keytab_enctypes; + +CREATE TABLE keytab_enctypes ( + ke_name varchar(255) NOT NULL, + ke_enctype varchar(255) NOT NULL, + PRIMARY KEY (ke_name, ke_enctype) +); + +-- +-- Table: keytab_sync +-- +DROP TABLE IF EXISTS keytab_sync; + +CREATE TABLE keytab_sync ( + ks_name varchar(255) NOT NULL, + ks_target varchar(255) NOT NULL, + PRIMARY KEY (ks_name, ks_target) +); + +-- +-- Table: sync_targets +-- +DROP TABLE IF EXISTS sync_targets; + +CREATE TABLE sync_targets ( + st_name varchar(255) NOT NULL, + PRIMARY KEY (st_name) +); + +-- +-- Table: types +-- +DROP TABLE IF EXISTS types; + +CREATE TABLE types ( + ty_name varchar(16) NOT NULL, + ty_class varchar(64), + PRIMARY KEY (ty_name) +); + +-- +-- Table: acl_entries +-- +DROP TABLE IF EXISTS acl_entries; + +CREATE TABLE acl_entries ( + ae_id integer NOT NULL, + ae_scheme varchar(32) NOT NULL, + ae_identifier varchar(255) NOT NULL, + PRIMARY KEY (ae_id, ae_scheme, ae_identifier), + FOREIGN KEY(ae_scheme) REFERENCES acl_schemes(as_name), + FOREIGN KEY(ae_id) REFERENCES acls(ac_id) +); + +CREATE INDEX acl_entries_idx_ae_scheme ON acl_entries (ae_scheme); + +CREATE INDEX acl_entries_idx_ae_id ON acl_entries (ae_id); + +-- +-- Table: objects +-- +DROP TABLE IF EXISTS objects; + +CREATE TABLE objects ( + ob_type varchar(16) NOT NULL, + ob_name varchar(255) NOT NULL, + ob_owner integer, + ob_acl_get integer, + ob_acl_store integer, + ob_acl_show integer, + ob_acl_destroy integer, + ob_acl_flags integer, + ob_expires datetime, + ob_created_by varchar(255) NOT NULL, + ob_created_from varchar(255) NOT NULL, + ob_created_on datetime NOT NULL, + ob_stored_by varchar(255), + ob_stored_from varchar(255), + ob_stored_on datetime, + ob_downloaded_by varchar(255), + ob_downloaded_from varchar(255), + ob_downloaded_on datetime, + ob_comment varchar(255), + PRIMARY KEY (ob_name, ob_type), + FOREIGN KEY(ob_acl_destroy) REFERENCES acls(ac_id), + FOREIGN KEY(ob_acl_flags) REFERENCES acls(ac_id), + FOREIGN KEY(ob_acl_get) REFERENCES acls(ac_id), + FOREIGN KEY(ob_owner) REFERENCES acls(ac_id), + FOREIGN KEY(ob_acl_show) REFERENCES acls(ac_id), + FOREIGN KEY(ob_acl_store) REFERENCES acls(ac_id), + FOREIGN KEY(ob_type) REFERENCES types(ty_name) +); + +CREATE INDEX objects_idx_ob_acl_destroy ON objects (ob_acl_destroy); + +CREATE INDEX objects_idx_ob_acl_flags ON objects (ob_acl_flags); + +CREATE INDEX objects_idx_ob_acl_get ON objects (ob_acl_get); + +CREATE INDEX objects_idx_ob_owner ON objects (ob_owner); + +CREATE INDEX objects_idx_ob_acl_show ON objects (ob_acl_show); + +CREATE INDEX objects_idx_ob_acl_store ON objects (ob_acl_store); + +CREATE INDEX objects_idx_ob_type ON objects (ob_type); + +-- +-- Table: object_history +-- +DROP TABLE IF EXISTS object_history; + +CREATE TABLE object_history ( + oh_id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL, + oh_type varchar(16) NOT NULL, + oh_name varchar(255) NOT NULL, + oh_action varchar(16) NOT NULL, + oh_field varchar(16), + oh_type_field varchar(255), + oh_old varchar(255), + oh_new varchar(255), + oh_by varchar(255) NOT NULL, + oh_from varchar(255) NOT NULL, + oh_on datetime NOT NULL, + FOREIGN KEY(oh_type) REFERENCES objects(ob_type) +); + +CREATE INDEX object_history_idx_oh_type_oh_name ON object_history (oh_type, oh_name); + +COMMIT; diff --git a/perl/t/admin.t b/perl/t/admin.t index 6250f8e..cf6a637 100755 --- a/perl/t/admin.t +++ b/perl/t/admin.t @@ -8,12 +8,13 @@ # # See LICENSE for licensing terms. -use Test::More tests => 18; +use Test::More tests => 23; use Wallet::Admin; use Wallet::Report; use Wallet::Schema; use Wallet::Server; +use DBI; use lib 't/lib'; use Util; @@ -56,6 +57,24 @@ is ($admin->register_verifier ('base', 'Wallet::ACL::Base'), undef, is ($server->acl_add ('ADMIN', 'base', 'foo'), 1, ' and adding a base ACL now works'); +# Test an upgrade. Reinitialize to an older version, then test upgrade to +# the current version. +$Wallet::Schema::VERSION = '0.07'; +is ($admin->reinitialize ('admin@EXAMPLE.COM'), 1, + ' and re-initialization succeeds'); +$Wallet::Schema::VERSION = '0.08'; +my $schema = $admin->dbh; +$schema->upgrade_directory ('sql/'); +my $retval = $admin->upgrade; +is ($retval, 1, 'Performing an upgrade succeeds'); +my $dbh = $schema->storage->dbh; +my $sql = "select version from dbix_class_schema_versions order by version " + ."DESC"; +$version = $dbh->selectall_arrayref ($sql); +is (@$version, 2, ' and versions table has correct number of rows'); +is (@{ $version->[0] }, 1, ' and correct number of columns'); +is ($version->[0][0], '0.08', ' and the schema version is correct'); + # Clean up. is ($admin->destroy, 1, 'Destruction succeeds'); unlink 'wallet-db'; diff --git a/perl/t/lib/Util.pm b/perl/t/lib/Util.pm index 8bbefc4..c15ccfe 100644 --- a/perl/t/lib/Util.pm +++ b/perl/t/lib/Util.pm @@ -45,6 +45,7 @@ sub contents { # for testing by default, but support t/data/test.database as a configuration # file to use another database backend. sub db_setup { + $Wallet::Config::DB_DDL_DIRECTORY = 'sql/'; if (-f 't/data/test.database') { open (DB, '<', 't/data/test.database') or die "cannot open t/data/test.database: $!"; @@ -60,6 +61,10 @@ sub db_setup { $Wallet::Config::DB_USER = $user if $user; $Wallet::Config::DB_PASSWORD = $password if $password; } else { + + # If we have a new SQLite db by default, disable version checking. + $ENV{DBIC_NO_VERSION_CHECK} = 1; + $Wallet::Config::DB_DRIVER = 'SQLite'; $Wallet::Config::DB_INFO = 'wallet-db'; unlink 'wallet-db'; diff --git a/perl/t/report.t b/perl/t/report.t index 363db20..13ef7b6 100755 --- a/perl/t/report.t +++ b/perl/t/report.t @@ -145,7 +145,7 @@ is (scalar (@lines), 1, 'Searching for objects owned by ADMIN finds one'); is ($lines[0][0], 'base', ' and it has the right type'); is ($lines[0][1], 'service/admin', ' and the right name'); @lines = $report->objects ('owner', 'null'); -is (scalar (@lines), 1, 'Searching for objects with no set ownerfinds one'); +is (scalar (@lines), 1, 'Searching for objects with no set owner finds one'); is ($lines[0][0], 'base', ' and it has the right type'); is ($lines[0][1], 'service/null', ' and the right name'); @lines = $report->objects ('acl', 'ADMIN'); diff --git a/perl/t/schema.t b/perl/t/schema.t deleted file mode 100755 index 5dd90d1..0000000 --- a/perl/t/schema.t +++ /dev/null @@ -1,111 +0,0 @@ -#!/usr/bin/perl -w -# -# Tests for the wallet schema class. -# -# Written by Russ Allbery -# Copyright 2007, 2008, 2011 -# The Board of Trustees of the Leland Stanford Junior University -# -# See LICENSE for licensing terms. - -use Test::More tests => 16; - -use DBI (); -use POSIX qw(strftime); -use Wallet::Config (); -use Wallet::Schema (); - -use lib 't/lib'; -use Util; - -my $schema = Wallet::Schema->new; -ok (defined $schema, 'Wallet::Schema creation'); -ok ($schema->isa ('Wallet::Schema'), ' and class verification'); -my @sql = $schema->sql; -ok (@sql > 0, 'sql() returns something'); -is (scalar (@sql), 32, ' and returns the right number of statements'); - -# Connect to a database and test create. -db_setup; -my $connect = "DBI:${Wallet::Config::DB_DRIVER}:${Wallet::Config::DB_INFO}"; -my $user = $Wallet::Config::DB_USER; -my $password = $Wallet::Config::DB_PASSWORD; -$dbh = DBI->connect ($connect, $user, $password); -if (not defined $dbh) { - die "cannot connect to database $connect: $DBI::errstr\n"; -} -$dbh->{RaiseError} = 1; -$dbh->{PrintError} = 0; -eval { $schema->create ($dbh) }; -is ($@, '', "create() doesn't die"); - -# Check that the version number is correct. -my $sql = "select md_version from metadata"; -my $version = $dbh->selectall_arrayref ($sql); -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. 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) }; -is ($@, '', "drop() doesn't die"); - -# Make sure all the tables are gone. -SKIP: { - if (lc ($Wallet::Config::DB_DRIVER) eq 'sqlite') { - my $sql = "select name from sqlite_master where type = 'table'"; - my $sth = $dbh->prepare ($sql); - $sth->execute; - my ($table, @tables); - while (defined ($table = $sth->fetchrow_array)) { - push (@tables, $table) unless $table =~ /^sqlite_/; - } - is ("@tables", '', ' and there are no tables in the database'); - } elsif (lc ($Wallet::Config::DB_DRIVER) eq 'mysql') { - my $sql = "show tables"; - my $sth = $dbh->prepare ($sql); - $sth->execute; - my ($table, @tables); - while (defined ($table = $sth->fetchrow_array)) { - push (@tables, $table); - } - is ("@tables", '', ' and there are no tables in the database'); - } else { - skip 1; - } -} -eval { $schema->create ($dbh) }; -is ($@, '', ' and we can run create again'); - -# Clean up. -eval { $schema->drop ($dbh) }; -unlink 'wallet-db'; diff --git a/perl/t/server.t b/perl/t/server.t index 8e0a30d..63f2e76 100755 --- a/perl/t/server.t +++ b/perl/t/server.t @@ -1030,5 +1030,5 @@ is ($@, "database connection information not configured\n", ' or if DB_INFO is not set'); $Wallet::Config::DB_INFO = 't'; $server = eval { Wallet::Server->new ($user2, $host) }; -like ($@, qr/^cannot connect to database: /, +like ($@, qr/unable to open database file/, ' or if the database connection fails'); diff --git a/server/wallet-admin b/server/wallet-admin index 94d62c7..7e5a402 100755 --- a/server/wallet-admin +++ b/server/wallet-admin @@ -15,6 +15,13 @@ use strict; use Wallet::Admin; +# The last non-DBIx::Class version. If a database has no DBIx::Class +# versioning, we want to set it to this so that upgrades can begin. +our $BASE_VERSION = '0.07'; + +# Directory that contains the wallet SQL files for upgrades. +our $SQL_DIR = '/usr/share/wallet/sql/'; + ############################################################################## # Implementation ############################################################################## @@ -41,6 +48,9 @@ sub command { die "too few arguments to initialize\n" if @args < 1; die "invalid admin principal $args[0]\n" unless $args[0] =~ /^[^\@\s]+\@\S+$/; + + my $schema = $admin->{dbh}; + $schema->upgrade_directory ($SQL_DIR); $admin->initialize (@args) or die $admin->error, "\n"; } elsif ($command eq 'register') { die "too many arguments to register\n" if @args > 3; @@ -59,7 +69,20 @@ sub command { } } elsif ($command eq 'upgrade') { die "too many arguments to upgrade\n" if @args; + + my $schema = $admin->{dbh}; + $schema->upgrade_directory ($SQL_DIR); + + # Check to see if the database is versioned. If not, install the + # versioning table and default version. + if (!$schema->get_db_version) { + print "Versioning database.\n"; + $schema->install ($BASE_VERSION); + } + + # Actually upgrade. $admin->upgrade or die $admin->error, "\n"; + } else { die "unknown command $command\n"; } -- cgit v1.2.3 From 9cf3e7900f8aab3ec91067c950eb100389ce04b2 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Wed, 30 Jan 2013 18:51:08 -0800 Subject: Configure $DB_DDL_DIRECTORY in client/full test We attempt to create a new SQLite database, which requires the schema directory be configured. Add that directory to the test wallet configuration. Change-Id: Id17fd10056760fe8efd5ef89cea134bca17e1abb Reviewed-on: https://gerrit.stanford.edu/728 Reviewed-by: Russ Allbery Tested-by: Russ Allbery --- tests/data/wallet.conf | 3 +++ 1 file changed, 3 insertions(+) diff --git a/tests/data/wallet.conf b/tests/data/wallet.conf index 877a16f..19c3aeb 100644 --- a/tests/data/wallet.conf +++ b/tests/data/wallet.conf @@ -4,6 +4,9 @@ $DB_DRIVER = 'SQLite'; $DB_INFO = 'wallet-db'; +# Point to the schema directory in the distribution. +$DB_DDL_DIRECTORY = "$ENV{SOURCE}/sql"; + # Set up a file bucket. $FILE_BUCKET = 'test-files'; -- cgit v1.2.3 From 73600a19d58c110282be5307dbcc8479ab1d07bf Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Wed, 30 Jan 2013 18:52:07 -0800 Subject: Remove initialize and update code out of wallet-admin wallet-admin is solely a thin wrapper around Wallet::Admin, but it gained specific code for initialize and update, which caused the server/admin test to fail. Move the update code to set a default version into into Wallet::Admin instead. The initialize code appears to be unnecessary; it was setting a default for a parameter that was already handled by Wallet::Config. Change-Id: I1a7e5dbbfd005e4f60e89e50a91019295e44df99 Reviewed-on: https://gerrit.stanford.edu/729 Reviewed-by: Russ Allbery Tested-by: Russ Allbery --- perl/Wallet/Admin.pm | 15 ++++++++++++++- server/wallet-admin | 25 +------------------------ 2 files changed, 15 insertions(+), 25 deletions(-) diff --git a/perl/Wallet/Admin.pm b/perl/Wallet/Admin.pm index 511916d..d2e8cb0 100644 --- a/perl/Wallet/Admin.pm +++ b/perl/Wallet/Admin.pm @@ -1,7 +1,7 @@ # Wallet::Admin -- Wallet system administrative interface. # # Written by Russ Allbery -# Copyright 2008, 2009, 2010, 2011, 2012 +# Copyright 2008, 2009, 2010, 2011, 2012, 2013 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -24,6 +24,12 @@ use Wallet::Schema; # that it will sort properly. $VERSION = '0.07'; +# The last non-DBIx::Class version of Wallet::Schema. If a database has no +# DBIx::Class versioning, we artificially install this version number before +# starting the upgrade process so that the automated DBIx::Class upgrade will +# work properly. +our $BASE_VERSION = '0.07'; + ############################################################################## # Constructor, destructor, and accessors ############################################################################## @@ -166,6 +172,13 @@ sub backup { sub upgrade { my ($self) = @_; + # Check to see if the database is versioned. If not, install the + # versioning table and default version. + if (!$self->{dbh}->get_db_version) { + $self->{dbh}->install ($BASE_VERSION); + } + + # Perform the actual upgrade. if ($self->{dbh}->get_db_version) { eval { $self->{dbh}->upgrade; }; } diff --git a/server/wallet-admin b/server/wallet-admin index 7e5a402..516423b 100755 --- a/server/wallet-admin +++ b/server/wallet-admin @@ -3,7 +3,7 @@ # wallet-admin -- Wallet server administrative commands. # # Written by Russ Allbery -# Copyright 2008, 2009, 2010, 2011 +# Copyright 2008, 2009, 2010, 2011, 2013 # The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -15,13 +15,6 @@ use strict; use Wallet::Admin; -# The last non-DBIx::Class version. If a database has no DBIx::Class -# versioning, we want to set it to this so that upgrades can begin. -our $BASE_VERSION = '0.07'; - -# Directory that contains the wallet SQL files for upgrades. -our $SQL_DIR = '/usr/share/wallet/sql/'; - ############################################################################## # Implementation ############################################################################## @@ -48,9 +41,6 @@ sub command { die "too few arguments to initialize\n" if @args < 1; die "invalid admin principal $args[0]\n" unless $args[0] =~ /^[^\@\s]+\@\S+$/; - - my $schema = $admin->{dbh}; - $schema->upgrade_directory ($SQL_DIR); $admin->initialize (@args) or die $admin->error, "\n"; } elsif ($command eq 'register') { die "too many arguments to register\n" if @args > 3; @@ -69,20 +59,7 @@ sub command { } } elsif ($command eq 'upgrade') { die "too many arguments to upgrade\n" if @args; - - my $schema = $admin->{dbh}; - $schema->upgrade_directory ($SQL_DIR); - - # Check to see if the database is versioned. If not, install the - # versioning table and default version. - if (!$schema->get_db_version) { - print "Versioning database.\n"; - $schema->install ($BASE_VERSION); - } - - # Actually upgrade. $admin->upgrade or die $admin->error, "\n"; - } else { die "unknown command $command\n"; } -- cgit v1.2.3 From 298588849847a5017c696b48193578fe5d69b818 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Thu, 31 Jan 2013 15:52:19 -0800 Subject: Resynchronize TODO with JIRA Change-Id: If4bd4a62517572fed6fe911bc39a0e5c6be36e76 Reviewed-on: https://gerrit.stanford.edu/732 Reviewed-by: Russ Allbery Tested-by: Russ Allbery --- TODO | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) diff --git a/TODO b/TODO index 2fc17b5..07d7a2c 100644 --- a/TODO +++ b/TODO @@ -179,6 +179,16 @@ Administrative Interface: DNS-based objects for which the hosts no longer exist. Will need to support a site-specific callout to determine whether the host exists. + * WALLET-66: Database creation appears not to work without the SQL files, + but it's supposed to work directly from the classes. Double-check + this. + +Installation: + + * WALLET-65: Install the SQL files and set a default value for + $DB_DDL_DIRECTORY. Document this in the installation instructions. + Test for the validity of that variable before doing upgrades? + Documentation: * WALLET-43: Write a conventions document for ACL naming, object naming, @@ -210,11 +220,6 @@ Code Style and Cleanup: * WALLET-50: The Wallet::Config class is very ugly and could use some better internal API to reference the variables in it. - * WALLET-51: Use Class::DBI and Class::Trigger (or DBIx::Class) to handle - the data access layer rather than writing SQL directly, and implement - the logging requirements with triggers rather than explicit SQL. This - may also replace Wallet::Schema. - * WALLET-52: Consider using Class::Accessor to get rid of the scaffolding code to access object data, and a Wallet::Base class to handle things like the error() method common to many classes. -- cgit v1.2.3 From 22f1c07a21bc6155450de35c838855f73db35d05 Mon Sep 17 00:00:00 2001 From: Jon Robertson Date: Wed, 30 Jan 2013 20:06:37 -0800 Subject: Suppress DBIx::Class::Schema::Versioned warnings DBIx::Class::Schema::Versioned uses carp to send a few warnings that are more just informational messages. Use a local warning handler to skip the warnings we'll always get for normal upgrades. Change-Id: I4f987b290ec17b95d737150dd106e7bb0f62a264 Reviewed-on: https://gerrit.stanford.edu/730 Reviewed-by: Russ Allbery Tested-by: Russ Allbery --- perl/Wallet/Admin.pm | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/perl/Wallet/Admin.pm b/perl/Wallet/Admin.pm index d2e8cb0..c0b1730 100644 --- a/perl/Wallet/Admin.pm +++ b/perl/Wallet/Admin.pm @@ -178,6 +178,14 @@ sub upgrade { $self->{dbh}->install ($BASE_VERSION); } + # Suppress warnings that actually are just informational messages. + local $SIG{__WARN__} = sub { + my ($warn) = @_; + return if $warn =~ m{Upgrade not necessary}; + return if $warn =~ m{Attempting upgrade}; + warn $warn; + }; + # Perform the actual upgrade. if ($self->{dbh}->get_db_version) { eval { $self->{dbh}->upgrade; }; -- cgit v1.2.3 From a30984dc9602e5a7efe9556f337eb21dbcec8319 Mon Sep 17 00:00:00 2001 From: Jon Robertson Date: Thu, 31 Jan 2013 14:38:25 -0800 Subject: Fixed errors with Keytab object and its tests perl/Wallet/Object/Keytab.pm was using the wrong value for the database handle in some places (trying to load as a subroutine rather than part of the object). Also, the keytab.t tests were attempting to run against the DBIx::Class object rather than a direct dbh handle that they expected. Change-Id: Ifbb8b110d559f3ba867fc5b0dc3933fd2d4fd484 Reviewed-on: https://gerrit.stanford.edu/731 Reviewed-by: Russ Allbery Tested-by: Russ Allbery --- perl/Wallet/Object/Keytab.pm | 8 +++---- perl/t/keytab.t | 55 +++++++++++++++++++++++++++++--------------- 2 files changed, 40 insertions(+), 23 deletions(-) diff --git a/perl/Wallet/Object/Keytab.pm b/perl/Wallet/Object/Keytab.pm index 083dae6..b50fb6e 100644 --- a/perl/Wallet/Object/Keytab.pm +++ b/perl/Wallet/Object/Keytab.pm @@ -140,8 +140,8 @@ sub sync_set { eval { my $name = $self->{name}; my %search = (ks_name => $name); - my $sync_rs = $self->dbh->resultset('KeytabSync') - ->search (\%search); + my $sync_rs = $self->{dbh}->resultset('KeytabSync') + ->find (\%search); if (defined $sync_rs) { my $target = $sync_rs->ks_target; $sync_rs->delete; @@ -167,8 +167,8 @@ sub sync_list { eval { my %search = (ks_name => $self->{name}); my %attrs = (order_by => 'ks_target'); - my @syncs = $self->dbh->resultset('KeytabSync')->search (\%search, - \%attrs); + my @syncs = $self->{dbh}->resultset('KeytabSync')->search (\%search, + \%attrs); for my $sync_rs (@syncs) { push (@targets, $sync_rs->ks_target); } diff --git a/perl/t/keytab.t b/perl/t/keytab.t index 01def75..c263f58 100755 --- a/perl/t/keytab.t +++ b/perl/t/keytab.t @@ -13,6 +13,7 @@ use Test::More tests => 139; BEGIN { $Wallet::Config::KEYTAB_TMP = '.' } +use DBI; use Wallet::Admin; use Wallet::Config; use Wallet::Kadmin; @@ -146,7 +147,8 @@ db_setup; my $admin = eval { Wallet::Admin->new }; is ($@, '', 'Database connection succeeded'); is ($admin->reinitialize ($user), 1, 'Database initialization succeeded'); -my $dbh = $admin->dbh; +my $schema = $admin->dbh; +my $dbh = $schema->storage->dbh; # Use this to accumulate the history traces so that we can check history. my $history = ''; @@ -173,7 +175,8 @@ SKIP: { # Test that object creation without KEYTAB_TMP fails. undef $Wallet::Config::KEYTAB_TMP; $object = eval { - Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace) + Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema, + @trace) }; is ($object, undef, 'Creating keytab without KEYTAB_TMP fails'); is ($@, "KEYTAB_TMP configuration variable not set\n", @@ -182,7 +185,8 @@ SKIP: { # Okay, now we can test. First, create. $object = eval { - Wallet::Object::Keytab->create ('keytab', "wallet\nf", $dbh, @trace) + Wallet::Object::Keytab->create ('keytab', "wallet\nf", $schema, + @trace) }; is ($object, undef, 'Creating malformed principal fails'); if ($Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') { @@ -192,7 +196,7 @@ SKIP: { ' with the right error'); } $object = eval { - Wallet::Object::Keytab->create ('keytab', '', $dbh, @trace) + Wallet::Object::Keytab->create ('keytab', '', $schema, @trace) }; is ($object, undef, 'Creating empty principal fails'); if ($Wallet::Config::KEYTAB_KRBTYPE eq 'MIT') { @@ -201,7 +205,8 @@ SKIP: { like ($@, qr/^error adding principal \@/, ' with the right error'); } $object = eval { - Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace) + Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema, + @trace) }; if (defined ($object)) { ok (defined ($object), 'Creating good principal succeeds'); @@ -212,7 +217,8 @@ SKIP: { ok (created ('wallet/one'), ' and the principal was created'); create ('wallet/two'); $object = eval { - Wallet::Object::Keytab->create ('keytab', 'wallet/two', $dbh, @trace) + Wallet::Object::Keytab->create ('keytab', 'wallet/two', $schema, + @trace) }; if (defined ($object)) { ok (defined ($object), 'Creating an existing principal succeeds'); @@ -224,13 +230,13 @@ SKIP: { is ($object->error, undef, ' with no error message'); ok (! created ('wallet/two'), ' and now it does not exist'); my @name = qw(keytab wallet-test/one); - $object = eval { Wallet::Object::Keytab->create (@name, $dbh, @trace) }; + $object = eval { Wallet::Object::Keytab->create (@name, $schema, @trace) }; is ($object, undef, 'Creation without permissions fails'); like ($@, qr{^error adding principal wallet-test/one\@\Q$realm: }, ' with the right error'); # Now, try retrieving the keytab. - $object = Wallet::Object::Keytab->new ('keytab', 'wallet/one', $dbh); + $object = Wallet::Object::Keytab->new ('keytab', 'wallet/one', $schema); ok (defined ($object), 'Retrieving the object works'); ok ($object->isa ('Wallet::Object::Keytab'), ' and is the right type'); is ($object->flag_set ('locked', @trace), 1, ' and setting locked works'); @@ -283,7 +289,8 @@ EOO # Test principal deletion on object destruction. $object = eval { - Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace) + Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema, + @trace) }; ok (defined ($object), 'Creating good principal succeeds'); ok (created ('wallet/one'), ' and the principal was created'); @@ -332,7 +339,8 @@ EOO # Test configuration errors. undef $Wallet::Config::KEYTAB_FILE; $object = eval { - Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace) + Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema, + @trace) }; is ($object, undef, 'Creating with bad configuration fails'); is ($@, "keytab object implementation not configured\n", @@ -340,7 +348,8 @@ EOO $Wallet::Config::KEYTAB_FILE = 't/data/test.keytab'; undef $Wallet::Config::KEYTAB_PRINCIPAL; $object = eval { - Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace) + Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema, + @trace) }; is ($object, undef, ' likewise with another missing variable'); is ($@, "keytab object implementation not configured\n", @@ -348,7 +357,8 @@ EOO $Wallet::Config::KEYTAB_PRINCIPAL = contents ('t/data/test.principal'); undef $Wallet::Config::KEYTAB_REALM; $object = eval { - Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace) + Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema, + @trace) }; is ($object, undef, ' and another'); is ($@, "keytab object implementation not configured\n", @@ -356,14 +366,16 @@ EOO $Wallet::Config::KEYTAB_REALM = contents ('t/data/test.realm'); undef $Wallet::Config::KEYTAB_KRBTYPE; $object = eval { - Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace) + Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema, + @trace) }; is ($object, undef, ' and another'); is ($@, "keytab object implementation not configured\n", ' with the right error'); $Wallet::Config::KEYTAB_KRBTYPE = 'Active Directory'; $object = eval { - Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace) + Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema, + @trace) }; is ($object, undef, ' and one set to an invalid value'); is ($@, "unknown KEYTAB_KRBTYPE setting: Active Directory\n", @@ -387,12 +399,14 @@ SKIP: { # Create the objects for testing and set the unchanging flag. my $one = eval { - Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace) + Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema, + @trace) }; ok (defined ($one), 'Creating wallet/one succeeds'); is ($one->flag_set ('unchanging', @trace), 1, ' and setting unchanging'); my $two = eval { - Wallet::Object::Keytab->create ('keytab', 'wallet/two', $dbh, @trace); + Wallet::Object::Keytab->create ('keytab', 'wallet/two', $schema, + @trace); }; ok (defined ($two), 'Creating wallet/two succeeds'); is ($two->flag_set ('unchanging', @trace), 1, ' and setting unchanging'); @@ -507,7 +521,8 @@ SKIP: { # Test setting synchronization attributes, which can also be done without # configuration. my $one = eval { - Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace) + Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema, + @trace) }; ok (defined ($one), 'Creating wallet/one succeeds'); my $expected = <<"EOO"; @@ -584,7 +599,8 @@ SKIP: { # Create an object for testing and determine the enctypes we have to work # with. my $one = eval { - Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace) + Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema, + @trace) }; if (defined ($one)) { ok (1, 'Creating wallet/one succeeds'); @@ -730,7 +746,8 @@ EOO 'Setting a single enctype works'); is ($one->destroy (@trace), 1, ' and destroying the object works'); $one = eval { - Wallet::Object::Keytab->create ('keytab', 'wallet/one', $dbh, @trace) + Wallet::Object::Keytab->create ('keytab', 'wallet/one', $schema, + @trace) }; ok (defined ($one), ' as does recreating it'); @values = $one->attr ('enctypes'); -- cgit v1.2.3 From bf18b39b6afe541e6888d32d6a555643cbe9d22e Mon Sep 17 00:00:00 2001 From: Jon Robertson Date: Thu, 31 Jan 2013 16:27:49 -0800 Subject: Renamed dbh subroutines and variables for clarity In moving from DBI to DBIx::Class, we at first left the various variables the same. This goes through to update them for the proper names. * Wallet::Admin::schema was created to return the schema object (and similarly for Wallet::Server and Wallet::Report). * Wallet::Admin::dbh was modified to return the actual DBI handle again (and similarly for Wallet::Server and Wallet::Report). * Various places that used $admin->{dbh} were moved to $admin->{schema}. * Various places using $dbh for the schema object were changed to $schema. Change-Id: I00914866e9a8250855a7828474aa9ce0f37b914f Reviewed-on: https://gerrit.stanford.edu/733 Reviewed-by: Russ Allbery Tested-by: Russ Allbery --- perl/Wallet/ACL.pm | 64 ++++++++++++++++----------------- perl/Wallet/Admin.pm | 49 ++++++++++++++----------- perl/Wallet/Object/Base.pm | 80 ++++++++++++++++++++--------------------- perl/Wallet/Object/File.pm | 2 +- perl/Wallet/Object/Keytab.pm | 43 +++++++++++----------- perl/Wallet/Object/WAKeyring.pm | 2 +- perl/Wallet/Report.pm | 50 ++++++++++++++------------ perl/Wallet/Schema.pm | 6 ++-- perl/Wallet/Server.pm | 64 +++++++++++++++++++-------------- perl/t/acl.t | 26 +++++++------- perl/t/admin.t | 4 +-- perl/t/file.t | 14 ++++---- perl/t/init.t | 6 ++-- perl/t/keytab.t | 4 +-- perl/t/object.t | 20 +++++------ perl/t/server.t | 4 +-- perl/t/wa-keyring.t | 10 +++--- 17 files changed, 236 insertions(+), 212 deletions(-) diff --git a/perl/Wallet/ACL.pm b/perl/Wallet/ACL.pm index 4f51c70..1e62e7b 100644 --- a/perl/Wallet/ACL.pm +++ b/perl/Wallet/ACL.pm @@ -32,7 +32,7 @@ $VERSION = '0.07'; # and the database handle to use for future operations. If the object # doesn't exist, throws an exception. sub new { - my ($class, $id, $dbh) = @_; + my ($class, $id, $schema) = @_; my (%search, $data, $name); if ($id =~ /^\d+\z/) { $search{ac_id} = $id; @@ -40,7 +40,7 @@ sub new { $search{ac_name} = $id; } eval { - $data = $dbh->resultset('Acl')->find (\%search); + $data = $schema->resultset('Acl')->find (\%search); }; if ($@) { die "cannot search for ACL $id: $@\n"; @@ -48,9 +48,9 @@ sub new { die "ACL $id not found\n"; } my $self = { - dbh => $dbh, - id => $data->ac_id, - name => $data->ac_name, + schema => $schema, + id => $data->ac_id, + name => $data->ac_name, }; bless ($self, $class); return $self; @@ -60,18 +60,18 @@ sub new { # blessed ACL object for it. Stores the database handle to use and the ID of # the newly created ACL in the object. On failure, throws an exception. sub create { - my ($class, $name, $dbh, $user, $host, $time) = @_; + my ($class, $name, $schema, $user, $host, $time) = @_; if ($name =~ /^\d+\z/) { die "ACL name may not be all numbers\n"; } $time ||= time; my $id; eval { - my $guard = $dbh->txn_scope_guard; + my $guard = $schema->txn_scope_guard; # Create the new record. my %record = (ac_name => $name); - my $acl = $dbh->resultset('Acl')->create (\%record); + my $acl = $schema->resultset('Acl')->create (\%record); $id = $acl->ac_id; die "unable to retrieve new ACL ID" unless defined $id; @@ -82,7 +82,7 @@ sub create { ah_by => $user, ah_from => $host, ah_on => $date); - my $history = $dbh->resultset('AclHistory')->create (\%record); + my $history = $schema->resultset('AclHistory')->create (\%record); die "unable to create new history entry" unless defined $history; $guard->commit; @@ -91,9 +91,9 @@ sub create { die "cannot create ACL $name: $@\n"; } my $self = { - dbh => $dbh, - id => $id, - name => $name, + schema => $schema, + id => $id, + name => $name, }; bless ($self, $class); return $self; @@ -134,7 +134,7 @@ sub scheme_mapping { my $class; eval { my %search = (as_name => $scheme); - my $scheme_rec = $self->{dbh}->resultset('AclScheme') + my $scheme_rec = $self->{schema}->resultset('AclScheme') ->find (\%search); $class = $scheme_rec->as_class; }; @@ -169,7 +169,7 @@ sub log_acl { ah_by => $user, ah_from => $host, ah_on => strftime ('%Y-%m-%d %T', localtime $time)); - $self->{dbh}->resultset('AclHistory')->create (\%record); + $self->{schema}->resultset('AclHistory')->create (\%record); } ############################################################################## @@ -186,9 +186,9 @@ sub rename { return; } eval { - my $guard = $self->{dbh}->txn_scope_guard; + my $guard = $self->{schema}->txn_scope_guard; my %search = (ac_id => $self->{id}); - my $acls = $self->{dbh}->resultset('Acl')->find (\%search); + my $acls = $self->{schema}->resultset('Acl')->find (\%search); $acls->ac_name ($name); $acls->update; $guard->commit; @@ -212,7 +212,7 @@ sub destroy { my ($self, $user, $host, $time) = @_; $time ||= time; eval { - my $guard = $self->{dbh}->txn_scope_guard; + my $guard = $self->{schema}->txn_scope_guard; # Make certain no one is using the ACL. my @search = ({ ob_owner => $self->{id} }, @@ -221,7 +221,7 @@ sub destroy { { ob_acl_show => $self->{id} }, { ob_acl_destroy => $self->{id} }, { ob_acl_flags => $self->{id} }); - my @entries = $self->{dbh}->resultset('Object')->search (\@search); + my @entries = $self->{schema}->resultset('Object')->search (\@search); if (@entries) { my ($entry) = @entries; die "ACL in use by ".$entry->ob_type.":".$entry->ob_name; @@ -229,14 +229,14 @@ sub destroy { # Delete any entries (there may or may not be any). my %search = (ae_id => $self->{id}); - @entries = $self->{dbh}->resultset('AclEntry')->search(\%search); + @entries = $self->{schema}->resultset('AclEntry')->search(\%search); for my $entry (@entries) { $entry->delete; } # There should definitely be an ACL record to delete. %search = (ac_id => $self->{id}); - my $entry = $self->{dbh}->resultset('Acl')->find(\%search); + my $entry = $self->{schema}->resultset('Acl')->find(\%search); $entry->delete if defined $entry; # Create new history line for the deletion. @@ -245,7 +245,7 @@ sub destroy { ah_by => $user, ah_from => $host, ah_on => $time); - $self->{dbh}->resultset('AclHistory')->create (\%record); + $self->{schema}->resultset('AclHistory')->create (\%record); $guard->commit; }; if ($@) { @@ -268,11 +268,11 @@ sub add { return; } eval { - my $guard = $self->{dbh}->txn_scope_guard; + my $guard = $self->{schema}->txn_scope_guard; my %record = (ae_id => $self->{id}, ae_scheme => $scheme, ae_identifier => $identifier); - my $entry = $self->{dbh}->resultset('AclEntry')->create (\%record); + my $entry = $self->{schema}->resultset('AclEntry')->create (\%record); $self->log_acl ('add', $scheme, $identifier, $user, $host, $time); $guard->commit; }; @@ -290,11 +290,11 @@ sub remove { my ($self, $scheme, $identifier, $user, $host, $time) = @_; $time ||= time; eval { - my $guard = $self->{dbh}->txn_scope_guard; + my $guard = $self->{schema}->txn_scope_guard; my %search = (ae_id => $self->{id}, ae_scheme => $scheme, ae_identifier => $identifier); - my $entry = $self->{dbh}->resultset('AclEntry')->find (\%search); + my $entry = $self->{schema}->resultset('AclEntry')->find (\%search); unless (defined $entry) { die "entry not found in ACL\n"; } @@ -322,9 +322,9 @@ sub list { undef $self->{error}; my @entries; eval { - my $guard = $self->{dbh}->txn_scope_guard; + my $guard = $self->{schema}->txn_scope_guard; my %search = (ae_id => $self->{id}); - my @entry_recs = $self->{dbh}->resultset('AclEntry') + my @entry_recs = $self->{schema}->resultset('AclEntry') ->search (\%search); for my $entry (@entry_recs) { push (@entries, [ $entry->ae_scheme, $entry->ae_identifier ]); @@ -364,11 +364,11 @@ sub history { my ($self) = @_; my $output = ''; eval { - my $guard = $self->{dbh}->txn_scope_guard; + my $guard = $self->{schema}->txn_scope_guard; my %search = (ah_acl => $self->{id}); my %options = (order_by => 'ah_on'); - my @data = $self->{dbh}->resultset('AclHistory')->search (\%search, - \%options); + my @data = $self->{schema}->resultset('AclHistory') + ->search (\%search, \%options); for my $data (@data) { $output .= sprintf ("%s %s ", $data->ah_on->ymd, $data->ah_on->hms); @@ -512,14 +512,14 @@ references. =over 4 -=item new(ACL, DBH) +=item new(ACL, SCHEMA) Instantiate a new ACL object with the given ACL ID or name. Takes the Wallet::Schema object to use for retrieving metadata from the wallet database. Returns a new ACL object if the ACL was found and throws an exception if it wasn't or on any other error. -=item create(NAME, DBH, PRINCIPAL, HOSTNAME [, DATETIME]) +=item create(NAME, SCHEMA, PRINCIPAL, HOSTNAME [, DATETIME]) Similar to new() in that it instantiates a new ACL object, but instead of finding an existing one, creates a new ACL record in the database with the diff --git a/perl/Wallet/Admin.pm b/perl/Wallet/Admin.pm index c0b1730..9fc146c 100644 --- a/perl/Wallet/Admin.pm +++ b/perl/Wallet/Admin.pm @@ -39,8 +39,8 @@ our $BASE_VERSION = '0.07'; # Throw an exception if anything goes wrong. sub new { my ($class) = @_; - my $dbh = Wallet::Schema->connect; - my $self = { dbh => $dbh }; + my $schema = Wallet::Schema->connect; + my $self = { schema => $schema }; bless ($self, $class); return $self; } @@ -48,7 +48,13 @@ sub new { # Returns the database handle (used mostly for testing). sub dbh { my ($self) = @_; - return $self->{dbh}; + return $self->{schema}->storage->dbh; +} + +# Returns the DBIx::Class-based database schema object. +sub schema { + my ($self) = @_; + return $self->{schema}; } # Set or return the error stashed in the object. @@ -66,7 +72,7 @@ sub error { # Disconnect the database handle on object destruction to avoid warnings. sub DESTROY { my ($self) = @_; - $self->{dbh}->storage->dbh->disconnect; + $self->{schema}->storage->dbh->disconnect; } ############################################################################## @@ -83,7 +89,7 @@ sub initialize { # Deploy the database schema from DDL files, if they exist. If not then # we automatically get the database from the Schema modules. - $self->{dbh}->deploy ({}, $Wallet::Config::DB_DDL_DIRECTORY); + $self->{schema}->deploy ({}, $Wallet::Config::DB_DDL_DIRECTORY); if ($@) { $self->error ($@); return; @@ -91,7 +97,8 @@ sub initialize { $self->default_data; # Create a default admin ACL. - my $acl = Wallet::ACL->create ('ADMIN', $self->{dbh}, $user, 'localhost'); + my $acl = Wallet::ACL->create ('ADMIN', $self->{schema}, $user, + 'localhost'); unless ($acl->add ('krb5', $user, $user, 'localhost')) { $self->error ($acl->error); return; @@ -106,7 +113,7 @@ sub default_data { my ($self) = @_; # acl_schemes default rows. - my ($r1) = $self->{dbh}->resultset('AclScheme')->populate ([ + my ($r1) = $self->{schema}->resultset('AclScheme')->populate ([ [ qw/as_name as_class/ ], [ 'krb5', 'Wallet::ACL::Krb5' ], [ 'krb5-regex', 'Wallet::ACL::Krb5::Regex' ], @@ -120,7 +127,7 @@ sub default_data { my @record = ([ qw/ty_name ty_class/ ], [ 'file', 'Wallet::Object::File' ], [ 'keytab', 'Wallet::Object::Keytab' ]); - ($r1) = $self->{dbh}->resultset('Type')->populate (\@record); + ($r1) = $self->{schema}->resultset('Type')->populate (\@record); warn "default Type not installed" unless defined $r1; return 1; @@ -141,13 +148,13 @@ sub destroy { my ($self) = @_; # Get an actual DBI handle and use it to delete all tables. - my $real_dbh = $self->{dbh}->storage->dbh; + my $dbh = $self->dbh; my @tables = qw/acls acl_entries acl_history acl_schemes enctypes flags keytab_enctypes keytab_sync objects object_history sync_targets types dbix_class_schema_versions/; for my $table (@tables) { my $sql = "DROP TABLE IF EXISTS $table"; - $real_dbh->do ($sql); + $dbh->do ($sql); } return 1; @@ -160,9 +167,9 @@ sub backup { my @dbs = qw/MySQL SQLite PostgreSQL/; my $version = $Wallet::Schema::VERSION; - $self->{dbh}->create_ddl_dir (\@dbs, $version, - $Wallet::Config::DB_DDL_DIRECTORY, - $oldversion); + $self->{schema}->create_ddl_dir (\@dbs, $version, + $Wallet::Config::DB_DDL_DIRECTORY, + $oldversion); return 1; } @@ -174,8 +181,8 @@ sub upgrade { # Check to see if the database is versioned. If not, install the # versioning table and default version. - if (!$self->{dbh}->get_db_version) { - $self->{dbh}->install ($BASE_VERSION); + if (!$self->{schema}->get_db_version) { + $self->{schema}->install ($BASE_VERSION); } # Suppress warnings that actually are just informational messages. @@ -187,8 +194,8 @@ sub upgrade { }; # Perform the actual upgrade. - if ($self->{dbh}->get_db_version) { - eval { $self->{dbh}->upgrade; }; + if ($self->{schema}->get_db_version) { + eval { $self->{schema}->upgrade; }; } if ($@) { $self->error ($@); @@ -210,10 +217,10 @@ sub upgrade { sub register_object { my ($self, $type, $class) = @_; eval { - my $guard = $self->{dbh}->txn_scope_guard; + my $guard = $self->{schema}->txn_scope_guard; my %record = (ty_name => $type, ty_class => $class); - $self->{dbh}->resultset('Type')->create (\%record); + $self->{schema}->resultset('Type')->create (\%record); $guard->commit; }; if ($@) { @@ -230,10 +237,10 @@ sub register_object { sub register_verifier { my ($self, $scheme, $class) = @_; eval { - my $guard = $self->{dbh}->txn_scope_guard; + my $guard = $self->{schema}->txn_scope_guard; my %record = (as_name => $scheme, as_class => $class); - $self->{dbh}->resultset('AclScheme')->create (\%record); + $self->{schema}->resultset('AclScheme')->create (\%record); $guard->commit; }; if ($@) { diff --git a/perl/Wallet/Object/Base.pm b/perl/Wallet/Object/Base.pm index 5bd89a7..dd128cc 100644 --- a/perl/Wallet/Object/Base.pm +++ b/perl/Wallet/Object/Base.pm @@ -36,16 +36,16 @@ $VERSION = '0.06'; # type in the object. If the object doesn't exist, returns undef. This will # probably be usable as-is by most object types. sub new { - my ($class, $type, $name, $dbh) = @_; + my ($class, $type, $name, $schema) = @_; my %search = (ob_type => $type, ob_name => $name); - my $object = $dbh->resultset('Object')->find (\%search); + my $object = $schema->resultset('Object')->find (\%search); die "cannot find ${type}:${name}\n" unless ($object and $object->ob_name eq $name); my $self = { - dbh => $dbh, - name => $name, - type => $type, + schema => $schema, + name => $name, + type => $type, }; bless ($self, $class); return $self; @@ -56,11 +56,11 @@ sub new { # specified class. Stores the database handle to use, the name, and the type # in the object. Subclasses may need to override this to do additional setup. sub create { - my ($class, $type, $name, $dbh, $user, $host, $time) = @_; + my ($class, $type, $name, $schema, $user, $host, $time) = @_; $time ||= time; die "invalid object type\n" unless $type; die "invalid object name\n" unless $name; - my $guard = $dbh->txn_scope_guard; + my $guard = $schema->txn_scope_guard; eval { my %record = (ob_type => $type, ob_name => $name, @@ -68,7 +68,7 @@ sub create { ob_created_from => $host, ob_created_on => strftime ('%Y-%m-%d %T', localtime $time)); - $dbh->resultset('Object')->create (\%record); + $schema->resultset('Object')->create (\%record); %record = (oh_type => $type, oh_name => $name, @@ -76,7 +76,7 @@ sub create { oh_by => $user, oh_from => $host, oh_on => strftime ('%Y-%m-%d %T', localtime $time)); - $dbh->resultset('ObjectHistory')->create (\%record); + $schema->resultset('ObjectHistory')->create (\%record); $guard->commit; }; @@ -84,9 +84,9 @@ sub create { die "cannot create object ${type}:${name}: $@\n"; } my $self = { - dbh => $dbh, - name => $name, - type => $type, + schema => $schema, + name => $name, + type => $type, }; bless ($self, $class); return $self; @@ -136,7 +136,7 @@ sub log_action { # We have two traces to record, one in the object_history table and one in # the object record itself. Commit both changes as a transaction. We # assume that AutoCommit is turned off. - my $guard = $self->{dbh}->txn_scope_guard; + my $guard = $self->{schema}->txn_scope_guard; eval { my %record = (oh_type => $self->{type}, oh_name => $self->{name}, @@ -144,11 +144,11 @@ sub log_action { oh_by => $user, oh_from => $host, oh_on => strftime ('%Y-%m-%d %T', localtime $time)); - $self->{dbh}->resultset('ObjectHistory')->create (\%record); + $self->{schema}->resultset('ObjectHistory')->create (\%record); my %search = (ob_type => $self->{type}, ob_name => $self->{name}); - my $object = $self->{dbh}->resultset('Object')->find (\%search); + my $object = $self->{schema}->resultset('Object')->find (\%search); if ($action eq 'get') { $object->ob_downloaded_by ($user); $object->ob_downloaded_from ($host); @@ -202,7 +202,7 @@ sub log_set { oh_by => $user, oh_from => $host, oh_on => strftime ('%Y-%m-%d %T', localtime $time)); - $self->{dbh}->resultset('ObjectHistory')->create (\%record); + $self->{schema}->resultset('ObjectHistory')->create (\%record); } ############################################################################## @@ -225,11 +225,11 @@ sub _set_internal { return; } - my $guard = $self->{dbh}->txn_scope_guard; + my $guard = $self->{schema}->txn_scope_guard; eval { my %search = (ob_type => $type, ob_name => $name); - my $object = $self->{dbh}->resultset('Object')->find (\%search); + my $object = $self->{schema}->resultset('Object')->find (\%search); my $old = $object->get_column ("ob_$attr"); $object->update ({ "ob_$attr" => $value }); @@ -261,7 +261,7 @@ sub _get_internal { eval { my %search = (ob_type => $type, ob_name => $name); - my $object = $self->{dbh}->resultset('Object')->find (\%search); + my $object = $self->{schema}->resultset('Object')->find (\%search); $value = $object->get_column ($attr); }; if ($@) { @@ -282,7 +282,7 @@ sub acl { my $attr = "acl_$type"; if ($id) { my $acl; - eval { $acl = Wallet::ACL->new ($id, $self->{dbh}) }; + eval { $acl = Wallet::ACL->new ($id, $self->{schema}) }; if ($@) { $self->error ($@); return; @@ -352,7 +352,7 @@ sub owner { my ($self, $owner, $user, $host, $time) = @_; if ($owner) { my $acl; - eval { $acl = Wallet::ACL->new ($owner, $self->{dbh}) }; + eval { $acl = Wallet::ACL->new ($owner, $self->{schema}) }; if ($@) { $self->error ($@); return; @@ -375,13 +375,13 @@ sub flag_check { my ($self, $flag) = @_; my $name = $self->{name}; my $type = $self->{type}; - my $dbh = $self->{dbh}; + my $schema = $self->{schema}; my $value; eval { my %search = (fl_type => $type, fl_name => $name, fl_flag => $flag); - my $flag = $dbh->resultset('Flag')->find (\%search); + my $flag = $schema->resultset('Flag')->find (\%search); if (not defined $flag) { $value = 0; } else { @@ -403,13 +403,13 @@ sub flag_clear { $time ||= time; my $name = $self->{name}; my $type = $self->{type}; - my $dbh = $self->{dbh}; - my $guard = $dbh->txn_scope_guard; + my $schema = $self->{schema}; + my $guard = $schema->txn_scope_guard; eval { my %search = (fl_type => $type, fl_name => $name, fl_flag => $flag); - my $flag = $dbh->resultset('Flag')->find (\%search); + my $flag = $schema->resultset('Flag')->find (\%search); unless (defined $flag) { die "flag not set\n"; } @@ -435,8 +435,8 @@ sub flag_list { my %search = (fl_type => $self->{type}, fl_name => $self->{name}); my %attrs = (order_by => 'fl_flag'); - my @flags_rs = $self->{dbh}->resultset('Flag')->search (\%search, - \%attrs); + my @flags_rs = $self->{schema}->resultset('Flag')->search (\%search, + \%attrs); for my $flag (@flags_rs) { push (@flags, $flag->fl_flag); } @@ -457,17 +457,17 @@ sub flag_set { $time ||= time; my $name = $self->{name}; my $type = $self->{type}; - my $dbh = $self->{dbh}; - my $guard = $dbh->txn_scope_guard; + my $schema = $self->{schema}; + my $guard = $schema->txn_scope_guard; eval { my %search = (fl_type => $type, fl_name => $name, fl_flag => $flag); - my $flag = $dbh->resultset('Flag')->find (\%search); + my $flag = $schema->resultset('Flag')->find (\%search); if (defined $flag) { die "flag already set\n"; } - $flag = $dbh->resultset('Flag')->create (\%search); + $flag = $schema->resultset('Flag')->create (\%search); $self->log_set ('flags', undef, $flag->fl_flag, $user, $host, $time); $guard->commit; }; @@ -489,7 +489,7 @@ sub format_acl_id { my $name = $id; my %search = (ac_id => $id); - my $acl_rs = $self->{dbh}->resultset('Acl')->find (\%search); + my $acl_rs = $self->{schema}->resultset('Acl')->find (\%search); if (defined $acl_rs) { $name = $acl_rs->ac_name . " ($id)"; } @@ -507,7 +507,7 @@ sub history { my %search = (oh_type => $self->{type}, oh_name => $self->{name}); my %attrs = (order_by => 'oh_on'); - my @history = $self->{dbh}->resultset('ObjectHistory') + my @history = $self->{schema}->resultset('ObjectHistory') ->search (\%search, \%attrs); for my $history_rs (@history) { @@ -620,7 +620,7 @@ sub show { eval { my %search = (ob_type => $type, ob_name => $name); - $object_rs = $self->{dbh}->resultset('Object')->find (\%search); + $object_rs = $self->{schema}->resultset('Object')->find (\%search); }; if ($@) { $self->error ("cannot retrieve data for ${type}:${name}: $@"); @@ -658,7 +658,7 @@ sub show { $output .= $attr_output; } if ($field =~ /^ob_(owner|acl_)/) { - my $acl = eval { Wallet::ACL->new ($value, $self->{dbh}) }; + my $acl = eval { Wallet::ACL->new ($value, $self->{schema}) }; if ($acl and not $@) { $value = $acl->name || $value; push (@acls, [ $acl, $value ]); @@ -688,18 +688,18 @@ sub destroy { $self->error ("cannot destroy ${type}:${name}: object is locked"); return; } - my $guard = $self->{dbh}->txn_scope_guard; + my $guard = $self->{schema}->txn_scope_guard; eval { # Remove any flags that may exist for the record. my %search = (fl_type => $type, fl_name => $name); - $self->{dbh}->resultset('Flag')->search (\%search)->delete; + $self->{schema}->resultset('Flag')->search (\%search)->delete; # Remove any object records %search = (ob_type => $type, ob_name => $name); - $self->{dbh}->resultset('Object')->search (\%search)->delete; + $self->{schema}->resultset('Object')->search (\%search)->delete; # And create a new history object for the destroy action. my %record = (oh_type => $type, @@ -708,7 +708,7 @@ sub destroy { oh_by => $user, oh_from => $host, oh_on => strftime ('%Y-%m-%d %T', localtime $time)); - $self->{dbh}->resultset('ObjectHistory')->create (\%record); + $self->{schema}->resultset('ObjectHistory')->create (\%record); $guard->commit; }; if ($@) { diff --git a/perl/Wallet/Object/File.pm b/perl/Wallet/Object/File.pm index 47c8ac2..69468e1 100644 --- a/perl/Wallet/Object/File.pm +++ b/perl/Wallet/Object/File.pm @@ -143,7 +143,7 @@ API HOSTNAME DATETIME keytab remctld backend nul Allbery wallet-backend my @name = qw(file mysql-lsdb) my @trace = ($user, $host, time); - my $object = Wallet::Object::Keytab->create (@name, $dbh, @trace); + my $object = Wallet::Object::Keytab->create (@name, $schema, @trace); unless ($object->store ("the-password\n")) { die $object->error, "\n"; } diff --git a/perl/Wallet/Object/Keytab.pm b/perl/Wallet/Object/Keytab.pm index b50fb6e..962c19b 100644 --- a/perl/Wallet/Object/Keytab.pm +++ b/perl/Wallet/Object/Keytab.pm @@ -40,12 +40,12 @@ sub enctypes_set { my @trace = ($user, $host, $time); my $name = $self->{name}; my %enctypes = map { $_ => 1 } @$enctypes; - my $guard = $self->{dbh}->txn_scope_guard; + my $guard = $self->{schema}->txn_scope_guard; eval { # Find all enctypes for the given keytab. my %search = (ke_name => $name); - my @enctypes = $self->{dbh}->resultset('KeytabEnctype') + my @enctypes = $self->{schema}->resultset('KeytabEnctype') ->search (\%search); my (@current); for my $enctype_rs (@enctypes) { @@ -61,7 +61,7 @@ sub enctypes_set { } else { %search = (ke_name => $name, ke_enctype => $enctype); - $self->{dbh}->resultset('KeytabEnctype')->find (\%search) + $self->{schema}->resultset('KeytabEnctype')->find (\%search) ->delete; $self->log_set ('type_data enctypes', $enctype, undef, @trace); } @@ -73,13 +73,13 @@ sub enctypes_set { # to make it easier to test. for my $enctype (sort keys %enctypes) { my %search = (en_name => $enctype); - my $enctype_rs = $self->{dbh}->('Enctype')->find (\%search); + my $enctype_rs = $self->{schema}->('Enctype')->find (\%search); unless (defined $enctype_rs) { die "unknown encryption type $enctype\n"; } my %record = (ke_name => $name, ke_enctype => $enctype); - $self->{dbh}->resultset('Enctype')->create (\%record); + $self->{schema}->resultset('Enctype')->create (\%record); $self->log_set ('type_data enctypes', undef, $enctype, @trace); } $guard->commit; @@ -101,7 +101,7 @@ sub enctypes_list { eval { my %search = (ke_name => $self->{name}); my %attrs = (order_by => 'ke_enctype'); - my @enctypes_rs = $self->{dbh}->resultset('KeytabEnctype') + my @enctypes_rs = $self->{schema}->resultset('KeytabEnctype') ->search (\%search, \%attrs); for my $enctype_rs (@enctypes_rs) { push (@enctypes, $enctype_rs->ke_enctype); @@ -136,11 +136,11 @@ sub sync_set { $self->error ("unsupported synchronization target $target"); return; } else { - my $guard = $self->{dbh}->txn_scope_guard; + my $guard = $self->{schema}->txn_scope_guard; eval { my $name = $self->{name}; my %search = (ks_name => $name); - my $sync_rs = $self->{dbh}->resultset('KeytabSync') + my $sync_rs = $self->{schema}->resultset('KeytabSync') ->find (\%search); if (defined $sync_rs) { my $target = $sync_rs->ks_target; @@ -167,8 +167,8 @@ sub sync_list { eval { my %search = (ks_name => $self->{name}); my %attrs = (order_by => 'ks_target'); - my @syncs = $self->{dbh}->resultset('KeytabSync')->search (\%search, - \%attrs); + my @syncs = $self->{schema}->resultset('KeytabSync')->search (\%search, + \%attrs); for my $sync_rs (@syncs) { push (@targets, $sync_rs->ks_target); } @@ -239,16 +239,16 @@ sub attr_show { # Override new to start by creating a handle for the kadmin module we're # using. sub new { - my ($class, $type, $name, $dbh) = @_; + my ($class, $type, $name, $schema) = @_; my $self = { - dbh => $dbh, + schema => $schema, kadmin => undef, }; bless $self, $class; my $kadmin = Wallet::Kadmin->new (); $self->{kadmin} = $kadmin; - $self = $class->SUPER::new ($type, $name, $dbh); + $self = $class->SUPER::new ($type, $name, $schema); $self->{kadmin} = $kadmin; return $self; } @@ -258,9 +258,9 @@ sub new { # great here since we don't have a way to communicate the error back to the # caller. sub create { - my ($class, $type, $name, $dbh, $creator, $host, $time) = @_; + my ($class, $type, $name, $schema, $creator, $host, $time) = @_; my $self = { - dbh => $dbh, + schema => $schema, kadmin => undef, }; bless $self, $class; @@ -270,7 +270,8 @@ sub create { if (not $kadmin->create ($name)) { die $kadmin->error, "\n"; } - $self = $class->SUPER::create ($type, $name, $dbh, $creator, $host, $time); + $self = $class->SUPER::create ($type, $name, $schema, $creator, $host, + $time); $self->{kadmin} = $kadmin; return $self; } @@ -283,15 +284,15 @@ sub destroy { $self->error ("cannot destroy $id: object is locked"); return; } - my $dbh = $self->{dbh}; - my $guard = $dbh->txn_scope_guard; + my $schema = $self->{schema}; + my $guard = $schema->txn_scope_guard; eval { my %search = (ks_name => $self->{name}); - my $sync_rs = $dbh->resultset('KeytabSync')->search (\%search); + my $sync_rs = $schema->resultset('KeytabSync')->search (\%search); $sync_rs->delete_all if defined $sync_rs; %search = (ke_name => $self->{name}); - my $enctype_rs = $dbh->resultset('KeytabEnctype')->search (\%search); + my $enctype_rs = $schema->resultset('KeytabEnctype')->search (\%search); $enctype_rs->delete_all if defined $enctype_rs; $guard->commit; @@ -353,7 +354,7 @@ Wallet::Object::Keytab - Keytab object implementation for wallet my @name = qw(keytab host/shell.example.com); my @trace = ($user, $host, time); - my $object = Wallet::Object::Keytab->create (@name, $dbh, @trace); + my $object = Wallet::Object::Keytab->create (@name, $schema, @trace); my $keytab = $object->get (@trace); $object->destroy (@trace); diff --git a/perl/Wallet/Object/WAKeyring.pm b/perl/Wallet/Object/WAKeyring.pm index b26be58..f33497c 100644 --- a/perl/Wallet/Object/WAKeyring.pm +++ b/perl/Wallet/Object/WAKeyring.pm @@ -255,7 +255,7 @@ Wallet::Object::WAKeyring - WebAuth keyring object implementation for wallet my ($user, $host, $time); my @name = qw(wa-keyring www.stanford.edu); my @trace = ($user, $host, $time); - my $object = Wallet::Object::WAKeyring->create (@name, $dbh, $trace); + my $object = Wallet::Object::WAKeyring->create (@name, $schema, $trace); my $keyring = $object->get (@trace); unless ($object->store ($keyring)) { die $object->error, "\n"; diff --git a/perl/Wallet/Report.pm b/perl/Wallet/Report.pm index ea8cd2f..ff25b3a 100644 --- a/perl/Wallet/Report.pm +++ b/perl/Wallet/Report.pm @@ -32,8 +32,8 @@ $VERSION = '0.04'; # exception if anything goes wrong. sub new { my ($class) = @_; - my $dbh = Wallet::Schema->connect; - my $self = { dbh => $dbh }; + my $schema = Wallet::Schema->connect; + my $self = { schema => $schema }; bless ($self, $class); return $self; } @@ -41,7 +41,13 @@ sub new { # Returns the database handle (used mostly for testing). sub dbh { my ($self) = @_; - return $self->{dbh}; + return $self->{schema}->storage->dbh; +} + +# Returns the DBIx::Class-based database schema object. +sub schema { + my ($self) = @_; + return $self->{schema}; } # Set or return the error stashed in the object. @@ -59,7 +65,7 @@ sub error { # Disconnect the database handle on object destruction to avoid warnings. sub DESTROY { my ($self) = @_; - $self->{dbh}->storage->dbh->disconnect; + $self->{schema}->storage->dbh->disconnect; } ############################################################################## @@ -106,7 +112,7 @@ sub objects_owner { if (lc ($owner) eq 'null') { %search = (ob_owner => undef); } else { - my $acl = eval { Wallet::ACL->new ($owner, $self->{dbh}) }; + my $acl = eval { Wallet::ACL->new ($owner, $self->{schema}) }; return unless $acl; %search = (ob_owner => $acl->id); } @@ -138,8 +144,8 @@ sub objects_acl { my ($self, $search) = @_; my @objects; - my $dbh = $self->{dbh}; - my $acl = eval { Wallet::ACL->new ($search, $dbh) }; + my $schema = $self->{schema}; + my $acl = eval { Wallet::ACL->new ($search, $schema) }; return unless $acl; my @search = ({ ob_owner => $acl->id }, @@ -202,10 +208,10 @@ sub objects { # Perform the search and return on any errors. my @objects; - my $dbh = $self->{dbh}; + my $schema = $self->{schema}; eval { - my @objects_rs = $dbh->resultset('Object')->search ($search_ref, - $options_ref); + my @objects_rs = $schema->resultset('Object')->search ($search_ref, + $options_ref); for my $object_rs (@objects_rs) { push (@objects, [ $object_rs->ob_type, $object_rs->ob_name ]); } @@ -228,13 +234,13 @@ sub acls_all { my ($self) = @_; my @acls; - my $dbh = $self->{dbh}; + my $schema = $self->{schema}; my %search = (); my %options = (order_by => [ qw/ac_id/ ], select => [ qw/ac_id ac_name/ ]); eval { - my @acls_rs = $dbh->resultset('Acl')->search (\%search, \%options); + my @acls_rs = $schema->resultset('Acl')->search (\%search, \%options); for my $acl_rs (@acls_rs) { push (@acls, [ $acl_rs->ac_id, $acl_rs->ac_name ]); } @@ -252,7 +258,7 @@ sub acls_empty { my ($self) = @_; my @acls; - my $dbh = $self->{dbh}; + my $schema = $self->{schema}; my %search = (ae_id => undef); my %options = (join => 'acl_entries', prefetch => 'acl_entries', @@ -260,7 +266,7 @@ sub acls_empty { select => [ qw/ac_id ac_name/ ]); eval { - my @acls_rs = $dbh->resultset('Acl')->search (\%search, \%options); + my @acls_rs = $schema->resultset('Acl')->search (\%search, \%options); for my $acl_rs (@acls_rs) { push (@acls, [ $acl_rs->ac_id, $acl_rs->ac_name ]); } @@ -280,7 +286,7 @@ sub acls_entry { my ($self, $type, $identifier) = @_; my @acls; - my $dbh = $self->{dbh}; + my $schema = $self->{schema}; my %search = (ae_scheme => $type, ae_identifier => { like => '%'.$identifier.'%' }); my %options = (join => 'acl_entries', @@ -290,7 +296,7 @@ sub acls_entry { distinct => 1); eval { - my @acls_rs = $dbh->resultset('Acl')->search (\%search, \%options); + my @acls_rs = $schema->resultset('Acl')->search (\%search, \%options); for my $acl_rs (@acls_rs) { push (@acls, [ $acl_rs->ac_id, $acl_rs->ac_name ]); } @@ -308,7 +314,7 @@ sub acls_unused { my ($self) = @_; my @acls; - my $dbh = $self->{dbh}; + my $schema = $self->{schema}; my %search = ( #'acls_owner.ob_owner' => undef, #'acls_get.ob_owner' => undef, @@ -322,7 +328,7 @@ sub acls_unused { select => [ qw/ac_id ac_name/ ]); eval { - my @acls_rs = $dbh->resultset('Acl')->search (\%search, \%options); + my @acls_rs = $schema->resultset('Acl')->search (\%search, \%options); # FIXME: Almost certainly a way of doing this with the search itself. for my $acl_rs (@acls_rs) { @@ -347,7 +353,7 @@ sub acls_unused { # on error and setting the internal error. sub acl_membership { my ($self, $id) = @_; - my $acl = eval { Wallet::ACL->new ($id, $self->{dbh}) }; + my $acl = eval { Wallet::ACL->new ($id, $self->{schema}) }; if ($@) { $self->error ($@); return; @@ -433,7 +439,7 @@ sub acls { sub owners { my ($self, $type, $name) = @_; undef $self->{error}; - my $dbh = $self->{dbh}; + my $schema = $self->{schema}; my @owners; eval { @@ -446,8 +452,8 @@ sub owners { distinct => 1, ); - my @acls_rs = $dbh->resultset('AclEntry')->search (\%search, - \%options); + my @acls_rs = $schema->resultset('AclEntry')->search (\%search, + \%options); for my $acl_rs (@acls_rs) { my $scheme = $acl_rs->ae_scheme; my $identifier = $acl_rs->ae_identifier; diff --git a/perl/Wallet/Schema.pm b/perl/Wallet/Schema.pm index d36b7ac..cee94f7 100644 --- a/perl/Wallet/Schema.pm +++ b/perl/Wallet/Schema.pm @@ -40,11 +40,11 @@ sub connect { my $user = $Wallet::Config::DB_USER; my $pass = $Wallet::Config::DB_PASSWORD; my %attrs = (PrintError => 0, RaiseError => 1); - my $dbh = eval { $class->SUPER::connect ($dsn, $user, $pass, \%attrs) }; + my $schema = eval { $class->SUPER::connect ($dsn, $user, $pass, \%attrs) }; if ($@) { die "cannot connect to database: $@\n"; } - return $dbh; + return $schema; } __END__ @@ -62,7 +62,7 @@ Wallet::Schema - Database schema and connector for the wallet system =head1 SYNOPSIS use Wallet::Schema; - my $dbh = Wallet::Schema->connect; + my $schema = Wallet::Schema->connect; =head1 DESCRIPTION diff --git a/perl/Wallet/Server.pm b/perl/Wallet/Server.pm index 402fbe0..db53f6c 100644 --- a/perl/Wallet/Server.pm +++ b/perl/Wallet/Server.pm @@ -37,13 +37,13 @@ $VERSION = '0.11'; # for various things. Throw an exception if anything goes wrong. sub new { my ($class, $user, $host) = @_; - my $dbh = Wallet::Schema->connect; - my $acl = Wallet::ACL->new ('ADMIN', $dbh); + my $schema = Wallet::Schema->connect; + my $acl = Wallet::ACL->new ('ADMIN', $schema); my $self = { - dbh => $dbh, - user => $user, - host => $host, - admin => $acl, + schema => $schema, + user => $user, + host => $host, + admin => $acl, }; bless ($self, $class); return $self; @@ -52,7 +52,13 @@ sub new { # Returns the database handle (used mostly for testing). sub dbh { my ($self) = @_; - return $self->{dbh}; + return $self->{schema}->storage->dbh; +} + +# Returns the DBIx::Class-based database schema object. +sub schema { + my ($self) = @_; + return $self->{schema}; } # Set or return the error stashed in the object. @@ -71,8 +77,8 @@ sub error { sub DESTROY { my ($self) = @_; - if ($self->{dbh}) { - $self->{dbh}->storage->dbh->disconnect; + if ($self->{schema}) { + $self->{schema}->storage->dbh->disconnect; } } @@ -86,9 +92,9 @@ sub type_mapping { my ($self, $type) = @_; my $class; eval { - my $guard = $self->{dbh}->txn_scope_guard; + my $guard = $self->{schema}->txn_scope_guard; my %search = (ty_name => $type); - my $type_rec = $self->{dbh}->resultset('Type')->find (\%search); + my $type_rec = $self->{schema}->resultset('Type')->find (\%search); $class = $type_rec->ty_class; $guard->commit; }; @@ -118,7 +124,7 @@ sub create_check { my ($self, $type, $name) = @_; my $user = $self->{user}; my $host = $self->{host}; - my $dbh = $self->{dbh}; + my $schema = $self->{schema}; unless (defined (&Wallet::Config::default_owner)) { $self->error ("$user not authorized to create ${type}:${name}"); return; @@ -128,9 +134,9 @@ sub create_check { $self->error ("$user not authorized to create ${type}:${name}"); return; } - my $acl = eval { Wallet::ACL->new ($aname, $dbh) }; + my $acl = eval { Wallet::ACL->new ($aname, $schema) }; if ($@) { - $acl = eval { Wallet::ACL->create ($aname, $dbh, $user, $host) }; + $acl = eval { Wallet::ACL->create ($aname, $schema, $user, $host) }; if ($@) { $self->error ($@); return; @@ -181,10 +187,10 @@ sub create_object { $self->error ("unknown object type $type"); return; } - my $dbh = $self->{dbh}; + my $schema = $self->{schema}; my $user = $self->{user}; my $host = $self->{host}; - my $object = eval { $class->create ($type, $name, $dbh, $user, $host) }; + my $object = eval { $class->create ($type, $name, $schema, $user, $host) }; if ($@) { $self->error ($@); return; @@ -246,7 +252,7 @@ sub retrieve { $self->error ("unknown object type $type"); return; } - my $object = eval { $class->new ($type, $name, $self->{dbh}) }; + my $object = eval { $class->new ($type, $name, $self->{schema}) }; if ($@) { $self->error ($@); return; @@ -302,7 +308,7 @@ sub acl_verify { $self->object_error ($object, $action); return; } - my $acl = eval { Wallet::ACL->new ($id, $self->{dbh}) }; + my $acl = eval { Wallet::ACL->new ($id, $self->{schema}) }; if ($@) { $self->error ($@); return; @@ -556,7 +562,7 @@ sub flag_set { # 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}) }; + my $acl = eval { Wallet::ACL->new ($id, $self->{schema}) }; if ($@) { if ($@ =~ /^ACL .* not found/) { return 0; @@ -585,8 +591,8 @@ sub acl_create { return; } } - my $dbh = $self->{dbh}; - my $acl = eval { Wallet::ACL->create ($name, $dbh, $user, $host) }; + my $schema = $self->{schema}; + my $acl = eval { Wallet::ACL->create ($name, $schema, $user, $host) }; if ($@) { $self->error ($@); return; @@ -617,7 +623,7 @@ sub acl_history { $self->acl_error ($id, 'history'); return; } - my $acl = eval { Wallet::ACL->new ($id, $self->{dbh}) }; + my $acl = eval { Wallet::ACL->new ($id, $self->{schema}) }; if ($@) { $self->error ($@); return; @@ -637,7 +643,7 @@ sub acl_show { $self->acl_error ($id, 'show'); return; } - my $acl = eval { Wallet::ACL->new ($id, $self->{dbh}) }; + my $acl = eval { Wallet::ACL->new ($id, $self->{schema}) }; if ($@) { $self->error ($@); return; @@ -658,7 +664,7 @@ sub acl_rename { $self->acl_error ($id, 'rename'); return; } - my $acl = eval { Wallet::ACL->new ($id, $self->{dbh}) }; + my $acl = eval { Wallet::ACL->new ($id, $self->{schema}) }; if ($@) { $self->error ($@); return; @@ -689,7 +695,7 @@ sub acl_destroy { $self->acl_error ($id, 'destroy'); return; } - my $acl = eval { Wallet::ACL->new ($id, $self->{dbh}) }; + my $acl = eval { Wallet::ACL->new ($id, $self->{schema}) }; if ($@) { $self->error ($@); return; @@ -713,7 +719,7 @@ sub acl_add { $self->acl_error ($id, 'add'); return; } - my $acl = eval { Wallet::ACL->new ($id, $self->{dbh}) }; + my $acl = eval { Wallet::ACL->new ($id, $self->{schema}) }; if ($@) { $self->error ($@); return; @@ -733,7 +739,7 @@ sub acl_remove { $self->acl_error ($id, 'remove'); return; } - my $acl = eval { Wallet::ACL->new ($id, $self->{dbh}) }; + my $acl = eval { Wallet::ACL->new ($id, $self->{schema}) }; if ($@) { $self->error ($@); return; @@ -975,6 +981,10 @@ 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 diff --git a/perl/t/acl.t b/perl/t/acl.t index f169eb5..62eb411 100755 --- a/perl/t/acl.t +++ b/perl/t/acl.t @@ -29,30 +29,30 @@ db_setup; my $setup = eval { Wallet::Admin->new }; is ($@, '', 'Database connection succeeded'); is ($setup->reinitialize ($setup), 1, 'Database initialization succeeded'); -my $dbh = $setup->dbh; +my $schema = $setup->schema; # Test create and new. -my $acl = eval { Wallet::ACL->create ('test', $dbh, @trace) }; +my $acl = eval { Wallet::ACL->create ('test', $schema, @trace) }; ok (defined ($acl), 'ACL creation'); is ($@, '', ' with no exceptions'); ok ($acl->isa ('Wallet::ACL'), ' and the right class'); is ($acl->name, 'test', ' and the right name'); is ($acl->id, 2, ' and the right ID'); -$acl = eval { Wallet::ACL->create (3, $dbh, @trace) }; +$acl = eval { Wallet::ACL->create (3, $schema, @trace) }; ok (!defined ($acl), 'Creating with a numeric name'); is ($@, "ACL name may not be all numbers\n", ' with the right error message'); -$acl = eval { Wallet::ACL->create ('test', $dbh, @trace) }; +$acl = eval { Wallet::ACL->create ('test', $schema, @trace) }; ok (!defined ($acl), 'Creating a duplicate object'); like ($@, qr/^cannot create ACL test: /, ' with the right error message'); -$acl = eval { Wallet::ACL->new ('test2', $dbh) }; +$acl = eval { Wallet::ACL->new ('test2', $schema) }; ok (!defined ($acl), 'Searching for a non-existent ACL'); is ($@, "ACL test2 not found\n", ' with the right error message'); -$acl = eval { Wallet::ACL->new ('test', $dbh) }; +$acl = eval { Wallet::ACL->new ('test', $schema) }; ok (defined ($acl), 'Searching for the test ACL by name'); is ($@, '', ' with no exceptions'); ok ($acl->isa ('Wallet::ACL'), ' and the right class'); is ($acl->id, 2, ' and the right ID'); -$acl = eval { Wallet::ACL->new (2, $dbh) }; +$acl = eval { Wallet::ACL->new (2, $schema) }; ok (defined ($acl), 'Searching for the test ACL by ID'); is ($@, '', ' with no exceptions'); ok ($acl->isa ('Wallet::ACL'), ' and the right class'); @@ -66,15 +66,15 @@ if ($acl->rename ('example')) { } is ($acl->name, 'example', ' and the new name is right'); is ($acl->id, 2, ' and the ID did not change'); -$acl = eval { Wallet::ACL->new ('test', $dbh) }; +$acl = eval { Wallet::ACL->new ('test', $schema) }; ok (!defined ($acl), ' and it cannot be found under the old name'); is ($@, "ACL test not found\n", ' with the right error message'); -$acl = eval { Wallet::ACL->new ('example', $dbh) }; +$acl = eval { Wallet::ACL->new ('example', $schema) }; ok (defined ($acl), ' and it can be found with the new name'); is ($@, '', ' with no exceptions'); is ($acl->name, 'example', ' and the right name'); is ($acl->id, 2, ' and the right ID'); -$acl = eval { Wallet::ACL->new (2, $dbh) }; +$acl = eval { Wallet::ACL->new (2, $schema) }; ok (defined ($acl), ' and it can still found by ID'); is ($@, '', ' with no exceptions'); is ($acl->name, 'example', ' and the right name'); @@ -212,13 +212,13 @@ if ($acl->destroy (@trace)) { } else { is ($acl->error, '', 'Destroying the ACL works'); } -$acl = eval { Wallet::ACL->new ('example', $dbh) }; +$acl = eval { Wallet::ACL->new ('example', $schema) }; ok (!defined ($acl), ' and now cannot be found'); is ($@, "ACL example not found\n", ' with the right error message'); -$acl = eval { Wallet::ACL->new (2, $dbh) }; +$acl = eval { Wallet::ACL->new (2, $schema) }; ok (!defined ($acl), ' or by ID'); is ($@, "ACL 2 not found\n", ' with the right error message'); -$acl = eval { Wallet::ACL->create ('example', $dbh, @trace) }; +$acl = eval { Wallet::ACL->create ('example', $schema, @trace) }; ok (defined ($acl), ' and creating another with the same name works'); is ($@, '', ' with no exceptions'); is ($acl->name, 'example', ' and the right name'); diff --git a/perl/t/admin.t b/perl/t/admin.t index cf6a637..ff69ee9 100755 --- a/perl/t/admin.t +++ b/perl/t/admin.t @@ -63,11 +63,11 @@ $Wallet::Schema::VERSION = '0.07'; is ($admin->reinitialize ('admin@EXAMPLE.COM'), 1, ' and re-initialization succeeds'); $Wallet::Schema::VERSION = '0.08'; -my $schema = $admin->dbh; +my $schema = $admin->schema; $schema->upgrade_directory ('sql/'); my $retval = $admin->upgrade; is ($retval, 1, 'Performing an upgrade succeeds'); -my $dbh = $schema->storage->dbh; +my $dbh = $admin->dbh; my $sql = "select version from dbix_class_schema_versions order by version " ."DESC"; $version = $dbh->selectall_arrayref ($sql); diff --git a/perl/t/file.t b/perl/t/file.t index a821c4f..f902fba 100755 --- a/perl/t/file.t +++ b/perl/t/file.t @@ -31,7 +31,7 @@ db_setup; my $admin = eval { Wallet::Admin->new }; is ($@, '', 'Database connection succeeded'); is ($admin->reinitialize ($user), 1, 'Database initialization succeeded'); -my $dbh = $admin->dbh; +my $schema = $admin->schema; # Use this to accumulate the history traces so that we can check history. my $history = ''; @@ -39,7 +39,7 @@ my $date = strftime ('%Y-%m-%d %H:%M:%S', localtime $trace[2]); # Test error handling in the absence of configuration. $object = eval { - Wallet::Object::File->create ('file', 'test', $dbh, @trace) + Wallet::Object::File->create ('file', 'test', $schema, @trace) }; ok (defined ($object), 'Creating a basic file object succeeds'); ok ($object->isa ('Wallet::Object::File'), ' and is the right class'); @@ -55,7 +55,7 @@ $Wallet::Config::FILE_BUCKET = 'test-files'; # Okay, now we can test. First, the basic object without store. $object = eval { - Wallet::Object::File->create ('file', 'test', $dbh, @trace) + Wallet::Object::File->create ('file', 'test', $schema, @trace) }; ok (defined ($object), 'Creating a basic file object succeeds'); ok ($object->isa ('Wallet::Object::File'), ' and is the right class'); @@ -66,7 +66,7 @@ is ($object->destroy (@trace), 1, ' but destroying the object succeeds'); # Now store something and be sure that we get something reasonable. $object = eval { - Wallet::Object::File->create ('file', 'test', $dbh, @trace) + Wallet::Object::File->create ('file', 'test', $schema, @trace) }; ok (defined ($object), 'Recreating the object succeeds'); is ($object->store ("foo\n", @trace), 1, ' and storing data in it succeeds'); @@ -103,7 +103,7 @@ ok (! -f 'test-files/09/test', ' and the file is gone'); # Now try some aggressive names. $object = eval { - Wallet::Object::File->create ('file', '../foo', $dbh, @trace) + Wallet::Object::File->create ('file', '../foo', $schema, @trace) }; ok (defined ($object), 'Creating ../foo succeeds'); is ($object->store ("foo\n", @trace), 1, ' and storing data in it succeeds'); @@ -115,7 +115,7 @@ is ($object->get (@trace), "foo\n", ' and get returns correctly'); is ($object->destroy (@trace), 1, 'Destroying the object works'); ok (! -f 'test-files/39/%2E%2E%2Ffoo', ' and the file is gone'); $object = eval { - Wallet::Object::File->create ('file', "\0", $dbh, @trace) + Wallet::Object::File->create ('file', "\0", $schema, @trace) }; ok (defined ($object), 'Creating nul succeeds'); is ($object->store ("foo\n", @trace), 1, ' and storing data in it succeeds'); @@ -130,7 +130,7 @@ ok (! -f 'test-files/93/%00', ' and the file is gone'); # Test error handling in the file store. system ('rm -r test-files') == 0 or die "cannot remove test-files\n"; $object = eval { - Wallet::Object::File->create ('file', 'test', $dbh, @trace) + Wallet::Object::File->create ('file', 'test', $schema, @trace) }; ok (defined ($object), 'Recreating the object succeeds'); is ($object->store ("foo\n", @trace), undef, diff --git a/perl/t/init.t b/perl/t/init.t index 213aedf..aa028e3 100755 --- a/perl/t/init.t +++ b/perl/t/init.t @@ -24,7 +24,7 @@ is ($admin->initialize ('admin@EXAMPLE.COM'), 1, ' and initialization succeeds'); # Check whether the database entries that should be created were. -my $acl = eval { Wallet::ACL->new ('ADMIN', $admin->dbh) }; +my $acl = eval { Wallet::ACL->new ('ADMIN', $admin->schema) }; is ($@, '', 'Retrieving ADMIN ACL successful'); ok ($acl->isa ('Wallet::ACL'), ' and is the right class'); my @entries = $acl->list; @@ -38,7 +38,7 @@ is ($admin->reinitialize ('admin@EXAMPLE.ORG'), 1, 'Reinitialization succeeded'); # Now repeat the database content checks. -$acl = eval { Wallet::ACL->new ('ADMIN', $admin->dbh) }; +$acl = eval { Wallet::ACL->new ('ADMIN', $admin->schema) }; is ($@, '', 'Retrieving ADMIN ACL successful'); ok ($acl->isa ('Wallet::ACL'), ' and is the right class'); @entries = $acl->list; @@ -49,7 +49,7 @@ is ($entries[0][1], 'admin@EXAMPLE.ORG', ' with the right user'); # Test cleanup. is ($admin->destroy, 1, 'Destroying the database works'); -$acl = eval { Wallet::ACL->new ('ADMIN', $admin->dbh) }; +$acl = eval { Wallet::ACL->new ('ADMIN', $admin->schema) }; like ($@, qr/^cannot search for ACL ADMIN: /, ' and now the database is gone'); unlink 'wallet-db'; diff --git a/perl/t/keytab.t b/perl/t/keytab.t index c263f58..561f130 100755 --- a/perl/t/keytab.t +++ b/perl/t/keytab.t @@ -147,8 +147,8 @@ db_setup; my $admin = eval { Wallet::Admin->new }; is ($@, '', 'Database connection succeeded'); is ($admin->reinitialize ($user), 1, 'Database initialization succeeded'); -my $schema = $admin->dbh; -my $dbh = $schema->storage->dbh; +my $schema = $admin->schema; +my $dbh = $admin->dbh; # Use this to accumulate the history traces so that we can check history. my $history = ''; diff --git a/perl/t/object.t b/perl/t/object.t index 2d60dd2..5eb6941 100755 --- a/perl/t/object.t +++ b/perl/t/object.t @@ -30,26 +30,26 @@ db_setup; my $admin = eval { Wallet::Admin->new }; is ($@, '', 'Database connection succeeded'); is ($admin->reinitialize ($user), 1, 'Database initialization succeeded'); -my $dbh = $admin->dbh; +my $schema = $admin->schema; # Okay, now we have a database. Test create and new. We make believe this is # a keytab object; it won't matter for what we're doing. my $object = eval { - Wallet::Object::Base->create ('keytab', $princ, $dbh, @trace) + Wallet::Object::Base->create ('keytab', $princ, $schema, @trace) }; is ($@, '', 'Object creation did not die'); ok ($object->isa ('Wallet::Object::Base'), ' and returned the right class'); my $other = eval { - Wallet::Object::Base->create ('keytab', $princ, $dbh, @trace) + Wallet::Object::Base->create ('keytab', $princ, $schema, @trace) }; like ($@, qr/^cannot create object \Qkeytab:$princ: /, 'Repeating fails'); -$other = eval { Wallet::Object::Base->create ('', $princ, $dbh, @trace) }; +$other = eval { Wallet::Object::Base->create ('', $princ, $schema, @trace) }; is ($@, "invalid object type\n", 'Using an empty type fails'); -$other = eval { Wallet::Object::Base->create ('keytab', '', $dbh, @trace) }; +$other = eval { Wallet::Object::Base->create ('keytab', '', $schema, @trace) }; is ($@, "invalid object name\n", ' as does an empty name'); -$object = eval { Wallet::Object::Base->new ('keytab', "a$princ", $dbh) }; +$object = eval { Wallet::Object::Base->new ('keytab', "a$princ", $schema) }; is ($@, "cannot find keytab:a$princ\n", 'Searching for unknown object fails'); -$object = eval { Wallet::Object::Base->new ('keytab', $princ, $dbh) }; +$object = eval { Wallet::Object::Base->new ('keytab', $princ, $schema) }; is ($@, '', 'Object new did not die'); ok ($object->isa ('Wallet::Object::Base'), ' and returned the right class'); @@ -58,7 +58,7 @@ is ($object->type, 'keytab', 'Type accessor works'); is ($object->name, $princ, 'Name accessor works'); # We'll use this for later tests. -my $acl = Wallet::ACL->new ('ADMIN', $dbh); +my $acl = Wallet::ACL->new ('ADMIN', $schema); # Owner. is ($object->owner, undef, 'Owner is not set to start'); @@ -266,12 +266,12 @@ if ($object->destroy (@trace)) { } else { is ($object->error, '', 'Destroy is successful'); } -$object = eval { Wallet::Object::Base->new ('keytab', $princ, $dbh) }; +$object = eval { Wallet::Object::Base->new ('keytab', $princ, $schema) }; is ($@, "cannot find keytab:$princ\n", ' and object is all gone'); # Test history. $object = eval { - Wallet::Object::Base->create ('keytab', $princ, $dbh, @trace) + Wallet::Object::Base->create ('keytab', $princ, $schema, @trace) }; ok (defined ($object), 'Recreating the object succeeds'); $output = <<"EOO"; diff --git a/perl/t/server.t b/perl/t/server.t index 63f2e76..8474989 100755 --- a/perl/t/server.t +++ b/perl/t/server.t @@ -36,8 +36,8 @@ is ($setup->reinitialize ($admin), 1, 'Database initialization succeeded'); $server = eval { Wallet::Server->new (@trace) }; is ($@, '', 'Reopening with new did not die'); ok ($server->isa ('Wallet::Server'), ' and returned the right class'); -my $dbh = $server->dbh; -ok (defined ($dbh), ' and returns a defined database handle'); +my $schema = $server->schema; +ok (defined ($schema), ' and returns a defined schema object'); # Allow creation of base objects for testing purposes. $setup->register_object ('base', 'Wallet::Object::Base'); diff --git a/perl/t/wa-keyring.t b/perl/t/wa-keyring.t index 703b7fe..3011d54 100755 --- a/perl/t/wa-keyring.t +++ b/perl/t/wa-keyring.t @@ -40,14 +40,14 @@ db_setup; my $admin = eval { Wallet::Admin->new }; is ($@, '', 'Database connection succeeded'); is ($admin->reinitialize ($user), 1, 'Database initialization succeeded'); -my $dbh = $admin->dbh; +my $schema = $admin->schema; # Create a WebAuth context to use. my $wa = WebAuth->new; # Test error handling in the absence of configuration. my $object = eval { - Wallet::Object::WAKeyring->create ('wa-keyring', 'test', $dbh, @trace) + Wallet::Object::WAKeyring->create ('wa-keyring', 'test', $schema, @trace) }; ok (defined ($object), 'Creating a basic WebAuth keyring object succeeds'); ok ($object->isa ('Wallet::Object::WAKeyring'), ' and is the right class'); @@ -65,7 +65,7 @@ $Wallet::Config::WAKEYRING_BUCKET = 'test-keyrings'; # Okay, now we can test. First, the basic object without store. $object = eval { - Wallet::Object::WAKeyring->create ('wa-keyring', 'test', $dbh, @trace) + Wallet::Object::WAKeyring->create ('wa-keyring', 'test', $schema, @trace) }; ok (defined ($object), 'Creating a basic WebAuth keyring object succeeds'); ok ($object->isa ('Wallet::Object::WAKeyring'), ' and is the right class'); @@ -100,7 +100,7 @@ is ($object->destroy (@trace), 1, 'Destroying the object succeeds'); # Now store something and be sure that we get something reasonable. $object = eval { - Wallet::Object::WAKeyring->create ('wa-keyring', 'test', $dbh, @trace) + Wallet::Object::WAKeyring->create ('wa-keyring', 'test', $schema, @trace) }; ok (defined ($object), 'Recreating the object succeeds'); my $key = WebAuth::Key->new ($wa, WA_KEY_AES, WA_AES_128); @@ -159,7 +159,7 @@ is ($object->destroy (@trace), 1, 'Destroying the object succeeds'); # Test error handling in the file store. system ('rm -r test-keyrings') == 0 or die "cannot remove test-keyrings\n"; $object = eval { - Wallet::Object::WAKeyring->create ('wa-keyring', 'test', $dbh, @trace) + Wallet::Object::WAKeyring->create ('wa-keyring', 'test', $schema, @trace) }; ok (defined ($object), 'Recreating the object succeeds'); is ($object->get (@trace), undef, ' but retrieving it fails'); -- cgit v1.2.3 From f806961bf9e6be8e07f2e304a3aa9906add2aad6 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Sun, 3 Feb 2013 21:40:12 -0800 Subject: Add another case to the Stanford ssl-key naming convention If there are multiple SSL private keys for the same host-based CN, an application name can be added as an additional component of the name. Change-Id: I06e25359b291a77a7dbca1a7f3db84afb2b16ddd Reviewed-on: https://gerrit.stanford.edu/754 Reviewed-by: Russ Allbery Tested-by: Russ Allbery --- docs/stanford-naming | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/docs/stanford-naming b/docs/stanford-naming index f88d148..aa59f68 100644 --- a/docs/stanford-naming +++ b/docs/stanford-naming @@ -119,7 +119,7 @@ Object Naming (OLD: --ssh-) - ssl-key/ + ssl-key/[/] Stores the SSL X.509 certificate private key for . Used for Apache, Postfix, LDAP, and similar cases where the certificate @@ -130,6 +130,12 @@ Object Naming virtual hosts, for example, or because the certificate is for a load-balanced name). + An optional component may be added if there are + multiple certificates with the same host name as the CN but with + different private keys. (This may happen if, for example, + multiple services are running on the same FQDN but should have + isolated security contexts.) + Use ssl-key/starYYYY.stanford.edu for the key for the *.stanford.edu certificate, where YYYY is the expiration year. -- cgit v1.2.3 From 0753a60cc0b6f9873c6b9fe70e298bd045306466 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Sun, 3 Feb 2013 23:24:40 -0800 Subject: Add current Stanford naming policy and test suite To make it easier to revise and test revisions to the Stanford wallet naming policy, convert the code to a module and include it in the distribution. Add a test suite for the current policy. Change-Id: I73b888fa8d18401a239144c2e9f810ad4692c44b Reviewed-on: https://gerrit.stanford.edu/755 Reviewed-by: Russ Allbery Tested-by: Russ Allbery --- perl/Wallet/Policy/Stanford.pm | 237 +++++++++++++++++++++++++++++++++++++++++ perl/t/stanford-naming.t | 193 +++++++++++++++++++++++++++++++++ 2 files changed, 430 insertions(+) create mode 100644 perl/Wallet/Policy/Stanford.pm create mode 100755 perl/t/stanford-naming.t diff --git a/perl/Wallet/Policy/Stanford.pm b/perl/Wallet/Policy/Stanford.pm new file mode 100644 index 0000000..906f6ba --- /dev/null +++ b/perl/Wallet/Policy/Stanford.pm @@ -0,0 +1,237 @@ +# Wallet::Policy::Stanford -- Stanford's wallet naming and ownership policy. +# +# Written by Russ Allbery +# Copyright 2013 +# The Board of Trustees of the Leland Stanford Junior University +# +# See LICENSE for licensing terms. + +############################################################################## +# Modules and declarations +############################################################################## + +package Wallet::Policy::Stanford; + +use 5.008; +use strict; +use warnings; + +use base qw(Exporter); + +# Declare variables that should be set in BEGIN for robustness. +our (@EXPORT_OK, $VERSION); + +# Set $VERSION and everything export-related in a BEGIN block for robustness +# against circular module loading (not that we load any modules, but +# consistency is good). +BEGIN { + $VERSION = '1.00'; + @EXPORT_OK = qw(default_owner verify_name); +} + +############################################################################## +# Implementation +############################################################################## + +# Retrieve an existing ACL and check whether it contains a netdb-root member. +# This is used to check if a default ACL is already present with a netdb-root +# member so that we can return a default owner that matches. We only ever +# increase the ACL from netdb to netdb-root, never degrade it, so this doesn't +# pose a security problem. +# +# On any failure, just return an empty ACL to use the default. +sub acl_has_netdb_root { + my ($name) = @_; + my $schema = eval { Wallet::Schema->connect }; + return unless ($schema and not $@); + my $acl = eval { Wallet::ACL->new ($name, $schema) }; + return unless ($acl and not $@); + for my $line ($acl->list) { + return 1 if $line->[0] eq 'netdb-root'; + } + return; +} + +# Map a file object name to a hostname and return it. Returns undef if this +# file object name doesn't map to a hostname. +sub _host_for_file { + my ($name) = @_; + my %allowed = map { $_ => 1 } + qw(htpasswd ssh-rsa ssh-dsa ssl-key tivoli-key); + my $allowed_regex = '(?:' . join ('|', sort keys %allowed) . ')'; + if ($name !~ /^[^-]+-(.*)-$allowed_regex(?:-.*)?$/) { + return; + } + my $host = $1; + if ($host !~ /\./) { + $host .= '.stanford.edu'; + } + return $host; +} + +# Map a keytab object name to a hostname and return it. Returns undef if this +# keytab principal name doesn't map to a hostname. +sub _host_for_keytab { + my ($name) = @_; + my %allowed = map { $_ => 1 } + qw(HTTP afpserver cifs ftp host imap ipp ldap lpr nfs pop postgres + sieve smtp webauth xmpp); + return unless $name =~ m,/,; + my ($service, $host) = split ('/', $name, 2); + return unless $allowed{$service}; + if ($host !~ /\./) { + $host .= '.stanford.edu'; + } + return $host; +} + +# The default owner of host-based objects should be the host keytab and the +# NetDB ACL for that host, with one twist. If the creator of a new node is +# using a root instance, we want to require everyone managing that node be +# using root instances by default. +sub default_owner { + my ($type, $name) = @_; + my $realm = 'stanford.edu'; + my %host_for = ( + keytab => \&_host_for_keytab, + file => \&_host_for_file, + ); + return unless defined $host_for{$type}; + my $host = $host_for{$type}->($name); + return unless $host; + my $acl_name = "host/$host"; + my @acl; + if ($ENV{REMOTE_USER} =~ m,/root, or acl_has_netdb_root ($acl_name)) { + @acl = ([ 'netdb-root', $host ], + [ 'krb5', "host/$host\@$realm" ]); + } else { + @acl = ([ 'netdb', $host ], + [ 'krb5', "host/$host\@$realm" ]); + } + return ($acl_name, @acl); +} + +# Enforce a naming policy. Host-based keytabs must have fully-qualified +# hostnames, limit the acceptable characters for service/* keytabs, and +# enforce our naming constraints on */cgi principals. +# +# Also use this function to require that IDG staff always do implicit object +# creation using a */root instance. +sub verify_name { + my ($type, $name, $user) = @_; + my %host = map { $_ => 1 } + qw(HTTP afpserver cifs ftp http host ident imap ipp ldap lpr nfs pop + postgres sieve smtp uniengd webauth xmpp); + my %staff; + if (open (STAFF, '<', '/etc/remctl/acl/its-idg')) { + local $_; + while () { + s/^\s+//; + s/\s+$//; + next if m,/root\@,; + $staff{$_} = 1; + } + close STAFF; + } + + # Check for a staff member not using their root instance. + if (defined ($user) && $staff{$user}) { + return 'use a */root instance for wallet object creation'; + } + + # Check keytab naming conventions. + if ($type eq 'keytab') { + if ($name !~ m,^[a-zA-Z0-9_-]+/[a-z0-9.-]+$,) { + return "invalid principal name $name"; + } + my ($principal, $instance) + = ($name =~ m,^([a-zA-Z0-9_-]+)/([a-z0-9.-]+)$,); + unless (defined ($principal) && defined ($instance)) { + return "invalid principal name $name"; + } + if ($host{$principal} and $principal ne 'http') { + if ($instance !~ /^[a-z0-9-]+\.[a-z0-9.-]+$/) { + return "host name $instance is not fully qualified"; + } + } elsif ($principal eq 'service') { + if ($instance !~ /^[a-z0-9-]+$/) { + return "invalid service principal name $name"; + } + } elsif ($instance eq 'cgi') { + if ($principal !~ /^[a-z][a-z0-9]{1,7}$/ + and $principal !~ /^(class|dept|group)-[a-z0-9_-]+$/) { + return "invalid CGI principal name $name"; + } + } else { + return "unknown principal type $principal"; + } + } + + # Check file object naming conventions. + if ($type eq 'file') { + my %groups = map { $_ => 1 } + qw(apps crcsg gsb idg sysadmin sulair vast); + my %types = map { $_ => 1 } + qw(config db gpg-key htpasswd password properties ssh-rsa ssh-dsa + ssl-key ssl-keystore ssl-pkcs12 tivoli-key); + if ($name !~ m,^[a-zA-Z0-9_.-]+$,) { + return "invalid file object $name"; + } + my $group_regex = '(?:' . join ('|', sort keys %groups) . ')'; + my $type_regex = '(?:' . join ('|', sort keys %types) . ')'; + if ($name !~ /^$group_regex-/) { + return "no recognized owning group in $name"; + } elsif ($name !~ /^$group_regex-.*-$type_regex(-.*)?$/) { + return "invalid file object name $name"; + } + } + + # Success. + return; +} + +1; + +############################################################################## +# Documentation +############################################################################## + +=head1 NAME + +Wallet::Policy::Stanford - Stanford's wallet naming and ownership policy + +=head1 SYNOPSIS + + use Wallet::Policy::Stanford; + my ($type, $name, $user) = @_; + + my $error = valid_name($type, $name, $user); + my ($name, @acl) = default_owner($type, $name); + +=head1 DESCRIPTION + +Wallet::Policy::Stanford implements Stanford's wallet naming and ownership +policy as described in F in the wallet distribution. +It is primarily intended as an example for other sites, but it is used at +Stanford to implement that policy. + +This module provides the default_owner() and verify_name() functions that +are part of the wallet configuration interface (as documented in +L). They can be imported directly into a wallet +configuration file from this module or wrapped to apply additional rules. + +=head1 SEE ALSO + +Wallet::Config(3) + +The L +implemented by this module. + +This module is part of the wallet system. The current version is +available from L. + +=head1 AUTHOR + +Russ Allbery + +=cut diff --git a/perl/t/stanford-naming.t b/perl/t/stanford-naming.t new file mode 100755 index 0000000..ec3760a --- /dev/null +++ b/perl/t/stanford-naming.t @@ -0,0 +1,193 @@ +#!/usr/bin/perl +# +# Tests for the Stanford naming policy. +# +# The naming policy code is included primarily an example for non-Stanford +# sites, but it's used at Stanford and this test suite is used to verify +# behavior at Stanford. +# +# Written by Russ Allbery +# Copyright 2013 +# The Board of Trustees of the Leland Stanford Junior University +# +# See LICENSE for licensing terms. + +use 5.008; +use strict; +use warnings; + +use Test::More tests => 57; + +use lib 't/lib'; +use Util; + +# Load the naming policy module. +BEGIN { + use_ok('Wallet::Admin'); + use_ok('Wallet::Policy::Stanford', qw(default_owner verify_name)); + use_ok('Wallet::Server'); +} + +# Various valid keytab names. +my @VALID_KEYTABS = qw(host/example.stanford.edu HTTP/example.stanford.edu + service/example example/cgi class-example01/cgi dept-01example/cgi + group-example-01/cgi); + +# Various invalid keytab names. +my @INVALID_KEYTABS = qw(example host/example service/example.stanford.edu + thisistoolong/cgi not-valid/cgi unknown/example.stanford.edu); + +# Various valid file names. +my @VALID_FILES = qw(apps-example-config-file crcsg-example-db-s_example + idg-debian-gpg-key idg-devnull-password-root sulair-accounts-properties + idg-accounts-ssl-keystore idg-accounts-ssl-pkcs12 + crcsg-example-htpasswd-web sulair-example-password-ipmi + sulair-example-password-root sulair-example-password-tivoli + sulair-example-ssh-dsa sulair-example-ssh-rsa idg-mdm-ssl-key + idg-openafs-tivoli-key); + +# Various invalid file names. +my @INVALID_FILES = qw(unknown foo-example-ssh-rsa idg-accounts-foo !!bad); + +# Global variables for the wallet server setup. +my $ADMIN = 'admin@EXAMPLE.COM'; +my $HOST = 'localhost'; +my @TRACE = ($ADMIN, $HOST); + +# Start by testing lots of straightforward naming validity. +for my $name (@VALID_KEYTABS) { + is(verify_name('keytab', $name), undef, "Valid keytab $name"); +} +for my $name (@INVALID_KEYTABS) { + isnt(verify_name('keytab', $name), undef, "Invalid keytab $name"); +} +for my $name (@VALID_FILES) { + is(verify_name('file', $name), undef, "Valid file $name"); +} +for my $name (@INVALID_FILES) { + isnt(verify_name('file', $name), undef, "Invalid file $name"); +} + +# Now we need an actual database. Use Wallet::Admin to set it up. +db_setup; +my $setup = eval { Wallet::Admin->new }; +is($@, q{}, 'Database initialization did not die'); +is($setup->reinitialize($ADMIN), 1, 'Database initialization succeeded'); +my $server = eval { Wallet::Server->new(@TRACE) }; +is($@, q{}, 'Server creation did not die'); + +# Create a host/example.stanford.edu ACL that uses the netdb ACL type. +is($server->acl_create('host/example.stanford.edu'), 1, 'Created netdb ACL'); +is( + $server->acl_add('host/example.stanford.edu', 'netdb', + 'example.stanford.edu'), + 1, + '...with netdb ACL line' +); +is( + $server->acl_add('host/example.stanford.edu', 'krb5', + 'host/example.stanford.edu@stanford.edu'), + 1, + '...and krb5 ACL line' +); + +# Likewise for host/foo.example.edu with the netdb-root ACL type. +is($server->acl_create('host/foo.stanford.edu'), 1, 'Created netdb-root ACL'); +is( + $server->acl_add('host/foo.stanford.edu', 'netdb-root', + 'foo.stanford.edu'), + 1, + '...with netdb-root ACL line' +); +is( + $server->acl_add('host/foo.stanford.edu', 'krb5', + 'host/foo.stanford.edu@stanford.edu'), + 1, + '...and krb5 ACL line' +); + +# Now we can test default ACLs. First, without a root instance. +local $ENV{REMOTE_USER} = $ADMIN; +is_deeply( + [default_owner('keytab', 'host/bar.stanford.edu')], + [ + 'host/bar.stanford.edu', + ['netdb', 'bar.stanford.edu'], + ['krb5', 'host/bar.stanford.edu@stanford.edu'] + ], + 'Correct default owner for host-based keytab' +); +is_deeply( + [default_owner('keytab', 'HTTP/example.stanford.edu')], + [ + 'host/example.stanford.edu', + ['netdb', 'example.stanford.edu'], + ['krb5', 'host/example.stanford.edu@stanford.edu'] + ], + '...and when netdb ACL already exists' +); +is_deeply( + [default_owner('keytab', 'webauth/foo.stanford.edu')], + [ + 'host/foo.stanford.edu', + ['netdb-root', 'foo.stanford.edu'], + ['krb5', 'host/foo.stanford.edu@stanford.edu'] + ], + '...and when netdb-root ACL already exists' +); + +# Now with a root instance. +local $ENV{REMOTE_USER} = 'admin/root@stanford.edu'; +is_deeply( + [default_owner('keytab', 'host/bar.stanford.edu')], + [ + 'host/bar.stanford.edu', + ['netdb-root', 'bar.stanford.edu'], + ['krb5', 'host/bar.stanford.edu@stanford.edu'] + ], + 'Correct default owner for host-based keytab for /root' +); +is_deeply( + [default_owner('keytab', 'HTTP/example.stanford.edu')], + [ + 'host/example.stanford.edu', + ['netdb-root', 'example.stanford.edu'], + ['krb5', 'host/example.stanford.edu@stanford.edu'] + ], + '...and when netdb ACL already exists' +); +is_deeply( + [default_owner('keytab', 'webauth/foo.stanford.edu')], + [ + 'host/foo.stanford.edu', + ['netdb-root', 'foo.stanford.edu'], + ['krb5', 'host/foo.stanford.edu@stanford.edu'] + ], + '...and when netdb-root ACL already exists' +); + +# Check for a type that isn't host-based. +is(default_owner('keytab', 'service/foo'), undef, + 'No default owner for service/foo'); + +# Check for an unknown object type. +is(default_owner('unknown', 'foo'), undef, + 'No default owner for unknown type'); + +# Check for legacy autocreation mappings for file objects. +for my $type (qw(htpasswd ssh-rsa ssh-dsa ssl-key tivoli-key)) { + my $name = "idg-example-$type"; + is_deeply( + [default_owner('file', $name)], + [ + 'host/example.stanford.edu', + ['netdb-root', 'example.stanford.edu'], + ['krb5', 'host/example.stanford.edu@stanford.edu'] + ], + "Default owner for file $name", + ); +} + +# Clean up. +$setup->destroy; +unlink 'wallet-db'; -- cgit v1.2.3 From abcbf4eada033bd364d685f56e80f0bd07a3f76a Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 5 Feb 2013 18:09:49 -0800 Subject: Refactor Stanford naming policy, add new file patterns Refactor the Wallet::Policy::Stanford module to pull some of the constants out, and then add data and support in the naming policy for the new file object naming scheme. Change-Id: Iba0c24c119ce529a1d3fd8cd3332335c4433df09 Reviewed-on: https://gerrit.stanford.edu/756 Reviewed-by: Russ Allbery Tested-by: Russ Allbery --- perl/Wallet/Policy/Stanford.pm | 176 +++++++++++++++++++++++++++++++++-------- perl/t/stanford-naming.t | 35 +++++++- 2 files changed, 174 insertions(+), 37 deletions(-) diff --git a/perl/Wallet/Policy/Stanford.pm b/perl/Wallet/Policy/Stanford.pm index 906f6ba..640c43c 100644 --- a/perl/Wallet/Policy/Stanford.pm +++ b/perl/Wallet/Policy/Stanford.pm @@ -29,6 +29,59 @@ BEGIN { @EXPORT_OK = qw(default_owner verify_name); } +############################################################################## +# Configuration +############################################################################## + +# These variables are all declared as globals so that they can be overridden +# from wallet.conf if desirable. + +# The domain to append to hostnames to fully-qualify them. +our $DOMAIN = 'stanford.edu'; + +# Groups for file object naming. This default is entirely Stanford-specific, +# even more so than the rest of this file. +our @GROUPS = qw(apps crcsg gsb idg sysadmin sulair vast); + +# File object types. Each type can have one or more parameters: whether it is +# host-based (host), whether it takes a qualifier after the host or service +# (extra), and whether that qualifier is mandatory (need_extra). +our %FILE_TYPES = ( + config => { extra => 1, need_extra => 1 }, + db => { extra => 1, need_extra => 1 }, + 'gpg-key' => { }, + htpasswd => { host => 1, extra => 1, need_extra => 1 }, + password => { extra => 1, need_extra => 1 }, + 'password-ipmi' => { host => 1 }, + 'password-root' => { host => 1 }, + 'password-tivoli' => { host => 1 }, + properties => { extra => 1 }, + 'ssh-dsa' => { host => 1 }, + 'ssh-rsa' => { host => 1 }, + 'ssl-key' => { host => 1, extra => 1 }, + 'ssl-keystore' => { extra => 1 }, + 'ssl-pkcs12' => { extra => 1 }, + 'tivoli-key' => { host => 1 }, +); + +# Host-based file object types for the legacy file object naming scheme. +our @FILE_HOST_LEGACY = qw(htpasswd ssh-rsa ssh-dsa ssl-key tivoli-key); + +# File object types for the legacy file object naming scheme. +our @FILE_TYPES_LEGACY = qw(config db gpg-key htpasswd password properties + ssh-rsa ssh-dsa ssl-key ssl-keystore ssl-pkcs12 tivoli-key); + +# Host-based Kerberos principal prefixes. +our @KEYTAB_HOST = qw(HTTP afpserver cifs ftp host imap ipp ldap lpr nfs pop + postgres sieve smtp webauth xmpp); + +# The Kerberos realm, used when forming principals for krb5 ACLs. +our $REALM = 'stanford.edu'; + +# A file listing principal names that should be required to use a root +# instance to autocreate any objects. +our $ROOT_REQUIRED = '/etc/remctl/acl/its-idg'; + ############################################################################## # Implementation ############################################################################## @@ -40,7 +93,7 @@ BEGIN { # pose a security problem. # # On any failure, just return an empty ACL to use the default. -sub acl_has_netdb_root { +sub _acl_has_netdb_root { my ($name) = @_; my $schema = eval { Wallet::Schema->connect }; return unless ($schema and not $@); @@ -52,19 +105,19 @@ sub acl_has_netdb_root { return; } -# Map a file object name to a hostname and return it. Returns undef if this -# file object name doesn't map to a hostname. -sub _host_for_file { +# Map a file object name to a hostname for the legacy file object naming +# scheme and return it. Returns undef if this file object name doesn't map to +# a hostname. +sub _host_for_file_legacy { my ($name) = @_; - my %allowed = map { $_ => 1 } - qw(htpasswd ssh-rsa ssh-dsa ssl-key tivoli-key); + my %allowed = map { $_ => 1 } @FILE_HOST_LEGACY; my $allowed_regex = '(?:' . join ('|', sort keys %allowed) . ')'; if ($name !~ /^[^-]+-(.*)-$allowed_regex(?:-.*)?$/) { return; } my $host = $1; if ($host !~ /\./) { - $host .= '.stanford.edu'; + $host .= q{.} . $DOMAIN; } return $host; } @@ -73,14 +126,12 @@ sub _host_for_file { # keytab principal name doesn't map to a hostname. sub _host_for_keytab { my ($name) = @_; - my %allowed = map { $_ => 1 } - qw(HTTP afpserver cifs ftp host imap ipp ldap lpr nfs pop postgres - sieve smtp webauth xmpp); + my %allowed = map { $_ => 1 } @KEYTAB_HOST; return unless $name =~ m,/,; my ($service, $host) = split ('/', $name, 2); return unless $allowed{$service}; if ($host !~ /\./) { - $host .= '.stanford.edu'; + $host .= q{.} . $DOMAIN; } return $host; } @@ -91,22 +142,21 @@ sub _host_for_keytab { # using root instances by default. sub default_owner { my ($type, $name) = @_; - my $realm = 'stanford.edu'; my %host_for = ( keytab => \&_host_for_keytab, - file => \&_host_for_file, + file => \&_host_for_file_legacy, ); return unless defined $host_for{$type}; my $host = $host_for{$type}->($name); return unless $host; my $acl_name = "host/$host"; my @acl; - if ($ENV{REMOTE_USER} =~ m,/root, or acl_has_netdb_root ($acl_name)) { + if ($ENV{REMOTE_USER} =~ m,/root, or _acl_has_netdb_root ($acl_name)) { @acl = ([ 'netdb-root', $host ], - [ 'krb5', "host/$host\@$realm" ]); + [ 'krb5', "host/$host\@$REALM" ]); } else { @acl = ([ 'netdb', $host ], - [ 'krb5', "host/$host\@$realm" ]); + [ 'krb5', "host/$host\@$REALM" ]); } return ($acl_name, @acl); } @@ -119,11 +169,8 @@ sub default_owner { # creation using a */root instance. sub verify_name { my ($type, $name, $user) = @_; - my %host = map { $_ => 1 } - qw(HTTP afpserver cifs ftp http host ident imap ipp ldap lpr nfs pop - postgres sieve smtp uniengd webauth xmpp); my %staff; - if (open (STAFF, '<', '/etc/remctl/acl/its-idg')) { + if (open (STAFF, '<', $ROOT_REQUIRED)) { local $_; while () { s/^\s+//; @@ -141,6 +188,7 @@ sub verify_name { # Check keytab naming conventions. if ($type eq 'keytab') { + my %host = map { $_ => 1 } @KEYTAB_HOST; if ($name !~ m,^[a-zA-Z0-9_-]+/[a-z0-9.-]+$,) { return "invalid principal name $name"; } @@ -169,20 +217,80 @@ sub verify_name { # Check file object naming conventions. if ($type eq 'file') { - my %groups = map { $_ => 1 } - qw(apps crcsg gsb idg sysadmin sulair vast); - my %types = map { $_ => 1 } - qw(config db gpg-key htpasswd password properties ssh-rsa ssh-dsa - ssl-key ssl-keystore ssl-pkcs12 tivoli-key); - if ($name !~ m,^[a-zA-Z0-9_.-]+$,) { - return "invalid file object $name"; - } - my $group_regex = '(?:' . join ('|', sort keys %groups) . ')'; - my $type_regex = '(?:' . join ('|', sort keys %types) . ')'; - if ($name !~ /^$group_regex-/) { - return "no recognized owning group in $name"; - } elsif ($name !~ /^$group_regex-.*-$type_regex(-.*)?$/) { - return "invalid file object name $name"; + my %groups = map { $_ => 1 } @GROUPS; + if ($name =~ m{ / }xms) { + my @name = split('/', $name); + + # Names have between two and four components and all must be + # non-empty. + if (@name > 4) { + return "too many components in $name"; + } + if (@name < 2) { + return "too few components in $name"; + } + if (grep { $_ eq q{} } @name) { + return "empty component in $name"; + } + + # All objects start with the type. First check if this is a + # host-based type. + my $type = shift @name; + if ($FILE_TYPES{$type} && $FILE_TYPES{$type}{host}) { + my ($host, $extra) = @name; + if ($host !~ m{ [.] }xms) { + return "host name $host is not fully qualified"; + } + if (defined($extra) && !$FILE_TYPES{$type}{extra}) { + return "extraneous component at end of $name"; + } + if (!defined($extra) && $FILE_TYPES{$type}{need_extra}) { + return "missing component in $name"; + } + return; + } + + # Otherwise, the name is group-based. There be at least two + # remaining components. + if (@name < 2) { + return "too few components in $name"; + } + my ($group, $service, $extra) = @name; + + # Check the group. + if (!$groups{$group}) { + return "unknown group $group"; + } + + # Check the type. Be sure it's not host-based. + if (!$FILE_TYPES{$type}) { + return "unknown type $type"; + } + if ($FILE_TYPES{$type}{host}) { + return "bad name for host-based file type $type"; + } + + # Check the extra data. + if (defined($extra) && !$FILE_TYPES{$type}{extra}) { + return "extraneous component at end of $name"; + } + if (!defined($extra) && $FILE_TYPES{$type}{need_extra}) { + return "missing component in $name"; + } + return; + } else { + # Legacy naming scheme. + my %types = map { $_ => 1 } @FILE_TYPES_LEGACY; + if ($name !~ m,^[a-zA-Z0-9_.-]+$,) { + return "invalid file object $name"; + } + my $group_regex = '(?:' . join ('|', sort keys %groups) . ')'; + my $type_regex = '(?:' . join ('|', sort keys %types) . ')'; + if ($name !~ /^$group_regex-/) { + return "no recognized owning group in $name"; + } elsif ($name !~ /^$group_regex-.*-$type_regex(-.*)?$/) { + return "invalid file object name $name"; + } } } diff --git a/perl/t/stanford-naming.t b/perl/t/stanford-naming.t index ec3760a..2ed8014 100755 --- a/perl/t/stanford-naming.t +++ b/perl/t/stanford-naming.t @@ -16,7 +16,7 @@ use 5.008; use strict; use warnings; -use Test::More tests => 57; +use Test::More tests => 91; use lib 't/lib'; use Util; @@ -38,7 +38,28 @@ my @INVALID_KEYTABS = qw(example host/example service/example.stanford.edu thisistoolong/cgi not-valid/cgi unknown/example.stanford.edu); # Various valid file names. -my @VALID_FILES = qw(apps-example-config-file crcsg-example-db-s_example +my @VALID_FILES = qw(htpasswd/example.stanford.edu/web + password-ipmi/example.stanford.edu + password-root/example.stanford.edu + password-tivoli/example.stanford.edu + ssh-dsa/example.stanford.edu + ssh-rsa/example.stanford.edu + ssl-key/example.stanford.edu + ssl-key/example.stanford.edu/mysql + tivoli-key/example.stanford.edu + config/idg/example/foo + db/idg/example/s_foo + gpg-key/idg/debian + password/idg/example/backup + properties/idg/accounts + properties/idg/accounts/sponsorship + ssl-keystore/idg/accounts + ssl-keystore/idg/accounts/sponsorship + ssl-pkcs12/idg/accounts + ssl-pkcs12/idg/accounts/sponsorship); + +# Various valid legacy file names. +my @VALID_LEGACY_FILES = qw(apps-example-config-file crcsg-example-db-s_example idg-debian-gpg-key idg-devnull-password-root sulair-accounts-properties idg-accounts-ssl-keystore idg-accounts-ssl-pkcs12 crcsg-example-htpasswd-web sulair-example-password-ipmi @@ -47,7 +68,12 @@ my @VALID_FILES = qw(apps-example-config-file crcsg-example-db-s_example idg-openafs-tivoli-key); # Various invalid file names. -my @INVALID_FILES = qw(unknown foo-example-ssh-rsa idg-accounts-foo !!bad); +my @INVALID_FILES = qw(unknown foo-example-ssh-rsa idg-accounts-foo !!bad + htpasswd/example.stanford.edu htpasswd/example password-root/example + password-root/example.stanford.edu/foo ssh-foo/example.stanford.edu + tivoli-key/example.stanford.edu/foo tivoli-key config config/idg + config/idg/example db/idg/example password/idg/example + idg/password/example properties//accounts properties/idg/); # Global variables for the wallet server setup. my $ADMIN = 'admin@EXAMPLE.COM'; @@ -64,6 +90,9 @@ for my $name (@INVALID_KEYTABS) { for my $name (@VALID_FILES) { is(verify_name('file', $name), undef, "Valid file $name"); } +for my $name (@VALID_LEGACY_FILES) { + is(verify_name('file', $name), undef, "Valid file $name"); +} for my $name (@INVALID_FILES) { isnt(verify_name('file', $name), undef, "Invalid file $name"); } -- cgit v1.2.3 From 7001e303c51b1b18f07fb764c91b5ff67b2318f8 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 5 Feb 2013 19:01:55 -0800 Subject: Add default owner support to Stanford naming policy Add support for a default owner for host-based file objects to Wallet::Policy::Stanford. Change-Id: I1a9bf07def1356788fbd0acf9910a2e86c9e8f08 Reviewed-on: https://gerrit.stanford.edu/757 Reviewed-by: Russ Allbery Tested-by: Russ Allbery --- perl/Wallet/Policy/Stanford.pm | 18 +++++++++++++++++- perl/t/stanford-naming.t | 26 +++++++++++++++++++++++++- 2 files changed, 42 insertions(+), 2 deletions(-) diff --git a/perl/Wallet/Policy/Stanford.pm b/perl/Wallet/Policy/Stanford.pm index 640c43c..0183df8 100644 --- a/perl/Wallet/Policy/Stanford.pm +++ b/perl/Wallet/Policy/Stanford.pm @@ -122,6 +122,22 @@ sub _host_for_file_legacy { return $host; } +# Map a file object name to a hostname. Returns undef if this file object +# name doesn't map to a hostname. +sub _host_for_file { + my ($name) = @_; + + # If $name doesn't contain /, defer to the legacy naming scheme. + if ($name !~ m{ / }xms) { + return _host_for_file_legacy($name); + } + + # Parse the name and check whether this is a host-based object. + my ($type, $host) = split('/', $name); + return if !$FILE_TYPES{$type}{host}; + return $host; +} + # Map a keytab object name to a hostname and return it. Returns undef if this # keytab principal name doesn't map to a hostname. sub _host_for_keytab { @@ -144,7 +160,7 @@ sub default_owner { my ($type, $name) = @_; my %host_for = ( keytab => \&_host_for_keytab, - file => \&_host_for_file_legacy, + file => \&_host_for_file, ); return unless defined $host_for{$type}; my $host = $host_for{$type}->($name); diff --git a/perl/t/stanford-naming.t b/perl/t/stanford-naming.t index 2ed8014..909ad1e 100755 --- a/perl/t/stanford-naming.t +++ b/perl/t/stanford-naming.t @@ -16,7 +16,7 @@ use 5.008; use strict; use warnings; -use Test::More tests => 91; +use Test::More tests => 94; use lib 't/lib'; use Util; @@ -203,6 +203,30 @@ is(default_owner('keytab', 'service/foo'), undef, is(default_owner('unknown', 'foo'), undef, 'No default owner for unknown type'); +# Check for autocreation mappings for host-based file objects. +is_deeply( + [default_owner('file', 'ssl-key/example.stanford.edu')], + [ + 'host/example.stanford.edu', + ['netdb-root', 'example.stanford.edu'], + ['krb5', 'host/example.stanford.edu@stanford.edu'] + ], + 'Default owner for file ssl-key/example.stanford.edu', +); +is_deeply( + [default_owner('file', 'ssl-key/example.stanford.edu/mysql')], + [ + 'host/example.stanford.edu', + ['netdb-root', 'example.stanford.edu'], + ['krb5', 'host/example.stanford.edu@stanford.edu'] + ], + 'Default owner for file ssl-key/example.stanford.edu/mysql', +); + +# Check for a file object that isn't host-based. +is(default_owner('file', 'config/idg/example/foo'), undef, + 'No default owner for non-host-based file type'); + # Check for legacy autocreation mappings for file objects. for my $type (qw(htpasswd ssh-rsa ssh-dsa ssl-key tivoli-key)) { my $name = "idg-example-$type"; -- cgit v1.2.3 From 271896c3a9dee9108e021519e340e4547ef5ab93 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 5 Feb 2013 19:51:00 -0800 Subject: Separate legacy groups from new groups in Stanford policy Add all the new group names for the Stanford naming policy and associate them with default ACLs (not yet used). Distinguish them from the legacy group names, and use the appropriate ones for naming policy enforcement. Change-Id: I4b87ff48d34d82195245798f41afefff26efa95d Reviewed-on: https://gerrit.stanford.edu/758 Reviewed-by: Russ Allbery Tested-by: Russ Allbery --- perl/Wallet/Policy/Stanford.pm | 20 +++++++++++++++----- perl/t/stanford-naming.t | 31 ++++++++++++++++--------------- 2 files changed, 31 insertions(+), 20 deletions(-) diff --git a/perl/Wallet/Policy/Stanford.pm b/perl/Wallet/Policy/Stanford.pm index 0183df8..840f5f3 100644 --- a/perl/Wallet/Policy/Stanford.pm +++ b/perl/Wallet/Policy/Stanford.pm @@ -39,9 +39,19 @@ BEGIN { # The domain to append to hostnames to fully-qualify them. our $DOMAIN = 'stanford.edu'; -# Groups for file object naming. This default is entirely Stanford-specific, -# even more so than the rest of this file. -our @GROUPS = qw(apps crcsg gsb idg sysadmin sulair vast); +# Groups for file object naming, each mapped to the ACL to use for +# non-host-based objects owned by that group. This default is entirely +# Stanford-specific, even more so than the rest of this file. +our %GROUPS = ( + 'its-apps' => 'group/sharedapps', + 'its-crc-sg' => 'group/crcsg', + 'its-idg' => 'group/its-idg', + 'its-rc' => 'group/its-rc', + 'its-sa-core' => 'group/its-sa-core', +); + +# Legacy group names for older file objects. +our @GROUPS_LEGACY = qw(apps crcsg gsb idg sysadmin sulair vast); # File object types. Each type can have one or more parameters: whether it is # host-based (host), whether it takes a qualifier after the host or service @@ -233,7 +243,6 @@ sub verify_name { # Check file object naming conventions. if ($type eq 'file') { - my %groups = map { $_ => 1 } @GROUPS; if ($name =~ m{ / }xms) { my @name = split('/', $name); @@ -274,7 +283,7 @@ sub verify_name { my ($group, $service, $extra) = @name; # Check the group. - if (!$groups{$group}) { + if (!$GROUPS{$group}) { return "unknown group $group"; } @@ -296,6 +305,7 @@ sub verify_name { return; } else { # Legacy naming scheme. + my %groups = map { $_ => 1 } @GROUPS_LEGACY; my %types = map { $_ => 1 } @FILE_TYPES_LEGACY; if ($name !~ m,^[a-zA-Z0-9_.-]+$,) { return "invalid file object $name"; diff --git a/perl/t/stanford-naming.t b/perl/t/stanford-naming.t index 909ad1e..00c7121 100755 --- a/perl/t/stanford-naming.t +++ b/perl/t/stanford-naming.t @@ -16,7 +16,7 @@ use 5.008; use strict; use warnings; -use Test::More tests => 94; +use Test::More tests => 95; use lib 't/lib'; use Util; @@ -47,16 +47,16 @@ my @VALID_FILES = qw(htpasswd/example.stanford.edu/web ssl-key/example.stanford.edu ssl-key/example.stanford.edu/mysql tivoli-key/example.stanford.edu - config/idg/example/foo - db/idg/example/s_foo - gpg-key/idg/debian - password/idg/example/backup - properties/idg/accounts - properties/idg/accounts/sponsorship - ssl-keystore/idg/accounts - ssl-keystore/idg/accounts/sponsorship - ssl-pkcs12/idg/accounts - ssl-pkcs12/idg/accounts/sponsorship); + config/its-idg/example/foo + db/its-idg/example/s_foo + gpg-key/its-idg/debian + password/its-idg/example/backup + properties/its-idg/accounts + properties/its-idg/accounts/sponsorship + ssl-keystore/its-idg/accounts + ssl-keystore/its-idg/accounts/sponsorship + ssl-pkcs12/its-idg/accounts + ssl-pkcs12/its-idg/accounts/sponsorship); # Various valid legacy file names. my @VALID_LEGACY_FILES = qw(apps-example-config-file crcsg-example-db-s_example @@ -71,9 +71,10 @@ my @VALID_LEGACY_FILES = qw(apps-example-config-file crcsg-example-db-s_example my @INVALID_FILES = qw(unknown foo-example-ssh-rsa idg-accounts-foo !!bad htpasswd/example.stanford.edu htpasswd/example password-root/example password-root/example.stanford.edu/foo ssh-foo/example.stanford.edu - tivoli-key/example.stanford.edu/foo tivoli-key config config/idg - config/idg/example db/idg/example password/idg/example - idg/password/example properties//accounts properties/idg/); + tivoli-key/example.stanford.edu/foo tivoli-key config config/its-idg + config/its-idg/example db/its-idg/example password/its-idg/example + its-idg/password/example properties//accounts properties/its-idg/ + ssl-keystore/idg/accounts); # Global variables for the wallet server setup. my $ADMIN = 'admin@EXAMPLE.COM'; @@ -224,7 +225,7 @@ is_deeply( ); # Check for a file object that isn't host-based. -is(default_owner('file', 'config/idg/example/foo'), undef, +is(default_owner('file', 'config/its-idg/example/foo'), undef, 'No default owner for non-host-based file type'); # Check for legacy autocreation mappings for file objects. -- cgit v1.2.3 From 4948053f7fd8a19f5c645d535ea3fa96f9539f4e Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Tue, 5 Feb 2013 20:18:35 -0800 Subject: Add default owner for group-based files in Stanford policy In Wallet::Policy::Stanford, add support for setting a default owner of file objects whose names are based on a group that has an ACL mapping. Change-Id: I4f63815621d81e26ba4779d10f249cb31eef2b5e Reviewed-on: https://gerrit.stanford.edu/759 Reviewed-by: Russ Allbery Tested-by: Russ Allbery --- perl/Wallet/Policy/Stanford.pm | 94 +++++++++++++++++++++++++++++------------- perl/t/stanford-naming.t | 14 +++++-- 2 files changed, 77 insertions(+), 31 deletions(-) diff --git a/perl/Wallet/Policy/Stanford.pm b/perl/Wallet/Policy/Stanford.pm index 840f5f3..39bea33 100644 --- a/perl/Wallet/Policy/Stanford.pm +++ b/perl/Wallet/Policy/Stanford.pm @@ -42,7 +42,7 @@ our $DOMAIN = 'stanford.edu'; # Groups for file object naming, each mapped to the ACL to use for # non-host-based objects owned by that group. This default is entirely # Stanford-specific, even more so than the rest of this file. -our %GROUPS = ( +our %ACL_FOR_GROUP = ( 'its-apps' => 'group/sharedapps', 'its-crc-sg' => 'group/crcsg', 'its-idg' => 'group/its-idg', @@ -56,7 +56,7 @@ our @GROUPS_LEGACY = qw(apps crcsg gsb idg sysadmin sulair vast); # File object types. Each type can have one or more parameters: whether it is # host-based (host), whether it takes a qualifier after the host or service # (extra), and whether that qualifier is mandatory (need_extra). -our %FILE_TYPES = ( +our %FILE_TYPE = ( config => { extra => 1, need_extra => 1 }, db => { extra => 1, need_extra => 1 }, 'gpg-key' => { }, @@ -96,6 +96,21 @@ our $ROOT_REQUIRED = '/etc/remctl/acl/its-idg'; # Implementation ############################################################################## +# Retrieve an existing ACL and return its members as a list. +# +# $name - Name of the ACL to retrieve +# +# Returns: Members of the ACL as a list of pairs +# The empty list on any failure to retrieve the ACL +sub _acl_members { + my ($name) = @_; + my $schema = eval { Wallet::Schema->connect }; + return if (!$schema || $@); + my $acl = eval { Wallet::ACL->new ($name, $schema) }; + return if (!$acl || $@); + return $acl->list; +} + # Retrieve an existing ACL and check whether it contains a netdb-root member. # This is used to check if a default ACL is already present with a netdb-root # member so that we can return a default owner that matches. We only ever @@ -105,11 +120,7 @@ our $ROOT_REQUIRED = '/etc/remctl/acl/its-idg'; # On any failure, just return an empty ACL to use the default. sub _acl_has_netdb_root { my ($name) = @_; - my $schema = eval { Wallet::Schema->connect }; - return unless ($schema and not $@); - my $acl = eval { Wallet::ACL->new ($name, $schema) }; - return unless ($acl and not $@); - for my $line ($acl->list) { + for my $line (_acl_members($name)) { return 1 if $line->[0] eq 'netdb-root'; } return; @@ -144,7 +155,7 @@ sub _host_for_file { # Parse the name and check whether this is a host-based object. my ($type, $host) = split('/', $name); - return if !$FILE_TYPES{$type}{host}; + return if !$FILE_TYPE{$type}{host}; return $host; } @@ -168,23 +179,50 @@ sub _host_for_keytab { # using root instances by default. sub default_owner { my ($type, $name) = @_; + + # How to determine the host for host-based objects. my %host_for = ( keytab => \&_host_for_keytab, file => \&_host_for_file, ); - return unless defined $host_for{$type}; - my $host = $host_for{$type}->($name); - return unless $host; - my $acl_name = "host/$host"; - my @acl; - if ($ENV{REMOTE_USER} =~ m,/root, or _acl_has_netdb_root ($acl_name)) { - @acl = ([ 'netdb-root', $host ], - [ 'krb5', "host/$host\@$REALM" ]); - } else { - @acl = ([ 'netdb', $host ], - [ 'krb5', "host/$host\@$REALM" ]); + + # If we have a possible host mapping, see if we can use that. + if (defined($host_for{$type})) { + my $host = $host_for{$type}->($name); + if ($host) { + my $acl_name = "host/$host"; + my @acl; + if ($ENV{REMOTE_USER} =~ m,/root, + || _acl_has_netdb_root ($acl_name)) { + @acl = ([ 'netdb-root', $host ], + [ 'krb5', "host/$host\@$REALM" ]); + } else { + @acl = ([ 'netdb', $host ], + [ 'krb5', "host/$host\@$REALM" ]); + } + return ($acl_name, @acl); + } } - return ($acl_name, @acl); + + # We have no open if this is not a file object. + return if $type ne 'file'; + + # Parse the name of the file object only far enough to get type and group + # (if there is a group). + my ($file_type, $group) = split('/', $name); + + # Host-based file objects should be caught by the above. We certainly + # can't do anything about them here. + return if $FILE_TYPE{$file_type}{host}; + + # If we have a mapping for this group, retrieve the ACL contents. We + # would like to just return the ACL name, but wallet currently requires we + # return the whole ACL. + my $acl = $ACL_FOR_GROUP{$group}; + return if !defined($acl); + my @members = _acl_members($acl); + return if @members == 0; + return ($acl, @members); } # Enforce a naming policy. Host-based keytabs must have fully-qualified @@ -261,15 +299,15 @@ sub verify_name { # All objects start with the type. First check if this is a # host-based type. my $type = shift @name; - if ($FILE_TYPES{$type} && $FILE_TYPES{$type}{host}) { + if ($FILE_TYPE{$type} && $FILE_TYPE{$type}{host}) { my ($host, $extra) = @name; if ($host !~ m{ [.] }xms) { return "host name $host is not fully qualified"; } - if (defined($extra) && !$FILE_TYPES{$type}{extra}) { + if (defined($extra) && !$FILE_TYPE{$type}{extra}) { return "extraneous component at end of $name"; } - if (!defined($extra) && $FILE_TYPES{$type}{need_extra}) { + if (!defined($extra) && $FILE_TYPE{$type}{need_extra}) { return "missing component in $name"; } return; @@ -283,23 +321,23 @@ sub verify_name { my ($group, $service, $extra) = @name; # Check the group. - if (!$GROUPS{$group}) { + if (!$ACL_FOR_GROUP{$group}) { return "unknown group $group"; } # Check the type. Be sure it's not host-based. - if (!$FILE_TYPES{$type}) { + if (!$FILE_TYPE{$type}) { return "unknown type $type"; } - if ($FILE_TYPES{$type}{host}) { + if ($FILE_TYPE{$type}{host}) { return "bad name for host-based file type $type"; } # Check the extra data. - if (defined($extra) && !$FILE_TYPES{$type}{extra}) { + if (defined($extra) && !$FILE_TYPE{$type}{extra}) { return "extraneous component at end of $name"; } - if (!defined($extra) && $FILE_TYPES{$type}{need_extra}) { + if (!defined($extra) && $FILE_TYPE{$type}{need_extra}) { return "missing component in $name"; } return; diff --git a/perl/t/stanford-naming.t b/perl/t/stanford-naming.t index 00c7121..9473ed5 100755 --- a/perl/t/stanford-naming.t +++ b/perl/t/stanford-naming.t @@ -16,7 +16,7 @@ use 5.008; use strict; use warnings; -use Test::More tests => 95; +use Test::More tests => 97; use lib 't/lib'; use Util; @@ -136,6 +136,11 @@ is( '...and krb5 ACL line' ); +# Create a group/its-idg ACL, which will be used for autocreation of file +# objects. +is($server->acl_create('group/its-idg'), 1, 'Created group/its-idg ACL'); +is($server->acl_add('group/its-idg', 'krb5', $ADMIN), 1, '...with member'); + # Now we can test default ACLs. First, without a root instance. local $ENV{REMOTE_USER} = $ADMIN; is_deeply( @@ -225,8 +230,11 @@ is_deeply( ); # Check for a file object that isn't host-based. -is(default_owner('file', 'config/its-idg/example/foo'), undef, - 'No default owner for non-host-based file type'); +is_deeply( + [default_owner('file', 'config/its-idg/example/foo')], + ['group/its-idg', ['krb5', $ADMIN]], + 'Default owner for file config/its-idg/example/foo', +); # Check for legacy autocreation mappings for file objects. for my $type (qw(htpasswd ssh-rsa ssh-dsa ssl-key tivoli-key)) { -- cgit v1.2.3 From 3733b1537c987a42e4c3f6b30f4ccfef378e7cfc Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Wed, 13 Feb 2013 12:13:41 -0800 Subject: Add ssl-keypair to Stanford naming policy Used currently by MDM to store both the certificate and the key in the same file for convenience. Change-Id: I38901ac93fe3022c2e00f735a0f995500841d709 Reviewed-on: https://gerrit.stanford.edu/784 Reviewed-by: Russ Allbery Tested-by: Russ Allbery --- docs/stanford-naming | 10 ++++++++++ perl/Wallet/Policy/Stanford.pm | 1 + perl/t/stanford-naming.t | 4 +++- 3 files changed, 14 insertions(+), 1 deletion(-) diff --git a/docs/stanford-naming b/docs/stanford-naming index aa59f68..5207c40 100644 --- a/docs/stanford-naming +++ b/docs/stanford-naming @@ -141,6 +141,16 @@ Object Naming (OLD: --ssl-key) + ssl-keypair/[/] + + Same as ssl-key except that the signed certificate is included in + the same file as the private key. This is used for convenience + with some applications that want to have both the signed + certificate and private key in the same file. + + The meaning of and are the same as for + ssl-key. + tivoli-key/ The Tivoli password or backup encryption key for this server. diff --git a/perl/Wallet/Policy/Stanford.pm b/perl/Wallet/Policy/Stanford.pm index 39bea33..1444d51 100644 --- a/perl/Wallet/Policy/Stanford.pm +++ b/perl/Wallet/Policy/Stanford.pm @@ -69,6 +69,7 @@ our %FILE_TYPE = ( 'ssh-dsa' => { host => 1 }, 'ssh-rsa' => { host => 1 }, 'ssl-key' => { host => 1, extra => 1 }, + 'ssl-keypair' => { host => 1, extra => 1 }, 'ssl-keystore' => { extra => 1 }, 'ssl-pkcs12' => { extra => 1 }, 'tivoli-key' => { host => 1 }, diff --git a/perl/t/stanford-naming.t b/perl/t/stanford-naming.t index 9473ed5..3b9ea60 100755 --- a/perl/t/stanford-naming.t +++ b/perl/t/stanford-naming.t @@ -16,7 +16,7 @@ use 5.008; use strict; use warnings; -use Test::More tests => 97; +use Test::More tests => 99; use lib 't/lib'; use Util; @@ -46,6 +46,8 @@ my @VALID_FILES = qw(htpasswd/example.stanford.edu/web ssh-rsa/example.stanford.edu ssl-key/example.stanford.edu ssl-key/example.stanford.edu/mysql + ssl-keypair/example.stanford.edu + ssl-keypair/example.stanford.edu/mysql tivoli-key/example.stanford.edu config/its-idg/example/foo db/its-idg/example/s_foo -- cgit v1.2.3 From a03d2f7fedc1088bce90e2b921ae2aeae06fddd0 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Wed, 13 Feb 2013 12:41:27 -0800 Subject: Add spelling stopwords to new wallet Perl modules Change-Id: Id8810ff6deb991b70c2fd4587019aa245d247419 Reviewed-on: https://gerrit.stanford.edu/785 Reviewed-by: Russ Allbery Tested-by: Russ Allbery --- perl/Wallet/Policy/Stanford.pm | 3 +++ perl/Wallet/Schema.pm | 4 ++++ perl/Wallet/Schema/Result/AclScheme.pm | 3 +++ perl/Wallet/Schema/Result/Type.pm | 3 +++ 4 files changed, 13 insertions(+) diff --git a/perl/Wallet/Policy/Stanford.pm b/perl/Wallet/Policy/Stanford.pm index 1444d51..5e04b4f 100644 --- a/perl/Wallet/Policy/Stanford.pm +++ b/perl/Wallet/Policy/Stanford.pm @@ -369,6 +369,9 @@ sub verify_name { # Documentation ############################################################################## +=for stopwords +Allbery + =head1 NAME Wallet::Policy::Stanford - Stanford's wallet naming and ownership policy diff --git a/perl/Wallet/Schema.pm b/perl/Wallet/Schema.pm index cee94f7..6868876 100644 --- a/perl/Wallet/Schema.pm +++ b/perl/Wallet/Schema.pm @@ -55,6 +55,10 @@ __END__ # Documentation ############################################################################## +=for stopwords +RaiseError PrintError AutoCommit ACL verifier API APIs enums keytab backend +enctypes DBI Allbery + =head1 NAME Wallet::Schema - Database schema and connector for the wallet system diff --git a/perl/Wallet/Schema/Result/AclScheme.pm b/perl/Wallet/Schema/Result/AclScheme.pm index 96db79d..be20d49 100644 --- a/perl/Wallet/Schema/Result/AclScheme.pm +++ b/perl/Wallet/Schema/Result/AclScheme.pm @@ -6,6 +6,9 @@ use warnings; use base 'DBIx::Class::Core'; __PACKAGE__->load_components (qw//); +=for stopwords +ACL verifier APIs + =head1 NAME Wallet::Schema::Result::AclScheme diff --git a/perl/Wallet/Schema/Result/Type.pm b/perl/Wallet/Schema/Result/Type.pm index 89fb4c3..7af837b 100644 --- a/perl/Wallet/Schema/Result/Type.pm +++ b/perl/Wallet/Schema/Result/Type.pm @@ -5,6 +5,9 @@ use warnings; use base 'DBIx::Class::Core'; +=for stopwords +APIs + =head1 NAME Wallet::Schema::Result::Type -- cgit v1.2.3 From b750e56ea3f93fbc09917cacfc6b2737ef9671a7 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Wed, 13 Feb 2013 18:24:56 -0800 Subject: Set upgrade directory in Wallet::Admin In the upgrade() wrapper in Wallet::Admin, set the DDL directory in the schema before attempting an upgrade. Change-Id: I691184fc4cf416e68f300bc78f7caffc41bf94b8 Reviewed-on: https://gerrit.stanford.edu/793 Reviewed-by: Russ Allbery Tested-by: Russ Allbery --- perl/Wallet/Admin.pm | 1 + perl/t/admin.t | 2 -- 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/perl/Wallet/Admin.pm b/perl/Wallet/Admin.pm index 9fc146c..fd184a0 100644 --- a/perl/Wallet/Admin.pm +++ b/perl/Wallet/Admin.pm @@ -195,6 +195,7 @@ sub upgrade { # Perform the actual upgrade. if ($self->{schema}->get_db_version) { + $self->{schema}->upgrade_directory ($Wallet::Config::DB_DDL_DIRECTORY); eval { $self->{schema}->upgrade; }; } if ($@) { diff --git a/perl/t/admin.t b/perl/t/admin.t index ff69ee9..a11b9b2 100755 --- a/perl/t/admin.t +++ b/perl/t/admin.t @@ -63,8 +63,6 @@ $Wallet::Schema::VERSION = '0.07'; is ($admin->reinitialize ('admin@EXAMPLE.COM'), 1, ' and re-initialization succeeds'); $Wallet::Schema::VERSION = '0.08'; -my $schema = $admin->schema; -$schema->upgrade_directory ('sql/'); my $retval = $admin->upgrade; is ($retval, 1, 'Performing an upgrade succeeds'); my $dbh = $admin->dbh; -- cgit v1.2.3 From dc5d5b7d4a10cf44c356e8f920d852ef26601e1b Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Wed, 13 Feb 2013 18:25:53 -0800 Subject: Install the wallet schema during make install Install the wallet schema files generated by DBIx::Class for the various supported database engines into /usr/local/share/wallet (by default, using pkgdatadir) on make install. Set the default $DB_DDL_DIRECTORY value in Wallet::Config accordingly. Change-Id: I7ec52b171bc6aca2c3e1040c037e7cf24553231f Reviewed-on: https://gerrit.stanford.edu/794 Reviewed-by: Russ Allbery Tested-by: Russ Allbery --- Makefile.am | 13 +++++++++++-- TODO | 6 ------ perl/Wallet/Config.pm | 21 +++++++++++---------- 3 files changed, 22 insertions(+), 18 deletions(-) diff --git a/Makefile.am b/Makefile.am index 1c42b2d..0e1d99c 100644 --- a/Makefile.am +++ b/Makefile.am @@ -1,8 +1,8 @@ # Automake makefile for wallet. # # Written by Russ Allbery -# Copyright 2006, 2007, 2008, 2010 -# Board of Trustees, Leland Stanford Jr. University +# Copyright 2006, 2007, 2008, 2010, 2013 +# The Board of Trustees of the Leland Stanford Junior University # # See LICENSE for licensing terms. @@ -82,6 +82,15 @@ client_wallet_rekey_LDADD = client/libwallet.a util/libutil.a \ dist_man_MANS = client/wallet.1 client/wallet-rekey.1 server/keytab-backend.8 \ server/wallet-admin.8 server/wallet-backend.8 server/wallet-report.8 +# Install the SQL files that are used by the server code to do upgrades. +dist_pkgdata_DATA = perl/sql/Wallet-Schema-0.07-0.08-MySQL.sql \ + perl/sql/Wallet-Schema-0.07-0.08-SQLite.sql \ + perl/sql/Wallet-Schema-0.07-MySQL.sql \ + perl/sql/Wallet-Schema-0.07-SQLite.sql \ + perl/sql/Wallet-Schema-0.08-MySQL.sql \ + perl/sql/Wallet-Schema-0.08-PostgreSQL.sql \ + perl/sql/Wallet-Schema-0.08-SQLite.sql + # A set of flags for warnings. Add -O because gcc won't find some warnings # without optimization turned on. Desirable warnings that can't be turned # on due to other problems: diff --git a/TODO b/TODO index 07d7a2c..cd95736 100644 --- a/TODO +++ b/TODO @@ -183,12 +183,6 @@ Administrative Interface: but it's supposed to work directly from the classes. Double-check this. -Installation: - - * WALLET-65: Install the SQL files and set a default value for - $DB_DDL_DIRECTORY. Document this in the installation instructions. - Test for the validity of that variable before doing upgrades? - Documentation: * WALLET-43: Write a conventions document for ACL naming, object naming, diff --git a/perl/Wallet/Config.pm b/perl/Wallet/Config.pm index 98dae03..9649c6c 100644 --- a/perl/Wallet/Config.pm +++ b/perl/Wallet/Config.pm @@ -84,6 +84,17 @@ file. =over 4 +=item DB_DDL_DIRECTORY + +Specifies the directory used to dump the database schema in formats for +each possible database server. This also includes diffs between schema +versions, for upgrades. The default value is F, +which matches the default installation location. + +=cut + +our $DB_DDL_DIRECTORY = '/usr/local/share/wallet'; + =item DB_DRIVER Sets the Perl database driver to use for the wallet database. Common @@ -167,16 +178,6 @@ backends, particularly SQLite, do not need this. our $DB_PASSWORD; -=item DB_DDL_DIRECTORY - -Specifies the directory used to dump the database schema in formats for -each possible database server. This also includes diffs between schema -versions, for upgrades. - -=cut - -our $DB_DDL_DIRECTORY; - =back =head1 FILE OBJECT CONFIGURATION -- cgit v1.2.3 From a43b3ebfc2f48079a4c4f20132567e6b0f30028c Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Wed, 13 Feb 2013 18:27:37 -0800 Subject: Don't separately warn on upgrade in Wallet::Admin The wallet-admin wrapper script will already pass any errors to die, so don't separately warn. Change-Id: Id5b27c5f9eaba8cf2d45ef058aaaa93e50f9cab5 Reviewed-on: https://gerrit.stanford.edu/795 Reviewed-by: Russ Allbery Tested-by: Russ Allbery --- perl/Wallet/Admin.pm | 1 - 1 file changed, 1 deletion(-) diff --git a/perl/Wallet/Admin.pm b/perl/Wallet/Admin.pm index fd184a0..97a2c15 100644 --- a/perl/Wallet/Admin.pm +++ b/perl/Wallet/Admin.pm @@ -200,7 +200,6 @@ sub upgrade { } if ($@) { $self->error ($@); - warn $@; return; } -- cgit v1.2.3 From 027ed879d1697b04939547585ff3838b300154e1 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Fri, 22 Feb 2013 20:29:28 -0800 Subject: Fix NAME sections of new Wallet::Schema::Result::* classes Change-Id: I8aa2d9232a3f15d424eafbda69b6e065824e62b8 --- perl/Wallet/Schema/Result/Acl.pm | 2 +- perl/Wallet/Schema/Result/AclEntry.pm | 2 +- perl/Wallet/Schema/Result/AclHistory.pm | 2 +- perl/Wallet/Schema/Result/AclScheme.pm | 2 +- perl/Wallet/Schema/Result/Enctype.pm | 5 ++++- perl/Wallet/Schema/Result/Flag.pm | 2 +- perl/Wallet/Schema/Result/KeytabEnctype.pm | 2 +- perl/Wallet/Schema/Result/KeytabSync.pm | 2 +- perl/Wallet/Schema/Result/Object.pm | 2 +- perl/Wallet/Schema/Result/ObjectHistory.pm | 2 +- perl/Wallet/Schema/Result/SyncTarget.pm | 2 +- perl/Wallet/Schema/Result/Type.pm | 2 +- 12 files changed, 15 insertions(+), 12 deletions(-) diff --git a/perl/Wallet/Schema/Result/Acl.pm b/perl/Wallet/Schema/Result/Acl.pm index 60a357b..07956b7 100644 --- a/perl/Wallet/Schema/Result/Acl.pm +++ b/perl/Wallet/Schema/Result/Acl.pm @@ -7,7 +7,7 @@ use base 'DBIx::Class::Core'; =head1 NAME -Wallet::Schema::Result::Acl +Wallet::Schema::Result::Acl - Wallet schema for an ACL =head1 DESCRIPTION diff --git a/perl/Wallet/Schema/Result/AclEntry.pm b/perl/Wallet/Schema/Result/AclEntry.pm index 99105a0..2a7aad3 100644 --- a/perl/Wallet/Schema/Result/AclEntry.pm +++ b/perl/Wallet/Schema/Result/AclEntry.pm @@ -7,7 +7,7 @@ use base 'DBIx::Class::Core'; =head1 NAME -Wallet::Schema::Result::AclEntry +Wallet::Schema::Result::AclEntry - Wallet schema for an entry in an ACL =head1 DESCRIPTION diff --git a/perl/Wallet/Schema/Result/AclHistory.pm b/perl/Wallet/Schema/Result/AclHistory.pm index 2ad56ff..fd372e2 100644 --- a/perl/Wallet/Schema/Result/AclHistory.pm +++ b/perl/Wallet/Schema/Result/AclHistory.pm @@ -9,7 +9,7 @@ __PACKAGE__->load_components("InflateColumn::DateTime"); =head1 NAME -Wallet::Schema::Result::AclHistory +Wallet::Schema::Result::AclHistory - Wallet schema for ACL history =head1 DESCRIPTION diff --git a/perl/Wallet/Schema/Result/AclScheme.pm b/perl/Wallet/Schema/Result/AclScheme.pm index be20d49..8f76530 100644 --- a/perl/Wallet/Schema/Result/AclScheme.pm +++ b/perl/Wallet/Schema/Result/AclScheme.pm @@ -11,7 +11,7 @@ ACL verifier APIs =head1 NAME -Wallet::Schema::Result::AclScheme +Wallet::Schema::Result::AclScheme - Wallet schema for ACL scheme =head1 DESCRIPTION diff --git a/perl/Wallet/Schema/Result/Enctype.pm b/perl/Wallet/Schema/Result/Enctype.pm index be41b84..ca54de5 100644 --- a/perl/Wallet/Schema/Result/Enctype.pm +++ b/perl/Wallet/Schema/Result/Enctype.pm @@ -5,9 +5,12 @@ use warnings; use base 'DBIx::Class::Core'; +=for stopwords +Kerberos + =head1 NAME -Wallet::Schema::Result::Enctype +Wallet::Schema::Result::Enctype - Wallet schema for Kerberos encryption type =head1 DESCRIPTION diff --git a/perl/Wallet/Schema/Result/Flag.pm b/perl/Wallet/Schema/Result/Flag.pm index b38e85f..9b98da9 100644 --- a/perl/Wallet/Schema/Result/Flag.pm +++ b/perl/Wallet/Schema/Result/Flag.pm @@ -7,7 +7,7 @@ use base 'DBIx::Class::Core'; =head1 NAME -Wallet::Schema::Result::Flag +Wallet::Schema::Result::Flag - Wallet schema for object flags =head1 DESCRIPTION diff --git a/perl/Wallet/Schema/Result/KeytabEnctype.pm b/perl/Wallet/Schema/Result/KeytabEnctype.pm index ae40c52..9626d49 100644 --- a/perl/Wallet/Schema/Result/KeytabEnctype.pm +++ b/perl/Wallet/Schema/Result/KeytabEnctype.pm @@ -7,7 +7,7 @@ use base 'DBIx::Class::Core'; =head1 NAME -Wallet::Schema::Result::KeytabEnctype +Wallet::Schema::Result::KeytabEnctype - Wallet schema for keytab enctype =head1 DESCRIPTION diff --git a/perl/Wallet/Schema/Result/KeytabSync.pm b/perl/Wallet/Schema/Result/KeytabSync.pm index 92ab6b8..828c6f0 100644 --- a/perl/Wallet/Schema/Result/KeytabSync.pm +++ b/perl/Wallet/Schema/Result/KeytabSync.pm @@ -7,7 +7,7 @@ use base 'DBIx::Class::Core'; =head1 NAME -Wallet::Schema::Result::KeytabSync +Wallet::Schema::Result::KeytabSync - Wallet schema for keytab synchronization =head1 DESCRIPTION diff --git a/perl/Wallet/Schema/Result/Object.pm b/perl/Wallet/Schema/Result/Object.pm index 17c51e2..7f59d27 100644 --- a/perl/Wallet/Schema/Result/Object.pm +++ b/perl/Wallet/Schema/Result/Object.pm @@ -9,7 +9,7 @@ __PACKAGE__->load_components("InflateColumn::DateTime"); =head1 NAME -Wallet::Schema::Result::Object +Wallet::Schema::Result::Object - Wallet schema for an object =head1 DESCRIPTION diff --git a/perl/Wallet/Schema/Result/ObjectHistory.pm b/perl/Wallet/Schema/Result/ObjectHistory.pm index 067712f..df0a7df 100644 --- a/perl/Wallet/Schema/Result/ObjectHistory.pm +++ b/perl/Wallet/Schema/Result/ObjectHistory.pm @@ -9,7 +9,7 @@ __PACKAGE__->load_components("InflateColumn::DateTime"); =head1 NAME -Wallet::Schema::Result::ObjectHistory +Wallet::Schema::Result::ObjectHistory - Wallet schema for object history =head1 DESCRIPTION diff --git a/perl/Wallet/Schema/Result/SyncTarget.pm b/perl/Wallet/Schema/Result/SyncTarget.pm index 17f4320..27174f5 100644 --- a/perl/Wallet/Schema/Result/SyncTarget.pm +++ b/perl/Wallet/Schema/Result/SyncTarget.pm @@ -7,7 +7,7 @@ use base 'DBIx::Class::Core'; =head1 NAME -Wallet::Schema::Result::SyncTarget +Wallet::Schema::Result::SyncTarget - Wallet schema for synchronization targets =head1 DESCRIPTION diff --git a/perl/Wallet/Schema/Result/Type.pm b/perl/Wallet/Schema/Result/Type.pm index 7af837b..5b2e1d0 100644 --- a/perl/Wallet/Schema/Result/Type.pm +++ b/perl/Wallet/Schema/Result/Type.pm @@ -10,7 +10,7 @@ APIs =head1 NAME -Wallet::Schema::Result::Type +Wallet::Schema::Result::Type - Wallet schema for object types =head1 DESCRIPTION -- cgit v1.2.3 From 2a937e1145d3226ced41c2397339c03b1191573e Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Wed, 27 Feb 2013 13:50:35 -0800 Subject: Add stopwords for POD documentation of contrib/* scripts Change-Id: I850cb07c344757362f09a3c2d88adc5b8154d7d7 Reviewed-on: https://gerrit.stanford.edu/838 Reviewed-by: Russ Allbery Tested-by: Russ Allbery --- contrib/used-principals | 3 +++ contrib/wallet-contacts | 3 +++ contrib/wallet-summary | 3 +++ contrib/wallet-unknown-hosts | 5 ++++- 4 files changed, 13 insertions(+), 1 deletion(-) diff --git a/contrib/used-principals b/contrib/used-principals index c4a6c07..aa838fe 100755 --- a/contrib/used-principals +++ b/contrib/used-principals @@ -106,6 +106,9 @@ __END__ # Documentation ############################################################################## +=for stopwords +KDC bzip2 + =head1 NAME used-principals - Report which Kerberos v5 principals are in use diff --git a/contrib/wallet-contacts b/contrib/wallet-contacts index a7bccf3..177fc76 100755 --- a/contrib/wallet-contacts +++ b/contrib/wallet-contacts @@ -135,6 +135,9 @@ print join ("\n", @email, ''); # Documentation ############################################################################## +=for stopwords +ACL NetDB SQL hostname lookup swhois whois + =head1 NAME wallet-contacts - Report contact addresses for matching wallet objects diff --git a/contrib/wallet-summary b/contrib/wallet-summary index b782a97..aba8406 100755 --- a/contrib/wallet-summary +++ b/contrib/wallet-summary @@ -174,6 +174,9 @@ close REPORT; # Documentation ############################################################################## +=for stopwords +-hm keytab keytabs + =head1 NAME wallet-summary - Report on keytabs in the wallet database diff --git a/contrib/wallet-unknown-hosts b/contrib/wallet-unknown-hosts index 29efb96..da972b2 100755 --- a/contrib/wallet-unknown-hosts +++ b/contrib/wallet-unknown-hosts @@ -187,6 +187,9 @@ if ($command eq 'check') { # Documentation ############################################################################## +=for stopwords +ACL API CNAME DNS IP env keytab keytabs timestamp + =head1 NAME wallet-unknown-hosts - Report host keytabs in wallet for unknown hosts @@ -236,7 +239,7 @@ those thresholds. When run with the C argument, B will build a list of keytab objects the same as with the C argument, using the -same additioanl arguments, but rather than printing them out will instead +same additional arguments, but rather than printing them out will instead delete them from the wallet database. To run C, the environment variable REMOTE_USER must be set to a principal that's a member of the C ACL. -- cgit v1.2.3 From 54715c37f1649b88d52806e1ad4b30e32c6f816e Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Wed, 27 Feb 2013 14:21:22 -0800 Subject: Add stopwords for new Wallet::Schema classes Change-Id: I48984226f67ded5539f6bc8c8cd88cfa770be775 Reviewed-on: https://gerrit.stanford.edu/839 Reviewed-by: Russ Allbery Tested-by: Russ Allbery --- perl/Wallet/Schema/Result/Acl.pm | 3 +++ perl/Wallet/Schema/Result/AclEntry.pm | 3 +++ perl/Wallet/Schema/Result/AclHistory.pm | 3 +++ perl/Wallet/Schema/Result/KeytabEnctype.pm | 3 +++ perl/Wallet/Schema/Result/KeytabSync.pm | 3 +++ 5 files changed, 15 insertions(+) diff --git a/perl/Wallet/Schema/Result/Acl.pm b/perl/Wallet/Schema/Result/Acl.pm index 07956b7..7fe395b 100644 --- a/perl/Wallet/Schema/Result/Acl.pm +++ b/perl/Wallet/Schema/Result/Acl.pm @@ -5,6 +5,9 @@ use warnings; use base 'DBIx::Class::Core'; +=for stopwords +ACL + =head1 NAME Wallet::Schema::Result::Acl - Wallet schema for an ACL diff --git a/perl/Wallet/Schema/Result/AclEntry.pm b/perl/Wallet/Schema/Result/AclEntry.pm index 2a7aad3..a5ae5fa 100644 --- a/perl/Wallet/Schema/Result/AclEntry.pm +++ b/perl/Wallet/Schema/Result/AclEntry.pm @@ -5,6 +5,9 @@ use warnings; use base 'DBIx::Class::Core'; +=for stopwords +ACL + =head1 NAME Wallet::Schema::Result::AclEntry - Wallet schema for an entry in an ACL diff --git a/perl/Wallet/Schema/Result/AclHistory.pm b/perl/Wallet/Schema/Result/AclHistory.pm index fd372e2..cc3978b 100644 --- a/perl/Wallet/Schema/Result/AclHistory.pm +++ b/perl/Wallet/Schema/Result/AclHistory.pm @@ -7,6 +7,9 @@ use base 'DBIx::Class::Core'; __PACKAGE__->load_components("InflateColumn::DateTime"); +=for stopwords +ACL + =head1 NAME Wallet::Schema::Result::AclHistory - Wallet schema for ACL history diff --git a/perl/Wallet/Schema/Result/KeytabEnctype.pm b/perl/Wallet/Schema/Result/KeytabEnctype.pm index 9626d49..3de620f 100644 --- a/perl/Wallet/Schema/Result/KeytabEnctype.pm +++ b/perl/Wallet/Schema/Result/KeytabEnctype.pm @@ -5,6 +5,9 @@ use warnings; use base 'DBIx::Class::Core'; +=for stopwords +keytab enctype + =head1 NAME Wallet::Schema::Result::KeytabEnctype - Wallet schema for keytab enctype diff --git a/perl/Wallet/Schema/Result/KeytabSync.pm b/perl/Wallet/Schema/Result/KeytabSync.pm index 828c6f0..77ee23d 100644 --- a/perl/Wallet/Schema/Result/KeytabSync.pm +++ b/perl/Wallet/Schema/Result/KeytabSync.pm @@ -5,6 +5,9 @@ use warnings; use base 'DBIx::Class::Core'; +=for stopwords +keytab + =head1 NAME Wallet::Schema::Result::KeytabSync - Wallet schema for keytab synchronization -- cgit v1.2.3 From 7a572127a7305a17bf84c26e66e65ab37f66b77d Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Wed, 27 Feb 2013 14:21:48 -0800 Subject: Check for errors when renaming new keytab When linking the temporary keytab to its final file name, wallet wasn't checking for errors. Caught by the new gcc warnings. Change-Id: Ia75b231754bafc800e9e521345b85da256c95ed1 Reviewed-on: https://gerrit.stanford.edu/840 Reviewed-by: Russ Allbery Tested-by: Russ Allbery --- client/keytab.c | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/client/keytab.c b/client/keytab.c index 9a7734e..6614c4b 100644 --- a/client/keytab.c +++ b/client/keytab.c @@ -252,9 +252,11 @@ rekey_keytab(struct remctl *r, krb5_context ctx, const char *type, * keys. If there is an error, first make a backup of the current keytab * file as keytab.old. */ - if (access(file, F_OK) != 0) - link(tempfile, file); - else { + if (access(file, F_OK) != 0) { + if (link(tempfile, file) < 0) + sysdie("rename of temporary keytab %s to %s failed", tempfile, + file); + } else { if (error) { data = read_file(file, &length); backupfile = concat(file, ".old", (char *) 0); -- cgit v1.2.3 From 234e3805c524a7432caed8be328df6e2fbfe9afb Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Wed, 27 Feb 2013 14:25:37 -0800 Subject: Update to rra-c-util 4.8 and C TAP Harness 1.12 Update to rra-c-util 4.8: * Look for krb5-config in /usr/kerberos/bin after the user's PATH. * Kerberos library probing fixes without transitive shared libraries. * Fix Autoconf warnings when probing for AIX's bundled Kerberos. * Avoid using krb5-config if --with-{krb5,gssapi}-{include,lib} given. * Correctly remove -I/usr/include from Kerberos and GSS-API flags. * Build on systems where krb5/krb5.h exists but krb5.h does not. * Pass --deps to krb5-config unless --enable-reduced-depends was used. * Do not use krb5-config results unless gssapi is supported. * Fix probing for Heimdal's libroken to work with older versions. * Update warning flags for GCC 4.6.1. * Update utility library and test suite for newer GCC warnings. * Fix broken GCC attribute markers causing compilation problems. * Suppress warnings on compilers that support gcc's __attribute__. * Add notices to all files copied over from rra-c-util. * Fix warnings when reporting memory allocation failure in messages.c. * Fix message utility library compiler warnings on 64-bit systems. * Include strings.h for additional POSIX functions where found. * Use an atexit handler to clean up after Kerberos tests. * Kerberos test configuration now goes in tests/config. * The principal of the test keytab is determined automatically. * Simplify the test suite calls for Kerberos and remctl tests. * Check for a missing ssize_t. * Improve the xstrndup utility function. * Checked asprintf variants are now void functions and cannot fail. * Fix use of long long in portable/mkstemp.c. * Fix test suite portability to Solaris. * Substantial improvements to the POD syntax and spelling checks. Update to C TAP Harness 1.12: * Fix compliation of runtests with more aggressive warnings. * Add a more complete usage message and a -h command-line flag. * Flush stderr before printing output from tests. * Better handle running shell tests without BUILD and SOURCE set. * Fix runtests to honor -s even if BUILD and -b aren't given. * runtests now frees all allocated resources on exit. * Only use feature-test macros when requested or built with gcc -ansi. * Drop is_double from the C TAP library to avoid requiring -lm. * Avoid using local in the shell libtap.sh library. * Suppress warnings on compilers that support gcc's __attribute__. Change-Id: I394294d5486ac1ce265c7713bec71a148aaaf1ce Reviewed-on: https://gerrit.stanford.edu/841 Reviewed-by: Russ Allbery Tested-by: Russ Allbery --- .gitignore | 8 +- Makefile.am | 20 +- NEWS | 43 ++++ README | 2 +- configure.ac | 35 +-- m4/gssapi.m4 | 114 +++++--- m4/krb5-config.m4 | 101 ++++++++ m4/krb5.m4 | 206 +++++++++------ m4/lib-depends.m4 | 9 +- m4/lib-pathname.m4 | 10 +- m4/remctl.m4 | 94 +++++-- m4/snprintf.m4 | 9 +- m4/vamacros.m4 | 9 +- portable/asprintf.c | 12 +- portable/dummy.c | 12 +- portable/krb5-extra.c | 12 +- portable/krb5.h | 20 +- portable/macros.h | 35 ++- portable/mkstemp.c | 14 +- portable/setenv.c | 19 +- portable/snprintf.c | 3 + portable/stdbool.h | 20 +- portable/strlcat.c | 12 +- portable/strlcpy.c | 12 +- portable/system.h | 75 ++++-- portable/uio.h | 12 +- tests/client/full-t.in | 8 +- tests/client/prompt-t.in | 12 +- tests/config/README | 24 ++ tests/data/perl.conf | 6 + tests/docs/pod-spelling-t | 108 +++----- tests/docs/pod-t | 52 +++- tests/portable/asprintf-t.c | 13 +- tests/portable/mkstemp-t.c | 13 +- tests/portable/setenv-t.c | 16 +- tests/portable/snprintf-t.c | 18 +- tests/portable/strlcat-t.c | 16 +- tests/portable/strlcpy-t.c | 16 +- tests/runtests.c | 165 ++++++++---- tests/tap/basic.c | 239 +++++++++++++---- tests/tap/basic.h | 81 +++--- tests/tap/kerberos.c | 499 ++++++++++++++++++++++++++++++------ tests/tap/kerberos.h | 115 ++++++++- tests/tap/kerberos.sh | 64 +++-- tests/tap/libtap.sh | 192 +++++++++----- tests/tap/macros.h | 88 +++++++ tests/tap/messages.c | 49 ++-- tests/tap/messages.h | 30 ++- tests/tap/perl/Test/RRA.pm | 222 ++++++++++++++++ tests/tap/perl/Test/RRA/Automake.pm | 362 ++++++++++++++++++++++++++ tests/tap/perl/Test/RRA/Config.pm | 200 +++++++++++++++ tests/tap/process.c | 125 +++++++-- tests/tap/process.h | 52 +++- tests/tap/remctl.sh | 61 +++-- tests/tap/string.c | 65 +++++ tests/tap/string.h | 49 ++++ tests/util/messages-krb5-t.c | 41 ++- tests/util/messages-t.c | 126 +++++---- tests/util/xmalloc-t | 130 ++++++---- tests/util/xmalloc.c | 72 ++++-- util/macros.h | 21 +- util/messages-krb5.c | 50 +++- util/messages-krb5.h | 23 +- util/messages.c | 26 +- util/messages.h | 37 ++- util/xmalloc.c | 62 +++-- util/xmalloc.h | 27 +- 67 files changed, 3603 insertions(+), 890 deletions(-) create mode 100644 m4/krb5-config.m4 create mode 100644 tests/config/README create mode 100644 tests/data/perl.conf create mode 100644 tests/tap/macros.h create mode 100644 tests/tap/perl/Test/RRA.pm create mode 100644 tests/tap/perl/Test/RRA/Automake.pm create mode 100644 tests/tap/perl/Test/RRA/Config.pm create mode 100644 tests/tap/string.c create mode 100644 tests/tap/string.h diff --git a/.gitignore b/.gitignore index d5ae8a0..23ffe53 100644 --- a/.gitignore +++ b/.gitignore @@ -22,11 +22,9 @@ /tests/client/full-t /tests/client/prompt-t /tests/client/rekey-t -/tests/data/.placeholder -/tests/data/test.keytab -/tests/data/test.password -/tests/data/test.principal -/tests/data/test.krbtype +/tests/config/keytab +/tests/config/password +/tests/config/principal /tests/portable/asprintf-t /tests/portable/mkstemp-t /tests/portable/setenv-t diff --git a/Makefile.am b/Makefile.am index 0e1d99c..772a71e 100644 --- a/Makefile.am +++ b/Makefile.am @@ -26,7 +26,6 @@ PERL_FILES = perl/Wallet/ACL.pm perl/Wallet/ACL/Base.pm \ perl/t/schema.t perl/t/server.t perl/t/verifier-netdb.t \ perl/t/verifier.t -AUTOMAKE_OPTIONS = foreign subdir-objects ACLOCAL_AMFLAGS = -I m4 EXTRA_DIST = .gitignore LICENSE autogen client/wallet.pod \ client/wallet-rekey.pod config/allow-extract config/keytab \ @@ -97,18 +96,22 @@ dist_pkgdata_DATA = perl/sql/Wallet-Schema-0.07-0.08-MySQL.sql \ # # -Wconversion http://bugs.debian.org/488884 (htons warnings) # -# Last checked against gcc 4.4 (2010-08-15). -WARNINGS = -g -O -Wall -Wextra -Wendif-labels -Wformat=2 -Winit-self \ - -Wswitch-enum -Wdeclaration-after-statement -Wshadow -Wpointer-arith \ - -Wbad-function-cast -Wwrite-strings -Wstrict-prototypes \ - -Wmissing-prototypes -Wnested-externs -Werror +# Last checked against gcc 4.6.1 (2011-05-04). -D_FORTIFY_SOURCE=2 enables +# warn_unused_result attribute markings on glibc functions on Linux, which +# catches a few more issues. +WARNINGS = -g -O -D_FORTIFY_SOURCE=2 -Wall -Wextra -Wendif-labels \ + -Wformat=2 -Winit-self -Wswitch-enum -Wdeclaration-after-statement \ + -Wshadow -Wpointer-arith -Wbad-function-cast -Wcast-align \ + -Wwrite-strings -Wjump-misses-init -Wlogical-op \ + -Wstrict-prototypes -Wmissing-prototypes -Wredundant-decls \ + -Wnested-externs -Werror warnings: $(MAKE) V=0 CFLAGS='$(WARNINGS)' $(MAKE) V=0 CFLAGS='$(WARNINGS)' $(check_PROGRAMS) # Remove some additional files. -DISTCLEANFILES = perl/Makefile tests/data/.placeholder +DISTCLEANFILES = perl/Makefile MAINTAINERCLEANFILES = Makefile.in aclocal.m4 build-aux/compile \ build-aux/depcomp build-aux/install-sh build-aux/missing \ client/wallet.1 config.h.in config.h.in~ configure \ @@ -163,7 +166,8 @@ check_LIBRARIES = tests/tap/libtap.a tests_tap_libtap_a_CPPFLAGS = -I$(abs_top_srcdir)/tests $(KRB5_CPPFLAGS) tests_tap_libtap_a_SOURCES = tests/tap/basic.c tests/tap/basic.h \ tests/tap/kerberos.c tests/tap/kerberos.h tests/tap/messages.c \ - tests/tap/messages.h tests/tap/process.c tests/tap/process.h + tests/tap/messages.h tests/tap/process.c tests/tap/process.h \ + tests/tap/string.c tests/tap/string.h # All of the test programs. tests_portable_asprintf_t_SOURCES = tests/portable/asprintf-t.c \ diff --git a/NEWS b/NEWS index b948d91..0d98220 100644 --- a/NEWS +++ b/NEWS @@ -27,6 +27,49 @@ wallet 1.0 (unreleased) Add docs/objects-and-schemes, which provides a brief summary of the current supported object types and ACL schemes. + Update to rra-c-util 4.8: + + * Look for krb5-config in /usr/kerberos/bin after the user's PATH. + * Kerberos library probing fixes without transitive shared libraries. + * Fix Autoconf warnings when probing for AIX's bundled Kerberos. + * Avoid using krb5-config if --with-{krb5,gssapi}-{include,lib} given. + * Correctly remove -I/usr/include from Kerberos and GSS-API flags. + * Build on systems where krb5/krb5.h exists but krb5.h does not. + * Pass --deps to krb5-config unless --enable-reduced-depends was used. + * Do not use krb5-config results unless gssapi is supported. + * Fix probing for Heimdal's libroken to work with older versions. + * Update warning flags for GCC 4.6.1. + * Update utility library and test suite for newer GCC warnings. + * Fix broken GCC attribute markers causing compilation problems. + * Suppress warnings on compilers that support gcc's __attribute__. + * Add notices to all files copied over from rra-c-util. + * Fix warnings when reporting memory allocation failure in messages.c. + * Fix message utility library compiler warnings on 64-bit systems. + * Include strings.h for additional POSIX functions where found. + * Use an atexit handler to clean up after Kerberos tests. + * Kerberos test configuration now goes in tests/config. + * The principal of the test keytab is determined automatically. + * Simplify the test suite calls for Kerberos and remctl tests. + * Check for a missing ssize_t. + * Improve the xstrndup utility function. + * Checked asprintf variants are now void functions and cannot fail. + * Fix use of long long in portable/mkstemp.c. + * Fix test suite portability to Solaris. + * Substantial improvements to the POD syntax and spelling checks. + + Update to C TAP Harness 1.12: + + * Fix compliation of runtests with more aggressive warnings. + * Add a more complete usage message and a -h command-line flag. + * Flush stderr before printing output from tests. + * Better handle running shell tests without BUILD and SOURCE set. + * Fix runtests to honor -s even if BUILD and -b aren't given. + * runtests now frees all allocated resources on exit. + * Only use feature-test macros when requested or built with gcc -ansi. + * Drop is_double from the C TAP library to avoid requiring -lm. + * Avoid using local in the shell libtap.sh library. + * Suppress warnings on compilers that support gcc's __attribute__. + wallet 0.12 (2010-08-25) New client program wallet-rekey that, given a list of keytabs on the diff --git a/README b/README index c440b8c..b714098 100644 --- a/README +++ b/README @@ -223,7 +223,7 @@ TESTING support in the server, however, you will need to do some preparatory work before running the test suite. Review the files: - tests/data/README + tests/config/README perl/t/data/README and follow the instructions in those files to enable the full test diff --git a/configure.ac b/configure.ac index ffd7eeb..a79e42d 100644 --- a/configure.ac +++ b/configure.ac @@ -13,7 +13,8 @@ AC_INIT([wallet], [0.12], [rra@stanford.edu]) AC_CONFIG_AUX_DIR([build-aux]) AC_CONFIG_LIBOBJ_DIR([portable]) AC_CONFIG_MACRO_DIR([m4]) -AM_INIT_AUTOMAKE([1.11 check-news silent-rules]) +AM_INIT_AUTOMAKE([1.11 check-news dist-xz foreign silent-rules subdir-objects + -Wall -Wno-override -Werror]) AM_MAINTAINER_MODE AC_PROG_CC @@ -22,6 +23,18 @@ AM_PROG_CC_C_O AC_PROG_INSTALL AC_PROG_RANLIB +AC_ARG_WITH([wallet-server], + [AC_HELP_STRING([--with-wallet-server=HOST], [Default wallet server])], + [AS_IF([test x"$withval" != xno && test x"$withval" != xyes], + [AC_DEFINE_UNQUOTED([WALLET_SERVER], ["$withval"], + [Define to the default server host name.])])]) +AC_ARG_WITH([wallet-port], + [AC_HELP_STRING([--with-wallet-port=PORT], + [Default wallet server port])], + [AS_IF([test x"$withval" != xno && test x"$withval" != xyes], + [AC_DEFINE_UNQUOTED([WALLET_PORT], [$withval], + [Define to the default server port.])])]) + RRA_LIB_REMCTL RRA_LIB_KRB5 RRA_LIB_KRB5_SWITCH @@ -30,8 +43,9 @@ AC_CHECK_FUNCS([krb5_get_init_creds_opt_alloc \ krb5_principal_get_realm]) AC_CHECK_FUNCS([krb5_get_init_creds_opt_free], [RRA_FUNC_KRB5_GET_INIT_CREDS_OPT_FREE_ARGS]) +AC_CHECK_DECLS([krb5_kt_free_entry], [], [], [RRA_INCLUDES_KRB5]) AC_CHECK_DECLS([krb5_kt_free_entry]) -AC_CHECK_MEMBERS([krb5_keytab_entry.keyblock], , , [#include ]) +AC_CHECK_MEMBERS([krb5_keytab_entry.keyblock], [], [], [RRA_INCLUDES_KRB5]) RRA_LIB_KRB5_RESTORE AC_HEADER_STDBOOL @@ -40,31 +54,18 @@ AC_CHECK_DECLS([snprintf, vsnprintf]) RRA_C_C99_VAMACROS RRA_C_GNU_VAMACROS AC_TYPE_LONG_LONG_INT +AC_CHECK_TYPES([ssize_t], [], [], + [#include ]) RRA_FUNC_SNPRINTF AC_CHECK_FUNCS([setrlimit]) AC_REPLACE_FUNCS([asprintf mkstemp setenv strlcat strlcpy]) -AC_ARG_WITH([wallet-server], - [AC_HELP_STRING([--with-wallet-server=HOST], [Default wallet server])], - [AS_IF([test x"$withval" != xno && test x"$withval" != xyes], - [AC_DEFINE_UNQUOTED([WALLET_SERVER], ["$withval"], - [Define to the default server host name.])])]) -AC_ARG_WITH([wallet-port], - [AC_HELP_STRING([--with-wallet-port=PORT], - [Default wallet server port])], - [AS_IF([test x"$withval" != xno && test x"$withval" != xyes], - [AC_DEFINE_UNQUOTED([WALLET_PORT], [$withval], - [Define to the default server port.])])]) - AC_ARG_VAR([REMCTLD], [Path to the remctld binary]) AC_PATH_PROG([REMCTLD], [remctld], , [$PATH:/usr/sbin:/usr/local/sbin]) AS_IF([test x"$REMCTLD" != x], [AC_DEFINE_UNQUOTED([PATH_REMCTLD], ["$REMCTLD"], [Define to the full path to remctld to run remctl tests.])]) -dnl Create the tests/data directory for builds outside the source directory. -AC_CONFIG_COMMANDS([tests/data/.placeholder], [touch tests/data/.placeholder]) - AC_CONFIG_HEADER([config.h]) AC_CONFIG_FILES([Makefile perl/Makefile.PL]) AC_CONFIG_FILES([tests/client/basic-t], [chmod +x tests/client/basic-t]) diff --git a/m4/gssapi.m4 b/m4/gssapi.m4 index 0a657ff..c596609 100644 --- a/m4/gssapi.m4 +++ b/m4/gssapi.m4 @@ -3,7 +3,8 @@ dnl dnl Finds the compiler and linker flags for linking with GSS-API libraries. dnl Provides the --with-gssapi, --with-gssapi-include, and --with-gssapi-lib dnl configure option to specify a non-standard path to the GSS-API libraries. -dnl Uses krb5-config where available unless reduced dependencies is requested. +dnl Uses krb5-config where available unless reduced dependencies is requested +dnl or --with-gssapi-include or --with-gssapi-lib are given. dnl dnl Provides the macro RRA_LIB_GSSAPI and sets the substitution variables dnl GSSAPI_CPPFLAGS, GSSAPI_LDFLAGS, and GSSAPI_LIBS. Also provides @@ -11,13 +12,34 @@ dnl RRA_LIB_GSSAPI_SWITCH to set CPPFLAGS, LDFLAGS, and LIBS to include the dnl GSS-API libraries, saving the ecurrent values, and RRA_LIB_GSSAPI_RESTORE dnl to restore those settings to before the last RRA_LIB_GSSAPI_SWITCH. dnl -dnl Depends on RRA_ENABLE_REDUCED_DEPENDS and RRA_SET_LDFLAGS. +dnl Also provides RRA_INCLUDES_KRB5, which are the headers to include when +dnl probing the Kerberos library properties. +dnl +dnl Depends on RRA_KRB5_CONFIG, RRA_ENABLE_REDUCED_DEPENDS, and +dnl RRA_SET_LDFLAGS. +dnl +dnl The canonical version of this file is maintained in the rra-c-util +dnl package, available at . dnl dnl Written by Russ Allbery -dnl Copyright 2005, 2006, 2007, 2008, 2009 -dnl Board of Trustees, Leland Stanford Jr. University +dnl Copyright 2005, 2006, 2007, 2008, 2009, 2011, 2012 +dnl The Board of Trustees of the Leland Stanford Junior University dnl -dnl See LICENSE for licensing terms. +dnl This file is free software; the authors give unlimited permission to copy +dnl and/or distribute it, with or without modifications, as long as this +dnl notice is preserved. + +dnl Headers to include when probing for Kerberos library properties. +AC_DEFUN([RRA_INCLUDES_GSSAPI], [[ +#ifdef HAVE_GSSAPI_GSSAPI_H +# include +#else +# include +#endif +#ifdef HAVE_GSSAPI_GSSAPI_KRB5_H +# include +#endif +]]) dnl Save the current CPPFLAGS, LDFLAGS, and LIBS settings and switch to dnl versions that include the GSS-API flags. Used as a wrapper, with @@ -68,18 +90,18 @@ AC_DEFUN([_RRA_LIB_GSSAPI_MANUAL], [RRA_LIB_GSSAPI_SWITCH rra_gssapi_extra= LIBS= - AC_SEARCH_LIBS([res_search], [resolv], , + AC_SEARCH_LIBS([res_search], [resolv], [], [AC_SEARCH_LIBS([__res_search], [resolv])]) AC_SEARCH_LIBS([gethostbyname], [nsl]) - AC_SEARCH_LIBS([socket], [socket], , - [AC_CHECK_LIB([nsl], [socket], [LIBS="-lnsl -lsocket $LIBS"], , + AC_SEARCH_LIBS([socket], [socket], [], + [AC_CHECK_LIB([nsl], [socket], [LIBS="-lnsl -lsocket $LIBS"], [], [-lsocket])]) AC_SEARCH_LIBS([crypt], [crypt]) + AC_SEARCH_LIBS([roken_concat], [roken]) rra_gssapi_extra="$LIBS" LIBS="$rra_gssapi_save_LIBS" AC_CHECK_LIB([gssapi], [gss_import_name], - [GSSAPI_LIBS="-lgssapi -lkrb5 -lasn1 -lroken -lcrypto -lcom_err" - GSSAPI_LIBS="$GSSAPI_LIBS $rra_gssapi_extra"], + [GSSAPI_LIBS="-lgssapi -lkrb5 -lasn1 -lcrypto -lcom_err $rra_gssapi_extra"], [AC_CHECK_LIB([krb5support], [krb5int_getspecific], [rra_gssapi_extra="-lkrb5support $rra_gssapi_extra"], [AC_CHECK_LIB([pthreads], [pthread_setspecific], @@ -88,7 +110,7 @@ AC_DEFUN([_RRA_LIB_GSSAPI_MANUAL], [rra_gssapi_pthread="-lpthread"])]) AC_CHECK_LIB([krb5support], [krb5int_setspecific], [rra_gssapi_extra="-lkrb5support $rra_gssapi_extra" - rra_gssapi_extra="$rra_gssapi_extra $rra_gssapi_pthread"], , + rra_gssapi_extra="$rra_gssapi_extra $rra_gssapi_pthread"], [], [$rra_gssapi_pthread])]) AC_CHECK_LIB([com_err], [error_message], [rra_gssapi_extra="-lcom_err $rra_gssapi_extra"]) @@ -101,7 +123,7 @@ AC_DEFUN([_RRA_LIB_GSSAPI_MANUAL], [GSSAPI_LIBS="-lgss"], [AC_MSG_ERROR([cannot find usable GSS-API library])])], [$rra_gssapi_extra])], - [-lkrb5 -lasn1 -lroken -lcrypto -lcom_err $rra_gssapi_extra]) + [-lkrb5 -lasn1 -lcrypto -lcom_err $rra_gssapi_extra]) RRA_LIB_GSSAPI_RESTORE]) dnl Sanity-check the results of krb5-config and be sure we can really link a @@ -116,6 +138,44 @@ AC_DEFUN([_RRA_LIB_GSSAPI_CHECK], _RRA_LIB_GSSAPI_PATHS _RRA_LIB_GSSAPI_MANUAL])]) +dnl Determine GSS-API compiler and linker flags from krb5-config. +AC_DEFUN([_RRA_LIB_GSSAPI_CONFIG], +[RRA_KRB5_CONFIG([${rra_gssapi_root}], [gssapi], [GSSAPI], + [_RRA_LIB_GSSAPI_CHECK], + [_RRA_LIB_GSSAPI_PATHS + _RRA_LIB_GSSAPI_MANUAL])]) + +dnl Check for a header using a file existence check rather than using +dnl AC_CHECK_HEADERS. This is used if there were arguments to configure +dnl specifying the GSS-API library path, since we may have one header in the +dnl default include path and another under our explicitly-configured GSS-API +dnl location. +AC_DEFUN([_RRA_LIB_GSSAPI_CHECK_HEADER], +[AC_MSG_CHECKING([for $1]) + AS_IF([test -f "${rra_gssapi_incroot}/$1"], + [AC_DEFINE_UNQUOTED(AS_TR_CPP([HAVE_$1]), [1], + [Define to 1 if you have the <$1> header file.]) + AC_MSG_RESULT([yes])], + [AC_MSG_RESULT([no])])]) + +dnl Determine the GSS-API header location and probe for some other +dnl characteristics of the libraries. We use a file existence check rather +dnl than letting the compiler probe for the right header location +AC_DEFUN([_RRA_LIB_GSSAPI_EXTRA], +[rra_gssapi_incroot= + AS_IF([test x"$rra_gssapi_includedir" != x], + [rra_gssapi_incroot="$rra_gssapi_includedir"], + [AS_IF([test x"$rra_gssapi_root" != x], + [rra_gssapi_incroot="${rra_gssapi_root}/include"])]) + AS_IF([test x"$rra_gssapi_incroot" = x], + [AC_CHECK_HEADERS([gssapi/gssapi.h gssapi/gssapi_krb5.h])], + [_RRA_LIB_GSSAPI_CHECK_HEADER([gssapi/gssapi.h]) + _RRA_LIB_GSSAPI_CHECK_HEADER([gssapi/gssapi_krb5.h])]) + AC_CHECK_DECL([GSS_C_NT_USER_NAME], + [AC_DEFINE([HAVE_GSS_RFC_OIDS], 1, + [Define to 1 if the GSS-API library uses RFC-compliant OIDs.])], [], + [RRA_INCLUDES_GSSAPI])]) + dnl The main macro. AC_DEFUN([RRA_LIB_GSSAPI], [AC_REQUIRE([RRA_ENABLE_REDUCED_DEPENDS]) @@ -148,24 +208,12 @@ AC_DEFUN([RRA_LIB_GSSAPI], AS_IF([test x"$rra_reduced_depends" = xtrue], [_RRA_LIB_GSSAPI_PATHS _RRA_LIB_GSSAPI_REDUCED], - [AC_ARG_VAR([KRB5_CONFIG], [Path to krb5-config]) - AS_IF([test x"$rra_gssapi_root" != x && test -z "$KRB5_CONFIG"], - [AS_IF([test -x "${rra_gssapi_root}/bin/krb5-config"], - [KRB5_CONFIG="${rra_gssapi_root}/bin/krb5-config"])], - [AC_PATH_PROG([KRB5_CONFIG], [krb5-config])]) - AS_IF([test x"$KRB5_CONFIG" != x && test -x "$KRB5_CONFIG"], - [AC_CACHE_CHECK([for gssapi support in krb5-config], - [rra_cv_lib_gssapi_config], - [AS_IF(["$KRB5_CONFIG" 2>&1 | grep gssapi >/dev/null 2>&1], - [rra_cv_lib_gssapi_config=yes], - [rra_cv_lib_gssapi_config=no])]) - AS_IF([test "$rra_cv_lib_gssapi_config" = yes], - [GSSAPI_CPPFLAGS=`"$KRB5_CONFIG" --cflags gssapi 2>/dev/null` - GSSAPI_LIBS=`"$KRB5_CONFIG" --libs gssapi 2>/dev/null`], - [GSSAPI_CPPFLAGS=`"$KRB5_CONFIG" --cflags 2>/dev/null` - GSSAPI_LIBS=`"$KRB5_CONFIG" --libs 2>/dev/null`]) - GSSAPI_CPPFLAGS=`echo "$GSSAPI_CPPFLAGS" \ - | sed 's%-I/usr/include ?%%'` - _RRA_LIB_GSSAPI_CHECK], - [_RRA_LIB_GSSAPI_PATHS - _RRA_LIB_GSSAPI_MANUAL])])]) + [AS_IF([test x"$rra_gssapi_includedir" = x \ + && test x"$rra_gssapi_libdir" = x], + [_RRA_LIB_GSSAPI_CONFIG], + [_RRA_LIB_GSSAPI_PATHS + _RRA_LIB_GSSAPI_MANUAL])]) + + RRA_LIB_GSSAPI_SWITCH + _RRA_LIB_GSSAPI_EXTRA + RRA_LIB_GSSAPI_RESTORE]) diff --git a/m4/krb5-config.m4 b/m4/krb5-config.m4 new file mode 100644 index 0000000..d73085f --- /dev/null +++ b/m4/krb5-config.m4 @@ -0,0 +1,101 @@ +dnl Use krb5-config to get link paths for Kerberos libraries. +dnl +dnl Provides one macro, RRA_KRB5_CONFIG, which attempts to get compiler and +dnl linker flags for a library via krb5-config and sets the appropriate shell +dnl variables. Defines the Autoconf variable PATH_KRB5_CONFIG, which can be +dnl used to find the default path to krb5-config. +dnl +dnl Depends on RRA_ENABLE_REDUCED_DEPENDS. +dnl +dnl The canonical version of this file is maintained in the rra-c-util +dnl package, available at . +dnl +dnl Written by Russ Allbery +dnl Copyright 2011, 2012 +dnl The Board of Trustees of the Leland Stanford Junior University +dnl +dnl This file is free software; the authors give unlimited permission to copy +dnl and/or distribute it, with or without modifications, as long as this +dnl notice is preserved. + +dnl Check for krb5-config in the user's path and set PATH_KRB5_CONFIG. This +dnl is moved into a separate macro so that it can be loaded via AC_REQUIRE, +dnl meaning it will only be run once even if we link with multiple krb5-config +dnl libraries. +AC_DEFUN([_RRA_KRB5_CONFIG_PATH], +[AC_ARG_VAR([PATH_KRB5_CONFIG], [Path to krb5-config]) + AC_PATH_PROG([PATH_KRB5_CONFIG], [krb5-config], [], + [${PATH}:/usr/kerberos/bin])]) + +dnl Check whether the --deps flag is supported by krb5-config. Takes the path +dnl to krb5-config to use. Note that this path is not embedded in the cache +dnl variable, so this macro implicitly assumes that we will always use the +dnl same krb5-config program. +AC_DEFUN([_RRA_KRB5_CONFIG_DEPS], +[AC_REQUIRE([_RRA_KRB5_CONFIG_PATH]) + AC_CACHE_CHECK([for --deps support in krb5-config], + [rra_cv_krb5_config_deps], + [AS_IF(["$1" 2>&1 | grep deps >/dev/null 2>&1], + [rra_cv_krb5_config_deps=yes], + [rra_cv_krb5_config_deps=no])])]) + +dnl Obtain the library flags for a particular library using krb5-config. +dnl Takes the path to the krb5-config program to use, the argument to +dnl krb5-config to use, and the variable prefix under which to store the +dnl library flags. +AC_DEFUN([_RRA_KRB5_CONFIG_LIBS], +[AC_REQUIRE([_RRA_KRB5_CONFIG_PATH]) + AC_REQUIRE([RRA_ENABLE_REDUCED_DEPENDS]) + _RRA_KRB5_CONFIG_DEPS([$1]) + AS_IF([test x"$rra_reduced_depends" = xfalse \ + && test x"$rra_cv_krb5_config_deps" = xyes], + [$3[]_LIBS=`"$1" --deps --libs $2 2>/dev/null`], + [$3[]_LIBS=`"$1" --libs $2 2>/dev/null`])]) + +dnl Attempt to find the flags for a library using krb5-config. Takes the +dnl following arguments (in order): +dnl +dnl 1. The root directory for the library in question, generally from an +dnl Autoconf --with flag. Used by preference as the path to krb5-config. +dnl +dnl 2. The argument to krb5-config to retrieve flags for this particular +dnl library. +dnl +dnl 3. The variable prefix to use when setting CPPFLAGS and LIBS variables +dnl based on the result of krb5-config. +dnl +dnl 4. Further actions to take if krb5-config was found and supported that +dnl library type. +dnl +dnl 5. Further actions to take if krb5-config could not be used to get flags +dnl for that library type. +dnl +dnl Special-case a krb5-config argument of krb5 and run krb5-config without an +dnl argument if that option was requested and not supported. Old versions of +dnl krb5-config didn't take an argument to specify the library type, but +dnl always returned the flags for libkrb5. +AC_DEFUN([RRA_KRB5_CONFIG], +[AC_REQUIRE([_RRA_KRB5_CONFIG_PATH]) + rra_krb5_config_$3= + rra_krb5_config_$3[]_ok= + AS_IF([test x"$1" != x && test -x "$1/bin/krb5-config"], + [rra_krb5_config_$3="$1/bin/krb5-config"], + [rra_krb5_config_$3="$PATH_KRB5_CONFIG"]) + AS_IF([test x"$rra_krb5_config_$3" != x && test -x "$rra_krb5_config_$3"], + [AC_CACHE_CHECK([for $2 support in krb5-config], [rra_cv_lib_$3[]_config], + [AS_IF(["$rra_krb5_config_$3" 2>&1 | grep $2 >/dev/null 2>&1], + [rra_cv_lib_$3[]_config=yes], + [rra_cv_lib_$3[]_config=no])]) + AS_IF([test "$rra_cv_lib_$3[]_config" = yes], + [$3[]_CPPFLAGS=`"$rra_krb5_config_$3" --cflags $2 2>/dev/null` + _RRA_KRB5_CONFIG_LIBS([$rra_krb5_config_$3], [$2], [$3]) + rra_krb5_config_$3[]_ok=yes], + [AS_IF([test x"$2" = xkrb5], + [$3[]_CPPFLAGS=`"$rra_krb5_config_$3" --cflags 2>/dev/null` + $3[]_LIBS=`"$rra_krb5_config_$3" --libs $2 2>/dev/null` + rra_krb5_config_$3[]_ok=yes])])]) + AS_IF([test x"$rra_krb5_config_$3[]_ok" = xyes], + [$3[]_CPPFLAGS=`echo "$$3[]_CPPFLAGS" | sed 's%-I/usr/include %%'` + $3[]_CPPFLAGS=`echo "$$3[]_CPPFLAGS" | sed 's%-I/usr/include$%%'` + $4], + [$5])]) diff --git a/m4/krb5.m4 b/m4/krb5.m4 index 38a050e..964023a 100644 --- a/m4/krb5.m4 +++ b/m4/krb5.m4 @@ -1,17 +1,18 @@ -dnl Find the compiler and linker flags for Kerberos v5. +dnl Find the compiler and linker flags for Kerberos. dnl -dnl Finds the compiler and linker flags for linking with Kerberos v5 -dnl libraries. Provides the --with-krb5, --with-krb5-include, and -dnl --with-krb5-lib configure options to specify non-standard paths to the -dnl Kerberos libraries. Uses krb5-config where available unless reduced -dnl dependencies is requested. +dnl Finds the compiler and linker flags for linking with Kerberos libraries. +dnl Provides the --with-krb5, --with-krb5-include, and --with-krb5-lib +dnl configure options to specify non-standard paths to the Kerberos libraries. +dnl Uses krb5-config where available unless reduced dependencies is requested +dnl or --with-krb5-include or --with-krb5-lib are given. dnl dnl Provides the macro RRA_LIB_KRB5 and sets the substitution variables dnl KRB5_CPPFLAGS, KRB5_LDFLAGS, and KRB5_LIBS. Also provides dnl RRA_LIB_KRB5_SWITCH to set CPPFLAGS, LDFLAGS, and LIBS to include the dnl Kerberos libraries, saving the current values first, and dnl RRA_LIB_KRB5_RESTORE to restore those settings to before the last -dnl RRA_LIB_KRB5_SWITCH. +dnl RRA_LIB_KRB5_SWITCH. HAVE_KERBEROS will always be defined if RRA_LIB_KRB5 +dnl is used. dnl dnl If KRB5_CPPFLAGS, KRB5_LDFLAGS, or KRB5_LIBS are set before calling these dnl macros, their values will be added to whatever the macros discover. @@ -32,14 +33,31 @@ dnl Also provides RRA_FUNC_KRB5_GET_INIT_CREDS_OPT_FREE_ARGS, which checks dnl whether krb5_get_init_creds_opt_free takes one argument or two. Defines dnl HAVE_KRB5_GET_INIT_CREDS_OPT_FREE_2_ARGS if it takes two arguments. dnl +dnl Also provides RRA_INCLUDES_KRB5, which are the headers to include when +dnl probing the Kerberos library properties. +dnl +dnl The canonical version of this file is maintained in the rra-c-util +dnl package, available at . +dnl dnl Written by Russ Allbery -dnl Copyright 2005, 2006, 2007, 2008, 2009, 2010 -dnl Board of Trustees, Leland Stanford Jr. University +dnl Copyright 2005, 2006, 2007, 2008, 2009, 2010, 2011 +dnl The Board of Trustees of the Leland Stanford Junior University dnl -dnl See LICENSE for licensing terms. +dnl This file is free software; the authors give unlimited permission to copy +dnl and/or distribute it, with or without modifications, as long as this +dnl notice is preserved. + +dnl Headers to include when probing for Kerberos library properties. +AC_DEFUN([RRA_INCLUDES_KRB5], [[ +#if HAVE_KRB5_H +# include +#else +# include +#endif +]]) dnl Save the current CPPFLAGS, LDFLAGS, and LIBS settings and switch to -dnl versions that include the Kerberos v5 flags. Used as a wrapper, with +dnl versions that include the Kerberos flags. Used as a wrapper, with dnl RRA_LIB_KRB5_RESTORE, around tests. AC_DEFUN([RRA_LIB_KRB5_SWITCH], [rra_krb5_save_CPPFLAGS="$CPPFLAGS" @@ -69,44 +87,62 @@ AC_DEFUN([_RRA_LIB_KRB5_PATHS], [AS_IF([test x"$rra_krb5_root" != x/usr], [KRB5_CPPFLAGS="-I${rra_krb5_root}/include"])])])]) -dnl Does the appropriate library checks for reduced-dependency Kerberos v5 +dnl Check for a header using a file existence check rather than using +dnl AC_CHECK_HEADERS. This is used if there were arguments to configure +dnl specifying the Kerberos header path, since we may have one header in the +dnl default include path and another under our explicitly-configured Kerberos +dnl location. +AC_DEFUN([_RRA_LIB_KRB5_CHECK_HEADER], +[AC_MSG_CHECKING([for $1]) + AS_IF([test -f "${rra_krb5_incroot}/$1"], + [AC_DEFINE_UNQUOTED(AS_TR_CPP([HAVE_$1]), [1], + [Define to 1 if you have the <$1> header file.]) + AC_MSG_RESULT([yes])], + [AC_MSG_RESULT([no])])]) + +dnl Does the appropriate library checks for reduced-dependency Kerberos dnl linkage. The single argument, if true, says to fail if Kerberos could not dnl be found. AC_DEFUN([_RRA_LIB_KRB5_REDUCED], [RRA_LIB_KRB5_SWITCH AC_CHECK_LIB([krb5], [krb5_init_context], [KRB5_LIBS="-lkrb5"], [AS_IF([test x"$1" = xtrue], - [AC_MSG_ERROR([cannot find usable Kerberos v5 library])])]) + [AC_MSG_ERROR([cannot find usable Kerberos library])])]) LIBS="$KRB5_LIBS $LIBS" + AS_IF([test x"$rra_krb5_incroot" = x], + [AC_CHECK_HEADERS([krb5.h krb5/krb5.h])], + [_RRA_LIB_KRB5_CHECK_HEADER([krb5.h]) + _RRA_LIB_KRB5_CHECK_HEADER([krb5/krb5.h])]) AC_CHECK_FUNCS([krb5_get_error_message], [AC_CHECK_FUNCS([krb5_free_error_message])], - [AC_CHECK_FUNCS([krb5_get_error_string], , - [AC_CHECK_FUNCS([krb5_get_err_txt], , + [AC_CHECK_FUNCS([krb5_get_error_string], [], + [AC_CHECK_FUNCS([krb5_get_err_txt], [], [AC_CHECK_LIB([ksvc], [krb5_svc_get_msg], [KRB5_LIBS="$KRB5_LIBS -lksvc" AC_DEFINE([HAVE_KRB5_SVC_GET_MSG], [1]) - AC_CHECK_HEADERS([ibm_svc/krb5_svc.h])], + AC_CHECK_HEADERS([ibm_svc/krb5_svc.h], [], [], + [RRA_INCLUDES_KRB5])], [AC_CHECK_LIB([com_err], [com_err], [KRB5_LIBS="$KRB5_LIBS -lcom_err"], [AC_MSG_ERROR([cannot find usable com_err library])]) AC_CHECK_HEADERS([et/com_err.h])])])])]) RRA_LIB_KRB5_RESTORE]) -dnl Does the appropriate library checks for Kerberos v5 linkage when we don't +dnl Does the appropriate library checks for Kerberos linkage when we don't dnl have krb5-config or reduced dependencies. The single argument, if true, dnl says to fail if Kerberos could not be found. AC_DEFUN([_RRA_LIB_KRB5_MANUAL], [RRA_LIB_KRB5_SWITCH rra_krb5_extra= LIBS= - AC_SEARCH_LIBS([res_search], [resolv], , + AC_SEARCH_LIBS([res_search], [resolv], [], [AC_SEARCH_LIBS([__res_search], [resolv])]) AC_SEARCH_LIBS([gethostbyname], [nsl]) - AC_SEARCH_LIBS([socket], [socket], , - [AC_CHECK_LIB([nsl], [socket], [LIBS="-lnsl -lsocket $LIBS"], , + AC_SEARCH_LIBS([socket], [socket], [], + [AC_CHECK_LIB([nsl], [socket], [LIBS="-lnsl -lsocket $LIBS"], [], [-lsocket])]) AC_SEARCH_LIBS([crypt], [crypt]) - AC_SEARCH_LIBS([rk_simple_execve], [roken]) + AC_SEARCH_LIBS([roken_concat], [roken]) rra_krb5_extra="$LIBS" LIBS="$rra_krb5_save_LIBS" AC_CHECK_LIB([krb5], [krb5_init_context], @@ -119,28 +155,34 @@ AC_DEFUN([_RRA_LIB_KRB5_MANUAL], [rra_krb5_pthread="-lpthread"])]) AC_CHECK_LIB([krb5support], [krb5int_setspecific], [rra_krb5_extra="-lkrb5support $rra_krb5_extra $rra_krb5_pthread"], - , [$rra_krb5_pthread])]) + [], [$rra_krb5_pthread $rra_krb5_extra])], + [$rra_krb5_extra]) AC_CHECK_LIB([com_err], [error_message], - [rra_krb5_extra="-lcom_err $rra_krb5_extra"]) + [rra_krb5_extra="-lcom_err $rra_krb5_extra"], [], [$rra_krb5_extra]) AC_CHECK_LIB([ksvc], [krb5_svc_get_msg], - [rra_krb5_extra="-lksvc $rra_krb5_extra"]) + [rra_krb5_extra="-lksvc $rra_krb5_extra"], [], [$rra_krb5_extra]) AC_CHECK_LIB([k5crypto], [krb5int_hash_md5], - [rra_krb5_extra="-lk5crypto $rra_krb5_extra"]) + [rra_krb5_extra="-lk5crypto $rra_krb5_extra"], [], [$rra_krb5_extra]) AC_CHECK_LIB([k5profile], [profile_get_values], - [rra_krb5_extra="-lk5profile $rra_krb5_extra"]) + [rra_krb5_extra="-lk5profile $rra_krb5_extra"], [], [$rra_krb5_extra]) AC_CHECK_LIB([krb5], [krb5_cc_default], [KRB5_LIBS="-lkrb5 $rra_krb5_extra"], [AS_IF([test x"$1" = xtrue], - [AC_MSG_ERROR([cannot find usable Kerberos v5 library])])], + [AC_MSG_ERROR([cannot find usable Kerberos library])])], [$rra_krb5_extra])], [-lasn1 -lcom_err -lcrypto $rra_krb5_extra]) LIBS="$KRB5_LIBS $LIBS" + AS_IF([test x"$rra_krb5_incroot" = x], + [AC_CHECK_HEADERS([krb5.h krb5/krb5.h])], + [_RRA_LIB_KRB5_CHECK_HEADER([krb5.h]) + _RRA_LIB_KRB5_CHECK_HEADER([krb5/krb5.h])]) AC_CHECK_FUNCS([krb5_get_error_message], [AC_CHECK_FUNCS([krb5_free_error_message])], - [AC_CHECK_FUNCS([krb5_get_error_string], , - [AC_CHECK_FUNCS([krb5_get_err_txt], , + [AC_CHECK_FUNCS([krb5_get_error_string], [], + [AC_CHECK_FUNCS([krb5_get_err_txt], [], [AC_CHECK_FUNCS([krb5_svc_get_msg], - [AC_CHECK_HEADERS([ibm_svc/krb5_svc.h])], + [AC_CHECK_HEADERS([ibm_svc/krb5_svc.h], [], [], + [RRA_INCLUDES_KRB5])], [AC_CHECK_HEADERS([et/com_err.h])])])])]) RRA_LIB_KRB5_RESTORE]) @@ -158,49 +200,49 @@ AC_DEFUN([_RRA_LIB_KRB5_CHECK], _RRA_LIB_KRB5_PATHS _RRA_LIB_KRB5_MANUAL([$1])])]) +dnl Determine Kerberos compiler and linker flags from krb5-config. Does the +dnl additional probing we need to do to uncover error handling features, and +dnl falls back on the manual checks. +AC_DEFUN([_RRA_LIB_KRB5_CONFIG], +[RRA_KRB5_CONFIG([${rra_krb5_root}], [krb5], [KRB5], + [_RRA_LIB_KRB5_CHECK([$1]) + RRA_LIB_KRB5_SWITCH + AS_IF([test x"$rra_krb5_incroot" = x], + [AC_CHECK_HEADERS([krb5.h krb5/krb5.h])], + [_RRA_LIB_KRB5_CHECK_HEADER([krb5.h]) + _RRA_LIB_KRB5_CHECK_HEADER([krb5/krb5.h])]) + AC_CHECK_FUNCS([krb5_get_error_message], + [AC_CHECK_FUNCS([krb5_free_error_message])], + [AC_CHECK_FUNCS([krb5_get_error_string], [], + [AC_CHECK_FUNCS([krb5_get_err_txt], [], + [AC_CHECK_FUNCS([krb5_svc_get_msg], + [AC_CHECK_HEADERS([ibm_svc/krb5_svc.h], [], [], + [RRA_INCLUDES_KRB5])], + [AC_CHECK_HEADERS([et/com_err.h])])])])]) + RRA_LIB_KRB5_RESTORE], + [_RRA_LIB_KRB5_PATHS + _RRA_LIB_KRB5_MANUAL([$1])])]) + dnl The core of the library checking, shared between RRA_LIB_KRB5 and dnl RRA_LIB_KRB5_OPTIONAL. The single argument, if "true", says to fail if -dnl Kerberos could not be found. +dnl Kerberos could not be found. Set up rra_krb5_incroot for later header +dnl checking. AC_DEFUN([_RRA_LIB_KRB5_INTERNAL], [AC_REQUIRE([RRA_ENABLE_REDUCED_DEPENDS]) + rra_krb5_incroot= + AS_IF([test x"$rra_krb5_includedir" != x], + [rra_krb5_incroot="$rra_krb5_includedir"], + [AS_IF([test x"$rra_krb5_root" != x], + [rra_krb5_incroot="${rra_krb5_root}/include"])]) AS_IF([test x"$rra_reduced_depends" = xtrue], [_RRA_LIB_KRB5_PATHS _RRA_LIB_KRB5_REDUCED([$1])], - [AC_ARG_VAR([KRB5_CONFIG], [Path to krb5-config]) - AS_IF([test x"$rra_krb5_root" != x && test -z "$KRB5_CONFIG"], - [AS_IF([test -x "${rra_krb5_root}/bin/krb5-config"], - [KRB5_CONFIG="${rra_krb5_root}/bin/krb5-config"])], - [AC_PATH_PROG([KRB5_CONFIG], [krb5-config])]) - AS_IF([test x"$KRB5_CONFIG" != x && test -x "$KRB5_CONFIG"], - [AC_CACHE_CHECK([for krb5 support in krb5-config], - [rra_cv_lib_krb5_config], - [AS_IF(["$KRB5_CONFIG" 2>&1 | grep krb5 >/dev/null 2>&1], - [rra_cv_lib_krb5_config=yes], - [rra_cv_lib_krb5_config=no])]) - AS_IF([test x"$rra_cv_lib_krb5_config" = xyes], - [KRB5_CPPFLAGS=`"$KRB5_CONFIG" --cflags krb5 2>/dev/null` - KRB5_LIBS=`"$KRB5_CONFIG" --libs krb5 2>/dev/null`], - [KRB5_CPPFLAGS=`"$KRB5_CONFIG" --cflags 2>/dev/null` - KRB5_LIBS=`"$KRB5_CONFIG" --libs 2>/dev/null`]) - KRB5_CPPFLAGS=`echo "$KRB5_CPPFLAGS" | sed 's%-I/usr/include ?%%'` - _RRA_LIB_KRB5_CHECK([$1]) - RRA_LIB_KRB5_SWITCH - AC_CHECK_FUNCS([krb5_get_error_message], - [AC_CHECK_FUNCS([krb5_free_error_message])], - [AC_CHECK_FUNCS([krb5_get_error_string], , - [AC_CHECK_FUNCS([krb5_get_err_txt], , - [AC_CHECK_FUNCS([krb5_svc_get_msg], - [AC_CHECK_HEADERS([ibm_svc/krb5_svc.h])], - [AC_CHECK_HEADERS([et/com_err.h])])])])]) - RRA_LIB_KRB5_RESTORE], - [_RRA_LIB_KRB5_PATHS - _RRA_LIB_KRB5_MANUAL([$1])])]) + [AS_IF([test x"$rra_krb5_includedir" = x && test x"$rra_krb5_libdir" = x], + [_RRA_LIB_KRB5_CONFIG([$1])], + [_RRA_LIB_KRB5_PATHS + _RRA_LIB_KRB5_MANUAL([$1])])]) rra_krb5_uses_com_err=false - case "$LIBS" in - *-lcom_err*) - rra_krb5_uses_com_err=true - ;; - esac + AS_CASE([$LIBS], [*-lcom_err*], [rra_krb5_uses_com_err=true]) AM_CONDITIONAL([KRB5_USES_COM_ERR], [test x"$rra_krb5_uses_com_err" = xtrue])]) dnl The main macro for packages with mandatory Kerberos support. @@ -208,26 +250,28 @@ AC_DEFUN([RRA_LIB_KRB5], [rra_krb5_root= rra_krb5_libdir= rra_krb5_includedir= + rra_use_kerberos=true AC_SUBST([KRB5_CPPFLAGS]) AC_SUBST([KRB5_LDFLAGS]) AC_SUBST([KRB5_LIBS]) AC_ARG_WITH([krb5], [AS_HELP_STRING([--with-krb5=DIR], - [Location of Kerberos v5 headers and libraries])], + [Location of Kerberos headers and libraries])], [AS_IF([test x"$withval" != xyes && test x"$withval" != xno], [rra_krb5_root="$withval"])]) AC_ARG_WITH([krb5-include], [AS_HELP_STRING([--with-krb5-include=DIR], - [Location of Kerberos v5 headers])], + [Location of Kerberos headers])], [AS_IF([test x"$withval" != xyes && test x"$withval" != xno], [rra_krb5_includedir="$withval"])]) AC_ARG_WITH([krb5-lib], [AS_HELP_STRING([--with-krb5-lib=DIR], - [Location of Kerberos v5 libraries])], + [Location of Kerberos libraries])], [AS_IF([test x"$withval" != xyes && test x"$withval" != xno], [rra_krb5_libdir="$withval"])]) - _RRA_LIB_KRB5_INTERNAL([true])]) + _RRA_LIB_KRB5_INTERNAL([true]) + AC_DEFINE([HAVE_KERBEROS], 1, [Define to enable Kerberos features.])]) dnl The main macro for packages with optional Kerberos support. AC_DEFUN([RRA_LIB_KRB5_OPTIONAL], @@ -241,29 +285,41 @@ AC_DEFUN([RRA_LIB_KRB5_OPTIONAL], AC_ARG_WITH([krb5], [AS_HELP_STRING([--with-krb5@<:@=DIR@:>@], - [Location of Kerberos v5 headers and libraries])], + [Location of Kerberos headers and libraries])], [AS_IF([test x"$withval" = xno], [rra_use_kerberos=false], [AS_IF([test x"$withval" != xyes], [rra_krb5_root="$withval"]) rra_use_kerberos=true])]) AC_ARG_WITH([krb5-include], [AS_HELP_STRING([--with-krb5-include=DIR], - [Location of Kerberos v5 headers])], + [Location of Kerberos headers])], [AS_IF([test x"$withval" != xyes && test x"$withval" != xno], [rra_krb5_includedir="$withval"])]) AC_ARG_WITH([krb5-lib], [AS_HELP_STRING([--with-krb5-lib=DIR], - [Location of Kerberos v5 libraries])], + [Location of Kerberos libraries])], [AS_IF([test x"$withval" != xyes && test x"$withval" != xno], [rra_krb5_libdir="$withval"])]) AS_IF([test x"$rra_use_kerberos" != xfalse], [AS_IF([test x"$rra_use_kerberos" = xtrue], [_RRA_LIB_KRB5_INTERNAL([true])], - [_RRA_LIB_KRB5_INTERNAL([false])])]) + [_RRA_LIB_KRB5_INTERNAL([false])])], + [AM_CONDITIONAL([KRB5_USES_COM_ERR], [false])]) AS_IF([test x"$KRB5_LIBS" != x], [AC_DEFINE([HAVE_KERBEROS], 1, [Define to enable Kerberos features.])])]) +dnl Source used by RRA_FUNC_KRB5_GET_INIT_CREDS_OPT_FREE_ARGS. +AC_DEFUN([_RRA_FUNC_KRB5_OPT_FREE_ARGS_SOURCE], [RRA_INCLUDES_KRB5] [[ +int +main(void) +{ + krb5_get_init_creds_opt *opts; + krb5_context c; + krb5_get_init_creds_opt_free(c, opts); +} +]]) + dnl Check whether krb5_get_init_creds_opt_free takes one argument or two. dnl Early Heimdal used to take a single argument. Defines dnl HAVE_KRB5_GET_INIT_CREDS_OPT_FREE_2_ARGS if it takes two arguments. @@ -272,9 +328,7 @@ dnl Should be called with RRA_LIB_KRB5_SWITCH active. AC_DEFUN([RRA_FUNC_KRB5_GET_INIT_CREDS_OPT_FREE_ARGS], [AC_CACHE_CHECK([if krb5_get_init_creds_opt_free takes two arguments], [rra_cv_func_krb5_get_init_creds_opt_free_args], - [AC_TRY_COMPILE([#include ], - [krb5_get_init_creds_opt *opts; krb5_context c; - krb5_get_init_creds_opt_free(c, opts);], + [AC_COMPILE_IFELSE([AC_LANG_SOURCE([_RRA_FUNC_KRB5_OPT_FREE_ARGS_SOURCE])], [rra_cv_func_krb5_get_init_creds_opt_free_args=yes], [rra_cv_func_krb5_get_init_creds_opt_free_args=no])]) AS_IF([test $rra_cv_func_krb5_get_init_creds_opt_free_args = yes], diff --git a/m4/lib-depends.m4 b/m4/lib-depends.m4 index 039e245..b5185f3 100644 --- a/m4/lib-depends.m4 +++ b/m4/lib-depends.m4 @@ -9,11 +9,16 @@ dnl dnl This macro doesn't do much but is defined separately so that other macros dnl can require it with AC_REQUIRE. dnl +dnl The canonical version of this file is maintained in the rra-c-util +dnl package, available at . +dnl dnl Written by Russ Allbery dnl Copyright 2005, 2006, 2007 -dnl Board of Trustees, Leland Stanford Jr. University +dnl The Board of Trustees of the Leland Stanford Junior University dnl -dnl See LICENSE for licensing terms. +dnl This file is free software; the authors give unlimited permission to copy +dnl and/or distribute it, with or without modifications, as long as this +dnl notice is preserved. AC_DEFUN([RRA_ENABLE_REDUCED_DEPENDS], [rra_reduced_depends=false diff --git a/m4/lib-pathname.m4 b/m4/lib-pathname.m4 index fc326a0..fd5a5a1 100644 --- a/m4/lib-pathname.m4 +++ b/m4/lib-pathname.m4 @@ -12,10 +12,16 @@ dnl dnl This file also provides the Autoconf macro RRA_SET_LIBDIR, which sets the dnl libdir variable to PREFIX/lib{,32,64} as appropriate. dnl +dnl The canonical version of this file is maintained in the rra-c-util +dnl package, available at . +dnl dnl Written by Russ Allbery -dnl Copyright 2008, 2009 Board of Trustees, Leland Stanford Jr. University +dnl Copyright 2008, 2009 +dnl The Board of Trustees of the Leland Stanford Junior University dnl -dnl See LICENSE for licensing terms. +dnl This file is free software; the authors give unlimited permission to copy +dnl and/or distribute it, with or without modifications, as long as this +dnl notice is preserved. dnl Probe for the alternate library name that we should attempt on this dnl architecture, given the size of an int, and set rra_lib_arch_name to that diff --git a/m4/remctl.m4 b/m4/remctl.m4 index bb3a56f..588404f 100644 --- a/m4/remctl.m4 +++ b/m4/remctl.m4 @@ -10,15 +10,28 @@ dnl REMCTL_CPPFLAGS, REMCTL_LDFLAGS, and REMCTL_LIBS. Also provides dnl RRA_LIB_REMCTL_SWITCH to set CPPFLAGS, LDFLAGS, and LIBS to include the dnl remctl libraries, saving the current values first, and dnl RRA_LIB_REMCTL_RESTORE to restore those settings to before the last -dnl RRA_LIB_REMCTL_SWITCH. +dnl RRA_LIB_REMCTL_SWITCH. HAVE_REMCTL will always be defined if +dnl RRA_LIB_REMCTL is used. +dnl +dnl Provides the RRA_LIB_REMCTL_OPTIONAL macro, which should be used if +dnl Kerberos support is optional. This macro will still always est the +dnl substitution variables, but they'll be empty unless --with-remctl is +dnl given. HAVE_REMCTL will be defined if --with-remctl is given and +dnl $rra_use_remctl will be set to "true". dnl dnl Depends on RRA_ENABLE_REDUCED_DEPENDS, RRA_SET_LDFLAGS, and dnl RRA_LIB_GSSAPI. dnl +dnl The canonical version of this file is maintained in the rra-c-util +dnl package, available at . +dnl dnl Written by Russ Allbery -dnl Copyright 2008, 2009 Board of Trustees, Leland Stanford Jr. University +dnl Copyright 2008, 2009, 2011 +dnl The Board of Trustees of the Leland Stanford Junior University dnl -dnl See LICENSE for licensing terms. +dnl This file is free software; the authors give unlimited permission to copy +dnl and/or distribute it, with or without modifications, as long as this +dnl notice is preserved. dnl Save the current CPPFLAGS, LDFLAGS, and LIBS settings and switch to dnl versions that include the remctl flags. Used as a wrapper, with @@ -55,16 +68,34 @@ dnl Sanity-check the results of the remctl library search to be sure we can dnl really link a remctl program. AC_DEFUN([_RRA_LIB_REMCTL_CHECK], [RRA_LIB_REMCTL_SWITCH - AC_CHECK_FUNC([remctl_open], , - [AC_MSG_FAILURE([unable to link with remctl library])]) + AC_CHECK_FUNC([remctl_open], [], + [AS_IF([test x"$1" = xtrue], + [AC_MSG_FAILURE([unable to link with remctl library])]) + REMCTL_CPPFLAGS= + REMCTL_LDFLAGS= + REMCTL_LIBS=]) RRA_LIB_REMCTL_RESTORE]) -dnl The main macro. -AC_DEFUN([RRA_LIB_REMCTL], +dnl The core of the library checking, shared between RRA_LIB_REMCTL and +dnl RRA_LIB_REMCTL_OPTIONAL. The single argument, if "true", says to fail if +dnl remctl could not be found. +AC_DEFUN([_RRA_LIB_REMCTL_INTERNAL], [AC_REQUIRE([RRA_ENABLE_REDUCED_DEPENDS]) - rra_remctl_root= + _RRA_LIB_REMCTL_PATHS + AS_IF([test x"$rra_reduced_depends" = xtrue], + [REMCTL_LIBS="-lremctl"], + [RRA_LIB_GSSAPI + REMCTL_CPPFLAGS="$REMCTL_CPPFLAGS $GSSAPI_CPPFLAGS" + REMCTL_LDFLAGS="$REMCTL_LDFLAGS $GSSAPI_LDFLAGS" + REMCTL_LIBS="-lremctl $GSSAPI_LIBS"]) + _RRA_LIB_REMCTL_CHECK([$1])]) + +dnl The main macro for packages with mandatory remctl support. +AC_DEFUN([RRA_LIB_REMCTL], +[rra_remctl_root= rra_remctl_libdir= rra_remctl_includedir= + rra_use_remctl=true REMCTL_CPPFLAGS= REMCTL_LDFLAGS= REMCTL_LIBS= @@ -87,12 +118,43 @@ AC_DEFUN([RRA_LIB_REMCTL], [Location of remctl libraries])], [AS_IF([test x"$withval" != xyes && test x"$withval" != xno], [rra_remctl_libdir="$withval"])]) + _RRA_LIB_REMCTL_INTERNAL([true]) + AC_DEFINE([HAVE_REMCTL], 1, [Define to enable remctl features.])]) - _RRA_LIB_REMCTL_PATHS - AS_IF([test x"$rra_reduced_depends" = xtrue], - [REMCTL_LIBS="-lremctl"], - [RRA_LIB_GSSAPI - REMCTL_CPPFLAGS="$REMCTL_CPPFLAGS $GSSAPI_CPPFLAGS" - REMCTL_LDFLAGS="$REMCTL_LDFLAGS $GSSAPI_LDFLAGS" - REMCTL_LIBS="-lremctl $GSSAPI_LIBS"]) - _RRA_LIB_REMCTL_CHECK]) +dnl The main macro for packages with optional remctl support. +AC_DEFUN([RRA_LIB_REMCTL_OPTIONAL], +[rra_remctl_root= + rra_remctl_libdir= + rra_remctl_includedir= + rra_use_remctl= + REMCTL_CPPFLAGS= + REMCTL_LDFLAGS= + REMCTL_LIBS= + AC_SUBST([REMCTL_CPPFLAGS]) + AC_SUBST([REMCTL_LDFLAGS]) + AC_SUBST([REMCTL_LIBS]) + + AC_ARG_WITH([remctl], + [AS_HELP_STRING([--with-remctl@<:@=DIR@:>@], + [Location of remctl headers and libraries])], + [AS_IF([test x"$withval" = xno], + [rra_use_remctl=false], + [AS_IF([test x"$withval" != xyes], [rra_remctl_root="$withval"]) + rra_use_remctl=true])]) + AC_ARG_WITH([remctl-include], + [AS_HELP_STRING([--with-remctl-include=DIR], + [Location of remctl headers])], + [AS_IF([test x"$withval" != xyes && test x"$withval" != xno], + [rra_remctl_includedir="$withval"])]) + AC_ARG_WITH([remctl-lib], + [AS_HELP_STRING([--with-remctl-lib=DIR], + [Location of remctl libraries])], + [AS_IF([test x"$withval" != xyes && test x"$withval" != xno], + [rra_remctl_libdir="$withval"])]) + AS_IF([test x"$rra_use_remctl" != xfalse], + [AS_IF([test x"$rra_use_remctl" = xtrue], + [_RRA_LIB_REMCTL_INTERNAL([true])], + [_RRA_LIB_REMCTL_INTERNAL([false])])]) + AS_IF([test x"$REMCTL_LIBS" != x], + [rra_use_remctl=true + AC_DEFINE([HAVE_REMCTL], 1, [Define to enable remctl features.])])]) diff --git a/m4/snprintf.m4 b/m4/snprintf.m4 index d933f55..cd585ef 100644 --- a/m4/snprintf.m4 +++ b/m4/snprintf.m4 @@ -9,11 +9,16 @@ dnl dnl Provides RRA_FUNC_SNPRINTF, which adds snprintf.o to LIBOBJS unless a dnl fully working snprintf is found. dnl +dnl The canonical version of this file is maintained in the rra-c-util +dnl package, available at . +dnl dnl Written by Russ Allbery dnl Copyright 2006, 2008, 2009 -dnl Board of Trustees, Leland Stanford Jr. University +dnl The Board of Trustees of the Leland Stanford Junior University dnl -dnl See LICENSE for licensing terms. +dnl This file is free software; the authors give unlimited permission to copy +dnl and/or distribute it, with or without modifications, as long as this +dnl notice is preserved. dnl Source used by RRA_FUNC_SNPRINTF. AC_DEFUN([_RRA_FUNC_SNPRINTF_SOURCE], [[ diff --git a/m4/vamacros.m4 b/m4/vamacros.m4 index 855bb40..af98f6a 100644 --- a/m4/vamacros.m4 +++ b/m4/vamacros.m4 @@ -13,11 +13,16 @@ dnl #define macro(args...) fprintf(stderr, args) dnl dnl They set HAVE_C99_VAMACROS or HAVE_GNU_VAMACROS as appropriate. dnl +dnl The canonical version of this file is maintained in the rra-c-util +dnl package, available at . +dnl dnl Written by Russ Allbery dnl Copyright 2006, 2008, 2009 -dnl Board of Trustees, Leland Stanford Jr. University +dnl The Board of Trustees of the Leland Stanford Junior University dnl -dnl See LICENSE for licensing terms. +dnl This file is free software; the authors give unlimited permission to copy +dnl and/or distribute it, with or without modifications, as long as this +dnl notice is preserved. AC_DEFUN([_RRA_C_C99_VAMACROS_SOURCE], [[ #include diff --git a/portable/asprintf.c b/portable/asprintf.c index 4219a19..0093070 100644 --- a/portable/asprintf.c +++ b/portable/asprintf.c @@ -4,8 +4,18 @@ * Provides the same functionality as the standard GNU library routines * asprintf and vasprintf for those platforms that don't have them. * + * The canonical version of this file is maintained in the rra-c-util package, + * which can be found at . + * * Written by Russ Allbery - * This work is hereby placed in the public domain by its author. + * + * The authors hereby relinquish any claim to any copyright that they may have + * in this work, whether granted under contract or by operation of law or + * international treaty, and hereby commit to the public, at large, that they + * shall not, at any time in the future, seek to enforce any copyright in this + * work against any person or entity, or prevent any person or entity from + * copying, publishing, distributing or creating derivative works of this + * work. */ #include diff --git a/portable/dummy.c b/portable/dummy.c index 8a0d54d..50052ec 100644 --- a/portable/dummy.c +++ b/portable/dummy.c @@ -5,8 +5,18 @@ * supply, Automake builds an empty library and then calls ar with nonsensical * arguments. Ensure that libportable always contains at least one symbol. * + * The canonical version of this file is maintained in the rra-c-util package, + * which can be found at . + * * Written by Russ Allbery - * This work is hereby placed in the public domain by its author. + * + * The authors hereby relinquish any claim to any copyright that they may have + * in this work, whether granted under contract or by operation of law or + * international treaty, and hereby commit to the public, at large, that they + * shall not, at any time in the future, seek to enforce any copyright in this + * work against any person or entity, or prevent any person or entity from + * copying, publishing, distributing or creating derivative works of this + * work. */ /* Prototype to avoid gcc warnings. */ diff --git a/portable/krb5-extra.c b/portable/krb5-extra.c index 89ccbde..849842c 100644 --- a/portable/krb5-extra.c +++ b/portable/krb5-extra.c @@ -6,8 +6,18 @@ * Everything in this file will be protected by #ifndef. If the native * Kerberos libraries are fully capable, this file will be skipped. * + * The canonical version of this file is maintained in the rra-c-util package, + * which can be found at . + * * Written by Russ Allbery - * This work is hereby placed in the public domain by its author. + * + * The authors hereby relinquish any claim to any copyright that they may have + * in this work, whether granted under contract or by operation of law or + * international treaty, and hereby commit to the public, at large, that they + * shall not, at any time in the future, seek to enforce any copyright in this + * work against any person or entity, or prevent any person or entity from + * copying, publishing, distributing or creating derivative works of this + * work. */ #include diff --git a/portable/krb5.h b/portable/krb5.h index 3b5700b..b418ae7 100644 --- a/portable/krb5.h +++ b/portable/krb5.h @@ -16,8 +16,18 @@ * prefers the generic krb5_xfree(). In this case, this header provides * krb5_free_unparsed_name() for both APIs since it's the most specific call. * + * The canonical version of this file is maintained in the rra-c-util package, + * which can be found at . + * * Written by Russ Allbery - * This work is hereby placed in the public domain by its author. + * + * The authors hereby relinquish any claim to any copyright that they may have + * in this work, whether granted under contract or by operation of law or + * international treaty, and hereby commit to the public, at large, that they + * shall not, at any time in the future, seek to enforce any copyright in this + * work against any person or entity, or prevent any person or entity from + * copying, publishing, distributing or creating derivative works of this + * work. */ #ifndef PORTABLE_KRB5_H @@ -32,7 +42,11 @@ #endif #include -#include +#ifdef HAVE_KRB5_H +# include +#else +# include +#endif #include BEGIN_DECLS @@ -75,7 +89,7 @@ krb5_error_code krb5_get_init_creds_opt_alloc(krb5_context, /* Heimdal-specific. */ #ifndef HAVE_KRB5_GET_INIT_CREDS_OPT_SET_DEFAULT_FLAGS -#define krb5_get_init_creds_opt_set_default_flags(c, p, r, o) /* empty */ +# define krb5_get_init_creds_opt_set_default_flags(c, p, r, o) /* empty */ #endif /* diff --git a/portable/macros.h b/portable/macros.h index 8d5adbd..b33d064 100644 --- a/portable/macros.h +++ b/portable/macros.h @@ -1,8 +1,18 @@ /* * Portability macros used in include files. * + * The canonical version of this file is maintained in the rra-c-util package, + * which can be found at . + * * Written by Russ Allbery - * This work is hereby placed in the public domain by its author. + * + * The authors hereby relinquish any claim to any copyright that they may have + * in this work, whether granted under contract or by operation of law or + * international treaty, and hereby commit to the public, at large, that they + * shall not, at any time in the future, seek to enforce any copyright in this + * work against any person or entity, or prevent any person or entity from + * copying, publishing, distributing or creating derivative works of this + * work. */ #ifndef PORTABLE_MACROS_H @@ -19,6 +29,29 @@ # endif #endif +/* + * We use __alloc_size__, but it was only available in fairly recent versions + * of GCC. Suppress warnings about the unknown attribute if GCC is too old. + * We know that we're GCC at this point, so we can use the GCC variadic macro + * extension, which will still work with versions of GCC too old to have C99 + * variadic macro support. + */ +#if !defined(__attribute__) && !defined(__alloc_size__) +# if __GNUC__ < 4 || (__GNUC__ == 4 && __GNUC_MINOR__ < 3) +# define __alloc_size__(spec, args...) /* empty */ +# endif +#endif + +/* + * LLVM and Clang pretend to be GCC but don't support all of the __attribute__ + * settings that GCC does. For them, suppress warnings about unknown + * attributes on declarations. This unfortunately will affect the entire + * compilation context, but there's no push and pop available. + */ +#if !defined(__attribute__) && (defined(__llvm__) || defined(__clang__)) +# pragma GCC diagnostic ignored "-Wattributes" +#endif + /* * BEGIN_DECLS is used at the beginning of declarations so that C++ * compilers don't mangle their names. END_DECLS is used at the end. diff --git a/portable/mkstemp.c b/portable/mkstemp.c index dd2a485..8668db1 100644 --- a/portable/mkstemp.c +++ b/portable/mkstemp.c @@ -4,8 +4,18 @@ * Provides the same functionality as the library function mkstemp for those * systems that don't have it. * + * The canonical version of this file is maintained in the rra-c-util package, + * which can be found at . + * * Written by Russ Allbery - * This work is hereby placed in the public domain by its author. + * + * The authors hereby relinquish any claim to any copyright that they may have + * in this work, whether granted under contract or by operation of law or + * international treaty, and hereby commit to the public, at large, that they + * shall not, at any time in the future, seek to enforce any copyright in this + * work against any person or entity, or prevent any person or entity from + * copying, publishing, distributing or creating derivative works of this + * work. */ #include @@ -27,7 +37,7 @@ int test_mkstemp(char *); #endif /* Pick the longest available integer type. */ -#if HAVE_LONG_LONG +#if HAVE_LONG_LONG_INT typedef unsigned long long long_int_type; #else typedef unsigned long long_int_type; diff --git a/portable/setenv.c b/portable/setenv.c index d66ddcd..fd2b10c 100644 --- a/portable/setenv.c +++ b/portable/setenv.c @@ -4,8 +4,18 @@ * Provides the same functionality as the standard library routine setenv for * those platforms that don't have it. * + * The canonical version of this file is maintained in the rra-c-util package, + * which can be found at . + * * Written by Russ Allbery - * This work is hereby placed in the public domain by its author. + * + * The authors hereby relinquish any claim to any copyright that they may have + * in this work, whether granted under contract or by operation of law or + * international treaty, and hereby commit to the public, at large, that they + * shall not, at any time in the future, seek to enforce any copyright in this + * work against any person or entity, or prevent any person or entity from + * copying, publishing, distributing or creating derivative works of this + * work. */ #include @@ -31,10 +41,9 @@ setenv(const char *name, const char *value, int overwrite) /* * Allocate memory for the environment string. We intentionally don't use - * concat here, or the xmalloc family of allocation routines, since the - * intention is to provide a replacement for the standard library function - * which sets errno and returns in the event of a memory allocation - * failure. + * the xmalloc family of allocation routines here, since the intention is + * to provide a replacement for the standard library function that sets + * errno and returns in the event of a memory allocation failure. */ size = strlen(name) + 1 + strlen(value) + 1; envstring = malloc(size); diff --git a/portable/snprintf.c b/portable/snprintf.c index ab3121c..91c8491 100644 --- a/portable/snprintf.c +++ b/portable/snprintf.c @@ -8,6 +8,9 @@ * Please do not reformat or otherwise change this file more than necessary so * that later merges with the original source are easy. Bug fixes and * improvements should be sent back to the original author. + * + * The canonical version of this file is maintained in the rra-c-util package, + * which can be found at . */ /* diff --git a/portable/stdbool.h b/portable/stdbool.h index bfbf4c4..045436f 100644 --- a/portable/stdbool.h +++ b/portable/stdbool.h @@ -5,13 +5,31 @@ * following the C99 specification, on hosts that don't have stdbool.h. This * logic is based heavily on the example in the Autoconf manual. * + * The canonical version of this file is maintained in the rra-c-util package, + * which can be found at . + * * Written by Russ Allbery - * This work is hereby placed in the public domain by its author. + * + * The authors hereby relinquish any claim to any copyright that they may have + * in this work, whether granted under contract or by operation of law or + * international treaty, and hereby commit to the public, at large, that they + * shall not, at any time in the future, seek to enforce any copyright in this + * work against any person or entity, or prevent any person or entity from + * copying, publishing, distributing or creating derivative works of this + * work. */ #ifndef PORTABLE_STDBOOL_H #define PORTABLE_STDBOOL_H 1 +/* + * Allow inclusion of config.h to be skipped, since sometimes we have to use a + * stripped-down version of config.h with a different name. + */ +#ifndef CONFIG_H_INCLUDED +# include +#endif + #if HAVE_STDBOOL_H # include #else diff --git a/portable/strlcat.c b/portable/strlcat.c index f696db3..3bee4ee 100644 --- a/portable/strlcat.c +++ b/portable/strlcat.c @@ -9,8 +9,18 @@ * space available in the destination buffer, not just the amount of space * remaining. * + * The canonical version of this file is maintained in the rra-c-util package, + * which can be found at . + * * Written by Russ Allbery - * This work is hereby placed in the public domain by its author. + * + * The authors hereby relinquish any claim to any copyright that they may have + * in this work, whether granted under contract or by operation of law or + * international treaty, and hereby commit to the public, at large, that they + * shall not, at any time in the future, seek to enforce any copyright in this + * work against any person or entity, or prevent any person or entity from + * copying, publishing, distributing or creating derivative works of this + * work. */ #include diff --git a/portable/strlcpy.c b/portable/strlcpy.c index 596e968..df75fd8 100644 --- a/portable/strlcpy.c +++ b/portable/strlcpy.c @@ -8,8 +8,18 @@ * total space required is returned. The destination string is not nul-filled * like strncpy does, just nul-terminated. * + * The canonical version of this file is maintained in the rra-c-util package, + * which can be found at . + * * Written by Russ Allbery - * This work is hereby placed in the public domain by its author. + * + * The authors hereby relinquish any claim to any copyright that they may have + * in this work, whether granted under contract or by operation of law or + * international treaty, and hereby commit to the public, at large, that they + * shall not, at any time in the future, seek to enforce any copyright in this + * work against any person or entity, or prevent any person or entity from + * copying, publishing, distributing or creating derivative works of this + * work. */ #include diff --git a/portable/system.h b/portable/system.h index 461601b..d1ccc94 100644 --- a/portable/system.h +++ b/portable/system.h @@ -13,13 +13,24 @@ * #include * #include * #include + * #include * #include * * Missing functions are provided via #define or prototyped if available from * the portable helper library. Also provides some standard #defines. * + * The canonical version of this file is maintained in the rra-c-util package, + * which can be found at . + * * Written by Russ Allbery - * This work is hereby placed in the public domain by its author. + * + * The authors hereby relinquish any claim to any copyright that they may have + * in this work, whether granted under contract or by operation of law or + * international treaty, and hereby commit to the public, at large, that they + * shall not, at any time in the future, seek to enforce any copyright in this + * work against any person or entity, or prevent any person or entity from + * copying, publishing, distributing or creating derivative works of this + * work. */ #ifndef PORTABLE_SYSTEM_H @@ -38,6 +49,9 @@ #include #include #include +#if HAVE_STRINGS_H +# include +#endif #if HAVE_INTTYPES_H # include #endif @@ -56,6 +70,38 @@ /* Get the bool type. */ #include +/* Windows provides snprintf under a different name. */ +#ifdef _WIN32 +# define snprintf _snprintf +#endif + +/* Windows does not define ssize_t. */ +#ifndef HAVE_SSIZE_T +typedef ptrdiff_t ssize_t; +#endif + +/* + * POSIX requires that these be defined in . If one of them has + * been defined, all the rest almost certainly have. + */ +#ifndef STDIN_FILENO +# define STDIN_FILENO 0 +# define STDOUT_FILENO 1 +# define STDERR_FILENO 2 +#endif + +/* + * C99 requires va_copy. Older versions of GCC provide __va_copy. Per the + * Autoconf manual, memcpy is a generally portable fallback. + */ +#ifndef va_copy +# ifdef __va_copy +# define va_copy(d, s) __va_copy((d), (s)) +# else +# define va_copy(d, s) memcpy(&(d), &(s), sizeof(va_list)) +# endif +#endif + BEGIN_DECLS /* Default to a hidden visibility for all portability functions. */ @@ -96,31 +142,4 @@ extern size_t strlcpy(char *, const char *, size_t); END_DECLS -/* Windows provides snprintf under a different name. */ -#ifdef _WIN32 -# define snprintf _snprintf -#endif - -/* - * POSIX requires that these be defined in . If one of them has - * been defined, all the rest almost certainly have. - */ -#ifndef STDIN_FILENO -# define STDIN_FILENO 0 -# define STDOUT_FILENO 1 -# define STDERR_FILENO 2 -#endif - -/* - * C99 requires va_copy. Older versions of GCC provide __va_copy. Per the - * Autoconf manual, memcpy is a generally portable fallback. - */ -#ifndef va_copy -# ifdef __va_copy -# define va_copy(d, s) __va_copy((d), (s)) -# else -# define va_copy(d, s) memcpy(&(d), &(s), sizeof(va_list)) -# endif -#endif - #endif /* !PORTABLE_SYSTEM_H */ diff --git a/portable/uio.h b/portable/uio.h index 3c9e840..3bd1f96 100644 --- a/portable/uio.h +++ b/portable/uio.h @@ -5,8 +5,18 @@ * (primarily Windows). Currently, the corresponding readv and writev * functions are not provided or prototyped here. * + * The canonical version of this file is maintained in the rra-c-util package, + * which can be found at . + * * Written by Russ Allbery - * This work is hereby placed in the public domain by its author. + * + * The authors hereby relinquish any claim to any copyright that they may have + * in this work, whether granted under contract or by operation of law or + * international treaty, and hereby commit to the public, at large, that they + * shall not, at any time in the future, seek to enforce any copyright in this + * work against any person or entity, or prevent any person or entity from + * copying, publishing, distributing or creating derivative works of this + * work. */ #ifndef PORTABLE_UIO_H diff --git a/tests/client/full-t.in b/tests/client/full-t.in index ce2789d..680e78f 100644 --- a/tests/client/full-t.in +++ b/tests/client/full-t.in @@ -56,19 +56,19 @@ chdir "$ENV{SOURCE}" or die "Cannot chdir to $ENV{SOURCE}: $!\n"; SKIP: { skip 'no keytab configuration', $total - unless -f "$ENV{BUILD}/data/test.keytab"; + unless -f "$ENV{BUILD}/config/keytab"; my $remctld = '@REMCTLD@'; skip 'remctld not found', $total unless $remctld; # Spawn remctld and get local tickets. Don't destroy the user's Kerberos # ticket cache. unlink ('krb5cc_test', 'test-pid'); - my $principal = contents ("$ENV{BUILD}/data/test.principal"); + my $principal = contents ("$ENV{BUILD}/config/principal"); remctld_spawn ($remctld, $principal, - "$ENV{BUILD}/data/test.keytab", + "$ENV{BUILD}/config/keytab", "$ENV{SOURCE}/data/full.conf"); $ENV{KRB5CCNAME} = 'krb5cc_test'; - getcreds ("$ENV{BUILD}/data/test.keytab", $principal); + getcreds ("$ENV{BUILD}/config/keytab", $principal); # Use Wallet::Admin to set up the database. db_setup; diff --git a/tests/client/prompt-t.in b/tests/client/prompt-t.in index 1d8b079..682cd70 100644 --- a/tests/client/prompt-t.in +++ b/tests/client/prompt-t.in @@ -21,11 +21,11 @@ chdir "$ENV{SOURCE}" or die "Cannot chdir to $ENV{SOURCE}: $!\n"; SKIP: { skip 'no password configuration', $total - unless -f "$ENV{BUILD}/data/test.password"; + unless -f "$ENV{BUILD}/config/password"; my $remctld = '@REMCTLD@'; skip 'remctld not found', $total unless $remctld; eval { require Expect }; - skip 'Exepct module not found', $total if $@; + skip 'Expect module not found', $total if $@; # Disable sending of wallet's output to our standard output. Do this # twice to avoid Perl warnings. @@ -34,14 +34,14 @@ SKIP: { # Spawn remctld and set up with a different ticket cache. unlink ('krb5cc_test', 'test-pid'); - my $principal = contents ("$ENV{BUILD}/data/test.principal"); - remctld_spawn ($remctld, $principal, "$ENV{BUILD}/data/test.keytab", + my $principal = contents ("$ENV{BUILD}/config/principal"); + remctld_spawn ($remctld, $principal, "$ENV{BUILD}/config/keytab", "$ENV{SOURCE}/data/basic.conf"); $ENV{KRB5CCNAME} = 'krb5cc_test'; # Read in the principal and password. - open (PASS, '<', "$ENV{BUILD}/data/test.password") - or die "Cannot open $ENV{BUILD}/data/test.password: $!\n"; + open (PASS, '<', "$ENV{BUILD}/config/password") + or die "Cannot open $ENV{BUILD}/config/password: $!\n"; my $user = ; my $password = ; close PASS; diff --git a/tests/config/README b/tests/config/README new file mode 100644 index 0000000..2992a11 --- /dev/null +++ b/tests/config/README @@ -0,0 +1,24 @@ +This directory contains configuration required to run the complete wallet +test suite. If there is no configuration in this directory, some of the +tests will be skipped. To enable the full test suite, create the +following files: + +keytab + + A valid Kerberos keytab for a principal, preferrably in your local + realm. This will be used to test network interactions that require + Kerberos authentication. + +principal + + The name of the Kerberos principal whose keys are stored in keytab. + +password + + This file should contain two lines. The first line is the + fully-qualified principal (including the realm) of a Kerberos + principal to use for testing authentication. The second line is + the password for that principal. The realm of the principal must + be configured in your system krb5.conf file or in DNS configuration + picked up by your Kerberos libraries and must be in the same realm as + the keytab above or have valid cross-realm trust to it. diff --git a/tests/data/perl.conf b/tests/data/perl.conf new file mode 100644 index 0000000..eaf7443 --- /dev/null +++ b/tests/data/perl.conf @@ -0,0 +1,6 @@ +# Configuration for Perl tests. -*- perl -*- + +# No special configuration yet. + +# File must end with this line. +1; diff --git a/tests/docs/pod-spelling-t b/tests/docs/pod-spelling-t index eaa7dd6..e1a95cd 100755 --- a/tests/docs/pod-spelling-t +++ b/tests/docs/pod-spelling-t @@ -1,80 +1,52 @@ #!/usr/bin/perl # -# Check for spelling errors in POD documentation +# Checks all POD files in the tree for spelling errors using Test::Spelling. +# This test is disabled unless RRA_MAINTAINER_TESTS is set, since spelling +# dictionaries vary too much between environments. # -# 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. +# The canonical version of this file is maintained in the rra-c-util package, +# which can be found at . # -# Copyright 2008, 2009 Russ Allbery +# Written by Russ Allbery +# Copyright 2012, 2013 +# The Board of Trustees of the Leland Stanford Junior University # -# See LICENSE for licensing terms. +# 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. +use 5.006; use strict; -use Test::More; +use warnings; -# 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}; +use lib "$ENV{SOURCE}/tap/perl"; + +use Test::More; +use Test::RRA qw(skip_unless_maintainer use_prereq); +use Test::RRA::Automake qw(automake_setup perl_dirs); -# 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 $@; +# Only run this test for the maintainer. +skip_unless_maintainer('Spelling tests'); -# 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; +# Load prerequisite modules. +use_prereq('Test::Spelling'); -# 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 client/wallet-rekey.pod server/keytab-backend - server/wallet-admin server/wallet-backend server/wallet-report); -plan tests => scalar @pod; +# Set up Automake testing. +automake_setup(); -# 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 = ; - close CHILD; - SKIP: { - skip "@spell failed for $pod", 1 unless $? == 0; - for (@words) { - s/^\s+//; - s/\s+$//; - } - is ("@words", '', $pod); - } - } -} +# Run the tests. +all_pod_files_spelling_ok(perl_dirs()); diff --git a/tests/docs/pod-t b/tests/docs/pod-t index e25ade2..2743287 100755 --- a/tests/docs/pod-t +++ b/tests/docs/pod-t @@ -1,22 +1,48 @@ #!/usr/bin/perl -w # -# Test POD formatting for documentation. +# Check all POD documents in the tree, except for any embedded Perl module +# distribution, for POD formatting errors. +# +# The canonical version of this file is maintained in the rra-c-util package, +# which can be found at . # # Written by Russ Allbery -# Copyright 2008, 2010 Board of Trustees, Leland Stanford Jr. University +# Copyright 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: # -# See LICENSE for licensing terms. +# 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. +use 5.006; use strict; +use warnings; + +use lib "$ENV{SOURCE}/tap/perl"; + use Test::More; -eval 'use Test::Pod 1.00'; -plan skip_all => 'Test::Pod 1.00 required for testing POD' if $@; +use Test::RRA qw(use_prereq); +use Test::RRA::Automake qw(automake_setup perl_dirs); + +# Load prerequisite modules. +use_prereq('Test::Pod'); + +# Set up Automake testing. +automake_setup(); -my @files = qw(client/wallet.pod client/wallet-rekey.pod server/keytab-backend - server/wallet-admin server/wallet-backend - server/wallet-report); -my $total = scalar (@files); -plan tests => $total; -for my $file (@files) { - pod_file_ok ("$ENV{SOURCE}/../$file", $file); -} +# Run the tests. +all_pod_files_ok(perl_dirs()); diff --git a/tests/portable/asprintf-t.c b/tests/portable/asprintf-t.c index 04fbd1b..4513a85 100644 --- a/tests/portable/asprintf-t.c +++ b/tests/portable/asprintf-t.c @@ -1,11 +1,18 @@ /* * asprintf and vasprintf test suite. * + * The canonical version of this file is maintained in the rra-c-util package, + * which can be found at . + * * Written by Russ Allbery - * Copyright 2006, 2008, 2009 - * Board of Trustees, Leland Stanford Jr. University * - * See LICENSE for licensing terms. + * The authors hereby relinquish any claim to any copyright that they may have + * in this work, whether granted under contract or by operation of law or + * international treaty, and hereby commit to the public, at large, that they + * shall not, at any time in the future, seek to enforce any copyright in this + * work against any person or entity, or prevent any person or entity from + * copying, publishing, distributing or creating derivative works of this + * work. */ #include diff --git a/tests/portable/mkstemp-t.c b/tests/portable/mkstemp-t.c index 54701f7..98c708e 100644 --- a/tests/portable/mkstemp-t.c +++ b/tests/portable/mkstemp-t.c @@ -1,11 +1,18 @@ /* * mkstemp test suite. * + * The canonical version of this file is maintained in the rra-c-util package, + * which can be found at . + * * Written by Russ Allbery - * Copyright 2002, 2004, 2008, 2009 - * Board of Trustees, Leland Stanford Jr. University * - * See LICENSE for licensing terms. + * The authors hereby relinquish any claim to any copyright that they may have + * in this work, whether granted under contract or by operation of law or + * international treaty, and hereby commit to the public, at large, that they + * shall not, at any time in the future, seek to enforce any copyright in this + * work against any person or entity, or prevent any person or entity from + * copying, publishing, distributing or creating derivative works of this + * work. */ #include diff --git a/tests/portable/setenv-t.c b/tests/portable/setenv-t.c index 5bc59ce..a1aecb5 100644 --- a/tests/portable/setenv-t.c +++ b/tests/portable/setenv-t.c @@ -1,14 +1,18 @@ /* * setenv test suite. * + * The canonical version of this file is maintained in the rra-c-util package, + * which can be found at . + * * Written by Russ Allbery - * Copyright 2009 Board of Trustees, Leland Stanford Jr. University - * Copyright (c) 2004, 2005, 2006 - * by Internet Systems Consortium, Inc. ("ISC") - * Copyright (c) 1991, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, - * 2002, 2003 by The Internet Software Consortium and Rich Salz * - * See LICENSE for licensing terms. + * The authors hereby relinquish any claim to any copyright that they may have + * in this work, whether granted under contract or by operation of law or + * international treaty, and hereby commit to the public, at large, that they + * shall not, at any time in the future, seek to enforce any copyright in this + * work against any person or entity, or prevent any person or entity from + * copying, publishing, distributing or creating derivative works of this + * work. */ #include diff --git a/tests/portable/snprintf-t.c b/tests/portable/snprintf-t.c index 4b64f5b..927de96 100644 --- a/tests/portable/snprintf-t.c +++ b/tests/portable/snprintf-t.c @@ -1,14 +1,20 @@ /* * snprintf test suite. * + * The canonical version of this file is maintained in the rra-c-util package, + * which can be found at . + * * Written by Russ Allbery - * Copyright 2009, 2010 Board of Trustees, Leland Stanford Jr. University - * Copyright (c) 2004, 2005, 2006 - * by Internet Systems Consortium, Inc. ("ISC") - * Copyright (c) 1991, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, - * 2002, 2003 by The Internet Software Consortium and Rich Salz + * Copyright 2000, 2001, 2002, 2003, 2004, 2005, 2006 + * Russ Allbery + * Copyright 2009, 2010 + * The Board of Trustees of the Leland Stanford Junior University + * Copyright 1995 Patrick Powell + * Copyright 2001 Hrvoje Niksic * - * See LICENSE for licensing terms. + * This code is based on code written by Patrick Powell (papowell@astart.com) + * It may be used for any purpose as long as this notice remains intact + * on all source code distributions */ #include diff --git a/tests/portable/strlcat-t.c b/tests/portable/strlcat-t.c index e02c277..54d0d40 100644 --- a/tests/portable/strlcat-t.c +++ b/tests/portable/strlcat-t.c @@ -1,14 +1,18 @@ /* * strlcat test suite. * + * The canonical version of this file is maintained in the rra-c-util package, + * which can be found at . + * * Written by Russ Allbery - * Copyright 2009 Board of Trustees, Leland Stanford Jr. University - * Copyright (c) 2004, 2005, 2006 - * by Internet Systems Consortium, Inc. ("ISC") - * Copyright (c) 1991, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, - * 2002, 2003 by The Internet Software Consortium and Rich Salz * - * See LICENSE for licensing terms. + * The authors hereby relinquish any claim to any copyright that they may have + * in this work, whether granted under contract or by operation of law or + * international treaty, and hereby commit to the public, at large, that they + * shall not, at any time in the future, seek to enforce any copyright in this + * work against any person or entity, or prevent any person or entity from + * copying, publishing, distributing or creating derivative works of this + * work. */ #include diff --git a/tests/portable/strlcpy-t.c b/tests/portable/strlcpy-t.c index ba224ba..26aa8f2 100644 --- a/tests/portable/strlcpy-t.c +++ b/tests/portable/strlcpy-t.c @@ -1,14 +1,18 @@ /* * strlcpy test suite. * + * The canonical version of this file is maintained in the rra-c-util package, + * which can be found at . + * * Written by Russ Allbery - * Copyright 2009 Board of Trustees, Leland Stanford Jr. University - * Copyright (c) 2004, 2005, 2006 - * by Internet Systems Consortium, Inc. ("ISC") - * Copyright (c) 1991, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, - * 2002, 2003 by The Internet Software Consortium and Rich Salz * - * See LICENSE for licensing terms. + * The authors hereby relinquish any claim to any copyright that they may have + * in this work, whether granted under contract or by operation of law or + * international treaty, and hereby commit to the public, at large, that they + * shall not, at any time in the future, seek to enforce any copyright in this + * work against any person or entity, or prevent any person or entity from + * copying, publishing, distributing or creating derivative works of this + * work. */ #include diff --git a/tests/runtests.c b/tests/runtests.c index ab77629..4249875 100644 --- a/tests/runtests.c +++ b/tests/runtests.c @@ -3,14 +3,15 @@ * * Usage: * - * runtests + * runtests [-b ] [-s ] + * runtests -o [-b ] [-s ] * - * Expects a list of executables located in the given file, one line per - * executable. For each one, runs it as part of a test suite, reporting - * results. Test output should start with a line containing the number of - * tests (numbered from 1 to this number), optionally preceded by "1..", - * although that line may be given anywhere in the output. Each additional - * line should be in the following format: + * In the first case, expects a list of executables located in the given file, + * one line per executable. For each one, runs it as part of a test suite, + * reporting results. Test output should start with a line containing the + * number of tests (numbered from 1 to this number), optionally preceded by + * "1..", although that line may be given anywhere in the output. Each + * additional line should be in the following format: * * ok * not ok @@ -39,10 +40,21 @@ * This is a subset of TAP as documented in Test::Harness::TAP or * TAP::Parser::Grammar, which comes with Perl. * + * If the -o option is given, instead run a single test and display all of its + * output. This is intended for use with failing tests so that the person + * running the test suite can get more details about what failed. + * + * If built with the C preprocessor symbols SOURCE and BUILD defined, C TAP + * Harness will export those values in the environment so that tests can find + * the source and build directory and will look for tests under both + * directories. These paths can also be set with the -b and -s command-line + * options, which will override anything set at build time. + * * Any bug reports, bug fixes, and improvements are very much welcome and - * should be sent to the e-mail address below. + * should be sent to the e-mail address below. This program is part of C TAP + * Harness . * - * Copyright 2000, 2001, 2004, 2006, 2007, 2008, 2009, 2010 + * Copyright 2000, 2001, 2004, 2006, 2007, 2008, 2009, 2010, 2011 * Russ Allbery * * Permission is hereby granted, free of charge, to any person obtaining a @@ -64,6 +76,13 @@ * DEALINGS IN THE SOFTWARE. */ +/* Required for fdopen(), getopt(), and putenv(). */ +#if defined(__STRICT_ANSI__) || defined(PEDANTIC) +# ifndef _XOPEN_SOURCE +# define _XOPEN_SOURCE 500 +# endif +#endif + #include #include #include @@ -71,6 +90,7 @@ #include #include #include +#include #include #include #include @@ -133,10 +153,10 @@ struct testset { unsigned long skipped; /* Count of skipped tests (passed). */ unsigned long allocated; /* The size of the results table. */ enum test_status *results; /* Table of results by test number. */ - int aborted; /* Whether the set as aborted. */ + unsigned int aborted; /* Whether the set as aborted. */ int reported; /* Whether the results were reported. */ int status; /* The exit status of the test. */ - int all_skipped; /* Whether all tests were skipped. */ + unsigned int all_skipped; /* Whether all tests were skipped. */ char *reason; /* Why all tests were skipped. */ }; @@ -146,6 +166,23 @@ struct testlist { struct testlist *next; }; +/* + * Usage message. Should be used as a printf format with two arguments: the + * path to runtests, given twice. + */ +static const char usage_message[] = "\ +Usage: %s [-b ] [-s ] \n\ + %s -o [-b ] [-s ] \n\ +\n\ +Options:\n\ + -b Set the build directory to \n\ + -o Run a single test rather than a list of tests\n\ + -s Set the source directory to \n\ +\n\ +runtests normally runs each test listed in a file whose path is given as\n\ +its command-line argument. With the -o option, it instead runs a single\n\ +test and shows its complete output.\n"; + /* * Header used for test output. %s is replaced by the file name of the list * of tests. @@ -367,7 +404,9 @@ test_plan(const char *line, struct testset *ts) * Get the count, check it for validity, and initialize the struct. If we * have something of the form "1..0 # skip foo", the whole file was * skipped; record that. If we do skip the whole file, zero out all of - * our statistics, since they're no longer relevant. + * our statistics, since they're no longer relevant. strtol is called + * with a second argument to advance the line pointer past the count to + * make it simpler to detect the # skip case. */ n = strtol(line, (char **) &line, 10); if (n == 0) { @@ -437,6 +476,7 @@ test_checkline(const char *line, struct testset *ts) char *end; long number; unsigned long i, current; + int outlen; /* Before anything, check for a test abort. */ bail = strstr(line, "Bail out!"); @@ -557,7 +597,8 @@ test_checkline(const char *line, struct testset *ts) ts->results[current - 1] = status; test_backspace(ts); if (isatty(STDOUT_FILENO)) { - ts->length = printf("%lu/%lu", current, ts->count); + outlen = printf("%lu/%lu", current, ts->count); + ts->length = (outlen >= 0) ? outlen : 0; fflush(stdout); } } @@ -565,23 +606,20 @@ test_checkline(const char *line, struct testset *ts) /* * Print out a range of test numbers, returning the number of characters it - * took up. Add a comma and a space before the range if chars indicates that + * took up. Takes the first number, the last number, the number of characters + * already printed on the line, and the limit of number of characters the line + * can hold. Add a comma and a space before the range if chars indicates that * something has already been printed on the line, and print ... instead if * chars plus the space needed would go over the limit (use a limit of 0 to - * disable this. + * disable this). */ static unsigned int test_print_range(unsigned long first, unsigned long last, unsigned int chars, unsigned int limit) { unsigned int needed = 0; - unsigned int out = 0; unsigned long n; - if (chars > 0) { - needed += 2; - if (!limit || chars <= limit) out += printf(", "); - } for (n = first; n > 0; n /= 10) needed++; if (last > first) { @@ -589,15 +627,26 @@ test_print_range(unsigned long first, unsigned long last, unsigned int chars, needed++; needed++; } - if (limit && chars + needed > limit) { - if (chars <= limit) - out += printf("..."); + if (chars > 0) + needed += 2; + if (limit > 0 && chars + needed > limit) { + needed = 0; + if (chars <= limit) { + if (chars > 0) { + printf(", "); + needed += 2; + } + printf("..."); + needed += 3; + } } else { + if (chars > 0) + printf(", "); if (last > first) - out += printf("%lu-", first); - out += printf("%lu", last); + printf("%lu-", first); + printf("%lu", last); } - return out; + return needed; } @@ -825,14 +874,14 @@ test_fail_summary(const struct testlist *fails) last = i + 1; else { if (first != 0) - chars += test_print_range(first, last, chars, 20); + chars += test_print_range(first, last, chars, 19); first = i + 1; last = i + 1; } } } if (first != 0) - test_print_range(first, last, chars, 20); + test_print_range(first, last, chars, 19); putchar('\n'); free(ts->file); free(ts->path); @@ -861,10 +910,17 @@ find_test(const char *name, struct testset *ts, const char *source, const char *build) { char *path; - const char *bases[] = { ".", build, source, NULL }; + const char *bases[4]; unsigned int i; - for (i = 0; bases[i] != NULL; i++) { + bases[0] = "."; + bases[1] = build; + bases[2] = source; + bases[3] = NULL; + + for (i = 0; i < 3; i++) { + if (bases[i] == NULL) + continue; path = xmalloc(strlen(bases[i]) + strlen(name) + 4); sprintf(path, "%s/%s-t", bases[i], name); if (access(path, X_OK) != 0) @@ -993,6 +1049,7 @@ test_batch(const char *testlist, const char *source, const char *build) failed += ts.failed; } total -= skipped; + fclose(tests); /* Stop the timer and get our child resource statistics. */ gettimeofday(&end, NULL); @@ -1060,17 +1117,23 @@ int main(int argc, char *argv[]) { int option; + int status = 0; int single = 0; - char *setting; + char *source_env = NULL; + char *build_env = NULL; const char *list; const char *source = SOURCE; const char *build = BUILD; - while ((option = getopt(argc, argv, "b:os:")) != EOF) { + while ((option = getopt(argc, argv, "b:hos:")) != EOF) { switch (option) { case 'b': build = optarg; break; + case 'h': + printf(usage_message, argv[0], argv[0]); + exit(0); + break; case 'o': single = 1; break; @@ -1081,36 +1144,46 @@ main(int argc, char *argv[]) exit(1); } } - argc -= optind; - argv += optind; - if (argc != 1) { - fprintf(stderr, "Usage: runtests \n"); + if (argc - optind != 1) { + fprintf(stderr, usage_message, argv[0], argv[0]); exit(1); } + argc -= optind; + argv += optind; if (source != NULL) { - setting = xmalloc(strlen("SOURCE=") + strlen(source) + 1); - sprintf(setting, "SOURCE=%s", source); - if (putenv(setting) != 0) + source_env = xmalloc(strlen("SOURCE=") + strlen(source) + 1); + sprintf(source_env, "SOURCE=%s", source); + if (putenv(source_env) != 0) sysdie("cannot set SOURCE in the environment"); } if (build != NULL) { - setting = xmalloc(strlen("BUILD=") + strlen(build) + 1); - sprintf(setting, "BUILD=%s", build); - if (putenv(setting) != 0) + build_env = xmalloc(strlen("BUILD=") + strlen(build) + 1); + sprintf(build_env, "BUILD=%s", build); + if (putenv(build_env) != 0) sysdie("cannot set BUILD in the environment"); } - if (single) { + if (single) test_single(argv[0], source, build); - exit(0); - } else { + else { list = strrchr(argv[0], '/'); if (list == NULL) list = argv[0]; else list++; printf(banner, list); - exit(test_batch(argv[0], source, build) ? 0 : 1); + status = test_batch(argv[0], source, build) ? 0 : 1; + } + + /* For valgrind cleanliness. */ + if (source_env != NULL) { + putenv((char *) "SOURCE="); + free(source_env); + } + if (build_env != NULL) { + putenv((char *) "BUILD="); + free(build_env); } + exit(status); } diff --git a/tests/tap/basic.c b/tests/tap/basic.c index 829f91a..e8196fc 100644 --- a/tests/tap/basic.c +++ b/tests/tap/basic.c @@ -1,22 +1,38 @@ /* * Some utility routines for writing tests. * - * Herein are a variety of utility routines for writing tests. All routines - * of the form ok() or is*() take a test number and some number of appropriate - * arguments, check to be sure the results match the expected output using the - * arguments, and print out something appropriate for that test number. Other - * utility routines help in constructing more complex tests, skipping tests, - * or setting up the TAP output format. + * Here are a variety of utility routines for writing tests compatible with + * the TAP protocol. All routines of the form ok() or is*() take a test + * number and some number of appropriate arguments, check to be sure the + * results match the expected output using the arguments, and print out + * something appropriate for that test number. Other utility routines help in + * constructing more complex tests, skipping tests, reporting errors, setting + * up the TAP output format, or finding things in the test environment. * - * Copyright 2009, 2010 Russ Allbery - * Copyright 2006, 2007, 2008 - * Board of Trustees, Leland Stanford Jr. University - * Copyright (c) 2004, 2005, 2006 - * by Internet Systems Consortium, Inc. ("ISC") - * Copyright (c) 1991, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, - * 2002, 2003 by The Internet Software Consortium and Rich Salz + * This file is part of C TAP Harness. The current version plus supporting + * documentation is at . * - * See LICENSE for licensing terms. + * Copyright 2009, 2010, 2011, 2012 Russ Allbery + * Copyright 2001, 2002, 2004, 2005, 2006, 2007, 2008, 2011, 2012 + * 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. */ #include @@ -24,12 +40,21 @@ #include #include #include +#ifdef _WIN32 +# include +#else +# include +#endif #include -#include -#include #include -#include +#include + +/* Windows provides mkdir and rmdir under different names. */ +#ifdef _WIN32 +# define mkdir(p, m) _mkdir(p) +# define rmdir(p) _rmdir(p) +#endif /* * The test count. Always contains the number that will be used for the next @@ -57,7 +82,9 @@ static int _lazy = 0; /* * Our exit handler. Called on completion of the test to report a summary of - * results provided we're still in the original process. + * results provided we're still in the original process. This also handles + * printing out the plan if we used plan_lazy(), although that's suppressed if + * we never ran a test (due to an early bail, for example). */ static void finish(void) @@ -66,8 +93,9 @@ finish(void) if (_planned == 0 && !_lazy) return; + fflush(stderr); if (_process != 0 && getpid() == _process) { - if (_lazy) { + if (_lazy && highest > 0) { printf("1..%lu\n", highest); _planned = highest; } @@ -98,6 +126,7 @@ plan(unsigned long count) if (setvbuf(stdout, NULL, _IOLBF, BUFSIZ) != 0) fprintf(stderr, "# cannot set stdout to line buffered: %s\n", strerror(errno)); + fflush(stderr); printf("1..%lu\n", count); testnum = 1; _planned = count; @@ -130,6 +159,7 @@ plan_lazy(void) void skip_all(const char *format, ...) { + fflush(stderr); printf("1..0 # skip"); if (format != NULL) { va_list args; @@ -162,6 +192,7 @@ print_desc(const char *format, va_list args) void ok(int success, const char *format, ...) { + fflush(stderr); printf("%sok %lu", success ? "" : "not ", testnum++); if (!success) _failed++; @@ -182,6 +213,7 @@ ok(int success, const char *format, ...) void okv(int success, const char *format, va_list args) { + fflush(stderr); printf("%sok %lu", success ? "" : "not ", testnum++); if (!success) _failed++; @@ -197,6 +229,7 @@ okv(int success, const char *format, va_list args) void skip(const char *reason, ...) { + fflush(stderr); printf("ok %lu # skip", testnum++); if (reason != NULL) { va_list args; @@ -218,6 +251,7 @@ ok_block(unsigned long count, int status, const char *format, ...) { unsigned long i; + fflush(stderr); for (i = 0; i < count; i++) { printf("%sok %lu", status ? "" : "not ", testnum++); if (!status) @@ -242,6 +276,7 @@ skip_block(unsigned long count, const char *reason, ...) { unsigned long i; + fflush(stderr); for (i = 0; i < count; i++) { printf("ok %lu # skip", testnum++); if (reason != NULL) { @@ -264,6 +299,7 @@ skip_block(unsigned long count, const char *reason, ...) void is_int(long wanted, long seen, const char *format, ...) { + fflush(stderr); if (wanted == seen) printf("ok %lu", testnum++); else { @@ -293,6 +329,7 @@ is_string(const char *wanted, const char *seen, const char *format, ...) wanted = "(null)"; if (seen == NULL) seen = "(null)"; + fflush(stderr); if (strcmp(wanted, seen) == 0) printf("ok %lu", testnum++); else { @@ -311,31 +348,6 @@ is_string(const char *wanted, const char *seen, const char *format, ...) } -/* - * Takes an expected double and a seen double and assumes the test passes if - * those two numbers match. - */ -void -is_double(double wanted, double seen, const char *format, ...) -{ - if (wanted == seen) - printf("ok %lu", testnum++); - else { - printf("# wanted: %g\n# seen: %g\n", wanted, seen); - printf("not ok %lu", testnum++); - _failed++; - } - if (format != NULL) { - va_list args; - - va_start(args, format); - print_desc(format, args); - va_end(args); - } - putchar('\n'); -} - - /* * Takes an expected unsigned long and a seen unsigned long and assumes the * test passes if the two numbers match. Otherwise, reports them in hex. @@ -343,6 +355,7 @@ is_double(double wanted, double seen, const char *format, ...) void is_hex(unsigned long wanted, unsigned long seen, const char *format, ...) { + fflush(stderr); if (wanted == seen) printf("ok %lu", testnum++); else { @@ -370,6 +383,7 @@ bail(const char *format, ...) { va_list args; + fflush(stderr); fflush(stdout); printf("Bail out! "); va_start(args, format); @@ -389,6 +403,7 @@ sysbail(const char *format, ...) va_list args; int oerrno = errno; + fflush(stderr); fflush(stdout); printf("Bail out! "); va_start(args, format); @@ -407,6 +422,7 @@ diag(const char *format, ...) { va_list args; + fflush(stderr); fflush(stdout); printf("# "); va_start(args, format); @@ -425,6 +441,7 @@ sysdiag(const char *format, ...) va_list args; int oerrno = errno; + fflush(stderr); fflush(stdout); printf("# "); va_start(args, format); @@ -434,6 +451,92 @@ sysdiag(const char *format, ...) } +/* + * Allocate cleared memory, reporting a fatal error with bail on failure. + */ +void * +bcalloc(size_t n, size_t size) +{ + void *p; + + p = calloc(n, size); + if (p == NULL) + sysbail("failed to calloc %lu", (unsigned long)(n * size)); + return p; +} + + +/* + * Allocate memory, reporting a fatal error with bail on failure. + */ +void * +bmalloc(size_t size) +{ + void *p; + + p = malloc(size); + if (p == NULL) + sysbail("failed to malloc %lu", (unsigned long) size); + return p; +} + + +/* + * Reallocate memory, reporting a fatal error with bail on failure. + */ +void * +brealloc(void *p, size_t size) +{ + p = realloc(p, size); + if (p == NULL) + sysbail("failed to realloc %lu bytes", (unsigned long) size); + return p; +} + + +/* + * Copy a string, reporting a fatal error with bail on failure. + */ +char * +bstrdup(const char *s) +{ + char *p; + size_t len; + + len = strlen(s) + 1; + p = malloc(len); + if (p == NULL) + sysbail("failed to strdup %lu bytes", (unsigned long) len); + memcpy(p, s, len); + return p; +} + + +/* + * Copy up to n characters of a string, reporting a fatal error with bail on + * failure. Don't use the system strndup function, since it may not exist and + * the TAP library doesn't assume any portability support. + */ +char * +bstrndup(const char *s, size_t n) +{ + const char *p; + char *copy; + size_t length; + + /* Don't assume that the source string is nul-terminated. */ + for (p = s; (size_t) (p - s) < n && *p != '\0'; p++) + ; + length = p - s; + copy = malloc(length + 1); + if (p == NULL) + sysbail("failed to strndup %lu bytes", (unsigned long) length); + memcpy(copy, s, length); + copy[length] = '\0'; + return copy; +} + + /* * Locate a test file. Given the partial path to a file, look under BUILD and * then SOURCE for the file and return the full path to the file. Returns @@ -458,9 +561,7 @@ test_file_path(const char *file) if (base == NULL) continue; length = strlen(base) + 1 + strlen(file) + 1; - path = malloc(length); - if (path == NULL) - sysbail("cannot allocate memory"); + path = bmalloc(length); sprintf(path, "%s/%s", base, file); if (access(path, R_OK) == 0) break; @@ -482,3 +583,47 @@ test_file_path_free(char *path) if (path != NULL) free(path); } + + +/* + * Create a temporary directory, tmp, under BUILD if set and the current + * directory if it does not. Returns the path to the temporary directory in + * newly allocated memory, and calls bail on any failure. The return value + * should be freed with test_tmpdir_free. + * + * This function uses sprintf because it attempts to be independent of all + * other portability layers. The use immediately after a memory allocation + * should be safe without using snprintf or strlcpy/strlcat. + */ +char * +test_tmpdir(void) +{ + const char *build; + char *path = NULL; + size_t length; + + build = getenv("BUILD"); + if (build == NULL) + build = "."; + length = strlen(build) + strlen("/tmp") + 1; + path = bmalloc(length); + sprintf(path, "%s/tmp", build); + if (access(path, X_OK) < 0) + if (mkdir(path, 0777) < 0) + sysbail("error creating temporary directory %s", path); + return path; +} + + +/* + * Free a path returned from test_tmpdir() and attempt to remove the + * directory. If we can't delete the directory, don't worry; something else + * that hasn't yet cleaned up may still be using it. + */ +void +test_tmpdir_free(char *path) +{ + rmdir(path); + if (path != NULL) + free(path); +} diff --git a/tests/tap/basic.h b/tests/tap/basic.h index 9602db4..fa4adaf 100644 --- a/tests/tap/basic.h +++ b/tests/tap/basic.h @@ -1,47 +1,38 @@ /* * Basic utility routines for the TAP protocol. * - * Copyright 2009, 2010 Russ Allbery - * Copyright 2006, 2007, 2008 - * Board of Trustees, Leland Stanford Jr. University - * Copyright (c) 2004, 2005, 2006 - * by Internet Systems Consortium, Inc. ("ISC") - * Copyright (c) 1991, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, - * 2002, 2003 by The Internet Software Consortium and Rich Salz + * This file is part of C TAP Harness. The current version plus supporting + * documentation is at . * - * See LICENSE for licensing terms. + * Copyright 2009, 2010, 2011, 2012 Russ Allbery + * Copyright 2001, 2002, 2004, 2005, 2006, 2007, 2008, 2011, 2012 + * 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. */ #ifndef TAP_BASIC_H #define TAP_BASIC_H 1 +#include #include /* va_list */ -#include /* pid_t */ - -/* - * __attribute__ is available in gcc 2.5 and later, but only with gcc 2.7 - * could you use the __format__ form of the attributes, which is what we use - * (to avoid confusion with other macros). - */ -#ifndef __attribute__ -# if __GNUC__ < 2 || (__GNUC__ == 2 && __GNUC_MINOR__ < 7) -# define __attribute__(spec) /* empty */ -# endif -#endif - -/* - * BEGIN_DECLS is used at the beginning of declarations so that C++ - * compilers don't mangle their names. END_DECLS is used at the end. - */ -#undef BEGIN_DECLS -#undef END_DECLS -#ifdef __cplusplus -# define BEGIN_DECLS extern "C" { -# define END_DECLS } -#else -# define BEGIN_DECLS /* empty */ -# define END_DECLS /* empty */ -#endif +#include /* size_t */ /* * Used for iterating through arrays. ARRAY_SIZE returns the number of @@ -93,8 +84,6 @@ void skip_block(unsigned long count, const char *reason, ...) /* Check an expected value against a seen value. */ void is_int(long wanted, long seen, const char *format, ...) __attribute__((__format__(printf, 3, 4))); -void is_double(double wanted, double seen, const char *format, ...) - __attribute__((__format__(printf, 3, 4))); void is_string(const char *wanted, const char *seen, const char *format, ...) __attribute__((__format__(printf, 3, 4))); void is_hex(unsigned long wanted, unsigned long seen, const char *format, ...) @@ -112,6 +101,18 @@ void diag(const char *format, ...) void sysdiag(const char *format, ...) __attribute__((__nonnull__, __format__(printf, 1, 2))); +/* Allocate memory, reporting a fatal error with bail on failure. */ +void *bcalloc(size_t, size_t) + __attribute__((__alloc_size__(1, 2), __malloc__)); +void *bmalloc(size_t) + __attribute__((__alloc_size__(1), __malloc__)); +void *brealloc(void *, size_t) + __attribute__((__alloc_size__(2), __malloc__)); +char *bstrdup(const char *) + __attribute__((__malloc__, __nonnull__)); +char *bstrndup(const char *, size_t) + __attribute__((__malloc__, __nonnull__)); + /* * Find a test file under BUILD or SOURCE, returning the full path. The * returned path should be freed with test_file_path_free(). @@ -120,6 +121,14 @@ char *test_file_path(const char *file) __attribute__((__malloc__, __nonnull__)); void test_file_path_free(char *path); +/* + * Create a temporary directory relative to BUILD and return the path. The + * returned path should be freed with test_tmpdir_free. + */ +char *test_tmpdir(void) + __attribute__((__malloc__)); +void test_tmpdir_free(char *path); + END_DECLS #endif /* TAP_BASIC_H */ diff --git a/tests/tap/kerberos.c b/tests/tap/kerberos.c index a17d980..474cf4f 100644 --- a/tests/tap/kerberos.c +++ b/tests/tap/kerberos.c @@ -1,47 +1,90 @@ /* * Utility functions for tests that use Kerberos. * - * Currently only provides kerberos_setup(), which assumes a particular set of - * data files in either the SOURCE or BUILD directories and, using those, - * obtains Kerberos credentials, sets up a ticket cache, and sets the - * environment variable pointing to the Kerberos keytab to use for testing. + * The core function is kerberos_setup, which loads Kerberos test + * configuration and returns a struct of information. It also supports + * obtaining initial tickets from the configured keytab and setting up + * KRB5CCNAME and KRB5_KTNAME if a Kerberos keytab is present. Also included + * are utility functions for setting up a krb5.conf file and reporting + * Kerberos errors or warnings during testing. * - * Copyright 2006, 2007, 2009, 2010 - * Board of Trustees, Leland Stanford Jr. University + * Some of the functionality here is only available if the Kerberos libraries + * are available. * - * See LICENSE for licensing terms. + * The canonical version of this file is maintained in the rra-c-util package, + * which can be found at . + * + * Written by Russ Allbery + * Copyright 2006, 2007, 2009, 2010, 2011, 2012 + * 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. */ #include -#include +#ifdef HAVE_KERBEROS +# include +#endif #include +#include + #include #include -#include -#include +#include +#include + +/* + * Disable the requirement that format strings be literals, since it's easier + * to handle the possible patterns for kinit commands as an array. + */ +#pragma GCC diagnostic ignored "-Wformat-nonliteral" /* - * Obtain Kerberos tickets for the principal specified in test.principal using - * the keytab specified in test.keytab, both of which are presumed to be in - * tests/data in either the build or the source tree. - * - * Returns the contents of test.principal in newly allocated memory or NULL if - * Kerberos tests are apparently not configured. If Kerberos tests are - * configured but something else fails, calls bail(). + * These variables hold the allocated configuration struct, the environment to + * point to a different Kerberos ticket cache, keytab, and configuration file, + * and the temporary directories used. We store them so that we can free them + * on exit for cleaner valgrind output, making it easier to find real memory + * leaks in the tested programs. + */ +static struct kerberos_config *config = NULL; +static char *krb5ccname = NULL; +static char *krb5_ktname = NULL; +static char *krb5_config = NULL; +static char *tmpdir_ticket = NULL; +static char *tmpdir_conf = NULL; + + +/* + * Obtain Kerberos tickets and fill in the principal config entry. * - * The error handling here is not great. We should have a bail_krb5 that uses - * the same logic as messages-krb5.c, which hasn't yet been imported into - * rra-c-util. + * There are two implementations of this function, one if we have native + * Kerberos libraries available and one if we don't. Uses keytab to obtain + * credentials, and fills in the cache member of the provided config struct. */ -char * -kerberos_setup(void) +#ifdef HAVE_KERBEROS + +static void +kerberos_kinit(void) { - char *path, *krbtgt; - const char *build, *realm; - FILE *file; - char principal[BUFSIZ]; + char *name, *krbtgt; krb5_error_code code; krb5_context ctx; krb5_ccache ccache; @@ -49,89 +92,397 @@ kerberos_setup(void) krb5_keytab keytab; krb5_get_init_creds_opt *opts; krb5_creds creds; + const char *realm; - /* Read the principal name and find the keytab file. */ - path = test_file_path("data/test.principal"); - if (path == NULL) - return NULL; - file = fopen(path, "r"); - if (file == NULL) { - free(path); - return NULL; - } - if (fgets(principal, sizeof(principal), file) == NULL) { - fclose(file); - bail("cannot read %s", path); - } - fclose(file); - if (principal[strlen(principal) - 1] != '\n') - bail("no newline in %s", path); - free(path); - principal[strlen(principal) - 1] = '\0'; - path = test_file_path("data/test.keytab"); - if (path == NULL) - return NULL; - - /* Set the KRB5CCNAME and KRB5_KTNAME environment variables. */ - build = getenv("BUILD"); - if (build == NULL) - build = "."; - putenv(concat("KRB5CCNAME=", build, "/data/test.cache", (char *) 0)); - putenv(concat("KRB5_KTNAME=", path, (char *) 0)); - - /* Now do the Kerberos initialization. */ + /* + * Determine the principal corresponding to that keytab. We copy the + * memory to ensure that it's allocated in the right memory domain on + * systems where that may matter (like Windows). + */ code = krb5_init_context(&ctx); if (code != 0) - bail("error initializing Kerberos"); + bail_krb5(ctx, code, "error initializing Kerberos"); + kprinc = kerberos_keytab_principal(ctx, config->keytab); + code = krb5_unparse_name(ctx, kprinc, &name); + if (code != 0) + bail_krb5(ctx, code, "error unparsing name"); + krb5_free_principal(ctx, kprinc); + config->principal = bstrdup(name); + krb5_free_unparsed_name(ctx, name); + + /* Now do the Kerberos initialization. */ code = krb5_cc_default(ctx, &ccache); if (code != 0) - bail("error setting ticket cache"); - code = krb5_parse_name(ctx, principal, &kprinc); + bail_krb5(ctx, code, "error setting ticket cache"); + code = krb5_parse_name(ctx, config->principal, &kprinc); if (code != 0) - bail("error parsing principal %s", principal); + bail_krb5(ctx, code, "error parsing principal %s", config->principal); realm = krb5_principal_get_realm(ctx, kprinc); - krbtgt = concat("krbtgt/", realm, "@", realm, (char *) 0); - code = krb5_kt_resolve(ctx, path, &keytab); + basprintf(&krbtgt, "krbtgt/%s@%s", realm, realm); + code = krb5_kt_resolve(ctx, config->keytab, &keytab); if (code != 0) - bail("cannot open keytab %s", path); + bail_krb5(ctx, code, "cannot open keytab %s", config->keytab); code = krb5_get_init_creds_opt_alloc(ctx, &opts); if (code != 0) - bail("cannot allocate credential options"); + bail_krb5(ctx, code, "cannot allocate credential options"); krb5_get_init_creds_opt_set_default_flags(ctx, NULL, realm, opts); krb5_get_init_creds_opt_set_forwardable(opts, 0); krb5_get_init_creds_opt_set_proxiable(opts, 0); code = krb5_get_init_creds_keytab(ctx, &creds, kprinc, keytab, 0, krbtgt, opts); if (code != 0) - bail("cannot get Kerberos tickets"); + bail_krb5(ctx, code, "cannot get Kerberos tickets"); code = krb5_cc_initialize(ctx, ccache, kprinc); if (code != 0) - bail("error initializing ticket cache"); + bail_krb5(ctx, code, "error initializing ticket cache"); code = krb5_cc_store_cred(ctx, ccache, &creds); if (code != 0) - bail("error storing credentials"); + bail_krb5(ctx, code, "error storing credentials"); krb5_cc_close(ctx, ccache); krb5_free_cred_contents(ctx, &creds); krb5_kt_close(ctx, keytab); krb5_free_principal(ctx, kprinc); + krb5_get_init_creds_opt_free(ctx, opts); krb5_free_context(ctx); free(krbtgt); - free(path); +} - return xstrdup(principal); +#else /* !HAVE_KERBEROS */ + +static void +kerberos_kinit(void) +{ + static const char * const format[] = { + "kinit --no-afslog -k -t %s %s >/dev/null 2>&1 /dev/null 2>&1 /dev/null 2>&1 /dev/null 2>&1 keytab); + config->keytab = NULL; + return; + } + file = fopen(path, "r"); + if (file == NULL) { + test_file_path_free(path); + return; + } + test_file_path_free(path); + if (fgets(principal, sizeof(principal), file) == NULL) + bail("cannot read %s", path); + fclose(file); + if (principal[strlen(principal) - 1] != '\n') + bail("no newline in %s", path); + principal[strlen(principal) - 1] = '\0'; + config->principal = bstrdup(principal); + + /* Now do the Kerberos initialization. */ + for (i = 0; i < ARRAY_SIZE(format); i++) { + basprintf(&command, format[i], config->keytab, principal); + status = system(command); + free(command); + if (status != -1 && WEXITSTATUS(status) == 0) + break; + } + if (status == -1 || WEXITSTATUS(status) != 0) + bail("cannot get Kerberos tickets"); } +#endif /* !HAVE_KERBEROS */ + /* - * Clean up at the end of a test. Currently, all this does is remove the - * ticket cache. + * Clean up at the end of a test. This removes the ticket cache and resets + * and frees the memory allocated for the environment variables so that + * valgrind output on test suites is cleaner. */ void kerberos_cleanup(void) { char *path; - path = concatpath(getenv("BUILD"), "data/test.cache"); - unlink(path); - free(path); + if (tmpdir_ticket != NULL) { + basprintf(&path, "%s/krb5cc_test", tmpdir_ticket); + unlink(path); + free(path); + test_tmpdir_free(tmpdir_ticket); + tmpdir_ticket = NULL; + } + if (config != NULL) { + if (config->keytab != NULL) { + test_file_path_free(config->keytab); + free(config->principal); + free(config->cache); + } + if (config->userprinc != NULL) { + free(config->userprinc); + free(config->username); + free(config->password); + } + free(config); + config = NULL; + } + if (krb5ccname != NULL) { + putenv((char *) "KRB5CCNAME="); + free(krb5ccname); + krb5ccname = NULL; + } + if (krb5_ktname != NULL) { + putenv((char *) "KRB5_KTNAME="); + free(krb5_ktname); + krb5_ktname = NULL; + } +} + + +/* + * Obtain Kerberos tickets for the principal specified in config/principal + * using the keytab specified in config/keytab, both of which are presumed to + * be in tests in either the build or the source tree. Also sets KRB5_KTNAME + * and KRB5CCNAME. + * + * Returns the contents of config/principal in newly allocated memory or NULL + * if Kerberos tests are apparently not configured. If Kerberos tests are + * configured but something else fails, calls bail. + */ +struct kerberos_config * +kerberos_setup(enum kerberos_needs needs) +{ + char *path; + char buffer[BUFSIZ]; + FILE *file = NULL; + + /* If we were called before, clean up after the previous run. */ + if (config != NULL) + kerberos_cleanup(); + config = bcalloc(1, sizeof(struct kerberos_config)); + + /* + * If we have a config/keytab file, set the KRB5CCNAME and KRB5_KTNAME + * environment variables and obtain initial tickets. + */ + config->keytab = test_file_path("config/keytab"); + if (config->keytab == NULL) { + if (needs == TAP_KRB_NEEDS_KEYTAB || needs == TAP_KRB_NEEDS_BOTH) + skip_all("Kerberos tests not configured"); + } else { + tmpdir_ticket = test_tmpdir(); + basprintf(&config->cache, "%s/krb5cc_test", tmpdir_ticket); + basprintf(&krb5ccname, "KRB5CCNAME=%s/krb5cc_test", tmpdir_ticket); + basprintf(&krb5_ktname, "KRB5_KTNAME=%s", config->keytab); + putenv(krb5ccname); + putenv(krb5_ktname); + kerberos_kinit(); + } + + /* + * If we have a config/password file, read it and fill out the relevant + * members of our config struct. + */ + path = test_file_path("config/password"); + if (path != NULL) + file = fopen(path, "r"); + if (file == NULL) { + if (needs == TAP_KRB_NEEDS_PASSWORD || needs == TAP_KRB_NEEDS_BOTH) + skip_all("Kerberos tests not configured"); + } else { + if (fgets(buffer, sizeof(buffer), file) == NULL) + bail("cannot read %s", path); + if (buffer[strlen(buffer) - 1] != '\n') + bail("no newline in %s", path); + buffer[strlen(buffer) - 1] = '\0'; + config->userprinc = bstrdup(buffer); + if (fgets(buffer, sizeof(buffer), file) == NULL) + bail("cannot read password from %s", path); + fclose(file); + if (buffer[strlen(buffer) - 1] != '\n') + bail("password too long in %s", path); + buffer[strlen(buffer) - 1] = '\0'; + config->password = bstrdup(buffer); + + /* + * Strip the realm from the principal and set realm and username. + * This is not strictly correct; it doesn't cope with escaped @-signs + * or enterprise names. + */ + config->username = bstrdup(config->userprinc); + config->realm = strchr(config->username, '@'); + if (config->realm == NULL) + bail("test principal has no realm"); + *config->realm = '\0'; + config->realm++; + } + if (path != NULL) + test_file_path_free(path); + + /* + * Register the cleanup function as an atexit handler so that the caller + * doesn't have to worry about cleanup. + */ + if (atexit(kerberos_cleanup) != 0) + sysdiag("cannot register cleanup function"); + + /* Return the configuration. */ + return config; +} + + +/* + * Clean up the krb5.conf file generated by kerberos_generate_conf and free + * the memory used to set the environment variable. This doesn't fail if the + * file and variable are already gone, allowing it to be harmlessly run + * multiple times. + * + * Normally called via an atexit handler. + */ +void +kerberos_cleanup_conf(void) +{ + char *path; + + if (tmpdir_conf != NULL) { + basprintf(&path, "%s/krb5.conf", tmpdir_conf); + unlink(path); + free(path); + test_tmpdir_free(tmpdir_conf); + tmpdir_conf = NULL; + } + putenv((char *) "KRB5_CONFIG="); + if (krb5_config != NULL) { + free(krb5_config); + krb5_config = NULL; + } } + + +/* + * Generate a krb5.conf file for testing and set KRB5_CONFIG to point to it. + * The [appdefaults] section will be stripped out and the default realm will + * be set to the realm specified, if not NULL. This will use config/krb5.conf + * in preference, so users can configure the tests by creating that file if + * the system file isn't suitable. + * + * Depends on data/generate-krb5-conf being present in the test suite. + */ +void +kerberos_generate_conf(const char *realm) +{ + char *path; + const char *argv[3]; + + if (tmpdir_conf != NULL) + kerberos_cleanup_conf(); + path = test_file_path("data/generate-krb5-conf"); + if (path == NULL) + bail("cannot find generate-krb5-conf"); + argv[0] = path; + argv[1] = realm; + argv[2] = NULL; + run_setup(argv); + test_file_path_free(path); + tmpdir_conf = test_tmpdir(); + basprintf(&krb5_config, "KRB5_CONFIG=%s/krb5.conf", tmpdir_conf); + putenv(krb5_config); + if (atexit(kerberos_cleanup_conf) != 0) + sysdiag("cannot register cleanup function"); +} + + +/* + * The remaining functions in this file are only available if Kerberos + * libraries are available. + */ +#ifdef HAVE_KERBEROS + + +/* + * Report a Kerberos error and bail out. + */ +void +bail_krb5(krb5_context ctx, krb5_error_code code, const char *format, ...) +{ + const char *k5_msg = NULL; + char *message; + va_list args; + + if (ctx != NULL) + k5_msg = krb5_get_error_message(ctx, code); + va_start(args, format); + bvasprintf(&message, format, args); + va_end(args); + if (k5_msg == NULL) + bail("%s", message); + else + bail("%s: %s", message, k5_msg); +} + + +/* + * Report a Kerberos error as a diagnostic to stderr. + */ +void +diag_krb5(krb5_context ctx, krb5_error_code code, const char *format, ...) +{ + const char *k5_msg = NULL; + char *message; + va_list args; + + if (ctx != NULL) + k5_msg = krb5_get_error_message(ctx, code); + va_start(args, format); + bvasprintf(&message, format, args); + va_end(args); + if (k5_msg == NULL) + diag("%s", message); + else + diag("%s: %s", message, k5_msg); + free(message); + if (k5_msg != NULL) + krb5_free_error_message(ctx, k5_msg); +} + + +/* + * Find the principal of the first entry of a keytab and return it. The + * caller is responsible for freeing the result with krb5_free_principal. + * Exit on error. + */ +krb5_principal +kerberos_keytab_principal(krb5_context ctx, const char *path) +{ + krb5_keytab keytab; + krb5_kt_cursor cursor; + krb5_keytab_entry entry; + krb5_principal princ; + krb5_error_code status; + + status = krb5_kt_resolve(ctx, path, &keytab); + if (status != 0) + bail_krb5(ctx, status, "error opening %s", path); + status = krb5_kt_start_seq_get(ctx, keytab, &cursor); + if (status != 0) + bail_krb5(ctx, status, "error reading %s", path); + status = krb5_kt_next_entry(ctx, keytab, &entry, &cursor); + if (status == 0) { + status = krb5_copy_principal(ctx, entry.principal, &princ); + if (status != 0) + bail_krb5(ctx, status, "error copying principal from %s", path); + krb5_kt_free_entry(ctx, &entry); + } + if (status != 0) + bail("no principal found in keytab file %s", path); + krb5_kt_end_seq_get(ctx, keytab, &cursor); + krb5_kt_close(ctx, keytab); + return princ; +} + +#endif /* HAVE_KERBEROS */ diff --git a/tests/tap/kerberos.h b/tests/tap/kerberos.h index 1c64f70..31b6343 100644 --- a/tests/tap/kerberos.h +++ b/tests/tap/kerberos.h @@ -1,32 +1,125 @@ /* * Utility functions for tests that use Kerberos. * - * Copyright 2006, 2007, 2009 - * Board of Trustees, Leland Stanford Jr. University + * The canonical version of this file is maintained in the rra-c-util package, + * which can be found at . * - * See LICENSE for licensing terms. + * Written by Russ Allbery + * Copyright 2006, 2007, 2009, 2011, 2012 + * 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. */ #ifndef TAP_KERBEROS_H #define TAP_KERBEROS_H 1 #include -#include +#include + +#ifdef HAVE_KERBEROS +# include +#endif + +/* Holds the information parsed from the Kerberos test configuration. */ +struct kerberos_config { + char *keytab; /* Path to the keytab. */ + char *principal; /* Principal whose keys are in the keytab. */ + char *cache; /* Path to the Kerberos ticket cache. */ + char *userprinc; /* The fully-qualified principal. */ + char *username; /* The local (non-realm) part of principal. */ + char *realm; /* The realm part of the principal. */ + char *password; /* The password. */ +}; + +/* + * Whether to skip all tests (by calling skip_all) in kerberos_setup if + * certain configuration information isn't available. + */ +enum kerberos_needs { + TAP_KRB_NEEDS_NONE, + TAP_KRB_NEEDS_KEYTAB, + TAP_KRB_NEEDS_PASSWORD, + TAP_KRB_NEEDS_BOTH +}; BEGIN_DECLS /* - * Set up Kerberos, returning the test principal in newly allocated memory if - * we were successful. If there is no principal in tests/data/test.principal - * or no keytab in tests/data/test.keytab, return NULL. Otherwise, on - * failure, calls bail(). + * Set up Kerberos, returning the test configuration information. This + * obtains Kerberos tickets from config/keytab, if one is present, and stores + * them in a Kerberos ticket cache, sets KRB5_KTNAME and KRB5CCNAME. It also + * loads the principal and password from config/password, if it exists, and + * stores the principal, password, username, and realm in the returned struct. + * + * If there is no config/keytab file, KRB5_KTNAME and KRB5CCNAME won't be set + * and the keytab field will be NULL. If there is no config/password file, + * the principal field will be NULL. If the files exist but loading them + * fails, or authentication fails, kerberos_setup calls bail. + * + * kerberos_cleanup will be set up to run from an atexit handler. This means + * that any child processes that should not remove the Kerberos ticket cache + * should call _exit instead of exit. The principal will be automatically + * freed when kerberos_cleanup is called or if kerberos_setup is called again. + * The caller doesn't need to worry about it. */ -char *kerberos_setup(void) +struct kerberos_config *kerberos_setup(enum kerberos_needs) __attribute__((__malloc__)); - -/* Clean up at the end of a test. */ void kerberos_cleanup(void); +/* + * Generate a krb5.conf file for testing and set KRB5_CONFIG to point to it. + * The [appdefaults] section will be stripped out and the default realm will + * be set to the realm specified, if not NULL. This will use config/krb5.conf + * in preference, so users can configure the tests by creating that file if + * the system file isn't suitable. + * + * Depends on data/generate-krb5-conf being present in the test suite. + * + * kerberos_cleanup_conf will clean up after this function, but usually + * doesn't need to be called directly since it's registered as an atexit + * handler. + */ +void kerberos_generate_conf(const char *realm); +void kerberos_cleanup_conf(void); + +/* Thes interfaces are only available with native Kerberos support. */ +#ifdef HAVE_KERBEROS + +/* Bail out with an error, appending the Kerberos error message. */ +void bail_krb5(krb5_context, krb5_error_code, const char *format, ...) + __attribute__((__noreturn__, __nonnull__, __format__(printf, 3, 4))); + +/* Report a diagnostic with Kerberos error to stderr prefixed with #. */ +void diag_krb5(krb5_context, krb5_error_code, const char *format, ...) + __attribute__((__nonnull__, __format__(printf, 3, 4))); + +/* + * Given a Kerberos context and the path to a keytab, retrieve the principal + * for the first entry in the keytab and return it. Calls bail on failure. + * The returned principal should be freed with krb5_free_principal. + */ +krb5_principal kerberos_keytab_principal(krb5_context, const char *path) + __attribute__((__nonnull__)); + +#endif /* HAVE_KERBEROS */ + END_DECLS #endif /* !TAP_MESSAGES_H */ diff --git a/tests/tap/kerberos.sh b/tests/tap/kerberos.sh index 904cae5..d2f174d 100644 --- a/tests/tap/kerberos.sh +++ b/tests/tap/kerberos.sh @@ -1,30 +1,61 @@ # Shell function library to initialize Kerberos credentials # +# Note that while many of the functions in this library could benefit from +# using "local" to avoid possibly hammering global variables, Solaris /bin/sh +# doesn't support local and this library aspires to be portable to Solaris +# Bourne shell. Instead, all private variables are prefixed with "tap_". +# +# The canonical version of this file is maintained in the rra-c-util package, +# which can be found at . +# # Written by Russ Allbery -# Copyright 2009, 2010 Board of Trustees, Leland Stanford Jr. University +# Copyright 2009, 2010, 2011, 2012 +# 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. # -# See LICENSE for licensing terms. +# 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. + +# We use test_tmpdir. +. "${SOURCE}/tap/libtap.sh" # Set up Kerberos, including the ticket cache environment variable. Bail out # if not successful, return 0 if successful, and return 1 if Kerberos is not # configured. Sets the global principal variable to the principal to use. kerberos_setup () { - local keytab - keytab=`test_file_path data/test.keytab` - principal=`test_file_path data/test.principal` + tap_keytab=`test_file_path config/keytab` + principal=`test_file_path config/principal` principal=`cat "$principal" 2>/dev/null` - if [ -z "$keytab" ] || [ -z "$principal" ] ; then + if [ -z "$tap_keytab" ] || [ -z "$principal" ] ; then return 1 fi - KRB5CCNAME="$BUILD/data/test.cache"; export KRB5CCNAME - kinit -k -t "$keytab" "$principal" >/dev/null /dev/null /dev/null /dev/null /dev/null /dev/null /dev/null ktutil-tmp 2>/dev/null ; then + tap_tmp=`test_tmpdir` + if klist -keK "$1" > "$tap_tmp"/ktutil-tmp 2>/dev/null ; then : else - ktutil -k "$1" list --keys > ktutil-tmp < /dev/null 2>/dev/null + ktutil -k "$1" list --keys > "$tap_tmp"/ktutil-tmp /dev/null fi - sed -e '/Keytab name:/d' -e "/^[^ ]*:/d" ktutil-tmp > "$2" - rm -f ktutil-tmp + sed -e '/Keytab name:/d' -e "/^[^ ]*:/d" "$tap_tmp"/ktutil-tmp > "$2" + rm -f "$tap_tmp"/ktutil-tmp } diff --git a/tests/tap/libtap.sh b/tests/tap/libtap.sh index a9b46d4..f9347d8 100644 --- a/tests/tap/libtap.sh +++ b/tests/tap/libtap.sh @@ -1,10 +1,36 @@ # Shell function library for test cases. # +# Note that while many of the functions in this library could benefit from +# using "local" to avoid possibly hammering global variables, Solaris /bin/sh +# doesn't support local and this library aspires to be portable to Solaris +# Bourne shell. Instead, all private variables are prefixed with "tap_". +# +# This file provides a TAP-compatible shell function library useful for +# writing test cases. It is part of C TAP Harness, which can be found at +# . +# # Written by Russ Allbery -# Copyright 2009, 2010 Russ Allbery -# Copyright 2006, 2007, 2008 Board of Trustees, Leland Stanford Jr. University +# Copyright 2009, 2010, 2011, 2012 Russ Allbery +# Copyright 2006, 2007, 2008 +# 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: # -# See LICENSE for licensing terms. +# 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. # Print out the number of test cases we expect to run. plan () { @@ -25,33 +51,35 @@ plan_lazy () { # Report the test status on exit. finish () { - local highest looks - highest=`expr "$count" - 1` + tap_highest=`expr "$count" - 1` if [ "$planned" = 0 ] ; then - echo "1..$highest" - planned="$highest" + echo "1..$tap_highest" + planned="$tap_highest" fi - looks='# Looks like you' + tap_looks='# Looks like you' if [ "$planned" -gt 0 ] ; then - if [ "$planned" -gt "$highest" ] ; then + if [ "$planned" -gt "$tap_highest" ] ; then if [ "$planned" -gt 1 ] ; then - echo "$looks planned $planned tests but only ran $highest" + echo "$tap_looks planned $planned tests but only ran" \ + "$tap_highest" else - echo "$looks planned $planned test but only ran $highest" + echo "$tap_looks planned $planned test but only ran" \ + "$tap_highest" fi - elif [ "$planned" -lt "$highest" ] ; then - local extra - extra=`expr "$highest" - "$planned"` + elif [ "$planned" -lt "$tap_highest" ] ; then + tap_extra=`expr "$tap_highest" - "$planned"` if [ "$planned" -gt 1 ] ; then - echo "$looks planned $planned tests but ran $extra extra" + echo "$tap_looks planned $planned tests but ran" \ + "$tap_extra extra" else - echo "$looks planned $planned test but ran $extra extra" + echo "$tap_looks planned $planned test but ran" \ + "$tap_extra extra" fi elif [ "$failed" -gt 0 ] ; then if [ "$failed" -gt 1 ] ; then - echo "$looks failed $failed tests of $planned" + echo "$tap_looks failed $failed tests of $planned" else - echo "$looks failed $failed test of $planned" + echo "$tap_looks failed $failed test of $planned" fi elif [ "$planned" -gt 1 ] ; then echo "# All $planned tests successful or skipped" @@ -63,10 +91,9 @@ finish () { # Skip the entire test suite. Should be run instead of plan. skip_all () { - local desc - desc="$1" - if [ -n "$desc" ] ; then - echo "1..0 # skip $desc" + tap_desc="$1" + if [ -n "$tap_desc" ] ; then + echo "1..0 # skip $tap_desc" else echo "1..0 # skip" fi @@ -77,16 +104,15 @@ skip_all () { # command is successful, false otherwise. The count starts at 1 and is # updated each time ok is printed. ok () { - local desc - desc="$1" - if [ -n "$desc" ] ; then - desc=" - $desc" + tap_desc="$1" + if [ -n "$tap_desc" ] ; then + tap_desc=" - $tap_desc" fi shift if "$@" ; then - echo ok $count$desc + echo ok "$count$tap_desc" else - echo not ok $count$desc + echo not ok "$count$tap_desc" failed=`expr $failed + 1` fi count=`expr $count + 1` @@ -101,58 +127,80 @@ skip () { # Report the same status on a whole set of tests. Takes the count of tests, # the description, and then the command to run to determine the status. ok_block () { - local end i desc - i=$count - end=`expr $count + $1` - shift - desc="$1" + tap_i=$count + tap_end=`expr $count + $1` shift - while [ "$i" -lt "$end" ] ; do - ok "$desc" "$@" - i=`expr $i + 1` + while [ "$tap_i" -lt "$tap_end" ] ; do + ok "$@" + tap_i=`expr $tap_i + 1` done } # Skip a whole set of tests. Takes the count and then the reason for skipping # the test. skip_block () { - local i end - i=$count - end=`expr $count + $1` + tap_i=$count + tap_end=`expr $count + $1` shift - while [ "$i" -lt "$end" ] ; do + while [ "$tap_i" -lt "$tap_end" ] ; do skip "$@" - i=`expr $i + 1` + tap_i=`expr $tap_i + 1` done } +# Portable variant of printf '%s\n' "$*". In the majority of cases, this +# function is slower than printf, because the latter is often implemented +# as a builtin command. The value of the variable IFS is ignored. +# +# This macro must not be called via backticks inside double quotes, since this +# will result in bizarre escaping behavior and lots of extra backslashes on +# Solaris. +puts () { + cat << EOH +$@ +EOH +} + # Run a program expected to succeed, and print ok if it does and produces the # correct output. Takes the description, expected exit status, the expected -# output, the command to run, and then any arguments for that command. Strip -# a colon and everything after it off the output if the expected status is -# non-zero, since this is probably a system-specific error message. +# output, the command to run, and then any arguments for that command. +# Standard output and standard error are combined when analyzing the output of +# the command. +# +# If the command may contain system-specific error messages in its output, +# add strip_colon_error before the command to post-process its output. ok_program () { - local desc w_status w_output output status - desc="$1" + tap_desc="$1" shift - w_status="$1" + tap_w_status="$1" shift - w_output="$1" + tap_w_output="$1" shift - output=`"$@" 2>&1` - status=$? - if [ "$w_status" -ne 0 ] ; then - output=`echo "$output" | sed 's/^\([^:]* [^:]*\):.*/\1/'` - fi - if [ $status = $w_status ] && [ x"$output" = x"$w_output" ] ; then - ok "$desc" true + tap_output=`"$@" 2>&1` + tap_status=$? + if [ $tap_status = $tap_w_status ] \ + && [ x"$tap_output" = x"$tap_w_output" ] ; then + ok "$tap_desc" true else - echo "# saw: ($status) $output" - echo "# not: ($w_status) $w_output" - ok "$desc" false + echo "# saw: ($tap_status) $tap_output" + echo "# not: ($tap_w_status) $tap_w_output" + ok "$tap_desc" false fi } +# Strip a colon and everything after it off the output of a command, as long +# as that colon comes after at least one whitespace character. (This is done +# to avoid stripping the name of the program from the start of an error +# message.) This is used to remove system-specific error messages (coming +# from strerror, for example). +strip_colon_error() { + tap_output=`"$@" 2>&1` + tap_status=$? + tap_output=`puts "$tap_output" | sed 's/^\([^ ]* [^:]*\):.*/\1/'` + puts "$tap_output" + return $tap_status +} + # Bail out with an error message. bail () { echo 'Bail out!' "$@" @@ -167,12 +215,32 @@ diag () { # Search for the given file first in $BUILD and then in $SOURCE and echo the # path where the file was found, or the empty string if the file wasn't # found. +# +# This macro uses puts, so don't run it using backticks inside double quotes +# or bizarre quoting behavior will happen with Solaris sh. test_file_path () { - if [ -f "$BUILD/$1" ] ; then - echo "$BUILD/$1" - elif [ -f "$SOURCE/$1" ] ; then - echo "$SOURCE/$1" + if [ -n "$BUILD" ] && [ -f "$BUILD/$1" ] ; then + puts "$BUILD/$1" + elif [ -n "$SOURCE" ] && [ -f "$SOURCE/$1" ] ; then + puts "$SOURCE/$1" else echo '' fi } + +# Create $BUILD/tmp for use by tests for storing temporary files and return +# the path (via standard output). +# +# This macro uses puts, so don't run it using backticks inside double quotes +# or bizarre quoting behavior will happen with Solaris sh. +test_tmpdir () { + if [ -z "$BUILD" ] ; then + tap_tmpdir="./tmp" + else + tap_tmpdir="$BUILD"/tmp + fi + if [ ! -d "$tap_tmpdir" ] ; then + mkdir "$tap_tmpdir" || bail "Error creating $tap_tmpdir" + fi + puts "$tap_tmpdir" +} diff --git a/tests/tap/macros.h b/tests/tap/macros.h new file mode 100644 index 0000000..33fee42 --- /dev/null +++ b/tests/tap/macros.h @@ -0,0 +1,88 @@ +/* + * Helpful macros for TAP header files. + * + * This is not, strictly speaking, related to TAP, but any TAP add-on is + * probably going to need these macros, so define them in one place so that + * everyone can pull them in. + * + * This file is part of C TAP Harness. The current version plus supporting + * documentation is at . + * + * Copyright 2008, 2012 Russ Allbery + * + * 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. + */ + +#ifndef TAP_MACROS_H +#define TAP_MACROS_H 1 + +/* + * __attribute__ is available in gcc 2.5 and later, but only with gcc 2.7 + * could you use the __format__ form of the attributes, which is what we use + * (to avoid confusion with other macros), and only with gcc 2.96 can you use + * the attribute __malloc__. 2.96 is very old, so don't bother trying to get + * the other attributes to work with GCC versions between 2.7 and 2.96. + */ +#ifndef __attribute__ +# if __GNUC__ < 2 || (__GNUC__ == 2 && __GNUC_MINOR__ < 96) +# define __attribute__(spec) /* empty */ +# endif +#endif + +/* + * We use __alloc_size__, but it was only available in fairly recent versions + * of GCC. Suppress warnings about the unknown attribute if GCC is too old. + * We know that we're GCC at this point, so we can use the GCC variadic macro + * extension, which will still work with versions of GCC too old to have C99 + * variadic macro support. + */ +#if !defined(__attribute__) && !defined(__alloc_size__) +# if __GNUC__ < 4 || (__GNUC__ == 4 && __GNUC_MINOR__ < 3) +# define __alloc_size__(spec, args...) /* empty */ +# endif +#endif + +/* + * LLVM and Clang pretend to be GCC but don't support all of the __attribute__ + * settings that GCC does. For them, suppress warnings about unknown + * attributes on declarations. This unfortunately will affect the entire + * compilation context, but there's no push and pop available. + */ +#if !defined(__attribute__) && (defined(__llvm__) || defined(__clang__)) +# pragma GCC diagnostic ignored "-Wattributes" +#endif + +/* Used for unused parameters to silence gcc warnings. */ +#define UNUSED __attribute__((__unused__)) + +/* + * BEGIN_DECLS is used at the beginning of declarations so that C++ + * compilers don't mangle their names. END_DECLS is used at the end. + */ +#undef BEGIN_DECLS +#undef END_DECLS +#ifdef __cplusplus +# define BEGIN_DECLS extern "C" { +# define END_DECLS } +#else +# define BEGIN_DECLS /* empty */ +# define END_DECLS /* empty */ +#endif + +#endif /* TAP_MACROS_H */ diff --git a/tests/tap/messages.c b/tests/tap/messages.c index 3bb9a1a..abc2c49 100644 --- a/tests/tap/messages.c +++ b/tests/tap/messages.c @@ -5,24 +5,39 @@ * into a buffer that can be inspected later, allowing testing of error * handling. * - * Copyright 2006, 2007, 2009 - * Board of Trustees, Leland Stanford Jr. University - * Copyright (c) 2004, 2005, 2006 - * by Internet Systems Consortium, Inc. ("ISC") - * Copyright (c) 1991, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, - * 2002, 2003 by The Internet Software Consortium and Rich Salz + * The canonical version of this file is maintained in the rra-c-util package, + * which can be found at . * - * See LICENSE for licensing terms. + * Copyright 2002, 2004, 2005 Russ Allbery + * Copyright 2006, 2007, 2009, 2012 + * 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. */ #include #include +#include #include -#include -#include +#include #include -#include /* A global buffer into which message_log_buffer stores error messages. */ char *errors = NULL; @@ -33,18 +48,18 @@ char *errors = NULL; * error_capture. */ static void -message_log_buffer(int len, const char *fmt, va_list args, int error UNUSED) +message_log_buffer(int len UNUSED, const char *fmt, va_list args, + int error UNUSED) { char *message; - message = xmalloc(len + 1); - vsnprintf(message, len + 1, fmt, args); - if (errors == NULL) { - errors = concat(message, "\n", (char *) 0); - } else { + bvasprintf(&message, fmt, args); + if (errors == NULL) + basprintf(&errors, "%s\n", message); + else { char *new_errors; - new_errors = concat(errors, message, "\n", (char *) 0); + basprintf(&new_errors, "%s%s\n", errors, message); free(errors); errors = new_errors; } diff --git a/tests/tap/messages.h b/tests/tap/messages.h index 2b9a7db..0544f2d 100644 --- a/tests/tap/messages.h +++ b/tests/tap/messages.h @@ -1,21 +1,37 @@ /* * Utility functions to test message handling. * + * The canonical version of this file is maintained in the rra-c-util package, + * which can be found at . + * + * Copyright 2002 Russ Allbery * Copyright 2006, 2007, 2009 - * Board of Trustees, Leland Stanford Jr. University - * Copyright (c) 2004, 2005, 2006 - * by Internet Systems Consortium, Inc. ("ISC") - * Copyright (c) 1991, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, - * 2002, 2003 by The Internet Software Consortium and Rich Salz + * 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. * - * See LICENSE for licensing terms. + * 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. */ #ifndef TAP_MESSAGES_H #define TAP_MESSAGES_H 1 #include -#include +#include /* A global buffer into which errors_capture stores errors. */ extern char *errors; diff --git a/tests/tap/perl/Test/RRA.pm b/tests/tap/perl/Test/RRA.pm new file mode 100644 index 0000000..2d119f4 --- /dev/null +++ b/tests/tap/perl/Test/RRA.pm @@ -0,0 +1,222 @@ +# Helper functions for test programs written in Perl. +# +# This module provides a collection of helper functions used by test programs +# written in Perl. This is a general collection of functions that can be used +# by both C packages with Automake and by stand-alone Perl modules. See +# Test::RRA::Automake for additional functions specifically for C Automake +# distributions. +# +# The canonical version of this file is maintained in the rra-c-util package, +# which can be found at . +# +# Written by Russ Allbery +# Copyright 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. + +package Test::RRA; + +use 5.006; +use strict; +use warnings; + +use Exporter; +use Test::More; + +# For Perl 5.006 compatibility. +## no critic (ClassHierarchies::ProhibitExplicitISA) + +# Declare variables that should be set in BEGIN for robustness. +our (@EXPORT_OK, @ISA, $VERSION); + +# Set $VERSION and everything export-related in a BEGIN block for robustness +# against circular module loading (not that we load any modules, but +# consistency is good). +BEGIN { + @ISA = qw(Exporter); + @EXPORT_OK = qw(skip_unless_maintainer use_prereq); + + # This version should match the corresponding rra-c-util release, but with + # two digits for the minor version, including a leading zero if necessary, + # so that it will sort properly. + $VERSION = '4.08'; +} + +# Skip this test unless maintainer tests are requested. Takes a short +# description of what tests this script would perform, which is used in the +# skip message. Calls plan skip_all, which will terminate the program. +# +# $description - Short description of the tests +# +# Returns: undef +sub skip_unless_maintainer { + my ($description) = @_; + if (!$ENV{RRA_MAINTAINER_TESTS}) { + plan skip_all => "$description only run for maintainer"; + } + return; +} + +# Attempt to load a module and skip the test if the module could not be +# loaded. If the module could be loaded, call its import function manually. +# If the module could not be loaded, calls plan skip_all, which will terminate +# the program. +# +# The special logic here is based on Test::More and is required to get the +# imports to happen in the caller's namespace. +# +# $module - Name of the module to load +# @imports - Any arguments to import, possibly including a version +# +# Returns: undef +sub use_prereq { + my ($module, @imports) = @_; + + # If the first import looks like a version, pass it as a bare string. + my $version = q{}; + if (@imports >= 1 && $imports[0] =~ m{ \A \d+ (?: [.]\d+ )* \z }xms) { + $version = shift(@imports); + } + + # Get caller information to put imports in the correct package. + my ($package) = caller; + + # Do the import with eval, and try to isolate it from the surrounding + # context as much as possible. Based heavily on Test::More::_eval. + ## no critic (BuiltinFunctions::ProhibitStringyEval) + ## no critic (ValuesAndExpressions::ProhibitImplicitNewlines) + my ($result, $error, $sigdie); + { + local $@ = undef; + local $! = undef; + local $SIG{__DIE__} = undef; + $result = eval qq{ + package $package; + use $module $version \@imports; + 1; + }; + $error = $@; + $sigdie = $SIG{__DIE__} || undef; + } + + # If the use failed for any reason, skip the test. + if (!$result || $error) { + plan skip_all => "$module required for test"; + } + + # If the module set $SIG{__DIE__}, we cleared that via local. Restore it. + ## no critic (Variables::RequireLocalizedPunctuationVars) + if (defined($sigdie)) { + $SIG{__DIE__} = $sigdie; + } + return; +} + +1; +__END__ + +=for stopwords +Allbery Allbery's DESC bareword sublicense MERCHANTABILITY NONINFRINGEMENT +rra-c-util + +=head1 NAME + +Test::RRA - Support functions for Perl tests + +=head1 SYNOPSIS + + use Test::RRA qw(skip_unless_maintainer use_prereq); + + # Skip this test unless maintainer tests are requested. + skip_unless_maintainer('Coding style tests'); + + # Load modules, skipping the test if they're not available. + use_prereq('File::Slurp'); + use_prereq('Test::Script::Run', '0.04'); + +=head1 DESCRIPTION + +This module collects utility functions that are useful for Perl test +scripts. It assumes Russ Allbery's Perl module layout and test +conventions and will only be useful for other people if they use the +same conventions. + +=head1 FUNCTIONS + +None of these functions are imported by default. The ones used by a +script should be explicitly imported. + +=over 4 + +=item skip_unless_maintainer(DESC) + +Checks whether RRA_MAINTAINER_TESTS is set in the environment and skips +the whole test (by calling C from Test::More) if it is not. +DESC is a description of the tests being skipped. A space and C will be appended to it and used as the skip reason. + +=item use_prereq(MODULE[, VERSION][, IMPORT ...]) + +Attempts to load MODULE with the given VERSION and import arguments. If +this fails for any reason, the test will be skipped (by calling C from Test::More) with a skip reason saying that MODULE is +required for the test. + +VERSION will be passed to C as a version bareword if it looks like a +version number. The remaining IMPORT arguments will be passed as the +value of an array. + +=back + +=head1 AUTHOR + +Russ Allbery + +=head1 COPYRIGHT AND LICENSE + +Copyright 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 + +Test::More(3), Test::RRA::Automake(3), Test::RRA::Config(3) + +This module is maintained in the rra-c-util package. The current version +is available from L. + +=cut diff --git a/tests/tap/perl/Test/RRA/Automake.pm b/tests/tap/perl/Test/RRA/Automake.pm new file mode 100644 index 0000000..2aadb6a --- /dev/null +++ b/tests/tap/perl/Test/RRA/Automake.pm @@ -0,0 +1,362 @@ +# Helper functions for Perl test programs in Automake distributions. +# +# This module provides a collection of helper functions used by test programs +# written in Perl and included in C source distributions that use Automake. +# They embed knowledge of how I lay out my source trees and test suites with +# Autoconf and Automake. They may be usable by others, but doing so will +# require closely following the conventions implemented by the rra-c-util +# utility collection. +# +# All the functions here assume that BUILD and SOURCE are set in the +# environment. This is normally done via the C TAP Harness runtests wrapper. +# +# The canonical version of this file is maintained in the rra-c-util package, +# which can be found at . +# +# Written by Russ Allbery +# Copyright 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. + +package Test::RRA::Automake; + +use 5.006; +use strict; +use warnings; + +# For Perl 5.006 compatibility. +## no critic (ClassHierarchies::ProhibitExplicitISA) + +use Exporter; +use File::Spec; +use Test::More; +use Test::RRA::Config qw($LIBRARY_PATH); + +# Used below for use lib calls. +my ($PERL_BLIB_ARCH, $PERL_BLIB_LIB); + +# Determine the path to the build tree of any embedded Perl module package in +# this source package. We do this in a BEGIN block because we're going to use +# the results in a use lib command below. +BEGIN { + $PERL_BLIB_ARCH = File::Spec->catdir(qw(perl blib arch)); + $PERL_BLIB_LIB = File::Spec->catdir(qw(perl blib lib)); + + # If BUILD is set, we can come up with better values. + if (defined($ENV{BUILD})) { + my ($vol, $dirs) = File::Spec->splitpath($ENV{BUILD}, 1); + my @dirs = File::Spec->splitdir($dirs); + pop(@dirs); + $PERL_BLIB_ARCH = File::Spec->catdir(@dirs, qw(perl blib arch)); + $PERL_BLIB_LIB = File::Spec->catdir(@dirs, qw(perl blib lib)); + } +} + +# Prefer the modules built as part of our source package. Otherwise, we may +# not find Perl modules while testing, or find the wrong versions. +use lib $PERL_BLIB_ARCH; +use lib $PERL_BLIB_LIB; + +# Declare variables that should be set in BEGIN for robustness. +our (@EXPORT_OK, @ISA, $VERSION); + +# Set $VERSION and everything export-related in a BEGIN block for robustness +# against circular module loading (not that we load any modules, but +# consistency is good). +BEGIN { + @ISA = qw(Exporter); + @EXPORT_OK = qw(automake_setup perl_dirs test_file_path); + + # This version should match the corresponding rra-c-util release, but with + # two digits for the minor version, including a leading zero if necessary, + # so that it will sort properly. + $VERSION = '4.08'; +} + +# Perl directories to skip globally for perl_dirs. We ignore the perl +# directory if it exists since, in my packages, it is treated as a Perl module +# distribution and has its own standalone test suite. +my @GLOBAL_SKIP = qw(.git perl); + +# Perform initial test setup for running a Perl test in an Automake package. +# This verifies that BUILD and SOURCE are set and then changes directory to +# the SOURCE directory by default. Sets LD_LIBRARY_PATH if the $LIBRARY_PATH +# configuration option is set. Calls BAIL_OUT if BUILD or SOURCE are missing +# or if anything else fails. +# +# $args_ref - Reference to a hash of arguments to configure behavior: +# chdir_build - If set to a true value, changes to BUILD instead of SOURCE +# +# Returns: undef +sub automake_setup { + my ($args_ref) = @_; + + # Bail if BUILD or SOURCE are not set. + if (!$ENV{BUILD}) { + BAIL_OUT('BUILD not defined (run under runtests)'); + } + if (!$ENV{SOURCE}) { + BAIL_OUT('SOURCE not defined (run under runtests)'); + } + + # BUILD or SOURCE will be the test directory. Change to the parent. + my $start = $args_ref->{chdir_build} ? $ENV{BUILD} : $ENV{SOURCE}; + my ($vol, $dirs) = File::Spec->splitpath($start, 1); + my @dirs = File::Spec->splitdir($dirs); + pop(@dirs); + if ($dirs[-1] eq File::Spec->updir) { + pop(@dirs); + pop(@dirs); + } + my $root = File::Spec->catpath($vol, File::Spec->catdir(@dirs), q{}); + chdir($root) or BAIL_OUT("cannot chdir to $root: $!"); + + # If BUILD is a subdirectory of SOURCE, add it to the global ignore list. + my ($buildvol, $builddirs) = File::Spec->splitpath($ENV{BUILD}, 1); + my @builddirs = File::Spec->splitdir($builddirs); + pop(@builddirs); + if ($buildvol eq $vol && @builddirs == @dirs + 1) { + while (@dirs && $builddirs[0] eq $dirs[0]) { + shift(@builddirs); + shift(@dirs); + } + if (@builddirs == 1) { + push(@GLOBAL_SKIP, $builddirs[0]); + } + } + + # Set LD_LIBRARY_PATH if the $LIBRARY_PATH configuration option is set. + ## no critic (Variables::RequireLocalizedPunctuationVars) + if (defined($LIBRARY_PATH)) { + @builddirs = File::Spec->splitdir($builddirs); + pop(@builddirs); + my $libdir = File::Spec->catdir(@builddirs, $LIBRARY_PATH); + my $path = File::Spec->catpath($buildvol, $libdir, q{}); + if (-d "$path/.libs") { + $path .= '/.libs'; + } + if ($ENV{LD_LIBRARY_PATH}) { + $ENV{LD_LIBRARY_PATH} .= ":$path"; + } else { + $ENV{LD_LIBRARY_PATH} = $path; + } + } + return; +} + +# Returns a list of directories that may contain Perl scripts and that should +# be passed to Perl test infrastructure that expects a list of directories to +# recursively check. The list will be all eligible top-level directories in +# the package except for the tests directory, which is broken out to one +# additional level. Calls BAIL_OUT on any problems +# +# $args_ref - Reference to a hash of arguments to configure behavior: +# skip - A reference to an array of directories to skip +# +# Returns: List of directories possibly containing Perl scripts to test +sub perl_dirs { + my ($args_ref) = @_; + + # Add the global skip list. + my @skip = $args_ref->{skip} ? @{ $args_ref->{skip} } : (); + push(@skip, @GLOBAL_SKIP); + + # Separate directories to skip under tests from top-level directories. + my @skip_tests = grep { m{ \A tests/ }xms } @skip; + @skip = grep { !m{ \A tests }xms } @skip; + for my $skip_dir (@skip_tests) { + $skip_dir =~ s{ \A tests/ }{}xms; + } + + # Convert the skip lists into hashes for convenience. + my %skip = map { $_ => 1 } @skip, 'tests'; + my %skip_tests = map { $_ => 1 } @skip_tests; + + # Build the list of top-level directories to test. + opendir(my $rootdir, q{.}) or BAIL_OUT("cannot open .: $!"); + my @dirs = grep { -d $_ && !$skip{$_} } readdir($rootdir); + closedir($rootdir); + @dirs = File::Spec->no_upwards(@dirs); + + # Add the list of subdirectories of the tests directory. + if (-d 'tests') { + opendir(my $testsdir, q{tests}) or BAIL_OUT("cannot open tests: $!"); + + # Skip if found in %skip_tests or if not a directory. + my $is_skipped = sub { + my ($dir) = @_; + return 1 if $skip_tests{$dir}; + $dir = File::Spec->catdir('tests', $dir); + return -d $dir ? 0 : 1; + }; + + # Build the filtered list of subdirectories of tests. + my @test_dirs = grep { !$is_skipped->($_) } readdir($testsdir); + closedir($testsdir); + @test_dirs = File::Spec->no_upwards(@test_dirs); + + # Add the tests directory to the start of the directory name. + push(@dirs, map { File::Spec->catdir('tests', $_) } @test_dirs); + } + return @dirs; +} + +# Find a configuration file for the test suite. Searches relative to BUILD +# first and then SOURCE and returns whichever is found first. Calls BAIL_OUT +# if the file could not be found. +# +# $file - Partial path to the file +# +# Returns: Full path to the file +sub test_file_path { + my ($file) = @_; + BASE: + for my $base ($ENV{BUILD}, $ENV{SOURCE}) { + next if !defined($base); + if (-f "$base/$file") { + return "$base/$file"; + } + } + BAIL_OUT("cannot find $file"); + return; +} + +1; +__END__ + +=for stopwords +Allbery Automake Automake-aware Automake-based rra-c-util ARGS +subdirectories sublicense MERCHANTABILITY NONINFRINGEMENT + +=head1 NAME + +Test::RRA::Automake - Automake-aware support functions for Perl tests + +=head1 SYNOPSIS + + use Test::RRA::Automake qw(automake_setup perl_dirs test_file_path); + automake_setup({ chdir_build => 1 }); + + # Paths to directories that may contain Perl scripts. + my @dirs = perl_dirs({ skip => [qw(lib)] }); + + # Configuration for Kerberos tests. + my $keytab = test_file_path('config/keytab'); + +=head1 DESCRIPTION + +This module collects utility functions that are useful for test scripts +written in Perl and included in a C Automake-based package. They assume +the layout of a package that uses rra-c-util and C TAP Harness for the +test structure. + +Loading this module will also add the directories C and +C to the Perl library search path, relative to BUILD if +that environment variable is set. This is harmless for C Automake +projects that don't contain an embedded Perl module, and for those +projects that do, this will allow subsequent C calls to find modules +that are built as part of the package build process. + +The automake_setup() function should be called before calling any other +functions provided by this module. + +=head1 FUNCTIONS + +None of these functions are imported by default. The ones used by a +script should be explicitly imported. On failure, all of these functions +call BAIL_OUT (from Test::More). + +=over 4 + +=item automake_setup([ARGS]) + +Verifies that the BUILD and SOURCE environment variables are set and +then changes directory to the top of the source tree (which is one +directory up from the SOURCE path, since SOURCE points to the top of +the tests directory). + +If ARGS is given, it should be a reference to a hash of configuration +options. Only one option is supported: C. If it is set +to a true value, automake_setup() changes directories to the top of +the build tree instead. + +=item perl_dirs([ARGS]) + +Returns a list of directories that may contain Perl scripts that should be +tested by test scripts that test all Perl in the source tree (such as +syntax or coding style checks). The paths will be simple directory names +relative to the current directory or two-part directory names under the +F directory. (Directories under F are broken out separately +since it's common to want to apply different policies to different +subdirectories of F.) + +If ARGS is given, it should be a reference to a hash of configuration +options. Only one option is supported: C, whose value should be a +reference to an array of additional top-level directories or directories +starting with C that should be skipped. + +=item test_file_path(FILE) + +Given FILE, which should be a relative path, locates that file relative to +the test directory in either the source or build tree. FILE will be +checked for relative to the environment variable BUILD first, and then +relative to SOURCE. test_file_path() returns the full path to FILE or +calls BAIL_OUT if FILE could not be found. + +=back + +=head1 AUTHOR + +Russ Allbery + +=head1 COPYRIGHT AND LICENSE + +Copyright 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 + +Test::More(3), Test::RRA(3), Test::RRA::Config(3) + +The C TAP Harness test driver and libraries for TAP-based C testing are +available from L. + +This module is maintained in the rra-c-util package. The current version +is available from L. + +=cut diff --git a/tests/tap/perl/Test/RRA/Config.pm b/tests/tap/perl/Test/RRA/Config.pm new file mode 100644 index 0000000..0091b26 --- /dev/null +++ b/tests/tap/perl/Test/RRA/Config.pm @@ -0,0 +1,200 @@ +# Configuration for Perl test cases. +# +# In order to reuse the same Perl test cases in multiple packages, I use a +# configuration file to store some package-specific data. This module loads +# that configuration and provides the namespace for the configuration +# settings. +# +# The canonical version of this file is maintained in the rra-c-util package, +# which can be found at . + +package Test::RRA::Config; + +use 5.006; +use strict; +use warnings; + +# For Perl 5.006 compatibility. +## no critic (ClassHierarchies::ProhibitExplicitISA) + +use Exporter; +use Test::More; + +# Declare variables that should be set in BEGIN for robustness. +our (@EXPORT_OK, @ISA, $VERSION); + +# Set $VERSION and everything export-related in a BEGIN block for robustness +# against circular module loading (not that we load any modules, but +# consistency is good). +BEGIN { + @ISA = qw(Exporter); + @EXPORT_OK = qw( + $COVERAGE_LEVEL @COVERAGE_SKIP_TESTS @CRITIC_IGNORE $LIBRARY_PATH + $MINIMUM_VERSION %MINIMUM_VERSION @POD_COVERAGE_EXCLUDE + ); + + # This version should match the corresponding rra-c-util release, but with + # two digits for the minor version, including a leading zero if necessary, + # so that it will sort properly. + $VERSION = '4.08'; +} + +# If BUILD or SOURCE are set in the environment, look for data/perl.conf under +# those paths for a C Automake package. Otherwise, look in t/data/perl.conf +# for a standalone Perl module. Don't use Test::RRA::Automake since it may +# not exist. +our $PATH; +for my $base ($ENV{BUILD}, $ENV{SOURCE}, 't') { + next if !defined($base); + my $path = "$base/data/perl.conf"; + if (-r $path) { + $PATH = $path; + last; + } +} +if (!defined($PATH)) { + BAIL_OUT('cannot find data/perl.conf'); +} + +# Pre-declare all of our variables and set any defaults. +our $COVERAGE_LEVEL = 100; +our @COVERAGE_SKIP_TESTS; +our @CRITIC_IGNORE; +our $LIBRARY_PATH; +our $MINIMUM_VERSION = '5.008'; +our %MINIMUM_VERSION; +our @POD_COVERAGE_EXCLUDE; + +# Load the configuration. +if (!do($PATH)) { + my $error = $@ || $! || 'loading file did not return true'; + BAIL_OUT("cannot load data/perl.conf: $error"); +} + +1; +__END__ + +=for stopwords +Allbery rra-c-util Automake perlcritic .libs namespace sublicense +MERCHANTABILITY NONINFRINGEMENT + +=head1 NAME + +Test::RRA::Config - Perl test configuration + +=head1 SYNOPSIS + + use Test::RRA::Config qw($MINIMUM_VERSION); + print "Required Perl version is $MINIMUM_VERSION\n"; + +=head1 DESCRIPTION + +Test::RRA::Config encapsulates per-package configuration for generic Perl +test programs that are shared between multiple packages using the +rra-c-util infrastructure. It handles locating and loading the test +configuration file for both C Automake packages and stand-alone Perl +modules. + +Test::RRA::Config looks for a file named F relative to the +root of the test directory. That root is taken from the environment +variables BUILD or SOURCE (in that order) if set, which will be the case +for C Automake packages using C TAP Harness. If neither is set, it +expects the root of the test directory to be a directory named F +relative to the current directory, which will be the case for stand-alone +Perl modules. + +The following variables are supported: + +=over 4 + +=item $COVERAGE_LEVEL + +The coverage level achieved by the test suite for Perl test coverage +testing using Test::Strict, as a percentage. The test will fail if test +coverage less than this percentage is achieved. If not given, defaults +to 100. + +=item @COVERAGE_SKIP_TESTS + +Directories under F whose tests should be skipped when doing coverage +testing. This can be tests that won't contribute to coverage or tests +that don't run properly under Devel::Cover for some reason (such as ones +that use taint checking). F and F