#!/usr/bin/perl
#
# LSB Scanner
# - Make LSB header changes persistent across init script updates.
# 
# This has two modes of operation; Pre-Scan and Post-Write
# 
# In Pre-Scan mode:
# - Read the LSB header of the named init script and records the chkconfig,
#   Required-Start, Should-Start, Required-Stop, Should-Stop, Default-Start,
#   Default-Stop and Default-Enabled. 
# - These will be stored as "variable = value" pairs in the destination
#   directory ('/etc/sysconfig by' default) under the name
#   '<program>.lsb.conf'.
# 
# In Post-Write mode:
# - The '<program>.lsb.conf' file will be read into memory.
# - The named '/etc/init.d/<program>' file will be read up to
#   '### END INIT INFO'.
# - The read value will be compared against the stored value, if any. If there
#   is a difference, the LSB line will be updated to match the stored value.
# - The modified init script will be re-written *only* if a value was changed.
# 
# To Do:
# - The logging is useless right now as I've put the debug check outside of the
#   record() function. Change this to a critical level check.
# 
# Author:  Madison Kelly (mkelly@alteeve.ca)
# Date:    Sep. 21, 2010
# License: GPL v2+
# Version: 0.1
# 

# Play safe!
use strict;
use warnings;
use IO::Handle;
use File::Copy;

# Defaults.
my $conf={
	set_next	=>	"",
	'log'		=>	"/tmp/lsb-scanner.log",
	debug		=>	0,
	quiet		=>	0,
	mode		=>	"",
	program		=>	"",
	init_file	=>	"/etc/init.d",
	lsb_conf	=>	"/etc/sysconfig",
	from_conf	=>	{
		'chkconfig'		=>	undef,
		'Provides'		=>	undef,
		'Required-Start'	=>	undef,
		'Required-Stop'		=>	undef,
		'Should-Start'		=>	undef,
		'Should-Stop'		=>	undef,
		'Default-Start'		=>	undef,
		'Default-Stop'		=>	undef,
		'Default-Enabled'	=>	undef,
	},
};

# Make sure I am running as root.
# print "Real UID: [$<], Effective UID: [$>]\n";
die "The LSB Scanner must be run as root. Exiting.\n" if (($< != 0) && ($> != 0));

# Log file for output.
my $log=IO::Handle->new();
open ($log, ">>$conf->{'log'}") or die "Failed to open: [$conf->{'log'}] for writing; Error: $!\n";
print $log "LSB Scanner starting at unix time: [".time."]\n";

# Set STDOUT and $log to hot (unbuffered) output.
if (1)
{
	select $log;
	$|=1;
	select STDOUT;
	$|=1;
}

# Read in arguments from the command line.
if (read_cla($conf, $log))
{
	record($conf, $log, __LINE__, "Exiting on errors reading command line argiments!\n", 2);
	help($conf, $log, 1);
}

# Sanity check
if (not $conf->{mode})
{
	record($conf, $log, __LINE__, "Mode was not set.\n", 2);
}
elsif (not $conf->{program})
{
	record($conf, $log, __LINE__, "Program was not defined.\n", 2);
}

# Replace some place holders.
my $program=$conf->{program};
$conf->{'log'}=~s/#!prog_name!#/$program/;
$conf->{init_file}.="/$program";
$conf->{lsb_conf}.="/lsb-scanner.$program.conf";
record($conf, $log, __LINE__, "Log: [$conf->{'log'}], init_file: [$conf->{init_file}], lsb_conf: [$conf->{lsb_conf}]\n") if $conf->{debug};

# Start work.
record($conf, $log, __LINE__, "Running in mode: [$conf->{mode}] for program: [$conf->{program}]\n") if $conf->{debug};
if ($conf->{mode} eq "pre")
{
	# Read in the init script. read_init_lsb() returns >0 on success.
	if (read_init_lsb($conf, $log))
	{
		# Write out what I read to the LSB config file.
		write_lsb_conf($conf, $log);
	}
}
elsif ($conf->{mode} eq "post")
{
	# Read in the config file, if it exists.
	if (read_lsb_conf($conf, $log))
	{
		# read_lsb_conf() returns >0 on success.
		write_init_lsb($conf, $log);
	}
}
else
{
	record($conf, $log, __LINE__, "Invalid mode! This should have been caught earlier and is likely the sign of a program error.\n", 2);
}
record($conf, $log, __LINE__, " - LSB Scanner complete.\n") if $conf->{debug};
do_exit($conf, $log, 0);


