Package: insserv
Version: 1.14.0-5
Severity: normal

When update-rc.d calls insserv, the rcN.d directories are rebuilt
without taking into consideration any adjustment that might have
been set up locally.  That seems to be done on the assumption that
the dependencies coded in the LSB blocks are universally accurate.
Now, LSBs are a great improvement over numeric priorities, but to
hamper local system tuning, which is not necessarily related to
LSBs, IMHO is an insult to the legendary versatility of SysV init.

On the other hand, when .legacy-bootordering exists, update-rc.d
does not use LSB blocks at all, and mindlessly links at priority
20.  I understand that maintainers don't put default priority
orders, which are difficult to maintain: That is exactly the
reason why LSB INIT INFO blocks were devised.  So, why not use
them?

A way to use that info and still respect existing priorities is
coded in the attached script.  Thanks to it, I was able to get the
cleanest boot since I upgraded to wheezy.  Unlike update-rc.d,
fix-init does not take a scrip name to operate on.  It assumes all
links older than .legacy-bootordering are to be respected, and
writes any action it deems required to a shell script.

Please have a look at it.

Regards
Ale


-- System Information:
Debian Release: 7.0
  APT prefers stable-updates
  APT policy: (500, 'stable-updates'), (500, 'stable')
Architecture: amd64 (x86_64)
Foreign Architectures: i386

Kernel: Linux 3.2.41ale20 (SMP w/8 CPU cores)
Locale: LANG=en_US.UTF-8, LC_CTYPE=en_US.UTF-8 (charmap=UTF-8)
Shell: /bin/sh linked to /bin/bash

Versions of packages insserv depends on:
ii  libc6  2.13-38

insserv recommends no packages.

Versions of packages insserv suggests:
pn  bootchart2  <none>

-- debconf-show failed
#! /usr/bin/perl
# written by Alessandro Vesely in June 2013.  This is free software.

=head1 NAME

fix-init - rebuild F<init?.d> links according to LSB headers

=head1 SYNOPSIS

fix-init [-n|--dry-run [I<file>]]
         [-r|--renum [I<step>]]
         [--root I<root>]
         [-v|--verbose [2|3|4]]

fix-init -h|--help [1|2]

=head1 OPTIONS

=over

=item help

An optional value of I<1> displays these options in addition to the synopsis.
Use I<2> for a man-like page.

=item root

Default to F</>.  Use a different directory for testing.

=item dry-run

B<fix-init> writes shell commands on a temporary file, then executes it.
This option prevents that execution.  It is implied if I<root> is not
writable.  If an output I<file> is specified, it will be used instead of a
temporary one, overwriting its previous content if any.

=item renum

Without this option, B<fix-init> tries to respect the existing order of links.
Otherwise, it renumbers them.  The default I<step> is 6, resulting in names
like F<S06xyz>, F<S12xyzzy>, F<S18foo>, ...  This option is implied if
dependecy based boot sequencing is in effect.

=item verbose

Minimal verbosity (I<-v>) is recommended, otherwise B<fix-init> is almost
silent.  At intermediate verbosity, unsatisfied required dependencies (I<-v 2>),
optional ("should") and satisfied ones (I<-v 3>) are displayed, as well as some
skipped files and "strange" facts.  Top verbosity (I<-v 4>) dumps some internal
structures, such as the initial and resulting order for each level.

=back

=cut

use strict;
use warnings;
use feature "switch";

use File::Find;
use File::Temp 'tempfile';
use Getopt::Long;
use List::Util qw(max min);
use Data::Dumper;
use Pod::Usage;

use constant {BROKEN_LINK => 1,
	PLAIN_FILE => 2, STRANGE_LINK => 3, NEW_LINK => 4};

my ($dryrun, $renum, $help, $root, $verbose);

Getopt::Long::Configure('no_ignore_case');
if (!GetOptions('verbose|v:i' => \$verbose,
                'dry-run|n:s' => \$dryrun,
                'renum|r:i'   => \$renum,
                'root=s'      => \$root,
                'help|h:i'    => \$help))
{
	pod2usage();
	exit 1;
}

if (defined($help))
{
	pod2usage(-verbose => $help);
}

if (defined($verbose))
{
	$verbose = 1 unless ($verbose); # -v same as -v 1
}
else {$verbose = 0;}

$root = '/' unless defined($root);
$root .= '/' unless (substr($root, -1) eq '/');
my $initdir = $root . 'etc/init.d';
my $init_link = "../init.d/";
my $fix_flag = $initdir .'/.legacy-bootordering';
my $overridepath = "/usr/share/insserv/overrides";
my $hostoverridepath =  "/etc/insserv/overrides";

$Data::Dumper::Terse = 1;

my @levels = map "$_", ('S', 0.. 6);
my %rc_d = map {$_ => $root ."etc/rc$_.d"} @levels;
my $rc_d_length = length($rc_d{0}); # different from length($initdir)
do {
	my @invalid = grep ! -d, values %rc_d;
	push(@invalid, $initdir) unless -d $initdir;
	pod2usage(-msg => 'Invalid dir: '. join(', ', @invalid)) if (@invalid);
};

