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 :const :colors auto_reverse check_x32 check_x64 check_multilib error_code get_build_queue get_full_reverse get_full_reverse_queue get_installed_cpans get_installed_packages get_orig_location get_reverse_reqs get_readme_contents get_requires get_sbo_location get_sbo_locations get_user_group in ineligible_compat is_obsolete merge_queues on_blacklist open_fh print_failures process_sbos prompt rationalize_queue show_version slackbuilds_or_fetch slurp uniq usage_error user_group_do_not_exist user_prompt verify_gpg lint_sbo_config wrapsay %concluded %warnings /;
use Getopt::Long qw(:config bundling);
use File::Basename;
use File::Copy;
use JSON::PP;

use sigtrap qw/ handler _caught_signal ABRT INT QUIT TERM /;

my $self = basename($0);

sub show_usage {
	print <<"EOF";
Usage: $self (options) sbo ...
       $self --use-template file
       $self --mass-rebuild

Options (defaults shown first where applicable):
  -h|--help:
    this screen.
  -v|--version:
    version information.
  --(no)color:
    (do not) use sbotools color output.
  --(no)wrap:
    (do not) wrap sbotools output.
  -c|--noclean (FALSE|TRUE):
    if TRUE, do not clean working directories after building.
  -D|--dry-run:
    show the potential queue and exit
  -d|--distclean (FALSE|TRUE):
    if TRUE, delete downloaded source archives and the completed package.
  -e|--etc-profile (FALSE|TRUE):
    if TRUE, source executable *.sh scripts in /etc/profile.d.
  -i|--noinstall:
    do not run installpkg after building.
  -j|--jobs (FALSE|#):
    specify the number of parallel jobs (make).
  -o|--norecall:
    do not use saved build options with nointeractive.
  -k|--pkg-dir (FALSE|/path):
    set to an absolute path to save compiled packages here, or to FALSE.
  -L|--log-dir (FALSE|/path):
    set to an absolute path to save build logs here, or to FALSE.
  -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.
  -t|--template-only (FILE):
    create a template, but do not download or install anything.
  --batch:
    like nointeractive, but calculates dependencies (use with caution).
  --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.
  --series-rebuild (SERIES):
    rebuild all installed SlackBuilds in one or more series (comma-separated).
EOF
	return 1;
}

my ($help, $vers, $no_install, $no_recall, $non_int, $no_reqs, $compat32, $ctemp, $utemp, $reinstall, $mass_rebuild, $reverse_rebuild, $yes_really, $dry_run, $noclean, $distclean, $pkg_dir, $log_dir, $etc_profile, $gpg, $series_rebuild, $jobs, $nocolor, $color, $wrap, $nowrap, $ctemp_only);

my $options_ok = GetOptions(
	'help|h'            => \$help,
	'version|v'         => \$vers,
	'noclean|c=s'       => \$noclean,
	'distclean|d=s'     => \$distclean,
	'noinstall|i'       => \$no_install,
	'jobs|j=s'          => \$jobs,
	'norecall|o'        => \$no_recall,
	'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,
	'batch'             => \$yes_really,
	'dry-run|D'         => \$dry_run,
	'etc-profile|e=s'   => \$etc_profile,
	'pkg-dir|k=s'       => \$pkg_dir,
	'log-dir|L=s'       => \$log_dir,
	'series-rebuild=s'  => \$series_rebuild,
	'nocolor'           => \$nocolor,
	'color'             => \$color,
	'nowrap'            => \$nowrap,
	'wrap'              => \$wrap,
	'template-only|t=s' => \$ctemp_only,
);

if ($help) {
	show_usage();
	wrapsay "\nNon-root users can call $self with -D, -t, -v and -h." unless $< == 0;
	exit 0;
}
if ($vers) { show_version(); exit 0; }
$config{COLOR} = $color ? 'TRUE' : 'FALSE' if $color xor $nocolor;
$config{NOWRAP} = $nowrap ? 'TRUE' : 'FALSE' if $wrap xor $nowrap;
unless ($< == 0 or $dry_run or $ctemp_only) {
	show_usage();
	usage_error "\nNon-root users can call $self with -D, -t, -v and -h.";
}
unless ($options_ok) {
	show_usage();
	usage_error "\nOne or more invalid options detected.";
}

$config{NOCLEAN} = $noclean if $noclean;
$config{DISTCLEAN} = $distclean if $distclean;
$config{GPG_VERIFY} = $gpg if $gpg;
$config{ETC_PROFILE} = $etc_profile if $etc_profile;
$config{PKG_DIR} = $pkg_dir if $pkg_dir;
$config{LOG_DIR} = $log_dir if $log_dir;
$config{JOBS} = $jobs if $jobs;

lint_sbo_config($self, %config);

if (!@ARGV and not length $utemp and not $mass_rebuild and not $series_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 }

# warn about missing local overrides directory (stop the show if --batch
# or --nointeractive))
if ($config{LOCAL_OVERRIDES} ne "FALSE" and not -d $config{LOCAL_OVERRIDES}) {
	usage_error "$config{LOCAL_OVERRIDES} is specified as the overrides directory, but does not exist. Exiting." if $yes_really or $non_int;
	if ($dry_run) {
		wrapsay_color $color_lesser, "$config{LOCAL_OVERRIDES} is specified as the overrides directory, but does not exist.";
	} else {
		unless (prompt($color_lesser, "$config{LOCAL_OVERRIDES} is specified as the overrides directory, but does not exist.\nContinue anyway?", default => 'no')) {
			exit 1;
		}
	}
}

my $skip_gpg = ($< != 0 and ($dry_run or $ctemp_only));
if ($config{GPG_VERIFY} eq "TRUE" and not $skip_gpg) { verify_gpg(); }

if ($compat32) {
	usage_error("compat32 only works on x86_64.") unless $arch eq 'x86_64';
	usage_error("compat32 is incompatible with mass-rebuild.") if $mass_rebuild;
	usage_error("compat32 is incompatible with series-rebuild.") if $series_rebuild;
	usage_error("compat32 is incompatible with use-template.") if $utemp;
}

usage_error("template-only is incompatible with create-template.") if $ctemp_only and $ctemp;
usage_error("mass-rebuild is incompatible with use-template.") if $utemp and $mass_rebuild;
usage_error("mass-rebuild is incompatible with norequirements.") if $no_reqs and $mass_rebuild;
usage_error("mass-rebuild is incompatible with reverse_rebuild.") if $reverse_rebuild and $mass_rebuild;
usage_error("series-rebuild is incompatible with use-template.") if $utemp and $series_rebuild;
usage_error("series-rebuild is incompatible with norequirements.") if $no_reqs and $series_rebuild;
usage_error("reverse-rebuild is incompatible with use-template.") if $utemp and $reverse_rebuild;
usage_error("reverse-rebuild is incompatible with norequirements.") if $no_reqs and $reverse_rebuild;
usage_error("mass-rebuild is incompatible with series-rebuild.") if $series_rebuild and $mass_rebuild;

my $true_non_int = $non_int;
$yes_really = 1 if $dry_run;
$non_int = 1 if $yes_really;
$ctemp = $ctemp_only if $ctemp_only;

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

# 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;
}
my $requested_reinstall = 1 if $reinstall;
$reinstall = 1 if $mass_rebuild or $reverse_rebuild or $series_rebuild;

