Imported Upstream version 0.10

5 files changed, 383 insertions, 14 deletions

diff --git a/contrib/convert-srvtab-db b/contrib/convert-srvtab-db
index 74b19a7..8d3b31e 100755
--- a/contrib/convert-srvtab-db
+++ b/contrib/convert-srvtab-db
@@ -1,5 +1,4 @@
 #!/usr/bin/perl -w
-our $ID = q$Id$;
 #
 # convert-srvtab-db -- Converts a leland_srvtab database to wallet
 #
diff --git a/contrib/used-principals b/contrib/used-principals
index f5abaf0..c4a6c07 100755
--- a/contrib/used-principals
+++ b/contrib/used-principals
@@ -1,5 +1,4 @@
 #!/usr/bin/perl -w
-our $ID = q$Id$;
 #
 # used-principals -- Report which Kerberos v5 principals are in use.
 #
diff --git a/contrib/wallet-contacts b/contrib/wallet-contacts
new file mode 100755
index 0000000..a7bccf3
--- /dev/null
+++ b/contrib/wallet-contacts
@@ -0,0 +1,193 @@
+#!/usr/bin/perl -w
+#
+# wallet-contacts -- Report contact addresses for matching wallet objects.
+#
+# Written by Russ Allbery <rra@stanford.edu>
+# Copyright 2009 Board of Trustees, Leland Stanford Jr. University
+#
+# See LICENSE for licensing terms.
+
+##############################################################################
+# Modules and declarations
+##############################################################################
+
+require 5.006;
+
+use strict;
+
+use Getopt::Long qw(GetOptions);
+use Wallet::Admin ();
+
+# Used to cache lookups of e-mail addresses by identifiers.
+our %EMAIL;
+
+##############################################################################
+# whois lookups
+##############################################################################
+
+# Given the directory handle of a user, look up their e-mail address.  This
+# assumes the Stanford-specific swhois program.
+sub person_email {
+    my ($identifier) = @_;
+    return $EMAIL{$identifier} if exists $EMAIL{$identifier};
+    my @output = `swhois '$identifier'`;
+    for my $line (@output) {
+        if ($line =~ /^\s*Email:\s*(\S+)/i) {
+            $EMAIL{$identifier} = $1;
+            return $1;
+        } elsif ($line =~ /^\s*SUNet IDs:\s*(\S+)/) {
+            my $email = $1 . '@stanford.edu';
+            $EMAIL{$identifier} = $email;
+            return $email;
+        }
+    }
+    warn "$0: unable to find email address for identifier $identifier\n";
+    $EMAIL{$identifier} = undef;
+    return;
+}
+
+# Look up a system in whois and return the e-mail address or addresses of the
+# administrator.
+sub whois_lookup {
+    my ($system) = @_;
+    my @output = `swhois '$system'`;
+    my ($inadmin, @users, @admins);
+    for (@output) {
+        if (/^\s*administrator:\s*(?:\S+\s+)+\((d\S+)\)\s*$/i) {
+            push (@admins, person_email ($1));
+            $inadmin = 1;
+        } elsif (/^\s*administrator:/i) {
+            $inadmin = 1;
+        } elsif (/^\s*group:/i) {
+            $inadmin = 0;
+        } elsif ($inadmin and /^\s*e-?mail: (\S+)/i) {
+            push (@admins, $1);
+        } elsif ($inadmin and /^\s*(?:\S+\s+)+\((d\S+)\)\s*$/i) {
+            push (@admins, person_email ($1));
+        } elsif (/^\s*user:\s*(?:\S+\s+)+\((d\S+)\)\s*$/i) {
+            push (@users, person_email ($1));
+        }
+    }
+    @admins = @users if !@admins;
+    warn "$0: unable to find administrator for $system\n" unless @admins;
+    return @admins;
+}
+
+##############################################################################
+# Main routine
+##############################################################################
+
+# Read in command-line options.
+my ($help);
+Getopt::Long::config ('no_ignore_case', 'bundling');
+GetOptions ('help|h' => \$help) or exit 1;
+if ($help) {
+    print "Feeding myself to perldoc, please wait....\n";
+    exec ('perldoc', '-t', $0);
+}
+my ($type, $name) = @ARGV;
+if (@ARGV > 2 or not defined $name) {
+    die "Usage: wallet-contacts <type> <name>\n";
+}
+
+# Clean up $0 for error reporting.
+$0 =~ s%.*/%%;
+
+# Gather the list of ACL lines.
+my $admin = Wallet::Admin->new;
+my @lines = $admin->report_owners ($type, $name);
+if (!@lines and $admin->error) {
+    die $admin->error, "\n";
+}
+
+# Now, for each line, turn it into an e-mail address.  krb5 ACLs go as-is if
+# they are regular user principals.  If they're other principals, ignore them
+# unless they're of the form host/*, in which case extract the host and treat
+# it the same as a netdb ACL.  netdb and netdb-root ACLs result in a whois
+# lookup on that host, extracting the e-mail address of the administrator
+# group.  If there is no e-mail address, extract the user and look up their
+# e-mail address.
+my @email;
+for (@lines) {
+    my ($scheme, $identifier) = @$_;
+    my $machine;
+    if ($scheme eq 'krb5') {
+        if ($identifier =~ m,^[^/]+\@,) {
+            push (@email, $identifier);
+        } elsif ($identifier =~ m,^host/([^/]+)\@,) {
+            $machine = $1;
+        }
+    } elsif ($scheme eq 'netdb' or $scheme eq 'netdb-root') {
+        $machine = $identifier;
+    }
+    if ($machine) {
+        push (@email, whois_lookup ($machine));
+    }
+}
+
+# We now have a list of e-mail addresses.  De-duplicate and then print them
+# out.
+my %seen;
+@email = grep { !$seen{$_}++ } sort @email;
+print join ("\n", @email, '');
+
+##############################################################################
+# Documentation
+##############################################################################
+
+=head1 NAME
+
+wallet-contacts - Report contact addresses for matching wallet objects
+
+=head1 SYNOPSIS
+
+B<wallet-contacts> [B<-h>] I<type-pattern> I<name-pattern>
+
+=head1 DESCRIPTION
+
+B<wallet-contacts> returns a list of e-mail addresses corresponding to
+members of owner ACLs for all objects in the wallet database matching
+I<type-pattern> and I<name-pattern>.  The patterns can be wallet object
+types or names, or they can be SQL patterns using C<%> as a wildcard.
+
+C<krb5> ACL schemes will return the corresponding identifier as an e-mail
+address unless it contains a C</>.  If it contains C</>, it will be
+ignored except for principals of the form C<host/I<hostname>>, which will
+have I<hostname> treated as if it were the identifier in a C<netdb> ACL.
+
+C<netdb> and C<netdb-root> ACL schemes will return the e-mail address from
+a whois lookup of the corresponding NetDB object.  B<wallet-contacts> will
+run B<whois> on the system name and search the output for users and
+administrators.  E-mail addresses for admin groups will be returned as-is.
+Administrators will result in a second lookup via B<swhois> for their
+directory handle, returning the corresponding e-mail address if found in
+their whois record.  If there are no administrators or admin teams with
+e-mail addresses, the value of the user key, if any, will be looked up
+similar to an administrator.
+
+If B<wallet-contacts> is unable to find any contact for a host or any
+e-mail address for an administrator or user, it will warn but continue.
+
+=head1 OPTIONS
+
+=over 4
+
+=item B<-h>, B<--help>
+
+Print out this documentation (which is done simply by feeding the script
+to C<perldoc -t>).
+
+=back
+
+=head1 CAVEATS
+
+Many of the assumptions made by this script are Stanford-specific, such as
+the ability to use Kerberos principals as-is as e-mail addresses, the
+B<swhois> program for looking up people, and the parsing of the B<whois>
+output format.
+
+=head1 AUTHOR
+
+Russ Allbery <rra@stanford.edu>
+
+=cut
diff --git a/contrib/wallet-report b/contrib/wallet-summary
index 6f09914..7a51f9e 100755
--- a/contrib/wallet-report
+++ b/contrib/wallet-summary
@@ -1,10 +1,9 @@
 #!/usr/bin/perl -w
