From: Maxim Cournoyer <maxim.cournoyer@gmail.com>
To: 57168@debbugs.gnu.org
Cc: Maxim Cournoyer <maxim.cournoyer@gmail.com>
Subject: [bug#57168] [PATCH 13/14] build: marionette: Add support for Tesseract OCR.
Date: Sat, 13 Aug 2022 02:54:32 -0400 [thread overview]
Message-ID: <20220813065433.27319-13-maxim.cournoyer@gmail.com> (raw)
In-Reply-To: <20220813065433.27319-1-maxim.cournoyer@gmail.com>
* 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(-)
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)
--
2.36.1
next prev parent reply other threads:[~2022-08-13 6:57 UTC|newest]
Thread overview: 18+ messages / expand[flat|nested] mbox.gz Atom feed top
2022-08-13 6:50 [bug#57168] [PATCH 00/14] Add a LightDM service Maxim Cournoyer
2022-08-13 6:54 ` [bug#57168] [PATCH 01/14] services: configuration: Add a 'maybe-value-set?' procedure Maxim Cournoyer
2022-08-13 6:54 ` [bug#57168] [PATCH 02/14] gnu: accountsservice: Update to 22.08.8, enable doc and test suite Maxim Cournoyer
2022-08-13 6:54 ` [bug#57168] [PATCH 03/14] gnu: accountsservice: Provide a means to locate extensions Maxim Cournoyer
2022-08-13 6:54 ` [bug#57168] [PATCH 04/14] gnu: lightdm-gtk-greeter: Add GDK_PIXBUF_MODULE_FILE to wrapper Maxim Cournoyer
2022-08-13 6:54 ` [bug#57168] [PATCH 05/14] gnu: lightdm-gtk-greeter: Use the glib-or-gtk-wrap phase as-is Maxim Cournoyer
2022-08-13 6:54 ` [bug#57168] [PATCH 06/14] gnu: lightdm-gtk-greeter: Enable libklavier support Maxim Cournoyer
2022-08-13 6:54 ` [bug#57168] [PATCH 07/14] gnu: lightdm-gtk-greeter: Adjust default config file path Maxim Cournoyer
2022-08-13 6:54 ` [bug#57168] [PATCH 08/14] gnu: lightdm-gtk-greeter: Adjust --enable-at-spi-command value Maxim Cournoyer
2022-08-13 6:54 ` [bug#57168] [PATCH 09/14] gnu: lightdm: Apply patch to fix a problem with VNC integration Maxim Cournoyer
2022-08-13 6:54 ` [bug#57168] [PATCH 10/14] gnu: lightdm: Apply patch to allow using VNC options Maxim Cournoyer
2022-08-13 6:54 ` [bug#57168] [PATCH 11/14] gnu: lightdm: Apply patch to fix color depth issue with VNC Maxim Cournoyer
2022-08-13 6:54 ` [bug#57168] [PATCH 12/14] marionette: Improve the error message of 'wait-for-screen-text' Maxim Cournoyer
2022-08-13 6:54 ` Maxim Cournoyer [this message]
2022-08-13 6:54 ` [bug#57168] [PATCH 14/14] services: Add lightdm-service-type Maxim Cournoyer
2022-08-26 16:54 ` Maxime Devos
2022-08-29 2:33 ` bug#57168: [PATCH 00/14] Add a LightDM service Maxim Cournoyer
2022-08-30 19:44 ` [bug#57168] " Maxime Devos
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://guix.gnu.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20220813065433.27319-13-maxim.cournoyer@gmail.com \
--to=maxim.cournoyer@gmail.com \
--cc=57168@debbugs.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).