#!/usr/bin/perl
# This program is copyright 2003 Konstantin Starodubtsev <kostya@ptc.spbu.ru>
#
# It is licensed under the terms of the GNU General Public License (GPL),
# version 2.0 or later, as published by the Free Software Foundation.
# See <http://www.gnu.org/copyleft/gpl.txt> for the terms of the latest version
# of the GNU General Public License.
#
# TODO
#  * Fix multi-line lslpp output processing.
#  * Situation when several updates with different version and product ID 
#    reported for one package name.
#  * Support lynx as .bff downloader instead of wget
#  * Check PGP signatures
#  * Check update server SSL Cert /* added to bugzilla */
#  * Make a "spool cleaner" to remove superseded packages. /* added to bugzilla */
#  * Make FTP support more clean 
#  * Do cleanups after SIGTERM
#  * look at geninstall man page :) (bautt)
#  
# THANKS
#  * To all members of #aix channel on irc.freenode.net
#
# CHANGES
#  v0.1 21-09-2003
#      * Initial public release
#
#  v0.2 22-09-2003
#      * Printing message when downloading LatestFixData file (bug reported by bautt)
#      * Checking if lynx supports HTTPS (bug reported by ggv)
#      * -h key added
#      
#  v0.3 22-09-2003
#      * support for RPMs update from Linux toolbox repository added (feature 
#        request by bautt)
#
#  v0.3.1 22-09-2003
#      * -P parameter for http proxy support (for those who are too lazy 
#        to know about http_proxy env variable)
#        
#  v0.3.2 01-10-2003
#      * Various changes regarding urls: bugzilla, project's home page, etc.
#
#  v0.3.3 03-10-2003
#      * Added cleanup function to rename and delete duplicate files.
#
#  v0.3.4 05-10-2003
#      * Notify if error was occured during package downloading (i.e. check 
#        for wget return code)
#
#  v0.4 05-10-2003
#      * Use smarter, bffcreate-based algorithm to determine if we need 
#        to d/l update.
#      * -X key for automatically extending filesystem with updates dir.
#      * `import' command to import directories with lots of updates.
#        (specify source dir with -t and target with -d)
#      * bffs are being downloaded to temporary directory first (specify 
#        with -t key)
#      * bugfix for cleanup function: deadloop unless -d was working dir.
#      * package renaming is now based on what bffcreate -l think about.
#
#  v0.4.1 10-10-2003
#      * SIGTERM/SIGINT handler for operations via system() call.
#      * Warn if we're running on system other than AIX 5
#
#  v0.4.2 11-10-2003
#      * small -F fixes
#      * fixed bug with aborting when target updates directory was empty
#
#  v0.4.3 20-10-2003
#      * export https_proxy environment variable too with -P flag
#
#  v0.4.4 07-11-2003
#      * small changes in diagnostic and runtime messages.
#
#  v0.4.5 15-04-2004
#      * fix for strings containing only PTF ID in compare_report output
#      * -m option for bumping up to latest maintenance level instead of 
#        default latest package versions

use warnings;
use strict;

use Getopt::Std;

# some constants

my $version = '0.4.5';
my $method = 'http';
my $server = 'www7b.boulder.ibm.com';
my $baseurl = 'aix/fixes/byCompID';
my $rpm_server = 'ftp.software.ibm.com';
my $rpm_baseurl = 'aix/freeSoftware/aixtoolbox';
my $lslpp = '/usr/bin/lslpp -q -c -i';
my $tmp = '/usr/sys/inst.images';
my $rpm_dir = '/usr/sys/inst.images/RPMS/ppc';
my $wget = 'wget -nv -nd -N';
my $lynx = 'lynx';
my $latest_fix_data_url_base = 'https://techsupport.services.ibm.com/server';
my $serverlist_url_base = "$method://$rpm_server/$rpm_baseurl/data"; #FIXME this should be just default.

my %opt = (
	b => $baseurl,	# Base url
	c => 0,		# remove LatestFixData file after processing (Clean)
	d => $tmp,	# Directory to download installp files to
	F => 0,		# force program running with prereqs failed
	f => undef,	# `LatestFixData5x' File
	h => 0,		# request a Help
	k => 0,		# Keep aix-get.$$.urls file after exiting
	m => 0,		# Update to latest maintenance level, not latest current
	n => 0,		# No updates downloading, just print URIs
	q => 0,		# Quiet mode
	P => undef,	# Use specified HTTP Proxy 
	R => 0,		# Update RPMs from official toolbox too
	r => $rpm_dir,	# directory to download RPM files to
	s => $server,	# Server with updates
	T => $rpm_server, # AIX Toolbox server
	t => '/tmp', # temp directory
	U => 0,		# run sm_inst _update_all after downloading
	u => "'-c' '-N' '-g' '-X'",	# flags passed to installp from sm_inst. -a -f -d are hardcoded.
	v => 0,		# be Verbose
	w => $wget,	# Wget command and params
	X => 0,  #Automatically extends the file system if space is needed.
);

