build: marionette: Add support for Tesseract OCR.

* gnu/build/marionette.scm (invoke-ocrad-ocr): New procedure.
(invoke-tesseract-ocr): Likewise.
(marionette-screen-text): Rename the #:ocrad argument to #:ocr.  Dispatch the
matching OCR invocation procedure.
(wait-for-screen-text): Rename the #:ocrad argument to #:ocr.
* gnu/tests/base.scm (run-basic-test): Adjust accordingly.
* gnu/tests/install.scm (enter-luks-passphrase): Likewise.
(enter-luks-passphrase-for-home): Likewise.

gnu/build/marionette.scm

@@ -268,39 +268,50 @@ Monitor\")."
      ;; The "quit" command terminates QEMU immediately, with no output.
      (unless (string=? command "quit") (wait-for-monitor-prompt monitor)))))
 
-(define* (marionette-screen-text marionette
+(define* (invoke-ocrad-ocr image #:key (ocrad "ocrad"))
-                                 #:key
+  "Invoke the OCRAD command on image, and return the recognized text."
-                                 (ocrad "ocrad"))
+  (let* ((pipe (open-pipe* OPEN_READ ocrad "-i" "-s" "10" image))
-  "Take a screenshot of MARIONETTE, perform optical character
-recognition (OCR), and return the text read from the screen as a string.  Do
-this by invoking OCRAD (file name for GNU Ocrad's command)"
-  (define (random-file-name)
-    (string-append "/tmp/marionette-screenshot-"
-                   (number->string (random (expt 2 32)) 16)
-                   ".ppm"))
-
-  (let ((image (random-file-name)))
-    (dynamic-wind
-      (const #t)
-      (lambda ()
-        (marionette-control (string-append "screendump " image)
-                            marionette)
-
-        ;; Tell Ocrad to invert the image colors (make it black on white) and
-        ;; to scale the image up, which significantly improves the quality of
-        ;; the result.  In spite of this, be aware that OCR confuses "y" and
-        ;; "V" and sometimes erroneously introduces white space.
-        (let* ((pipe (open-pipe* OPEN_READ ocrad
-                                 "-i" "-s" "10" image))
          (text (get-string-all pipe)))
     (unless (zero? (close-pipe pipe))
       (error "'ocrad' failed" ocrad))
     text))
+
+(define* (invoke-tesseract-ocr image #:key (tesseract "tesseract"))
+  "Invoke the TESSERACT command on IMAGE, and return the recognized text."
+  (let* ((output-basename (tmpnam))
+         (output-basename* (string-append output-basename ".txt")))
+    (dynamic-wind
+      (const #t)
       (lambda ()
-        (false-if-exception (delete-file image))))))
+        (let ((exit-val (status:exit-val
+                         (system* tesseract image output-basename))))
+          (unless (zero? exit-val)
+            (error "'tesseract' failed" tesseract))
+          (call-with-input-file output-basename* get-string-all)))
+      (lambda ()
+        (false-if-exception (delete-file output-basename))
+        (false-if-exception (delete-file output-basename*))))))
+
+(define* (marionette-screen-text marionette #:key (ocr "ocrad"))
+  "Take a screenshot of MARIONETTE, perform optical character
+recognition (OCR), and return the text read from the screen as a string.  Do
+this by invoking OCR, which should be the file name of GNU Ocrad's
+@command{ocrad} or Tesseract OCR's @command{tesseract} command."
+  (define image (string-append (tmpnam) ".ppm"))
+  ;; Use the QEMU Monitor to save an image of the screen to the host.
+  (marionette-control (string-append "screendump " image) marionette)
+  ;; Process it via the OCR.
+  (cond
+   ((string-contains ocr "ocrad")
+    (invoke-ocrad-ocr image #:ocrad ocr))
+   ((string-contains ocr "tesseract")
+    (invoke-tesseract-ocr image #:tesseract ocr))
+   (else (error "unsupported ocr command"))))
 
 (define* (wait-for-screen-text marionette predicate
-                               #:key (timeout 30) (ocrad "ocrad"))
+                               #:key
+                               (ocr "ocrad")
+                               (timeout 30))
   "Wait for TIMEOUT seconds or until the screen text on MARIONETTE matches
 PREDICATE, whichever comes first.  Raise an error when TIMEOUT is exceeded."
   (define start
@@ -312,7 +323,7 @@ PREDICATE, whichever comes first.  Raise an error when TIMEOUT is exceeded."
   (let loop ((last-text #f))
     (if (> (car (gettimeofday)) end)
         (error "'wait-for-screen-text' timeout" 'ocr-text: last-text)
-        (let ((text (marionette-screen-text marionette #:ocrad ocrad)))
+        (let ((text (marionette-screen-text marionette #:ocr ocr)))
           (or (predicate text)
               (begin
                 (sleep 1)

gnu/tests/base.scm

@@ -341,7 +341,7 @@ info --version")
                       (wait-for-screen-text marionette
                                             (lambda (text)
                                               (string-contains text "Password"))
-                                            #:ocrad
+                                            #:ocr
                                             #$(file-append ocrad "/bin/ocrad"))
                       (marionette-type (string-append password "\n\n")
                                        marionette))
@@ -510,7 +510,7 @@ info --version")
 
           (test-assert "screen text"
             (let ((text (marionette-screen-text marionette
-                                                #:ocrad
+                                                #:ocr
                                                 #$(file-append ocrad
                                                                "/bin/ocrad"))))
               ;; Check whether the welcome message and shell prompt are

gnu/tests/install.scm

@@ -784,7 +784,7 @@ to enter the LUKS passphrase."
             ;; At this point we have no choice but to use OCR to determine
             ;; when the passphrase should be entered.
             (wait-for-screen-text #$marionette passphrase-prompt?
-                                  #:ocrad #$ocrad)
+                                  #:ocr #$ocrad)
             (marionette-type #$(string-append %luks-passphrase "\n")
                              #$marionette)
 
@@ -792,7 +792,7 @@ to enter the LUKS passphrase."
             ;; we can then be sure we match the "Enter passphrase" prompt from
             ;; 'cryptsetup', in the initrd.
             (wait-for-screen-text #$marionette (negate bios-boot-screen?)
-                                  #:ocrad #$ocrad
+                                  #:ocr #$ocrad
                                   #:timeout 20)))
 
         (test-assert "enter LUKS passphrase for the initrd"
@@ -800,7 +800,7 @@ to enter the LUKS passphrase."
             ;; XXX: Here we use OCR as well but we could instead use QEMU
             ;; '-serial stdio' and run it in an input pipe,
             (wait-for-screen-text #$marionette passphrase-prompt?
-                                  #:ocrad #$ocrad
+                                  #:ocr #$ocrad
                                   #:timeout 60)
             (marionette-type #$(string-append %luks-passphrase "\n")
                              #$marionette)
@@ -999,7 +999,7 @@ launched as a shepherd service."
             ;; XXX: Here we use OCR as well but we could instead use QEMU
             ;; '-serial stdio' and run it in an input pipe,
             (wait-for-screen-text #$marionette passphrase-prompt?
-                                  #:ocrad #$ocrad
+                                  #:ocr #$ocrad
                                   #:timeout 120)
             (marionette-type #$(string-append %luks-passphrase "\n")
                              #$marionette)