From 665d9ad8aa8b8a71198ef8b6cae00e94b9244391 Mon Sep 17 00:00:00 2001 From: Pascal Rigaux Date: Thu, 12 Aug 1999 12:05:22 +0000 Subject: no_comment --- perl-install/Makefile | 6 +- perl-install/devices.pm | 8 ++- perl-install/fs.pm | 5 +- perl-install/fsedit.pm | 2 +- perl-install/install2.pm | 9 ++- perl-install/install_steps.pm | 4 +- perl-install/install_steps_interactive.pm | 13 +++-- perl-install/my_gtk.pm | 91 +++++++++++++++++++++++-------- perl-install/partition_table.pm | 2 +- perl-install/pkgs.pm | 8 ++- perl-install/run_program.pm | 2 +- perl-install/share/diskdrake.rc | 12 +--- 12 files changed, 105 insertions(+), 57 deletions(-) (limited to 'perl-install') 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" -- cgit v1.2.1