#!/usr/bin/perl
#
# Report host keytabs in wallet for unknown hosts.

##############################################################################
# Modules and declarations
##############################################################################

require 5.006;

use strict;
use warnings;

use DB_File ();
use Wallet::Report ();
use Wallet::Server ();

##############################################################################
# Site configuration
##############################################################################

# The path to the supplemental database used to store last seen times and
# counts.  Keys are hostnames, and values are the number of times the hostname
# was not seen in DNS, a comma, and the UNIX seconds since epoch of the first
# run during which the host was not found.
#
# This should probably be in the wallet database, but let's try it here first
# and hammer out the data and then add it there later.
our $HISTORY = '/var/lib/wallet/hosts.db';

# Default thresholds for reporting or purging.  $MIN is the number of times we
# see the keytab in a row eligible for purge, and $THRESHOLD is the newest
# that the first time can be and still be eligible.
our $MIN       = 3;
our $THRESHOLD = time - 30 * 24 * 60 * 60;

# Set up a Net::DNS resolver that will be used by local_check_keytab.
my $DNS;
BEGIN {
    use Net::DNS;
    $DNS = Net::DNS::Resolver->new;
}

# Pre-filter.  This is called for all host-based keytabs and is the place to
# apply local exceptions for keytabs that should be retained even though
# there's no corresponding DNS entry.  The first argument is the full
# principal name and the second argument is the extracted host.
#
# This function should return 1 if the host is found or if the keytab should
# otherwise not be a candidate for purging, 0 if the keytab should be a
# candidate for purging, and undef if the normal DNS-based check should be
# done.
sub local_check_keytab {
    my ($keytab, $host) = @_;

    # Aliases of proxy.best.stanford.edu and www.best.stanford.edu should not
    # have host-based keytabs of their own.
    my %purge = map { $_ => 1 }
        qw(proxy.best.stanford.edu www.best.stanford.edu);
    my $query = $DNS->search ($host);
    return unless $query;
    for my $rr ($query->answer) {
        next unless $rr->type eq 'CNAME';
        return 0 if $purge{$rr->cname};
    }

    # Do normal processing by default.
    return;
}

##############################################################################
# Utility functions
##############################################################################

# Return a list of host-based keytab objects in the wallet database.  The
# current heuristic is to look for any keytab object with a principal name
# that includes a slash and at least one period.  This may be refined later.
sub list_keytabs {
    my $report = Wallet::Report->new;
    my @objects = $report->objects ('type', 'keytab');
    if (!@objects and $report->error) {
        die $report->error, "\n";
    }
    return grep { m%/.+\..+% } map { $$_[1] } @objects;
}

# Given a host, look it up in DNS and see if it exists.  Returns true if the
# host exists and false otherwise.
sub check_host {
    my ($host) = @_;
    my $addr = gethostbyname $host;
    return defined ($addr) ? 1 : 0;
}

##############################################################################
# Main functions
##############################################################################

# Do a scan of all host-based keytabs in wallet and record those that are not
# found in DNS or which should not be used according to site configuration.
sub check {
    my %history;
    tie %history, 'DB_File', $HISTORY;
    my @keytabs = list_keytabs;
    for my $keytab (@keytabs) {
        my ($host) = (split '/', $keytab)[1];
        my $result = local_check_keytab ($keytab, $host);
        unless (defined $result) {
            $result = check_host ($host);
        }
        if ($result) {
            delete $history{$keytab};
        } elsif ($history{$keytab}) {
            my ($count, $time) = split (',', $history{$keytab});
            $count++;
            $history{$keytab} = "$count,$time";
        } else {
            $history{$keytab} = '1,' . time;
        }
    }
    untie %history;
}

# Report on all keytabs that are eligible to be deleted.  Takes two values:
# the threshold for the number of times the keytab had to show up as eligible
# for purge, and the threshold for how long the keytab must have been on that
# list (given as a threshold time in seconds since epoch).
sub report {
    my ($min, $threshold) = @_;
    my %history;
    tie %history, 'DB_File', $HISTORY;
    for my $keytab (sort keys %history) {
        my ($count, $time) = split (',', $history{$keytab});
        if ($count > $min && $time < $threshold) {
            print $keytab, "\n";
        }
    }
    untie %history;
}

