path: root/gurpmi2

#!/usr/bin/perl

#- Copyright (C) 2005 MandrakeSoft SA
#- Copyright (C) 2005-2010 Mandriva SA

use strict;

BEGIN { #- set up a safe path and environment
    $ENV{PATH} = "/sbin:/usr/sbin:/bin:/usr/bin";
    delete @ENV{qw(ENV BASH_ENV IFS CDPATH)};
}

use gurpmi;
use gurpm::RPMProgressDialog;
use urpm::install;
use urpm::media;
use urpm::signature;
use urpm::get_pkgs;
use urpm::msg;
use urpm::select;
use urpm::main_loop;
use Gtk2;

#- default options.
our $allow_medium_change = 0;
our $auto_select = 0;
our $force = 0;
our $test = 0;
our $use_provides = 1;

# For other distros w/o exception support:
eval { Glib->enable_exceptions2 };
if (my $err = $@) {
   warn "Error: $err\n";
}

#- GUI globals
my $mainw;

my @all_rpms = gurpmi::parse_command_line();

$> and fatal(N("Must be root"));

#- Now, the graphical stuff.

Gtk2->init;

#- Initialize urpm

my $urpm;
{ 
    local @ARGV = @ARGV;
    $urpm = urpm->new_parse_cmdline;
}

#- Create main window

$mainw = gurpm::RPMProgressDialog->new($urpm, \&quit);

#- Performs installation

configure_urpm($urpm);

my $state = {};
my %requested = $urpm->register_rpms(@all_rpms);
if (@gurpmi::names) {
    urpm::select::search_packages($urpm, \%requested, [ @gurpmi::names ],
                                  use_provides => $use_provides,
                              ) || $force or exit 1;
}

$mainw->label(N("Preparing packages installation..."));

#- return value is true if program should be restarted (in order to take care of important
#- packages being upgraded (problably urpmi and perl-URPM, but maybe rpm too, and glibc also ?).
my $restart_itself = urpm::select::resolve_dependencies($urpm,
    $state,
    \%requested,
    callback_choices => \&ask_choice,
    auto_select => $::auto_select,
    priority_upgrade => $urpm->{options}{'priority-upgrade'},
);
my @ask_unselect = urpm::select::unselected_packages($state);

# If there are some unselected packages, designate that we are going to return nonzero code.
if (@ask_unselect) {
    my $unselect_msg = N("Some requested packages cannot be installed:\n%s",
        urpm::select::translate_why_unselected($urpm, $state, @ask_unselect));
    $urpm::postponed_msg .= $unselect_msg . "\n";
    $urpm::postponed_code = 17;
}

@ask_unselect
? ask_continue(N(
	"Some requested packages cannot be installed:\n%s\nContinue installation anyway?",
	urpm::select::translate_why_unselected($urpm, $state, @ask_unselect)
    ), \&do_install)
: do_install();

$mainw->show_all;
Gtk2->main;

my ($rpm_lock, $urpmi_lock);

#- Creates and configure an urpm object for this application to use.
sub configure_urpm {
    my ($urpm) = @_;

    $urpm->{fatal} = sub {
	printf STDERR "%s\n", $_[1];
	Gtk2::MessageDialog->new($mainw, [qw(modal destroy-with-parent)], 'error', 'ok', Locale::gettext::iconv($_[1], undef, 'UTF-8'))->run;
	quit();
	exit $_[0];
    };
    $urpm->{log}   = sub { printf "%s\n", $_[0] };
    $urpm->{error} = sub {
	my ($message) = @_;
	printf STDERR "%s\n", $message;

	if (my $download_errors = delete $urpm->{download_errors}) {
	    $message = join("\n", @$download_errors, $message);
	}
	my $nb_lines = $message =~ tr/\n/\n/;
	my $w;
	if ($nb_lines > 30 || $message =~ /^transaction is too small/) {
	    $w  = Gtk2::Dialog->new(N("Warning"), $mainw, [qw(modal destroy-with-parent)], N("Ok"), 'ok');
	    $w->vbox->add(my $f = Gtk2::Frame->new);
	    my $sw = create_scrolled_window(my $text = Gtk2::TextView->new);
	    $sw->set_border_width(2);
	    $text->set_wrap_mode('word');
	    $f->add($sw);
	    $text->get_buffer->set_text($message);
	    $text->set_editable(0);
	    $_->show foreach $f, $sw, $text;
	    $w->set_size_request(400, 400);
	    $w->set_default_response('ok');
	} else {
	    $w  = Gtk2::MessageDialog->new($mainw, [qw(modal destroy-with-parent)], 'warning', 'ok', $message);
	}
	$w->run;
	$w->destroy;
    };
    urpm::select::set_priority_upgrade_option($urpm, $gurpmi::options{previous_priority_upgrade});
    $rpm_lock = urpm::lock::rpm_db($urpm, 'exclusive');
    $urpmi_lock = urpm::lock::urpmi_db($urpm);
    urpm::media::configure($urpm,
	media	    => $gurpmi::options{media},
	searchmedia => $gurpmi::options{searchmedia},
        update      => $::update,
    );
    $urpm->{options}{'verify-rpm'} = 0 if $gurpmi::options{'no-verify-rpm'};
}

