#***************************************************************************** # # Copyright (c) 2002 Guillaume Cottenceau # Copyright (c) 2002-2007 Thierry Vignaud # 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$ package rpmdrake; use lib qw(/usr/lib/libDrakX); use urpm::download (); use urpm::prompt; use urpm::media; use MDK::Common; use MDK::Common::System; use urpm; use urpm::cfg; use URPM; use URPM::Resolve; use strict; use c; use POSIX qw(_exit); use common; use Locale::gettext; use curl_download; our @ISA = qw(Exporter); our $VERSION = '2.27'; our @EXPORT = qw( $changelog_first_config $mandrakeupdate_wanted_categories $already_splashed $max_info_in_descr $offered_to_add_sources $tree_mode $tree_flat $typical_width distro_type to_utf8 myexit readconf writeconf interactive_msg interactive_packtable interactive_list interactive_list_ interactive_msg_with_banner fatal_msg getbanner wait_msg remove_wait_msg but but_ slow_func slow_func_statusbar statusbar_msg statusbar_msg_remove choose_mirror make_url_mirror make_url_mirror_dist show_urpm_progress update_sources update_sources_check update_sources_interactive add_medium_and_check check_update_media_version strip_first_underscore ); our $typical_width = 280; # i18n: IMPORTANT: to get correct namespace (rpmdrake instead of libDrakX) BEGIN { unshift @::textdomains, qw(rpmdrake urpmi rpm-summary-main rpm-summary-contrib rpm-summary-devel) } use ugtk2 qw(:all); ugtk2::add_icon_path('/usr/share/rpmdrake/icons'); Locale::gettext::bind_textdomain_codeset('rpmdrake', 'UTF8'); our $mandrake_release = cat_( -e '/etc/mandrakelinux-release' ? '/etc/mandrakelinux-release' : '/etc/release' ) || ''; chomp $mandrake_release; our ($mdk_version) = $mandrake_release =~ /(\d+\.\d+)/; our ($branded, %distrib); $branded = -f '/etc/sysconfig/oem' and %distrib = MDK::Common::System::distrib(); our $myname_update = $branded ? N("Software Update") : N("Mandriva Linux Update"); @rpmdrake::prompt::ISA = 'urpm::prompt'; sub rpmdrake::prompt::prompt { my ($self) = @_; my @answers; my $d = ugtk2->new("", grab => 1, if_($::main_window, transient => $::main_window)); $d->{rwindow}->set_position('center_on_parent'); gtkadd( $d->{window}, gtkpack( Gtk2::VBox->new(0, 5), Gtk2::WrappedLabel->new($self->{title}), (map { gtkpack( Gtk2::HBox->new(0, 5), Gtk2::Label->new($self->{prompts}[$_]), $answers[$_] = gtkset_visibility(gtkentry(), !$self->{hidden}[$_]), ) } 0 .. $#{$self->{prompts}}), gtksignal_connect(Gtk2::Button->new(N("Ok")), clicked => sub { Gtk2->main_quit }), ), ); $d->main; map { $_->get_text } @answers; } $urpm::download::PROMPT_PROXY = new rpmdrake::prompt( N("Please enter your credentials for accessing proxy\n"), [ N("User name:"), N("Password:") ], undef, [ 0, 1 ], ); sub to_utf8 { foreach (@_) { $_ = Locale::gettext::iconv($_, undef, "UTF-8"); c::set_tagged_utf8($_); } wantarray() ? @_ : $_[0]; } sub myexit { writeconf(); ugtk2::exit(undef, @_); } my ($root) = grep { $_->[2] == 0 } list_passwd(); $ENV{HOME} = $> == 0 ? $root->[7] : $ENV{HOME} || '/root'; our $configfile = "$ENV{HOME}/.rpmdrake"; our ($already_splashed, $changelog_first_config, $max_info_in_descr, $tree_flat, $tree_mode); our ($mandrakeupdate_wanted_categories, $offered_to_add_sources); our %config = ( mandrakeupdate_wanted_categories => { var => \$mandrakeupdate_wanted_categories, default => [ qw(security) ] }, already_splashed => { var => \$already_splashed, default => [] }, max_info_in_descr => { var => \$max_info_in_descr, default => [] }, offered_to_add_sources => { var => \$offered_to_add_sources, default => [ 0 ] }, tree_mode => { var => \$tree_mode, default => [ qw(mandrake_choices) ] }, tree_flat => { var => \$tree_flat, default => [ 0 ] }, changelog_first_config => { var => \$changelog_first_config, default => [ 0 ] }, ); sub readconf() { ${$config{$_}{var}} = $config{$_}{default} foreach keys %config; foreach my $l (cat_($configfile)) { $l =~ /^\Q$_\E (.*)/ and ${$config{$_}{var}} = [ split ' ', $1 ] foreach keys %config; } } sub writeconf() { unlink $configfile; output $configfile, map { "$_ " . (ref ${$config{$_}{var}} ? join(' ', @${$config{$_}{var}}) : ()) . "\n" } keys %config; } sub getbanner() { $::MODE or return undef; if (0) { +{ remove => N("Software Packages Removal"), update => N("Software Packages Update"), install => N("Software Packages Installation"), }; } Gtk2::Banner->new('title-update', $::MODE eq 'update' ? N("Software Packages Update") : N("Software Management")); } sub interactive_msg { my ($title, $contents, %options) = @_; $options{transient} ||= $::main_window if $::main_window; local $::isEmbedded; my $d = ugtk2->new($title, grab => 1, if_(exists $options{transient}, transient => $options{transient})); $d->{rwindow}->set_position($options{transient} ? 'center_on_parent' : 'center_always'); $contents = formatAlaTeX($contents) unless $options{scroll}; #- because we'll use a WrappedLabel my $banner = $options{banner} ? getbanner() : undef; gtkadd( $d->{window}, gtkpack_( Gtk2::VBox->new(0, 5), if_($banner, 0, $banner), 1, ( $options{scroll} ? gtkadd( gtkset_shadow_type(Gtk2::Frame->new, 'in'), gtkset_size_request( create_scrolled_window(gtktext_insert(Gtk2::TextView->new, $contents)), $typical_width*2, 300 ) ) : gtkpack(create_hbox(), Gtk2::WrappedLabel->new($contents)) ), if_($options{widget}, 0, $options{widget}), 0, gtkpack( create_hbox(), ( ref($options{yesno}) eq 'ARRAY' ? map { my $label = $_; gtksignal_connect( Gtk2::Button->new($label), clicked => sub { $d->{retval} = $label; Gtk2->main_quit } ); } @{$options{yesno}} : ( $options{yesno} ? ( gtksignal_connect( Gtk2::Button->new($options{text}{no} || N("No")), clicked => sub { $d->{retval} = 0; Gtk2->main_quit } ), gtksignal_connect( Gtk2::Button->new($options{text}{yes} || N("Yes")), clicked => sub { $d->{retval} = 1; Gtk2->main_quit } ), ) : gtksignal_connect( Gtk2::Button->new(N("Ok")), clicked => sub { Gtk2->main_quit } ) ) ) ) ) ); $d->main; return $d->{retval}; } sub interactive_packtable { my ($title, $parent_window, $top_label, $lines, $action_buttons) = @_; my $w = ugtk2->new($title, grab => 1, transient => $parent_window); local $::main_window = $w->{real_window}; $w->{rwindow}->set_position($parent_window ? 'center_on_parent' : 'center'); my $packtable = create_packtable({}, @$lines); gtkadd($w->{window}, gtkpack_(Gtk2::VBox->new(0, 5), if_($top_label, 0, Gtk2::Label->new($top_label)), 1, create_scrolled_window($packtable), 0, gtkpack__(create_hbox(), @$action_buttons))); my $preq = $packtable->size_request; my ($xpreq, $ypreq) = ($preq->width, $preq->height); my $wreq = $w->{rwindow}->size_request; my ($xwreq, $ywreq) = ($wreq->width, $wreq->height); $w->{rwindow}->set_default_size(max($typical_width, min($typical_width*2.5, $xpreq+$xwreq)), max(200, min(450, $ypreq+$ywreq))); $w->main; } sub interactive_list { my ($title, $contents, $list, $callback, %options) = @_; my $d = ugtk2->new($title, grab => 1, if_(exists $options{transient}, transient => $options{transient})); $d->{rwindow}->set_position($options{transient} ? 'center_on_parent' : 'center_always'); my @radios = gtkradio('', @$list); my $vbradios = $callback ? create_packtable( {}, mapn { my $n = $_[1]; [ $_[0], gtksignal_connect( Gtk2::Button->new(but(N("Info..."))), clicked => sub { $callback->($n) }, ) ]; } \@radios, $list, ) : gtkpack__(Gtk2::VBox->new(0, 0), @radios); my $choice; gtkadd( $d->{window}, gtkpack__( Gtk2::VBox->new(0,5), Gtk2::Label->new($contents), int(@$list) > 8 ? gtkset_size_request(create_scrolled_window($vbradios), 250, 320) : $vbradios, gtkpack__( create_hbox(), if_(!$options{nocancel}, gtksignal_connect( Gtk2::Button->new(N("Cancel")), clicked => sub { Gtk2->main_quit }), ), gtksignal_connect( Gtk2::Button->new(N("Ok")), clicked => sub { each_index { $_->get_active and $choice = $::i } @radios; Gtk2->main_quit; } ) ) ) ); $d->main; $choice; } sub interactive_list_ { interactive_list(@_, if_($::main_window, transient => $::main_window)) } sub interactive_msg_with_banner { push @_, banner => 1 if $::isEmbedded; &interactive_msg } sub fatal_msg { interactive_msg @_; myexit -1; } sub wait_msg { my ($msg, %options) = @_; gtkflush(); $options{transient} ||= $::main_window if $::main_window; local $::isEmbedded; my $mainw = ugtk2->new(N("Please wait"), grab => 1, if_(exists $options{transient}, transient => $options{transient})); $mainw->{real_window}->set_position($options{transient} ? 'center_on_parent' : 'center_always'); my $label = ref($msg) =~ /^Gtk/ ? $msg : Gtk2::WrappedLabel->new($msg); my $banner = $options{banner} ? getbanner() : undef; gtkadd( $mainw->{window}, gtkpack__( gtkset_border_width(Gtk2::VBox->new(0, 5), 6), if_($banner, $banner), $label, if_(exists $options{widgets}, @{$options{widgets}}), ) ); $mainw->sync; gtkset_mousecursor_wait($mainw->{rwindow}->window) unless $options{no_wait_cursor}; $mainw->flush; $mainw; } sub remove_wait_msg { my $w = shift; gtkset_mousecursor_normal($w->{rwindow}->window); $w->destroy; } sub but { " $_[0] " } sub but_ { " $_[0] " } sub slow_func ($&) { my ($param, $func) = @_; if (ref($param) =~ /^Gtk/) { gtkset_mousecursor_wait($param); ugtk2::flush(); $func->(); gtkset_mousecursor_normal($param); } else { my $w = wait_msg($param); $func->(); remove_wait_msg($w); } } sub statusbar_msg { unless ($::statusbar) { #- fallback if no status bar if (defined &::wait_msg_) { goto &::wait_msg_ } else { goto &wait_msg } } my ($msg) = @_; #- always use the same context description for now my $cx = $::statusbar->get_context_id("foo"); $::w and $::w->{rwindow} and gtkset_mousecursor_wait($::w->{rwindow}->window); #- returns a msg_id to be passed optionnally to statusbar_msg_remove $::statusbar->push($cx, $msg); } sub statusbar_msg_remove { my ($msg_id) = @_; if (!$::statusbar || ref $msg_id) { #- fallback if no status bar goto &remove_wait_msg; } my $cx = $::statusbar->get_context_id("foo"); if (defined $msg_id) { $::statusbar->remove($cx, $msg_id); } else { $::statusbar->pop($cx); } $::w and $::w->{rwindow} and gtkset_mousecursor_normal($::w->{rwindow}->window); } sub slow_func_statusbar ($$&) { my ($msg, $w, $func) = @_; gtkset_mousecursor_wait($w->window); my $msg_id = statusbar_msg($msg); gtkflush(); $func->(); statusbar_msg_remove($msg_id); gtkset_mousecursor_normal($w->window); } 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"), ); 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) ], ); #- get distrib release number (2006.0, etc) sub etc_version() { (my $v) = split / /, cat_('/etc/version'); return $v; } #- returns the keyword describing the type of the distribution. #- the parameter indicates whether we want base or update sources sub distro_type { my ($want_base_distro) = @_; return 'cooker' if $mandrake_release =~ /cooker/i; #- we can't use updates for community while official is not out (release ends in ".0") if ($want_base_distro || $mandrake_release =~ /community/i && etc_version() =~ /\.0$/) { return 'official' if $mandrake_release =~ /official|limited/i; return 'community' if $mandrake_release =~ /community/i; #- unknown: fallback to updates } return 'updates'; } sub compat_arch_for_updates($) { # FIXME: We prefer 64-bit packages to update on biarch platforms, # since the system is populated with 64-bit packages anyway. my ($arch) = @_; return $arch =~ /x86_64|amd64/ if arch() eq 'x86_64'; MDK::Common::System::compat_arch($arch); } sub mirrors { my ($cachedir, $want_base_distro, $o_arch) = @_; $cachedir ||= '/root'; use 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 $res = curl_download::download($url, $cachedir, sub {}); $res and do { c::set_tagged_utf8($res); die $res }; return cat_($file); }); my @mirrors = @{ mirror::list(common::parse_LDAP_namespace_structure(cat_('/etc/product.id')), ($want_base_distro ? 'distrib' : 'updates'), $o_arch) || [] }; 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 choose_mirror { my (%options) = @_; my $message = $options{message} ? $options{message} : $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 Mandriva website to get the mirror list. Please check that your network is currently running. Is it ok to continue?"); delete $options{message}; my @transient_options = exists $options{transient} ? (transient => $options{transient}) : (); interactive_msg(N("Mirror choice"), $message, yesno => 1, %options) or return ''; my $wait = wait_msg( ($branded ? N("Please wait, downloading mirror addresses.") : N("Please wait, downloading mirror addresses from the Mandriva website.")), @transient_options ); my @mirrors = eval { mirrors('/var/cache/urpmi', $options{want_base_distro}, $options{arch}) }; my $error = $@; remove_wait_msg($wait); if ($error) { interactive_msg(N("Error during download"), ($branded ? N("There was an error downloading the mirror list: %s The network, or the website, may be unavailable. Please try again later.", $error) : N("There was an error downloading the mirror list: %s The network, or the Mandriva website, may be unavailable. Please try again later.", $error)), %options ); 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. There can be many reasons for this problem; the most frequent is the case when the architecture of your processor is not supported by Mandriva Linux Official Updates.")), %options ), return ''; 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"); my $tree = Gtk2::TreeView->new_with_model($tree_model); $tree->get_selection->set_mode('browse'); $tree->append_column(Gtk2::TreeViewColumn->new_with_attributes(undef, Gtk2::CellRendererText->new, text => 0)); $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 ] ), ) ); my %roots; $tree_model->append_set($roots{$_->{country}} ||= $tree_model->append_set(undef, [ 0 => $_->{country} ]), [ 0 => $_->{url} ]) foreach @mirrors; $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); $w->main && return grep { $w->{retval}{sel} eq $_->{url} } @mirrors; } sub make_url_mirror { my ($mirror) = @_; # because updates media do not provide media.cfg yet $mirror . '/media/main/updates'; } sub make_url_mirror_dist { my ($mirror) = @_; $mirror =~ s!/(?:RPMS|media/main)/?\Z!/!; $mirror; } sub show_urpm_progress { my ($label, $pb, $mode, $file, $percent, $total, $eta, $speed) = @_; $file =~ s|([^:]*://[^/:\@]*:)[^/:\@]*(\@.*)|$1xxxx$2|; #- if needed... my $medium if 0; if ($mode eq 'copy') { $pb->set_fraction(0); $label->set_label(N("Copying file for medium `%s'...", $file)); } elsif ($mode eq 'parse') { $pb->set_fraction(0); $label->set_label(N("Examining file of medium `%s'...", $file)); } elsif ($mode eq 'retrieve') { $pb->set_fraction(0); $label->set_label(N("Examining remote file of medium `%s'...", $file)); $medium = $file; } elsif ($mode eq 'done') { $pb->set_fraction(1.0); $label->set_label($label->get_label . N(" done.")); $medium = undef; } elsif ($mode eq 'failed') { $pb->set_fraction(1.0); $label->set_label($label->get_label . N(" failed!")); $medium = undef; } else { length($file) > 60 and $file = $medium ? #-PO: We're downloading the said file from the said medium N("%s from medium %s", basename($file), $medium) : basename($file); if ($mode eq 'start') { $pb->set_fraction(0); $label->set_label(N("Starting download of `%s'...", $file)); } elsif ($mode eq 'progress') { if (defined $total && defined $eta) { $pb->set_fraction($percent/100); $label->set_label(N("Download of `%s', time to go:%s, speed:%s", $file, $eta, $speed)); } else { $pb->set_fraction($percent/100); $label->set_label(N("Download of `%s', speed:%s", $file, $speed)); } } } Gtk2->main_iteration while Gtk2->events_pending; } sub update_sources { my ($urpm, %options) = @_; my $cancel = 0; my $w; my $label; $w = wait_msg( $label = Gtk2::Label->new(N("Please wait, updating media...")), no_wait_cursor => 1, banner => $options{banner}, widgets => [ my $pb = gtkset_size_request(Gtk2::ProgressBar->new, 300, -1), gtkpack( create_hbox(), gtksignal_connect( Gtk2::Button->new(N("Cancel")), clicked => sub { $cancel = 1; $w->destroy; }, ), ), ], ); my @media; @media = @{$options{medialist}} if ref $options{medialist}; my $outerfatal = $urpm->{fatal}; local $urpm->{fatal} = sub { $w->destroy; $outerfatal->(@_) }; urpm::media::update_media($urpm, %options, callback => sub { $cancel and goto cancel_update; my ($type, $media) = @_; return if $type !~ /^(?:start|progress|end)$/ && @media && !member($media, @media); if ($type eq 'failed') { $urpm->{fatal}->(N("Error retrieving packages"), N("It's impossible to retrieve the list of new packages from the media `%s'. Either this update media is misconfigured, and in this case you should use the Software Media Manager to remove it and re-add it in order to reconfigure it, either it is currently unreachable and you should retry later.", $media)); } else { show_urpm_progress($label, $pb, @_); } }, ); $w->destroy; cancel_update: } sub update_sources_check { my ($urpm, $options, $error_msg, @media) = @_; my @error_msgs; local $urpm->{fatal} = sub { push @error_msgs, $_[1]; goto fatal_error }; local $urpm->{error} = sub { push @error_msgs, $_[0] }; update_sources($urpm, %$options, noclean => 1, medialist => \@media); fatal_error: if (@error_msgs) { interactive_msg(N("Error"), sprintf(translate($error_msg), join("\n", map { formatAlaTeX($_) } @error_msgs)), scroll => 1); return 0; } return 1; } sub update_sources_interactive { my ($urpm, %options) = @_; my $w = ugtk2->new(N("Update media"), grab => 1, center => 1, %options); $w->{rwindow}->set_position($options{transient} ? 'center_on_parent' : 'center_always'); my @buttons; my @media = grep { ! $_->{ignore} } @{$urpm->{media}}; unless (@media) { interactive_msg(N("Warning"), N("No active medium found. You must enable some media to be able to update them.")); return 0; } gtkadd( $w->{window}, gtkpack__( Gtk2::VBox->new(0,5), Gtk2::Label->new(N("Select the media you wish to update:")), ( @buttons = map { Gtk2::CheckButton->new_with_label($_->{name}); } @media ), Gtk2::HSeparator->new, gtkpack( create_hbox(), gtksignal_connect( Gtk2::Button->new(N("Cancel")), clicked => sub { $w->{retval} = 0; Gtk2->main_quit }, ), gtksignal_connect( Gtk2::Button->new(N("Select all")), clicked => sub { $_->set_active(1) foreach @buttons }, ), gtksignal_connect( Gtk2::Button->new(N("Update")), clicked => sub { $w->{retval} = any { $_->get_active } @buttons; # list of media listed in the checkbox panel my @buttonmedia = grep { !$_->{ignore} } @{$urpm->{media}}; @media = map_index { if_($_->get_active, $buttonmedia[$::i]{name}) } @buttons; Gtk2->main_quit; }, ), ) ) ); if ($w->main) { #- force ignored media to be returned alive (forked from urpmi.update...) foreach (@{$urpm->{media}}) { $_->{modified} and delete $_->{ignore}; } urpm::media::select_media($urpm, @media); update_sources_check( $urpm, {}, N_("Unable to update medium; it will be automatically disabled.\n\nErrors:\n%s"), @media, ); return 1; } return 0; } sub add_medium_and_check { my ($urpm, $options) = splice @_, 0, 2; my @newnames = ($_[0]); #- names of added media my $fatal_msg; my @error_msgs; local $urpm->{fatal} = sub { printf STDERR "Fatal: %s\n", $_[1]; $fatal_msg = $_[1]; goto fatal_error }; local $urpm->{error} = sub { printf STDERR "Error: %s\n", $_[0]; push @error_msgs, $_[0] }; if ($options->{distrib}) { @newnames = urpm::media::add_distrib_media($urpm, @_); } else { urpm::media::add_medium($urpm, @_); } if (@error_msgs) { interactive_msg( N("Error"), N("Unable to add medium, errors reported:\n\n%s", join("\n", map { formatAlaTeX($_) } @error_msgs)) . "\n\n" . N("Medium: ") . "$_[0] ($_[1])", scroll => 1, ); return 0; } foreach my $name (@newnames) { urpm::download::set_proxy_config($_, $options->{proxy}{$_}, $name) foreach keys %{$options->{proxy} || {}}; } if (update_sources_check($urpm, $options, N_("Unable to add medium, errors reported:\n\n%s"), @newnames)) { urpm::media::write_config($urpm); $options->{proxy} and urpm::download::dump_proxy_config(); } else { urpm::media::read_config($urpm); return 0; } my %newnames; @newnames{@newnames} = (); if (any { exists $newnames{$_->{name}} } @{$urpm->{media}}) { return 1; } else { interactive_msg(N("Error"), N("Unable to create medium.")); return 0; } fatal_error: interactive_msg(N("Failure when adding medium"), N("There was a problem adding medium:\n\n%s", $fatal_msg)); return 0; } #- Check whether the default update media (added by installation) #- matches the current mdk version sub check_update_media_version { my $urpm = shift; foreach (@_) { if ($_->{name} =~ /(\d+\.\d+).*\bftp\du\b/ && $1 ne $mdk_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 Mandriva Linux you're running (%s). It will be disabled.", $_->{name}, $mdk_version) ); $_->{ignore} = 1; urpm::media::write_config($urpm) if -w $urpm->{config}; return 0; } } 1; } sub open_help { my ($mode) = @_; use run_program; run_program::raw({ detach => 1 }, 'drakhelp', '--id', "software-management-$mode"); interactive_msg( N("Help launched in background"), N("The help window has been started, it should appear shortly on your desktop."), ); } sub strip_first_underscore { join '', map { s/_//; $_ } @_ } 1; 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 
package fsedit; # $Id$

