home *** CD-ROM | disk | FTP | other *** search
/ Inter.Net 55-2 / Inter.Net 55-2.iso / Mandrake / mdkinst / usr / bin / perl-install / swap.pm < prev    next >
Encoding:
Perl POD Document  |  2000-01-12  |  4.0 KB  |  134 lines
  1. package swap;
  2.  
  3.  
  4.  
  5.  
  6. use common qw(:common :system :constant);
  7. use log;
  8. use devices;
  9. use c;
  10.  
  11.  
  12. my $pagesize = c::getpagesize();
  13. my $signature_page = "\0" x $pagesize;
  14.  
  15. # Maximum allowable number of pages in one swap.
  16. # From 2.2.0 onwards, this depends on how many offset bits
  17. # the architectures can actually store into the page tables
  18. # and on 32bit architectures it is limited to 2GB at the
  19. # same time.
  20. # Old swap format keeps the limit of 8*pagesize*(pagesize - 10)
  21.  
  22. my $V0_MAX_PAGES = 8 * $pagesize - 10;
  23. my $V1_OLD_MAX_PAGES = int 0x7fffffff / $pagesize - 1;
  24. my $V1_MAX_PAGES = $V1_OLD_MAX_PAGES; 
  25. my $MAX_BADPAGES = int ($pagesize - 1024 - 128 * $common::sizeof_int - 10) / $common::sizeof_int;
  26. my $signature_format_v1 = "x1024 I I I I125"; 
  27.  
  28. 1;
  29.  
  30. sub kernel_greater_or_equal($$$) {
  31.     c::kernel_version() =~ /(\d*)\.(\d*)\.(\d*)/;
  32.     ($1 <=> $_[0] || $2 <=> $_[1] || $3 <=> $_[2]) >= 0;
  33. }
  34.  
  35. sub check_blocks {
  36.     my ($fd, $version, $nbpages) = @_;
  37.     my ($last_read_ok, $badpages) = (0, 0);
  38.     my ($buffer);
  39.     my $badpages_field_v1 = \substr($signature_page, psizeof($signature_format_v1));
  40.  
  41.     for (my $i = 0; $i < $nbpages; $i++) {
  42.  
  43.     $last_read_ok || sysseek($fd, $i * $pagesize, 0) or die "seek failed";
  44.  
  45.     unless ($last_read_ok = sysread($fd, $buffer, $pagesize)) {
  46.         if ($version == 1) {
  47.         $badpages == $MAX_BADPAGES and die "too many bad pages";
  48.         vec($$badpages_field_v1, $badpages, $bitof_int) = $i;
  49.         }
  50.         $badpages++;
  51.     }
  52.     vec($signature_page, $i, 1) = bool($last_read_ok) if $version == 0;
  53.     }
  54.  
  55.     
  56.  
  57.     $badpages and log::l("$badpages bad pages\n");
  58.     return $badpages;
  59. }
  60.  
  61. sub make($;$) {
  62.     my ($devicename, $checkBlocks) = @_;
  63.     my $tmpdev = 0;
  64.     my $badpages = 0;
  65.     my ($version, $maxpages);
  66.  
  67.     $devicename = devices::make($devicename);
  68.  
  69.     my $nbpages = divide(devices::size($devicename), $pagesize);
  70.  
  71.     if ($nbpages <= $V0_MAX_PAGES || !kernel_greater_or_equal(2,1,117) || $pagesize < 2048) {
  72.     $version = 0;
  73.     } else {
  74.     $version = 1;
  75.     }
  76.  
  77.     $nbpages >= 10 or die "swap area needs to be at least " . (10 * $pagesize >> 10) . "kB";
  78.  
  79.     -b $devicename or $checkBlocks = 0;
  80.     my $rdev = (stat $devicename)[6];# or log::l("stat of $devicename failed: $!");
  81.     $rdev == 0x300 || $rdev == 0x340 and die "$devicename is not a good device for swap";
  82.  
  83.     sysopen F, $devicename, 2 or die "opening $devicename for writing failed: $!";
  84.  
  85.     if ($version == 0) { $maxpages = $V0_MAX_PAGES; }
  86.     elsif (kernel_greater_or_equal(2,2,1)) { $maxpages = $V1_MAX_PAGES; }
  87.     else { $maxpages = min($V1_OLD_MAX_PAGES, $V1_MAX_PAGES); }
  88.  
  89.     if ($nbpages > $maxpages) {
  90.     $nbpages = $maxpages;
  91.     log::l("warning: truncating swap area to " . ($nbpages * $pagesize >> 10) . "kB");
  92.     }
  93.  
  94.     if ($checkBlocks) {
  95.     $badpages = check_blocks(*F, $version, $nbpages);
  96.     } elsif ($version == 0) {
  97.     for (my $i = 0; $i < $nbpages; $i++) { vec($signature_page, $i, 1) = 1; }
  98.     }
  99.  
  100.     $version == 0 and !vec($signature_page, 0, 1) and die "bad block on first page";
  101.     vec($signature_page, 0, 1) = 0;
  102.  
  103.     $version == 1 and strcpy($signature_page, pack($signature_format_v1, $version, $nbpages - 1, $badpages));
  104.  
  105.     my $goodpages = $nbpages - $badpages - 1;
  106.     $goodpages > 0 or die "all blocks are bad";
  107.  
  108.     log::l("Setting up swapspace on $devicename version $version, size = " . $goodpages * $pagesize . " bytes");
  109.  
  110.     strcpy($signature_page, $version == 0 ? "SWAP-SPACE" : "SWAPSPACE2", $pagesize - 10);
  111.  
  112.     my $offset = ($version == 0) ? 0 : 1024;
  113.     sysseek(F, $offset, 0) or die "unable to rewind swap-device: $!";
  114.  
  115.     syswrite(F, substr($signature_page, $offset)) or die "unable to write signature page: $!";
  116.  
  117.     
  118.     syscall_('fsync', fileno(F)) or die "fsync failed: $!";
  119.     close F;
  120. }
  121.  
  122. sub enable($;$) {
  123.     my ($devicename, $checkBlocks) = @_;
  124.     make($devicename, $checkBlocks);
  125.     swapon($devicename);
  126. }
  127.  
  128. sub swapon($) {
  129.     syscall_('swapon', devices::make($_[0]), 0) or die "swapon($_[0]) failed: $!";
  130. }
  131. sub swapoff($) {
  132.     syscall_('swapoff', devices::make($_[0])) or die "swapoff($_[0]) failed: $!";
  133. }
  134.