summaryrefslogtreecommitdiffstats
path: root/perl-install
diff options
context:
space:
mode:
Diffstat (limited to 'perl-install')
-rw-r--r--perl-install/Makefile6
-rw-r--r--perl-install/devices.pm8
-rw-r--r--perl-install/fs.pm5
-rw-r--r--perl-install/fsedit.pm2
-rw-r--r--perl-install/install2.pm9
-rw-r--r--perl-install/install_steps.pm4
-rw-r--r--perl-install/install_steps_interactive.pm13
-rw-r--r--perl-install/my_gtk.pm91
-rw-r--r--perl-install/partition_table.pm2
-rw-r--r--perl-install/pkgs.pm8
-rw-r--r--perl-install/run_program.pm2
-rw-r--r--perl-install/share/diskdrake.rc12
12 files changed, 105 insertions, 57 deletions
diff --git a/perl-install/Makefile b/perl-install/Makefile
index 9f3a9e6d7..8155ce1fc 100644
--- a/perl-install/Makefile
+++ b/perl-install/Makefile
@@ -1,6 +1,6 @@
SO_FILES = c/blib/arch/auto/c/c.so
PMS = *.pm c/*.pm resize_fat/*.pm po/*.pm pci_probing/*.pm commands install2 diskdrake
-ROOTDEST = /tmp/t
+ROOTDEST = /export
DEST = $(ROOTDEST)/Mandrake/instimage
DESTREP4PMS = $(DEST)/usr/bin/perl-install
PERL = perl
@@ -79,7 +79,7 @@ install_pms: all
perl -ne 'print #unless /^use (diagnostics|vars|strict)/' $$i > $(DESTREP4PMS)/$$i; \
done
- cp diskdrake.rc $(DESTREP4PMS)
+ cp diskdrake.rc install.rc $(DESTREP4PMS)
ln -sf perl-install/install2 $(DEST)/usr/bin
ln -sf perl-install/commands $(DEST)/usr/bin
chmod a+x $(DESTREP4PMS)/install2
@@ -161,6 +161,6 @@ stage2:
# function f() { grep "$*" /usr/include/*.h /usr/include/*/*.h; }
-# dd if=/dev/zero of=/tmp/initrd bs=1k count=2000 ; echo y | mke2fs /tmp/initrd ; mount /tmp/initrd /mnt/disk/ -o loop ; cd ~pixel/gi/perl-install ; install -s install/local-install install1/bin/install ; cp -a install1/* /mnt/disk/ ; umount /mnt/disk ; gzip -c /tmp/initrd > /tmp/initrd.img ; mcopy -o /tmp/initrd.img a:
+# dd if=/dev/zero of=/tmp/initrd bs=1k count=2000 ; echo y | mke2fs /tmp/initrd ; mount /tmp/initrd /mnt/disk/ -o loop ; cd ~pixel/gi/perl-install ; install -s install/install install1/bin/install ; cp -a install1/* /mnt/disk/ ; umount /mnt/disk ; gzip -c /tmp/initrd > /tmp/initrd.img ; mcopy -o /tmp/initrd.img a:
# mount /tmp/initrd /mnt/disk/ -o loop ; ; umount /mnt/disk ; gzip -c /tmp/initrd > /tmp/initrd.img ; mcopy -o /tmp/initrd.img a:
diff --git a/perl-install/devices.pm b/perl-install/devices.pm
index 704b3d40d..9346b687e 100644
--- a/perl-install/devices.pm
+++ b/perl-install/devices.pm
@@ -38,9 +38,11 @@ sub size($) {
sub make($) {
local $_ = my $file = $_[0];
my ($type, $major, $minor);
+ my ($prefix);
- unless (s,^/(dev|tmp)/,,) {
- $file = -e "/dev/$file" ? "/dev/$file" : "/tmp/$file";
+ unless (s,^(.*)/(dev|tmp)/,,) {
+ $prefix = $1;
+ $file = -e "$prefix/dev/$file" ? "$prefix/dev/$file" : "$prefix/tmp/$file";
}
-e $file and return $file; # assume nobody takes fun at creating files named as device
@@ -94,7 +96,7 @@ sub make($) {
"scd0" => [ c::S_IFBLK(), 11, 0 ],
"scd1" => [ c::S_IFBLK(), 11, 1 ],
"sjcd" => [ c::S_IFBLK(), 18, 0 ],
- }}{$_} or die "unknown device $type" };
+ }}{$_} or die "unknown device $_" };
}
# make a directory for this inode if needed.
diff --git a/perl-install/fs.pm b/perl-install/fs.pm
index 8d3995aa4..74b9f5448 100644
--- a/perl-install/fs.pm
+++ b/perl-install/fs.pm
@@ -198,8 +198,9 @@ sub write($$) {
symlink $cddev, "$prefix/dev/cdrom" or log::l("failed to symlink $prefix/dev/cdrom: $!");
}
write_fstab($fstab, $prefix, $cddev);
-}
+ devices::make "$prefix/dev/$_->{device}" foreach grep { $_->{device} && !isNfs($_) } @$fstab;
+}
sub write_fstab($;$$) {
my ($fstab, $prefix, $cddev) = @_;
@@ -241,3 +242,5 @@ sub write_fstab($;$$) {
}
print F join(" ", @$_), "\n" foreach @to_add;
}
+
+
diff --git a/perl-install/fsedit.pm b/perl-install/fsedit.pm
index ca613be3c..56bb59490 100644
--- a/perl-install/fsedit.pm
+++ b/perl-install/fsedit.pm
@@ -16,7 +16,7 @@ my @suggestions = (
{ mntpoint => "/boot", minsize => 10 << 11, size => 16 << 11, type => 0x83 },
{ mntpoint => "/", minsize => 50 << 11, size => 100 << 11, type => 0x83 },
{ mntpoint => "swap", minsize => 30 << 11, size => 60 << 11, type => 0x82 },
- { mntpoint => "/usr", minsize => 200 << 11, size => 500 << 11, type => 0x83 },
+ { mntpoint => "/usr", minsize => 200 << 11, size => 600 << 11, type => 0x83 },
{ mntpoint => "/home", minsize => 50 << 11, size => 200 << 11, type => 0x83 },
{ mntpoint => "/var", minsize => 200 << 11, size => 250 << 11, type => 0x83 },
{ mntpoint => "/tmp", minsize => 50 << 11, size => 100 << 11, type => 0x83 },
diff --git a/perl-install/install2.pm b/perl-install/install2.pm
index a1645d07a..cab2718db 100644
--- a/perl-install/install2.pm
+++ b/perl-install/install2.pm
@@ -18,6 +18,7 @@ use detect_devices;
use pkgs;
use smp;
use lang;
+use run_program;
my @installStepsFields = qw(text help skipOnCancel skipOnLocal prev next);
my @installSteps = (
@@ -205,11 +206,13 @@ sub finishNetworking { $o->finishNetworking }
sub configureTimezone { $o->timeConfig }
sub configureServices { $o->servicesConfig }
sub setRootPassword { $o->setRootPassword }
-sub addUser { $o->addUser }
+sub addUser {
+ $o->addUser;
+ run_program::rooted($o->{prefix}, "pwconv"); # use shadow passwords
+}
sub createBootdisk {
- $::testing and return;
- $o->{isUpgrade} or fs::write($o->{prefix}, $o->{fstab});
+ fs::write($o->{prefix}, $o->{fstab}) unless $o->{isUpgrade};
modules::write_conf("$o->{prefix}/etc/conf.modules", 'append');
$o->createBootdisk;
}
diff --git a/perl-install/install_steps.pm b/perl-install/install_steps.pm
index 827039c41..22f75f715 100644
--- a/perl-install/install_steps.pm
+++ b/perl-install/install_steps.pm
@@ -183,11 +183,11 @@ sub addUser($) {
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);
+ commands::chown_("-r", "$new_uid.$new_gid", $homedir);
}
sub createBootdisk($) {
- lilo::mkbootdisk($o->{prefix}, versionString()) if $o->{default}->{mkbootdisk};
+ lilo::mkbootdisk($o->{prefix}, versionString()) if $o->{default}->{mkbootdisk} && !$::testing;
}
sub setupBootloader($) {
diff --git a/perl-install/install_steps_interactive.pm b/perl-install/install_steps_interactive.pm
index 2ea2d84b8..d1436523e 100644
--- a/perl-install/install_steps_interactive.pm
+++ b/perl-install/install_steps_interactive.pm
@@ -82,14 +82,18 @@ sub choosePartitionsToFormat($$) {
sub createBootdisk($) {
my ($o) = @_;
- $o->SUPER::createBootdisk if
- $o->{default}->{mkbootdisk} = $o->ask_yesorno('',
+ $o->{default}->{mkbootdisk} = $o->ask_yesorno('',
_("A custom bootdisk provides a way of booting into your Linux system without
depending on the normal bootloader. This is useful if you don't want to install
lilo on your system, or another operating system removes lilo, or lilo doesn't
work with your hardware configuration. A custom bootdisk can also be used with
the Mandrake rescue image, making it much easier to recover from severe system
failures. Would you like to create a bootdisk for your system?"));
+
+ $o->ask_warn('',
+_("Insert a floppy in drive fd0 (aka A:)"));
+
+ $o->SUPER::createBootdisk;
}
sub setupBootloader($) {
@@ -104,12 +108,11 @@ sub setupBootloader($) {
sub exitInstall {
my ($o) = @_;
$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/.
Information on configuring your system is available in the post
-install chapter of the Official Linux Mandrake User's Guide.");
+install chapter of the Official Linux Mandrake User's Guide."));
}
-
=cut
diff --git a/perl-install/my_gtk.pm b/perl-install/my_gtk.pm
index dcf0458ee..09feb7c19 100644
--- a/perl-install/my_gtk.pm
+++ b/perl-install/my_gtk.pm
@@ -18,6 +18,7 @@ use c;
use common qw(:common);
my $forgetTime = 1000; # in milli-seconds
+my $border = 10;
1;
@@ -29,30 +30,32 @@ sub new {
Gtk->init;
my $o = bless { @opts }, $type;
- $o->{window} = $o->_create_window($title);
+ $o->_create_window($title);
$o;
}
sub main($;$) {
my ($o, $f) = @_;
$o->show;
- $o->{window}->grab_add;
+
+ $o->{rwindow}->grab_add;
do { Gtk->main } while ($o->{retval} && $f && !&$f());
- $o->{window}->grab_remove;
+ $o->{rwindow}->grab_remove;
$o->destroy;
$o->{retval}
}
sub show($) {
my ($o) = @_;
$o->{window}->show;
+ $o->{rwindow}->show;
}
sub destroy($) {
my ($o) = @_;
- $o->{window}->destroy;
+ $o->{rwindow}->destroy;
flush();
}
sub sync($) {
my ($o) = @_;
- $o->{window}->show;
+ $o->show;
my $h = Gtk->idle_add(sub { Gtk->main_quit; 1 });
map { Gtk->main } (1..4);
@@ -62,7 +65,7 @@ sub flush(;$) {
Gtk->main_iteration while Gtk::Gdk->events_pending;
}
sub bigsize($) {
- $_[0]->{window}->set_usize(600,400);
+ $_[0]->{rwindow}->set_usize(600,400);
}
@@ -118,26 +121,33 @@ sub gtkadd($@) {
$w
}
-sub gtkset_mousecursor($) {
- my ($type) = @_;
+sub gtkroot {
Gtk->init;
-
- my $root = Gtk::Gdk::Window->new_foreign(Gtk::Gdk->ROOT_WINDOW);
- $root->set_cursor(Gtk::Gdk::Cursor->new($type));
+ Gtk::Gdk::Window->new_foreign(Gtk::Gdk->ROOT_WINDOW);
}
-sub gtkset_background($$$) {
+sub gtkcolor($$$) {
my ($r, $g, $b) = @_;
- Gtk->init;
- my $root = Gtk::Gdk::Window->new_foreign(Gtk::Gdk->ROOT_WINDOW);
- my $gc = Gtk::Gdk::GC->new($root);
-
my $color = bless {}, 'Gtk::Gdk::Color';
$color->red ($r << 8);
$color->green($g << 8);
$color->blue ($b << 8);
- $color = $root->get_colormap->color_alloc($color);
+ gtkroot()->get_colormap->color_alloc($color);
+}
+
+sub gtkset_mousecursor($) {
+ my ($type) = @_;
+ gtkroot()->set_cursor(Gtk::Gdk::Cursor->new($type));
+}
+
+sub gtkset_background($$$) {
+ my ($r, $g, $b) = @_;
+
+ my $root = gtkroot();
+ my $gc = Gtk::Gdk::GC->new($root);
+
+ my $color = gtkcolor($r, $g, $b);
$gc->set_foreground($color);
$root->set_background($color);
@@ -166,7 +176,11 @@ sub create_okcancel($;$$) {
sub create_box_with_title($@) {
my $o = shift;
$o->{box} = gtkpack_(new Gtk::VBox(0,0),
- map({ 0, $_ } @_),
+ map({
+ my $w = ref $_ ? $_ : new Gtk::Label($_);
+ $w->set_name("Title");
+ 0, $w;
+ } @_),
0, new Gtk::HSeparator,
)
}
@@ -240,12 +254,41 @@ sub create_vbox {
sub _create_window($$) {
my ($o, $title) = @_;
- $o->{window} = new Gtk::Window;
- $o->{window}->set_title($title);
- $o->{window}->signal_connect("expose_event" => sub { c::XSetInputFocus($o->{window}->window->XWINDOW) }) if $my_gtk::force_focus;
- $o->{window}->signal_connect("delete_event" => sub { $o->{retval} = undef; Gtk->main_quit });
- $o->{window}->set_uposition(@$my_gtk::force_position) if $my_gtk::force_position;
- $o->{window}
+ my $w = new Gtk::Window;
+ my $f = new Gtk::Frame(undef);
+ $w->set_name("Title");
+
+ if ($::isStandalone) {
+ gtkadd($w, $f);
+ } else {
+ my $t = new Gtk::Table(0, 0, 0);
+
+ my $new = sub {
+ my $w = new Gtk::DrawingArea;
+ $w->set_usize($border, $border);
+ $w->signal_connect_after(expose_event =>
+ sub { $w->window->draw_rectangle($w->style->black_gc, 1, 0, 0, @{$w->allocation}[2,3]); }
+ );
+ $w->show;
+ $w;
+ };
+
+ $t->attach(&$new(), 0, 1, 0, 3, [], , ["expand","fill"], 0, 0);
+ $t->attach(&$new(), 1, 2, 0, 1, ["expand","fill"], [], 0, 0);
+ $t->attach($f, 1, 2, 1, 2, ["expand","fill"], ["expand","fill"], 0, 0);
+ $t->attach(&$new(), 1, 2, 2, 3, ["expand","fill"], [], 0, 0);
+ $t->attach(&$new(), 2, 3, 0, 3, [], ["expand","fill"], 0, 0);
+
+ gtkadd($w, $t);
+ }
+
+ $w->set_title($title);
+ $w->signal_connect("expose_event" => sub { c::XSetInputFocus($w->window->XWINDOW) }) if $my_gtk::force_focus;
+ $w->signal_connect("delete_event" => sub { $o->{retval} = undef; Gtk->main_quit });
+ $w->set_uposition(@$my_gtk::force_position) if $my_gtk::force_position;
+
+ $o->{window} = $f;
+ $o->{rwindow} = $w;
}
diff --git a/perl-install/partition_table.pm b/perl-install/partition_table.pm
index 11d29f981..a4bb4bbb8 100644
--- a/perl-install/partition_table.pm
+++ b/perl-install/partition_table.pm
@@ -196,7 +196,7 @@ sub adjust_main_extended($) {
$l->{start} = $hd->{primary}->{extended}->{start} = $start;
$l->{size} = $hd->{primary}->{extended}->{size} = $end - $start;
}
- unless (@{$hd->{extended}} || !$hd->{primary}->{extended}) {
+ unless (@{$hd->{extended} || []} || !$hd->{primary}->{extended}) {
%{$hd->{primary}->{extended}} = (); # modify the raw entry
delete $hd->{primary}->{extended};
}
diff --git a/perl-install/pkgs.pm b/perl-install/pkgs.pm
index 22256af4e..340036fc9 100644
--- a/perl-install/pkgs.pm
+++ b/perl-install/pkgs.pm
@@ -23,12 +23,15 @@ sub skipThisPackage { member($_[0], @skipThesesPackages) }
sub Package {
my ($packages, $name) = @_;
- $packages->{$name} or die "unknown package $name";
+ $packages->{$name} ;# or die "unknown package $name"; hack hack :(
}
sub select($$;$) {
my ($packages, $p, $base) = @_;
$p->{selected} = -1; # selected by user
+ unless ($p->{deps}) {
+ 1;
+ }
my @l = @{$p->{deps}};
while (@l) {
my $n = shift @l;
@@ -107,6 +110,7 @@ sub psUsingDirectory(;$) {
log::l("scanning $dirname for packages");
foreach (all("$dirname")) {
my ($name, $version, $release) = /(.*)-([^-]+)-([^-.]+)\.[^.]+\.rpm/ or log::l("skipping $_"), next;
+
$packages{$name} = {
name => $name, version => $version, release => $release,
file => "$dirname/$_", selected => 0, deps => [],
@@ -125,7 +129,7 @@ sub getDeps($) {
$packages->{$name} or next;
$packages->{$name}->{size} = $size;
$packages->{$name}->{deps} = \@deps;
- map { push @{$packages->{$_}->{provides}}, $name } @deps;
+ map { push @{$packages->{$_}->{provides}}, $name if $packages->{$_} } @deps;
}
}
diff --git a/perl-install/run_program.pm b/perl-install/run_program.pm
index 0341fe06d..2973a57cc 100644
--- a/perl-install/run_program.pm
+++ b/perl-install/run_program.pm
@@ -25,6 +25,6 @@ sub rooted($$@) {
$root and chroot $root;
chdir "/";
- exec $name, @args or log::l("exec of $name failed: $!"), exec 'false';
+ exec $name, @args or log::l("exec of $name failed: $!"), exec('false') || exit(1);
}
}
diff --git a/perl-install/share/diskdrake.rc b/perl-install/share/diskdrake.rc
index 637b8f3b1..77ac9e890 100644
--- a/perl-install/share/diskdrake.rc
+++ b/perl-install/share/diskdrake.rc
@@ -1,17 +1,8 @@
-binding "bind"
-{
- bind "m" {
- "clicked" ("Mount")
- }
-}
-
style "font"
{
font = "-adobe-helvetica-medium-r-normal-*-*-80-*-*-p-*-iso8859-1"
}
-
-
style "red" = "font"
{
bg[NORMAL] = { 1.0, 0, 0 }
@@ -32,8 +23,7 @@ style "white" = "font"
bg[NORMAL] = { 1.0, 1.0, 1.0 }
}
-widget "*PART_*" binding "bind"
widget "*Linux*" style "red"
-widget "*Linux swap" style "green"
+widget "GtkWindow.Gtk*Linux swap" style "green"
widget "*FAT*" style "blue"
widget "*Empty*" style "white"
generated by cgit v1.2.1 (git 2.21.0) at 2024-11-01 04:51:08 +0000