#!/bin/sh -- # A comment mentioning perl, to prevent perl from looping. Indented to work with bash.
eval 'exec perl -S $0 ${1+"$@"}'
        if 0;

# Todo: switch to a set of mirrors via cmd line and old url.

chop($program = `basename $0`);

$Rpm = 'rpm';
$Rpm_Args = '-Uvvh';
@Rpm_Args = ();
$Rpm_Dir = '/usr/local/RPMS';	# place to store downloaded rpm's and logs.

@Mirrors = qw(
	ftp://ftp.redhat.com/pub/redhat
	ftp://ftp.varesearch.com/pub/mirrors/redhat/redhat
	ftp://ftp.ou.edu/linux/redhat
	ftp://ftp.wgs.com/pub/linux/redhat
	ftp://ftp.kernel.org/pub/mirrors/redhat/redhat
	ftp://ftp.infomagic.com/pub/mirrors/linux/RedHat
	ftp://ftp.caldera.com/pub/mirrors/redhat
	ftp://ftp.rge.com/pub/systems/linux/redhat
	ftp://sunsite.unc.edu/pub/Linux/distributions/redhat
	ftp://tsx-11.mit.edu/pub/linux/distributions/redhat
);
 
$Arch_Match = 'i386|sparc|alpha|noarch';
sub arch {
	local($x) = @_;
	if ( $x =~ /$Arch_Match/o ) {
		return 1;
	} else {
		return 0;
	}
}

$Use_Mirror = 0;

$Fetch_Updates = 0;

$Sleep = 0;
$Size_Only = 0;
$Install_It = 1;
$Do_PGP_Check = 1;

$Tmp_File = "/tmp/$program.$$";

#$Download_Program = 'ncftp';	# EXTERNAL command
$Download_Program = 'ftp_get';	# EXTERNAL command
$Url_Size = 'url_size';		# EXTERNAL command
$List_Only = 0;
$Upgrade_Only = 0;

# Make Usage statement:

$version_num = '0.2';
$Version = "$program:	Version $version_num Copyright (c) 1998, 1999  Karl J. Runge";

$Usage = <<"EOQ";

$Version

	A wrapper program to $Rpm.

Usage: 
	$program -h		(this help)
	$program [rpm_args] <file|dir|url> ...

	Where "file" is a local rpm file or url is a ftp:// url to an rpm file.
	Directories "dir" are recursively searched for *.rpm files.

	rpm_args are args to $Rpm for installation. Default: $Rpm_Args.

$program:
	1) Retrieves files given by ftp:// url and places in common area
	   (currently $Rpm_Dir)
	2) Runs a size, md5, PGP checks via $Rpm --checksig
	3) Runs $Rpm on the source as root to install it.
	   (root password will be prompted for.)

Misc:
	$program -L <file|url> ...

		will just to a $Rpm listing of the associated package.
		(piped to xargs ls -ldt to show dates and sizes).
		Same as -q


	-D <dir>	Changes rpm common area.
	-m		Prompts you to select a mirror site.

	-log <file>	Use <file> as log file.
	-l

	-no_install	Do not install packages, just test what would 
	-n		happen (packages ARE downloaded, however)

	-S		Report Size only.
	-no_size	Do not report Size.
	-ns

	-no_pgp		Do not use pgp which checking.

	-upgrade_only	Only install package if earlier version
	-uo		is already installed.

#	-fetch_updates	Fetch the contents of the RedHat "updates"
#	-fu		directory for this architecture.

	-sleep <n>	sleep n seconds between packages.

Programs needed:
	Basic:      perl5 sh mv date xargs ls tee file basename uname sed awk
	Extra:      rpm pgp ncftp
	HomeBrew:   url_size sum.pl


