aboutsummaryrefslogtreecommitdiff
path: root/SBO-Lib/lib
diff options
context:
space:
mode:
Diffstat (limited to 'SBO-Lib/lib')
-rw-r--r--SBO-Lib/lib/SBO/Lib.pm288
1 files changed, 192 insertions, 96 deletions
diff --git a/SBO-Lib/lib/SBO/Lib.pm b/SBO-Lib/lib/SBO/Lib.pm
index c138846..8e2ea2c 100644
--- a/SBO-Lib/lib/SBO/Lib.pm
+++ b/SBO-Lib/lib/SBO/Lib.pm
@@ -13,7 +13,6 @@ use 5.16.0;
use strict;
use warnings FATAL => 'all';
-
package SBO::Lib;
our $VERSION = '1.4';
@@ -58,7 +57,24 @@ our @EXPORT = qw(
%config
);
-$< == 0 or die "This script requires root privileges.\n";
+use constant {
+ _ERR_USAGE => 1, # usage errors
+ _ERR_SCRIPT => 2, # errors with the scripts themselves
+ _ERR_BUILD => 3, # errors during the slackbuild process
+ _ERR_MD5SUM => 4, # md5sum verification
+ _ERR_DOWNLOAD => 5, # errors with downloading things
+ _ERR_OPENFH => 6, # opening file handles
+ _ERR_NOINFO => 7, # missing information
+ _ERR_F_SETFD => 8, # unsetting exec-on-close bit
+ _ERR_NOMULTILIB => 9, # lacking multilib where required
+ _ERR_CONVERTPKG => 10, # errors while running convertpkg-compat32
+ _ERR_NOCONVERTPKG => 11, # lacking convertpkg-compat32 where required
+};
+
+unless ($< == 0) {
+ warn "This script requires root privileges.\n";
+ exit _ERR_USAGE;
+}
use Tie::File;
use Sort::Versions;
@@ -70,11 +86,6 @@ use File::Find;
use File::Basename;
use Fcntl qw(F_SETFD F_GETFD);
-# define error statuses
-use constant {
- _ERR_USAGE => 1,
-};
-
our $tempdir = tempdir(CLEANUP => 1);
# define this to facilitate unit testing - should only ever be modified from
@@ -83,8 +94,9 @@ our $pkg_db = '/var/log/packages';
# subroutine for throwing internal script errors
sub script_error(;$) {
- exists $_[0] ? die "A fatal script error has occurred:\n$_[0]\nExiting.\n"
- : die "A fatal script error has occurred. Exiting.\n";
+ exists $_[0] ? warn "A fatal script error has occurred:\n$_[0]\nExiting.\n"
+ : warn "A fatal script error has occurred. Exiting.\n";
+ exit _ERR_SCRIPT;
}
# subroutine for usage errors
@@ -100,7 +112,12 @@ sub open_fh {
-f $_[0] or script_error "open_fh, $_[0] is not a file";
}
my ($file, $op) = @_;
- open my $fh, $op, $file or die "Unable to open $file.\n";
+ my $fh;
+ unless (open $fh, $op, $file) {
+ my $warn = "Unable to open $file.\n";
+ my $exit = _ERR_OPENFH;
+ return ($warn, $exit);
+ }
return $fh;
}
@@ -123,7 +140,12 @@ our %config = (
sub read_config() {
my %conf_values;
if (-f $conf_file) {
- my $fh = open_read $conf_file;
+ my ($fh, $exit) = open_read $conf_file;
+ if ($exit) {
+ warn $fh;
+ $config{SBO_HOME} = '/usr/sbo';
+ return;
+ }
my $text = do {local $/; <$fh>};
%conf_values = $text =~ /^(\w+)=(.*)$/mg;
close $fh;
@@ -153,11 +175,15 @@ sub show_version() {
# but it's already future-proofed, so leave it.
sub get_slack_version() {
my %supported = ('14.0' => '14.0');
- my $fh = open_read '/etc/slackware-version';
+ my ($fh, $exit) = open_read '/etc/slackware-version';
+ if ($exit) {
+ warn $fh;
+ exit $exit;
+ }
chomp(my $line = <$fh>);
close $fh;
my $version = ($line =~ /\s+(\d+[^\s]+)$/)[0];
- die "Unsupported Slackware version: $version\n"
+ usage_error "Unsupported Slackware version: $version\n"
unless $version ~~ %supported;
return $supported{$version};
}
@@ -174,10 +200,10 @@ sub check_home() {
opendir(my $home_handle, $sbo_home);
FIRST: while (readdir $home_handle) {
next FIRST if /^\.[\.]{0,1}$/;
- die "$sbo_home exists and is not empty. Exiting.\n";
+ usage_error "$sbo_home exists and is not empty. Exiting.\n";
}
} else {
- make_path($sbo_home) or die "Unable to create $sbo_home.\n";
+ make_path($sbo_home) or usage_error "Unable to create $sbo_home.\n";
}
return 1;
}
@@ -215,8 +241,12 @@ sub slackbuilds_or_fetch() {
unless (chk_slackbuilds_txt) {
say 'It looks like you haven\'t run "sbosnap fetch" yet.';
print 'Would you like me to do this now? [y] ';
- <STDIN> =~ /^[Yy\n]/ ? fetch_tree :
- die "Please run \"sbosnap fetch\"\n";
+ if (<STDIN> =~ /^[Yy\n]/) {
+ fetch_tree;
+ } else {
+ say 'Please run "sbosnap fetch"';
+ exit 0;
+ }
}
return 1;
}
@@ -269,7 +299,11 @@ sub get_sbo_location {
return $$store{$sbos[0]} if exists $$store{$sbos[0]};
}
my %locations;
- my $fh = open_read $slackbuilds_txt;
+ my ($fh, $exit) = open_read $slackbuilds_txt;
+ if ($exit) {
+ warn $fh;
+ exit $exit;
+ }
FIRST: for my $sbo (@sbos) {
$locations{$sbo} = $$store{$sbo}, next FIRST if exists $$store{$sbo};
my $regex = qr#LOCATION:\s+\.(/[^/]+/\Q$sbo\E)$#;
@@ -307,7 +341,8 @@ sub get_from_info {
my $sbo = get_sbo_from_loc $args{LOCATION};
return $$store{$args{GET}} if $$store{PRGNAM}[0] eq $sbo;
# if we're here, we haven't read in the .info file yet.
- my $fh = open_read "$args{LOCATION}/$sbo.info";
+ my ($fh, $exit) = open_read "$args{LOCATION}/$sbo.info";
+#TODO: do something with $exit from open_read
# suck it all in, clean it all up, stuff it all in $store.
my $contents = do {local $/; <$fh>};
$contents =~ s/("|\\\n)//g;
@@ -422,7 +457,8 @@ sub get_filename_from_link($) {
# for a given file, compute its md5sum
sub compute_md5sum($) {
-f $_[0] or script_error 'compute_md5sum requires a file argument.';
- my $fh = open_read shift;
+ my ($fh, $exit) = open_read shift;
+# TODO: do something with $exit
my $md5 = Digest::MD5->new;
$md5->addfile($fh);
my $md5sum = $md5->hexdigest;
@@ -450,11 +486,12 @@ sub get_distfile {
mkdir $distfiles unless -d $distfiles;
chdir $distfiles;
unlink $filename if -f $filename;
- system("wget --no-check-certificate $link") == 0 or
- die "Unable to wget $link\n";
+ if (system("wget --no-check-certificate $link") != 0) {
+ return "Unable to wget $link.\n", _ERR_DOWNLOAD;
+ }
# can't do anything if the link in the .info doesn't lead to a good d/l
- verify_distfile(@_) ? return 1 : die "md5sum failure for $filename.\n";
- return 1;
+ verify_distfile(@_) ? return 1 : return "md5sum failure for $filename.\n",
+ _ERR_MD5SUM;
}
# for a given distfile, figure out what the full path to its symlink will be
@@ -525,8 +562,10 @@ sub rewrite_slackbuild {
$args{SLACKBUILD} or script_error 'rewrite_slackbuild requires SLACKBUILD.';
my $slackbuild = $args{SLACKBUILD};
my $changes = $args{CHANGES};
- copy($slackbuild, "$slackbuild.orig") or
- die "Unable to backup $slackbuild to $slackbuild.orig\n";
+ unless (copy($slackbuild, "$slackbuild.orig")) {
+ return "Unable to backup $slackbuild to $slackbuild.orig\n",
+ _ERR_OPENFH;
+ }
my $libdir_regex = qr/^\s*LIBDIRSUFFIX="64"\s*$/;
my $arch_regex = qr/\$VERSION-\$ARCH-\$BUILD/;
my $dc_regex = qr/(?<![a-z])(tar|p7zip|unzip|ar|rpm2cpio|sh)\s+/;
@@ -592,10 +631,16 @@ sub check_distfiles {
LOCATION => $location,
32 => $args{COMPAT32}
);
- die "Unable to get download information from $location/$sbo.info.\n" unless
- keys %$downloads > 0;
+ # return an error if we're unable to get download info
+ unless (keys %$downloads > 0) {
+ return "Unable to get download info from $location/$sbo.info\n",
+ _ERR_NOINFO;
+ }
while (my ($link, $md5) = each %$downloads) {
- get_distfile($link, $md5) unless verify_distfile($link, $md5);
+ unless (verify_distfile($link, $md5)) {
+ my ($fail, $exit) = get_distfile($link, $md5);
+ return $fail, $exit if $exit;
+ }
}
my $symlinks = create_symlinks($args{LOCATION}, $downloads);
return $symlinks;
@@ -655,7 +700,9 @@ sub get_src_dir($) {
sub get_tmp_extfn($) {
exists $_[0] or script_error 'get_tmp_extfn requires an argument.';
my $fh = shift;
- fcntl($fh, F_SETFD, 0) or die "Can't unset exec-on-close bit\n";
+ unless (fcntl($fh, F_SETFD, 0)) {
+ return "Can't unset exec-on-close bit.\n", _ERR_F_SETFD;
+ }
return '/dev/fd/'. fileno $fh;
}
@@ -701,22 +748,31 @@ sub perform_sbo {
}
# get a tempfile to store the exit status of the slackbuild
my $exit_temp = tempfile(DIR => $tempdir);
- my $exit_fn = get_tmp_extfn $exit_temp;
+ my ($exit_fn, $exit) = get_tmp_extfn $exit_temp;
+ return $exit_fn, undef, $exit if $exit;
$cmd .= " /bin/sh $location/$sbo.SlackBuild; echo \$? > $exit_fn )";
my $tempfh = tempfile(DIR => $tempdir);
- my $fn = get_tmp_extfn $tempfh;
+ my $fn;
+ ($fn, $exit) = get_tmp_extfn $tempfh;
+ return $fn, undef, $exit if $exit;
$cmd .= " | tee -a $fn";
- rewrite_slackbuild(
+ # attempt to rewrite the slackbuild, or exit if we can't
+ my $fail;
+ ($fail, $exit) = rewrite_slackbuild(
SBO => $sbo,
SLACKBUILD => "$location/$sbo.SlackBuild",
CHANGES => \%changes,
C32 => $args{C32},
);
+ return $fail, undef, $exit if $exit;
+ # run the slackbuild, grab its exit status, revert our changes
chdir $location, system $cmd;
seek $exit_temp, 0, 0;
my $out = do {local $/; <$exit_temp>};
+ close $exit_temp;
revert_slackbuild "$location/$sbo.SlackBuild";
- die "$sbo.SlackBuild returned non-zero exit status\n" unless $out == 0;
+ # return error now if the slackbuild didn't exit 0
+ return "$sbo.SlackBuild return non-zero\n", undef, _ERR_BUILD if $out != 0;
my $pkg = get_pkg_name $tempfh;
my $src = get_src_dir $src_ls_fh;
return $pkg, $src;
@@ -729,8 +785,10 @@ sub do_convertpkg($) {
my $tempfh = tempfile(DIR => $tempdir);
my $fn = get_tmp_extfn $tempfh;
my $cmd = "/usr/sbin/convertpkg-compat32 -i $pkg -d /tmp | tee $fn";
- system($cmd) == 0 or
- die "convertpkg-compt32 returned non-zero exit status\n";
+ if (system($cmd) != 0) {
+ return "convertpkg-compt32 returned non-zero exit status\n",
+ _ERR_CONVERTPKG;
+ }
unlink $pkg;
return get_pkg_name $tempfh;
}
@@ -753,19 +811,26 @@ sub do_slackbuild {
my $x32;
# ensure x32 stuff is set correctly, or that we're setup for it
if ($args{COMPAT32}) {
- die "compat32 requires multilib.\n" unless $multilib;
- die "compat32 requires /usr/sbin/convertpkg-compat32.\n"
- unless -f '/usr/sbin/convertpkg-compat32';
+ unless ($multilib) {
+ return "compat32 requires multilib.\n", (undef) x 2,
+ _ERR_NOMULTILIB;
+ }
+ unless (-f '/usr/sbin/convertpkg-compat32') {
+ return "compat32 requires /usr/sbin/convertpkg-compat32.\n",
+ (undef) x 2, _ERR_NOCONVERTPKG;
+ }
} else {
if ($arch eq 'x86_64') {
$x32 = check_x32 $args{LOCATION};
if ($x32 && ! $multilib) {
- die "$sbo is 32-bit which requires multilib on x86_64.\n";
+ my $warn =
+ "$sbo is 32-bit which requires multilib on x86_64.\n";
+ return $warn, (undef) x 2, _ERR_NOMULTILIB;
}
}
}
# setup and run the .SlackBuild itself
- my ($pkg, $src) = perform_sbo(
+ my ($pkg, $src, $exit) = perform_sbo(
OPTS => $args{OPTS},
JOBS => $args{JOBS},
LOCATION => $location,
@@ -773,7 +838,11 @@ sub do_slackbuild {
C32 => $args{COMPAT32},
X32 => $x32,
);
- $pkg = do_convertpkg $pkg if $args{COMPAT32};
+ return $pkg, (undef) x 2, $exit if $exit;
+ if ($args{COMPAT32}) {
+ ($pkg, $exit) = do_convertpkg $pkg;
+ return $pkg, (undef) x 2, $exit if $exit;
+ }
return $version, $pkg, $src;
}
@@ -814,8 +883,8 @@ sub make_distclean {
make_clean(SBO => $sbo, SRC => $args{SRC}, VERSION => $args{VERSION});
say "Distcleaning for $sbo-$args{VERSION}...";
# remove any distfiles for this particular SBo.
- my %downloads = get_sbo_downloads(LOCATION => $args{LOCATION});
- for my $key (keys %downloads) {
+ my $downloads = get_sbo_downloads(LOCATION => $args{LOCATION});
+ for my $key (keys %$downloads) {
my $filename = get_filename_from_link $key;
unlink $filename if -f $filename;
}
@@ -894,7 +963,8 @@ sub merge_queues {
sub get_readme_contents($) {
exists $_[0] or script_error 'get_readme_contents requires an argument.';
- my $fh = open_read(shift .'/README');
+ my ($fh, $exit) = open_read(shift .'/README');
+# TODO: do something with $exit
my $readme = do {local $/; <$fh>};
close $fh;
return $readme;
@@ -908,7 +978,8 @@ sub get_installed_cpans() {
}
my @contents;
for my $file (@locals) {
- my $fh = open_read $file;
+ my ($fh, $exit) = open_read $file;
+ return [] if $exit;
# push @contents, grep {/Module|VERSION/} <$fh>;
push @contents, grep {/Module/} <$fh>;
close $fh;
@@ -1011,6 +1082,7 @@ sub process_sbos {
NOINSTALL => 0,
NOCLEAN => 'FALSE',
DISTCLEAN => 'FALSE',
+ NON_INT => 0,
@_
);
my $todo = $args{TODO};
@@ -1019,23 +1091,32 @@ sub process_sbos {
my $locs = $args{LOCATIONS};
my $jobs = $args{JOBS} =~ /^\d+$/ ? $args{JOBS} : 0;
exists $$todo[0] or script_error 'process_sbos requires TODO.';
- my (%failures, @symlinks, $temp_syms);
- for my $sbo (@$todo) {
+ my (@failures, @symlinks, $temp_syms, $exit);
+ FIRST: for my $sbo (@$todo) {
my $compat32 = $sbo =~ /-compat32$/ ? 1 : 0;
- eval { $temp_syms = check_distfiles(
+ ($temp_syms, $exit) = check_distfiles(
LOCATION => $$locs{$sbo}, COMPAT32 => $compat32
- ); };
- # if $@ is defined, $temp_syms will be empty and the script will error
- # instead of having a proper failure message.
- $@ ? $failures{$sbo} = $@ : push @symlinks, @$temp_syms;
- }
- # return now if we were unable to download/verify everything - might want
- # to not do this. not sure.
- if (keys %failures > 0) {
- unlink for @symlinks;
- return \%failures;
+ );
+ # if $exit is defined, prompt to proceed or return with last $exit
+ if ($exit) {
+ my $fail = $temp_syms;
+ push @failures, {$sbo => $fail};
+ # return now if we're not interactive
+ return \@failures, $exit if $args{NON_INT};
+ say "Unable to download/verify source file(s) for $sbo:";
+ say " $fail";
+ print 'Do you want to proceed? [n] ';
+ if (<STDIN> =~ /^[yY]/) {
+ next FIRST;
+ } else {
+ unlink for @symlinks;
+ return \@failures, $exit;
+ }
+ }
}
- for my $sbo (@$todo) {
+ my $count = 0 unless $args{NON_INT};
+ FIRST: for my $sbo (@$todo) {
+ $count++;
my $options = 0;
$options = $$opts{$sbo} if defined $$opts{$sbo};
my $cmds = $$cmds{$sbo} if defined $$cmds{$sbo};
@@ -1045,54 +1126,69 @@ sub process_sbos {
# switch compat32 on if upgrading/installing a -compat32
# else make sure compat32 is off
my $compat32 = $sbo =~ /-compat32$/ ? 1 : 0;
- my ($version, $pkg, $src);
- eval { ($version, $pkg, $src) = do_slackbuild(
+ my ($version, $pkg, $src, $exit) = do_slackbuild(
OPTS => $options,
JOBS => $jobs,
LOCATION => $$locs{$sbo},
COMPAT32 => $compat32,
- ); };
- if ($@) {
- $failures{$sbo} = $@;
- } else {
- do_upgradepkg $pkg unless $args{NOINSTALL};
-
- unless ($args{DISTCLEAN}) {
- make_clean(SBO => $sbo, SRC => $src, VERSION => $version)
- unless $args{NOCLEAN};
- } else {
- make_distclean(
- SBO => $sbo,
- SRC => $src,
- VERSION => $version,
- LOCATION => $$locs{$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 ($args{DISTCLEAN}) {
- unlink $pkg;
+ );
+ if ($exit) {
+ my $fail = $version;
+ push @failures, {$sbo => $fail};
+ # return now if we're not interactive
+ return \@failures, $exit if $args{NON_INT};
+ # or if this is the last $sbo
+ return \@failures, $exit if $count == @$todo;
+ say "Failure encountered while building $sbo:";
+ say " $fail";
+ print 'Do you want to proceed [n] ';
+ if (<STDIN> =~ /^[yY]/) {
+ next FIRST;
+ } else {
+ unlink for @symlinks;
+ return \@failures, $exit;
+ }
+ }
+
+ do_upgradepkg $pkg unless $args{NOINSTALL};
+
+ unless ($args{DISTCLEAN}) {
+ make_clean(SBO => $sbo, SRC => $src, VERSION => $version)
+ unless $args{NOCLEAN};
+ } else {
+ make_distclean(
+ SBO => $sbo,
+ SRC => $src,
+ VERSION => $version,
+ LOCATION => $$locs{$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 ($args{DISTCLEAN}) {
+ unlink $pkg;
}
}
unlink for @symlinks;
- return \%failures;
+ return \@failures, $exit;
}
# subroutine to print out failures
sub print_failures {
my $failures = shift;
- if (keys %$failures > 0) {
- say 'Failures:';
- say " $_: $$failures{$_}" for keys %$failures;
+ if (@$failures > 0) {
+ warn "Failures:\n";
+ for my $failure (@$failures) {
+ warn " $_: $$failure{$_}" for keys %$failure;
+ }
}
}
generated by cgit v1.2.3 (git 2.26.2) at 2025-04-21 19:11:47 +0000