sboinstall

#!/usr/bin/perl
#
# vim: ts=4:noet
#
# sboinstall
# script to install (a) SlackBuild(s) by name
#
# authors: Jacob Pipkin <j@dawnrazor.net>
#          Luke Williams <xocel@iquidus.org>
#          Andreas Guldstrand <andreas.guldstrand@gmail.com>
# maintainer: K. Eugene Carlson <kvngncrlsn@gmail.com>
# license: MIT License

use 5.16.0;
use strict;
use warnings FATAL => 'all';
use SBO::Lib qw/ %config _ERR_OPENFH get_arch get_build_queue get_full_reverse get_installed_cpans get_installed_packages get_reverse_reqs get_sbo_location get_sbo_locations in merge_queues open_fh print_failures process_sbos prompt show_version slackbuilds_or_fetch slurp uniq usage_error user_prompt verify_gpg lint_sbo_config wrapsay /;
use Getopt::Long qw(:config bundling);
use File::Basename;
use File::Copy;
use JSON::PP;

my $self = basename($0);

sub show_usage {
	print <<"EOF";
Usage: $self [options] sbo
       $self --use-template file

Options (defaults shown first where applicable):
  -h|--help:
    this screen.
  -v|--version:
    version information.
  -c|--noclean (FALSE|TRUE):
    if TRUE, do not clean working directories after building.
  -d|--distclean (TRUE|FALSE):
    if TRUE, delete downloaded source archives after building.
  -i|--noinstall:
    do not run installpkg after building.
  -j|--jobs (FALSE|#):
    specify the number of parallel jobs (make).
  -p|--compat32:
    install a -compat32 package (multilib systems only).
  -q|--reverse-rebuild:
    rebuild a script's reverse dependencies.
  -r|--nointeractive:
    non-interactive; skips README and all prompts.
  -R|--norequirements:
    view the README but do not parse requirements, commands, or options.
  --reinstall:
    ask to reinstall any installed packages in the requirements list.
  --create-template (FILE):
    create a template with specified requirements, commands, and options.
  --use-template (FILE):
    use a template created by --create-template to install requirements with
    specified commands and options.
  --mass-rebuild:
    rebuild all installed SlackBuilds at the available version.

EOF
	return 1;
}

my $noclean = $config{NOCLEAN};
my $distclean = $config{DISTCLEAN};
my $jobs = $config{JOBS};
my $gpg = $config{GPG_VERIFY};
my ($help, $vers, $no_install, $non_int, $no_reqs, $compat32, $ctemp, $utemp, $reinstall, $mass_rebuild, $reverse_rebuild);

GetOptions(
	'help|h'            => \$help,
	'version|v'         => \$vers,
	'noclean|c=s'       => \$noclean,
	'distclean|d=s'     => \$distclean,
	'noinstall|i'       => \$no_install,
	'jobs|j=s'          => \$jobs,
	'compat32|p'        => \$compat32,
	'nointeractive|r'   => \$non_int,
	'norequirements|R'  => \$no_reqs,
	'reinstall'         => \$reinstall,
	'mass-rebuild'      => \$mass_rebuild,
	'create-template=s' => \$ctemp,
	'use-template=s'    => \$utemp,
	'reverse-rebuild|q' => \$reverse_rebuild,
);

if ($help) { show_usage(); exit 0 }
if ($vers) { show_version(); exit 0 }

lint_sbo_config($self, %config);

if (!@ARGV and not length $utemp and not $mass_rebuild) { show_usage(); exit 1 }
if (defined $utemp and not length $utemp) { show_usage(); exit 1 }
if (defined $ctemp and not length $ctemp) { show_usage(); exit 1 }

# invalid parameters may have been passed from the command line
if (defined $noclean) {
	usage_error("You have provided an invalid value for -c|--noclean")
		unless ($noclean =~ /^(TRUE|FALSE)$/);
}

if (defined $distclean) {
	usage_error("You have provided an invalid value for -d|--distclean")
		unless ($distclean =~ /^(TRUE|FALSE)$/);
}

if ($jobs) {
	usage_error("You have provided an invalid value for -j|--jobs")
		unless ($jobs =~ /^\d+$/ || $jobs eq 'FALSE');
}

$noclean = $noclean eq 'TRUE' ? 1 : 0;
$distclean = $distclean eq 'TRUE' ? 1 : 0;
$gpg = $gpg eq 'TRUE' ? 1 : 0;

if ($gpg) { verify_gpg(); }

if ($compat32) {
	usage_error("compat32 only works on x86_64.") unless get_arch eq 'x86_64';
	usage_error("compat32 is incompatible with mass-rebuild.") unless not $mass_rebuild;
	usage_error("compat32 is incompatible with reverse-rebuild.") unless not $reverse_rebuild;
}

if ($utemp and $mass_rebuild) {
	usage_error("mass-rebuild is incompatible with use-template.");
}

if ($no_reqs and $mass_rebuild) {
	usage_error("mass-rebuild is incompatible with norequirements.");
}

if ($reverse_rebuild and $mass_rebuild) {
	usage_error("mass-rebuild is incompatible with reverse_rebuild.");
}

if ($utemp and $reverse_rebuild) {
	usage_error("reverse-rebuild is incompatible with use-template.");
}

if ($no_reqs and $reverse_rebuild) {
	usage_error("reverse-rebuild is incompatible with norequirements.");
}

# if we can't find SLACKBUILDS.TXT in $config{HOME}, prompt to fetch the tree
slackbuilds_or_fetch();

my (%warnings, $build_queue, $template);

# if SBO_HOME/resume.temp exists, resume the mass rebuild
my $mtemp = "$config{SBO_HOME}/mass_rebuild.temp";
my $mtemp_resume = "$config{SBO_HOME}/resume.temp";
my $resume_mass_rebuild;
if ($mass_rebuild and -f $mtemp_resume) {
	$resume_mass_rebuild = 1;
	$utemp = $mtemp_resume;
}
$reinstall = 1 if $mass_rebuild or $reverse_rebuild;

if (length $utemp) {
	my $json = JSON::PP->new->latin1;
	$non_int = 1;

	my $data = slurp($utemp);
	if (length $data) {
		eval { $template = $json->decode($data); };
	}
	do { warn "Could not read template from $utemp.\n"; exit _ERR_OPENFH } if not defined $template;

	$build_queue = $template->{build_queue};
} elsif (not $mass_rebuild) {
	if (not $reverse_rebuild and ($no_reqs or $non_int)) {
		$build_queue = \@ARGV;
	} elsif ($reverse_rebuild) {
		my @all_installed = @{ get_installed_packages('ALL') };
		my $all_installed = +{ map {; $_->{name}, $_->{pkg} } @all_installed };
		my @namelist;
		for my $item (@all_installed) { push @namelist, $item->{name}; }

		my @installed = @{ get_installed_packages('SBO') };
		my $installed = +{ map {; $_->{name}, $_->{pkg} } @installed };
		my $fulldeps = get_reverse_reqs($installed);
		my @list;
		REVERSE: for my $sbo (@ARGV) {
			# ensure that targeted scripts do not depend on each other
			my $check_queue = get_build_queue([$sbo], \%warnings);
			@$check_queue = grep { !/^$sbo$/ } @$check_queue;
			for my $sbo2 (@ARGV) { next REVERSE if grep { /^$sbo2$/ } @$check_queue; }

			my $interim_queue;
			my @full_reverse = get_full_reverse($sbo, $installed, $fulldeps, @list);
			if (@full_reverse) {
				for my $revdep (@full_reverse) {
					my $queue = get_build_queue([$revdep], \%warnings);
					# for items not in the reverse queue, install only if missing
					for my $cand (@$queue) {
						if (grep { /^$cand$/ } @full_reverse or not grep { /^$cand$/ } @namelist) {
							push @$interim_queue, $cand;
						}
					}
				}
				@$interim_queue = grep { !/^$sbo$/ } @$interim_queue;
			}
			$build_queue = merge_queues($build_queue, $interim_queue) if $interim_queue;
		}
		exit 0 unless $build_queue;
	} else {
		for my $sbo (@ARGV) {
			my $queue = get_build_queue([$sbo], \%warnings);
			$build_queue = merge_queues($build_queue, $queue);
		}
	}
}

# get lists of installed packages and perl modules from CPAN
my $inst_pkgs = get_installed_packages('ALL');
my $std_pkgs = get_installed_packages('STD');
my $pms = get_installed_cpans();
s/::/-/g for @$pms;
my (%inst_names, %std_names);
$inst_names{$_->{name}} = $_ for @$inst_pkgs;
$std_names{$_->{name}} = $_ for @$std_pkgs;

# prepare a queue in case of mass_rebuild
if ($mass_rebuild and not $resume_mass_rebuild) {
	my $inst_sbos = get_installed_packages('SBO');
	my %sbos_names;
	$sbos_names{$_->{name}} = $_ for @$inst_sbos;
	for my $sbo (%sbos_names) {
		my $name = $sbos_names{$sbo}{name};
		next if not $name;
		# mass_rebuild does not handle -compat32 builds
		$name =~ s/-compat32$//;
		my $queue = get_build_queue([$name], \%warnings);
		$build_queue = merge_queues($build_queue, $queue);
	}
}

# populate %locations and sanity check
my %locations = get_sbo_locations($build_queue);
for my $sbo (@$build_queue) {
	# Fall-backs for compat32 and templates.
	if ($compat32 and not $locations{$sbo}) {
		$locations{$sbo} = get_sbo_location($sbo);
	}
	if ($utemp and not $locations{$sbo}) {
		$locations{$sbo} = get_sbo_location($sbo);
	}
	next if $inst_names{$sbo};

	if (not $locations{$sbo} and in(@ARGV, $sbo)) {
		usage_error("Unable to locate $sbo in the SlackBuilds.org tree.")
	}
	if ($compat32) {
		usage_error("-p|--compat32 is not supported with Perl SBos.")
			if $locations{$sbo} =~ qr|/perl/[^/]+$|;
	}
}

# check for already-installeds and prompt for the rest
my (@temp_queue, %commands, %options);
if (defined $template) {
	%commands = %{ $template->{commands} };
	%options = %{ $template->{options} };
}
my $added = ' added to install queue.';
FIRST: for my $sbo (@$build_queue) {
	my $name = $compat32 ? "$sbo-compat32" : $sbo;

	if ($inst_names{$name}) {
		my $inst_msg = sprintf "%s (%s) is already installed.", $name, $inst_names{$name}{pkg};
		# Regardless of nointeractive or anything else, always
		# warn with default "no" for reinstall if the package is
		# installed non-SBo and it exists in the tree.
		if ($reinstall and $std_names{$name} and not (defined $warnings{$sbo} and $warnings{$sbo} eq 'nonexistent')) {
			next FIRST unless prompt("$inst_msg\nWarning: $name is not an SBo package. Reinstall from SBo anyway?", default => 'no');
		} elsif ($reinstall and not $non_int) {
			if ($mass_rebuild or $reverse_rebuild) {
				next FIRST unless prompt("$inst_msg Do you want to reinstall from SBo?", default => 'yes');
			} else {
				next FIRST unless prompt("$inst_msg Do you want to reinstall from SBo?", default => 'no');
			}
		} elsif ($reinstall) {
			say "$inst_msg Reinstalling.";
		} else {
			say $inst_msg;
			next FIRST;
		}
	} else {
		if ($sbo =~ /^perl-/) {
			my $pm_name = $sbo;
			$pm_name =~ s/^perl-//;
			for my $pm (@$pms) {
				if ($pm =~ /^$pm_name$/i) {
					say "$sbo installed via the cpan.";
					next FIRST;
				}
			}
		}
	}

	# Make sure the slackbuild exists on SBo
	if (defined $warnings{$sbo} and $warnings{$sbo} eq 'nonexistent') {
		wrapsay "Unable to locate $sbo in the SlackBuilds.org tree.";
		if (not $non_int) {
			exit 0 unless prompt "Do you want to ignore it and continue?", default => 'yes';
		}
		next FIRST;
	}

	$locations{$name} = get_sbo_location($sbo) if $compat32;
	unless ($non_int) {
		# if compat32 is TRUE, we need to see if the non-compat version exists.
		if ($compat32) {
			unless ($inst_names{$sbo}) {
				say "$name requires $sbo.";
				my ($cmds, $opts, $exit) = user_prompt($sbo, $locations{$sbo});
				if ($exit) {
					warn "Unable to open README for $sbo.\n";
					exit $exit;
				}
				if ($cmds) {
					next FIRST if $cmds eq 'N';
				}
				push(@temp_queue, $sbo);
				$commands{$sbo} = $cmds;
				$options{$sbo} = $opts;
				say "$sbo$added";
			}
		}
		my ($cmds, $opts, $exit) = user_prompt($name, $locations{$name});
		if ($exit) {
			warn "Unable to open README for $name.\n";
			exit $exit;
		}
		if ($cmds) {
			next FIRST if $cmds eq 'N';
		}
		push(@temp_queue, $name);
		$commands{$sbo} = $cmds;
		$options{$sbo} = $opts;
		say "$name$added";
	} else {
		if ($reverse_rebuild or ($mass_rebuild and not $resume_mass_rebuild)) {
			my $opts_log = "/var/log/sbotools/$sbo";
			if (-f $opts_log) {
				my ($prev_fh, $exit) = open_fh($opts_log, '<');
				if ($exit) {
					warn $prev_fh;
				} else {
					my $opts = <$prev_fh>;
					$options{$sbo} = $opts;
				}
			}
		}
		push(@temp_queue, $sbo);
		say "\n$name$added";
	}
}
@$build_queue = @temp_queue;

exit 0 if @{ $build_queue } == 0;
wrapsay "\nInstall queue: " . join(' ', @$build_queue);
unless ($non_int) {
    exit 0 unless prompt("\nAre you sure you wish to continue?", default => 'yes');
}

if (defined $ctemp or $mass_rebuild) {
	$ctemp = $mtemp unless defined $ctemp;
	my ($temp_fh, $exit) = open_fh($ctemp, '>');
	do { warn $temp_fh; exit $exit } if $exit;

	my $json = JSON::PP->new->latin1->pretty->canonical;
	my $build_settings = {
		build_queue => $build_queue,
		commands    => \%commands,
		options     => \%options,
	};
	print {$temp_fh} $json->encode( $build_settings );
	close $temp_fh;
	if ($ctemp ne $mtemp and $mass_rebuild) {
		my ($m_fh, $exit_m) = open_fh($mtemp, '>');
		print {$m_fh} $json->encode( $build_settings );
		close $m_fh;
	}
	print "\nTemplate $ctemp saved.\n";
}

my ($failures, $exit) = process_sbos(
	TODO      => $build_queue,
	CMDS      => \%commands,
	OPTS      => \%options,
	JOBS      => $jobs,
	LOCATIONS => \%locations,
	NOINSTALL => $no_install,
	NOCLEAN   => $noclean,
	DISTCLEAN => $distclean,
	NON_INT   => $non_int,
	MASS      => $mass_rebuild,
);
print_failures($failures);

unlink $mtemp if -f $mtemp;
if ($exit) {
	exit $exit;
} else {
	exit 0;
}