# Purge eligible keytabs.  Takes three values: the user to authenticate as,
# the threshold for the number of times the keytab had to show up as eligible
# for purge, and the threshold for the first date when the keytab was seen
# eligible for purge.  Rather than listing the keytabs, this deletes them
# immediately.
sub purge {
    my ($user, $min, $threshold) = @_;
    my $wallet = Wallet::Server->new ($user, 'localhost');
    my %history;
    tie %history, 'DB_File', $HISTORY;
    for my $keytab (sort keys %history) {
        my ($count, $time) = split (',', $history{$keytab});
        if ($count > $min && $time < $threshold) {
            unless ($wallet->destroy ('keytab', $keytab)) {
                warn "$0: cannot destroy keytab $keytab: ",
                    $wallet->error, "\n";
            }
        }
    }
    untie %history;
}

##############################################################################
# Main routine
##############################################################################

my $command = shift or die "Usage: $0 (check | report | purge)\n";
if ($command eq 'check') {
    check ();
} elsif ($command eq 'report') {
    my ($min, $threshold) = @_;
    $min = $MIN unless defined ($min);
    die "$0: minimum count must be at least 1\n" if $min < 1;
    $threshold = $THRESHOLD unless defined ($threshold);
    report ($min, $threshold);
} elsif ($command eq 'purge') {
    my $user = $ENV{REMOTE_USER} or die "$0: REMOTE_USER must be set\n";
    my ($min, $threshold) = @_;
    $min = $MIN unless defined ($min);
    die "$0: minimum count must be at least 1\n" if $min < 1;
    $threshold = $THRESHOLD unless defined ($threshold);
    purge ($min, $threshold);
} else {
    die "$0: unknown command $command\n";
}

##############################################################################
# Documentation
##############################################################################

=for stopwords
ACL API CNAME DNS IP env keytab keytabs timestamp MERCHANTABILITY
NONINFRINGEMENT sublicense Allbery

=head1 NAME

wallet-unknown-hosts - Report host keytabs in wallet for unknown hosts

=head1 SYNOPSIS

B<wallet-unknown-hosts> check

B<wallet-unknown-hosts> report I<min> I<date>

env REMOTE_USER=I<principal> B<wallet-unknown-hosts> purge I<min> I<date>

=head1 DESCRIPTION

B<wallet-unknown-hosts> constructs a database recording host-based keytabs
in wallet whose corresponding hosts are not found in DNS.  It records in
that database the number of times the host wasn't found and the timestamp
of the first time it was not found.  It can then generate a report of
host-based keytab objects that have not been found for a minimum number of
consecutive times and which were last found longer ago than a particular
date.  Finally, it can purge from wallet all objects that meet those
requirements.

When run with the C<check> argument, B<wallet-unknown-hosts> traverses the
wallet database looking for host-based keytabs, which it recognizes by
looking for keytab objects for principals with at least one period (C<.>)
after a slash (C</>).  It then applies a local check followed by a DNS
check.  The DNS check is only successful (only considers the host to be
found) if it resolves to an IP address (possibly through a CNAME).

For any host that's not found, it records that host in its associated
database.  If this is the first time it wasn't found, it records the first
missing time as the current time and the missing count as 1.  If it
previously wasn't found, it just increments the missing count.

For any host that is found, it deletes any record for that keytab from the
database.

When run with the C<report> argument, B<wallet-unknown-hosts> takes two
additional arguments: I<min> and I<date>.  I<min> is the minimum number of
times that a host must be found missing for the corresponding keytabs to
show up on the report.  I<date> is a cutoff date in seconds since epoch;
keytabs will not be included in the report unless their first missing date
is older than I<date>.  The output will be the name component of the
keytab objects in the wallet that correspond to unknown hosts and meet
those thresholds.

When run with the C<purge> argument, B<wallet-unknown-hosts> will build a
list of keytab objects the same as with the C<report> argument, using the
same additional arguments, but rather than printing them out will instead
delete them from the wallet database.  To run C<purge>, the environment
variable REMOTE_USER must be set to a principal that's a member of the
C<ADMIN> ACL.

=head1 BUGS

B<wallet-unknown-hosts> doesn't have any facility to purge from its
database all objects that are no longer in the wallet.

Having to specify an identity for purge mode is an artifact of the
Wallet::Server API and needs to be fixed by providing some way to perform
actions as a local administrator.

=head1 AUTHOR

Russ Allbery <eagle@eyrie.org>

=head1 COPYRIGHT AND LICENSE

Copyright 2010, 2013 The Board of Trustees of the Leland Stanford Junior
University

Permission is hereby granted, free of charge, to any person obtaining a
copy of this software and associated documentation files (the "Software"),
to deal in the Software without restriction, including without limitation
the rights to use, copy, modify, merge, publish, distribute, sublicense,
and/or sell copies of the Software, and to permit persons to whom the
Software is furnished to do so, subject to the following conditions:

The above copyright notice and this permission notice shall be included in
all copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
DEALINGS IN THE SOFTWARE.

=cut