diff --git a/lib/build-vms.nix b/lib/build-vms.nix new file mode 100644 index 00000000000..7032489253b --- /dev/null +++ b/lib/build-vms.nix @@ -0,0 +1,180 @@ +{ nixos ? /etc/nixos/nixos +, nixpkgs ? /etc/nixos/nixpkgs +}: + +let pkgs = import nixpkgs { config = {}; }; in + +with pkgs; + +rec { + + inherit pkgs; + + + # Build a virtual network from an attribute set `{ machine1 = + # config1; ... machineN = configN; }', where `machineX' is the + # hostname and `configX' is a NixOS system configuration. The + # result is a script that starts a QEMU instance for each virtual + # machine. Each machine is given an arbitrary IP address in the + # virtual network. + buildVirtualNetwork = + { nodes }: + + let nodes_ = lib.mapAttrs (n: buildVM nodes_) (assignIPAddresses nodes); in + + stdenv.mkDerivation { + name = "vms"; + buildCommand = + '' + ensureDir $out/vms + ${ + lib.concatMapStrings (vm: + '' + ln -sn ${vm.config.system.build.vm} $out/vms/${vm.config.networking.hostName} + '' + ) (lib.attrValues nodes_) + } + + ensureDir $out/bin + cat > $out/bin/run-vms <> $TMPDIR/full.info + done + + ${pkgs.lcov}/bin/lcov --remove $TMPDIR/full.info "/nix/store/*" > $TMPDIR/out.info + + echo "making report..." + ensureDir $out/coverage + ${pkgs.lcov}/bin/genhtml --show-details $TMPDIR/out.info -o $out/coverage + ''; # */ + +} diff --git a/lib/test-driver/Machine.pm b/lib/test-driver/Machine.pm new file mode 100644 index 00000000000..b30cd501a8d --- /dev/null +++ b/lib/test-driver/Machine.pm @@ -0,0 +1,242 @@ +package Machine; + +use strict; +use Socket; +use IO::Handle; +use POSIX qw(dup2); + + +# Stuff our PID in the multicast address/port to prevent collissions +# with other NixOS VM networks. +my $mcastAddr = "232.18.1." . ($$ >> 8) . ":" . (64000 + ($$ & 0xff)); +print STDERR "using multicast address $mcastAddr\n"; + + +sub new { + my ($class, $vmScript) = @_; + + $vmScript =~ /run-(.*)-vm$/ or die; + my $name = $1; + + my $tmpDir = $ENV{'TMPDIR'} || "/tmp"; + + my $self = { + script => $vmScript, + name => $name, + booted => 0, + pid => 0, + connected => 0, + socket => undef, + stateDir => "$tmpDir/$name", + }; + + mkdir $self->{stateDir}, 0700; + + bless $self, $class; + return $self; +} + + +sub log { + my ($self, $msg) = @_; + chomp $msg; + print STDERR $self->{name}, ": $msg\n"; +} + + +sub name { + my ($self) = @_; + return $self->{name}; +} + + +sub start { + my ($self) = @_; + return if $self->{booted}; + + $self->log("starting vm"); + + my $pid = fork(); + die if $pid == -1; + + if ($pid == 0) { + my $name = $self->{name}; + open LOG, "| sed --unbuffered 's|^|$name console: |'" or die; + dup2(fileno(LOG), fileno(STDOUT)); + dup2(fileno(LOG), fileno(STDERR)); + $ENV{TMPDIR} = $self->{stateDir}; + $ENV{QEMU_OPTS} = "-nographic -redir tcp:65535::514 -net nic,vlan=1 -net socket,vlan=1,mcast=$mcastAddr"; + $ENV{QEMU_KERNEL_PARAMS} = "console=ttyS0 panic=1 hostTmpDir=$ENV{TMPDIR}"; + chdir $self->{stateDir} or die; + exec $self->{script}; + die; + } + + $self->log("vm running as pid $pid"); + $self->{pid} = $pid; + $self->{booted} = 1; +} + + +sub connect { + my ($self) = @_; + return if $self->{connected}; + + $self->start; + + while (1) { + last if -e ($self->{stateDir} . "/running"); + sleep 1; + } + + while (1) { + $self->log("trying to connect"); + my $socket = new IO::Handle; + $self->{socket} = $socket; + socket($socket, PF_UNIX, SOCK_STREAM, 0) or die; + connect($socket, sockaddr_un($self->{stateDir} . "/65535.socket")) or die; + $socket->autoflush(1); + print $socket "echo hello\n" or next; + flush $socket; + my $line = readline($socket); + chomp $line; + last if $line eq "hello"; + sleep 1; + } + + $self->log("connected"); + $self->{connected} = 1; + + print { $self->{socket} } "PATH=/var/run/current-system/sw/bin:/var/run/current-system/sw/sbin:\$PATH\n"; + print { $self->{socket} } "export GCOV_PREFIX=/tmp/coverage-data\n"; + print { $self->{socket} } "cd /tmp\n"; + # !!! Should make sure the commands above don't produce output, otherwise we're out of sync. +} + + +sub waitForShutdown { + my ($self) = @_; + return unless $self->{booted}; + + waitpid $self->{pid}, 0; + $self->{pid} = 0; + $self->{booted} = 0; +} + + +sub execute { + my ($self, $command) = @_; + + $self->connect; + + $self->log("running command: $command"); + + print { $self->{socket} } ("($command); echo '|!=EOF' \$?\n"); + + my $out = ""; + + while (1) { + my $line = readline($self->{socket}) or die "connection to VM lost unexpectedly"; + #$self->log("got line: $line"); + if ($line =~ /^(.*)\|\!\=EOF\s+(\d+)$/) { + $out .= $1; + $self->log("exit status $2"); + return ($2, $out); + } + $out .= $line; + } +} + + +sub mustSucceed { + my ($self, $command) = @_; + my ($status, $out) = $self->execute($command); + if ($status != 0) { + $self->log("output: $out"); + die "command `$command' did not succeed (exit code $status)"; + } + return $out; +} + + +sub mustFail { + my ($self, $command) = @_; + my ($status, $out) = $self->execute($command); + die "command `$command' unexpectedly succeeded" + if $status == 0; +} + + +# Wait for an Upstart job to reach the "running" state. +sub waitForJob { + my ($self, $jobName) = @_; + while (1) { + my ($status, $out) = $self->execute("initctl status $jobName"); + return if $out =~ /\(start\)\s+running/; + sleep 1; + # !!! need a timeout + } +} + + +sub stopJob { + my ($self, $jobName) = @_; + $self->execute("initctl stop $jobName"); + while (1) { + my ($status, $out) = $self->execute("initctl status $jobName"); + return if $out =~ /\(stop\)\s+waiting/; + sleep 1; + # !!! need a timeout + } +} + + +# Wait until the machine is listening on the given TCP port. +sub waitForOpenPort { + my ($self, $port) = @_; + while (1) { + my ($status, $out) = $self->execute("nc -z localhost $port"); + return if $status == 0; + sleep 1; + } +} + + +# Wait until the machine is not listening on the given TCP port. +sub waitForClosedPort { + my ($self, $port) = @_; + while (1) { + my ($status, $out) = $self->execute("nc -z localhost $port"); + return if $status != 0; + sleep 1; + } +} + + +sub shutdown { + my ($self) = @_; + return unless $self->{booted}; + + $self->execute("poweroff -f &"); + + $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->mustSucceed("ifconfig eth1 down"); +} + + +# Make the machine reachable. +sub unblock { + my ($self) = @_; + $self->mustSucceed("ifconfig eth1 up"); +} + + +1; diff --git a/lib/test-driver/test-driver.pl b/lib/test-driver/test-driver.pl new file mode 100644 index 00000000000..f76d01199a5 --- /dev/null +++ b/lib/test-driver/test-driver.pl @@ -0,0 +1,41 @@ +use strict; +use Machine; + +$SIG{PIPE} = 'IGNORE'; # because Unix domain sockets may die unexpectedly + +my %vms; +my $context = ""; + + +foreach my $vmScript (@ARGV) { + my $vm = Machine->new($vmScript); + $vms{$vm->name} = $vm; + $context .= "my \$" . $vm->name . " = \$vms{'" . $vm->name . "'}; "; +} + + +sub startAll { + $_->start foreach values %vms; +} + + +sub runTests { + eval "$context $ENV{tests}"; + die $@ if $@; +} + + +END { + foreach my $vm (values %vms) { + if ($vm->{pid}) { + print STDERR "killing ", $vm->{name}, " (pid ", $vm->{pid}, ")\n"; + kill 9, $vm->{pid}; + } + } +} + + +runTests; + + +print STDERR "DONE\n"; diff --git a/tests/subversion.nix b/tests/subversion.nix new file mode 100644 index 00000000000..024d1fc3651 --- /dev/null +++ b/tests/subversion.nix @@ -0,0 +1,112 @@ +with import ../lib/build-vms.nix {}; + +let + + # Build some packages with coverage instrumentation. + overrides = pkgs: + let + do = pkg: pkg.override (args: { + stdenv = pkgs.addCoverageInstrumentation args.stdenv; + }); + in + rec { + apr = do pkgs.apr; + aprutil = do pkgs.aprutil; + apacheHttpd = do pkgs.apacheHttpd; + mod_python = do pkgs.mod_python; + subversion = do pkgs.subversion; + }; + +in + +rec { + + nodes = + { webserver = + { config, pkgs, ... }: + + { + services.httpd.enable = true; + services.httpd.adminAddr = "e.dolstra@tudelft.nl"; + services.httpd.extraSubservices = + [ { serviceType = "subversion"; + urlPrefix = ""; + dataDir = "/data/subversion"; + userCreationDomain = "192.168.0.0/16"; + } + ]; + nixpkgs.config.packageOverrides = overrides; + }; + + client = + { config, pkgs, ... }: + + { + environment.systemPackages = [ pkgs.subversion ]; + nixpkgs.config.packageOverrides = overrides; + }; + + }; + + vms = buildVirtualNetwork { inherit nodes; }; + + test = runTests vms + '' + startAll; + + $webserver->waitForOpenPort(80); + + my $out = $client->mustSucceed("svn --version"); + print STDERR "GOT: $out"; + + my $out = $client->mustSucceed("curl --fail http://webserver/"); + print STDERR "GOT: $out"; + + # Create a new user through the web interface. + $client->mustSucceed("curl --fail -F username=alice -F fullname='Alice Lastname' -F address=alice\@example.org -F password=foobar -F password_again=foobar http://webserver/repoman/adduser"); + + # Let Alice create a new repository. + $client->mustSucceed("curl --fail -u alice:foobar --form repo=xyzzy --form description=Xyzzy http://webserver/repoman/create"); + + $client->mustSucceed("curl --fail http://webserver/") =~ /alice/ or die; + + # Let Alice do a checkout. + my $svnFlags = "--non-interactive --username alice --password foobar"; + $client->mustSucceed("svn co $svnFlags http://webserver/repos/xyzzy wc"); + $client->mustSucceed("echo hello > wc/world"); + $client->mustSucceed("svn add wc/world"); + $client->mustSucceed("svn ci $svnFlags -m 'Added world.' wc/world"); + + # Create a new user on the server through the create-user.pl script. + $webserver->execute("svn-server-create-user.pl bob bob\@example.org Bob"); + $webserver->mustSucceed("svn-server-resetpw.pl bob fnord"); + $client->mustSucceed("curl --fail http://webserver/") =~ /bob/ or die; + + # Bob should not have access to the repo. + my $svnFlagsBob = "--non-interactive --username bob --password fnord"; + $client->mustFail("svn co $svnFlagsBob http://webserver/repos/xyzzy wc2"); + + # Bob should not be able change the ACLs of the repo. + # !!! Repoman should really return a 403 here. + $client->execute("curl --fail -u bob:fnord -F description=Xyzzy -F readers=alice,bob -F writers=alice -F watchers= -F tardirs= http://webserver/repoman/update/xyzzy") + =~ /not authorised/ or die; + + # Give Bob access. + $client->mustSucceed("curl --fail -u alice:foobar -F description=Xyzzy -F readers=alice,bob -F writers=alice -F watchers= -F tardirs= http://webserver/repoman/update/xyzzy"); + + # So now his checkout should succeed. + $client->mustSucceed("svn co $svnFlagsBob http://webserver/repos/xyzzy wc2"); + + # Test ViewVC and WebSVN + $client->mustSucceed("curl --fail -u alice:foobar http://webserver/viewvc/xyzzy"); + $client->mustSucceed("curl --fail -u alice:foobar http://webserver/websvn/xyzzy"); + $client->mustSucceed("curl --fail -u alice:foobar http://webserver/repos-xml/xyzzy"); + + # Stop Apache to gather all the coverage data. + $webserver->stopJob("httpd"); + $webserver->execute("sleep 5"); # !!! + ''; + + report = makeReport test; + +}