#!/usr/bin/perl

use warnings;
use strict;

use Data::Dumper;

use constant COMMANDS => qw( disable enable required status );
use constant INITDIR => '/etc/init.d';
use constant RUNLEVELS => qw( S 1 2 3 4 5 6 0 );
use constant SVCKEYS => qw(
	Provides
	Required-Start
	Required-Stop
	Should-Start
	Should-Stop
	X-Start-Before
	X-Start-After
	Default-Start
	Default-Stop
	Short-Description
	Description
	);
use constant VERBOSE => eval {
	for ( my $i = 0; $i <= $#ARGV; $i++ ) {
		if ( $ARGV[$i] eq '-v' || $ARGV[$i] eq '--verbose' ) {
			splice( @ARGV, $i, 1 );

			return( 1 );
			}
		}

	return( 0 );
	};

sub enable {
	my $service = shift || error( -1, "enable(): service not provided" );
	my $services = shift || error( -1, "enable(): services not provided" );

	if ( $service->{'enabled'} ) {
		return;
		}

	if ( VERBOSE ) {
		print "Enabling $service->{'name'}\n";
		}

	foreach my $rlvl ( @{$service->{'Default-Stop'}} ) {
		$service->{'rlvls'}{$rlvl} = 'K';
		}
	foreach my $rlvl ( @{$service->{'Default-Start'}} ) {
		$service->{'rlvls'}{$rlvl} = 'S';
		}

	$service->{'enabled'} = 1;

	if ( ! $service->{'Required-Start'} ) {
		return;
		}

	foreach my $svc ( keys( %{$services} ) ) {
		if ( grep( $_ eq $svc, @{$service->{'Required-Start'}} ) &&
		! $services->{$svc}{'enabled'} ) {
			if ( VERBOSE ) {
				print "  $service->{'name'} requires $svc\n";
				}

			enable( $services->{$svc}, $services );
			}
		elsif ( ref( $services->{$svc}{'Provides'} ) eq 'ARRAY' &&
		! $services->{$svc}{'enabled'} ) {
			foreach my $provides (
			@{$services->{$svc}{'Provides'}} ) {
				if ( grep( $_ eq $provides,
				@{$service->{'Required-Start'}} ) ) {
					if ( VERBOSE ) {
						print "  $service->{'name'}"
							. " requires $svc\n";
						}

					enable( $services->{$svc}, $services );
					}
				}
			}
		}
	}

sub error {
	my $status = shift;
	my $errstr = shift;
	my $level = 1;
	my @stack = ();
	( my $self = ( caller() )[1] ) =~ s/.*\///;

	chomp( $errstr );

	print "\n";

	print STDERR "$self:\n  $errstr at line "
		. ( caller() )[2] . "\n";

	if ( VERBOSE ) {
		if ( caller( $level ) ) {
			print "\n=== Stack Trace ===\n";
			}

		while ( my @trace = caller( $level++ ) ) {
			print STDERR "  $trace[1]:\n"
				. "    $trace[3]() called at line $trace[2]\n";
			}
		}

	print "\n";

	if ( $status ) {
		exit( $status );
		}
	}

sub getsvcrlvls {
	my $service = shift ||
		error( -1, "getsvcrlvls(): service not provided\n" );

	foreach my $rlvl ( RUNLEVELS ) {
		my $dir = "/etc/rc$rlvl.d";

		opendir( my $dh, $dir ) ||
			error( int( $! ), "getsvcrlvls(): opendir(): $!" );

		while ( readdir( $dh ) ) {
			if ( ! -l "$dir/$_" ) {
				next;
				}

			my $link = readlink( "$dir/$_" ) ||
				error( int( $! ),
					"getsvcrlvls(): readlink(): $!" );
			( my $name = $link ) =~ s/.*\///;

			if ( $name eq $service->{'name'} &&
			$_ =~ /^([KS])(\d+)$service->{'name'}$/ ) {
				$service->{'rlvls'}{$rlvl} = $1;
				}
			}

		closedir( $dh );
		}
	}

