no_comment

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;