summaryrefslogtreecommitdiffstats
path: root/perl-install
diff options
context:
space:
mode:
authorPascal Rigaux <pixel@mandriva.com>1999-07-02 09:25:48 +0000
committerPascal Rigaux <pixel@mandriva.com>1999-07-02 09:25:48 +0000
commit755e511024f29df150d9d150d19c849e59c1e216 (patch)
tree008a780c08366ce366c55cc3bbe0d49703f544d6 /perl-install
parente82688c8b8f639705356d25c180ffe754c2b2c34 (diff)
downloaddrakx-backup-do-not-use-755e511024f29df150d9d150d19c849e59c1e216.tar
drakx-backup-do-not-use-755e511024f29df150d9d150d19c849e59c1e216.tar.gz
drakx-backup-do-not-use-755e511024f29df150d9d150d19c849e59c1e216.tar.bz2
drakx-backup-do-not-use-755e511024f29df150d9d150d19c849e59c1e216.tar.xz
drakx-backup-do-not-use-755e511024f29df150d9d150d19c849e59c1e216.zip
*** empty log message ***
Diffstat (limited to 'perl-install')
-rw-r--r--perl-install/commands.pm38
-rw-r--r--perl-install/fsedit.pm19
-rw-r--r--perl-install/install2.pm13
-rw-r--r--perl-install/install_steps.pm58
-rw-r--r--perl-install/keyboard.pm11
-rw-r--r--perl-install/modules.pm2
-rw-r--r--perl-install/my_gtk.pm30
7 files changed, 85 insertions, 86 deletions
diff --git a/perl-install/commands.pm b/perl-install/commands.pm
index 8448a9f24..17f4b2580 100644
--- a/perl-install/commands.pm
+++ b/perl-install/commands.pm
@@ -246,25 +246,25 @@ sub cp {
&$cp(@_);
}
-sub ps {
- @_ and die "usage: ps\n";
- my ($pid, $cmd);
-
- local (*STDOUT_TOP, *STDOUT);
- format STDOUT_TOP =
- PID CMD
-.
- format =
-@>>>> @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-$pid, $cmd
-.
-
- foreach $pid (sort {$a <=> $b} grep { /\d+/ } all('/proc')) {
- (($cmd) = cat_("/proc/$pid/cmdline")) =~ s/\0/ /g;
- $cmd ||= (split ' ', (cat_("/proc/$pid/stat"))[0])[1];
- write STDOUT
- }
-}
+#sub ps {
+# @_ and die "usage: ps\n";
+# my ($pid, $cmd);
+#
+# local (*STDOUT_TOP, *STDOUT);
+# format STDOUT_TOP =
+# PID CMD
+#.
+# format =
+#@>>>> @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+#$pid, $cmd
+#.
+#
+# foreach $pid (sort {$a <=> $b} grep { /\d+/ } all('/proc')) {
+# (($cmd) = cat_("/proc/$pid/cmdline")) =~ s/\0/ /g;
+# $cmd ||= (split ' ', (cat_("/proc/$pid/stat"))[0])[1];
+# write STDOUT
+# }
+#}
sub dd {
diff --git a/perl-install/fsedit.pm b/perl-install/fsedit.pm
index ecc13a79f..8687d694c 100644
--- a/perl-install/fsedit.pm
+++ b/perl-install/fsedit.pm
@@ -155,27 +155,28 @@ sub removeFromList($$$) {
sub allocatePartitions($$) {
my ($hds, $to_add) = @_;
my %free_sectors = map { $_->{device} => [1, $_->{totalsectors} ] } @$hds; # first sector is always occupied by the MBR
- my $remove = sub { removeFromList($_->{start}, $_->{start} + $_->{size}, $free_sectors{$_->{rootDevice}}) };
+ my $remove = sub { removeFromList($_[0]->{start}, $_[0]->{start} + $_[0]->{size}, $free_sectors{$_[0]->{rootDevice}}) };
my $success = 0;
- foreach (get_fstab(@$hds)) { &$remove(); }
+ foreach (get_fstab(@$hds)) { &$remove($_); }
FSTAB: foreach (@$to_add) {
+ my %e = %$_;
foreach my $hd (@$hds) {
my $v = $free_sectors{$hd->{device}};
for (my $i = 0; $i < @$v; $i += 2) {
my $size = $v->[$i + 1] - $v->[$i];
- $_->{size} > $size and next;
- $_->{start} = $v->[$i];
- $_->{rootDevice} = $hd->{device};
- partition_table::adjustStartAndEnd($hd, $_);
- &$remove();
- partition_table::add($hd, $_);
+ $e{size} > $size and next;
+ $e{start} = $v->[$i];
+ $e{rootDevice} = $hd->{device};
+ partition_table::adjustStartAndEnd($hd, \%e);
+ &$remove(\%e);
+ partition_table::add($hd, \%e);
$success++;
next FSTAB;
}
}
- log::ld("can't allocate partition $_->{mntpoint} of size $_->{size}, not enough room");
+ log::ld("can't allocate partition $e{mntpoint} of size $e{size}, not enough room");
}
$success;
}
diff --git a/perl-install/install2.pm b/perl-install/install2.pm
index 295d65a28..611addef3 100644
--- a/perl-install/install2.pm
+++ b/perl-install/install2.pm
@@ -14,7 +14,7 @@ use net;
use keyboard;
use fs;
use fsedit;
-use install_steps;
+use install_steps_graphical;
use install_methods;
use modules;
use partition_table qw(:types);
@@ -154,7 +154,7 @@ sub partitionDisks {
fs::format_part($_) if $_->{mntpoint} && isExt2($_) || isSwap($_);
}
}
- fs::mount_all($o->{fstab}, $o->{prefix});
+ fs::mount_all([ grep { isExt2($_) || isSwap($_) } @{$o->{fstab}} ], $o->{prefix});
}
sub findInstallFiles {
@@ -165,8 +165,6 @@ sub findInstallFiles {
sub choosePackages { $o->choosePackages($o->{packages}, $o->{comps}); }
sub doInstallStep {
- $testing and return 0;
-
$o->beforeInstallPackages;
$o->installPackages($o->{packages});
$o->afterInstallPackages;
@@ -209,9 +207,10 @@ sub main {
spawnSync();
eval { spawnShell() };
- $o->{prefix} = "/mnt";
+ $o->{prefix} = $testing ? "/tmp/test-perl-install" : "/mnt";
+ mkdir $o->{prefix}, 0755;
$o->{method} = install_methods->new('cdrom');
- $o = install_steps->new($o);
+ $o = install_steps_graphical->new($o);
$o->{lang} = $o->chooseLanguage;
@@ -229,7 +228,7 @@ sub main {
modules::read_conf("/tmp/conf.modules");
# make sure we don't pick up any gunk from the outside world
- $ENV{PATH} = "/usr/bin:/bin:/sbin:/usr/sbin:/mnt/sbin:/mnt/bin:/mnt/usr/sbin:/mnt/usr/bin";
+ $ENV{PATH} = "/usr/bin:/bin:/sbin:/usr/sbin:$o->{prefix}/sbin:$o->{prefix}/bin:$o->{prefix}/usr/sbin:$o->{prefix}/usr/bin";
$ENV{LD_LIBRARY_PATH} = "";
$o->{keyboard} = eval { keyboard::read("/tmp/keyboard") } || $default->{keyboard};
diff --git a/perl-install/install_steps.pm b/perl-install/install_steps.pm
index 897edd139..e97ea8e41 100644
--- a/perl-install/install_steps.pm
+++ b/perl-install/install_steps.pm
@@ -30,7 +30,6 @@ sub new($$) {
sub chooseLanguage($) {
$o->{default}->{lang}
}
-
sub selectInstallOrUpgrade($) {
$o->{default}->{isUpgrade} || 0;
}
@@ -59,7 +58,8 @@ sub choosePackages($$$) {
}
sub beforeInstallPackages($) {
- $o->{method}->prepareMedia($o->{fstab});
+
+ $o->{method}->prepareMedia($o->{prefix}, $o->{fstab}) unless $::testing;
foreach (qw(dev etc home mnt tmp var var/tmp var/lib var/lib/rpm)) {
mkdir "$o->{prefix}/$_", 0755;
@@ -70,12 +70,13 @@ sub beforeInstallPackages($) {
open F, "> $o->{prefix}/etc/hosts" or die "Failed to create etc/hosts: $!";
print F "127.0.0.1 localhost localhost.localdomain\n";
}
+
+ pkgs::init_db($o->{prefix}, $o->{isUpgrade});
}
sub installPackages($$) {
my ($o, $packages) = @_;
my $toInstall = [ grep { $_->{selected} } values %$packages ];
- pkgs::init_db($o->{prefix}, $o->{isUpgrade});
pkgs::install($o->{prefix}, $o->{method}, $toInstall, $o->{isUpgrade}, 0);
}
@@ -83,7 +84,7 @@ sub afterInstallPackages($) {
my ($o) = @_;
unless ($o->{isUpgrade}) {
- keyboard::write($o->{prefix}, $o->{keymap});
+ keyboard::write($o->{prefix}, $o->{keyboard});
lang::write($o->{prefix});
}
# why not?
@@ -122,8 +123,26 @@ sub finishNetworking($) {
sub timeConfig {}
sub servicesConfig {}
+sub setRootPassword($) {
+ my ($o) = @_;
+ my $p = $o->{prefix};
+ my $pw = $o->{default}->{rootPassword};
+ $pw = crypt_($pw);
+
+ my $f = "$p/etc/passwd";
+ my @lines = cat_($f, "failed to open file $f");
+
+ local *F;
+ open F, "> $f" or die "failed to write file $f: $!\n";
+ foreach (@lines) {
+ s/^root:.*?:/root:$pw:/;
+ print F $_;
+ }
+}
+
sub addUser($) {
my ($o) = @_;
+ my %u = %{$o->{default}->{user}};
my $p = $o->{prefix};
my $new_uid;
@@ -136,50 +155,31 @@ sub addUser($) {
#for ($new_gid = 500; member($new_gid, @gids); $new_gid++) {}
for ($new_gid = 500; getgrgid($new_gid); $new_gid++) {}
- my $homedir = "$p/home/$o->{user}->{name}";
+ my $homedir = "$p/home/$u{name}";
- my $pw = crypt_($o->{user}->{password});
+ my $pw = crypt_($u{password});
- $::testing and return;
local *F;
open F, ">> $p/etc/passwd" or die "can't append to passwd file: $!";
- print F "$o->{user}->{name}:$pw:$new_uid:$new_gid:$o->{user}->{realname}:/home/$o->{user}->{name}:$o->{user}->{shell}\n";
+ print F "$u{name}:$pw:$new_uid:$new_gid:$u{realname}:/home/$u{name}:$u{shell}\n";
open F, ">> $p/etc/group" or die "can't append to group file: $!";
- print F "$o->{user}->{name}::$new_gid:\n";
+ print F "$u{name}::$new_gid:\n";
eval { commands::cp("-f", "$p/etc/skel", $homedir) }; $@ and log::l("copying of skel failed: $@"), mkdir($homedir, 0750);
commands::chown_("-r", "$new_uid.$new_gid", $homedir);
}
sub createBootdisk($) {
- lilo::mkbootdisk($o->{prefix}, versionString()) if $o->{mkbootdisk} || $o->{default}->{mkbootdisk};
+ lilo::mkbootdisk($o->{prefix}, versionString()) if $o->{default}->{mkbootdisk};
}
sub setupBootloader($) {
my ($o) = @_;
my $versionString = versionString();
- log::l("installed kernel version $versionString");
- lilo::install($o->{prefix}, $o->{hds}, $o->{fstab}, $versionString, $o->{bootloader} || $o->{default}->{bootloader});
+ lilo::install($o->{prefix}, $o->{hds}, $o->{fstab}, $versionString, $o->{default}->{bootloader});
}
-sub setRootPassword($) {
- my ($o) = @_;
- my $p = $o->{prefix};
- my $pw = $o->{rootPassword};
- $pw = crypt_($pw);
-
- my @lines = cat_("$p/etc/passwd", 'die');
- $::testing and return;
- local *F;
- open F, "> $p/etc/passwd" or die "can't write in passwd: $!\n";
- foreach (@lines) {
- s/^root:.*?:/root:$pw:/;
- print F $_;
- }
-}
-
-
sub setupXfree {
my ($o) = @_;
my $x = $o->{default}->{Xserver} or return;
diff --git a/perl-install/keyboard.pm b/perl-install/keyboard.pm
index 267b0be95..bece2df93 100644
--- a/perl-install/keyboard.pm
+++ b/perl-install/keyboard.pm
@@ -5,6 +5,7 @@ use strict;
use vars qw($KMAP_MAGIC %defaultKeyboards %loadKeymap);
use common qw(:system :file);
+use run_program;
use log;
@@ -93,15 +94,7 @@ sub write($$) {
open F, ">$prefix/etc/sysconfig/keyboard" or die "failed to create keyboard configuration: $!";
print F "KEYTABLE=$keymap\n" or die "failed to write keyboard configuration: $!";
- # write default keymap
- if (fork) {
- wait;
- $? == 0 or die "dumpkeys failed";
- } else {
- chroot $prefix;
- CORE::system("/usr/bin/dumpkeys > /etc/sysconfig/console/default.kmap 2>/dev/null");
- exit($?);
- }
+ run_program::rooted($prefix, "dumpkeys > /etc/sysconfig/console/default.kmap") or die "dumpkeys failed";
}
sub read($) {
diff --git a/perl-install/modules.pm b/perl-install/modules.pm
index 9d722f0b3..8ccf611ca 100644
--- a/perl-install/modules.pm
+++ b/perl-install/modules.pm
@@ -210,7 +210,7 @@ sub load($;$$) {
load_raw($name, $type, $minor);
}
-sub unload($) { run_program::run("/bin/rmmod", $_[0]); }
+sub unload($) { run_program::run("rmmod", $_[0]); }
sub load_raw($$$@) {
my ($name, $type, $minor, @options) = @_;
diff --git a/perl-install/my_gtk.pm b/perl-install/my_gtk.pm
index 1205a7eda..7d92617ad 100644
--- a/perl-install/my_gtk.pm
+++ b/perl-install/my_gtk.pm
@@ -6,7 +6,7 @@ use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK);
@ISA = qw(Exporter);
%EXPORT_TAGS = (
- all => [ qw(ask_warn ask_yesorno ask_from_entry ask_from_list create_yesorno createScrolledWindow create_menu create_notebook create_packtable create_hbox create_adjustment gtksignal_connect gtkpack gtkpack_ gtkappend gtkadd gtkset_usize gtkset_justify gtkshow gtkdestroy) ],
+ all => [ qw(ask_warn ask_okcancel ask_yesorno ask_from_entry ask_from_list create_okcancel createScrolledWindow create_menu create_notebook create_packtable create_hbox create_adjustment gtksignal_connect gtkpack gtkpack_ gtkappend gtkadd gtkset_usize gtkset_justify gtkshow gtkdestroy) ],
);
@EXPORT_OK = map { @$_ } values %EXPORT_TAGS;
@@ -26,13 +26,17 @@ sub new {
$o->{window} = $o->_create_window($title);
$o;
}
-sub main($) {
- my $o = shift;
- $o->{window}->show;
- Gtk->main;
+sub main($;$) {
+ my ($o, $f) = @_;
+ $o->show;
+ do { Gtk->main } while ($o->{retval} && $f && !&$f());
$o->destroy;
$o->{retval}
}
+sub show($) {
+ my ($o) = @_;
+ $o->{window}->show;
+}
sub destroy($) {
my ($o) = @_;
$o->{window}->destroy;
@@ -114,12 +118,12 @@ sub gtkadd($@) {
# these functions return a widget
################################################################################
-sub create_yesorno($) {
- my ($w) = @_;
+sub create_okcancel($;$$) {
+ my ($w, $ok, $cancel) = @_;
gtkadd(create_hbox(),
- gtksignal_connect($w->{ok} = new Gtk::Button("Ok"), "clicked" => sub { $w->{retval} = 1; Gtk->main_quit }),
- gtksignal_connect(new Gtk::Button("Cancel"), "clicked" => sub { $w->{retval} = 0; Gtk->main_quit }),
+ gtksignal_connect($w->{ok} = new Gtk::Button($ok || "Ok"), "clicked" => sub { $w->{retval} = 1; Gtk->main_quit }),
+ gtksignal_connect(new Gtk::Button($cancel || "Cancel"), "clicked" => sub { $w->{retval} = 0; Gtk->main_quit }),
);
}
@@ -210,7 +214,8 @@ sub _create_window($$) {
################################################################################
sub ask_warn { my $w = my_gtk->new(shift @_); $w->_ask_warn(@_); main($w); }
-sub ask_yesorno { my $w = my_gtk->new(shift @_); $w->_ask_yesorno(@_, "Is it ok?"); main($w); }
+sub ask_yesorno { my $w = my_gtk->new(shift @_); $w->_ask_okcancel(@_, "Yes", "No"); main($w); }
+sub ask_okcancel { my $w = my_gtk->new(shift @_); $w->_ask_okcancel(@_, "Is it ok?", "Ok", "Cancel"); main($w); }
sub ask_from_entry { my $w = my_gtk->new(shift @_); $w->_ask_from_entry(@_); main($w); }
sub ask_from_list { my $w = my_gtk->new(shift @_); $w->_ask_from_list(pop @_, @_); main($w); }
@@ -254,12 +259,13 @@ sub _ask_warn($@) {
$w->grab_focus();
}
-sub _ask_yesorno($@) {
+sub _ask_okcancel($@) {
my ($o, @msgs) = @_;
+ my ($ok, $cancel) = splice @msgs, -2;
gtkadd($o->{window},
gtkpack(create_box_with_title($o, @msgs),
- create_yesorno($o),
+ create_okcancel($o, $ok, $cancel),
)
);
$o->{ok}->grab_focus();