sub korder {
	my $service = shift || error( -1, "korder(): service missing" );
	my $services = shift || error( -1, "korder(): services missing" );
	my $korder = shift || [];
	my $stack = shift || [];

	if ( ( $stack->[0] && grep( $_ eq $service, @$stack ) ) ||
	( $korder->[0] && grep( $_->{'name'} eq $service, @$korder ) ) ||
	@$stack > 99 ) {
		return;
		}
	else {
		push( @$stack, $service );
		}

	foreach my $svc ( sort( keys( %{$services} ) ) ) {
		if ( $service eq 'halt' || $service eq 'reboot' ) {
			korder( $svc, $services, $korder, $stack );

			next;
			}

		if ( ( $services->{$svc}{'X-Stop-After'} && grep( $_ eq
		$service, @{$services->{$svc}{'X-Stop-After'}} ) ) ||
		( $services->{$svc}{'Required-Stop'} && grep( $_ eq $service,
		@{$services->{$svc}{'Required-Stop'}} ) ) ||
		( $services->{$svc}{'Should-Stop'} && grep( $_ eq $service,
		@{$services->{$svc}{'Should-Stop'}} ) ) ) {
			korder( $svc, $services, $korder, $stack );
			}

		if ( $services->{$service}{'Provides'} ) {
			foreach my $provides (
			@{$services->{$service}{'Provides'}} ) {
				if ( ( $services->{$svc}{'Required-Stop'} &&
				 grep( $_ eq $provides,
				@{$services->{$svc}{'Required-Stop'}} ) ) ||
				( $services->{$svc}{'Should-Stop'} &&
				grep( $_ eq $provides,
				@{$services->{$svc}{'Should-Stop'}} ) ) ) {
					korder( $svc, $services, $korder,
						$stack );
					}
				}
			}
		}

	push( @$korder, $services->{$service} );
	}

sub readlsb {
	my $file = shift;
	my $begin = 0;
	my $prev;
	my $lsb = {
		'Provides' => [],
		'Required-Start' => [],
		'Required-Stop' => [],
		'Should-Start' => [],
		'Should-Stop' => [],
		'X-Start-Before' => [],
		'X-Stop-After' => [],
		'Default-Start' => [],
		'Default-Stop' => [],
		'Short-Description' => '',
		'Description' => ''
		};
	my @splitpath = split( '/', $file );
	my $override;
	my @files;

	$splitpath[-1] = '.' . $splitpath[-1];
	$override = join( '/', @splitpath );

	push( @files, $file );

	if ( -f $override ) {
		push( @files, $override );
		}

	foreach ( @files ) {
		open( FILE, "<$_" ) || error( int( $! ), "open(): $_: $!" );

		while ( <FILE> ) {
			chomp();

			if ( substr( $_, 0, 19 ) eq '### BEGIN INIT INFO' ) {
				$begin++;

				next;
				}
			elsif ( substr( $_, 0, 17 ) eq '### END INIT INFO' ) {
				last;
				}
			elsif ( ! $begin ) {
				next;
				}

			if ( $_ =~ /^#\s*((Short\-|)Description):\s*(.*)/ ) {
				$lsb->{$1} = $3;
				$prev = $1;
				}
			elsif ( $_ =~ /^#\s*(\S+):\s*(.*)/ ) {
				$lsb->{$1} = [];
				$prev = $1;

				push( @{$lsb->{$1}}, split( /\s+/, $2 ) );
				}
			elsif ( $prev && $prev =~ /Description/ &&
			$_ =~ /^#\s*(.*)/ ) {
				$lsb->{$prev} .= " $1";
				}
			elsif ( $prev && $_ =~ /^#\s*(.*)/ ) {
				push( @{$lsb->{$prev}}, split( /\s+/, $1 ) );
				}
			}

		close( FILE );
		}

	return( $lsb );
	}

