From 697b797160f8145f282767cedd66be2d7297fe1e Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Fri, 12 Aug 2022 08:53:46 -0400 Subject: marionette: Improve the error message of 'wait-for-screen-text'. * gnu/build/marionette.scm (wait-for-screen-text): Return the last OCR'd text when the predicate fails to match instead of the not useful predicate object. --- gnu/build/marionette.scm | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) (limited to 'gnu/build/marionette.scm') diff --git a/gnu/build/marionette.scm b/gnu/build/marionette.scm index 4f409166db..24170bbd30 100644 --- a/gnu/build/marionette.scm +++ b/gnu/build/marionette.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2016-2022 Ludovic Courtès ;;; Copyright © 2018 Chris Marusich +;;; Copyright © 2022 Maxim Cournoyer ;;; ;;; This file is part of GNU Guix. ;;; @@ -308,13 +309,14 @@ (define start (define end (+ start timeout)) - (let loop () + (let loop ((last-text #f)) (if (> (car (gettimeofday)) end) - (error "'wait-for-screen-text' timeout" predicate) - (or (predicate (marionette-screen-text marionette #:ocrad ocrad)) - (begin - (sleep 1) - (loop)))))) + (error "'wait-for-screen-text' timeout" 'ocr-text: last-text) + (let ((text (marionette-screen-text marionette #:ocrad ocrad))) + (or (predicate text) + (begin + (sleep 1) + (loop text))))))) (define %qwerty-us-keystrokes ;; Maps "special" characters to their keystrokes. -- cgit v1.2.3 From 42fee6d0f176aea5d208e3e6d8b5270abcf4173c Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Fri, 12 Aug 2022 11:23:29 -0400 Subject: 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 | 67 ++++++++++++++++++++++++++++-------------------- gnu/tests/base.scm | 4 +-- gnu/tests/install.scm | 8 +++--- 3 files changed, 45 insertions(+), 34 deletions(-) (limited to 'gnu/build/marionette.scm') diff --git a/gnu/build/marionette.scm b/gnu/build/marionette.scm index 24170bbd30..06b699bd7b 100644 --- a/gnu/build/marionette.scm +++ b/gnu/build/marionette.scm @@ -268,39 +268,50 @@ (define (marionette-control command marionette) ;; The "quit" command terminates QEMU immediately, with no output. (unless (string=? command "quit") (wait-for-monitor-prompt monitor))))) -(define* (marionette-screen-text marionette - #:key - (ocrad "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 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))) +(define* (invoke-ocrad-ocr image #:key (ocrad "ocrad")) + "Invoke the OCRAD command on image, and return the recognized text." + (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 () - (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)) + (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 image)))))) + (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 @@ (define end (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) diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm index 353d6d415a..636b127fb8 100644 --- a/gnu/tests/base.scm +++ b/gnu/tests/base.scm @@ -341,7 +341,7 @@ (define (user-owned? file) (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 @@ (define (entry->list entry) (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 diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm index fbb97d451c..4e0e274e66 100644 --- a/gnu/tests/install.scm +++ b/gnu/tests/install.scm @@ -784,7 +784,7 @@ (define (bios-boot-screen? text) ;; 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 @@ (define (bios-boot-screen? text) ;; 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 @@ (define (bios-boot-screen? text) ;; 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 @@ (define (passphrase-prompt? text) ;; 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) -- cgit v1.2.3