#!/usr/bin/perl
use Switch;
use Digest;
use Cwd;
use File::Copy;
use File::Path qw(rmtree);
use IO::CaptureOutput qw(capture_exec);
use Term::ANSIColor qw(:constants);
use warnings;
use strict;

###############################################################################
#
# rspm
# $Id: rspm,v 1.11 2009/09/06 01:34:27 werdz Exp $
#
# Builds and manages packages for Redbrick's Solaris systems.
#
# Package information is stored in the file specified in the configuration
# section below.
#
# Written January 2009 by Andrew Martin <werdz@redbrick.dcu.ie>
# No rights in particular reserved
#
# Designed to work in Solaris 10, to build packages for rspm
# (Redbrick Solaris Package Manager)
#
###############################################################################

# Configuration section

my %global_config = ( 'prefix' => '/usr/redbrick2',
	'cmd_wget' => '/usr/sfw/bin/wget',
	'log_directory' => '/var/log/rspm',
);

# Location of the lock file
my $lockfile = "/usr/redbrick/rspm/lockfile";

# Location of package information database
my $location_package_db = "/usr/redbrick/rspm/packages.dat";	

# Directory to be used for temp purposes (e.g. package compilation)
my $location_tmp = "/tmp/rspm";		

# The location of the GNU wget utility
my $cmd_wget = "/usr/sfw/bin/wget";

# The location of the Solaris pkginfo utility
my $cmd_pkginfo = "/usr/bin/pkginfo";

# Location of the Solaris pkgmk utility
my $cmd_pkgmk = "/usr/bin/pkgmk";

# Location of the Solaris pkgtrans utility
my $cmd_pkgtrans = "/usr/bin/pkgtrans";

# Location of the Solaris pkgadd utility
my $cmd_pkgadd = "/usr/sbin/pkgadd";

# Location of the Solaris pkgrm utility
my $cmd_pkgrm = "/usr/sbin/pkgrm";

# The location of the gunzip utility
my $cmd_gunzip = "/usr/bin/gunzip";

# The location of the bunzip2 utility
my $cmd_bunzip2 = "/usr/bin/bunzip2";

# The location of the (Sun Solaris) tar utility
my $cmd_tar = "/usr/bin/tar";

# The location of the rspm-chroot utility
my $cmd_rspm_chroot = "/usr/redbrick/rspm/rspm-chroot";

# Mount command (needed to mount /proc inside chroots)
my $cmd_mount = "/usr/sbin/mount";

# Unmount command
my $cmd_umount = "/usr/sbin/umount";

# rm command
my $cmd_rm = "/bin/rm";

# System architecture
my $system_arch = `uname -m`;

# Vendor of packages
my $vendor = "DCU Networking Society";

# Email address for packages
my $maintainer_email = "admins\@redbrick.dcu.ie";

# Pstamp (I'm not quite sure what this is) for maintainer
my $maintainer_pstamp = "Redbrick admins";

# Umask for the script
my $umask = 0022;

# End of configuration section
# You probably don't want to go any further (then again, maybe you do)
###############################################################################

umask $umask;

# - Ensure that when copying over /usr/redbrick/*, the chroot script does not copy over the package being
#   compiled. This will result in old non-updated files being repackaged into new versions.

chomp $system_arch;

# Find a better way to acquire run locks
if( -f $lockfile) {
	print "There appears to already be somebody running RSPM. Please try later.\n";
	exit 0;
}
else {
	open LOCKFILE,">$lockfile";
	close LOCKFILE;
}

my %run_flags;
$run_flags{'output_tags'} = 0;
$run_flags{'suppress_child_output'} = 1;

# Check that there's at least one argument
usage() unless $ARGV[0];

# Load package database
open DB,$location_package_db;
my @dblines = <DB>;			# Each element is a line of the database file
close DB;


# Parallel arrays, to be used globally, to store all package information
# read from the package database. These can be updated throughout the script,
# as all values are saved at the end of execution.
my @package_id;							# Unique text ID of the package (eg apache22)
my @package_title;						# Human readable package name.
my @package_description; 				# Brief single line description
my @package_version_regex;				# Regex to decode the version number
my @package_version_rules;				# Precedence rules for terms extracted from version number
my @package_last_check;					# Last check data
my @package_version_check_regex;		# Regex for extracting the latest version from authorative source
my @package_version_check_url;			# URL of package version authority
my @package_download_link_url;			# URL of the page containing download links
my @package_download_link_regex;		# Regex for extracting the URL of the latest source package form the download link page
my @package_depends;					# *direct* dependencies.
my @package_basedir;					# Name of basedir. Subdir of /usr/redbrick
my @package_prebuild;					# Prebuild script. Runs from basedir outside chroot
my @package_build;						# Build script. Runs from basedir inside chroot
my @package_postinstall;				# Post install scripts, executed by pkgadd. Runs from basedir.
my @package_externals;					# External directories used by this package
my @package_compression;				# The archive type of the package. Defaults to targz. Can be set to tarbz2
my @package_preremove;					# Pre-removal script

# Temporary variables, used as the package database is parsed
my $current_id = "";					# Unique text ID of the package (eg apache22)
my $current_title = "";					# Human readable package name.
my $current_description = ""; 			# Brief single line description
my $current_version_regex = "";			# Regex to decode the version number
my $current_version_rules = "";			# Precedence rules for terms extracted from version number
my $current_last_check = "";			# Last check data
my $current_version_check_regex = "";	# Regex for extracting the latest version from authorative source
my $current_version_check_url = "";		# URL of package version authority
my $current_download_link_url;			# URL of the page containing download links
my $current_download_link_regex;		# Regex for extracting the URL of the latest source package form the download link page
my $current_depends = "";				# *direct* dependencies
my $current_basedir = "";				# Name of basedir. Subdir of /usr/redbrick
my $current_prebuild = "";				# Prebuild script. Runs from basedir outside chroot
my $current_build = "";					# Build script. Runs from basedir inside chroot
my $current_postinstall = "";			# Post install scripts, executed by pkgadd. Runs from basedir.
my $current_externals = "";				# External directories used by this package
my $current_compression = "targz";		# The compression type
my $current_preremove = "";			# Pre-removal script