use diagnostics;
use strict;
use vars qw(%suggestions);

#-######################################################################################
#- misc imports
#-######################################################################################
use common;
use partition_table qw(:types);
use partition_table_raw;
use detect_devices;
use fsedit;
use devices;
use loopback;
use log;
use fs;

%suggestions = (
  __("simple") => [
    { mntpoint => "/",     size => 300 << 11, type =>0x483, ratio => 5, maxsize =>3500 << 11 },
    { mntpoint => "swap",  size =>  64 << 11, type => 0x82, ratio => 1, maxsize => 250 << 11 },
    { mntpoint => "/home", size => 300 << 11, type =>0x483, ratio => 3 },
  ], 'with usr' => [
    { mntpoint => "/",     size => 150 << 11, type =>0x483, ratio => 1, maxsize => 500 << 11 },
    { mntpoint => "swap",  size =>  64 << 11, type => 0x82, ratio => 1, maxsize => 250 << 11 },
    { mntpoint => "/usr",  size => 300 << 11, type =>0x483, ratio => 4, maxsize =>3000 << 11 },
    { mntpoint => "/home", size => 100 << 11, type =>0x483, ratio => 5 },
  ], __("server") => [
    { mntpoint => "/",     size => 150 << 11, type =>0x483, ratio => 1, maxsize => 250 << 11 },
    { mntpoint => "swap",  size =>  64 << 11, type => 0x82, ratio => 2, maxsize => 400 << 11 },
    { mntpoint => "/usr",  size => 300 << 11, type =>0x483, ratio => 3, maxsize =>3000 << 11 },
    { mntpoint => "/var",  size => 100 << 11, type =>0x483, ratio => 4 },
    { mntpoint => "/home", size => 100 << 11, type =>0x483, ratio => 5 },
  ],
);
foreach (values %suggestions) {
    if (arch() =~ /ia64/) {
	@$_ = ({ mntpoint => "/boot/efi", size => 50 << 11, type => 0xb, ratio => 1, maxsize => 150 << 11 }, @$_);
    }
}

