From 75bcbea29b0dba1954344cc78b9ecb75e5007bfa Mon Sep 17 00:00:00 2001 From: Pascal Rigaux Date: Thu, 30 Mar 2000 23:25:44 +0000 Subject: no_comment --- perl-install/Makefile.config | 2 +- perl-install/any.pm | 119 ++++++++++++++++++++++++++++++ perl-install/c/stuff.xs.pm | 4 +- perl-install/detect_devices.pm | 2 +- perl-install/g_auto_install | 2 +- perl-install/install_steps.pm | 2 +- perl-install/install_steps_gtk.pm | 2 +- perl-install/install_steps_interactive.pm | 115 +---------------------------- perl-install/modules.pm | 1 - perl-install/standalone/adduserdrake | 2 +- perl-install/standalone/diskdrake | 4 +- perl-install/standalone/drakboot | 42 +++++++++++ perl-install/standalone/drakxconf | 4 +- 13 files changed, 175 insertions(+), 126 deletions(-) create mode 100755 perl-install/standalone/drakboot (limited to 'perl-install') diff --git a/perl-install/Makefile.config b/perl-install/Makefile.config index 80ffaf36e..bfd64e562 100644 --- a/perl-install/Makefile.config +++ b/perl-install/Makefile.config @@ -5,7 +5,7 @@ VERSION = 2.2.10-BOOT SUDO = sudo SO_FILES = c/blib/arch/auto/c/c.so PMS = *.pm Newt/*.pm c/stuff.pm resize_fat/*.pm pci_probing/*.pm commands install2 g_auto_install -STANDALONEPMS= diskdrake XFdrake mousedrake lspcidrake printerdrake keyboarddrake netdrake drakxconf drakxservices draksec adduserdrake rpmdrake +STANDALONEPMS= diskdrake XFdrake mousedrake lspcidrake printerdrake keyboarddrake netdrake drakxconf drakxservices draksec drakboot adduserdrake rpmdrake PMS += $(STANDALONEPMS:%=standalone/%) REP4PMS = /usr/bin/perl-install ROOTDEST = /export diff --git a/perl-install/any.pm b/perl-install/any.pm index b932c4831..735753809 100644 --- a/perl-install/any.pm +++ b/perl-install/any.pm @@ -9,6 +9,8 @@ use vars qw(@users); #-###################################################################################### use common qw(:common :system :file); use commands; +use detect_devices; +use fsedit; use run_program; #-PO: names (tie, curly...) have corresponding icons for kdm @@ -48,4 +50,121 @@ sub addUsers { run_program::rooted($prefix, "/etc/security/msec/init-sh/grpuser.sh --refresh"); } +sub setupBootloader { + my ($in, $b, $hds, $fstab, $security, $prefix, $more) = @_; + + $more++ if $b->{bootUnsafe}; + + if ($::beginner && $more == 1) { + my @l = (__("First sector of drive (MBR)"), __("First sector of boot partition")); + + $in->set_help('setupBootloaderBeginner') unless $::isStandalone; + my $boot = $hds->[0]{device}; + my $onmbr = "/dev/$boot" eq $b->{boot}; + $b->{boot} = "/dev/" . ($in->ask_from_list_(_("LILO Installation"), + _("Where do you want to install the bootloader?"), + \@l, $l[!$onmbr]) eq $l[0] + ? $boot : fsedit::get_root($fstab, 'boot')->{device}); + } elsif ($more || !$::beginner) { + $in->set_help("setupBootloaderGeneral") unless $::isStandalone; + + $::expert and $in->ask_yesorno('', _("Do you want to use LILO?"), 1) || return; + + my @l = ( +_("Boot device") => { val => \$b->{boot}, list => [ map { "/dev/$_" } (map { $_->{device} } @$hds, @$fstab), detect_devices::floppies() ], not_edit => !$::expert }, +_("LBA (doesn't work on old BIOSes)") => { val => \$b->{lba32}, type => "bool", text => "lba" }, +_("Compact") => { val => \$b->{compact}, type => "bool", text => _("compact") }, +_("Delay before booting default image") => \$b->{timeout}, +_("Video mode") => { val => \$b->{vga}, list => [ keys %lilo::vga_modes ], not_edit => $::beginner }, +$security < 4 ? () : ( +_("Password") => { val => \$b->{password}, hidden => 1 }, +_("Password (again)") => { val => \$b->{password2}, hidden => 1 }, +_("Restrict command line options") => { val => \$b->{restricted}, type => "bool", text => _("restrict") }, +) + ); + @l = @l[0..3] unless $::expert; + + $b->{vga} ||= 'Normal'; + $in->ask_from_entries_refH('', _("LILO main options"), \@l, + complete => sub { +#- $security > 4 && length($b->{password}) < 6 and $in->ask_warn('', _("At this level of security, a password (and a good one) in lilo is requested")), return 1; + $b->{restricted} && !$b->{password} and $in->ask_warn('', _("Option ``Restrict command line options'' is of no use without a password")), return 1; + $b->{password} eq $b->{password2} or !$b->{restricted} or $in->ask_warn('', [ _("The passwords do not match"), _("Please try again") ]), return 1; + 0; + } + ) or return 0; + $b->{vga} = $lilo::vga_modes{$b->{vga}} || $b->{vga}; + } + + until ($::beginner && $more <= 1) { + $in->set_help('setupBootloaderAddEntry') unless $::isStandalone; + my $c = $in->ask_from_list_([''], +_("Here are the following entries in LILO. +You can add some more or change the existing ones."), + [ (sort @{[map { "$_->{label} ($_->{kernel_or_dev})" . ($b->{default} eq $_->{label} && " *") } @{$b->{entries}}]}), __("Add"), __("Done") ], + ); + $c eq "Done" and last; + + my ($e); + + if ($c eq "Add") { + my @labels = map { $_->{label} } @{$b->{entries}}; + my $prefix; + if ($in->ask_from_list_('', _("Which type of entry do you want to add"), [ __("Linux"), __("Other OS (windows...)") ]) eq "Linux") { + $e = { type => 'image' }; + $prefix = "linux"; + } else { + $e = { type => 'other' }; + $prefix = "windows"; + } + $e->{label} = $prefix; + for (my $nb = 0; member($e->{label}, @labels); $nb++) { $e->{label} = "$prefix-$nb" } + } else { + $c =~ /(\S+)/; + ($e) = grep { $_->{label} eq $1 } @{$b->{entries}}; + } + my %old_e = %$e; + my $default = my $old_default = $e->{label} eq $b->{default}; + + my @l; + if ($e->{type} eq "image") { + @l = ( +_("Image") => { val => \$e->{kernel_or_dev}, list => [ eval { glob_("/boot/vmlinuz*") } ] }, +_("Root") => { val => \$e->{root}, list => [ map { "/dev/$_->{device}" } @$fstab ], not_edit => !$::expert }, +_("Append") => \$e->{append}, +_("Initrd") => { val => \$e->{initrd}, list => [ eval { glob_("/boot/initrd*") } ] }, +_("Read-write") => { val => \$e->{'read-write'}, type => 'bool' } + ); + @l = @l[0..5] unless $::expert; + } else { + @l = ( +_("Root") => { val => \$e->{kernel_or_dev}, list => [ map { "/dev/$_->{device}" } @$fstab ], not_edit => !$::expert }, +_("Table") => { val => \$e->{table}, list => [ '', map { "/dev/$_->{device}" } @$hds ], not_edit => !$::expert }, +_("Unsafe") => { val => \$e->{unsafe}, type => 'bool' } + ); + @l = @l[0..1] unless $::expert; + } + @l = ( +_("Label") => \$e->{label}, +@l, +_("Default") => { val => \$default, type => 'bool' }, + ); + + if ($in->ask_from_entries_refH($c eq "Add" ? '' : ['', _("Ok"), _("Remove entry")], + '', \@l, + complete => sub { + $e->{label} or $in->ask_warn('', _("Empty label not allowed")), return 1; + member($e->{label}, map { $_->{label} } grep { $_ != $e } @{$b->{entries}}) and $in->ask_warn('', _("This label is already in use")), return 1; + 0; + })) { + $b->{default} = $old_default || $default ? $default && $e->{label} : $b->{default}; + + push @{$b->{entries}}, $e if $c eq "Add"; + } else { + @{$b->{entries}} = grep { $_ != $e } @{$b->{entries}}; + } + } + 1; +} + 1; diff --git a/perl-install/c/stuff.xs.pm b/perl-install/c/stuff.xs.pm index 6b1fdd732..4ed85484a 100644 --- a/perl-install/c/stuff.xs.pm +++ b/perl-install/c/stuff.xs.pm @@ -125,8 +125,8 @@ total_sectors(fd) int fd CODE: { - struct hd_driveid s; - RETVAL = ioctl(fd, HDIO_GET_IDENTITY, &s) == 0 ? s.lba_capacity : 0; + long s; + RETVAL = ioctl(fd, BLKGETSIZE, &s) == 0 ? s : 0; } OUTPUT: RETVAL diff --git a/perl-install/detect_devices.pm b/perl-install/detect_devices.pm index 04cef1ccb..74e498d8d 100644 --- a/perl-install/detect_devices.pm +++ b/perl-install/detect_devices.pm @@ -67,7 +67,7 @@ sub hasSCSI() { foreach () { /devices: none/ and log::l("no scsi devices are available"), return 0; } - log::l("scsi devices are available"); +#- log::l("scsi devices are available"); 1; } sub hasIDE() { -e "/proc/ide" } diff --git a/perl-install/g_auto_install b/perl-install/g_auto_install index bcaf8ba8b..24185b6ae 100755 --- a/perl-install/g_auto_install +++ b/perl-install/g_auto_install @@ -6,7 +6,7 @@ $dir .= "/../../.."; $ENV{PERL5LIB} = join ":", map { "$dir/$_" } @INC; $ENV{LD_LIBRARY_PATH} = "$dir/usr/lib"; -$ENV{PATH} = join ":", map { "$dir/$_" } split ":", "/usr/bin:/bin:/sbin:/usr/sbin:/usr/X11R6/bin"; +$ENV{PATH} = join(":", map { "$dir/$_" } split ":", "/usr/bin:/bin:/sbin:/usr/sbin:/usr/X11R6/bin") . ":$ENV{PATH}"; $ENV{SHARE_PATH} = "$dir/usr/share"; exec "../perl", "./install2", "--g_auto_install", @ARGV or die; diff --git a/perl-install/install_steps.pm b/perl-install/install_steps.pm index 1108398a5..b22e8869a 100644 --- a/perl-install/install_steps.pm +++ b/perl-install/install_steps.pm @@ -682,7 +682,7 @@ sub setupBootloader($) { eval { lilo::install($o->{prefix}, $o->{bootloader}, $o->{fstab}) }; my $err = $@; eval { lilo::install_grub($o->{prefix}, $o->{bootloader}, $o->{fstab}, $o->{hds}) }; - die $err if $@; + die $err if $@ && $err; } } diff --git a/perl-install/install_steps_gtk.pm b/perl-install/install_steps_gtk.pm index 8aa06986e..7d572505f 100644 --- a/perl-install/install_steps_gtk.pm +++ b/perl-install/install_steps_gtk.pm @@ -414,7 +414,7 @@ sub choosePackagesTree { my ($root, $leaf); foreach (sort keys %{$packages->[0]}) { - $add_node->($_, 'all'); + $add_node->($_, 'all')->hide; } foreach (sort @$compss) { ($root, $leaf) = m|(.*)/(.+)|o or ($root, $leaf) = ('', $_); diff --git a/perl-install/install_steps_interactive.pm b/perl-install/install_steps_interactive.pm index d07466a94..007e6f378 100644 --- a/perl-install/install_steps_interactive.pm +++ b/perl-install/install_steps_interactive.pm @@ -113,7 +113,7 @@ sub selectInstallClass($@) { expert => _("Expert"), ); my $installClass = ${{reverse %c}}{$o->ask_from_list(_("Install Class"), - _("What installation class do you want?"), + _("Which installation class do you want?"), [ map { $c{$_} } @c ], $c{$o->{installClass}} || $c{beginner})}; $::expert = $installClass eq "expert"; $::beginner = $installClass eq "beginner"; @@ -689,7 +689,6 @@ failures. Would you like to create a bootdisk for your system?"), return $o->{mkbootdisk} = '' if $o->{mkbootdisk} eq 'Skip'; } - log::l(">>>> mkbootdisk $o->{mkbootdisk}, $l{$o->{mkbootdisk}}"); $o->ask_warn('', _("Insert a floppy in drive %s", $l{$o->{mkbootdisk}})); my $w = $o->wait_message('', _("Creating bootdisk")); install_steps::createBootdisk($o); @@ -698,119 +697,9 @@ failures. Would you like to create a bootdisk for your system?"), #------------------------------------------------------------------------------ sub setupLILO { my ($o, $more) = @_; - my $b = $o->{bootloader}; - - $more++ if $b->{bootUnsafe}; - - if ($::beginner && $more == 1) { - my @l = (__("First sector of drive (MBR)"), __("First sector of boot partition")); - - $o->set_help('setupBootloaderBeginner'); - my $boot = $o->{hds}[0]{device}; - my $onmbr = "/dev/$boot" eq $b->{boot}; - $b->{boot} = "/dev/" . ($o->ask_from_list_(_("LILO Installation"), - _("Where do you want to install the bootloader?"), - \@l, $l[!$onmbr]) eq $l[0] - ? $boot : fsedit::get_root($o->{fstab}, 'boot')->{device}); - } elsif ($more || !$::beginner) { - $o->set_help("setupBootloaderGeneral"); - - $::expert and $o->ask_yesorno('', _("Do you want to use LILO?"), 1) || return; - - my @l = ( -_("Boot device") => { val => \$b->{boot}, list => [ map { "/dev/$_" } (map { $_->{device} } @{$o->{hds}}, @{$o->{fstab}}), detect_devices::floppies ], not_edit => !$::expert }, -_("LBA (doesn't work on old BIOSes)") => { val => \$b->{lba32}, type => "bool", text => "lba" }, -_("Compact") => { val => \$b->{compact}, type => "bool", text => _("compact") }, -_("Delay before booting default image") => \$b->{timeout}, -_("Video mode") => { val => \$b->{vga}, list => [ keys %lilo::vga_modes ], not_edit => $::beginner }, -$o->{security} < 4 ? () : ( -_("Password") => { val => \$b->{password}, hidden => 1 }, -_("Password (again)") => { val => \$b->{password2}, hidden => 1 }, -_("Restrict command line options") => { val => \$b->{restricted}, type => "bool", text => _("restrict") }, -) - ); - @l = @l[0..3] unless $::expert; - $b->{vga} ||= 'Normal'; - $o->ask_from_entries_refH('', _("LILO main options"), \@l, - complete => sub { -#- $o->{security} > 4 && length($b->{password}) < 6 and $o->ask_warn('', _("At this level of security, a password (and a good one) in lilo is requested")), return 1; - $b->{restricted} && !$b->{password} and $o->ask_warn('', _("Option ``Restrict command line options'' is of no use without a password")), return 1; - $b->{password} eq $b->{password2} or !$b->{restricted} or $o->ask_warn('', [ _("The passwords do not match"), _("Please try again") ]), return 1; - 0; - } - ) or return; - $b->{vga} = $lilo::vga_modes{$b->{vga}} || $b->{vga}; - } - - until ($::beginner && $more <= 1) { - $o->set_help('setupBootloaderAddEntry'); - my $c = $o->ask_from_list_([''], -_("Here are the following entries in LILO. -You can add some more or change the existing ones."), - [ (sort @{[map { "$_->{label} ($_->{kernel_or_dev})" . ($b->{default} eq $_->{label} && " *") } @{$b->{entries}}]}), __("Add"), __("Done") ], - ); - $c eq "Done" and last; - - my ($e); - - if ($c eq "Add") { - my @labels = map { $_->{label} } @{$b->{entries}}; - my $prefix; - if ($o->ask_from_list_('', _("Which type of entry do you want to add"), [ __("Linux"), __("Other OS (windows...)") ]) eq "Linux") { - $e = { type => 'image' }; - $prefix = "linux"; - } else { - $e = { type => 'other' }; - $prefix = "windows"; - } - $e->{label} = $prefix; - for (my $nb = 0; member($e->{label}, @labels); $nb++) { $e->{label} = "$prefix-$nb" } - } else { - $c =~ /(\S+)/; - ($e) = grep { $_->{label} eq $1 } @{$b->{entries}}; - } - my %old_e = %$e; - my $default = my $old_default = $e->{label} eq $b->{default}; - - my @l; - if ($e->{type} eq "image") { - @l = ( -_("Image") => { val => \$e->{kernel_or_dev}, list => [ eval { glob_("/boot/vmlinuz*") } ] }, -_("Root") => { val => \$e->{root}, list => [ map { "/dev/$_->{device}" } @{$o->{fstab}} ], not_edit => !$::expert }, -_("Append") => \$e->{append}, -_("Initrd") => { val => \$e->{initrd}, list => [ eval { glob_("/boot/initrd*") } ] }, -_("Read-write") => { val => \$e->{'read-write'}, type => 'bool' } - ); - @l = @l[0..5] unless $::expert; - } else { - @l = ( -_("Root") => { val => \$e->{kernel_or_dev}, list => [ map { "/dev/$_->{device}" } @{$o->{fstab}} ], not_edit => !$::expert }, -_("Table") => { val => \$e->{table}, list => [ '', map { "/dev/$_->{device}" } @{$o->{hds}} ], not_edit => !$::expert }, -_("Unsafe") => { val => \$e->{unsafe}, type => 'bool' } - ); - @l = @l[0..1] unless $::expert; - } - @l = ( -_("Label") => \$e->{label}, -@l, -_("Default") => { val => \$default, type => 'bool' }, - ); + any::setupBootloader($o, $o->{bootloader}, $o->{hds}, $o->{fstab}, $o->{security}, $o->{prefix}, $more); - if ($o->ask_from_entries_refH($c eq "Add" ? '' : ['', _("Ok"), _("Remove entry")], - '', \@l, - complete => sub { - $e->{label} or $o->ask_warn('', _("Empty label not allowed")), return 1; - member($e->{label}, map { $_->{label} } grep { $_ != $e } @{$b->{entries}}) and $o->ask_warn('', _("This label is already in use")), return 1; - 0; - })) { - $b->{default} = $old_default || $default ? $default && $e->{label} : $b->{default}; - - push @{$b->{entries}}, $e if $c eq "Add"; - } else { - @{$b->{entries}} = grep { $_ != $e } @{$b->{entries}}; - } - } eval { $o->SUPER::setupBootloader }; if ($@) { $o->ask_warn('', diff --git a/perl-install/modules.pm b/perl-install/modules.pm index 2e3729d59..fc02afec3 100644 --- a/perl-install/modules.pm +++ b/perl-install/modules.pm @@ -374,7 +374,6 @@ sub load { my ($name, $type, @options) = @_; if ($::testing) { - print join ",", @options, "\n"; log::l("i try to install $name module (@options)"); } else { $conf{$name}{loaded} and return; diff --git a/perl-install/standalone/adduserdrake b/perl-install/standalone/adduserdrake index 7ead7679b..1d2eeb9c5 100755 --- a/perl-install/standalone/adduserdrake +++ b/perl-install/standalone/adduserdrake @@ -1,6 +1,6 @@ #!/usr/bin/perl -use lib qw(.); #/usr/lib/libDrakX); +use lib qw(/usr/lib/libDrakX); use common qw(:common :functional :system :file); use interactive; diff --git a/perl-install/standalone/diskdrake b/perl-install/standalone/diskdrake index 242f07c6d..6696f29f4 100755 --- a/perl-install/standalone/diskdrake +++ b/perl-install/standalone/diskdrake @@ -22,7 +22,7 @@ # DiskDrake is also based upon the libfdisk and the install from Red Hat Software -use lib "."; #qw(/usr/lib/libDrakX); +use lib qw(/usr/lib/libDrakX); use common qw(:common :functional); use diskdrake; use interactive_gtk; @@ -62,7 +62,7 @@ my $hds = I'll try to go on blanking bad partitions"), $err]); }; -$SIG{__DIE__} = sub { chomp $_[0]; log::l("ERROR: $_[0]") }; +$SIG{__DIE__} = sub { chomp (my $m = $_[0]); log::l("ERROR: $m") }; my $fstab = [ fsedit::get_fstab(@$hds) ]; fs::get_mntpoints_from_fstab($fstab); diff --git a/perl-install/standalone/drakboot b/perl-install/standalone/drakboot new file mode 100755 index 000000000..33af4079a --- /dev/null +++ b/perl-install/standalone/drakboot @@ -0,0 +1,42 @@ +#!/usr/bin/perl + +use lib qw(/usr/lib/libDrakX); + +use common qw(:system :file :functional); +use interactive; +use any; +use lilo; +use detect_devices; +use fsedit; +use c; + +local $_ = join '', @ARGV; + +/-h/ and die "usage: drakboot\n"; + +$::isStandalone = 1; + +my $in = vnew interactive('su'); + +my $bootloader = lilo::read('', '/etc/lilo.conf'); + +my $hds = catch_cdie { fsedit::hds([ detect_devices::hds() ], {}) } sub { 1 }; +my $fstab = [ fsedit::get_fstab(@$hds) ]; +fs::get_mntpoints_from_fstab($fstab); + +ask: +any::setupBootloader($in, $bootloader, $hds, $fstab, $ENV{SECURE_LEVEL}) or $in->exit(0); + +eval { lilo::install('', $bootloader) }; +my $err = $@; +eval { lilo::install_grub('', $bootloader, $fstab, $hds) }; + +if ($err && $@) { + $in->ask_warn('', + [ _("Installation of LILO failed. The following error occured:"), + grep { !/^Warning:/ } cat_("/tmp/.error") ]); + unlink "/tmp/.error"; + goto ask; +} + +$in->exit(0); diff --git a/perl-install/standalone/drakxconf b/perl-install/standalone/drakxconf index 8699b05a2..e4e4e9bd3 100755 --- a/perl-install/standalone/drakxconf +++ b/perl-install/standalone/drakxconf @@ -11,7 +11,7 @@ use c; local $_ = join '', @ARGV; -/-h/ and die "usage: draxconf\n"; +/-h/ and die "usage: drakxconf\n"; $::isStandalone = 1; @@ -20,7 +20,7 @@ my $in = vnew interactive('su'); my $choice = $in->ask_from_list("drakxconf", _("Choose the tool you want to use"), [ grep { my $prog = $_; int grep { -x "$_/$prog" } split ":", $ENV{PATH} } - qw(XFdrake adduserdrake diskdrake drakxservices keyboarddrake mousedrake netdrake printerdrake draksec) ]) or c::_exit(0); #- workaround for perl-GTK + qw(XFdrake adduserdrake diskdrake drakxservices keyboarddrake mousedrake netdrake printerdrake draksec drakboot) ]) or c::_exit(0); #- workaround for perl-GTK $in->end; -- cgit v1.2.1