my @sbos;
my %locations = get_sbo_locations();

# if a requested compat32 script is ineligible anyway,
# do not bother with its dependencies, etc.
#
# also check here for incompatible architecture
if (@ARGV) {
	for my $sbo (@ARGV) {
		my $sbo_location = get_sbo_location($sbo);
		unless ($sbo_location) {
			wrapsay_color $color_lesser, "$sbo not found; skipping.";
			next;
		}
		if ($compat32 or $sbo =~ /-compat32$/) {
			if (my $msg = ineligible_compat $sbo_location) {
				wrapsay_color $color_lesser, $msg;
				next;
			}
		} elsif ($arch !~ /64/) {
			if (check_x64 $sbo_location) {
				wrapsay_color $color_lesser, "$sbo is 64-bit only; skipping.";
				next;
			}
		} elsif ($arch =~ /64/ and not check_multilib()) {
			if (check_x32 $sbo_location) {
				wrapsay_color $color_lesser, "$sbo is 32-bit only; skipping.";
				next;
			}
		}
		push @sbos, $sbo;
	}
}
exit 0 if (@ARGV and not @sbos);
@sbos = uniq @sbos;

if ($compat32) {
	for my $sbo (@sbos) { $sbo = "$sbo-compat32" unless $sbo =~ /-compat32$/; }
}