sub readsvcs {
	my $services = {};

	opendir( DIR, INITDIR ) ||
		error( int( $! ), "opendir(): " . INITDIR . ": $!" );

	foreach my $svcname ( sort( readdir( DIR ) ) ) {
		if ( ! -f INITDIR . "/$svcname" ||
		! -X INITDIR . "/$svcname" ) {
			next;
			}

		$services->{$svcname} = readlsb( INITDIR . "/$svcname" );

		if ( ! @{$services->{$svcname}{'Provides'}} ) {
			delete( $services->{$svcname} );

			next;
			}

		$services->{$svcname}{'name'} = $svcname;
		getsvcrlvls( $services->{$svcname} );
		}

	close( DIR );

	return( $services );
	}

sub sorder {
	my $service = shift || error( -1, "sorder(): service missing" );
	my $services = shift || error( -1, "sorder(): services missing" );
	my $sorder = shift || [];
	my $stack = shift || [];

	if ( ! keys( %{$services->{$service}{'rlvls'}} ) ) {
		return;
		}
	elsif ( ( $stack->[0] && grep( $_ eq $service, @$stack ) ) ||
	( $sorder->[0] && grep( $_->{'name'} eq $service, @$sorder ) ) ||
	@$stack > 99 ) {
		return;
		}
	else {
		if ( VERBOSE ) {
			print "Checking start order for $service\n";
			}

		push( @$stack, $service );
		}

	if ( ! @$sorder ) {
		push( @$sorder, $services->{'hostname'} );
		}

	foreach my $svc ( sort( keys( %{$services} ) ) ) {
		if ( $services->{$svc}{'X-Start-Before'} && grep(
		$_ eq $service, @{$services->{$svc}{'X-Start-Before'}} ) ) {
			if ( VERBOSE ) {
				print "  $svc should be before $service\n";
				}

			sorder( $svc, $services, $sorder, $stack );
			}
		}

	if ( ref( $services->{$service}{'Required-Start'} ) eq 'ARRAY' ) {
		MAINLOOP: foreach my $required (
		@{$services->{$service}{'Required-Start'}} ) {
			if ( $services->{$required} && ! grep(
			$_->{'name'} eq $required, @$sorder ) ) {
				if ( VERBOSE ) {
					print "  $service requires service"
						. " $required\n";
					}

				sorder( $services->{$required}{'name'},
					$services, $sorder, $stack );

				next;
				}

			foreach my $svc ( sort( keys( %{$services} ) ) ) {
				if ( ref( $services->{$svc}{'Provides'} )
				eq 'ARRAY' && grep( $_ eq $required,
				@{$services->{$svc}{'Provides'}} ) && ! grep(
				$_->{'name'} eq $svc, @$sorder ) ) {
					if ( VERBOSE ) {
						print "  $service requires"
							. " service $svc\n";
						}

					sorder( $svc, $services,
						$sorder, $stack );

					next MAINLOOP;
					}
				}
			}
		}

	if ( ref( $services->{$service}{'Should-Start'} ) eq 'ARRAY' ) {
		MAINLOOP: foreach my $should (
		@{$services->{$service}{'Should-Start'}} ) {
			if ( $services->{$should} ) {
				if ( VERBOSE ) {
					print "  $service should start"
						. " $should first\n";
					}

				sorder( $services->{$should}{'name'},
					$services, $sorder, $stack );

				next;
				}

			foreach my $svc ( sort( keys( %{$services} ) ) ) {
				if ( ref( $services->{$svc}{'Provides'} )
				eq 'ARRAY' && grep( $_ eq $should,
				@{$services->{$svc}{'Provides'}} ) ) {
					if ( VERBOSE ) {
						print "  $service requires"
							. " service $svc\n";
						}

					sorder( $svc, $services,
						$sorder, $stack );

					next MAINLOOP;
					}
				}
			}
		}

	push( @$sorder, $services->{$service} );
	pop( @$stack );

	if ( VERBOSE ) {
		print "Service $service added to start order\n";
		}
	}

