diff options
| -rw-r--r-- | urpm.pm | 216 | ||||
| -rwxr-xr-x | urpmi | 59 | ||||
| -rw-r--r-- | urpmi.spec | 15 | ||||
| -rwxr-xr-x | urpmq | 63 |
4 files changed, 328 insertions, 25 deletions
@@ -3,7 +3,7 @@ package urpm; use strict; use vars qw($VERSION @ISA); -$VERSION = '1.40'; +$VERSION = '1.5'; =head1 NAME @@ -1125,5 +1125,219 @@ sub upload_source_packages { @$local_sources, @sources; } +sub select_packages_to_upgrade { + my ($urpm, $prefix, $packages, $remove_packages, $keep_files) = @_; + my $db = rpmtools::db_open($prefix); + + #- used for package that are not correctly updated. + #- should only be used when nothing else can be done correctly. + my %upgradeNeedRemove = ( + 'libstdc++' => 1, + 'compat-glibc' => 1, + 'compat-libs' => 1, + ); + + #- help removing package which may have different release numbering + my %toRemove; + + #- help searching package to upgrade in regard to already installed files. + my %installedFilesForUpgrade; + + #- help keeping memory by this set of package that have been obsoleted. + my %obsoletedPackages; + + #- make a subprocess here for reading filelist, this is important + #- not to waste a lot of memory for the main program which will fork + #- latter for each transaction. + local (*INPUT, *OUTPUT_CHILD); pipe INPUT, OUTPUT_CHILD; + local (*INPUT_CHILD, *OUTPUT); pipe INPUT_CHILD, OUTPUT; + if (my $pid = fork()) { + close INPUT_CHILD; + close OUTPUT_CHILD; + select((select(OUTPUT), $| = 1)[0]); + + #- internal reading from interactive mode of parsehdlist. + #- takes a code to call with the line read, this avoid allocating + #- memory for that. + my $ask_child = sub { + my ($name, $tag, $code) = @_; + $code or die "no callback code for parsehdlist output"; + print OUTPUT "$name:$tag\n"; + + local $_; + while (<INPUT>) { + chomp; + /^\s*$/ and last; + $code->($_); + } + }; + + #- select packages which obseletes other package, obselete package are not removed, + #- should we remove them ? this could be dangerous ! + foreach my $pkg (values %{$urpm->{params}{info}}) { + $ask_child->($pkg->{name}, "obsoletes", sub { + #- take care of flags and version and release if present + if ($_[0] =~ /^(\S*)\s*(\S*)\s*([^\s-]*)-?(\S*)/ && + rpmtools::db_traverse_names($db, [], [$1], undef) > 0) { + $3 and eval(rpmtools::version_compare($pkg->{version}, $3) . $2 . 0) or next; + $4 and eval(rpmtools::version_compare($pkg->{release}, $4) . $2 . 0) or next; + $urpm->{log}("selecting $pkg->{name}-$pkg->{version}-$pkg->{release} using obsoletes"); + $obsoletedPackages{$1} = undef; + $pkg->{selected} = 1; + } + }); + } + + #- mark all files which are not in /etc/rc.d/ for packages which are already installed but which + #- are not in the packages list to upgrade. + #- the 'installed' property will make a package unable to be selected, look at select. + rpmtools::db_traverse($db, [ qw(name version release files) ], sub { + my ($p) = @_; + my $otherPackage = $p->{release} !~ /mdk\w*$/ && "$p->{name}-$p->{version}-$p->{release}"; + my $pkg = $urpm->{params}{info}{$p->{name}}; + + if ($pkg) { + my $version_cmp = rpmtools::version_compare($p->{version}, $pkg->{version}); + if ($version_cmp > 0 || $version_cmp == 0 && + rpmtools::version_compare($p->{release}, $pkg->{release}) >= 0) { + if ($otherPackage && $version_cmp <= 0) { + $toRemove{$otherPackage} = 0; + $pkg->{selected} = 1; + $urpm->{log}("removing $otherPackage to upgrade ...\n to $pkg->{name}-$pkg->{version}-$pkg->{release} since it will not be updated otherwise"); + } else { + $pkg->{installed} = 1; + } + } elsif ($upgradeNeedRemove{$pkg->{name}}) { + my $otherPackage = "$p->{name}-$p->{version}-$p->{release}"; + $toRemove{$otherPackage} = 0; + $pkg->{selected} = 1; + $urpm->{log}("removing $otherPackage to upgrade ...\n to $pkg->{name}-$pkg->{version}-$pkg->{release} since it will not upgrade correctly!"); + } + } else { + if (! exists $obsoletedPackages{$p->{name}}) { + @installedFilesForUpgrade{grep { ($_ !~ m|^/etc/rc.d/| && $_ !~ m|\.la$| && + ! -d "$prefix/$_" && ! -l "$prefix/$_") } + @{$p->{files}}} = (); + } + } + }); + + #- find new packages to upgrade. + foreach my $pkg (values %{$urpm->{params}{info}}) { + my $skipThis = 0; + my $count = rpmtools::db_traverse_names($db, [ 'name' ], [ $pkg->{name} ], sub { + $skipThis ||= $pkg->{installed}; + }); + + #- skip if not installed (package not found in current install). + $skipThis ||= ($count == 0); + + #- select the package if it is already installed with a lower version or simply not installed. + unless ($skipThis) { + my $cumulSize; + + $pkg->{selected} = 1; + + #- keep in mind installed files which are not being updated. doing this costs in + #- execution time but use less memory, else hash all installed files and unhash + #- all file for package marked for upgrade. + rpmtools::db_traverse_names($db, [ qw(name files) ], [ $pkg->{name} ], sub { + my ($p) = @_; + @installedFilesForUpgrade{grep { ($_ !~ m|^/etc/rc.d/| && $_ !~ m|\.la$| && + ! -d "$prefix/$_" && ! -l "$prefix/$_") } + @{$p->{files}}} = (); + }); + + $ask_child->($pkg->{name}, "files", sub { + delete $installedFilesForUpgrade{$_[0]}; + }); + } + } + + #- unmark all files for all packages marked for upgrade. it may not have been done above + #- since some packages may have been selected by depsList. + foreach my $pkg (values %{$urpm->{params}{info}}) { + if ($pkg->{selected}) { + $ask_child->($pkg->{name}, "files", sub { + delete $installedFilesForUpgrade{$_[0]}; + }); + } + } + + #- select packages which contains marked files, then unmark on selection. + #- a special case can be made here, the selection is done only for packages + #- requiring locales if the locales are selected. + #- another special case are for devel packages where fixes over the time has + #- made some files moving between the normal package and its devel couterpart. + #- if only one file is affected, no devel package is selected. + foreach my $pkg (values %{$urpm->{params}{info}}) { + unless ($pkg->{selected}) { + my $toSelect = 0; + $ask_child->($pkg->{name}, "files", sub { + if ($_[0] !~ m|^/etc/rc.d/| && $_ !~ m|\.la$| && exists $installedFilesForUpgrade{$_[0]}) { + ++$toSelect if ! -d "$prefix/$_[0]" && ! -l "$prefix/$_[0]"; + } + delete $installedFilesForUpgrade{$_[0]}; + }); + if ($toSelect) { + if ($toSelect <= 1 && $pkg->{name} =~ /-devel/) { + $urpm->{log}("avoid selecting $pkg->{name}-$pkg->{version}-$pkg->{release} as not enough files will be updated"); + } else { + #- default case is assumed to allow upgrade. + my @deps = map { /\|/ and next; #- do not inspect choice + my $p = $urpm->{params}{depslist}[$_]; + $p && $p->{name} =~ /locales-/ ? ($p) : () } split ' ', $pkg->{deps}; + if (@deps == 0 || @deps > 0 && (grep { !$_->{selected} && !$_->{installed} } @deps) == 0) { + $urpm->{log}("selecting $pkg->{name} by selection on files"); + $pkg->{selected} = 1; + } else { + $urpm->{log}("avoid selecting $pkg->{name}-$pkg->{version}-$pkg->{release} as its locales language is not already selected"); + } + } + } + } + } + + #- clean memory... + %installedFilesForUpgrade = (); + + #- no need to still use the child as this point, we can let him to terminate. + close OUTPUT; + close INPUT; + waitpid $pid, 0; + } else { + close INPUT; + close OUTPUT; + open STDIN, "<&INPUT_CHILD"; + open STDOUT, ">&OUTPUT_CHILD"; + exec "parsehdlist", "--interactive", map { "$urpm->{statedir}/$_->{hdlist}" } grep { ! $_->{ignore} } @{$urpm->{media}} + or rpmtools::_exit(1); + } + + #- let the caller known about what we found here! + foreach my $pkg (values %{$urpm->{params}{info}}) { + $packages->{$pkg->{id}} = 0 if $pkg->{selected}; + } + + #- clean false value on toRemove. + delete $toRemove{''}; + + #- get filenames that should be saved for packages to remove. + #- typically config files, but it may broke for packages that + #- are very old when compabilty has been broken. + #- but new version may saved to .rpmnew so it not so hard ! + if ($keep_files && keys %toRemove) { + rpmtools::db_traverse($db, [ qw(name version release conffiles) ], sub { + my ($p) = @_; + my $otherPackage = "$p->{name}-$p->{version}-$p->{release}"; + if (exists $toRemove{$otherPackage}) { + @{$keep_files}{@{$p->{conffiles} || []}} = (); + } + }); + } + + #- close db, job finished ! + rpmtools::db_close($db); +} 1; @@ -22,11 +22,13 @@ use urpm; #- default options. my $auto = 0; +my $auto_select = 0; my $force = 0; my $X = 0; my $all = 0; +my $complete = 0; my $rpm_opt = "-Uvh"; -my $datadir = "/var/lib/urpmi"; +my $verbose = 0; my $uid; my @files; @@ -40,7 +42,26 @@ delete @ENV{qw(ENV BASH_ENV IFS CDPATH)}; ($<, $uid) = ($>, $<); sub usage { - die(_("usage: urpmi [-h] [--auto] [--force] [-a] [-v] package_name|rpm_file [package_names|rpm_files...]\n")); + #die(_("usage: urpmi [-h] [--auto] [--force] [-a] [-v] package_name|rpm_file [package_names|rpm_files...]\n")); + die(_("urpmi version %s +Copyright (C) 1999, 2000 MandrakeSoft. +This is free software and may be redistributed under the terms of the GNU GPL. + +usage: + --help - print this help message. + --auto - automatically select a good package in choices. + --auto-select - automatically select packages for upgrading the system. + --force - force invocation even if some package does not exists. + --X - use X interface. + --best-output - chose best interface according to the environment: + X or text mode. + -a - select all matches on command line. + -c - choose complete method for resolving requires closure. + -q - quiet mode. + -v - verbose mode. + + names or rpm files (only for root) given on command line are installed. +", $urpm::VERSION)); } #- parse arguments list. @@ -48,6 +69,7 @@ my @nextargv; for (@ARGV) { /^--help$/ and do { usage; next }; /^--auto$/ and do { $auto = 1; next }; + /^--auto-select$/ and do { $auto_select = 1; next }; /^--force$/ and do { $force = 1; next }; /^--X$/ and do { $X = 1; next }; /^--best-output$/ and do { $X ||= $ENV{DISPLAY} && system('/usr/X11R6/bin/xtest', '') == 0; next }; @@ -55,8 +77,9 @@ for (@ARGV) { /^-(.*)$/ and do { foreach (split //, $1) { /[\?h]/ and do { usage; next }; /a/ and do { $all = 1; next }; - /v/ and do { $rpm_opt = "-Uvh"; next }; + /c/ and do { $complete = 1; next }; /q/ and do { $rpm_opt = "-U"; next }; + /v/ and do { $verbose = 1; next }; die "urpmi: unknown option \"-$1\", check usage with --help\n"; } next }; @nextargv and do { my $r = shift @nextargv; $r and $$r = $_; next }; /\.rpm$/ and do { -r $_ or print STDERR "urpmi: cannot read rpm file \"$_\"\n", next; @@ -77,6 +100,9 @@ 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; if (@files) { @@ -104,6 +130,17 @@ $urpm->relocate_depslist; my %packages; $urpm->search_packages(\%packages, [ 'basesystem', @names], all => $all) or $force or exit 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"; + } +} + #- filter to add in packages selected required packages. $urpm->filter_packages_to_upgrade(\%packages, sub { my ($urpm, @choices_id) = @_; @@ -128,7 +165,7 @@ $urpm->filter_packages_to_upgrade(\%packages, sub { } $choices_id[$n - 1]; -}); +}, complete => $complete); #- package to install as a array of strings. my @to_install; @@ -182,10 +219,8 @@ my @sources = $urpm->upload_source_packages($local_sources, $list, 'force_local' } }); -my $something_was_installed; - install(@sources); -$something_was_installed or message_auto(_("everything already installed")); +@sources or message_auto(_("everything already installed")); #- this help flushing correctly by closing this file before (piped on tee). close STDERR; @@ -194,7 +229,6 @@ close STDOUT; sub install { @_ or return; - $something_was_installed = 1; print SAVEOUT _("installing %s\n", join(' ', @_)); log_it(scalar localtime, " @_\n"); system($X ? "grpmi" : ("rpm", $rpm_opt), @_); @@ -278,12 +312,3 @@ sub load_po { } } -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; -} @@ -1,13 +1,13 @@ %define group System/Configuration/Packaging Name: urpmi -Version: 1.4 -Release: 7mdk +Version: 1.5 +Release: 1mdk License: GPL Source0: %{name}.tar.bz2 Summary: User mode rpm install Requires: /usr/bin/suidperl, eject, wget -PreReq: rpmtools >= 2.1-9mdk +PreReq: rpmtools >= 2.2 BuildRoot: %{_tmppath}/%{name}-buildroot Group: %{group} @@ -18,7 +18,7 @@ well-known rpms to be installed. You can compare rpm vs. urpmi with insmod vs. modprobe %package -n gurpmi -Version: 0.8 +Version: 0.9 Summary: User mode rpm GUI install Requires: urpmi grpmi gchooser gmessage Group: %{group} @@ -29,7 +29,7 @@ well-known rpms to be installed. You can compare rpm vs. urpmi with insmod vs. modprobe %package -n autoirpm -Version: 0.6 +Version: 0.7 Summary: Auto install of rpm on demand Requires: sh-utils urpmi gurpmi xtest gmessage gurpmi Group: %{group} @@ -113,6 +113,11 @@ autoirpm.uninstall %changelog +* Wed Feb 14 2001 François Pons <fpons@ackbar.mandrakesoft.com> 1.5-1mdk +- added --auto-select flag for urpmi and urpmq. +- added --headers flag to urpmq. +- changed help screen for both urpmi and urpmq. + * Mon Feb 05 2001 François Pons <fpons@mandrakesoft.com> 1.4-7mdk - fixed wrong probing of medium list file. @@ -31,13 +31,34 @@ my %I18N; load_po(); sub usage { - die(_("usage: urpmq [-h] [-d] [-u] [-c] [-g] [-v] [-r] package_name|rpm_file [package_names|rpm_files...]\n")); + #die(_("usage: urpmq [-h] [-d] [-u] [-c] [-g] [-v] [-r] package_name|rpm_file [package_names|rpm_files...]\n")); + die(_("urpmq version %s +Copyright (C) 2000 MandrakeSoft. +This is free software and may be redistributed under the terms of the GNU GPL. + +usage: + -h - print this help message. + -d - extend query to package dependancies. + -u - remove package if a better version is already installed. + -c - choose complete method for resolving requires closure. + -g - print groups too with name. + -v - print version too with name. + -r - print release too with name. + + --auto-select - automatically select packages for upgrading the system. + --headers - extract headers for package listed from urpmi db to + stdout (root only). + + names or rpm files given on command line are queried. +", $urpm::VERSION)); } #- parse arguments list. my @nextargv; for (@ARGV) { /^--help$/ and do { usage; next }; + /^--auto-select$/ and do { $query->{auto_select} = 1; next }; + /^--headers$/ and do { $query->{headers} = 1; next }; /^-(.*)$/ and do { foreach (split //, $1) { /[\?h]/ and do { usage; next }; /d/ and do { $query->{deps} = 1; next }; @@ -80,12 +101,50 @@ $urpm->{params}->relocate_depslist(); #- basesystem is added to the list so if it need to be upgraded, all its dependancy #- will be updated too. my %packages; -$urpm->search_packages(\%packages, [ @names ], all => $all) or $force or exit 1; +$urpm->search_packages(\%packages, [ @names ]) or exit 1; + +#- auto select package for upgrading the distribution. +if ($query->{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"; + } +} #- filter to add in packages selected required packages. $query->{deps} && !$query->{upgrade} and $urpm->compute_closure(\%packages); $query->{upgrade} and $urpm->filter_packages_to_upgrade(\%packages, complete => $query->{complete}); +if ($query->{headers}) { + $urpm->read_config(); + + my ($local_sources, $list) = $urpm->get_source_packages(\%packages); + unless ($local_sources || $list) { + die("unable to get source packages, aborting"); + exit 1; + } + + #- now examine source package to build headers list to extract. + foreach (@$local_sources) { + system 'rpm2header', @$local_sources; + } + foreach (0..$#{$urpm->{media} || []}) { + my @headers = (grep { my $file = "$urpm->{cachedir}/headers/$_"; + -s $file and system 'cat', $file; + ! -s $file } + map { /(.*)\/([^\/]*)-([^-]*)-([^-]*)\.([^\.]*)\.rpm/ and "$2-$3-$4.$5" } @{$list->[$_]}); + @headers > 0 or next; + + require packdrake; + my $packer = new packdrake("$urpm->{statedir}/$urpm->{media}[$_]{hdlist}"); + $packer->extract_archive(undef, @headers); + } + exit 0; +} + #- print sub for query. my $query_sub = sub { my ($id) = @_; |