my $timestamp = (stat($fix_flag))[9];
if (!defined($timestamp))
{
	$timestamp = 0;
	if (!defined($renum))
	{
		$renum = 0;
		print "Dependecy based boot sequencing detected, --renum implied\n"
			if ($verbose);
	}
}

my $defaultstep = 6;
$renum = $defaultstep if (defined($renum) && $renum == 0);

# cannot do, because order becomes negative or larger than 99
my $cannot;

# which files to skip in $initdir (after chkconfig, modified, to be revised)
my %skip_rc = map {$_ => 1} qw {rc rcS rx skeleton powerfail boot
	boot.local halt.local README};

# a hash of all data, keyed by script name
my %services = ();

# a hash of script names, keyed by services each provides
my %provides2name = ();

# a hash of priority orders found at each level
my %foundpriority = ();

# a hash of config lines, keyed by script name
my %configure = ();
die ("Abort fix-init\n") if (load_config('/etc/fix-init.conf'));
print "configure: ", Dumper(\%configure), "\n" if ($verbose > 3);

# a hash of virtual services to real ones, after insserv/check-initd-order
my %sysmap;
my $rcbase = "/etc";
load_sysmap("$rcbase/insserv.conf");
find(sub {load_sysmap($_) if (-f $_);}, "$rcbase/insserv.conf.d");
print "sysmap: ", Dumper(\%sysmap), "\n" if ($verbose > 3);


sub configured_lvl
{
	my ($orig, $conf) = @_;
	$orig = [] unless defined($orig);
	$conf = [] unless defined($conf);

	my @result = @{$orig};
	while (@{$conf})
	{
		my $op = shift($conf);
		given (shift @{$op})
		{
			push(@result, @{$op}) when '+';
			@result = grep {my $el = $_; !grep {$_ eq $el} @{$op}} @result
				when '-';
			@result = @{$op} when '=';
		}
	}
	return \@result
}

sub set_services_rec
{
	my ($lname, $fname) = @_;
	my $lsb = load_lsb_tags($fname, $lname);
	if (defined($configure{$lname}))
	{
		my $start_conf = $configure{$lname}{'S'};
		my $stop_conf = $configure{$lname}{'K'};
		$lsb = {} unless $lsb;
		${$lsb}{'lvlS'} = configured_lvl(${$lsb}{'lvlS'}, $start_conf);
		${$lsb}{'lvlK'} = configured_lvl(${$lsb}{'lvlK'}, $stop_conf);
		print 'Resulting runlevel Start: ', Dumper(${$lsb}{'lvlS'}), "\n",
			'Resulting runlevel Stop: ', Dumper(${$lsb}{'lvlK'}), "\n"
				if ($verbose > 3);
	}

	if ($lsb)
	{
		$services{$lname} = {lsb => $lsb, found => {S => {}, K => {}}};
	}
	else
	{
		$services{$lname} = {found => {S => {}, K => {}}};
		print 'No LSB record found for ', $fname, "\n" if ($verbose);
	}
}

sub skip_dir
{
	$File::Find::prune = 1;
	print 'Skipping directory ', $File::Find::name, "\n" if ($verbose > 1);
}

sub skip_file
{
	my $min_verbose = shift;
	print 'Skipping ', $File::Find::name, "\n" if ($verbose > $min_verbose);
}

