summaryrefslogtreecommitdiffstats
path: root/perl-install/swap.pm
blob: ed0669f8e91070fda3e293302971ea61e9304fd1 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
package swap; # $Id$

use diagnostics;
use strict;

use common qw(:common :system :constant);
use log;
use devices;
use c;


my $pagesize = c::getpagesize();
my $signature_page = "\0" x $pagesize;

# Maximum allowable number of pages in one swap.
# From 2.2.0 onwards, this depends on how many offset bits
# the architectures can actually store into the page tables
# and on 32bit architectures it is limited to 2GB at the
# same time.
# Old swap format keeps the limit of 8*pagesize*(pagesize - 10)

my $V0_MAX_PAGES = 8 * $pagesize - 10;
my $V1_OLD_MAX_PAGES = int 0x7fffffff / $pagesize - 1;
my $V1_MAX_PAGES = $V1_OLD_MAX_PAGES; #- (1 << 24) - 1;
my $MAX_BADPAGES = int ($pagesize - 1024 - 128 * $common::sizeof_int - 10) / $common::sizeof_int;
my $signature_format_v1 = "x1024 I I I I125"; #- bootbits, version, last_page, nr_badpages, padding

1;

sub kernel_greater_or_equal($$$) {
    c::kernel_version() =~ /(\d*)\.(\d*)\.(\d*)/;
    ($1 <=> $_[0] || $2 <=> $_[1] || $3 <=> $_[2]) >= 0;
}

sub check_blocks {
    my ($fd, $version, $nbpages) = @_;
    my ($last_read_ok, $badpages) = (0, 0);
    my ($buffer);
    my $badpages_field_v1 = \substr($signature_page, psizeof($signature_format_v1));

    for (my $i = 0; $i < $nbpages; $i++) {

	$last_read_ok || sysseek($fd, $i * $pagesize, 0) or die "seek failed";

	unless ($last_read_ok = sysread($fd, $buffer, $pagesize)) {
	    if ($version == 1) {
		$badpages == $MAX_BADPAGES and die "too many bad pages";
		vec($$badpages_field_v1, $badpages, $bitof_int) = $i;
	    }
	    $badpages++;
	}
	vec($signature_page, $i, 1) = bool($last_read_ok) if $version == 0;
    }

    #- TODO: add interface

    $badpages and log::l("$badpages bad pages\n");
    return $badpages;
}

sub make($;$) {
    my ($devicename, $checkBlocks) = @_;
    my $tmpdev = 0;
    my $badpages = 0;
    my ($version, $maxpages);

    $devicename = devices::make($devicename);

    my $nbpages = divide(devices::size($devicename), $pagesize);

    if ($nbpages <= $V0_MAX_PAGES || !kernel_greater_or_equal(2,1,117) || $pagesize < 2048) {
	$version = 0;
    } else {
	$version = 1;
    }

    $nbpages >= 10 or die "swap area needs to be at least " . (10 * $pagesize / 1024) . "kB";

    -b $devicename or $checkBlocks = 0;
    my $rdev = (stat $devicename)[6];# or log::l("stat of $devicename failed: $!");
    $rdev == 0x300 || $rdev == 0x340 and die "$devicename is not a good device for swap";

    sysopen F, $devicename, 2 or die "opening $devicename for writing failed: $!";

    if ($version == 0) { $maxpages = $V0_MAX_PAGES; }
    elsif (kernel_greater_or_equal(2,2,1)) { $maxpages = $V1_MAX_PAGES; }
    else { $maxpages = min($V1_OLD_MAX_PAGES, $V1_MAX_PAGES); }

    if ($nbpages > $maxpages) {
	$nbpages = $maxpages;
	log::l("warning: truncating swap area to " . ($nbpages * $pagesize / 1024) . "kB");
    }

    if ($checkBlocks) {
	$badpages = check_blocks(*F, $version, $nbpages);
    } elsif ($version == 0) {
	for (my $i = 0; $i < $nbpages; $i++) { vec($signature_page, $i, 1) = 1; }
    }

    $version == 0 and !vec($signature_page, 0, 1) and die "bad block on first page";
    vec($signature_page, 0, 1) = 0;

    $version == 1 and strcpy($signature_page, pack($signature_format_v1, $version, $nbpages - 1, $badpages));

    my $goodpages = $nbpages - $badpages - 1;
    $goodpages > 0 or die "all blocks are bad";

    log::l("Setting up swapspace on $devicename version $version, size = " . $goodpages * $pagesize . " bytes");

    strcpy($signature_page, $version == 0 ? "SWAP-SPACE" : "SWAPSPACE2", $pagesize - 10);

    my $offset = ($version == 0) ? 0 : 1024;
    sysseek(F, $offset, 0) or die "unable to rewind swap-device: $!";

    syswrite(F, substr($signature_page, $offset)) or die "unable to write signature page: $!";

    #- A subsequent swapon() will fail if the signature is not actually on disk. (This is a kernel bug.)
    syscall_('fsync', fileno(F)) or die "fsync failed: $!";
    close F;
}

sub enable($;$) {
    my ($devicename, $checkBlocks) = @_;
    make($devicename, $checkBlocks);
    swapon($devicename);
}

sub swapon($) {
    log::l("swapon called with $_[0]");
    syscall_('swapon', devices::make($_[0]), 0) or die "swapon($_[0]) failed: $!";
}

sub swapoff($) {
    syscall_('swapoff', devices::make($_[0])) or die "swapoff($_[0]) failed: $!";
}