no_comment

9 files changed, 133 insertions, 89 deletions

diff --git a/docs/TODO b/docs/TODO
index 8d1bcba03..6261f3851 100644
--- a/docs/TODO
+++ b/docs/TODO
@@ -11,6 +11,8 @@ look at the pcmcia case
 
 merge the install(1) of redhat
 
+lilo-deinstallation in case of lilo auto-installation for beginners
+
 in package choosing, the group (on the left) is no more `selected' (gtk focus) when clicking on a package (on the right)
 
 verify the free space is big enough.
diff --git a/perl-install/common.pm b/perl-install/common.pm
index e47df42d4..6d759420f 100644
--- a/perl-install/common.pm
+++ b/perl-install/common.pm
@@ -6,8 +6,8 @@ use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK $printable_chars $sizeof_int $bitof_int
 
 @ISA = qw(Exporter);
 %EXPORT_TAGS = (
-    common     => [ qw(__ min max sqr sum sign product bool listlength bool2text to_int to_float ikeys member divide is_empty_array_ref is_empty_hash_ref add2hash add2hash_ set_new set_add round round_up round_down first second top uniq translate untranslate warp_text formatAlaTeX) ],
-    functional => [ qw(fold_left compose map_index map_tab_hash mapn mapn_ difference2 before_leaving catch_cdie cdie) ],
+    common     => [ qw(__ even odd min max sqr sum sign product bool listlength bool2text to_int to_float ikeys member divide is_empty_array_ref is_empty_hash_ref add2hash add2hash_ set_new set_add round round_up round_down first second top uniq translate untranslate warp_text formatAlaTeX) ],
+    functional => [ qw(fold_left compose map_index grep_index map_tab_hash mapn mapn_ difference2 before_leaving catch_cdie cdie) ],
     file       => [ qw(dirname basename touch all glob_ cat_ chop_ mode) ],
     system     => [ qw(sync makedev unmakedev psizeof strcpy gettimeofday syscall_ crypt_ getVarsFromSh setVarsInSh) ],
     constant   => [ qw($printable_chars $sizeof_int $bitof_int $SECTORSIZE) ],
@@ -37,6 +37,8 @@ sub fold_left(&@) {
 sub _ { my $s = shift @_; sprintf translate($s), @_ }
 #-delete $main::{'_'};
 sub __ { $_[0] }
+sub even($) { $_[0] % 2 == 0 }
+sub odd($)  { $_[0] % 2 == 1 }
 sub min { fold_left { $a < $b ? $a : $b } @_ }
 sub max { fold_left { $a > $b ? $a : $b } @_ }
 sub sum { fold_left { $a + $b } @_ }
@@ -92,10 +94,13 @@ sub touch {
 
 sub map_index(&@) {
     my $f = shift;
-    my @l;
-    local $::i = 0;
-    foreach (@_) { push @l, &$f($::i); $::i++; }
-    @l;
+    my $v; local $::i = 0;
+    map { $v = &$f($::i); $::i++; $v } @_;
+}
+sub grep_index(&@) {
+    my $f = shift;
+    my $v; local $::i = 0;
+    grep { $v = &$f($::i); $::i++; $v } @_;
 }
 
 #- pseudo-array-hash :)
diff --git a/perl-install/detect_devices.pm b/perl-install/detect_devices.pm
index 60295f880..35a85dfc5 100644
--- a/perl-install/detect_devices.pm
+++ b/perl-install/detect_devices.pm
@@ -95,7 +95,7 @@ sub getIDE() {
     my @idi;
 
     #- Great. 2.2 kernel, things are much easier and less error prone.
-    foreach my $d (glob_('/proc/ide/hd*')) {
+    foreach my $d (sort @{[glob_('/proc/ide/hd*')]}) {
 	my ($t) = chop_(cat_("$d/media"));
 	my $type = $ {{disk => 'hd', cdrom => 'cdrom', tape => 'tape', floppy => 'fd'}}{$t} or next;
 	my ($info) = chop_(cat_("$d/model")); $info ||= "(none)";
diff --git a/perl-install/fs.pm b/perl-install/fs.pm
index fadb328a1..7379e6d2e 100644
--- a/perl-install/fs.pm
+++ b/perl-install/fs.pm
@@ -24,10 +24,9 @@ sub read_fstab($) {
     open F, $file or return;
 
     map {
-	my ($dev, $mntpoint, @l) = split;
+	my ($dev, @l) = split;
 	$dev =~ s,/(tmp|dev)/,,;
-	while (@l > 4) { $mntpoint .= " " . shift @l; }
-	{ device => $dev, mntpoint => $mntpoint, type => $l[0], options => $l[1] }
+	{ device => $dev, mntpoint => $l[0], type => $l[1], options => $l[2] }
     } <F>;
 }
 
diff --git a/perl-install/install2.pm b/perl-install/install2.pm
index c0a4e2178..ada8f5945 100644
--- a/perl-install/install2.pm
+++ b/perl-install/install2.pm
@@ -16,6 +16,7 @@ use help;
 use network;
 use lang;
 use keyboard;
+use lilo;
 use mouse;
 use fs;
 use fsedit;
@@ -30,7 +31,7 @@ use install_steps_graphical;
 use run_program;
 
 #-######################################################################################
-#- Steps  table
+#- Steps table
 #-######################################################################################
 my @installStepsFields = qw(text redoable onError needs entered reachable toBeDone help next done);
 my @installSteps = (
@@ -51,9 +52,9 @@ my @installSteps = (
   setRootPassword    => [ __("Set root password"), 1, 1, "formatPartitions" ],
   addUser            => [ __("Add a user"), 1, 1, "doInstallStep" ],
   createBootdisk     => [ __("Create bootdisk"), 1, 0, "doInstallStep" ],
-  setupBootloader    => [ __("Install bootloader"), 1, 1, "doInstallStep" ],
+  setupBootloader    => [ __("Install bootloader"), 1, 1],#, "doInstallStep" ],
   configureX         => [ __("Configure X"), 1, 0, "formatPartitions" ],
-  exitInstall        => [ __("Exit install"), 0, 0, "alldone" ],
+  exitInstall        => [ __("Exit install"), 0, 0 ],
 );
 
 my (%installSteps, %upgradeSteps, @orderedInstallSteps, @orderedUpgradeSteps);
@@ -113,7 +114,7 @@ my %suggestedPartitions = (
 #-the variable $default)
 #-#######################################################################################
 $o = $::o = {
-    bootloader => { onmbr => 1, linear => 0, message => 1, keytable => 1, timeout => 50 },
+#    bootloader => { linear => 0, message => 1, keytable => 1, timeout => 5, restricted => 0 },
     autoSCSI   => 0,
     mkbootdisk => 1, #- no mkbootdisk if 0 or undef,   find a floppy with 1
 #-    packages   => [ qw() ],
@@ -353,7 +354,9 @@ sub createBootdisk {
 
 #------------------------------------------------------------------------------
 sub setupBootloader {
-    $o->setupBootloader;
+    add2hash($o->{bootloader} ||= {}, lilo::read("$o->{prefix}/etc/lilo.conf"));
+    lilo::suggest($o->{prefix}, $o->{bootloader}, $o->{hds}, $o->{fstab}, install_any::kernelVersion());
+    $o->setupBootloader($_[1] > 1);
 }
 #------------------------------------------------------------------------------
 sub configureX {
@@ -361,7 +364,7 @@ sub configureX {
     $o->setupXfree if $o->{packages}{XFree86}{installed} || $clicked;
 }
 #------------------------------------------------------------------------------
-sub exitInstall { $o->exitInstall }
+sub exitInstall { $o->exitInstall(getNextStep() eq "exitInstall") }
 
 
 #-######################################################################################
@@ -471,6 +474,7 @@ sub main {
 	$clicked = 0;
 	while ($@) {
 	    local $_ = $@;
+	    $o->kill_action;
 	    /^setstep (.*)/ and $o->{step} = $1, $clicked = 1, redo MAIN;
 	    /^theme_changed$/ and redo MAIN;
 	    eval { $o->errorInStep($_) };
diff --git a/perl-install/install_any.pm b/perl-install/install_any.pm
index d8e5a48f8..d06f02d5c 100644
--- a/perl-install/install_any.pm
+++ b/perl-install/install_any.pm
@@ -6,7 +6,7 @@ use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK);
 
 @ISA = qw(Exporter);
 %EXPORT_TAGS = (
-    all => [ qw(versionString getNextStep spawnSync spawnShell addToBeDone) ],
+    all => [ qw(getNextStep spawnSync spawnShell addToBeDone) ],
 );
 @EXPORT_OK = map { @$_ } values %EXPORT_TAGS;
 
@@ -46,8 +46,8 @@ sub getFile($) {
     goto &getFile;
 }
 
-sub versionString {
-    local $_ = readlink("$::o->{prefix}/boot/vmlinuz") or die "I couldn't find the kernel package!";
+sub kernelVersion {
+    local $_ = readlink("$::o->{prefix}/boot/vmlinuz") or $::testing && "2.2.testversion" or die "I couldn't find the kernel package!";
     first(/vmlinuz-(.*)/);
 }
 
@@ -96,8 +96,8 @@ sub shells($) {
 sub getAvailableSpace {
     my ($o) = @_;
 
-    do { $_->{mntpoint} eq '/usr' and return $_->{size} << 9 } foreach @{$o->{fstab}};
-    do { $_->{mntpoint} eq '/'    and return $_->{size} << 9 } foreach @{$o->{fstab}};
+    do { $_->{mntpoint} eq '/usr' and return $_->{size} * 512 } foreach @{$o->{fstab}};
+    do { $_->{mntpoint} eq '/'    and return $_->{size} * 512 } foreach @{$o->{fstab}};
 
     if ($::testing) {
 	log::l("taking 200MB for testing");
diff --git a/perl-install/install_steps.pm b/perl-install/install_steps.pm
index f779268ca..d02e735aa 100644
--- a/perl-install/install_steps.pm
+++ b/perl-install/install_steps.pm
@@ -276,7 +276,7 @@ sub createBootdisk($) {
 
     return if $::testing;
 
-    lilo::mkbootdisk($o->{prefix}, versionString(), $dev);
+    lilo::mkbootdisk($o->{prefix}, install_any::kernelVersion(), $dev);
     $o->{mkbootdisk} = $dev;
 }
 
@@ -284,9 +284,8 @@ sub createBootdisk($) {
 sub setupBootloader($) {
     my ($o) = @_;
     return if $::g_auto_install;
-    my $versionString = versionString();
     $o->{bootloader}{keytable} = keyboard::kmap($o->{keyboard}) if $o->{bootloader}{keytable} eq "1";
-    lilo::install($o->{prefix}, $o->{hds}, $o->{fstab}, $versionString, $o->{bootloader});
+    lilo::install($o->{prefix}, $o->{bootloader});
 }
 
 #------------------------------------------------------------------------------
diff --git a/perl-install/install_steps_interactive.pm b/perl-install/install_steps_interactive.pm
index 59b92f90b..85ecce2b8 100644
--- a/perl-install/install_steps_interactive.pm
+++ b/perl-install/install_steps_interactive.pm
@@ -10,7 +10,7 @@ use vars qw(@ISA);
 #-######################################################################################
 #- misc imports
 #-######################################################################################
-use common qw(:common);
+use common qw(:common :functional);
 use partition_table qw(:types);
 use install_steps;
 use pci_probing::main;
@@ -529,31 +529,55 @@ failures. Would you like to create a bootdisk for your system?"), !$o->{mkbootdi
 }
 
 #------------------------------------------------------------------------------
-sub setupBootloader($) {
-    my ($o) = @_;
-    my @l = (__("First sector of drive"), __("First sector of boot partition"));
-
-    add2hash_($o->{bootloader}, { onmbr => lilo::suggest_onmbr($o->{hds}) });
+sub setupBootloader {
+    my ($o, $more) = @_;
+    my $b = $o->{bootloader} ||= {};
 
-    $o->{bootloader}{onmbr} =
-      $o->ask_from_list_(_("Lilo Installation"),
-			 _("Where do you want to install the bootloader?"),
-			 \@l,
-			 $l[!$o->{bootloader}{onmbr}]
-			) eq $l[0] unless $::beginner && $o->{bootloader}{onmbr};
+    if ($::beginner && !$more) {
+	my @l = (__("First sector of drive"), __("First sector of boot partition"));
 
-    lilo::suggest($o->{hds}, $o->{fstab}, $o->{bootloader});
+	$b->{onmbr} =
+	  $o->ask_from_list_(_("Lilo Installation"),
+			     _("Where do you want to install the bootloader?"),
+			     \@l,
+			     $l[!lilo::suggest_onmbr($o->{hds})]
+			    ) eq $l[0] unless $::beginner && $b->{onmbr};
+	
 
-    unless ($::beginner) {
-	my @entries = grep { $_->{liloLabel} } @{$o->{fstab}};
+    } else {
+	$::expert and $o->ask_yesorno('', _("Do you want to use lilo?")) || return;
+    
+	my @l = (
+_("Boot device") => { val => \$b->{boot}, list => [ map{ $_->{device} } @{$o->{hds}}, @{$o->{fstab}} ], not_edit => !$::expert },
+_("Linear (needed for some SCSI drives)") => { val => \$b->{linear}, type => "bool", text => _("linear") },
+_("Delay before choosing default choice") => \$b->{timeout},
+_("Video mode") => { val => \$b->{vga}, list => [ keys %lilo::vga_modes ], not_edit => $::beginner },
+_("Password") => { val => \$b->{password}, hidden => 1 },
+_("Restrict command line options") => { val => \$b->{restricted}, type => "bool", text => _("restrict") },
+	);
+	@l = @l[0..3] if $::beginner;
+
+	$b->{vga} ||= 'Normal';
+	$o->ask_from_entries_ref('',
+				 _("Lilo main options"), 
+				 [ grep_index { even($::i) } @l ],
+				 [ grep_index {  odd($::i) } @l ],
+				 complete => sub {
+				     $b->{restricted} && !$b->{password} and $o->ask_warn('', _("Option ``Restrict command line options'' is of no use without a password")), return 1;
+				     0;
+				 }
+				) or return;
+	$b->{vga} = $lilo::vga_modes{$b->{vga}} || $b->{vga};
+    }
 
+    unless ($::beginner && !$more) {
 	$o->ask_from_entries_ref('',
 _("The boot manager Mandrake uses can boot other
 operating systems as well. You need to tell me
 what partitions you would like to be able to boot
 and what label you want to use for each of them."),
-				 [map {"$_->{device}" . type2name($_->{type})} @entries],
-				 [map {\$_->{liloLabel}} @entries],
+				 [ keys %{$b->{entries}} ],
+				 [ map { \$_->{label} } values %{$b->{entries}} ],
 				);
     }
     my $w = $o->wait_message('', _("Installing bootloader"));
@@ -562,9 +586,14 @@ and what label you want to use for each of them."),
 
 #------------------------------------------------------------------------------
 sub exitInstall {
-    my ($o) = @_;
+    my ($o, $alldone) = @_;
+
+    return $o->{step} = '' unless $alldone || $o->ask_yesorno('', 
+_("Some steps are not completed
+Do you really want to quit now?"), 0);
+
     $o->ask_warn('',
-		 _("Congratulations, installation is complete.
+_("Congratulations, installation is complete.
 Remove the boot media and press return to reboot.
 For information on fixes which are available for this release of Linux Mandrake,
 consult the Errata available from http://www.linux-mandrake.com/.
diff --git a/perl-install/interactive_gtk.pm b/perl-install/interactive_gtk.pm
index 253b7ef1c..f730cc2e6 100644
--- a/perl-install/interactive_gtk.pm
+++ b/perl-install/interactive_gtk.pm
@@ -79,43 +79,53 @@ sub ask_from_entries_refW {
     my $num_fields = @{$l};
     my $ignore = 0; #-to handle recursivity
 
-    my $w       = my_gtk->new($title, %$o);
+    my $w = my_gtk->new($title, %$o);
     #-the widgets
-    my @entries = map {
+    my @widgets = map {
 	if ($_->{type} eq "list") {
-	    my $depth_combo = new Gtk::Combo;
-	    $depth_combo->set_use_arrows_always(1);
-	    $depth_combo->entry->set_editable(!$_->{not_edit});
-	    $depth_combo->set_popdown_strings(@{$_->{list}});
-	    $depth_combo->disable_activate;
+	    my $w = new Gtk::Combo;
+	    $w->set_use_arrows_always(1);
+	    $w->entry->set_editable(!$_->{not_edit});
+	    $w->set_popdown_strings(@{$_->{list}});
+	    $w->disable_activate;
 	    $_->{val} ||= $_->{list}[0];
-	    $depth_combo;
+	    $w;
+	} elsif ($_->{type} eq "bool") {
+	    my $w = Gtk::CheckButton->new($_->{text});
+	    $w->set_active(${$_->{val}});
+	    my $i = $_; $w->signal_connect(clicked => sub { $ignore or ${$i->{val}} = !${$i->{val}} });
+	    $w;
 	} else {
 	    new Gtk::Entry;
 	}
     } @{$val};
     my $ok      = $w->create_okcancel;
 
-    sub comb_entry {
-	my ($entry, $ref) = @_;
-	($ref->{type} eq "list" && @{$ref->{list}}) ? $entry->entry : $entry
+    sub widget {
+	my ($w, $ref) = @_;
+	($ref->{type} eq "list" && @{$ref->{list}}) ? $w->entry : $w
     }
-
     my @updates = mapn {
-	my ($entry, $ref) = @_;
-	sub { ${$ref->{val}} = comb_entry($entry, $ref)->get_text };
-    } \@entries, $val;
+	my ($w, $ref) = @_;
+	sub {
+	    $ref->{type} eq "bool" and return;
+	    ${$ref->{val}} = widget($w, $ref)->get_text;
+	};
+    } \@widgets, $val;
 
     my @updates_inv = mapn {
-	my ($entry, $ref) = @_;
-	sub { comb_entry($entry, $ref)->set_text(${$ref->{val}})
+	my ($w, $ref) = @_;
+	sub { 
+	    $ref->{type} eq "bool" ? 
+	      $w->set_active(${$ref->{val}}) :
+	      widget($w, $ref)->set_text(${$ref->{val}})
 	};
-    } \@entries, $val;
+    } \@widgets, $val;
 
 
     for (my $i = 0; $i < $num_fields; $i++) {
 	my $ind = $i; #-cos lexical bindings pb !!
-	my $entry = comb_entry($entries[$i], $val->[$i]);
+	my $widget = widget($widgets[$i], $val->[$i]);
 	my $changed_callback = sub {
 	    return if $ignore; #-handle recursive deadlock
 	    &{$updates[$ind]};
@@ -133,38 +143,34 @@ sub ask_from_entries_refW {
 		&{$hcallback{focus_out}}($ind);
 		#update all the value
 		$ignore = 1;
-		foreach (@updates_inv) { &{$_};}
+		&$_ foreach @updates_inv;
 		$ignore = 0;
 	    };
-	    $entry->signal_connect(focus_out_event => $focusout_callback);
+	    $widget->signal_connect(focus_out_event => $focusout_callback);
 	}
-	$entry->signal_connect(changed => $changed_callback);
-	my $go_to_next = sub {
-	    if ($ind == ($num_fields -1)) {
-		$w->{ok}->grab_focus();
-	    } else {
-		comb_entry($entries[$ind+1],$val->[$ind+1])->grab_focus();
-	    }
-	};
-	$entry->signal_connect(activate => $go_to_next);
-	$entry->signal_connect(key_press_event => sub {
-	   my ($w, $e) = @_;
-	   my $c = chr $e->{keyval};
-	   if ($c eq "\x8d")
-	     {
-		 #-don't know why it works, i believe that
-		 #-i must say before &$go_to_next, but with it doen't work HACK!
-		 $w->signal_emit_stop("key_press_event");
-	     }
-	    ;
+	if (ref $widget eq "Gtk::Entry") {
+	    $widget->signal_connect(changed => $changed_callback);
+	    my $go_to_next = sub {
+		if ($ind == ($num_fields -1)) {
+		    $w->{ok}->grab_focus();
+		} else {
+		    widget($widgets[$ind+1],$val->[$ind+1])->grab_focus();
+		}
+	    };
+	    $widget->signal_connect(activate => $go_to_next);
+	    $widget->signal_connect(key_press_event => sub {
+		my ($w, $e) = @_;
+		#-don't know why it works, i believe that
+		#-i must say before &$go_to_next, but with it doen't work HACK!
+		$w->signal_emit_stop("key_press_event") if chr($e->{keyval}) eq "\x8d";
 	    });
-
-	$entry->set_text(${$val->[$i]{val}})  if ${$val->[$i]{val}};
-	$entry->set_visibility(0) if $val->[$i]{hidden};
+	    $widget->set_text(${$val->[$i]{val}})  if ${$val->[$i]{val}};
+	    $widget->set_visibility(0) if $val->[$i]{hidden};
+	}
 	&{$updates[$i]};
     }
 
-    my @entry_list = mapn { [($_[0], $_[1])]} $l, \@entries;
+    my @entry_list = mapn { [($_[0], $_[1])]} $l, \@widgets;
 
     gtkadd($w->{window},
 	   gtkpack(
@@ -172,7 +178,7 @@ sub ask_from_entries_refW {
 		   create_packtable({}, @entry_list),
 		   $ok
 		   ));
-    comb_entry($entries[0],$val->[0])->grab_focus();
+    widget($widgets[0],$val->[0])->grab_focus();
     if ($hcallback{complete}) {
 	my $callback = sub {
 	    my ($error, $focus) = &{$hcallback{complete}};
@@ -182,7 +188,7 @@ sub ask_from_entries_refW {
 	    $ignore = 0;
 	    if ($error) {
 		$focus ||= 0;
-		comb_entry($entries[$focus], $val->[$focus])->grab_focus();
+		widget($widgets[$focus], $val->[$focus])->grab_focus();
 	    } else {
 		return 1;
 	    }