summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorPascal Rigaux <pixel@mandriva.com>1999-08-23 13:01:55 +0000
committerPascal Rigaux <pixel@mandriva.com>1999-08-23 13:01:55 +0000
commit673787cbdab4a47b0b3cb987866c57704d7bdee9 (patch)
tree32255ffefd59a78b5e798e18a4f790b032449c1b
parent57ea24fde5f61bb54bee187847f1119b5c79f9f3 (diff)
downloaddrakx-backup-do-not-use-673787cbdab4a47b0b3cb987866c57704d7bdee9.tar
drakx-backup-do-not-use-673787cbdab4a47b0b3cb987866c57704d7bdee9.tar.gz
drakx-backup-do-not-use-673787cbdab4a47b0b3cb987866c57704d7bdee9.tar.bz2
drakx-backup-do-not-use-673787cbdab4a47b0b3cb987866c57704d7bdee9.tar.xz
drakx-backup-do-not-use-673787cbdab4a47b0b3cb987866c57704d7bdee9.zip
no_comment
-rw-r--r--docs/TODO36
-rw-r--r--docs/diskdrake.TODO5
-rw-r--r--perl-install/Makefile47
-rw-r--r--perl-install/Xconfig.pm37
-rw-r--r--perl-install/Xconfigurator.pm112
-rw-r--r--perl-install/commands.pm42
-rw-r--r--perl-install/common.pm57
-rw-r--r--perl-install/fs.pm11
-rw-r--r--perl-install/fsedit.pm10
-rw-r--r--perl-install/install2.pm141
-rw-r--r--perl-install/install_any.pm20
-rw-r--r--perl-install/install_steps.pm148
-rw-r--r--perl-install/install_steps_interactive.pm67
-rw-r--r--perl-install/install_steps_stdio.pm6
-rw-r--r--perl-install/interactive.pm28
-rw-r--r--perl-install/interactive_gtk.pm64
-rw-r--r--perl-install/interactive_stdio.pm6
-rw-r--r--perl-install/lang.pm5
-rw-r--r--perl-install/modules.pm58
-rw-r--r--perl-install/my_gtk.pm37
-rw-r--r--perl-install/network.pm129
-rw-r--r--perl-install/partition_table.pm104
-rw-r--r--perl-install/partition_table_raw.pm10
-rw-r--r--perl-install/pkgs.pm46
-rw-r--r--perl-install/resize_fat/any.pm10
-rw-r--r--perl-install/resize_fat/fat.pm18
-rw-r--r--perl-install/resize_fat/info_sector.pm6
-rw-r--r--perl-install/resize_fat/main.pm16
-rw-r--r--perl-install/share/diskdrake.rc1
-rw-r--r--perl-install/share/install.rc18
-rw-r--r--perl-install/share/list2
-rw-r--r--perl-install/share/themes-blackwhite.rc40
-rw-r--r--perl-install/share/themes-blue.rc36
-rw-r--r--perl-install/share/themes-savane.rc39
-rw-r--r--perl-install/share/themes.rc18
35 files changed, 950 insertions, 480 deletions
diff --git a/docs/TODO b/docs/TODO
index d7320a4b4..b69c4b7eb 100644
--- a/docs/TODO
+++ b/docs/TODO
@@ -1,19 +1,28 @@
+replace in place catchable die's by cdie's (as in partition_table::load)
+
+add the different xmodmaps for every languages (maybe gnome-core xmodmaps can help)
+xmodmap needed even for english as the backspace is not what it should
+
in diskdrake, only swap partitions with a ``mount point'' are used.
it should be: all swap for newbie, ask for others?
+replace the after_install_packages with callbacks about things to do when available
+
+mkdosfs missing => crash :(
+
+look at SuperProbe
+
after install, startx does not launch an available window manager
(kdebase was present, and twm too)
-problem with initrd and lilo (computer with scsi). mkbootdisk is ok
+problem with mkbootdisk
-xmodmap needed even for english as the backspace is not what it should
+add the ability to give arguments to insmod.
remove the hack in pkgs.pm (search for hack)
`Show all' should toggle in package selection
-`(Un)Select all' in package selection
help:programs is empty in expert in package selection
-left scroll bar is half visible
pb with ghostscript-both & ghostscript-X11...
@@ -26,35 +35,26 @@ Xconfigurator:
possibility to show card autodetected
use the VideoRam for skeeping some tests (not all the 32 24 16 15 8)
-add a waiting message while formatting
-
-does not reboot at the end of install
-
-insmod of /modules/loop.o fails (eg: in mkbootdisk)
-(no /modules nor insmod)
+in package choosing, the group (on the left) is no more `selected' (gtk focus) when clicking on a package (on the right)
install2 sigsegv when leaving :(
(i hacked init to reboot on error)
-xmodmaps for every languages (maybe gnome-core xmodmaps can help)
-
verify the free space is big enough.
+ask realname first, then propose a username using the realname
be able to add more than one normal user
-left window in the install (steps) should have a smaller font.
-
loadFont sucks
trash on the screen when X first start
-do not allow window resizing
-
network configuration
get the error when reading .rpm files fail
-setupSCSIInterfaces
+ask for notepad (aka portable) or not
+ask for hdparm or not
+
mouseConfig in setup.c
add a log != tty3 (like /tmp/...)
-ps in commands marche pas
diff --git a/docs/diskdrake.TODO b/docs/diskdrake.TODO
index 4c0726a2c..e3e44d3b1 100644
--- a/docs/diskdrake.TODO
+++ b/docs/diskdrake.TODO
@@ -1,10 +1,13 @@
+- popup menu should no be closed when a simple click is done
- test what windows can handle (the number of partitions)
-- bug when creating smallest partitions (size < 0)
+- better keyboard focus handling
+- end sector in Create
- add warnings for scsi drives if you create more than sdx15
- the information put in save/restore partitions must be cleaned
(remove mounted/formatted/..., also remove the Data::Dumper dependency)
- test, test, test
- integrate ext2resize
+- do not allow swap partitions above 2Gigs
- wanting the first partition to be extended is not used
- maybe warn if a mounted partition change of dev number
- add the ability to specify primary or extended partitions (in expert mode)
diff --git a/perl-install/Makefile b/perl-install/Makefile
index 71e122a49..b85b2d198 100644
--- a/perl-install/Makefile
+++ b/perl-install/Makefile
@@ -1,17 +1,20 @@
-VERSION = 2.2.11-1mdkBOOT
+VERSION = 2.2.10-BOOT
SO_FILES = c/blib/arch/auto/c/c.so
-PMS = *.pm c/*.pm resize_fat/*.pm po/*.pm pci_probing/*.pm commands install2 diskdrake
+PMS = *.pm c/*.pm resize_fat/*.pm po/*.pm pci_probing/*.pm commands install2 diskdrake XFdrake
ROOTDEST = /export
-DEST = $(ROOTDEST)/Mandrake/instimage
+DEST = $(ROOTDEST)/Mandrake/mdkinst
DESTREP4PMS = $(DEST)/usr/bin/perl-install
PERL = perl
LOCALFILES = $(PERL) mouseconfig
DIRS = po pci_probing
EXCLUDE = $(LOCALFILES) boot.img keymaps xmodmaps consolefonts install
-.PHONY: all $(DIRS) tags install clean verify_c
+CFLAGS = -Wall
+override CFLAGS += -pipe
-all: $(SO_FILES) $(DIRS) install1_hd
+.PHONY: all $(DIRS) tags install clean stage2 full_stage2 verify_c
+
+all: $(SO_FILES) $(DIRS)
tags:
etags -o - $(PMS) | perl2etags > TAGS
@@ -19,16 +22,14 @@ tags:
clean:
test ! -e c/Makefile || $(MAKE) -C c clean
for i in $(DIRS); do $(MAKE) -C $$i clean; done
- rm -f c/c.xs install1_hd gendepslist
+ rm -f c/c.xs gendepslist
find . -name "*~" -o -name "TAGS" -o -name "*.old" | xargs rm -f
tar: clean
cd .. ; tar cfy perl-install.tar.bz2 $(EXCLUDE:%=--exclude %) perl-install
-floppy: tar
- mcopy -o ../perl-install.tar.bz2 a:
- mcopy -o ../perl-install.tar.bz2 a:a
- mcopy -o ../perl-install.tar.bz2 a:aa
+floppy:
+ dd if=/dev/zero of=/tmp/initrd bs=1k count=2000 ; echo y | mke2fs /tmp/initrd ; mount /tmp/initrd /mnt/disk/ -o loop ; cp -a ../install1/* /mnt/disk/ ; umount /mnt/disk ; gzip -c /tmp/initrd > /tmp/initrd.img ; mcopy -o /tmp/initrd.img a:
tar-diskdrake: clean
cd .. ; rm -rf diskdrake ; cp -af perl-install diskdrake
@@ -51,9 +52,6 @@ $(SO_FILES): c/c.xs
test -e c/Makefile || (cd c; export C_RPM=1 ; perl Makefile.PL)
$(MAKE) -C c
-install1_hd: install1_hd.c
- $(CC) -static -Wall -o $@ $<
-
$(DIRS):
$(MAKE) -C $@
@@ -80,7 +78,7 @@ install_pms: all
perl -ne 'print #unless /^use (diagnostics|vars|strict)/' $$i > $(DESTREP4PMS)/$$i; \
done
- cp diskdrake.rc install.rc $(DESTREP4PMS)
+ cp *.rc $(DESTREP4PMS)
ln -sf perl-install/install2 $(DEST)/usr/bin
ln -sf perl-install/commands $(DEST)/usr/bin
chmod a+x $(DESTREP4PMS)/install2
@@ -111,7 +109,7 @@ get_needed_files: $(SO_FILES)
d=`echo $(DEST)/$$i | sed 's/\/usr\/local\//\/usr\//'`; \
install -d `dirname $$d` && \
if (echo $$i | grep -q "\.pm"); then \
- perl -pe '$$_ eq "__END__" and exit(0);' $$i > $$d; \
+ perl -pe '$$_ =~ /^__END__/ and exit(0);' $$i > $$d; \
else \
cp -f $$i $$d; \
strip $$d 2>/dev/null || true; \
@@ -122,21 +120,21 @@ get_needed_files: $(SO_FILES)
mv -f $(DEST)/bin/* $(DEST)/sbin/* $(DEST)/usr/bin
rmdir $(DEST)/bin $(DEST)/sbin
- ln -s ash $(DEST)/usr/bin/sh
+ ln -sf ash $(DEST)/usr/bin/sh
- install -d $(DEST)/usr/X11R6/lib/X11/fonts/
- cp -a /usr/X11R6/lib/X11/fonts/misc $(DEST)/usr/X11R6/lib/X11/fonts/
+ install -d $(DEST)/usr/X11R6/lib/X11/fonts/75dpi
+ install -d $(DEST)/usr/X11R6/lib/X11/fonts/misc
+ cd /usr/X11R6/lib/X11/fonts/75dpi ; cp -a fonts.* helvR* $(DEST)/usr/X11R6/lib/X11/fonts/75dpi
+ cd /usr/X11R6/lib/X11/fonts/misc ; cp -a fonts.* cursor.pcf.gz 6x13.pcf.gz $(DEST)/usr/X11R6/lib/X11/fonts/misc
cp -a xmodmaps $(DEST)/usr/share
cp -a keymaps $(DEST)/usr/share
cp -a consolefonts $(DEST)/usr/share
cp MonitorsDB $(DEST)/usr/share
+ cp logo-mandrake.xpm $(DEST)/usr/share
cp compss $(ROOTDEST)/Mandrake/base
- install -d $(DEST)/lib/modules
- (cd /lib/modules/$(VERSION) ; \
- cp `find -name "*.o"` $(DEST)/lib/modules ; \
- /sbin/depmod -m /boot/System.map-$(VERSION) -i -e *.o | grep ': ' | sed 's/\.o//g' > $(DEST)/lib/modules/modules.dep)
+ cp -f ../modules/modules.cpio.bz2 $(DEST)/lib/
ln -s install2 $(DEST)/usr/bin/runinstall2
# echo -e "#!/bin/sh\n\nexec '/usr/bin/sh'" > $(DEST)/usr/bin/runinstall2
@@ -158,7 +156,7 @@ full_stage2:
stage2:
$(MAKE) install_pms
# cd $(ROOTDEST) ; tar cfz /tmp/instimage-full.tgz Mandrake
-# cd $(ROOTDEST) ; tar cfz /tmp/instimage-light.tgz Mandrake/base/compss Mandrake/instimage/usr/[bl]*
+# cd $(ROOTDEST) ; tar cfz /tmp/instimage-light.tgz Mandrake/base/compss Mandrake/mdkinst/usr/[bl]*
@#rm -rf /mnt/initrd/*
@#cp -a $(DEST)/* /mnt/initrd
@@ -167,6 +165,7 @@ 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/install install1/bin/install ; install -s installinit/init install1/bin/ ; cp -a install1/* /mnt/disk/ ; umount /mnt/disk ; gzip -c /tmp/initrd > /tmp/initrd.img ; mcopy -o /tmp/initrd.img a:
+#
+# install -s install/install install1/bin/install ; install -s installinit/init install1/bin/init
# 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/Xconfig.pm b/perl-install/Xconfig.pm
index 042388e85..248cf125f 100644
--- a/perl-install/Xconfig.pm
+++ b/perl-install/Xconfig.pm
@@ -18,15 +18,16 @@ sub keymap_translate {
sub getinfo {
my $o = {};
- getinfoFromXF86Config($o);
+# getinfoFromXF86Config($o);
getinfoFromSysconfig($o);
- unless ($o->{mouse}->{xtype}) {
+ unless ($o->{mouse}{xtype}) {
my ($type, $dev) = split("\n", `mouseconfig --nointeractive 2>/dev/null`) or die "mouseconfig failed";
- $o->{mouse}->{xtype} ||= $type;
- $o->{mouse}->{device} ||= "/dev/$dev";
+ $o->{mouse}{emulate3buttons} = 1;
+ $o->{mouse}{xtype} ||= $type;
+ $o->{mouse}{device} ||= "/dev/$dev";
}
- $o->{mouse}->{device} ||= "/dev/mouse" if -e "/dev/mouse";
+ $o->{mouse}{device} ||= "/dev/mouse" if -e "/dev/mouse";
$o;
}
@@ -34,16 +35,16 @@ sub getinfoFromXF86Config {
my $o = shift || {};
my (%c, $depth);
- $o->{card}->{server} ||= $1 if readlink("/etc/X11/X") =~ /XF86_ (\w+)$/x; # /x for perl2fcalls
+ $o->{card}{server} ||= $1 if readlink("/etc/X11/X") =~ /XF86_ (\w+)$/x; # /x for perl2fcalls
local *F;
open F, "/etc/X11/XF86Config" or return {};
foreach (<F>) {
if (/^Section "Keyboard"/ .. /^EndSection/) {
- $o->{keyboard}->{xkb_keymap} ||= $1 if /^\s*XkbLayout\s+"(.*?)"/;
+ $o->{keyboard}{xkb_keymap} ||= $1 if /^\s*XkbLayout\s+"(.*?)"/;
} elsif (/^Section "Pointer"/ .. /^EndSection/) {
- $o->{mouse}->{xtype} ||= $1 if /^\s*Protocol\s+"(.*?)"/;
- $o->{mouse}->{device} ||= $1 if /^\s*Device\s+"(.*?)"/;
+ $o->{mouse}{xtype} ||= $1 if /^\s*Protocol\s+"(.*?)"/;
+ $o->{mouse}{device} ||= $1 if /^\s*Device\s+"(.*?)"/;
} elsif (my $i = /^Section "Device"/ .. /^EndSection/) {
if ($i = 1 && $c{type} && $c{type} ne "Generic VGA") {
add2hash($o->{card} ||= {}, \%c);
@@ -56,19 +57,19 @@ sub getinfoFromXF86Config {
push @{$c{lines}}, $_ unless /(Section|Identifier|VideoRam|VendorName|BoardName)/;
} elsif (/^Section "Monitor"/ .. /^EndSection/) {
- $o->{monitor}->{type} ||= $1 if /^\s*Identifier\s+"(.*?)"/;
- $o->{monitor}->{hsyncrange} ||= $1 if /^\s*HorizSync\s+(.*)/;
- $o->{monitor}->{vsyncrange} ||= $1 if /^\s*VertRefresh\s+(.*)/;
- $o->{monitor}->{vendor} ||= $1 if /^\s*VendorName\s+"(.*?)"/;
- $o->{monitor}->{model} ||= $1 if /^\s*ModelName\s+"(.*?)"/;
+ $o->{monitor}{type} ||= $1 if /^\s*Identifier\s+"(.*?)"/;
+ $o->{monitor}{hsyncrange} ||= $1 if /^\s*HorizSync\s+(.*)/;
+ $o->{monitor}{vsyncrange} ||= $1 if /^\s*VertRefresh\s+(.*)/;
+ $o->{monitor}{vendor} ||= $1 if /^\s*VendorName\s+"(.*?)"/;
+ $o->{monitor}{model} ||= $1 if /^\s*ModelName\s+"(.*?)"/;
} elsif (/^Section "Screen"/ .. /^EndSection/) {
- $o->{card}->{default_depth} ||= $1 if /^\s*DefaultColorDepth\s+(\d+)/;
+ $o->{card}{default_depth} ||= $1 if /^\s*DefaultColorDepth\s+(\d+)/;
if (my $i = /^\s*Subsection\s+"Display"/ .. /^\s*EndSubsection/) {
$depth = undef if $i == 1;
$depth = $1 if /^\s*Depth\s+(\d*)/;
if (/^\s*Modes\s+(.*)/) {
my $a = 0;
- push @{$o->{card}->{depth}->{$depth || 8}},
+ push @{$o->{card}{depth}{$depth || 8}},
grep { $_->[0] >= 640 } map { [ /"(\d+)x(\d+)"/ ] } split ' ', $1;
}
}
@@ -80,10 +81,10 @@ sub getinfoFromXF86Config {
sub getinfoFromSysconfig {
my $o = shift || {};
if (my %mouse = getVarsFromSh "/etc/sysconfig/mouse") {
- $o->{mouse}->{xtype} ||= $mouse{XMOUSETYPE};
+ $o->{mouse}{xtype} ||= $mouse{XMOUSETYPE};
}
if (my %keyboard = getVarsFromSh "/etc/sysconfig/keyboard") {
$keyboard{KEYTABLE} or last;
- $o->{keyboard}->{xkb_keymap} ||= keymap_translate($keyboard{KEYTABLE});
+ $o->{keyboard}{xkb_keymap} ||= keymap_translate($keyboard{KEYTABLE});
}
}
diff --git a/perl-install/Xconfigurator.pm b/perl-install/Xconfigurator.pm
index d39e58238..16ecde778 100644
--- a/perl-install/Xconfigurator.pm
+++ b/perl-install/Xconfigurator.pm
@@ -36,46 +36,50 @@ sub readCardsDB {
local *F;
open F, $file or die "file $file not found";
- my $lineno = 0; foreach (<F>) { $lineno++;
+ my ($lineno, $cmd, $val) = 0;
+ my $fs = {
+ LINE => sub { push @{$card->{lines}}, $val unless $val eq "VideoRam" },
+ NAME => sub {
+ $cards{$card->{type}} = $card if $card;
+ $card = { type => $val };
+ },
+ SEE => sub {
+ my $c = $cards{$val} or die "Error in database, invalid reference $val at line $lineno";
+
+ push @{$card->{lines}}, @{$c->{lines} || []};
+ add2hash($card->{flags}, $c->{flags});
+ add2hash($card, $c);
+ },
+ CHIPSET => sub {
+ $card->{chipset} = $val;
+ $card->{flags}{needVideoRam} = 1 if member($val, qw(mgag10 mgag200 RIVA128));
+ },
+ SERVER => sub { $card->{server} = $val; },
+ RAMDAC => sub { $card->{ramdac} = $val; },
+ DACSPEED => sub { $card->{dacspeed} = $val; },
+ CLOCKCHIP => sub { $card->{clockchip} = $val; $card->{flags}{noclockprobe} = 1; },
+ NOCLOCKPROBE => sub { $card->{flags}{noclockprobe} = 1 },
+ UNSUPPORTED => sub { $card->{flags}{unsupported} = 1 },
+ COMMENT => sub {},
+ };
+
+ foreach (<F>) { $lineno++;
s/\s+$//;
/^#/ and next;
/^$/ and next;
/^END/ and last;
- my ($cmd, $val) = /(\S+)\s*(.*)/ or log::l("bad line $lineno ($_)"), next;
+ ($cmd, $val) = /(\S+)\s*(.*)/ or log::l("bad line $lineno ($_)"), next;
- my $f = $ {{
- LINE => sub { push @{$card->{lines}}, $val unless $val eq "VideoRam" },
- NAME => sub {
- $cards{$card->{type}} = $card if $card;
- $card = { type => $val };
- },
- SEE => sub {
- my $c = $cards{$val} or die "Error in database, invalid reference $val at line $lineno";
-
- push @{$card->{lines}}, @{$c->{lines} || []};
- add2hash($card->{flags}, $c->{flags});
- add2hash($card, $c);
- },
- CHIPSET => sub { $card->{chipset} = $val;
- $card->{flags}->{needVideoRam} = 1 if member($val, qw(mgag10 mgag200 RIVA128));
- },
- SERVER => sub { $card->{server} = $val; },
- RAMDAC => sub { $card->{ramdac} = $val; },
- DACSPEED => sub { $card->{dacspeed} = $val; },
- CLOCKCHIP => sub { $card->{clockchip} = $val; $card->{flags}->{noclockprobe} = 1; },
- NOCLOCKPROBE => sub { $card->{flags}->{noclockprobe} = 1 },
- UNSUPPORTED => sub { $card->{flags}->{unsupported} = 1 },
- COMMENT => sub {},
- }}{$cmd};
+ my $f = $fs->{$cmd};
$f ? &$f() : log::l("unknown line $lineno ($_)");
}
- push @{$cards{S3}->{lines}}, $s3_comment;
- push @{$cards{'CL-GD'}->{lines}}, $cirrus_comment;
+ push @{$cards{S3}{lines}}, $s3_comment;
+ push @{$cards{'CL-GD'}{lines}}, $cirrus_comment;
# this entry is broken in X11R6 cards db
- $cards{I128}->{flags}->{noclockprobe} = 1;
+ $cards{I128}{flags}{noclockprobe} = 1;
}
sub readMonitorsDB {
@@ -156,7 +160,7 @@ sub cardConfiguration(;$$) {
add2hash($card, { vendor => "Unknown", board => "Unknown" });
$card->{prog} = "/usr/X11R6/bin/XF86_$card->{server}";
-
+
-x "$prefix$card->{prog}" or !defined $install or &$install($card->{server});
-x "$prefix$card->{prog}" or die "server $card->{server} is not available (should be in $prefix$card->{prog})";
@@ -166,10 +170,10 @@ sub cardConfiguration(;$$) {
}
unless ($card->{type}) {
- $card->{flags}->{noclockprobe} = member($card->{server}, qw(I128 S3 S3V Mach64));
+ $card->{flags}{noclockprobe} = member($card->{server}, qw(I128 S3 S3V Mach64));
}
- $card->{flags}->{needVideoRam} and
+ $card->{flags}{needVideoRam} and
$card->{memory} ||=
$videomemory{$in->ask_from_list_('',
_("Give your graphic card memory size"),
@@ -198,9 +202,9 @@ sub testConfig($) {
write_XF86Config($o, $tmpconfig);
local *F;
- open F, "$prefix$o->{card}->{prog} :9 -probeonly -pn -xf86config $tmpconfig 2>&1 |";
+ open F, "$prefix$o->{card}{prog} :9 -probeonly -pn -xf86config $tmpconfig 2>&1 |";
foreach (<F>) {
- $o->{card}->{memory} ||= $2 if /(videoram|Video RAM):\s*(\d*)/;
+ $o->{card}{memory} ||= $2 if /(videoram|Video RAM):\s*(\d*)/;
# look for clocks
push @$clocklines, $1 if /clocks: (.*)/ && !/(pixel |num)clocks:/;
@@ -216,13 +220,13 @@ sub testConfig($) {
sub testFinalConfig($;$) {
my ($o, $auto) = @_;
- $o->{monitor}->{hsyncrange} && $o->{monitor}->{vsyncrange} or
+ $o->{monitor}{hsyncrange} && $o->{monitor}{vsyncrange} or
$in->ask_warn('', _("Monitor not configured yet")), return;
- $o->{card}->{server} or
+ $o->{card}{server} or
$in->ask_warn('', _("Graphic card not configured yet")), return;
- $o->{card}->{depth} or
+ $o->{card}{depth} or
$in->ask_warn('', _("Resolutions not chosen yet")), return;
rename("$prefix/etc/X11/XF86Config", "$prefix/etc/X11/XF86Config.old") || die "unable to make a backup of XF86Config" unless $::testing;
@@ -235,7 +239,7 @@ sub testFinalConfig($;$) {
my $pid; unless ($pid = fork) {
my @l = "X";
- @l = ($o->{card}->{prog}, "-xf86config", $tmpconfig) if $::testing;
+ @l = ($o->{card}{prog}, "-xf86config", $tmpconfig) if $::testing;
chroot $prefix if $prefix;
exec @l, ":9" or exit 1;
}
@@ -266,8 +270,7 @@ sub testFinalConfig($;$) {
$time-- or Gtk->main_quit;
});
- exit (interactive_gtk->new->ask_yesorno('', [ _("Is this ok?"), $text ], 1)
- ? 0 : 222);
+ exit (interactive_gtk->new->ask_yesorno('', [ _("Is this ok?"), $text ], 1) ? 0 : 222);
};
my $rc = close F;
my $err = $?;
@@ -298,10 +301,10 @@ You can switch if off if you want, you'll hear a beep when it's over")) or retur
my ($resolutions, $clocklines) = eval { testConfig($o) };
if ($@ || !$resolutions) {
- delete $card->{depth}->{$_};
+ delete $card->{depth}{$_};
} else {
- $card->{clocklines} ||= $clocklines unless $card->{flags}->{noclockprobe};
- $card->{depth}->{$_} = [ @$resolutions ];
+ $card->{clocklines} ||= $clocklines unless $card->{flags}{noclockprobe};
+ $card->{depth}{$_} = [ @$resolutions ];
}
}
@@ -373,7 +376,7 @@ sub chooseResolutions($$) {
$depth_combo->set_popdown_strings(map { translate($depths{$_}) } ikeys(%{$card->{depth}}));
$depth_combo->entry->signal_connect(changed => sub {
$chosen_depth = $txt2depth{untranslate($depth_combo->entry->get_text, keys %txt2depth)};
- my $w = $card->{depth}->{$chosen_depth}->[0][0];
+ my $w = $card->{depth}{$chosen_depth}[0][0];
$chosen_w > $w and &$set($w2widget{$chosen_w = $w});
});
&$set_depth();
@@ -420,7 +423,7 @@ sub resolutionsConfiguration($$) {
# _("Do you want to try?") ]);
unless ($card->{depth}) {
- $card->{depth}->{$_} = [ map { [ split "x" ] } @resolutions ]
+ $card->{depth}{$_} = [ map { [ split "x" ] } @resolutions ]
foreach @depths;
if ($nowarning || (!$noauto && $in->ask_okcancel(_("Automatic resolutions"),
@@ -432,12 +435,11 @@ Do you want to try?")))) {
}
# sort resolutions in each depth
- {
+ foreach (values %{$card->{depth}}) {
my $i;
@$_ = grep { first($i != $_->[0], $i = $_->[0]) }
- sort { $b->[0] <=> $a->[0] } @$_
- foreach values %{$card->{depth}};
- }
+ sort { $b->[0] <=> $a->[0] } @$_;
+ }
# remove unusable resolutions (based on the video memory size)
keepOnlyLegalModes($card);
@@ -448,11 +450,11 @@ Do you want to try?")))) {
$auto or ($depth, $res) = chooseResolutions($card, $depth) or return;
# needed in auto mode when all has been provided by the user
- $card->{depth}->{$depth} or die "you fixed an unusable depth";
+ $card->{depth}{$depth} or die "you fixed an unusable depth";
# remove all biggest resolution (keep the small ones for ctl-alt-+)
# otherwise there'll be a virtual screen :(
- $card->{depth}->{$depth} = [ grep { $_->[0] <= $res } @{$card->{depth}->{$depth}} ];
+ $card->{depth}{$depth} = [ grep { $_->[0] <= $res } @{$card->{depth}{$depth}} ];
$card->{default_depth} = $depth;
1;
}
@@ -512,7 +514,7 @@ sub write_XF86Config {
print F qq( VertRefresh $O->{vsyncrange}\n);
print F "\n";
print F $monitorsection_text4;
- print F ($o->{card}->{type} eq "TG 96" ?
+ print F ($o->{card}{type} eq "TG 96" ?
$modelines_text_Trident_TG_96xx :
$modelines_text);
print F "EndSection\n\n\n";
@@ -525,7 +527,7 @@ sub write_XF86Config {
print F qq( VendorName "$O->{vendor}"\n);
print F qq( BoardName "$O->{board}"\n);
- print F "#" if $O->{memory} && !$O->{flags}->{needVideoRam};
+ print F "#" if $O->{memory} && !$O->{flags}{needVideoRam};
print F " VideoRam $O->{memory}\n" if $O->{memory};
print F map { " $_\n" } @{$O->{lines} || []};
@@ -551,7 +553,7 @@ sub write_XF86Config {
Section "Screen"
Driver "$server"
Device "$device"
- Monitor "$o->{monitor}->{type}"
+ Monitor "$o->{monitor}{type}"
);
print F " DefaultColorDepth $defdepth\n" if $defdepth;
@@ -627,7 +629,7 @@ sub main {
__("Change Graphic card") => sub { $o->{card} = cardConfiguration('', 'noauto') },
__("Change Resolution") => sub { resolutionsConfiguration($o, 'noauto') },
__("Automaticall resolutions search") => sub {
- delete $o->{card}->{depth};
+ delete $o->{card}{depth};
resolutionsConfiguration($o, 'nowarning');
},
__("Test again") => sub { $ok = testFinalConfig($o, 1) },
diff --git a/perl-install/commands.pm b/perl-install/commands.pm
index 9b06743fa..4a4340f2f 100644
--- a/perl-install/commands.pm
+++ b/perl-install/commands.pm
@@ -246,25 +246,29 @@ 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, $cpu, $cmd);
+ my $uptime = int first(cat_("/proc/uptime"));
+ my $hertz = 100;
+
+ local (*STDOUT_TOP);
+ format STDOUT_TOP =
+ PID CMD
+.
+ format =
+@>>>> @>>> @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+$pid, $cpu, $cmd
+.
+
+ foreach $pid (sort {$a <=> $b} grep { /\d+/ } all('/proc')) {
+ my @l = split(' ', cat_("/proc/$pid/stat"));
+ $cpu = sprintf "%2.1f", max(0, min(99, ($l[13] + $l[14]) * 100 / $hertz / ($uptime - $l[21] / $hertz)));
+ (($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/common.pm b/perl-install/common.pm
index 449efb922..90b02b82a 100644
--- a/perl-install/common.pm
+++ b/perl-install/common.pm
@@ -7,9 +7,9 @@ use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK $printable_chars $sizeof_int $bitof_int
@ISA = qw(Exporter);
%EXPORT_TAGS = (
common => [ qw(__ min max sum sign product bool ikeys member divide is_empty_array_ref add2hash set_new set_add round_up round_down first second top uniq translate untranslate warp_text) ],
- functional => [ qw(fold_left difference2) ],
+ functional => [ qw(fold_left difference2 before_leaving catch_cdie cdie) ],
file => [ qw(dirname basename touch all glob_ cat_ chop_ mode) ],
- system => [ qw(sync makedev unmakedev psizeof strcpy gettimeofday syscall_ crypt_ getVarsFromSh) ],
+ system => [ qw(sync makedev unmakedev psizeof strcpy gettimeofday syscall_ crypt_ getVarsFromSh setVarsInSh) ],
constant => [ qw($printable_chars $sizeof_int $bitof_int $SECTORSIZE) ],
);
@EXPORT_OK = map { @$_ } values %EXPORT_TAGS;
@@ -49,7 +49,7 @@ sub is_empty_array_ref { my $a = shift; !defined $a || @$a == 0 }
sub difference2 { my %l; @l{@{$_[1]}} = (); grep { !exists $l{$_} } @{$_[0]} }
sub set_new(@) { my %l; @l{@_} = undef; { list => [ @_ ], hash => \%l } }
-sub set_add($@) { my $o = shift; foreach (@_) { exists $o->{hash}->{$_} and next; push @{$o->{list}}, $_; $o->{hash}->{$_} = undef } }
+sub set_add($@) { my $o = shift; foreach (@_) { exists $o->{hash}{$_} and next; push @{$o->{list}}, $_; $o->{hash}{$_} = undef } }
sub sync { syscall_('sync') }
sub gettimeofday { my $t = pack "LL"; syscall_('gettimeofday', $t, 0) or die "gettimeofday failed: $!\n"; unpack("LL", $t) }
@@ -75,6 +75,50 @@ sub fold_left(&$@) {
$a
}
+sub add_f4before_leaving {
+ my ($f, $b, $name) = @_;
+
+# print "add_f4before_leaving\n";
+ unless ($common::before_leaving::{$name}) {
+ no strict 'refs';
+ ${"common::before_leaving::$name"} = 1;
+ ${"common::before_leaving::list"} = 1;
+ }
+ local *N = *{$common::before_leaving::{$name}};
+ my $list = *common::before_leaving::list;
+ $list->{$b}{$name} = $f;
+ *N = sub {
+ my $f = $list->{$_[0]}{$name} or die;
+ $name eq 'DESTROY' and delete $list->{$_[0]};
+ goto $f;
+ } unless defined &{*N};
+
+}
+
+# ! the functions are not called in the order wanted, in case of multiple before_leaving :(
+sub before_leaving(&) {
+ my ($f) = @_;
+ my $b = bless {}, 'common::before_leaving';
+ add_f4before_leaving($f, $b, 'DESTROY');
+ $b;
+}
+
+sub catch_cdie(&&) {
+ my ($f, $catch) = @_;
+
+ unshift @common::cdie_catches, $catch;
+ &$f();
+ shift @common::cdie_catches;
+}
+
+sub cdie {
+ $@ = join '', @_;
+ foreach (@common::cdie_catches) {
+ print;
+ &{$_}(@_) and return;
+ }
+ die @_;
+}
sub all {
my $d = shift;
@@ -164,3 +208,10 @@ sub getVarsFromSh($) {
}
%l;
}
+
+sub setVarsInSh {
+ my ($file, $l, @fields) = @_;
+ local *F;
+ open F, "> $_[0]" or die "cannot create config file $file";
+ $l->{$_} and print F "$_=$l->{$_}\n" foreach @fields;
+}
diff --git a/perl-install/fs.pm b/perl-install/fs.pm
index 74b9f5448..860ab4ebd 100644
--- a/perl-install/fs.pm
+++ b/perl-install/fs.pm
@@ -12,6 +12,7 @@ use nfs;
use swap;
use detect_devices;
use commands;
+use modules;
1;
@@ -23,7 +24,7 @@ sub read_fstab($) {
open F, $file or return;
map {
- my ($dev, $mntpoint, @l) = split ' ';
+ my ($dev, $mntpoint, @l) = split;
$dev =~ s,/(tmp|dev)/,,;
while (@l > 4) { $mntpoint .= " " . shift @l; }
{ device => $dev, mntpoint => $mntpoint, type => $l[0], options => $l[1] }
@@ -111,7 +112,13 @@ sub mount($$$;$) {
my $flag = 0;#c::MS_MGC_VAL();
$flag |= c::MS_RDONLY() if $rdonly;
- my $mount_opt = $fs eq 'vfat' ? "check=relaxed" : "";
+ my $mount_opt = "";
+
+ if ($fs eq 'vfat') {
+ $mount_opt = "check=relaxed";
+ eval { modules::load('vfat') }; # try using vfat
+ eval { modules::load('msdos') } if $@; # otherwise msdos...
+ }
log::l("calling mount($dev, $where, $fs, $flag, $mount_opt)");
syscall_('mount', $dev, $where, $fs, $flag, $mount_opt) or die _("mount failed: ") . "$!";
diff --git a/perl-install/fsedit.pm b/perl-install/fsedit.pm
index ac2126339..1cde1f847 100644
--- a/perl-install/fsedit.pm
+++ b/perl-install/fsedit.pm
@@ -174,7 +174,7 @@ 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($_[0]->{start}, $_[0]->{start} + $_[0]->{size}, $free_sectors{$_[0]->{rootDevice}}) };
+ my $remove = sub { removeFromList($_[0]{start}, $_[0]->{start} + $_[0]->{size}, $free_sectors{$_[0]->{rootDevice}}) };
my $success = 0;
foreach (get_fstab(@$hds)) { &$remove($_); }
@@ -217,6 +217,10 @@ sub undo_prepare($) {
push @{$_->{undo}}, Data::Dumper->Dump([\@h], ['$h']);
}
}
+sub undo_forget($) {
+ my ($hds) = @_;
+ pop @{$_->{undo}} foreach @$hds;
+}
sub undo($) {
my ($hds) = @_;
@@ -233,12 +237,12 @@ sub move {
my $part2 = { %$part };
$part2->{start} = $sector2;
- $part2->{size} += partition_table::cylinder_size($hd2);
+ $part2->{size} += partition_table::cylinder_size($hd2) - 1;
partition_table::remove($hd, $part);
{
local ($part2->{notFormatted}, $part2->{isFormatted}); # do not allow partition::add to change this
partition_table::add($hd2, $part2);
- }
+ }
return if $part2->{notFormatted} && !$part2->{isFormatted} || $::testing;
diff --git a/perl-install/install2.pm b/perl-install/install2.pm
index 5a771acb7..98bf55d1b 100644
--- a/perl-install/install2.pm
+++ b/perl-install/install2.pm
@@ -7,7 +7,7 @@ use vars qw($o);
use common qw(:common :file :system);
use install_any qw(:all);
use log;
-use net;
+use network;
use keyboard;
use fs;
use fsedit;
@@ -20,64 +20,40 @@ use smp;
use lang;
use run_program;
-my @installStepsFields = qw(text help skipOnCancel skipOnLocal prev next);
+my @installStepsFields = qw(text help redoable onError needs);
my @installSteps = (
- selectLanguage => [ __("Choose your language"), "help", 0, 0 ],
+ selectLanguage => [ __("Choose your language"), "help", 1, 1 ],
selectPath => [ __("Choose install or upgrade"), __("help"), 0, 0 ],
- selectInstallClass => [ __("Select installation class"), __("help"), 0, 0 ],
- setupSCSI => [ __("Setup SCSI"), __("help"), 0, 1 ],
- partitionDisks => [ __("Setup filesystems"), __("help"), 0, 1 ],
- formatPartitions => [ __("Format partitions"), __("help"), 0, 1 ],
- findInstallFiles => [ __("Find installation files"), __("help"), 1, 0 ],
- choosePackages => [ __("Choose packages to install"), __("help"), 0, 0 ],
- doInstallStep => [ __("Install system"), __("help"), 0, 0 ],
+ selectInstallClass => [ __("Select installation class"), __("help"), 1, 1 ],
+ setupSCSI => [ __("Setup SCSI"), __("help"), 1, 0 ],
+ partitionDisks => [ __("Setup filesystems"), __("help"), 1, 0 ],
+ formatPartitions => [ __("Format partitions"), __("help"), 1, -1, "partitionDisks" ],
+ choosePackages => [ __("Choose packages to install"), __("help"), 1, 1 ],
+ doInstallStep => [ __("Install system"), __("help"), 1, -1, ["formatPartitions", "selectPath"] ],
# configureMouse => [ __("Configure mouse"), __("help"), 0, 0 ],
- finishNetworking => [ __("Configure networking"), __("help"), 0, 0 ],
+ finishNetworking => [ __("Configure networking"), __("help"), 1, 1, "formatPartitions" ],
# configureTimezone => [ __("Configure timezone"), __("help"), 0, 0 ],
# configureServices => [ __("Configure services"), __("help"), 0, 0 ],
# configurePrinter => [ __("Configure printer"), __("help"), 0, 0 ],
- setRootPassword => [ __("Set root password"), __("help"), 0, 0 ],
- addUser => [ __("Add a user"), __("help"), 0, 0 ],
- createBootdisk => [ __("Create bootdisk"), __("help"), 0, 1 ],
- setupBootloader => [ __("Install bootloader"), __("help"), 0, 1 ],
- configureX => [ __("Configure X"), __("help"), 0, 0 ],
- exitInstall => [ __("Exit install"), __("help"), 0, 0, undef, 'done' ],
-);
-
-# this table is translated at run time
-my @upgradeSteps = (
- selectLanguage => [ "Choose your language", "help", 0, 0 ],
- selectPath => [ __("Choose install or upgrade"), __("help"), 0, 0 ],
- selectInstallClass => [ __("Select installation class"), __("help"), 0, 0 ],
- setupSCSI => [ __("Setup SCSI"), __("help"), 0, 0 ],
- upgrFindInstall => [ __("Find current installation"), __("help"), 0, 0 ],
- findInstallFiles => [ __("Find installation files"), __("help"), 1, 0 ],
- upgrChoosePackages => [ __("Choose packages to upgrade"), __("help"), 0, 0 ],
- doInstallStep => [ __("Upgrade system"), __("help"), 0, 0 ],
- createBootdisk => [ __("Create bootdisk"), __("help"), 0, 0 , 'none' ],
- setupBootloader => [ __("Install bootloader"), __("help"), 0, 0 ],
- exitInstall => [ __("Exit install"), __("help"), 0, 0 , undef, 'done' ],
+ setRootPassword => [ __("Set root password"), __("help"), 1, 0, "formatPartitions" ],
+ addUser => [ __("Add a user"), __("help"), 1, 0, "formatPartitions" ],
+ createBootdisk => [ __("Create bootdisk"), __("help"), 1, 0, "doInstallStep" ],
+ setupBootloader => [ __("Install bootloader"), __("help"), 1, 1, "doInstallStep" ],
+ configureX => [ __("Configure X"), __("help"), 1, 0, "formatPartitions" ],
+ exitInstall => [ __("Exit install"), __("help"), 0, 0, "alldone" ],
);
my (%installSteps, %upgradeSteps, @orderedInstallSteps, @orderedUpgradeSteps);
for (my $i = 0; $i < @installSteps; $i += 2) {
my %h; @h{@installStepsFields} = @{ $installSteps[$i + 1] };
- $h{prev} ||= $installSteps[$i - 2];
- $h{next} ||= $installSteps[$i + 2];
+ $h{next} = $installSteps[$i + 2];
+ $h{onError} = $installSteps[$i + 2 * $h{onError}];
$installSteps{ $installSteps[$i] } = \%h;
push @orderedInstallSteps, $installSteps[$i];
}
$installSteps{first} = $installSteps[0];
-for (my $i = 0; $i < @upgradeSteps; $i += 2) {
- my %h; @h{@installStepsFields} = @{ $upgradeSteps[$i + 1] };
- $h{prev} ||= $upgradeSteps[$i - 2];
- $h{next} ||= $upgradeSteps[$i + 2];
- $upgradeSteps{ $upgradeSteps[$i] } = \%h;
- push @orderedUpgradeSteps, $installSteps[$i];
-}
-$upgradeSteps{first} = $upgradeSteps[0];
-my @install_classes = (__("newbie"), __("developer"), __("server"), __("expert"));
+my @install_classes = (__("beginner"), __("developer"), __("server"), __("expert"));
# partition layout for a server
my @serverPartitioning = (
@@ -91,16 +67,20 @@ my @serverPartitioning = (
my $default = {
# display => "192.168.1.9:0",
- user => { name => 'foo', password => 'foo', shell => '/bin/bash', realname => 'really, it is foo' },
- rootPassword => 'toto',
- lang => 'fr',
- isUpgrade => 0,
- installClass => 'newbie',
+
+ # for the list of fields available for user and superuser, see @etc_pass_fields in install_steps.pm
+# user => { name => 'foo', password => 'bar', home => '/home/foo', shell => '/bin/bash', realname => 'really, it is foo' },
+# superuser => { password => 'a', shell => '/bin/bash', realname => 'God' },
+
+# lang => 'fr',
+# isUpgrade => 0,
+# installClass => 'beginner',
bootloader => { onmbr => 1, linear => 0 },
+ autoSCSI => 0,
mkbootdisk => 0,
base => [ qw(basesystem initscripts console-tools mkbootdisk linuxconf anacron linux_logo rhs-hwdiag utempter ldconfig chkconfig ntsysv mktemp setup setuptool filesystem MAKEDEV SysVinit ash at authconfig bash bdflush binutils console-tools crontabs dev e2fsprogs ed etcskel file fileutils findutils getty_ps gpm grep groff gzip hdparm info initscripts isapnptools kbdconfig kernel less ldconfig lilo logrotate losetup man mkinitrd mingetty modutils mount net-tools passwd procmail procps psmisc mandrake-release rootfiles rpm sash sed setconsole setserial shadow-utils sh-utils slocate stat sysklogd tar termcap textutils time timeconfig tmpwatch util-linux vim-minimal vixie-cron which) ],
packages => [ qw() ],
- partitionning => { clearall => $::testing, eraseBadPartitions => 1, autoformat => 1 },
+ partitionning => { clearall => $::testing, eraseBadPartitions => 1, auto_allocate => 0, autoformat => 1 },
partitions => [
{ mntpoint => "/boot", size => 16 << 11, type => 0x83 },
{ mntpoint => "/", size => 300 << 11, type => 0x83 },
@@ -116,6 +96,13 @@ sub selectLanguage {
$o->{lang} = $o->chooseLanguage;
lang::set($o->{lang});
$o->{keyboard} = keyboard::setup();
+
+ addToBeDone {
+ unless ($o->{isUpgrade}) {
+ keyboard::write($o->{prefix}, $o->{keyboard});
+ lang::write($o->{prefix});
+ }
+ } 'doInstallStep';
}
sub selectPath {
@@ -127,16 +114,23 @@ sub selectPath {
sub selectInstallClass {
$o->{installClass} = $o->selectInstallClass(@install_classes);
$::expert = $o->{installClass} eq "expert";
+ $o->{autoSCSI} = $o->default("autoSCSI") || $o->{installClass} eq "beginner";
}
sub setupSCSI { $o->setupSCSI }
sub partitionDisks {
$o->{drives} = [ detect_devices::hds() ];
- $o->{hds} = fsedit::hds($o->{drives}, $o->{default}->{partitionning});
- @{$o->{hds}} > 0 or die _("An error has occurred - no valid devices were found on which to create new filesystems. Please check your hardware for the cause of this problem");
+ $o->{hds} = fsedit::hds($o->{drives}, $o->{default}{partitionning});
+ unless (@{$o->{hds}} > 0) {
+ $o->setupSCSI if $o->{autoSCSI}; # ask for an unautodetected scsi card
+ }
+ unless (@{$o->{hds}} > 0) { # no way
+ die _("An error has occurred - no valid devices were found on which to create new filesystems. Please check your hardware for the cause of this problem");
+ }
unless ($o->{isUpgrade}) {
+ eval { fsedit::auto_allocate($o->{hds}, $o->{partitions}) } if $o->{default}{partitionning}{auto_allocate};
$o->doPartitionDisks($o->{hds});
unless ($::testing) {
@@ -162,29 +156,26 @@ sub formatPartitions {
$::testing and return;
- foreach (@{$o->{fstab}}) {
- fs::format_part($_) if $_->{toFormat};
- }
+ $o->formatPartitions(@{$o->{fstab}});
+
fs::mount_all([ grep { isExt2($_) || isSwap($_) } @{$o->{fstab}} ], $o->{prefix});
}
-sub findInstallFiles {
+sub choosePackages {
$o->{packages} = pkgs::psUsingDirectory();
pkgs::getDeps($o->{packages});
$o->{compss} = pkgs::readCompss($o->{packages});
-}
-
-sub choosePackages {
- my @p = @{$o->{default}->{base}};
+
+ my @p = @{$o->{default}{base}};
push @p, "kernel-smp" if smp::detect();
- foreach (@p) { $o->{packages}->{$_}->{base} = 1 }
+ foreach (@p) { $o->{packages}{$_}{base} = 1 }
pkgs::setCompssSelected($o->{compss}, $o->{packages}, $o->{installClass});
$o->choosePackages($o->{packages}, $o->{compss});
- foreach (@p) { $o->{packages}->{$_}->{selected} = 1 }
+ foreach (@p) { $o->{packages}{$_}{selected} = 1 }
}
sub doInstallStep {
@@ -213,7 +204,7 @@ sub setupBootloader {
$o->{isUpgrade} or modules::read_conf("$o->{prefix}/etc/conf.modules");
$o->setupBootloader;
}
-sub configureX { $o->setupXfree if $o->{packages}->{XFree86}->{installed} }
+sub configureX { $o->setupXfree if $o->{packages}{XFree86}{installed} }
sub exitInstall { $o->exitInstall }
@@ -244,22 +235,32 @@ sub main {
$o = install_steps_graphical->new($o);
- $o->{netc} = net::readNetConfig("/tmp");
+ $o->{netc} = network::read_conf("/tmp/network");
if (my ($file) = glob_('/tmp/ifcfg-*')) {
log::l("found network config file $file");
- $o->{intf} = net::readNetInterfaceConfig($file);
+ $o->{intf} = network::read_interface_conf($file);
}
- modules::load_deps("/lib/modules/modules.dep");
+ modules::load_deps("/modules/modules.dep");
modules::read_conf("/tmp/conf.modules");
- for (my $step = $o->{steps}->{first}; $step ne 'done'; $step = getNextStep($step)) {
- $o->enteringStep($step);
+ for ($o->{step} = $o->{steps}{first};; $o->{step} = getNextStep()) {
+ $o->enteringStep($o->{step});
+ $o->{steps}{$o->{step}}{entered} = 1;
eval {
- &{$install2::{$step}}();
+ &{$install2::{$o->{step}}}();
};
- $o->errorInStep($@), redo if $@;
- $o->leavingStep($step);
+ $@ =~ /^setstep (.*)/ and $o->{step} = $1, redo;
+ $@ =~ /^theme_changed$/ and redo;
+ if ($@) {
+ $o->errorInStep($@);
+ $o->{step} = $o->{steps}{$o->{step}}{onError};
+ redo;
+ }
+ $o->leavingStep($o->{step});
+ $o->{steps}{$o->{step}}{done} = 1;
+
+ last if $o->{step} eq 'exitInstall';
}
killCardServices();
diff --git a/perl-install/install_any.pm b/perl-install/install_any.pm
index 1233b6e9e..9cf68eb7b 100644
--- a/perl-install/install_any.pm
+++ b/perl-install/install_any.pm
@@ -6,7 +6,7 @@ use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK);
@ISA = qw(Exporter);
%EXPORT_TAGS = (
- all => [ qw(versionString getNextStep doSuspend spawnSync spawnShell) ],
+ all => [ qw(versionString getNextStep doSuspend spawnSync spawnShell addToBeDone) ],
);
@EXPORT_OK = map { @$_ } values %EXPORT_TAGS;
@@ -26,7 +26,7 @@ sub imageGetFile {
}
sub versionString {
- my $kernel = $::o->{packages}->{kernel};
+ my $kernel = $::o->{packages}{kernel};
$kernel && $kernel->{header} or die "I couldn't find the kernel package!";
c::headerGetEntry($kernel->{header}, 'version') . "-" .
@@ -35,11 +35,9 @@ sub versionString {
sub getNextStep {
- my ($lastStep) = @_;
-
- $::o->{direction} = 1;
-
- return $::o->{lastChoice} = $::o->{steps}->{$lastStep}->{next};
+ my ($s) = $::o->{steps}{first};
+ $s = $::o->{steps}{$s}{next} while $::o->{steps}{$s}{done};
+ $s;
}
sub doSuspend {
@@ -92,11 +90,17 @@ sub mouse_detect() {
sub shells($) {
my ($o) = @_;
- my @l = grep { -x "$o->{prefix}$_" } @{$o->{default}->{shells}};
+ my @l = grep { 1 || -x "$o->{prefix}$_" } @{$o->{default}{shells}};
@l or die "no shell available";
@l;
}
+sub addToBeDone(&$) {
+ my ($f, $step) = @_;
+
+ push @{$::o->{steps}{$step}{toBeDone}}, $f;
+}
+
sub upgrFindInstall {
# int rc;
#
diff --git a/perl-install/install_steps.pm b/perl-install/install_steps.pm
index 64854e6e3..422c3657a 100644
--- a/perl-install/install_steps.pm
+++ b/perl-install/install_steps.pm
@@ -3,9 +3,10 @@ package install_steps;
use diagnostics;
use strict;
-use common qw(:file :system);
+use common qw(:file :system :common);
use install_any qw(:all);
use partition_table qw(:types);
+use modules;
use run_program;
use lilo;
use lang;
@@ -15,6 +16,11 @@ use cpio;
use log;
use fsedit;
use commands;
+use network;
+use fs;
+
+
+my @etc_pass_fields = qw(name password uid gid realname home shell);
my $o;
@@ -28,25 +34,55 @@ sub new($$) {
$o = bless $o_, ref $type || $type;
}
+sub default {
+ my ($o, $field) = @_;
+ $o->{$field} || $o->{default}{$field};
+}
+
sub enteringStep($$) {
my ($o, $step) = @_;
log::l("starting step `$step'");
+ $o->kill;
+
+ for (my $s = $o->{steps}{first}; $s; $s = $o->{steps}{$s}{next}) {
+
+ next if $o->{steps}{$s}{done} && !$o->{steps}{$s}{redoable};
+
+ my $reachable = 1;
+ if (my $needs = $o->{steps}{$s}{needs}) {
+ my @l = ref $needs ? @$needs : $needs;
+ $reachable = min(map { $o->{steps}{$_}{done} } @l);
+ }
+ if ($reachable && !$o->{steps}{$s}{reachable}) {
+ $o->{steps}{$s}{reachable} = 1;
+ $o->step_set_reachable($s);
+ }
+ }
}
sub leavingStep($$) {
my ($o, $step) = @_;
log::l("step `$step' finished");
+
+ unless ($o->{steps}{$step}{redoable}) {
+ $o->{steps}{$step}{reachable} = 0;
+ $o->step_set_unreachable($step);
+ }
+
+ while (my $f = shift @{$o->{steps}{$step}{toBeDone} || []}) {
+ &$f();
+ }
}
sub errorInStep($$) {}
sub chooseLanguage($) {
- $o->{default}->{lang};
+ $o->default("lang");
}
sub selectInstallOrUpgrade($) {
- $o->{default}->{isUpgrade} || 0;
+ $o->default("isUpgrade") || 0;
}
sub selectInstallClass($@) {
- $o->{default}->{installClass} || $_[1];
+ $o->default("installClass") || $_[1];
}
sub setupSCSI {
modules::load_thiskind('scsi');
@@ -54,7 +90,7 @@ sub setupSCSI {
sub doPartitionDisks($$) {
my ($o, $hds) = @_;
- fsedit::auto_allocate($hds, $o->{default}->{partitions});
+ fsedit::auto_allocate($hds, $o->{default}{partitions});
}
sub rebootNeeded($) {
my ($o) = @_;
@@ -66,8 +102,15 @@ sub choosePartitionsToFormat($$) {
my ($o, $fstab) = @_;
foreach (@$fstab) {
- $_->{toFormat} = $_->{mntpoint} && (isExt2($_) || isSwap($_)) &&
- ($_->{notFormatted} || $o->{default}->{partitionning}->{autoformat});
+ $_->{toFormat} = ($_->{mntpoint} && isExt2($_) || isSwap($_)) &&
+ ($_->{notFormatted} || $o->{default}{partitionning}{autoformat});
+ }
+}
+
+sub formatPartitions {
+ my $o = shift;
+ foreach (@_) {
+ fs::format_part($_) if $_->{toFormat};
}
}
@@ -76,17 +119,8 @@ sub choosePackages($$$) {
}
sub beforeInstallPackages($) {
-
- foreach (qw(dev etc home mnt tmp var var/tmp var/lib var/lib/rpm)) {
- mkdir "$o->{prefix}/$_", 0755;
- }
-
- unless ($o->{isUpgrade}) {
- local *F;
- open F, "> $o->{prefix}/etc/hosts" or die "Failed to create etc/hosts: $!";
- print F "127.0.0.1 localhost localhost.localdomain\n";
- }
-
+ mkdir "$o->{prefix}/$_", 0755 foreach qw(dev etc home mnt tmp var var/tmp var/lib var/lib/rpm);
+ network::add2hosts("$o->{prefix}/etc/hosts", "127.0.0.1", "localhost.localdomain");
pkgs::init_db($o->{prefix}, $o->{isUpgrade});
}
@@ -99,10 +133,6 @@ sub installPackages($$) {
sub afterInstallPackages($) {
my ($o) = @_;
- unless ($o->{isUpgrade}) {
- keyboard::write($o->{prefix}, $o->{keyboard});
- lang::write($o->{prefix});
- }
# why not?
sync(); sync();
@@ -115,25 +145,16 @@ sub mouseConfig($) {
sub finishNetworking($) {
my ($o) = @_;
+ my $etc = "$o->{prefix}/etc";
#
# rc = checkNetConfig(&$o->{intf}, &$o->{netc}, &$o->{intfFinal},
# &$o->{netcFinal}, &$o->{driversLoaded}, $o->{direction});
-#
-# if (rc) return rc;
-#
-# sprintf(path, "%s/etc/sysconfig", $o->{rootPath});
-# writeNetConfig(path, &$o->{netcFinal},
-# &$o->{intfFinal}, 0);
-# strcat(path, "/network-scripts");
-# writeNetInterfaceConfig(path, &$o->{intfFinal});
-# sprintf(path, "%s/etc", $o->{rootPath});
-# writeResolvConf(path, &$o->{netcFinal});
-#
-# # this is a bit of a hack
-# writeHosts(path, &$o->{netcFinal},
-# &$o->{intfFinal}, !$o->{isUpgrade});
-#
-# return 0;
+ network::write_conf("$etc/sysconfig/network", $o->{netc});
+ network::write_interface_conf("$etc/sysconfig/network-scripts/ifcfg-$o->{intf}{DEVICE}", $o->{intf});
+ network::write_resolv_conf("$etc/resolv.conf", $o->{netc});
+ network::add2hosts("$etc/hosts", $o->{intf}{IPADDR}, $o->{netc}{HOSTNAME});
+# syscall_('sethostname', $hostname, length $hostname) or warn "sethostname failed: $!";
+ #res_init(); # reinit the resolver so DNS changes take affect
}
sub timeConfig {}
@@ -141,9 +162,10 @@ sub servicesConfig {}
sub setRootPassword($) {
my ($o) = @_;
+ my %u = %{$o->default("superuser")};
my $p = $o->{prefix};
- my $pw = $o->{default}->{rootPassword};
- $pw = crypt_($pw);
+
+ $u{password} = crypt_($u{password}) if $u{password};
my $f = "$p/etc/passwd";
my @lines = cat_($f, "failed to open file $f");
@@ -151,49 +173,55 @@ sub setRootPassword($) {
local *F;
open F, "> $f" or die "failed to write file $f: $!\n";
foreach (@lines) {
- s/^root:.*?:/root:$pw:/;
+ if (/^root:/) {
+ chomp;
+ my %l; @l{@etc_pass_fields} = split ':';
+ add2hash(\%u, \%l);
+ $_ = join(':', @u{@etc_pass_fields}) . "\n";
+ }
print F $_;
}
}
sub addUser($) {
my ($o) = @_;
- my %u = %{$o->{default}->{user}};
+ my %u = %{$o->default("user")};
my $p = $o->{prefix};
+ my @passwd = cat_("$p/etc/passwd");;
- my $new_uid;
- #my @uids = map { (split)[2] } cat__("$p/etc/passwd");
- #for ($new_uid = 500; member($new_uid, @uids); $new_uid++) {}
- for ($new_uid = 500; getpwuid($new_uid); $new_uid++) {}
+ !$u{name} || member($u{name}, map { (split ':')[0] } @passwd) and return;
- my $new_gid;
- #my @gids = map { (split)[2] } cat__("$p/etc/group");
- #for ($new_gid = 500; member($new_gid, @gids); $new_gid++) {}
- for ($new_gid = 500; getgrgid($new_gid); $new_gid++) {}
-
- my $homedir = "$p/home/$u{name}";
+ unless ($u{uid}) {
+ my @uids = map { (split ':')[2] } @passwd;
+ for ($u{uid} = 500; member($u{uid}, @uids); $u{uid}++) {}
+ }
+ unless ($u{gid}) {
+ my @gids = map { (split ':')[2] } cat_("$p/etc/group");
+ for ($u{gid} = 500; member($u{gid}, @gids); $u{gid}++) {}
+ }
+ $u{home} ||= "/home/$u{name}";
- my $pw = crypt_($u{password});
+ $u{password} = crypt_($u{password}) if $u{password};
local *F;
open F, ">> $p/etc/passwd" or die "can't append to passwd file: $!";
- print F "$u{name}:$pw:$new_uid:$new_gid:$u{realname}:/home/$u{name}:$u{shell}\n";
-
+ print F join(':', @u{@etc_pass_fields}), "\n";
+
open F, ">> $p/etc/group" or die "can't append to group file: $!";
- print F "$u{name}::$new_gid:\n";
+ print F "$u{name}::$u{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);
+ eval { commands::cp("-f", "$p/etc/skel", "$p$u{home}") }; $@ and log::l("copying of skel failed: $@"), mkdir("$p$u{home}", 0750);
+ commands::chown_("-r", "$u{uid}.$u{gid}", "$p$u{home}");
}
sub createBootdisk($) {
- lilo::mkbootdisk($o->{prefix}, versionString()) if $o->{default}->{mkbootdisk} && !$::testing;
+ lilo::mkbootdisk($o->{prefix}, versionString()) if $o->default("mkbootdisk") && !$::testing;
}
sub setupBootloader($) {
my ($o) = @_;
my $versionString = versionString();
- lilo::install($o->{prefix}, $o->{hds}, $o->{fstab}, $versionString, $o->{default}->{bootloader});
+ lilo::install($o->{prefix}, $o->{hds}, $o->{fstab}, $versionString, $o->default("bootloader"));
}
sub setupXfree {
diff --git a/perl-install/install_steps_interactive.pm b/perl-install/install_steps_interactive.pm
index e34a82d83..8f640d649 100644
--- a/perl-install/install_steps_interactive.pm
+++ b/perl-install/install_steps_interactive.pm
@@ -31,21 +31,22 @@ use partition_table qw(:types);
use install_steps;
use modules;
use lang;
+use fs;
use log;
1;
-
sub errorInStep($$) {
my ($o, $err) = @_;
$o->ask_warn(_("Error"), [ _("An error occured"), $err ]);
}
+
sub chooseLanguage($) {
my ($o) = @_;
lang::text2lang($o->ask_from_list("Language",
__("Which language do you want?"), # the translation may be used for the help
- [ lang::list() ]));
+ [ lang::list() ], lang::lang2text($o->default("lang"))));
}
sub selectInstallOrUpgrade($) {
@@ -53,25 +54,34 @@ sub selectInstallOrUpgrade($) {
$o->ask_from_list_(_("Install/Upgrade"),
_("Is it an install or an updgrade?"),
[ __("Install"), __("Upgrade") ],
- "Install") eq "Upgrade";
+ $o->default("isUpgrade") ? "Upgrade" : "Install") eq "Upgrade";
}
sub selectInstallClass($@) {
my ($o, @classes) = @_;
$o->ask_from_list_(_("Install Class"),
_("What type of user will you have?"),
- [ @classes ]);
+ [ @classes ], $o->default("installClass"));
}
sub setupSCSI {
my ($o) = @_;
- my @l = modules::load_thiskind('scsi');
+ my $w;
+ my @l = modules::load_thiskind('scsi', sub {
+ $w = $o->wait_message('',
+ [ _("Installing driver for scsi card %s", $_->[0]),
+ $o->{installClass} ne "beginner" ? _("(module %s)", $_->[1]) : ()
+ ]);
+ });
+ undef $w; # kill wait_message
+
+ $o->default("autoSCSI") and return;
while (1) {
@l ?
$o->ask_yesorno('',
[ _("Found ") . join(", ", map { $_->[0] } @l) . _(" scsi interfaces"),
- _("Do you have another one?") ]) :
- $o->ask_yesorno('', _("Do you have an scsi interface?")) or return;
+ _("Do you have another one?") ], "No") :
+ $o->ask_yesorno('', _("Do you have an scsi interface?"), "No") or return;
my $l = $o->ask_from_list('', _("What scsi card have you?"), [ modules::text_of_type('scsi') ]) or return;
my $m = modules::text2driver($l);
@@ -88,39 +98,54 @@ sub rebootNeeded($) {
sub choosePartitionsToFormat($$) {
my ($o, $fstab) = @_;
- my @l = grep { $_->{mntpoint} && (isExt2($_) || isSwap($_)) } @$fstab;
+
+ my @l = grep { $_->{mntpoint} && isExt2($_) || isSwap($_) } @$fstab;
my @r = $o->ask_many_from_list('', _("Choose the partitions you want to format"),
- [ map { $_->{mntpoint} } @l ],
+ [ map { $_->{mntpoint} || type2name($_->{type}) . " ($_->{device})" } @l ],
[ map { $_->{notFormatted} } @l ]);
- for (my $i = 0; $i < @l; $i++) {
- $l[$i]->{toFormat} = $r[$i];
+ defined @r or die "cancel";
+ my $i = 0;
+ $_->{toFormat} = $r[$i++] foreach @l;
+}
+
+sub formatPartitions {
+ my $o = shift;
+ my $w = $o->wait_message('', '');
+ foreach (@_) {
+ if ($_->{toFormat}) {
+ $w->set(_("Formatting partition %s", $_->{device}));
+ fs::format_part($_);
+ }
}
}
sub createBootdisk($) {
my ($o) = @_;
- if ($o->{default}->{mkbootdisk} = $o->ask_yesorno('',
+ if ($o->{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:)"));
+failures. Would you like to create a bootdisk for your system?"), !$o->default("mkbootdisk"))) {
+ $o->ask_warn('', _("Insert a floppy in drive fd0 (aka A:)"));
+ my $w = $o->wait_message('', _("Creating bootdisk"));
$o->SUPER::createBootdisk;
}
}
sub setupBootloader($) {
my ($o) = @_;
-
- my $where = $o->ask_from_list(_("Lilo Installation"), _("Where do you want to install the bootloader?"), [ _("First sector of drive"), _("First sector of boot partition") ]);
- $o->{default}->{bootloader}->{onmbr} = $where eq _("First sector of drive");
-
+ my @l = (__("First sector of drive"), __("First sector of boot partition"));
+
+ $o->{bootloader}{onmbr} =
+ $o->ask_from_list_(_("Lilo Installation"),
+ _("Where do you want to install the bootloader?"),
+ \@l,
+ $l[!$o->default("bootloader")->{onmbr}]
+ ) eq $l[0];
$o->SUPER::setupBootloader;
}
@@ -134,3 +159,5 @@ 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."));
}
+
+=cut
diff --git a/perl-install/install_steps_stdio.pm b/perl-install/install_steps_stdio.pm
index f5b05a0f1..8122c3ba2 100644
--- a/perl-install/install_steps_stdio.pm
+++ b/perl-install/install_steps_stdio.pm
@@ -18,7 +18,7 @@ use log;
sub enteringStep($$$) {
my ($o, $step) = @_;
- print _("Starting step `%s'\n", $o->{steps}->{$step}->{text});
+ print _("Starting step `%s'\n", $o->{steps}{$step}{text});
}
sub leavingStep {
my ($o) = @_;
@@ -50,7 +50,7 @@ sub setRootPassword($) {
print "Password (again for confirmation): ";
} until ($w{password} eq $o->readln());
- $o->{default}->{rootPassword} = $w{password};
+ $o->{default}{rootPassword} = $w{password};
$o->SUPER::setRootPassword;
}
@@ -68,6 +68,6 @@ sub addUser($) {
$w{shell} = $o->ask_from_list('', 'Shell', [ install_any::shells($o) ], "/bin/bash");
- $o->{default}->{user} = { map { $_ => $w{$_}->get_text } qw(name password realname shell) };
+ $o->{default}{user} = { map { $_ => $w{$_}->get_text } qw(name password realname shell) };
$o->SUPER::addUser;
}
diff --git a/perl-install/interactive.pm b/perl-install/interactive.pm
index 76ed30345..b0bd6bb7d 100644
--- a/perl-install/interactive.pm
+++ b/perl-install/interactive.pm
@@ -3,7 +3,7 @@ package interactive;
use diagnostics;
use strict;
-use common qw(:common);
+use common qw(:common :functional);
1;
@@ -18,11 +18,11 @@ sub ask_warn($$$) {
my ($o, $title, $message) = @_;
ask_from_list($o, $title, $message, [ _("Ok") ]);
}
-sub ask_yesorno($$$) {
+sub ask_yesorno($$$;$) {
my ($o, $title, $message, $def) = @_;
ask_from_list_($o, $title, $message, [ __("Yes"), __("No") ], $def ? "No" : "Yes") eq "Yes";
}
-sub ask_okcancel($$$) {
+sub ask_okcancel($$$;$) {
my ($o, $title, $message, $def) = @_;
ask_from_list_($o, $title, $message, [ __("Ok"), __("Cancel") ], $def ? "Cancel" : "Ok") eq "Ok";
}
@@ -56,3 +56,25 @@ sub ask_from_entry($$$;$) {
$o->ask_from_entryW($title, $message, $def);
}
+
+sub wait_message($$$) {
+ my ($o, $title, $message) = @_;
+
+ $message = ref $message ? $message : [ $message ];
+
+ my $w = $o->wait_messageW($title, [ _("Please wait"), @$message ]);
+ my $b = before_leaving { $o->wait_message_endW($w) };
+
+ # enable access through set
+ common::add_f4before_leaving(sub { $o->wait_message_nextW($_[1], $w) }, $b, 'set');
+ $b;
+}
+
+sub kill {
+ my ($o) = @_;
+ while ($o->{before_killing} && @interactive::objects > $o->{before_killing}) {
+ my $w = pop @interactive::objects;
+ $w->destroy;
+ }
+ $o->{before_killing} = @interactive::objects;
+}
diff --git a/perl-install/interactive_gtk.pm b/perl-install/interactive_gtk.pm
index de58e765d..7c52e0d97 100644
--- a/perl-install/interactive_gtk.pm
+++ b/perl-install/interactive_gtk.pm
@@ -12,19 +12,28 @@ use my_gtk qw(:helpers :wrappers);
1;
+# redefine ask_warn
+sub ask_warn {
+ my $o = shift;
+ local $my_gtk::grab = 1;
+ $o->SUPER::ask_warn(@_);
+}
+
sub ask_from_entryW {
my ($o, $title, $messages, $def) = @_;
- my_gtk::ask_from_entry($title, @$messages);
+ my $w = my_gtk->new($title, %$o);
+ $w->_ask_from_entry(@$messages);
+ $w->main;
}
sub ask_from_listW {
my ($o, $title, $messages, $l, $def) = @_;
if (@$l < 5 && sum(map { length $_ } @$l) < 70) {
- my $w = my_gtk->new($title);
+ my $w = my_gtk->new($title, %$o);
my $f = sub { $w->{retval} = $_[1]; Gtk->main_quit };
gtkadd($w->{window},
- gtkpack(create_box_with_title($o, @$messages),
+ gtkpack(create_box_with_title($w, @$messages),
gtkadd((@$l < 3 ? create_hbox() : create_vbox()),
map {
my $b = new Gtk::Button($_);
@@ -37,6 +46,53 @@ sub ask_from_listW {
$def->grab_focus if $def;
$w->main;
} else {
- my_gtk::ask_from_list($title, $messages, $l, $def);
+ my $w = my_gtk->new($title);
+ $w->_ask_from_list($messages, $l, $def);
+ $w->main;
}
}
+
+sub ask_many_from_listW {
+ my ($o, $title, $messages, $list, $default) = @_;
+ my @rr = @$default;
+ my $n = 0;
+ my $w = my_gtk->new('', %$o);
+ gtkadd($w->{window},
+ gtkpack(create_box_with_title($w, @$messages),
+ gtkpack(new Gtk::VBox(0,0),
+ map {
+ my $nn = $n++;
+ my $o = Gtk::CheckButton->new($_);
+ $o->set_active($rr[$nn]);
+ $o->signal_connect(clicked => sub { $rr[$nn] = !$rr[$nn] });
+ $o;
+ } @$list),
+ $w->create_okcancel,
+ )
+ );
+ $w->{ok}->grab_focus;
+ $w->main or return;
+ @rr;
+}
+
+sub wait_messageW($$$) {
+ my ($o, $title, $message) = @_;
+
+ my $w = my_gtk->new(_("Resizing"), %$o, grab => 1);
+ my $W = pop @$message;
+ gtkadd($w->{window},
+ gtkpack(new Gtk::VBox(0,0),
+ @$message,
+ $w->{wait_messageW} = new Gtk::Label($W)));
+ $w->sync;
+ $w;
+}
+sub wait_message_nextW {
+ my ($o, $message, $w) = @_;
+ $w->{wait_messageW}->set($message);
+ $w->sync;
+}
+sub wait_message_endW {
+ my ($o, $w) = @_;
+ $w->destroy;
+}
diff --git a/perl-install/interactive_stdio.pm b/perl-install/interactive_stdio.pm
index 40dcdbb7c..de848b9e6 100644
--- a/perl-install/interactive_stdio.pm
+++ b/perl-install/interactive_stdio.pm
@@ -78,3 +78,9 @@ sub ask_many_from_listW {
}
+sub wait_messageW {
+ my ($o, $title, $message) = @_;
+ print map { "$_\n" } @$message;
+}
+sub wait_message_nextW { print "$_[1]\n" }
+sub wait_message_endW { print "Done\n" }
diff --git a/perl-install/lang.pm b/perl-install/lang.pm
index fe03cf72d..9a30749a7 100644
--- a/perl-install/lang.pm
+++ b/perl-install/lang.pm
@@ -29,6 +29,7 @@ my %languages = (
1;
sub list { map { $_->[0] } values %languages }
+sub lang2text { $languages{$_[0]} && $languages{$_[0]}[0] }
sub text2lang {
my ($t) = @_;
while (my ($k, $v) = each %languages) {
@@ -42,8 +43,8 @@ sub set {
if ($lang) {
$ENV{LANG} = $ENV{LINGUAS} = $lang;
- $ENV{LC_ALL} = $languages{$lang}->[3];
- #if (my $f = $languages{$lang}->[1]) { load_font($f) }
+ $ENV{LC_ALL} = $languages{$lang}[3];
+ #if (my $f = $languages{$lang}[1]) { load_font($f) }
} else {
# stick with the default (English) */
delete $ENV{LANG};
diff --git a/perl-install/modules.pm b/perl-install/modules.pm
index 8c59b3431..e1e735e1b 100644
--- a/perl-install/modules.pm
+++ b/perl-install/modules.pm
@@ -4,11 +4,11 @@ use diagnostics;
use strict;
use vars qw(%loaded);
-use common qw(:file);
+use common qw(:common :file);
+use pci_probing::main;
use log;
use detect_devices;
use run_program;
-use pci;
%loaded = ();
@@ -231,11 +231,11 @@ sub load_raw($$$@) {
my ($name, $type, $minor, @options) = @_;
# @options or @options = guiGetModuleOptions($name);
- my $m = "/modules/$name.o";
- -r $m or $m = "/lib$m";
- -r $m or die "can't find module $name";
-
- run_program::run("insmod", $m, @options) or die("insmod $name failed");
+ my $f = "/tmp/$name.o";
+ run_program::run("cd /tmp ; bzip2 -cd /lib/modules.cpio.bz2 | cpio -i $name.o");
+ -r $f or die "can't find module $name";
+ run_program::run("insmod", $f, @options) or die("insmod $name failed");
+ unlink $f;
# this is a hack to make plip go
if ($name eq "parport_pc") {
@@ -259,7 +259,6 @@ sub load_deps($) {
my ($f, $deps) = split ':';
push @{$deps{$f}}, split ' ', $deps;
}
- 1;
}
sub read_conf {
@@ -271,43 +270,36 @@ sub read_conf {
foreach (<F>) {
/^alias\s+eth0\s+(\S+)/ and $loaded{$1} = { type => 'net', minor => 'ethernet' };
/^alias\s+scsi_hostadapter\s+(\S+)/ and $loaded{$1} = { type => 'scsi' };
- /^option\s+(\S+)\s+(.*)/ and $loaded{$1} = { type => 'other', options => [ split ' ', $2 ] };
+ /^options\s+(\S+)\s+(.*)/ and add2hash($loaded{$1} || {}, { type => 'other', options => [ split ' ', $2 ] });
}
- 1;
}
sub write_conf {
my ($file, $append) = @_;
my ($tr, $eth, $scsi) = (0, 0, 0);
- $append or rename($file, "$file.orig"), log::l("backing up old conf.modules");
+ $append or rename($file, "$file.orig"), log::l("backing up old $file");
local *F;
open F, ($append ? ">" : "") . "> $file" or die("cannot write module config file $file: $!\n");
while (my ($k, $v) = each %loaded) {
- unless ($append && $v->{persistFlags}->{alias}) {
- if ($v->{type} eq 'net') {
- $v->{minor} eq 'tr' and print F "alias tr", $tr++, " $k\n";
- $v->{minor} eq 'ethernet' and print F "alias eth", $eth++, " $k\n";
- } elsif ($v->{type} eq 'scsi') {
- print F "alias scsi_hostadapter", $scsi++, " $k\n";
- }
- }
- unless ($append && $v->{persistFlags}->{options} || !$v->{options}) {
- print F "options $k ", join(' ', @{$v->{options}}), "\n";
+ if ($v->{type} eq 'net') {
+ $v->{minor} eq 'tr' and print F "alias tr", $tr++, " $k\n";
+ $v->{minor} eq 'ethernet' and print F "alias eth", $eth++, " $k\n";
+ } elsif ($v->{type} eq 'scsi') {
+ print F "alias scsi_hostadapter", $scsi++, " $k\n";
}
+ print F "options $k ", join(' ', @{$v->{options}}), "\n" unless is_empty_array_ref($v->{options});
}
-
print F "alias parport_lowlevel parport_pc\n";
print F "pre-install pcmcia_core /etc/rc.d/init.d/pcmcia start\n";
- 1;
}
-sub load_thiskind($) {
- my ($type) = @_;
+sub load_thiskind($;&) {
+ my ($type, $f) = @_;
my @devs;
my $found;
@@ -315,14 +307,14 @@ sub load_thiskind($) {
@devs = pci_probing::main::probe($type);
log::l("pci probe found " . scalar @devs . " $type devices");
}
-
my %devs;
- foreach (map { $_->[1] } @devs) {
- $devs{$_}++ and log::l("multiple $_ devices found"), next;
- $drivers{$_} or log::l("module $_ not in install table"), next;
- log::l("found driver for $_");
- load($_);
- $found = $_;
+ foreach (@devs) {
+ my ($text, $mod) = @$_;
+ $devs{$mod}++ and log::l("multiple $mod devices found"), next;
+ $drivers{$mod} or log::l("module $mod not in install table"), next;
+ log::l("found driver for $mod");
+ &$f($text, $mod) if $f;
+ load($mod);
}
@devs;
}
@@ -331,7 +323,7 @@ sub load_thiskind($) {
sub removeDeviceDriver {
# my ($type) = @_;
#
-# my @m = grep { $loaded{$_}->{type} eq $type } keys %loaded;
+# my @m = grep { $loaded{$_}{type} eq $type } keys %loaded;
# @m or return 0;
# @m > 1 and log::l("removeDeviceDriver assume only one of each driver type is loaded, which is not the case (" . join(' ', @m) . ")");
# removeModule($m[0]);
diff --git a/perl-install/my_gtk.pm b/perl-install/my_gtk.pm
index 2fdfdda19..b530034fd 100644
--- a/perl-install/my_gtk.pm
+++ b/perl-install/my_gtk.pm
@@ -2,7 +2,7 @@ package my_gtk;
use diagnostics;
use strict;
-use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK);
+use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK $border);
@ISA = qw(Exporter);
%EXPORT_TAGS = (
@@ -18,7 +18,7 @@ use c;
use common qw(:common);
my $forgetTime = 1000; # in milli-seconds
-my $border = 10;
+$border = 5;
1;
@@ -26,20 +26,23 @@ my $border = 10;
# OO stuff
################################################################################
sub new {
- my ($type, $title, @opts) = @_;
+ my ($type, $title, %opts) = @_;
Gtk->init;
- my $o = bless { @opts }, $type;
+ my $o = bless { %opts }, $type;
$o->_create_window($title);
+ push @interactive::objects, $o unless $opts{no_interactive_objects};
$o;
}
sub main($;$) {
my ($o, $f) = @_;
$o->show;
- $o->{rwindow}->grab_add;
- do { Gtk->main } while ($o->{retval} && $f && !&$f());
- $o->{rwindow}->grab_remove;
+ $o->{rwindow}->grab_add if $my_gtk::grab || $o->{grab};
+ do {
+ Gtk->main
+ } while ($o->{retval} && $f && !&$f());
+ $o->{rwindow}->grab_remove if $my_gtk::grab || $o->{grab};
$o->destroy;
$o->{retval}
}
@@ -53,6 +56,7 @@ sub destroy($) {
$o->{rwindow}->destroy;
flush();
}
+sub DESTROY { goto &destroy }
sub sync($) {
my ($o) = @_;
$o->show;
@@ -65,7 +69,7 @@ sub flush(;$) {
Gtk->main_iteration while Gtk::Gdk->events_pending;
}
sub bigsize($) {
- $_[0]->{rwindow}->set_usize(600,400);
+ $_[0]{rwindow}->set_usize(600,400);
}
@@ -141,7 +145,7 @@ sub gtkset_mousecursor($) {
gtkroot()->set_cursor(Gtk::Gdk::Cursor->new($type));
}
-sub gtkset_background($$$) {
+sub gtkset_background {
my ($r, $g, $b) = @_;
my $root = gtkroot();
@@ -152,7 +156,6 @@ sub gtkset_background($$$) {
$root->set_background($color);
my ($h, $w) = $root->get_size;
-
$root->draw_rectangle($gc, 1, 0, 0, $w, $h);
}
@@ -176,7 +179,7 @@ sub create_okcancel($;$$) {
sub create_box_with_title($@) {
my $o = shift;
- @_ = map { warp_text($_) } @_;
+ @_ = map { ref $_ ? $_ : warp_text($_) } @_;
$o->{box} = gtkpack_(new Gtk::VBox(0,0),
map({
my $w = ref $_ ? $_ : new Gtk::Label($_);
@@ -285,9 +288,15 @@ sub _create_window($$) {
}
$w->set_title($title);
- $w->signal_connect("expose_event" => sub { c::XSetInputFocus($w->window->XWINDOW) }) if $my_gtk::force_focus;
+ $w->signal_connect("expose_event" => sub { c::XSetInputFocus($w->window->XWINDOW) }) if $my_gtk::force_focus || $o->{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;
+ $w->set_uposition(@{$my_gtk::force_position || $o->{force_position}}) if $my_gtk::force_position || $o->{force_position};
+
+ $w->signal_connect(size_allocate => sub {
+ my ($wi, $he) = @{$_[1]}[2,3];
+ my ($X, $Y, $Wi, $He) = @{$my_gtk::force_center || $o->{force_center}};
+ $w->set_uposition(max(0, $X + ($Wi - $wi) / 2), max(0, $Y + ($He - $he) / 2));
+ }) if ($my_gtk::force_center || $o->{force_center}) && !($my_gtk::force_position || $o->{force_position}) ;
$o->{window} = $f;
$o->{rwindow} = $w;
@@ -399,7 +408,7 @@ sub _ask_okcancel($@) {
sub _ask_file($$) {
my ($o, $title) = @_;
- my $f = $o->{window} = new Gtk::FileSelection $title;
+ my $f = $o->{rwindow} = new Gtk::FileSelection $title;
$f->ok_button->signal_connect(clicked => sub { $o->{retval} = $f->get_filename ; Gtk->main_quit });
$f->cancel_button->signal_connect(clicked => sub { Gtk->main_quit });
$f->hide_fileop_buttons;
diff --git a/perl-install/network.pm b/perl-install/network.pm
new file mode 100644
index 000000000..29edb4ff3
--- /dev/null
+++ b/perl-install/network.pm
@@ -0,0 +1,129 @@
+package network;
+
+use diagnostics;
+use strict;
+
+use Socket;
+
+use common qw(:common :file :system);
+use detect_devices;
+use modules;
+use log;
+
+1;
+
+
+sub read_conf {
+ my ($file) = @_;
+ my %netc = getVarsFromSh($file);
+ \%netc;
+}
+
+sub read_interface_conf {
+ my ($file) = @_;
+ my %intf = getVarsFromSh($file) or die "cannot open file $file: $!";
+
+ $intf{BOOTPROTO} ||= 'static';
+ $intf{isPtp} = $intf{NETWORK} eq '255.255.255.255';
+ $intf{isUp} = 1;
+ \%intf;
+}
+
+sub write_conf {
+ my ($file, $netc) = @_;
+
+ add2hash($netc, {
+ NETWORKING => "yes",
+ FORWARD_IPV4 => "false",
+ HOSTNAME => "localhost.localdomain",
+ DOMAINNAME => "localdomain",
+ });
+
+ setVarsInSh($file, $netc, qw(NETWORKING FORWARD_IPV4 HOSTNAME DOMAINNAME GATEWAY GATEWAYDEV));
+}
+
+sub add2hosts {
+ my ($file, $ip, $hostname) = @_;
+ my %l = ($ip => $hostname);
+
+ local *F;
+ if (-e $file) {
+ open F, $file or die "cannot open $file: $!";
+ /\s*(\S+)(.*)/ and $l{$1} = $2 foreach <F>;
+ }
+ log::l("writing host information to $file");
+ open F, ">$file" or die "cannot write $file: $!";
+ while (my ($ip, $v) = each %l) {
+ print F "$ip";
+ if ($v =~ /^\s/) {
+ print F $v;
+ } else {
+ print F "\t\t$v";
+ print F " $1" if $v =~ /(.*?)\./;
+ }
+ print F "\n";
+ }
+}
+
+sub write_resolv_conf {
+ my ($file, $netc) = @_;
+
+ # We always write these, even if they were autoconfigured. Otherwise, the reverse name lookup in the install doesn't work.
+ unless ($netc->{DOMAINNAME} || $netc->{dnsServers}) {
+ unlink($file);
+ log::l("neither domain name nor dns server are configured");
+ return 0;
+ }
+ my @l = cat_($file);
+
+ local *F;
+ open F, "> $file" or die "cannot write $file: $!";
+ print F "search $netc->{DOMAINNAME}\n" if $netc->{DOMAINNAME};
+ print F "nameserver $_\n" foreach @{$netc->{dnsServers}};
+ print F "#$_" foreach @l;
+
+ #res_init(); # reinit the resolver so DNS changes take affect
+ 1;
+}
+
+sub write_interface_conf {
+ my ($file, $intf) = @_;
+
+ add2hash($intf, { ONBOOT => "yes" });
+ setVarsInSh($file, $intf, qw(DEVICE BOOTPROTO IPADDR NETMASK NETWORK BROADCAST ONBOOT));
+}
+
+
+# The interface/gateway needs to be configured before this will work!
+sub guessHostname {
+ my ($prefix, $netc, $intf) = @_;
+
+ $intf->{isUp} && $netc->{dnsServers} or return 0;
+ $netc->{HOSTNAME} && $netc->{DOMAINNAME} and return 1;
+
+ write_resolv_conf("$prefix/etc/resolv.conf", $netc);
+
+# winStatus(40, 3, _("Hostname"), _("Determining host name and domain..."));
+ my $name = gethostbyaddr(Socket::inet_aton($intf->{IPADDR}), AF_INET) or log::l("reverse name lookup failed"), return 0;
+
+ log::l("reverse name lookup worked");
+
+ add2hash($netc, { HOSTNAME => $name, DOMAINNAME => $name =~ /\.(.*)/ });
+ 1;
+}
+
+sub addDefaultRoute {
+ my ($netc) = @_;
+ c::addDefaultRoute($netc->{gateway}) if $netc->{gateway} || !$::testing;
+}
+
+sub getAvailableNetDevice {
+ my $device = detect_devices::getNet();
+
+ unless ($device) {
+ modules::load_thiskind('net') or return;
+ $device = detect_devices::getNet();
+ }
+ $device;
+}
+
diff --git a/perl-install/partition_table.pm b/perl-install/partition_table.pm
index 861c657e2..5ef63bc65 100644
--- a/perl-install/partition_table.pm
+++ b/perl-install/partition_table.pm
@@ -11,7 +11,7 @@ use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK @important_types @fields2save);
@EXPORT_OK = map { @$_ } values %EXPORT_TAGS;
-use common qw(:common :system);
+use common qw(:common :system :functional);
use partition_table_raw;
use Data::Dumper;
@@ -88,22 +88,22 @@ sub type2fs($) { $type2fs{$_[0]} }
sub name2type($) { $types_rev{$_[0]} }
sub fs2type($) { $fs2type{$_[0]} }
-sub isExtended($) { $_[0]->{type} == 5 }
-sub isSwap($) { $type2fs{$_[0]->{type}} eq 'swap' }
-sub isExt2($) { $type2fs{$_[0]->{type}} eq 'ext2' }
-sub isDos($) { $ {{ 1=>1, 4=>1, 6=>1 }}{$_[0]->{type}} }
-sub isWin($) { $ {{ 0xb=>1, 0xc=>1, 0xe=>1 }}{$_[0]->{type}} }
-sub isNfs($) { $_[0]->{type} eq 'nfs' } # small hack
+sub isExtended($) { $_[0]{type} == 5 }
+sub isSwap($) { $type2fs{$_[0]{type}} eq 'swap' }
+sub isExt2($) { $type2fs{$_[0]{type}} eq 'ext2' }
+sub isDos($) { $ {{ 1=>1, 4=>1, 6=>1 }}{$_[0]{type}} }
+sub isWin($) { $ {{ 0xb=>1, 0xc=>1, 0xe=>1 }}{$_[0]{type}} }
+sub isNfs($) { $_[0]{type} eq 'nfs' } # small hack
sub isPrimary($$) {
my ($part, $hd) = @_;
- foreach (@{$hd->{primary}->{raw}}) { $part eq $_ and return 1; }
+ foreach (@{$hd->{primary}{raw}}) { $part eq $_ and return 1; }
0;
}
sub cylinder_size($) {
my ($hd) = @_;
- $hd->{geom}->{sectors} * $hd->{geom}->{heads};
+ $hd->{geom}{sectors} * $hd->{geom}{heads};
}
sub adjustStart($$) {
@@ -111,8 +111,8 @@ sub adjustStart($$) {
my $end = $part->{start} + $part->{size};
$part->{start} = round_up($part->{start},
- $part->{start} % cylinder_size($hd) < 2 * $hd->{geom}->{sectors} ?
- $hd->{geom}->{sectors} : cylinder_size($hd));
+ $part->{start} % cylinder_size($hd) < 2 * $hd->{geom}{sectors} ?
+ $hd->{geom}{sectors} : cylinder_size($hd));
$part->{size} = $end - $part->{start};
}
sub adjustEnd($$) {
@@ -138,26 +138,32 @@ sub verifyInside($$) {
$b->{start} <= $a->{start} && $a->{start} + $a->{size} <= $b->{start} + $b->{size};
}
-sub verifyPrimary($) {
- my ($pt) = @_;
- my @l = (@{$pt->{normal}}, $pt->{extended});
- foreach my $i (@l) { foreach (@l) {
+sub verifyParts_ {
+ foreach my $i (@_) { foreach (@_) {
$i != $_ and verifyNotOverlap($i, $_) || die "partitions $i->{start} $i->{size} and $_->{start} $_->{size} are overlapping!";
}}
}
+sub verifyParts($) {
+ my ($hd) = @_;
+ verifyParts_(get_normal_parts($hd));
+}
+sub verifyPrimary($) {
+ my ($pt) = @_;
+ verifyParts_(@{$pt->{normal}}, $pt->{extended});
+}
sub assign_device_numbers($) {
my ($hd) = @_;
my $i = 1;
- $_->{device} = $hd->{prefix} . $i++ foreach @{$hd->{primary}->{raw}},
+ $_->{device} = $hd->{prefix} . $i++ foreach @{$hd->{primary}{raw}},
map { $_->{normal} } @{$hd->{extended} || []};
# try to figure what the windobe drive letter could be!
#
# first verify there's at least one primary dos partition, otherwise it
# means it is a secondary disk and all will be false :(
- my ($c, @others) = grep { isDos($_) || isWin($_) } @{$hd->{primary}->{normal}};
+ my ($c, @others) = grep { isDos($_) || isWin($_) } @{$hd->{primary}{normal}};
$c or return;
$i = ord 'D';
@@ -170,7 +176,7 @@ sub assign_device_numbers($) {
sub remove_empty_extended($) {
my ($hd) = @_;
- my $last = $hd->{primary}->{extended} or return;
+ my $last = $hd->{primary}{extended} or return;
@{$hd->{extended}} = grep {
if ($_->{normal}) {
$last = $_;
@@ -189,27 +195,27 @@ sub adjust_main_extended($) {
my ($l, @l) = @{$hd->{extended}};
# the first is a special case, must recompute its real size
- my $start = round_down($l->{normal}->{start} - 1, cylinder_size($hd));
- my $end = $l->{normal}->{start} + $l->{normal}->{size};
+ my $start = round_down($l->{normal}{start} - 1, cylinder_size($hd));
+ my $end = $l->{normal}{start} + $l->{normal}{size};
foreach (map $_->{normal}, @l) {
$start = min($start, $_->{start});
$end = max($end, $_->{start} + $_->{size});
}
- $l->{start} = $hd->{primary}->{extended}->{start} = $start;
- $l->{size} = $hd->{primary}->{extended}->{size} = $end - $start;
+ $l->{start} = $hd->{primary}{extended}{start} = $start;
+ $l->{size} = $hd->{primary}{extended}{size} = $end - $start;
}
- unless (@{$hd->{extended} || []} || !$hd->{primary}->{extended}) {
- %{$hd->{primary}->{extended}} = (); # modify the raw entry
- delete $hd->{primary}->{extended};
+ unless (@{$hd->{extended} || []} || !$hd->{primary}{extended}) {
+ %{$hd->{primary}{extended}} = (); # modify the raw entry
+ delete $hd->{primary}{extended};
}
- verifyPrimary($hd->{primary}); # verify everything is all right
+ verifyParts($hd); # verify everything is all right
}
sub get_normal_parts($) {
my ($hd) = @_;
- @{$hd->{primary}->{normal} || []}, map { $_->{normal} } @{$hd->{extended} || []}
+ @{$hd->{primary}{normal} || []}, map { $_->{normal} } @{$hd->{extended} || []}
}
@@ -257,14 +263,14 @@ sub read_extended($$) {
@{$pt->{normal}} <= 1 or die "more than one normal partition in extended partition";
@{$pt->{normal}} >= 1 or die "no normal partition in extended partition";
- $pt->{normal} = $pt->{normal}->[0];
+ $pt->{normal} = $pt->{normal}[0];
# in case of extended partitions, the start sector is local to the partition or to the first extended_part!
- $pt->{normal}->{start} += $pt->{start};
+ $pt->{normal}{start} += $pt->{start};
- verifyInside($pt->{normal}, $extended) or die "partition $pt->{normal}->{device} is not inside its extended partition";
+ verifyInside($pt->{normal}, $extended) or die "partition $pt->{normal}{device} is not inside its extended partition";
if ($pt->{extended}) {
- $pt->{extended}->{start} += $hd->{primary}->{extended}->{start};
+ $pt->{extended}{start} += $hd->{primary}{extended}{start};
read_extended($hd, $pt->{extended}) or return 0;
}
1;
@@ -275,15 +281,15 @@ sub write($) {
my ($hd) = @_;
# set first primary partition active if no primary partitions are marked as active.
- for ($hd->{primary}->{raw}) {
- (grep { $_->{local_start} = $_->{start}; $_->{active} ||= 0 } @$_) or $_->[0]->{active} = 0x80;
+ for ($hd->{primary}{raw}) {
+ (grep { $_->{local_start} = $_->{start}; $_->{active} ||= 0 } @$_) or $_->[0]{active} = 0x80;
}
- partition_table_raw::write($hd, 0, $hd->{primary}->{raw}) or die "writing of partition table failed";
+ partition_table_raw::write($hd, 0, $hd->{primary}{raw}) or die "writing of partition table failed";
foreach (@{$hd->{extended}}) {
# in case of extended partitions, the start sector must be local to the partition
- $_->{normal}->{local_start} = $_->{normal}->{start} - $_->{start};
- $_->{extended} and $_->{extended}->{local_start} = $_->{extended}->{start} - $hd->{primary}->{extended}->{start};
+ $_->{normal}{local_start} = $_->{normal}{start} - $_->{start};
+ $_->{extended} and $_->{extended}{local_start} = $_->{extended}{start} - $hd->{primary}{extended}{start};
partition_table_raw::write($hd, $_->{start}, $_->{raw}) or die "writing of partition table failed";
}
@@ -300,7 +306,7 @@ sub write($) {
sub active($$) {
my ($hd, $part) = @_;
- $_->{active} = 0 foreach @{$hd->{primary}->{normal}};
+ $_->{active} = 0 foreach @{$hd->{primary}{normal}};
$part->{active} = 0x80;
}
@@ -311,9 +317,9 @@ sub remove($$) {
my $i;
# first search it in the primary partitions
- $i = 0; foreach (@{$hd->{primary}->{normal}}) {
+ $i = 0; foreach (@{$hd->{primary}{normal}}) {
if ($_ eq $part) {
- splice(@{$hd->{primary}->{normal}}, $i, 1);
+ splice(@{$hd->{primary}{normal}}, $i, 1);
%$_ = (); # blank it
return $hd->{isDirty} = $hd->{needKernelReread} = 1;
@@ -337,18 +343,18 @@ sub add_primary($$) {
my ($hd, $part) = @_;
{
- local $hd->{primary}->{normal}; # save it to fake an addition of $part, that way add_primary do not modify $hd if it fails
- push @{$hd->{primary}->{normal}}, $part;
+ local $hd->{primary}{normal}; # save it to fake an addition of $part, that way add_primary do not modify $hd if it fails
+ push @{$hd->{primary}{normal}}, $part;
adjust_main_extended($hd); # verify
- raw_add($hd->{primary}->{raw}, $part);
+ raw_add($hd->{primary}{raw}, $part);
}
- push @{$hd->{primary}->{normal}}, $part; # really do it
+ push @{$hd->{primary}{normal}}, $part; # really do it
}
sub add_extended($$) {
my ($hd, $part) = @_;
- my $e = $hd->{primary}->{extended};
+ my $e = $hd->{primary}{extended};
if ($e && !verifyInside($part, $e)) {
#ie "sorry, can't add outside the main extended partition" unless $::unsafe;
@@ -371,8 +377,8 @@ The only solution is to move your primary partitions to have the hole next to th
my $l = first (@{$hd->{extended}});
# the first is a special case, must recompute its real size
- $l->{start} = round_down($l->{normal}->{start} - 1, cylinder_size($hd));
- $l->{size} = $l->{normal}->{start} + $l->{normal}->{size} - $l->{start};
+ $l->{start} = round_down($l->{normal}{start} - 1, cylinder_size($hd));
+ $l->{size} = $l->{normal}{start} + $l->{normal}{size} - $l->{start};
my $ext = { %$l };
unshift @{$hd->{extended}}, { type => 5, raw => [ $part, $ext, {}, {} ], normal => $part, extended => $ext };
# size will be autocalculated :)
@@ -403,9 +409,9 @@ sub add($$;$) {
$part->{start} ||= 1; # starting at sector 0 is not allowed
adjustStartAndEnd($hd, $part);
- my $e = $hd->{primary}->{extended};
+ my $e = $hd->{primary}{extended};
- if (is_empty_array_ref($hd->{primary}->{normal}) || $want_primary) {
+ if (is_empty_array_ref($hd->{primary}{normal}) || $want_primary) {
eval { add_primary($hd, $part) };
return unless $@;
}
@@ -461,7 +467,7 @@ sub load($$;$) {
my %h; @h{@fields2save} = @$h;
- $h{totalsectors} == $hd->{totalsectors} or $force or die "Bad totalsectors";
+ $h{totalsectors} == $hd->{totalsectors} or $force or cdie("Bad totalsectors");
# unsure we don't modify totalsectors
local $hd->{totalsectors};
diff --git a/perl-install/partition_table_raw.pm b/perl-install/partition_table_raw.pm
index 67223e392..aa25321a2 100644
--- a/perl-install/partition_table_raw.pm
+++ b/perl-install/partition_table_raw.pm
@@ -34,8 +34,8 @@ sub CHS2rawCHS($$$) {
sub sector2CHS($$) {
my ($hd, $start) = @_;
my ($s, $h);
- ($start, $s) = divide($start, $hd->{geom}->{sectors});
- ($start, $h) = divide($start, $hd->{geom}->{heads});
+ ($start, $s) = divide($start, $hd->{geom}{sectors});
+ ($start, $h) = divide($start, $hd->{geom}{heads});
($start, $h, $s + 1);
}
@@ -51,7 +51,7 @@ sub get_geometry($) {
{ geom => \%geom, totalsectors => $geom{heads} * $geom{sectors} * $geom{cylinders} };
}
-sub openit($$;$) { sysopen $_[1], $_[0]->{file}, $_[2] || 0; }
+sub openit($$;$) { sysopen $_[1], $_[0]{file}, $_[2] || 0; }
# cause kernel to re-read partition table
sub kernel_read($) {
@@ -102,6 +102,6 @@ sub write($$$) {
sub clear_raw { { raw => [ ({}) x $nb_primary ] } }
sub zero_MBR($) {
- $_[0]->{primary} = clear_raw();
- delete $_[0]->{extended};
+ $_[0]{primary} = clear_raw();
+ delete $_[0]{extended};
}
diff --git a/perl-install/pkgs.pm b/perl-install/pkgs.pm
index 340036fc9..970fa2209 100644
--- a/perl-install/pkgs.pm
+++ b/perl-install/pkgs.pm
@@ -92,16 +92,6 @@ sub set($$$) {
$val ? &select($packages, $p) : unselect($packages, $p);
}
-sub addInfosFromHeader($$;$) {
- my ($packages, $header, $file) = @_;
-
- my $name = c::headerGetEntry($header, 'name');
- $packages->{$name} = {
- name => $name, file => $file, selected => 0, deps => [],
- header => $header, size => c::headerGetEntry($header, 'size'),
- };
-}
-
sub psUsingDirectory(;$) {
my ($dirname) = @_;
my %packages;
@@ -119,6 +109,10 @@ sub psUsingDirectory(;$) {
\%packages;
}
+sub chop_version($) {
+ first($_[0] =~ /(.*)-[^-]+-[^-.]+/) || $_[0];
+}
+
sub getDeps($) {
my ($packages) = @_;
@@ -126,10 +120,11 @@ sub getDeps($) {
open F, install_any::imageGetFile("depslist") or die "can't find dependencies list";
foreach (<F>) {
my ($name, $size, @deps) = split;
+ ($name, @deps) = map { chop_version($_) } ($name, @deps);
$packages->{$name} or next;
- $packages->{$name}->{size} = $size;
- $packages->{$name}->{deps} = \@deps;
- map { push @{$packages->{$_}->{provides}}, $name if $packages->{$_} } @deps;
+ $packages->{$name}{size} = $size;
+ $packages->{$name}{deps} = \@deps;
+ map { push @{$packages->{$_}{provides}}, $name if $packages->{$_} } @deps;
}
}
@@ -186,24 +181,26 @@ sub setCompssSelected($$$) {
}
}
-sub psFromHeaderListDesc {
+sub addHdlistInfos {
my ($fd, $noSeek) = @_;
my %packages;
my $end;
+ my $file;
+ local *F;
+ sysopen F, $file, 0 or die "error opening header file $file: $!";
- unless ($noSeek) {
- my $current = sysseek $fd, 0, 1 or die "seek failed";
- $end = sysseek $fd, 0, 2 or die "seek failed";
- sysseek $fd, $current, 0 or die "seek failed";
- }
+ $end = sysseek $fd, 0, 2 or die "seek failed";
+ sysseek $fd, 0, 0 or die "seek failed";
- while (1) {
+ while (sysseek($fd, 0, 1) <= $end) {
my $header = c::headerRead(fileno($fd), 1);
unless ($header) {
$noSeek and last;
die "error reading header at offset ", sysseek($fd, 0, 1);
}
- addInfosFromHeader(\%packages, $header);
+
+ c::headerGetEntry($header, 'name');
+
$noSeek or $end <= sysseek($fd, 0, 1) and last;
}
@@ -212,13 +209,6 @@ sub psFromHeaderListDesc {
\%packages;
}
-sub psFromHeaderListFile {
- my ($file) = @_;
- local *F;
- sysopen F, $file, 0 or die "error opening header file $file: $!";
- psFromHeaderListDesc(\*F, 0);
-}
-
sub init_db {
my ($prefix, $isUpgrade) = @_;
diff --git a/perl-install/resize_fat/any.pm b/perl-install/resize_fat/any.pm
index 8c57eb6b0..e4747dc87 100644
--- a/perl-install/resize_fat/any.pm
+++ b/perl-install/resize_fat/any.pm
@@ -33,7 +33,7 @@ sub max_cluster_count($) {
# calculates the minimum size of a partition, in physical sectors
sub min_size($) {
my ($fs) = @_;
- my $count = $fs->{clusters}->{count};
+ my $count = $fs->{clusters}{count};
# directories are both in `used' and `dirs', so are counted twice
# It's done on purpose since we're moving all directories. So at the worse
@@ -71,12 +71,12 @@ sub flag_clusters {
for (; !resize_fat::fat::is_eof($cluster); $cluster = resize_fat::fat::next($fs, $cluster)) {
$cluster == 0 and die "Bad FAT: unterminated chain for $entry->{name}\n";
- $fs->{fat_flag_map}->[$cluster] and die "Bad FAT: cluster $cluster is cross-linked for $entry->{name}\n";
- $fs->{fat_flag_map}->[$cluster] = $type;
- $fs->{clusters}->{count}->{dirs}++ if $type == $DIRECTORY;
+ $fs->{fat_flag_map}[$cluster] and die "Bad FAT: cluster $cluster is cross-linked for $entry->{name}\n";
+ $fs->{fat_flag_map}[$cluster] = $type;
+ $fs->{clusters}{count}{dirs}++ if $type == $DIRECTORY;
}
};
$fs->{fat_flag_map} = [ ($FREE) x ($fs->{nb_clusters} + 2) ];
- $fs->{clusters}->{count}->{dirs} = 0;
+ $fs->{clusters}{count}{dirs} = 0;
resize_fat::directory::traverse_all($fs, $f);
}
diff --git a/perl-install/resize_fat/fat.pm b/perl-install/resize_fat/fat.pm
index 371e90feb..87ce2af71 100644
--- a/perl-install/resize_fat/fat.pm
+++ b/perl-install/resize_fat/fat.pm
@@ -18,7 +18,7 @@ sub read($) {
$fat;
} (0 .. $fs->{nb_fats} - 1);
- $fs->{fat} = $fs->{fats}->[0];
+ $fs->{fat} = $fs->{fats}[0];
my ($free, $bad, $used) = (0, 0, 0);
@@ -28,7 +28,7 @@ sub read($) {
elsif ($cluster == $resize_fat::bad_cluster_value) { $bad++; }
else { $used++; }
}
- @{$fs->{clusters}->{count}}{qw(free bad used)} = ($free, $bad, $used);
+ @{$fs->{clusters}{count}}{qw(free bad used)} = ($free, $bad, $used);
}
sub write($) {
@@ -49,7 +49,7 @@ sub write($) {
sub allocate_remap {
my ($fs, $cut_point) = @_;
my ($cluster, $new_cluster);
- my $remap = sub { $fs->{fat_remap}->[$cluster] = $new_cluster; };
+ my $remap = sub { $fs->{fat_remap}[$cluster] = $new_cluster; };
my $get_new = sub {
$new_cluster = get_free($fs);
0 < $new_cluster && $new_cluster < $cut_point or die "no free clusters";
@@ -57,11 +57,11 @@ sub allocate_remap {
#log::ld("resize_fat: [$cluster,", &next($fs, $cluster), "...]->$new_cluster...");
};
- $fs->{fat_remap}->[0] = 0;
+ $fs->{fat_remap}[0] = 0;
$fs->{last_free_cluster} = 2;
for ($cluster = 2; $cluster < $fs->{nb_clusters} + 2; $cluster++) {
if ($cluster < $cut_point) {
- if ($fs->{fat_flag_map}->[$cluster] == $resize_fat::any::DIRECTORY) {
+ if ($fs->{fat_flag_map}[$cluster] == $resize_fat::any::DIRECTORY) {
&$get_new();
} else {
$new_cluster = $cluster;
@@ -80,10 +80,10 @@ sub update {
my ($fs) = @_;
for (my $cluster = 2; $cluster < $fs->{nb_clusters} + 2; $cluster++) {
- if ($fs->{fat_flag_map}->[$cluster]) {
+ if ($fs->{fat_flag_map}[$cluster]) {
my $old_next = &next($fs, $cluster);
- my $new = $fs->{fat_remap}->[$cluster];
- my $new_next = $fs->{fat_remap}->[$old_next];
+ my $new = $fs->{fat_remap}[$cluster];
+ my $new_next = $fs->{fat_remap}[$old_next];
set_available($fs, $cluster);
@@ -101,7 +101,7 @@ sub update {
sub check($) {
my ($fs) = @_;
foreach (@{$fs->{fats}}) {
- $_ eq $fs->{fats}->[0] or die "FAT tables do not match";
+ $_ eq $fs->{fats}[0] or die "FAT tables do not match";
}
}
diff --git a/perl-install/resize_fat/info_sector.pm b/perl-install/resize_fat/info_sector.pm
index 5b92501ea..2eacf58ca 100644
--- a/perl-install/resize_fat/info_sector.pm
+++ b/perl-install/resize_fat/info_sector.pm
@@ -22,13 +22,13 @@ sub read($) {
my ($fs) = @_;
my $info = resize_fat::io::read($fs, $fs->{info_offset}, psizeof($format));
@{$fs->{info_sector}}{@fields} = unpack $format, $info;
- $fs->{info_sector}->{signature} == 0x61417272 or die "Invalid information sector signature\n";
+ $fs->{info_sector}{signature} == 0x61417272 or die "Invalid information sector signature\n";
}
sub write($) {
my ($fs) = @_;
- $fs->{info_sector}->{free_clusters} = $fs->{clusters}->{count}->{free};
- $fs->{info_sector}->{next_cluster} = 2;
+ $fs->{info_sector}{free_clusters} = $fs->{clusters}->{count}->{free};
+ $fs->{info_sector}{next_cluster} = 2;
my $info = pack $format, @{$fs->{info_sector}}{@fields};
diff --git a/perl-install/resize_fat/main.pm b/perl-install/resize_fat/main.pm
index 6239e6075..55cc34d7b 100644
--- a/perl-install/resize_fat/main.pm
+++ b/perl-install/resize_fat/main.pm
@@ -64,8 +64,8 @@ sub copy_clusters {
}
};
for (; $cluster < $fs->{nb_clusters} + 2; $cluster++) {
- $fs->{fat_flag_map}->[$cluster] == $resize_fat::any::FILE or next;
- push @buffer, $fs->{fat_remap}->[$cluster], resize_fat::io::read_cluster($fs, $cluster);
+ $fs->{fat_flag_map}[$cluster] == $resize_fat::any::FILE or next;
+ push @buffer, $fs->{fat_remap}[$cluster], resize_fat::io::read_cluster($fs, $cluster);
@buffer > 50 and &$flush();
}
&$flush();
@@ -78,14 +78,14 @@ sub construct_dir_tree {
if ($resize_fat::isFAT32) {
# fat32's root must remain in the first 64k clusters
# so don't set it as DIRECTORY, it will be specially handled
- $fs->{fat_flag_map}->[$fs->{fat32_root_dir_cluster}] = $resize_fat::any::FREE;
+ $fs->{fat_flag_map}[$fs->{fat32_root_dir_cluster}] = $resize_fat::any::FREE;
}
for (my $cluster = 2; $cluster < $fs->{nb_clusters} + 2; $cluster++) {
- $fs->{fat_flag_map}->[$cluster] == $resize_fat::any::DIRECTORY or next;
+ $fs->{fat_flag_map}[$cluster] == $resize_fat::any::DIRECTORY or next;
resize_fat::io::write_cluster($fs,
- $fs->{fat_remap}->[$cluster],
+ $fs->{fat_remap}[$cluster],
resize_fat::directory::remap($fs, resize_fat::io::read_cluster($fs, $cluster)));
}
@@ -101,7 +101,7 @@ sub construct_dir_tree {
my $cluster = $fs->{fat32_root_dir_cluster};
resize_fat::io::write_cluster($fs,
- $fs->{fat_remap}->[$cluster],
+ $fs->{fat_remap}[$cluster],
resize_fat::directory::remap($fs, resize_fat::io::read_cluster($fs, $cluster)));
} else {
resize_fat::io::write($fs, $fs->{root_dir_offset}, $fs->{root_dir_size},
@@ -147,8 +147,8 @@ sub resize {
$fs->{nb_sectors} = $size;
$fs->{nb_clusters} = $new_nb_clusters;
- $fs->{clusters}->{count}->{free} =
- $fs->{nb_clusters} - $fs->{clusters}->{count}->{used} - $fs->{clusters}->{count}->{bad} - 2;
+ $fs->{clusters}{count}->{free} =
+ $fs->{nb_clusters} - $fs->{clusters}{count}->{used} - $fs->{clusters}->{count}->{bad} - 2;
$fs->{system_id} = 'was here!';
$fs->{small_nb_sectors} = 0;
diff --git a/perl-install/share/diskdrake.rc b/perl-install/share/diskdrake.rc
index 6d315056e..e92a089b4 100644
--- a/perl-install/share/diskdrake.rc
+++ b/perl-install/share/diskdrake.rc
@@ -21,6 +21,7 @@ style "blue" = "font"
style "white" = "font"
{
bg[NORMAL] = { 1.0, 1.0, 1.0 }
+ bg[PRELIGHT] = { 0.67, 0.67, 0.67 }
}
widget "*Linux*" style "red"
diff --git a/perl-install/share/install.rc b/perl-install/share/install.rc
index aa893579d..44e808c66 100644
--- a/perl-install/share/install.rc
+++ b/perl-install/share/install.rc
@@ -1,22 +1,14 @@
-
-
-style "border"
-{
- bg[NORMAL] = { 0, 0, 0 }
-}
-
style "steps"
{
bg[NORMAL] = { 0, 0, 0 }
fg[NORMAL] = { 1.0, 1.0, 1.0 }
+ font = "-adobe-helvetica-medium-r-normal-*-*-80-*-*-p-*-iso8859-1"
}
-style "title"
+style "logo"
{
- bg[NORMAL] = { 0, 0.66, 1.0 }
-# fg[NORMAL] = { 1.0, 1.0, 1.0 }
+ bg[NORMAL] = { 1.0, 1.0, 1.0 }
}
-
-widget "*Title" style "title"
-widget "*Steps" style "steps"
+widget "*Steps*" style "steps"
+widget "*logo*" style "logo" \ No newline at end of file
diff --git a/perl-install/share/list b/perl-install/share/list
index 301cbb4a7..3ab0eed94 100644
--- a/perl-install/share/list
+++ b/perl-install/share/list
@@ -1,6 +1,8 @@
/bin/ash
+/bin/cpio
/sbin/insmod
/sbin/mke2fs
+/usr/bin/bzip2
/usr/lib/rpm/rpmrc
/usr/X11R6/bin/xmodmap
/usr/X11R6/bin/XF86_VGA16
diff --git a/perl-install/share/themes-blackwhite.rc b/perl-install/share/themes-blackwhite.rc
new file mode 100644
index 000000000..bc94df9aa
--- /dev/null
+++ b/perl-install/share/themes-blackwhite.rc
@@ -0,0 +1,40 @@
+style "any"
+{
+ font = "-adobe-helvetica-medium-r-normal-*-*-100-*-*-p-*-iso8859-1"
+
+ bg[NORMAL] = { 0.67, 0.67, 0.67 }
+ bg[ACTIVE] = { 0, 0, 0 }
+ bg[PRELIGHT] = { 0, 0, 0 }
+ bg[INSENSITIVE] = { 0, 0, 0 }
+
+ fg[NORMAL] = { 1.0, 1.0, 1.0 }
+ fg[ACTIVE] = { 1.0, 1.0, 1.0 }
+ fg[PRELIGHT] = { 1.0, 1.0, 1.0 }
+ fg[INSENSITIVE] = { 1.0, 1.0, 1.0 }
+}
+
+style "entry"
+{
+ base[NORMAL] = { 1.0, 1.0, 1.0 }
+ fg[NORMAL] = { 0.67, 0.67, 0.67 }
+}
+
+style "button"
+{
+ bg[NORMAL] = { 1.0, 1.0, 1.0 }
+ fg[NORMAL] = { 0, 0, 0 }
+ bg[PRELIGHT] = { 1.0, 1.0, 1.0 }
+ fg[PRELIGHT] = { 0.67, 0.67, 0.67 }
+}
+
+style "background"
+{
+ bg[NORMAL] = { 0.67, 0.67, 0.67 }
+}
+
+widget_class "*" style "any"
+widget_class "*GtkEntry*" style "entry"
+widget_class "*GtkSpin*" style "entry"
+widget_class "*Gtk*List*" style "entry"
+widget "*GtkButton*" style "button"
+widget "*background*" style "background"
diff --git a/perl-install/share/themes-blue.rc b/perl-install/share/themes-blue.rc
new file mode 100644
index 000000000..1404d4dce
--- /dev/null
+++ b/perl-install/share/themes-blue.rc
@@ -0,0 +1,36 @@
+style "any"
+{
+ font = "-adobe-helvetica-medium-r-normal-*-*-100-*-*-p-*-iso8859-1"
+
+ bg[NORMAL] = { 0, 0, 0.67 }
+ bg[ACTIVE] = { 0, 0.67, 1.0 }
+ bg[PRELIGHT] = { 0, 0, 1.0 }
+ bg[INSENSITIVE] = { 1.0, 0, 0.67 }
+
+ fg[NORMAL] = { 1.0, 1.0, 1.0 }
+ fg[ACTIVE] = { 1.0, 1.0, 1.0 }
+ fg[PRELIGHT] = { 1.0, 1.0, 1.0 }
+ fg[INSENSITIVE] = { 1.0, 1.0, 1.0 }
+}
+
+style "entry"
+{
+ base[NORMAL] = { 0, 1.0, 1.0 }
+ fg[NORMAL] = { 0.67, 0, 0.67 }
+}
+
+style "button" = "any"
+{
+}
+
+style "background"
+{
+ bg[NORMAL] = { 0, 0.67, 1.0 }
+}
+
+widget_class "*" style "any"
+widget_class "*GtkEntry*" style "entry"
+widget_class "*GtkSpin*" style "entry"
+widget_class "*Gtk*List*" style "entry"
+widget "*GtkButton*" style "button"
+widget "*background*" style "background"
diff --git a/perl-install/share/themes-savane.rc b/perl-install/share/themes-savane.rc
new file mode 100644
index 000000000..43e67583c
--- /dev/null
+++ b/perl-install/share/themes-savane.rc
@@ -0,0 +1,39 @@
+style "any"
+{
+ font = "-adobe-helvetica-medium-r-normal-*-*-100-*-*-p-*-iso8859-1"
+
+ bg[NORMAL] = { 0.67, 0.33, 0 }
+ bg[PRELIGHT] = { 1.0, 1.0, 0 }
+ bg[INSENSITIVE] = { 1.0, 0, 0.67 }
+
+ fg[NORMAL] = { 1.0, 1.0, 1.0 }
+ fg[ACTIVE] = { 1.0, 1.0, 1.0 }
+ fg[PRELIGHT] = { 1.0, 1.0, 1.0 }
+ fg[INSENSITIVE] = { 1.0, 1.0, 1.0 }
+}
+
+style "entry"
+{
+ base[NORMAL] = { 1.0, 1.0, 1.0 }
+ fg[NORMAL] = { 0, 0, 0 }
+}
+
+style "button"
+{
+ bg[NORMAL] = { 1.0, 0.67, 0 }
+ fg[NORMAL] = { 0, 0, 0 }
+ bg[PRELIGHT] = { 1.0, 1.0, 0 }
+ fg[PRELIGHT] = { 0, 0, 0 }
+}
+
+style "background"
+{
+ bg[NORMAL] = { 0, 0.67, 0 }
+}
+
+widget_class "*" style "any"
+widget_class "*GtkEntry*" style "entry"
+widget_class "*GtkSpin*" style "entry"
+widget_class "*Gtk*List*" style "entry"
+widget "*GtkButton*" style "button"
+widget "*background*" style "background"
diff --git a/perl-install/share/themes.rc b/perl-install/share/themes.rc
new file mode 100644
index 000000000..5d8db5b90
--- /dev/null
+++ b/perl-install/share/themes.rc
@@ -0,0 +1,18 @@
+style "savane"
+{
+ bg[NORMAL] = { 1.0, 0.67, 0 }
+ bg[PRELIGHT] = { 0.67, 0.33, 0 }
+}
+style "blackwhite"
+{
+ bg[NORMAL] = { 0.67, 0.67, 0.67 }
+ bg[PRELIGHT] = { 1.0, 1.0, 1.0 }
+}
+style "blue"
+{
+ bg[NORMAL] = { 0, 0, 0.67 }
+ bg[PRELIGHT] = { 0, 0, 1.0 }
+}
+widget "*savane*" style "savane"
+widget "*blackwhite*" style "blackwhite"
+widget "*blue*" style "blue"