###############################################################################
# Functions                                                                   #
###############################################################################

# This re-writes the init script if changes are needed.
sub write_init_lsb
{
	my ($conf, $log)=@_;
	
	# This gets set to '1' if anything changes.
	my $save = 0;
	
	# Check that I can read the init script. Die if not, as the program
	# should have been installed by the time this runs in post-write mode.
	record($conf, $log, __LINE__, "The init script: [$conf->{init_file}] doesn't seem to exist.\n", 2) if not -f $conf->{init_file};
	
	# Now the fun part; If I don't have write access, record the current
	# mode so that it can be restored later.
	my $old_mode_o=(stat($conf->{init_file}))[2];
	my $old_mode_a=sprintf "%04o", $old_mode_o & 07777;
	record($conf, $log, __LINE__, "Mode of: [$conf->{init_file}] is: [$old_mode_a] ($old_mode_o)\n") if $conf->{debug};
	
	# Now check to see if I need to change and later reset the mode.
	my $reset_mode = 0;
	if (not -l $conf->{init_file})
	{
		$reset_mode = 1;
		record($conf, $log, __LINE__, "Unable to write to: [$conf->{init_file}], I will change the mode.\n", 1);
		chmod 0755, $conf->{init_file};
	}
	
	# Now read in the source init script and see if there are any headers
	# to change.
	my @new;
	my @orig;
	my $done_processing = 0;
	my $read=IO::Handle->new();
	my $shell_call="$conf->{init_file}";
	open ($read, "<$shell_call") or record($conf, $log, __LINE__, "Failed to read: [$shell_call], error was: $!\n", 2);
	record($conf, $log, __LINE__, "Shell call: [$shell_call]\n") if $conf->{debug};
	while (<$read>)
	{
		my $line=$_;
		
		# This will be written out as then backup, so I record it
		# straight away. I could do a system call or use File::Copy
		# but that's going outside the program or one more dependency.
		push @orig, $line;
		
		# If it's not a comment, or if I've seen the end of the LSB
		# header, just record the line and loop.
		if (($done_processing) || ($line !~ /#/))
		{
			push @new, $line;
			next;
		}
		
		# Parse comments.
		if ($line =~ /^#/)
		{
			# Record that I am done when I see the '### END INIT INFO' line.
			if ($line =~ /^### END INIT INFO/)
			{
				$done_processing = 1;
			}
			elsif ($line =~ /:/)
			{
				my ($var, $old_val)=($line=~/#\s+(.*?):\s+(.*)/);
				$old_val=~s/\s+$//;
				foreach my $key (keys %{$conf->{from_conf}})
				{
					# If the hash key matches the variable,
					# and if the variable exists in the
					# hash, store the value.
					if (($key eq $var) && (exists $conf->{from_conf}{$key}))
					{
						record($conf, $log, __LINE__, "Checking old_val: [$old_val] against stored val: [$conf->{from_conf}{$key}]\n") if $conf->{debug};
						if ($old_val ne $conf->{from_conf}{$key})
						{
							chomp $line;
							my $old=$old_val;
							my $new=$conf->{from_conf}{$key};
							record($conf, $log, __LINE__, " - Different!\n") if $conf->{debug};
							record($conf, $log, __LINE__, " - old: [$line]\n") if $conf->{debug};
							$save = 1;
							$line =~ s/#(\s+)(.*?):(\s+)(.*)/#$1$2:$3$new/;
							record($conf, $log, __LINE__, " - new: [$line]\n") if $conf->{debug};
							$line.="\n";
						}
					}
				}
			}
			
			push @new, $line;
		}
	}
	$read->close();
	
	# Write the changes, if needed.
	if ($save)
	{
		# It's needed. Save a backup first.
		my $backup=$conf->{lsb_conf};
		$backup=~s/.conf$/.init.backup./;
		$backup.=time;
		
		my $bk=IO::Handle->new();
		record($conf, $log, __LINE__, "Opening: [$backup] for writing.\n") if $conf->{debug};
		open ($bk, ">$backup") or die "Failed to open: [$backup] for writing; Error: $!\n";
		foreach my $line (@orig)
		{
			print $bk $line;
		}
		$bk->close();
		
		# Now write out the modified copy.
		my $init=IO::Handle->new();
		record($conf, $log, __LINE__, "Opening: [$conf->{init_file}] for writing.\n") if $conf->{debug};
		open ($init, ">$conf->{init_file}") or die "Failed to open: [$conf->{init_file}] for writing; Error: $!\n";
		foreach my $line (@new)
		{
			print $init $line;
		}
		$init->close();
	}
	
	# Restore the original permissions, if needed.
	if ($reset_mode)
	{
		record($conf, $log, __LINE__, "Restoring original mode of: [$conf->{init_file}] to: [$old_mode_a].\n", 1);
		chmod $old_mode_o, $conf->{init_file};
	}
	
	return 0;
}

# Read in the LSB config file.
sub read_lsb_conf
{
	my ($conf, $log)=@_;
	
	# It's not an error to not have an LSB config file.
	return 0 if not -f $conf->{lsb_conf};
	
	# Parse and record.
	my $read=IO::Handle->new();
	my $shell_call="$conf->{lsb_conf}";
	open ($read, "<$shell_call") or record($conf, $log, __LINE__, "Failed to read: [$shell_call], error was: $!\n", 2);
	record($conf, $log, __LINE__, "Shell call: [$shell_call]\n") if $conf->{debug};
	while (<$read>)
	{
		chomp;
		my $line=$_;
		next if not $line;
		next if $line !~ /:/;
		$line=~s/^\s+//;
		$line=~s/\s+$//;
		next if $line =~ /^#/;
		next if not $line;
		my ($var, $val)=(split/: /, $line, 2);
		$val="" if not defined $val;
		$var=~s/^\s+//;
		$var=~s/\s+$//;
		$val=~s/^\s+//;
		$val=~s/\s+$//;
		next if (not $var);
		$conf->{from_conf}{$var}=$val;
		record($conf, $log, __LINE__, "from_conf::$var: [$conf->{from_conf}{$var}]\n") if $conf->{debug};
	}
	$read->close();
	
	return (1);
}

# This writes out configuration files that were set in the read_init_lsb().
sub write_lsb_conf
{
	my ($conf, $log)=@_;
	
	my $lsb=IO::Handle->new();
	record($conf, $log, __LINE__, "Opening: [$conf->{lsb_conf}] for writing.\n") if $conf->{debug};
	open ($lsb, ">$conf->{lsb_conf}") or die "Failed to open: [$conf->{lsb_conf}] for writing; Error: $!\n";
	
	foreach my $key (sort {$a cmp $b} keys %{$conf->{from_conf}})
	{
		print $lsb "$key: $conf->{from_conf}{$key}\n" if defined $conf->{from_conf}{$key};
	}
	$lsb->close();
	
	return 0;
}

# This reads in the init script up to the LSB header ending string.
sub read_init_lsb
{
	my ($conf, $log)=@_;
	
	if (not -f $conf->{init_file})
	{
		# This is not a problem as it will happen on new installs.
		record($conf, $log, __LINE__, "Unable to find the source file: [$conf->{init_file}].\n") if $conf->{debug};
		return 0;
	}
	elsif (not -r $conf->{init_file})
	{
		record($conf, $log, __LINE__, "Unable to read the source file: [$conf->{init_file}], error was: $!\n", 2);
	}
	
	my $read=IO::Handle->new();
	my $shell_call="$conf->{init_file}";
	open ($read, "<$shell_call") or record($conf, $log, __LINE__, "Failed to read: [$shell_call], error was: $!\n", 2);
	record($conf, $log, __LINE__, "Shell call: [$shell_call]\n") if $conf->{debug};
	while (<$read>)
	{
		chomp;
		my $line=$_;
		next if not $line;
		# For safety reasons, I don't want to look at an uncommented
		# line.
		next if $line !~ /^#/;
		last if $line =~ /^### END INIT INFO/;
		my ($var, $val)=($line=~/#\s+(.*?):\s+(.*)/);
		$val="" if not defined $val;
		next if not $var;
		$val=~s/^\s+//;
		$val=~s/\s+$//;
		foreach my $key (keys %{$conf->{from_conf}})
		{
			# If the hash key matches the variable, and if the
			# variable exists in the hash, store the value.
			if (($key eq $var) && (exists $conf->{from_conf}{$key}))
			{
				$conf->{from_conf}{$key}=$val;
				record($conf, $log, __LINE__, "Set 'conf_file::$key' to: [$conf->{from_conf}{$key}]\n") if $conf->{debug};
				last;
			}
		}
	}
	$read->close();
	
	return (1);
}

# This returns the 'help' message.
sub help
{
	my ($conf, $log, $error)=@_;
	$error = 0 if not defined $error;
	
	# MADI: Convert this to 'man' formatting and then pipe it through
	#       man.
	print "\nFor more information on using lsb-scanner, please run 'man lsb-scanner'\n\n";
	
	do_exit($conf, $log, $error);
}

# Read in command line arguments
sub read_cla
{
	my ($conf, $log)=@_;
	
	my $bad = 0;
	
	# Loop through the passed arguments, if any.
	my $set_next="";
	while (@ARGV)
	{
		my $arg = shift @ARGV;
		my $val="";
		record($conf, $log, __LINE__, "Processing argument: [$arg].\n") if $conf->{debug};
		($arg, $val) = ($arg =~ /(-{1,2}\w+)=(\w+)/) if $arg=~ /=/;
		record($conf, $log, __LINE__, "Parsed argument: [$arg], value: [$val].\n") if $conf->{debug};
		
		if ($arg=~/-h/)
		{
			# Print the help message and then exit.
			help($conf, $log, 0);
		}
		elsif (($arg=~/-d/) || ($arg=~/--debug/))
		{
			# Turn on debugging output.
			$conf->{debug}=1;
		}
		elsif (($arg=~/-D/) || ($arg=~/--no-debug/))
		{
			# Turn off debugging output.
			$conf->{debug}=0;
		}
		elsif (($arg=~/-q/) || ($arg=~/--quiet/))
		{
			# Silence all non-fatal errors.
			$conf->{quiet}=1;
		}
		elsif (($arg=~/-Q/) || ($arg=~/--not-quiet/))
		{
			# Display informative message.
			$conf->{quiet}=0;
		}
		elsif (($arg=~/-m/) || ($arg=~/--mode/))
		{
			# mode, must be 'pre' or 'post'
			$val = $val ? $val : shift @ARGV;
			record($conf, $log, __LINE__, "Value set to: [$val].\n") if $conf->{debug};
			if ((not $val) || ($val =~ /^-/))
			{
				record($conf, $log, __LINE__, "Bad argument! Passed '-m' without a mode. Must be 'pre' or 'post'.\n");
				$bad = 1;
			}
			elsif ((lc($val) ne "pre") && (lc($val) ne "post"))
			{
				record($conf, $log, __LINE__, "Bad mode! Got: [$val], must be 'pre' or 'post'.\n");
				$bad = 1;
			}
			else
			{
				$conf->{mode} = lc($val) eq "pre" ? "pre" : "post";
				record($conf, $log, __LINE__, "- Mode set to: [$conf->{mode}].\n") if $conf->{debug};
			}
		}
		elsif (($arg=~/-p/) || ($arg=~/--program/))
		{
			# program name.
			$val=$val ? $val : shift @ARGV;
			record($conf, $log, __LINE__, "Value set to: [$val].\n") if $conf->{debug};
			if ((not $val) || ($val =~ /^-/))
			{
				record($conf, $log, __LINE__, "Bad argument! Passed '-p' without a program name.\n");
				$bad = 1;
			}
			else
			{
				$conf->{program} = $val;
				record($conf, $log, __LINE__, "- Program set to: [$conf->{program}].\n") if $conf->{debug};
			}
		}
		else
		{
			# Bad argument.
			record($conf, $log, __LINE__, "\nERROR: Argument: [$arg] is not valid!\n");
			$bad=1;
		}
	}
	return ($bad);
}

# This cleanly exits the agent.
sub do_exit
{
	my ($conf, $log, $exit_status)=@_;
	$exit_status=9 if not defined $exit_status;
	
	# Close the Node Assassin and log file handle, if they exist.
	$log->close() if $log;
	
	exit ($exit_status);
}

# This function simply prints messages to both the log and to stdout.
sub record
{
	my ($conf, $log, $line, $msg, $critical)=@_;
	$msg="--" if not defined $msg;
	$critical=0 if not $critical;
	
	# The log file gets everything.
	print $log $msg;
	print $msg if not $conf->{quiet};
	
	# Critical messages have to print, so this ensure that it gets out
	# when 'quiet' is in use.
	print $msg if (($critical == 1) && ($conf->{quiet}));
	die "\nERROR: Fatal error at line: [$line]\nERROR: $msg\n" if $critical == 2;
	
	return(0);
}

exit 0;