tools

package Rpmdrake::pkg;
#*****************************************************************************
#
#  Copyright (c) 2002 Guillaume Cottenceau
#  Copyright (c) 2002-2007 Thierry Vignaud <tvignaud@mandriva.com>
#  Copyright (c) 2003, 2004, 2005 MandrakeSoft SA
#  Copyright (c) 2005-2007 Mandriva SA
#
#  This program is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License version 2, as
#  published by the Free Software Foundation.
#
#  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.
#
#*****************************************************************************
#
# $Id$

use strict;
use MDK::Common::Func 'any';
use lib qw(/usr/lib/libDrakX);
use common;
use POSIX qw(_exit);
use URPM;
use utf8;
use Rpmdrake::gurpm;
use Rpmdrake::formatting;
use Rpmdrake::rpmnew;

use rpmdrake;
use urpm::lock;
use urpm::install;
use urpm::signature;
use urpm::get_pkgs;
use urpm::select;
use urpm::main_loop;


use Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw(extract_header find_installed_version formatlistpkg get_pkgs open_rpm_db parse_compssUsers_flat perform_installation perform_removal run_rpm);

use mygtk2 qw(gtknew);
use ugtk2 qw(:all);
use Gtk2::Pango;
use Gtk2::Gdk::Keysyms;


sub parse_compssUsers_flat() {
    my (%compssUsers, $category);
    my $compss = '/var/lib/urpmi/compssUsers.flat';
    -r $compss or $compss = '/usr/share/rpmdrake/compssUsers.flat.default';
    -r $compss or do {
	print STDERR "No compssUsers.flat file found\n";
	return undef;
    };
    foreach (cat_($compss)) {
	s/#.*//;
	/^\s*$/ and next;
	if (/^\S/) {
	    if (/^(.+?) \[icon=.+?\] \[path=(.+?)\]/) {
		$category = translate($2) . '|' . translate($1);
	    } else {
		print STDERR "Malformed category in compssUsers.flat: <$_>\n";
	    }
	} elsif (/^\t(\d) (\S+)\s*$/) {
	    $category or print STDERR "Entry without category <$_>\n";
	    push @{$compssUsers{$2}}, $category . ($1 <= 3 ? '|' . N("Other") : '');
	}
    }
    \%compssUsers;
}

sub run_rpm {
    foreach (qw(LANG LC_CTYPE LC_NUMERIC LC_TIME LC_COLLATE LC_MONETARY LC_MESSAGES LC_PAPER LC_NAME LC_ADDRESS LC_TELEPHONE LC_MEASUREMENT LC_IDENTIFICATION LC_ALL)) {
        local $ENV{$_} = $ENV{$_} . '.UTF-8' if !/UTF-8/;
    }
    my @l = map { to_utf8($_) } `@_`;
    wantarray() ? @l : join('', @l);
}


sub extract_header {
    my ($pkg, $urpm) = @_;
    my $chg_prepro = sub {
	#- preprocess changelog for faster TextView insert reaction
	[ map { [ "$_\n", if_(/^\*/, { 'weight' => Gtk2::Pango->PANGO_WEIGHT_BOLD }) ] } split("\n", $_[0]) ];
    };
    my $name = urpm_name($pkg->{pkg});
    if ($pkg->{pkg}->flag_installed && !$pkg->{pkg}->flag_upgrade) {
	add2hash($pkg, { files => [ split /\n/, chomp_(scalar(run_rpm("rpm -ql $name"))) || N("(none)") ],
                         changelog => $chg_prepro->(scalar(run_rpm("rpm -q --changelog $name"))) });
    } else {
	my ($p, $medium) = ($pkg->{pkg}, pkg2medium($pkg->{pkg}, $urpm));
	my $hdlist = urpm::media::any_hdlist($urpm, $medium);
	if (-r $hdlist) {
	    my $packer;
         require MDV::Packdrakeng; 
         eval { $packer = MDV::Packdrakeng->open(archive => $hdlist, quiet => 1) } or do {
		    warn "Warning, hdlist $hdlist seems corrupted ($@)\n";
		    goto header_non_available;
		};
            my ($headersdir, $retries);
         while (!-d $headersdir && $retries < 5) {
             $headersdir = chomp_(`mktemp -d /tmp/rpmdrake.XXXXXXXX`);
             $retries++;
             -d $headersdir or warn qq(Could not create temporary directory "$headersdir");
         }
         -d $headersdir or  do {
             warn "Warning, could not extract header!";
             goto header_non_available;
	    };
	    $packer->extract($headersdir, $p->header_filename);
	    $p->update_header("$headersdir/" . $p->header_filename) or do {
		warn "Warning, could not extract header!";
		goto header_non_available;
	    };
	    rm_rf($headersdir);
	    add2hash($pkg, { summary => rpm_summary($p->summary), description => rpm_description($p->description) });
	    add2hash($pkg, {
	        files => scalar($p->files) ? [ $p->files ] : [ N("(none)") ],
		changelog => $chg_prepro->(join("\n", mapn { "* " . localtime2changelog($_[2]) . " $_[0]\n\n$_[1]\n" }
						[ $p->changelog_name ], [ $p->changelog_text ], [ $p->changelog_time ])) });
	    $p->pack_header; # needed in order to call methods on objects outside ->traverse
	} else {
           header_non_available:
             add2hash($pkg, { summary => $p->summary || N("(Not available)"), description => undef });
	}
    }
}

