home *** CD-ROM | disk | FTP | other *** search
/ Inter.Net 55-2 / Inter.Net 55-2.iso / Mandrake / mdkinst / usr / bin / perl-install / fsedit.pm < prev    next >
Encoding:
Perl POD Document  |  2000-01-12  |  10.3 KB  |  412 lines
  1. package fsedit;
  2.  
  3.  
  4.  
  5.  
  6.  
  7.  
  8.  
  9. use common qw(:common :constant :functional :file);
  10. use partition_table qw(:types);
  11. use partition_table_raw;
  12. use detect_devices;
  13. use Data::Dumper;
  14. use fsedit;
  15. use devices;
  16. use fs;
  17. use log;
  18.  
  19.  
  20.  
  21.  
  22. my @suggestions = (
  23.   { mntpoint => "/boot",    size =>  16 << 11, type => 0x83, maxsize =>  30 << 11 },
  24.   { mntpoint => "/",        size =>  50 << 11, type => 0x83, ratio => 1, maxsize => 300 << 11 },
  25.   { mntpoint => "swap",     size =>  30 << 11, type => 0x82, ratio => 1, maxsize => 250 << 11 },
  26.   { mntpoint => "/usr",     size => 200 << 11, type => 0x83, ratio => 6, maxsize =>1500 << 11 },
  27.   { mntpoint => "/home",    size =>  50 << 11, type => 0x83, ratio => 3 },
  28.   { mntpoint => "/var",     size => 200 << 11, type => 0x83, ratio => 1, maxsize =>1000 << 11 },
  29.   { mntpoint => "/tmp",     size =>  50 << 11, type => 0x83, ratio => 3, maxsize => 500 << 11 },
  30.   { mntpoint => "/mnt/iso", size => 700 << 11, type => 0x83 },
  31. );
  32. my @suggestions_mntpoints = qw(/mnt/dos);
  33.  
  34.  
  35. my @partitions_signatures = (
  36.     [ 0x83, 0x438, "\x53\xEF" ],
  37.     [ 0x82, 4086, "SWAP-SPACE" ],
  38.     [ 0xc,  0x1FE, "\x55\xAA", 0x52, "FAT32" ],
  39.     [ 0x6,  0x1FE, "\x55\xAA", 0x36, "FAT" ],
  40. );
  41.  
  42. sub typeOfPart($) { typeFromMagic(devices::make($_[0]), @partitions_signatures) }
  43.  
  44.  
  45.  
  46.  
  47. sub hds($$) {
  48.     my ($drives, $flags) = @_;
  49.     my @hds;
  50.     my $rc;
  51.  
  52.     foreach (@$drives) {
  53.     my $file = devices::make($_->{device});
  54.  
  55.     my $hd = partition_table_raw::get_geometry($file) or log::l("An error occurred while getting the geometry of block device $file: $!"), next;
  56.     $hd = { (%$_, %$hd) };
  57.     $hd->{file} = $file;
  58.     $hd->{prefix} = $hd->{device};
  59.     # for RAID arrays of format c0d0p1
  60.     $hd->{prefix} .= "p" if $hd->{prefix} =~ m,(rd|ida)/,;
  61.  
  62.     eval { partition_table::read($hd, $flags->{clearall}) };
  63.     if ($@) {
  64.         cdie($@) unless $flags->{eraseBadPartitions};
  65.         partition_table_raw::zero_MBR($hd);
  66.     }
  67.     push @hds, $hd;
  68.     }
  69.     [ @hds ];
  70. }
  71.  
  72. sub readProcPartitions {
  73.     my ($hds) = @_;
  74.     my @parts;
  75.     foreach (cat_("/proc/partitions")) {
  76.     my (undef, undef, $size, $device) = split;
  77.     next if $size eq "1"; 
  78.     foreach (@$hds) {
  79.         push @parts, { start => 0, size => $size * 2, device => $device, 
  80.                type => typeOfPart($device), rootDevice => $_->{device} 
  81.              } if $device =~ /^$_->{device}./;
  82.     }
  83.     }
  84.     @parts;
  85. }
  86.  
  87. sub get_fstab(@) {
  88.     map { partition_table::get_normal_parts($_) } @_;
  89. }
  90.  
  91. sub free_space(@) {
  92.     sum map { $_->{size} } map { partition_table::get_holes($_) } @_;
  93. }
  94.  
  95. sub hasRAID {
  96.     my $b = 0;
  97.     map { $b ||= isRAID($_) } get_fstab(@_);
  98.     $b;
  99. }
  100.  
  101. sub get_root($;$) {
  102.     my ($fstab, $boot) = @_;
  103.     if ($boot) { $_->{mntpoint} eq "/boot" and return $_ foreach @$fstab; }
  104.     $_->{mntpoint} eq "/" and return $_ foreach @$fstab;
  105.     undef;
  106. }
  107. sub get_root_ { get_root([ get_fstab(@{$_[0]}) ], $_[1]) }
  108.  
  109. sub is_one_big_fat {
  110.     my ($hds) = @_;
  111.     @$hds == 1 or return;
  112.  
  113.     my @l = fsedit::get_fstab(@$hds);
  114.     @l == 1 && isFat($l[0]) && fsedit::free_space(@$hds) < 10 << 11;
  115. }
  116.  
  117.  
  118. sub computeSize($$$$) {
  119.     my ($part, $best, $hds, $suggestions) = @_;
  120.     my $max = $part->{maxsize} || $part->{size};
  121.     return min($max, $best->{size}) unless $best->{ratio};
  122.  
  123.     my $free_space = free_space(@$hds);
  124.     my @l = my @L = grep { 
  125.     if (!has_mntpoint($_->{mntpoint}, $hds) && $free_space >= $_->{size}) {
  126.         $free_space -= $_->{size};
  127.         1;
  128.     } else { 0 } } @$suggestions;
  129.  
  130.     my $tot_ratios = 0;
  131.     while (1) {
  132.     my $old_free_space = $free_space;
  133.     my $old_tot_ratios = $tot_ratios;
  134.  
  135.     $tot_ratios = sum(map { $_->{ratio} } @l);
  136.     last if $tot_ratios == $old_tot_ratios;
  137.  
  138.     @l = grep { 
  139.         if ($_->{ratio} && $_->{maxsize} && $tot_ratios &&
  140.         $_->{size} + $_->{ratio} / $tot_ratios * $old_free_space >= $_->{maxsize}) {
  141.         return min($max, $best->{maxsize}) if $best->{mntpoint} eq $_->{mntpoint};
  142.         $free_space -= $_->{maxsize} - $_->{size};
  143.         0;
  144.         } else {
  145.         $_->{ratio};
  146.         } 
  147.     } @l;
  148.     }
  149.     my $size = min($max, $best->{size} + $free_space * ($tot_ratios && $best->{ratio} / $tot_ratios));
  150.  
  151.     
  152.     if (grep { $_->{size} < $max - $size } @L) { $size } else { $max }
  153. }
  154.  
  155. sub suggest_part($$$;$) {
  156.     my ($hd, $part, $hds, $suggestions) = @_;
  157.     $suggestions ||= \@suggestions;
  158.  
  159.     my $has_swap = grep { isSwap($_) } get_fstab(@$hds);
  160.  
  161.     my ($best, $second) =
  162.       grep { !$_->{maxsize} || $part->{size} <= $_->{maxsize} }
  163.       grep { $_->{size} <= ($part->{maxsize} || $part->{size}) }
  164.       grep { !has_mntpoint($_->{mntpoint}, $hds) || isSwap($_) && !$has_swap }
  165.       grep { !$part->{type} || $part->{type} == $_->{type} }
  166.     @$suggestions or return;
  167.  
  168.     $best = $second if
  169.       $best->{mntpoint} eq '/boot' &&
  170.       $part->{start} + $best->{size} > 1024 * partition_table::cylinder_size($hd); 
  171.  
  172.     defined $best or return; 
  173.  
  174.     $part->{mntpoint} = $best->{mntpoint};
  175.     $part->{type} = $best->{type};
  176.     $part->{size} = computeSize($part, $best, $hds, $suggestions);
  177.     1;
  178. }
  179.  
  180. sub suggestions_mntpoint($) {
  181.     my ($hds) = @_;
  182.     sort grep { !/swap/ && !has_mntpoint($_, $hds) }
  183.       (@suggestions_mntpoints, map { $_->{mntpoint} } @suggestions);
  184. }
  185.  
  186.  
  187.  
  188.  
  189.  
  190.  
  191.  
  192.  
  193.  
  194.  
  195.  
  196.  
  197.  
  198.  
  199.  
  200.  
  201.  
  202.  
  203.  
  204.  
  205.  
  206. sub has_mntpoint($$) {
  207.     my ($mntpoint, $hds) = @_;
  208.     scalar grep { $mntpoint eq $_->{mntpoint} } get_fstab(@$hds);
  209. }
  210.  
  211.  
  212.  
  213. sub check_mntpoint {
  214.     my ($mntpoint, $hd, $part, $hds) = @_;
  215.  
  216.     $mntpoint eq '' || isSwap($part) || isRAID($part) and return;
  217.  
  218.     local $_ = $mntpoint;
  219.     m|^/| or die _("Mount points must begin with a leading /");
  220.  
  221.  
  222.     has_mntpoint($mntpoint, $hds) and die _("There is already a partition with mount point %s", $mntpoint);
  223.  
  224.     if ($part->{start} + $part->{size} > 1024 * partition_table::cylinder_size($hd)) {
  225.     die "/boot ending on cylinder > 1024" if $mntpoint eq "/boot";
  226.     die     "/ ending on cylinder > 1024" if $mntpoint eq "/" && !has_mntpoint("/boot", $hds);
  227.     }
  228. }
  229.  
  230. sub add($$$;$) {
  231.     my ($hd, $part, $hds, $options) = @_;
  232.  
  233.     isSwap($part) ?
  234.       ($part->{mntpoint} = 'swap') :
  235.       $options->{force} || check_mntpoint($part->{mntpoint}, $hd, $part, $hds);
  236.  
  237.     delete $part->{maxsize};
  238.     partition_table::add($hd, $part, $options->{primaryOrExtended});
  239. }
  240.  
  241. sub allocatePartitions($$) {
  242.     my ($hds, $to_add) = @_;
  243.  
  244.     foreach my $hd (@$hds) {
  245.     foreach (partition_table::get_holes($hd)) {
  246.         my ($start, $size) = @$_{"start", "size"};
  247.         my $part;
  248.         while (suggest_part($hd, 
  249.                 $part = { start => $start, size => 0, maxsize => $size }, 
  250.                 $hds, $to_add)) {
  251.         add($hd, $part, $hds);
  252.         $start = $part->{start} + $part->{size};
  253.         $size -= $part->{size};
  254.         }
  255.         $start = $_->{start} + $_->{size};
  256.     }
  257.     }
  258. }
  259.  
  260. sub auto_allocate($;$) {
  261.     my ($hds, $suggestions) = @_;    
  262.     allocatePartitions($hds, $suggestions || \@suggestions);
  263.     map { partition_table::assign_device_numbers($_) } @$hds;
  264. }
  265.  
  266. sub undo_prepare($) {
  267.     my ($hds) = @_;
  268.     $Data::Dumper::Purity = 1;
  269.     foreach (@$hds) {
  270.     my @h = @{$_}{@partition_table::fields2save};
  271.     push @{$_->{undo}}, Data::Dumper->Dump([\@h], ['$h']);
  272.     }
  273. }
  274. sub undo_forget($) {
  275.     my ($hds) = @_;
  276.     pop @{$_->{undo}} foreach @$hds;
  277. }
  278.  
  279. sub undo($) {
  280.     my ($hds) = @_;
  281.     foreach (@$hds) {
  282.     my $h; eval pop @{$_->{undo}} || next;
  283.     @{$_}{@partition_table::fields2save} = @$h;
  284.  
  285.     $_->{isDirty} = $_->{needKernelReread} = 1;
  286.     }
  287. }
  288.  
  289. sub move {
  290.     my ($hd, $part, $hd2, $sector2) = @_;
  291.  
  292.     my $part1 = { %$part };
  293.     my $part2 = { %$part };
  294.     $part2->{start} = $sector2;
  295.     $part2->{size} += partition_table::cylinder_size($hd2) - 1;
  296.     partition_table::remove($hd, $part);
  297.     {
  298.     local ($part2->{notFormatted}, $part2->{isFormatted}); 
  299.     partition_table::add($hd2, $part2);
  300.     }
  301.  
  302.     return if $part2->{notFormatted} && !$part2->{isFormatted} || $::testing;
  303.  
  304.     local (*F, *G);
  305.     sysopen F, $hd->{file}, 0 or die '';
  306.     sysopen G, $hd2->{file}, 2 or die _("Error opening %s for writing: %s", $hd2->{file}, "$!");
  307.  
  308.     my $base = $part1->{start};
  309.     my $base2 = $part2->{start};
  310.     my $step = 10;
  311.     if ($hd eq $hd2) {
  312.     $base == $base2 and return;
  313.     $step = min($step, abs($base2 - $base));
  314.  
  315.     if ($base < $base2) {
  316.         $base  += $part1->{size} - $step;
  317.         $base2 += $part1->{size} - $step;
  318.         $step = -$step;
  319.     }
  320.     }
  321.  
  322.     my $f = sub {
  323.     $base  < 0 and $base2 += -$base,  $base  = 0;
  324.     $base2 < 0 and $base  += -$base2, $base2 = 0;
  325.     c::lseek_sector(fileno(F), $base,  0) or die "seeking to sector $base failed on drive $hd->{device}";
  326.     c::lseek_sector(fileno(G), $base2, 0) or die "seeking to sector $base2 failed on drive $hd2->{device}";
  327.  
  328.     my $buf;
  329.     sysread F, $buf, $SECTORSIZE * abs($_[0]) or die '';
  330.     syswrite G, $buf;
  331.     };
  332.  
  333.     for (my $i = 0; $i < $part1->{size} / abs($step); $i++, $base += $step, $base2 += $step) {
  334.     print "$base $base2\n";
  335.     &$f($step);
  336.     }
  337.     if (my $v = ($part1->{size} % abs($step)) * sign($step)) {
  338.     $base += $v;
  339.     $base2 += $v;
  340.     &$f($v);
  341.     }
  342. }
  343.  
  344. sub change_type($$$) {
  345.     my ($hd, $part, $type) = @_;
  346.     $type != $part->{type} or return;
  347.     $hd->{isDirty} = 1;
  348.     $part->{mntpoint} = '' if isSwap($part) && $part->{mntpoint} eq "swap";
  349.     $part->{type} = $type;
  350.     $part->{notFormatted} = 1;
  351.     $part->{isFormatted} = 0;    
  352. }
  353.  
  354. sub rescuept($) {
  355.     my ($hd) = @_;
  356.     my ($ext, @hd);
  357.  
  358.     my $dev = devices::make($hd->{device});
  359.     open F, "rescuept $dev|";
  360.     foreach (<F>) {
  361.     my ($st, $si, $id) = /start=\s*(\d+),\s*size=\s*(\d+),\s*Id=\s*(\d+)/ or next;
  362.     my $part = { start => $st, size => $si, type => hex($id) };
  363.     if (isExtended($part)) {
  364.         $ext = $part;
  365.     } else {
  366.         push @hd, $part;
  367.     }
  368.     }
  369.     close F or die "rescuept failed";
  370.  
  371.     partition_table_raw::zero_MBR($hd);
  372.     foreach (@hd) {
  373.     my $b = partition_table::verifyInside($_, $ext);
  374.     if ($b) {
  375.         $_->{start}--;
  376.         $_->{size}++;
  377.     }
  378.     local $_->{notFormatted};
  379.  
  380.     partition_table::add($hd, $_, ($b ? 'Extended' : 'Primary'), 1);
  381.     }
  382. }
  383.  
  384. sub verifyHds {
  385.     my ($hds, $readonly, $ok) = @_;
  386.  
  387.     if (is_empty_array_ref($hds)) { 
  388.     die _("An error has occurred - no valid devices were found on which to create new filesystems. Please check your hardware for the cause of this problem");
  389.     }
  390.  
  391.     my @parts = readProcPartitions($hds);
  392.     $ok &&= @parts == listlength(get_fstab(@$hds));
  393.  
  394.     if ($readonly && !$ok) {
  395.     log::l("using /proc/partitions as diskdrake failed :(");
  396.     foreach my $hd (@$hds) {
  397.         partition_table_raw::zero_MBR($hd);
  398.         $hd->{primary} = { normal => [ grep { $hd->{device} eq $_->{rootDevice} } @parts ] };
  399.     }
  400.     }
  401.     my $fstab = [ get_fstab(@$hds) ];
  402.     if (is_empty_array_ref($fstab) && $readonly) {
  403.     die _("You don't have any partitions!");
  404.     }
  405.     ($hds, $fstab, $ok);
  406. }
  407.  
  408.  
  409.  
  410.  
  411. 1; #
  412.