Add a keytab reporting script.

4 files changed, 267 insertions, 14 deletions

diff --git a/Makefile.am b/Makefile.am
index d00465f..b8271e3 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -9,20 +9,21 @@ 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 \
-	docs/design-acl docs/design-api docs/netdb-role-api docs/notes \
-	docs/setup kasetkey/README kasetkey/kasetkey.pod perl/Wallet/ACL.pm \
-	perl/Wallet/ACL/Base.pm perl/Wallet/ACL/Krb5.pm \
-	perl/Wallet/ACL/NetDB.pm perl/Wallet/ACL/NetDB/Root.pm \
-	perl/Wallet/Admin.pm perl/Wallet/Config.pm \
-	perl/Wallet/Database.pm perl/Wallet/Object/Base.pm \
-	perl/Wallet/Object/Keytab.pm perl/Wallet/Schema.pm \
-	perl/Wallet/Server.pm perl/t/acl.t perl/t/admin.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.t tests/TESTS \
-	tests/data/README tests/data/allow-extract tests/data/cmd-fake \
-	tests/data/fake-data tests/data/fake-kadmin tests/data/fake-keytab \
+	contrib/README contrib/wallet-report docs/design-acl docs/design-api \
+	docs/netdb-role-api docs/notes docs/setup kasetkey/README \
+	kasetkey/kasetkey.pod perl/Wallet/ACL.pm perl/Wallet/ACL/Base.pm \
+	perl/Wallet/ACL/Krb5.pm perl/Wallet/ACL/NetDB.pm \
+	perl/Wallet/ACL/NetDB/Root.pm perl/Wallet/Admin.pm \
+	perl/Wallet/Config.pm perl/Wallet/Database.pm \
+	perl/Wallet/Object/Base.pm perl/Wallet/Object/Keytab.pm \
+	perl/Wallet/Schema.pm perl/Wallet/Server.pm perl/t/acl.t \
+	perl/t/admin.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.t tests/TESTS tests/data/README \
+	tests/data/allow-extract tests/data/cmd-fake tests/data/fake-data \
+	tests/data/fake-kadmin tests/data/fake-keytab \
 	tests/data/fake-keytab-2 tests/data/fake-keytab-merge \
 	tests/data/fake-srvtab tests/data/wallet.conf
 
diff --git a/TODO b/TODO
index b61db5b..fa15ef1 100644
--- a/TODO
+++ b/TODO
@@ -162,6 +162,11 @@ Future work:
   triggers rather than explicit SQL.  This may also replace
   Wallet::Schema.
 
+* 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.
+
 May or may not be good ideas:
 
 * Consider using Class::Accessor to get rid of the scaffolding code to
diff --git a/contrib/README b/contrib/README
new file mode 100644
index 0000000..5947efa
--- /dev/null
+++ b/contrib/README
@@ -0,0 +1,8 @@
+This directory contains various supporting scripts used with wallet at
+Stanford University.  They embed various paths, assumptions about object
+naming, local site policy, and similar quirks specific to Stanford and
+therefore will require modification for use at other sites.
+
+They may, however, be useful as examples of how to do various things with
+wallet or use the wallet Perl API outside of the provided backend scripts,
+or as a basis for similar local infrastructure.
diff --git a/contrib/wallet-report b/contrib/wallet-report
new file mode 100755
index 0000000..edf015e
--- /dev/null
+++ b/contrib/wallet-report
@@ -0,0 +1,239 @@
+#!/usr/bin/perl -w
+$ID = q$Id$
+#
+# wallet-report -- Report on keytabs in the wallet database.
+#
+# Written by Russ Allbery <rra@stanford.edu>
+# Copyright 2003, 2008 Board of Trustees, Leland Stanford Jr. University
+
+##############################################################################
+# 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 $ID @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, $version);
+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 <REPORT>;
+    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<perldoc -t>).
+
+=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</afs/ir/dept/itss/infrastructure/reports>.
+
+=back
+
+=head1 FILES
+
+=over 4
+
+=item F</afs/ir/dept/itss/infrastructure/reports>
+
+The root directory for archived reports.  Archived reports will be saved
+under this directory in a subdirectory for the year, the month, and
+C<kerberos>, under the name C<wallet>.  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 <rra@stanford.edu>
+
+=cut