# 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, $defective);
unless ($config{CPAN_IGNORE} eq "TRUE") {
	($pms, $defective) = get_installed_cpans();
	s/::/-/g for @$pms;
	s/::/-/g for @$defective;
}
my (%inst_names, %std_names);
$inst_names{$_->{name}} = $_ for @$inst_pkgs;
$std_names{$_->{name}} = $_ for @$std_pkgs;

my ($build_queue, $template, $needs_rationalize, @needs_reverse);

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 { error_code("Could not read template from $utemp.", _ERR_OPENFH); } unless defined $template;

	for my $cand (@{ $template->{build_queue} }) {
		unless (on_blacklist($cand)) {
			push @$build_queue, $cand;
		} else {
			wrapsay "$cand is blacklisted. Skipping.";
		}
	}
	unless ($mass_rebuild or $no_install) {
		if ($requested_reinstall) {
			my $extra_queue;
			for my $cand (@$build_queue) {
				if (auto_reverse($cand)) {
					push @needs_reverse, $cand;
					wrapsay_color $color_notice, "Reverse dependency rebuild for $cand." unless $cand =~ m/-compat32/ and not $compat32;
				}
			}
		}
	}
# the --mass-rebuild queue is handled later
} elsif (not $mass_rebuild and not $series_rebuild) {
	# noninteractive and no requirements
	if (not $reverse_rebuild and ($no_reqs or $true_non_int)) {
		my $interim_queue = \@sbos;
		for my $cand (@$interim_queue) {
			unless (on_blacklist($cand)) {
				push @$build_queue, $cand;
			} else {
				wrapsay "$cand is blacklisted. Skipping.";
			}
		}
	} elsif ($reverse_rebuild) {
		$build_queue = get_full_reverse_queue($self, $requested_reinstall ? 1 : 0, @sbos);
		exit 0 unless $build_queue;
	} else {
		for my $sbo (@sbos) {
			my $extra_queue;
			my $queue = get_build_queue([$sbo]);
			$build_queue = merge_queues($build_queue, $queue);
		}
	}
}

# --reinstall, no --reverse-rebuild: trigger automatic rebuilds
if ($requested_reinstall and not $reverse_rebuild and not $mass_rebuild and not $utemp and not $series_rebuild) {
	for my $sbo (@$build_queue) {
		if (auto_reverse($sbo)) {
			push @needs_reverse, $sbo;
			wrapsay_color $color_notice, "Reverse dependency rebuild for $sbo." unless $sbo =~ m/-compat32/ and not $compat32;
		}
	}
}

# prepare a queue in case of mass_rebuild or series_rebuild
if ($series_rebuild or ($mass_rebuild and not $resume_mass_rebuild)) {
	$needs_rationalize = 1;
	my @series_rebuild = split ",", $series_rebuild if $series_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 unless $name;
		if (@series_rebuild) {
			my $location = get_sbo_location($sbo);
			my $check_location = get_orig_location($sbo);
			$location = $check_location if $check_location;
			my $series = basename(dirname($location));
			next unless in $series, @series_rebuild;
		}
		my $queue = get_build_queue([$name]);
		$build_queue = merge_queues($build_queue, $queue);
		push @needs_reverse, $sbo if $series_rebuild and ($reverse_rebuild or auto_reverse($sbo));
	}
	unless ($build_queue) {
		usage_error("No SBo packages are installed. Exiting.") if $mass_rebuild;
		usage_error("No SBo packages are installed from the $series_rebuild series. Exiting.");
	}
}