Some useful URL's:

	ftp://ftp.redhat.com/pub/redhat/redhat-4.2/i386/RedHat/RPMS/
	ftp://ftp.redhat.com/pub/redhat/redhat-5.2/i386/RedHat/RPMS/
	ftp://ftp.redhat.com/updates/4.2/i386/

	Info, guides, Errata
	http://www.redhat.com/support/docs/rhl/
	http://www.redhat.com/support/docs/rhl/rh42-errata-general.html
	http://www.redhat.com/corp/support/errata/rh52-errata-general.html

Mirrors:
	ftp://gatekeeper.dec.com/pub/linux/redhat/
	ftp://ftp.infomagic.com/pub/mirrors/linux/RedHat/
	ftp://sunsite.unc.edu/pub/Linux/distributions/redhat/
	ftp://tsx-11.mit.edu/pub/linux/distributions/redhat/


EOQ

if ( $ARGV[0] eq '-m' && $ARGV[1] eq '' ) {
	foreach $mirror (@Mirrors) {
		print $mirror, "\n";
	}
	exit 0;
}

select(STDERR); $| = 1;
select(STDOUT); $| = 1;

LOOP:			# process command line arguments...
while (@ARGV) {
    $_ = shift;
    CASE: {
	/^-h.*/	&& ( (&help()), exit 0, last CASE);
	/^(-log|-l)$/	&& ( $Log = shift, last CASE);
	/^(-L|-q)$/i	&& ( $List_Only = 1, last CASE);
	/^-S$/	&& ( $Size_Only = 1, last CASE);
	/^-m$/	&& ( $Use_Mirror = 1, last CASE);
	/^-no_install$/	&& ( $Install_It = 0, last CASE);
	/^-n$/		&& ( $Install_It = 0, last CASE);
	/^-fetch_updates$/	&& ( $Fetch_Updates = 1, last CASE);
	/^-fu$/			&& ( $Fetch_Updates = 1, last CASE);
	/^-no_pgp$/	&& ( $Do_PGP_Check = 0, last CASE);
	/^-no_size$/	&& ( $Url_Size = '', last CASE);
	/^-ns$/		&& ( $Url_Size = '', last CASE);
	/^-D$/	&& ( $Rpm_Dir = shift, last CASE);
	/^-sleep$/	&& ( $Sleep = shift, last CASE);
	/^-upgrade_only$/ && ( $Upgrade_Only = 1, last CASE);
	/^-uo$/		  && ( $Upgrade_Only = 1, last CASE);
	/^-.+/	&& ( push ( @Rpm_Args, $_), last CASE);
	unshift(@ARGV,$_);
	last LOOP;
    }
}

print STDERR "\nParameters:\n";
foreach $var (qw(Version List_Only Size_Only Use_Mirror Install_It 
		Upgrade_Only Log Rpm Rpm_Args Download_Program
		Url_Size Rpm_Dir Tmp_File)) {
	local($value);
	eval "\$value = \$$var;";
	print STDERR "\t$var:	$value\n";
}
print STDERR "\n";

$Rpm_Args = join(' ', @Rpm_Args) if @Rpm_Args;

if ( $ARGV[0] eq '-' ) {
	$Stdin = 1;
} else {
	$Stdin = 0;
}

while (1) {
	if ( $Stdin ) {
		if ( @StdinList ) {
			$Item = shift(@StdinList);
		} else {
			print STDERR "NEXT> ";
			if ( eof(STDIN) ) {
				last;
			}
			chop($Item = <STDIN>);
		}
	} else {
		if ( @ARGV < 1 ) {
			last;
		}
		$Item = shift;
	}

	print STDERR "*** Processing:  $Item\n";
	sleep $Sleep;

	if ( $Item !~ m,^(file|ftp)://, && -d $Item ) {
		print STDERR "    FINDING *.rpms in directory \"$Item\" ...\n";
		open(FIND, "find $Item -name \"*.rpm\" -type f -follow -print|") 
			|| (print STDERR "    SKIPPING: $Item\n", next);
		while (<FIND>) {
			chop;
			if ( $Stdin ) {
				unshift(@StdinList, $_);
			} else {
				unshift(@ARGV, $_);
			}
		}
		close(FIND);
		next;
	}

	if ( $Use_Mirror ) {
		$Item = &MirrorReplace($Item); 	
	}

	if ( $List_Only ) {
		&List_Pkg($Item);
		next;
	}

	$Item =~ s,^file://,ftp://,;

	$Item =~ s,^file:,,;

	$File = $Item;

	if ( -f $Item ) {
		;
	} elsif ( $Item =~ m,^ftp://, ) {
		$File = &Retrieve_File($Item);
		next if $Size_Only;
	} else {
		print STDERR "    Could not locate \"$Item\".\n";
	}
	&Process($File);
	print STDERR "\n";
}