#- Callback for choices
sub ask_choice {
    my (undef, undef, undef, $choices) = @_;
    return $choices->[0] if $gurpmi::options{auto};
    my $radio;
    my @radios = map {
	$radio = Gtk2::RadioButton->new_with_label(
	    $radio ? $radio->get_group : undef,
	    (scalar $_->fullname) . " : " . $_->summary
	    . ($_->flag_installed ? N(" (to upgrade)") : '')
	    . ($_->flag_upgrade   ? N(" (to install)") : '')
	);
    } @$choices;
    my $d = Gtk2::Dialog->new(N("Package choice"), $mainw, [], N("_Cancel") => 0, N("_Ok") => 1);
    my $label = Gtk2::Label->new(N("One of the following packages is needed:"));
    $label->set_alignment(0.5, 0.5);
    $d->vbox->pack_start($label, 1, 1, 0);
    $d->vbox->pack_start($_, 1, 1, 0) foreach @radios;
    my $n = 0;
    $d->signal_connect(response => sub {
	if ($_[1] == 1) { #- "ok"
	    foreach (@radios) { last if $_->get_active; ++$n }
	}
	$d->destroy;
	exit(1) if $_[1] == 0; #- "cancel"
    });
    $radios[0]->set_active(1);
    $d->set_default_response(1); # defaults to ok
    $d->show_all;
    $d->run;
    $choices->[$n];
}

sub ask_continue {
    my ($msg, $nextclosure) = @_;
    my $vbox = Gtk2::VBox->new(0, 5);
    $vbox->pack_start(new_label($msg), 1, 1, 0);
    $urpm->{log}($msg);
    my $continue_button = Gtk2::Button->new(but(N("_Ok")));
    my $quit_button = Gtk2::Button->new(but(N("_Abort")));
    $quit_button->signal_connect(clicked => sub { $urpm->{log}("=> cancel"); &quit(); exit 1 });
    $continue_button->signal_connect(clicked => sub { $urpm->{log}("=> ok"); goto &$nextclosure });
    add_button_box($vbox, $quit_button, $continue_button);
    $mainw->change_widget($vbox);
    # default is to continue, but according to some HIG, warning should reverse the choise and defaults to abort
    $mainw->set_focus($continue_button); # also set_default should be called but it gives a warning!
}

sub ask_continue_if_no_auto {
    my ($msg, $nextclosure) = @_;
    if ($gurpmi::options{auto}) {
	$urpm->{log}($msg);
	$urpm->{log}("=> ok(auto)");
	goto &$nextclosure;
    } else {
	ask_continue($msg, $nextclosure);
    }
}

sub ask_continue_blocking {
    my ($msg) = @_;
    my $w = Gtk2::MessageDialog->new($mainw, [qw(modal destroy-with-parent)], 'question', 'yes-no', $msg);
    my $answer = $w->run;
    $w->destroy;
    $urpm->{log}($msg . " => " . $answer);
    exit(1) if $answer eq 'no';
    1;
}

sub do_install {
    $mainw->label;
    my @ask_remove = urpm::select::removed_packages($state);
    @ask_remove
	? ask_continue_if_no_auto(N(
	    "The following packages have to be removed for others to be upgraded:\n%s\nContinue installation anyway?",
	    urpm::select::translate_why_removed($urpm, $state, @ask_remove)
	), \&do_install_2)
	: goto &do_install_2;
}

sub do_install_2 () {
    my @to_install;
    my $sum;
    foreach my $pkg (sort { $a->name cmp $b->name } @{$urpm->{depslist}}[keys %{$state->{selected}}]) {
        if ($pkg->arch ne 'src') {
            push @to_install, scalar $pkg->fullname;
            $sum += $pkg->size;
        }
    }
    $urpm->{nb_install} = @to_install;
    @to_install > 1
	? ask_continue_if_no_auto(
		(scalar(@to_install) == 1 ?
		N("To satisfy dependencies, the following package is going to be installed:")
		: N("To satisfy dependencies, the following packages are going to be installed:"))
       	. join("\n", '', @to_install, '') 
	. P("(%d package, %d MB)", "(%d packages, %d MB)", scalar(@to_install), scalar(@to_install), toMb($sum)),
                    , \&do_install_3)
	: goto \&do_install_3;
}

