summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--perl-install/ChangeLog15
-rw-r--r--perl-install/detect_devices.pm8
-rw-r--r--perl-install/fs.pm71
-rw-r--r--perl-install/fsedit.pm11
-rw-r--r--perl-install/install_any.pm8
-rw-r--r--perl-install/install_steps.pm2
-rw-r--r--perl-install/install_steps_interactive.pm2
-rw-r--r--perl-install/loopback.pm83
-rw-r--r--perl-install/partition_table.pm8
-rw-r--r--perl-install/pkgs.pm2
-rw-r--r--perl-install/raid.pm8
-rwxr-xr-xperl-install/standalone/diskdrake2
12 files changed, 168 insertions, 52 deletions
diff --git a/perl-install/ChangeLog b/perl-install/ChangeLog
index 6035be0d0..b0f8ea58d 100644
--- a/perl-install/ChangeLog
+++ b/perl-install/ChangeLog
@@ -1,3 +1,18 @@
+2000-03-09 Pixel <pixel@mandrakesoft.com>
+
+ * fs.pm (format_*): move the @options before the device
+
+ * loopback.pm: created, added a lot of stuff for loopback in
+ diskdrake.pm, fs.pm...
+
+2000-03-08 Pixel <pixel@mandrakesoft.com>
+
+ * partition_table.pm: %type2fs replaced ox402 by 0x402
+
+ * detect_devices.pm (cdroms): fix "scd" (should be "scd0")
+
+ * install_any.pm (install_urpmi): update for new hdlist.cz2
+
2000-03-07 Pixel <pixel@mandrakesoft.com>
* interactive_gtk.pm (ask_from_treelistW): s/focus_row/set_focus_row/
diff --git a/perl-install/detect_devices.pm b/perl-install/detect_devices.pm
index c1333f34e..484a4dfe8 100644
--- a/perl-install/detect_devices.pm
+++ b/perl-install/detect_devices.pm
@@ -38,13 +38,13 @@ sub zips() { grep { $_->{type} eq 'hd' && isZipDrive($_) } get(); }
#-sub jazzs() { grep { $_->{type} eq 'hd' && isJazDrive($_) } get(); }
sub cdroms() {
my @l = grep { $_->{type} eq 'cdrom' } get();
- if (getIDEBurners()) {
+ if (my @l2 = getIDEBurners()) {
require modules;
- my $nb = modules::add_alias('scsi_hostadapter', 'ide-scsi') =~ /(\d+)/;
- foreach my $b (getIDEBurners()) {
+ my ($nb) = modules::add_alias('scsi_hostadapter', 'ide-scsi') =~ /(\d*)/;
+ foreach my $b (@l2) {
log::l("getIDEBurners: $b");
my ($e) = grep { $_->{device} eq $b } @l or next;
- $e->{device} = "scd" . $nb++;
+ $e->{device} = "scd" . ($nb++ || 0);
}
}
@l;
diff --git a/perl-install/fs.pm b/perl-install/fs.pm
index 27c177a25..661564ecd 100644
--- a/perl-install/fs.pm
+++ b/perl-install/fs.pm
@@ -13,9 +13,17 @@ use swap;
use detect_devices;
use commands;
use modules;
+use raid;
+use loopback;
1;
+sub add_options(\$@) {
+ my ($option, @options) = @_;
+ my %l; @l{split(',', $$option), @options} = (); delete $l{defaults};
+ $$option = join(',', keys %l) || "defaults";
+}
+
sub read_fstab($) {
my ($file) = @_;
@@ -64,29 +72,31 @@ sub format_ext2($@) {
$dev =~ m,(rd|ida)/, and push @options, qw(-b 4096 -R stride=16); #- For RAID only.
- run_program::run("mke2fs", devices::make($dev), @options) or die _("%s formatting of %s failed", "ext2", $dev);
+ run_program::run("mke2fs", @options, devices::make($dev)) or die _("%s formatting of %s failed", "ext2", $dev);
}
sub format_dos($@) {
my ($dev, @options) = @_;
- run_program::run("mkdosfs", devices::make($dev), @options) or die _("%s formatting of %s failed", "dos", $dev);
+ run_program::run("mkdosfs", @options, devices::make($dev)) or die _("%s formatting of %s failed", "dos", $dev);
}
sub format_hfs($@) {
my ($dev, @options) = @_;
- run_program::run("hformat", devices::make($dev), @options) or die _("%s formatting of %s failed", "HFS", $dev);
+ run_program::run("hformat", @options, devices::make($dev)) or die _("%s formatting of %s failed", "HFS", $dev);
}
-sub format_part($;@) {
- my ($part, @options) = @_;
+sub real_format_part {
+ my ($part) = @_;
$part->{isFormatted} and return;
+ my @options = $part->{toFormatCheck} ? "-c" : ();
log::l("formatting device $part->{device} (type ", type2name($part->{type}), ")");
if (isExt2($part)) {
+ push @options, "-F" if isLoopback($part);
format_ext2($part->{device}, @options);
} elsif (isDos($part)) {
format_dos($part->{device}, @options);
@@ -102,6 +112,16 @@ sub format_part($;@) {
}
$part->{isFormatted} = 1;
}
+sub format_part {
+ my ($raid, $part) = @_;
+ if (raid::is($part)) {
+ raid::format_part($raid, $part);
+ } elsif (isLoopback($part)) {
+ loopback::format_part($part);
+ } else {
+ real_format_part($part);
+ }
+}
sub mount($$$;$) {
my ($dev, $where, $fs, $rdonly) = @_;
@@ -184,7 +204,7 @@ sub mount_all($;$$) {
$hd_dev ||= cat_("/proc/mounts") =~ m|/tmp/(\S+)\s+/tmp/hdimage| unless $::isStandalone;
#- order mount by alphabetical ordre, that way / < /home < /home/httpd...
- foreach (grep { $_->{mntpoint} } sort { ($a->{mntpoint} || '') cmp ($b->{mntpoint} || '') } @$fstab) {
+ foreach (sort { $a->{mntpoint} cmp $b->{mntpoint} } grep { $_->{mntpoint} } @$fstab) {
if ($hd_dev && $_->{device} eq $hd_dev) {
my $dir = "$prefix$_->{mntpoint}";
$dir =~ s|/+$||;
@@ -258,39 +278,24 @@ sub write_fstab($;$$) {
$options = $_->{options} || $options;
isExt2($_) and ($freq, $passno) = (1, ($_->{mntpoint} eq '/') ? 1 : 2);
- isNfs($_) and $dir = '', $options ||= 'ro,nosuid,rsize=8192,wsize=8192';
+ isNfs($_) and $dir = '', $options = $_->{options} || 'ro,nosuid,rsize=8192,wsize=8192';
+ isFat($_) and $options = $_->{options} || "user,exec";
+
+ my $dev = isLoopback($_) ? loopback::file($_) :
+ $_->{device} =~ /^\// ? $_->{device} : "$dir$_->{device}";
+
+ add_options($options, "loop") if isLoopback($_);
#- keep in mind the new line for fstab.
- @new{($_->{mntpoint}, "$dir$_->{device}")} = undef;
+ @new{($_->{mntpoint}, $dev)} = undef;
- #- tested? devices::make("$prefix/$dir$_->{device}") if $_->{device} && $dir && !$_->{noMakeDevice};
- eval { devices::make("$prefix/$dir$_->{device}") } if $_->{device} && $dir;
+ eval { devices::make("$prefix/$dev") } if $dir && !isLoopback($_);
mkdir "$prefix/$_->{mntpoint}", 0755 if $_->{mntpoint} && !isSwap($_);
- [ ( $_->{device} =~ /^\// ? $_->{device} : "$dir$_->{device}" ),
- $_->{mntpoint}, type2fs($_->{type}), $options, $freq, $passno ];
-
- } grep { $_->{mntpoint} && type2fs($_->{type}) && !isFat($_) &&
- ! exists $new{$_->{mntpoint}} && ! exists $new{"/dev/$_->{device}"} } @$fstab;
-
- #- inserts dos/win partitions in fstab.
- #- backward compatible win kdeicons script to handle upgrade correctly?
- #- take into account an already provided mount point.
- unshift @to_add,
- map_index {
- my $i = $::i ? $::i + 1 : '';
- my $device = $_->{device} =~ /^\/dev\/(.*)$/ ? $1 : $_->{device};
- my $mntpoint = $_->{mntpoint} ? $_->{mntpoint} : "/mnt/DOS_$device";
-
- #- keep in mind the new line for fstab.
- @new{($mntpoint, "/dev/$device")} = undef;
-
- mkdir "$prefix/$mntpoint", 0755 or log::l("failed to mkdir $prefix/$mntpoint: $!");
- eval { devices::make("$prefix/dev/$device") };
+ [ $dev, $_->{mntpoint}, type2fs($_->{type}), $options, $freq, $passno ];
- [ "/dev/$device", $mntpoint, "vfat", "user,exec,conv=binary", 0, 0 ];
- } grep { isFat($_) &&
- ! exists $new{"/dev/$_->{device}"} } @$fstab;
+ } grep { $_->{mntpoint} && type2fs($_->{type}) &&
+ ! exists $new{$_->{mntpoint}} && ! exists $new{"/dev/$_->{device}"} } @$fstab;
push @to_add,
grep { !exists $new{$_->[0]} && !exists $new{$_->[1]} }
diff --git a/perl-install/fsedit.pm b/perl-install/fsedit.pm
index c05a1b27b..c1fd12697 100644
--- a/perl-install/fsedit.pm
+++ b/perl-install/fsedit.pm
@@ -13,6 +13,7 @@ use detect_devices;
use Data::Dumper;
use fsedit;
use devices;
+use loopback;
use fs;
use log;
@@ -39,6 +40,7 @@ my @suggestions_mntpoints = qw(/mnt/dos);
my @partitions_signatures = (
[ 0x83, 0x438, "\x53\xEF" ],
[ 0x82, 4086, "SWAP-SPACE" ],
+ [ 0x7, 0x3, "NTFS" ],
[ 0xc, 0x1FE, "\x55\xAA", 0x52, "FAT32" ],
arch() !~ /^sparc/ ? (
[ 0x6, 0x1FE, "\x55\xAA", 0x36, "FAT" ],
@@ -92,12 +94,12 @@ sub readProcPartitions {
#- get all normal partition including special ones as found on sparc.
sub get_fstab(@) {
- map { partition_table::get_normal_parts($_) } @_;
+ loopback::loopbacks(@_), map { partition_table::get_normal_parts($_) } @_
}
#- get normal partition that should be visible for working on.
sub get_visible_fstab(@) {
- grep { $_ && !partition_table::isWholedisk($_) } get_fstab(@_);
+ grep { $_ && !partition_table::isWholedisk($_) } map { partition_table::get_normal_parts($_) } @_;
}
sub free_space(@) {
@@ -219,7 +221,10 @@ sub suggestions_mntpoint($) {
sub has_mntpoint($$) {
my ($mntpoint, $hds) = @_;
- scalar grep { $mntpoint eq $_->{mntpoint} } get_fstab(@$hds);
+ scalar grep {
+ $mntpoint eq $_->{mntpoint} ||
+ grep { $mntpoint eq $_->{mntpoint} } @{$_->{loopback} || []}
+ } get_fstab(@$hds);
}
#- do this before modifying $part->{mntpoint}
diff --git a/perl-install/install_any.pm b/perl-install/install_any.pm
index e77c4af61..c11e24be3 100644
--- a/perl-install/install_any.pm
+++ b/perl-install/install_any.pm
@@ -506,6 +506,9 @@ sub install_urpmi {
(my $name = _("installation")) =~ s/\s/_/g; #- in case translators are too good :-/
+ my $hdlist = "$prefix/var/lib/urpmi/hdlist";
+ symlink "$hdlist.cz2", "hdlist.$name.cz2" or log::l("symlink failed " . __FILE__ . " " . __LINE__);
+
{
local *F = getFile("depslist");
output("$prefix/var/lib/urpmi/depslist", <F>);
@@ -519,7 +522,10 @@ sub install_urpmi {
ftp => $ENV{URLPREFIX},
http => $ENV{URLPREFIX},
cdrom => "removable_cdrom_1://mnt/cdrom" }}{$method};
- print LIST "$dir/Mandrake/RPMS/", /(\S+)/, "\n" foreach cat_("$prefix/var/lib/urpmi/depslist");
+
+ local *FILES; open FILES, "bzip2 -dc $hdlist.cz2 2>/dev/null | hdlist2names - |";
+ chop, print LIST "$dir/Mandrake/RPMS/$_\n" foreach <FILES>;
+ close FILES or log::l("hdlist2names failed"), return;
$dir .= "/Mandrake/RPMS with ../base/hdlist.cz2" if $method =~ /ftp|http/;
eval { output "$prefix/etc/urpmi/urpmi.cfg", "$name $dir\n" };
diff --git a/perl-install/install_steps.pm b/perl-install/install_steps.pm
index b1c842e16..099f44659 100644
--- a/perl-install/install_steps.pm
+++ b/perl-install/install_steps.pm
@@ -168,7 +168,7 @@ sub choosePartitionsToFormat($$) {
sub formatPartitions {
my $o = shift;
foreach (@_) {
- raid::format_part($o->{raid}, $_) if $_->{toFormat};
+ fs::format_part($o->{raid}, $_) if $_->{toFormat};
}
}
diff --git a/perl-install/install_steps_interactive.pm b/perl-install/install_steps_interactive.pm
index b66853989..86bed9004 100644
--- a/perl-install/install_steps_interactive.pm
+++ b/perl-install/install_steps_interactive.pm
@@ -229,7 +229,7 @@ sub formatPartitions {
foreach (@_) {
if ($_->{toFormat}) {
$w->set(_("Formatting partition %s", $_->{device}));
- raid::format_part($o->{raid}, $_);
+ fs::format_part($o->{raid}, $_);
}
}
}
diff --git a/perl-install/loopback.pm b/perl-install/loopback.pm
new file mode 100644
index 000000000..d992f4dec
--- /dev/null
+++ b/perl-install/loopback.pm
@@ -0,0 +1,83 @@
+package loopback;
+
+use diagnostics;
+use strict;
+
+#-######################################################################################
+#- misc imports
+#-######################################################################################
+use common qw(:common :system :file);
+use partition_table qw(:types);
+use commands;
+use fs;
+use log;
+
+
+sub file {
+ my ($part) = @_;
+ ($part->{device}{mntpoint} || die "loopback::file but loopback file has no associated mntpoint") .
+ $part->{loopback_file};
+}
+
+sub ffile { "$_[0]{device}{mntpoint}$_[0]{loopback_file}" }
+
+sub loopbacks {
+ map { map { @{$_->{loopback} || []} } partition_table::get_normal_parts($_) } @_;
+}
+
+sub format_part {
+ my ($part) = @_;
+ my $prefix = $::isStandalone ? '' : $::o->{prefix};
+ fs::mount_part($part->{device}, $prefix);
+ my $f = create($part);
+ local $part->{device} = $f;
+ fs::real_format_part($part);
+}
+
+sub create {
+ my ($part) = @_;
+ my $f = "$part->{device}{mntpoint}$part->{loopback_file}";
+ return $f if -e $f;
+
+ eval { commands::mkdir_("-p", dirname($f)) };
+
+ local *F;
+ open F, ">$f" or die "failed to create loopback file";
+ for (my $nb = $part->{size}; $nb >= 0; $nb -= 8) { #- 8 * 512 = 4096 :)
+ print F "\0" x 4096;
+ }
+ $f;
+}
+
+sub getFree {
+ my ($part, $prefix) = @_;
+
+ unless ($part->{freespace}) {
+ $part->{isFormatted} || !$part->{notFormatted} or return;
+ isMountableRW($part) or return;
+
+ my $dir = "/tmp/loopback_tmp";
+ if ($part->{isMounted}) {
+ $dir = ($prefix || '') . $part->{mntpoint};
+ } else {
+ mkdir $dir, 0700;
+ fs::mount($part->{device}, $dir, type2fs($part->{type}), 'rdonly');
+ }
+ my $buf = ' ' x 20000;
+ syscall_('statfs', $dir, $buf) or return;
+ my (undef, $blocksize, $size, undef, $free, undef) = unpack "L2L4", $buf;
+ $_ *= $blocksize / 512 foreach $size, $free;
+
+
+ unless ($part->{isMounted}) {
+ fs::umount($dir);
+ unlink $dir;
+ }
+
+ $part->{freespace} = $free;
+ }
+ $part->{freespace} - sum map { $_->{size} } @{$part->{loopback} || []};
+}
+
+1;
+
diff --git a/perl-install/partition_table.pm b/perl-install/partition_table.pm
index 586d85f26..660546339 100644
--- a/perl-install/partition_table.pm
+++ b/perl-install/partition_table.pm
@@ -7,7 +7,7 @@ use Data::Dumper;
@ISA = qw(Exporter);
%EXPORT_TAGS = (
- types => [ qw(type2name type2fs name2type fs2type isExtended isExt2 isSwap isDos isWin isFat isPrimary isNfs isSupermount isRAID isHFS isApplePartMap) ],
+ types => [ qw(type2name type2fs name2type fs2type isExtended isExt2 isSwap isDos isWin isFat isPrimary isNfs isSupermount isRAID isHFS isMountableRW isApplePartMap isLoopback) ],
);
@EXPORT_OK = map { @$_ } values %EXPORT_TAGS;
@@ -173,7 +173,7 @@ arch() !~ /^sparc/ ? (
0x1e => 'vfat',
0x82 => 'swap',
0x83 => 'ext2',
- ox402 => 'hfs',
+ 0x402 => 'hfs',
nfs => 'nfs', #- hack
);
@@ -204,7 +204,9 @@ sub isFat($) { isDos($_[0]) || isWin($_[0]) }
sub isNfs($) { $_[0]{type} eq 'nfs' } #- small hack
sub isSupermount($) { $_[0]{type} eq 'supermount' }
sub isHFS($) { $type2fs{$_[0]{type}} eq 'hfs' }
+sub isMountableRW { isExt2($_[0]) || isFat($_[0]) }
sub isApplePartMap { defined $_[0]{isMap} }
+sub isLoopback { defined $_[0]{loopback_file} }
sub isPrimary($$) {
my ($part, $hd) = @_;
@@ -320,7 +322,9 @@ sub adjust_local_extended($$) {
sub get_normal_parts($) {
my ($hd) = @_;
+ #- HACK !!
$hd->{raid} and return grep {$_} @{$hd->{raid}};
+ $hd->{loopback} and return grep {$_} @{$hd->{loopback}};
@{$hd->{primary}{normal} || []}, map { $_->{normal} } @{$hd->{extended} || []}
}
diff --git a/perl-install/pkgs.pm b/perl-install/pkgs.pm
index 50b6b09d1..8a028b53a 100644
--- a/perl-install/pkgs.pm
+++ b/perl-install/pkgs.pm
@@ -745,7 +745,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/raid.pm b/perl-install/raid.pm
index b59b2002b..5fcedf3b5 100644
--- a/perl-install/raid.pm
+++ b/perl-install/raid.pm
@@ -132,11 +132,9 @@ sub make {
sub format_part($$) {
my ($raid, $part) = @_;
- make($raid->{raid}, $part) if is($part);
- fs::format_part($part, $part->{toFormatCheck} ? "-c" : ());
- if (is($part)) {
- $_->{isFormatted} = 1 foreach @{$part->{disks}};
- }
+ make($raid->{raid}, $part);
+ fs::real_format_part($part);
+ $_->{isFormatted} = 1 foreach @{$part->{disks}};
}
sub verify($) {
diff --git a/perl-install/standalone/diskdrake b/perl-install/standalone/diskdrake
index f4f1e0d5c..39a2cf442 100755
--- a/perl-install/standalone/diskdrake
+++ b/perl-install/standalone/diskdrake
@@ -22,7 +22,7 @@
# DiskDrake is also based upon the libfdisk and the install from Red Hat Software
-use lib qw(/usr/lib/libDrakX);
+use lib qw(.); #/usr/lib/libDrakX);
use common qw(:common :functional);
use diskdrake;
use interactive_gtk;