&clean_up;
exit 0;

sub MirrorReplace {
	local($item) = @_;

	local($mirror, $prefix, $match, $path, $url);

	if ( $item =~ m,^/, ) {
		$path = $item;	
	}

	foreach $mirror (@Mirrors) {
		last if $path ne '';
		$prefix = $mirror;
		$prefix =~ s/(\W)/\\$1/g;
		if ( $item =~ /^$prefix/ ) {
			$path = $';
			$match = $&;
			$path = "/$path" unless $path =~ m,^/,;
		}
	}

	if ( $path eq '' ) {
		print STDERR "  Could not locate mirror prefix.\n";
		return $item;
	}
	
	local($cnt) = 0;
	print STDERR "  Choose a mirror:\n";
	foreach $mirror (@Mirrors) {
		if ( $mirror eq $match ) {
			print STDERR "  $cnt(*)\t$mirror\n";
		} else {
			print STDERR "  $cnt\t$mirror\n";
		}
		
		$cnt++;
	}
	print STDERR "\n  ===> ";
	chop($n = <STDIN>);
	if ( $Mirrors[$n] ne '' ) {
		$url = "$Mirrors[$n]$path"; 
		print STDERR "  URL is now:\n";
		print STDERR "  $url\n";
		return $url;
	} else {
		print STDERR "  Could not locate mirror prefix.\n";
		return $item;
	}
}

sub Retrieve_File {
	my($url) = @_;

	my($host, $file, $dest, $kid);

	$host = $url;
	$host =~ s,^ftp://,,;
	$host =~ s,/.*$,,;

	$file = $url;
	$file =~ s,^.*/,,;

	if ( ! -d $Rpm_Dir ) {
		&clean_up;
		mkdir($Rpm_Dir, 0777) || die "    Could not create $Rpm_Dir:$!";
	}

	if ( ! -w $Rpm_Dir ) {
		print STDERR "    Cannot write to $Rpm_Dir, SKIPPING: $url\n";
		return;
	}

	$dest = "$Rpm_Dir/$file";
	if ( -f "$dest" && ! $Size_Only ) {
		my ($suffix, $backup); 
	
		chop($suffix = `date +%m_%d_%y_%H.%M`);
		$backup = "$dest.$suffix";

		print STDERR "    Backing up: $dest\n";
		print STDERR "            to: $backup\n";

		if ( system("mv $dest $backup") != 0 ) {
			&clean_up;
			die "    Could not backup: $dest\n            to: $backup: $!";
		}
	}

	print STDERR "    Retrieving: $file from: $host ...\n";

	my $total_size0 = '';
	my $total_size = '';

	if ( $Url_Size ) {
		print STDERR "    Getting Size ... ";
		chop($total_size = `$Url_Size $url`);
		$total_size =~ s/\s+.*$//;
		if ( $total_size =~ /error/i ) {
			$total_size = '';
		} else {
			print STDERR "$total_size bytes";
			$total_size0 = $total_size;
			$total_size = "/$total_size";
			&short_sleep('0.3');
		}
		print STDERR "    \r";
	}

	if ( $Size_Only ) {
		print STDERR "\n";
		return "";
	}
	
	if ( $kid = fork() ) {
		;
	} else {
		my $size = 0;
		my $percent = 0;
		my $rate = ''; 
		my $st0 = ''; 
		my $st = ''; 
		$st0 = time;
		#print STDERR "\n";
		while (1) {
		    if ($size = -s $dest) {
			print STDERR "    \r";
			$st = time;
			if ( $st > $st0 + 2 ) {
				$rate = $size / (1024.0 * ($st - $st0));
				$rate = sprintf(" %4.1f K/s", $rate);
			} else {
				$rate = '';
			}
			if ( $total_size0 )  {
				$percent = int( (100.0 * $size) / $total_size0);
				$percent = " [$percent%]";
			} else {
				$percent = '';
			}
			$percent = '';
			print STDERR "    File: $dest ($size$total_size$percent$rate)";
		    }
		    &short_sleep('0.3');
		}
		exit 0;
	}

	if ( system("cd $Rpm_Dir; $Download_Program $url") != 0 ) {
		kill 9, $kid; print STDERR "    \r\n";
		sleep 1;
		&clean_up;
		die "    Error retrieving \"$url\": $!";
	}
	&short_sleep('0.5');
	kill 9, $kid; print STDERR "    \r\n";
	sleep 1;

	if ( ! -s "$dest" ) {
		&clean_up;
		die "    Error retrieving \"$url\": $!";
	}
	
	return $dest;
}

