me
/
guix
Archived
1
0
Fork 0
Code

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.
master
Maxim Cournoyer 2022-08-12 11:23:29 -04:00
parent 697b797160
commit 42fee6d0f1
No known key found for this signature in database
GPG Key ID: 1260E46482E63562
3 changed files with 44 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

65
gnu/build/marionette.scm
View File

@ -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
#: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"))
(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))
(let ((image (random-file-name)))
(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 @@ 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)

4
gnu/tests/base.scm
View File

@ -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

8
gnu/tests/install.scm
View File

@ -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)