# File::Find callback (cd and $_ = fname)
sub check_file
{
	return if $_ eq '.';
	return skip_dir() if (-d $_);

	my $fname = $_;
	if ($File::Find::dir eq $initdir)
	{
		return skip_file(2) if ($skip_rc{$fname});
		return skip_file(1) if (length($fname) <= 0 || ! -f $fname ||
			substr($fname, -1) eq '~' ||
			$fname =~ /^[\$.#%_\+\-\\\*\[\]\^:\(\)~]+/ ||
			$fname =~ /\.(?:rpm|ba|dpkg)[^.]*$/ ||
			$fname =~ /\.(?:old|new|org|orig|save|swp|core)$/);

		# symbolic link in the same directory, e.g. ups-monitor -> nut-client
		return skip_file(0) if (-l $fname && readlink($fname) !~ qr(/));

		if (exists($services{$fname}))  # how come?
		{
			print 'Already found: ', $fname, ' ', Dumper($services{$fname}), "\n"
				if ($verbose);
		}
		else
		{
			set_services_rec($fname, $fname);
		}
		return;
	}
	elsif (length($File::Find::dir) == $rc_d_length)
	{
		my $lvl = substr($File::Find::dir, -3, 1);
		return skip_file(0) unless exists($rc_d{$lvl});  # how come?

		my $dir = $rc_d{$lvl};
		return skip_file('README' eq $fname? 2: 1)
			unless ($fname =~ /^([SK])(\d\d)([-.\w]+)$/); # same as in rc?

		my ($sk, $order, $lname) = ($1, $2, $3);
		my $ftime = (lstat($fname))[9];
		my $hint;
		if (-l _)
		{
			my $l = readlink($fname);
			if (! -e $fname)
			{
				$hint = BROKEN_LINK;
				print 'Broken link ', $File::Find::name, ' -> ', $l, "\n"
					if ($verbose);
			}
			elsif ($l ne $init_link . $lname)
			{
				$hint = STRANGE_LINK;
				print 'Different link name in ',
					$File::Find::name, ' -> ', $l, "\n"
						if ($verbose);
			}
			elsif ($ftime > $timestamp)
			{
				$hint = NEW_LINK;
				print $lname, ' (', $File::Find::name, ') considered new', "\n"
					if ($verbose && ($verbose > 3 ||
						$timestamp && !exists($services{$lname}{'hint'})));
			}
		}
		else
		{
			$hint = PLAIN_FILE if (-f $fname);
			print 'Not a symbolic link ', $fname, ' in ', $dir, "\n"
				if ($verbose);
		}
		if (! exists($services{$lname})) # plain file, link to skipped file, ...
		{
			print 'Considering unexpected script ', $File::Find::name, "\n"
				if ($verbose);
			set_services_rec($lname, $fname);
		}

		my $norder = $order + 0;
		if (exists($services{$lname}))
		{
			$services{$lname}{'found'}{$sk}{$lvl} = $norder;
			if ($hint)
			{
				$services{$lname}{'hint'} = {}
					unless exists($services{$lname}{'hint'});
				$services{$lname}{'hint'}{$lvl . $sk . $order} = $hint;
			}
		}
		$norder = 99 - $norder if ($sk eq 'K');
		$foundpriority{$sk} = {} unless exists($foundpriority{$sk});
		$foundpriority{$sk}{$lvl} = [] unless exists($foundpriority{$sk}{$lvl});
		push(@{$foundpriority{$sk}{$lvl}}, $norder)
			unless (grep {$_ == $norder} @{$foundpriority{$sk}{$lvl}});
		return;
	}

	skip_file(1);
}

sub load_config
{
	my $fname = shift;
	my $fh;
	my $errcount = 0;
	unless (open($fh, "<", $fname))
	{
		unless ($!{ENOENT})
		{
			warn "Cannot open $fname: $!\n";
			$errcount = 1;
		}
		return $errcount;
	}

	my $line = 0;
	my $config_parse = sub
	{
		my $expr = shift;
		return undef unless $expr;

		my @op = ();
		if ($expr !~ /^\s*([=\+\-])\s*(.*)/)
		{
			warn "no operator (=+-) in \"$expr\" at line $line of $fname\n";
			++$errcount;
			return undef;
		}

		push(@op, $1);
		$expr = $2;
		while ($expr =~ /\G\s*(\S)/cg)
		{
			my $el = $1;
			if (!grep {$_ eq $el} @levels)
			{
				warn
					"$el is not a runlevel, in \"$expr\" at line $line of $fname\n";
				++$errcount;
				return undef;
			}
			push(@op, $el);
		}
		return \@op;
	};

	while (<$fh>)
	{
		++$line;
		chomp;
		s/#.*//;
		if (/^\s*([^\s,;:]+)\s+([^\/]*)(?:(\/)\s*(.*)?)?/)
		{
			my ($script, $start, $slash, $stop) = ($1, $2, $3, $4);
			$configure{$script} = {S => [], K => []}
				unless defined($configure{$script});

			my $op = $config_parse->($start);
			push($configure{$script}{'S'}, $op) if defined($op);
			if ($slash)
			{
				$op = $config_parse->($stop? $stop: '');
				push($configure{$script}{'K'}, $op) if defined($op);
			}
		}
	}

	close($fh);
	return $errcount;
}


#################################################################
# from insserv/check-initd-order (modified)
# Map system metapackages to packages. (opposite way around w.r.t. original)
sub load_sysmap {
    my $filename = shift;
    unless (open(CONF, "<", "$filename")) {
        print STDERR "error: unable to load $filename";
        return;
    }
    while (<CONF>) {
        chomp;
        s/\#.*$//;
        next if m/^\s*$/;
        if (/^(\$\S+)\s+(\S.*)$/) {
            my ($virt, $list) = ($1, $2);
            $sysmap{$virt} = [] unless exists($sysmap{$virt});
            push($sysmap{$virt}, split(/[\s,;]+/, $list));
        }
    }
    close(CONF);
}

sub load_lsb_tags
{
	my ($initfile, $name) = @_;
	my ($lsb, $fname);

	# First try the host override in $hostoverridepath.
	$fname = "$hostoverridepath/$name";
	if (-f $fname)
	{
		print "Override $fname\n" if $verbose > 3;
		$lsb = load_lsb_tags_from_file($fname);
		return $lsb if defined($lsb);
	}

	# Next try shipped override file if given
	$fname = "$overridepath/$name";
	if (-f $fname)
	{
		print "Override $fname\n" if $verbose > 3;
		$lsb = load_lsb_tags_from_file($fname);
		return $lsb if defined($lsb);
	}

	# usual case last
	return load_lsb_tags_from_file($initfile);
}

sub load_lsb_tags_from_file {
	my ($file) = @_;
	print "Loading $file\n" if $verbose > 3;
	### BEGIN INIT INFO
	# Provides:          boot_facility_1 [ boot_facility_2 ...]
	# Required-Start:    boot_facility_1 [ boot_facility_2 ...]
	# Required-Stop:     boot_facility_1 [ boot_facility_2 ...]
	# Should-Start:      boot_facility_1 [ boot_facility_2 ...]
	# Should-Stop:       boot_facility_1 [ boot_facility_2 ...]
	# X-Start-Before:    boot_facility_1 [ boot_facility_2 ...]
	# X-Stop-After:      boot_facility_1 [ boot_facility_2 ...]
	# Default-Start:     run_level_1 [ run_level_2 ...]
	# Default-Stop:      run_level_1 [ run_level_2 ...]
	# X-Interactive:     true
	# Short-Description: single_line_description
	# Description:       multiline_description
	### END INIT INFO
	unless (open(FILE, "<$file")) {
		warn "error: Unable to read $file:$!";
		return undef;
	}
	my %lsb;
	my $found = 0;
	my $delim = qr/[\s,;]+/;
	while (<FILE>)
	{
		chomp;
		$found = 1 if (/### BEGIN INIT INFO/);
		next unless $found;
		last if (/### END INIT INFO/);

		if (/^#\s*(\S+)\s*:\s*(.*)/i)
		{
			my @items = split($delim, $2);
			my $key = lc($1);
			$key =~ s/[-_]//g;

			my $id;
			given ($key)
			{
				$id = 'provides' when 'provides';
				$id = 'reqS' when 'requiredstart';
				$id = 'shdS' when 'shouldstart';
				$id = 'revS' when 'xstartbefore';
				$id = 'reqK' when 'requiredstop';
				$id = 'shdK' when 'shouldstop';
				$id = 'revK' when 'xstopafter';
				$id = 'lvlS' when 'defaultstart';
				$id = 'lvlK' when 'defaultstop';
			}
			next unless $id;

			print "Duplicate definition of $key in $file\n"
				if ($verbose && exists($lsb{$id}));
			$lsb{$id} = \@items;
		}
	}
	close(FILE);

	return undef unless(%lsb);

	normalize_req_shd(\%lsb, 'reqS', 'shdS');
	normalize_req_shd(\%lsb, 'reqK', 'shdK');

	return \%lsb;
}

sub normalize_req_shd
{
	my ($lsb, $req, $shd) = @_;
	return unless (exists(${$lsb}{$req}) || exists(${$lsb}{$shd}));

	my @dep;
	if (exists(${$lsb}{$req})) {@dep = @{${$lsb}{$req}}; delete(${$lsb}{$req})}
	else {@dep = ();}

	# "should" requirements are represented by prefixing a '+'
	if (exists(${$lsb}{$shd}))
	{
		push(@dep, map(substr($_, 0, 1) eq '+'? $_: "+$_", @{${$lsb}{$shd}}));
		delete(${$lsb}{$shd});
	}

	${$lsb}{substr($req, 3)} = \@dep;	
}

#################################################################
# All records are loaded

sub iterate_svc
{
	my ($ref, $proc) = @_;
	my @array = @{$ref};
	my %seen = ('$none' => 1);

	while (@array)
	{
		my $svc = shift(@array);
		my $opt = 0;
		if (substr($svc, 0, 1) eq '+')
		{
			$opt = 1;
			$svc = substr($svc, 1);
		}

		next if ($seen{$svc});
		$seen{$svc} = 1;

		$proc->($opt, $svc);

		push(@array, @{$sysmap{$svc}})
			if (substr($svc, 0, 1) eq '$' &&
				$svc ne '$all' &&
				exists($sysmap{$svc}));
	}
}

sub normalize_reverse
{
	my ($script, $xrev) = @_;
	return if (!exists($services{$script}{'lsb'}{$xrev}));

	my $direct = substr($xrev, 3);
	my $script_pro = $services{$script}{'lsb'}{'provides'};
	iterate_svc($services{$script}{'lsb'}{$xrev}, sub
	{
		my ($opt, $svc) = @_;
		if ($svc ne '$all' && exists($provides2name{$svc}))
		{
			foreach my $other (@{$provides2name{$svc}})
			{
				if (exists($services{$other}{'lsb'}))
				{
					$services{$other}{'lsb'}{$direct} = []
						unless exists($services{$other}{'lsb'}{$direct});
					push($services{$other}{'lsb'}{$direct}, @{$script_pro});
				}
				elsif ($verbose > 1)
				{
					print "\n\n$script: How come $other has no LSB?!\n\n\n"
				}
			}
		}
	});

	delete $services{$script}{'lsb'}{$xrev};
}

sub get_hint
{
	my ($script, $lvl, $sk, $order) = @_;
	return 0 unless exists($services{$script}{'hint'});
	$services{$script}{'hint'}{$lvl . $sk . sprintf('%02d', $order)} || 0;
}

# define which services we want and priority orders we respect
# (resp is only needed because of how update-rc.d works)
sub normalize_level
{
	my ($script, $lvlsk) = @_;
	my $sk = substr($lvlsk, 3);
	$services{$script}{'want'}{$sk} = ();
	$services{$script}{'resp'}{$sk} = ();

	if (exists($services{$script}{'lsb'}{$lvlsk}))
	{
		# turn LSB array into a hash
		foreach my $lvl (@{$services{$script}{'lsb'}{$lvlsk}})
		{
			$services{$script}{'want'}{$sk}{$lvl} = -1;
			my $order = $services{$script}{'found'}{$sk}{$lvl};
			if (defined($order))
			{
				my $hint = get_hint($script, $lvl, $sk, $order);
				$services{$script}{'resp'}{$sk}{$lvl} =
					$sk eq 'S'? $order: 99 - $order
						unless ($hint == BROKEN_LINK || $hint == NEW_LINK);
			}
		}
		delete $services{$script}{'lsb'}{$lvlsk};
	}
	else
	{
		# levels stay as they are if not specified otherwise
		foreach my $lvl (keys($services{$script}{'found'}{$sk}))
		{
			my $order = $services{$script}{'found'}{$sk}{$lvl};
			my $hint = get_hint($script, $lvl, $sk, $order);
			$services{$script}{'want'}{$sk}{$lvl} = -1
				unless ($hint == BROKEN_LINK);
			$services{$script}{'resp'}{$sk}{$lvl} =
				$sk eq 'S'? $order: 99 - $order
					unless ($hint == BROKEN_LINK || $hint == NEW_LINK);
		}
	}
}

# give up
sub set_cannot
{
	my $order = shift;
	return if ($order >= 0 && $order < 100);

	if (!$cannot)
	{
		warn "Cannot complete sorting order, try using --renum\n";
		$cannot = 1;
	}
	if ($verbose > 3)
	{
		my ($p, $f, $l) = caller;
		print "Cannot order=$order at line $l\n";
	}
}

# recursively check dependencies
my @path_array = ();
sub find_sk_order
{
	my ($script, $sk, $lvl) = @_;
	
	return if ($services{$script}{'want'}{$sk}{$lvl} > 0);

	my $min_order = $services{$script}{'resp'}{$sk}{$lvl};
	if (defined($min_order) && !$renum)
	{
		$min_order -= 1;
	}
	else
	{
		$min_order = 0;
	}

	push(@path_array, $script);
	if (exists($services{$script}{'lsb'}{$sk}))
	{
		iterate_svc($services{$script}{'lsb'}{$sk}, sub
		{
			my ($opt, $svc) = @_;
			if ($svc eq '$all')
			{
				$min_order = 99;
				if (!$renum && $foundpriority{$sk}{$lvl})
				{
					$min_order = $foundpriority{$sk}{$lvl}[0];
				}
				$min_order -= 1;
				if ($verbose > 2)
				{
					print 'Script ', $script, $opt? ' optionally': '',
						' requires $all, so min_order=', $min_order,
						"\n";
				}
			}
			elsif (exists($provides2name{$svc}))
			{
				foreach my $other (@{$provides2name{$svc}})
				{
					# skip dependencies not used at this level
					if (!exists($services{$other}{'want'}{$sk}{$lvl}))
					{
						print 'Script ', $script, $opt? ' optionally': '',
							' requires ', $svc, ', provided by ', $other,
							', which is not enabled at ', $sk, ' level ', $lvl, "\n"
								if ($verbose > 1);
						next;
					}

					# check circular dependencies
					my $seen;
					for ($seen = 0; $seen < @path_array; ++$seen)
					{
						last if ($path_array[$seen] eq $other);
					}

					if ($seen < @path_array)
					{
						print 'Circular dependencies (', $sk, ' level ', $lvl, '): ',
							join(' -> ', @path_array[$seen.. $#path_array]), "!\n",
								if ($verbose);

						# Arbitrarily break the loop here!
						# This is the first element that triggered the loop,
						# so start from 0 if it is not in resp
						my $order = $services{$other}{'want'}{$sk}{$lvl};
						if ($order < 0)
						{
							if (!$renum)
							{
								$order = $services{$other}{'resp'}{$sk}{$lvl};
								$order = 1 if (!defined($order));
							}
							else
							{
								$order = 1;
							}
							$order -= 1;
						}
						print "have $other at order=$order\n" if ($verbose > 3);

						foreach my $s (@path_array[$seen.. $#path_array])
						{
							my $want = $services{$s}{'want'}{$sk}{$lvl};
							my $found;
							$found = $services{$s}{'resp'}{$sk}{$lvl} if (!$renum);
							if ($want < $order)
							{
								$order += 1;
								$order = $found
									if (defined($found) && $found >= $order);
								$services{$s}{'want'}{$sk}{$lvl} = $order;
								set_cannot($order);
							}
							else
							{
								$order = $services{$s}{'want'}{$sk}{$lvl};
							}
						}
						print "have ". join(', ', map
							{"$_=". $services{$_}{'want'}{$sk}{$lvl}}
								@path_array[$seen.. $#path_array]), "\n"
									if ($verbose > 3);;
						next;
					}

					find_sk_order($other, $sk, $lvl);
					my $other_ord = $services{$other}{'want'}{$sk}{$lvl};
					$min_order = $other_ord if ($other_ord >= $min_order);

					if ($verbose > 2)
					{
						print 'Script ', $script, $opt? ' optionally': '',
							' requires ', $svc, ', provided by ', $other,
							$other_ord >= 0? ' (at order '. $other_ord .')': '',
							"\n";
					}
				}
			}
			elsif ($verbose > $opt)
			{
				my $direct = substr($svc, 0, 1) eq '$'? ' directly': '';
				print 'Script ', $script, $opt? ' optionally': '',
					' requires ', $svc, ', which is not provided', $direct, "\n"
						if (!$direct || $verbose > 1);
			}
		});
	}

	if ($services{$script}{'want'}{$sk}{$lvl} < 0)
	{
		my $x;
		if (!$renum)
		{
			my $found = $services{$script}{'resp'}{$sk}{$lvl};
			if (defined($found) && $min_order < $found)
			{
				$x = $found;
			}
		}
		$x = $min_order + 1 unless defined($x);
		$services{$script}{'want'}{$sk}{$lvl} = $x;
		print "have $script with min_order=$min_order, set to $x\n"
			if ($verbose > 3);
		set_cannot($x);
	}

	pop(@path_array);
}

# initial sort, and final adjustments.  Return the array of all scripts
# that we want to exist at the given sk/level.
sub do_find_sk_order
{
	my ($sk, $lvl) = @_;

	# sort orders found at this level, in reverse order
	if (exists($foundpriority{$sk}{$lvl}))
	{
		my @temp = sort {$b <=> $a} @{$foundpriority{$sk}{$lvl}};
		$foundpriority{$sk}{$lvl} = \@temp;
	}
	else
	{
		$foundpriority{$sk}{$lvl} = [];
	}	
	
	# sort keys according to the existing order, so that any circular
	# dependency loop stays the way it was.  New services which are
	# part of a loop will be started after existing ones.
	my @scripts = sort
	{
		my $fa = $services{$a}{'resp'}{$sk}{$lvl};
		my $fb = $services{$b}{'resp'}{$sk}{$lvl};
		$fa = 111 unless defined($fa);
		$fb = 111 unless defined($fb);
		($fa - $fb) || $a cmp $b;
	} grep(exists($services{$_}{'want'}{$sk}{$lvl}), keys(%services));

	print "\n=============================\nRUNLEVEL ",
		$lvl, ', ', $sk, ": Initial order:\n", Dumper(\@scripts), "\n"
			if $verbose > 3;

	foreach (@scripts)
	{
		find_sk_order($_, $sk, $lvl);
		warn 'INTERNAL ERROR: not empty: ', Dumper(\@path_array), "\n"
			if @path_array > 0;
	}

	my %order = ();
	foreach my $s (@scripts)
	{
		if (exists($services{$s}{'want'}{$sk}{$lvl}))
		{
			my $n = $services{$s}{'want'}{$sk}{$lvl};
			$order{$n} = [] unless exists($order{$n});
			push(@{$order{$n}}, $s);
		}
	}

	my @want = sort {$a - $b} keys(%order);
	if ($verbose > 3)
	{
		my $oref = \%order;
		$Data::Dumper::Sortkeys = sub
		{
			my $ref = shift;
			return \@want if ($ref eq $oref);
		};
		print "\nRUNLEVEL ", $lvl, ', ', $sk, ":\n",
			'%order = ', Dumper($oref), "\n";
		$Data::Dumper::Sortkeys = 0;
	}

	if (scalar(@want) >= 100)
	{
		print "FAILED: unable to establish $sk order for level $lvl\n"
			if ($verbose);
		print 'Numbers for ', $sk, 'nn: ', Dumper(\@want), "\n"
			if ($verbose > 3);
		return undef;
	}

	if ($renum)
	{
		my $ren = $renum;
		if (scalar(@want) * $ren >= 100)
		{
			$ren = int(100.0/scalar(@want));
			print "$renum is too hight for renum ($sk, $lvl), reduced to $ren\n"
				if ($verbose);
		}

		my $i;
		for ($i = 0; $i < @want;)
		{
			my $n = $want[$i];
			my $m = ++$i * $ren;
			$services{$_}{'want'}{$sk}{$lvl} = $m foreach @{$order{$n}};
		}
	}

	elsif (scalar(@want) > 1)
	# leave some gaps around newly inserted orders
	{
		my ($left, $first, $count, $right, $is_new, $i);
		$left = 0;
		$i = 0;
		do
		{
			$count = 0;
			$first = $i;
			do
			{
				$right = $want[$i];
				$is_new = !grep {$_ == $right} @{$foundpriority{$sk}{$lvl}};

				++$count;
				++$i;
			} while ($is_new && $i < @want);

			if ($is_new) {$right = 99;} else {--$count;}
			my $step = int(($right - $left)/($count + 1));

			# we have $count newly inserted orders between $left and $right
			if ($count > 0 && $step > 1)
			{
				$step = $defaultstep if ($step > $defaultstep);
				while ($count-- > 0)
				{
					my $n = $want[$first++];
					$left += $step;
					$services{$_}{'want'}{$sk}{$lvl} = $left foreach @{$order{$n}};
					print "Adjust $sk level $lvl: $n -> $left\n" if ($verbose > 3);
				}
			}

			$left = $right;

		} while ($i < @want);
	}

	return \@scripts
}

sub write_commands
{
	my ($scriptfh, $sk, $lvl, $scripts) = @_;
	my $changes = 0;
	my $renumbered = 0;
	my $rc_dir = $rc_d{$lvl};
	my $def_v = $renum? 3: 1;

	# sort by target for readability
	foreach my $s (sort {$services{$a}{'want'}{$sk}{$lvl} <=>
		$services{$b}{'want'}{$sk}{$lvl}} @{$scripts})
	{
		my $min_v = $def_v;
		my $display;
		my $dsk = $rc_dir .'/'. $sk;
		my $new = $services{$s}{'want'}{$sk}{$lvl};
		$new = 99 - $new if ($sk eq 'K');
		my $new2 = sprintf('%02d', $new);
		my $old = $services{$s}{'found'}{$sk}{$lvl};
		if (defined($old))
		{
			if ($old != $new)
			{
				my $old2 = sprintf('%02d', $old);
				print $scriptfh
					'mv -T '. $dsk . $old2 . $s .' '. $dsk . $new2 . $s ." \n";
				$display = 'moved from '. $old .' to ';
				++$changes;
				++$renumbered;
				set_cannot($old);
			}
			else
			{
				$display = 'remains at ';
				$min_v = 3;
			}
		}
		else
		{
			print $scriptfh
				'ln -s -T '. $init_link . $s .' '. $dsk . $new2 . $s ." \n";
			$display = 'new, linked at ';
			++$changes;
		}
		print $s, ', ', $display, $new, "\n" if ($verbose > $min_v);
		set_cannot($new);
	}
	print "$renumbered script(s) renumbered at RUNLEVEL $lvl, $sk\n"
		if ($verbose && $renumbered && !$renum);
	return $changes;
}

sub write_rm
{
	my ($scriptfh, $sk, $lvl) = @_;
	my $changes = 0;

	my $rc_dir = $rc_d{$lvl};
	my @scripts = grep(exists($services{$_}{'found'}{$sk}{$lvl}) &&
		!exists($services{$_}{'want'}{$sk}{$lvl}), keys(%services));

	foreach my $s (@scripts)
	{
		my $order = sprintf('%02d', $services{$s}{'found'}{$sk}{$lvl});
		my $hint = get_hint($s, $lvl, $sk, $order);
		my $fname = $rc_dir .'/'. $sk . $order . $s;

		if ($hint == PLAIN_FILE)
		{
			print $scriptfh 'mv -T '. $fname .' '.
				$rc_dir .'/DeleteMe.'. $sk . $order . $s, "\n";
		}
		else
		{
			print $scriptfh 'rm -f '. $fname, "\n";
		}
		++$changes;
	}
	return $changes;
}
#################################################################

# populate %services
find(\&check_file, ($initdir, values %rc_d));

# populate %provides2name
foreach my $script (keys(%services))
{
	if (!exists($services{$script}{'lsb'}{'provides'}))
	{
		$services{$script}{'lsb'}{'provides'} = [$script];
		print "$script misses LSB's Provides\n" if ($verbose > 1);
	}

	my @provides = @{$services{$script}{'lsb'}{'provides'}};
	next unless @provides;

	foreach my $svc (@provides)
	{
		$provides2name{$svc} = [] unless exists($provides2name{$svc});
		push($provides2name{$svc}, $script);
	}
}

# normalize reverse X-* dependencies
foreach my $script (keys(%services))
{
	normalize_reverse($script, 'revS');
	normalize_reverse($script, 'revK');
	normalize_level($script, 'lvlS');
	normalize_level($script, 'lvlK');
}

# output file
my ($scriptfh, $scriptname, $runscript);
if ($dryrun)
{
	$scriptname = $dryrun;
	open($scriptfh, '>', $dryrun) or
		die("Cannot open $dryrun for writing: $!\n");
}
else
{
	$runscript = (!defined($dryrun) && -w $root)? 1: 0;
	($scriptfh, $scriptname) =
		tempfile("fix-init-XXXXX",
			DIR => '/tmp', UNLINK => $runscript);
	die unless $scriptname;
}

my $shell = exists($ENV{'SHELL'})? $ENV{'SHELL'}: '/bin/sh';
print $scriptfh '#! ', $shell, "\n",
	'# automatically created by fix-init on '. localtime(), "\n";

# sort dependencies for each level
my $changes = 0;
foreach my $lvl (@levels)
{
	print "\n" if ($verbose > 1);
	my $start = do_find_sk_order('S', $lvl);
	my $stop = do_find_sk_order('K', $lvl);

	if (!defined($start) || !defined($stop))
	{
		warn "abort\n";
		$runscript = 0;
		last;
	}

	print $scriptfh "\n", '# RUNLEVEL ', $lvl, "\n";
	$changes += write_rm($scriptfh, 'S', $lvl);
	$changes += write_rm($scriptfh, 'K', $lvl);
	$changes += write_commands($scriptfh, 'S', $lvl, $start);
	$changes += write_commands($scriptfh, 'K', $lvl, $stop);
}

# stick to traditional boot and set timestamp
print $scriptfh 'touch '. $fix_flag, "\n";

if ($verbose)
{
	if ($verbose > 3)
	{
		print '%services = ', Dumper(\%services), "\n";
		print '%provides2name = ', Dumper(\%provides2name), "\n";
		print '%foundpriority = ', Dumper(\%foundpriority), "\n";
	}
	print "$changes total change(s)\n";
}

# run it
if ($runscript)
{
	my $old = select($scriptfh);
	$| = 1;
	print "\n";
	select($old);
	if (!$cannot)
	{
		print "Running $shell -c \". $scriptname\"\n" if ($verbose > 1);
		system($shell, '-c', '. '. $scriptname)
	}
	close($scriptfh);
	if ($? == -1)
	{
		warn "failed to execute $shell: $!\n";
	}
	elsif ($? & 127)
	{
		warn sprintf("$shell killed by signal %d\n", ($? & 127));
	}
	elsif ($? >> 8)
	{
		warn sprintf("return code from $shell %d\n", ($? >> 8));
	}
}
else
{
	close($scriptfh);
	my $bye = "Commands saved to $scriptname\n";
	$bye .= "($changes total change(s))\n" unless ($verbose);
	if ($dryrun)
	{
		print $bye if ($verbose > 3);
	}
	else
	{
		warn $bye;
	}
}

1;

__END__


=head1 DESCRIPTION

B<fix-init> is designed to allow working with traditional init script links,
also known as legacy boot ordering.  It reads LSB blocks from the scripts it
finds and tries to assign priorities so as to respect their well established
order as well as LSB dependencies.  File F<.legacy-bootordering> is used as a
timestamp to determine what is well established:  It is necessary to touch that
file after considered priority adjustments.

Especially after running update-rc.d in dependency based boot sequencing mode,
priorities can be so tight as to not allow further insertions.  In that case
this script fails, asking for --renum.  In either case, an attempt is made to
leave gaps between subsequent priority orders.

Circular dependencies are broken respecting the high-priority well established
scripts.  That is, starting new scripts later.  If verbose is enabled, loops
are displayed with messages like, for example:

=over

Circular dependencies (K level 0): umountnfs.sh -E<gt> foo -E<gt> rsyslog!

=back

That means it is I<K>ill at runlevel I<0>, and the loop is being broken giving
the highest priority to the first script.  That is, scripts will be stopped in
the reverse order than displayed, i.e. rsyslog first.  If it were an I<S>,
high priorities would imply low numbers, providing for scripts to be started in
the order displayed.  The initial order determines where to break any circular
dependency loop.  On building such initial order, non-linked scripts --whose
priority orders are not defined-- go last.  So, if you want the loop to break
at foo rather than at umountnfs.sh, you can remove rc0.d/K??umountnfs.sh and/or
create rc0.d/K22foo, then run fix-init again.  Alternatively, use --dry-run and
edit the resulting script before running it.

Although existing priorities are respected (unless --renum), existing runlevels
are not.  Except for scripts with no associated LSB info, B<fix-init> always
adds and removes files so as to honor the specified runlevels.

B<fix-init> does not require that services bearing the same name don't coexist,
as that's a package management job.  It copes with missing LSBs and unsatisfied
dependencies (but complains).  It uses both directories of LSB overriding as
defined by B<insserv>; on top of that, it has a configuration file.

=head1 CONFIGURATION

LSB blocks specify runlevels in the Default-Start and Default-Stop directives.
It is not advisable to customize those defaults by overriding the whole LSB,
let alone editing the script itself.  Therefore, one needs to save local
customizations somewhere else, F</etc/fix-init.conf> is a candidate.

Each line specifies how to modify the default runlevels for a given script.
The syntax is like so:

=over

I<script-name> [ =|+|- [ I<level> ]... ] [ / [ =|+|- [ I<level> ]... ]]

=back

The C<=>, C<+>, and C<-> operators mean replace, increase by appending, and
decreases by removing respectively.  Any level following such operator modifies
accordingly the list of levels built thus far.  The C</> separates start levels
from stop ones.

Comments (C<#>), and empty lines work as usual.  Spaces (or commas) around
levels are optional.  For example:

    # This too can solve the loop above, if the box mounts no NFS
    umountnfs.sh /=   # replace LSB's Default-Stop with an empty list

    gdm3 -2           # avoid starting X at runlevel 2
    gdm3 +34          # but make sure 3 and 4 are set

B<NOTE>: Configuration for a script with no LSB starts with emtpy runlevels,
not the actual runlevels that would be considered otherwise.  On the other
hand, setting levels for nonexistent scripts is a no-op.

=head1 BUGS

For wrong names, such as F<S31a-name> -E<gt> F<../init.d/another-name>, the
name of the file, "a-name", is used for overrides and configuration.

Hard links are not detected.

Plain files that ought to be deleted are renamed to F<DeleteMe.whatever>
instead.

No attempt is made to intelligently discriminate between Should- and Required-
Start / Stop directives in LSB blocks.

=head1 FILES

=over

=item F</etc/fix-init.conf>

=item F</etc/init.d/.legacy-bootordering>

=item F</etc/insserv/overrides/>

=item F</usr/share/insserv/overrides/>

=item F</etc/insserv.conf>

=item F</etc/insserv.conf.d/>

=back

=head1 SEE ALSO

B<insserv>(8), B<update-rc.d>(8), B<chkconfig>(8), B<sysv-rc-conf>(8)

=head1 AUTHOR

Alessandro Vesely, ves...@tana.it

=head1 ACKNOWLEDGMENTS

Werner Fink and Petter Reinholdtsen provided the code for F<insserv> and
F<check-initd-order>, which this script heavily draws on.

=cut

Reply via email to