my %help = (	
	b => "Base url [/$opt{b}]",
	c => "remove LatestFixData file after processing (Clean) [unset]",
	d => "Directory to download files to [$opt{d}]",
	F => "force program running with prereqs failed [unset]",
	f => "`LatestFixData5x' File [unset]",
	h => "print this Help",
	k => "Keep aix-get.\$pid.urls file after exiting [unset]",
	m => " Update to latest maintenance level, not latest current [unset]",
	n => "No updates downloading, just print URIs [unset]",
	q => "Quiet mode [unset]",
	P => "Use specified HTTP Proxy [`http_proxy' environment variable]",
	R => "Update RPMs from official toolbox too [unset]",
	r => "directory to download RPM files to [$opt{r}]",
	s => "Server with updates [$opt{s}]",
	t => "temporary directory [$opt{t}]",
	U => "run `sm_inst _update_all' after downloading [unset]",
	u => "flags passed to installp from sm_inst. -a -f -d are hardcoded.\n        [$opt{u}]",
	v => "be Verbose [unset]",
	w => "Wget command and params [$opt{w}]",
	X => "Automatically extends the file system if space is needed. [unset]",
);

my %not_found_messages = (
	oslevel => 
"Correct your PATH environment variable and return.",
	ksh => 
"You \$PATH should be really broken",
	compare_report => 
"To get more info about it and/or download go to 
https://techsupport.services.ibm.com/server/aix.techTips?refNo=0274",
	bffcreate => 
"Seems that your AIX installation is broken, as it is an essential package",
	lslpp => 
"Seems that your AIX installation is broken, as it is an essential package",
	wget => 
"You can either install it from 'AIX Toolbox for Linux Applications' CD or
dowload it from official toolbox page located at
http://www-1.ibm.com/servers/aix/products/aixos/linux/rpmgroups.html#Applications/Internet",
	lynx => 
"This program (version with SSL support) is required if you want to have 
LatestFixData file downloaded automatically. You can install it from 
'AIX Toolbox Cryptographic Content' ( i.e. lynx-2.8.4-1ssl.aix4.3.ppc.rpm )
or download it from http://www6.software.ibm.com/dl/aixtbx/aixtbx-p
If you have any reasons not to install lynx-ssl then you should provide
this file to $0 manually. See help for -f key.",
);

# We should make it global to use `write' function
my( $ptf, $comp_id, $fileset, $cur_level, $avail_level, @urls_installp, @urls_rpm );

format STDOUT_TOP = 
   PTF      CompID           fileset                 installed       available
--------+-----------+------------------------------+-------------+-------------
.
	
format STDOUT =
@<<<<<<<| @<<<<<<<< | @<<<<<<<<<<<<<<<<<<<<<<<<<<< | @<<<<<<<<<< -> @<<<<<<<<<<
  $ptf,$comp_id,$fileset,$cur_level,$avail_level
.

sub sigterm {
	print STDERR "Interrupted by SIGTERM. Exiting..\n";
	exit 15;
}

sub sigint {
	print STDERR "Interrupted by SIGINT. Exiting..\n";
	exit 2;
}

#############################################################################
#############################################################################
#############################################################################

$SIG{INT} = \&sigint;
$SIG{TERM} = \&sigterm;

getopts( 'b:cd:Ff:hknmqP:Rr:s:T:t:Uu:vw:X', \%opt );
exit print_help() if $opt{h};
if( $ARGV[0] ) {
	my $ret = -1;
	if( $ARGV[0] eq 'clean' ){	
		$ret = do_cleanup( $opt{d} );
	}elsif( $ARGV[0] eq 'import' ){
		$ret = do_import( $opt{t}, $opt{d} );
	}
	exit $ret;
}

$ENV{http_proxy} = $ENV{https_proxy} = $opt{P} if $opt{P};

my $DEBUG = $opt{v};

my %dl_dir = (
	installp => $opt{d},
	rpm => $opt{r},
);