# Parser for packages.dat/package info file. A finite state machine in it's simplest form.
# To add a new single-line parameter - Add the holder variables above, add a rule to state 1
# (use the ones there already as a guide), add it to the ---end package--- section to check that
# it was set (if it's a required parameter), and save it to the package arrays, and reset the $current_
# variable.
#
# Also add the variable to the packages.dat save subroutine below, so it doesn't get forgotten about.
# 
# To add a multi-line variable, add a ---begin whatever--- rule to state 1, create a new possible state,
# and add code to read it in line by line until it hits ---end whatever---. Use the ones there already as
# samples. Once it hits the end line, it should go back to state 1.
# Then add the cleanup code as you would for a single-line variable.


# Current parse state.
my $state = 0; 							# 0=nothing, 1=in package, 2=in prebuild, 3=in build, 4=in postinstall, 5=in externals, 6=in preremove

# Process package database, line by line. Certain state/input combinations will result in certain actions and state changes.
foreach my $line(@dblines) {
	chomp $line; # Remove newlines
	
	if($state == 0) {
		# In no section
		if($line =~ m/^---\s*package\s+([a-zA-Z0-9]+)\s*---\s*$/i) {
			$state = 1;
			$current_id = $1;
		}
	}
	elsif($state == 1) {
		# In package section
		if($line =~ m/^title (.*?)$/i) {
			$current_title = $1;
		}
		elsif($line =~ m/^description (.*?)$/i) {
			$current_description = $1;
		}
		elsif($line =~ m/^version_regex (.*?)$/i) {
			$current_version_regex = $1;
		}
		elsif($line =~ m/^version_rules (.*?)$/i) {
			$current_version_rules = $1;
		}
		elsif($line =~ m/^last_check (\d+)\s*$/i) {
			$current_last_check = $1;
		}
		elsif($line =~ m/^version_check_regex (.*?)$/i) {
			$current_version_check_regex = $1;
		}
		elsif($line =~ m/^version_check_url (.*?)$/i) {
			$current_version_check_url = $1;
		}
		elsif($line =~ m/^download_link_url (.*?)$/i) {
			$current_download_link_url = $1;
		}
		elsif($line =~ m/^download_link_regex (.*?)$/i) {
			$current_download_link_regex = $1;
		}
		elsif($line =~ m/^depends (.*?)$/i) {
			$current_depends = $1;
		}
		elsif($line =~ m/^basedir ([a-zA-Z0-9\/\_]+)\s*$/i) {
			$current_basedir = $1;
		}
		elsif($line =~ m/^compression (tarbz2|targz)\s*$/i) {
			$current_compression = $1;
		}
		elsif($line =~ m/^---\s*prebuild\s*---\s*$/i) {
			$state = 2; # Change to state 2 (reading prebuild script)
		}
		elsif($line =~ m/^---\s*build\s*---\s*$/i) {
			$state = 3; # Change to state 3 (reading build script)
		}
		elsif($line =~ m/^---\s*postinstall\s*---\s*$/i) {
			$state = 4; # Change to state 4 (reading postinstall script)
		}
		elsif($line =~ m/^---\s*externals\s*---\s*$/i) {
			$state = 5; # Change to state 5 (reading externals)
		}
		elsif($line =~ m/^---\s*preremove\s*---\s*$/i) {
			$state = 6; # Change to state 6 (inside preremove)
		}
		elsif($line =~ m/^---\s*end package.*?---\s*$/i) {
			# Check everything's in order, and save package to list.
			# Exit if a required field is missing
			#
			# Required fields are:
			# - id
			# - title
			# - version_regex
			# - version_rules
			# - version_check_regex
			# - version_check_url
			# - download_link_url
			# - download_link_regex
			# - last_check
			# - basedir
			# - build
			
			my $error = "";
			
			# Validate required fields
			if($current_id eq "") {
				$error .= "Package identifier missing or invalid\n";
			}
			if($current_title eq "") {
				$error .= "Package title missing or invalid\n";
			}
			if($current_version_regex eq "") {
				$error .= "Version regex missing or invalid\n";
			}
			if($current_version_rules eq "") {
				$error .= "Version rules missing or invalid\n";
			}
			if($current_version_check_regex eq "") {
				$error .= "Version check regex missing or invalid\n";
			}
			if($current_version_check_url eq "") {
				$error .= "Version check URL missing or invalid\n";
			}
			if($current_download_link_url eq "") {
				$error .= "Download link URL missing or invalid\n";
			}
			if($current_download_link_regex eq "") {
				$error .= "Download link regex missing or invalid\n";
			}
			if($current_last_check eq "") {
				$error .= "Last check timestamp missing or invalid\n";
			}
			if($current_basedir eq "") {
				$error .= "Base install directory slug missing or invalid\n";
			}
			if($current_build eq "") {
				$error .= "Build script missing or empty\n";
			}
			
			# Check for errors
			if($error ne "") {
				print "Error parsing package definition for $current_id:\n";
				print $error;
				print "Will not continue.\n";
				unlink $lockfile;
				exit 1;
			}
			
			# Package is good, save it
			push(@package_id,$current_id);
			push(@package_title,$current_title);
			push(@package_description,$current_description);
			push(@package_version_regex,$current_version_regex);
			push(@package_version_rules,$current_version_rules);
			push(@package_last_check,$current_last_check);
			push(@package_version_check_regex,$current_version_check_regex);
			push(@package_version_check_url,$current_version_check_url);
			push(@package_download_link_url,$current_download_link_url);
			push(@package_download_link_regex,$current_download_link_regex);
			push(@package_depends,$current_depends);
			push(@package_basedir,$current_basedir);
			push(@package_prebuild,$current_prebuild);
			push(@package_build,$current_build);
			push(@package_postinstall,$current_postinstall);
			push(@package_externals,$current_externals);
			push(@package_compression,$current_compression);
			push(@package_preremove,$current_preremove);

			# Clear temporary variables for the next package
			$current_id = "";
			$current_title = "";
			$current_description = "";
			$current_version_regex = "";
			$current_version_rules = "";
			$current_last_check = "";
			$current_version_check_regex = "";
			$current_version_check_url = "";
			$current_download_link_url = "";
			$current_download_link_regex = "";
			$current_depends = "";
			$current_basedir = "";
			$current_prebuild = "";
			$current_build = "";
			$current_postinstall = "";
			$current_externals = "";
			$current_compression = "targz";
			$current_preremove = "";

			$state = 0;	# Reset to state 0 (no package currently being read)
		}
	}
	elsif($state == 2) {
		# In prebuild section
		if($line =~ m/^---\s*end prebuild\s*---\s*$/i) {
			$state = 1;
		}
		else {
			$current_prebuild .= $line . "\n";
		}
	}
	elsif($state == 3) {
		# In build section
		if($line =~ m/^---\s*end build\s*---\s*$/i) {
			$state = 1;
		}
		else {
			$current_build .= $line . "\n";
		}
	}
	elsif($state == 4) {
		# In postinstall section
		if($line =~ m/^---\s*end postinstall\s*---\s*$/i) {
			$state = 1;
		}
		else {
			$current_postinstall .= $line . "\n";
		}
	}
	elsif($state == 5) {
		# In externals section
		if($line =~ m/^---\s*end externals\s*---\s*$/i) {
			$state = 1;
		}
		else {
			$current_postinstall .= $line . "\n";
		}
	}
	elsif($state == 6) {
		# In preremove section
		if($line =~ m/^---\s*end preremove\s*---\s*$/i) {
			$state = 1;
		}
		else {
			$current_preremove .= $line . "\n";
		}
	}
}