sub do_install_3 () {
    $mainw->label($mainw->title);
    my ($local_sources, $blists) = urpm::get_pkgs::selected2local_and_blists($urpm, $state->{selected});
    $local_sources || $blists or $urpm->{fatal}(3, N("unable to get source packages, aborting"));

    $mainw->init_progressbar;

    my $exit_code = urpm::main_loop::run($urpm, $state, scalar(@gurpmi::names),  \@ask_unselect, {
        bad_signature => sub {
            my ($msg, $msg2) = @_;
            $urpm->{log}("$msg\n$msg2");
            ask_continue_blocking("$msg\n$msg2");
        },
        copy_removable => sub {
            #FIXME: use use udisks to wait-for/mount cdroms: 
            my $w = Gtk2::MessageDialog->new($mainw, [qw(modal destroy-with-parent)], 'warning', 'ok-cancel',
                                             N("Please insert the medium named \"%s\"", $_[0])
                                         );
            my $response = $w->run;
            $w->destroy;
            exit 1 if $response eq 'cancel';
            1;
        },
        trans_log => &gurpm::RPMProgressDialog::callback_download,
        ask_yes_or_no => \&ask_yes_or_no,

        completed => sub {
            $urpmi_lock->unlock;
            $rpm_lock->unlock;
            urpm::removable::try_umounting_removables($urpm);
            my $vbox = Gtk2::VBox->new(0, 5); # FIXME: should it be change_widget???
            my $progress_label = Gtk2::Label->new('-'); # TEST ME
            return 0 if $gurpmi::options{auto};
            my $sw = create_scrolled_window($progress_label);
            $sw->set_size_request(500, 200);
            $vbox->pack_start($sw, 1, 1, 0);
            my $quit_button = Gtk2::Button->new(but(N("_Done")));
            $quit_button->signal_connect(clicked => \&quit);
            add_button_box($vbox, $quit_button);
            $mainw->change_widget($vbox);
            $mainw->set_focus($quit_button);
        },
        need_restart => sub {
            return if $gurpmi::options{auto};
            my ($need_restart_formatted) = @_;
            my $w = Gtk2::MessageDialog->new($mainw, [qw(modal destroy-with-parent)], 'warning', 'ok',
                                             join("\n", values %$need_restart_formatted)
                                         );
            $w->run;
            $w->destroy;
        },
        missing_files_summary => sub {
            my ($error_sources) = @_;
            $mainw->set_progresslabel(N("Installation failed, some files are missing:\n%s",
                                         join("\n", map { s|([^:]*://[^/:\@]*:)[^/:\@]*(\@.*)|$1xxxx$2|; "    $_" }
                                                values %$error_sources))
                                   . "\n" . N("You may want to update your urpmi database."));
        },
        trans_error_summary => sub {
            my ($_nok, $errors) = @_;
            $mainw->set_progresslabel(N("Installation failed:") . "\n" . join("\n",  map { "\t$_" } @$errors));
        },
        # TODO: use urpmi strings:
        already_installed_or_not_installable => sub {
            my ($_msg1, $_msg2) = @_;
            $mainw->set_progresslabel(N("The package(s) are already installed"));
        },
        success_summary => sub { $mainw->set_progresslabel(N("Installation finished")) },
        uninst => \&gurpm::RPMProgressDialog::callback_inst,
        inst => \&gurpm::RPMProgressDialog::callback_inst,
        trans => \&gurpm::RPMProgressDialog::callback_inst,
    }
                     );

    # Merge postponed exit code to the result of package installation.
    $exit_code ||= $urpm::postponed_code;

    #- restart gurpmi if needed, keep command line for that.
    if ($restart_itself && !$exit_code) {
        print N("restarting urpmi"), "\n";
        #- it seems to work correctly with exec instead of system, provided
        #- added --previous-priority-upgrade to allow checking if yet if
        #-   priority-upgrade list has changed. and make sure we don't uselessly restart
        @ARGV = ('--previous-priority-upgrade=' . $urpm->{options}{'priority-upgrade'}, 
                grep { !/^--no-priority-upgrade$|--previous-priority-upgrade=/ } @ARGV);
        exec $0, @ARGV;
    }

    # Show postponed message before exiting
    $urpm->{error}->($urpm::postponed_msg) if $urpm::postponed_code != 0;

    exit $exit_code;
}

sub ask_yes_or_no {
    my ($_title, $msg) = @_;
    # MessageDialogs have no titles unless using 'secondary-text'
    my $w = Gtk2::MessageDialog->new($mainw, [qw(modal destroy-with-parent)], 'warning', 'yes-no', $msg);
    my $response = $w->run;
    $w->destroy;
    $response eq 'yes';
}