check_prerequisites() && exit 1;
print "Checking for available packages..\n" if $opt{v};
my @available_bffs = get_dir_available_bffs( $dl_dir{installp} );
	
@urls_installp = process_fixdata( ( $opt{f} || get_latest_fix_data( $opt{d} ) ), \@available_bffs );
@urls_rpm = process_serverlist( get_serverlist( $opt{r}) ) if $opt{R};

# we're up-to-date
unless( @urls_installp or @urls_rpm ) {
	print "Your system seems to be up-to-date.\n";
	exit 0;
}

my %dl_urls = (
	installp => \@urls_installp,
	rpm => \@urls_rpm,
);

my @todo = ( 'installp' ); 
push( @todo, 'rpm' ) if $opt{R};

my $tmpdir = "$opt{t}/aix-get.bff.cache";
-d $tmpdir or mkdir( $tmpdir ) or die "Can't create `$tmpdir': $!";
$dl_dir{installp} = $tmpdir;
print "Temporary directory is `$tmpdir'\n" if $opt{v};

my ( $downloaded, $total ) = ( 0, 0 );

for my $pt ( @todo ) {
	my $wget_cmd = "$wget -q -P $dl_dir{$pt}";
	my @urls = @{$dl_urls{$pt}};

# --no-download
	if( $opt{n} ) {
		my $urlfile_name = "$dl_dir{$pt}/aix-get.$$.$pt.urls";
		open( URLFILE, ">>$urlfile_name" ) or die "Can't open $urlfile_name: $!";
		print URLFILE join( "\n", @urls );
		close URLFILE;
		print( "Run `$wget_cmd -i $urlfile_name' to download $pt updates\n");
		next;
	}

# I think it's better to run one wget per file as we can produce a nice
# progress output then.

	for ( @urls ) {
		my $ret;
		/\/([^\/]+)$/;
		print "Getting $1.. ";
		print( "already downloaded.\n" ), next if /^#/;
		$total++;
		if( $ret = system( "$wget_cmd $_" ) ) {
			ugly( $ret ); # err.. graceful
			print "failed\n";
		}else{
			print "ok\n";
			$downloaded++;
		}
	}

	#TODO that's not a joke, we'll use more useful $total in future
	print "$pt downloading finished. Got $downloaded/$total of ".(scalar @urls)." packages.\n";

	run_inutoc( $dl_dir{$pt} );
}

move_bffs( $tmpdir, $opt{d} ) if $downloaded;

# install updates
if( $opt{U} ) {
	my $sm_inst_command = "/usr/lib/instl/sm_inst installp_cmd -a -d '$opt{d}' -f '_update_all' $opt{u}";
	print "Running $sm_inst_command..\n";
	ugly( system( $sm_inst_command ), $sm_inst_command );
	if( $opt{R} ) {
		for( @urls_rpm ) {
			my $fname = $_; $fname =~ s|^.+/([^/]+?\.rpm)$|$1|;
			my $rpm_update_command = "rpm -Uhv $dl_dir{rpm}/$fname";
			print "Running $rpm_update_command..\n";
			system( $rpm_update_command );
		}
	}
}
	
print "Finished.\n";

exit 0;

#############################################################################
#############################################################################
#############################################################################

#####################################################################
# @urls = process_fixdata( $path_to_latestfixdata_file )
####
sub process_fixdata {
	my( $fixdata, $available_bffs ) = @_;
	my( @installp_urls );
	my $command = "ksh -c 'compare_report -s -r $fixdata -l'"; 

	print "Checking for upgradable packages..\n";
	open( FIXDATA, "$command |" ) or die "Can't execute `$command': $!";

	if( $opt{m} ) {
		print "Getting packages only for latest ML\n" if $opt{v};
		while( <FIXDATA> ) {
			last if /^\Q#(lowerthanmaint.rpt)\E/;
		}
	}

	while( <FIXDATA> ) {
		next if /^\s*#/;
		chomp;
		next if /^$/;
		( $ptf, $fileset, $cur_level, $avail_level ) = split /:/;

		# I don't know what means a string with only PTF number on it so let's skip it
		next if $ptf and not $fileset;

		my $already_dl = grep( { /^\Q$fileset.$avail_level.\E(I|U)$/ } @$available_bffs ) ? '# ' : '';
		
		$fileset =~ /^([^\.]+\.[^\.]+)/;
		my $dir = $1 or die "`$command': Can't add dir for '$fileset' (ptf $ptf)";
		$comp_id = (split /:/, `$lslpp $fileset`)[3];
		$comp_id =~ s/\-//g;
		print( STDERR "Can't determine product ID for $fileset.\nPlease update to latest maintanance level manually first\n(consider -m option for aix-get)\n or just install base level fileset if it is missing." ), last unless $comp_id;
		write unless $opt{q};
		my $url = $already_dl."${method}://$server/$baseurl/$comp_id/$dir/${fileset}.${avail_level}.bff";
		push @installp_urls, $url;
	}

	close FIXDATA;
	unlink $fixdata if $opt{c};
	return @installp_urls;
}