my %options;

# because rpm blocks some signals when rpm DB is opened, we don't keep open around:
sub open_rpm_db {
    my ($o_force) = @_;
    my $host;
    log::explanations("opening the RPM database");
    if ($options{parallel} && ((undef, $host) = @{$options{parallel}})) {
        my $done if 0;
        my $dblocation = "/var/cache/urpmi/distantdb/$host";
        if (!$done || $o_force) {
            print "syncing db from $host to $dblocation...";
            mkdir_p "$dblocation/var/lib/rpm";
            system "rsync -Sauz -e ssh $host:/var/lib/rpm/ $dblocation/var/lib/rpm";
            $? == 0 or die "Couldn't sync db from $host to $dblocation";
            $done = 1;
            print "done.\n";
        }
        URPM::DB::open($dblocation) or die "Couldn't open RPM DB";
    } else {
        URPM::DB::open or die "Couldn't open RPM DB";
    }
}


sub find_installed_version {
    my ($p) = @_;
    my @version;
    open_rpm_db()->traverse_tag('name', [ $p->name ], sub { push @version, $_[0]->version . '-' . $_[0]->release });
    @version ? join(',', sort @version) : N("(none)");
}

sub formatlistpkg { join("\n", map { s/^(\s)/  \1/mg; "- $_" } sort { uc($a) cmp uc($b) } @_) }


# -=-=-=---=-=-=---=-=-=-- install packages -=-=-=---=-=-=---=-=-=-

my (@update_medias, $is_update_media_already_asked);

