diff options
Diffstat (limited to 'nixpkgs/nixos/lib/test-driver')
| -rw-r--r-- | nixpkgs/nixos/lib/test-driver/Logger.pm | 75 | ||||
| -rw-r--r-- | nixpkgs/nixos/lib/test-driver/Machine.pm | 734 | ||||
| -rw-r--r-- | nixpkgs/nixos/lib/test-driver/test-driver.pl | 191 | ||||
| -rw-r--r-- | nixpkgs/nixos/lib/test-driver/test-driver.py | 68 |
4 files changed, 58 insertions, 1010 deletions
diff --git a/nixpkgs/nixos/lib/test-driver/Logger.pm b/nixpkgs/nixos/lib/test-driver/Logger.pm deleted file mode 100644 index 080310ea34e..00000000000 --- a/nixpkgs/nixos/lib/test-driver/Logger.pm +++ /dev/null @@ -1,75 +0,0 @@ -package Logger; - -use strict; -use Thread::Queue; -use XML::Writer; -use Encode qw(decode encode); -use Time::HiRes qw(clock_gettime CLOCK_MONOTONIC); - -sub new { - my ($class) = @_; - - my $logFile = defined $ENV{LOGFILE} ? "$ENV{LOGFILE}" : "/dev/null"; - my $log = new XML::Writer(OUTPUT => new IO::File(">$logFile")); - - my $self = { - log => $log, - logQueue => Thread::Queue->new() - }; - - $self->{log}->startTag("logfile"); - - bless $self, $class; - return $self; -} - -sub close { - my ($self) = @_; - $self->{log}->endTag("logfile"); - $self->{log}->end; -} - -sub drainLogQueue { - my ($self) = @_; - while (defined (my $item = $self->{logQueue}->dequeue_nb())) { - $self->{log}->dataElement("line", sanitise($item->{msg}), 'machine' => $item->{machine}, 'type' => 'serial'); - } -} - -sub maybePrefix { - my ($msg, $attrs) = @_; - $msg = $attrs->{machine} . ": " . $msg if defined $attrs->{machine}; - return $msg; -} - -sub nest { - my ($self, $msg, $coderef, $attrs) = @_; - print STDERR maybePrefix("$msg\n", $attrs); - $self->{log}->startTag("nest"); - $self->{log}->dataElement("head", $msg, %{$attrs}); - my $now = clock_gettime(CLOCK_MONOTONIC); - $self->drainLogQueue(); - eval { &$coderef }; - my $res = $@; - $self->drainLogQueue(); - $self->log(sprintf("(%.2f seconds)", clock_gettime(CLOCK_MONOTONIC) - $now)); - $self->{log}->endTag("nest"); - die $@ if $@; -} - -sub sanitise { - my ($s) = @_; - $s =~ s/[[:cntrl:]\xff]//g; - $s = decode('UTF-8', $s, Encode::FB_DEFAULT); - return encode('UTF-8', $s, Encode::FB_CROAK); -} - -sub log { - my ($self, $msg, $attrs) = @_; - chomp $msg; - print STDERR maybePrefix("$msg\n", $attrs); - $self->drainLogQueue(); - $self->{log}->dataElement("line", $msg, %{$attrs}); -} - -1; diff --git a/nixpkgs/nixos/lib/test-driver/Machine.pm b/nixpkgs/nixos/lib/test-driver/Machine.pm deleted file mode 100644 index 4d3d63cd2db..00000000000 --- a/nixpkgs/nixos/lib/test-driver/Machine.pm +++ /dev/null @@ -1,734 +0,0 @@ -package Machine; - -use strict; -use threads; -use Socket; -use IO::Handle; -use POSIX qw(dup2); -use FileHandle; -use Cwd; -use File::Basename; -use File::Path qw(make_path); -use File::Slurp; -use Time::HiRes qw(clock_gettime CLOCK_MONOTONIC); - - -my $showGraphics = defined $ENV{'DISPLAY'}; - -my $sharedDir; - - -sub new { - my ($class, $args) = @_; - - my $startCommand = $args->{startCommand}; - - my $name = $args->{name}; - if (!$name) { - $startCommand =~ /run-(.*)-vm$/ if defined $startCommand; - $name = $1 || "machine"; - } - - if (!$startCommand) { - # !!! merge with qemu-vm.nix. - my $netBackend = "-netdev user,id=net0"; - my $netFrontend = "-device virtio-net-pci,netdev=net0"; - - $netBackend .= "," . $args->{netBackendArgs} - if defined $args->{netBackendArgs}; - - $netFrontend .= "," . $args->{netFrontendArgs} - if defined $args->{netFrontendArgs}; - - $startCommand = - "qemu-kvm -m 384 $netBackend $netFrontend \$QEMU_OPTS "; - - if (defined $args->{hda}) { - if ($args->{hdaInterface} eq "scsi") { - $startCommand .= "-drive id=hda,file=" - . Cwd::abs_path($args->{hda}) - . ",werror=report,if=none " - . "-device scsi-hd,drive=hda "; - } else { - $startCommand .= "-drive file=" . Cwd::abs_path($args->{hda}) - . ",if=" . $args->{hdaInterface} - . ",werror=report "; - } - } - - $startCommand .= "-cdrom $args->{cdrom} " - if defined $args->{cdrom}; - $startCommand .= "-device piix3-usb-uhci -drive id=usbdisk,file=$args->{usb},if=none,readonly -device usb-storage,drive=usbdisk " - if defined $args->{usb}; - $startCommand .= "-bios $args->{bios} " - if defined $args->{bios}; - $startCommand .= $args->{qemuFlags} || ""; - } - - my $tmpDir = $ENV{'TMPDIR'} || "/tmp"; - unless (defined $sharedDir) { - $sharedDir = $tmpDir . "/xchg-shared"; - make_path($sharedDir, { mode => 0700, owner => $< }); - } - - my $allowReboot = 0; - $allowReboot = $args->{allowReboot} if defined $args->{allowReboot}; - - my $self = { - startCommand => $startCommand, - name => $name, - allowReboot => $allowReboot, - booted => 0, - pid => 0, - connected => 0, - socket => undef, - stateDir => "$tmpDir/vm-state-$name", - monitor => undef, - log => $args->{log}, - redirectSerial => $args->{redirectSerial} // 1, - }; - - mkdir $self->{stateDir}, 0700; - - bless $self, $class; - return $self; -} - - -sub log { - my ($self, $msg) = @_; - $self->{log}->log($msg, { machine => $self->{name} }); -} - - -sub nest { - my ($self, $msg, $coderef, $attrs) = @_; - $self->{log}->nest($msg, $coderef, { %{$attrs || {}}, machine => $self->{name} }); -} - - -sub name { - my ($self) = @_; - return $self->{name}; -} - - -sub stateDir { - my ($self) = @_; - return $self->{stateDir}; -} - - -sub start { - my ($self) = @_; - return if $self->{booted}; - - $self->log("starting vm"); - - # Create a socket pair for the serial line input/output of the VM. - my ($serialP, $serialC); - socketpair($serialP, $serialC, PF_UNIX, SOCK_STREAM, 0) or die; - - # Create a Unix domain socket to which QEMU's monitor will connect. - my $monitorPath = $self->{stateDir} . "/monitor"; - unlink $monitorPath; - my $monitorS; - socket($monitorS, PF_UNIX, SOCK_STREAM, 0) or die; - bind($monitorS, sockaddr_un($monitorPath)) or die "cannot bind monitor socket: $!"; - listen($monitorS, 1) or die; - - # Create a Unix domain socket to which the root shell in the guest will connect. - my $shellPath = $self->{stateDir} . "/shell"; - unlink $shellPath; - my $shellS; - socket($shellS, PF_UNIX, SOCK_STREAM, 0) or die; - bind($shellS, sockaddr_un($shellPath)) or die "cannot bind shell socket: $!"; - listen($shellS, 1) or die; - - # Start the VM. - my $pid = fork(); - die if $pid == -1; - - if ($pid == 0) { - close $serialP; - close $monitorS; - close $shellS; - if ($self->{redirectSerial}) { - open NUL, "</dev/null" or die; - dup2(fileno(NUL), fileno(STDIN)); - dup2(fileno($serialC), fileno(STDOUT)); - dup2(fileno($serialC), fileno(STDERR)); - } - $ENV{TMPDIR} = $self->{stateDir}; - $ENV{SHARED_DIR} = $sharedDir; - $ENV{USE_TMPDIR} = 1; - $ENV{QEMU_OPTS} = - ($self->{allowReboot} ? "" : "-no-reboot ") . - "-monitor unix:./monitor -chardev socket,id=shell,path=./shell " . - "-device virtio-serial -device virtconsole,chardev=shell " . - "-device virtio-rng-pci " . - ($showGraphics ? "-serial stdio" : "-nographic") . " " . ($ENV{QEMU_OPTS} || ""); - chdir $self->{stateDir} or die; - exec $self->{startCommand}; - die "running VM script: $!"; - } - - # Process serial line output. - close $serialC; - - threads->create(\&processSerialOutput, $self, $serialP)->detach; - - sub processSerialOutput { - my ($self, $serialP) = @_; - while (<$serialP>) { - chomp; - s/\r$//; - print STDERR $self->{name}, "# $_\n"; - $self->{log}->{logQueue}->enqueue({msg => $_, machine => $self->{name}}); # !!! - } - } - - eval { - local $SIG{CHLD} = sub { die "QEMU died prematurely\n"; }; - - # Wait until QEMU connects to the monitor. - accept($self->{monitor}, $monitorS) or die; - - # Wait until QEMU connects to the root shell socket. QEMU - # does so immediately; this doesn't mean that the root shell - # has connected yet inside the guest. - accept($self->{socket}, $shellS) or die; - $self->{socket}->autoflush(1); - }; - die "$@" if $@; - - $self->waitForMonitorPrompt; - - $self->log("QEMU running (pid $pid)"); - - $self->{pid} = $pid; - $self->{booted} = 1; -} - - -# Send a command to the monitor and wait for it to finish. TODO: QEMU -# also has a JSON-based monitor interface now, but it doesn't support -# all commands yet. We should use it once it does. -sub sendMonitorCommand { - my ($self, $command) = @_; - $self->log("sending monitor command: $command"); - syswrite $self->{monitor}, "$command\n"; - return $self->waitForMonitorPrompt; -} - - -# Wait until the monitor sends "(qemu) ". -sub waitForMonitorPrompt { - my ($self) = @_; - my $res = ""; - my $s; - while (sysread($self->{monitor}, $s, 1024)) { - $res .= $s; - last if $res =~ s/\(qemu\) $//; - } - return $res; -} - - -# Call the given code reference repeatedly, with 1 second intervals, -# until it returns 1 or a timeout is reached. -sub retry { - my ($coderef) = @_; - my $n; - for ($n = 899; $n >=0; $n--) { - return if &$coderef($n); - sleep 1; - } - die "action timed out after $n seconds"; -} - - -sub connect { - my ($self) = @_; - return if $self->{connected}; - - $self->nest("waiting for the VM to finish booting", sub { - - $self->start; - - my $now = clock_gettime(CLOCK_MONOTONIC); - local $SIG{ALRM} = sub { die "timed out waiting for the VM to connect\n"; }; - alarm 600; - readline $self->{socket} or die "the VM quit before connecting\n"; - alarm 0; - - $self->log("connected to guest root shell"); - # We're interested in tracking how close we are to `alarm`. - $self->log(sprintf("(connecting took %.2f seconds)", clock_gettime(CLOCK_MONOTONIC) - $now)); - $self->{connected} = 1; - - }); -} - - -sub waitForShutdown { - my ($self) = @_; - return unless $self->{booted}; - - $self->nest("waiting for the VM to power off", sub { - waitpid $self->{pid}, 0; - $self->{pid} = 0; - $self->{booted} = 0; - $self->{connected} = 0; - }); -} - - -sub isUp { - my ($self) = @_; - return $self->{booted} && $self->{connected}; -} - - -sub execute_ { - my ($self, $command) = @_; - - $self->connect; - - print { $self->{socket} } ("( $command ); echo '|!=EOF' \$?\n"); - - my $out = ""; - - while (1) { - my $line = readline($self->{socket}); - die "connection to VM lost unexpectedly" unless defined $line; - #$self->log("got line: $line"); - if ($line =~ /^(.*)\|\!\=EOF\s+(\d+)$/) { - $out .= $1; - $self->log("exit status $2"); - return ($2, $out); - } - $out .= $line; - } -} - - -sub execute { - my ($self, $command) = @_; - my @res; - $self->nest("running command: $command", sub { - @res = $self->execute_($command); - }); - return @res; -} - - -sub succeed { - my ($self, @commands) = @_; - - my $res; - foreach my $command (@commands) { - $self->nest("must succeed: $command", sub { - my ($status, $out) = $self->execute_($command); - if ($status != 0) { - $self->log("output: $out"); - die "command `$command' did not succeed (exit code $status)\n"; - } - $res .= $out; - }); - } - - return $res; -} - - -sub mustSucceed { - succeed @_; -} - - -sub waitUntilSucceeds { - my ($self, $command) = @_; - $self->nest("waiting for success: $command", sub { - retry sub { - my ($status, $out) = $self->execute($command); - return 1 if $status == 0; - }; - }); -} - - -sub waitUntilFails { - my ($self, $command) = @_; - $self->nest("waiting for failure: $command", sub { - retry sub { - my ($status, $out) = $self->execute($command); - return 1 if $status != 0; - }; - }); -} - - -sub fail { - my ($self, $command) = @_; - $self->nest("must fail: $command", sub { - my ($status, $out) = $self->execute_($command); - die "command `$command' unexpectedly succeeded" - if $status == 0; - }); -} - - -sub mustFail { - fail @_; -} - - -sub getUnitInfo { - my ($self, $unit, $user) = @_; - my ($status, $lines) = $self->systemctl("--no-pager show \"$unit\"", $user); - return undef if $status != 0; - my $info = {}; - foreach my $line (split '\n', $lines) { - $line =~ /^([^=]+)=(.*)$/ or next; - $info->{$1} = $2; - } - return $info; -} - -sub systemctl { - my ($self, $q, $user) = @_; - if ($user) { - $q =~ s/'/\\'/g; - return $self->execute("su -l $user -c \$'XDG_RUNTIME_DIR=/run/user/`id -u` systemctl --user $q'"); - } - - return $self->execute("systemctl $q"); -} - -# Fail if the given systemd unit is not in the "active" state. -sub requireActiveUnit { - my ($self, $unit) = @_; - $self->nest("checking if unit ‘$unit’ has reached state 'active'", sub { - my $info = $self->getUnitInfo($unit); - my $state = $info->{ActiveState}; - if ($state ne "active") { - die "Expected unit ‘$unit’ to to be in state 'active' but it is in state ‘$state’\n"; - }; - }); -} - -# Wait for a systemd unit to reach the "active" state. -sub waitForUnit { - my ($self, $unit, $user) = @_; - $self->nest("waiting for unit ‘$unit’", sub { - retry sub { - my $info = $self->getUnitInfo($unit, $user); - my $state = $info->{ActiveState}; - die "unit ‘$unit’ reached state ‘$state’\n" if $state eq "failed"; - if ($state eq "inactive") { - # If there are no pending jobs, then assume this unit - # will never reach active state. - my ($status, $jobs) = $self->systemctl("list-jobs --full 2>&1", $user); - if ($jobs =~ /No jobs/) { # FIXME: fragile - # Handle the case where the unit may have started - # between the previous getUnitInfo() and - # list-jobs. - my $info2 = $self->getUnitInfo($unit); - die "unit ‘$unit’ is inactive and there are no pending jobs\n" - if $info2->{ActiveState} eq $state; - } - } - return 1 if $state eq "active"; - }; - }); -} - - -sub waitForJob { - my ($self, $jobName) = @_; - return $self->waitForUnit($jobName); -} - - -# Wait until the specified file exists. -sub waitForFile { - my ($self, $fileName) = @_; - $self->nest("waiting for file ‘$fileName’", sub { - retry sub { - my ($status, $out) = $self->execute("test -e $fileName"); - return 1 if $status == 0; - } - }); -} - -sub startJob { - my ($self, $jobName, $user) = @_; - $self->systemctl("start $jobName", $user); - # FIXME: check result -} - -sub stopJob { - my ($self, $jobName, $user) = @_; - $self->systemctl("stop $jobName", $user); -} - - -# Wait until the machine is listening on the given TCP port. -sub waitForOpenPort { - my ($self, $port) = @_; - $self->nest("waiting for TCP port $port", sub { - retry sub { - my ($status, $out) = $self->execute("nc -z localhost $port"); - return 1 if $status == 0; - } - }); -} - - -# Wait until the machine is not listening on the given TCP port. -sub waitForClosedPort { - my ($self, $port) = @_; - retry sub { - my ($status, $out) = $self->execute("nc -z localhost $port"); - return 1 if $status != 0; - } -} - - -sub shutdown { - my ($self) = @_; - return unless $self->{booted}; - - print { $self->{socket} } ("poweroff\n"); - - $self->waitForShutdown; -} - - -sub crash { - my ($self) = @_; - return unless $self->{booted}; - - $self->log("forced crash"); - - $self->sendMonitorCommand("quit"); - - $self->waitForShutdown; -} - - -# Make the machine unreachable by shutting down eth1 (the multicast -# interface used to talk to the other VMs). We keep eth0 up so that -# the test driver can continue to talk to the machine. -sub block { - my ($self) = @_; - $self->sendMonitorCommand("set_link virtio-net-pci.1 off"); -} - - -# Make the machine reachable. -sub unblock { - my ($self) = @_; - $self->sendMonitorCommand("set_link virtio-net-pci.1 on"); -} - - -# Take a screenshot of the X server on :0.0. -sub screenshot { - my ($self, $filename) = @_; - my $dir = $ENV{'out'} || Cwd::abs_path("."); - $filename = "$dir/${filename}.png" if $filename =~ /^\w+$/; - my $tmp = "${filename}.ppm"; - my $name = basename($filename); - $self->nest("making screenshot ‘$name’", sub { - $self->sendMonitorCommand("screendump $tmp"); - system("pnmtopng $tmp > ${filename}") == 0 - or die "cannot convert screenshot"; - unlink $tmp; - }, { image => $name } ); -} - -# Get the text of TTY<n> -sub getTTYText { - my ($self, $tty) = @_; - - my ($status, $out) = $self->execute("fold -w\$(stty -F /dev/tty${tty} size | awk '{print \$2}') /dev/vcs${tty}"); - return $out; -} - -# Wait until TTY<n>'s text matches a particular regular expression -sub waitUntilTTYMatches { - my ($self, $tty, $regexp) = @_; - - $self->nest("waiting for $regexp to appear on tty $tty", sub { - retry sub { - my ($retries_remaining) = @_; - if ($retries_remaining == 0) { - $self->log("Last chance to match /$regexp/ on TTY$tty, which currently contains:"); - $self->log($self->getTTYText($tty)); - } - - return 1 if $self->getTTYText($tty) =~ /$regexp/; - } - }); -} - -# Debugging: Dump the contents of the TTY<n> -sub dumpTTYContents { - my ($self, $tty) = @_; - - $self->execute("fold -w 80 /dev/vcs${tty} | systemd-cat"); -} - -# Take a screenshot and return the result as text using optical character -# recognition. -sub getScreenText { - my ($self) = @_; - - system("command -v tesseract &> /dev/null") == 0 - or die "getScreenText used but enableOCR is false"; - - my $text; - $self->nest("performing optical character recognition", sub { - my $tmpbase = Cwd::abs_path(".")."/ocr"; - my $tmpin = $tmpbase."in.ppm"; - - $self->sendMonitorCommand("screendump $tmpin"); - - my $magickArgs = "-filter Catrom -density 72 -resample 300 " - . "-contrast -normalize -despeckle -type grayscale " - . "-sharpen 1 -posterize 3 -negate -gamma 100 " - . "-blur 1x65535"; - my $tessArgs = "-c debug_file=/dev/null --psm 11 --oem 2"; - - $text = `convert $magickArgs $tmpin tiff:- | tesseract - - $tessArgs`; - my $status = $? >> 8; - unlink $tmpin; - - die "OCR failed with exit code $status" if $status != 0; - }); - return $text; -} - - -# Wait until a specific regexp matches the textual contents of the screen. -sub waitForText { - my ($self, $regexp) = @_; - $self->nest("waiting for $regexp to appear on the screen", sub { - retry sub { - my ($retries_remaining) = @_; - if ($retries_remaining == 0) { - $self->log("Last chance to match /$regexp/ on the screen, which currently contains:"); - $self->log($self->getScreenText); - } - - return 1 if $self->getScreenText =~ /$regexp/; - } - }); -} - - -# Wait until it is possible to connect to the X server. Note that -# testing the existence of /tmp/.X11-unix/X0 is insufficient. -sub waitForX { - my ($self, $regexp) = @_; - $self->nest("waiting for the X11 server", sub { - retry sub { - my ($status, $out) = $self->execute("journalctl -b SYSLOG_IDENTIFIER=systemd | grep 'Reached target Current graphical'"); - return 0 if $status != 0; - ($status, $out) = $self->execute("[ -e /tmp/.X11-unix/X0 ]"); - return 1 if $status == 0; - } - }); -} - - -sub getWindowNames { - my ($self) = @_; - my $res = $self->mustSucceed( - q{xwininfo -root -tree | sed 's/.*0x[0-9a-f]* \"\([^\"]*\)\".*/\1/; t; d'}); - return split /\n/, $res; -} - - -sub waitForWindow { - my ($self, $regexp) = @_; - $self->nest("waiting for a window to appear", sub { - retry sub { - my @names = $self->getWindowNames; - - my ($retries_remaining) = @_; - if ($retries_remaining == 0) { - $self->log("Last chance to match /$regexp/ on the the window list, which currently contains:"); - $self->log(join(", ", @names)); - } - - foreach my $n (@names) { - return 1 if $n =~ /$regexp/; - } - } - }); -} - - -sub copyFileFromHost { - my ($self, $from, $to) = @_; - my $s = `cat $from` or die; - $s =~ s/'/'\\''/g; - $self->mustSucceed("echo '$s' > $to"); -} - - -my %charToKey = ( - 'A' => "shift-a", 'N' => "shift-n", '-' => "0x0C", '_' => "shift-0x0C", '!' => "shift-0x02", - 'B' => "shift-b", 'O' => "shift-o", '=' => "0x0D", '+' => "shift-0x0D", '@' => "shift-0x03", - 'C' => "shift-c", 'P' => "shift-p", '[' => "0x1A", '{' => "shift-0x1A", '#' => "shift-0x04", - 'D' => "shift-d", 'Q' => "shift-q", ']' => "0x1B", '}' => "shift-0x1B", '$' => "shift-0x05", - 'E' => "shift-e", 'R' => "shift-r", ';' => "0x27", ':' => "shift-0x27", '%' => "shift-0x06", - 'F' => "shift-f", 'S' => "shift-s", '\'' => "0x28", '"' => "shift-0x28", '^' => "shift-0x07", - 'G' => "shift-g", 'T' => "shift-t", '`' => "0x29", '~' => "shift-0x29", '&' => "shift-0x08", - 'H' => "shift-h", 'U' => "shift-u", '\\' => "0x2B", '|' => "shift-0x2B", '*' => "shift-0x09", - 'I' => "shift-i", 'V' => "shift-v", ',' => "0x33", '<' => "shift-0x33", '(' => "shift-0x0A", - 'J' => "shift-j", 'W' => "shift-w", '.' => "0x34", '>' => "shift-0x34", ')' => "shift-0x0B", - 'K' => "shift-k", 'X' => "shift-x", '/' => "0x35", '?' => "shift-0x35", - 'L' => "shift-l", 'Y' => "shift-y", ' ' => "spc", - 'M' => "shift-m", 'Z' => "shift-z", "\n" => "ret", -); - - -sub sendKeys { - my ($self, @keys) = @_; - foreach my $key (@keys) { - $key = $charToKey{$key} if exists $charToKey{$key}; - $self->sendMonitorCommand("sendkey $key"); - } -} - - -sub sendChars { - my ($self, $chars) = @_; - $self->nest("sending keys ‘$chars’", sub { - $self->sendKeys(split //, $chars); - }); -} - - -# Sleep N seconds (in virtual guest time, not real time). -sub sleep { - my ($self, $time) = @_; - $self->succeed("sleep $time"); -} - - -# Forward a TCP port on the host to a TCP port on the guest. Useful -# during interactive testing. -sub forwardPort { - my ($self, $hostPort, $guestPort) = @_; - $hostPort = 8080 unless defined $hostPort; - $guestPort = 80 unless defined $guestPort; - $self->sendMonitorCommand("hostfwd_add tcp::$hostPort-:$guestPort"); -} - - -1; diff --git a/nixpkgs/nixos/lib/test-driver/test-driver.pl b/nixpkgs/nixos/lib/test-driver/test-driver.pl deleted file mode 100644 index a3354fb0e1e..00000000000 --- a/nixpkgs/nixos/lib/test-driver/test-driver.pl +++ /dev/null @@ -1,191 +0,0 @@ -#! /somewhere/perl -w - -use strict; -use Machine; -use Term::ReadLine; -use IO::File; -use IO::Pty; -use Logger; -use Cwd; -use POSIX qw(_exit dup2); -use Time::HiRes qw(clock_gettime CLOCK_MONOTONIC); - -$SIG{PIPE} = 'IGNORE'; # because Unix domain sockets may die unexpectedly - -STDERR->autoflush(1); - -my $log = new Logger; - - -# Start vde_switch for each network required by the test. -my %vlans; -foreach my $vlan (split / /, $ENV{VLANS} || "") { - next if defined $vlans{$vlan}; - # Start vde_switch as a child process. We don't run it in daemon - # mode because we want the child process to be cleaned up when we - # die. Since we have to make sure that the control socket is - # ready, we send a dummy command to vde_switch (via stdin) and - # wait for a reply. Note that vde_switch requires stdin to be a - # TTY, so we create one. - $log->log("starting VDE switch for network $vlan"); - my $socket = Cwd::abs_path "./vde$vlan.ctl"; - my $pty = new IO::Pty; - my ($stdoutR, $stdoutW); pipe $stdoutR, $stdoutW; - my $pid = fork(); die "cannot fork" unless defined $pid; - if ($pid == 0) { - dup2(fileno($pty->slave), 0); - dup2(fileno($stdoutW), 1); - exec "vde_switch -s $socket --dirmode 0700" or _exit(1); - } - close $stdoutW; - print $pty "version\n"; - readline $stdoutR or die "cannot start vde_switch"; - $ENV{"QEMU_VDE_SOCKET_$vlan"} = $socket; - $vlans{$vlan} = $pty; - die unless -e "$socket/ctl"; -} - - -my %vms; -my $context = ""; - -sub createMachine { - my ($args) = @_; - my $vm = Machine->new({%{$args}, log => $log, redirectSerial => ($ENV{USE_SERIAL} // "0") ne "1"}); - $vms{$vm->name} = $vm; - $context .= "my \$" . $vm->name . " = \$vms{'" . $vm->name . "'}; "; - return $vm; -} - -foreach my $vmScript (@ARGV) { - my $vm = createMachine({startCommand => $vmScript}); -} - - -sub startAll { - $log->nest("starting all VMs", sub { - $_->start foreach values %vms; - }); -} - - -# Wait until all VMs have terminated. -sub joinAll { - $log->nest("waiting for all VMs to finish", sub { - $_->waitForShutdown foreach values %vms; - }); -} - - -# In interactive tests, this allows the non-interactive test script to -# be executed conveniently. -sub testScript { - eval "$context $ENV{testScript};\n"; - warn $@ if $@; -} - - -my $nrTests = 0; -my $nrSucceeded = 0; - - -sub subtest { - my ($name, $coderef) = @_; - $log->nest("subtest: $name", sub { - $nrTests++; - eval { &$coderef }; - if ($@) { - $log->log("error: $@", { error => 1 }); - } else { - $nrSucceeded++; - } - }); -} - - -sub runTests { - if (defined $ENV{tests}) { - $log->nest("running the VM test script", sub { - eval "$context $ENV{tests}"; - if ($@) { - $log->log("error: $@", { error => 1 }); - die $@; - } - }, { expanded => 1 }); - } else { - my $term = Term::ReadLine->new('nixos-vm-test'); - $term->ReadHistory; - while (defined ($_ = $term->readline("> "))) { - eval "$context $_\n"; - warn $@ if $@; - } - $term->WriteHistory; - } - - # Copy the kernel coverage data for each machine, if the kernel - # has been compiled with coverage instrumentation. - $log->nest("collecting coverage data", sub { - foreach my $vm (values %vms) { - my $gcovDir = "/sys/kernel/debug/gcov"; - - next unless $vm->isUp(); - - my ($status, $out) = $vm->execute("test -e $gcovDir"); - next if $status != 0; - - # Figure out where to put the *.gcda files so that the - # report generator can find the corresponding kernel - # sources. - my $kernelDir = $vm->mustSucceed("echo \$(dirname \$(readlink -f /run/current-system/kernel))/.build/linux-*"); - chomp $kernelDir; - my $coverageDir = "/tmp/xchg/coverage-data/$kernelDir"; - - # Copy all the *.gcda files. - $vm->execute("for d in $gcovDir/nix/store/*/.build/linux-*; do for i in \$(cd \$d && find -name '*.gcda'); do echo \$i; mkdir -p $coverageDir/\$(dirname \$i); cp -v \$d/\$i $coverageDir/\$i; done; done"); - } - }); - - $log->nest("syncing", sub { - foreach my $vm (values %vms) { - next unless $vm->isUp(); - $vm->execute("sync"); - } - }); - - if ($nrTests != 0) { - $log->log("$nrSucceeded out of $nrTests tests succeeded", - ($nrSucceeded < $nrTests ? { error => 1 } : { })); - } -} - - -# Create an empty raw virtual disk with the given name and size (in -# MiB). -sub createDisk { - my ($name, $size) = @_; - system("qemu-img create -f raw $name ${size}M") == 0 - or die "cannot create image of size $size"; -} - - -END { - $log->nest("cleaning up", sub { - foreach my $vm (values %vms) { - if ($vm->{pid}) { - $log->log("killing " . $vm->{name} . " (pid " . $vm->{pid} . ")"); - kill 9, $vm->{pid}; - } - } - }); - $log->close(); -} - -my $now1 = clock_gettime(CLOCK_MONOTONIC); - -runTests; - -my $now2 = clock_gettime(CLOCK_MONOTONIC); - -printf STDERR "test script finished in %.2fs\n", $now2 - $now1; - -exit ($nrSucceeded < $nrTests ? 1 : 0); diff --git a/nixpkgs/nixos/lib/test-driver/test-driver.py b/nixpkgs/nixos/lib/test-driver/test-driver.py index e7b05968b07..156392ad1e3 100644 --- a/nixpkgs/nixos/lib/test-driver/test-driver.py +++ b/nixpkgs/nixos/lib/test-driver/test-driver.py @@ -3,7 +3,10 @@ from contextlib import contextmanager, _GeneratorContextManager from queue import Queue, Empty from typing import Tuple, Any, Callable, Dict, Iterator, Optional, List from xml.sax.saxutils import XMLGenerator +import queue +import io import _thread +import argparse import atexit import base64 import codecs @@ -19,6 +22,7 @@ import subprocess import sys import tempfile import time +import traceback import unicodedata CHAR_TO_KEY = { @@ -213,7 +217,7 @@ class Machine: match = re.search("run-(.+)-vm$", cmd) if match: self.name = match.group(1) - + self.logger = args["log"] self.script = args.get("startCommand", self.create_startcommand(args)) tmp_dir = os.environ.get("TMPDIR", tempfile.gettempdir()) @@ -223,7 +227,10 @@ class Machine: os.makedirs(path, mode=0o700, exist_ok=True) return path - self.state_dir = create_dir("vm-state-{}".format(self.name)) + self.state_dir = os.path.join(tmp_dir, f"vm-state-{self.name}") + if not args.get("keepVmState", False): + self.cleanup_statedir() + os.makedirs(self.state_dir, mode=0o700, exist_ok=True) self.shared_dir = create_dir("shared-xchg") self.booted = False @@ -231,7 +238,6 @@ class Machine: self.pid: Optional[int] = None self.socket = None self.monitor: Optional[socket.socket] = None - self.logger: Logger = args["log"] self.allow_reboot = args.get("allowReboot", False) @staticmethod @@ -420,15 +426,18 @@ class Machine: output += out return output - def fail(self, *commands: str) -> None: + def fail(self, *commands: str) -> str: """Execute each command and check that it fails.""" + output = "" for command in commands: with self.nested("must fail: {}".format(command)): - status, output = self.execute(command) + (status, out) = self.execute(command) if status == 0: raise Exception( "command `{}` unexpectedly succeeded".format(command) ) + output += out + return output def wait_until_succeeds(self, command: str) -> str: """Wait until a command returns success and return its output. @@ -671,6 +680,22 @@ class Machine: with self.nested("waiting for {} to appear on screen".format(regex)): retry(screen_matches) + def wait_for_console_text(self, regex: str) -> None: + self.log("waiting for {} to appear on console".format(regex)) + # Buffer the console output, this is needed + # to match multiline regexes. + console = io.StringIO() + while True: + try: + console.write(self.last_lines.get()) + except queue.Empty: + self.sleep(1) + continue + console.seek(0) + matches = re.search(regex, console.read()) + if matches is not None: + return + def send_key(self, key: str) -> None: key = CHAR_TO_KEY.get(key, key) self.send_monitor_command("sendkey {}".format(key)) @@ -734,11 +759,16 @@ class Machine: self.monitor, _ = self.monitor_socket.accept() self.shell, _ = self.shell_socket.accept() + # Store last serial console lines for use + # of wait_for_console_text + self.last_lines: Queue = Queue() + def process_serial_output() -> None: assert self.process.stdout is not None for _line in self.process.stdout: # Ignore undecodable bytes that may occur in boot menus line = _line.decode(errors="ignore").replace("\r", "").rstrip() + self.last_lines.put(line) eprint("{} # {}".format(self.name, line)) self.logger.enqueue({"msg": line, "machine": self.name}) @@ -751,6 +781,12 @@ class Machine: self.log("QEMU running (pid {})".format(self.pid)) + def cleanup_statedir(self) -> None: + if os.path.isdir(self.state_dir): + shutil.rmtree(self.state_dir) + self.logger.log(f"deleting VM state directory {self.state_dir}") + self.logger.log("if you want to keep the VM state, pass --keep-vm-state") + def shutdown(self) -> None: if not self.booted: return @@ -807,7 +843,8 @@ class Machine: retry(window_is_visible) def sleep(self, secs: int) -> None: - time.sleep(secs) + # We want to sleep in *guest* time, not *host* time. + self.succeed(f"sleep {secs}") def forward_port(self, host_port: int = 8080, guest_port: int = 80) -> None: """Forward a TCP port on the host to a TCP port on the guest. @@ -863,7 +900,8 @@ def run_tests() -> None: try: exec(tests, globals()) except Exception as e: - eprint("error: {}".format(str(e))) + eprint("error: ") + traceback.print_exc() sys.exit(1) else: ptpython.repl.embed(locals(), globals()) @@ -889,6 +927,15 @@ def subtest(name: str) -> Iterator[None]: if __name__ == "__main__": + arg_parser = argparse.ArgumentParser() + arg_parser.add_argument( + "-K", + "--keep-vm-state", + help="re-use a VM state coming from a previous run", + action="store_true", + ) + (cli_args, vm_scripts) = arg_parser.parse_known_args() + log = Logger() vlan_nrs = list(dict.fromkeys(os.environ.get("VLANS", "").split())) @@ -896,8 +943,10 @@ if __name__ == "__main__": for nr, vde_socket, _, _ in vde_sockets: os.environ["QEMU_VDE_SOCKET_{}".format(nr)] = vde_socket - vm_scripts = sys.argv[1:] - machines = [create_machine({"startCommand": s}) for s in vm_scripts] + machines = [ + create_machine({"startCommand": s, "keepVmState": cli_args.keep_vm_state}) + for s in vm_scripts + ] machine_eval = [ "{0} = machines[{1}]".format(m.name, idx) for idx, m in enumerate(machines) ] @@ -911,7 +960,6 @@ if __name__ == "__main__": continue log.log("killing {} (pid {})".format(machine.name, machine.pid)) machine.process.kill() - for _, _, process, _ in vde_sockets: process.terminate() log.close() |