#!/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 = ''; my $synthesis = ''; my $auto = 0; my $allow_medium_change = 0; my $auto_select = 0; my $force = 0; my $allow_nodeps = 0; my $allow_force = 0; my $parallel = ''; 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 $install_src = 0; my $clean = 0; my $noclean = 0; my $pre_clean_cache = 0; my $post_clean_cache = 1; my $verbose = 0; my $root = ''; my $bug = ''; my $env = ''; my $log = ''; my $verify_rpm = 1; my $test = 0; my $excludepath = 0; my $uid; my @files; my @src_files; 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) = ($>, $<); $ENV{HOME} ||= "/root"; $ENV{USER} ||= "root"; 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: ", $urpm::VERSION) . _(" --help - print this help message. ") . _(" --update - use only update media. ") . _(" --media - use only the media listed by comma. ") . _(" --synthesis - use the given synthesis instead of urpmi db. ") . _(" --auto - automatically select a package in choices. ") . _(" --auto-select - automatically select packages to upgrade the system. ") . _(" --fuzzy - impose fuzzy search (same as -y). ") . _(" --src - next package is a source package (same as -s). ") . _(" --install-src - install only source package (no binaries). ") . _(" --clean - remove rpm from cache before anything else. ") . _(" --noclean - keep rpm not used in cache. ") . _(" --force - force invocation even if some packages do not exist. ") . _(" --allow-nodeps - allow asking user to install packages without dependencies checking. ") . _(" --allow-force - allow asking user to install packages without dependencies checking and integrity. ") . _(" --parallel - distributed urpmi accross machines of alias. ") . _(" --wget - use wget to retrieve distant files. ") . _(" --curl - use curl to retrieve distant files. ") . _(" --proxy - use specified HTTP proxy, the port number is assumed to be 1080 by default (format is ). ") . _(" --proxy-user - specify user and password to use for proxy authentication (format is ). ") . _(" --bug - output a bug report in directory indicated by next arg. ") . _(" --env - use specific environment (typically a bug report). ") . _(" --X - use X interface. ") . _(" --best-output - choose best interface according to the environment: X or text mode. ") . _(" --verify-rpm - verify rpm signature before installation (--no-verify-rpm disable it, default is enabled). ") . _(" --test - verify if the installation can be achieved correctly. ") . _(" --excludepath - exclude path separated by comma. ") . _(" -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 will be installed. "); exit(0); } #- parse arguments list. my @nextargv; my $command_line = join " ", @ARGV; @ARGV or usage; while (defined($_ = shift @ARGV)) { /^--help$/ and do { usage; next }; /^--no-locales$/ and do { undef *_; undef *urpm::_; *_ = *urpm::_ = sub { sprintf(shift @_, @_) }; next }; /^--update$/ and do { $update = 1; next }; /^--media$/ and do { push @nextargv, \$media; next }; /^--mediums$/ and do { push @nextargv, \$media; next }; /^--synthesis$/ and do { push @nextargv, \$synthesis; 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 }; /^--install-src$/ and do { $install_src = 1; next }; /^--clean$/ and do { $clean = 1; $noclean = 0; next }; /^--noclean$/ and do { $clean = $pre_clean_cache = $post_clean_cache = 0; $noclean = 1; next }; /^--(no-)?pre-clean$/ and do { $pre_clean_cache = !$1; next }; /^--(no-)?post-clean$/ and do { $post_clean_cache = !$1; next }; /^--force$/ and do { $force = 1; next }; /^--allow-nodeps$/ and do { $allow_nodeps = 1; next }; /^--allow-force$/ and do { $allow_force = 1; next }; /^--parallel$/ and do { push @nextargv, \$parallel; next }; /^--wget$/ and do { $sync = sub { my $options = shift @_; if (ref $options) { $options->{prefer} = 'wget' } else { $options = { dir => $options, prefer => 'wget' } } urpm::sync_webfetch($options, @_) }; next }; /^--curl$/ and do { $sync = \&urpm::sync_webfetch; next }; /^--proxy$/ and do { my ($proxy, $port) = ($_ = shift @ARGV) =~ m,^(?:http://)?([^:]+(:\d+)?)/*$, or die _("bad proxy declaration on command line\n"); $proxy .= ":1080" unless $port; $urpm->{proxy}{http_proxy} = "http://$proxy"; next; }; /^--proxy-user$/ and do { ($_ = shift @ARGV) =~ /(.+):(.+)/, or die _("bad proxy declaration on command line\n"); $urpm->{proxy}->{user} = $1; $urpm->{proxy}->{pwd} = $2; next; }; /^--bug$/ and do { push @nextargv, \$bug; next }; /^--env$/ and do { push @nextargv, \$env; 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/sbin/grpmi" && system('/usr/X11R6/bin/xtest', '') == 0; next }; /^--(no-)?verify-rpm$/ and do { $verify_rpm = !$1; next }; /^--(no-)?test$/ and do { $test = !$1; next }; /^--comment$/ and do { push @nextargv, undef; next }; /^--root$/ and do { push @nextargv, \$root; next }; /^--excludepath$/ and do { push @nextargv, \$excludepath; 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 { --$verbose; $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; $rpm_opt = "vh"; 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); #- use install_src to promote all names as src package. if ($install_src) { @files and $urpm->{fatal}(1, _("What can be done with binary rpm files when using --install-src")); push @src_names, @names; @names = (); } #- 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; #- allow log file. $log = "$bug/urpmi.log"; } if ($env) { print STDERR _("using specific environment on %s\n", $env); $log = "$env/urpmi_env.log"; unlink $log; #- setting new environment. $urpm->{config} = "$env/urpmi.cfg"; $urpm->{skiplist} = "$env/skip.list"; $urpm->{instlist} = "$env/inst.list"; $urpm->{statedir} = $env; } else { if ($uid > 0) { #- only src files are installable using urpmi. $install_src || $root or @names || @files and $urpm->{fatal}(1, _("Only superuser is allowed to install packages")); } else { #- allow log if not defined. $log ||= "/var/log/urpmi.log"; } } if ($log) { #- log only at this point in case of query usage. log_it(scalar localtime, " urpmi called with $command_line\n"); open SAVEOUT, ">&STDOUT"; select SAVEOUT; $| = 1; open SAVEERR, ">&STDERR"; select SAVEERR; $| = 1; unless ($pid_out = open STDOUT, "|-") { while () { open F, ">>$log"; select F; $| = 1; select SAVEOUT; $| = 1; $/ = \1; print SAVEOUT $_; print F $_; close F; } exit 0; } unless ($pid_err = open STDERR, "|-") { while () { open F, ">>$log"; select F; $| = 1; select SAVEERR; $| = 1; $/ = \1; print SAVEERR $_; print F $_; close F; } exit 0; } select STDERR; $| = 1; # make unbuffered select STDOUT; $| = 1; # make unbuffered } else { open SAVEOUT, ">&STDOUT"; select SAVEOUT; $| = 1; open SAVEERR, ">&STDERR"; select SAVEERR; $| = 1; } #- use specific sync routine. $sync and $urpm->{sync} = $sync; #- remove verbose if not asked. unless ($bug) { $urpm->{fatal} = sub { printf SAVEERR "%s\n", $_[1]; exit($_[0]) }; $urpm->{error} = sub { printf SAVEERR "%s\n", $_[0] }; $urpm->{log} = sub { printf SAVEERR "%s\n", $_[0] }; } $verbose > 0 or $urpm->{log} = sub {}; $urpm->configure(nocheck_access => $env || $uid > 0, media => $media, synthesis => $synthesis, update => $update, root => $root, bug => $bug, parallel => $parallel, ); my $state = {}; my %requested = $urpm->register_rpms(@files, @src_files); #- 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(\%requested, [ @names ], all => $all, use_provides => $use_provides, fuzzy => $fuzzy) or $force or exit 1; } if (@src_names) { $urpm->search_packages(\%requested, [ @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. sub ask_choice { my ($urpm, $db, $state, $choices) = @_; my $n = 1; #- default value. my (@l) = map { scalar $_->fullname } @$choices; my $from = undef; #TODO if (@l > 1 && !$auto) { my $msg = (defined $from ? _("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 { message("$msg"); my $i = 0; foreach (@l) { message(" " . ++$i . "- $_") } while (1) { $n = message_input(_("What is your choice? (1-%d) ", $i)); defined $n or exit 1; 1 <= $n && $n <= $i and last; message(_("Sorry, bad choice, try again\n")); } } } $choices->[$n - 1]; }; #- do the resolution of dependencies between requested package (and auto selection if any). #- handle parallel option if any. $urpm->resolve_dependencies($state, \%requested, rpmdb => $env && "$env/rpmdb.cz", auto_select => $auto_select, callback_choices => \&ask_choice, install_src => $install_src, ); if (%{$state->{ask_unselect} || {}}) { unless ($auto) { my $list = join "\n", map { scalar $urpm->{depslist}[$_]->fullname } keys %{$state->{ask_unselect}}; my $msg = _("Some package requested cannot be installed:\n%s\ndo you agree ?", $list); if ($X) { my $ok = _("Ok"); my $cancel = _("Cancel"); `gmessage -default $ok -buttons "$ok:0,$cancel:2" "$msg"`; $? and exit 0; } else { $noexpr = _("Nn"); $yesexpr = _("Yy"); message_input($msg . _(" (Y/n) ")) =~ /[$noexpr]/ and exit 0; } } delete @{$state->{selected}}{keys %{$state->{ask_unselect}}}; } if (%{$state->{ask_remove} || {}}) { unless ($auto) { my $list = join "\n", map { my ($from) = keys %{$state->{ask_remove}{$_}{closure}}; my ($whyk) = keys %{$state->{ask_remove}{$_}{closure}{$from}}; my ($whyv) = $state->{ask_remove}{$_}{closure}{$from}{$whyk}; my $frompkg = $urpm->{depslist}[$from]; my $s; for ($whyk) { /old_requested/ and $s .= _("in order to install %s", $frompkg ? $frompkg->fullname : $from); /unsatisfied/ and do { foreach (@$whyv) { $s and $s .= ', '; if (/([^\[\s]*)(?:\[\*\])?(?:\[|\s+)([^\]]*)\]?$/) { $s .= _("due to unsatisfied %s", "$1 $2"); } else { $s .= _("due to missing %s", $_); } } }; /conflicts/ and $s .= _("due to conflicts with %s", $whyv); /unrequested/ and $s .= _("unrequested"); } #- now insert the reason if available. $_ . ($s ? " ($s)" : ''); } sort { $a cmp $b } keys %{$state->{ask_remove}}; my $msg = _("The following packages have to be removed for others to be upgraded:\n%s\ndo you agree ?", $list); if ($X) { my $ok = _("Ok"); my $cancel = _("Cancel"); `gmessage -default $ok -buttons "$ok:0,$cancel:2" "$msg"`; $? and exit 0; } else { $noexpr = _("Nn"); $yesexpr = _("Yy"); message_input($msg . _(" (Y/n) ")) =~ /[$noexpr]/ and exit 0; } } } #- get out of package that should not be upgraded. $urpm->deselect_unwanted_packages($state->{selected}); #- 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 = $env; my $sum = 0; my @root_only; foreach my $pkg (sort { $a->name cmp $b->name } @{$urpm->{depslist}}[keys %{$state->{selected}}]) { $ask_user ||= $pkg->flag_required || $auto_select || $parallel; my $fullname = $pkg->fullname; if (!$env && $install_src && $pkg->arch ne 'src') { push @root_only, $fullname; } elsif ($install_src || $pkg->arch ne 'src') { $sum += $pkg->size; push @to_install, $fullname; } } if ($env) { my $msg = _("To satisfy dependencies, the following packages are going to be installed (%d MB)", toMb($sum)); my $p = join "\n", @to_install; print STDERR "$msg:\n$p\n"; exit 0; #- exit now for specific environment. } 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 || $X) && @to_install) { my $msg = _("To satisfy dependencies, the following packages are going to be installed (%d MB)", toMb($sum)); my $msg2 = _("Is this OK?"); my $p = join "\n", @to_install; if ($X) { 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"); message_input("$msg:\n$p\n$msg2" . _(" (Y/n) ")) =~ /[$noexpr]/ and exit 0; } } #- if not root, the list become invisible and no download will be possible. my ($local_sources, $list) = $urpm->get_source_packages($state->{selected}, clean_all => $clean, clean_other => !$noclean && $pre_clean_cache); unless ($local_sources || $list) { $urpm->{fatal}(3, _("unable to get source packages, aborting")); } my %sources = $urpm->download_source_packages($local_sources, $list, verbose => $verbose > 0, force_local => !$X, ask_for_medium => (!$auto || $allow_medium_change) && sub { my $msg = _("Please insert the medium named \"%s\" on device [%s]", @_); my $msg2 = _("Press Enter when ready..."); if ($X) { my $ok = _("Ok"); my $cancel = _("Cancel"); $msg =~ s/"/\\"/g; `gmessage -default $ok -buttons "$ok:0,$cancel:2" "$msg"`; !$?; } else { defined message_input("$msg\n$msg2 "); } }); my %sources_install = %{$urpm->extract_packages_to_install(\%sources) || {}}; if ($verify_rpm) { my @invalid_sources; foreach (values %sources_install, values %sources) { URPM::verify_rpm($_) =~ /NOT OK/ and push @invalid_sources, $_; } if (@invalid_sources) { my $msg = _("The following packages have bad signatures"); my $msg2 = _("Do you want to continue installation ?"); my $p = join "\n", @invalid_sources; if ($auto) { message("$msg:\n$p\n", 'noX'); exit 1; } else { if ($X) { my $ok = _("Ok"); my $cancel = _("Cancel"); `gmessage -default $cancel -buttons "$ok:0,$cancel:2" "$msg:\n$p\n\n$msg2"`; $? and exit 1; } else { $noexpr = _("Nn"); $yesexpr = _("Yy"); message_input("$msg:\n$p\n$msg2" . _(" (y/N) ")) =~ /[$yesexpr]/ or exit 1; } } } } #- check for local files. if (my @missing = grep { m|^/| && ! -e $_ } values %sources_install, values %sources) { message(_("Installation failed, some files are missing:\n%s\nYou may want to update your urpmi database", join "\n", map { " $_" } @missing)); exit 2; } #- install source package only (whatever the user is root or not, but use rpm for that). if ($install_src) { if (my @l = grep { /\.src\.rpm$/ } values %sources_install, values %sources) { system("rpm", "-i$rpm_opt", @l, ($root ? ("--root", $root) : ())); $? and message(_("Installation failed")), exit 1; } exit 0; } #- clean to remove any src package now. foreach (\%sources_install, \%sources) { foreach my $id (keys %$_) { my $pkg = $urpm->{depslist}[$id] or next; $pkg->arch eq 'src' and delete $_->{$id}; } } if (%sources_install || %sources) { if ($parallel) { message(_("distributing %s\n", join(' ', values %sources_install, values %sources)), 'noX'); #- no remove are handle here, automatically done by each distant node. $urpm->{log}("starting distributed install"); $urpm->parallel_install([ keys %{$state->{ask_remove} || {}} ], \%sources_install, \%sources, test => $test, excludepath => $excludepath); } else { message(_("installing %s\n", join(' ', values %sources_install, values %sources)), 'noX'); log_it(scalar localtime, " ", join(' ', values %sources_install, values %sources), "\n"); $urpm->{log}("starting installing packages"); if ($X && !$root && !$test) { system("rpm", "-e", "--nodeps", keys %{$state->{ask_remove} || {}}); system("grpmi", $WID ? ("--WID=$WID") : (), (map { ("-noupgrade", $_) } values %sources_install), values %sources); 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 { my @l = $urpm->install([ keys %{$state->{ask_remove} || {}} ], \%sources_install, \%sources, translate_message => 1, oldpackage => $state->{oldpackage}, post_clean_cache => $post_clean_cache, test => $test, excludepath => $excludepath); if (@l) { message(_("Installation failed") . ":\n" . join("\n", map { "\t$_" } @l)); m|^/| && !-e $_ and exit 2 foreach values %sources_install, values %sources; #- missing local file $auto || !$allow_nodeps && !$allow_force and exit 1; #- if auto has been set, avoid asking user. $noexpr = _("Nn"); $yesexpr = _("Yy"); message_input(_("Try installation without checking dependencies? (y/N) "), $force && $yesexpr) =~ /[$yesexpr]/ or exit 1; $urpm->{log}("starting installing packages without deps"); @l = $urpm->install([ keys %{$state->{ask_remove} || {}} ], \%sources_install, \%sources, translate_message => 1, nodeps => 1, oldpackage => $state->{oldpackage}, post_clean_cache => $post_clean_cache, test => $test, excludepath => $excludepath); if (@l) { message(_("Installation failed") . ":\n" . join("\n", map { "\t$_" } @l)); !$allow_force and exit 1; message_input(_("Try installation even more strongly (--force)? (y/N) "), $force && $yesexpr) =~ /[$yesexpr]/ or exit 1; $urpm->{log}("starting force installing packages without deps"); @l = $urpm->install([ keys %{$state->{ask_remove} || {}} ], \%sources_install, \%sources, translate_message => 1, nodeps => 1, force => 1, oldpackage => $state->{oldpackage}, post_clean_cache => $post_clean_cache, test => $test, excludepath => $excludepath); @l and $urpm->fatal(2, _("Installation failed") . ":\n" . join("\n", map { "\t$_" } @l)); } } else { $test and message(_("Installation is possible")); } } } } else { $verbose >= 0 and message(_("everything already installed"), $auto); } #- try to umount removable device which may have been mounted. $urpm->try_umounting_removables; #- 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 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 @_; } } #- message functions. sub message { my ($msg, $noX) = @_; if ($X && !$noX && !$auto) { `gmessage -default Ok -buttons Ok "$msg"`; $bug and log_it($msg); } else { if ($bug) { print STDOUT "$msg\n"; } else { print SAVEOUT "$msg\n"; } } } sub message_input { my ($msg, $default_input) = @_; if ($X && !default_input) { #- if a default input is given, the user doesn't have to choose (and being asked). `gmessage -default Ok -buttons Ok "$msg"`; $bug and log_it($msg); } else { if ($bug) { print STDOUT "$msg"; } else { print SAVEOUT "$msg"; } } my $input = $default_input || ; $bug and log_it($input); return $input; } sub untaint { my @r = (); foreach (@_) { /(.*)/; push @r, $1; } @r == 1 ? $r[0] : @r }