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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3694 - (show annotations) (download)
Fri Mar 23 19:50:35 2012 UTC (8 years, 6 months ago) by tv
File size: 38969 byte(s)
perl_checker cleanups
1 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);
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 $o->ask_warn('', "The characters of your language cannot be displayed in console,
78 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 _try_to_upgrade($o, @l);
136 }
137 }
138
139 sub _try_to_upgrade {
140 my ($o, @l) = @_;
141 log::l("proposing to upgrade partitions " . join(" ", map { $_->{part} && $_->{part}{device} } @l));
142
143 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
149 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
165 if (ref $p) {
166 _prepare_upgrade($o, $p);
167 }
168 }
169
170 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
177 #- 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
186 $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 }
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 { 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 { 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 # perl_checker: require install::steps_gtk
488 $choice = install::steps_gtk::reallyChooseDesktop($o, $title, $message, \@l, $default_choice);
489 } else {
490 $o->ask_from_({ title => $title, message => $message }, [
491 { val => \$choice, list => \@l, type => 'list', format => sub { $_[0][1] } },
492 ]);
493 }
494 my $desktop = $choice->[0];
495 log::l("chosen Desktop: $desktop");
496 my @desktops = ('KDE', 'GNOME');
497 if (member($desktop, @desktops)) {
498 my ($want, $dontwant) = ($desktop, grep { $desktop ne $_ } @desktops);
499 $rpmsrate_flags_chosen->{"CAT_$want"} = 1;
500 $rpmsrate_flags_chosen->{"CAT_$dontwant"} = 0;
501 my @flags = map_each { if_($::b, $::a) } %$rpmsrate_flags_chosen;
502 log::l("flags ", join(' ', sort @flags));
503 install::any::unselectMostPackages($o);
504 } else {
505 $$chooseGroups = 1;
506 }
507 }
508 sub chooseGroups {
509 my ($o, $packages, $compssUsers, $individual) = @_;
510
511 #- for all groups available, determine package which belongs to each one.
512 #- this will enable getting the size of each groups more quickly due to
513 #- limitation of current implementation.
514 #- use an empty state for each one (no flag update should be propagated).
515
516 my $b = install::pkgs::saveSelected($packages);
517 install::any::unselectMostPackages($o);
518 install::pkgs::setSelectedFromCompssList($packages, { CAT_SYSTEM => 1 }, $o->{compssListLevel}, 0);
519 my $system_size = install::pkgs::selectedSize($packages);
520 my ($sizes, $pkgs) = install::pkgs::computeGroupSize($packages, $o->{compssListLevel});
521 install::pkgs::restoreSelected($b);
522 log::l("system_size: $system_size");
523
524 my %stable_flags = grep_each { $::b } %{$o->{rpmsrate_flags_chosen}};
525 delete $stable_flags{"CAT_$_"} foreach map { @{$_->{flags}} } @{$o->{compssUsers}};
526
527 my $compute_size = sub {
528 my %pkgs;
529 my %flags = %stable_flags; @flags{@_} = ();
530 my $total_size;
531 A: while (my ($k, $size) = each %$sizes) {
532 Or: foreach (split "\t", $k) {
533 foreach (split "&&") {
534 exists $flags{$_} or next Or;
535 }
536 $total_size += $size;
537 $pkgs{$_} = 1 foreach @{$pkgs->{$k}};
538 next A;
539 }
540 }
541 log::l("computed size $total_size (flags " . join(' ', keys %flags) . ")");
542 log::l("chooseGroups: ", join(" ", sort keys %pkgs));
543
544 int $total_size;
545 };
546
547 my ($size, $unselect_all);
548 my $available_size = install::any::getAvailableSpace($o) / sqr(1024);
549 my $size_to_display = sub {
550 my $lsize = $system_size + $compute_size->(map { "CAT_$_" } map { @{$_->{flags}} } grep { $_->{selected} } @$compssUsers);
551
552 #- if a profile is deselected, deselect everything (easier than deselecting the profile packages)
553 $unselect_all ||= $size > $lsize;
554 $size = $lsize;
555 N("Total size: %d / %d MB", install::pkgs::correctSize($size / sqr(1024)), $available_size);
556 };
557
558 while (1) {
559 if ($available_size < 200) {
560 # too small to choose anything. Defaulting to no group chosen
561 $_->{selected} = 0 foreach @$compssUsers;
562 last;
563 }
564
565 $o->reallyChooseGroups($size_to_display, $individual, $compssUsers) or return;
566
567 last if $::testing || install::pkgs::correctSize($size / sqr(1024)) < $available_size || every { !$_->{selected} } @$compssUsers;
568
569 $o->ask_warn('', N("Selected size is larger than available space"));
570 }
571 install::any::set_rpmsrate_category_flags($o, $compssUsers);
572
573 log::l("compssUsersChoice selected: ", join(', ', map { qq("$_->{path}|$_->{label}") } grep { $_->{selected} } @$compssUsers));
574
575 #- do not try to deselect package (by default no groups are selected).
576 if (!$o->{isUpgrade}) {
577 install::any::unselectMostPackages($o) if $unselect_all;
578 }
579 #- if no group have been chosen, ask for using base system only, or no X, or normal.
580 if (!$o->{isUpgrade} && !any { $_->{selected} } @$compssUsers) {
581 my $docs = !$o->{excludedocs};
582 my $minimal;
583 my $suggests;
584
585 $o->ask_from_({ title => N("Type of install"),
586 message => N("You have not selected any group of packages.
587 Please choose the minimal installation you want:"),
588 interactive_help_id => 'choosePackages#minimal-install'
589 },
590 [
591 { val => \$o->{rpmsrate_flags_chosen}{CAT_X}, type => 'bool', text => N("With X"), disabled => sub { $minimal } },
592 { val => \$suggests, type => 'bool', text => N("Install suggested packages"), disabled => sub { $minimal } },
593 { val => \$docs, type => 'bool', text => N("With basic documentation (recommended!)"), disabled => sub { $minimal } },
594 { val => \$minimal, type => 'bool', text => N("Truly minimal install (especially no urpmi)") },
595 ],
596 ) or return &chooseGroups;
597
598 if ($minimal) {
599 $o->{rpmsrate_flags_chosen}{CAT_X} = $docs = $suggests = 0;
600 $o->{rpmsrate_flags_chosen}{CAT_SYSTEM} = 0;
601 }
602 $o->{excludedocs} = !$docs;
603 $o->{rpmsrate_flags_chosen}{CAT_MINIMAL_DOCS} = $docs;
604 $o->{no_suggests} = !$suggests;
605 $o->{compssListLevel} = pkgs::rpmsrate_rate_max() if !$suggests;
606
607 install::any::unselectMostPackages($o);
608 }
609 1;
610 }
611
612 sub reallyChooseGroups {
613 my ($o, $size_to_display, $individual, $compssUsers) = @_;
614
615 my $size_text = &$size_to_display;
616
617 my ($path, $all);
618 $o->ask_from_({ messages => N("Package Group Selection"),
619 interactive_help_id => 'choosePackages',
620 }, [
621 { val => \$size_text, type => 'label' }, {},
622 (map {
623 my $old = $path;
624 $path = $_->{path};
625 if_($old ne $path, { val => translate($path) }),
626 {
627 val => \$_->{selected},
628 type => 'bool',
629 disabled => sub { $all },
630 text => translate($_->{label}),
631 help => translate($_->{descr}),
632 changed => sub { $size_text = &$size_to_display },
633 };
634 } @$compssUsers),
635 if_($individual, { text => N("Individual package selection"), val => $individual, advanced => 1, type => 'bool' }),
636 ]);
637
638 if ($all) {
639 $_->{selected} = 1 foreach @$compssUsers;
640 }
641 1;
642 }
643
644 #------------------------------------------------------------------------------
645 sub installPackages {
646 my ($o) = @_;
647 my ($current, $total) = (0, 0);
648
649 my ($_w, $wait_message) = $o->wait_message_with_progress_bar(N("Installing"));
650 $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
651
652 local *install::steps::installCallback = sub {
653 my ($packages, $type, $id, $subtype, $_amount, $total_) = @_;
654 if ($type eq 'user' && $subtype eq 'install') {
655 $total = $total_;
656 } elsif ($type eq 'inst' && $subtype eq 'start') {
657 my $p = $packages->{depslist}[$id];
658 $wait_message->(N("Installing package %s", $p->name), $current, $total);
659 $current += $p->size;
660 }
661 };
662
663 my $install_result;
664 catch_cdie { $install_result = $o->install::steps::installPackages('interactive') }
665 sub { installPackages__handle_error($o, $_[0]) };
666
667 if ($install::pkgs::cancel_install) {
668 $install::pkgs::cancel_install = 0;
669 die "setstep choosePackages\n";
670 }
671 $install_result;
672 }
673
674 sub installPackages__handle_error {
675 my ($o, $err_ref) = @_;
676
677 log::l("catch_cdie: $$err_ref");
678 my $time = time();
679 my $go_on;
680 if ($$err_ref =~ /^error ordering package list: (.*)/) {
681 $go_on = $o->ask_yesorno('', [
682 N("There was an error ordering packages:"), $1, N("Go on anyway?") ], 1);
683 } elsif ($$err_ref =~ /^error installing package list: (\S+)\s*(.*)/) {
684 my ($pkg_name, $medium_name) = ($1, $2);
685 my @choices = (
686 [ 'retry', N("Retry") ],
687 [ 'skip_one', N("Skip this package") ],
688 [ 'disable_media', N("Skip all packages from medium \"%s\"", $medium_name) ],
689 [ '', N("Go back to media and packages selection") ],
690 );
691 my $choice;
692 $o->ask_from_({ messages => N("There was an error installing package %s.", $pkg_name) },
693 [ { val => \$choice, type => 'list', list => \@choices, format => sub { $_[0][1] } } ]);
694 $go_on = $choice->[0];
695 }
696 if ($go_on) {
697 #- add the elapsed time (otherwise the predicted time will be rubbish)
698 $o->{install_start_time} += time() - $time;
699 $go_on;
700 } else {
701 $o->{askmedia} = 1;
702 $$err_ref = "already displayed";
703 0;
704 }
705 }
706
707
708 sub afterInstallPackages($) {
709 my ($o) = @_;
710 local $o->{pop_wait_messages} = 1;
711 my $_w = $o->wait_message(N("Post-install configuration"), N("Post-install configuration"));
712 $o->SUPER::afterInstallPackages;
713 }
714
715 sub updatemodules {
716 my ($o, $dev, $rel_dir) = @_;
717
718 $o->ask_okcancel('', N("Please ensure the Update Modules media is in drive %s", $dev), 1) or return;
719 $o->SUPER::updatemodules($dev, $rel_dir);
720 }
721
722 #------------------------------------------------------------------------------
723 sub configureNetwork {
724 my ($o) = @_;
725 #- don't overwrite configuration in a network install
726 if (!install::any::is_network_install($o)) {
727 require network::network;
728 network::network::easy_dhcp($o->{net}, $o->{modules_conf});
729 }
730 $o->SUPER::configureNetwork;
731 }
732
733 #------------------------------------------------------------------------------
734 sub installUpdates {
735 my ($o) = @_;
736 $o->{updates} ||= {};
737
738 $o->hasNetwork or return;
739
740 if (install::any::is_network_install($o) &&
741 find { $_->{update} } install::media::allMediums($o->{packages})) {
742 log::l("installUpdates: skipping since updates were already available during install");
743 return;
744 }
745
746 $o->ask_yesorno_({ title => N("Updates"), messages => formatAlaTeX(
747 N("You now have the opportunity to download updated packages. These packages
748 have been updated after the distribution was released. They may
749 contain security or bug fixes.
750
751 To download these packages, you will need to have a working Internet
752 connection.
753
754 Do you want to install the updates?")),
755 interactive_help_id => 'installUpdates',
756 }, 1) or return;
757
758 #- bring all interface up for installing updates packages.
759 install::interactive::upNetwork($o);
760
761 install::pkgs::clean_rpmdb_shared_regions();
762 if (any::urpmi_add_all_media($o, $o->{previous_release})) {
763 my $binary = find { whereis_binary($_, $::prefix) } 'gurpmi2', 'urpmi' or return;
764 my $log_file = '/root/drakx/updates.log';
765 run_program::rooted($::prefix, $binary, '>>', $log_file, '2>>', $log_file, '--auto-select', '--update');
766 }
767 install::pkgs::clean_rpmdb_shared_regions();
768
769 #- not downing network, even ppp. We don't care much since it is the end of install :)
770 }
771
772
773 #------------------------------------------------------------------------------
774 sub configureTimezone {
775 my ($o, $clicked) = @_;
776
777 any::configure_timezone($o, $o->{timezone}, $clicked) or return;
778
779 install::steps::configureTimezone($o);
780 1;
781 }
782
783 #------------------------------------------------------------------------------
784 sub configureServices {
785 my ($o, $clicked) = @_;
786 require services;
787 $o->{services} = services::ask($o) if $clicked;
788 install::steps::configureServices($o);
789 }
790
791
792 sub summaryBefore {
793 my ($o) = @_;
794
795 install::any::preConfigureTimezone($o);
796 #- get back network configuration.
797 require network::network;
798 eval {
799 network::network::read_net_conf($o->{net});
800 };
801 log::l("summaryBefore: network configuration: ", formatError($@)) if $@;
802 }
803
804 sub summary_prompt {
805 my ($o, $l, $check_complete) = @_;
806
807 foreach (@$l) {
808 my $val = $_->{val};
809 ($_->{format}, $_->{val}) = (sub { $val && $val->() || N("not configured") }, '');
810 }
811
812 $o->ask_from_({
813 messages => N("Summary"),
814 interactive_help_id => 'summary',
815 cancel => '',
816 callbacks => { complete => sub { !$check_complete->() } },
817 }, $l);
818 }
819
820 sub summary {
821 my ($o) = @_;
822
823 my @l;
824
825 my $timezone_manually_set;
826 push @l, {
827 group => N("System"),
828 label => N("Timezone"),
829 val => sub { $o->{timezone}{timezone} },
830 clicked => sub { $timezone_manually_set = $o->configureTimezone(1) || $timezone_manually_set },
831 };
832 push @l, {
833 group => N("System"),
834 label => N("Country / Region"),
835 val => sub { lang::c2name($o->{locale}{country}) },
836 clicked => sub {
837 any::selectCountry($o, $o->{locale}) or return;
838
839 my $pkg_locale = lang::locale_to_main_locale(lang::getlocale_for_country($o->{locale}{lang}, $o->{locale}{country}));
840 my @pkgs = URPM::packages_providing($o->{packages}, "locales-$pkg_locale");
841 $o->pkg_install(map { $_->name } @pkgs) if @pkgs;
842
843 lang::write_and_install($o->{locale}, $o->do_pkgs);
844 if (!$timezone_manually_set) {
845 delete $o->{timezone};
846 install::any::preConfigureTimezone($o); #- now we can precise the timezone thanks to the country
847 }
848 },
849 };
850 push @l, {
851 group => N("System"),
852 label => N("Bootloader"),
853 val => sub {
854
855 $o->{bootloader}{boot} ?
856 #-PO: example: lilo-graphic on /dev/hda1
857 N("%s on %s", $o->{bootloader}{method}, $o->{bootloader}{boot}) : N("None");
858 },
859 clicked => sub {
860 any::setupBootloader($o, $o->{bootloader}, $o->{all_hds}, $o->{fstab}, $o->{security}) or return;
861 },
862 } if !$::local_install;
863
864 push @l, {
865 group => N("System"),
866 label => N("User management"),
867 clicked => sub {
868 if (my $u = any::ask_user($o, $o->{users}, $o->{security}, needauser => 1)) {
869 any::add_users([$u], $o->{authentication});
870 }
871 },
872 };
873
874 push @l, {
875 group => N("System"),
876 label => N("Services"),
877 val => sub {
878 require services;
879 my ($l, $activated) = services::services();
880 N("%d activated for %d registered", int(@$activated), int(@$l));
881 },
882 clicked => sub {
883 require services;
884 $o->{services} = services::ask($o) and services::doit($o, $o->{services});
885 },
886 };
887
888 push @l, {
889 group => N("Hardware"),
890 label => N("Keyboard"),
891 val => sub { $o->{keyboard} && translate(keyboard::keyboard2text($o->{keyboard})) },
892 clicked => sub { $o->selectKeyboard(1) },
893 };
894
895 push @l, {
896 group => N("Hardware"),
897 label => N("Mouse"),
898 val => sub { translate($o->{mouse}{type}) . ' ' . translate($o->{mouse}{name}) },
899 clicked => sub { selectMouse($o, 1); mouse::write($o->do_pkgs, $o->{mouse}) },
900 };
901
902
903 my @sound_cards = detect_devices::getSoundDevices();
904
905 my $sound_index = 0;
906 foreach my $device (@sound_cards) {
907 $device->{sound_slot_index} = $sound_index;
908 push @l, {
909 group => N("Hardware"),
910 label => N("Sound card"),
911 val => sub {
912 $device->{driver} && modules::module2description($device->{driver}) || $device->{description};
913 },
914 clicked => sub {
915 require harddrake::sound;
916 harddrake::sound::config($o, $o->{modules_conf}, $device);
917 },
918 };
919 $sound_index++;
920 }
921
922 if (!@sound_cards && ($o->{rpmsrate_flags_chosen}{CAT_GAMES} || $o->{rpmsrate_flags_chosen}{CAT_AUDIO})) {
923 #- if no sound card are detected AND the user selected things needing a sound card,
924 #- propose a special case for ISA cards
925 push @l, {
926 group => N("Hardware"),
927 label => N("Sound card"),
928 val => sub {},
929 clicked => sub {
930 if ($o->ask_yesorno('', N("Do you have an ISA sound card?"))) {
931 $o->do_pkgs->install(qw(alsa-utils sndconfig aoss));
932 $o->ask_warn('', N("Run \"alsaconf\" or \"sndconfig\" after installation to configure your sound card"));
933 } else {
934 $o->ask_warn('', N("No sound card detected. Try \"harddrake\" after installation"));
935 }
936 },
937 };
938 }
939
940 push @l, {
941 group => N("Hardware"),
942 label => N("Graphical interface"),
943 val => sub { $o->{raw_X} ? Xconfig::various::to_string($o->{raw_X}) : '' },
944 clicked => sub { configureX($o, 'expert') },
945 };
946
947 push @l, {
948 group => N("Network & Internet"),
949 label => N("Network"),
950 val => sub { $o->{net}{type} },
951 clicked => sub {
952 require network::netconnect;
953 network::netconnect::real_main($o->{net}, $o, $o->{modules_conf});
954 },
955 };
956
957 $o->{miscellaneous} ||= {};
958 push @l, {
959 group => N("Network & Internet"),
960 label => N("Proxies"),
961 val => sub { $o->{miscellaneous}{http_proxy} || $o->{miscellaneous}{ftp_proxy} ? N("configured") : N("not configured") },
962 clicked => sub {
963 require network::network;
964 network::network::miscellaneous_choose($o, $o->{miscellaneous});
965 network::network::proxy_configure($o->{miscellaneous}) if !$::testing;
966 },
967 };
968
969 push @l, {
970 group => N("Security"),
971 label => N("Security Level"),
972 val => sub {
973 require security::level;
974 security::level::to_string($o->{security});
975 },
976 clicked => sub {
977 require security::level;
978 my $security = $o->{security};
979 set_sec_level:
980 if (security::level::level_choose($o, \$security, \$o->{security_user})) {
981 check_security_level($o, $security) or goto set_sec_level;
982 $o->{security} = $security;
983 install::any::set_security($o);
984 }
985 },
986 };
987
988 push @l, {
989 group => N("Security"),
990 label => N("Firewall"),
991 val => sub {
992 require network::shorewall;
993 my $shorewall = network::shorewall::read();
994 $shorewall && !$shorewall->{disabled} ? N("activated") : N("disabled");
995 },
996 clicked => sub {
997 require network::drakfirewall;
998 if (my @rc = network::drakfirewall::main($o, $o->{security} < 1)) {
999 $o->{firewall_ports} = !$rc[0] && $rc[1];
1000 }
1001 },
1002 } if detect_devices::get_net_interfaces();
1003
1004 my $check_complete = sub {
1005 require install::pkgs;
1006 my $p = install::pkgs::packageByName($o->{packages}, 'task-x11');
1007 $o->{raw_X} || !$::testing && $p && !$p->flag_installed ||
1008 $o->ask_yesorno('', N("You have not configured X. Are you sure you really want this?"));
1009 };
1010
1011 $o->summary_prompt(\@l, $check_complete);
1012
1013 any::installBootloader($o, $o->{bootloader}, $o->{all_hds}) if !$::local_install;
1014 install::steps::configureTimezone($o) if !$timezone_manually_set; #- do not forget it.
1015 }
1016
1017 #------------------------------------------------------------------------------
1018 #-setRootPassword_addUser
1019 #------------------------------------------------------------------------------
1020 sub setRootPassword_addUser {
1021 my ($o) = @_;
1022 $o->{users} ||= [];
1023
1024 my $sup = $o->{superuser} ||= {};
1025 $sup->{password2} ||= $sup->{password} ||= "";
1026
1027 any::ask_user_and_root($o, $sup, $o->{users}, $o->{security});
1028
1029 install::steps::setRootPassword($o);
1030 install::steps::addUser($o);
1031 }
1032
1033 #------------------------------------------------------------------------------
1034 sub setupBootloaderBefore {
1035 my ($o) = @_;
1036 local $o->{pop_wait_messages} = 1;
1037 my $_w = $o->wait_message(N("Preparing bootloader..."), N("Preparing initial startup program...") . "\n" .
1038 N("Be patient, this may take a while...")
1039 );
1040 $o->SUPER::setupBootloaderBefore;
1041 }
1042
1043 #------------------------------------------------------------------------------
1044 sub setupBootloader {
1045 my ($o) = @_;
1046 if (arch() =~ /ppc/) {
1047 if (detect_devices::get_mac_generation() !~ /NewWorld/ &&
1048 detect_devices::get_mac_model() !~ /IBM/) {
1049 $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}));
1050 log::l("OldWorld or Unknown Machine - no yaboot setup");
1051 return;
1052 }
1053 }
1054 {
1055 any::setupBootloader_simple($o, $o->{bootloader}, $o->{all_hds}, $o->{fstab}, $o->{security}) or return;
1056 }
1057 }
1058
1059 sub check_security_level {
1060 my ($o, $security) = @_;
1061 if ($security > 3 && find { $_->{fs_type} eq 'vfat' } @{$o->{fstab}}) {
1062 $o->ask_okcancel('', N("In this security level, access to the files in the Windows partition is restricted to the administrator.")) or return 0;
1063 }
1064 return 1;
1065 }
1066
1067 sub miscellaneous {
1068 my ($o, $_clicked) = @_;
1069
1070 install::steps::miscellaneous($o);
1071 }
1072
1073 #------------------------------------------------------------------------------
1074 sub configureX {
1075 my ($o, $expert) = @_;
1076
1077 install::steps::configureXBefore($o);
1078 symlink "$::prefix/etc/gtk", "/etc/gtk";
1079
1080 require Xconfig::main;
1081 my ($raw_X) = Xconfig::main::configure_everything_or_configure_chooser($o, install::any::X_options_from_o($o), !$expert, $o->{keyboard}, $o->{mouse});
1082 if ($raw_X) {
1083 $o->{raw_X} = $raw_X;
1084 install::steps::configureXAfter($o);
1085 }
1086 }
1087
1088 #------------------------------------------------------------------------------
1089 sub generateAutoInstFloppy {
1090 my ($o, $replay) = @_;
1091 my $img = install::any::getAndSaveAutoInstallFloppies($o, $replay) or return;
1092
1093 my $floppy = detect_devices::floppy();
1094 $o->ask_okcancel('', N("Insert a blank floppy in drive %s", $floppy), 1) or return;
1095
1096 my $_w = $o->wait_message('', N("Creating auto install floppy..."));
1097 require install::commands;
1098 install::commands::dd("if=$img", 'of=' . devices::make($floppy));
1099 common::sync();
1100 }
1101
1102 #------------------------------------------------------------------------------
1103 sub exitInstall {
1104 my ($o, $alldone) = @_;
1105
1106 return $o->{step} = '' if !$alldone && !$o->ask_yesorno(N("Warning"),
1107 N("Some steps are not completed.
1108
1109 Do you really want to quit now?"), 0);
1110
1111 install::steps::exitInstall($o);
1112
1113 $o->exit unless $alldone;
1114
1115 $o->ask_from_no_check(
1116 {
1117 title => N("Congratulations"),
1118 messages => formatAlaTeX(messages::install_completed()),
1119 interactive_help_id => 'exitInstall',
1120 ok => $::local_install ? N("Quit") : N("Reboot"),
1121 }, []) if $alldone;
1122 }
1123
1124
1125 #-######################################################################################
1126 #- Misc Steps Functions
1127 #-######################################################################################
1128
1129 1;

  ViewVC Help
Powered by ViewVC 1.1.28