-$ID = q$Id$;
 #
-# wallet-report -- Report on keytabs in the wallet database.
+# wallet-summarize -- Summarize keytabs in the wallet database.
 #
 # Written by Russ Allbery <rra@stanford.edu>
-# Copyright 2003, 2008 Board of Trustees, Leland Stanford Jr. University
+# Copyright 2003, 2008, 2010 Board of Trustees, Leland Stanford Jr. University
 #
 # See LICENSE for licensing terms.
 
@@ -41,7 +40,7 @@ $ADDRESS = 'nobody@example.com';
 require 5.005;
 
 use strict;
-use vars qw($ADDRESS $DUMPFILE $ID @PATTERNS $REPORTS);
+use vars qw($ADDRESS $DUMPFILE @PATTERNS $REPORTS);
 
 use Getopt::Long qw(GetOptions);
 use File::Path qw(mkpath);
@@ -55,10 +54,10 @@ use Wallet::Admin ();
 # 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;
+    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;
 }
@@ -177,11 +176,11 @@ close REPORT;
 
 =head1 NAME
 
-wallet-report - Report on keytabs in the wallet database
+wallet-summary - Report on keytabs in the wallet database
 
 =head1 SYNOPSIS
 
-wallet-report [B<-hm>]
+B<wallet-summary> [B<-hm>]
 
 =head1 DESCRIPTION
 
