#!/usr/bin/perl

use strict;
use warnings;

use MetaInit::Parse;

my $prefix = "";
$prefix = $ENV{METAINIT_PREFIX} if $ENV{METAINIT_PREFIX};

my $metainit_dir = "$prefix/etc/metainit";
my $etc = "$prefix/etc";
my $updatercd = "$prefix/usr/sbin/update-rc.d";
my $metainit_base = "$prefix/usr/share/metainit";

$metainit_base = $ENV{METAINIT_PREFIX} if $ENV{METAINIT_PREFIX};

#
# Rough plan of operation:
#    (Maybe:
#     Check all init files, find all generated ones, see if the metainit 
#     file is missing and delete them then)
#    Check all metainit files, whether the init.d file is out of date.
#    If the init.d file was created, find a suitable rc2.d/ number and run update-rc.
#

use Getopt::Long;

my $remove = '';
my $purge = 0;
GetOptions( 'purge' => \$purge, 'remove-metainit=s' => \$remove );

if ($remove) {
	# Operation: Remove all geranted files for the given metainit name
	remove($remove, $purge)
} else {
	if ($purge) {
		die "--purge only useful in conjunction with --remove.\n";
		exit 1;
	}
	# Operation: Rebuild everything
	
	#check_orphaned_initscripts()
	my %metainits = read_metainits();
	my @generated = ();
	foreach my $metainit (values %metainits) {
		my $created = regenerate_initscript($metainit);
		push @generated, $metainit->{Name} if $created;
	}

	my %arrangement = ();
	open(ARRANGE, '-|',"$metainit_base/utils/arrange-sysvinit",@generated) or die $!;
	while (<ARRANGE>) {
		if (/^([\w\.-]+) (\d\d)$/){
			$arrangement{$1} = $2;
		} else {
			die "Can't parse $_";
		}
	}
	close ARRANGE;

	while (my ($initname,$num) = each %arrangement) {
		my %data = %{$metainits{$initname}};
		system($updatercd, $initname,
			@{$data{"Start-Levels"}} ?  ("start", $num, @{$data{"Start-Levels"}}, ".") : (),
			@{$data{"Stop-Levels"}}  ?  ("stop",  $num, @{$data{"Stop-Levels"}}, ".") : ()
		);
	}

}

sub read_metainits{
	my %metainits;
	for my $metainit_file (<$metainit_dir/*.metainit>) {
		my $parsed = MetaInit::Parse::parse({ filename => $metainit_file });
		$metainits{$parsed->{Name}} = $parsed;
	}
	return %metainits;
}

sub regenerate_initscript {
	my ($metainit) = @_;
	my $initscript = init_script_file($metainit);
	my $new = not -e $initscript;

	if (not $new) {
		if (not may_modify($initscript)) {
			warn "Not overriding user-modified init script $initscript.\n";
			return;
		}
	} else {
		# Here me might want to check if the file is up-to-date.
		# For now, we just override it always.
	}

	system("$metainit_base/utils/create-sysvinit-file", $metainit->{File}, $initscript);

	return $new;

}

sub may_modify {
	my $initscript = shift;
	if (-e $initscript) {
		return 0 if not -w $initscript;

		my $can_touch = 0;
		open INIT, '<', $initscript or die $!;
		while (<INIT>) {
			if (/DO NOT EDIT THIS FILE/) {
				$can_touch = 1;
				last;
			}
		}
		close INIT;
		return $can_touch;
	} else {
		return 1;
	}
}

sub init_script_file {
	my ($metainit) = @_;
	return init_script_filename($metainit->{Name});
}
sub init_script_filename {
	my ($initname) = @_;
	return sprintf "%s/init.d/%s", $etc, $initname;
}


sub remove {
	my $initname = shift;
	my $purge = shift;
	# It seems that --remove without --purge is not good, because possible user
	# configuration in the form of rc syslinks will not be presered. We rather
	# leave the generated init script around until purge then. So do not call
	# --remove in postrm if not purging, and do call --remove --purge when purging.
	my $initscript = init_script_filename($initname);
	if (may_modify($initscript) || $purge) {
		warn "Removing init script $initscript\n";
		unlink $initscript or warn $! if -e $initscript;
		system($updatercd, $initname, "remove");
	} else {
		warn "Init script $initscript is modified, not removing.\n";
	}
}
