pintos-os.org Git - pintos-anon/blob - src/utils/pintos

   1 #! /usr/bin/perl -w
   2
   3 use strict;
   4 use POSIX;
   5 use Fcntl;
   6 use File::Temp 'tempfile';
   7 use Getopt::Long qw(:config bundling);
   8
   9 # Command-line options.
  10 our ($sim);                     # Simulator: bochs, qemu, or gsx.
  11 our ($debug) = "none";          # Debugger: none, monitor, or gdb.
  12 our ($mem) = 4;                 # Physical RAM in MB.
  13 our ($serial_out) = 1;          # Send output to serial port?
  14 our ($vga);                     # VGA output: window, terminal, or none.
  15 our ($jitter);                  # Seed for random timer interrupts, if set.
  16 our ($realtime);                # Synchronize timer interrupts with real time?
  17 our ($timeout);                 # Maximum runtime in seconds, if set.
  18 our (@puts);                    # Files to copy into the VM.
  19 our (@gets);                    # Files to copy out of the VM.
  20 our ($as_ref);                  # Reference to last addition to @gets or @puts.
  21 our (@kernel_args);             # Arguments to pass to kernel.
  22 our (%disks) = (OS => {FILENAME => 'os.dsk'},           # Disks to give VM.
  23                 FS => {DEF_FN => 'fs.dsk'},
  24                 SCRATCH => {DEF_FN => 'scratch.dsk'},
  25                 SWAP => {DEF_FN => 'swap.dsk'});
  26 our (@disks_by_iface) = @disks{qw (OS FS SCRATCH SWAP)};
  27
  28 parse_command_line ();
  29 find_disks ();
  30 prepare_scratch_disk ();
  31 prepare_arguments ();
  32 run_vm ();
  33 finish_scratch_disk ();
  34
  35 exit 0;
  36 \f
  37 # Parses the command line.
  38 sub parse_command_line {
  39     usage (0) if @ARGV == 0 || (@ARGV == 1 && $ARGV[0] eq '--help');
  40
  41     @kernel_args = @ARGV;
  42     if (grep ($_ eq '--', @kernel_args)) {
  43         @ARGV = ();
  44         while ((my $arg = shift (@kernel_args)) ne '--') {
  45             push (@ARGV, $arg);
  46         }
  47         GetOptions ("sim=s" => sub { set_sim (@_) },
  48                     "bochs" => sub { set_sim ("bochs") },
  49                     "qemu" => sub { set_sim ("qemu") },
  50                     "gsx" => sub { set_sim ("gsx") },
  51
  52                     "debug=s" => sub { set_debug (@_) },
  53                     "no-debug" => sub { set_debug ("none") },
  54                     "monitor" => sub { set_debug ("monitor") },
  55                     "gdb" => sub { set_debug ("gdb") },
  56
  57                     "m|memory=i" => \$mem,
  58                     "j|jitter=i" => sub { set_jitter (@_) },
  59                     "r|realtime" => sub { set_realtime () },
  60                     "T|timeout=i" => \$timeout,
  61
  62                     "v|no-vga" => sub { set_vga ('none'); },
  63                     "s|no-serial" => sub { $serial_out = 0; },
  64                     "t|terminal" => sub { set_vga ('terminal'); },
  65
  66                     "p|put-file=s" => sub { add_file (\@puts, $_[1]); },
  67                     "g|get-file=s" => sub { add_file (\@gets, $_[1]); },
  68                     "a|as=s" => sub { set_as ($_[1]); },
  69
  70                     "h|help" => sub { usage (0); },
  71
  72                     "os-disk=s" => \$disks{OS}{FILENAME},
  73                     "fs-disk=s" => \$disks{FS}{FILENAME},
  74                     "scratch-disk=s" => \$disks{SCRATCH}{FILENAME},
  75                     "swap-disk=s" => \$disks{SWAP}{FILENAME},
  76
  77                     "0|disk-0|hda=s" => \$disks_by_iface[0]{FILENAME},
  78                     "1|disk-1|hdb=s" => \$disks_by_iface[1]{FILENAME},
  79                     "2|disk-2|hdc=s" => \$disks_by_iface[2]{FILENAME},
  80                     "3|disk-3|hdd=s" => \$disks_by_iface[3]{FILENAME})
  81           or exit 1;
  82     }
  83
  84     $sim = "bochs" if !defined $sim;
  85     $debug = "none" if !defined $debug;
  86     $vga = "window" if !defined $vga;
  87 }
  88
  89 # usage($exitcode).
  90 # Prints a usage message and exits with $exitcode.
  91 sub usage {
  92     my ($exitcode) = @_;
  93     $exitcode = 1 unless defined $exitcode;
  94     print <<'EOF';
  95 pintos, a utility for running Pintos in a simulator
  96 Usage: pintos [OPTION...] -- [ARGUMENT...]
  97 where each OPTION is one of the following options
  98   and each ARGUMENT is passed to Pintos kernel verbatim.
  99 Simulator selection:
 100   --bochs                  (default) Use Bochs as simulator
 101   --qemu                   Use qemu as simulator
 102   --gsx                    Use VMware GSX Server 3.x as simulator
 103 Debugger selection:
 104   --no-debug               (default) No debugger
 105   --monitor                Debug with simulator's monitor
 106   --gdb                    Debug with gdb
 107 Display options: (default is both VGA and serial)
 108   -v, --no-vga             No VGA display
 109   -s, --no-serial          No serial output
 110   -t, --terminal           Display VGA in terminal (Bochs only)
 111 Timing options: (Bochs only)
 112   -j SEED                  Randomize timer interrupts
 113   -r, --realtime           Use realistic, not reproducible, timings
 114   -T, --timeout=N          Time out and kill Pintos after N seconds
 115 Configuration options:
 116   -m, --mem=N              Give Pintos N MB physical RAM (default: 4)
 117 File system commands (for `run' command):
 118   -p, --put-file=HOSTFN    Copy HOSTFN into VM, by default under same name
 119   -g, --get-file=GUESTFN   Copy GUESTFN out of VM, by default under same name
 120   -a, --as=FILENAME        Specifies guest (for -p) or host (for -g) file name
 121 Disk options: (name an existing FILE or specify SIZE in MB for a temp disk)
 122   --os-disk=FILE           Set OS disk file (default: os.dsk)
 123   --fs-disk=FILE|SIZE      Set FS disk file (default: fs.dsk)
 124   --scratch-disk=FILE|SIZE Set scratch disk (default: scratch.dsk)
 125   --swap-disk=FILE|SIZE    Set swap disk file (default: swap.dsk)
 126 Other options:
 127   -h, --help               Display this help message.
 128 EOF
 129     exit $exitcode;
 130 }
 131
 132 # Sets the simulator.
 133 sub set_sim {
 134     my ($new_sim) = @_;
 135     die "--$new_sim conflicts with --$sim\n"
 136         if defined ($sim) && $sim ne $new_sim;
 137     $sim = $new_sim;
 138 }
 139
 140 # Sets the debugger.
 141 sub set_debug {
 142     my ($new_debug) = @_;
 143     die "--$new_debug conflicts with --$debug\n"
 144         if $debug ne 'none' && $new_debug ne 'none' && $debug ne $new_debug;
 145     $debug = $new_debug;
 146 }
 147
 148 # Sets VGA output destination.
 149 sub set_vga {
 150     my ($new_vga) = @_;
 151     if (defined ($vga) && $vga ne $new_vga) {
 152         print "warning: conflicting vga display options\n";
 153     }
 154     $vga = $new_vga;
 155 }
 156
 157 # Sets randomized timer interrupts.
 158 sub set_jitter {
 159     my ($new_jitter) = @_;
 160     die "--realtime conflicts with --jitter\n" if defined $realtime;
 161     die "different --jitter already defined\n"
 162         if defined $jitter && $jitter != $new_jitter;
 163     $jitter = $new_jitter;
 164 }
 165
 166 # Sets real-time timer interrupts.
 167 sub set_realtime {
 168     die "--realtime conflicts with --jitter\n" if defined $jitter;
 169     $realtime = 1;
 170 }
 171
 172 # add_file(\@list, $file)
 173 #
 174 # Adds [$file] to @list, which should be @puts or @gets.
 175 # Sets $as_ref to point to the added element.
 176 sub add_file {
 177     my ($list, $file) = @_;
 178     $as_ref = [$file];
 179     push (@$list, $as_ref);
 180 }
 181
 182 # Sets the guest/host name for the previous put/get.
 183 sub set_as {
 184     my ($as) = @_;
 185     die "-a (or --as) is only allowed after -p or -g\n" if !defined $as_ref;
 186     die "Only one -a (or --as) is allowed after -p or -g\n"
 187       if defined $as_ref->[1];
 188     $as_ref->[1] = $as;
 189 }
 190 \f
 191 # Locates the files used to back each of the virtual disks,
 192 # and creates temporary disks.
 193 sub find_disks {
 194     for my $disk (values %disks) {
 195         # If there's no assigned file name but the default file exists,
 196         # assign the default file.
 197         $disk->{FILENAME} = $disk->{DEF_FN}
 198           if !defined ($disk->{FILENAME}) && -e $disk->{DEF_FN};
 199
 200         # If there's no file name, we're done.
 201         next if !defined ($disk->{FILENAME});
 202
 203         if ($disk->{FILENAME} =~ /^\d+(\.\d+)?|\.\d+$/) {
 204             # Create a temporary disk of approximately the specified
 205             # size in megabytes.
 206             die "OS disk can't be temporary\n" if $disk == $disks{OS};
 207
 208             my ($mb) = $disk->{FILENAME};
 209             undef $disk->{FILENAME};
 210
 211             my ($cylinder) = 1024 * 504;
 212             my ($bytes) = $mb * ($cylinder * 2);
 213             $bytes = int (($bytes + $cylinder - 1) / $cylinder) * $cylinder;
 214             extend_disk ($disk, $bytes);
 215         } else {
 216             # The file must exist and have nonzero size.
 217             -e $disk->{FILENAME} or die "$disk->{FILENAME}: stat: $!\n";
 218             -s _ or die "$disk->{FILENAME}: disk has zero size\n";
 219         }
 220     }
 221
 222     # Warn about (potentially) missing disks.
 223     if (my ($project) = `pwd` =~ /\b(threads|userprog|vm|filesys)\b/) {
 224         if ((grep ($project eq $_, qw (userprog vm filesys)))
 225             && !defined ($disks{FS}{FILENAME})) {
 226             print STDERR "warning: it looks like you're running the $project ";
 227             print STDERR "project, but no file system disk is present\n";
 228         }
 229         if ($project eq 'vm' && !defined $disks{SWAP}{FILENAME}) {
 230             print STDERR "warning: it looks like you're running the $project ";
 231             print STDERR "project, but no swap disk is present\n";
 232         }
 233     }
 234 }
 235 \f
 236 # Prepare the scratch disk for gets and puts.
 237 sub prepare_scratch_disk {
 238     # Copy the files to put onto the scratch disk.
 239     put_scratch_file ($_->[0]) foreach @puts;
 240
 241     # Make sure the scratch disk is big enough to get big files.
 242     extend_disk ($disks{SCRATCH}, @gets * 1024 * 1024) if @gets;
 243 }
 244
 245 # Read "get" files from the scratch disk.
 246 sub finish_scratch_disk {
 247     # We need to start reading the scratch disk from the beginning again.
 248     if (@gets) {
 249         close ($disks{SCRATCH}{HANDLE});
 250         undef ($disks{SCRATCH}{HANDLE});
 251     }
 252
 253     # Read each file.
 254     get_scratch_file (defined ($_->[1]) ? $_->[1] : $_->[0]) foreach @gets;
 255 }
 256
 257 # put_scratch_file($file).
 258 #
 259 # Copies $file into the scratch disk.
 260 sub put_scratch_file {
 261     my ($put_filename) = @_;
 262     my ($disk_handle, $disk_filename) = open_disk ($disks{SCRATCH});
 263
 264     print "Copying $put_filename into $disk_filename...\n";
 265
 266     # Write metadata sector, which consists of a 4-byte signature
 267     # followed by the file size.
 268     stat $put_filename or die "$put_filename: stat: $!\n";
 269     my ($size) = -s _;
 270     my ($metadata) = pack ("a4 V x504", "PUT\0", $size);
 271     write_fully ($disk_handle, $disk_filename, $metadata);
 272
 273     # Copy file data.
 274     my ($put_handle);
 275     sysopen ($put_handle, $put_filename, O_RDONLY)
 276       or die "$put_filename: open: $!\n";
 277     copy_file ($put_handle, $put_filename, $disk_handle, $disk_filename,
 278                $size);
 279     close ($put_handle);
 280
 281     # Round up disk data to beginning of next sector.
 282     write_fully ($disk_handle, $disk_filename, "\0" x (512 - $size % 512))
 283       if $size % 512;
 284 }
 285
 286 # get_scratch_file($file).
 287 #
 288 # Copies from the scratch disk to $file.
 289 sub get_scratch_file {
 290     my ($get_filename) = @_;
 291     my ($disk_handle, $disk_filename) = open_disk ($disks{SCRATCH});
 292
 293     print "Copying $get_filename out of $disk_filename...\n";
 294
 295     # Read metadata sector, which has a 4-byte signature followed by
 296     # the file size.
 297     my ($metadata) = read_fully ($disk_handle, $disk_filename, 512);
 298     my ($signature, $size) = unpack ("a4 V", $metadata);
 299     die "bad signature reading scratch disk--did Pintos run correctly?\n"
 300       if $signature ne "GET\0";
 301
 302     # Copy file data.
 303     my ($get_handle);
 304     sysopen ($get_handle, $get_filename, O_WRONLY | O_CREAT | O_EXCL, 0666)
 305       or die "$get_filename: create: $!\n";
 306     copy_file ($disk_handle, $disk_filename, $get_handle, $get_filename,
 307                $size);
 308     close ($get_handle);
 309
 310     # Skip forward in disk up to beginning of next sector.
 311     read_fully ($disk_handle, $disk_filename, 512 - $size % 512)
 312       if $size % 512;
 313 }
 314 \f
 315 # Prepares the arguments to pass to the Pintos kernel,
 316 # and then write them into Pintos bootloader.
 317 sub prepare_arguments {
 318     my (@args);
 319     push (@args, shift (@kernel_args))
 320       while @kernel_args && $kernel_args[0] =~ /^-/;
 321     push (@args, 'put', defined $_->[1] ? $_->[1] : $_->[0]) foreach @puts;
 322     push (@args, @kernel_args);
 323     push (@args, 'get', $_->[0]) foreach @gets;
 324     write_cmd_line ($disks{OS}, @args);
 325 }
 326
 327 # Writes @args into the Pintos bootloader at the beginning of $disk.
 328 sub write_cmd_line {
 329     my ($disk, @args) = @_;
 330
 331     # Figure out command line to write.
 332     my ($arg_cnt) = pack ("V", scalar (@args));
 333     my ($args) = join ('', map ("$_\0", @args));
 334     die "command line exceeds 128 bytes" if length ($args) > 128;
 335     $args .= "\0" x (128 - length ($args));
 336
 337     # Write command line.
 338     my ($handle, $filename) = open_disk_copy ($disk);
 339     print "Writing command line to $filename...\n";
 340     sysseek ($handle, 0x17a, 0) == 0x17a or die "$filename: seek: $!\n";
 341     syswrite ($handle, "$arg_cnt$args") or die "$filename: write: $!\n";
 342 }
 343 \f
 344 # Running simulators.
 345
 346 # Runs the selected simulator.
 347 sub run_vm {
 348     if ($sim eq 'bochs') {
 349         run_bochs ();
 350     } elsif ($sim eq 'qemu') {
 351         run_qemu ();
 352     } elsif ($sim eq 'gsx') {
 353         run_gsx ();
 354     } else {
 355         die "unknown simulator `$sim'\n";
 356     }
 357 }
 358
 359 # Runs Bochs.
 360 sub run_bochs {
 361     # Select Bochs binary based on the chosen debugger.
 362     my ($bin);
 363     if ($debug eq 'none') {
 364         $bin = 'bochs';
 365     } elsif ($debug eq 'monitor') {
 366         $bin = 'bochs-dbg';
 367     } elsif ($debug eq 'gdb') {
 368         $bin = 'bochs-gdb';
 369     }
 370
 371     # Write bochsrc.txt configuration file.
 372     open (BOCHSRC, ">", "bochsrc.txt") or die "bochsrc.txt: create: $!\n";
 373     print BOCHSRC <<EOF;
 374 romimage: file=\$BXSHARE/BIOS-bochs-latest, address=0xf0000
 375 vgaromimage: \$BXSHARE/VGABIOS-lgpl-latest
 376 boot: c
 377 ips: 1000000
 378 megs: $mem
 379 log: bochsout.txt
 380 EOF
 381     print BOCHSRC "clock: sync=", $realtime ? 'realtime' : 'none', "time0=0\n";
 382     print_bochs_disk_line ("ata0-master", 0);
 383     print_bochs_disk_line ("ata0-slave", 1);
 384     if (defined ($disks_by_iface[2]{FILENAME})
 385         || defined ($disks_by_iface[3]{FILENAME})) {
 386         print BOCHSRC "ata1: enabled=1, ioaddr1=0x170, ",
 387           "ioaddr2=0x370, irq=15\n";
 388         print_bochs_disk_line ("ata1-master", 2);
 389         print_bochs_disk_line ("ata1-slave", 3);
 390     }
 391     if ($vga ne 'terminal') {
 392         print BOCHSRC "com1: enabled=1, dev=/dev/stdout\n" if $serial_out;
 393         print BOCHSRC "display_library: nogui\n" if $vga eq 'none';
 394     } else {
 395         print BOCHSRC "display_library: term\n";
 396     }
 397     close (BOCHSRC);
 398
 399     # Compose Bochs command line.
 400     my (@cmd) = ($bin, '-q');
 401     push (@cmd, '-j', $jitter) if defined $jitter;
 402
 403     # Run Bochs.
 404     print join (' ', @cmd), "\n";
 405     my ($exit) = xsystem (@cmd);
 406     if (WIFEXITED ($exit)) {
 407         # Bochs exited normally.
 408         # Ignore the exit code; Bochs normally exits with status 1,
 409         # which is weird.
 410     } elsif (WIFSIGNALED ($exit)) {
 411         die "Bochs died with signal ", WTERMSIG ($exit), "\n";
 412     } else {
 413         die "Bochs died: code $exit\n";
 414     }
 415 }
 416
 417 # print_bochs_disk_line($device, $iface)
 418 #
 419 # If IDE interface $iface has a disk attached, prints a bochsrc.txt
 420 # line for attaching it to $device.
 421 sub print_bochs_disk_line {
 422     my ($device, $iface) = @_;
 423     my ($file) = $disks_by_iface[$iface]{FILENAME};
 424     if (defined $file) {
 425         my (%geom) = disk_geometry ($file);
 426         print BOCHSRC "$device: type=disk, path=$file, mode=flat, ";
 427         print BOCHSRC "cylinders=$geom{C}, heads=$geom{H}, spt=$geom{S}, ";
 428         print BOCHSRC "translation=none\n";
 429     }
 430 }
 431
 432 # Runs qemu.
 433 sub run_qemu {
 434     print "warning: qemu doesn't support --terminal\n"
 435       if $vga eq 'terminal';
 436     print "warning: qemu doesn't support jitter\n"
 437       if defined $jitter;
 438     my (@cmd) = ('qemu');
 439     for my $iface (0...3) {
 440         my ($option) = ('-hda', '-hdb', '-hdc', '-hdd')[$iface];
 441         push (@cmd, $option, $disks_by_iface[$iface]{FILENAME})
 442           if defined $disks_by_iface[$iface]{FILENAME};
 443     }
 444     push (@cmd, '-m', $mem);
 445     push (@cmd, '-nographic') if $vga eq 'none';
 446     push (@cmd, '-serial', 'stdio') if $serial_out && $vga ne 'none';
 447     push (@cmd, '-S') if $debug eq 'monitor';
 448     push (@cmd, '-s', '-S') if $debug eq 'gdb';
 449     push (@cmd, '-monitor', 'null') if $vga eq 'none' && $debug eq 'none';
 450     run_command (@cmd);
 451 }
 452
 453 # gsx_unsup($flag)
 454 #
 455 # Prints a message that $flag is unsupported by GSX Server.
 456 sub gsx_unsup {
 457     my ($flag) = @_;
 458     print "warning: no support for $flag with VMware GSX Server\n";
 459 }
 460
 461 # Runs VMware GSX Server.
 462 sub run_gsx {
 463     gsx_unsup ("--$debug") if $debug ne 'none';
 464     gsx_unsup ("--no-vga") if $vga eq 'none';
 465     gsx_unsup ("--terminal") if $vga eq 'terminal';
 466     gsx_unsup ("--jitter") if defined $jitter;
 467
 468     unlink ("pintos.out");
 469
 470     open (VMX, ">", "pintos.vmx") or die "pintos.vmx: create: $!\n";
 471     chmod 0777 & ~umask, "pintos.vmx";
 472     print VMX <<EOF;
 473 #! /usr/bin/vmware -G
 474 config.version = 6
 475 guestOS = "linux"
 476 floppy0.present = FALSE
 477 memsize = $mem
 478
 479 serial0.present = TRUE
 480 serial0.fileType = "file"
 481 serial0.fileName = "pintos.out"
 482 EOF
 483
 484     for (my ($i) = 0; $i < 4; $i++) {
 485         my ($dsk) = $disks_by_iface[$i]{FILENAME};
 486         next if !defined $dsk;
 487
 488         my ($pln) = $dsk;
 489         $pln =~ s/\.dsk//;
 490         $pln .= ".pln";
 491
 492         my ($device) = "ide" . int ($i / 2) . ":" . ($i % 2);
 493         print VMX <<EOF;
 494
 495 $device.present = TRUE
 496 $device.deviceType = "plainDisk"
 497 $device.fileName = "$pln"
 498 EOF
 499
 500         my (%geom) = disk_geometry ($dsk);
 501         open (PLN, ">", $pln) or die "$pln: create: $!\n";
 502         print PLN <<EOF;
 503 DRIVETYPE       ide
 504 #vm|VERSION     2
 505 #vm|TOOLSVERSION        2
 506 CYLINDERS       $geom{C}
 507 HEADS           $geom{H}
 508 SECTORS         $geom{S}
 509 #vm|CAPACITY    $geom{CAPACITY}
 510 ACCESS "$dsk" 0 $geom{CAPACITY}
 511 EOF
 512         close (PLN);
 513     }
 514     close (VMX);
 515
 516     my ($vmx) = getcwd () . "/pintos.vmx";
 517     system ("vmware-cmd -s register $vmx >&/dev/null");
 518     system ("vmware-cmd $vmx stop hard >&/dev/null");
 519     system ("vmware -l -G -x -q $vmx");
 520     system ("vmware-cmd $vmx stop hard >&/dev/null");
 521     system ("vmware-cmd -s unregister $vmx >&/dev/null");
 522 }
 523 \f
 524 # Disk utilities.
 525
 526 # open_disk($disk)
 527 #
 528 # Opens $disk, if it is not already open, and returns its file handle
 529 # and file name.
 530 sub open_disk {
 531     my ($disk) = @_;
 532     if (!defined ($disk->{HANDLE})) {
 533         if ($disk->{FILENAME}) {
 534             sysopen ($disk->{HANDLE}, $disk->{FILENAME}, O_RDWR)
 535               or die "$disk->{FILENAME}: open: $!\n";
 536         } else {
 537             ($disk->{HANDLE}, $disk->{FILENAME}) = tempfile (UNLINK => 1,
 538                                                              SUFFIX => '.dsk');
 539         }
 540     }
 541     return ($disk->{HANDLE}, $disk->{FILENAME});
 542 }
 543
 544 # open_disk_copy($disk)
 545 #
 546 # Makes a temporary copy of $disk and returns its file handle and file name.
 547 sub open_disk_copy {
 548     my ($disk) = @_;
 549     die if !$disk->{FILENAME};
 550
 551     my ($orig_handle, $orig_filename) = open_disk ($disk);
 552     my ($cp_handle, $cp_filename) = tempfile (UNLINK => 1, SUFFIX => '.dsk');
 553     copy_file ($orig_handle, $orig_filename, $cp_handle, $cp_filename,
 554                -s $orig_handle);
 555     return ($disk->{HANDLE}, $disk->{FILENAME}) = ($cp_handle, $cp_filename);
 556 }
 557
 558 # extend_disk($disk, $size)
 559 #
 560 # Extends $disk, if necessary, so that it is at least $size bytes
 561 # long.
 562 sub extend_disk {
 563     my ($disk, $size) = @_;
 564     my ($handle, $filename) = open_disk ($disk);
 565     if (-s ($handle) < $size) {
 566         sysseek ($handle, $size - 1, 0) == $size - 1
 567           or die "$filename: seek: $!\n";
 568         syswrite ($handle, "\0") == 1
 569           or die "$filename: write: $!\n";
 570     }
 571 }
 572
 573 # disk_geometry($file)
 574 #
 575 # Examines $file and returns a valid IDE disk geometry for it, as a
 576 # hash.
 577 sub disk_geometry {
 578     my ($file) = @_;
 579     my ($size) = -s $file;
 580     die "$file: stat: $!\n" if !defined $size;
 581     die "$file: size not a multiple of 512 bytes\n" if $size % 512;
 582     my ($cylinders) = int ($size / (512 * 16 * 63));
 583     $cylinders++ if $size % (512 * 16 * 63);
 584
 585     return (CAPACITY => $size / 512,
 586             C => $cylinders,
 587             H => 16,
 588             S => 63);
 589 }
 590
 591 # copy_file($from_handle, $from_filename, $to_handle, $to_filename, $size)
 592 #
 593 # Copies $size bytes from $from_handle to $to_handle.
 594 # $from_filename and $to_filename are used in error messages.
 595 sub copy_file {
 596     my ($from_handle, $from_filename, $to_handle, $to_filename, $size) = @_;
 597
 598     while ($size > 0) {
 599         my ($chunk_size) = 4096;
 600         $chunk_size = $size if $chunk_size > $size;
 601         $size -= $chunk_size;
 602
 603         my ($data) = read_fully ($from_handle, $from_filename, $chunk_size);
 604         write_fully ($to_handle, $to_filename, $data);
 605     }
 606 }
 607
 608 # read_fully($handle, $filename, $bytes)
 609 #
 610 # Reads exactly $bytes bytes from $handle and returns the data read.
 611 # $filename is used in error messages.
 612 sub read_fully {
 613     my ($handle, $filename, $bytes) = @_;
 614     my ($data);
 615     my ($read_bytes) = sysread ($handle, $data, $bytes);
 616     die "$filename: read: $!\n" if !defined $read_bytes;
 617     die "$filename: unexpected end of file\n" if $read_bytes != $bytes;
 618     return $data;
 619 }
 620
 621 # write_fully($handle, $filename, $data)
 622 #
 623 # Write $data to $handle.
 624 # $filename is used in error messages.
 625 sub write_fully {
 626     my ($handle, $filename, $data) = @_;
 627     my ($written_bytes) = syswrite ($handle, $data);
 628     die "$filename: write: $!\n" if !defined $written_bytes;
 629     die "$filename: short write\n" if $written_bytes != length $data;
 630 }
 631 \f
 632 # Subprocess utilities.
 633
 634 # run_command(@args)
 635 #
 636 # Runs xsystem(@args).
 637 # Also prints the command it's running and checks that it succeeded.
 638 sub run_command {
 639     print join (' ', @_), "\n";
 640     die "command failed\n" if xsystem (@_);
 641 }
 642
 643 # xsystem(@args)
 644 #
 645 # Creates a subprocess via exec(@args) and waits for it to complete.
 646 # Relays common signals to the subprocess.
 647 # If $timeout is set then the subprocess will be killed after that long.
 648 sub xsystem {
 649     my ($pid) = fork;
 650     if (!defined ($pid)) {
 651         # Fork failed.
 652         die "fork: $!\n";
 653     } elsif (!$pid) {
 654         # Running in child process.
 655         exec (@_);
 656         exit (1);
 657     } else {
 658         # Running in parent process.
 659         local $SIG{ALRM} = sub { timeout ($pid); };
 660         local $SIG{INT} = sub { relay_signal ($pid, "INT"); };
 661         local $SIG{TERM} = sub { relay_signal ($pid, "TERM"); };
 662         alarm ($timeout) if defined ($timeout);
 663         waitpid ($pid, 0);
 664         alarm (0);
 665         return $?;
 666     }
 667 }
 668
 669 # relay_signal($pid, $signal)
 670 #
 671 # Relays $signal to $pid and then reinvokes it for us with the default
 672 # handler.
 673 sub relay_signal {
 674     my ($pid, $signal) = @_;
 675     kill $signal, $pid;
 676     $SIG{$signal} = 'DEFAULT';
 677     kill $signal, getpid ();
 678 }
 679
 680 # timeout($pid)
 681 #
 682 # Interrupts $pid and dies with a timeout error message.
 683 sub timeout {
 684     my ($pid) = @_;
 685     relay_signal ($pid, "INT");
 686     my ($load_avg) = `uptime` =~ /(load average:.*)$/i;
 687     print "TIMEOUT after $timeout seconds";
 688     print  " - $load_avg" if defined $load_avg;
 689     print "\n";
 690     exit (2);
 691 }