#!/usr/bin/perl

#- Copyright (C) 1999,2001 MandrakeSoft (pixel@linux-mandrake.com)
#-
#- This program is free software; you can redistribute it and/or modify
#- it under the terms of the GNU General Public License as published by
#- the Free Software Foundation; either version 2, or (at your option)
#- any later version.
#-
#- This program is distributed in the hope that it will be useful,
#- but WITHOUT ANY WARRANTY; without even the implied warranty of
#- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#- GNU General Public License for more details.
#-
#- You should have received a copy of the GNU General Public License
#- along with this program; if not, write to the Free Software
#- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.

#use strict qw(subs vars refs);
use urpm;

#- get I18N translation method.
import urpm _;

#- default options.
my $update = 0;
my $media = 0;
my $auto = 0;
my $allow_medium_change = 0;
my $auto_select = 0;
my $force = 0;
my $sync = undef;
my $X = 0;
my $WID = 0;
my $all = 0;
my $rpm_opt = "vh";
my $use_provides = 1;
my $fuzzy = 0;
my $src = 0;
my $noclean = 0;
my $verbose = 0;
my $root = '';
my $bug = '';
my $log = '';

my $uid;
my @files;
my @src_files;
my @rpms_install;
my @rpms_upgrade;
my @names;
my @src_names;

$ENV{PATH} = "/sbin:/usr/sbin:/bin:/usr/bin:/usr/X11R6/bin";
delete @ENV{qw(ENV BASH_ENV IFS CDPATH)};
($<, $uid) = ($>, $<);
    
