#!/usr/bin/perl
#
# Author: Petter Reinholdtsen
# Date:   2005-08-21
#
# Read LSM init.d headers in SysV init.d scripts, and verify correct
# start order for all runlevels.  It can also provide a graph.
#
# To generate a graph, run it like this
#
#   check-initd-order -g > initorder.dotty && dotty initorder.dotty 

use strict;
use warnings;

my $rcbase = "/etc";
#$rcbase = "/opt/ltsp/i386/etc";

my $overridepath = "/usr/share/insserv/overrides";

my $debug = 0;

my %rcmap =
    (
     'B' => 'rc.boot',
     'S' => 'rcS.d',
     '1' => 'rc1.d',
     '2' => 'rc2.d',
     '3' => 'rc3.d',
     '4' => 'rc4.d',
     '5' => 'rc5.d',
     '6' => 'rc6.d',
     );

# Map packages to system metapackages.  These dependencies should
# probably be more complex
my %sysmap =
    (
     'network'      => '$network',
     'networking'   => '$network',
     'syslog'       => '$syslog',
     'sysklogd'     => '$syslog',
     'klogd'        => '$syslog',
     'mountall'     => '$local_fs',
     'umountfs'     => '$local_fs',
     'sendsigs'     => '$local_fs',
     'mountnfs'     => '$remote_fs',
     'umountnfs'    => '$remote_fs',
     'hwclock'      => '$time',
     'ntpdate'      => '$time',
     'bind9'        => '$named',
     'portmap'      => '$portmap',
     );

my %scriptorder;
my %opts;

while($#ARGV >= 0 && ($_ = $ARGV[0]) =~ /^-/) {
	shift @ARGV;
	if (/^-([dgko])$/) { $opts{$1}++; next }
	if (/^-h|--help$/) { &usage; }
	&usage("unknown option");
}

$debug = $opts{'d'};
my $useoverrides = $opts{'o'} ? 0 : 1;

if ($opts{'g'}) {
    graph_generate();
    exit 0;
}

check_bootorder();