sub Process {
	my($file) = @_;

	my($pkg, $vers, $cmd, $arch, $src);

	$src = $file;

	my $log;
	
	if ( ! -d $Rpm_Dir ) {
		&clean_up;
		mkdir($Rpm_Dir, 0777) || die "    Could not create $Rpm_Dir:$!";
	}

	if ( ! -w $Rpm_Dir ) {
		$log = "$src.log";
		print STDERR "Switching default logfile to: $log\n";
	} else {
		$log = "$Rpm_Dir" . "/" . &basename($file) . ".log";
	}

	$log = "/dev/null" if ! $Install_It;
	if ( $Log ne '' ) {
		$log = $Log;
	}

	if ( $log =~ /%RPM%/ ) {
		my $base = &basename($file);
		$base = "RPM_LOG" unless $base;
		$log =~ s/%RPM%/$base/g;
	}

	$LOG = $log;
	print STDERR "logfile is: $log\n";

	sub log {
		local($x) = @_;
		print STDOUT $x, "\n";
		$x =~ s/"/\\"/g;
		system("echo \"$x\" >> $LOG");
	}

	system("echo >> $log");
	system("echo ========= `date` ======== >> $log");
	system("ls -l $src >> $log");

	local($rc, $base, $package1, $version, $rh_version, $arch1); 
	($rc, $base, $package1, $version, $rh_version, $arch1) 
		= &RH_Parse($file);

	if ( ! $rc ) {
		&log("    Could not RH_Parse: \"$file\"");
		return;
	}

	$file =~ s,^.*/,,;
	if ( $file !~ /\.rpm$/ )  {
		my $tmp = '';
		my $file_out = `file $src 2>/dev/null`;
		($tmp, $file_out) = split(/:/, $file_out, 2);
		if ( $file_out !~ /RPM/i ) {
			&log("    Not an rpm file: \"$file\" ($file_out)");
			return;
		}
	}
	$file =~ s,\.rpm$,,;

	chop($arch = `uname -m`);

	if ( $arch =~ /^i\d86$/ ) {
		$arch = 'i386';
	}
	if ( $file !~ /\.$arch$/ && $file !~ /\.noarch$/ )  {
		my $tmp = '';
		my $file_out = `file $src 2>/dev/null`;
		($tmp, $file_out) = split(/:/, $file_out, 2);
		if ( $file_out !~ /$arch/i ) {
			&log("    Wrong arch: \"$file\" ($arch) ($file_out)");
			return;
		}
	}
	$file =~ s,\.$arch$,,;

	
	$pkg = $package1;
###	$pkg =~ s,-(\d[\d\.\-\w]*)$,,;

	&log("");
	&log("    Package is \"$pkg\", version is \"${version}\", release is \"$rh_version\", arch is \"$arch\"");

	my $tf = $Tmp_File;
	
	local($current_version) = '';
	print STDOUT "\n>>> into $Rpm <<<\n";
	if ( system("$Rpm -q $pkg 1>$tf 2>&1") == 0 ) {
		&log("Existing/Installed pkg: ");
		system ("cat $tf; cat $tf >> $log"); 
		chop($current_version = `$Rpm -q $pkg`);
#		&msg("CV: $current_version\n");
#		&msg("RP: ${package1}-${version}-${rh_version}\n");
		if ( $current_version eq "${package1}-${version}-${rh_version}" ) {
			&log("    SKIPPING: Package $current_version already installed. ($base)");
			return;
		}
		&log("");
		system("$Rpm -q -l $pkg 2>&1 | xargs ls -ldt 2>&1 | tee -a $log");

		&log(">>> OLD (installed) REQUIRES:");
		system("$Rpm -q -R $pkg 2>&1 | tee -a $log");

		&log("");
		&log(">>> OLD (installed) PROVIDES:");
		system("$Rpm -q --provides $pkg 2>&1 | tee -a $log");

		&log("");
	} else {
		&log("NOT INSTALLED:");
		system ("cat $tf; cat $tf >> $log"); 
		if ( $Upgrade_Only ) {
			&log("    SKIPPING: Upgrading Only: package $package1 not installed. ($base)");
			return;
		}
	}

	&log(">>> NEW (uninstalled) REQUIRES:");
	system("$Rpm -q -R -p $src 2>&1 | tee -a $log");
	&log(">>> NEW (uninstalled) PROVIDES:");
	system("$Rpm -q --provides -p $src 2>&1 | tee -a $log");


	&log("");
	&log(">>> NEW CHECKSUMS/PGP:");
	local($args) = '';
	if ( ! $Do_PGP_Check ) {
		$args = '--nopgp ';
	}
	if ( system("$Rpm --checksig $args $src 1>$tf 2>&1") != 0 ) {
		system ("cat $tf; cat $tf >> $log"); 
		print STDOUT "\n<<< $Rpm >>>\n";
		&log("    SKIPPING: Package \"$src\", failed(1) rpm --checksig: $!\n");
		return;
	} elsif ( $Do_PGP_Check && `grep 'OK\$' $tf | grep -iv NOT | grep pgp` =~ /^\s*$/ ) {
		system ("cat $tf; cat $tf >> $log"); 
		print STDOUT "\n<<< $Rpm >>>\n";
		&log("    SKIPPING: Package \"$src\", failed(2) rpm --checksig: $!\n");
		return;
	} else {
		system ("cat $tf; cat $tf >> $log"); 
	}

	$cmd = "su root -c \"$Rpm $Rpm_Args $src\" 2>&1 | tee -a $log";
	my $cmsg = $cmd;
	$cmsg =~ s/2>/\n        2>/;
	&log("");
	&log(">>> $cmsg");
	&log("");

	if ( ! $Install_It ) {
		&log("    SKIPPING: *** DEBUG (-no_install) *** $pkg \[CURRENT=$current_version] ($base)");
		return;
	}
	if ( system($cmd) != 0 ) {
		print STDOUT "\n<<< $Rpm >>>\n";
		&log(">>> Install failed: $cmd: $!");
		
	} else {
		if ( system("$Rpm -q $pkg 1>$tf 2>&1") == 0 ) {
			system ("cat $tf; cat $tf >> $log"); 
			system("$Rpm -q -l $pkg | xargs ls -ldt | tee -a $log");
		} else {
			system ("cat $tf; cat $tf >> $log"); 
		}
		print STDOUT "\n<<< $Rpm >>>\n";
	}
}

