initial repo add

2 files changed, 580 insertions, 0 deletions

diff --git a/SBO-Lib/lib/SBO/.Lib.pm.swp b/SBO-Lib/lib/SBO/.Lib.pm.swp
new file mode 100644
index 0000000..88b9abf
--- /dev/null
+++ b/SBO-Lib/lib/SBO/.Lib.pm.swp
diff --git a/SBO-Lib/lib/SBO/Lib.pm b/SBO-Lib/lib/SBO/Lib.pm
new file mode 100644
index 0000000..458df14
--- /dev/null
+++ b/SBO-Lib/lib/SBO/Lib.pm
@@ -0,0 +1,580 @@
+#!/usr/bin/env perl
+#
+# sbolib.sh
+# shared functions for the sbo_ scripts.
+#
+# author: Jacob Pipkin <j@dawnrazor.net>
+# date: Setting Orange, the 37th day of Discord in the YOLD 3178
+# license: WTFPL <http://sam.zoy.org/wtfpl/COPYING>
+
+package SBO::Lib 0.1;
+my $version = "0.1";
+
+require Exporter;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(
+	script_error
+	show_version
+	get_slack_version
+	check_slackbuilds_txt
+	fetch_tree
+	update_tree
+	get_installed_sbos
+	get_available_updates
+	check_sbo_name_validity
+	do_slack_build
+	make_clean
+	make_distclean
+	do_upgradepkg
+	get_sbo_location
+);
+
+use warnings FATAL => 'all';
+use strict;
+use File::Basename;
+use English '-no_match_vars';
+use Tie::File;
+use IO::File;
+use Sort::Versions;
+use Digest::MD5;
+use File::Copy;
+use File::Path qw(make_path remove_tree);
+use Fcntl;
+
+$UID == 0 or print "This script requires root privileges.\n" and exit(1);
+
+our $conf_dir = '/etc/sbotools';
+our $conf_file = "$conf_dir/sbotools.conf";
+my @valid_conf_keys = (
+	'NOCLEAN',
+	'DISTCLEAN',
+#	"JOBS",
+	'PKG_DIR',
+	'SBO_HOME'
+);
+
+our %config;
+if (-f $conf_file) {
+	open my $reader, '<', $conf_file;
+	my $text = do {local $/; <$reader>};
+	%config = $text =~ /^(\w+)=(.*)$/mg;
+	close($reader);
+}
+for my $key (keys %config) {
+	unless ($key ~~ @valid_conf_keys) {
+		undef $config{$key};
+	}
+}
+for (@valid_conf_keys) {
+	unless ($_ eq 'SBO_HOME') {
+		$config{$_} = "FALSE" unless exists $config{$_};
+	} else {
+		$config{$_} = '/usr/sbo' unless exists $config{$_};
+	}
+}
+
+
+my $distfiles = "$config{SBO_HOME}/distfiles";
+my $slackbuilds_txt = "$config{SBO_HOME}/SLACKBUILDS.TXT";
+
+my $name_regex = '\ASLACKBUILD\s+NAME:\s+';
+
+# this should be done a bit differently.
+#
+sub script_error {
+	unless (exists $_[0]) {
+		print "A fatal script error has occured. Exiting.\n";
+	} else {
+		print "A fatal script error has occured:\n";
+		print "$_[0]\n";
+		print "Exiting.\n";
+	}
+	exit(1);
+} 
+
+sub show_version {
+	print "sbotools version $version\n";
+	print "licensed under the WTFPL\n";
+	print "<http://sam.zoy.org/wtfpl/COPYING>\n";
+}
+
+sub get_slack_version {
+	if (-f '/etc/slackware-version') {
+		open my $slackver, '<', '/etc/slackware-version';
+		chomp(my $line = <$slackver>); 
+		close($slackver);
+		my $slk_version = split_line($line,' ',1);
+		$slk_version = '13.37' if $slk_version eq '13.37.0';
+		return $slk_version;
+	}
+}
+
+sub check_slackbuilds_txt {
+	if (-f $slackbuilds_txt) {
+		return 1;
+	} else {
+		print "I am unable to find SLACKBUILDS.TXT.\n";
+		print "Perhaps you need to \"sbosnap fetch\"?\n";
+		exit(1);
+	}
+}
+
+sub rsync_sbo_tree {
+	my $slk_version = get_slack_version();
+	my $cmd = 'rsync';
+	my @arg = ('-a','--exclude=*.tar.gz','--exclude=*.tar.gz.asc');
+	push(@arg,"rsync://slackbuilds.org/slackbuilds/$slk_version/*");
+	push(@arg,$config{SBO_HOME});
+	system($cmd,@arg);
+	print "Finished.\n";
+	return 1;
+}
+
+sub check_home {
+	my $sbo_home = $config{SBO_HOME};
+	if (-d $sbo_home) {
+		opendir(my $home_handle,$sbo_home);
+		while (readdir $home_handle) {
+			next if /^\.[\.]{0,1}$/;
+			print "$sbo_home exists and is not empty. Exiting.\n";
+			exit(1);
+		}
+	} else {
+		make_path($sbo_home) or print "Unable to create $sbo_home. Exiting.\n"
+			and exit(1);
+	 }
+}
+
+sub fetch_tree {
+	check_home();
+	print "Pulling SlackBuilds tree...\n";
+	rsync_sbo_tree();
+}
+
+sub update_tree {
+	check_slackbuilds_txt();
+	print "Updating SlackBuilds tree...\n";
+	rsync_sbo_tree();
+}
+
+sub get_installed_sbos {
+	my @installed;
+	opendir my $diread, '/var/log/packages';
+	while (my $ls = readdir $diread) {
+		next if $ls =~ /\A\./;
+		if (index($ls,"SBo") != -1) {
+			my @split = split(/-/,reverse($ls),4);
+			my %hash;
+			$hash{name} = reverse($split[3]);
+			$hash{version} = reverse($split[2]);
+			push(@installed,\%hash);
+		}
+	}
+	return @installed;
+}
+
+sub clean_line {
+	script_error('clean line requires an argument')
+		unless exists $_[0];
+	chomp(my $line = shift);
+	$line =~ s/[\s"\\]//g;
+	return $line;
+}
+
+#sub get_available_updates {
+#	check_slackbuilds_txt();
+#	my @updates;
+#	my @pkg_list = get_installed_sbos();
+#	my $sb_txt = IO::File->new($slackbuilds_txt,"r");
+#	FIRST: for my $c (keys @pkg_list) {
+#		my $name = $pkg_list[$c]{name};
+#		my $version = $pkg_list[$c]{version};
+#		my $regex = qr/$name_regex\Q$name\E\n\z/;
+#		my $found = "FALSE";
+#		SECOND: while (my $line = <$sb_txt>) {
+#			if ($line =~ $regex) {
+#				$found = "TRUE";
+#				next SECOND;
+#			}
+#			if ($found eq "TRUE") {
+#			    if ($line =~ /VERSION/) {
+#					$found = "FALSE";
+#					my @split = split(' ',$line);
+#					my $sbo_version = clean_line($split[2]);
+#					if (versioncmp($sbo_version,$version) == 1) {
+#						my %hash = (
+#							name => $name,
+#							installed => $version,
+#							update => $sbo_version,
+#						);
+#						push(@updates,\%hash);
+#					}
+#					$sb_txt->seek(0,0);
+#			        next FIRST;
+#				}
+#			}
+#		}
+#	}
+#	$sb_txt->close;
+#	return @updates;
+#}
+
+# much nicer version above does not work with perl 5.12, at last on Slackware
+# 13.37 - the regex within the SECOND loop (while inside for) will never ever
+# match, or at least I couldn't find a way to make it do so. switch which is
+# inside which, and it works, so we use this method for now.
+#
+# iterate over all the lines!
+#
+sub get_available_updates {
+	check_slackbuilds_txt();
+	my (@updates,$index);
+	my @pkg_list = get_installed_sbos();
+	open my $sb_txt, '<', $slackbuilds_txt;
+	my $found = 'FALSE';
+	FIRST: while (my $line = <$sb_txt>) {
+		if ($found eq 'TRUE') {
+			if ($line =~ /VERSION/) {
+				$found = 'FALSE';
+				my $sbo_version = split_line($line,' ',2);
+				if (versioncmp($sbo_version,$pkg_list[$index]{version}) == 1) {
+					my %hash = (
+						name => $pkg_list[$index]{name},
+						installed => $pkg_list[$index]{version},
+						update => $sbo_version,
+					);
+					push(@updates,\%hash);
+				}
+			}
+		} else {
+			SECOND: for my $c (keys @pkg_list) {
+				my $regex = qr/$name_regex\Q$pkg_list[$c]{name}\E\n\z/;
+				if ($line =~ $regex) {
+					$found = 'TRUE';
+					$index = $c;
+					last SECOND;
+				}
+			}
+		}
+	}
+	close $sb_txt;
+	return @updates;
+}
+
+sub check_sbo_name_validity {
+	script_error('check_sbo_name_validity requires an argument')
+		unless exists $_[0];
+	my $sbo = shift;
+	check_slackbuilds_txt();
+	my $valid = 'FALSE';
+	my $regex = qr/$name_regex\Q$sbo\E\n\z/;
+	open my $sb_txt, '<', $slackbuilds_txt;
+	FIRST: while (my $line = <$sb_txt>) {
+		if ($line =~ $regex) {
+			$valid = 'TRUE';
+			last FIRST;
+		}
+	}
+	close($sb_txt);
+	unless ($valid eq 'TRUE') {
+		print "$sbo does not exist in the SlackBuilds tree. Exiting.\n";
+		exit(1);
+	}
+	return 1;
+}
+
+sub get_sbo_location {
+	script_error('get_sbo_location requires an argument.Exiting.')
+		unless exists $_[0];
+	my $sbo = shift;
+	check_slackbuilds_txt();
+	my $found = 'FALSE';
+	my $location;
+	my $regex = qr/$name_regex\Q$sbo\E\n\z/;
+	open my $sb_txt, '<', $slackbuilds_txt;
+	FIRST: while (my $line = <$sb_txt>) {
+		if ($line =~ $regex) {
+			$found = 'TRUE';
+			next FIRST;
+		}
+		if ($found eq 'TRUE') {
+			if ($line =~ /LOCATION/) {
+				my $loc_line = split_line($line,' ',2);
+				$loc_line  =~ s#^\./##;
+				$location = "$config{SBO_HOME}/$loc_line";
+				last FIRST;
+			}
+		}
+	}
+	close($sb_txt);
+	return $location;
+}
+
+sub split_line {
+	script_error('split_line requires three arguments') unless exists $_[2];
+	my ($line,$pattern,$index) = @_;
+	if ($pattern eq ' ') {
+		my @split = split("$pattern",$line);
+	} else {
+		my @split = split(/$pattern/,$line);
+	}
+	return clean_line($split[$index]);
+}
+
+sub split_equal_one {
+	script_error("split_equal_one requires an argument") unless exists $_[0];
+	return split_line($_[0],'=',1);
+}
+
+sub check_multilib {
+	return 1 if -f '/etc/profile.d/32dev.sh';
+	return;
+}
+
+sub find_download_info {
+	script_error('find_download_info requires four arguments.')
+		unless exists $_[3];
+	my ($sbo,$location,$type,$x64) = @_;
+	my @return;
+	my $regex;
+	if ($type eq 'download') {
+		$regex = qr/^DOWNLOAD/;
+	} elsif ($type eq 'md5sum') {
+		$regex = qr/^MD5SUM/;
+	}
+	if ($x64) {
+		$regex = qr/${regex}_x86_64=/;
+	} else {
+		$regex = qr/$regex=/;
+	}
+	my $empty_regex = qr/=""$/;
+	my $back_regex = qr/\\$/;
+	my $more = 'FALSE';
+	open my $info,'<',"$location/$sbo.info";
+	FIRST: while (my $line = <$info>) {
+		unless ($more eq 'TRUE') {
+			if ($line =~ $regex) {
+				last FIRST if $line =~ $empty_regex;
+				unless ($link eq 'UNSUPPORTED') {
+					push(@return,split_equal_one($line));
+					$more = 'TRUE' if $line =~ $back_regex;
+				} else {
+					last FIRST;
+				}
+			}
+		} else {
+			unless ($line =~ $back_regex) {
+				$more = 'FALSE';
+				last FIRST;
+			}
+			$line = clean_line($line);
+			push(@return,$line);
+		}
+	}
+	close($return);
+	return @return if exists $return[0];
+	return;
+}
+
+# this is a bit wonky - if running a 64-bit system, we have to first see if
+# DOWNLOAD_x86_64 is defined, and make sure it's not set to "UNSUPPORTED";
+# then if that doesn't yield anything, go through again pulling the DOWNLOAD
+# contents.
+#
+# would like to think of a better way to handle this.
+#
+sub get_sbo_downloads {
+	script_error('get_sbo_downloads requires two arguments.')
+		unless exists $_[1];
+	script_error('get_sbo_downloads given a non-directory.') unless -d $_[1];
+	my ($sbo,$location) = @_;
+	chomp(my $arch = `uname -m`);
+	my (@links,@md5s);
+	if ($arch eq 'x86_64') {
+		my @links = find_download_info($sbo,$location,'download',1);
+		my @md5s = find_download_info($sbo,$location,'md5sum',1);
+	}
+	unless (exists $links[0]) {
+		my @links = find_download_info($sbo,$location,'download',0);
+		my @md5s = find_download_info($sbo,$location,'md5sum',0);
+	}
+	my @downloads;
+	for my $c (keys @links) {
+		my %hash = (link => $links[$c],md5sum => $md5s[$c]);
+		push (@downloads,\%hash);
+	}
+	return @downloads;
+}
+
+sub compute_md5sum {
+	script_error('compute_md5sum requires an argument.') unless exists $_[0];
+	script_error('compute_md5sum argument is not a file.') unless -f $_[0];
+	my $filename = shift;
+	open my $reader, '<', $filename;
+	my $md5 = Digest::MD5->new;
+	$md5->addfile($reader);
+	my $md5sum = $md5->hexdigest;
+	close($reader);
+	return $md5sum;
+}
+
+sub get_filename_from_link {
+	script_error('get_filename_from_link requires an argument')
+		unless exists $_[0];
+	my @split = split('/',reverse($_[0]),2);
+	chomp(my $filename = $distfiles .'/'. reverse($split[0]));
+	return $filename;
+}
+
+sub check_distfile {
+	script_error('check_distfile requires an argument.') unless exists $_[0];
+	my $filename = get_filename_from_link($_[0]);
+	return unless -d $distfiles;
+	return unless -f $filename;
+	my $md5sum = compute_md5sum($filename);
+	return unless $_[1] eq $md5sum;
+	return 1;
+}
+
+sub get_distfile {
+	script_error('get_distfile requires an argument') unless exists $_[1];
+	my ($link,$expected_md5sum) = @_;
+	my $filename = get_filename_from_link($link);
+	mkdir($distfiles) unless -d $distfiles;
+	chdir($distfiles);
+	my $out = system("wget $link");
+	return unless $out == 0;
+	my $md5sum = compute_md5sum($filename);
+	if ($md5sum ne $expected_md5sum) {
+		print "md5sum failure for $filename.\n";
+		exit(1);
+	}
+	return 1;
+}
+
+sub get_sbo_version {
+	script_error('get_sbo_version requires two arguments.')
+		unless exists $_[1];
+	my ($sbo,$location) = @_;
+	my $version;
+	open my $info, '<', "$location/$sbo.info";
+	my $version_regex = qr/\AVERSION=/;
+	FIRST: while (my $line = <$info>) {
+		if ($line =~ $version_regex) {
+			$version = split_equal_one($line);
+			last FIRST;
+		}
+	}
+	close($info);
+	return $version;
+}
+
+sub get_symlink_from_filename {
+	script_error('get_symlink_from_filename requires two arguments')
+		unless exists $_[1];
+	script_error('get_symlink_from_filename first argument is not a file')
+		unless -f $_[0];
+	my @split = split('/',reverse($_[0]),2);
+	my $fn = reverse($split[0]);
+	return "$_[1]/$fn";
+}
+
+sub check_x32 {
+	script_error('check_x32 requires two arguments.') unless exists $_[1];
+	my ($sbo,$location) = @_;
+	open my $info,'<',"$location/$sbo.info";
+	my $regex = qr/^DOWNLOAD_x86_64/;
+	FIRST: while (my $line = <$info>) {
+		if ($line =~ $regex) {
+			return 1 if index($line,'UNSUPPORTED') != -1;
+		}
+	}
+	return;
+}
+
+sub check_multilib {
+	return 1 if -f '/etc/profile.d/32dev.sh';
+	return;
+}
+
+sub do_slack_build {
+	script_error('do_slack_build requires two arguments.') unless exists $_[1];
+	my ($jobs,$sbo) = @_;
+	my $sbo_home = $config{SBO_HOME};
+	my $location = get_sbo_location($sbo);
+	my $x32 = check_x32($sbo,$location);
+	if ($x32) {
+		if (! check_multilib()) {
+			print "$sbo is 32-bit only, however, this system does not appear 
+to be multilib ready\n";
+			exit 1
+		}
+	}
+	my $version = get_sbo_version($sbo,$location);
+	my @downloads = get_sbo_downloads($sbo,$location);
+	my @symlinks;
+	for my $c (keys @downloads) {
+		my $link = $downloads[$c]{link};
+		my $md5sum = $downloads[$c]{md5sum};
+		my $filename = get_filename_from_link($link);
+		unless (check_distfile($link,$md5sum)) {
+			die unless get_distfile($link,$md5sum);
+		}
+		my $symlink = get_symlink_from_filename($filename,$location);
+		push(@symlinks,$symlink);
+		symlink($filename,$symlink);
+	}
+	chdir($location);
+	chmod(0755,"$location/$sbo.SlackBuild");
+	my $cmd;
+	if ($x32) {
+		$cmd = ". /etc/profile.d/32dev.sh && $location/$sbo.SlackBuild";
+	} else {
+		$cmd = "$location/$sbo.SlackBuild";
+	}
+	my $out = system($cmd);
+	die unless $out == 0;
+	unlink($_) for (@symlinks);
+	return $version;
+}
+
+sub make_clean {
+	script_error('make_clean requires two arguments.') unless exists $_[1];
+	my ($sbo,$version) = @_;
+	print "Cleaning for $sbo-$version...\n";
+	remove_tree("/tmp/SBo/$sbo-$version") if -d "/tmp/SBo/$sbo-$version";
+	remove_tree("/tmp/SBo/package-$sbo") if -d "/tmp/SBo/package-$sbo";
+	return 1;
+}
+
+sub make_distclean {
+	script_error('make_distclean requires two arguments.') unless exists $_[1];
+	my ($sbo,$version) = @_;
+	make_clean($sbo,$version);
+	print "Distcleaning for $sbo-$version...\n";
+	my $location = get_sbo_location($sbo);
+	my @downloads = get_sbo_downloads($sbo,$location);
+	for my $dl (@downloads) {
+		my $filename = get_filename_from_link($dl);
+		unlink($filename) if -f $filename;
+	}
+	return 1;
+}
+
+sub do_upgradepkg {
+	script_error('do_upgradepkg requires two arguments.') unless exists $_[1];
+	my ($sbo,$version) = @_;
+	my $pkg;
+	my $pkg_regex = qr/^(\Q$sbo\E-\Q$version\E-[^-]+-.*_SBo.t[xblg]z)$/;
+	opendir my $diread, '/tmp/';
+	FIRST: while (my $ls = readdir $diread) {
+		if ($ls =~ $pkg_regex) {
+			chomp($pkg = "/tmp/$1");
+			last FIRST;
+		}
+	}
+	system("/sbin/upgradepkg --reinstall --install-new $pkg");
+	return $pkg;
+} 
+