sub usage {
    print STDERR "check-initd-order: error: @_\n" if ($#_ >= 0);
    print STDERR <<EOF;
usage: check-initd-order [-dgko]
EOF
    exit 1;
}

# Simple basename implementatin to avoid dependin on File::Basename
# from perl-modules
sub basename {
    my $path = shift;
    $path =~ s%^.*/([^/]+)$%$1%;
    return $path;
}

sub graph_addnode {
    my %lsbinfo = @_;

    unless ($lsbinfo{'provides'}) {
	print STDERR "error: File ". $lsbinfo{'file'} . " is missing the provides header\n";
	$lsbinfo{'provides'} = $lsbinfo{'file'};
    }

    my $key = $opts{'k'} ? 'stop' : 'start';
    my @provides = split(/\s+/, $lsbinfo{'provides'});
    for my $name (@provides) {
	if (exists $sysmap{$name}) {
	    graph_addnode('provides'      => $sysmap{$name},
			  "required-$key" => $name);
	}
    }

    if (1 < @provides) {
	print STDERR "warning: Unable to properly handle multiple provides: @provides\n";
    }

    if (exists $lsbinfo{"required-$key"} && $lsbinfo{"required-$key"}) {
	my @depends = split(/\s+/, $lsbinfo{"required-$key"});
	for my $pkg (@depends) {
	    print "\"$pkg\" -> \"$provides[0]\"[color=blue];\n";
	}
    }
    if (exists $lsbinfo{"should-$key"} && $lsbinfo{"should-$key"}) {
	my @depends = split(/\s+/, $lsbinfo{"should-$key"});
	for my $pkg (@depends) {
	    print "\"$pkg\" -> \"$provides[0]\"[color=springgreen] ;\n";
	}
    }
    print "\"$provides[0]\" [shape=box];\n";
}

sub graph_generate {
    print "# Generating graph\n";
    print <<EOF;
digraph packages {
concentrate=true;
EOF
    my @dirs = $opts{'k'} ? $rcmap{6} : ($rcmap{S}, $rcmap{2});
    for my $rcdir (@dirs) {
	chdir "$rcbase/$rcdir/.";
	my @scripts = $opts{'k'} ? <K*> : <S*>;
	for my $script (@scripts) {
	    my $lsbinforef = load_lsb_tags("$rcbase/$rcdir/$script",
					   $useoverrides);
	    
	    unless (defined $lsbinforef) {
		print STDERR "warning: LSB header missing in $rcbase/$rcdir/$script\n";
		$lsbinforef = {'provides' => $script};
	    }
	    my %lsbinfo = %{$lsbinforef};
	    graph_addnode %lsbinfo;
	}
    }
    print <<EOF;
}
EOF
}

sub check_bootorder {
    my $bootorder = 0;
    my @dirs = $opts{'k'} ? $rcmap{6} : ($rcmap{S}, $rcmap{2});
    for my $rcdir (@dirs) {
	chdir "$rcbase/$rcdir/.";
	my @scripts = $opts{'k'} ? <K*> : <S*>;
	for my $script (@scripts) {
	    $bootorder++;
	    my ($tag, $order, $name) = $script =~ m/^(.)(\d{2})(.+)$/;

	    $scriptorder{$tag}{$name} = $bootorder;
	    $scriptorder{$tag}{$sysmap{$name}} = $bootorder
		if (exists $sysmap{$name});

#	    print "$script\n";
#	    print "T: $tag O: $order N: $name\n";
	    my $lsbinforef = load_lsb_tags("$rcbase/$rcdir/$script",
					   $useoverrides);

	    unless (defined $lsbinforef) {
		print STDERR "LSB header missing in $rcbase/$rcdir/$script\n";
		next;
	    }
	    my %lsbinfo = %{$lsbinforef};

	    for my $provide (split(/\s+/, $lsbinfo{'provides'})) {
		$scriptorder{$tag}{$provide} = $bootorder;
		$scriptorder{$tag}{$sysmap{$provide}} = $bootorder
		    if (exists $sysmap{$provide});
	    }

	    if ('S' eq $tag) {
		if ($lsbinfo{'required-start'}) {
		    my @depends = split(/\s+/, $lsbinfo{'required-start'});
		    for my $dep (@depends) {
			unless (exists $scriptorder{$tag}{$dep}
				and $scriptorder{$tag}{$dep} < $bootorder) {
			    my $deporder;
			    if (exists $scriptorder{$tag}{$dep}) {
				$deporder = $scriptorder{$tag}{$dep}
			    } else {
				$deporder = "?";
			    }
			    print "Incorrect order " .
				"$dep\@$deporder > $name\@$order\n";
			}
		    }
		}
	    }
	    if ('K' eq $tag) {
	    }
	}
    }
}

sub load_lsb_tags {
    my ($initfile, $useoverrides) = @_;
    print STDERR "Loading $initfile\n" if $debug;
    ### BEGIN INIT INFO
    # Provides:          xdebconfigurator
    # Required-Start:    $syslog
    # Required-Stop:     $syslog
    # Default-Start:     2 3 4 5
    # Default-Stop:      1 6
    # Short-Description: Genererate xfree86 configuration at boot time
    # Description:       Preseed X configuration and use dexconf to
    #                    genereate a new configuration file.
    ### END INIT INFO
    unless (open(FILE, "<$initfile")) {
        warn "error: Unable to read $initfile";
	return;
    }
    my $found = 0;
    my ($provides, $requiredstart, $requiredstop, $shouldstart, $shouldstop);
    while (<FILE>) {
	chomp;
	$found = 1 if (m/\#\#\# BEGIN INIT INFO/);
	next unless $found;
	last if (m/\#\#\# END INIT INFO/);

	$provides = $1      if (m/^\# provides:\s+(\S*.*\S+)\s*$/i);
	$requiredstart = $1 if (m/^\# required-start:\s+(\S*.*\S+)\s*$/i);
	$requiredstop = $1  if (m/^\# required-stop:\s+(\S*.*\S+)\s*$/i);
	$shouldstart = $1   if (m/^\# should-start:\s+(\S*.*\S+)\s*$/i);
	$shouldstop = $1    if (m/^\# should-stop:\s+(\S*.*\S+)\s*$/i);
    }
    close(FILE);

    # Try override file
    $initfile = readlink($initfile) if (-l $initfile);
    my $basename = basename($initfile);

    if (!$found) {
	if ($useoverrides && -f "$overridepath/$basename") {
	    print STDERR "Override $overridepath/$basename\n"
		if $debug;
	    return load_lsb_tags("$overridepath/$basename", $useoverrides);
	}
    }
    return undef unless ($found);

#    print "Provides: $provides\n" if $provides;
    return {
	    'provides'       => $provides,
	    'required-start' => $requiredstart,
	    'required-stop'  => $requiredstop,
	    'should-start'   => $shouldstart,
	    'should-stop'    => $shouldstop,
	    'file'           => $initfile,
	    };
}