sub List_Pkg {
	my ($item) = @_;

	my $orig = $item;
	# get package name:
	$item =~ s,^.*/,,; 
	$item =~ s,-(\d[\d\.\-\w]*)$,,;

	print STDOUT "PKG: $item\n";
	if ( system("$Rpm -q $item") == 0 ) {
		# print STDOUT "Package: " . `$Rpm -q $item`;
		system("$Rpm -q -l $item | xargs ls -ldt");
		print STDOUT "SIZE: ";
		system("$Rpm -q -l $item | xargs ls -ldt | awk '{print \$5}' | sum.pl | sed -e 's/\\.[0-9][0-9]*//'");
		print STDOUT "REQUIRES:\n";
		system("$Rpm -q -R $item");
		print STDOUT "PROVIDES:\n";
		system("$Rpm -q --provides $item");
	}

	if ( $orig =~ m,^(ftp|file|http)://, ) {
		print STDERR "Find Size? y/[n] ";
		my $reply = '';
		chop($reply = <STDIN>);
		if ( $reply =~ /^y/i ) {
			system("$Url_Size $orig");
		}
	}
	print STDERR "\n";
}

sub help {
	local($data) = @_;
	$data = $Usage if $data eq '';

	if ( $ENV{'PAGER'} ne '' && open(PAGER, "|$ENV{'PAGER'}") ) {		
		# open pipeline to user's pager
		print PAGER "$data";
		close(PAGER);
	} elsif ( open(MORE, "|more") ) {	# open pipeline to "more"
		print MORE "$data";
		close(MORE);
	} else {
		print STDERR "$data";
	}
}