my @suggestions_mntpoints = (
    "/var/ftp", "/var/www", "/boot",
    arch() =~ /sparc/ ? "/mnt/sunos" : arch() =~ /ppc/ ? "/mnt/macos" : "/mnt/windows",
);

my @partitions_signatures = (
    [ 0x8e, 0, "HM\1\0" ],
    [ 0x83, 0x438, "\x53\xEF" ],
    [ 0x183, 0x10034, "ReIsErFs" ],
    [ 0x183, 0x10034, "ReIsEr2Fs" ],
    [ 0x283, 0, 'XFSB', 0x200, 'XAGF', 0x400, 'XAGI' ],
    [ 0x383, 0x8000, 'JFS1' ],
    [ 0x82, 4086, "SWAP-SPACE" ],
    [ 0x82, 4086, "SWAPSPACE2" ],
    [ 0x7,  0x1FE, "\x55\xAA", 0x3, "NTFS" ],
    [ 0xc,  0x1FE, "\x55\xAA", 0x52, "FAT32" ],
arch() !~ /^sparc/ ? (
    [ 0x6,  0x1FE, "\x55\xAA", 0x36, "FAT" ],
) : (),
);

sub typeOfPart { 
    my $dev = devices::make($_[0]);
    my $t = typeFromMagic($dev, @partitions_signatures);
    if ($t == 0x83) {
	#- there is no magic to differentiate ext3 and ext2. Using libext2fs
	#- to check if it has a journal
	$t = 0x483 if c::is_ext3($dev);
    }
    $t;
}

