diff --git a/nixos/doc/manual/release-notes/rl-2009.xml b/nixos/doc/manual/release-notes/rl-2009.xml
index 166aec25512b..b0cdce07a038 100644
--- a/nixos/doc/manual/release-notes/rl-2009.xml
+++ b/nixos/doc/manual/release-notes/rl-2009.xml
@@ -204,6 +204,16 @@ GRANT ALL PRIVILEGES ON *.* TO 'mysql'@'localhost' WITH GRANT OPTION;
Note: Password support is only avaiable in GRUB version 2.
+
+
+ Following its deprecation in 20.03, the Perl NixOS test driver has been removed.
+ All remaining tests have been ported to the Python test framework.
+ Code outside nixpkgs using make-test.nix or
+ testing.nix needs to be ported to
+ make-test-python.nix and
+ testing-python.nix respectively.
+
+
diff --git a/nixos/lib/test-driver/Logger.pm b/nixos/lib/test-driver/Logger.pm
deleted file mode 100644
index a3384084a0ef..000000000000
--- a/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/nixos/lib/test-driver/Machine.pm b/nixos/lib/test-driver/Machine.pm
deleted file mode 100644
index 4d3d63cd2dbf..000000000000
--- a/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, "{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
-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'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
-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/nixos/lib/test-driver/test-driver.pl b/nixos/lib/test-driver/test-driver.pl
deleted file mode 100644
index a3354fb0e1eb..000000000000
--- a/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/nixos/lib/testing.nix b/nixos/lib/testing.nix
deleted file mode 100644
index 5c784c2f0abe..000000000000
--- a/nixos/lib/testing.nix
+++ /dev/null
@@ -1,258 +0,0 @@
-{ system
-, pkgs ? import ../.. { inherit system config; }
- # Use a minimal kernel?
-, minimal ? false
- # Ignored
-, config ? {}
- # Modules to add to each VM
-, extraConfigurations ? [] }:
-
-with import ./build-vms.nix { inherit system pkgs minimal extraConfigurations; };
-with pkgs;
-
-rec {
-
- inherit pkgs;
-
-
- testDriver = lib.warn ''
- Perl VM tests are deprecated and will be removed for 20.09.
- Please update your tests to use the python test driver.
- See https://github.com/NixOS/nixpkgs/pull/71684 for details.
- '' stdenv.mkDerivation {
- name = "nixos-test-driver";
-
- buildInputs = [ makeWrapper perl ];
-
- dontUnpack = true;
-
- preferLocalBuild = true;
-
- installPhase =
- ''
- mkdir -p $out/bin
- cp ${./test-driver/test-driver.pl} $out/bin/nixos-test-driver
- chmod u+x $out/bin/nixos-test-driver
-
- libDir=$out/${perl.libPrefix}
- mkdir -p $libDir
- cp ${./test-driver/Machine.pm} $libDir/Machine.pm
- cp ${./test-driver/Logger.pm} $libDir/Logger.pm
-
- wrapProgram $out/bin/nixos-test-driver \
- --prefix PATH : "${lib.makeBinPath [ qemu_test vde2 netpbm coreutils ]}" \
- --prefix PERL5LIB : "${with perlPackages; makePerlPath [ TermReadLineGnu XMLWriter IOTty FileSlurp ]}:$out/${perl.libPrefix}"
- '';
- };
-
-
- # Run an automated test suite in the given virtual network.
- # `driver' is the script that runs the network.
- runTests = driver:
- stdenv.mkDerivation {
- name = "vm-test-run-${driver.testName}";
-
- requiredSystemFeatures = [ "kvm" "nixos-test" ];
-
- buildCommand =
- ''
- mkdir -p $out
-
- LOGFILE=/dev/null tests='eval $ENV{testScript}; die $@ if $@;' ${driver}/bin/nixos-test-driver
-
- for i in */xchg/coverage-data; do
- mkdir -p $out/coverage-data
- mv $i $out/coverage-data/$(dirname $(dirname $i))
- done
- '';
- };
-
-
- makeTest =
- { testScript
- , makeCoverageReport ? false
- , enableOCR ? false
- , name ? "unnamed"
- , ...
- } @ t:
-
- let
- # A standard store path to the vm monitor is built like this:
- # /tmp/nix-build-vm-test-run-$name.drv-0/vm-state-machine/monitor
- # The max filename length of a unix domain socket is 108 bytes.
- # This means $name can at most be 50 bytes long.
- maxTestNameLen = 50;
- testNameLen = builtins.stringLength name;
-
- testDriverName = with builtins;
- if testNameLen > maxTestNameLen then
- abort ("The name of the test '${name}' must not be longer than ${toString maxTestNameLen} " +
- "it's currently ${toString testNameLen} characters long.")
- else
- "nixos-test-driver-${name}";
-
- nodes = buildVirtualNetwork (
- t.nodes or (if t ? machine then { machine = t.machine; } else { }));
-
- testScript' =
- # Call the test script with the computed nodes.
- if lib.isFunction testScript
- then testScript { inherit nodes; }
- else testScript;
-
- vlans = map (m: m.config.virtualisation.vlans) (lib.attrValues nodes);
-
- vms = map (m: m.config.system.build.vm) (lib.attrValues nodes);
-
- ocrProg = tesseract4.override { enableLanguages = [ "eng" ]; };
-
- imagemagick_tiff = imagemagick_light.override { inherit libtiff; };
-
- # Generate onvenience wrappers for running the test driver
- # interactively with the specified network, and for starting the
- # VMs from the command line.
- driver = runCommand testDriverName
- { buildInputs = [ makeWrapper];
- testScript = testScript';
- preferLocalBuild = true;
- testName = name;
- }
- ''
- mkdir -p $out/bin
- echo "$testScript" > $out/test-script
- ln -s ${testDriver}/bin/nixos-test-driver $out/bin/
- vms=($(for i in ${toString vms}; do echo $i/bin/run-*-vm; done))
- wrapProgram $out/bin/nixos-test-driver \
- --add-flags "''${vms[*]}" \
- ${lib.optionalString enableOCR
- "--prefix PATH : '${ocrProg}/bin:${imagemagick_tiff}/bin'"} \
- --run "export testScript=\"\$(cat $out/test-script)\"" \
- --set VLANS '${toString vlans}'
- ln -s ${testDriver}/bin/nixos-test-driver $out/bin/nixos-run-vms
- wrapProgram $out/bin/nixos-run-vms \
- --add-flags "''${vms[*]}" \
- ${lib.optionalString enableOCR "--prefix PATH : '${ocrProg}/bin'"} \
- --set tests 'startAll; joinAll;' \
- --set VLANS '${toString vlans}' \
- ${lib.optionalString (builtins.length vms == 1) "--set USE_SERIAL 1"}
- ''; # "
-
- passMeta = drv: drv // lib.optionalAttrs (t ? meta) {
- meta = (drv.meta or {}) // t.meta;
- };
-
- test = passMeta (runTests driver);
- report = passMeta (releaseTools.gcovReport { coverageRuns = [ test ]; });
-
- nodeNames = builtins.attrNames nodes;
- invalidNodeNames = lib.filter
- (node: builtins.match "^[A-z_][A-z0-9_]+$" node == null) nodeNames;
-
- in
- if lib.length invalidNodeNames > 0 then
- throw ''
- Cannot create machines out of (${lib.concatStringsSep ", " invalidNodeNames})!
- All machines are referenced as perl variables in the testing framework which will break the
- script when special characters are used.
-
- Please stick to alphanumeric chars and underscores as separation.
- ''
- else
- (if makeCoverageReport then report else test) // {
- inherit nodes driver test;
- };
-
- runInMachine =
- { drv
- , machine
- , preBuild ? ""
- , postBuild ? ""
- , ... # ???
- }:
- let
- vm = buildVM { }
- [ machine
- { key = "run-in-machine";
- networking.hostName = "client";
- nix.readOnlyStore = false;
- virtualisation.writableStore = false;
- }
- ];
-
- buildrunner = writeText "vm-build" ''
- source $1
-
- ${coreutils}/bin/mkdir -p $TMPDIR
- cd $TMPDIR
-
- exec $origBuilder $origArgs
- '';
-
- testScript = ''
- startAll;
- $client->waitForUnit("multi-user.target");
- ${preBuild}
- $client->succeed("env -i ${bash}/bin/bash ${buildrunner} /tmp/xchg/saved-env >&2");
- ${postBuild}
- $client->succeed("sync"); # flush all data before pulling the plug
- '';
-
- vmRunCommand = writeText "vm-run" ''
- xchg=vm-state-client/xchg
- ${coreutils}/bin/mkdir $out
- ${coreutils}/bin/mkdir -p $xchg
-
- for i in $passAsFile; do
- i2=''${i}Path
- _basename=$(${coreutils}/bin/basename ''${!i2})
- ${coreutils}/bin/cp ''${!i2} $xchg/$_basename
- eval $i2=/tmp/xchg/$_basename
- ${coreutils}/bin/ls -la $xchg
- done
-
- unset i i2 _basename
- export | ${gnugrep}/bin/grep -v '^xchg=' > $xchg/saved-env
- unset xchg
-
- export tests='${testScript}'
- ${testDriver}/bin/nixos-test-driver ${vm.config.system.build.vm}/bin/run-*-vm
- ''; # */
-
- in
- lib.overrideDerivation drv (attrs: {
- requiredSystemFeatures = [ "kvm" ];
- builder = "${bash}/bin/sh";
- args = ["-e" vmRunCommand];
- origArgs = attrs.args;
- origBuilder = attrs.builder;
- });
-
-
- runInMachineWithX = { require ? [], ... } @ args:
- let
- client =
- { ... }:
- {
- inherit require;
- imports = [
- ../tests/common/auto.nix
- ];
- virtualisation.memorySize = 1024;
- services.xserver.enable = true;
- test-support.displayManager.auto.enable = true;
- services.xserver.displayManager.defaultSession = "none+icewm";
- services.xserver.windowManager.icewm.enable = true;
- };
- in
- runInMachine ({
- machine = client;
- preBuild =
- ''
- $client->waitForX;
- '';
- } // args);
-
-
- simpleTest = as: (makeTest as).test;
-
-}
diff --git a/nixos/tests/make-test.nix b/nixos/tests/make-test.nix
deleted file mode 100644
index cee5da93454a..000000000000
--- a/nixos/tests/make-test.nix
+++ /dev/null
@@ -1,9 +0,0 @@
-f: {
- system ? builtins.currentSystem,
- pkgs ? import ../.. { inherit system; config = {}; },
- ...
-} @ args:
-
-with import ../lib/testing.nix { inherit system pkgs; };
-
-makeTest (if pkgs.lib.isFunction f then f (args // { inherit pkgs; inherit (pkgs) lib; }) else f)