diff options
| -rw-r--r-- | Makefile.am | 29 | ||||
| -rw-r--r-- | TODO | 5 | ||||
| -rw-r--r-- | contrib/README | 8 | ||||
| -rwxr-xr-x | contrib/wallet-report | 239 |
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 @@ -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 |