summaryrefslogtreecommitdiffstats
path: root/perl-install
diff options
context:
space:
mode:
Diffstat (limited to 'perl-install')
-rw-r--r--perl-install/Makefile18
-rw-r--r--perl-install/Xconfigurator.pm102
-rw-r--r--perl-install/common.pm11
-rw-r--r--perl-install/fs.pm4
-rw-r--r--perl-install/fsedit.pm109
-rwxr-xr-xperl-install/install22
-rw-r--r--perl-install/install2.pm25
-rw-r--r--perl-install/install_any.pm7
-rw-r--r--perl-install/install_steps.pm7
-rw-r--r--perl-install/install_steps_interactive.pm19
-rw-r--r--perl-install/install_steps_stdio.pm2
-rw-r--r--perl-install/interactive.pm5
-rw-r--r--perl-install/interactive_gtk.pm5
-rw-r--r--perl-install/partition_table.pm210
-rw-r--r--perl-install/partition_table_raw.pm8
-rw-r--r--perl-install/pkgs.pm8
-rw-r--r--perl-install/share/list4
17 files changed, 381 insertions, 165 deletions
diff --git a/perl-install/Makefile b/perl-install/Makefile
index c4567e638..9f3a9e6d7 100644
--- a/perl-install/Makefile
+++ b/perl-install/Makefile
@@ -1,5 +1,5 @@
SO_FILES = c/blib/arch/auto/c/c.so
-PMS = *.pm c/*.pm resize_fat/*.pm po/*.pm commands install2 diskdrake
+PMS = *.pm c/*.pm resize_fat/*.pm po/*.pm pci_probing/*.pm commands install2 diskdrake
ROOTDEST = /tmp/t
DEST = $(ROOTDEST)/Mandrake/instimage
DESTREP4PMS = $(DEST)/usr/bin/perl-install
@@ -24,12 +24,23 @@ clean:
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
+
tar-diskdrake: clean
cd .. ; rm -rf diskdrake ; cp -af perl-install diskdrake
- l=`perl2fcalls -uses -excludec diskdrake | sort | uniq | sed -e 's/::/\//' -e 's/^/diskdrake\//' -e 's/$$/.pm/'` ; \
+ l=`./perl2fcalls -uses -excludec diskdrake | sort | uniq | sed -e 's/::/\//' -e 's/^/diskdrake\//' -e 's/$$/.pm/'` ; \
cd .. ; tar cfz diskdrake.tgz --exclude CVS $(patsubst %,diskdrake/%,c po diskdrake*) $$l
+tar-XFdrake: clean
+ cd .. ; rm -rf XFdrake ; cp -af perl-install XFdrake
+
+ l=`./perl2fcalls -uses -excludec -excludepci_probing::ids XFdrake | sort | uniq | sed -e 's/::/\//' -e 's/^/XFdrake\//' -e 's/$$/.pm/'` ; \
+ cd .. ; tar cfz XFdrake.tgz --exclude CVS $(patsubst %,XFdrake/%,c MonitorsDB po pci_probing XFdrake*) $$l
+
c/c.xs: c/c.xs.pm
rm -f $@
export C_RPM=1 ; perl $< > $@
@@ -46,7 +57,7 @@ $(DIRS):
$(MAKE) -C $@
test_pms: verify_c
- perl2fcalls -excludec install2
+ ./perl2fcalls -excludec install2
(for i in $(PMS); do perl -cw -I. -Ic -Ic/blib/arch $$i || exit 1 ; done)
verify_c:
@@ -118,6 +129,7 @@ get_needed_files: $(SO_FILES)
cp -a xmodmaps $(DEST)/usr/share
cp -a keymaps $(DEST)/usr/share
cp -a consolefonts $(DEST)/usr/share
+ cp MonitorsDB $(DEST)/usr/share
cp compss $(ROOTDEST)/Mandrake/base
ln -s install2 $(DEST)/usr/bin/runinstall2
diff --git a/perl-install/Xconfigurator.pm b/perl-install/Xconfigurator.pm
index 751efeebd..d39e58238 100644
--- a/perl-install/Xconfigurator.pm
+++ b/perl-install/Xconfigurator.pm
@@ -13,7 +13,7 @@ use my_gtk qw(:wrappers);
my $tmpconfig = "/tmp/Xconfig";
-my (%cards, %monitors);
+my ($prefix, %cards, %monitors);
1;
@@ -84,7 +84,7 @@ sub readMonitorsDB {
%monitors and return;
local *F;
- open F, $file or die "can't open monitors database ($file): ?!";
+ open F, $file or die "can't open monitors database ($file): $!";
my $lineno = 0; foreach (<F>) {
$lineno++;
s/\s+$//;
@@ -109,15 +109,15 @@ sub rewriteInittab {
my ($runlevel) = @_;
{
local (*F, *G);
- open F, "/etc/inittab" or die "cannot open /etc/inittab: $!";
- open G, "> /etc/inittab-" or die "cannot write in /etc/inittab-: $!";
+ open F, "$prefix/etc/inittab" or die "cannot open $prefix/etc/inittab: $!";
+ open G, "> $prefix/etc/inittab-" or die "cannot write in $prefix/etc/inittab-: $!";
foreach (<F>) {
- print G /^(id:)[35](:initdefault:)\s*$/ ? "$1$runlevel$2\n" : $_;
+ print G /^(id:)[35](:initdefault:)\s*$/ ? "$1$runlevel$2\n" : $_; # **
}
}
- unlink("/etc/inittab");
- rename("/etc/inittab-", "/etc/inittab");
+ unlink("$prefix/etc/inittab");
+ rename("$prefix/etc/inittab-", "$prefix/etc/inittab");
}
sub keepOnlyLegalModes {
@@ -144,21 +144,25 @@ sub cardConfiguration(;$$) {
my ($card, $noauto) = @_;
$card ||= {};
- readCardsDB("/usr/X11R6/lib/X11/Cards");
+ readCardsDB("$prefix/usr/X11R6/lib/X11/Cards");
- add2hash($card, cardConfigurationAuto()) unless $card->{type} || $card->{server} || $noauto;
+ add2hash($card, $cards{$card->{type}}) if $card->{type}; # try to get info from given type
+ $card->{type} = undef unless $card->{server}; # bad type as we can't find the server
+
+ add2hash($card, cardConfigurationAuto()) unless $card->{server} || $noauto;
add2hash($card, { type => $in->ask_from_list('', _("Choose a graphic card"), [keys %cards]) }) unless $card->{type} || $card->{server};
+
add2hash($card, $cards{$card->{type}}) if $card->{type};
add2hash($card, { vendor => "Unknown", board => "Unknown" });
$card->{prog} = "/usr/X11R6/bin/XF86_$card->{server}";
-
- -x $card->{prog} or !defined $install or &$install($card->{server});
- -x $card->{prog} or die "server $card->{server} is not available (should be in $card->{prog})";
-
+
+ -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})";
+
unless ($::testing) {
- unlink("/etc/X11/X");
- symlink("../../$card->{prog}", "/etc/X11/X");
+ unlink("$prefix/etc/X11/X");
+ symlink("../..$card->{prog}", "$prefix/etc/X11/X");
}
unless ($card->{type}) {
@@ -177,11 +181,13 @@ sub cardConfiguration(;$$) {
sub monitorConfiguration(;$) {
my $monitor = shift || {};
- readMonitorsDB("MonitorsDB");
+ $monitor->{hsyncrange} && $monitor->{vsyncrange} and return $monitor;
+
+ readMonitorsDB(-e "MonitorsDB" ? "MonitorsDB" : "/usr/share/MonitorsDB");
add2hash($monitor, { type => $in->ask_from_list('', _("Choose a monitor"), [keys %monitors]) }) unless $monitor->{type};
add2hash($monitor, $monitors{$monitor->{type}});
- add2hash($monitor, { vendor => "Unknown", model => "Unknown" });
+ add2hash($monitor, { type => "Unknown", vendor => "Unknown", model => "Unknown" });
$monitor;
}
@@ -192,7 +198,7 @@ sub testConfig($) {
write_XF86Config($o, $tmpconfig);
local *F;
- open F, "$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*)/;
@@ -219,9 +225,9 @@ sub testFinalConfig($;$) {
$o->{card}->{depth} or
$in->ask_warn('', _("Resolutions not chosen yet")), return;
- rename("/etc/X11/XF86Config", "/etc/X11/XF86Config.old") || die "unable to make a backup of XF86Config" unless $::testing;
+ rename("$prefix/etc/X11/XF86Config", "$prefix/etc/X11/XF86Config.old") || die "unable to make a backup of XF86Config" unless $::testing;
- write_XF86Config($o, $::testing ? $tmpconfig : "/etc/X11/XF86Config");
+ write_XF86Config($o, $::testing ? $tmpconfig : "$prefix/etc/X11/XF86Config");
$auto
or $in->ask_yesorno(_("Test configuration"), _("Do you want to test configuration?"))
@@ -230,10 +236,16 @@ sub testFinalConfig($;$) {
my $pid; unless ($pid = fork) {
my @l = "X";
@l = ($o->{card}->{prog}, "-xf86config", $tmpconfig) if $::testing;
+ chroot $prefix if $prefix;
exec @l, ":9" or exit 1;
}
do { sleep 1; } until (c::Xtest(':0'));
+ # create a link from the non-prefixed /tmp/.X11-unix/X9 to the prefixed one
+ # that way, you can talk to :9 without doing a chroot
+ unlink "/tmp/.X11-unix/X9" if $prefix;
+ symlink "$prefix/tmp/.X11-unix/X9", "/tmp/.X11-unix/X9" if $prefix;
+
local *F;
open F, "|perl" or die;
print F "use lib qw(", join(' ', @INC), ");\n";
@@ -242,7 +254,7 @@ sub testFinalConfig($;$) {
use my_gtk qw(:wrappers);
$ENV{DISPLAY} = ":9";
- gtkset_mousecursor(2);
+ gtkset_mousecursor(68);
gtkset_background(200, 210, 210);
my ($h, $w) = Gtk::Gdk::Window->new_foreign(Gtk::Gdk->ROOT_WINDOW)->get_size;
$my_gtk::force_position = [ $w / 3, $h / 2.4 ];
@@ -259,10 +271,11 @@ sub testFinalConfig($;$) {
};
my $rc = close F;
my $err = $?;
+
+ unlink "/tmp/.X11-unix/X9" if $prefix;
kill 2, $pid;
$rc || $err == 222 << 8 or $in->ask_warn('', _("An error occured, try changing some parameters"));
-
$rc;
}
@@ -378,11 +391,6 @@ sub resolutionsConfiguration($$) {
my $nowarning = $auto || $option eq 'nowarning';
my $noauto = $option eq 'noauto';
- unless ($card->{depth}) {
- $card->{depth}->{$_} = [ map { [ split "x" ] } @resolutions ]
- foreach @depths;
- }
-
# For the mono and vga16 server, no further configuration is required.
return if member($card->{server}, "Mono", "VGA16");
@@ -411,15 +419,25 @@ sub resolutionsConfiguration($$) {
#$unknown and $manual ||= !$in->ask_okcancel('', [ _("I can try to autodetect information about graphic card, but it may freeze :("),
# _("Do you want to try?") ]);
- if ($nowarning || (!$noauto && $in->ask_okcancel(_("Automatic resolutions"),
+ unless ($card->{depth}) {
+ $card->{depth}->{$_} = [ map { [ split "x" ] } @resolutions ]
+ foreach @depths;
+
+ if ($nowarning || (!$noauto && $in->ask_okcancel(_("Automatic resolutions"),
_("I can try to find the available resolutions (eg: 800x600).
Alas it can freeze sometimes
Do you want to try?")))) {
- autoResolutions($o, $nowarning);
+ autoResolutions($o, $nowarning);
+ }
}
# sort resolutions in each depth
- @$_ = sort { $b->[0] <=> $a->[0] } @$_ foreach values %{$card->{depth}};
+ {
+ my $i;
+ @$_ = grep { first($i != $_->[0], $i = $_->[0]) }
+ sort { $b->[0] <=> $a->[0] } @$_
+ foreach values %{$card->{depth}};
+ }
# remove unusable resolutions (based on the video memory size)
keepOnlyLegalModes($card);
@@ -462,11 +480,11 @@ sub write_XF86Config {
# Write pointer section.
$O = $o->{mouse};
print F $pointersection_text1;
- print F qq( Protocol "$O->{type}"\n);
+ print F qq( Protocol "$O->{xtype}"\n);
print F qq( Device "$O->{device}"\n);
# this will enable the "wheel" or "knob" functionality if the mouse supports it
print F " ZAxisMapping 4 5\n" if
- member($O->{type}, qw(IntelliMouse IMPS/2 ThinkingMousePS/2 NetScrollPS/2 NetMousePS/2 MouseManPlusPS/2));
+ member($O->{xtype}, qw(IntelliMouse IMPS/2 ThinkingMousePS/2 NetScrollPS/2 NetMousePS/2 MouseManPlusPS/2));
print F $pointersection_text2;
print F "#" unless $O->{emulate3buttons};
@@ -538,9 +556,7 @@ Section "Screen"
print F " DefaultColorDepth $defdepth\n" if $defdepth;
foreach (ikeys(%$depths)) {
- my $m = join(" ",
- map { '"' . join("x", @$_) . '"' }
- sort { $b->[0] <=> $a->[0] } @{$depths->{$_}});
+ my $m = join(" ", map { qq("$_->[0]x$_->[1]") } @{$depths->{$_}});
print F qq( Subsection "Display"\n);
print F qq( Depth $_\n) if $_;
print F qq( Modes $m\n);
@@ -575,10 +591,10 @@ Section "Screen"
sub XF86check_link {
my ($void) = @_;
- my $f = "/etc/X11/XF86Config";
+ my $f = "$prefix/etc/X11/XF86Config";
touch($f);
- my $l = "/usr/X11R6/lib/X11/XF86Config";
+ my $l = "$prefix/usr/X11R6/lib/X11/XF86Config";
if (-e $l && (stat($f))[1] != (stat($l))[1]) { # compare the inode, must be the sames
-e $l and unlink($l) || die "can't remove bad $l";
@@ -589,10 +605,9 @@ sub XF86check_link {
# * Program entry point.
sub main {
- my ($default, $interact, $install_pkg) = @_;
- my $o = $default;
- $in = $interact;
- $install = $install_pkg;
+ my $o;
+ ($prefix, $o, $in, $install) = @_;
+ $o ||= {};
XF86check_link();
@@ -611,7 +626,10 @@ sub main {
__("Change Monitor") => sub { $o->{monitor} = monitorConfiguration() },
__("Change Graphic card") => sub { $o->{card} = cardConfiguration('', 'noauto') },
__("Change Resolution") => sub { resolutionsConfiguration($o, 'noauto') },
- __("Automaticall resolutions search") => sub { resolutionsConfiguration($o, 'nowarning') },
+ __("Automaticall resolutions search") => sub {
+ delete $o->{card}->{depth};
+ resolutionsConfiguration($o, 'nowarning');
+ },
__("Test again") => sub { $ok = testFinalConfig($o, 1) },
__("Quit") => sub { $quit = 1 },
);
diff --git a/perl-install/common.pm b/perl-install/common.pm
index 2fee51d59..9a21b7b57 100644
--- a/perl-install/common.pm
+++ b/perl-install/common.pm
@@ -6,10 +6,10 @@ use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK $printable_chars $sizeof_int $bitof_int
@ISA = qw(Exporter);
%EXPORT_TAGS = (
- common => [ qw(_ __ min max sum product bool ikeys member divide is_empty_array_ref add2hash set_new set_add round_up round_down first second top uniq translate untranslate) ],
- functional => [ qw(fold_left) ],
- file => [ qw(dirname basename touch all glob_ cat_ chop_ mode getVarsFromSh) ],
- system => [ qw(sync makedev unmakedev psizeof strcpy gettimeofday syscall_ crypt_) ],
+ 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) ],
+ functional => [ qw(fold_left difference2) ],
+ file => [ qw(dirname basename touch all glob_ cat_ chop_ mode) ],
+ system => [ qw(sync makedev unmakedev psizeof strcpy gettimeofday syscall_ crypt_ getVarsFromSh) ],
constant => [ qw($printable_chars $sizeof_int $bitof_int $SECTORSIZE) ],
);
@EXPORT_OK = map { @$_ } values %EXPORT_TAGS;
@@ -22,10 +22,12 @@ $SECTORSIZE = 512;
1;
sub _ { my $s = shift @_; sprintf translate($s), @_ }
+#delete $main::{'_'};
sub __ { $_[0] }
sub min { fold_left(sub { $a < $b ? $a : $b }, @_) }
sub max { fold_left(sub { $a > $b ? $a : $b }, @_) }
sub sum { fold_left(sub { $a + $b }, @_) }
+sub sign { $_[0] <=> 0 }
sub product { fold_left(sub { $a * $b }, @_) }
sub first { $_[0] }
sub second { $_[1] }
@@ -44,6 +46,7 @@ sub divide { my $d = int $_[0] / $_[1]; wantarray ? ($d, $_[0] % $_[1]) : $d }
sub round_up { my ($i, $r) = @_; $i += $r - ($i + $r - 1) % $r - 1; }
sub round_down { my ($i, $r) = @_; $i -= $i % $r; }
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 } }
diff --git a/perl-install/fs.pm b/perl-install/fs.pm
index 0b08c0775..8d3995aa4 100644
--- a/perl-install/fs.pm
+++ b/perl-install/fs.pm
@@ -79,7 +79,7 @@ sub format_part($;$) {
$part->{isFormatted} and return;
- log::l("formatting device $part->{device} (type ", type2name($_->{type}), ")");
+ log::l("formatting device $part->{device} (type ", type2name($part->{type}), ")");
if (isExt2($part)) {
format_ext2($part->{device}, $bad_blocks);
@@ -151,7 +151,7 @@ sub umount_part($;$) {
isSwap($part) ?
swap::swapoff($part->{device}) :
- umount(($prefix || '') . ($part->{mntpoint} || "/dev/$part->{device}"));
+ umount(($prefix || '') . ($part->{mntpoint} || devices::make($part->{device})));
$part->{isMounted} = 0;
}
diff --git a/perl-install/fsedit.pm b/perl-install/fsedit.pm
index df2ae8e7d..ca613be3c 100644
--- a/perl-install/fsedit.pm
+++ b/perl-install/fsedit.pm
@@ -3,9 +3,10 @@ package fsedit;
use diagnostics;
use strict;
-use common qw(:common);
+use common qw(:common :constant);
use partition_table qw(:types);
use partition_table_raw;
+use Data::Dumper;
use devices;
use log;
@@ -45,12 +46,14 @@ sub hds($$) {
# for RAID arrays of format c0d0p1
$hd->{prefix} .= "p" if $hd->{prefix} =~ m,(rd|ida)/,;
- eval { $rc = partition_table::read($hd, $flags->{clearall}) };
+ eval { partition_table::read($hd, $flags->{clearall}) };
if ($@) {
- $@ =~ /bad magic number/ or die;
- partition_table_raw::zero_MBR($hd) if $flags->{eraseBadPartitions};
+# $@ =~ /bad magic number/ or die;
+ $flags->{eraseBadPartitions} ?
+ partition_table_raw::zero_MBR($hd) :
+ die;
}
- $rc ? push @hds, $hd : log::l("An error occurred reading the partition table for the block device $_->{device}");
+ push @hds, $hd;
}
[ @hds ];
}
@@ -114,7 +117,7 @@ sub has_mntpoint($$) {
sub check_mntpoint {
my ($mntpoint, $hd, $part, $hds) = @_;
- $mntpoint eq '' and return;
+ $mntpoint eq '' || isSwap($part) and return;
local $_ = $mntpoint;
m|^/| or die _("Mount points must begin with a leading /");
@@ -122,20 +125,20 @@ sub check_mntpoint {
has_mntpoint($mntpoint, $hds) and die _("There is already a partition with mount point %s", $mntpoint);
- if ($part->{start} + $part->{size} > 124 * partition_table::cylinder_size($hd)) {
+ if ($part->{start} + $part->{size} > 1024 * partition_table::cylinder_size($hd)) {
die "/boot ending on cylinder > 1024" if $mntpoint eq "/boot";
die "/ ending on cylinder > 1024" if $mntpoint eq "/" && !has_mntpoint("/boot", $hds);
}
}
sub add($$$;$) {
- my ($hd, $part, $hds, $force) = @_;
+ my ($hd, $part, $hds, $options) = @_;
isSwap($part) ?
($part->{mntpoint} = 'swap') :
- $force || check_mntpoint($part->{mntpoint}, $hd, $part, $hds);
+ $options->{force} || check_mntpoint($part->{mntpoint}, $hd, $part, $hds);
- partition_table::add($hd, $part);
+ partition_table::add($hd, $part, $options->{want_primary});
}
sub removeFromList($$$) {
@@ -204,3 +207,89 @@ sub auto_allocate($;$) {
]);
map { partition_table::assign_device_numbers($_) } @$hds;
}
+
+sub undo_prepare($) {
+ my ($hds) = @_;
+ $Data::Dumper::Purity = 1;
+ foreach (@$hds) {
+ my @h = @{$_}{@partition_table::fields2save};
+ push @{$_->{undo}}, Data::Dumper->Dump([\@h], ['$h']);
+ }
+}
+
+sub undo($) {
+ my ($hds) = @_;
+ foreach (@$hds) {
+ my $h; eval pop @{$_->{undo}} || next;
+ @{$_}{@partition_table::fields2save} = @$h;
+
+ $_->{isDirty} = $_->{needKernelReread} = 1;
+ }
+}
+
+sub verify_room {
+ my ($part, $hd2, $sector2) = @_;
+ my $free_sectors = [ 1, $hd2->{totalsectors} ]; # first sector is always occupied by the MBR
+ my $remove = sub { removeFromList($_[0]->{start}, $_[0]->{start} + $_[0]->{size}, $free_sectors) };
+
+ $_ eq $part or &$remove($_) foreach get_fstab($hd2);
+
+ for (my $i = 0; $i < @$free_sectors; $i += 2) {
+ $sector2 < $free_sectors->[$i] && $sector2 < $free_sectors->[$i + 1] or next;
+ $sector2 + $part->{size} < $free_sectors->[$i + 1] or die
+_("Not enough place to move (%dGb, should be %dGb)", ($free_sectors->[$i + 1] - $free_sectors->[$i]), $part->{size} >> 11);
+ return;
+ }
+ die _("There is already a partition there");
+}
+
+sub move {
+ my ($hd, $part, $hd2, $sector2) = @_;
+
+ my $part2 = { %$part };
+ $part2->{start} = $sector2;
+ partition_table::remove($hd, $part);
+ {
+ local ($part2->{notFormatted}, $part2->{isFormatted}); # do not allow partition::add to change this
+ partition_table::add($hd2, $part2);
+ }
+ verify_room($part, $hd2, $part2->{start});
+
+ return if $part2->{notFormatted} && !$part2->{isFormatted} || $::testing;
+
+ local (*F, *G);
+ sysopen F, $hd->{file}, 0 or die;
+ sysopen G, $hd2->{file}, 2 or die _("Error opening %s for writing: %s", $hd2->{file}, "$!");
+
+ my $base = $part->{start};
+ my $base2 = $part2->{start};
+ my $step = 1 << 10;
+ if ($hd eq $hd2) {
+ $part->{start} == $part2->{start} and return;
+ $step = min($step, abs($part->{start} - $part2->{start}));
+
+ if ($part->{start} < $part2->{start}) {
+ $base += $part->{size} - $step;
+ $base2 += $part->{size} - $step;
+ $step = -$step;
+ }
+ }
+
+ my $f = sub {
+ c::lseek_sector(fileno(F), $base, 0) or die "seeking to sector $base failed on drive $hd->{device}";
+ c::lseek_sector(fileno(G), $base2, 0) or die "seeking to sector $base2 failed on drive $hd2->{device}";
+
+ my $buf;
+ sysread F, $buf, $SECTORSIZE * abs($_[0]) or die;
+ syswrite G, $buf;
+ };
+
+ for (my $i = 0; $i < $part->{size} / abs($step); $i++, $base += $step, $base2 += $step) {
+ &$f($step);
+ }
+ if (my $v = $part->{size} % abs($step) * sign($step)) {
+ $base += $v;
+ $base2 += $v;
+ &$f($v);
+ }
+}
diff --git a/perl-install/install2 b/perl-install/install2
index 5076029b0..7d9c4a278 100755
--- a/perl-install/install2
+++ b/perl-install/install2
@@ -23,5 +23,7 @@ use strict;
use lib qw(/usr/bin/perl-install . c c/blib/arch);
use install2;
+$::testing = $ENV{PERL_INSTALL_TEST};
+
install2::main(@ARGV);
diff --git a/perl-install/install2.pm b/perl-install/install2.pm
index 3c70564df..a1645d07a 100644
--- a/perl-install/install2.pm
+++ b/perl-install/install2.pm
@@ -2,7 +2,7 @@ package install2;
use diagnostics;
use strict;
-use vars qw($testing $INSTALL_VERSION $o);
+use vars qw($o);
use common qw(:common :file :system);
use install_any qw(:all);
@@ -19,9 +19,6 @@ use pkgs;
use smp;
use lang;
-$::testing = $ENV{PERL_INSTALL_TEST};
-$INSTALL_VERSION = 0;
-
my @installStepsFields = qw(text help skipOnCancel skipOnLocal prev next);
my @installSteps = (
selectLanguage => [ __("Choose your language"), "help", 0, 0 ],
@@ -42,7 +39,7 @@ my @installSteps = (
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 ],
+ configureX => [ __("Configure X"), __("help"), 0, 0 ],
exitInstall => [ __("Exit install"), __("help"), 0, 0, undef, 'done' ],
);
@@ -97,10 +94,10 @@ my $default = {
rootPassword => 'toto',
lang => 'fr',
isUpgrade => 0,
- installClass => 'Server',
+ installClass => 'newbie',
bootloader => { onmbr => 1, linear => 0 },
mkbootdisk => 0,
- base => [ qw(basesystem 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) ],
+ 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 },
partitions => [
@@ -128,6 +125,7 @@ sub selectPath {
sub selectInstallClass {
$o->{installClass} = $o->selectInstallClass(@install_classes);
+ $::expert = $o->{installClass} eq "expert";
}
sub setupSCSI {
@@ -220,7 +218,7 @@ sub setupBootloader {
$o->{isUpgrade} or modules::read_conf("$o->{prefix}/etc/conf.modules");
$o->setupBootloader;
}
-sub configureX { $o->setupXfree }
+sub configureX { $o->setupXfree if $o->{packages}->{XFree86}->{installed} }
sub exitInstall { $o->exitInstall }
@@ -232,7 +230,7 @@ sub main {
print STDERR "in second stage install\n";
log::openLog(($::testing || $o->{localInstall}) && 'debug.log');
- log::l("second stage install running (version $INSTALL_VERSION)");
+ log::l("second stage install running");
log::ld("extra log messages are enabled");
$o->{prefix} = $::testing ? "/tmp/test-perl-install" : "/mnt";
@@ -245,6 +243,9 @@ sub main {
spawnSync();
eval { spawnShell() };
+ # needed very early for install_steps_graphical
+ @{$o->{mouse}}{"xtype", "device"} = install_any::mouse_detect() unless $::testing;
+
$o = install_steps_graphical->new($o);
$o->{netc} = net::readNetConfig("/tmp");
@@ -258,17 +259,15 @@ sub main {
for (my $step = $o->{steps}->{first}; $step ne 'done'; $step = getNextStep($step)) {
$o->enteringStep($step);
- #eval {
+ eval {
&{$install2::{$step}}();
- #};
+ };
$o->errorInStep($@) if $@;
$o->leavingStep($step);
}
killCardServices();
log::l("installation complete, leaving");
-
- <STDIN> unless $::testing;
}
sub killCardServices {
diff --git a/perl-install/install_any.pm b/perl-install/install_any.pm
index dd9bcd4de..d299b8bfc 100644
--- a/perl-install/install_any.pm
+++ b/perl-install/install_any.pm
@@ -86,10 +86,15 @@ sub spawnShell {
}
sub mouse_detect() {
- my ($type, $dev) = split("\n", `./mouseconfig --nointeractive 2>/dev/null`) or die "mouseconfig failed";
+ my ($type, $dev) = split("\n", `mouseconfig --nointeractive 2>/dev/null`) or die "mouseconfig failed";
$type, $dev;
}
+sub shells($) {
+ my ($o) = @_;
+ grep { -x "$o->{prefix}$_" } @{$o->{default}->{shells}};
+}
+
sub upgrFindInstall {
# int rc;
#
diff --git a/perl-install/install_steps.pm b/perl-install/install_steps.pm
index a80807c1b..827039c41 100644
--- a/perl-install/install_steps.pm
+++ b/perl-install/install_steps.pm
@@ -198,13 +198,6 @@ sub setupBootloader($) {
sub setupXfree {
my ($o) = @_;
- my $x = $o->{default}->{Xserver} or return;
- $o->{packages}->{$x} or die "can't find X server $x";
-
- log::l("I will install the $x package");
- pkgs::install($o->{prefix}, $o->{packages}->{$x}, $o->{isUpgrade}, 0);
-
- #TODO
}
sub exitInstall {}
diff --git a/perl-install/install_steps_interactive.pm b/perl-install/install_steps_interactive.pm
index f3fabc985..2ea2d84b8 100644
--- a/perl-install/install_steps_interactive.pm
+++ b/perl-install/install_steps_interactive.pm
@@ -33,13 +33,13 @@ use lang;
use log;
1;
+=cut
sub errorInStep($$) {
my ($o, $err) = @_;
$o->ask_warn(_("Error"), [ _("An error occured"), $err ]);
}
-=cut
sub chooseLanguage($) {
my ($o) = @_;
lang::text2lang($o->ask_from_list("Language",
@@ -79,20 +79,6 @@ sub choosePartitionsToFormat($$) {
}
}
-sub installPackages {
- my $o = shift;
-
- my $old = \&log::ld;
- local *log::ld = sub {
- my $m = shift;
- if ($m =~ /^starting installing/) {
- my $name = first($_[0] =~ m|([^/]*)-.+?-|);
- print("installing package $name");
- } else { goto $old }
- };
- $o->SUPER::installPackages(@_);
-}
-
sub createBootdisk($) {
my ($o) = @_;
@@ -114,7 +100,7 @@ sub setupBootloader($) {
$o->SUPER::setupBootloader;
}
-=cut
+
sub exitInstall {
my ($o) = @_;
$o->ask_warn('',
@@ -126,3 +112,4 @@ 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 908d14080..f5b05a0f1 100644
--- a/perl-install/install_steps_stdio.pm
+++ b/perl-install/install_steps_stdio.pm
@@ -66,7 +66,7 @@ sub addUser($) {
} until ($w{password} eq $o->readln());
print "Real name: "; $w{realname} = $o->readln();
- $w{shell} = $o->ask_from_list('', 'Shell', $o->{default}->{shells}, "/bin/bash");
+ $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->SUPER::addUser;
diff --git a/perl-install/interactive.pm b/perl-install/interactive.pm
index 65b3c895b..76ed30345 100644
--- a/perl-install/interactive.pm
+++ b/perl-install/interactive.pm
@@ -49,5 +49,10 @@ sub ask_many_from_list($$$$;$) {
$o->ask_many_from_listW($title, $message, $l, $def);
}
+sub ask_from_entry($$$;$) {
+ my ($o, $title, $message, $def) = @_;
+ $message = ref $message ? $message : [ $message ];
+ $o->ask_from_entryW($title, $message, $def);
+}
diff --git a/perl-install/interactive_gtk.pm b/perl-install/interactive_gtk.pm
index e83e161cb..de58e765d 100644
--- a/perl-install/interactive_gtk.pm
+++ b/perl-install/interactive_gtk.pm
@@ -12,6 +12,11 @@ use my_gtk qw(:helpers :wrappers);
1;
+sub ask_from_entryW {
+ my ($o, $title, $messages, $def) = @_;
+ my_gtk::ask_from_entry($title, @$messages);
+}
+
sub ask_from_listW {
my ($o, $title, $messages, $l, $def) = @_;
diff --git a/perl-install/partition_table.pm b/perl-install/partition_table.pm
index fbd5a57df..11d29f981 100644
--- a/perl-install/partition_table.pm
+++ b/perl-install/partition_table.pm
@@ -2,7 +2,7 @@ package partition_table;
use diagnostics;
use strict;
-use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK @important_types);
+use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK @important_types @fields2save);
@ISA = qw(Exporter);
%EXPORT_TAGS = (
@@ -18,6 +18,9 @@ use Data::Dumper;
@important_types = ("Linux native", "Linux swap", "DOS FAT16", "Win98 FAT32");
+@fields2save = qw(primary extended totalsectors);
+
+
my %types = (
0 => "Empty",
1 => "DOS 12-bit FAT",
@@ -76,8 +79,6 @@ my %type2fs = (
my %types_rev = reverse %types;
my %fs2type = reverse %type2fs;
-my @fields2save = qw(primary extended totalsectors);
-
1;
@@ -135,28 +136,74 @@ 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) {
+ $i != $_ and verifyNotOverlap($i, $_) || die "partitions $i->{start} $i->{size} and $_->{start} $_->{size} are overlapping!";
+ }}
+}
+
sub assign_device_numbers($) {
my ($hd) = @_;
- my $i = 1; foreach (@{$hd->{primary}->{raw}}, map { $_->{normal} } @{$hd->{extended}}) {
- $_->{device} = $hd->{prefix} . $i++;
- }
+ my $i = 1;
+ $_->{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}->{raw}};
+ my ($c, @others) = grep { isDos($_) || isWin($_) } @{$hd->{primary}->{normal}};
$c or return;
$i = ord 'D';
- foreach (grep { isDos($_) || isWin($_) } @{$hd->{extended}}) {
+ foreach (grep { isDos($_) || isWin($_) } map { $_->{normal} } @{$hd->{extended}}) {
$_->{device_windobe} = chr($i++);
}
$c->{device_windobe} = 'C';
$_->{device_windobe} = chr($i++) foreach @others;
}
+sub remove_empty_extended($) {
+ my ($hd) = @_;
+ my $last = $hd->{primary}->{extended} or return;
+ @{$hd->{extended}} = grep {
+ if ($_->{normal}) {
+ $last = $_;
+ } else {
+ %{$last->{extended}} = $_->{extended} ? %{$_->{extended}} : ();
+ }
+ $_->{normal};
+ } @{$hd->{extended}};
+ adjust_main_extended($hd);
+}
+
+sub adjust_main_extended($) {
+ my ($hd) = @_;
+
+ if (!is_empty_array_ref $hd->{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};
+ 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;
+ }
+ 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
+}
+
+
sub get_normal_parts($) {
my ($hd) = @_;
@@ -180,21 +227,20 @@ sub read_one($$) {
sub read($;$) {
my ($hd, $clearall) = @_;
- my $pt = $clearall ? { raw => [ {}, {}, {}, {} ] } : read_one($hd, 0) || return 0;
+ my $pt = $clearall ?
+ partition_table_raw::clear_raw() :
+ read_one($hd, 0) || return 0;
$hd->{primary} = $pt;
$hd->{extended} = undef;
$clearall and return $hd->{isDirty} = $hd->{needKernelReread} = 1;
-
- my @l = (@{$pt->{normal}}, $pt->{extended});
- foreach my $i (@l) { foreach (@l) {
- $i != $_ and verifyNotOverlap($i, $_) || die "partitions $i->{device} and $_->{device} are overlapping!";
- }}
+ verifyPrimary($pt);
eval {
$pt->{extended} and read_extended($hd, $pt->{extended}) || return 0;
}; die "extended partition: $@" if $@;
assign_device_numbers($hd);
+ remove_empty_extended($hd);
1;
}
@@ -222,7 +268,7 @@ sub read_extended($$) {
1;
}
-# give a hard drive hd, write the partition data
+# write the partition table
sub write($) {
my ($hd) = @_;
@@ -266,67 +312,105 @@ sub remove($$) {
$i = 0; foreach (@{$hd->{primary}->{normal}}) {
if ($_ eq $part) {
splice(@{$hd->{primary}->{normal}}, $i, 1);
- %$_ = ();
+ %$_ = (); # blank it
return $hd->{isDirty} = $hd->{needKernelReread} = 1;
}
$i++;
}
# otherwise search it in extended partitions
- my $last = $hd->{primary}->{extended};
- $i = 0; foreach (@{$hd->{extended}}) {
- if ($_->{normal} eq $part) {
- %{$last->{extended}} = $_->{extended} ? %{$_->{extended}} : ();
- splice(@{$hd->{extended}}, $i, 1);
-
- unless (@{$hd->{extended}}) {
- %{$hd->{primary}->{extended}} = ();
- delete $hd->{primary}->{extended};
- }
+ foreach (@{$hd->{extended}}) {
+ $_->{normal} eq $part or next;
- return $hd->{isDirty} = $hd->{needKernelReread} = 1;
- }
- $last = $_;
- $i++;
+ delete $_->{normal}; # remove it
+ remove_empty_extended($hd);
+
+ return $hd->{isDirty} = $hd->{needKernelReread} = 1;
}
0;
}
# create of partition at starting at `start', of size `size' and of type `type' (nice comment, uh?)
-# !be carefull!, no verification is done (start -> start+size must be free)
-sub add($$) {
+sub add_primary($$) {
my ($hd, $part) = @_;
- $part->{notFormatted} = 1;
- $part->{isFormatted} = 0;
- $part->{rootDevice} = $hd->{device};
- $hd->{isDirty} = $hd->{needKernelReread} = 1;
- adjustStartAndEnd($hd, $part);
-
- if (is_empty_array_ref($hd->{primary}->{normal})) {
+ {
+ 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);
- @{$hd->{primary}->{normal}} = $part;
- } else {
- $hd->{primary}->{extended} && !verifyInside($part, $hd->{primary}->{extended})
- and die "sorry, can't add outside the main extended partition";
-
- foreach (@{$hd->{extended}}) {
- $_->{normal} and next;
- raw_add($_->{raw}, $part);
- $_->{normal} = $part;
- return;
+ }
+ push @{$hd->{primary}->{normal}}, $part; # really do it
+}
+
+sub add_extended($$) {
+ my ($hd, $part) = @_;
+
+ my $e = $hd->{primary}->{extended};
+
+ if ($e && !verifyInside($part, $e)) {
+ #ie "sorry, can't add outside the main extended partition" unless $::unsafe;
+ my $end = $e->{start} + $e->{size};
+ my $start = min($e->{start}, $part->{start});
+ $end = max($end, $part->{start} + $part->{size}) - $start;
+
+ { # faking a resizing of the main extended partition to test for problems
+ local $e->{start} = $start;
+ local $e->{size} = $end - $start;
+ eval { verifyPrimary($hd->{primary}) };
+ $@ and die
+_("You have a hole in your partition table but I can't use it.
+The only solution is to move your primary partitions to have the hole next to the extended partitions");
}
+ }
+
+ if ($e && $part->{start} < $e->{start}) {
+
+ 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};
+ my $ext = { %$l };
+ unshift @{$hd->{extended}}, { type => 5, raw => [ $part, $ext, {}, {} ], normal => $part, extended => $ext };
+ # size will be autocalculated :)
+ } else {
+
my ($ext, $ext_size) = is_empty_array_ref($hd->{extended}) ?
- ($hd->{primary}, $hd->{totalsectors} - $part->{start}) :
+ ($hd->{primary}, -1) : # -1 size will be computed by adjust_main_extended
(top(@{$hd->{extended}}), $part->{size});
my %ext = ( type => 5, start => $part->{start}, size => $ext_size );
-
+
raw_add($ext->{raw}, \%ext);
$ext->{extended} = \%ext;
push @{$hd->{extended}}, { %ext, raw => [ $part, {}, {}, {} ], normal => $part };
+ }
+ $part->{start}++; $part->{size}--; # let it start after the extended partition sector
+ adjustStartAndEnd($hd, $part);
- $part->{start}++; $part->{size}--; # let it start after the extended partition sector
- adjustStartAndEnd($hd, $part);
+ adjust_main_extended($hd);
+}
+
+sub add($$;$) {
+ my ($hd, $part, $want_primary) = @_;
+
+ $part->{notFormatted} = 1;
+ $part->{isFormatted} = 0;
+ $part->{rootDevice} = $hd->{device};
+ $hd->{isDirty} = $hd->{needKernelReread} = 1;
+ $part->{start} ||= 1; # starting at sector 0 is not allowed
+ adjustStartAndEnd($hd, $part);
+
+ my $e = $hd->{primary}->{extended};
+
+ if (is_empty_array_ref($hd->{primary}->{normal}) || $want_primary) {
+ eval { add_primary($hd, $part) };
+ return unless $@;
+ }
+ eval { add_extended($hd, $part) }; # try adding extended
+ if (my $err = $@) {
+ eval { add_primary($hd, $part) };
+ die $@ if $@; # send the add extended error which should be better
}
}
@@ -366,30 +450,30 @@ sub load($$;$) {
my $h;
{
- no strict 'vars';
- $h = eval join '', <F>;
+ local $/ = "\0";
+ eval <F>;
}
$@ and die _("Restoring from file %s failed: %s", $file, $@);
- ref $h eq 'HASH' or die _("Bad backup file");
+ ref $h eq 'ARRAY' or die _("Bad backup file");
- $h->{totalsectors} == $hd->{totalsectors} or $force
- or die "Bad totalsectors";
+ my %h; @h{@fields2save} = @$h;
+
+ $h{totalsectors} == $hd->{totalsectors} or $force or die "Bad totalsectors";
# unsure we don't modify totalsectors
- $h->{totalsectors} = $hd->{totalsectors} if $force;
+ local $hd->{totalsectors};
- @{$hd}{@fields2save} = @{$h}{@fields2save};
+ @{$hd}{@fields2save} = @$h;
$hd->{isDirty} = $hd->{needKernelReread} = 1;
}
-
sub save($$) {
my ($hd, $file) = @_;
- my %h; @h{@fields2save} = @{$hd}{@fields2save};
+ my @h = @{$hd}{@fields2save};
local *F;
open F, ">$file"
- and print F Dumper(\%h)
+ and print F Data::Dumper->Dump([\@h], ['$h']), "\0"
or die _("Error writing to file %s", $file);
}
diff --git a/perl-install/partition_table_raw.pm b/perl-install/partition_table_raw.pm
index 973961f5a..67223e392 100644
--- a/perl-install/partition_table_raw.pm
+++ b/perl-install/partition_table_raw.pm
@@ -98,4 +98,10 @@ sub write($$$) {
syswrite F, $magic, length $magic or return 0;
1;
}
-sub zero_MBR($) { &write($_[0], 0, [ {} x $nb_primary ]); }
+
+sub clear_raw { { raw => [ ({}) x $nb_primary ] } }
+
+sub zero_MBR($) {
+ $_[0]->{primary} = clear_raw();
+ delete $_[0]->{extended};
+}
diff --git a/perl-install/pkgs.pm b/perl-install/pkgs.pm
index 0ad16d1b0..22256af4e 100644
--- a/perl-install/pkgs.pm
+++ b/perl-install/pkgs.pm
@@ -34,7 +34,7 @@ sub select($$;$) {
my $n = shift @l;
$n =~ /|/ and $n = first(split '\|', $n); #TODO better handling of choice
my $i = Package($packages, $n);
- $i->{base} = $base;
+ $i->{base} ||= $base;
$i->{deps} or log::l("missing deps for $n");
push @l, @{$i->{deps} || []} unless $i->{selected};
$i->{selected}++ unless $i->{selected} == -1;
@@ -42,6 +42,7 @@ sub select($$;$) {
}
sub unselect($$) {
my ($packages, $p) = @_;
+ $p->{base} and return;
my $set = set_new($p->{name});
my $l = $set->{list};
@@ -57,7 +58,7 @@ sub unselect($$) {
my $n = shift @$l;
my $i = Package($packages, $n);
- $i->{selected} <= 0 and next;
+ $i->{selected} <= 0 || $i->{base} and next;
if (--$i->{selected} == 0) {
push @$l, @{$i->{deps} || []};
}
@@ -121,6 +122,7 @@ sub getDeps($) {
open F, install_any::imageGetFile("depslist") or die "can't find dependencies list";
foreach (<F>) {
my ($name, $size, @deps) = split;
+ $packages->{$name} or next;
$packages->{$name}->{size} = $size;
$packages->{$name}->{deps} = \@deps;
map { push @{$packages->{$_}->{provides}}, $name } @deps;
@@ -160,6 +162,7 @@ sub setCompssSelected($$$) {
my $L = uc $l;
my $verif_lang = sub {
+ local $SIG{__DIE__} = 'none';
$_[0] =~ /-([^-]*)$/;
$1 eq $ENV{LANG} || eval { lang::text2lang($1) eq $ENV{LANG} } && !$@;
};
@@ -252,6 +255,7 @@ sub install {
my ($total, $nb);
foreach my $p (@$toInstall) {
+ $p->{installed} = 1;
c::rpmtransAddPackage($trans, getHeader($p), $p->{file}, $isUpgrade);
$nb++;
$total += $p->{size};
diff --git a/perl-install/share/list b/perl-install/share/list
index 83ca02797..2a5c7f5d3 100644
--- a/perl-install/share/list
+++ b/perl-install/share/list
@@ -14,11 +14,14 @@
/usr/lib/perl5/5.00503/SelfLoader.pm
/usr/lib/perl5/5.00503/Term/Cap.pm
/usr/lib/perl5/5.00503/Term/ReadLine.pm
+/usr/lib/perl5/5.00503/Data/Dumper.pm
/usr/lib/perl5/5.00503/diagnostics.pm
/usr/lib/perl5/5.00503/dumpvar.pl
/usr/lib/perl5/5.00503/i386-linux/Config.pm
/usr/lib/perl5/5.00503/i386-linux/DynaLoader.pm
/usr/lib/perl5/5.00503/i386-linux/Socket.pm
+/usr/lib/perl5/5.00503/i386-linux/auto/Data/Dumper/Dumper.bs
+/usr/lib/perl5/5.00503/i386-linux/auto/Data/Dumper/Dumper.so
/usr/lib/perl5/5.00503/i386-linux/auto/Socket/Socket.bs
/usr/lib/perl5/5.00503/i386-linux/auto/Socket/Socket.so
/usr/lib/perl5/5.00503/i386-linux/bits/syscall.ph
@@ -29,6 +32,7 @@
/usr/lib/perl5/5.00503/lib.pm
/usr/lib/perl5/5.00503/perl5db.pl
/usr/lib/perl5/5.00503/pod/perldiag.pod
+/usr/lib/perl5/5.00503/overload.pm
/usr/lib/perl5/5.00503/strict.pm
/usr/lib/perl5/5.00503/vars.pm
/usr/lib/perl5/site_perl/5.005/i386-linux/Gtk.pm
generated by cgit v1.2.1 (git 2.21.0) at 2024-11-02 19:48:59 +0000