+
+# copy_file($from_handle, $from_filename, $to_handle, $to_filename, $size)
+#
+# Copies $size bytes from $from_handle to $to_handle.
+# $from_filename and $to_filename are used in error messages.
+sub copy_file {
+ my ($from_handle, $from_filename, $to_handle, $to_filename, $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_filename, $chunk_size);
+ write_fully ($to_handle, $to_filename, $data);
+ }
+}
+
+# read_fully($handle, $filename, $bytes)
+#
+# Reads exactly $bytes bytes from $handle and returns the data read.
+# $filename is used in error messages.
+sub read_fully {
+ my ($handle, $filename, $bytes) = @_;
+ my ($data);
+ my ($read_bytes) = sysread ($handle, $data, $bytes);
+ die "$filename: read: $!\n" if !defined $read_bytes;
+ die "$filename: unexpected end of file\n" if $read_bytes != $bytes;
+ return $data;
+}
+
+# write_fully($handle, $filename, $data)
+#
+# Write $data to $handle.
+# $filename is used in error messages.
+sub write_fully {
+ my ($handle, $filename, $data) = @_;
+ my ($written_bytes) = syswrite ($handle, $data);
+ die "$filename: write: $!\n" if !defined $written_bytes;
+ die "$filename: short write\n" if $written_bytes != length $data;
+}
+\f
+# 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 {
+ my ($pid) = fork;
+ if (!defined ($pid)) {
+ # Fork failed.
+ die "fork: $!\n";
+ } elsif (!$pid) {
+ # Running in child process.
+ exec (@_);
+ exit (1);
+ } else {
+ # Running in parent process.
+ local $SIG{ALRM} = sub { timeout ($pid); };
+ local $SIG{INT} = sub { relay_signal ($pid, "INT"); };
+ local $SIG{TERM} = sub { relay_signal ($pid, "TERM"); };
+ alarm ($timeout) if defined ($timeout);
+ waitpid ($pid, 0);
+ alarm (0);
+ return $?;
+ }
+}
+
+# relay_signal($pid, $signal)
+#
+# Relays $signal to $pid and then reinvokes it for us with the default
+# handler.
+sub relay_signal {
+ my ($pid, $signal) = @_;
+ kill $signal, $pid;
+ $SIG{$signal} = 'DEFAULT';
+ kill $signal, getpid ();
+}
+
+# timeout($pid)
+#
+# Interrupts $pid and dies with a timeout error message.
+sub timeout {
+ my ($pid) = @_;
+ kill "INT", $pid;
+ waitpid ($pid, 0);
+ seek (STDOUT, 0, 2);
+ my ($load_avg) = `uptime` =~ /(load average:.*)$/i;
+ print "\nTIMEOUT after $timeout seconds";
+ print " - $load_avg" if defined $load_avg;
+ print "\n";
+ exit 0;
+}