packaging/check-initd-order

   1 #!/usr/bin/perl
   2 #
   3 # Author: Petter Reinholdtsen
   4 # Date:   2005-08-21
   5 #
   6 # Read LSM init.d headers in SysV init.d scripts, and verify correct
   7 # start order for all runlevels.  It can also provide a graph.
   8 #
   9 # To generate a graph, run it like this
  10 #
  11 #   check-initd-order -g > initorder.dotty && dotty initorder.dotty
  12
  13 use strict;
  14 use warnings;
  15
  16 my $rcbase = "/etc";
  17
  18 my $overridepath = "/usr/share/insserv/overrides";
  19 my $hostoverridepath =  "/etc/insserv/overrides";
  20
  21 my $debug = 0;
  22 my $errors = 0;
  23
  24 my %rcmap =
  25     (
  26      'B' => 'rc.boot',
  27      'S' => 'rcS.d',
  28      '1' => 'rc1.d',
  29      '2' => 'rc2.d',
  30      '3' => 'rc3.d',
  31      '4' => 'rc4.d',
  32      '5' => 'rc5.d',
  33      '6' => 'rc6.d',
  34      );
  35
  36 my %sysmap;
  37
  38 my %provideslist;
  39 my %scriptorder;
  40 my %opts;
  41
  42 # Used to draw graphs
  43 my %gotrevdeps;
  44 my %allprovides;
  45
  46 while($#ARGV >= 0 && ($_ = $ARGV[0]) =~ /^-/) {
  47         shift @ARGV;
  48         if (/^-([cdgko])$/) { $opts{$1}++; next }
  49         if (/^-b$/) { $rcbase = shift; next }
  50         if (/^-h|--help$/) { &usage; }
  51         &usage("unknown option");
  52 }
  53
  54 load_sysmap("$rcbase/insserv.conf");
  55
  56 $debug = $opts{'d'};
  57 my $useoverrides = $opts{'o'} ? 0 : 1;
  58
  59 if ($opts{'g'}) {
  60     graph_generate();
  61     exit 0;
  62 }
  63
  64 check_bootorder();
  65 exit $errors > 0 ? 1 : 0;
  66
  67 sub usage {
  68     print STDERR "check-initd-order: error: @_\n" if ($#_ >= 0);
  69     print STDERR <<EOF;
  70 usage: check-initd-order [-cdgko] [-b basedir]
  71   -b basedir (default /etc)
  72   -d enable debug output
  73   -o do not load override files
  74   -k use shutdown (reboot) sequence instead of boot sequence
  75   -g generate graph
  76   -c use combined boot and shutdown sequence (only for graphs)
  77 EOF
  78     exit 1;
  79 }
  80
  81 # Simple basename implementatin to avoid dependin on File::Basename
  82 # from perl-modules
  83 sub basename {
  84     my $path = shift;
  85     $path =~ s%^.*/([^/]+)$%$1%;
  86     return $path;
  87 }
  88
  89 sub error {
  90     print STDERR "error: ", @_;
  91     $errors++;
  92 }
  93
  94 # Map packages to system metapackages.  These dependencies should
  95 # probably be more complex
  96 sub load_sysmap {
  97     my $filename = shift;
  98     unless (open(CONF, "<", "$filename")) {
  99         print STDERR "error: unable to load $filename";
 100         return;
 101     }
 102     while (<CONF>) {
 103         chomp;
 104         s/\#.*$//;
 105         next if m/^\s*$/;
 106         if (m/^(\$\S+)\s+(\S.*\S*)\S*$/) {
 107             my $virt = $1;
 108             for my $dep (split(/\s+/, $2)) {
 109                 $dep =~ s/^\+//g;
 110                 $sysmap{$dep} = $virt;
 111             }
 112         }
 113     }
 114     close(CONF);
 115 }
 116
 117 sub graph_addnode {
 118     my ($isstopseq, $lsbinforef) = @_;
 119     my %lsbinfo = %{$lsbinforef};
 120
 121     unless ($lsbinfo{'provides'}) {
 122         error "File ". $lsbinfo{'file'} . " is missing the provides header\n";
 123         $lsbinfo{'provides'} = $lsbinfo{'file'};
 124         $lsbinfo{'provides'} =~ s/^[SK]\d{2}//;
 125     }
 126
 127     my $key = $opts{'k'} ? 'stop' : 'start';
 128     my $revkey = $opts{'k'} ? 'stop-after' : 'start-before';
 129     my @provides = split(/\s+/, $lsbinfo{'provides'});
 130     for my $name (@provides) {
 131         if (exists $sysmap{$name}) {
 132             graph_addnode($isstopseq,
 133                           {'provides'      => $sysmap{$name},
 134                           "required-$key" => $name});
 135         }
 136     }
 137
 138     if (1 < @provides) {
 139         my @providescopy = @provides;
 140         my $lastprovide = shift @providescopy;
 141         for my $provide (@providescopy) {
 142             graph_addnode($isstopseq,
 143                           {'provides'      => $lastprovide,
 144                            "required-$key" => $provide});
 145             graph_addnode($isstopseq,
 146                           {'provides'      => $provide,
 147                            "required-$key" => $lastprovide});
 148         }
 149     }
 150
 151     for my $provide (@provides) {
 152         my $provideesc = $provide; $provideesc =~ s/"/\\"/g;
 153         my %deps =
 154             (
 155              "required-$key" => 'blue',
 156              "should-$key" => 'springgreen',
 157              "$revkey" => 'yellow'
 158              );
 159
 160         for $key (keys %deps) {
 161             if (exists $lsbinfo{$key} && $lsbinfo{$key}) {
 162                 my @depends = split(/\s+/, $lsbinfo{$key});
 163
 164                 my $dependonall = 0;
 165                 for my $pkg (@depends) {
 166                     $dependonall = 1 if ($pkg eq '$all');
 167                 }
 168
 169                 for my $pkg (@depends) {
 170                     my $pkgesc = $pkg; $pkgesc =~ s/"/\\"/g;
 171                     my $color = $deps{$key};
 172                     if ($revkey eq $key) {
 173                         print "\"$provideesc\" -> \"$pkgesc\"[color=$color] ;\n";
 174                         $gotrevdeps{$pkg} = 1 unless $dependonall;
 175                     } else {
 176                         print "\"$pkgesc\" -> \"$provideesc\"[color=$color] ;\n";
 177                         $gotrevdeps{$provide} = 1 unless $dependonall;
 178                     }
 179                 }
 180             }
 181         }
 182
 183         print "\"$provideesc\" [shape=box];\n" unless $allprovides{$provide};
 184         $allprovides{$provide} = 1;
 185     }
 186 }
 187
 188 sub graph_generate_mode {
 189     my ($isstopseq) = @_;
 190     my @dirs = $isstopseq ? $rcmap{6} : ($rcmap{S}, $rcmap{2});
 191     for my $rcdir (@dirs) {
 192         chdir "$rcbase/$rcdir/.";
 193         my @scripts = $isstopseq ? <K*> : <S*>;
 194         for my $script (@scripts) {
 195             my $lsbinforef = load_lsb_tags("$rcbase/$rcdir/$script",
 196                                            $useoverrides);
 197
 198             unless (defined $lsbinforef) {
 199                 error "LSB header missing in $rcbase/$rcdir/$script\n";
 200                 $script =~ s/^[SK]\d{2}//;
 201                 $lsbinforef = {'provides'       => $script,
 202                                'required-start' => '$remote_fs $syslog',
 203                                'required-stop'  => '$remote_fs $syslog'};
 204             }
 205             graph_addnode($isstopseq, $lsbinforef);
 206         }
 207     }
 208     # Mark all packages without any reverse dependencies as depending
 209     # on $all
 210     for my $provide (keys %allprovides) {
 211         next unless (exists $gotrevdeps{$provide});
 212         my $lsbinforef = {'provides'       => '$all',
 213                           'required-start' => "$provide",
 214                           'required-stop'  => "$provide"};
 215         graph_addnode($isstopseq, $lsbinforef);
 216     }
 217 }
 218
 219 sub graph_generate {
 220     print "# Generating graph\n";
 221     print <<EOF;
 222 digraph packages {
 223 rankdir=LR;
 224 concentrate=true;
 225 EOF
 226     if ($opts{'c'}) {
 227         graph_generate_mode();
 228         graph_generate_mode(1);
 229     } else {
 230         graph_generate_mode($opts{'k'});
 231     }
 232     print <<EOF;
 233 }
 234 EOF
 235 }
 236
 237 sub check_deps {
 238     my ($lsbinforef, $tag, $order, $bootorder, $headername, $required) = @_;
 239     my %lsbinfo = %{$lsbinforef};
 240     my $name = $lsbinfo{'file'};
 241     if ($lsbinfo{$headername}) {
 242         my @depends = split(/\s+/, $lsbinfo{$headername});
 243         for my $dep (@depends) {
 244             if (! $required && exists $provideslist{$dep}) {
 245                 unless (exists $scriptorder{$tag}{$dep}
 246                         and ("S" eq $tag
 247                              ? $scriptorder{$tag}{$dep} < $bootorder
 248                              : $scriptorder{$tag}{$dep} > $bootorder)) {
 249                     my $deporder;
 250                     if (exists $scriptorder{$tag}{$dep}) {
 251                         $deporder = $scriptorder{$tag}{$dep}
 252                     } else {
 253                         $deporder = exists $provideslist{$dep} ? $provideslist{$dep} : "?";
 254                     }
 255                     error(sprintf("Incorrect order %s@%s %s %s%s\n",
 256                            $dep, $deporder, 'S' eq $tag ? '>' : '<',
 257                            $name, $order));
 258                 }
 259             }
 260         }
 261     }
 262 }
 263
 264 sub check_bootorder {
 265     my $bootorder = 0;
 266     my @dirs = $opts{'k'} ? $rcmap{6} : ($rcmap{S}, $rcmap{2});
 267     my @scripts;
 268     for my $rcdir (@dirs) {
 269         push(@scripts, $opts{'k'} ? <$rcbase/$rcdir/K*> : <$rcbase/$rcdir/S*>);
 270     }
 271
 272     if ($opts{'k'}) {
 273         $scriptorder{'K'}{'$all'} = 1;
 274     } else {
 275         # Calculate script order for the script before the scripts
 276         # with the last boot sequence number.
 277         my $tmpbootorder = 0;
 278         my $allorder = 0;
 279         my $maxorder = 0;
 280         my $maxbootorder = 0;
 281         for my $scriptpath (@scripts) {
 282             my $script = $scriptpath;
 283             $script =~ s%^.*/([^/]+)$%$1%;
 284             $tmpbootorder++;
 285             my ($tag, $order, $name) = $script =~ m/^(.)(\d{2})(.+)$/;
 286             if ($order > $maxorder) {
 287                 $allorder = $maxbootorder;
 288                 $maxbootorder = $tmpbootorder;
 289                 $maxorder = $order;
 290             }
 291
 292             my $lsbinforef = load_lsb_tags($scriptpath,
 293                                            $useoverrides);
 294
 295             if (exists $lsbinforef->{'provides'}
 296                 && $lsbinforef->{'provides'}) {
 297                 for my $provide (split(/\s+/, $lsbinforef->{'provides'})) {
 298                     $provideslist{$provide} = $order;
 299                 }
 300             } else {
 301                 $provideslist{$script} = $order;
 302             }
 303         }
 304         $scriptorder{'S'}{'$all'} = $allorder;
 305     }
 306     for my $scriptpath (@scripts) {
 307         my $script = $scriptpath;
 308         $script =~ s%^.*/([^/]+)$%$1%;
 309         $bootorder++;
 310         my ($tag, $order, $name) = $script =~ m/^(.)(\d{2})(.+)$/;
 311
 312         $scriptorder{$tag}{$name} = $bootorder;
 313         $scriptorder{$tag}{$sysmap{$name}} = $bootorder
 314             if (exists $sysmap{$name});
 315
 316 #           print "$script\n";
 317 #           print "T: $tag O: $order N: $name\n";
 318         my $lsbinforef = load_lsb_tags($scriptpath,
 319                                        $useoverrides);
 320
 321         unless (defined $lsbinforef) {
 322             error "LSB header missing in $scriptpath\n";
 323             next;
 324         }
 325         my %lsbinfo = %{$lsbinforef};
 326
 327         if (exists $lsbinfo{'provides'} && $lsbinfo{'provides'}) {
 328             for my $provide (split(/\s+/, $lsbinfo{'provides'})) {
 329                 $scriptorder{$tag}{$provide} = $bootorder;
 330                 $scriptorder{$tag}{$sysmap{$provide}} = $bootorder
 331                     if (exists $sysmap{$provide});
 332             }
 333         } else {
 334             error "no LSB header provides value in script $scriptpath\n";
 335         }
 336
 337         if ('S' eq $tag) {
 338             check_deps($lsbinforef, $tag, $order, $bootorder, 'required-start', 1);
 339             check_deps($lsbinforef, $tag, $order, $bootorder, 'should-start', 0);
 340 #            check_deps($lsbinforef, 'K', $order, $bootorder, 'start-before', 0);
 341         }
 342         if ('K' eq $tag) {
 343             check_deps($lsbinforef, $tag, $order, $bootorder, 'required-stop', 1);
 344             check_deps($lsbinforef, $tag, $order, $bootorder, 'should-stop', 0);
 345 #            check_deps($lsbinforef, 'S', $order, $bootorder, 'stop-after', 0);
 346         }
 347     }
 348 }
 349
 350 sub load_lsb_tags {
 351     my ($initfile, $useoverrides) = @_;
 352     my $lsbinforef = load_lsb_tags_from_file($initfile);
 353
 354     if ($useoverrides) {
 355         # Try override file
 356         $initfile = readlink($initfile) if (-l $initfile);
 357         my $basename = basename($initfile);
 358
 359         # Only read shipped override file when initscript does not
 360         # contain LSB tags.
 361         if (! defined($lsbinforef) && -f "$overridepath/$basename") {
 362             print STDERR "Override $overridepath/$basename\n" if $debug;
 363             $lsbinforef = load_lsb_tags_from_file("$overridepath/$basename");
 364         }
 365
 366         # Always read the host override in $hostoverridepath.
 367         if (-f "$hostoverridepath/$basename") {
 368             print STDERR "Override $hostoverridepath/$basename\n" if $debug;
 369             $lsbinforef = load_lsb_tags_from_file("$hostoverridepath/$basename");
 370         }
 371
 372     }
 373     return $lsbinforef;
 374 }
 375
 376 sub load_lsb_tags_from_file {
 377     my ($file) = @_;
 378     print STDERR "Loading $file\n" if $debug;
 379     ### BEGIN INIT INFO
 380     # Provides:          xdebconfigurator
 381     # Required-Start:    $syslog
 382     # Required-Stop:     $syslog
 383     # Default-Start:     2 3 4 5
 384     # Default-Stop:      1 6
 385     # Short-Description: Genererate xfree86 configuration at boot time
 386     # Description:       Preseed X configuration and use dexconf to
 387     #                    genereate a new configuration file.
 388     ### END INIT INFO
 389     unless (open(FILE, "<$file")) {
 390         warn "error: Unable to read $file";
 391         return;
 392     }
 393     my $found = 0;
 394     my ($provides, $requiredstart, $requiredstop, $shouldstart, $shouldstop);
 395     my ($startbefore, $stopafter);
 396     while (<FILE>) {
 397         chomp;
 398         $found = 1 if (m/\#\#\# BEGIN INIT INFO/);
 399         next unless $found;
 400         last if (m/\#\#\# END INIT INFO/);
 401
 402         $provides = $1      if (m/^\# provides:\s+(\S*.*\S+)\s*$/i);
 403         $requiredstart = $1 if (m/^\# required-start:\s+(\S*.*\S+)\s*$/i);
 404         $requiredstop = $1  if (m/^\# required-stop:\s+(\S*.*\S+)\s*$/i);
 405         $shouldstart = $1   if (m/^\# should-start:\s+(\S*.*\S+)\s*$/i);
 406         $shouldstop = $1    if (m/^\# should-stop:\s+(\S*.*\S+)\s*$/i);
 407         $startbefore = $1   if (m/^\# X-Start-Before:\s+(\S*.*\S+)\s*$/i);
 408         $stopafter = $1     if (m/^\# X-Stop-After:\s+(\S*.*\S+)\s*$/i);
 409     }
 410     close(FILE);
 411
 412     return undef unless ($found);
 413
 414 #    print "Provides: $provides\n" if $provides;
 415     return {
 416             'provides'       => $provides,
 417             'required-start' => $requiredstart,
 418             'required-stop'  => $requiredstop,
 419             'should-start'   => $shouldstart,
 420             'should-stop'    => $shouldstop,
 421             'start-before'   => $startbefore,
 422             'stop-after'     => $stopafter,
 423             'file'           => $file,
 424             };
 425 }