diff options
| -rw-r--r-- | perl-install/ChangeLog | 15 | ||||
| -rw-r--r-- | perl-install/detect_devices.pm | 8 | ||||
| -rw-r--r-- | perl-install/fs.pm | 71 | ||||
| -rw-r--r-- | perl-install/fsedit.pm | 11 | ||||
| -rw-r--r-- | perl-install/install_any.pm | 8 | ||||
| -rw-r--r-- | perl-install/install_steps.pm | 2 | ||||
| -rw-r--r-- | perl-install/install_steps_interactive.pm | 2 | ||||
| -rw-r--r-- | perl-install/loopback.pm | 83 | ||||
| -rw-r--r-- | perl-install/partition_table.pm | 8 | ||||
| -rw-r--r-- | perl-install/pkgs.pm | 2 | ||||
| -rw-r--r-- | perl-install/raid.pm | 8 | ||||
| -rwxr-xr-x | perl-install/standalone/diskdrake | 2 |
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; |