From 235c2228ca9f608f898bc455c9b5bb1e3c4cb3f0 Mon Sep 17 00:00:00 2001
From: aszlig <aszlig@redmoonstudios.org>
Date: Thu, 21 May 2015 19:06:09 +0200
Subject: [PATCH] nixos/test-driver: Add new getScreenText function.

Basically, this creates a screenshot and throws tesseract at it to
recognize the characters from the screenshot. In order to produce a
result that is well enough, we're using lanczos scaling and scale the
image up to 400% of its original size.

This provides the base functionality for a new Machine method which will
be called waitForText. I originally had that idea long ago when writing
the VM tests for VirtualBox and Chromium, but thought it would be
disproportionate to the case.

The downside however is that VM tests now depend on tesseract, but given
the average runtime of our tests it really shouldn't have a too big
impact and it's only a runtime dependency after all.

Another issue is that the OCR process takes quite some time to finish,
but IMHO it's better (as in more deterministic) than to rely on sleep().

Signed-off-by: aszlig <aszlig@redmoonstudios.org>
---
 .../development/writing-nixos-tests.xml       |  7 ++++++
 nixos/lib/test-driver/Machine.pm              | 25 +++++++++++++++++++
 nixos/lib/testing.nix                         |  4 +--
 3 files changed, 34 insertions(+), 2 deletions(-)

diff --git a/nixos/doc/manual/development/writing-nixos-tests.xml b/nixos/doc/manual/development/writing-nixos-tests.xml
index bbb655eed2a..6224be0ca1a 100644
--- a/nixos/doc/manual/development/writing-nixos-tests.xml
+++ b/nixos/doc/manual/development/writing-nixos-tests.xml
@@ -154,6 +154,13 @@ startAll;
     log.</para></listitem>
   </varlistentry>
 
+  <varlistentry>
+    <term><methodname>getScreenText</methodname></term>
+    <listitem><para>Return a textual representation of what is currently
+    visible on the machine's screen using optical character
+    recognition.</para></listitem>
+  </varlistentry>
+
   <varlistentry>
     <term><methodname>sendMonitorCommand</methodname></term>
     <listitem><para>Send a command to the QEMU monitor. This is rarely
diff --git a/nixos/lib/test-driver/Machine.pm b/nixos/lib/test-driver/Machine.pm
index e0791692d3e..0dddc1dc14b 100644
--- a/nixos/lib/test-driver/Machine.pm
+++ b/nixos/lib/test-driver/Machine.pm
@@ -9,6 +9,7 @@ use FileHandle;
 use Cwd;
 use File::Basename;
 use File::Path qw(make_path);
+use File::Slurp;
 
 
 my $showGraphics = defined $ENV{'DISPLAY'};
@@ -493,6 +494,30 @@ sub screenshot {
 }
 
 
+# Take a screenshot and return the result as text using optical character
+# recognition.
+sub getScreenText {
+    my ($self) = @_;
+
+    my $text;
+    $self->nest("performing optical character recognition", sub {
+        my $tmpbase = Cwd::abs_path(".")."/ocr";
+        my $tmpin = $tmpbase."in.ppm";
+        my $tmpout = "$tmpbase.ppm";
+
+        $self->sendMonitorCommand("screendump $tmpin");
+        system("ppmtopgm $tmpin | pamscale 4 -filter=lanczos > $tmpout") == 0
+            or die "cannot scale screenshot";
+        unlink $tmpin;
+        system("tesseract $tmpout $tmpbase") == 0 or die "OCR failed";
+        unlink $tmpout;
+        $text = read_file("$tmpbase.txt");
+        unlink "$tmpbase.txt";
+    });
+    return $text;
+}
+
+
 # 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 {
diff --git a/nixos/lib/testing.nix b/nixos/lib/testing.nix
index c14f15a1ad5..431e3de6a8c 100644
--- a/nixos/lib/testing.nix
+++ b/nixos/lib/testing.nix
@@ -27,8 +27,8 @@ rec {
         cp ${./test-driver/Logger.pm} $libDir/Logger.pm
 
         wrapProgram $out/bin/nixos-test-driver \
-          --prefix PATH : "${qemu_kvm}/bin:${vde2}/bin:${netpbm}/bin:${coreutils}/bin" \
-          --prefix PERL5LIB : "${lib.makePerlPath [ perlPackages.TermReadLineGnu perlPackages.XMLWriter perlPackages.IOTty ]}:$out/lib/perl5/site_perl"
+          --prefix PATH : "${qemu_kvm}/bin:${vde2}/bin:${netpbm}/bin:${coreutils}/bin:${tesseract}/bin" \
+          --prefix PERL5LIB : "${with perlPackages; lib.makePerlPath [ TermReadLineGnu XMLWriter IOTty FileSlurp ]}:$out/lib/perl5/site_perl"
       '';
   };