@@ -190,8 +189,8 @@ 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.
+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
 
diff --git a/contrib/wallet-summary.8 b/contrib/wallet-summary.8
new file mode 100644
index 0000000..088f307
--- /dev/null
+++ b/contrib/wallet-summary.8
@@ -0,0 +1,179 @@
+.\" Automatically generated by Pod::Man 2.22 (Pod::Simple 3.13)
+.\"
+.\" Standard preamble:
+.\" ========================================================================
+.de Sp \" Vertical space (when we can't use .PP)
+.if t .sp .5v
+.if n .sp
+..
+.de Vb \" Begin verbatim text
+.ft CW
+.nf
+.ne \\$1
+..
+.de Ve \" End verbatim text
+.ft R
+.fi
+..
+.\" Set up some character translations and predefined strings.  \*(-- will
+.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
+.\" double quote, and \*(R" will give a right double quote.  \*(C+ will
+.\" give a nicer C++.  Capital omega is used to do unbreakable dashes and
+.\" therefore won't be available.  \*(C` and \*(C' expand to `' in nroff,
+.\" nothing in troff, for use with C<>.
+.tr \(*W-
+.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
+.ie n \{\
+.    ds -- \(*W-
+.    ds PI pi
+.    if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
+.    if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\"  diablo 12 pitch
+.    ds L" ""
+.    ds R" ""
+.    ds C` ""
+.    ds C' ""
+'br\}
+.el\{\
+.    ds -- \|\(em\|
+.    ds PI \(*p
+.    ds L" ``
+.    ds R" ''
+'br\}
+.\"
+.\" Escape single quotes in literal strings from groff's Unicode transform.
+.ie \n(.g .ds Aq \(aq
+.el       .ds Aq '
+.\"
+.\" If the F register is turned on, we'll generate index entries on stderr for
+.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
+.\" entries marked with X<> in POD.  Of course, you'll have to process the
+.\" output yourself in some meaningful fashion.
+.ie \nF \{\
+.    de IX
+.    tm Index:\\$1\t\\n%\t"\\$2"
+..
+.    nr % 0
+.    rr F
+.\}
+.el \{\
+.    de IX
+..
+.\}
+.\"
+.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2).
+.\" Fear.  Run.  Save yourself.  No user-serviceable parts.
+.    \" fudge factors for nroff and troff
+.if n \{\
+.    ds #H 0
+.    ds #V .8m
+.    ds #F .3m
+.    ds #[ \f1
+.    ds #] \fP
+.\}
+.if t \{\
+.    ds #H ((1u-(\\\\n(.fu%2u))*.13m)
+.    ds #V .6m
+.    ds #F 0
+.    ds #[ \&
+.    ds #] \&
+.\}
+.    \" simple accents for nroff and troff
+.if n \{\
+.    ds ' \&
+.    ds ` \&
+.    ds ^ \&
+.    ds , \&
+.    ds ~ ~
+.    ds /
+.\}
+.if t \{\
+.    ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u"
+.    ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u'
+.    ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u'
+.    ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u'
+.    ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u'
+.    ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u'
+.\}
+.    \" troff and (daisy-wheel) nroff accents
+.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V'
+.ds 8 \h'\*(#H'\(*b\h'-\*(#H'
+.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#]
+.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H'
+.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u'
+.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#]
+.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#]
+.ds ae a\h'-(\w'a'u*4/10)'e
+.ds Ae A\h'-(\w'A'u*4/10)'E
+.    \" corrections for vroff
+.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u'
+.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u'
+.    \" for low resolution devices (crt and lpr)
+.if \n(.H>23 .if \n(.V>19 \
+\{\
+.    ds : e
+.    ds 8 ss
+.    ds o a
+.    ds d- d\h'-1'\(ga
+.    ds D- D\h'-1'\(hy
+.    ds th \o'bp'
+.    ds Th \o'LP'
+.    ds ae ae
+.    ds Ae AE
+.\}
+.rm #[ #] #H #V #F C
+.\" ========================================================================
+.\"
+.IX Title "WALLET-SUMMARY 8"
+.TH WALLET-SUMMARY 8 "2010-02-20" "0.10" "wallet"
+.\" For nroff, turn off justification.  Always turn off hyphenation; it makes
+.\" way too many mistakes in technical documents.
+.if n .ad l
+.nh
+.SH "NAME"
+wallet\-summary \- Report on keytabs in the wallet database
+.SH "SYNOPSIS"
+.IX Header "SYNOPSIS"
+\&\fBwallet-summary\fR [\fB\-hm\fR]
+.SH "DESCRIPTION"
+.IX Header "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 \fB\-m\fR below.
+.PP
+The classifications of principals are determined by a set of patterns at
+the beginning of this script.  Modify it to add new classifications.
+.SH "OPTIONS"
+.IX Header "OPTIONS"
+.IP "\fB\-h\fR, \fB\-\-help\fR" 4
+.IX Item "-h, --help"
+Print out this documentation (which is done simply by feeding the script to
+\&\f(CW\*(C`perldoc \-t\*(C'\fR).
+.IP "\fB\-m\fR, \fB\-\-mail\fR" 4
+.IX Item "-m, --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 \fI/afs/ir/dept/itss/infrastructure/reports\fR.
+.SH "FILES"
+.IX Header "FILES"
+.IP "\fI/afs/ir/dept/itss/infrastructure/reports\fR" 4
+.IX Item "/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
+\&\f(CW\*(C`kerberos\*(C'\fR, under the name \f(CW\*(C`wallet\*(C'\fR.  In other words, for a report run
+in March of 2003, the report will be saved in the file:
+.Sp
+.Vb 1
+\&    /afs/ir/dept/itss/infrastructure/reports/2003/03/kerberos/srvtabs
+.Ve
+.SH "NOTES"
+.IX Header "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.
+.SH "AUTHOR"
+.IX Header "AUTHOR"
+Russ Allbery <rra@stanford.edu>