if($state != 0) {
	print "Unexpected EOF parsing package database. Will not continue.\n";
	unlink $lockfile;
	exit 1;
}

# Parse of package database complete. If we're still here, the database was
# found to be valid, and the @package_* parallel arrays should contain all
# required information.

# Process the command given by the user
my $command = $ARGV[0];

my @new_argv;
foreach my $argument(@ARGV) {
	if($argument eq "--output-tags") {
		$run_flags{'output_tags'} = 1;
	}
	elsif($argument eq "--log-to-screen") {
		$run_flags{'suppress_child_output'} = 0;
	}
	else {
		push(@new_argv,$argument);
	}
}

@ARGV = @new_argv;
if($command eq "versioncheck") {
	# Check a package, and it's dependencies, for available updates
	
	my @to_check; 				# List of packages to version check (by index)
	my @packages_to_update; 	# List of packages requiring updates (by index)
	my @packages_not_installed; # List of packages found to be not installed
	my @checked;				# Packages already checked.
	
	if($ARGV[1]) { 
		# Single package specified, find it's index
		my $i;
		for($i = 0;$i < scalar(@package_id);$i++) {
			if($package_id[$i] eq $ARGV[1]) {
				push(@to_check,$i);
			}
		}
	}
	else {
		# No package specified, get a list of all indexes
		my $i;
		for($i = 0;$i < scalar(@package_id);$i++) {
			push(@to_check,$i);
		}
	}
	
	# If check list is empty, abort.
	if(scalar(@to_check) <= 0) {
		print "versioncheck command specified, but no valid or matching packages could be\n";
		print "found. Aborting.\n";
		unlink $lockfile;	
		exit 1;
	}
	
	foreach my $item(@to_check) {
		check_version($item,\@checked,\@packages_to_update,\@packages_not_installed);
	}
	
	say_report("--------------------------------------------------------------------------------\n");
	say_report(" Update summary\n");
	say_report("--------------------------------------------------------------------------------\n");
	say_report(" Packages requiring update:\n\n");
	foreach my $item(@packages_to_update) {
		say_report(" * " . $package_id[$item] . " (" . $package_title[$item] . ")\n");
	}
	say_report(" Total " . scalar(@packages_to_update) . " of " . scalar(@checked) . ".\n");
	say_report("--------------------------------------------------------------------------------\n");
}
elsif($command eq "install" or $command eq "update" or $command eq "upgrade" or $command eq "compile") {
	# Compile command
	
	# Check command line arguments
	usage() unless $ARGV[1];
		
	my $i = get_package_index($ARGV[1]); # Find the index of the package identifier provided
	if($i == -1) {
		print "Package " . $ARGV[1] . " not found. Cannot continue.\n";
		unlink $lockfile;
		exit 1;
	}

	# Find a list of dependencies
	my @deps;	
	find_dependency_list(get_package_index($ARGV[1]),\@deps);
	
	# Check that dependencies are installed
	my @missing_dependencies;
	foreach my $dep(@deps) {
		if(check_package_version($dep) eq "-1") {
			push(@missing_dependencies,$dep);
		}
	}
	
	# Prompt user for descision on whether or not to compile and install dependencies
	if(scalar(@missing_dependencies) > 0) {
		say("Missing dependencies for package " . $package_id[$i] . "\n");
		say("The following packages need to be compiled and installed first:\n");
		foreach my $missing_dep(@missing_dependencies) {
			say(" * " . $package_id[$missing_dep] . "\n");
		}
		
		say("Would you like to download, compile and install these packages first? (y/n)");
		my $answer = "";
		while($answer ne "y" && $answer ne "Y" && $answer ne "n" && $answer ne "N") {
			$answer = <STDIN>;
			chomp $answer;
		}
		
		if($answer ne "y" && $answer ne "Y") {
			print "Cannot continue without package dependencies. Aborting.\n";
			unlink $lockfile;
			exit 1;
		}
	}
	
	# Compile and install dependencies
	foreach my $dep(@missing_dependencies) {
		say("Beginning compile of dependency $dep\n");
		compile($dep);
	}
	
	# Compile target
	compile($i);
}
else {
	usage();
}

