path: root/urpmi

#!/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 $auto = 0;
my $allow_medium_change = 0;
my $auto_select = 0;
my $force = 0;
my $X = 0;
my $WID = 0;
my $all = 0;
my $complete = 0;
my $minimal = 1;
my $rpm_opt = "-Uvh";
my $use_provides = 0;
my $verbose = 0;

my $uid;
my @files;
my @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 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.
  --auto           - automatically select a good package in choices.
  --auto-select    - automatically select packages for upgrading the system.
  --force          - force invocation even if some package do not exist.
  --X              - use X interface.
  --best-output    - choose best interface according to the environment:
                     X or text mode.
  -a               - select all matches on command line.
  -m               - choose minimum closure of requires (default).
  -M               - choose maximun closure of requires.
  -c               - choose complete method for resolving requires closure.
  -p               - allow search in provides to find package.
  -q               - quiet mode.
  -v               - verbose mode.

  names or rpm files (only for root) 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 };
    /^--auto$/ and do { $auto = 1; next };
    /^--allow-medium-change$/ and do { $allow_medium_change = 1; next };
    /^--auto-select$/ and do { $auto_select = 1; $minimal = 0; next };
    /^--force$/ and do { $force = 1; 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 };
    /^-(.*)$/ and do { foreach (split //, $1) {
	/[\?h]/ and do { usage; next };
	/a/ and do { $all = 1; next };
	/c/ and do { $complete = 1; next };
	/m/ and do { $minimal = 1; next };
	/M/ and do { $minimal = 0; next };
	/q/ and do { $rpm_opt = "-U"; next };
	/p/ and do { $use_provides = 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 };
    /\.rpm$/ and do { push @files, untaint($_); next };
    push @names, $_;
}

#- log only at this point in case of query usage.
log_it(scalar localtime, " urpmi called with @ARGV\n");

my ($pid_out, $pid_err);

open SAVEOUT, ">&STDOUT"; select SAVEOUT; $| = 1;
open SAVEERR, ">&STDERR"; select SAVEERR; $| = 1;
unless ($pid_out = open STDOUT, "|-") {
    open F, ">>/var/log/urpmi.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, ">>/var/log/urpmi.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

#- params contains informations to parse installed system.
my $urpm = new urpm;

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

$urpm->read_depslist;
$use_provides and $urpm->read_provides;

if (@files) {
    $uid == 0 or $urpm->fatal(1, _("Only superuser is allowed to install local packages"));

    #- sanity check of pathname.
    m|^/| or $_ = "./$_" foreach @files;

    #- read provides file which is needed only to compute incremental
    #- dependencies, of files provided.
    $use_provides or $urpm->read_provides;

    #- build closure with local package and return list of names.
    push @names, $urpm->register_local_packages($minimal, @files);
}

#- reparse whole internal depslist to match against newer packages only.
#- ignored medium MUST HAVE BEEN taken into account for building hdlist before!
if ($update) {
    $urpm->read_config();
    $urpm->filter_active_media(use_update => 1);
}
$urpm->relocate_depslist_provides(use_active => $update);


#- 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.
my %packages;
$urpm->search_packages(\%packages,
		       [ ($minimal || !$urpm->{params}{info}{basesystem} ? () : ('basesystem')), @names],
		       all => $all, use_provides => $use_provides, use_active => $update) 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 $info = $urpm->{params}{depslist}[$_];
			   "$info->{name}-$info->{version}-$info->{release}" } ($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>;
		1 <= $n && $n <= $i and last;
		print SAVEOUT _("Sorry, bad choice, try again\n");
	    }
	}
    }

    $choices_id[$n - 1];
};

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

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

    if (keys(%to_remove) > 0) {
	print STDERR "some package have to be removed for being upgraded, this is not supported yet\n";
    }
}

if ($minimal) {
    $use_provides || @files or $urpm->read_provides;
    $update or $urpm->read_config;
    $urpm->filter_minimal_packages_to_upgrade(\%packages, $ask_choice);
} else {
    $urpm->filter_packages_to_upgrade(\%packages, $ask_choice, complete => $complete);
}

#- 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;
foreach (keys %packages) {
    defined $packages{$_} and $ask_user = 1;
    my $info  = $urpm->{params}{depslist}[$_];
    $sum += $info->{size};
    push @to_install, "$info->{name}-$info->{version}-$info->{release}";
}
if (!$auto) {
    if ($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");
	    print SAVEOUT "$msg:\n@to_install\n$msg2" . _(" (Y/n) ");
	    <STDIN> =~ /[$noexpr]/ and exit 0;
	}
    }
}

$urpm->read_config;

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.
#- TODO check not another urpmi is doing the same...
foreach (@$local_to_removes) {
    unlink $_;
}

my @sources = $urpm->upload_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 {
						    print SAVEOUT "$msg\n$msg2 ";
						    <STDIN>; 1;
						}
					    });

install(@sources);
@sources or message_auto(_("everything already installed"));

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

sub install {
    @_ or return;
	
    printf SAVEOUT _("installing %s\n", join(' ', @_));
    log_it(scalar localtime, " @_\n");
    $urpm->{log}("starting installing packages");
    system($X ? ("grpmi", $WID ? ("--WID=$WID") : ()) : ("rpm", $rpm_opt), @_);
    if ($?) {
	message(_("Installation failed"));
	$X and exit(($? >> 8) + 32); #- grpmi handles --nodeps and --force by itself, forward grpmi error + 32

	m|^/| && !-e $_ and exit 2 foreach @_; #- missing local file

	$noexpr = _("Nn");
	$yesexpr = _("Yy");
	print SAVEOUT _("Try installation without checking dependencies? (y/N) ");
	$auto and exit 1; #- if auto has been set, avoid asking user.
	$force or <STDIN> =~ /[$yesexpr]/ or exit 1;
	$urpm->{log}("starting installing packages without deps");
	system("rpm", $rpm_opt, "--nodeps", @_);	

	if ($?) {
	    message(_("Installation failed"));
	    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", $rpm_opt, "--nodeps", "--force", @_);	
	}
    }
}

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

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

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

sub log_it {
    local *LOG;
    open LOG, ">>/var/log/urpmi.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
}