summaryrefslogtreecommitdiffstats
path: root/perl-install
diff options
context:
space:
mode:
Diffstat (limited to 'perl-install')
-rw-r--r--perl-install/ChangeLog16
-rw-r--r--perl-install/c/stuff.xs.pm18
-rw-r--r--perl-install/commands.pm1
-rw-r--r--perl-install/devices.pm5
-rw-r--r--perl-install/fs.pm85
-rw-r--r--perl-install/fsedit.pm23
-rw-r--r--perl-install/install2.pm26
-rw-r--r--perl-install/install_any.pm1
-rw-r--r--perl-install/install_steps.pm8
-rw-r--r--perl-install/install_steps_interactive.pm21
-rw-r--r--perl-install/interactive_gtk.pm6
-rw-r--r--perl-install/loopback.pm9
-rw-r--r--perl-install/modules.pm5
-rw-r--r--perl-install/pkgs.pm2
-rw-r--r--perl-install/share/fonts.tar.bz2bin1105673 -> 1105293 bytes
15 files changed, 159 insertions, 67 deletions
diff --git a/perl-install/ChangeLog b/perl-install/ChangeLog
index 2372bfb23..06f1f5a71 100644
--- a/perl-install/ChangeLog
+++ b/perl-install/ChangeLog
@@ -1,3 +1,19 @@
+2000-03-11 Pixel <pixel@mandrakesoft.com>
+
+ * devices.pm (set_loop): created, searches for an available
+ loopback and sets the file to it
+
+ * lilo.pm (dev2grub): fixed a missing slash
+
+ * interactive_gtk.pm (wait_message_nextW): do not update if same
+ message, otherwise silly gtk won't do anything and we'll wait
+ forever :(
+
+2000-03-10 Pixel <pixel@mandrakesoft.com>
+
+ * install2.pm (@install_classes): cleanup, no more i18n (is now in
+ install_steps_interactive), remove old entries
+
2000-03-09 Pixel <pixel@mandrakesoft.com>
* modules.pm (write_conf): don't add alias block-major-11 in every case
diff --git a/perl-install/c/stuff.xs.pm b/perl-install/c/stuff.xs.pm
index cdaa2d292..d8395dc66 100644
--- a/perl-install/c/stuff.xs.pm
+++ b/perl-install/c/stuff.xs.pm
@@ -255,7 +255,7 @@ set_loop(dev_fd, file)
if (file_fd < 0) return;
- memset(&loopinfo, 0, sizeof (loopinfo));
+ memset(&loopinfo, 0, sizeof(loopinfo));
strncpy(loopinfo.lo_name, file, LO_NAME_SIZE);
loopinfo.lo_name[LO_NAME_SIZE - 1] = 0;
@@ -269,6 +269,22 @@ set_loop(dev_fd, file)
}
OUTPUT:
RETVAL
+
+int
+del_loop(device)
+ char *device
+ CODE:
+ RETVAL = 0;
+{
+ int fd;
+ if ((fd = open(device, O_RDONLY)) < 0) return;
+ if (ioctl(fd, LOOP_CLR_FD, 0) < 0) return;
+ close(fd);
+ RETVAL = 1;
+}
+ OUTPUT:
+ RETVAL
+
';
$ENV{C_RPM} and print '
diff --git a/perl-install/commands.pm b/perl-install/commands.pm
index ace3cb395..1f2170de2 100644
--- a/perl-install/commands.pm
+++ b/perl-install/commands.pm
@@ -68,6 +68,7 @@ sub mount {
my $fs = $t && shift;
@_ == 2 or die "usage: mount [-r] [-t <fs>] <device> <dir>\n",
+ " (use -r for readonly)\n",
" (if /dev/ is left off the device name, a temporary node will be created)\n";
my ($dev, $where) = @_;
diff --git a/perl-install/devices.pm b/perl-install/devices.pm
index 19baec6f7..29c89a1d5 100644
--- a/perl-install/devices.pm
+++ b/perl-install/devices.pm
@@ -38,11 +38,12 @@ sub size($) {
sub set_loop {
my ($file) = @_;
- foreach (0..9) {
+ foreach (0..7) {
local *F;
my $dev = make("loop$_");
- sysopen F, $dev, 0 or next;
+ sysopen F, $dev, 2 or next;
!ioctl(F, c::LOOP_GET_STATUS(), my $tmp) && $! == 6 or next; #- 6 == ENXIO
+ log::l("trying with loop $dev");
return c::set_loop(fileno F, $file) && $dev;
}
}
diff --git a/perl-install/fs.pm b/perl-install/fs.pm
index 5a506c411..7fc15dcec 100644
--- a/perl-install/fs.pm
+++ b/perl-install/fs.pm
@@ -37,6 +37,15 @@ sub read_fstab($) {
} <F>;
}
+sub up_mount_point {
+ my ($mntpoint, $fstab) = @_;
+ while (1) {
+ $mntpoint = dirname($mntpoint);
+ $mntpoint ne "." or return;
+ $_->{mntpoint} eq $mntpoint and return $_ foreach @$fstab;
+ }
+}
+
sub check_mounted($) {
my ($fstab) = @_;
@@ -113,16 +122,39 @@ sub real_format_part {
$part->{isFormatted} = 1;
}
sub format_part {
- my ($raid, $part) = @_;
+ my ($raid, $part, $prefix) = @_;
if (raid::is($part)) {
raid::format_part($raid, $part);
} elsif (isLoopback($part)) {
- loopback::format_part($part);
+ loopback::format_part($part, $prefix);
} else {
real_format_part($part);
}
}
+sub formatMount_part {
+ my ($part, $raid, $fstab, $prefix, $callback) = @_;
+
+ if (my $p = up_mount_point($part->{mntpoint}, $fstab)) {
+ formatMount_part($p, $raid, $fstab, $prefix, $callback);
+ }
+ if (isLoopback($part)) {
+ formatMount_part($part->{device}, $raid, $fstab, $prefix, $callback);
+ }
+
+ if ($part->{toFormat}) {
+ $callback->($part) if $callback;
+ format_part($raid, $part, $prefix);
+ }
+ mount_part($part, $prefix);
+}
+
+sub formatMount_all {
+ my ($raid, $fstab, $prefix, $callback) = @_;
+ formatMount_part($_, $raid, $fstab, $prefix, $callback)
+ foreach sort { isLoopback($a) ? 1 : -1 } grep { $_->{mntpoint} } @$fstab;
+}
+
sub mount($$$;$) {
my ($dev, $where, $fs, $rdonly) = @_;
log::l("mounting $dev on $where as type $fs");
@@ -173,11 +205,15 @@ sub mount_part($;$$) {
$part->{isMounted} and return;
unless ($::testing) {
- local $part->{device} = devices::set_loop(loopback::file($part)) || die if isLoopback($part);
if (isSwap($part)) {
- swap::swapon($part->{device});
+ swap::swapon(isLoopback($part) ? $prefix . loopback::file($part) : $part->{device});
} else {
$part->{mntpoint} or die "missing mount point";
+
+ eval { modules::load('loop') } if isLoopback($part);
+ $part->{real_device} = devices::set_loop($prefix . loopback::file($part)) || die if isLoopback($part);
+ local $part->{device} = $part->{real_device} if isLoopback($part);
+
mount(devices::make($part->{device}), ($prefix || '') . $part->{mntpoint}, type2fs($part->{type}), $rdonly);
}
}
@@ -190,9 +226,12 @@ sub umount_part($;$) {
$part->{isMounted} or return;
unless ($::testing) {
- isSwap($part) ?
- swap::swapoff($part->{device}) :
- umount(($prefix || '') . ($part->{mntpoint} || devices::make($part->{device})));
+ if (isSwap($part)) {
+ swap::swapoff($part->{device});
+ } else {
+ umount(($prefix || '') . $part->{mntpoint} || devices::make($part->{device}));
+ c::del_loop(delete $part->{real_device}) if isLoopback($part);
+ }
}
$part->{isMounted} = 0;
}
@@ -308,19 +347,19 @@ sub write_fstab($;$$) {
print F join(" ", @$_), "\n" foreach sort { $a->[1] cmp $b->[1] } @to_add;
}
-sub check_mount_all_fstab($;$) {
- my ($fstab, $prefix) = @_;
- $prefix ||= '';
-
- foreach (sort { ($a->{mntpoint} || '') cmp ($b->{mntpoint} || '') } @$fstab) {
- #- avoid unwanted mount in fstab.
- next if ($_->{device} =~ /none/ || $_->{type} =~ /nfs|smbfs|ncpfs|proc/ || $_->{options} =~ /noauto|ro/);
-
- #- TODO fsck
-
- eval { mount(devices::make($_->{device}), $prefix . $_->{mntpoint}, $_->{type}, 0); };
- if ($@) {
- log::l("unable to mount partition $_->{device} on $prefix/$_->{mntpoint}");
- }
- }
-}
+#sub check_mount_all_fstab($;$) {
+# my ($fstab, $prefix) = @_;
+# $prefix ||= '';
+#
+# foreach (sort { ($a->{mntpoint} || '') cmp ($b->{mntpoint} || '') } @$fstab) {
+# #- avoid unwanted mount in fstab.
+# next if ($_->{device} =~ /none/ || $_->{type} =~ /nfs|smbfs|ncpfs|proc/ || $_->{options} =~ /noauto|ro/);
+#
+# #- TODO fsck
+#
+# eval { mount(devices::make($_->{device}), $prefix . $_->{mntpoint}, $_->{type}, 0); };
+# if ($@) {
+# log::l("unable to mount partition $_->{device} on $prefix/$_->{mntpoint}");
+# }
+# }
+#}
diff --git a/perl-install/fsedit.pm b/perl-install/fsedit.pm
index 96d572cb5..e8b045d04 100644
--- a/perl-install/fsedit.pm
+++ b/perl-install/fsedit.pm
@@ -230,7 +230,7 @@ sub has_mntpoint($$) {
#- do this before modifying $part->{mntpoint}
#- $part->{mntpoint} should not be used here, use $mntpoint instead
sub check_mntpoint {
- my ($mntpoint, $hd, $part, $hds) = @_;
+ my ($mntpoint, $hd, $part, $hds, $loopbackDevice) = @_;
$mntpoint eq '' || isSwap($part) || isRAID($part) and return;
@@ -238,7 +238,23 @@ sub check_mntpoint {
m|^/| or die _("Mount points must begin with a leading /");
#- m|(.)/$| and die "The mount point $_ is illegal.\nMount points may not end with a /";
- has_mntpoint($mntpoint, $hds) and die _("There is already a partition with mount point %s", $mntpoint);
+ has_mntpoint($mntpoint, $hds) and die _("There is already a partition with mount point %s\n", $mntpoint);
+
+ my $fake_part = { mntpoint => $mntpoint, device => $loopbackDevice };
+ $fake_part->{loopback_file} = 1 if $loopbackDevice;
+ my $fstab = [ get_fstab(@$hds), $fake_part ];
+ my $check; $check = sub {
+ my ($p, @seen) = @_;
+ push @seen, $p->{mntpoint} || return;
+ @seen > 1 && $p->{mntpoint} eq $mntpoint and die _("Circular mounts %s\n", join(", ", @seen));
+ if (my $part = fs::up_mount_point($p->{mntpoint}, $fstab)) {
+ $check->($part, @seen);
+ }
+ if (isLoopback($p)) {
+ $check->($p->{device}, @seen);
+ }
+ };
+ $check->($fake_part);
#- if ($part->{start} + $part->{size} > 1024 * $hd->cylinder_size() && arch() =~ /i386/) {
#- die "/boot ending on cylinder > 1024" if $mntpoint eq "/boot";
@@ -267,12 +283,9 @@ sub allocatePartitions($$) {
while (suggest_part($hd,
$part = { start => $start, size => 0, maxsize => $size },
$hds, $to_add)) {
- log::l("partsize " . ($part->{size}+ $part->{start}));
- log::l("size " . ($size+ $start));
add($hd, $part, $hds);
$size -= $part->{size} + $part->{start} - $start;
$start = $part->{start} + $part->{size};
- log::l("size " . ($size+ $start));
}
}
}
diff --git a/perl-install/install2.pm b/perl-install/install2.pm
index bc00a3e6e..e658953dd 100644
--- a/perl-install/install2.pm
+++ b/perl-install/install2.pm
@@ -81,8 +81,7 @@ arch() =~ /alpha/ ? (
#-INTERNAL CONSTANT
#-#####################################################################################
-#- these strings are used in quite a lot of places and must not be changed!!!!!
-my @install_classes = (__("beginner"), __("developer"), __("server"), __("expert"));
+my @install_classes = qw(normal developer server);
#-#####################################################################################
#-Default value
@@ -327,13 +326,7 @@ Then choose action ``Mount point'' and set it to `/'");
sub formatPartitions {
unless ($o->{lnx4win} || $o->{isUpgrade}) {
$o->choosePartitionsToFormat($o->{fstab});
-
- unless ($::testing) {
- $o->formatPartitions(@{$o->{fstab}});
- fs::mount_all([ grep { isSwap($_) } @{$o->{fstab}} ], $o->{prefix});
- die _("Not enough swap to fulfill installation, please add some") if availableMemory < 40 * 1024;
- fs::mount_all([ grep { isExt2($_) } @{$o->{fstab}} ], $o->{prefix}, $o->{hd_dev});
- }
+ $o->formatMountPartitions($o->{fstab}) unless $::testing;
eval { $o = $::o = install_any::loadO($o) } if $_[1] == 1;
}
@@ -546,11 +539,16 @@ sub main {
symlinkf $root, "/tmp/rhimage" or die "unable to create link /tmp/rhimage";
}
- unlink "/sbin/insmod" unless $::testing;
- unlink "/modules/pcmcia_core.o" unless $::testing; #- always use module from archive.
- unlink "/modules/i82365.o" unless $::testing;
- unlink "/modules/tcic.o" unless $::testing;
- unlink "/modules/ds.o" unless $::testing;
+ unless ($::testing) {
+ unlink $_ foreach (
+ "/sbin/insmod", "/sbin/rmmod", "/sbin/install",
+ "/modules/modules.cgz",
+ "/modules/pcmcia_core.o", #- always use module from archive.
+ "/modules/i82365.o",
+ "/modules/tcic.o",
+ "/modules/ds.o",
+ );
+ }
print STDERR "in second stage install\n";
log::openLog(($::testing || $o->{localInstall}) && 'debug.log');
diff --git a/perl-install/install_any.pm b/perl-install/install_any.pm
index 5e1232f90..41a46f93b 100644
--- a/perl-install/install_any.pm
+++ b/perl-install/install_any.pm
@@ -178,6 +178,7 @@ sub setPackages($) {
push @{$o->{default_packages}}, "apmd" if $o->{pcmcia};
push @{$o->{default_packages}}, "raidtools" if $o->{raid} && !is_empty_array_ref($o->{raid}{raid});
push @{$o->{default_packages}}, "cdrecord" if detect_devices::getIDEBurners();
+ push @{$o->{default_packages}}, "alsa" if modules::get_alias("sound") =~ /^snd-card-/;
pkgs::getDeps($o->{packages});
diff --git a/perl-install/install_steps.pm b/perl-install/install_steps.pm
index 6004096b1..a867b8155 100644
--- a/perl-install/install_steps.pm
+++ b/perl-install/install_steps.pm
@@ -165,11 +165,9 @@ sub choosePartitionsToFormat($$) {
}
}
-sub formatPartitions {
- my $o = shift;
- foreach (@_) {
- fs::format_part($o->{raid}, $_) if $_->{toFormat};
- }
+sub formatMountPartitions {
+ my ($o) = @_;
+ fs::formatMount_all($o->{raid}, $o->{fstab}, $o->{prefix});
}
#------------------------------------------------------------------------------
diff --git a/perl-install/install_steps_interactive.pm b/perl-install/install_steps_interactive.pm
index 86bed9004..3fa598da9 100644
--- a/perl-install/install_steps_interactive.pm
+++ b/perl-install/install_steps_interactive.pm
@@ -25,6 +25,7 @@ use mouse;
use modules;
use lang;
use services;
+use loopback;
use keyboard;
use any;
use fs;
@@ -223,15 +224,17 @@ sub choosePartitionsToFormat($$) {
[ map { \$_->{toFormatCheck} } @l ]) or goto &choosePartitionsToFormat if $::expert;
}
-sub formatPartitions {
- my $o = shift;
- my $w = $o->wait_message('', '');
- foreach (@_) {
- if ($_->{toFormat}) {
- $w->set(_("Formatting partition %s", $_->{device}));
- fs::format_part($o->{raid}, $_);
- }
- }
+
+sub formatMountPartitions {
+ my ($o, $fstab) = @_;
+ my $w = $o->wait_message('', _("Formatting partitions"));
+ fs::formatMount_all($o->{raid}, $o->{fstab}, $o->{prefix}, sub {
+ my ($part) = @_;
+ $w->set(isLoopback($part) ?
+ _("Creating and formatting loopback file %s", loopback::file($part)) :
+ _("Formatting partition %s", $part->{device}));
+ });
+ die _("Not enough swap to fulfill installation, please add some") if availableMemory < 40 * 1024;
}
#------------------------------------------------------------------------------
diff --git a/perl-install/interactive_gtk.pm b/perl-install/interactive_gtk.pm
index 250700578..3a9feefb8 100644
--- a/perl-install/interactive_gtk.pm
+++ b/perl-install/interactive_gtk.pm
@@ -297,14 +297,16 @@ sub wait_messageW($$$) {
@$messages,
$w->{wait_messageW} = new Gtk::Label($W)));
$w->{rwindow}->set_position('center') if $::isStandalone;
- $w->{wait_messageW}->signal_connect(expose_event => sub { $w->{displayed} = 1 });
+ $w->{wait_messageW}->signal_connect(expose_event => sub { print "expose_event\n"; $w->{displayed} = 1 });
$w->sync until $w->{displayed};
$w;
}
sub wait_message_nextW {
my ($o, $messages, $w) = @_;
+ my $msg = join "\n", @$messages;
+ return if $msg eq $w->{wait_messageW}->get; #- needed otherwise no expose_event :(
$w->{displayed} = 0;
- $w->{wait_messageW}->set(join "\n", @$messages);
+ $w->{wait_messageW}->set($msg);
$w->flush until $w->{displayed};
}
sub wait_message_endW {
diff --git a/perl-install/loopback.pm b/perl-install/loopback.pm
index 0fdebebaf..32bb62b3a 100644
--- a/perl-install/loopback.pm
+++ b/perl-install/loopback.pm
@@ -24,17 +24,16 @@ sub loopbacks {
}
sub format_part {
- my ($part) = @_;
- my $prefix = $::isStandalone ? '' : $::o->{prefix};
+ my ($part, $prefix) = @_;
fs::mount_part($part->{device}, $prefix);
- my $f = create($part);
+ my $f = create($part, $prefix);
local $part->{device} = $f;
fs::real_format_part($part);
}
sub create {
- my ($part) = @_;
- my $f = "$part->{device}{mntpoint}$part->{loopback_file}";
+ my ($part, $prefix) = @_;
+ my $f = "$prefix$part->{device}{mntpoint}$part->{loopback_file}";
return $f if -e $f;
eval { commands::mkdir_("-p", dirname($f)) };
diff --git a/perl-install/modules.pm b/perl-install/modules.pm
index 8ed1be0c9..c288168dd 100644
--- a/perl-install/modules.pm
+++ b/perl-install/modules.pm
@@ -338,6 +338,11 @@ sub text2driver($) {
die "$text is not a valid module description";
}
+sub get_alias {
+ my ($alias) = @_;
+ $conf{$alias}{alias};
+}
+
sub add_alias($$) {
my ($alias, $name) = @_;
/\Q$alias/ && $conf{$_}{alias} && $conf{$_}{alias} eq $name and return $_ foreach keys %conf;
diff --git a/perl-install/pkgs.pm b/perl-install/pkgs.pm
index d30d0e408..c6d7f402e 100644
--- a/perl-install/pkgs.pm
+++ b/perl-install/pkgs.pm
@@ -788,7 +788,7 @@ sub install($$$;$$) {
foreach @transToInstall;
my $close = sub {
- c::headerFree(delete $_->{header}) foreach @transToInstall;
+# c::headerFree(delete $_->{header}) foreach @transToInstall;
c::rpmtransFree($trans);
};
diff --git a/perl-install/share/fonts.tar.bz2 b/perl-install/share/fonts.tar.bz2
index ef771a167..66dcc9053 100644
--- a/perl-install/share/fonts.tar.bz2
+++ b/perl-install/share/fonts.tar.bz2
Binary files differ
generated by cgit v1.2.1 (git 2.21.0) at 2024-11-03 00:29:20 +0000