# Save the package database.
#say("Saving package database state\n");
#open DB,">$location_package_db";
#my $i;
#for($i = 0;$i < scalar(@package_id);$i++) {
#	print DB "--- package " . $package_id[$i] . " ---\n";
#	print DB "title " . $package_title[$i] . "\n";
#	print DB "description " . $package_description[$i] . "\n";
#	print DB "version_regex " . $package_version_regex[$i] . "\n";
#	print DB "version_rules " . $package_version_rules[$i] . "\n";
#	print DB "last_check " . $package_last_check[$i] . "\n";
#	print DB "version_check_regex " . $package_version_check_regex[$i] . "\n";
#	print DB "version_check_url " . $package_version_check_url[$i] . "\n";
#	print DB "download_link_url " . $package_download_link_url[$i] . "\n";
#	print DB "download_link_regex " . $package_download_link_regex[$i] . "\n";
#	print DB "depends " . $package_depends[$i] . "\n";
#	print DB "basedir " . $package_basedir[$i] . "\n";
#	print DB "compression " . $package_compression[$i] . "\n";
#	print DB "--- prebuild ---\n" . $package_prebuild[$i] . "--- end prebuild ---\n";
#	print DB "--- build ---\n" . $package_build[$i] . "--- end build ---\n";
#	print DB "--- postinstall ---\n" . $package_postinstall[$i] . "--- end postinstall ---\n";
#	print DB "--- externals ---\n" . $package_externals[$i] . "--- end externals ---\n";
#	print DB "--- preremove ---\n" . $package_preremove[$i] . "--- end preremove ---\n";
#	print DB "--- end package " . $package_id[$i] . " ---\n"; # Printing package ID here isn't strictly required, but makes things more readable.
#	print DB "\n\n";
#}
#close DB;

sub say_report {
	my $what = $_[0];
	chomp $what;
	print $what . "\n";
}

# Output something
# Applies [info] tag if run_flags{'tag_output'} is set to 1
#
# arg what	The information to be output
sub say {
	my $what = $_[0];
	
	if($run_flags{'output_tags'} == 1) {
		print "[info]";
	}
	
	chomp $what;
	print $what . "\n";
}

