/[soft]/drakx/trunk/perl-install/install/steps_interactive.pm
ViewVC logotype

Annotation of /drakx/trunk/perl-install/install/steps_interactive.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1942 - (hide annotations) (download)
Sat Sep 17 09:22:15 2011 UTC (12 years, 7 months ago) by tv
File size: 38921 byte(s)
(_try_to_upgrade,_prepare_upgrade) split them out of
selectInstallClass() for readability
1 dmorgan 446 package install::steps_interactive; # $Id: steps_interactive.pm 267011 2010-03-19 12:00:12Z pterjan $
2    
3    
4     use strict;
5    
6     our @ISA = qw(install::steps);
7    
8    
9     #-######################################################################################
10     #- misc imports
11     #-######################################################################################
12     use common;
13     use partition_table;
14     use fs::type;
15     use fs::partitioning;
16     use fs::partitioning_wizard;
17     use install::steps;
18     use install::interactive;
19     use install::any;
20     use messages;
21     use detect_devices;
22     use run_program;
23     use devices;
24     use fsedit;
25     use mouse;
26     use modules;
27     use modules::interactive;
28     use lang;
29     use keyboard;
30     use any;
31     use log;
32    
33     #-######################################################################################
34     #- In/Out Steps Functions
35     #-######################################################################################
36     sub errorInStep {
37     my ($o, $err) = @_;
38     $err = ugtk2::escape_text_for_TextView_markup_format($err) if $o->isa('install::steps_gtk');
39     $o->ask_warn(N("Error"), [ N("An error occurred"), formatError($err) ]);
40     }
41    
42     sub kill_action {
43     my ($o) = @_;
44     $o->kill;
45     }
46    
47     #-######################################################################################
48     #- Steps Functions
49     #-######################################################################################
50     #------------------------------------------------------------------------------
51    
52     sub acceptLicense {
53     my ($o) = @_;
54     return if $o->{useless_thing_accepted};
55    
56     any::acceptLicense($o, $o->{meta_class} eq 'powerpack');
57     }
58    
59     sub selectLanguage {
60     my ($o) = @_;
61    
62     any::selectLanguage_install($o, $o->{locale});
63     install::steps::selectLanguage($o);
64    
65     if ($o->isa('interactive::gtk')) {
66     $o->ask_warn('', formatAlaTeX(
67     "If you see this message it is because you chose a language for
68     which DrakX does not include a translation yet; however the fact
69     that it is listed means there is some support for it anyway.
70    
71     That is, once GNU/Linux will be installed, you will be able to at
72     least read and write in that language; and possibly more (various
73     fonts, spell checkers, various programs translated etc. that
74     varies from language to language).")) if $o->{locale}{lang} !~ /^en/ && !lang::load_mo();
75     } else {
76     #- no need to have this in po since it is never translated
77 ahmad 805 $o->ask_warn('', "The characters of your language cannot be displayed in console,
78 dmorgan 446 so the messages will be displayed in english during installation") if $ENV{LANGUAGE} eq 'C';
79     }
80     }
81    
82     #------------------------------------------------------------------------------
83     sub selectKeyboard {
84     my ($o, $clicked) = @_;
85    
86     my $from_usb = keyboard::from_usb();
87     my $l = keyboard::lang2keyboards(lang::langs($o->{locale}{langs}));
88    
89     if ($clicked || !($from_usb || @$l && $l->[0][1] >= 90) || listlength(lang::langs($o->{locale}{langs})) > 1) {
90     add2hash($o->{keyboard}, $from_usb);
91     my @best = uniq(grep { $_ } $from_usb && $from_usb->{KEYBOARD}, $o->{keyboard}{KEYBOARD},
92     map { $_->[0] } @$l);
93     @best = () if @best == 1;
94    
95     my $format = sub { translate(keyboard::KEYBOARD2text($_[0])) };
96     my $other;
97     my $ext_keyboard = my $KEYBOARD = $o->{keyboard}{KEYBOARD};
98     $o->ask_from_(
99     { title => N("Keyboard"),
100     interactive_help_id => 'selectKeyboard',
101     advanced_label => N("More"),
102     },
103     [
104     { label => N("Please choose your keyboard layout"), title => 1 },
105     if_(@best, { val => \$KEYBOARD, type => 'list', format => $format, sort => 1,
106     list => [ @best ], changed => sub { $other = 0 } }),
107     if_(@best,
108     { label => N("Here is the full list of available keyboards:"), title => 1, advanced => 1 }),
109     { val => \$ext_keyboard, type => 'list', format => $format, changed => sub { $other = 1 },
110     list => [ difference2([ keyboard::KEYBOARDs() ], \@best) ], advanced => @best > 1 }
111     ]);
112     $o->{keyboard}{KEYBOARD} = !@best || $other ? $ext_keyboard : $KEYBOARD;
113     delete $o->{keyboard}{unsafe};
114     }
115     keyboard::group_toggle_choose($o, $o->{keyboard}) or goto &selectKeyboard;
116     install::steps::selectKeyboard($o);
117     if ($::isRestore) {
118     require MDV::Snapshot::Restore;
119     MDV::Snapshot::Restore::main($o);
120     $o->exit;
121     }
122     }
123    
124     #------------------------------------------------------------------------------
125     sub selectInstallClass {
126     my ($o) = @_;
127    
128     return if $::isRestore;
129    
130     my @l = install::any::find_root_parts($o->{fstab}, $::prefix);
131     # Don't list other archs as ugrading between archs is not supported
132     my $arch = arch() =~ /i.86/ ? $MDK::Common::System::compat_arch{arch()} : arch();
133     @l = grep { $_->{arch} eq $arch } @l;
134     if (@l) {
135 tv 1942 _try_to_upgrade($o, @l);
136     }
137     }
138 dmorgan 446
139 tv 1942 sub _try_to_upgrade {
140     my ($o, @l) = @_;
141     log::l("proposing to upgrade partitions " . join(" ", map { $_->{part} && $_->{part}{device} } @l));
142 dmorgan 446
143 tv 1942 my @releases = uniq(map { "$_->{release} $_->{version}" } @l);
144     if (@releases != @l) {
145     #- same release name so adding the device to differentiate them:
146     $_->{release} .= " ($_->{part}{device})" foreach @l;
147     }
148 dmorgan 446
149 tv 1942 askInstallClass:
150     my $p;
151     $o->ask_from_({ title => N("Install/Upgrade"),
152     interactive_help_id => 'selectInstallClass',
153     },
154     [
155     { label => N("Is this an install or an upgrade?"), title => 1 },
156     { val => \$p,
157     list => [ @l, N_("_: This is a noun:\nInstall") ],
158     type => 'list',
159     format => sub { ref($_[0]) ? N("Upgrade %s", "$_[0]->{release} $_[0]->{version}") : translate($_[0]) }
160     } ]);
161     if (ref $p) {
162     _check_unsafe_upgrade_and_warn($o, $p->{part}) or $p = undef;
163     }
164 dmorgan 446
165 tv 1942 if (ref $p) {
166     _prepare_upgrade($o, $p);
167     }
168     }
169 dmorgan 446
170 tv 1942 sub _prepare_upgrade {
171     my ($o, $p) = @_;
172     if ($p->{part}) {
173     log::l("choosing to upgrade partition $p->{part}{device}");
174     $o->{migrate_device_names} = install::any::use_root_part($o->{all_hds}, $p->{part}, $o);
175     }
176 dmorgan 446
177 tv 1942 #- handle encrypted partitions (esp. /home)
178     foreach (grep { $_->{mntpoint} } @{$o->{fstab}}) {
179     my ($options, $_unknown) = fs::mount_options::unpack($_);
180     $options->{encrypted} or next;
181     $o->ask_from_({ focus_first => 1 },
182     [ { label => N("Encryption key for %s", $_->{mntpoint}),
183     hidden => 1, val => \$_->{encrypt_key} } ]);
184     }
185 dmorgan 446
186 tv 1942 $o->{previous_release} = $p;
187     $o->{isUpgrade} = (find { $p->{release_file} =~ /$_/ } 'mageia', 'mandriva', 'mandrake', 'conectiva', 'redhat') || 'unknown';
188     $o->{upgrade_by_removing_pkgs_matching} ||= {
189     conectiva => 'cl',
190     redhat => '.', #- everything!
191     }->{$o->{isUpgrade}};
192     log::l("upgrading $o->{isUpgrade} distribution" . ($o->{upgrade_by_removing_pkgs_matching} ? " (upgrade_by_removing_pkgs_matching $o->{upgrade_by_removing_pkgs_matching})" : ''));
193 dmorgan 446 }
194    
195     sub _check_unsafe_upgrade_and_warn {
196     my ($o, $part) = @_;
197     !_is_unsafe_upgrade($part) || _warn_unsafe_upgrade($o);
198     }
199     sub _is_unsafe_upgrade {
200     my ($part) = @_;
201    
202     my $r = run_program::get_stdout('dumpe2fs', devices::make($part->{device}));
203     my $block_size = $r =~ /^Block size:\s*(\d+)/m && $1;
204     log::l("block_size $block_size");
205     $block_size == 1024;
206     }
207     sub _warn_unsafe_upgrade {
208     my ($o) = @_;
209    
210     log::l("_warn_unsafe_upgrade");
211    
212     my @choices = (
213     N_("Cancel installation, reboot system"),
214     N_("New Installation"),
215     N_("Upgrade previous installation (not recommended)"),
216     );
217    
218     my $choice;
219     $o->ask_from_({ messages => N("Installer has detected that your installed Linux system could not
220     safely be upgraded to %s.
221    
222     New installation replacing your previous one is recommended.
223    
224     Warning : you should backup all your personal data before choosing \"New
225     Installation\".", '%s') },
226     [ { val => \$choice, type => 'list', list => \@choices, format => \&translate } ]);
227    
228     log::l("_warn_unsafe_upgrade: got $choice");
229    
230     if ($choice eq $choices[0]) {
231     any::reboot();
232     } elsif ($choice eq $choices[1]) {
233     undef;
234     } else {
235     1;
236     }
237     }
238    
239     #------------------------------------------------------------------------------
240     sub selectMouse {
241     my ($o, $force) = @_;
242    
243     $force || $o->{mouse}{unsafe} or return;
244    
245     mouse::select($o, $o->{mouse}) or return;
246    
247     if ($o->{mouse}{device} eq "input/mice") {
248     modules::interactive::load_category($o, $o->{modules_conf}, 'bus/usb', 1, 0);
249     eval {
250     devices::make("usbmouse");
251     modules::load('usbhid');
252     };
253     }
254     }
255     #------------------------------------------------------------------------------
256     sub setupSCSI {
257     my ($o) = @_;
258    
259     install::any::configure_pcmcia($o);
260     {
261     my $_w = $o->wait_message(N("IDE"), N("Configuring IDE"));
262     modules::load(modules::category2modules('disk/cdrom'));
263     }
264     modules::interactive::load_category($o, $o->{modules_conf}, 'bus/firewire', 1);
265    
266     my $have_non_scsi = detect_devices::hds(); #- at_least_one scsi device if we have no disks
267     modules::interactive::load_category($o, $o->{modules_conf}, 'disk/card_reader|ide|scsi|hardware_raid|sata|firewire|virtual', 1, !$have_non_scsi);
268     modules::interactive::load_category($o, $o->{modules_conf}, 'disk/card_reader|ide|scsi|hardware_raid|sata|firewire|virtual') if !detect_devices::hds(); #- we really want a disk!
269    
270     install::interactive::tellAboutProprietaryModules($o);
271    
272     install::any::getHds($o, $o);
273     }
274    
275     #------------------------------------------------------------------------------
276     sub doPartitionDisks {
277     my ($o) = @_;
278    
279     if (arch() =~ /ppc/) {
280     my $generation = detect_devices::get_mac_generation();
281     if ($generation =~ /NewWorld/) {
282     #- mac partition table
283     if (defined $partition_table::mac::bootstrap_part) {
284     #- do not do anything if we've got the bootstrap setup
285     #- otherwise, go ahead and create one somewhere in the drive free space
286     } else {
287     my $freepart = $partition_table::mac::freepart;
288     if ($freepart && $freepart->{size} >= 1) {
289     log::l("creating bootstrap partition on drive /dev/$freepart->{hd}{device}, block $freepart->{start}");
290     $partition_table::mac::bootstrap_part = $freepart->{part};
291     log::l("bootstrap now at $partition_table::mac::bootstrap_part");
292     my $p = { start => $freepart->{start}, size => MB(1), mntpoint => '' };
293     fs::type::set_pt_type($p, 0x401);
294     fsedit::add($freepart->{hd}, $p, $o->{all_hds}, { force => 1, primaryOrExtended => 'Primary' });
295     $partition_table::mac::new_bootstrap = 1;
296    
297     } else {
298     $o->ask_warn('', N("No free space for 1MB bootstrap! Install will continue, but to boot your system, you'll need to create the bootstrap partition in DiskDrake"));
299     }
300     }
301     } elsif ($generation =~ /IBM/) {
302     #- dos partition table
303     $o->ask_warn('', N("You'll need to create a PPC PReP Boot bootstrap! Install will continue, but to boot your system, you'll need to create the bootstrap partition in DiskDrake"));
304     }
305     }
306    
307     if (!$o->{isUpgrade}) {
308     fs::partitioning_wizard::main($o, $o->{all_hds}, $o->{fstab}, $o->{manualFstab}, $o->{partitions}, $o->{partitioning}, $::local_install);
309     }
310     }
311    
312     #------------------------------------------------------------------------------
313     sub rebootNeeded {
314     my ($o) = @_;
315     fs::partitioning_wizard::warn_reboot_needed($o);
316     install::steps::rebootNeeded($o);
317     }
318    
319     #------------------------------------------------------------------------------
320     sub choosePartitionsToFormat {
321     my ($o) = @_;
322     fs::partitioning::choose_partitions_to_format($o, $o->{fstab});
323     }
324    
325     sub formatMountPartitions {
326     my ($o, $_fstab) = @_;
327     fs::partitioning::format_mount_partitions($o, $o->{all_hds}, $o->{fstab});
328     }
329    
330     #------------------------------------------------------------------------------
331     #- group by CD
332     sub ask_deselect_media__copy_on_disk {
333     my ($o, $hdlists, $o_copy_rpms_on_disk) = @_;
334    
335     log::l("ask_deselect_media__copy_on_disk");
336    
337     my @names = uniq(map { $_->{name} } @$hdlists);
338     my %selection = map { $_ => 1 } @names;
339    
340     $o->ask_from_({ messages => formatAlaTeX(N("The following installation media have been found.
341     If you want to skip some of them, you can unselect them now.")) },
342     [ (map { { type => 'bool', text => $_, val => \$selection{$_},
343     if_($_ eq $names[0], disabled => sub { 1 }),
344     } } @names),
345     if_($o_copy_rpms_on_disk,
346 ahmad 832 { type => 'label', val => \(formatAlaTeX(N("You have the option to copy the contents of the CDs onto the hard disk drive before installation.
347     It will then continue from the hard disk drive and the packages will remain available once the system is fully installed."))) },
348 dmorgan 446 { type => 'bool', text => N("Copy whole CDs"), val => $o_copy_rpms_on_disk },
349     ),
350     ]);
351     $_->{ignore} = !$selection{$_->{name}} foreach @$hdlists;
352     log::l("keeping media " . join ',', map { $_->{rpmsdir} } grep { !$_->{ignore} } @$hdlists);
353     }
354    
355     sub while_suspending_time {
356     my ($o, $f) = @_;
357    
358     my $time = time();
359    
360     my $r = $f->();
361    
362     #- add the elapsed time (otherwise the predicted time will be rubbish)
363     $o->{install_start_time} += time() - $time;
364    
365     $r;
366     }
367    
368     # nb: $file can be a directory
369     sub ask_change_cd {
370     my ($o, $medium) = @_;
371    
372     while_suspending_time($o, sub { ask_change_cd_($o, $medium) });
373     }
374    
375     sub ask_change_cd_ {
376     my ($o, $medium) = @_;
377    
378     local $::isWizard = 0; # make button name match text, aka being "cancel" rather than "previous"
379     $o->ask_okcancel('', N("Change your Cd-Rom!
380     Please insert the Cd-Rom labelled \"%s\" in your drive and press Ok when done.
381     If you do not have it, press Cancel to avoid installation from this Cd-Rom.", $medium), 1) or return;
382    
383     }
384    
385     sub selectSupplMedia {
386     my ($o) = @_;
387     install::any::selectSupplMedia($o);
388     }
389     #------------------------------------------------------------------------------
390     sub choosePackages {
391     my ($o) = @_;
392    
393     require pkgs;
394     add2hash_($o, { compssListLevel => pkgs::rpmsrate_rate_default() });
395    
396     my $w = $o->wait_message('', N("Looking for available packages..."));
397     my $availableC = install::steps::choosePackages($o, pkgs::rpmsrate_rate_max());
398    
399     require install::pkgs;
400    
401     my $min_size = install::pkgs::selectedSize($o->{packages});
402     undef $w;
403     if ($min_size >= $availableC) {
404     my $msg = N("Your system does not have enough space left for installation or upgrade (%dMB > %dMB)",
405     $min_size / sqr(1024), $availableC / sqr(1024));
406     log::l($msg);
407     $o->ask_warn('', $msg);
408     install::steps::rebootNeeded($o);
409     }
410    
411     my ($individual, $chooseGroups);
412    
413     if (!$o->{isUpgrade}) {
414     my $tasks_ok = install::pkgs::packageByName($o->{packages}, 'task-kde4') &&
415     install::pkgs::packageByName($o->{packages}, 'task-gnome-minimal');
416     if ($tasks_ok && $availableC >= 2_500_000_000) {
417     _chooseDesktop($o, $o->{rpmsrate_flags_chosen}, \$chooseGroups);
418     } else {
419     $tasks_ok ? log::l("not asking for desktop since not enough place") :
420     log::l("not asking for desktop since kde and gnome are not available on media (useful for mini iso)");
421     $chooseGroups = 1;
422     }
423     }
424    
425     chooseGroups:
426     $o->chooseGroups($o->{packages}, $o->{compssUsers}, \$individual) if $chooseGroups;
427    
428     ($o->{packages_}{ind}) =
429     install::pkgs::setSelectedFromCompssList($o->{packages}, $o->{rpmsrate_flags_chosen}, $o->{compssListLevel}, $availableC);
430    
431     $o->choosePackagesTree($o->{packages}) or goto chooseGroups if $individual;
432    
433     install::any::warnAboutRemovedPackages($o, $o->{packages});
434     }
435    
436     sub choosePackagesTree {
437     my ($o, $packages, $o_limit_to_medium) = @_;
438    
439     $o->ask_many_from_list('', N("Choose the packages you want to install"),
440     {
441     list => [ grep { !$o_limit_to_medium || install::pkgs::packageMedium($packages, $_) == $o_limit_to_medium }
442     @{$packages->{depslist}} ],
443     value => \&URPM::Package::flag_selected,
444     label => \&URPM::Package::name,
445     sort => 1,
446     });
447     }
448     sub loadSavePackagesOnFloppy {
449     my ($o, $packages) = @_;
450     $o->ask_from('',
451     N("Please choose load or save package selection.
452     The format is the same as auto_install generated files."),
453     [ { val => \ (my $choice), list => [ N_("Load"), N_("Save") ], format => \&translate, type => 'list' } ]) or return;
454    
455     if ($choice eq 'Load') {
456     while (1) {
457     log::l("load package selection");
458     my ($_h, $fh) = install::any::media_browser($o, '', 'package_list.pl') or return;
459     my $O = eval { install::any::loadO(undef, $fh) };
460     if ($@) {
461     $o->ask_okcancel('', N("Bad file")) or return;
462     } else {
463     install::any::unselectMostPackages($o);
464     install::pkgs::select_by_package_names($packages, $O->{default_packages} || []);
465     return 1;
466     }
467     }
468     } else {
469     log::l("save package selection");
470     install::any::g_default_packages($o);
471     }
472     }
473     sub _chooseDesktop {
474     my ($o, $rpmsrate_flags_chosen, $chooseGroups) = @_;
475    
476     my @l = group_by2(
477     KDE => N("KDE"),
478     GNOME => N("GNOME"),
479     Custom => N("Custom"),
480     );
481     my $title = N("Desktop Selection");
482     my $message = N("You can choose your workstation desktop profile.");
483    
484     my $default_choice = (find { $rpmsrate_flags_chosen->{"CAT_" . $_->[0]} } @l) || $l[0];
485     my $choice = $default_choice;
486     if ($o->isa('interactive::gtk')) {
487     $choice = install::steps_gtk::reallyChooseDesktop($o, $title, $message, \@l, $default_choice);
488     } else {
489     $o->ask_from_({ title => $title, message => $message }, [
490     { val => \$choice, list => \@l, type => 'list', format => sub { $_[0][1] } },
491     ]);
492     }
493     my $desktop = $choice->[0];
494     log::l("chosen Desktop: $desktop");
495     my @desktops = ('KDE', 'GNOME');
496     if (member($desktop, @desktops)) {
497     my ($want, $dontwant) = ($desktop, grep { $desktop ne $_ } @desktops);
498     $rpmsrate_flags_chosen->{"CAT_$want"} = 1;
499     $rpmsrate_flags_chosen->{"CAT_$dontwant"} = 0;
500     my @flags = map_each { if_($::b, $::a) } %$rpmsrate_flags_chosen;
501     log::l("flags ", join(' ', sort @flags));
502     install::any::unselectMostPackages($o);
503     } else {
504     $$chooseGroups = 1;
505     }
506     }
507     sub chooseGroups {
508     my ($o, $packages, $compssUsers, $individual) = @_;
509    
510     #- for all groups available, determine package which belongs to each one.
511     #- this will enable getting the size of each groups more quickly due to
512     #- limitation of current implementation.
513     #- use an empty state for each one (no flag update should be propagated).
514    
515     my $b = install::pkgs::saveSelected($packages);
516     install::any::unselectMostPackages($o);
517     install::pkgs::setSelectedFromCompssList($packages, { CAT_SYSTEM => 1 }, $o->{compssListLevel}, 0);
518     my $system_size = install::pkgs::selectedSize($packages);
519     my ($sizes, $pkgs) = install::pkgs::computeGroupSize($packages, $o->{compssListLevel});
520     install::pkgs::restoreSelected($b);
521     log::l("system_size: $system_size");
522    
523     my %stable_flags = grep_each { $::b } %{$o->{rpmsrate_flags_chosen}};
524     delete $stable_flags{"CAT_$_"} foreach map { @{$_->{flags}} } @{$o->{compssUsers}};
525    
526     my $compute_size = sub {
527     my %pkgs;
528     my %flags = %stable_flags; @flags{@_} = ();
529     my $total_size;
530     A: while (my ($k, $size) = each %$sizes) {
531     Or: foreach (split "\t", $k) {
532     foreach (split "&&") {
533     exists $flags{$_} or next Or;
534     }
535     $total_size += $size;
536     $pkgs{$_} = 1 foreach @{$pkgs->{$k}};
537     next A;
538     }
539     }
540     log::l("computed size $total_size (flags " . join(' ', keys %flags) . ")");
541     log::l("chooseGroups: ", join(" ", sort keys %pkgs));
542    
543     int $total_size;
544     };
545    
546     my ($size, $unselect_all);
547     my $available_size = install::any::getAvailableSpace($o) / sqr(1024);
548     my $size_to_display = sub {
549     my $lsize = $system_size + $compute_size->(map { "CAT_$_" } map { @{$_->{flags}} } grep { $_->{selected} } @$compssUsers);
550    
551     #- if a profile is deselected, deselect everything (easier than deselecting the profile packages)
552     $unselect_all ||= $size > $lsize;
553     $size = $lsize;
554     N("Total size: %d / %d MB", install::pkgs::correctSize($size / sqr(1024)), $available_size);
555     };
556    
557     while (1) {
558     if ($available_size < 200) {
559     # too small to choose anything. Defaulting to no group chosen
560     $_->{selected} = 0 foreach @$compssUsers;
561     last;
562     }
563    
564     $o->reallyChooseGroups($size_to_display, $individual, $compssUsers) or return;
565    
566     last if $::testing || install::pkgs::correctSize($size / sqr(1024)) < $available_size || every { !$_->{selected} } @$compssUsers;
567    
568     $o->ask_warn('', N("Selected size is larger than available space"));
569     }
570     install::any::set_rpmsrate_category_flags($o, $compssUsers);
571    
572     log::l("compssUsersChoice selected: ", join(', ', map { qq("$_->{path}|$_->{label}") } grep { $_->{selected} } @$compssUsers));
573    
574     #- do not try to deselect package (by default no groups are selected).
575     if (!$o->{isUpgrade}) {
576     install::any::unselectMostPackages($o) if $unselect_all;
577     }
578     #- if no group have been chosen, ask for using base system only, or no X, or normal.
579     if (!$o->{isUpgrade} && !any { $_->{selected} } @$compssUsers) {
580     my $docs = !$o->{excludedocs};
581     my $minimal;
582     my $suggests;
583    
584     $o->ask_from_({ title => N("Type of install"),
585     message =>N("You have not selected any group of packages.
586     Please choose the minimal installation you want:"),
587     interactive_help_id => 'choosePackages#minimal-install'
588     },
589     [
590     { val => \$o->{rpmsrate_flags_chosen}{CAT_X}, type => 'bool', text => N("With X"), disabled => sub { $minimal } },
591     { val => \$suggests, type => 'bool', text => N("Install suggested packages"), disabled => sub { $minimal } },
592     { val => \$docs, type => 'bool', text => N("With basic documentation (recommended!)"), disabled => sub { $minimal } },
593     { val => \$minimal, type => 'bool', text => N("Truly minimal install (especially no urpmi)") },
594     ],
595     ) or return &chooseGroups;
596    
597     if ($minimal) {
598     $o->{rpmsrate_flags_chosen}{CAT_X} = $docs = $suggests = 0;
599     $o->{rpmsrate_flags_chosen}{CAT_SYSTEM} = 0;
600     }
601     $o->{excludedocs} = !$docs;
602     $o->{rpmsrate_flags_chosen}{CAT_MINIMAL_DOCS} = $docs;
603     $o->{no_suggests} = !$suggests;
604     $o->{compssListLevel} = pkgs::rpmsrate_rate_max() if !$suggests;
605    
606     install::any::unselectMostPackages($o);
607     }
608     1;
609     }
610    
611     sub reallyChooseGroups {
612     my ($o, $size_to_display, $individual, $compssUsers) = @_;
613    
614     my $size_text = &$size_to_display;
615    
616     my ($path, $all);
617     $o->ask_from_({ messages => N("Package Group Selection"),
618     interactive_help_id => 'choosePackages',
619     }, [
620     { val => \$size_text, type => 'label' }, {},
621     (map {
622     my $old = $path;
623     $path = $_->{path};
624     if_($old ne $path, { val => translate($path) }),
625     {
626     val => \$_->{selected},
627     type => 'bool',
628     disabled => sub { $all },
629     text => translate($_->{label}),
630     help => translate($_->{descr}),
631     changed => sub { $size_text = &$size_to_display },
632     };
633     } @$compssUsers),
634     if_($individual, { text => N("Individual package selection"), val => $individual, advanced => 1, type => 'bool' }),
635     ]);
636    
637     if ($all) {
638     $_->{selected} = 1 foreach @$compssUsers;
639     }
640     1;
641     }
642    
643     #------------------------------------------------------------------------------
644     sub installPackages {
645     my ($o) = @_;
646     my ($current, $total) = (0, 0);
647    
648     my ($_w, $wait_message) = $o->wait_message_with_progress_bar(N("Installing"));
649     $wait_message->(N("Preparing installation"), 0, 100); #- beware, interactive::curses::wait_message_with_progress_bar need to create the Dialog::Progress here because in installCallback we are chrooted
650    
651     local *install::steps::installCallback = sub {
652     my ($packages, $type, $id, $subtype, $_amount, $total_) = @_;
653     if ($type eq 'user' && $subtype eq 'install') {
654     $total = $total_;
655     } elsif ($type eq 'inst' && $subtype eq 'start') {
656     my $p = $packages->{depslist}[$id];
657     $wait_message->(N("Installing package %s", $p->name), $current, $total);
658     $current += $p->size;
659     }
660     };
661    
662     my $install_result;
663     catch_cdie { $install_result = $o->install::steps::installPackages('interactive') }
664     sub { installPackages__handle_error($o, $_[0]) };
665    
666     if ($install::pkgs::cancel_install) {
667     $install::pkgs::cancel_install = 0;
668     die "setstep choosePackages\n";
669     }
670     $install_result;
671     }
672    
673     sub installPackages__handle_error {
674     my ($o, $err_ref) = @_;
675    
676     log::l("catch_cdie: $$err_ref");
677     my $time = time();
678     my $go_on;
679     if ($$err_ref =~ /^error ordering package list: (.*)/) {
680     $go_on = $o->ask_yesorno('', [
681     N("There was an error ordering packages:"), $1, N("Go on anyway?") ], 1);
682     } elsif ($$err_ref =~ /^error installing package list: (\S+)\s*(.*)/) {
683     my ($pkg_name, $medium_name) = ($1, $2);
684     my @choices = (
685     [ 'retry', N("Retry") ],
686     [ 'skip_one', N("Skip this package") ],
687     [ 'disable_media', N("Skip all packages from medium \"%s\"", $medium_name) ],
688     [ '', N("Go back to media and packages selection") ],
689     );
690     my $choice;
691     $o->ask_from_({ messages => N("There was an error installing package %s.", $pkg_name) },
692     [ { val => \$choice, type => 'list', list => \@choices, format => sub { $_[0][1] } } ]);
693     $go_on = $choice->[0];
694     }
695     if ($go_on) {
696     #- add the elapsed time (otherwise the predicted time will be rubbish)
697     $o->{install_start_time} += time() - $time;
698     $go_on;
699     } else {
700     $o->{askmedia} = 1;
701     $$err_ref = "already displayed";
702     0;
703     }
704     }
705    
706    
707     sub afterInstallPackages($) {
708     my ($o) = @_;
709     local $o->{pop_wait_messages} = 1;
710     my $_w = $o->wait_message(N("Post-install configuration"), N("Post-install configuration"));
711     $o->SUPER::afterInstallPackages;
712     }
713    
714     sub updatemodules {
715     my ($o, $dev, $rel_dir) = @_;
716    
717     $o->ask_okcancel('', N("Please ensure the Update Modules media is in drive %s", $dev), 1) or return;
718     $o->SUPER::updatemodules($dev, $rel_dir);
719     }
720    
721     #------------------------------------------------------------------------------
722     sub configureNetwork {
723     my ($o) = @_;
724     #- don't overwrite configuration in a network install
725     if (!install::any::is_network_install($o)) {
726     require network::network;
727     network::network::easy_dhcp($o->{net}, $o->{modules_conf});
728     }
729     $o->SUPER::configureNetwork;
730     }
731    
732     #------------------------------------------------------------------------------
733     sub installUpdates {
734     my ($o) = @_;
735     my $u = $o->{updates} ||= {};
736    
737     $o->hasNetwork or return;
738    
739     if (install::any::is_network_install($o) &&
740     find { $_->{update} } install::media::allMediums($o->{packages})) {
741     log::l("installUpdates: skipping since updates were already available during install");
742     return;
743     }
744    
745     $o->ask_yesorno_({ title => N("Updates"), messages => formatAlaTeX(
746     N("You now have the opportunity to download updated packages. These packages
747     have been updated after the distribution was released. They may
748     contain security or bug fixes.
749    
750     To download these packages, you will need to have a working Internet
751     connection.
752    
753     Do you want to install the updates?")),
754     interactive_help_id => 'installUpdates',
755     }, 1) or return;
756    
757     #- bring all interface up for installing updates packages.
758     install::interactive::upNetwork($o);
759    
760     install::pkgs::clean_rpmdb_shared_regions();
761     if (any::urpmi_add_all_media($o, $o->{previous_release})) {
762     my $binary = find { whereis_binary($_, $::prefix) } 'gurpmi2', 'urpmi' or return;
763     my $log_file = '/root/drakx/updates.log';
764     run_program::rooted($::prefix, $binary, '>>', $log_file, '2>>', $log_file, '--auto-select', '--update');
765     }
766     install::pkgs::clean_rpmdb_shared_regions();
767    
768     #- not downing network, even ppp. We don't care much since it is the end of install :)
769     }
770    
771    
772     #------------------------------------------------------------------------------
773     sub configureTimezone {
774     my ($o, $clicked) = @_;
775    
776     any::configure_timezone($o, $o->{timezone}, $clicked) or return;
777    
778     install::steps::configureTimezone($o);
779     1;
780     }
781    
782     #------------------------------------------------------------------------------
783     sub configureServices {
784     my ($o, $clicked) = @_;
785     require services;
786     $o->{services} = services::ask($o) if $clicked;
787     install::steps::configureServices($o);
788     }
789    
790    
791     sub summaryBefore {
792     my ($o) = @_;
793    
794     install::any::preConfigureTimezone($o);
795     #- get back network configuration.
796     require network::network;
797     eval {
798     network::network::read_net_conf($o->{net});
799     };
800     log::l("summaryBefore: network configuration: ", formatError($@)) if $@;
801     }
802    
803     sub summary_prompt {
804     my ($o, $l, $check_complete) = @_;
805    
806     foreach (@$l) {
807     my $val = $_->{val};
808     ($_->{format}, $_->{val}) = (sub { $val && $val->() || N("not configured") }, '');
809     }
810    
811     $o->ask_from_({
812     messages => N("Summary"),
813     interactive_help_id => 'summary',
814     cancel => '',
815     callbacks => { complete => sub { !$check_complete->() } },
816     }, $l);
817     }
818    
819     sub summary {
820     my ($o) = @_;
821    
822     my @l;
823    
824     my $timezone_manually_set;
825     push @l, {
826     group => N("System"),
827     label => N("Timezone"),
828     val => sub { $o->{timezone}{timezone} },
829     clicked => sub { $timezone_manually_set = $o->configureTimezone(1) || $timezone_manually_set },
830     };
831     push @l, {
832     group => N("System"),
833     label => N("Country / Region"),
834     val => sub { lang::c2name($o->{locale}{country}) },
835     clicked => sub {
836     any::selectCountry($o, $o->{locale}) or return;
837    
838     my $pkg_locale = lang::locale_to_main_locale(lang::getlocale_for_country($o->{locale}{lang}, $o->{locale}{country}));
839     my @pkgs = URPM::packages_providing($o->{packages}, "locales-$pkg_locale");
840     $o->pkg_install(map { $_->name } @pkgs) if @pkgs;
841    
842     lang::write_and_install($o->{locale}, $o->do_pkgs);
843     if (!$timezone_manually_set) {
844     delete $o->{timezone};
845     install::any::preConfigureTimezone($o); #- now we can precise the timezone thanks to the country
846     }
847     },
848     };
849     push @l, {
850     group => N("System"),
851     label => N("Bootloader"),
852     val => sub {
853     #-PO: example: lilo-graphic on /dev/hda1
854     $o->{bootloader}{boot} ? N("%s on %s", $o->{bootloader}{method}, $o->{bootloader}{boot}) : N("None");
855     },
856     clicked => sub {
857     any::setupBootloader($o, $o->{bootloader}, $o->{all_hds}, $o->{fstab}, $o->{security}) or return;
858     },
859     } if !$::local_install;
860    
861     push @l, {
862     group => N("System"),
863     label => N("User management"),
864     clicked => sub {
865     if (my $u = any::ask_user($o, $o->{users}, $o->{security}, needauser => 1)) {
866     any::add_users([$u], $o->{authentication});
867     }
868     },
869     };
870    
871     push @l, {
872     group => N("System"),
873     label => N("Services"),
874     val => sub {
875     require services;
876     my ($l, $activated) = services::services();
877     N("%d activated for %d registered", int(@$activated), int(@$l));
878     },
879     clicked => sub {
880     require services;
881     $o->{services} = services::ask($o) and services::doit($o, $o->{services});
882     },
883     };
884    
885     push @l, {
886     group => N("Hardware"),
887     label => N("Keyboard"),
888     val => sub { $o->{keyboard} && translate(keyboard::keyboard2text($o->{keyboard})) },
889     clicked => sub { $o->selectKeyboard(1) },
890     };
891    
892     push @l, {
893     group => N("Hardware"),
894     label => N("Mouse"),
895     val => sub { translate($o->{mouse}{type}) . ' ' . translate($o->{mouse}{name}) },
896     clicked => sub { selectMouse($o, 1); mouse::write($o->do_pkgs, $o->{mouse}) },
897     };
898    
899    
900     my @sound_cards = detect_devices::getSoundDevices();
901    
902     my $sound_index = 0;
903     foreach my $device (@sound_cards) {
904     $device->{sound_slot_index} = $sound_index;
905     push @l, {
906     group => N("Hardware"),
907     label => N("Sound card"),
908     val => sub {
909     $device->{driver} && modules::module2description($device->{driver}) || $device->{description};
910     },
911     clicked => sub {
912     require harddrake::sound;
913     harddrake::sound::config($o, $o->{modules_conf}, $device);
914     },
915     };
916     $sound_index++;
917     }
918    
919     if (!@sound_cards && ($o->{rpmsrate_flags_chosen}{CAT_GAMES} || $o->{rpmsrate_flags_chosen}{CAT_AUDIO})) {
920     #- if no sound card are detected AND the user selected things needing a sound card,
921     #- propose a special case for ISA cards
922     push @l, {
923     group => N("Hardware"),
924     label => N("Sound card"),
925     val => sub {},
926     clicked => sub {
927     if ($o->ask_yesorno('', N("Do you have an ISA sound card?"))) {
928     $o->do_pkgs->install(qw(alsa-utils sndconfig aoss));
929     $o->ask_warn('', N("Run \"alsaconf\" or \"sndconfig\" after installation to configure your sound card"));
930     } else {
931     $o->ask_warn('', N("No sound card detected. Try \"harddrake\" after installation"));
932     }
933     },
934     };
935     }
936    
937     push @l, {
938     group => N("Hardware"),
939     label => N("Graphical interface"),
940     val => sub { $o->{raw_X} ? Xconfig::various::to_string($o->{raw_X}) : '' },
941     clicked => sub { configureX($o, 'expert') },
942     };
943    
944     push @l, {
945     group => N("Network & Internet"),
946     label => N("Network"),
947     val => sub { $o->{net}{type} },
948     clicked => sub {
949     require network::netconnect;
950     network::netconnect::real_main($o->{net}, $o, $o->{modules_conf});
951     },
952     };
953    
954     $o->{miscellaneous} ||= {};
955     push @l, {
956     group => N("Network & Internet"),
957     label => N("Proxies"),
958     val => sub { $o->{miscellaneous}{http_proxy} || $o->{miscellaneous}{ftp_proxy} ? N("configured") : N("not configured") },
959     clicked => sub {
960     require network::network;
961     network::network::miscellaneous_choose($o, $o->{miscellaneous});
962     network::network::proxy_configure($o->{miscellaneous}) if !$::testing;
963     },
964     };
965    
966     push @l, {
967     group => N("Security"),
968     label => N("Security Level"),
969     val => sub {
970     require security::level;
971     security::level::to_string($o->{security});
972     },
973     clicked => sub {
974     require security::level;
975     my $security = $o->{security};
976     set_sec_level:
977     if (security::level::level_choose($o, \$security, \$o->{security_user})) {
978     check_security_level($o, $security) or goto set_sec_level;
979     $o->{security} = $security;
980     install::any::set_security($o);
981     }
982     },
983     };
984    
985     push @l, {
986     group => N("Security"),
987     label => N("Firewall"),
988     val => sub {
989     require network::shorewall;
990     my $shorewall = network::shorewall::read();
991     $shorewall && !$shorewall->{disabled} ? N("activated") : N("disabled");
992     },
993     clicked => sub {
994     require network::drakfirewall;
995     if (my @rc = network::drakfirewall::main($o, $o->{security} < 1)) {
996     $o->{firewall_ports} = !$rc[0] && $rc[1];
997     }
998     },
999     } if detect_devices::get_net_interfaces();
1000    
1001     my $check_complete = sub {
1002     require install::pkgs;
1003     my $p = install::pkgs::packageByName($o->{packages}, 'task-x11');
1004     $o->{raw_X} || !$::testing && $p && !$p->flag_installed ||
1005     $o->ask_yesorno('', N("You have not configured X. Are you sure you really want this?"));
1006     };
1007    
1008     $o->summary_prompt(\@l, $check_complete);
1009    
1010     any::installBootloader($o, $o->{bootloader}, $o->{all_hds}) if !$::local_install;
1011     install::steps::configureTimezone($o) if !$timezone_manually_set; #- do not forget it.
1012     }
1013    
1014     #------------------------------------------------------------------------------
1015     #-setRootPassword_addUser
1016     #------------------------------------------------------------------------------
1017     sub setRootPassword_addUser {
1018     my ($o) = @_;
1019     $o->{users} ||= [];
1020    
1021     my $sup = $o->{superuser} ||= {};
1022     $sup->{password2} ||= $sup->{password} ||= "";
1023    
1024     any::ask_user_and_root($o, $sup, $o->{users}, $o->{security});
1025    
1026     install::steps::setRootPassword($o);
1027     install::steps::addUser($o);
1028     }
1029    
1030     #------------------------------------------------------------------------------
1031     sub setupBootloaderBefore {
1032     my ($o) = @_;
1033     local $o->{pop_wait_messages} = 1;
1034     my $_w = $o->wait_message(N("Preparing bootloader..."), N("Preparing bootloader...") . "\n" .
1035     N("Be patient, this may take a while...")
1036     );
1037     $o->SUPER::setupBootloaderBefore;
1038     }
1039    
1040     #------------------------------------------------------------------------------
1041     sub setupBootloader {
1042     my ($o) = @_;
1043     if (arch() =~ /ppc/) {
1044     if (detect_devices::get_mac_generation() !~ /NewWorld/ &&
1045     detect_devices::get_mac_model() !~ /IBM/) {
1046     $o->ask_warn('', N("You appear to have an OldWorld or Unknown machine, the yaboot bootloader will not work for you. The install will continue, but you'll need to use BootX or some other means to boot your machine. The kernel argument for the root fs is: root=%s", '/dev/' . fs::get::root_($o->{fstab})->{device}));
1047     log::l("OldWorld or Unknown Machine - no yaboot setup");
1048     return;
1049     }
1050     }
1051     {
1052     any::setupBootloader_simple($o, $o->{bootloader}, $o->{all_hds}, $o->{fstab}, $o->{security}) or return;
1053     }
1054     }
1055    
1056     sub check_security_level {
1057     my ($o, $security) = @_;
1058     if ($security > 3 && find { $_->{fs_type} eq 'vfat' } @{$o->{fstab}}) {
1059     $o->ask_okcancel('', N("In this security level, access to the files in the Windows partition is restricted to the administrator.")) or return 0;
1060     }
1061     return 1;
1062     }
1063    
1064     sub miscellaneous {
1065     my ($o, $_clicked) = @_;
1066    
1067     install::steps::miscellaneous($o);
1068     }
1069    
1070     #------------------------------------------------------------------------------
1071     sub configureX {
1072     my ($o, $expert) = @_;
1073    
1074     install::steps::configureXBefore($o);
1075     symlink "$::prefix/etc/gtk", "/etc/gtk";
1076    
1077     require Xconfig::main;
1078     my ($raw_X) = Xconfig::main::configure_everything_or_configure_chooser($o, install::any::X_options_from_o($o), !$expert, $o->{keyboard}, $o->{mouse});
1079     if ($raw_X) {
1080     $o->{raw_X} = $raw_X;
1081     install::steps::configureXAfter($o);
1082     }
1083     }
1084    
1085     #------------------------------------------------------------------------------
1086     sub generateAutoInstFloppy {
1087     my ($o, $replay) = @_;
1088     my $img = install::any::getAndSaveAutoInstallFloppies($o, $replay) or return;
1089    
1090     my $floppy = detect_devices::floppy();
1091     $o->ask_okcancel('', N("Insert a blank floppy in drive %s", $floppy), 1) or return;
1092    
1093     my $_w = $o->wait_message('', N("Creating auto install floppy..."));
1094     require install::commands;
1095     install::commands::dd("if=$img", 'of=' . devices::make($floppy));
1096     common::sync();
1097     }
1098    
1099     #------------------------------------------------------------------------------
1100     sub exitInstall {
1101     my ($o, $alldone) = @_;
1102    
1103     return $o->{step} = '' if !$alldone && !$o->ask_yesorno(N("Warning"),
1104     N("Some steps are not completed.
1105    
1106     Do you really want to quit now?"), 0);
1107    
1108     install::steps::exitInstall($o);
1109    
1110     $o->exit unless $alldone;
1111    
1112     $o->ask_from_no_check(
1113     {
1114     title => N("Congratulations"),
1115     messages => formatAlaTeX(messages::install_completed()),
1116     interactive_help_id => 'exitInstall',
1117     ok => $::local_install ? N("Quit") : N("Reboot"),
1118     }, []) if $alldone;
1119     }
1120    
1121    
1122     #-######################################################################################
1123     #- Misc Steps Functions
1124     #-######################################################################################
1125    
1126     1;

  ViewVC Help
Powered by ViewVC 1.1.30