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 --- TODO | 18 ------------------ 1 file changed, 18 deletions(-) (limited to 'TODO') 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 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(+) (limited to 'TODO') 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 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(+) (limited to 'TODO') 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(+) (limited to 'TODO') 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 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(-) (limited to 'TODO') 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 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(-) (limited to 'TODO') 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 2651ef4352c8cc782c4e0f3175257f7bb0c1e495 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Thu, 18 Feb 2010 18:03:09 -0800 Subject: Rename functions in Wallet::Kadmin API Now that we support multiple versions of Kerberos, use generic names for the functions in the Wallet::Kadmin interface rather than the commands from the MIT kadmin interface. --- TODO | 4 ---- perl/Wallet/Kadmin.pm | 14 +++++++------- perl/Wallet/Kadmin/Heimdal.pm | 12 ++++++------ perl/Wallet/Kadmin/MIT.pm | 12 ++++++------ perl/Wallet/Object/Keytab.pm | 17 ++++++----------- perl/t/kadmin.t | 14 +++++++------- perl/t/keytab.t | 4 ++-- 7 files changed, 34 insertions(+), 43 deletions(-) (limited to 'TODO') diff --git a/TODO b/TODO index bfc7910..4ad1b1e 100644 --- a/TODO +++ b/TODO @@ -2,12 +2,8 @@ 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. * Refactor attribute handling code in Wallet::Object::Keytab, move to diff --git a/perl/Wallet/Kadmin.pm b/perl/Wallet/Kadmin.pm index a06e1e2..21678ca 100644 --- a/perl/Wallet/Kadmin.pm +++ b/perl/Wallet/Kadmin.pm @@ -73,7 +73,7 @@ __END__ ############################################################################## =for stopwords -backend Kadmin keytabs keytab Heimdal API kadmind kadmin KDC ENCTYPES +backend Kadmin keytabs keytab Heimdal API kadmind kadmin KDC ENCTYPE enctypes enctype Allbery =head1 NAME @@ -83,10 +83,10 @@ Wallet::Kadmin - Kerberos administration API for wallet keytab backend =head1 SYNOPSIS my $kadmin = Wallet::Kadmin->new; - $kadmin->addprinc ("host/shell.example.com"); - $kadmin->ktadd ("host/shell.example.com", "aes256-cts-hmac-sha1-96"); + $kadmin->create ("host/foo.example.com"); + $kadmin->keytab ("host/foo.example.com", "aes256-cts-hmac-sha1-96"); my $exists = $kadmin->exists ("host/oldshell.example.com"); - $kadmin->delprinc ("host/oldshell.example.com") if $exists; + $kadmin->destroy ("host/oldshell.example.com") if $exists; =head1 DESCRIPTION @@ -123,14 +123,14 @@ appropriate for the configured Kerberos implementation. =over 4 -=item addprinc(PRINCIPAL) +=item create(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 and false on failure. If the principal already exists, return true as we are bringing our expectations in line with reality. -=item delprinc(PRINCIPAL) +=item destroy(PRINCIPAL) Removes a principal with the given name. Returns true on success or false on failure. If the principal does not exist, return true as we are @@ -162,7 +162,7 @@ kadmin command-line client, the sub CALLBACK will be called in the child process before running the program. This can be used to, for example, properly clean up shared database handles. -=item ktadd(PRINCIPAL, FILE, ENCTYPES) +=item keytab(PRINCIPAL, FILE [, ENCTYPE ... ]) 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 diff --git a/perl/Wallet/Kadmin/Heimdal.pm b/perl/Wallet/Kadmin/Heimdal.pm index d59b33c..0ac8cd9 100644 --- a/perl/Wallet/Kadmin/Heimdal.pm +++ b/perl/Wallet/Kadmin/Heimdal.pm @@ -59,7 +59,7 @@ sub exists { # 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 { +sub create { my ($self, $principal) = @_; $principal = $self->canonicalize_principal ($principal); my $exists = eval { $self->exists ($principal) }; @@ -97,7 +97,7 @@ sub addprinc { # 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 { +sub keytab { my ($self, $principal, $file, @enctypes) = @_; $principal = $self->canonicalize_principal ($principal); @@ -155,7 +155,7 @@ sub ktadd { # 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 { +sub destroy { my ($self, $principal) = @_; $principal = $self->canonicalize_principal ($principal); my $exists = eval { $self->exists ($principal) }; @@ -213,10 +213,10 @@ Wallet::Kadmin::Heimdal - Wallet Kerberos administration API for Heimdal =head1 SYNOPSIS my $kadmin = Wallet::Kadmin::Heimdal->new; - $kadmin->addprinc ("host/shell.example.com"); - $kadmin->ktadd ("host/shell.example.com", "aes256-cts-hmac-sha1-96"); + $kadmin->create ("host/foo.example.com"); + $kadmin->keytab ("host/foo.example.com", "aes256-cts-hmac-sha1-96"); my $exists = $kadmin->exists ("host/oldshell.example.com"); - $kadmin->delprinc ("host/oldshell.example.com") if $exists; + $kadmin->destroy ("host/oldshell.example.com") if $exists; =head1 DESCRIPTION diff --git a/perl/Wallet/Kadmin/MIT.pm b/perl/Wallet/Kadmin/MIT.pm index 1ab8b1d..9ab575c 100644 --- a/perl/Wallet/Kadmin/MIT.pm +++ b/perl/Wallet/Kadmin/MIT.pm @@ -116,7 +116,7 @@ sub exists { # 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 { +sub create { my ($self, $principal) = @_; unless ($self->valid_principal ($principal)) { $self->error ("invalid principal name $principal"); @@ -141,7 +141,7 @@ sub addprinc { # 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 { +sub keytab { my ($self, $principal, $file, @enctypes) = @_; unless ($self->valid_principal ($principal)) { $self->error ("invalid principal name: $principal"); @@ -168,7 +168,7 @@ sub ktadd { # 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 { +sub destroy { my ($self, $principal) = @_; unless ($self->valid_principal ($principal)) { $self->error ("invalid principal name: $principal"); @@ -219,10 +219,10 @@ Wallet::Kadmin::MIT - Wallet Kerberos administration API for MIT =head1 SYNOPSIS my $kadmin = Wallet::Kadmin::MIT->new; - $kadmin->addprinc ("host/shell.example.com"); - $kadmin->ktadd ("host/shell.example.com", "aes256-cts-hmac-sha1-96"); + $kadmin->create ("host/foo.example.com"); + $kadmin->keytab ("host/foo.example.com", "aes256-cts-hmac-sha1-96"); my $exists = $kadmin->exists ("host/oldshell.example.com"); - $kadmin->delprinc ("host/oldshell.example.com") if $exists; + $kadmin->destroy ("host/oldshell.example.com") if $exists; =head1 DESCRIPTION diff --git a/perl/Wallet/Object/Keytab.pm b/perl/Wallet/Object/Keytab.pm index 760280f..66c5e6a 100644 --- a/perl/Wallet/Object/Keytab.pm +++ b/perl/Wallet/Object/Keytab.pm @@ -289,7 +289,7 @@ sub create { my $callback = sub { $self->{dbh}->{InactiveDestroy} = 1 }; $kadmin->fork_callback ($callback); - if (not $kadmin->addprinc ($name)) { + if (not $kadmin->create ($name)) { die $kadmin->error, "\n"; } $self = $class->SUPER::create ($type, $name, $dbh, $creator, $host, $time); @@ -318,7 +318,7 @@ sub destroy { return; } my $kadmin = $self->{kadmin}; - if (not $kadmin->delprinc ($self->{name})) { + if (not $kadmin->destroy ($self->{name})) { $self->error ($kadmin->error); return; } @@ -350,7 +350,7 @@ sub get { unlink $file; my @enctypes = $self->attr ('enctypes'); my $kadmin = $self->{kadmin}; - if (not $kadmin->ktadd ($self->{name}, $file, @enctypes)) { + if (not $kadmin->keytab ($self->{name}, $file, @enctypes)) { $self->error ($kadmin->error); return; } @@ -520,19 +520,14 @@ 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 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 =head1 LIMITATIONS -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. diff --git a/perl/t/kadmin.t b/perl/t/kadmin.t index 82e6edf..9c49995 100755 --- a/perl/t/kadmin.t +++ b/perl/t/kadmin.t @@ -83,15 +83,15 @@ SKIP: { $kadmin = eval { Wallet::Kadmin->new }; ok (defined $kadmin, 'Creating Wallet::Kadmin object succeeds'); is ($@, '', ' and there is no error'); - is ($kadmin->delprinc ('wallet/one'), 1, 'Deleting wallet/one works'); + is ($kadmin->destroy ('wallet/one'), 1, 'Deleting wallet/one works'); is ($kadmin->exists ('wallet/one'), 0, ' and it does not exist'); - # Create the principal and check that ktadd returns something. We'll + # Create the principal and check that keytab returns something. We'll # check the details of the return in the keytab check. - is ($kadmin->addprinc ('wallet/one'), 1, 'Creating wallet/one works'); + is ($kadmin->create ('wallet/one'), 1, 'Creating wallet/one works'); is ($kadmin->exists ('wallet/one'), 1, ' and it now exists'); unlink ('./tmp.keytab'); - is ($kadmin->ktadd ('wallet/one', './tmp.keytab'), 1, + is ($kadmin->keytab ('wallet/one', './tmp.keytab'), 1, ' and retrieving a keytab works'); ok (-s './tmp.keytab', ' and the resulting keytab is non-zero'); is (getcreds ('./tmp.keytab', "wallet/one\@$Wallet::Config::KEYTAB_REALM"), @@ -99,12 +99,12 @@ SKIP: { unlink ('./tmp.keytab'); # Delete the principal and confirm behavior. - is ($kadmin->delprinc ('wallet/one'), 1, 'Deleting principal works'); + is ($kadmin->destroy ('wallet/one'), 1, 'Deleting principal works'); is ($kadmin->exists ('wallet/one'), 0, ' and now it does not exist'); - is ($kadmin->ktadd ('wallet/one', './tmp.keytab'), undef, + is ($kadmin->keytab ('wallet/one', './tmp.keytab'), undef, ' and retrieving the keytab does not work'); ok (! -f './tmp.keytab', ' and no file was created'); like ($kadmin->error, qr%^error creating keytab for wallet/one%, ' and the right error message is set'); - is ($kadmin->delprinc ('wallet/one'), 1, ' and deleting it again works'); + is ($kadmin->destroy ('wallet/one'), 1, ' and deleting it again works'); } diff --git a/perl/t/keytab.t b/perl/t/keytab.t index 39be547..a14b63e 100755 --- a/perl/t/keytab.t +++ b/perl/t/keytab.t @@ -59,7 +59,7 @@ sub system_quiet { sub create { my ($principal) = @_; my $kadmin = Wallet::Kadmin->new; - return $kadmin->addprinc ($principal); + return $kadmin->create ($principal); } # Destroy a principal out of Kerberos. Only usable once the configuration has @@ -67,7 +67,7 @@ sub create { sub destroy { my ($principal) = @_; my $kadmin = Wallet::Kadmin->new; - return $kadmin->delprinc ($principal); + return $kadmin->destroy ($principal); } # Check whether a principal exists. MIT uses kvno and Heimdal uses kgetcred. -- cgit v1.2.3 From 908aa143b92b12e7d39989f6895625f255bc8d5b Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Thu, 18 Feb 2010 18:05:23 -0800 Subject: KRBTYPE is already case-insensitive; remove from TODO --- TODO | 2 -- 1 file changed, 2 deletions(-) (limited to 'TODO') diff --git a/TODO b/TODO index 4ad1b1e..883d59e 100644 --- a/TODO +++ b/TODO @@ -12,8 +12,6 @@ Release 0.10: * 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 748170660e3a7b1db4320ba9b0144da2e252cd27 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Thu, 18 Feb 2010 18:23:23 -0800 Subject: Refactor sync handling in Wallet::Object::Keytab Pull the sync code out into separate methods to avoid a really long and awkward attr method. Document the limited object support for the sync attribute. --- TODO | 3 -- perl/Wallet/Object/Keytab.pm | 121 ++++++++++++++++++++++++++++--------------- 2 files changed, 79 insertions(+), 45 deletions(-) (limited to 'TODO') diff --git a/TODO b/TODO index 883d59e..92bd025 100644 --- a/TODO +++ b/TODO @@ -6,9 +6,6 @@ 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. diff --git a/perl/Wallet/Object/Keytab.pm b/perl/Wallet/Object/Keytab.pm index 66c5e6a..44ee003 100644 --- a/perl/Wallet/Object/Keytab.pm +++ b/perl/Wallet/Object/Keytab.pm @@ -110,6 +110,75 @@ sub enctypes_list { return @enctypes; } +############################################################################## +# Synchronization +############################################################################## + +# Set a synchronization target or clear the targets if $targets is an +# empty list. Returns true on success and false on failure. +# +# Currently, no synchronization targets are supported, but we preserve the +# ability to clear synchronization and the basic structure of the code so +# that they can be added later. +sub sync_set { + my ($self, $targets, $user, $host, $time) = @_; + $time ||= time; + my @trace = ($user, $host, $time); + if (@$targets > 1) { + $self->error ('only one synchronization target supported'); + return; + } elsif (@$targets) { + my $target = $targets->[0]; + $self->error ("unsupported synchronization target $target"); + return; + } else { + 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; + }; + if ($@) { + $self->error ($@); + $self->{dbh}->rollback; + return; + } + } + return 1; +} + +# Return a list of the current synchronization targets. Returns the empty +# list on failure or on an empty list of enctype restrictions, but sets +# the object error on failure so the caller should use that to determine +# success. +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); + } + $self->{dbh}->commit; + }; + if ($@) { + $self->error ($@); + $self->{dbh}->rollback; + return; + } + return @targets; +} + ############################################################################## # Keytab retrieval ############################################################################## @@ -173,54 +242,15 @@ sub attr { } if ($values) { if ($attribute eq 'enctypes') { - $self->enctypes_set ($values, $user, $host, $time); + return $self->enctypes_set ($values, $user, $host, $time); } elsif ($attribute eq 'sync') { - if (@$values > 1) { - $self->error ('only one synchronization target supported'); - return; - } elsif (@$values) { - my $target = $values->[0]; - $self->error ("unsupported synchronization target $target"); - return; - } else { - 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; - } - } + return $self->sync_set ($values, $user, $host, $time); } } else { if ($attribute eq 'enctypes') { return $self->enctypes_list; } elsif ($attribute eq 'sync') { - 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); - } - $self->{dbh}->commit; - }; - if ($@) { - $self->error ($@); - $self->{dbh}->rollback; - return; - } - return @targets; + return $self->sync_list; } } } @@ -454,6 +484,13 @@ 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 + +This attribute is intended to set a list of external systems with which +data about this keytab is synchronized, but there are no supported targets +currently. However, there is support for clearing this attribute or +returning its current value. + =back If no other arguments besides ATTRIBUTE are given, returns the values of -- cgit v1.2.3 From a24d3ac3c7e8cb68fe2268f337a4edb599d5f881 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Thu, 18 Feb 2010 21:31:10 -0800 Subject: Support unchanging keytabs with Heimdal without remctl Heimdal supports retrieving a keytab containing the existing keys over the kadmin protocol. Move the support for using remctl to retrieve an existing keytab into Wallet::Kadmin::MIT and provide two separate methods in the Wallet::Kadmin interface: one which rekeys and one which doesn't. Implement the non-rekeying interface for Heimdal. Expand the test suite for the unchanging keytabs to include tests for the Heimdal method. --- TODO | 2 - perl/Wallet/Config.pm | 21 +++++-- perl/Wallet/Kadmin.pm | 43 ++++++++------ perl/Wallet/Kadmin/Heimdal.pm | 74 +++++++++++++++++++++--- perl/Wallet/Kadmin/MIT.pm | 68 +++++++++++++++++++--- perl/Wallet/Object/Keytab.pm | 49 +--------------- perl/t/kadmin.t | 4 +- perl/t/keytab.t | 127 ++++++++++++++++++++++++++++-------------- 8 files changed, 257 insertions(+), 131 deletions(-) (limited to 'TODO') diff --git a/TODO b/TODO index 92bd025..662ea47 100644 --- a/TODO +++ b/TODO @@ -2,8 +2,6 @@ Release 0.10: -* Handle unchanging support for Heimdal. - * Move reporting code from Wallet::Admin to Wallet::Report. * Check whether we can just drop the realm restriction on keytabs and diff --git a/perl/Wallet/Config.pm b/perl/Wallet/Config.pm index c59d3e3..396bf7d 100644 --- a/perl/Wallet/Config.pm +++ b/perl/Wallet/Config.pm @@ -26,7 +26,8 @@ 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 +usernames rekey hostnames Allbery wallet-backend keytab-backend Heimdal +rekeys =head1 SYNOPSIS @@ -313,11 +314,19 @@ 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. +Heimdal provides the choice, over the network protocol, of either +downloading the existing keys for a principal or generating new random +keys. MIT Kerberos does not; downloading a keytab over the kadmin +protocol always rekeys the principal. + +For MIT Kerberos, the keytab object backend therefore 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. + +This is not required for Heimdal; for Heimdal, setting the C +flag is all that's needed. =over 4 diff --git a/perl/Wallet/Kadmin.pm b/perl/Wallet/Kadmin.pm index 3ca531e..f3c2895 100644 --- a/perl/Wallet/Kadmin.pm +++ b/perl/Wallet/Kadmin.pm @@ -83,10 +83,12 @@ Wallet::Kadmin - Kerberos administration API for wallet keytab backend =head1 SYNOPSIS my $kadmin = Wallet::Kadmin->new; - $kadmin->create ("host/foo.example.com"); - $kadmin->keytab ("host/foo.example.com", "aes256-cts-hmac-sha1-96"); - my $exists = $kadmin->exists ("host/oldshell.example.com"); - $kadmin->destroy ("host/oldshell.example.com") if $exists; + $kadmin->create ('host/foo.example.com'); + $kadmin->keytab_rekey ('host/foo.example.com', 'keytab', + 'aes256-cts-hmac-sha1-96'); + my $data = $kadmin->keytab ('host/foo.example.com'); + my $exists = $kadmin->exists ('host/oldshell.example.com'); + $kadmin->destroy ('host/oldshell.example.com') if $exists; =head1 DESCRIPTION @@ -162,19 +164,26 @@ kadmin command-line client, the sub CALLBACK will be called in the child process before running the program. This can be used to, for example, properly clean up shared database handles. -=item keytab(PRINCIPAL, FILE [, ENCTYPE ... ]) - -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. - -ktadd() creates a new keytab for the given principal, storing it in the -given file and limited to the enctypes supplied. The enctype values must -be enctype strings recognized by the Kerberos implementation (strings like -C or C). Returns true on success -and false on failure. +=item keytab(PRINCIPAL) + +keytab() creates a keytab for the given principal, storing it in the given +file. 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 have previously been +created in the Kerberos KDC. Returns the keytab as binary data on success +and undef on failure. + +=item keytab_rekey(PRINCIPAL, FILE [, ENCTYPE ...]) + +Like keytab(), but randomizes the key for the principal before generating +the keytab and writes it to the given file. This will invalidate any +existing keytabs for that principal. This method can also limit the +encryption types of the keys for that principal via the optional ENCTYPE +arguments. The enctype values must be enctype strings recognized by the +Kerberos implementation (strings like C or +C). If none are given, the KDC defaults will be used. +Returns true on success and false on failure. =back diff --git a/perl/Wallet/Kadmin/Heimdal.pm b/perl/Wallet/Kadmin/Heimdal.pm index 0ac8cd9..e066006 100644 --- a/perl/Wallet/Kadmin/Heimdal.pm +++ b/perl/Wallet/Kadmin/Heimdal.pm @@ -39,6 +39,23 @@ sub canonicalize_principal { return $principal; } +# Read the entirety of a possibly binary file and return the contents. If +# reading the file fails, set the error message and return undef. +sub slurp_file { + my ($self, $file) = @_; + unless (open (TMPFILE, '<', $file)) { + $self->error ("cannot open temporary file $file: $!"); + return; + } + local $/; + my $data = ; + unless (close TMPFILE) { + $self->error ("cannot read temporary file $file: $!"); + return; + } + return $data; +} + ############################################################################## # Public interfaces ############################################################################## @@ -93,11 +110,38 @@ sub create { 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. +# Create a keytab for a principal. Returns the keytab as binary data or undef +# on failure, setting the error. sub keytab { + my ($self, $principal) = @_; + $principal = $self->canonicalize_principal ($principal); + my $kadmin = $self->{client}; + my $file = $Wallet::Config::KEYTAB_TMP . "/keytab.$$"; + unlink $file; + my $princdata = eval { $kadmin->getPrincipal ($principal) }; + if ($@) { + $self->error ("error creating keytab for $principal: $@"); + return; + } elsif (!$princdata) { + $self->error ("error creating keytab for $principal: principal does" + . " not exist"); + return; + } + eval { $kadmin->extractKeytab ($princdata, $file) }; + if ($@) { + $self->error ("error creating keytab for principal: $@"); + return; + } + my $data = $self->slurp_file ($file); + unlink $file; + return $data; +} + +# Create a keytab for a principal, randomizing the keys for that principal at +# the same time. 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 keytab_rekey { my ($self, $principal, $file, @enctypes) = @_; $principal = $self->canonicalize_principal ($principal); @@ -213,10 +257,12 @@ Wallet::Kadmin::Heimdal - Wallet Kerberos administration API for Heimdal =head1 SYNOPSIS my $kadmin = Wallet::Kadmin::Heimdal->new; - $kadmin->create ("host/foo.example.com"); - $kadmin->keytab ("host/foo.example.com", "aes256-cts-hmac-sha1-96"); - my $exists = $kadmin->exists ("host/oldshell.example.com"); - $kadmin->destroy ("host/oldshell.example.com") if $exists; + $kadmin->create ('host/foo.example.com'); + $kadmin->keytab_rekey ('host/foo.example.com', 'keytab', + 'aes256-cts-hmac-sha1-96'); + my $data = $kadmin->keytab ('host/foo.example.com'); + my $exists = $kadmin->exists ('host/oldshell.example.com'); + $kadmin->destroy ('host/oldshell.example.com') if $exists; =head1 DESCRIPTION @@ -228,6 +274,18 @@ 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 FILES + +=over 4 + +=item KEYTAB_TMP/keytab. + +The keytab is created in this file 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 + =head1 SEE ALSO kadmin(8), Wallet::Config(3), Wallet::Kadmin(3), diff --git a/perl/Wallet/Kadmin/MIT.pm b/perl/Wallet/Kadmin/MIT.pm index 9ab575c..1c6d2c1 100644 --- a/perl/Wallet/Kadmin/MIT.pm +++ b/perl/Wallet/Kadmin/MIT.pm @@ -137,11 +137,52 @@ sub create { 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. +# Retrieve an existing keytab from the KDC via a remctl call. The KDC needs +# to be running the keytab-backend script and support the keytab retrieve +# remctl command. In addition, the user must have configured us with the path +# to a ticket cache and the host to which to connect with remctl. Returns the +# keytab on success and undef on failure. sub keytab { + my ($self, $principal) = @_; + my $host = $Wallet::Config::KEYTAB_REMCTL_HOST; + unless ($host and $Wallet::Config::KEYTAB_REMCTL_CACHE) { + $self->error ('keytab unchanging support not configured'); + return; + } + eval { require Net::Remctl }; + if ($@) { + $self->error ("keytab unchanging support not available: $@"); + return; + } + if ($principal !~ /\@/ && $Wallet::Config::KEYTAB_REALM) { + $principal .= '@' . $Wallet::Config::KEYTAB_REALM; + } + local $ENV{KRB5CCNAME} = $Wallet::Config::KEYTAB_REMCTL_CACHE; + my $port = $Wallet::Config::KEYTAB_REMCTL_PORT || 0; + my $remctl_princ = $Wallet::Config::KEYTAB_REMCTL_PRINCIPAL || ''; + my @command = ('keytab', 'retrieve', $principal); + my $result = Net::Remctl::remctl ($host, $port, $remctl_princ, @command); + if ($result->error) { + $self->error ("cannot retrieve keytab for $principal: ", + $result->error); + return; + } elsif ($result->status != 0) { + my $error = $result->stderr; + $error =~ s/\s+$//; + $error =~ s/\n/ /g; + $self->error ("cannot retrieve keytab for $principal: $error"); + return; + } else { + return $result->stdout; + } +} + +# Create a keytab for a principal, randomizing the keys for that principal +# in the process. 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 keytab_rekey { my ($self, $principal, $file, @enctypes) = @_; unless ($self->valid_principal ($principal)) { $self->error ("invalid principal name: $principal"); @@ -210,7 +251,7 @@ __END__ ############################################################################## =for stopwords -keytabs keytab kadmin KDC API Allbery +rekeying rekeys remctl backend keytabs keytab kadmin KDC API Allbery =head1 NAME @@ -219,10 +260,12 @@ Wallet::Kadmin::MIT - Wallet Kerberos administration API for MIT =head1 SYNOPSIS my $kadmin = Wallet::Kadmin::MIT->new; - $kadmin->create ("host/foo.example.com"); - $kadmin->keytab ("host/foo.example.com", "aes256-cts-hmac-sha1-96"); - my $exists = $kadmin->exists ("host/oldshell.example.com"); - $kadmin->destroy ("host/oldshell.example.com") if $exists; + $kadmin->create ('host/foo.example.com'); + $kadmin->keytab_rekey ('host/foo.example.com', 'keytab', + 'aes256-cts-hmac-sha1-96'); + my $data = $kadmin->keytab ('host/foo.example.com'); + my $exists = $kadmin->exists ('host/oldshell.example.com'); + $kadmin->destroy ('host/oldshell.example.com') if $exists; =head1 DESCRIPTION @@ -231,6 +274,13 @@ providing an interface to create and delete principals and create keytabs. It provides the API documented in Wallet::Kadmin(3) for an MIT Kerberos KDC. +MIT Kerberos does not provide any method via the kadmin network protocol +to retrieve a keytab for a principal without rekeying it, so the keytab() +method (as opposed to keytab_rekey(), which rekeys the principal) is +implemented using a remctl backend. For that method (used for unchanging +keytab objects) to work, the necessary wallet configuration and remctl +interface on the KDC must be set up. + 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. diff --git a/perl/Wallet/Object/Keytab.pm b/perl/Wallet/Object/Keytab.pm index 44ee003..5c66967 100644 --- a/perl/Wallet/Object/Keytab.pm +++ b/perl/Wallet/Object/Keytab.pm @@ -179,49 +179,6 @@ sub sync_list { return @targets; } -############################################################################## -# Keytab retrieval -############################################################################## - -# Retrieve an existing keytab from the KDC via a remctl call. The KDC needs -# to be running the keytab-backend script and support the keytab retrieve -# remctl command. In addition, the user must have configured us with the path -# to a ticket cache and the host to which to connect with remctl. Returns the -# keytab on success and undef on failure. -sub keytab_retrieve { - my ($self, $keytab) = @_; - my $host = $Wallet::Config::KEYTAB_REMCTL_HOST; - unless ($host and $Wallet::Config::KEYTAB_REMCTL_CACHE) { - $self->error ('keytab unchanging support not configured'); - return; - } - eval { require Net::Remctl }; - if ($@) { - $self->error ("keytab unchanging support not available: $@"); - return; - } - if ($Wallet::Config::KEYTAB_REALM) { - $keytab .= '@' . $Wallet::Config::KEYTAB_REALM; - } - local $ENV{KRB5CCNAME} = $Wallet::Config::KEYTAB_REMCTL_CACHE; - my $port = $Wallet::Config::KEYTAB_REMCTL_PORT || 0; - my $principal = $Wallet::Config::KEYTAB_REMCTL_PRINCIPAL || ''; - my @command = ('keytab', 'retrieve', $keytab); - my $result = Net::Remctl::remctl ($host, $port, $principal, @command); - if ($result->error) { - $self->error ("cannot retrieve keytab for $keytab: ", $result->error); - return; - } elsif ($result->status != 0) { - my $error = $result->stderr; - $error =~ s/\s+$//; - $error =~ s/\n/ /g; - $self->error ("cannot retrieve keytab for $keytab: $error"); - return; - } else { - return $result->stdout; - } -} - ############################################################################## # Core methods ############################################################################## @@ -365,8 +322,9 @@ sub get { $self->error ("cannot get $id: object is locked"); return; } + my $kadmin = $self->{kadmin}; if ($self->flag_check ('unchanging')) { - my $result = $self->keytab_retrieve ($self->{name}); + my $result = $kadmin->keytab ($self->{name}); if (defined $result) { $self->log_action ('get', $user, $host, $time); } @@ -379,8 +337,7 @@ sub get { my $file = $Wallet::Config::KEYTAB_TMP . "/keytab.$$"; unlink $file; my @enctypes = $self->attr ('enctypes'); - my $kadmin = $self->{kadmin}; - if (not $kadmin->keytab ($self->{name}, $file, @enctypes)) { + if (not $kadmin->keytab_rekey ($self->{name}, $file, @enctypes)) { $self->error ($kadmin->error); return; } diff --git a/perl/t/kadmin.t b/perl/t/kadmin.t index 9c49995..a29cae3 100755 --- a/perl/t/kadmin.t +++ b/perl/t/kadmin.t @@ -91,7 +91,7 @@ SKIP: { is ($kadmin->create ('wallet/one'), 1, 'Creating wallet/one works'); is ($kadmin->exists ('wallet/one'), 1, ' and it now exists'); unlink ('./tmp.keytab'); - is ($kadmin->keytab ('wallet/one', './tmp.keytab'), 1, + is ($kadmin->keytab_rekey ('wallet/one', './tmp.keytab'), 1, ' and retrieving a keytab works'); ok (-s './tmp.keytab', ' and the resulting keytab is non-zero'); is (getcreds ('./tmp.keytab', "wallet/one\@$Wallet::Config::KEYTAB_REALM"), @@ -101,7 +101,7 @@ SKIP: { # Delete the principal and confirm behavior. is ($kadmin->destroy ('wallet/one'), 1, 'Deleting principal works'); is ($kadmin->exists ('wallet/one'), 0, ' and now it does not exist'); - is ($kadmin->keytab ('wallet/one', './tmp.keytab'), undef, + is ($kadmin->keytab_rekey ('wallet/one', './tmp.keytab'), undef, ' and retrieving the keytab does not work'); ok (! -f './tmp.keytab', ' and no file was created'); like ($kadmin->error, qr%^error creating keytab for wallet/one%, diff --git a/perl/t/keytab.t b/perl/t/keytab.t index a14b63e..a702c0f 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 => 125; +use Test::More tests => 135; use Wallet::Admin; use Wallet::Config; @@ -378,12 +378,7 @@ EOO # Tests for unchanging support. Skip these if we don't have a keytab or if we # can't find remctld. SKIP: { - skip 'no keytab configuration', 17 unless -f 't/data/test.keytab'; - my @path = (split (':', $ENV{PATH}), '/usr/local/sbin', '/usr/sbin'); - my ($remctld) = grep { -x $_ } map { "$_/remctld" } @path; - skip 'remctld not found', 17 unless $remctld; - eval { require Net::Remctl }; - skip 'Net::Remctl not available', 17 if $@; + skip 'no keytab configuration', 27 unless -f 't/data/test.keytab'; # Set up our configuration. $Wallet::Config::KEYTAB_FILE = 't/data/test.keytab'; @@ -406,41 +401,85 @@ SKIP: { ok (defined ($two), 'Creating wallet/two succeeds'); is ($two->flag_set ('unchanging', @trace), 1, ' and setting unchanging'); - # Now spawn our remctld server and get a ticket cache. - remctld_spawn ($remctld, $principal, 't/data/test.keytab', - 't/data/keytab.conf'); - $ENV{KRB5CCNAME} = 'krb5cc_test'; - getcreds ('t/data/test.keytab', $principal); - $ENV{KRB5CCNAME} = 'krb5cc_good'; + # Finally we can test. First the MIT Kerberos tests. + SKIP: { + skip 'skipping MIT unchanging tests for Heimdal', 12 + 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; + eval { require Net::Remctl }; + skip 'Net::Remctl not available', 12 if $@; + + # Now spawn our remctld server and get a ticket cache. + remctld_spawn ($remctld, $principal, 't/data/test.keytab', + 't/data/keytab.conf'); + $ENV{KRB5CCNAME} = 'krb5cc_test'; + getcreds ('t/data/test.keytab', $principal); + $ENV{KRB5CCNAME} = 'krb5cc_good'; + + # Do the unchanging tests for MIT Kerberos. + is ($one->get (@trace), undef, 'Get without configuration fails'); + is ($one->error, 'keytab unchanging support not configured', + ' with the right error'); + $Wallet::Config::KEYTAB_REMCTL_CACHE = 'krb5cc_test'; + is ($one->get (@trace), undef, ' and still fails without host'); + is ($one->error, 'keytab unchanging support not configured', + ' with the right error'); + $Wallet::Config::KEYTAB_REMCTL_HOST = 'localhost'; + $Wallet::Config::KEYTAB_REMCTL_PRINCIPAL = $principal; + $Wallet::Config::KEYTAB_REMCTL_PORT = 14373; + is ($one->get (@trace), undef, ' and still fails without ACL'); + is ($one->error, + "cannot retrieve keytab for wallet/one\@$realm: Access denied", + ' with the right error'); + open (ACL, '>', 'test-acl') or die "cannot create test-acl: $!\n"; + print ACL "$principal\n"; + close ACL; + is ($one->get (@trace), 'Keytab for wallet/one', 'Now get works'); + is ($ENV{KRB5CCNAME}, 'krb5cc_good', + ' and we did not nuke the cache name'); + is ($one->get (@trace), 'Keytab for wallet/one', + ' 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); + ok (defined ($data), ' and getting the keytab works'); + ok (valid ($data, 'wallet/one'), ' and the keytab is valid'); + is ($two->get (@trace), undef, 'Get for wallet/two does not work'); + is ($two->error, + "cannot retrieve keytab for wallet/two\@$realm: bite me", + ' with the right error'); + is ($one->destroy (@trace), 1, 'Destroying wallet/one works'); + is ($two->destroy (@trace), 1, ' as does destroying wallet/two'); + remctld_stop; + } - # Finally we can test. - is ($one->get (@trace), undef, 'Get without configuration fails'); - is ($one->error, 'keytab unchanging support not configured', - ' with the right error'); - $Wallet::Config::KEYTAB_REMCTL_CACHE = 'krb5cc_test'; - is ($one->get (@trace), undef, ' and still fails without host'); - is ($one->error, 'keytab unchanging support not configured', - ' with the right error'); - $Wallet::Config::KEYTAB_REMCTL_HOST = 'localhost'; - $Wallet::Config::KEYTAB_REMCTL_PRINCIPAL = $principal; - $Wallet::Config::KEYTAB_REMCTL_PORT = 14373; - is ($one->get (@trace), undef, ' and still fails without ACL'); - is ($one->error, - "cannot retrieve keytab for wallet/one\@$realm: Access denied", - ' with the right error'); - open (ACL, '>', 'test-acl') or die "cannot create test-acl: $!\n"; - print ACL "$principal\n"; - close ACL; - is ($one->get (@trace), 'Keytab for wallet/one', 'Now get works'); - is ($ENV{KRB5CCNAME}, 'krb5cc_good', - ' and we did not nuke the cache name'); - is ($two->get (@trace), undef, ' but get for wallet/two does not'); - is ($two->error, - "cannot retrieve keytab for wallet/two\@$realm: bite me", - ' with the right error'); - is ($one->destroy (@trace), 1, 'Destroying wallet/one works'); - is ($two->destroy (@trace), 1, ' as does destroying wallet/two'); - remctld_stop; + # Now Heimdal. Since the keytab contains timestamps, before testing for + # equality we have to substitute out the timestamps. + SKIP: { + skip 'skipping Heimdal unchanging tests for MIT', 10 + if (lc ($Wallet::Config::KEYTAB_KRBTYPE) eq 'mit'); + my $data = $one->get (@trace); + ok (defined $data, 'Get of unchanging keytab works'); + ok (valid ($data, 'wallet/one'), ' and the keytab is valid'); + my $second = $one->get (@trace); + ok (defined $second, ' and second retrieval also works'); + $data =~ s/one.{8}/one\000\000\000\000\000\000\000\000/g; + $second =~ s/one.{8}/one\000\000\000\000\000\000\000\000/g; + is ($data, $second, ' and the keytab matches'); + is ($one->flag_clear ('unchanging', @trace), 1, + 'Clearing the unchanging flag works'); + $data = $one->get (@trace); + ok (defined ($data), ' and getting the keytab works'); + ok (valid ($data, 'wallet/one'), ' and the keytab is valid'); + $data =~ s/one.{8}/one\000\000\000\000\000\000\000\000/g; + ok ($data ne $second, ' and the new keytab is different'); + is ($one->destroy (@trace), 1, 'Destroying wallet/one works'); + is ($two->destroy (@trace), 1, ' as does destroying wallet/two'); + } # Check that history has been updated correctly. $history .= <<"EOO"; @@ -450,6 +489,12 @@ $date set flag unchanging by $user from $host $date get by $user from $host +$date get + by $user from $host +$date clear flag unchanging + by $user from $host +$date get + by $user from $host $date destroy by $user from $host EOO -- cgit v1.2.3 From 345333f027be0b34318584b3f1b5e3e12adcaa98 Mon Sep 17 00:00:00 2001 From: Russ Allbery Date: Fri, 19 Feb 2010 01:21:48 -0800 Subject: Refactor reporting into a separate module and script Move all reporting from Wallet::Admin to Wallet::Report and simplify the method names since they're now part of a dedicated reporting class. Similarly, create a new wallet-report script to wrap Wallet::Report, moving all reporting commands to it from wallet-admin, and simplify the commands since they're for a dedicated reporting script. Remove the contrib script wallet-report to wallet-summary so that it doesn't conflict with the new reporting backend script. --- Makefile.am | 24 +-- NEWS | 27 +-- TODO | 2 - autogen | 6 +- contrib/wallet-report | 240 -------------------------- contrib/wallet-summary | 240 ++++++++++++++++++++++++++ perl/Wallet/Admin.pm | 311 +-------------------------------- perl/Wallet/Report.pm | 425 ++++++++++++++++++++++++++++++++++++++++++++++ perl/t/admin.t | 143 ++-------------- perl/t/report.t | 171 +++++++++++++++++++ server/wallet-report | 203 ++++++++++++++++++++++ tests/docs/pod-spelling-t | 2 +- tests/docs/pod-t | 2 +- tests/server/admin-t | 76 +-------- tests/server/report-t | 151 ++++++++++++++++ 15 files changed, 1246 insertions(+), 777 deletions(-) delete mode 100755 contrib/wallet-report create mode 100755 contrib/wallet-summary create mode 100644 perl/Wallet/Report.pm create mode 100755 perl/t/report.t create mode 100755 server/wallet-report create mode 100755 tests/server/report-t (limited to 'TODO') diff --git a/Makefile.am b/Makefile.am index db6738a..05ffe53 100644 --- a/Makefile.am +++ b/Makefile.am @@ -16,9 +16,10 @@ PERL_FILES = perl/Wallet/ACL.pm perl/Wallet/ACL/Base.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/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/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 \ @@ -28,14 +29,17 @@ 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 \ + 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 \ 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) + 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) noinst_LIBRARIES = portable/libportable.a util/libutil.a portable_libportable_a_SOURCES = portable/dummy.c portable/krb5-extra.c \ @@ -74,11 +78,11 @@ warnings: # Remove some additional files. 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 +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-admin.8 server/wallet-backend.8 server/wallet-report.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 diff --git a/NEWS b/NEWS index 96962f8..a87ae2f 100644 --- a/NEWS +++ b/NEWS @@ -32,15 +32,22 @@ 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. + Move all reporting from Wallet::Admin to Wallet::Report and simplify + the method names since they're now part of a dedicated reporting + class. Similarly, create a new wallet-report script to wrap + Wallet::Report, moving all reporting commands to it from wallet-admin, + and simplify the commands since they're for a dedicated reporting + script. + + Add additional reports for wallet-report: 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 owners command to wallet-report and corresponding owners() + method to Wallet::Report, which returns all ACL lines on owner ACLs + for matching objects. Report ACL names as well as numbers in object history. @@ -50,7 +57,7 @@ wallet 0.10 (unreleased) implementation than the wallet client. This primarily helps with testing. - Update to rra-c-util 3.0: + Update to rra-c-util 2.3: * Use Kerberos portability layer to support Heimdal. * Avoid Kerberos API calls deprecated on Heimdal. diff --git a/TODO b/TODO index 662ea47..cca8780 100644 --- a/TODO +++ b/TODO @@ -2,8 +2,6 @@ Release 0.10: -* Move reporting code from Wallet::Admin to Wallet::Report. - * 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. diff --git a/autogen b/autogen index aeb4339..f7c8055 100755 --- a/autogen +++ b/autogen @@ -11,11 +11,13 @@ 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 -s 8 contrib/wallet-report \ - > contrib/wallet-report.8 +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 diff --git a/contrib/wallet-report b/contrib/wallet-report deleted file mode 100755 index 1abe1f8..0000000 --- a/contrib/wallet-report +++ /dev/null @@ -1,240 +0,0 @@ -#!/usr/bin/perl -w -# -# wallet-report -- Report on keytabs in the wallet database. -# -# Written by Russ Allbery -# Copyright 2003, 2008 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 $admin = Wallet::Admin->new; - my @objects = $admin->list_objects; - if (!@objects and $admin->error) { - die $admin->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-report - Report on keytabs in the wallet database - -=head1 SYNOPSIS - -wallet-report [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 srvtabs 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/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(-) (limited to 'TODO') 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(-) (limited to 'TODO') 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 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(-) (limited to 'TODO') 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 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(-) (limited to 'TODO') 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 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(+) (limited to 'TODO') 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(+) (limited to 'TODO') 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 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(-) (limited to 'TODO') 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 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(-) (limited to 'TODO') 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 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(-) (limited to 'TODO') 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(+) (limited to 'TODO') 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(-) (limited to 'TODO') 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(+) (limited to 'TODO') 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(+) (limited to 'TODO') 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(-) (limited to 'TODO') 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 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 (limited to 'TODO') 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(-) (limited to 'TODO') 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(-) (limited to 'TODO') 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(+) (limited to 'TODO') 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 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(+) (limited to 'TODO') 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 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(+) (limited to 'TODO') 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 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(-) (limited to 'TODO') 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 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(-) (limited to 'TODO') 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 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(-) (limited to 'TODO') 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