#####################################################################
# @urls = process_serverlist( $path_to_serverlist_file )
####
sub process_serverlist {
	my( $serverlist ) = @_;
	my( %rpms, @rpm_urls );
	$comp_id = 'RPM'; $ptf = 'n/a';
	
	my $command = "rpm -qa --qf '\%{NAME}:\%{SERIAL}:\%{VERSION}:\%{RELEASE}\n'";
	print "Checking for upgradable RPM packages..\n" if $opt{v};

	my @rpms = `$command`;
	foreach ( @rpms ) {
		chomp;
		my @d = split /:/;
		$d[1] = 0 if $d[1] eq '(none)'; # there's no need to print default serials
		$rpms{$d[0]} = { serial => $d[1], version => $d[2], release => $d[3] };
	}

	open( SERVERLIST, "<$serverlist" ) or die "Can't open $serverlist: $!";
	while( <SERVERLIST> ) {
		chomp;
		next unless $_;
		
		# zlib-devel-1.1.4-3.aix4.3.ppc.rpm-1
		print( STDERR "Couldn't parse `$_'. Please report.\n" ), next 
			unless /^.+?\/(([^\-]+)(\-.+)*?)\-([^\-]+)\-(\d+)\.aix[45]\.\d\.\w+\.rpm\-(\d+)$/;
			
		my( $name, $serial, $version, $release ) = ( $1, $6, $4, $5 );
		$serial = 0 if $serial == 1; # there's no need to print default serials
		my $url_tail = $_; $url_tail =~ s/rpm\-\d+$/rpm/;
		
		if( exists $rpms{$name} ){
			my $rpm = $rpms{$name};
			my $q = cmp_rpm_versions( 
				$serial, $version, $release,
				$rpm->{serial}, $rpm->{version}, $rpm->{release} 
			); # if first is bigger than second
			next unless $q == 1;
			
			( $fileset, $cur_level, $avail_level ) = ( 
				$name,
				( $rpm->{serial} ? "$rpm->{serial}:" : '' )."$rpm->{version}-$rpm->{release}", 
				( $serial ? "${serial}:" : '' ). "$version-$release" 
			);
			write;
			my $url = "${method}://$rpm_server/$rpm_baseurl/RPMS/ppc/$url_tail";
			push @rpm_urls, $url;
		}
	}
	close SERVERLIST;

	unlink $serverlist if $opt{c};
	return @rpm_urls;
}	

###################################################
# Shity, eh?
####
sub cmp_rpm_versions {
	my( $a_s, $a_v, $a_r, $b_s, $b_v, $b_r ) = @_; # this is ugly but can't use brains anymore :-)
	return $a_s <=> $b_s if $a_s and $b_s and $a_s <=> $b_s; # I don't know how serials are enumerated but they are main

	my @a = split /\./, $a_v;
	my @b = split /\./, $b_v;
	for( my $i=0; $i < @a; $i++ ) { 
		my $zz = ( uc( "x$a[$i]" ) cmp uc( "x$b[$i]" ) ); 
		return $zz if $zz; 
	}
	
	@a = split /\./, $a_r;
	@b = split /\./, $b_r;
	for( my $i=0; $i < @a; $i++ ) { 
		unless( $a[$i] =~ /^\d+$/ and $b[$i] =~ /^\d+$/ ) {
#			print STDERR "I do not work with releases with alpha characters inside. Please resolve this yourself.\n" unless $opt{q};
			last;
		}
		my $zz = ( $a[$i] <=> $b[$i] ); 
		return $zz if $zz; 
	}
	return 0;
}

