X-Git-Url: https://pintos-os.org/cgi-bin/gitweb.cgi?p=pintos-anon;a=blobdiff_plain;f=src%2Futils%2Fpintos;h=fca610a15c83d6c4cdd1e80062d04b1812f5d1f8;hp=4ce2d8507872af4e3d30d7d9025fe1cc7e0bf949;hb=8349a4cbeec56e4b497d98064ce51aba80c1f258;hpb=5f9b230c5ca5f75dc7fe5619cdec350322cfef5f diff --git a/src/utils/pintos b/src/utils/pintos index 4ce2d85..fca610a 100755 --- a/src/utils/pintos +++ b/src/utils/pintos @@ -1,47 +1,149 @@ #! /usr/bin/perl -w use strict; +use POSIX; +use Fcntl; +use File::Temp 'tempfile'; +use Getopt::Long qw(:config bundling); + +# Command-line options. +our ($start_time) = time (); +our ($sim); # Simulator: bochs, qemu, or player. +our ($debug) = "none"; # Debugger: none, monitor, or gdb. +our ($mem) = 4; # Physical RAM in MB. +our ($serial) = 1; # Use serial port for input and output? +our ($vga); # VGA output: window, terminal, or none. +our ($jitter); # Seed for random timer interrupts, if set. +our ($realtime); # Synchronize timer interrupts with real time? +our ($timeout); # Maximum runtime in seconds, if set. +our ($kill_on_failure); # Abort quickly on test failure? +our (@puts); # Files to copy into the VM. +our (@gets); # Files to copy out of the VM. +our ($as_ref); # Reference to last addition to @gets or @puts. +our (@kernel_args); # Arguments to pass to kernel. +our (%disks) = (OS => {DEF_FN => 'os.dsk'}, # Disks to give VM. + FS => {DEF_FN => 'fs.dsk'}, + SCRATCH => {DEF_FN => 'scratch.dsk'}, + SWAP => {DEF_FN => 'swap.dsk'}); +our (@disks_by_iface) = @disks{qw (OS FS SCRATCH SWAP)}; + +parse_command_line (); +find_disks (); +prepare_scratch_disk (); +prepare_arguments (); +run_vm (); +finish_scratch_disk (); -our ($mem) = 4; -our ($serial_out) = 1; -our (@disks) = ("os.dsk", "fs.dsk", "scratch.dsk", "swap.dsk"); -our ($sim); -our ($debug); -our ($vga); -our ($jitter); - -use Getopt::Long qw(:config require_order bundling); -GetOptions ("sim=s" => sub { set_sim (@_) }, - "bochs" => sub { set_sim ("bochs") }, - "qemu" => sub { set_sim ("qemu") }, - "gsx" => sub { set_sim ("gsx") }, - - "debug=s" => sub { set_debug (@_) }, - "no-debug" => sub { set_debug ("no-debug") }, - "monitor" => sub { set_debug ("monitor") }, - "gdb" => sub { set_debug ("gdb") }, - - "run|get|put|make-disk" => \&cmd_option, - - "m|memory=i" => \$mem, - "j|jitter=i" => \$jitter, - - "v|no-vga" => sub { set_vga ('none'); }, - "s|no-serial" => sub { $serial_out = 0; }, - "t|terminal" => sub { set_vga ('terminal'); }, - - "h|help" => sub { usage (0); }, - - "0|os-disk|disk-0|hda=s" => \$disks[0], - "1|fs-disk|disk-1|hdb=s" => \$disks[1], - "2|scratch-disk|disk-2|hdc=s" => \$disks[2], - "3|swap-disk|disk-3|hdd=s" => \$disks[3]) - or exit 1; - -$sim = "bochs" if !defined $sim; -$debug = "no-debug" if !defined $debug; -$vga = "window" if !defined $vga; +exit 0; + +# Parses the command line. +sub parse_command_line { + usage (0) if @ARGV == 0 || (@ARGV == 1 && $ARGV[0] eq '--help'); + + @kernel_args = @ARGV; + if (grep ($_ eq '--', @kernel_args)) { + @ARGV = (); + while ((my $arg = shift (@kernel_args)) ne '--') { + push (@ARGV, $arg); + } + GetOptions ("sim=s" => sub { set_sim ($_[1]) }, + "bochs" => sub { set_sim ("bochs") }, + "qemu" => sub { set_sim ("qemu") }, + "player" => sub { set_sim ("player") }, + + "debug=s" => sub { set_debug ($_[1]) }, + "no-debug" => sub { set_debug ("none") }, + "monitor" => sub { set_debug ("monitor") }, + "gdb" => sub { set_debug ("gdb") }, + + "m|memory=i" => \$mem, + "j|jitter=i" => sub { set_jitter ($_[1]) }, + "r|realtime" => sub { set_realtime () }, + + "T|timeout=i" => \$timeout, + "k|kill-on-failure" => \$kill_on_failure, + + "v|no-vga" => sub { set_vga ('none'); }, + "s|no-serial" => sub { $serial = 0; }, + "t|terminal" => sub { set_vga ('terminal'); }, + + "p|put-file=s" => sub { add_file (\@puts, $_[1]); }, + "g|get-file=s" => sub { add_file (\@gets, $_[1]); }, + "a|as=s" => sub { set_as ($_[1]); }, + + "h|help" => sub { usage (0); }, + + "os-disk=s" => \$disks{OS}{FILE_NAME}, + "fs-disk=s" => \$disks{FS}{FILE_NAME}, + "scratch-disk=s" => \$disks{SCRATCH}{FILE_NAME}, + "swap-disk=s" => \$disks{SWAP}{FILE_NAME}, + + "0|disk-0|hda=s" => \$disks_by_iface[0]{FILE_NAME}, + "1|disk-1|hdb=s" => \$disks_by_iface[1]{FILE_NAME}, + "2|disk-2|hdc=s" => \$disks_by_iface[2]{FILE_NAME}, + "3|disk-3|hdd=s" => \$disks_by_iface[3]{FILE_NAME}) + or exit 1; + } + + $sim = "bochs" if !defined $sim; + $debug = "none" if !defined $debug; + $vga = "window" if !defined $vga; + + undef $timeout, print "warning: disabling timeout with --$debug\n" + if defined ($timeout) && $debug ne 'none'; + + print "warning: enabling serial port for -k or --kill-on-failure\n" + if $kill_on_failure && !$serial; +} + +# usage($exitcode). +# Prints a usage message and exits with $exitcode. +sub usage { + my ($exitcode) = @_; + $exitcode = 1 unless defined $exitcode; + print <<'EOF'; +pintos, a utility for running Pintos in a simulator +Usage: pintos [OPTION...] -- [ARGUMENT...] +where each OPTION is one of the following options + and each ARGUMENT is passed to Pintos kernel verbatim. +Simulator selection: + --bochs (default) Use Bochs as simulator + --qemu Use QEMU as simulator + --player Use VMware Player as simulator +Debugger selection: + --no-debug (default) No debugger + --monitor Debug with simulator's monitor + --gdb Debug with gdb +Display options: (default is both VGA and serial) + -v, --no-vga No VGA display or keyboard + -s, --no-serial No serial input or output + -t, --terminal Display VGA in terminal (Bochs only) +Timing options: (Bochs only) + -j SEED Randomize timer interrupts + -r, --realtime Use realistic, not reproducible, timings +Testing options: + -T, --timeout=N Kill Pintos after N seconds CPU time or N*load_avg + seconds wall-clock time (whichever comes first) + -k, --kill-on-failure Kill Pintos a few seconds after a kernel or user + panic, test failure, or triple fault +Configuration options: + -m, --mem=N Give Pintos N MB physical RAM (default: 4) +File system commands (for `run' command): + -p, --put-file=HOSTFN Copy HOSTFN into VM, by default under same name + -g, --get-file=GUESTFN Copy GUESTFN out of VM, by default under same name + -a, --as=FILENAME Specifies guest (for -p) or host (for -g) file name +Disk options: (name an existing FILE or specify SIZE in MB for a temp disk) + --os-disk=FILE Set OS disk file (default: os.dsk) + --fs-disk=FILE|SIZE Set FS disk file (default: fs.dsk) + --scratch-disk=FILE|SIZE Set scratch disk (default: scratch.dsk) + --swap-disk=FILE|SIZE Set swap disk file (default: swap.dsk) +Other options: + -h, --help Display this help message. +EOF + exit $exitcode; +} +# Sets the simulator. sub set_sim { my ($new_sim) = @_; die "--$new_sim conflicts with --$sim\n" @@ -49,13 +151,15 @@ sub set_sim { $sim = $new_sim; } +# Sets the debugger. sub set_debug { my ($new_debug) = @_; die "--$new_debug conflicts with --$debug\n" - if defined ($debug) && $debug ne $new_debug; + if $debug ne 'none' && $new_debug ne 'none' && $debug ne $new_debug; $debug = $new_debug; } +# Sets VGA output destination. sub set_vga { my ($new_vga) = @_; if (defined ($vga) && $vga ne $new_vga) { @@ -64,299 +168,791 @@ sub set_vga { $vga = $new_vga; } -sub cmd_option { - # Force an end to option processing, as with --. - die ("!FINISH"); -} - -die "no command specified; use --help for help\n" - if @ARGV < 1; -my ($cmd) = shift @ARGV; -if ($cmd eq 'run') { - run_vm (@ARGV); -} elsif ($cmd eq 'make-disk') { - usage () if @ARGV != 2; - my ($file, $mb) = @ARGV; - usage () if $mb !~ /^\d+(\.\d+)?|\.\d+$/; - die "$file: already exists\n" if -e $file; - - create_disk ($file, int ($mb * 1008)); -} elsif ($cmd eq 'put') { - # Take a -f option to combine formatting with putting. - my ($format) = 0; - if (@ARGV > 0 && $ARGV[0] eq '-f') { - shift @ARGV; - $format = 1; - } - - usage () if @ARGV != 1 && @ARGV != 2; - my ($hostfn, $guestfn) = @ARGV; - $guestfn = $hostfn if !defined $guestfn; - - # Create scratch disk from file. - die "$hostfn: $!\n" if ! -e $hostfn; - my ($size) = -s _; - copy_pad ($hostfn, "scratch.dsk", 512); - - # Do copy. - my (@cmd) = ("-ci", $guestfn, $size, "-q"); - unshift (@cmd, "-f") if $format; - run_vm (@cmd); -} elsif ($cmd eq 'get') { - usage () if @ARGV != 1 && @ARGV != 2; - my ($guestfn, $hostfn) = @ARGV; - $hostfn = $guestfn if !defined $hostfn; - die "$hostfn: already exists\n" if -e $hostfn; - - # Create scratch disk big enough for any file in the filesystem - # (modulo sparse files). - die "$disks[1]: $!\n" if ! -e $disks[1]; - my ($fs_size) = -s _; - my ($scratch_size) = -s $disks[2]; - $scratch_size = 0 if !defined $scratch_size; - create_disk ($disks[2], $fs_size / 1024 + 16) - if $scratch_size < $fs_size + 16384; - - # Do copy. - run_vm ("-co", $guestfn, "-q"); - - # Read out scratch disk. - print "copying $guestfn from $disks[2] to $hostfn...\n"; - open (SRC, "<$disks[2]") or die "$disks[2]: open: $!\n"; - open (DST, ">$hostfn") or die "$hostfn: create: $!\n"; - my ($input); - read (SRC, $input, 512) == 512 or die "$disks[2]: read error\n"; - my ($size) = unpack ("V", $input); - $size != 0xffffffff or die "$guestfn: too big for $disks[2]?"; - my ($src); - read (SRC, $src, $size) == $size or die "$disks[2]: read error\n"; - print DST $src or die "$hostfn: write error\n"; - close (DST); - close (SRC); -} elsif ($cmd eq 'help') { - usage (0); -} else { - die "unknown command `$cmd'; use --help for help\n"; +# Sets randomized timer interrupts. +sub set_jitter { + my ($new_jitter) = @_; + die "--realtime conflicts with --jitter\n" if defined $realtime; + die "different --jitter already defined\n" + if defined $jitter && $jitter != $new_jitter; + $jitter = $new_jitter; } -exit 0; -sub usage { - my ($exitcode) = @_; - $exitcode = 1 unless defined $exitcode; - print "pintos, a utility for invoking Pintos in a simulator\n"; - print "Usage: pintos [OPTION...] COMMAND [ARG...]\n"; - print "where COMMAND is one of the following:\n"; - print " run [CMDLINE...] run a VM in the simulator\n"; - print " make-disk FILE.DSK SIZE create FILE.DSK as empty SIZE MB disk\n"; - print " put HOSTFN [GUESTFN] copy HOSTFN into VM (as GUESTFN)\n"; - print " get GUESTFN [HOSTFN] copy GUESTFN out of VM (to HOSTFN)\n"; - print " help print this help message and exit\n"; - print "Simulator options:\n"; - print " --bochs (default) Use Bochs as simulator\n"; - print " --qemu Use qemu as simulator\n"; - print " --gsx Use VMware GSX Server 3.x as simulator\n"; - print "Debugger options:\n"; - print " --no-debug (default) No debugger\n"; - print " --monitor Debug with simulator's monitor\n"; - print " --gdb Debug with gdb\n"; - print "Display options: (default is VGA + serial)\n"; - print " -v, --no-vga No VGA display\n"; - print " -s, --no-serial No serial output\n"; - print " -t, --terminal Display VGA in terminal (Bochs only)\n"; - print "VM options:\n"; - print " -j SEED Randomize timer interrupts (Bochs only)\n"; - print " -m, --mem=MB Run VM with MB megabytes of physical memory\n"; - print "Disk options:\n"; - print " --os-disk=DISK Set OS disk file (default: os.dsk)\n"; - print " --fs-disk=DISK Set FS disk file (default: fs.dsk)\n"; - print " --scratch-disk=DISK Set scratch disk (default: scratch.dsk)\n"; - print " --swap-disk=DISK Set swap disk file (default: swap.dsk)\n"; - exit $exitcode; +# Sets real-time timer interrupts. +sub set_realtime { + die "--realtime conflicts with --jitter\n" if defined $jitter; + $realtime = 1; } -sub copy_pad { - my ($src, $dst, $blocksize) = @_; - run_command ("dd", "if=$src", "of=$dst", "bs=$blocksize", "conv=sync"); +# add_file(\@list, $file) +# +# Adds [$file] to @list, which should be @puts or @gets. +# Sets $as_ref to point to the added element. +sub add_file { + my ($list, $file) = @_; + $as_ref = [$file]; + push (@$list, $as_ref); } -sub create_disk { - my ($disk, $kb) = @_; - run_command ("dd", "if=/dev/zero", "of=$disk", "bs=1024", "count=$kb"); +# Sets the guest/host name for the previous put/get. +sub set_as { + my ($as) = @_; + die "-a (or --as) is only allowed after -p or -g\n" if !defined $as_ref; + die "Only one -a (or --as) is allowed after -p or -g\n" + if defined $as_ref->[1]; + $as_ref->[1] = $as; } + +# Locates the files used to back each of the virtual disks, +# and creates temporary disks. +sub find_disks { + for my $disk (values %disks) { + # If there's no assigned file name but the default file exists, + # try to assign a default file name. + if (!defined ($disk->{FILE_NAME})) { + for my $try_fn ($disk->{DEF_FN}, "build/" . $disk->{DEF_FN}) { + $disk->{FILE_NAME} = $try_fn, last + if -e $try_fn; + } + } -sub run_vm { - our (@disks); - - die "$disks[0]: can't find OS disk\n" if ! -e $disks[0]; - for my $i (1...3) { - undef $disks[$i] if ! -e $disks[$i]; - } + # If there's no file name, we're done. + next if !defined ($disk->{FILE_NAME}); - write_cmd_line ($disks[0], @_); + if ($disk->{FILE_NAME} =~ /^\d+(\.\d+)?|\.\d+$/) { + # Create a temporary disk of approximately the specified + # size in megabytes. + die "OS disk can't be temporary\n" if $disk == $disks{OS}; - if ($sim eq 'bochs') { - my ($bin); - if ($debug eq 'no-debug') { - $bin = 'bochs'; - } elsif ($debug eq 'monitor') { - $bin = 'bochs-dbg'; - } elsif ($debug eq 'gdb') { - $bin = 'bochs-gdb'; - } + my ($mb) = $disk->{FILE_NAME}; + undef $disk->{FILE_NAME}; - my ($bochsbin) = search_path ($bin); - my ($bochsshare) = "$bochsbin/../share/bochs"; - - open (BOCHSRC, ">bochsrc.txt") or die "bochsrc.txt: create: $!\n"; - print BOCHSRC "romimage: file=$bochsshare/BIOS-bochs-latest, " - . "address=0xf0000\n"; - print BOCHSRC "vgaromimage: $bochsshare/VGABIOS-lgpl-latest\n"; - print BOCHSRC bochs_disk_line ("ata0-master", $disks[0]); - print BOCHSRC bochs_disk_line ("ata0-slave", $disks[1]); - print BOCHSRC "ata1: enabled=1, ioaddr1=0x170, ioaddr2=0x370, irq=15\n" - if defined ($disks[2]) || defined ($disks[3]); - print BOCHSRC bochs_disk_line ("ata1-master", $disks[2]); - print BOCHSRC bochs_disk_line ("ata1-slave", $disks[3]); - print BOCHSRC "boot: c\n"; - print BOCHSRC "ips: 1000000\n"; - print BOCHSRC "clock: sync=none, time0=0\n"; - print BOCHSRC "megs: $mem\n"; - print BOCHSRC "log: bochsout.txt\n"; - if ($vga ne 'terminal') { - print BOCHSRC "com1: enabled=1, dev=/dev/stdout\n" - if $serial_out; - print BOCHSRC "display_library: nogui\n" - if $vga eq 'none'; + my ($cyl_size) = 512 * 16 * 63; + extend_disk ($disk, ceil ($mb * 2) * $cyl_size); } else { - print BOCHSRC "display_library: term\n"; + # The file must exist and have nonzero size. + -e $disk->{FILE_NAME} or die "$disk->{FILE_NAME}: stat: $!\n"; + -s _ or die "$disk->{FILE_NAME}: disk has zero size\n"; } - close (BOCHSRC); + } - my (@cmd) = ($bin, '-q'); - push (@cmd, '-j', $jitter) if defined $jitter; - print join (' ', @cmd), "\n"; - exec (@cmd); - } elsif ($sim eq 'qemu') { - print "warning: qemu doesn't support --terminal\n" - if $vga eq 'terminal'; - print "warning: qemu doesn't support jitter\n" - if defined $jitter; - my (@cmd) = ('qemu'); - push (@cmd, '-hda', $disks[0]) if defined $disks[0]; - push (@cmd, '-hdb', $disks[1]) if defined $disks[1]; - push (@cmd, '-hdc', $disks[2]) if defined $disks[2]; - push (@cmd, '-hdd', $disks[3]) if defined $disks[3]; - push (@cmd, '-m', $mem); - push (@cmd, '-nographic') if $vga eq 'none'; - push (@cmd, '-serial', 'stdio') if $serial_out && $vga ne 'none'; - push (@cmd, '-S') if $debug eq 'monitor'; - push (@cmd, '-s') if $debug eq 'gdb'; - run_command (@cmd); - } elsif ($sim eq 'gsx') { - print "warning: VMware GSX Server doesn't support --$debug\n" - if $debug ne 'no-debug'; - print "warning: VMware GSX Server doesn't support --no-vga\n" - if $vga eq 'none'; - print "warning: VMware GSX Server doesn't support --terminal\n" - if $vga eq 'terminal'; - print "warning: VMware GSX Server doesn't support jitter\n" - if defined $jitter; - - open (VMX, ">pintos.vmx") or die "pintos.vmx: create: $!\n"; - chmod 0777 & ~umask, "pintos.vmx"; - print VMX "#! /usr/bin/vmware -G\n"; - print VMX "config.version = 6\n"; - print VMX "guestOS = \"linux\"\n"; - print VMX "floppy0.present = FALSE\n"; - - if (! -e 'null.bin') { - open (NULL, ">null.bin") or die "null.bin: create: $!\n"; - close (NULL); + # Warn about (potentially) missing disks. + die "Cannot find OS disk\n" if !defined $disks{OS}{FILE_NAME}; + if (my ($project) = `pwd` =~ /\b(threads|userprog|vm|filesys)\b/) { + if ((grep ($project eq $_, qw (userprog vm filesys))) + && !defined ($disks{FS}{FILE_NAME})) { + print STDERR "warning: it looks like you're running the $project "; + print STDERR "project, but no file system disk is present\n"; + } + if ($project eq 'vm' && !defined $disks{SWAP}{FILE_NAME}) { + print STDERR "warning: it looks like you're running the $project "; + print STDERR "project, but no swap disk is present\n"; } + } +} + +# Prepare the scratch disk for gets and puts. +sub prepare_scratch_disk { + if (@puts) { + # Write ustar header and data for each file. + put_scratch_file ($_->[0], + defined $_->[1] ? $_->[1] : $_->[0]) + foreach @puts; + + # Write end-of-archive marker. + write_fully ($disks{SCRATCH}{HANDLE}, $disks{SCRATCH}{FILE_NAME}, + "\0" x 1024); + } + + # Make sure the scratch disk is big enough to get big files. + extend_disk ($disks{SCRATCH}, @gets * 1024 * 1024) if @gets; +} + +# Read "get" files from the scratch disk. +sub finish_scratch_disk { + # We need to start reading the scratch disk from the beginning again. + if (@gets) { + close ($disks{SCRATCH}{HANDLE}); + undef ($disks{SCRATCH}{HANDLE}); + } - for (my ($i) = 0; $i < 4; $i++) { - my ($dsk) = $disks[$i]; - next if !defined $dsk; - - my ($pln) = $dsk; - $pln =~ s/\.dsk//; - $pln .= ".pln"; - - my ($device) = "ide" . int ($i / 2) . ":" . ($i % 2); - print VMX "\n$device.present = TRUE\n"; - print VMX "$device.deviceType = \"plainDisk\"\n"; - print VMX "$device.fileName = \"$pln\"\n"; - - my (%geom) = disk_geometry ($dsk); - open (PLN, ">$pln") or die "$pln: create: $!\n"; - print PLN "DRIVETYPE ide\n"; - print PLN "#vm|VERSION 2\n"; - print PLN "#vm|TOOLSVERSION 2\n"; - print PLN "CYLINDERS $geom{C}\n"; - print PLN "HEADS $geom{H}\n"; - print PLN "SECTORS $geom{S}\n"; - print PLN "#vm|CAPACITY $geom{CAPACITY}\n"; - print PLN "ACCESS \"$dsk\" 0 $geom{CAPACITY}\n"; - close (PLN); + # Read each file. + # If reading fails, delete that file and all subsequent files. + my ($ok) = 1; + foreach my $get (@gets) { + my ($name) = defined ($get->[1]) ? $get->[1] : $get->[0]; + my ($error) = get_scratch_file ($name); + if ($error) { + print STDERR "getting $name failed ($error)\n"; + die "$name: unlink: $!\n" if !unlink ($name) && !$!{ENOENT}; + $ok = 0; } - close (VMX); - - use Cwd; - my ($vmx) = getcwd () . "/pintos.vmx"; - system ("vmware-cmd -s register $vmx >&/dev/null"); - system ("vmware-cmd $vmx stop hard >&/dev/null"); - system ("vmware -l -G -x -q $vmx"); - system ("vmware-cmd $vmx stop hard >&/dev/null"); } } +# mk_ustar_field($number, $size) +# +# Returns $number in a $size-byte numeric field in the format used by +# the standard ustar archive header. +sub mk_ustar_field { + my ($number, $size) = @_; + my ($len) = $size - 1; + my ($out) = sprintf ("%0${len}o", $number) . "\0"; + die "$number: too large for $size-byte octal ustar field\n" + if length ($out) != $size; + return $out; +} + +# calc_ustar_chksum($s) +# +# Calculates and returns the ustar checksum of 512-byte ustar archive +# header $s. +sub calc_ustar_chksum { + my ($s) = @_; + die if length ($s) != 512; + substr ($s, 148, 8, ' ' x 8); + return unpack ("%32a*", $s); +} + +# put_scratch_file($src_file_name, $dst_file_name). +# +# Copies $src_file_name into the scratch disk for extraction as +# $dst_file_name. +sub put_scratch_file { + my ($src_file_name, $dst_file_name) = @_; + my ($disk_handle, $disk_file_name) = open_disk ($disks{SCRATCH}); + + print "Copying $src_file_name to scratch partition...\n"; + + # ustar format supports up to 100 characters for a file name, and + # even longer names given some common properties, but our code in + # the Pintos kernel only supports at most 99 characters. + die "$dst_file_name: name too long (max 99 characters)\n" + if length ($dst_file_name) > 99; + + # Compose and write ustar header. + stat $src_file_name or die "$src_file_name: stat: $!\n"; + my ($size) = -s _; + my ($header) = (pack ("a100", $dst_file_name) # name + . mk_ustar_field (0644, 8) # mode + . mk_ustar_field (0, 8) # uid + . mk_ustar_field (0, 8) # gid + . mk_ustar_field ($size, 12) # size + . mk_ustar_field (1136102400, 12) # mtime + . (' ' x 8) # chksum + . '0' # typeflag + . ("\0" x 100) # linkname + . "ustar\0" # magic + . "00" # version + . "root" . ("\0" x 28) # uname + . "root" . ("\0" x 28) # gname + . "\0" x 8 # devmajor + . "\0" x 8 # devminor + . ("\0" x 155)) # prefix + . "\0" x 12; # pad to 512 bytes + substr ($header, 148, 8) = mk_ustar_field (calc_ustar_chksum ($header), 8); + write_fully ($disk_handle, $disk_file_name, $header); + + # Copy file data. + my ($put_handle); + sysopen ($put_handle, $src_file_name, O_RDONLY) + or die "$src_file_name: open: $!\n"; + copy_file ($put_handle, $src_file_name, $disk_handle, $disk_file_name, + $size); + die "$src_file_name: changed size while being read\n" + if $size != -s $put_handle; + close ($put_handle); + + # Round up disk data to beginning of next sector. + write_fully ($disk_handle, $disk_file_name, "\0" x (512 - $size % 512)) + if $size % 512; +} + +# get_scratch_file($file). +# +# Copies from the scratch disk to $file. +# Returns 1 if successful, 0 on failure. +sub get_scratch_file { + my ($get_file_name) = @_; + my ($disk_handle, $disk_file_name) = open_disk ($disks{SCRATCH}); + + print "Copying $get_file_name out of $disk_file_name...\n"; + + # Read ustar header sector. + my ($header) = read_fully ($disk_handle, $disk_file_name, 512); + return "scratch disk tar archive ends unexpectedly" + if $header eq ("\0" x 512); + + # Verify magic numbers. + return "corrupt ustar signature" if substr ($header, 257, 6) ne "ustar\0"; + return "invalid ustar version" if substr ($header, 263, 2) ne '00'; + + # Verify checksum. + my ($chksum) = oct (unpack ("Z*", substr ($header, 148, 8))); + my ($correct_chksum) = calc_ustar_chksum ($header); + return "checksum mismatch" if $chksum != $correct_chksum; + + # Get type. + my ($typeflag) = substr ($header, 156, 1); + return "not a regular file" if $typeflag ne '0' && $typeflag ne "\0"; + + # Get size. + my ($size) = oct (unpack ("Z*", substr ($header, 124, 12))); + return "bad size $size\n" if $size < 0; + + # Copy file data. + my ($get_handle); + sysopen ($get_handle, $get_file_name, O_WRONLY | O_CREAT, 0666) + or die "$get_file_name: create: $!\n"; + copy_file ($disk_handle, $disk_file_name, $get_handle, $get_file_name, + $size); + close ($get_handle); + + # Skip forward in disk up to beginning of next sector. + read_fully ($disk_handle, $disk_file_name, 512 - $size % 512) + if $size % 512; + + return 0; +} + +# Prepares the arguments to pass to the Pintos kernel, +# and then write them into Pintos bootloader. +sub prepare_arguments { + my (@args); + push (@args, shift (@kernel_args)) + while @kernel_args && $kernel_args[0] =~ /^-/; + push (@args, 'extract') if @puts; + push (@args, @kernel_args); + push (@args, 'append', $_->[0]) foreach @gets; + write_cmd_line ($disks{OS}, @args); +} + +# Writes @args into the Pintos bootloader at the beginning of $disk. sub write_cmd_line { my ($disk, @args) = @_; - die "command line includes empty string" if grep (/^$/, @args); - my ($args) = join ("\0", @args) . "\0\0"; + # Figure out command line to write. + my ($arg_cnt) = pack ("V", scalar (@args)); + my ($args) = join ('', map ("$_\0", @args)); die "command line exceeds 128 bytes" if length ($args) > 128; $args .= "\0" x (128 - length ($args)); - print "writing command line to $disk...\n"; - open (DISK, "+<$disk") or die "$disk: open: $!\n"; - seek (DISK, 0x17e, 0) or die "$disk: seek: $!\n"; - syswrite (DISK, $args) or die "$disk: write: $!\n"; - close (DISK) or die "$disk: close: $!\n"; + # Write command line. + my ($handle, $file_name) = open_disk_copy ($disk); + print "Writing command line to $file_name...\n"; + sysseek ($handle, 0x17a, 0) == 0x17a or die "$file_name: seek: $!\n"; + syswrite ($handle, "$arg_cnt$args") or die "$file_name: write: $!\n"; } + +# Running simulators. -sub run_command { - print join (' ', @_), "\n"; - die "command failed\n" if system (@_); +# Runs the selected simulator. +sub run_vm { + if ($sim eq 'bochs') { + run_bochs (); + } elsif ($sim eq 'qemu') { + run_qemu (); + } elsif ($sim eq 'player') { + run_player (); + } else { + die "unknown simulator `$sim'\n"; + } } -sub search_path { - my ($target) = @_; - for my $dir (split (':', $ENV{PATH})) { - return $dir if -e "$dir/$target"; +# Runs Bochs. +sub run_bochs { + # Select Bochs binary based on the chosen debugger. + my ($bin) = $debug eq 'monitor' ? 'bochs-dbg' : 'bochs'; + + my ($squish_pty); + if ($serial) { + $squish_pty = find_in_path ("squish-pty"); + print "warning: can't find squish-pty, so terminal input will fail\n" + if !defined $squish_pty; + } + + # Write bochsrc.txt configuration file. + open (BOCHSRC, ">", "bochsrc.txt") or die "bochsrc.txt: create: $!\n"; + print BOCHSRC <{FILE_NAME}; + if (defined $file) { + my (%geom) = disk_geometry ($disk); + print BOCHSRC "$device: type=disk, path=$file, mode=flat, "; + print BOCHSRC "cylinders=$geom{C}, heads=$geom{H}, spt=$geom{S}, "; + print BOCHSRC "translation=none\n"; + } +} + +# Runs QEMU. +sub run_qemu { + print "warning: qemu doesn't support --terminal\n" + if $vga eq 'terminal'; + print "warning: qemu doesn't support jitter\n" + if defined $jitter; + my (@cmd) = ('qemu'); + for my $iface (0...3) { + my ($option) = ('-hda', '-hdb', '-hdc', '-hdd')[$iface]; + push (@cmd, $option, $disks_by_iface[$iface]{FILE_NAME}) + if defined $disks_by_iface[$iface]{FILE_NAME}; + } + push (@cmd, '-m', $mem); + push (@cmd, '-net', 'none'); + push (@cmd, '-nographic') if $vga eq 'none'; + push (@cmd, '-serial', 'stdio') if $serial && $vga ne 'none'; + push (@cmd, '-S') if $debug eq 'monitor'; + push (@cmd, '-s', '-S') if $debug eq 'gdb'; + push (@cmd, '-monitor', 'null') if $vga eq 'none' && $debug eq 'none'; + run_command (@cmd); +} + +# player_unsup($flag) +# +# Prints a message that $flag is unsupported by VMware Player. +sub player_unsup { + my ($flag) = @_; + print "warning: no support for $flag with VMware Player\n"; +} + +# Runs VMware Player. +sub run_player { + player_unsup ("--$debug") if $debug ne 'none'; + player_unsup ("--no-vga") if $vga eq 'none'; + player_unsup ("--terminal") if $vga eq 'terminal'; + player_unsup ("--jitter") if defined $jitter; + player_unsup ("--timeout"), undef $timeout if defined $timeout; + player_unsup ("--kill-on-failure"), undef $kill_on_failure + if defined $kill_on_failure; + + # Memory size must be multiple of 4. + $mem = int (($mem + 3) / 4) * 4; + + open (VMX, ">", "pintos.vmx") or die "pintos.vmx: create: $!\n"; + chmod 0777 & ~umask, "pintos.vmx"; + print VMX <{FILE_NAME}; + next if !defined $dsk; + + my ($device) = "ide" . int ($i / 2) . ":" . ($i % 2); + my ($pln) = "$device.pln"; + print VMX <", $pln) or die "$pln: create: $!\n"; + print PLN <{HANDLE})) { + if ($disk->{FILE_NAME}) { + sysopen ($disk->{HANDLE}, $disk->{FILE_NAME}, O_RDWR) + or die "$disk->{FILE_NAME}: open: $!\n"; + } else { + ($disk->{HANDLE}, $disk->{FILE_NAME}) = tempfile (UNLINK => 1, + SUFFIX => '.dsk'); + } + } + return ($disk->{HANDLE}, $disk->{FILE_NAME}); } -sub bochs_disk_line { - my ($device, $file) = @_; - return "" if !defined $file; - my (%geom) = disk_geometry ($file); - return "$device: type=disk, path=$file, mode=flat, " - . "cylinders=$geom{C}, heads=$geom{H}, spt=$geom{S}, " - . "translation=none\n"; +# open_disk_copy($disk) +# +# Makes a temporary copy of $disk and returns its file handle and file name. +sub open_disk_copy { + my ($disk) = @_; + die if !$disk->{FILE_NAME}; + + my ($orig_handle, $orig_file_name) = open_disk ($disk); + my ($cp_handle, $cp_file_name) = tempfile (UNLINK => 1, SUFFIX => '.dsk'); + copy_file ($orig_handle, $orig_file_name, $cp_handle, $cp_file_name, + -s $orig_handle); + return ($disk->{HANDLE}, $disk->{FILE_NAME}) = ($cp_handle, $cp_file_name); } +# extend_disk($disk, $size) +# +# Extends $disk, if necessary, so that it is at least $size bytes +# long. +sub extend_disk { + my ($disk, $size) = @_; + my ($handle, $file_name) = open_disk ($disk); + if (-s ($handle) < $size) { + sysseek ($handle, $size - 1, 0) == $size - 1 + or die "$file_name: seek: $!\n"; + syswrite ($handle, "\0") == 1 + or die "$file_name: write: $!\n"; + } +} + +# disk_geometry($file) +# +# Examines $file and returns a valid IDE disk geometry for it, as a +# hash. sub disk_geometry { - my ($file) = @_; + my ($disk) = @_; + my ($file) = $disk->{FILE_NAME}; my ($size) = -s $file; die "$file: stat: $!\n" if !defined $size; die "$file: size not a multiple of 512 bytes\n" if $size % 512; - my ($cylinders) = int ($size / (512 * 16 * 63)); - $cylinders++ if $size % (512 * 16 * 63); + my ($cyl_size) = 512 * 16 * 63; + my ($cylinders) = ceil ($size / $cyl_size); + extend_disk ($disk, $cylinders * $cyl_size) if $size % $cyl_size; return (CAPACITY => $size / 512, C => $cylinders, H => 16, S => 63); } + +# copy_file($from_handle, $from_file_name, $to_handle, $to_file_name, $size) +# +# Copies $size bytes from $from_handle to $to_handle. +# $from_file_name and $to_file_name are used in error messages. +sub copy_file { + my ($from_handle, $from_file_name, $to_handle, $to_file_name, $size) = @_; + + while ($size > 0) { + my ($chunk_size) = 4096; + $chunk_size = $size if $chunk_size > $size; + $size -= $chunk_size; + + my ($data) = read_fully ($from_handle, $from_file_name, $chunk_size); + write_fully ($to_handle, $to_file_name, $data); + } +} + +# read_fully($handle, $file_name, $bytes) +# +# Reads exactly $bytes bytes from $handle and returns the data read. +# $file_name is used in error messages. +sub read_fully { + my ($handle, $file_name, $bytes) = @_; + my ($data); + my ($read_bytes) = sysread ($handle, $data, $bytes); + die "$file_name: read: $!\n" if !defined $read_bytes; + die "$file_name: unexpected end of file\n" if $read_bytes != $bytes; + return $data; +} + +# write_fully($handle, $file_name, $data) +# +# Write $data to $handle. +# $file_name is used in error messages. +sub write_fully { + my ($handle, $file_name, $data) = @_; + my ($written_bytes) = syswrite ($handle, $data); + die "$file_name: write: $!\n" if !defined $written_bytes; + die "$file_name: short write\n" if $written_bytes != length $data; +} + +# Subprocess utilities. + +# run_command(@args) +# +# Runs xsystem(@args). +# Also prints the command it's running and checks that it succeeded. +sub run_command { + print join (' ', @_), "\n"; + die "command failed\n" if xsystem (@_); +} + +# xsystem(@args) +# +# Creates a subprocess via exec(@args) and waits for it to complete. +# Relays common signals to the subprocess. +# If $timeout is set then the subprocess will be killed after that long. +sub xsystem { + # QEMU turns off local echo and does not restore it if killed by a signal. + # We compensate by restoring it ourselves. + my $cleanup = sub {}; + if (isatty (0)) { + my $termios = POSIX::Termios->new; + $termios->getattr (0); + $cleanup = sub { $termios->setattr (0, &POSIX::TCSANOW); } + } + + # Create pipe for filtering output. + pipe (my $in, my $out) or die "pipe: $!\n" if $kill_on_failure; + + my ($pid) = fork; + if (!defined ($pid)) { + # Fork failed. + die "fork: $!\n"; + } elsif (!$pid) { + # Running in child process. + dup2 (fileno ($out), STDOUT_FILENO) or die "dup2: $!\n" + if $kill_on_failure; + exec_setitimer (@_); + } else { + # Running in parent process. + close $out if $kill_on_failure; + + my ($cause); + local $SIG{ALRM} = sub { timeout ($pid, $cause, $cleanup); }; + local $SIG{INT} = sub { relay_signal ($pid, "INT", $cleanup); }; + local $SIG{TERM} = sub { relay_signal ($pid, "TERM", $cleanup); }; + alarm ($timeout * get_load_average () + 1) if defined ($timeout); + + if ($kill_on_failure) { + # Filter output. + my ($buf) = ""; + my ($boots) = 0; + local ($|) = 1; + for (;;) { + if (waitpid ($pid, WNOHANG) != 0) { + # Subprocess died. Pass through any remaining data. + print $buf while sysread ($in, $buf, 4096) > 0; + last; + } + + # Read and print out pipe data. + my ($len) = length ($buf); + waitpid ($pid, 0), last + if sysread ($in, $buf, 4096, $len) <= 0; + print substr ($buf, $len); + + # Remove full lines from $buf and scan them for keywords. + while ((my $idx = index ($buf, "\n")) >= 0) { + local $_ = substr ($buf, 0, $idx + 1, ''); + next if defined ($cause); + if (/(Kernel PANIC|User process ABORT)/ ) { + $cause = "\L$1\E"; + alarm (5); + } elsif (/Pintos booting/ && ++$boots > 1) { + $cause = "triple fault"; + alarm (5); + } elsif (/FAILED/) { + $cause = "test failure"; + alarm (5); + } + } + } + } else { + waitpid ($pid, 0); + } + alarm (0); + &$cleanup (); + + if (WIFSIGNALED ($?) && WTERMSIG ($?) == SIGVTALRM ()) { + seek (STDOUT, 0, 2); + print "\nTIMEOUT after $timeout seconds of host CPU time\n"; + exit 0; + } + + return $?; + } +} + +# relay_signal($pid, $signal, &$cleanup) +# +# Relays $signal to $pid and then reinvokes it for us with the default +# handler. Also cleans up temporary files and invokes $cleanup. +sub relay_signal { + my ($pid, $signal, $cleanup) = @_; + kill $signal, $pid; + eval { File::Temp::cleanup() }; # Not defined in old File::Temp. + &$cleanup (); + $SIG{$signal} = 'DEFAULT'; + kill $signal, getpid (); +} + +# timeout($pid, $cause, &$cleanup) +# +# Interrupts $pid and dies with a timeout error message, +# after invoking $cleanup. +sub timeout { + my ($pid, $cause, $cleanup) = @_; + kill "INT", $pid; + waitpid ($pid, 0); + &$cleanup (); + seek (STDOUT, 0, 2); + if (!defined ($cause)) { + my ($load_avg) = `uptime` =~ /(load average:.*)$/i; + print "\nTIMEOUT after ", time () - $start_time, + " seconds of wall-clock time"; + print " - $load_avg" if defined $load_avg; + print "\n"; + } else { + print "Simulation terminated due to $cause.\n"; + } + exit 0; +} + +# Returns the system load average over the last minute. +# If the load average is less than 1.0 or cannot be determined, returns 1.0. +sub get_load_average { + my ($avg) = `uptime` =~ /load average:\s*([^,]+),/; + return $avg >= 1.0 ? $avg : 1.0; +} + +# Calls setitimer to set a timeout, then execs what was passed to us. +sub exec_setitimer { + if (defined $timeout) { + if ($ ge 5.8.0) { + eval " + use Time::HiRes qw(setitimer ITIMER_VIRTUAL); + setitimer (ITIMER_VIRTUAL, $timeout, 0); + "; + } else { + { exec ("setitimer-helper", $timeout, @_); }; + exit 1 if !$!{ENOENT}; + print STDERR "warning: setitimer-helper is not installed, so ", + "CPU time limit will not be enforced\n"; + } + } + exec (@_); + exit (1); +} + +sub SIGVTALRM { + use Config; + my $i = 0; + foreach my $name (split(' ', $Config{sig_name})) { + return $i if $name eq 'VTALRM'; + $i++; + } + return 0; +} + +# find_in_path ($program) +# +# Searches for $program in $ENV{PATH}. +# Returns $program if found, otherwise undef. +sub find_in_path { + my ($program) = @_; + -x "$_/$program" and return $program foreach split (':', $ENV{PATH}); + return; +}