# Compile and install a package
#
# arg i		The index of the package to compile.
sub compile {
	my $i = $_[0];
	
	say("Checking currently installed version (if any)\n");
	my $current_version = check_package_version($i);
	
	my $version;
	my ($version_check_page,$stderr,$success,$exit_code) = capture_exec($cmd_wget,$package_version_check_url[$i],"-O","-");
	if($version_check_page =~ m/$package_version_check_regex[$i]/s) {
		$version = $1;
	}
	else {
		say("Could not find current version of package " . $package_id[$i] . "\n");
		say("Cannot continue.\n");
		unlink $lockfile;
		exit 1;
	}
	
	# Check for forced download links
	my $force_download_link = "";
	my $arg_length = @ARGV;
	for(my $j = 0;$j < $arg_length;$j++) {
		if($ARGV[$j] eq "--force-download-link") {
			# Check that there are two more arguments
			if(!$ARGV[$j + 2]) {
				say("--force-download-link requires two parameters.\n");
				unlink $lockfile;
				exit 1;
			}

			if($ARGV[$j + 1] eq $package_id[$i]) {
				$force_download_link = $ARGV[$j + 2];
			}
		}
	}

	say("Version is \"" . $version . "\"\n");
	say("Downloading source package for " . $package_id[$i] . "\n");
	say("Finding source package URL\n");
	
	# Find the source package
	my $download_link;
	my $download_link_url;

	if($force_download_link ne "") {
		$download_link = $force_download_link;
		say("Download link set to $download_link by force.\n");
	}
	else {
		# Do substitutions on the download link URL
		$download_link_url = $package_download_link_url[$i];
		$download_link_url =~ s/\$VERSION/$version/g;
	
		my $download_page;
		($download_page,$stderr,$success,$exit_code) = capture_exec($cmd_wget,$download_link_url,"-O","-");
		if($download_page =~ m/$package_download_link_regex[$i]/s) {
			$download_link = $1;
		}
		else {
			say("Could not find download link for package " . $package_id[$i] . "\n");
			say("Cannot continue.\n");
			unlink $lockfile;
			exit 1;
		}
		
		say("Found source package (version $version) at $download_link\n");
	
	}

	my $timestamp = time();
	
	# Download the source package
	if( ! -d $location_tmp ) {
		# Create new temp directory with mode 0700
		mkdir($location_tmp,0700);
	}
	else {
		# Make sure it's mode 0700
		chmod 0700,$location_tmp;
	}
	
	# Download file
	say("Downloading source file\n");
	
	if($force_download_link eq "") {
		if($download_link =~ m/^\//) {
			say("Rebasing URL\n");
			# If the download link is relative to a host, put the hostname of the download link page in front of it
			my $download_link_host = $download_link_url;
			$download_link_host =~ s/^(http|ftp)\:\/\/([^\/]+).*/$1:\/\/$2/;
			$download_link = $download_link_host . $download_link;
		}
		elsif($download_link =~ m/^(http|ftp)\:\/\/.*/) {
			$download_link = $download_link;
		}
		else {
			# Download link is relative to the web page the link was found on ;_;
			my $download_link_base = $download_link_url;
			$download_link_base =~ s/^(.*)\/[^\/]*$/$1\//;
			$download_link = $download_link_base . $download_link;
		}
	}

	my $extension;
	if($package_compression[$i] eq "targz") {
		$extension = "tar.gz";
	}
	elsif($package_compression[$i] eq "tarbz2") {
		$extension = "tar.bz2";
	}
	else {
		say("Internal error, could not determine compression type.\n");
		unlink $lockfile;
		exit 1;
	}
	
	my $wget_output;
	($wget_output,$stderr,$success,$exit_code) = capture_exec($cmd_wget,$download_link,"-O","$location_tmp/$timestamp-source.$extension");
	
	if($exit_code != 0) {
		say("Error downloading source archive. Cannot continue.");
		unlink $lockfile;
		exit 1;
	}

	# Calculate a load of checksums for inspection by the user.
	say("Calculating checksums...");

	my $sha1 = Digest->new('SHA-1');
	my $sha256 = Digest->new('SHA-256');
	my $sha384 = Digest->new('SHA-384');
	my $sha512 = Digest->new('SHA-512');
	my $md5 = Digest->new('MD5');
	
	open FILE,"<$location_tmp/$timestamp-source.$extension";
	binmode FILE;
	
	my $buffer;
	my $n;
	while(($n = read FILE,$buffer,(1024 * 1024 * 1024)) != 0) {
		$sha1->add($buffer);
		$sha256->add($buffer);
		$sha384->add($buffer);
		$sha512->add($buffer);
		$md5->add($buffer);
	}

	close FILE;

	my $sha1_hex = $sha1->hexdigest;
	my $sha256_hex = $sha256->hexdigest;
	my $sha384_hex = $sha384->hexdigest;
	my $sha512_hex = $sha512->hexdigest;
	my $md5_hex = $md5->hexdigest;

	# Ask the user to verify the checksum of the source archive.
	# Note: The COLOUR,"blahblah",RESET thing is made possible by importing Term::ANSIColor
	# above.
	say("-------------------------------------------------------------------------");
	print RED," Important, please read\n", RESET;
	say("-------------------------------------------------------------------------");
	say("The package downloaded was:");
	say($download_link);
	say("That package has the following checksums:");
	
	print "MD5\t";
	print YELLOW,$md5_hex . "\n",RESET;

	print "SHA1\t";
	print YELLOW,$sha1_hex . "\n",RESET;

	print "SHA256\t";
	print YELLOW,$sha256_hex . "\n",RESET;
	
	print "SHA384\t";
	print YELLOW,$sha384_hex . "\n",RESET;

	print "SHA512\t";
	print YELLOW,$sha512_hex . "\n",RESET;
	
	say("It is highly recommended that you ensure that at least one of these matches");
	say("the checksum provided by the software vendor for this source file. This");
	say("information is generally available at the vendor's website, or in a separate");
	say("file called MD5SUM or SHA1SUM alongside the source archive in the download");
	say("directory. Do these checksums appear to be correct? (Answer 'y' or 'n')");
	
	my $answer = "";
	while($answer ne "y" && $answer ne "Y" && $answer ne "n" && $answer ne "N") {
		$answer = <STDIN>;
		chomp $answer;
	}
	
	if($answer ne "y" && $answer ne "Y") {
		say("Package checksum was incorrect. Operation aborted.");
		unlink $lockfile;
		exit 1;
	}


	my $package_log_directory = $global_config{'log_directory'} . "/" . $package_id[$i];
	if( ! -d $package_log_directory ) {
		mkdir $package_log_directory,0700;
	}
	
	# Build chroot environment
	say("Building chroot environment for build.\n");
	my ($build_stdout,$build_stderr,$build_success,$build_exit_code) = capture_exec($cmd_rspm_chroot,"$location_tmp/$timestamp-chroot");
	
	# Remove old version of this package from the chroot
	say("Removing old version of current package from chroot\n");
	rmtree("$location_tmp/$timestamp-chroot/usr/redbrick/$package_basedir[$i]");
	
	# Extract package source into chroot
	if($package_compression[$i] eq "targz") {
		say("Extracting source package (decompress)\n");
		capture_exec($cmd_gunzip,"$location_tmp/$timestamp-source.tar.gz");
	}
	elsif($package_compression[$i] eq "tarbz2") {
		say("Extracting source package (decompress, bunzip2)\n");
		capture_exec($cmd_bunzip2,"$location_tmp/$timestamp-source.tar.bz2");
	}
	else {
		say("Invalid compression type. (internal error).\n");
		unlink $lockfile;
		exit 1;
	}


	my $original_cwd = Cwd::cwd();
	chdir "$location_tmp/$timestamp-chroot/tmp";
	mkdir("$timestamp-source",0700);
	chdir "$timestamp-source";
	
	say("Extracting source package (untar)\n");
	capture_exec($cmd_tar,"xvf","$location_tmp/$timestamp-source.tar");
	
	# If the extraction folder contains only a single folder, we probably have to get
	# into that to do anything with the source code. Change the name to something known.
	# If the extraction folder has anything more then this, just continue. The build
	# script probably knows what to do.
	opendir SOURCEDIR,"$location_tmp/$timestamp-chroot/tmp/$timestamp-source";
	my $count = 0;
	my $dir_count = 0;
	my $last_dir_name;
	while(my $dir = readdir(SOURCEDIR)) {
		if($dir ne "." && $dir ne "..") {
			if( -d "$location_tmp/$timestamp-chroot/tmp/$timestamp-source/$dir") {
				$dir_count++;
				$last_dir_name = $dir;
			}
			$count++;
		}
	}
	closedir SOURCEDIR;
	
	# Install any dependencies
	my @deps;	
	find_dependency_list($i,\@deps);
	foreach my $dep(@deps) {
		say("Copying dependency $dep to chroot environment\n");
		capture_exec("cp","-Prp","/usr/redbrick/$package_basedir[$i]","$location_tmp/$timestamp-chroot/usr/redbrick/");
	}

	say("Mounting chroot /proc\n");
	capture_exec($cmd_mount,"-F","proc","/proc","$location_tmp/$timestamp-chroot/proc");	
	
	say("Outputting chroot bootstrap script\n");
	my $buildhandle;
	my $bootstrap_command;
	if($dir_count == 1 && $last_dir_name) {
			move("$location_tmp/$timestamp-chroot/tmp/$timestamp-source/$last_dir_name","$location_tmp/$timestamp-chroot/tmp/$timestamp-source/$timestamp-build");
			open $buildhandle,">$location_tmp/$timestamp-chroot/tmp/$timestamp-source/$timestamp-build/$timestamp-build.sh";
			print $buildhandle "#!/bin/sh\n";
			print $buildhandle "cd /tmp/$timestamp-source/$timestamp-build\n";
			print $buildhandle "/tmp/$timestamp-source/$timestamp-build/$timestamp-build2.sh\n";
			print $buildhandle "exit \$?\n";
			close $buildhandle;
			
			open $buildhandle,">$location_tmp/$timestamp-chroot/tmp/$timestamp-source/$timestamp-build/$timestamp-build2.sh";
			print $buildhandle $package_build[$i];
			close $buildhandle;


			chmod 0700,"$location_tmp/$timestamp-chroot/tmp/$timestamp-source/$timestamp-build/$timestamp-build.sh";
			chmod 0700,"$location_tmp/$timestamp-chroot/tmp/$timestamp-source/$timestamp-build/$timestamp-build2.sh";
			
			
			$bootstrap_command = "/tmp/$timestamp-source/$timestamp-build/$timestamp-build.sh";
			
			
		}
		else {
		
			open $buildhandle,">$location_tmp/$timestamp-chroot/tmp/$timestamp-source/$timestamp-build.sh";
			print $buildhandle "#!/bin/sh\n";
			print $buildhandle "cd /tmp/$timestamp-source\n";
			print $buildhandle "/tmp/$timestamp-source/$timestamp-build2.sh\n";
			print $buildhandle "exit \$?\n";
			close $buildhandle;
			
			open $buildhandle,">$location_tmp/$timestamp-chroot/tmp/$timestamp-source/$timestamp-build2.sh";
			print $buildhandle $package_build[$i];
			close $buildhandle;
			
			chmod 0700,"$location_tmp/$timestamp-chroot/tmp/$timestamp-source/$timestamp-build.sh";
			chmod 0700,"$location_tmp/$timestamp-chroot/tmp/$timestamp-source/$timestamp-build2.sh";
			
			$bootstrap_command = "/tmp/$timestamp-source/$timestamp-build.sh";
	}
	
	chdir $original_cwd;
	
	# Output chroot bootstrap script
	open BOOTSTRAP,">$location_tmp/$timestamp-bootstrap.sh";
	print BOOTSTRAP "#!/bin/sh\n";
	print BOOTSTRAP "chroot $location_tmp/$timestamp-chroot $bootstrap_command\n";
	close BOOTSTRAP;
	
	chmod 0700,"$location_tmp/$timestamp-bootstrap.sh";	
	
	say("Running build (this may take a while, depending on the package)\n");
	my ($script_stdout,$script_stderr,$script_success,$script_exit_code) = capture_exec("$location_tmp/$timestamp-bootstrap.sh");
	
	my $stdout_log_handle;
	my $stderr_log_handle;
	
	open $stdout_log_handle,">" . $package_log_directory . "/build.stdout.$timestamp.log";
	print $stdout_log_handle $script_stdout;
	close $stdout_log_handle;
	
	open $stderr_log_handle,">" . $package_log_directory . "/build.stderr.$timestamp.log";
	print $stderr_log_handle $script_stderr;
	close $stderr_log_handle;

	if($script_exit_code != 0) {
		say("Compile of $package_id[$i] failed. Will not continue.\n");
		say("Leaving chroot intact at $location_tmp/$timestamp-chroot/\n for analysis. You can delete this if you want.\n");
		say("Unmounting chroot /proc\n");
		capture_exec($cmd_umount,"$location_tmp/$timestamp-chroot/proc");
		unlink $lockfile;
		exit 1;
	}
	
	# Build the actual SVR4 package
	say("Building SVR4 package\n");
	chdir "$location_tmp/$timestamp-chroot/usr/redbrick/$package_basedir[$i]";
	open PREBUILD,">$location_tmp/$timestamp-chroot/tmp/prebuild.sh";
	print PREBUILD $package_prebuild[$i];
	close PREBUILD;
	
	chmod 0700,"$location_tmp/$timestamp-chroot/tmp/prebuild.sh";
	
	($script_stdout,$script_stderr,$script_success,$script_exit_code) = capture_exec("$location_tmp/$timestamp-chroot/tmp/prebuild.sh");
	if($script_exit_code != 0) {
		say("Prebuild script of $package_id[$i] failed. Will not continue.\n");
		say("Leaving chroot intact at $location_tmp/$timestamp-chroot/\n for analysis. You can delete this if you want.\n");
		say("Unmounting chroot /proc\n");
		capture_exec($cmd_umount,"$location_tmp/$timestamp-chroot/proc");
		unlink $lockfile;
		exit 1;
	}
	
	# Output postinstall.sh
	say("Creating postinstall.sh script\n");
	open POSTINSTALLSH,">postinstall.sh";
	print POSTINSTALLSH $package_postinstall[$i];
	close POSTINSTALLSH;
	
	chmod 0700,"$location_tmp/$timestamp-chroot/usr/redbrick/$package_basedir[$i]/postinstall.sh";
	
	# Create the prototype file. This is hacky. TODO clean this up a bit
	say("Creating prototype file\n");
	`find . -print | pkgproto > prototype.s0`;
	`grep -v prototype.s0 prototype.s0 > prototype.s1`;
	
	open PROTOTYPES2,">prototype.s2";
	print PROTOTYPES2 "i pkginfo=./pkginfo\n";
	print PROTOTYPES2 "i postinstall=./postinstall\n";
	close PROTOTYPES2;
	
	`cat prototype.s1 >> prototype.s2`;
	`cp prototype.s2 prototype`;
	`rm prototype.s*`;
	
	say("Creating postinstall file\n");
	open POSTINSTALL,">postinstall";
	print POSTINSTALL "/bin/sh /usr/redbrick/$package_basedir[$i]/postinstall.sh\n";
	close POSTINSTALL;
	
	say("Creating pkginfo file\n");
	open PKGINFO,">pkginfo";
	print PKGINFO "PKG=\"$package_id[$i]\"\n";
	print PKGINFO "NAME=\"$package_title[$i]\"\n";
	print PKGINFO "ARCH=\"$system_arch\"\n";
	print PKGINFO "VERSION=\"$version\"\n";
	print PKGINFO "CATEGORY=\"application\"\n";
	print PKGINFO "VENDOR=\"$vendor\"\n";
	print PKGINFO "EMAIL=\"$maintainer_email\"\n";
	print PKGINFO "PSTAMP=\"$maintainer_pstamp\"\n";
	print PKGINFO "BASEDIR=\"/usr/redbrick/$package_basedir[$i]\"\n";
	print PKGINFO "CLASSES=\"none\"\n";
	close PKGINFO;
	
	say("Running pkgmk\n");
	capture_exec($cmd_pkgmk,"-o","-r","$location_tmp/$timestamp-chroot/usr/redbrick/$package_basedir[$i]");

	if(int($current_version) != -1) {
		say("Preparing preremove script\n");
		open PREREMOVE,">$location_tmp/$timestamp-preremove.sh";
		print PREREMOVE $package_preremove[$i];
		close PREREMOVE;

		chmod 0700,"$location_tmp/$timestamp-preremove.sh";
		my $script_success = system("$location_tmp/$timestamp-preremove.sh");
		if($script_success != 0) {
			say("Pre-removal script failed. May not be safe to continue.\n");
			say("Giving up. Unmounting chroot /proc\n");
			`$cmd_umount $location_tmp/$timestamp-chroot/proc`;
			unlink $lockfile;
			exit 1;
		}

		say("Removing currently installed version\n");
		`$cmd_pkgrm $package_id[$i]`; # This is interacive, don't use capture_exec
	}

	say("Running pkgadd\n");
	`$cmd_pkgadd $package_id[$i]`; # Do not use capture_exec here, this is interactive!
	
	say("Unmounting chroot /proc\n");
	`$cmd_umount $location_tmp/$timestamp-chroot/proc`;

	say("Removing chroot tree\n");
	chdir $original_cwd;
	`$cmd_rm -rf $location_tmp`;
	
	say("Package install successful\n");
}