sub clean_up {
	unlink($Tmp_File);
}

sub short_sleep {
	##############################################################
	# Do a sleep with fractional seconds. $time is a float.
	##############################################################
	local($time) = @_;
	select(undef, undef, undef, $time);
}

sub RH_Parse_orig {
	local($file) = @_;

	local($base, $pre1, $arch, $pre2, $rh_version, $pre3);
	local($package, $version);
	
	$base = &basename($file);
	if ( $base =~ /\.rpm$/ ) {
		$pre1 = $`;
	} else {
		&msg("    BAD match: $base\n");
		return 0;
	}

	if ( $pre1 =~ /\.([^\.]*)$/ ) {
		$arch = $1;
		$pre2 = $`;
		if ( ! &arch($arch) ) {
			&msg("arch ($arch) must match \"$Arch_Match\"\n");
			return 0;
		}
	} else {
		&msg("    BAD match: $pre1\n");
		return 0;
	}

	if ( $pre2 =~ /-([^-]*)$/ ) {
		$rh_version = $1;
		$pre3 = $`;
	} else {
		&msg("    BAD match: $pre2\n");
		return 0;
	}

	if ( $pre3 =~ /-([^-]*)$/ ) {
		$version = $1;
		$package = $`;
	} else {
		&msg("    BAD match: $pre3\n");
		return 0;
	}
	return (1, $base, $package, $version, $rh_version, $arch); 
}

sub RH_Parse {
	local($file) = @_;

	local($base, $pre1, $arch, $pre2, $rh_version, $pre3);
	local($package, $version);
	
	$base = &basename($file);
	
	chop($package		= `$Rpm -q --queryformat "%{NAME}\n" -p $file`);
	return 0 if $? >> 8;
	chop($version		= `$Rpm -q --queryformat "%{VERSION}\n" -p $file`);
	return 0 if $? >> 8;
	chop($rh_version	= `$Rpm -q --queryformat "%{RELEASE}\n" -p $file`);
	return 0 if $? >> 8;
	chop($arch		= `$Rpm -q --queryformat "%{ARCH}\n" -p $file`);
	return 0 if $? >> 8;
	if ( ! &arch($arch) ) {
		&msg("arch ($arch) must match \"$Arch_Match\"\n");
		return 0;
	}
	return (1, $base, $package, $version, $rh_version, $arch); 
}

sub basename {
        local($x) = @_;
        $x =~ s,^.*/,,;
        return $x;
}

sub msg {
	print STDERR @_;
}