path: root/urpmq

#!/usr/bin/perl

# $Id$

#- Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005 MandrakeSoft SA
#- Copyright (C) 2005, 2006 Mandriva SA
#-
#- 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.

#- this program is based upon urpmi.

use strict;

use urpm 'file_from_local_url';
use urpm::args;
use urpm::msg;
use urpm::sys;
use urpm::util;
use urpm::media;
use urpm::select;
use urpm::get_pkgs;

our @files;
our @names;
our @src_names;

sub usage() {
    print N("urpmq version %s
Copyright (C) 2000-2006 Mandriva.
This is free software and may be redistributed under the terms of the GNU GPL.

usage:
", $urpm::VERSION) . N("  --help         - print this help message.
") . N("  --update       - use only update media.
") . N("  --media        - use only the given media, separated by comma.
") . N("  --searchmedia  - use only the given media to search requested (or updated) packages.
") . N("  --excludemedia - do not use the given media, separated by comma.
") . N("  --sortmedia    - sort media according to substrings separated by comma.
") . N("  --synthesis    - use the given synthesis instead of urpmi db.
") . N("  --auto-select  - automatically select packages to upgrade the system.
") . N("  --fuzzy        - impose fuzzy search (same as -y).
") . N("  --keep         - keep existing packages if possible, reject requested
                   packages that lead to removals.
") . N("  --list         - list available packages.
") . N("  --list-media   - list available media.
") . N("  --list-url     - list available media and their url.
") . N("  --list-nodes   - list available nodes when using --parallel.
") . N("  --list-aliases - list available parallel aliases.
") . N("  --dump-config  - dump the config in form of urpmi.addmedia argument.
") . N("  --src          - next package is a source package (same as -s).
") . N("  --sources      - give all source packages before downloading (root only).
") . N("  --force        - force invocation even if some packages do not exist.
") . N("  --ignorearch   - allow to query rpms for unmatched architectures.
") . N("  --parallel     - distributed urpmi across machines of alias.
") . N("  --root         - use another root for rpm installation.
") . N("  --urpmi-root   - use another root for urpmi db & rpm installation.
") . N("  --use-distrib  - configure urpmi on the fly from a distrib tree.
                   This permit to querying a distro.
") . N("    --probe-synthesis - use synthesis file.
") . N("    --probe-hdlist - use hdlist file.
") . N("  --wget         - use wget to retrieve distant files.
") . N("  --curl         - use curl to retrieve distant files.
") . N("  --prozilla     - use prozilla to retrieve distant files.
") . N("  --proxy        - use specified HTTP proxy, the port number is assumed
                   to be 1080 by default (format is <proxyhost[:port]>).
") . N("  --proxy-user   - specify user and password to use for proxy
                   authentication (format is <user:password>).
") . N("  --env          - use specific environment (typically a bug report).
") . N("  --changelog    - print changelog.
") . N("  --summary, -S  - print summary.
") . N("  --verbose, -v  - verbose mode.
") . N("  --whatrequires - reverse search to what requires package.
") . N("  --whatrequires-recursive
                   - extended reverse search (includes virtual packages).
") . N("  --whatprovides, -p
                   - search in provides to find package.
") . N("  -a             - select all matches on command line.
") . N("  -c             - complete output with package to be removed.
") . N("  -d             - extend query to package dependencies.
") . N("  -f             - print version, release and arch with name.
") . N("  -g             - print groups with name also.
") . N("  -i             - print useful information in human readable form.
") . N("  -l             - list files in package.
") . N("  -m             - equivalent to -du
") . N("  -r             - print version and release with name also.
") . N("  -s             - next package is a source package (same as --src).
") . N("  -u             - remove package if a more recent version is already installed.
") . N("  -y             - impose fuzzy search (same as --fuzzy).
") . N("  -Y             - like -y, but forces to match case-insensitively.
") . "\n" . N("  names or rpm files given on command line are queried.
");
    exit(0);
}

sub escape_shell ($) {
    my ($s) = @_;
    if ($s =~ /\s|'|"/) {
	$s =~ s/"/\\"/g;
	$s = qq("$s");
    } else {
	return $s;
    }
}

#- parse arguments list.
@ARGV or usage();
my $urpm = new urpm;
urpm::args::parse_cmdline(urpm => $urpm) or exit(1);

#- we really don't want logs on stdout, and remove verbose if not asked.
$urpm->{info} = sub { print STDERR "$_[0]\n" };
$urpm->{log} = sub { print STDERR "$_[0]\n" } if $options{verbose} > 0;

#- improve speed if using any list_... options.
$options{nodepslist} = $options{list_aliases}
				|| $options{list_nodes}
				|| $options{list_media}
				|| $options{dump_config}
				|| $options{list_url};
$options{nolock} = 1 if $options{nodepslist};

if ($options{env}) {
    print N("using specific environment on %s\n", $options{env});
    #- setting new environment.
    $urpm->{config} = "$options{env}/urpmi.cfg";
    $urpm->{skiplist} = "$options{env}/skip.list";
    $urpm->{instlist} = "$options{env}/inst.list";
    $urpm->{statedir} = $options{env};
}

#- should we ignore arch compatibility
if ($options{ignorearch}) { urpm::shunt_ignorearch() }

my $rpm_lock = 
  $options{upgrade} && !$options{env} && !$options{nolock}
  && urpm::lock::rpm_db($urpm);
my $urpmi_lock = !$options{nolock} && urpm::lock::urpmi_db($urpm);
urpm::media::configure($urpm,
    nocheck_access => 1,
    nodepslist => $options{nodepslist},
    media => $options{media},
    searchmedia => $options{searchmedia},
    excludemedia => $options{excludemedia},
    sortmedia => $options{sortmedia},
    synthesis => $options{synthesis},
    update => $options{update},
    parallel => $options{parallel},
    probe_with => $options{probe_with},
    usedistrib => $options{usedistrib},
    cmdline_skiplist => $options{skip},
);

my $state = {};
my %requested;

if ($options{list_aliases}) {
    local $_;
    open my $parallelfh, "/etc/urpmi/parallel.cfg";
    while (<$parallelfh>) {
	chomp; s/#.*$//; s/^\s*//; s/\s*$//;
	/\s*([^:]*):/
	    and print "$1\n";
    }
    close $parallelfh;
} elsif ($options{list_nodes}) {
    $options{parallel} or $urpm->{fatal}(1, N("--list-nodes can only be used with --parallel"));
    foreach (keys %{$urpm->{parallel_handler}{nodes} || {}}) {
	print "$_\n";
    }
    exit 0;
} elsif ($options{list_media} || $options{list_url}) {
    foreach (@{$urpm->{media}}) {
	next if $options{list_media} eq 'update' && !$_->{update};
	next if $options{list_media} eq 'active' && $_->{ignore};
	print $_->{name} . ($options{list_url} ? " $_->{url}" : "") . "\n";
    }
    exit 0;
} elsif ($options{dump_config}) {
    foreach (@{$urpm->{media}}) {
	$_->{update} and print "--update ";
	$_->{virtual} and print "--virtual ";
	print escape_shell($_->{name}), " ", escape_shell($_->{url}), " ";
	$_->{with_hdlist} and print "with " . escape_shell($_->{with_hdlist});
	print "\n";
    }
    exit 0;
} elsif ($options{list}) {
    # --list lists all available packages: select them all
    @{$state->{selected}}{0 .. $#{$urpm->{depslist}}} = ();
} else {
    %requested = $urpm->register_rpms(@files);

    #- search the packages according to the selection given by the user.
    if (@names) {
	urpm::select::search_packages($urpm,
	    \%requested,
	    [ @names ],
	    use_provides => $options{use_provides},
	    fuzzy => $urpm->{options}{fuzzy},
	    caseinsensitive => $options{caseinsensitive},
	    all => $options{all},
	) or $options{force}
	    or exit 1;
    }
    if (@src_names) {
	urpm::select::search_packages($urpm,
	    \%requested,
	    [ @src_names ],
	    use_provides => $options{use_provides},
	    fuzzy => $urpm->{options}{fuzzy},
	    caseinsensitive => $options{caseinsensitive},
	    src => 1,
	) or $options{force}
	    or exit 1;
    }

    #- keep track of choices, don't propagate but mark them selected.
    my $stop_on_choices = sub {
	my (undef, undef, $state_, $choices) = @_;
	$state_->{selected}{join '|', sort { $a <=> $b } map { $_ ? $_->id : () } @$choices} = 0;
    };
    #- open/close of database should be moved here, in order to allow testing
    #- some bogus case and check for integrity. (note auto_select implies upgrade).
    if ($options{what_requires}) {
	#- search for packages that require one of the proposed packages.
	my (@properties, %requires, %properties, $dep);

	#- keep in mind the requested id (if given) in order to prefer these packages
	#- on choices instead of anything other one.
	@properties = keys %requested;

	if (@properties) {
	    #- build a requires to packages id hash.
	    foreach my $pkg (@{$urpm->{depslist}}) {
		foreach ($pkg->requires_nosense) {
		    $requires{$_}{$pkg->id} = undef;
		}
	    }

	    #- for each dep property evaluated, examine which package will be obsoleted on $db,
	    #- then examine provides that will be removed (which need to be satisfied by another
	    #- package present or by a new package to upgrade), then requires not satisfied and
	    #- finally conflicts that will force a new upgrade or a remove.
	    while (defined ($dep = shift @properties)) {
		#- take the best package for each choices of same name.
		my $packages = $urpm->find_candidate_packages($dep);
		foreach (values %$packages) {
		    my ($best_requested, $best);
		    foreach (@$_) {
			if ($best_requested || exists $requested{$_->id}) {
			    if ($best_requested && $best_requested != $_) {
				$_->compare_pkg($best_requested) > 0 and $best_requested = $_;
			    } else {
				$best_requested = $_;
			    }
			} elsif ($best && $best != $_) {
			    $_->compare_pkg($best) > 0 and $best = $_;
			} else {
			    $best = $_;
			}
		    }

		    #- examine all proposed choices.
		    my $pkg = $best_requested || $best or next;
		    exists $state->{selected}{$pkg->id} and next;
		    $state->{selected}{$pkg->id} = undef;

		    next if !$requested{$dep} && !$options{what_requires_recursive};

		    #- for all provides of package, look up what is requiring them.
		    foreach ($pkg->provides) {
			if (my ($n, $s) = /^([^\s\[]*)(?:\[\*\])?\[?([^\s\]]*\s*[^\s\]]*)/) {
                            if (my @l = grep { $_ ne $pkg->name } map { $_->name } $urpm->packages_providing($n)) {
				#- If another package provides this requirement,
				#- then don't bother finding stuff that needs it as it will be invalid
				$urpm->{log}(sprintf "skipping package(s) requiring %s via %s, since %s is also provided by %s", $pkg->name, $n, $n, join(' ', @l));
				next;
			    }

			    foreach (map { $urpm->{depslist}[$_] }
				     grep { ! exists $state->{selected}{$_} && ! exists $properties{$_} }
				     keys %{$requires{$n} || {}}) {
				if (grep { URPM::ranges_overlap("$n $s", $_) } $_->requires) {
				    push @properties, $_->id;
				    $urpm->{debug} and $urpm->{debug}(sprintf "adding package %s (requires %s%s)", $_->name, $pkg->name, $n eq $pkg->name ? '' : " via $n");
				    $properties{$_->id} = undef;
				}
			    }
			}
		    }
		}
	    }
	}
    } elsif ($options{auto_select} || $options{upgrade}) {
	urpm::select::resolve_dependencies($urpm, $state, \%requested,
				    keep => $options{keep},
				    rpmdb => $options{env} && "$options{env}/rpmdb.cz",
				    auto_select => $options{auto_select},
				    callback_choices => $stop_on_choices);
	$options{deps} or delete @{$state->{selected}}{grep { exists $state->{selected}{$_} &&
								  ! defined $state->{selected}{$_} } keys %{$state->{selected}}};
    } elsif ($options{deps}) {
	#- only deps required.
	my $empty_db = new URPM; #- URPM has same methods as URPM::DB and empty URPM will be seen as empty URPM::DB.
	$urpm->resolve_requested($empty_db, $state, \%requested, callback_choices => $stop_on_choices, nodeps => 1);
    } else {
	$state->{selected} = \%requested;
    }

    if ($options{sources}
     || $options{info}
     || $options{list_files}
     || $options{changelog})
    {
	my ($local_sources, $list) = urpm::get_pkgs::selected2list($urpm, $state->{selected});

	if ($options{info} || $options{list_files} || $options{changelog}) {
	    # get descriptions of update sources
	    my $updates_descr = urpm::get_updates_description($urpm);
	    # if not root, use a temporary directory to store headers
	    my $tmp_header_dir = $< != 0 ? urpm::sys::mktempdir() : "$urpm->{cachedir}/headers";

	    my @selected = uniq(map { keys %$_ } @$list);

	    foreach my $medium (@{$urpm->{media} || []}) {
		my @l = grep { $medium->{start} <= $_ && $_ <= $medium->{end} } @selected or next;
		my @pkgs = map { $urpm->{depslist}[$_] } @l or next;

		my $hdlist_path = urpm::media::any_hdlist($urpm, $medium);
		if (-s $hdlist_path) {
		    require MDV::Packdrakeng;
		    my $packer = MDV::Packdrakeng->open(archive => $hdlist_path, quiet => 1);
		    defined $packer or do {
			warn "Can't open archive: $MDV::Packdrakeng::error";
			exit 1;
		    };
		    my @headers = map { $_->header_filename } @pkgs or next;
		    $packer->extract($tmp_header_dir, @headers);
		} elsif (my $dir = file_from_local_url($medium->{url})) {
		    $local_sources->{$_->id} = "$dir/" . $_->filename foreach @pkgs;
		} else {
		    my $pkgs_text = join(' ', map { $_->name } @pkgs);
		    if ($options{info}) {
			$urpm->{info}((int(@pkgs) == 1) ?
				N("no hdlist for medium \"%s\", only partial result for package %s", $medium->{name}, $pkgs_text)
				: N("no hdlist for medium \"%s\", only partial result for packages %s", $medium->{name}, $pkgs_text));
		    } else {
			$urpm->{error}((int(@pkgs) == 1) ?
				N("no hdlist for medium \"%s\", unable to return any result for package %s",$medium->{name}, $pkgs_text)
				: N("no hdlist for medium \"%s\", unable to return any result for packages %s", $medium->{name}, $pkgs_text));
		    }
		}
	    }
	    foreach (keys %{$state->{selected}}) {
		foreach (split /\|/, $_) {
		    my $pkg = $urpm->{depslist}[$_] or next;

		    #- even if non-root, search for a header in the global cachedir
		    my $file1 = $local_sources->{$_} || "$urpm->{cachedir}/headers/" . $pkg->header_filename;
		    my $file2 = "$tmp_header_dir/" . $pkg->header_filename;
		    if (my ($file) = grep { -s $_ } $file1, $file2) {
			$pkg->update_header($file, keep_all_tags => 1);
			$file eq $file2 and unlink $file;
		    }
		    if ($options{info})  {
			printf "%-12s: %s\n", "Name", $pkg->name;
			printf "%-12s: %s\n", "Version", $pkg->version;
			printf "%-12s: %s\n", "Release", $pkg->release;
			printf "%-12s: %s\n", "Group", $pkg->group;
			printf "%-12s: %-28s %12s: %s\n", "Size", $pkg->size, "Architecture", $pkg->arch;
			if ($pkg->sourcerpm || $pkg->buildhost) {
			    if ($pkg->sourcerpm && $pkg->buildhost) {
				printf "%-12s: %-28s %12s: %s\n", "Source RPM", $pkg->sourcerpm, "Build Host", $pkg->buildhost;
			    } elsif ($pkg->sourcerpm) {
				$pkg->sourcerpm and printf "%-12s: %s\n", "Source RPM", $pkg->sourcerpm;
			    } else {
				$pkg->sourcerpm and printf "%-12s: %s\n", "Build Host", $pkg->buildhost;
			    }
			}
			$pkg->packager and printf "%-12s: %s\n", "Packager", $pkg->packager;
			$pkg->url and printf "%-12s: %s\n", "URL", $pkg->url;
			$pkg->summary and printf "%-12s: %s\n", "Summary", $pkg->summary;
			my $updesc = $updates_descr->{$pkg->name};
			$pkg->description && !$updesc->{description}
			    and printf "%-12s:\n%s\n", "Description", $pkg->description;
			if ($updesc) {
			    $updesc->{description}
				and printf "%-12s:\n%s\n", "Description", $updesc->{description};
			    $updesc->{updated}
				and printf "%-20s: %s\n", "Last updated", $updesc->{updated};
			    $updesc->{importance}
				and printf "%-20s: %s\n", "Update importance", $updesc->{importance};
			    $updesc->{pre}
				and printf "%-20s:\n%s\n", "Reason for update", $updesc->{pre};
			}
		    }
		    if ($options{list_files}) {
			if ($pkg->files) {
			    print join("\n", $pkg->files) . "\n";
			}
		    }
		    if ($options{changelog}) {
			if ($pkg->changelog_time && $pkg->changelog_name && $pkg->changelog_text) {
			    my @ti = $pkg->changelog_time;
			    my @na = $pkg->changelog_name;
			    my @tx = $pkg->changelog_text;
			    foreach my $i (0 .. $#ti) {
				print "* " . urpm::msg::localtime2changelog($ti[$i]) . " $na[$i]\n$tx[$i]\n\n";
			    }
			} else {
			    print STDERR N("No changelog found\n");
			}
		    }
		}
	    }
	    -d $tmp_header_dir && $< != 0 and rmdir $tmp_header_dir;
	} elsif ($options{sources}) {
	    print join "\n", values %$local_sources; values %$local_sources and print "\n";
	    foreach (0..$#{$urpm->{media} || []}) {
		print join "\n", values %{$list->[$_]}; values %{$list->[$_]} and print "\n";
	    }
	}
	exit 0;
    } elsif ($options{summary}) {
	foreach (keys %{$state->{selected}}) {
	    foreach (split /\|/, $_) {
		my $pkg = $urpm->{depslist}[$_] or next;
		printf "%s : %s ( %s%s-%s )\n", $pkg->name, $pkg->summary, ($pkg->epoch ? $pkg->epoch . ':' : ''), $pkg->version, $pkg->release;
	    }
	}
	exit 0;
    }
}
$urpmi_lock and $urpmi_lock->unlock;
$rpm_lock and $rpm_lock->unlock;

#- print sub for query.
my $query_sub = sub {
    my ($id) = @_;
    my $pkg = $urpm->{depslist}[$id];
    my $str = '';
    $options{group} and $str .= $pkg->group . '/';
    $str .= $pkg->name;
    $options{version} and $str .= '-' . $pkg->version;
    $options{release} and $str .= '-' . $pkg->release;
    $options{arch} and $str .= '.' . $pkg->arch;
    $str;
};

my %hack_only_one;
if ($options{complete}) {
    foreach my $removal (grep { $state->{rejected}{$_}{removed} && !$state->{rejected}{$_}{obsoleted} }
			 keys %{$state->{rejected} || {}}) {
	print '@removing@' . $removal . "\n";
    }
    foreach my $selected (values %{$state->{selected} || {}}) {
	if (ref($selected) eq 'HASH' && ref($selected->{unsatisfied}) eq 'ARRAY') {
	    foreach (@{$selected->{unsatisfied}}) {
		exists $hack_only_one{$_} and next;
		print '@unsatisfied@' . $_ . "\n";
		$hack_only_one{$_} = undef;
	    }
	}
    }
}
foreach my $id (sort { eval { $urpm->{depslist}[$a]->name cmp $urpm->{depslist}[$b]->name } || $a <=> $b }
		$state->{selected} ? keys %{$state->{selected}} : keys %requested) {
    my $class = $state->{selected}{$id} || $requested{$id};
    if (ref($class) eq 'ARRAY') {
	foreach my $choices (@{$class || []}) {
	    exists $hack_only_one{$choices} and next;
	    print join('|', map { $query_sub->($_) } @$choices), "\n";
	    $hack_only_one{$choices} = undef;
	}
    } else {
	print join('|', map { $query_sub->($_) } split '\|', $id), "\n";
    }
}