diff options
Diffstat (limited to 'lib/AdminPanel/rpmdragora.pm')
| -rw-r--r-- | lib/AdminPanel/rpmdragora.pm | 416 |
1 files changed, 215 insertions, 201 deletions
diff --git a/lib/AdminPanel/rpmdragora.pm b/lib/AdminPanel/rpmdragora.pm index 06cf9932..049dce00 100644 --- a/lib/AdminPanel/rpmdragora.pm +++ b/lib/AdminPanel/rpmdragora.pm @@ -165,7 +165,7 @@ sub myexit { my ($root) = grep { $_->[2] == 0 } list_passwd(); $ENV{HOME} = $> == 0 ? $root->[7] : $ENV{HOME} || '/root'; -$ENV{HOME} = $::env if $::env = $Rpmdragora::init::rpmdragora_options{env}[0]; +$ENV{HOME} = $::env if $::env = $AdminPanel::Rpmdragora::init::rpmdragora_options{env}[0]; our $configfile = "$ENV{HOME}/.rpmdragora"; @@ -221,7 +221,7 @@ sub readconf() { } # special cases: $::rpmdragora_options{'no-confirmation'} = $no_confirmation->[0] if !defined $::rpmdragora_options{'no-confirmation'}; - $Rpmdragora::init::default_list_mode = $tree_mode->[0] if ref $tree_mode && !$Rpmdragora::init::overriding_config; + $AdminPanel::Rpmdragora::init::default_list_mode = $tree_mode->[0] if ref $tree_mode && !$AdminPanel::Rpmdragora::init::overriding_config; } sub writeconf() { @@ -266,9 +266,8 @@ sub interactive_msg { $info->{richtext} = 1; ## richtext needs <br> instead of '\n' $contents =~ s/\n/<br>/g; - } else { #- because we'll use a WrappedLabel - $contents = MDK::Common::String::formatAlaTeX($contents) if !ref $contents; } + $info->{text} = $contents; my $dlg; @@ -288,7 +287,7 @@ sub interactive_msg { $dlg->setText($info->{text}, $rt) if (exists $info->{text}); $dlg->setDefaultButton($yui::YMGAMessageBox::B_ONE); - $dlg->setMinSize(50, 5); + $dlg->setMinSize(75, 6); $retVal = $dlg->show() == $yui::YMGAMessageBox::B_ONE ? 1 : 0; @@ -462,75 +461,75 @@ sub slow_func_statusbar ($$&) { } my %u2l = ( - at => N_("Austria"), - au => N_("Australia"), - be => N_("Belgium"), - br => N_("Brazil"), - ca => N_("Canada"), - ch => N_("Switzerland"), - cr => N_("Costa Rica"), - cz => N_("Czech Republic"), - de => N_("Germany"), - dk => N_("Danmark"), - el => N_("Greece"), - es => N_("Spain"), - fi => N_("Finland"), - fr => N_("France"), - gr => N_("Greece"), - hu => N_("Hungary"), - il => N_("Israel"), - it => N_("Italy"), - jp => N_("Japan"), - ko => N_("Korea"), - nl => N_("Netherlands"), - no => N_("Norway"), - pl => N_("Poland"), - pt => N_("Portugal"), - ru => N_("Russia"), - se => N_("Sweden"), - sg => N_("Singapore"), - sk => N_("Slovakia"), - tw => N_("Taiwan"), - uk => N_("United Kingdom"), - cn => N_("China"), - com => N_("United States"), - org => N_("United States"), - net => N_("United States"), - edu => N_("United States"), - ); + at => N_("Austria"), + au => N_("Australia"), + be => N_("Belgium"), + br => N_("Brazil"), + ca => N_("Canada"), + ch => N_("Switzerland"), + cr => N_("Costa Rica"), + cz => N_("Czech Republic"), + de => N_("Germany"), + dk => N_("Danmark"), + el => N_("Greece"), + es => N_("Spain"), + fi => N_("Finland"), + fr => N_("France"), + gr => N_("Greece"), + hu => N_("Hungary"), + il => N_("Israel"), + it => N_("Italy"), + jp => N_("Japan"), + ko => N_("Korea"), + nl => N_("Netherlands"), + no => N_("Norway"), + pl => N_("Poland"), + pt => N_("Portugal"), + ru => N_("Russia"), + se => N_("Sweden"), + sg => N_("Singapore"), + sk => N_("Slovakia"), + tw => N_("Taiwan"), + uk => N_("United Kingdom"), + cn => N_("China"), + com => N_("United States"), + org => N_("United States"), + net => N_("United States"), + edu => N_("United States"), +); my $us = [ qw(com org net edu) ]; my %t2l = ( - 'America/\w+' => $us, - 'Asia/Tel_Aviv' => [ qw(il ru it cz at de fr se) ], - 'Asia/Tokyo' => [ qw(jp ko tw), @$us ], - 'Asia/Seoul' => [ qw(ko jp tw), @$us ], - 'Asia/Taipei' => [ qw(tw jp), @$us ], - 'Asia/(Shanghai|Beijing)' => [ qw(cn tw sg), @$us ], - 'Asia/Singapore' => [ qw(cn sg), @$us ], - 'Atlantic/Reykjavik' => [ qw(uk no se fi dk), @$us, qw(nl de fr at cz it) ], - 'Australia/\w+' => [ qw(au jp ko tw), @$us ], - 'Brazil/\w+' => [ 'br', @$us ], - 'Canada/\w+' => [ 'ca', @$us ], - 'Europe/Amsterdam' => [ qw(nl be de at cz fr se dk it) ], - 'Europe/Athens' => [ qw(gr pl cz de it nl at fr) ], - 'Europe/Berlin' => [ qw(de be at nl cz it fr se) ], - 'Europe/Brussels' => [ qw(be de nl fr cz at it se) ], - 'Europe/Budapest' => [ qw(cz it at de fr nl se) ], - 'Europe/Copenhagen' => [ qw(dk nl de be se at cz it) ], - 'Europe/Dublin' => [ qw(uk fr be nl dk se cz it) ], - 'Europe/Helsinki' => [ qw(fi se no nl be de fr at it) ], - 'Europe/Istanbul' => [ qw(il ru it cz it at de fr nl se) ], - 'Europe/Lisbon' => [ qw(pt es fr it cz at de se) ], - 'Europe/London' => [ qw(uk fr be nl de at cz se it) ], - 'Europe/Madrid' => [ qw(es fr pt it cz at de se) ], - 'Europe/Moscow' => [ qw(ru de pl cz at se be fr it) ], - 'Europe/Oslo' => [ qw(no se fi dk de be at cz it) ], - 'Europe/Paris' => [ qw(fr be de at cz nl it se) ], - 'Europe/Prague' => [ qw(cz it at de fr nl se) ], - 'Europe/Rome' => [ qw(it fr cz de at nl se) ], - 'Europe/Stockholm' => [ qw(se no dk fi nl de at cz fr it) ], - 'Europe/Vienna' => [ qw(at de cz it fr nl se) ], - ); + 'America/\w+' => $us, + 'Asia/Tel_Aviv' => [ qw(il ru it cz at de fr se) ], + 'Asia/Tokyo' => [ qw(jp ko tw), @$us ], + 'Asia/Seoul' => [ qw(ko jp tw), @$us ], + 'Asia/Taipei' => [ qw(tw jp), @$us ], + 'Asia/(Shanghai|Beijing)' => [ qw(cn tw sg), @$us ], + 'Asia/Singapore' => [ qw(cn sg), @$us ], + 'Atlantic/Reykjavik' => [ qw(uk no se fi dk), @$us, qw(nl de fr at cz it) ], + 'Australia/\w+' => [ qw(au jp ko tw), @$us ], + 'Brazil/\w+' => [ 'br', @$us ], + 'Canada/\w+' => [ 'ca', @$us ], + 'Europe/Amsterdam' => [ qw(nl be de at cz fr se dk it) ], + 'Europe/Athens' => [ qw(gr pl cz de it nl at fr) ], + 'Europe/Berlin' => [ qw(de be at nl cz it fr se) ], + 'Europe/Brussels' => [ qw(be de nl fr cz at it se) ], + 'Europe/Budapest' => [ qw(cz it at de fr nl se) ], + 'Europe/Copenhagen' => [ qw(dk nl de be se at cz it) ], + 'Europe/Dublin' => [ qw(uk fr be nl dk se cz it) ], + 'Europe/Helsinki' => [ qw(fi se no nl be de fr at it) ], + 'Europe/Istanbul' => [ qw(il ru it cz it at de fr nl se) ], + 'Europe/Lisbon' => [ qw(pt es fr it cz at de se) ], + 'Europe/London' => [ qw(uk fr be nl de at cz se it) ], + 'Europe/Madrid' => [ qw(es fr pt it cz at de se) ], + 'Europe/Moscow' => [ qw(ru de pl cz at se be fr it) ], + 'Europe/Oslo' => [ qw(no se fi dk de be at cz it) ], + 'Europe/Paris' => [ qw(fr be de at cz nl it se) ], + 'Europe/Prague' => [ qw(cz it at de fr nl se) ], + 'Europe/Rome' => [ qw(it fr cz de at nl se) ], + 'Europe/Stockholm' => [ qw(se no dk fi nl de at cz fr it) ], + 'Europe/Vienna' => [ qw(at de cz it fr nl se) ], +); #- get distrib release number (2006.0, etc) sub etc_version() { @@ -855,71 +854,30 @@ sub update_sources_noninteractive { return 1; } -sub mirrors { - my ($urpm, $want_base_distro) = @_; - my $cachedir = $urpm->{cachedir} || '/root'; - require mirror; - mirror::register_downloader( - sub { - my ($url) = @_; - my $file = $url; - $file =~ s!.*/!$cachedir/!; - unlink $file; # prevent "partial file" errors - before_leaving(sub { unlink $file }); - - my ($gurpm, $id, $canceled); - # display a message in statusbar (if availlable): - $::statusbar and $id = statusbar_msg( - $branded - ? N("Please wait, downloading mirror addresses.") - : N("Please wait, downloading mirror addresses from the Mageia website."), - 0); - my $_clean_guard = before_leaving { - undef $gurpm; - $id and statusbar_msg_remove($id); - }; - - require Rpmdragora::gurpm; - require Rpmdragora::pkg; - - my $res = urpm::download::sync_url($urpm, $url, - dir => $cachedir, - callback => sub { - $gurpm ||= - Rpmdragora::gurpm->new(N("Please wait"), - transient => $::main_window); - $canceled ||= - !Rpmdragora::pkg::download_callback($gurpm, @_); - gtkflush(); - }, - ); - $res or die N("retrieval of [%s] failed", $file) . "\n"; - return $canceled ? () : MDK::Common::File::cat_($file); - }); - my @mirrors = @{ mirror::list(common::parse_LDAP_namespace_structure(MDK::Common::File::cat_('/etc/product.id')), 'distrib') || [] }; - require timezone; - my $tz = ${timezone::read()}{timezone}; - foreach my $mirror (@mirrors) { - my $goodness; - each_index { $_ = $u2l{$_} || $_; $_ eq $mirror->{country} and $goodness ||= 100-$::i } (map { if_($tz =~ /^$_$/, @{$t2l{$_}}) } keys %t2l), @$us; - $mirror->{goodness} = $goodness + rand(); - $mirror->{country} = translate($mirror->{country}); - } - unless (-x '/usr/bin/rsync') { - @mirrors = grep { $_->{url} !~ /^rsync:/ } @mirrors; - } - return sort { $b->{goodness} <=> $a->{goodness} } @mirrors; +sub add_distrib_update_media { + my ($urpm, $mirror, %options) = @_; + #- ensure a unique medium name + my $medium_name = $rpmdragora::mageia_release =~ /(\d+\.\d+) \((\w+)\)/ ? $2 . $1 . '-' : 'distrib'; + my $initial_number = 1 + max map { $_->{name} =~ /\(\Q$medium_name\E(\d+)\b/ ? $1 : 0 } @{$urpm->{media}}; + add_medium_and_check( + $urpm, + { nolock => 1, distrib => 1 }, + $medium_name, + ($mirror ? $mirror->{url} : (undef, mirrorlist => '$MIRRORLIST')), + probe_with => 'synthesis', initial_number => $initial_number, %options, + usedistrib => 1, + ); } sub warn_for_network_need { my ($message, %options) = @_; $message ||= -$branded -? N("I need to access internet to get the mirror list. + $branded + ? N("I need to access internet to get the mirror list. Please check that your network is currently running. Is it ok to continue?") -: N("I need to contact the Mageia website to get the mirror list. + : N("I need to contact the Mageia website to get the mirror list. Please check that your network is currently running. Is it ok to continue?"); @@ -935,33 +893,39 @@ sub choose_mirror { my $error = $@; if ($error) { $error = "\n$error\n"; - interactive_msg(N("Error during download"), -($branded -? N("There was an error downloading the mirror list: - -%s + interactive_msg(N("Error during download"), + ($branded + ? N("There was an error downloading the mirror list:\n%s\n The network, or the website, may be unavailable. Please try again later.", $error) -: N("There was an error downloading the mirror list: - -%s + : N("There was an error downloading the mirror list:\n%s\n The network, or the Mageia website, may be unavailable. Please try again later.", $error)), %options - - ); - return ''; + ); + return ''; } !@mirrors and interactive_msg(N("No mirror"), -($branded -? N("I can't find any suitable mirror.") -: N("I can't find any suitable mirror. - + ($branded + ? N("I can't find any suitable mirror.") + : N("I can't find any suitable mirror.\n There can be many reasons for this problem; the most frequent is the case when the architecture of your processor is not supported by Mageia Official Updates.")), %options ), return ''; + my @mirrorlist = map {$_->{country} . "-" . $_->{url}} @mirrors; + + my $sh_gui = AdminPanel::Shared::GUI->new(); + my $mirror = $sh_gui->ask_fromTreeList({title => N("Mirror choice"), + header => N("Please choose the desired mirror."), + default_button => 1, + item_separator => "-", +# default_item => 'leaf 2', + list => \@mirrorlist } + ); + +sub choose_mirror_to_be_removed { my $w = ugtk2->new(N("Mirror choice"), grab => 1, @transient_options); $w->{rwindow}->set_position($options{transient} ? 'center_on_parent' : 'center_always'); my $tree_model = Gtk2::TreeStore->new("Glib::String"); @@ -971,45 +935,45 @@ by Mageia Official Updates.")), %options $tree->set_headers_visible(0); gtkadd( - $w->{window}, - gtkpack_( - Gtk2::VBox->new(0,5), - 0, N("Please choose the desired mirror."), - 1, create_scrolled_window($tree), - 0, gtkpack( - create_hbox('edge'), - map { - my $retv = $_->[1]; - gtksignal_connect( - Gtk2::Button->new(but($_->[0])), - clicked => sub { - if ($retv) { - my ($model, $iter) = $tree->get_selection->get_selected; - $model and $w->{retval} = { sel => $model->get($iter, 0) }; - } - Gtk2->main_quit; - }, - ); - } [ N("Cancel"), 0 ], [ N("Ok"), 1 ] - ), - ) + $w->{window}, + gtkpack_( + Gtk2::VBox->new(0,5), + 0, N("Please choose the desired mirror."), + 1, create_scrolled_window($tree), + 0, gtkpack( + create_hbox('edge'), + map { + my $retv = $_->[1]; + gtksignal_connect( + Gtk2::Button->new(but($_->[0])), + clicked => sub { + if ($retv) { + my ($model, $iter) = $tree->get_selection->get_selected; + $model and $w->{retval} = { sel => $model->get($iter, 0) }; + } + Gtk2->main_quit; + }, + ); + } [ N("Cancel"), 0 ], [ N("Ok"), 1 ] + ), + ) ); my %roots; $tree_model->append_set($roots{$_->{country}} ||= $tree_model->append_set(undef, [ 0 => $_->{country} ]), - [ 0 => $_->{url} ]) foreach @mirrors; + [ 0 => $_->{url} ]) foreach @mirrors; - $w->{window}->set_size_request(500, 400); - $w->{rwindow}->show_all; + $w->{window}->set_size_request(500, 400); + $w->{rwindow}->show_all; - my $path = Gtk2::TreePath->new_first; - $tree->expand_row($path, 0); - $path->down; - $tree->get_selection->select_path($path); + my $path = Gtk2::TreePath->new_first; + $tree->expand_row($path, 0); + $path->down; + $tree->get_selection->select_path($path); - $w->main && return grep { $w->{retval}{sel} eq $_->{url} } @mirrors; + $w->main && return grep { $w->{retval}{sel} eq $_->{url} } @mirrors; } - +} @@ -1022,40 +986,90 @@ by Mageia Official Updates.")), %options sub check_update_media_version { my $urpm = shift; foreach (@_) { - if ($_->{name} =~ /(\d+\.\d+).*\bftp\du\b/ && $1 ne $distro_version) { - interactive_msg( - N("Warning"), - $branded - ? N("Your medium `%s', used for updates, does not match the version of %s you're running (%s). + if ($_->{name} =~ /(\d+\.\d+).*\bftp\du\b/ && $1 ne $distro_version) { + interactive_msg( + N("Warning"), + $branded + ? N("Your medium `%s', used for updates, does not match the version of %s you're running (%s). It will be disabled.", - $_->{name}, $distrib{system}, $distrib{product}) - : N("Your medium `%s', used for updates, does not match the version of Mageia you're running (%s). + $_->{name}, $distrib{system}, $distrib{product}) + : N("Your medium `%s', used for updates, does not match the version of Mageia you're running (%s). It will be disabled.", - $_->{name}, $distro_version) - ); - $_->{ignore} = 1; - urpm::media::write_config($urpm) if -w $urpm->{config}; - return 0; - } + $_->{name}, $distro_version) + ); + $_->{ignore} = 1; + urpm::media::write_config($urpm) if -w $urpm->{config}; + return 0; + } } 1; } -sub add_distrib_update_media { - my ($urpm, $mirror, %options) = @_; - #- ensure a unique medium name - my $medium_name = $rpmdragora::mageia_release =~ /(\d+\.\d+) \((\w+)\)/ ? $2 . $1 . '-' : 'distrib'; - my $initial_number = 1 + max map { $_->{name} =~ /\(\Q$medium_name\E(\d+)\b/ ? $1 : 0 } @{$urpm->{media}}; - add_medium_and_check( - $urpm, - { nolock => 1, distrib => 1 }, - $medium_name, - ($mirror ? $mirror->{url} : (undef, mirrorlist => '$MIRRORLIST')), - probe_with => 'synthesis', initial_number => $initial_number, %options, - usedistrib => 1, - ); + + +sub mirrors { + my ($urpm, $want_base_distro) = @_; + my $cachedir = $urpm->{cachedir} || '/root'; + require mirror; + mirror::register_downloader( + sub { + my ($url) = @_; + my $file = $url; + $file =~ s!.*/!$cachedir/!; + unlink $file; # prevent "partial file" errors + before_leaving(sub { unlink $file }); + + my ($gurpm, $id, $canceled); + # display a message in statusbar (if availlable): + $::statusbar and $id = statusbar_msg( + $branded + ? N("Please wait, downloading mirror addresses.") + : N("Please wait, downloading mirror addresses from the Mageia website."), + 0); + my $_clean_guard = before_leaving { + undef $gurpm; + $id and statusbar_msg_remove($id); + }; + + require AdminPanel::Rpmdragora::gurpm; + require AdminPanel::Rpmdragora::pkg; + + my $res = urpm::download::sync_url($urpm, $url, + dir => $cachedir, + callback => sub { + $gurpm ||= + AdminPanel::Rpmdragora::gurpm->new(N("Please wait"), + transient => $::main_window); + $canceled ||= + !AdminPanel::Rpmdragora::pkg::download_callback($gurpm, @_); + $gurpm->flush(); + }, + ); + $res or die N("retrieval of [%s] failed", $file) . "\n"; + return $canceled ? () : MDK::Common::File::cat_($file); + }); + my @mirrors = @{ mirror::list(common::parse_LDAP_namespace_structure(MDK::Common::File::cat_('/etc/product.id')), 'distrib') || [] }; + + require AdminPanel::Shared::TimeZone; + my $tzo = AdminPanel::Shared::TimeZone->new(); + my $tz = $tzo->readConfiguration()->{ZONE}; + + foreach my $mirror (@mirrors) { + my $goodness; + each_index { $_ = $u2l{$_} || $_; $_ eq $mirror->{country} and $goodness ||= 100-$::i } (map { if_($tz =~ /^$_$/, @{$t2l{$_}}) } keys %t2l), @$us; + $mirror->{goodness} = $goodness + rand(); + $mirror->{country} = translate($mirror->{country}); + } + unless (-x '/usr/bin/rsync') { + @mirrors = grep { $_->{url} !~ /^rsync:/ } @mirrors; + } + return sort { $b->{goodness} <=> $a->{goodness} } @mirrors; } + + + + sub open_help { my ($mode) = @_; use run_program; |