#################################################
# downloads LatestFixData and serverlist files
####
sub get_latest_fix_data {
	my( $path ) = @_;

	my $oslevel = ( `oslevel -r` =~ /^(\d\d)\d+\-(\d\d)$/ );
	my ( $version, $ml ) = ( $1, $2 );
	my $file = "LatestFixData$version";
	my $url = "${latest_fix_data_url_base}/$file";

	print "Downloading $file..";
	ugly( system( "$lynx -dump $url > '$path/$file' " ), "lynx -dump $url" );
	print "done.\n";

# we should make a better LatestFixData validation later
	open( LFD, "<$path/$file" ) or die "Can't open $path/${file}: $!";
	$_ = <LFD>; die "Error during downloading LatestFixData file" unless /^#/;
	close LFD;

	return "$path/$file";
}

##########################################################
# download list of available rpms
######
sub get_serverlist {
	my( $path ) = @_;
	my $file = "serverlist";
	my $url = "$serverlist_url_base/$file";
	
	print "Downloading $file..";
	ugly( system( "$lynx -dump $url > '$path/$file' " ), "lynx -dump url" );
	print "done.\n";
	
#FIXME no normal serverlist file validation yet
	die "Error during downloading $url" unless -s "$path/$file";
	return "$path/$file";
}