# Check the currently installed version of a package
#
# arg	i	The index of the package to check
# return	"-1" if a package is not installed. Else returns package version (string).
sub check_package_version {
	my $i = $_[0];	 # Index of package to check
	
	# Find currently installed version
	my @pkginfo = `$cmd_pkginfo -x $package_id[$i]`;
	my $current_version;

	if($pkginfo[1]) {
		$pkginfo[1] =~ m/^\s*\([^\)]*\)\s(\S*)\s*/;
		$current_version = $1;
	}
	else {
		$current_version = "-1";
	}
	
	return $current_version;
}

sub find_dependency_list {
	my $i = $_[0];	# Index of package to find
	my $ref_dep_list = $_[1];
	
	
	my @direct_dep_ids = split(' ',$package_depends[$i]);
	foreach my $dep(@direct_dep_ids) {
		$dep = trim($dep);
		my $dep_index = get_package_index($dep);
		
		if($dep_index >= 0) {
			# Check if item is already in list
			my $preexisting = 0;
			foreach my $item(@{$ref_dep_list}) {
				if($item == $dep_index) {
					$preexisting = 1;
					last;
				}
			}
			
			if(!$preexisting) {
				push(@{$ref_dep_list},$dep_index);
				# check subdependencies
				find_dependency_list($dep_index,$ref_dep_list);
			}
		}
		else {
			say("Error building dependency list for $dep.\n");
			unlink $lockfile;
			exit 1;
		}
	}
	
}


