aboutsummaryrefslogtreecommitdiff
path: root/contrib/wallet-summary
diff options
context:
space:
mode:
Diffstat (limited to 'contrib/wallet-summary')
-rwxr-xr-xcontrib/wallet-summary240
1 files changed, 240 insertions, 0 deletions
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 <rra@stanford.edu>
+# 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 <REPORT>;
+ 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<wallet-summary> [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<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