#-######################################################################################
#- Functions
#-######################################################################################
sub empty_all_hds {
    { hds => [], lvms => [], raids => [], loopbacks => [], raw_hds => [], nfss => [], smbs => [], special => [] };
}
sub recompute_loopbacks {
    my ($all_hds) = @_;
    my @fstab = get_all_fstab($all_hds);
    @{$all_hds->{loopbacks}} = map { isPartOfLoopback($_) ? @{$_->{loopback}} : () } @fstab;
}

sub raids {
    my ($hds) = @_;

    my @parts = get_fstab(@$hds);
    (grep { isRawRAID($_) } @parts) && detect_devices::raidAutoStart() or return [];

    fs::get_major_minor(@parts);
    my %devname2part = map { $_->{dev} => { %$_, device => $_->{dev} } } read_partitions();

    my @raids;
    my @mdstat = cat_("/proc/mdstat");
    for (my $i = 0; $i < @mdstat; $i++) {

	my ($nb, $level, $mdparts) = 
	  #- line format is:
	  #- md%d : {in}?active{ (read-only)}? {linear|raid1|raid4|raid5}{ DEVNAME[%d]{(F)}?}*
	  $mdstat[$i] =~ /^md(.).* ([^ \[\]]+) (\S+\[\d+\].*)/ or next;

	$level =~ s/raid//; #- { linear | raid0 | raid1 | raid5 } -> { linear | 0 | 1 | 5 }

	my $chunks = $mdstat[$i+1] =~ /(\S+) chunks/ ? $1 : "64k";

	my @raw_mdparts = map { /([^\[]+)/ } split ' ', $mdparts;
	my @mdparts = 
	  map { 
	      my $mdpart = $devname2part{$_} || { device => $_ };
	      if (my ($part) = grep { is_same_hd($mdpart, $_) } @parts) {
		  $part->{raid} = $nb;
		  delete $part->{mntpoint};
		  $part;
	      } else {
		  #- forget it when not found? that way it won't break much... beurk.
		  ();
	      }
	  } @raw_mdparts;

	my $type = typeOfPart("md$nb");
	log::l("RAID: found md$nb (raid $level) chunks $chunks ", if_($type, "type $type "), "with parts ", join(", ", @raw_mdparts));
	$raids[$nb] = { 'chunk-size' => $chunks, type => $type || 0x83, disks => \@mdparts,
			device => "md$nb", notFormatted => !$type, level => $level };
    }
    require raid;
    raid::update(@raids);
    \@raids;
}

sub hds {
    my ($drives, $flags) = @_;
    my (@hds);
    my $rc;

    foreach (@$drives) {
	my $file = devices::make($_->{device});

	my $hd = partition_table_raw::get_geometry($file) or log::l("An error occurred while getting the geometry of block device $file: $!"), next;
	add2hash_($hd, $_);
	$hd->{file} = $file;
	$hd->{prefix} = $hd->{device};
	# for RAID arrays of format c0d0p1
	$hd->{prefix} .= "p" if $hd->{prefix} =~ m,(rd|ida|cciss|ataraid)/,;

	eval { partition_table::read($hd, $flags->{clearall} || member($_->{device}, @{$flags->{clear} || []})) };
	if ($@) {
	    cdie "ask_before_blanking:$@";
	    partition_table_raw::zero_MBR($hd);
	}
	member($_->{device}, @{$flags->{clear} || []}) and partition_table::remove($hd, $_)
	  foreach partition_table::get_normal_parts($hd);

	# special case for Various type
	$_->{type} = typeOfPart($_->{device}) || 0x100 foreach grep { $_->{type} == 0x100 } partition_table::get_normal_parts($hd);

	#- special case for type overloading (eg: reiserfs is 0x183)
	foreach (grep { isExt2($_) } partition_table::get_normal_parts($hd)) {
	    my $type = typeOfPart($_->{device});
	    $_->{type} = $type if $type > 0x100 || $type && $hd->isa('partition_table_gpt');
	}
	push @hds, $hd;
    }
    #- detect raids before LVM allowing LVM on raid
    my $raids = raids(\@hds);
    my $all_hds = { %{ empty_all_hds() }, hds => \@hds, lvms => [], raids => $raids };

    my @lvms;
    if (my @pvs = grep { isRawLVM($_) } get_all_fstab($all_hds)) {
	#- otherwise vgscan won't find them
	devices::make($_->{device}) foreach @pvs; 
	require lvm;
	foreach (@pvs) {
	    my $name = lvm::get_vg($_) or next;
	    my ($lvm) = grep { $_->{LVMname} eq $name } @lvms;
	    if (!$lvm) {
		$lvm = bless { disks => [], LVMname => $name }, 'lvm';
		lvm::update_size($lvm);
		lvm::get_lvs($lvm);
		push @lvms, $lvm;
	    }
	    $_->{lvm} = $name;
	    push @{$lvm->{disks}}, $_;
	}
    }
    $all_hds->{lvms} = \@lvms;

    fs::get_major_minor(get_all_fstab($all_hds));

    $all_hds;
}


sub read_partitions() {
    my (undef, undef, @all) = cat_("/proc/partitions");
    grep {
	$_->{size} != 1 &&	 # skip main extended partition
	$_->{size} != 0x3fffffff # skip cdroms (otherwise stops cd-audios)
    } map { 
	my %l; 
	@l{qw(major minor size dev)} = split; 
	\%l;
    } @all;
}

sub readProcPartitions {
    my ($hds) = @_;

    my @all = read_partitions();
    my @parts = grep { $_->{dev} =~ /\d$/ } @all;
    my @disks = grep { $_->{dev} !~ /\d$/ } @all;

    my $devfs_like = grep { $_->{dev} =~ m|/disc$| } @disks;

    my %devfs2normal = map {
	my (undef, $major, $minor) = devices::entry($_->{device});
	my ($disk) = grep { $_->{major} == $major && $_->{minor} == $minor } @disks;
	$disk->{dev} => $_->{device};
    } @$hds;

    foreach my $part (@parts) {
	my $dev;
	if ($devfs_like) {
	    $dev = -e "/dev/$part->{dev}" ? $part->{dev} : sprintf("0x%x%02x", $part->{major}, $part->{minor});
	    $part->{rootDevice} = $devfs2normal{dirname($part->{dev}) . '/disc'};
	} else {
	    $dev = $part->{dev};
	    foreach my $hd (@$hds) {
		$part->{rootDevice} = $hd->{device} if $part->{dev} =~ /^$hd->{device}./;
	    }
	}
	$part->{device} = $dev;
	$part->{start} = 0;	# unknown, but we don't care
	$part->{size} *= 2;	# from KB to sectors
	$part->{type} = typeOfPart($dev); 

	delete $part->{dev}; # cleanup
    }
    @parts;
}

sub all_hds {
    my ($all_hds) = @_;
    (@{$all_hds->{hds}}, @{$all_hds->{lvms}});
}
sub part2hd {
    my ($part, $all_hds) = @_;
    my ($hd) = grep { $part->{rootDevice} eq $_->{device} } all_hds($all_hds);
    $hd;
}

sub is_same_hd {
    my ($hd1, $hd2) = @_;
    if ($hd1->{major} && $hd2->{major}) {
	$hd1->{major} == $hd2->{major} && $hd1->{minor} == $hd2->{minor};
    } else {
	$hd1->{device} eq $hd2->{device};
    }
}

sub is_same_part {
    my ($part1, $part2) = @_;
    foreach ('start', 'size', 'type', 'rootDevice') {
	$part1->{$_} eq $part2->{$_} or return;
    }
    1;
}

#- get all normal partition including special ones as found on sparc.
sub get_fstab {
    map { partition_table::get_normal_parts($_) } @_;
}

#- get normal partition that should be visible for working on.
sub get_visible_fstab {
    grep { $_ && !partition_table::isWholedisk($_) && !partition_table::isHiddenMacPart($_) }
      map { partition_table::get_normal_parts($_) } @_;
}

sub get_fstab_and_holes {
    map {
	if (isLVM($_)) {
	    my @parts = partition_table::get_normal_parts($_);
	    my $free = $_->{totalsectors} - sum map { $_->{size} } @parts;
	    my $free_part = { start => 0, size => $free, type => 0, rootDevice => $_->{device} };
	    @parts, if_($free >= $_->cylinder_size, $free_part);
	} else {
	    partition_table::get_normal_parts_and_holes($_);
	}
    } @_;
}
sub get_holes {
    grep { $_->{type} == 0 } get_fstab_and_holes(@_);
}

sub get_all_fstab {
    my ($all_hds) = @_;
    my @parts = map { partition_table::get_normal_parts($_) } all_hds($all_hds);
    my @raids = grep {$_} @{$all_hds->{raids}};
    @parts, @raids, @{$all_hds->{loopbacks}};
}
sub get_really_all_fstab {
    my ($all_hds) = @_;
    my @parts = map { partition_table::get_normal_parts($_) } all_hds($all_hds);
    my @raids = grep {$_} @{$all_hds->{raids}};
    @parts, @raids, @{$all_hds->{loopbacks}}, @{$all_hds->{raw_hds}}, @{$all_hds->{nfss}}, @{$all_hds->{smbs}};
}
sub get_all_fstab_and_holes {
    my ($all_hds) = @_;
    my @raids = grep {$_} @{$all_hds->{raids}};
    get_fstab_and_holes(all_hds($all_hds)), @raids, @{$all_hds->{loopbacks}};
}
sub get_all_holes {
    my ($all_hds) = @_;
    grep { $_->{type} == 0 } get_all_fstab_and_holes($all_hds);
}

sub all_free_space {
    my ($all_hds) = @_;
    sum map { $_->{size} } get_all_holes($all_hds);
}
sub free_space {
    sum map { $_->{size} } get_holes(@_);
}

sub is_one_big_fat {
    my ($hds) = @_;
    @$hds == 1 or return;

    my @l = get_fstab(@$hds);
    @l == 1 && isFat($l[0]) && free_space(@$hds) < 10 << 11;
}

sub file2part {
    my ($prefix, $fstab, $file, $keep_simple_symlinks) = @_;    
    my $part;

    $file = $keep_simple_symlinks ? common::expand_symlinks_but_simple("$prefix$file") : expand_symlinks("$prefix$file");
    unless ($file =~ s/^$prefix//) {
	my ($part) = grep { loopback::carryRootLoopback($_) } @$fstab or die;
	log::l("found $part->{mntpoint}");
	$file =~ s|/initrd/loopfs|$part->{mntpoint}|;
    }
    foreach (@$fstab) {
	my $m = $_->{mntpoint};
	$part = $_ if 
	  $file =~ /^\Q$m/ && 
	    (!$part || length $part->{mntpoint} < length $m);
    }
    $part or die "file2part: not found $file";
    $file =~ s|$part->{mntpoint}/?|/|;
    ($part, $file);
}


sub computeSize {
    my ($part, $best, $all_hds, $suggestions) = @_;
    my $max = $part->{maxsize} || $part->{size};
    return min($max, $best->{size}) unless $best->{ratio};

    my $free_space = all_free_space($all_hds);
    my @l = my @L = grep { 
	if (!has_mntpoint($_->{mntpoint}, $all_hds) && $free_space >= $_->{size}) {
	    $free_space -= $_->{size};
	    1;
	} else { 0 } } @$suggestions;

    my $tot_ratios = 0;
    while (1) {
	my $old_free_space = $free_space;
	my $old_tot_ratios = $tot_ratios;

	$tot_ratios = sum(map { $_->{ratio} } @l);
	last if $tot_ratios == $old_tot_ratios;

	@l = grep { 
	    if ($_->{ratio} && $_->{maxsize} && $tot_ratios &&
		$_->{size} + $_->{ratio} / $tot_ratios * $old_free_space >= $_->{maxsize}) {
		return min($max, $best->{maxsize}) if $best->{mntpoint} eq $_->{mntpoint};
		$free_space -= $_->{maxsize} - $_->{size};
		0;
	    } else {
		$_->{ratio};
	    } 
	} @l;
    }
    my $size = int min($max, $best->{size} + $free_space * ($tot_ratios && $best->{ratio} / $tot_ratios));
    #- verify other entry can fill the hole
    if (grep { $_->{size} < $max - $size } @L) { $size } else { $max }
}

sub suggest_part {
    my ($part, $all_hds, $suggestions) = @_;
    $suggestions ||= $suggestions{server} || $suggestions{simple};

    my $has_swap = grep { isSwap($_) } get_all_fstab($all_hds);

    my ($best, $second) =
      grep { !$_->{maxsize} || $part->{size} <= $_->{maxsize} }
      grep { $_->{size} <= ($part->{maxsize} || $part->{size}) }
      grep { !has_mntpoint($_->{mntpoint}, $all_hds) || isSwap($_) && !$has_swap }
      grep { !$_->{hd} || $_->{hd} eq $part->{rootDevice} }
      grep { !$part->{type} || $part->{type} == $_->{type} || isTrueFS($part) && isTrueFS($_) }
	@$suggestions or return;

#-    if (arch() =~ /i.86/) {
#-	  $best = $second if
#-	    $best->{mntpoint} eq '/boot' &&
#-	    $part->{start} + $best->{size} > 1024 * $hd->cylinder_size(); #- if the empty slot is beyond the 1024th cylinder, no use having /boot
#-    }

    defined $best or return; #- sorry no suggestion :(

    $part->{mntpoint} = $best->{mntpoint};
    $part->{type} = $best->{type} if !(isTrueFS($best) && isTrueFS($part));
    $part->{size} = computeSize($part, $best, $all_hds, $suggestions);
    $part->{options} = $best->{options} if $best->{options};
    1;
}

sub suggestions_mntpoint {
    my ($all_hds) = @_;
    sort grep { !/swap/ && !has_mntpoint($_, $all_hds) }
      (@suggestions_mntpoints, map { $_->{mntpoint} } @{$suggestions{server} || $suggestions{simple}});
}

#-sub partitionDrives {
#-
#-    my $cmd = "/sbin/fdisk";
#-    -x $cmd or $cmd = "/usr/bin/fdisk";
#-
#-    my $drives = findDrivesPresent() or die "You don't have any hard drives available! You probably forgot to configure a SCSI controller.";
#-
#-    foreach (@$drives) {
#-	 my $text = "/dev/" . $_->{device};
#-	 $text .= " - SCSI ID " . $_->{id} if $_->{device} =~ /^sd/;
#-	 $text .= " - Model " . $_->{info};
#-	 $text .= " array" if $_->{device} =~ /^c.d/;
#-
#-	 #- truncate at 50 columns for now
#-	 $text = substr $text, 0, 50;
#-    }
#-    #-TODO TODO
#-}


sub mntpoint2part {
    my ($mntpoint, $fstab) = @_;
    first(grep { $mntpoint eq $_->{mntpoint} } @$fstab);
}
sub has_mntpoint {
    my ($mntpoint, $all_hds) = @_;
    mntpoint2part($mntpoint, [ get_really_all_fstab($all_hds) ]);
}
sub get_root_ {
    my ($fstab, $boot) = @_;
    $boot && mntpoint2part("/boot", $fstab) || mntpoint2part("/", $fstab);
}
sub get_root { &get_root_ || {} }

#- do this before modifying $part->{type}
sub check_type {
    my ($type, $hd, $part) = @_;
    isThisFs("jfs", { type => name2type($type) }) && $part->{size} < 16 << 11 and die _("You can't use JFS for partitions smaller than 16MB");    
    isThisFs("reiserfs", { type => name2type($type) }) && $part->{size} < 32 << 11 and die _("You can't use ReiserFS for partitions smaller than 32MB");
}

#- do this before modifying $part->{mntpoint}
#- $part->{mntpoint} should not be used here, use $mntpoint instead
sub check_mntpoint {
    my ($mntpoint, $hd, $part, $all_hds) = @_;

    $mntpoint eq '' || isSwap($part) || isNonMountable($part) and return;
    $mntpoint =~ m|^/| or die _("Mount points must begin with a leading /");
    $mntpoint ne $part->{mntpoint} && has_mntpoint($mntpoint, $all_hds) and die _("There is already a partition with mount point %s\n", $mntpoint);

    die "raid / with no /boot" 
      if $mntpoint eq "/" && isRAID($part) && !has_mntpoint("/boot", $all_hds);
    die _("You can't use a LVM Logical Volume for mount point %s", $mntpoint)
      if ($mntpoint eq '/' || $mntpoint eq '/boot') && isLVM($hd);
    die _("This directory should remain within the root filesystem")
      if member($mntpoint, qw(/bin /dev /etc /lib /sbin));
    die _("You need a true filesystem (ext2, reiserfs) for this mount point\n")
      if !isTrueFS($part) && member($mntpoint, qw(/ /home /tmp /usr /var));
    die _("You can't use an encrypted file system for mount point %s", $mntpoint)
      if $part->{options} =~ /encrypted/ && member($mntpoint, qw(/ /usr));

    local $part->{mntpoint} = $mntpoint;
    loopback::check_circular_mounts($hd, $part, $all_hds);
}

sub check {
    my ($hd, $part, $all_hds) = @_;
    check_mntpoint($part->{mntpoint}, $hd, $part, $all_hds);
    check_type($part->{type}, $hd, $part);
}

sub add {
    my ($hd, $part, $all_hds, $options) = @_;

    isSwap($part) ?
      ($part->{mntpoint} = 'swap') :
      $options->{force} || check_mntpoint($part->{mntpoint}, $hd, $part, $all_hds);

    delete $part->{maxsize};

    if (isLVM($hd)) {
	lvm::lv_create($hd, $part);
    } else {
	partition_table::add($hd, $part, $options->{primaryOrExtended});
    }
}

sub allocatePartitions {
    my ($all_hds, $to_add) = @_;

    foreach my $part (get_all_holes($all_hds)) {
	my ($start, $size, $dev) = @$part{"start", "size", "rootDevice"};
	my $part;
	while (suggest_part($part = { start => $start, size => 0, maxsize => $size, rootDevice => $dev }, 
			    $all_hds, $to_add)) {
	    my ($hd) = fsedit::part2hd($part, $all_hds);
	    add($hd, $part, $all_hds);
	    $size -= $part->{size} + $part->{start} - $start;
	    $start = $part->{start} + $part->{size};
	}
    }
}

sub auto_allocate {
    my ($all_hds, $suggestions) = @_;
    my $before = listlength(fsedit::get_all_fstab($all_hds));

    my $suggestions_ = $suggestions || $suggestions{simple};
    allocatePartitions($all_hds, $suggestions_);
    auto_allocate_raids($all_hds, $suggestions) if $suggestions;

    partition_table::assign_device_numbers($_) foreach @{$all_hds->{hds}};

    if ($before == listlength(fsedit::get_all_fstab($all_hds))) {
	# find out why auto_allocate failed
	if (my @l = grep { !has_mntpoint($_->{mntpoint}, $all_hds) } @$suggestions_) {
	    die _("Not enough free space for auto-allocating");
	} else {
	    die _("Nothing to do");
	}
    }
}

sub auto_allocate_raids {
    my ($all_hds, $suggestions) = @_;

    my @raids = grep { isRawRAID($_) } get_all_fstab($all_hds) or return;
    if (@raids) {
	require raid;
	my @mds = grep { $_->{hd} =~ /md/ } @$suggestions;
	foreach my $md (@mds) {
	    my @raids_ = grep { !$md->{parts} || $md->{parts} =~ /\Q$_->{mntpoint}/ } @raids;
	    @raids = difference2(\@raids, \@raids_);
	    my $nb = raid::new($all_hds->{raids}, @raids_);
	    my $part = $all_hds->{raids}[$nb];

	    my %h = %$md;
	    delete @h{'hd', 'parts'};
	    put_in_hash($part, \%h); # mntpoint, level, chunk-size, type
	    raid::updateSize($part);
	}
    }
}

sub undo_prepare {
    my ($all_hds) = @_;
    require Data::Dumper;
    $Data::Dumper::Purity = 1;
    foreach (@{$all_hds->{hds}}) {
	my @h = @{$_}{@partition_table::fields2save};
	push @{$_->{undo}}, Data::Dumper->Dump([\@h], ['$h']);
    }
}
sub undo {
    my ($all_hds) = @_;
    foreach (@{$all_hds->{hds}}) {
	my $h; eval pop @{$_->{undo}} || next;
	@{$_}{@partition_table::fields2save} = @$h;

	$_->{isDirty} = $_->{needKernelReread} = 1 if $_->{hasBeenDirty};
    }
    
}

sub move {
    my ($hd, $part, $hd2, $sector2) = @_;

    die 'TODO'; # doesn't work for the moment
    my $part1 = { %$part };
    my $part2 = { %$part };
    $part2->{start} = $sector2;
    $part2->{size} += $hd2->cylinder_size() - 1;
    partition_table::remove($hd, $part);
    {
	local ($part2->{notFormatted}, $part2->{isFormatted}); #- do not allow partition::add to change this
	partition_table::add($hd2, $part2);
    }

    return if $part2->{notFormatted} && !$part2->{isFormatted} || $::testing;

    local (*F, *G);
    sysopen F, $hd->{file}, 0 or die '';
    sysopen G, $hd2->{file}, 2 or die _("Error opening %s for writing: %s", $hd2->{file}, "$!");

    my $base = $part1->{start};
    my $base2 = $part2->{start};
    my $step = 10;
    if ($hd eq $hd2) {
	$base == $base2 and return;
	$step = min($step, abs($base2 - $base));

	if ($base < $base2) {
	    $base  += $part1->{size} - $step;
	    $base2 += $part1->{size} - $step;
	    $step = -$step;
	}
    }

    my $f = sub {
	$base  < 0 and $base2 += -$base,  $base  = 0;
	$base2 < 0 and $base  += -$base2, $base2 = 0;
	c::lseek_sector(fileno(F), $base,  0) or die "seeking to sector $base failed on drive $hd->{device}";
	c::lseek_sector(fileno(G), $base2, 0) or die "seeking to sector $base2 failed on drive $hd2->{device}";

	my $buf;
	sysread F, $buf, $SECTORSIZE * abs($_[0]) or die '';
	syswrite G, $buf;
    };

    for (my $i = 0; $i < $part1->{size} / abs($step); $i++, $base += $step, $base2 += $step) {
	print "$base $base2\n";
	&$f($step);
    }
    if (my $v = ($part1->{size} % abs($step)) * sign($step)) {
	$base += $v;
	$base2 += $v;
	&$f($v);
    }
}

sub change_type {
    my ($type, $hd, $part) = @_;
    $type != $part->{type} or return;
    check_type($type, $hd, $part);
    $hd->{isDirty} = 1;
    $part->{mntpoint} = '' if isSwap($part) && $part->{mntpoint} eq "swap";
    $part->{mntpoint} = '' if isRawLVM({ type => $type }) || isRawRAID({ type => $type });
    $part->{type} = $type;
    $part->{notFormatted} = 1;
    $part->{isFormatted} = 0;    
}

sub rescuept($) {
    my ($hd) = @_;
    my ($ext, @hd);

    my $dev = devices::make($hd->{device});
    local *F; open F, "rescuept $dev|";
    local $_;
    while (<F>) {
	my ($st, $si, $id) = /start=\s*(\d+),\s*size=\s*(\d+),\s*Id=\s*(\d+)/ or next;
	my $part = { start => $st, size => $si, type => hex($id) };
	if (isExtended($part)) {
	    $ext = $part;
	} else {
	    push @hd, $part;
	}
    }
    close F or die "rescuept failed";

    partition_table_raw::zero_MBR($hd);
    foreach (@hd) {
	my $b = partition_table::verifyInside($_, $ext);
	if ($b) {
	    $_->{start}--;
	    $_->{size}++;
	}
	local $_->{notFormatted};

	partition_table::add($hd, $_, ($b ? 'Extended' : 'Primary'), 1);
    }
}

sub verifyHds {
    my ($hds, $readonly, $ok) = @_;

    if (is_empty_array_ref($hds)) { #- no way
	die _("An error has occurred - no valid devices were found on which to create new filesystems. Please check your hardware for the cause of this problem");
    }

    my @parts = readProcPartitions($hds);
    foreach my $hd (@$hds) {
	my @l1 = partition_table::get_normal_parts($hd);
	my @l2 = grep { $_->{rootDevice} eq $hd->{device} } @parts;
	if (int(@l1) != int(@l2) && arch() ne 'ppc') {
	    log::l(sprintf
		   "/proc/partitions doesn't agree with drakx %d != %d:\n%s\n", int(@l1), int(@l2),
		   "/proc/partitions: " . join(", ", map { "$_->{device} ($_->{rootDevice})" } @parts));
	    $ok = 0;
	}
    }

    if ($readonly && !$ok) {
	log::l("using /proc/partitions as diskdrake failed :(");
	foreach my $hd (@$hds) {
	    partition_table_raw::zero_MBR($hd);
	    $hd->{primary} = { normal => [ grep { $hd->{device} eq $_->{rootDevice} } @parts ] };
	}
	$ok = 1;
    }
    $readonly && get_fstab(@$hds) == 0 and die _("You don't have any partitions!");
    $ok;
}

#-######################################################################################
#- Wonderful perl :(
#-######################################################################################
1; #
generated by cgit v1.2.1 (git 2.21.0) at 2025-02-08 06:03:59 +0000