#!/usr/bin/env perl # # vim: set ts=4:noet # # sboupgrade # script to update an installed SlackBuild. # # author: Jacob Pipkin # date: Boomtime, the 39th day of Discord in the YOLD 3178 # license: WTFPL use 5.16.0; use strict; use warnings FATAL => 'all'; use SBO::Lib; use File::Basename; use Getopt::Std; use File::Copy; my $self = basename ($0); sub show_usage () { print < $location, GET => 'REQUIRES'); return unless $$requires[0]; # do nothing if a req list contains %README% return if '%README%' ~~ @$requires; # do nothing if there's a circular requirement FIRST: for my $req (@$requires) { my $req_req = get_from_info (LOCATION => get_sbo_location $req, GET => 'REQUIRES'); return if $sbo ~~ @$req_req; } return $requires; } # ask to install any requirements found sub ask_requires (%) { my %args = ( REQUIRES => '', README => '', SBO => '', @_ ); unless ($args{REQUIRES} && $args{README} && $args{SBO}) { script_error 'ask_requires requires three arguments.'; } FIRST: for my $req (@{$args{REQUIRES}}) { my $name = $compat32 ? "$req-compat32" : $req; my $inst = get_installed_sbos; my $inst_names = get_inst_names $inst; next FIRST if $name ~~ @$inst_names; say $args{README}; say "$args{SBO} has $name listed as a requirement."; print "Shall I attempt to install it first? [y] "; if ( =~ /^[Yy\n]/) { my @cmd_args = ('/usr/sbin/sboupgrade', '-oN'); # populate args so that they carry over correctly for my $arg (qw(c d p)) { push @cmd_args, "-$arg" if exists $options{$arg}; } push @cmd_args, "-j $options{j}" if exists $options{j}; system (@cmd_args, $req) == 0 or die "$name failed to install.\n"; } } return; } # look for any (user|group)add commands in the README sub get_user_group ($) { exists $_[0] or script_error 'get_user_group requires an argument'; my $readme = shift; my @cmds = $readme =~ /^\s*#*\s*(useradd.*|groupadd.*)/mg; return \@cmds; } # offer to run any user/group add commands sub ask_user_group ($$) { exists $_[1] or script_error 'ask_user_group requires two arguments'; my ($cmds, $readme) = @_; say "\n". $readme; print "\nIt looks like this slackbuild requires the following"; say " command(s) to be run first:"; say " # $_" for @$cmds; print "Shall I run it/them now? [y] "; if ( =~ /^[Yy\n]/) { for my $cmd (@$cmds) { system ($cmd) == 0 or warn "\"$cmd\" exited non-zero\n"; } } } # see if the README mentions any options sub get_opts ($) { exists $_[0] or script_error 'get_opts requires an argument'; my $readme = shift; return $readme =~ /[A-Z]+=[^\s]/ ? 1 : undef; } # provide an opportunity to set options sub ask_opts ($) { exists $_[0] or script_error 'ask_opts requires an argument'; my $readme = shift; say "\n". $readme; print "\nIt looks this slackbuilds has options; would you like to set any"; print " when the slackbuild is run? [n] "; if ( =~ /^[Yy]/) { my $ask = sub () { print "\nPlease supply any options here, or enter to skip: "; chomp (my $opts = ); return if $opts =~ /^$/; return $opts; }; my $kv_regex = qr/[A-Z]+=[^\s]+(|\s([A-Z]+=[^\s]+){0,})/; my $opts = &$ask; FIRST: while ($opts !~ $kv_regex) { warn "Invalid input received.\n"; $opts = &$ask; } return $opts; } return; } # prompt for the readme sub readme_prompt ($$) { exists $_[0] or script_error 'readme_prompt requires an argument.'; my ($sbo, $location) = @_; my $fh = open_read (get_readme_path $sbo); my $readme = do {local $/; <$fh>}; close $fh; # check for requirements, offer to install any found my $requires = get_requires $sbo, $location; ask_requires (REQUIRES => $requires, README => $readme, SBO => $sbo) if ref $requires eq 'ARRAY'; # check for user/group add commands, offer to run any found my $user_group = get_user_group $readme; ask_user_group $user_group, $readme if $$user_group[0]; # check for options mentioned in the README my $opts; $opts = ask_opts $readme if get_opts $readme; print "\n". $readme unless $opts; # present the name as -compat32 if appropriate my $name = $compat32 ? "$sbo-compat32" : $sbo; print "\nProceed with $name? [y]: "; exit 0 unless =~ /^[Yy\n]/; return $opts; } # do the things with the provided sbos - whether upgrades or new installs. sub process_sbos ($) { exists $_[0] or script_error 'process_sbos requires an argument.'; my $todo = shift; my %failures; FIRST: for my $sbo (@$todo) { my $opts = 0; $opts = readme_prompt $sbo, $locations{$sbo} unless $no_readme; # switch compat32 on if upgrading a -compat32 $compat32 = 1 if $sbo =~ /-compat32$/; my ($version, $pkg, $src); eval { ($version, $pkg, $src) = do_slackbuild ( OPTS => $opts, JOBS => $jobs, LOCATION => $locations{$sbo}, COMPAT32 => $compat32, ); }; if ($@) { $failures{$sbo} = $@; } else { do_upgradepkg $pkg unless $no_install; unless ($distclean eq 'TRUE') { make_clean (SBO => $sbo, SRC => $src, VERSION => $version) unless $noclean eq 'TRUE'; } else { make_distclean ( SBO => $sbo, SRC => $src, VERSION => $version, LOCATION => $locations{$sbo}, ); } # move package to $config{PKG_DIR} if defined unless ($config{PKG_DIR} eq 'FALSE') { my $dir = $config{PKG_DIR}; unless (-d $dir) { mkdir ($dir) or warn "Unable to create $dir\n"; } if (-d $dir) { move ($pkg, $dir), say "$pkg stored in $dir"; } else { warn "$pkg left in /tmp\n"; } } elsif ($distclean eq 'TRUE') { unlink $pkg; } } } return %failures; } sub print_failures (;%) { if (exists $_[0]) { my %failures = @_; say "Failures:"; while (my ($key, $val) = each %failures) { say " $key: $val"; } exit 1; } } # deal with any updates prior to any new installs. # no reason to bother if only_new is specified, ie running from sboinstall. goto INSTALL_NEW if $only_new; # doesn't matter what's updatable and what's not if force is specified my @updates unless $force; unless ($force) { my $updates = get_available_updates; push @updates, $$_{name} for @$updates; } my $todo_upgrade; # but without force, we only want to update what there are updates for unless ($force) { for my $sbo (@ARGV) { push @$todo_upgrade, $sbo if $sbo ~~ @updates; } } else { my $inst = get_installed_sbos; my $inst_names = get_inst_names $inst; FIRST: for my $sbo (@ARGV) { push @$todo_upgrade, $sbo if $sbo ~~ @$inst_names; } } my %failures = process_sbos $todo_upgrade if exists $$todo_upgrade[0]; print_failures %failures; INSTALL_NEW: exit 0 unless $install_new; my $todo_install; FIRST: for my $sbo (@ARGV) { my $name = $compat32 ? "$sbo-compat32" : $sbo; my $inst = get_installed_sbos; my $inst_names = get_inst_names $inst;; warn "$name already installed\n", next FIRST if $name ~~ @$inst_names; # if compat32 is TRUE, we need to see if the non-compat version exists. if ($compat32) { my $inst = get_installed_sbos; my $inst_names = get_inst_names $inst; unless ($sbo ~~ @$inst_names) { print "\nYou are attempting to install $name, however, $sbo is not"; print " yet installed. Shall I install it first? [y] "; if ( =~ /^[Yy\n]/) { my @args = ('/usr/sbin/sboupgrade', '-oN', $sbo); # populate args so that they carry over correctly for my $arg (qw(c d)) { push @args, "-$arg" if exists $options{$arg}; } push @args, "-j $options{j}" if exists $options{j}; system (@args) == 0 or die "$sbo failed to install.\n"; } else { warn "Please install $sbo\n" and exit 0; } } } push @$todo_install, $sbo; } %failures = process_sbos $todo_install if exists $$todo_install[0]; print_failures %failures; exit 0;