diff options
Diffstat (limited to 'gnu/build')
| -rw-r--r-- | gnu/build/hurd-boot.scm | 37 | ||||
| -rw-r--r-- | gnu/build/marionette.scm | 41 |
2 files changed, 64 insertions, 14 deletions
diff --git a/gnu/build/hurd-boot.scm b/gnu/build/hurd-boot.scm index 95c15907dd..19bdbdf6ae 100644 --- a/gnu/build/hurd-boot.scm +++ b/gnu/build/hurd-boot.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2020-2022 Ludovic Courtès <ludo@gnu.org> -;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org> +;;; Copyright © 2020, 2023 Janneke Nieuwenhuizen <janneke@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -105,7 +105,7 @@ Return the value associated with OPTION, or #f on failure." ;; TODO: Set the 'gnu.translator' extended attribute for passive translator ;; settings? - ) + (mkdir-p (scope "servers/bus/pci"))) (define (passive-translator-xattr? file-name) "Return true if FILE-NAME has an extended @code{gnu.translator} attribute @@ -183,7 +183,8 @@ set." (mkdir-p dir)))) (define servers - '(("servers/crash-dump-core" ("/hurd/crash" "--dump-core")) + '(("servers/bus/pci" ("/hurd/pci-arbiter")) + ("servers/crash-dump-core" ("/hurd/crash" "--dump-core")) ("servers/crash-kill" ("/hurd/crash" "--kill")) ("servers/crash-suspend" ("/hurd/crash" "--suspend")) ("servers/password" ("/hurd/password")) @@ -213,6 +214,15 @@ set." ;; 'fd_to_filename' in libc expects it. ("dev/fd" ("/hurd/magic" "--directory" "fd") #o555) + ("dev/rumpdisk" ("/hurd/rumpdisk") #o660) + ("dev/netdde" ("/hurd/netdde") #o660) + ("dev/eth0" ("/hurd/devnode" "--master-device=/dev/net" + "eth0") + #o660) + ("dev/eth1" ("/hurd/devnode" "--master-device=/dev/net" + "eth1") + #o660) + ;; Create a number of ttys; syslogd writes to tty12 by default. ;; FIXME: Creating /dev/tty12 leads the console client to switch to ;; tty12 when syslogd starts, which is confusing for users. Thus, do @@ -236,7 +246,22 @@ set." ("/hurd/term" ,(string-append "/dev/ttyp" n) "pty-slave" ,(string-append "/dev/ptyp" n)) #o666)))) - (iota 10 0)))) + (iota 10 0)) + ,@(append-map (lambda (n) + (let* ((n (number->string n)) + (drive (string-append "dev/wd" n)) + (disk (string-append "@/dev/disk:wd" n))) + `((,drive ("/hurd/storeio" ,disk) #o600) + ,@(map (lambda (p) + (let ((p (number->string p))) + `(,(string-append drive "s" p) + ("/hurd/storeio" + "--store-type=typed" + ,(string-append + "part:" p ":device:" disk)) + #o660))) + (iota 4 1))))) + (iota 4 0)))) (for-each scope-set-translator servers) (mkdir* "dev/vcs/1") @@ -249,6 +274,10 @@ set." (false-if-EEXIST (symlink "/dev/fd/1" (scope "dev/stdout"))) (false-if-EEXIST (symlink "/dev/fd/2" (scope "dev/stderr"))) (false-if-EEXIST (symlink "crash-dump-core" (scope "servers/crash"))) + (false-if-EEXIST (symlink "/dev/rumpdisk" (scope "dev/disk"))) + (false-if-EEXIST (symlink "/dev/netdde" (scope "dev/net"))) + (false-if-EEXIST (symlink "/servers/socket/2" (scope "servers/socket/inet"))) + (false-if-EEXIST (symlink "/servers/socket/26" (scope "servers/socket/inet6"))) ;; Make sure /etc/mtab is a symlink to /proc/mounts. (false-if-exception (delete-file (scope "etc/mtab"))) diff --git a/gnu/build/marionette.scm b/gnu/build/marionette.scm index b8fba61d06..27c10e3dfe 100644 --- a/gnu/build/marionette.scm +++ b/gnu/build/marionette.scm @@ -1,7 +1,8 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2016-2022 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com> -;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com> +;;; Copyright © 2022, 2023 Maxim Cournoyer <maxim.cournoyer@gmail.com> +;;; Copyright © 2023 Bruno Victal <mirai@makinata.eu> ;;; ;;; This file is part of GNU Guix. ;;; @@ -36,6 +37,7 @@ wait-for-unix-socket marionette-control wait-for-screen-text + %default-ocrad-arguments %qwerty-us-keystrokes marionette-type @@ -287,23 +289,30 @@ Monitor\")." ;; The "quit" command terminates QEMU immediately, with no output. (unless (string=? command "quit") (wait-for-monitor-prompt monitor))))) -(define* (invoke-ocrad-ocr image #:key (ocrad "ocrad")) +(define %default-ocrad-arguments + '("--invert" "--scale=10")) + +(define* (invoke-ocrad-ocr image #:key (ocrad "ocrad") + (ocr-arguments %default-ocrad-arguments)) "Invoke the OCRAD command on image, and return the recognized text." - (let* ((pipe (open-pipe* OPEN_READ ocrad "-i" "-s" "10" image)) + (let* ((command (string-join `(,ocrad ,@ocr-arguments ,image))) + (pipe (open-input-pipe command)) (text (get-string-all pipe))) (unless (zero? (close-pipe pipe)) (error "'ocrad' failed" ocrad)) text)) -(define* (invoke-tesseract-ocr image #:key (tesseract "tesseract")) +(define* (invoke-tesseract-ocr image #:key (tesseract "tesseract") + (ocr-arguments '())) "Invoke the TESSERACT command on IMAGE, and return the recognized text." (let* ((output-basename (tmpnam)) - (output-basename* (string-append output-basename ".txt"))) + (output-basename* (string-append output-basename ".txt")) + (arguments (cons* image output-basename ocr-arguments))) (dynamic-wind (const #t) (lambda () (let ((exit-val (status:exit-val - (system* tesseract image output-basename)))) + (apply system* tesseract arguments)))) (unless (zero? exit-val) (error "'tesseract' failed" tesseract)) (call-with-input-file output-basename* get-string-all))) @@ -311,7 +320,8 @@ Monitor\")." (false-if-exception (delete-file output-basename)) (false-if-exception (delete-file output-basename*)))))) -(define* (marionette-screen-text marionette #:key (ocr "ocrad")) +(define* (marionette-screen-text marionette #:key (ocr "ocrad") + ocr-arguments) "Take a screenshot of MARIONETTE, perform optical character recognition (OCR), and return the text read from the screen as a string, along the screen dump image used. Do this by invoking OCR, which should be the file @@ -324,14 +334,22 @@ if it is not needed." ;; Process it via the OCR. (cond ((string-contains ocr "ocrad") - (values (invoke-ocrad-ocr image #:ocrad ocr) image)) + (values (invoke-ocrad-ocr image + #:ocrad ocr + #:ocr-arguments + (or ocr-arguments %default-ocrad-arguments)) + image)) ((string-contains ocr "tesseract") - (values (invoke-tesseract-ocr image #:tesseract ocr) image)) + (values (invoke-tesseract-ocr image + #:tesseract ocr + #:ocr-arguments (or ocr-arguments '())) + image)) (else (error "unsupported ocr command")))) (define* (wait-for-screen-text marionette predicate #:key (ocr "ocrad") + ocr-arguments (timeout 30) pre-action post-action) @@ -359,7 +377,10 @@ Likewise for POST-ACTION, except it runs at the end of a successful OCR." 'ocr-text: last-text 'screendump: screendump-backup)) (let* ((_ (and (procedure? pre-action) (pre-action))) - (text screendump (marionette-screen-text marionette #:ocr ocr)) + (text screendump + (marionette-screen-text marionette + #:ocr ocr + #:ocr-arguments ocr-arguments)) (_ (and (procedure? post-action) (post-action))) (result (predicate text))) (cond (result |