##########################################################
# Check various programs required for successfull run
######
sub check_prerequisites {
	my $err;

	print( STDERR "This is not AIX!\nI'll continue with -F only.\n" ), exit 3  unless $^O eq 'aix' or $opt{F};

	die "Can't find working `which'. Aborting.\n" unless -x '/usr/bin/which';
	for ( qw/oslevel ksh lslpp bffcreate compare_report wget lynx rpm/ ) {
		my $ret = system( "which $_ >/dev/null" ); 
		print( STDERR "Can't find working `$_' somewhere in the \$PATH.\n$not_found_messages{$_}\n\n" ), $err++ if $ret > 0;
	}
	return 1 if $err and not $opt{F};

	my $oslevel = `oslevel`;
	unless( (split /\./, $oslevel)[0] == 5 or $opt{F} ) {
		print STDERR "Only AIX 5 is supported while your AIX version is $oslevel";
		exit 5;
	}

# let's check if lynx support ssl now
	if( !$opt{f} and `lynx -dump https://localhost/ 2>&1` =~ /\QAlert!: Unsupported URL scheme!\E/s ) {
		print STDERR "Your `lynx' doesn't support HTTPS protocol, therefore you should 
 provide $0 with LatestFixData file for your release manually. 
 See `-f' key for more help.\n";
 		return 4;
	}
	return 0;
}

####################################################
# prints out help message ( -h key )
#####
sub print_help {
	my( $key, $str );

	no warnings; # 
	print <<HELP;
Usage: aix-get [-h] [-cfFknqvU] [-d <dir>] [clean|{ -t <dir> import}]
See `aix-get -h' for complete help.

Version: $version
URL: http://aix-get.sf.net/

This program is copyright 2003 Konstantin Starodubtsev <kostya\@ptc.spbu.ru>

It is licensed under the terms of the GNU General Public License (GPL),
version 2.0 or later, as published by the Free Software Foundation.
See <http://www.gnu.org/copyleft/gpl.txt> for the terms of the latest version
of the GNU General Public License.

Please report bugs and wishes to aix-get bug tracker page on SourceForge.
HELP

	for ( sort keys %help ) {
		print "  -$_   $help{$_}\n";
	}
	return 0;
}

#######################################################
# do_import( $from, $to )
# moves and renames packages from $from to $to
####
sub do_import {
	my( $from, $to ) = @_;
	print "Importing directory `$from'..\n";
	my $ret = move_bffs( $from, $to );
	print "Import ".($ret ? "failed" : "finished successfully")."\n";
	return $ret;
}

#######################################################
# cleans up .bff directory
# do_cleanup( $bff_dir )
####
sub do_cleanup {
	my $dir = shift;
	my( $content, @packages, $changed );
	print_help(), return -1 unless -d $dir;

# check if .toc was not updated after dir change
	run_inutoc( $dir );

	open( TOC, "<$dir/.toc" ) or die "Can't open $dir/.toc: $!";
	$_ = <TOC>; # skip first string
	{
		local $/;
		$content = <TOC>;
	}
	close TOC;
	
	push( @packages, $1 ) while $content =~ 
	m{
		(
		[^{}]+
		\{
			(
				(?> [^{}]+ )
			|
			\{ 
				[^{}]*
				(
					(?> [^{}]+ )
					|
					\{ [^{}]+ \}
				)+
			\}
			)+
		\}
		)
	}gx;

	my @good_names = get_dir_available_bffs( $dir );
	my $noname = 0;

	for my $package ( @packages ) {
		chomp $package;
		print( STDERR "\ngot shit, please commit bugreport:\n$package\n------\n" ), next unless
			$package =~ /^\s*(\S+)\s[^\{]+\{\s*(\S+)\s+([\d\.]+)/s;
	#                       filename		  package   version
	#                       
		my( $filename, $package, $version ) = ( $1, $2, $3 );
		$version = join '.', map { sprintf( "%d", $_ ) } split( /\./, $version );
		my $good_name = (grep { /^\Q$package.$version.\E(I|U)$/ } @good_names )[0];
		$noname++, print( STDERR "Can't find good name for $filename\n" ), next unless $good_name;

		print( STDERR "repository inconsistency detected (on $filename) " ), run_inutoc( $dir, 'force' ) unless -f "$dir/$filename";
	
		unless( $filename eq $good_name ) {
			print "$filename should be $good_name\n" if $opt{v};
			next if $opt{n};
			$changed++;

			if( -f "$dir/$good_name" ) {
				die "$filename should become $good_name, but target is already exists and differs from source!\n" unless -s "$dir/$filename" == -s "$dir/$good_name";
				print "\t$good_name already exists, removing $filename\n" unless $opt{q};
				unlink "$dir/$filename" or die "Can't remove $dir/${filename}: $!";
				next;
			}
			print "Renaming $filename to $good_name\n" unless $opt{q};
			rename( "$dir/$filename", "$dir/$good_name" ) or die "Can't rename $dir/$filename to $dir/$good_name: $!";
		}
	}

	print STDERR <<MSG;

Couldn't rename $noname file(s). The possible reason is that that file(s)
wants to have different fileset name (usually shorter) than it is 
representing actually. I beleive this is incorrect so it's up to you
what to do with that files. They are still fully installable though.
MSG
	run_inutoc( $dir, 'force' ) if $changed;
	return 0;
}

####################################################
# make .toc in $dir if necessary or if $force
#####
sub run_inutoc {
	my( $dir, $force ) = @_;	
	if( $force or !( -f "$dir/.toc" ) or ( (stat($dir))[9] > (stat("$dir/.toc"))[9] ) ) {
		print "Running inutoc.." unless $opt{q};
		ugly( system( "inutoc $dir" ), "inutoc $dir" );
		print " done\n" unless $opt{q};
	}
}

####################################################
# get array of available bffs in $dir.
#####
sub get_dir_available_bffs {
	my( $dir ) = @_;
	my @ret = ();
	my $command = "bffcreate -l -d '$dir'"; #FIXME do a proper escaping in future

	run_inutoc( $dir );
	
	open( BFFCREATE, "$command 2>&1 |" ) or die "Can't execute `$command': $!";
	$_ = <BFFCREATE>;
	if( $_ and /Package Name/ ) {
		$_ = <BFFCREATE>;

		while( <BFFCREATE> ) {
			print STDERR "got shit: $_" unless my( $fileset, $version, $type ) = /^\s*(\S+)\s+([\d\.]+)\s+(I|U)\s+/;
			push @ret, "$fileset.$version.$type";
		}
		close BFFCREATE || die "bffcreate error: $!/$?";
	}else{
		close BFFCREATE;
		if( ( $? >> 8 ) == 139 ) {
			# dir is empty. That's ok for now.
			print "Target dir is empty, but you can ignore this message\n" unless $opt{q};
		}else{
			die "bffcreate output seems to be broken ($!/$?). Aborting.";
		}
	}
	return @ret;
}

###############################################################
# move_bffs( $from_dirm, $to_dir )
#####
sub move_bffs {
	my( $from, $to ) = @_;
	die "Bff dir is not exist." unless -d $from and -d $to;
	print "Moving downloaded packages to updates directory.. ";
	ugly( system( "bffcreate ".( $opt{X} ? '-X ' : '' )."-q -v -t $to -d $from all" ) ) and die "Error running bffcreate: $!";
	print "done\n";
	return 0;
}

##############################################################
# die with some messages if our subprocess caught signal
#####
sub ugly {
	my( $ret, $msg ) = @_;
	$msg ||= 'command';
	if( $ret == -1 ){
		die "Can't run `$msg': $!";
	}elsif( ($ret & 127) == 15 ){
		sigterm();
	}elsif( ($ret & 127) == 2 ){
		sigint();
	}elsif( $ret & 127 ){
		die "Caught unknown signal: ".($ret & 127 );
	}
	return $ret;
}