sub usage {
    print STDERR _("urpmi version %s
Copyright (C) 1999, 2000, 2001, 2002 MandrakeSoft.
This is free software and may be redistributed under the terms of the GNU GPL.

usage:
") . _("  --help         - print this help message.
") . _("  --update       - use only update media.
") . _("  --media        - use only the media listed by comma.
") . _("  --auto         - automatically select a good package in choices.
") . _("  --auto-select  - automatically select packages for upgrading the system.
") . _("  --fuzzy        - impose fuzzy search (same as -y).
") . _("  --src          - next package is a source package (same as -s).
") . _("  --noclean      - keep rpm not used in cache.
") . _("  --force        - force invocation even if some packages do not exist.
") . _("  --wget         - use wget to retrieve distant files.
") . _("  --curl         - use curl to retrieve distant files.
") . _("  --bug          - output a bug report in directory indicated by next arg.
") . _("  --X            - use X interface.
") . _("  --best-output  - choose best interface according to the environment:
                   X or text mode.
") . _("  -a             - select all matches on command line.
") . _("  -p             - allow search in provides to find package.
") . _("  -P             - do not search in provides to find package.
") . _("  -y             - impose fuzzy search (same as --fuzzy).
") . _("  -s             - next package is a source package (same as --src).
") . _("  -q             - quiet mode.
") . _("  -v             - verbose mode.
") . "\n" . _("  names or rpm files given on command line are installed.
", $urpm::VERSION);
    exit(0);
}

#- parse arguments list.
my @nextargv;
for (@ARGV) {
    /^--help$/ and do { usage; next };
    /^--update$/ and do { $update = 1; next };
    /^--media$/ and do { push @nextargv, \$media; next };
    /^--mediums$/ and do { push @nextargv, \$media; next };
    /^--auto$/ and do { $auto = 1; next };
    /^--allow-medium-change$/ and do { $allow_medium_change = 1; next };
    /^--auto-select$/ and do { $auto_select = 1; next };
    /^--fuzzy$/ and do { $fuzzy = 1; next };
    /^--src$/ and do { $src = 1; next };
    /^--noclean$/ and do { $noclean = 1; next };
    /^--force$/ and do { $force = 1; next };
    /^--wget$/ and do { $sync = \&urpm::sync_wget; next };
    /^--curl$/ and do { $sync = \&urpm::sync_curl; next };
    /^--bug$/ and do { push @nextargv, \$bug; next };
    /^--X$/ and do { $X = 1; next };
    /^--WID=(.*)$/ and do { $WID = $1; next };
    /^--WID$/ and do { push @nextargv, \$WID; next };
    /^--best-output$/ and do { $X ||= $ENV{DISPLAY} && -x "/usr/X11R6/bin/grpmi" && system('/usr/X11R6/bin/xtest', '') == 0;
			       next };
    /^--comment$/ and do { push @nextargv, undef; next };
    /^--root$/ and do { push @nextargv, \$root; next };
    /^-(.*)$/ and do { foreach (split //, $1) {
	/[\?h]/ and do { usage; next };
	/a/ and do { $all = 1; next };
	/c/ and do { next };
	/m/ and do { next };
	/M/ and do { next }; #- nop
	/q/ and do { $rpm_opt = ""; next };
	/p/ and do { $use_provides = 1; next };
	/P/ and do { $use_provides = 0; next };
	/y/ and do { $fuzzy = 1; next };
	/s/ and do { $src = 1; next };
	/v/ and do { $verbose = 1; next };
	die _("urpmi: unknown option \"-%s\", check usage with --help\n", $1); } next };
    @nextargv and do { my $r = shift @nextargv; $r and $$r = $_; next };
    if (/\.rpm$/) {
	if (/\.src\.rpm$/) {
	    push @src_files, $_;
	} else {
	    push @files, untaint($_);
	}
	next;
    }
    if ($src) {
	push @src_names, $_;
    } else {
	push @names, $_;
    }
    $src = 0; #- reset switch for next package.
}

#- params contains informations to parse installed system.
my $urpm = new urpm;
my ($pid_out, $pid_err);

#- prepare bug report.
if ($bug) {
    system("rm", "-rf", $bug);
    mkdir $bug or $urpm->{fatal}(8, _("Unable to create directory [%s] for bug report", $bug));
    #- copy all synthesis file used, along with configuration of urpmi
    system("cp", "-af", $urpm->{config}, $urpm->{skiplist}, $urpm->{instlist}, $bug);
    local *DIR;
    opendir DIR, $urpm->{statedir};
    while (defined ($_ = readdir DIR)) {
	/synthesis\./ and system "cp", "-af", "$urpm->{statedir}/$_", $bug;
    }
    closedir DIR;
    #- and a dump of rpmdb itself as synthesis file.
    my $db = URPM::DB::open($root);
    my $sig_handler = sub { undef $db; exit 3 };
    local $SIG{INT} = $sig_handler;
    local $SIG{QUIT} = $sig_handler;
    local *RPMDB;
    open RPMDB, "| " . ($ENV{LD_LOADER} || '') . " gzip -9 >'$bug/rpmdb.cz'";
    $db->traverse(sub{
		      my ($p) = @_;
		      $p->pack_header;
		      $p->build_info(fileno *RPMDB);
		  });
    close RPMDB;
    #- allow log file.
    $log = "$bug/urpmi.log";
}
if ($uid > 0) {
    #- only src files are installable using urpmi.
    @names || @files and $urpm->{fatal}(1, _("Only superuser is allowed to install packages"));

    #- allow installation.
    @rpms_install = @src_files;

    #- allow log.
    $log = "/var/log/urpmi.log";
}
if ($log) {
    #- log only at this point in case of query usage.
    log_it(scalar localtime, " urpmi called with @ARGV\n");

    open SAVEOUT, ">&STDOUT"; select SAVEOUT; $| = 1;
    open SAVEERR, ">&STDERR"; select SAVEERR; $| = 1;
    unless ($pid_out = open STDOUT, "|-") {
	open F, ">>$log"; select F; $| = 1;
	select SAVEOUT; $| = 1;
	$/ = \1;
	while (<STDIN>) {
	    print SAVEOUT $_;
	    print F $_;
	}
	close F;
	exit 0;
    }
    unless ($pid_err = open STDERR, "|-") {
	open F, ">>$log"; select F; $| = 1;
	select SAVEERR; $| = 1;
	$/ = \1;
	while (<STDIN>) {
	    print SAVEERR $_;
	    print F $_;
	}
	close F;
	exit 0;
    }
    select STDERR; $| = 1;     # make unbuffered
    select STDOUT; $| = 1;     # make unbuffered
}

#- use specific sync routine.
$sync and $urpm->{sync} = $sync;

#- remove verbose if not asked.
$verbose or $urpm->{log} = sub {};

$urpm->configure(nocheck_access => $uid > 0,
		 media => $media,
		 update => $update,
		);

my ($start, $end) = $urpm->register_rpms(@files, @src_files);

#- relocate depslist.
$urpm->relocate_depslist_provides();

#- select individual files.
my %packages;
defined $start && defined $end and @packages{($start .. $end)} = ();

#- search the packages according the selection given by the user,
#- basesystem is added to the list so if it need to be upgraded,
#- all its dependency will be updated too.
#- make sure basesystem exists before.
if (@names) {
    $urpm->search_packages(\%packages, [ @names ],
			   all => $all,
			   use_provides => $use_provides,
			   fuzzy => $fuzzy)
	or $force or exit 1;
}
if (@src_names) {
    $urpm->search_packages(\%packages, [ @src_names ],
			   all => $all,
			   use_provides => $use_provides,
			   fuzzy => $fuzzy,
			   src => 1)
	or $force or exit 1;
}

#- filter to add in packages selected required packages.
my $ask_choice = sub {
    my ($urpm, $from_id, @choices_id) = @_;
    my $n = 1; #- default value.
    my ($from, @l) = map { my $pkg = $urpm->{depslist}[$_]; scalar $pkg->fullname } ($from_id, @choices_id);

    if (@l > 1 && !$auto) {
	my $msg = (defined $from_id ?
		   _("One of the following packages is needed to install %s:", $from) :
		   _("One of the following packages is needed:"));
	if ($X) {
	    `gchooser "$msg" @l`;
	    $n = $? >> 8 || die;
	} else {
	    print SAVEOUT "$msg\n";
	    my $i = 0; foreach (@l) { print SAVEOUT " ", ++$i, "- $_\n"; }
	    while (1) {
		printf SAVEOUT _("What is your choice? (1-%d) ", $i);
		$n = <STDIN>;
		defined $n or exit 1;
		1 <= $n && $n <= $i and last;
		print SAVEOUT _("Sorry, bad choice, try again\n");
	    }
	}
    }

    $choices_id[$n - 1];
};

#- open/close of database should be moved here, in order to allow testing
#- some bogus case and check for integrity.
{
    my $db = URPM::DB::open($root);
    my $sig_handler = sub { undef $db; exit 3 };
    local $SIG{INT} = $sig_handler;
    local $SIG{QUIT} = $sig_handler;

    #- auto select package for upgrading the distribution.
    if ($auto_select) {
	my (%to_remove, %keep_files);

	$urpm->select_packages_to_upgrade($db, \%packages, \%to_remove, \%keep_files);

	if (keys(%to_remove) > 0) {
	    $urpm->{error}(_("some packages have to be removed for being upgraded, this is not supported yet\n"));
	}
    }

    $urpm->filter_packages_to_upgrade($db, \%packages, $ask_choice);
    #- my $track = $urpm->filter_packages_to_upgrade(\%packages, $ask_choice, track => 1);
    #- require Data::Dumper;
    #- print STDERR Data::Dumper->Dump([$track], ['$track']);
}

#- get out of package that should not be upgraded.
$urpm->deselect_unwanted_packages(\%packages);

#- package to install as a array of strings.
my @to_install;

#- check if there is at least one package to install that
#- has not been given by the user.
my $ask_user = $auto_select && scalar(keys %packages);
my $sum = 0;
my @root_only;

foreach (keys %packages) {
    defined $packages{$_} and $ask_user = 1;
    my $pkg = $urpm->{depslist}[$_];
    my $fullname = $pkg->fullname;
    if ($uid > 0 && $pkg->arch ne 'src') {
	push @root_only, $fullname;
    } elsif ($uid > 0 || $pkg->arch ne 'src') {
	$sum += $pkg->size;
	push @to_install, $fullname;
    }
}
if (@root_only) {
    print STDERR _("You need to be root to install the following dependencies:\n%s\n", join ' ', @root_only);
    exit 1;
} elsif (!$auto && $ask_user) {
    my $msg = _("To satisfy dependencies, the following packages are going to be installed (%d MB)", toMb($sum));
    my $msg2 = _("Is it OK?");
    if ($X) {
	my $p = join "\n", @to_install;
	my $ok = _("Ok");
	my $cancel = _("Cancel");
	`gmessage -default $ok -buttons "$ok:0,$cancel:2" "$msg:\n$p\n\n$msg2"`;
	$? and exit 0;
    } else {
	$noexpr = _("Nn");
	$yesexpr = _("Yy");
	if (!$log) {
	    print STDOUT "$msg:\n@to_install\n$msg2" . _(" (Y/n) ");
	} else {
	    print SAVEOUT "$msg:\n@to_install\n$msg2" . _(" (Y/n) ");
	}
	<STDIN> =~ /[$noexpr]/ and exit 0;
    }
}

#- if not root, the list become invisible and no download will be possible.
my ($local_sources, $list, $local_to_removes) = $urpm->get_source_packages(\%packages);
unless ($local_sources || $list) {
    $urpm->{fatal}(3, _("unable to get source packages, aborting"));
}
#- clean cache with file that are not necessary with this transaction.
unless ($noclean) {
    foreach (@$local_to_removes) {
	unlink $_;
    }
}

my %sources = $urpm->download_source_packages($local_sources, $list, ($X ? '' : 'force_local'),
					      (!$auto || $allow_medium_change) && sub {
						  my $msg = _("Please insert the medium named \"%s\" on device [%s]", @_);
						  my $msg2 = _("Press Enter when it's done...");
						  if ($X) {
						      my $ok = _("Ok");
						      my $cancel = _("Cancel");
						      $msg =~ s/"/\\"/g;
						      `gmessage -default $ok -buttons "$ok:0,$cancel:2" "$msg"`;
						      !$?;
						  } else {
						      if (!$log) {
							  print STDOUT "$msg\n$msg2 ";
						      } else {
							  print SAVEOUT "$msg\n$msg2 ";
						      }
						      defined <STDIN>;
						  }
					      });

#- install package.
if ($uid == 0) {
    @rpms_install = grep { $_ !~ /\.src\.rpm$/ } values %{$urpm->extract_packages_to_install(\%sources) || {}};
    @rpms_upgrade = grep { $_ !~ /\.src\.rpm$/ } values %sources;
}

if (@rpms_install || @rpms_upgrade) {
    if (!$log) {
	printf STDOUT _("installing %s\n", join(' ', @rpms_install, @rpms_upgrade));
    } else {
	printf SAVEOUT _("installing %s\n", join(' ', @rpms_install, @rpms_upgrade));
    }
    log_it(scalar localtime, " @_\n");
    #- check for local files.
    foreach (@rpms_install, @rpms_upgrade) {
	m|^/| && ! -e $_ or next;
	message(_("Installation failed, some files are missing.\nYou may want to update your urpmi database"));
	exit 2;
    }
    $urpm->{log}("starting installing packages");
    if ($X && !$root) {
	system("grpmi", $WID ? ("--WID=$WID") : (),
	       (map { ("-noupgrade", $_) } @rpms_install), @rpms_upgrade);
	if ($?) {
	    #- grpmi handles --nodeps and --force by itself,
	    #- and $WID is defined when integrated in rpminst.
	    $WID or message(_("Installation failed"));
	    exit(($? >> 8) + 32); #- forward grpmi error + 32
	}
    } else {
	if (@rpms_install) {
	    system("rpm", "-i$rpm_opt", "--nodeps", @rpms_install, ($root ? ("--root", $root) : ()));
	    if (@$_) {
		message(_("Installation failed"));

		m|^/| && !-e $_ and exit 2 foreach @rpms_install; #- missing local file
		$auto and exit 1; #- if auto has been set, avoid asking user.

		$noexpr = _("Nn");
		$yesexpr = _("Yy");
		if (!$log) {
		    print STDOUT _("Try installation even more strongly (--force)? (y/N) ");
		} else {
		    print SAVEOUT _("Try installation even more strongly (--force)? (y/N) ");
		}
		$force or <STDIN> =~ /[$yesexpr]/ or exit 1;
		$urpm->{log}("starting force installing packages without deps");
		system("rpm", "-i$rpm_opt", "--nodeps", "--force", @rpms_install, ($root ? ("--root", $root) : ()));
	    }
	}
	if (@rpms_upgrade) {
	    system("rpm", "-U$rpm_opt", @rpms_upgrade, ($root ? ("--root", $root) : ()));
	    if ($?) {
		message(_("Installation failed"));

		m|^/| && !-e $_ and exit 2 foreach @rpms_upgrade; #- missing local file
		$auto and exit 1; #- if auto has been set, avoid asking user.

		$noexpr = _("Nn");
		$yesexpr = _("Yy");
		if (!$log) {
		    print STDOUT _("Try installation without checking dependencies? (y/N) ");
		} else {
		    print SAVEOUT _("Try installation without checking dependencies? (y/N) ");
		}
		$force or <STDIN> =~ /[$yesexpr]/ or exit 1;
		$urpm->{log}("starting installing packages without deps");
		system("rpm", "-U$rpm_opt", "--nodeps", @rpms_upgrade, ($root ? ("--root", $root) : ()));

		if ($?) {
		    message(_("Installation failed"));
		    if (!$log) {
			print STDOUT _("Try installation even more strongly (--force)? (y/N) ");
		    } else {
			print SAVEOUT _("Try installation even more strongly (--force)? (y/N) ");
		    }
		    $force or <STDIN> =~ /[$yesexpr]/ or exit 1;
		    $urpm->{log}("starting force installing packages without deps");
		    system("rpm", "-U$rpm_opt", "--nodeps", "--force", @rpms_upgrade, ($root ? ("--root", $root) : ()));
		}
	    }
	}
    }
} else {
    message_auto(_("everything already installed"));
}

#- this help flushing correctly by closing this file before (piped on tee).
#- but killing them is generally better.
if ($pid_err && $pid_out) {
    kill 15, $pid_err, $pid_out;
    close STDERR;
    close STDOUT;
}

sub toMb {
    my $nb = $_[0] / 1024 / 1024;
    int $nb + 0.5;
}

sub message { $X ? `gmessage -default Ok -buttons Ok "$_[0]"` : !$log ? print STDOUT "$_[0]\n" : print SAVEOUT "$_[0]\n"; }

sub message_auto { $auto ? (!$log ? print STDOUT "$_[0]\n" : print SAVEOUT "$_[0]\n") : message($_[0]); }

sub log_it {
    #- if invoked as a simple user, nothing should be logged.
    if ($log) {
	local *LOG;
	open LOG, ">>$log" or die "can't output to log file\n";
	print LOG @_;
    }
}

sub untaint {
    my @r = ();
    foreach (@_) {
        /(.*)/;
	push @r, $1;
    }
    @r == 1 ? $r[0] : @r
}