#!/usr/bin/perl -T load_po(); $ENV{PATH} = "/sbin:/usr/sbin:/bin:/usr/bin:/usr/X11R6/bin"; delete $ENV{ENV}; delete $ENV{BASH_ENV}; ($<, $uid) = ($>, $<); if (@ARGV and $ARGV[0] =~ /^-?-h/) { shift @ARGV; } if (@ARGV and $ARGV[0] eq '--auto') { $auto = 1; shift @ARGV; } if (@ARGV and $ARGV[0] eq '--X') { $X = 1; shift @ARGV; } if (@ARGV and $ARGV[0] eq '-a') { $all = 1; shift @ARGV; } while (@ARGV and $ARGV[0] eq '--comment') { shift @ARGV; shift @ARGV; } @ARGV or die(_("usage: urpmi [-h] [--auto] [-a] package_name [package_names...]\n")); log_it(scalar localtime, " urpmi called with @ARGV\n"); $dir = "/var/lib/urpmi"; $dir2 = "/etc/urpmi"; $depsfile = "$dir/depslist"; open SAVEOUT, ">&STDOUT"; open SAVEERR, ">&STDERR"; open STDOUT, "|tee -a /var/log/urpmi.log" or die; open STDERR, "|tee -a /var/log/urpmi.log" or die; select STDERR; $| = 1; # make unbuffered select STDOUT; $| = 1; # make unbuffered open F, $depsfile or die "run urpmi.addmedia first\n"; if (@files = map { untaint($_) } grep { -e $_ } @ARGV) { $uid == 0 or die _("Only superuser is allowed to install local packages"); open G, "gendepslist2 @files -- $dir/hdlist*.cz2 2>/dev/null |"; -e $_ and s|(.*/)?(.*)\.[^.]+\.rpm$|$2| foreach @ARGV; m|^/| or $_ = "./$_" foreach @files; } foreach (, ) { my ($pack, $size, $deps) = /(\S+)\s+(\S+)\s+(.*)/ or die("urpmi: bad format file $depsfile\n"); $size{$pack} = $size; $deps{$pack} = [ split ' ', $deps ]; foreach $v (@ARGV) { $_ = quotemeta $v; $pack =~ /^$_-[^-]+-[^-]+$/ and $exact{$v} = $pack; $pack =~ /^$_-[^-]+$/ and $exact{$v} = $pack; $pack =~ /^$_$/ and $exact{$v} = $pack; $pack =~ /$_/ and push @{$found{$v}}, $pack; $pack =~ /$_/i and push @{$foundi{$v}}, $pack; } } close F; close G or die "gendepslist2 failed" if @files; my $ok = 1; foreach (@ARGV) { my $pack = $exact{$_}; if ($pack) { push @packages, $pack; } else { my $l = $found{$_} || $foundi{$_}; if (@$l == 0) { warn(_("no package named %s\n", $_)); $ok = 0; } elsif (@$l > 1 && !$all) { warn(_("The following packages contain %s: %s\n", $_, join(' ', @$l))); $ok = 0; } else { push @packages, @$l; } } } $ok or exit 1; @installed = `/bin/rpm -qa`; $? and die(_("rpm database query failed\n")); foreach (@installed) { my ($name, $v, $r) = /(.*)-([^-]+)-([^-]+)\n/; exists $installed{$name} && le_version([$v, $r], $installed{$name}) or $installed{$name} = [$v, $r]; } @installed{map { chop; $_ } @installed} = (); my %to_install; closure_deps(\%to_install, @packages); @to_install = keys %to_install; if (!$auto and difference2(\@to_install, \@packages)) { my $sum = 0; map { $sum += $size{$_} } @to_install; 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 { print SAVEOUT "$msg:\n@to_install\n$msg2 (Y/n) "; =~ /n/i and exit 0; } } $to_install = join '|', map { quotemeta($_) } @to_install; foreach $list (rpmlistfiles($dir)) { open F, "$dir/$list" or die("urpmi: error opening $list\n"); $list =~ s/list\.//; foreach () { chop; m|/($to_install)| and $long{$1} = $_, $name{$1} = $list } close F; } foreach (@files) { m|/($to_install)| and $long{$1} = $_ } foreach $l (@to_install) { local $_ = $long{$l} or die("urpmi: package $l is not available\n"); if (s|removable_(\w+)_(\d*):/||) { my $n = "$2-$name{$l}"; $removables{$n}->{name} = $name{$l}; $removables{$n}->{device} = $1; push @{$removables{$n}->{list}}, $_; } else { if (s|^file:/||) { if (m|^(/mnt/.*?)/|) { -e $_ || $try2mount{$1} or $try2mount{$1} = 1, `mount $1 2>/dev/null`; } } push @to_install_long, $_; } } install(@to_install_long) unless $removables{0} || $removables{1}; foreach (sort keys %removables) { my $f = @{$removables{$_}->{list}}[0]; my $dev = $removables{$_}->{device}; `mount /dev/$dev 2>/dev/null`; unless (-e $f) { `umount /dev/$dev 2>/dev/null ; eject $dev 2>/dev/null`; message(_("Please insert the %s named %s", $removables{$_}->{device}, $removables{$_}->{name})); unless ($X) { print SAVEOUT _("Press enter when it's done..."); ; } `mount /dev/$dev 2>/dev/null`; unless (-e $f) { message(_("Sorry can't find file %s, exiting", $f)); exit 1; } } install(@{$removables{$_}->{list}}); } install(@to_install_long) if $removables{0} || $removables{1}; $something_was_installed or message(_("everything already installed")); sub install { @_ or return; $something_was_installed = 1; print SAVEOUT _("installing %s\n", join(' ', @_)); log_it(scalar localtime, " @_\n"); system($X ? "grpmi" : ("rpm", "-U"), @_); if ($?) { message(_("Installation failed")); $X and exit 1; #- grpmi handles --nodeps and --force by itself m|^/| && !-e $_ and exit 1 foreach @_; #- missing local file print SAVEOUT _("Try installation without cheking dependencies?"), " (Y/n) "; =~ /n/i and exit 1; system("rpm", "-U", "--nodeps", @_); if ($?) { message(_("Installation failed")); print SAVEOUT _("Try installation even more strongly (--force)?"), " (Y/n) "; =~ /n/i and exit 0; system("rpm", "-U", "--nodeps", "--force", @_); } } } # uses @deps and @installed sub closure_deps { my $to_install = shift; foreach (@_) { exists $to_install->{$_} and next; my ($name, $v, $r) = /(.*)-([^-]+)-([^-]+)/; exists $installed{$name} && le_version([$v, $r], $installed{$name}) and next; $to_install->{$_} = undef; my @notfound; my @d = @{$deps{$_}} or next; up: foreach (@d) { my %l; foreach (split '\|') { exists $to_install->{$_} and next up; /^NOTFOUND_(.*)/ and push(@notfound, $1), next up; my ($name, $v, $r) = /(.*)-([^-]+)-([^-]+)/; if (exists $installed{$name}) { le_version([$v, $r], $installed{$name}) and next up; %l = ($name => [$v, $r]); last; } $l{$name} = [$v, $r] unless $l{$name} && le_version([$v, $r], $l{$name}); } my ($l) = my @l = map { "$_-$l{$_}[0]-$l{$_}[1]" } keys %l; if (@l > 1 && !$auto) { $msg = _("One of the following packages is needed:"); my $n; if ($X) { `gchooser "$msg" @l`; $n = $? >> 8 || die; } else { print SAVEOUT "$msg\n"; my $i = 0; foreach (@l) { print SAVEOUT " ", ++$i, "- $_\n"; } while (1) { print SAVEOUT _("What is your choice? (1-%d) ", $i); $n = ; 1 <= $n && $n <= $i and last; print SAVEOUT _("Sorry, bad choice, try again\n"); } } $l = $l[$n - 1]; } closure_deps($to_install, $l); } if (@notfound) { message(_("Failed dependencies: %s requires %s", $_, join(", ", @notfound))); exit 1; } } } #- compare a version string. sub version_compare { my ($a, $b) = @_; local $_; while ($a && $b) { my ($sb, $sa) = map { $1 if $a =~ /^\W*\d/ ? s/^\W*0*(\d+)// : s/^\W*(\D+)// } ($b, $a); $_ = length($sa) cmp length($sb) || $sa cmp $sb and return $_; } } sub le_version { my $cmp = version_compare($_[0][0], $_[1][0]); return $cmp < 0 || $cmp == 0 && version_compare($_[0][1], $_[1][1]) <= 0; } 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 member($@) { my $e = shift; foreach (@_) { $e eq $_ and return 1 } 0 } sub uniq { my %l; @l{@_} = (); keys %l } sub difference2(\@\@) { my %l; @l{@{$_[1]}} = (); grep { !exists $l{$_} } @{$_[0]} } sub _ { my $s = shift @_; my $t = translate($s); $t && ref $t or return sprintf $t, @_; my ($T, @p) = @$t; sprintf $T, @_[@p]; } sub translate { $I18N{$_[0]} || $_[0]; } sub log_it { local *LOG; open LOG, ">>/var/log/urpmi.log" or die "can't ouptput to log file\n"; print LOG @_; } sub untaint { my @r = (); foreach (@_) { /(.*)/; push @r, $1; } @r == 1 ? $r[0] : @r } sub load_po { my ($from, $to, $state, $fuzzy); my $lang = $ENV{LANGUAGE} || $ENV{LC_ALL} || $ENV{LC_MESSAGES} || $ENV{LANG}; my $f; -e ($f = "/usr/share/locale/$_/LC_MESSAGES/urpmi.po") and last foreach split ':', $lang; local *F; open F, $f or return; foreach () { /^msgstr/ and $state = 1; /^msgid/ && !$fuzzy and $state = 2; if (/^(#|$)/ && $state != 3) { $state = 3; s/\\n/\n/g foreach $from, $to; if (my @l = $to =~ /%(\d+)\$/g) { $to =~ s/%(\d+)\$/%/g; $to = [ $to, map { $_ - 1 } @l ]; } $I18N{$from} = $to if $from; $from = $to = ''; } $to .= (/"(.*)"/)[0] if $state == 1; $from .= (/"(.*)"/)[0] if $state == 2; $fuzzy = /^#, fuzzy/; } } sub rpmlistfiles { my ($d) = @_; local *F; opendir F, $d or die "all: can't open dir $d: $!\n"; my @l = grep { /^list\.*/ } readdir F; closedir F; @l; }