sub warn_about_media {
    my ($w, $opts) = @_;
    my $urpm = open_urpmi_db();

    my $update_name = 'update_source';
    return if !member($::default_list_mode, qw(all_updates security bugfix normal));
    return if $::options{'no-media-update'};
	    if (@update_medias > 0) {
		if (!$opts->{skip_updating_mu} && !$is_update_media_already_asked) {
              $is_update_media_already_asked = 1;
		     $::options{'no-confirmation'} or interactive_msg_with_banner(N("Confirmation"),
N("I need to contact the mirror to get latest update packages.
Please check that your network is currently running.

Is it ok to continue?"), yesno => 1) or myexit(-1);
		    urpm::media::select_media($urpm, map { $_->{name} } @update_medias);
		    update_sources($urpm, noclean => 1, banner => $::isEmbedded);
		}
	    } else {
		if (any { $_->{update} } @{$urpm->{media}}) {
		    interactive_msg(N("Already existing update media"),
N("You already have at least one update medium configured, but
all of them are currently disabled. You should run the Software
Media Manager to enable at least one (check it in the \"%s\"
column).

Then, restart \"%s\".", N("Enabled"), $rpmdrake::myname_update));
		    myexit(-1);
		}
	      mu_retry_another_mirror:
		my ($mirror) = choose_mirror(if_(exists $w->{real_window}, transient => $w->{real_window}));
		my $m = ref($mirror) ? $mirror->{url} : '';
		$m or interactive_msg(N("How to choose manually your mirror"),
N("You may also choose your desired mirror manually: to do so,
launch the Software Media Manager, and then add a `Security
updates' medium.

Then, restart %s.", $rpmdrake::myname_update)), myexit(-1);
		add_medium_and_check(
		    $urpm, {},
		    $update_name, make_url_mirror($m), 'media_info/synthesis.hdlist.cz', update => 1,
		);
		@update_medias = { name => $update_name };  #- hack to simulate a medium for parsing of descriptions
	    }
}


sub open_urpmi_db() {
    my $error_happened;
    my $urpm = urpm->new;
    $urpm->{options}{'split-level'} ||= 20;
    $urpm->{options}{'split-length'} ||= 1;
    $urpm->{options}{'allow-force'}   = 1;
    $urpm->{options}{'allow-nodeps'}  = 1;
    $urpm->{options}{'no-verify-rpm'} = $::options{'no-verify-rpm'};

    $urpm->{fatal} = sub {
        $error_happened = 1;
        interactive_msg(N("Fatal error"),
                         N("A fatal error occurred: %s.", $_[1]));
    };
    my $media = ref $::options{media} ? join(',', @{$::options{media}}) : '';
    urpm::media::configure($urpm, media => $media);
    if ($error_happened) {
        touch('/etc/urpmi/urpmi.cfg');
        exec('edit-urpm-sources.pl');
    }
    $urpm;
}


our $probe_only_for_updates;
sub get_pkgs {
    my ($opts) = @_;
    my %update_descr;
    @update_medias = ();
    my $w = $::main_window;

    Rpmdrake::gurpm::init(1 ? N("Please wait") : N("Package installation..."), N("Initializing..."), transient => $::main_window);
    my $_gurpm_clean_guard = before_leaving { Rpmdrake::gurpm::end() };
    my $_flush_guard = Gtk2::GUI_Update_Guard->new;

    my $urpm = open_urpmi_db();
    my $_lock = urpm::lock::urpmi_db($urpm);
    @update_medias = grep { !$_->{ignore} && $_->{update} } @{$urpm->{media}};

    warn_about_media($w, $opts);

    Rpmdrake::gurpm::label(N("Reading updates description"));
    Rpmdrake::gurpm::progress(0.05);
	my ($cur, $section);
	#- parse the description file
    foreach my $medium (@update_medias) {
        foreach (cat_(urpm::media::statedir_descriptions($urpm, $medium))) {
            /^%package +(.+)/ and do {
                my @pkg_list = split /\s+/, $1;
                 exists $cur->{importance} && $cur->{importance} !~ /^(?:security|bugfix)\z/
                   and $cur->{importance} = 'normal';
                $update_descr{$_} = $cur foreach @{$cur->{pkgs} || []};
                $cur = { pkgs => \@pkg_list, medium => $medium->{name} };
                $section = 'pkg';
                next;
            };
            /^%(pre|description)/ and do { $section = $1; next };
            /^Updated?: +(.+)/ && $section eq 'pkg'
              and do { $cur->{update} = $1; next };
            /^Importance: +(.+)/ && $section eq 'pkg'
              and do { $cur->{importance} = $1; next };
            /^(ID|URL): +(.+)/ && $section eq 'pkg'
              and do { $cur->{$1} = $2; next };
            $section =~ /^(pre|description)\z/ and $cur->{$1} .= $_;
        }
    }

    my $_unused = N("Please wait, finding available packages...");

    # find out installed packages:

    my $level = 0.05;
    my $total = @{$urpm->{depslist}};
    Rpmdrake::gurpm::label(N("Please wait, listing base packages..."));
    Rpmdrake::gurpm::progress($level);

    my ($count, $prev_stage, $new_stage, $limit);
    
    my $reset_update = sub { undef $prev_stage; $count = 0; $limit = $_[0] };
    my $update = sub {
        return if !$total; # don't die if there's no source
        $count++;
        $new_stage = $level+($limit-$level)*$count/$total;
        if ($prev_stage + 0.01 < $new_stage) {
            $prev_stage = $new_stage;
            Rpmdrake::gurpm::progress($new_stage);
        }
    };

    my @base = ("basesystem", split /,\s*/, $urpm->{global_config}{'prohibit-remove'});
    my (%base, %basepackages);
    my $db = open_rpm_db();
    my $sig_handler = sub { undef $db; exit 3 };
    local $SIG{INT} = $sig_handler;
    local $SIG{QUIT} = $sig_handler;
    $reset_update->(0.33);
    while (defined(local $_ = shift @base)) {
	exists $basepackages{$_} and next;
	$db->traverse_tag(m|^/| ? 'path' : 'whatprovides', [ $_ ], sub {
			      $update->();
			      push @{$basepackages{$_}}, urpm_name($_[0]);
			      push @base, $_[0]->requires_nosense;
			  });
    }
    foreach (values %basepackages) {
	my $n = @$_; #- count number of times it's provided
	foreach (@$_) {
	    $base{$_} = \$n;
	}
    }
    Rpmdrake::gurpm::label(N("Please wait, finding installed packages..."));
    Rpmdrake::gurpm::progress($level = 0.33);
    $reset_update->(0.66);
    my (@installed_pkgs, %all_pkgs);
    if (!$probe_only_for_updates) {
    $db->traverse(sub {
	    my ($pkg) = @_;
	    $update->();
	    my $fullname = urpm_name($pkg);
	    #- Extract summary and description since they'll be lost when the header is packed
	    $all_pkgs{$fullname} = {
		selected => 0, pkg => $pkg, urpm_name => urpm_name($pkg),
		summary => rpm_summary($pkg->summary),
		description => rpm_description($pkg->description),
	    } if !($all_pkgs{$fullname} && $all_pkgs{$fullname}{description});
	    if (my $name = $base{$fullname}) {
		$all_pkgs{$fullname}{base} = \$name;
		$pkg->set_flag_base(1) if $$name == 1;
	    }
         push @installed_pkgs, $fullname;
	    $pkg->pack_header; # needed in order to call methods on objects outside ->traverse
	});
    my $group;
    if ($::options{parallel} && (($group) = @{$::options{parallel}})) {
        urpm::media::configure($urpm, parallel => $group);
    }

    }

    # find out availlable packages:

    $urpm->{state} = {};
    my (@installable_pkgs, @updates);

    Rpmdrake::gurpm::label(N("Please wait, finding available packages..."));
    Rpmdrake::gurpm::progress($level = 0.66);

    @update_medias = grep { !$_->{ignore} && $_->{update} } @{$urpm->{media}};
    check_update_media_version($urpm, @update_medias);

    my $requested = {};
    my $state = {};
    $urpm->request_packages_to_upgrade(
	$db,
	$state,
	$requested,
    );

    # list of updates (including those matching /etc/urpmi/skip.list):
    my @requested = sort map { urpm_name($_) } @{$urpm->{depslist}}[keys %$requested];
    # list of pure updates (w/o those matching /etc/urpmi/skip.list but with their deps):
    my @requested_strict = $probe_only_for_updates ?
      sort map {
          urpm_name($_);
      } $urpm->resolve_requested($db, $state, $requested, callback_choices => \&Rpmdrake::gui::callback_choices)
        : ();
    # list updates including skiped ones + their deps in MandrivaUpdate:
    push @requested, difference2(\@requested_strict, \@requested) if $probe_only_for_updates;

    if (!$probe_only_for_updates) {
        $urpm->compute_installed_flags($db); # TODO/FIXME: not for updates
        $urpm->{depslist}[$_]->set_flag_installed foreach keys %$requested; #- pretend it's installed
    }
    $urpm->{rpmdrake_state} = $state; #- Don't forget it
    Rpmdrake::gurpm::progress($level = 0.7);

    my %pkg_sel   = map { $_ => 1 } @{$::options{'pkg-sel'}   || []};
    my %pkg_nosel = map { $_ => 1 } @{$::options{'pkg-nosel'} || []};
    $reset_update->(1);
    foreach my $pkg (@{$urpm->{depslist}}) {
        $update->();
	$pkg->flag_upgrade or next;
        my $selected = 0;
        my $name = urpm_name($pkg);

	if (member($name, @requested)) {
            #any { $pkg->id >= $_->{start} && $pkg->id <= $_->{end} } @update_medias or next;
            if ($::options{'pkg-sel'} || $::options{'pkg-nosel'}) {
		my $n = $name;
		$pkg_sel{$n} || $pkg_nosel{$n} or next;
		$pkg_sel{$n} and $selected = 1;
Mode	Name	Size
-rw-r--r--	Makefile	596	log stats plain
-rwxr-xr-x	checkusedmodules	973	log stats plain
-rwxr-xr-x	drakx-in-chroot	9696	log stats plain
-rw-r--r--	extractchangelog	17	log stats plain
-rwxr-xr-x	find-drivers-needing-nonfree-firmware	2661	log stats plain
-rwxr-xr-x	get-needed-drakx-modules	457	log stats plain
-rwxr-xr-x	hd_grub.cgi	3215	log stats plain
-rwxr-xr-x	install-xml-file-list	10732	log stats plain
-rw-r--r--	make_lang_png_transparent.c	3796	log stats plain
-rwxr-xr-x	mdkinst_stage2_tool	1587	log stats plain
-rw-r--r--	ntp_servers.pl	6912	log stats plain
-rw-r--r--	rpcinfo-flushed.c	18020	log stats plain
d---------	serial_probe	221	log stats plain
-rw-r--r--	shift_all.pl	1229	log stats plain
-rw-r--r--	shift_img.c	3741	log stats plain
-rwxr-xr-x	simplify-drakx-modules	111	log stats plain
-rwxr-xr-x	specific_arch	214	log stats plain
-rw-r--r--	xhost+.c	240	log stats plain