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 bbb655eed2a6..6224be0ca1a5 100644
--- a/nixos/doc/manual/development/writing-nixos-tests.xml
+++ b/nixos/doc/manual/development/writing-nixos-tests.xml
@@ -155,6 +155,13 @@ startAll;
   </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
     used, but allows doing stuff such as attaching virtual USB disks
diff --git a/nixos/lib/test-driver/Machine.pm b/nixos/lib/test-driver/Machine.pm
index e0791692d3ef..0dddc1dc14b1 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 c14f15a1ad5d..431e3de6a8ce 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"
       '';
   };