source: trunk/debathena/debathena/verify/debian/verify_ws.pl @ 25640

Revision 25640, 7.8 KB checked in by jdreed, 12 years ago (diff)
You do in fact need to be root
  • Property svn:executable set to *
Line 
1#!/usr/bin/perl -w
2#
3# Workstation "verification" script
4#
5
6use strict;
7use Getopt::Std;
8use File::Basename;
9use AptPkg::Config '$_config';
10use AptPkg::Cache;
11
12my $logfile = "/var/log/verify_ws.log";
13my $verify_dir = "/afs/athena.mit.edu/system/athena10/verify";
14
15($> == 0) || die "You must be root to run this.\n";
16
17our ($opt_d,$opt_s) = (0,'');
18
19getopts('ds:') || die "Usage: $0 [-d]\n";
20
21if ($opt_d) {
22    open(LOG, ">&STDOUT") || die "Can't dup stdout";
23} else {
24    open(LOG, ">>$logfile") || die "Cannot append to logfile: $!";
25}
26
27my %MIRRORS_OK = ();
28my %COMPONENTS_OK = ();
29my %SUITES_OK = ();
30my %DA_MIRRORS_OK = ();
31my %DA_COMPONENTS_OK = ();
32my %DA_SUITES_OK = ();
33my %APTKEYS_OK = ();
34my %DEBSUMS_MISSING_PKG_OK = ();
35my %DEBSUMS_MISSING_FILE_OK = ();
36my %DEBSUMS_CHANGED_FILE_OK = ();
37
38my $errors = 0;
39my $warns = 0;
40my %checks = ('sources' => 1,
41              'keys' => 1,
42              'debsums' => 1,
43              'policy', => 1 );
44
45
46# Initialize the APT configuration
47$_config->init;
48my $cache = AptPkg::Cache->new;
49my $policy = $cache->policy;
50
51# Basic setup
52my $codename = `/usr/bin/lsb_release -sc`;
53die "Can't determine codename" unless ($? == 0);
54chomp($codename);
55
56if ($opt_s) {
57    foreach my $skip (split(',', $opt_s)) {
58        die "Can't skip unknown check '$skip'" unless exists($checks{$skip});
59        warn("Skipping check '$skip'");
60        $checks{$skip} = 0;
61    }
62}
63           
64sub debug {
65    $opt_d && print LOG "DEBUG: ", @_, "\n";
66}
67
68sub error {
69    $errors = 1;
70    print LOG "ERROR: ", @_, "\n";
71}
72
73sub wank {
74    $warns = 1;
75    print LOG "WARNING: ", @_, "\n";
76}
77
78sub loadConfigFile {
79    my ($filename, $hashref) = @_;
80    open(F, join('/', $verify_dir, $codename, $filename)) ||
81        die "Can't open '$filename' file: $!";
82    foreach my $line (<F>) {
83        next if ($line =~ /^#/);
84        next unless ($line =~ /\w/);
85        chomp $line;
86        $hashref->{$line} = 1;
87    }
88    close(F);
89}
90   
91sub checkSourcesList {
92    my ($filename, $mirrorsok, $suitesok, $componentsok) = @_;
93    if (open(SLIST, $filename)) {
94        while (<SLIST>) {
95            next if /^#/;
96            next unless /\w/;
97            my ($type, $mirror, $suite, @components) = split(' ', $_);
98            error($filename, ":", $., " Unknown first field ($type)") unless
99                ($type =~ /^deb(-src){0,1}$/);
100            $mirror =~ s|/+$||g;
101            error($filename, ":", $., " Unknown mirror ($mirror)") unless
102                exists($mirrorsok->{$mirror});
103            error($filename, ":", $., " Unknown suite ($suite)") unless
104                exists($suitesok->{$suite});
105            foreach my $c (@components) {
106                error($filename, ":", $., " Unknown component ($c)") unless
107                    exists($componentsok->{$c});
108            }
109        }
110        close(SLIST);
111    } else {
112        error("Couldn't open file ($filename): $!");
113    }
114}           
115
116sub checkAptSources {
117    my $sourceslist = join('', $_config->get('Dir'),
118                           $_config->get('Dir::Etc'),
119                           $_config->get('Dir::Etc::sourcelist'));
120   
121    wank("sources.list ($sourceslist) looks funny") unless
122        ((-f $sourceslist) && ($sourceslist eq "/etc/apt/sources.list"));
123   
124   
125    my $sourceslistd = join('', $_config->get('Dir'),
126                            $_config->get('Dir::Etc'),
127                            $_config->get('Dir::Etc::sourceparts'));
128   
129    wank("sources.list.d ($sourceslistd) looks funny") unless
130        ((-d $sourceslistd ) && ($sourceslistd eq "/etc/apt/sources.list.d"));
131
132    debug("Looking at sources.list ($sourceslist)");
133    checkSourcesList($sourceslist, \%MIRRORS_OK, \%SUITES_OK, \%COMPONENTS_OK);
134   
135    foreach my $file (glob '/etc/apt/sources.list.d/*.list') {
136        debug("Looking at $file");
137        if (basename($file) eq "debathena.list") {
138            checkSourcesList($file,
139                             \%DA_MIRRORS_OK,
140                             { $codename => 1 },
141                             \%DA_COMPONENTS_OK);
142        } elsif (basename($file) eq "debathena.clusterinfo.list") {
143            checkSourcesList($file,
144                             \%DA_MIRRORS_OK,
145                             \%DA_SUITES_OK,
146                             \%DA_COMPONENTS_OK);
147        } else {
148            error("Unknown additional sources.list file ($file)");
149        }
150    }
151}
152
153sub checkAptKeys {
154    debug("Checking apt keys...");
155    my $apt_keys = qx'/usr/bin/apt-key finger';
156    die "Can't run apt-key" unless ($? == 0);
157    $apt_keys =~ s/^.*?\n(?=pub)//s;
158    foreach my $k (split(/\n\n/, $apt_keys)) {
159        if ($k =~ /^\s+Key fingerprint = (.*)\nuid\s+(\S.*)$/m) {
160            error("Unknown fingerprint ($1) for key ($2)") unless exists($APTKEYS_OK{$1});
161        }
162    }
163}
164       
165sub debsums {
166    debug("Running debsums");
167    # Bad-ideas: Since debsums is itself written in Perl...
168    open(DEBSUMS, "/usr/bin/debsums -as 2>&1 |") || die "Can't run debsums";
169    foreach my $sum (<DEBSUMS>) {
170        chomp $sum;
171        if ($sum =~ /^debsums: no md5sums for (\S+)/) {
172            error("$sum") unless exists($DEBSUMS_MISSING_PKG_OK{$1});
173        } elsif ($sum =~ /^debsums: changed file (\S+)/) {
174            error("$sum") unless exists($DEBSUMS_CHANGED_FILE_OK{$1});
175        } elsif ($sum =~ /^debsums: missing file (\S+)/) {
176            error("$sum") unless exists($DEBSUMS_MISSING_FILE_OK{$1});
177        } else {
178            error("Unexpected debsums output: $sum");
179        }
180    }
181    close(DEBSUMS);
182}
183
184sub checkPackage {
185    my $pkgname = shift;
186    debug("Checking package $pkgname");
187    my $pkg = $cache->{$pkgname};
188    unless ($pkg) {
189        error("Can't find $pkgname in cache");
190        return 0;
191    }
192#    use Data::Dumper;
193#    $Data::Dumper::Maxdepth = 2;
194#    print Dumper($pkg);
195#    exit;
196    if ($pkg->{CurrentState} ne 'Installed') {
197        if ($pkg->{CurrentState} eq 'ConfigFiles') {
198            wank("Package $pkgname still has config files");
199        } elsif ($pkg->{CurrentState} eq 'NotInstalled') {
200            wank("Package $pkgname should have been autoremoved.");
201        } else {
202            error("Package $pkgname in weird state " . $pkg->{CurrentState});
203        }
204        return 0;
205    }
206    my $currver = '';
207    if ($pkg->{CurrentVer}) {
208        $currver = $pkg->{CurrentVer}{VerStr};
209    }
210    my $fromrepo = 0;
211    foreach my $file (@{$pkg->{CurrentVer}{FileList}}) {
212        next if ($file->{File}->{IndexType} ne 'Debian Package Index');
213        if ($file->{File}->{Origin} =~ /^(Ubuntu|Debathena)$/) {
214            $fromrepo = 1;
215        }
216    }
217    if ($pkgname =~ /^linux-(headers|image)-/) {
218        wank("Old kernel package ($pkgname) needs cleanup!");
219    } else {
220        error("$pkgname ($currver) cannot be installed from a repository!") unless ($fromrepo);
221    }
222}
223       
224sub checkInstallability {
225    debug("Checking installability of installed packages");
226    # Todo: multiarch
227    my %seen = ();
228    # Seriously, why can't I do this natively?
229    open(PKGLIST, '/usr/bin/dpkg-query -W -f \'${Package}\n\' |') || die "Can't run dpkg-query";
230    while (<PKGLIST>) {
231        chomp;
232        next if exists($seen{$_});
233        $seen{$_} = 1;
234        checkPackage($_);
235    }
236    close(PKGLIST);
237}
238
239# __main__
240
241defined($ENV{'APT_CONFIG'}) && wank("APT_CONFIG is defined and shouldn't be");
242
243print LOG "Workstation verification beginning at ",
244    scalar(localtime()), "\n";
245
246# Load configuration from AFS
247foreach ('', '-updates', '-security') {
248    $SUITES_OK{join('', $codename, $_)} = 1;
249}
250$DA_SUITES_OK{$codename} = 1;
251if (-s "/var/run/athena-clusterinfo.sh") {
252    my $apt_release = qx'. /var/run/athena-clusterinfo.sh && echo -n $APT_RELEASE';
253    if ($apt_release !~ /^(production|proposed|development)$/) {
254        error("Unknown APT_RELEASE value ($apt_release)");
255    } elsif ($apt_release ne "production") {
256        $DA_SUITES_OK{join('', $codename, '-', $apt_release)} = 1;
257        if ($apt_release eq "development") {
258            $DA_SUITES_OK{join('', $codename, '-', 'proposed')} = 1;
259        }
260    }
261} else {
262    warn("No clusterinfo!");
263}
264loadConfigFile('mirrors', \%MIRRORS_OK);
265loadConfigFile('components', \%COMPONENTS_OK);
266loadConfigFile('debathena-mirrors', \%DA_MIRRORS_OK);
267loadConfigFile('debathena-components', \%DA_COMPONENTS_OK);
268loadConfigFile('aptkeys', \%APTKEYS_OK);
269loadConfigFile('debsums-missing-packages', \%DEBSUMS_MISSING_PKG_OK);
270loadConfigFile('debsums-missing-files', \%DEBSUMS_MISSING_FILE_OK);
271loadConfigFile('debsums-changed-files', \%DEBSUMS_CHANGED_FILE_OK);
272
273$checks{'keys'} && checkAptKeys();
274$checks{'sources'} && checkAptSources();
275$checks{'debums'} && debsums();
276$checks{'policy'} && checkInstallability();
277close(LOG);
278if ($errors) {
279    exit 1;
280}
281if ($warns) {
282    exit 2;
283}
284exit 0;
Note: See TracBrowser for help on using the repository browser.