# Handle automatic reverse rebuilds now
if (@needs_reverse) {
	my $extra_queue = get_full_reverse_queue($self, $requested_reinstall ? 1 : 0, @needs_reverse);
	if ($extra_queue) {
		$needs_rationalize = 1;
		$build_queue = merge_queues($build_queue, $extra_queue);
	}
}

SANITY: for my $sbo (@$build_queue) {
	next SANITY if $inst_names{$sbo};

	if ($utemp and not defined get_sbo_location($sbo)) {
		usage_error("Unable to locate $sbo and using a template.");
	} elsif ($non_int and not $yes_really and not defined get_sbo_location($sbo) and in($sbo, @sbos)) {
		usage_error("Unable to locate $sbo and using nointeractive.")
	}
}

# check for already-installeds and prompt for the rest
my (@temp_queue, %commands, %options, %missing_user_group);
if (defined $template) {
	%commands = %{ $template->{commands} };
	%options = %{ $template->{options} };
}
my $added = $no_install ? ' added to build queue.' : ' added to install queue.';
my (@see_readme, %saved_options);
$build_queue = rationalize_queue($build_queue) if $needs_rationalize;
FIRST: for my $sbo (@$build_queue) {
	my $name = $sbo;
	if ($compat32) {
		next FIRST unless $utemp or $requested_reinstall or not $inst_names{$sbo} or $sbo =~ /-compat32$/;
	}
	$sbo =~ s/-compat32$//;
	if ($std_names{$name} and $non_int and not $no_install) {
		wrapsay "$name is not an SBo package. Skipping.";
		next FIRST;
	}
	$locations{$name} = get_sbo_location($sbo) unless $locations{$name};
	if ($name =~ /-compat32$/ and $locations{$name}) {
		my $compat_fail_msg = ineligible_compat($locations{$name});
		if ($compat_fail_msg) { wrapsay_color $color_lesser, $compat_fail_msg; next FIRST; }
	}

	if ($inst_names{$name}) {
		next FIRST if defined $warnings{$name} and $warnings{$name} eq 'nonexistent';
		my $inst_msg = sprintf "%s (%s) is already installed.", $name, $inst_names{$name}{pkg};
		$inst_msg = $config{CLASSIC} eq 'TRUE' ? $inst_msg : $inst_msg. "\n  ($inst_names{$name}{created})";
		say $inst_msg;
		# 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 $no_install) {
			next FIRST unless prompt($color_warn, "Warning: $name is not an SBo package. Reinstall from SBo anyway?", default => 'no');
		} elsif ($reinstall and not $non_int and not $no_install) {
			my $default = ($mass_rebuild or $reverse_rebuild or $series_rebuild) ? "yes" : "no";
			next FIRST unless prompt($color_notice, "Do you want to reinstall from SBo?", default => $default);
		} elsif ($reinstall) {
			unless ($no_install) {
				say "Reinstalling." unless $dry_run;
			} else {
				say "Building, but not installing." unless $dry_run;
			}
		} else {
			next FIRST;
		}
	} else {
		if ($sbo =~ /^perl-/ and $config{CPAN_IGNORE} ne "TRUE") {
			my $pm_name = $sbo;
			$pm_name =~ s/^perl-//;
			for my $pm (@$pms) {
				if ($pm =~ /^$pm_name$/i) {
					say "$sbo installed via the CPAN.";
					unless ($no_install) {
						next FIRST;
					} else {
						say "Building, but not installing." unless $dry_run;
					}
				}
			}
			for my $pm (@$defective) {
				if ($pm =~ /^$pm_name$/i) {
					wrapsay "$sbo installed via the CPAN, but file(s) missing.";
				}
			}
		}
	}

	# Make sure the slackbuild exists on SBo
	if (defined $warnings{$name} and $warnings{$name} eq 'nonexistent') {
		next FIRST if is_obsolete($sbo);
		unless ($inst_names{$name}) {
			wrapsay "Unable to locate $name in the SlackBuilds.org tree.";
			unless ($non_int) {
				exit 0 unless prompt($color_default, "Do you want to ignore it and continue?", default => 'yes');
			}
		}
		next FIRST;
	}
	# will give %README% advisories later for --dry-run
	push @see_readme, $sbo if defined $warnings{$name} and $warnings{$name} eq '%README%';

	unless ($non_int) {
		my ($proceed, $cmds, $opts) = user_prompt($name, $locations{$name});
		next FIRST unless $proceed;
		push(@temp_queue, $name);
		$commands{$name} = $cmds;
		$options{$name} = $opts;
		say "$name$added";
	} else {
		unless ($utemp) {
			# for --batch, check for existing user and group, exiting
			# with a message if not; notify with --dry-run
			if ($yes_really) {
				my $cmds;
				if ($no_recall) {
					$cmds = get_user_group($sbo, $locations{$sbo});
				} else {
					if (-s "/var/log/sbotools/$sbo") {
						chomp(my $saved_opts = slurp "/var/log/sbotools/$sbo");
						$cmds = get_user_group($sbo, $locations{$sbo}, $saved_opts);
					} else {
						$cmds = get_user_group($sbo, $locations{$sbo});
					}
				}
				if ($$cmds[0]) {
					my $nonexistent = user_group_do_not_exist(@$cmds);
					if (@$nonexistent) {
						if ($dry_run) {
							$missing_user_group{$sbo} = $nonexistent;
						} else {
							wrapsay_color $color_warn, "A required user or group is missing for $sbo:", 1;
							for my $cmd (@$nonexistent) { say $cmd; }
							say "";
							error_code("Run the command(s) to install $sbo with --batch.", _ERR_USR_GRP);
						}
					}
				}
			}
			# if nointeractive or batch, use saved build options unless reading a template
			# or passing norecall
			unless ($no_recall) {
				my $opts_log = "/var/log/sbotools/$sbo";
				if (-f $opts_log) {
					my ($prev_fh, $exit) = open_fh($opts_log, '<');
					if ($exit) {
						warn_color $color_lesser, $prev_fh;
					} else {
						chomp(my $opts = <$prev_fh>);
						$saved_options{$name} = $opts if $dry_run;
						$options{$name} = $opts;
					}
				}
			}
		}
		push(@temp_queue, $name);
		say "\n$name$added" unless $dry_run;
	}
}
@$build_queue = @temp_queue;