my $command = shift( @ARGV ) || error( -1, "No command supplied" );
my $services = readsvcs();
my $ksvcs = [];
my $ssvcs = [];

if ( ! grep( $_ eq $command, &COMMANDS ) ) {
	error( -1, "$command: invalid command" );
	}

if ( $command eq 'enable' || $command eq 'disable' ) {
	foreach ( @ARGV ) {
		if ( $command eq 'enable' ) {
			enable( $services->{$_}, $services );
			}
		elsif ( $command eq 'disable' ) {
			if ( $services->{$_}{'X-Required'} &&
			$command eq 'disable' ) {
				print STDERR "Not disabling required"
					. " service '$_'\n";

				next;
				}

			foreach my $rlvl ( keys(
			%{$services->{$_}{'rlvls'}} ) ) {
				delete( $services->{$_}{'rlvls'}{$rlvl} );
				}
			}
		}
	}

foreach my $svc ( sort( keys( %$services ) ) ) {
	korder( $svc, $services, $ksvcs );
	sorder( $svc, $services, $ssvcs );

	if ( $services->{$svc}{'X-Required'} &&
	! $services->{$svc}{'enabled'}) {
		enable( $services->{$svc}, $services );
		}
	}

foreach my $rlvl ( &RUNLEVELS ) {
	my $rcdir = "/etc/rc$rlvl.d";
	my $kcnt = 0;
	my $scnt = 0;

	if ( VERBOSE ) {
		print "\n[RUNLEVEL $rlvl]\n";
		}

	opendir( my $rc, $rcdir ) || error( int( $! ),
		"opendir(): $rcdir: $!" );

	while ( readdir( $rc ) ) {
		if ( -l "$rcdir/$_" ) {
			my $target = readlink( "$rcdir/$_" ) || error(
				int( $! ), "readlink(): $rcdir/$_: $!" );
			( my $service = $target ) =~ s/.*\///;

			if ( $services->{$service} ) {
				unlink( "$rcdir/$_" ) || error( int( $! ),
					"unlink(): $rcdir/$_: $!" );
				}
			}
		}

	closedir( $rc );

	for ( my $i = 0; $i <= $#$ksvcs; $i++ ) {
		if ( ! $ksvcs->[$i]{'rlvls'}{$rlvl} ) {
			next;
			}

		if( grep( $_ eq $rlvl, @{$ksvcs->[$i]{'Default-Stop'}} ) ) {
			my $script = "../init.d/$ksvcs->[$i]{'name'}";
			my $link = sprintf( "%s/%s%02d%s", $rcdir,
				$ksvcs->[$i]{'rlvls'}{$rlvl},
				$kcnt, $ksvcs->[$i]{'name'} );

			symlink( $script, $link ) || error( int( $! ),
				"symlink(): $link: $!" );

			if ( VERBOSE ) {
				print "$link\n";
				}

			$kcnt++;
			}
		}

	for ( my $i = 0; $i <= $#$ssvcs; $i++ ) {
		if ( ! $ssvcs->[$i]{'rlvls'}{$rlvl} ) {
			next;
			}

		if ( grep( $_ eq $rlvl, @{$ssvcs->[$i]{'Default-Start'}} ) ) {
			my $script = "../init.d/$ssvcs->[$i]{'name'}";
			my $link = sprintf( "%s/%s%02d%s", $rcdir,
				$ssvcs->[$i]{'rlvls'}{$rlvl},
				$scnt, $ssvcs->[$i]{'name'} );

			symlink( $script, $link ) || error( int( $! ),
				"symlink(): $link: $!" );

			if ( VERBOSE ) {
				print "$link\n";
				}

			$scnt++;
			}
		}
	}