# Check the version of a specific package.
sub check_version {
	my $index = $_[0];	# Index of package to check
	my $ref_checked = $_[1]; # Reference to list of previously checked packages
	my $ref_packages_to_update = $_[2]; # Reference to list of packages requiring updates
	my $ref_packages_not_installed = $_[3]; # Reference to list of packages not installed
	
	my @deps;
	find_dependency_list($index,\@deps);
	
	push(@deps,$index);
	
	foreach my $i(@deps) {
		# Make sure that this package hasn't already been checked.
		foreach my $checked(@{$ref_checked}) {
			if($checked eq $i) {
				return;
			}
		}
	
		say("Checking for version updates for package " . $package_id[$i] . "\n");
	
		# Find currently installed version
		my ($pkginfo_str,$stderr,$success,$exit_code) = capture_exec($cmd_pkginfo,"-x",$package_id[$i]);
		
		my @pkginfo = split(/\n/,$pkginfo_str);
		my $current_version;
	
		if($pkginfo[1]) {
			$pkginfo[1] =~ m/^\s*\([^\)]*\)\s(\S*)\s*/;
			$current_version = $1;
		}
		else {
			$current_version = "0";
		}
	
		say("...Detected current version is " . $current_version);
		if($current_version eq "0") {
			say("...(No package currently installed)");
			push(@{$ref_packages_not_installed},$i);
		}
	
		# Find newest version available on vendor page
		my $newest_version;
		my $version_check_page;
		($version_check_page,$stderr,$success,$exit_code) = capture_exec($cmd_wget,$package_version_check_url[$i],"-O","-");
		if($version_check_page =~ m/$package_version_check_regex[$i]/s) {
			$newest_version = $1;
		}
		else {
			$newest_version = "0";
		}
	
		say("...Newest version is " . $newest_version . "\n");
		
		if($current_version ne "0" && $newest_version ne "0") {
	
			# Determine whether or not the newest version available from the vendor
			# is newer than the current version.
			my @version_rules = split(' ',$package_version_rules[$i]);
	
			my $newer = 0;		# To be used as boolean operator - Is the available package newer then the installed version?
			my $older = 0;		# To be used as boolean operator - Is the available package older then the installed version?
		
			foreach my $item (@version_rules) {
				$item = trim($item);
			
				my $current_cmp = "0";
				my $newest_cmp = "0";
		
				# I would love to replace this code with something a bit nicer.
				# It checks the next item on the version rules list, and copies the corresponding
				# match groups from the version_regex (run against current_version and newest_version)
				# into current_cmp and newest_cmp (for comparison below).
				# If a match is undefined, the _cmp is set to zero.
				#
				# If you can think of a better way to code this, be my guest!
				switch($item) {
					case "1" { $current_version =~ /$package_version_regex[$i]/; if(!defined($1)) { $1 = "0"; } $current_cmp = $1; $newest_version =~ /$package_version_regex[$i]/; if(!defined($1)) { $1 = "0"; } $newest_cmp = $1; }
					case "2" { $current_version =~ /$package_version_regex[$i]/; if(!defined($2)) { $2 = "0"; } $current_cmp = $2; $newest_version =~ /$package_version_regex[$i]/; if(!defined($2)) { $2 = "0"; } $newest_cmp = $2; }
					case "3" { $current_version =~ /$package_version_regex[$i]/; if(!defined($3)) { $3 = "0"; } $current_cmp = $3; $newest_version =~ /$package_version_regex[$i]/; if(!defined($3)) { $3 = "0"; } $newest_cmp = $3; }
					case "4" { $current_version =~ /$package_version_regex[$i]/; if(!defined($4)) { $4 = "0"; } $current_cmp = $4; $newest_version =~ /$package_version_regex[$i]/; if(!defined($4)) { $4 = "0"; } $newest_cmp = $4; }
					case "5" { $current_version =~ /$package_version_regex[$i]/; if(!defined($5)) { $5 = "0"; } $current_cmp = $5; $newest_version =~ /$package_version_regex[$i]/; if(!defined($5)) { $5 = "0"; } $newest_cmp = $5; }
					case "6" { $current_version =~ /$package_version_regex[$i]/; if(!defined($6)) { $6 = "0"; } $current_cmp = $6; $newest_version =~ /$package_version_regex[$i]/; if(!defined($6)) { $6 = "0"; } $newest_cmp = $6; }
					case "7" { $current_version =~ /$package_version_regex[$i]/; if(!defined($7)) { $7 = "0"; } $current_cmp = $7; $newest_version =~ /$package_version_regex[$i]/; if(!defined($7)) { $7 = "0"; } $newest_cmp = $7; }
					case "8" { $current_version =~ /$package_version_regex[$i]/; if(!defined($8)) { $8 = "0"; } $current_cmp = $8; $newest_version =~ /$package_version_regex[$i]/; if(!defined($8)) { $8 = "0"; } $newest_cmp = $8; }
					case "9" { $current_version =~ /$package_version_regex[$i]/; if(!defined($9)) { $9 = "0"; } $current_cmp = $9; $newest_version =~ /$package_version_regex[$i]/; if(!defined($9)) { $9 = "0"; } $newest_cmp = $9; }
				}
		
				if($current_cmp =~ m/^\d*$/ and $newest_cmp =~ m/^\d*$/) {
					# If both versions for comparison are integers, use integer operations (< and >)

					my $current_cmp_int = int $current_cmp;
					my $newest_cmp_int = int $newest_cmp;

					if($current_cmp_int < $newest_cmp_int) {
						$newer = 1;
						last;
					}
					elsif($current_cmp_int > $newest_cmp_int) {
						$older = 1;
						last;
					}
				}
				else {
					# If one of the versions isn't an integer (e.g. a letter), use string comparison operations (lt and gt)
					if($current_cmp lt $newest_cmp) {
						$newer = 1;
						last;
					}
					elsif($current_cmp gt $newest_cmp) {
						$older = 1;
						last;
					}
				}
			}
	
			if($newer == 0 && $older == 0) {
				say("...Package is up to date.\n");
			}
			elsif($newer == 1) {
				say("...Package requires update!\n");
				push(@{$ref_packages_to_update},$i);
			}
			elsif($older == 1) {
				say("...Package installed is newer then that available.\n");
			}
		}
		else {
			say("...Package either not installed, or unable to determine version information.\n");
		}

		# Mark this package as checked
		push(@{$ref_checked},$i);
	}
}