exit 0 if (@{ $build_queue } == 0);
if ($dry_run) {
	if (@see_readme) {
		wrapsay_color $color_lesser, "\nSee README for:";
		for my $item (@see_readme) { say "  $item"; }
	}
	if (%saved_options) {
		wrapsay_color $color_notice, "\nSaved build options to be used:";
		for my $item (keys %saved_options) { say "  $item: $saved_options{$item}"; }
	}
}
unless ($no_install) {
	wrapsay "\nInstall queue: " . join(' ', @$build_queue);
} else {
	wrapsay "\nBuild queue: " . join(' ', @$build_queue);
}
unless ($non_int) {
	wrapsay_color $color_notice, "\n--noinstall (-i) is in use; built packages will not be installed." if $no_install;
	unless (prompt($color_notice, "\nAre you sure you wish to continue?", default => 'yes')) {
		exit 0;
	}
}
if ($dry_run) {
	wrapsay_color $color_notice, "\n--noinstall (-i) is in use; built packages will not be installed." if $no_install;
	my $usr_grp_missing;
	if (%missing_user_group) {
		for my $item (keys %missing_user_group) {
			wrapsay_color $color_lesser, "\nA required user or group is missing for $item:", 1;
			for my $cmd (@{ $missing_user_group{$item} }) { say $cmd; }
			say "";
			wrapsay_color $color_lesser, "Run the command(s) to install $item with --batch.";
			$usr_grp_missing = 1;
		}
	}
	exit _ERR_USR_GRP if $usr_grp_missing;
	exit 0;
}

if (defined $ctemp or $mass_rebuild) {
	$ctemp = $mtemp unless defined $ctemp;
	my ($temp_fh, $exit) = open_fh($ctemp, '>');
	error_code("Failed to open $ctemp; exiting.", $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";
}
exit 0 if $ctemp_only;

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

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

sub _caught_signal {
	exit 0;
}

END { say ""; }