diff --git a/gnu/build/marionette.scm b/gnu/build/marionette.scm index 7554a710a..173a67cef 100644 --- a/gnu/build/marionette.scm +++ b/gnu/build/marionette.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2016, 2017 Ludovic Courtès +;;; Copyright © 2016, 2017, 2018 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -97,8 +97,11 @@ QEMU monitor and to the guest's backdoor REPL." "-monitor" (string-append "unix:" socket-directory "/monitor") "-chardev" (string-append "socket,id=repl,path=" socket-directory "/repl") + + ;; See + ;; . "-device" "virtio-serial" - "-device" "virtconsole,chardev=repl")) + "-device" "virtserialport,chardev=repl,name=org.gnu.guix.port.0")) (define (accept* port) (match (select (list port) '() (list port) timeout) diff --git a/gnu/tests.scm b/gnu/tests.scm index 3e4c3d4e3..31249f0be 100644 --- a/gnu/tests.scm +++ b/gnu/tests.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2016, 2017 Ludovic Courtès +;;; Copyright © 2016, 2017, 2018 Ludovic Courtès ;;; Copyright © 2017 Mathieu Othacehe ;;; Copyright © 2017 Tobias Geerinckx-Rice ;;; @@ -69,7 +69,7 @@ marionette-configuration make-marionette-configuration marionette-configuration? (device marionette-configuration-device ;string - (default "/dev/hvc0")) + (default "/dev/virtio-ports/org.gnu.guix.port.0")) (imported-modules marionette-configuration-imported-modules (default '())) (requirements marionette-configuration-requirements ;list of symbols @@ -87,17 +87,10 @@ (modules '((ice-9 match) (srfi srfi-9 gnu) - (guix build syscalls) (rnrs bytevectors))) (start - (with-imported-modules `((guix build syscalls) - ,@imported-modules) + (with-imported-modules imported-modules #~(lambda () - (define (clear-echo termios) - (set-field termios (termios-local-flags) - (logand (lognot (local-flags ECHO)) - (termios-local-flags termios)))) - (define (self-quoting? x) (letrec-syntax ((one-of (syntax-rules () ((_) #f) @@ -112,20 +105,7 @@ (dynamic-wind (const #t) (lambda () - (let* ((repl (open-file #$device "r+0")) - (termios (tcgetattr (fileno repl))) - (console (open-file "/dev/console" "r+0"))) - ;; Don't echo input back. - (tcsetattr (fileno repl) (tcsetattr-action TCSANOW) - (clear-echo termios)) - - ;; Redirect output to the console. - (close-fdes 1) - (close-fdes 2) - (dup2 (fileno console) 1) - (dup2 (fileno console) 2) - (close-port console) - + (let ((repl (open-file #$device "r+0"))) (display 'ready repl) (let loop () (newline repl) diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm index 1bc7a7027..64332000a 100644 --- a/gnu/tests/base.scm +++ b/gnu/tests/base.scm @@ -323,11 +323,6 @@ info --version") 'success! (marionette-eval '(begin ;; Make sure the (guix …) modules are found. - ;; - ;; XXX: Currently shepherd and marionette run - ;; on Guile 2.0 whereas Guix is on 2.2. Yet - ;; we should be able to load the 2.0 Scheme - ;; files since it's pure Scheme. (add-to-load-path #+(file-append guix "/share/guile/site/2.2")) @@ -337,9 +332,12 @@ info --version") (guard (c ((nix-protocol-error? c) (and (file-exists? system) 'success!))) - (with-store store - (delete-paths store (list system)) - #f)))) + (parameterize ((current-build-output-port + (open-file "/dev/console" + "r+0"))) + (with-store store + (delete-paths store (list system)) + #f))))) marionette)) ;; This symlink is currently unused, but better have it point to the