# Find a package index by ID
#	
# arg id		The identifier of the package
# return		The index of the package, or -1 if none found
sub get_package_index {
	my $id = $_[0];
	my $i;
	for($i = 0;$i < scalar(@package_id);$i++) {
		if($package_id[$i] eq $id) {
			return $i;
		}
	}
	return -1; # Not found
}

# Trim whitespace from the beginning and end of a string
#
# arg str		The string to trim
# return		The input string, without any whitespace before or after.
sub trim($)
{
	my $string = shift;
	$string =~ s/^\s+//;
	$string =~ s/\s+$//;
	return $string;
}

# Print usage information
sub usage {
	say("Redbrick Solaris Package Manager v1.11\n");
	say("Checks packages for updates.\n");
	say("Usage: rspm command packagename [arguments]\n");
	say("where command is one of:\n\n");
	say("\tversioncheck\tCheck for newer versions of packages.\n");
	say("\t\t\tSpecify an additional argument (a package identifier)\n");
	say("\t\t\tto check a single package and its dependencies.\n\n");
	say("\tcompile\t\tDownload, compile and package the latest version\n");
	say("\t(or) install\tof a package. Requires an additional argument (the\n");
	say("\t(or) update\tidentifier of the package to be compiled). Will not\n");
	say("\t(or) upgrade\tinstall the package. Will not do anything if the\n");
	say("\t\t\tinstalled package is not older then the available\n");
	say("\t\t\tversion\n\n");
	say("\t\t\tOptional arguments to compile:\n");
	say("\t\t\t--force-download-link packagename url\n");
	say("\t\t\t\tForces RSPM to download a package's source archive\n");
	say("\t\t\t\tfrom the specified location.\n\n");
	say("Global arguments (work for any command):\n");
	say("\t--output-tags\tOutput [info] tags before every line.\n");
	say("\t--suppress-child-output\tWrite child process stdout and stderr streams\n");
	say("\t\t\tto a log file instead of to the screen.\n");
	
	unlink $lockfile;
	exit 1;
}

unlink $lockfile;

# $Log: rspm,v $
# Revision 1.11  2009/09/06 01:34:27  werdz
# Added checksum verification (manual). Changed some more print statements
# to say().
#
# Revision 1.10  2009/09/03 01:19:27  werdz
# Added integer case to line 928
#
# Revision 1.9  2009/09/03 01:02:25  werdz
# Switched say() and say_report() for logwatch.
#
# Revision 1.8  2009/09/03 00:55:44  werdz
# Fixed package logfile bug, fixed /proc umount bug.
#
# Revision 1.7  2009/09/03 00:48:29  werdz
# Fixed typo on line 712
#
# Revision 1.6  2009/09/03 00:45:57  werdz
# Moved output to log files, instead of screen. Changed print statements to say() in compile().
#
# Revision 1.5  2009/09/02 21:56:19  werdz
# Added log info to the bottom of the file.
#