summaryrefslogtreecommitdiffstats
path: root/perl-install
diff options
context:
space:
mode:
Diffstat (limited to 'perl-install')
-rw-r--r--perl-install/Makefile.config2
-rw-r--r--perl-install/any.pm119
-rw-r--r--perl-install/c/stuff.xs.pm4
-rw-r--r--perl-install/detect_devices.pm2
-rwxr-xr-xperl-install/g_auto_install2
-rw-r--r--perl-install/install_steps.pm2
-rw-r--r--perl-install/install_steps_gtk.pm2
-rw-r--r--perl-install/install_steps_interactive.pm115
-rw-r--r--perl-install/modules.pm1
-rwxr-xr-xperl-install/standalone/adduserdrake2
-rwxr-xr-xperl-install/standalone/diskdrake4
-rwxr-xr-xperl-install/standalone/drakboot42
-rwxr-xr-xperl-install/standalone/drakxconf4
13 files changed, 175 insertions, 126 deletions
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 (<F>) {
/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;
generated by cgit v1.2.1 (git 2.21.0) at 2024-07-02 23:28:16 +0000