1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
|
#!/usr/bin/perl -w
#
# wallet-unknown-hosts -- Report host keytabs in wallet for unknown hosts.
#
# Written by Russ Allbery <rra@stanford.edu>
# Copyright 2010 Board of Trustees, Leland Stanford Jr. University
#
# See LICENSE for licensing terms.
##############################################################################
# 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.
BEGIN {
use Net::DNS;
our $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;
}
##############################################################################
# Modules and declarations
##############################################################################
require 5.006;
use strict;
use DB_File ();
use Wallet::Report ();
use Wallet::Server ();
##############################################################################
# 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 {
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) = @_;
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');
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";
$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";
}
|
