marionette: Use QEMU's "VM channel" mechanism.

* gnu/tests.scm (<marionette-configuration>)[device]: Default to
"/dev/virtio-ports/org.gnu.guix.port.0".
* gnu/tests.scm (marionette-shepherd-service): Remove (guix build
syscalls) from 'modules'.  Remove 'tcsetattr' call from 'start'.
* gnu/build/marionette.scm (make-marionette): Use "-virtserialport"
instead of "-virtconsole".
This commit is contained in:
Ludovic Courtès 2018-02-19 21:58:18 +01:00
parent ce0a62f6c5
commit 27a2c9c3e0
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 10 additions and 19 deletions

View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; 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") "-monitor" (string-append "unix:" socket-directory "/monitor")
"-chardev" (string-append "socket,id=repl,path=" socket-directory "-chardev" (string-append "socket,id=repl,path=" socket-directory
"/repl") "/repl")
;; See
;; <http://www.linux-kvm.org/page/VMchannel_Requirements#Invocation>.
"-device" "virtio-serial" "-device" "virtio-serial"
"-device" "virtconsole,chardev=repl")) "-device" "virtserialport,chardev=repl,name=org.gnu.guix.port.0"))
(define (accept* port) (define (accept* port)
(match (select (list port) '() (list port) timeout) (match (select (list port) '() (list port) timeout)

View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr> ;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
;;; ;;;
@ -69,7 +69,7 @@
marionette-configuration make-marionette-configuration marionette-configuration make-marionette-configuration
marionette-configuration? marionette-configuration?
(device marionette-configuration-device ;string (device marionette-configuration-device ;string
(default "/dev/hvc0")) (default "/dev/virtio-ports/org.gnu.guix.port.0"))
(imported-modules marionette-configuration-imported-modules (imported-modules marionette-configuration-imported-modules
(default '())) (default '()))
(requirements marionette-configuration-requirements ;list of symbols (requirements marionette-configuration-requirements ;list of symbols
@ -87,17 +87,10 @@
(modules '((ice-9 match) (modules '((ice-9 match)
(srfi srfi-9 gnu) (srfi srfi-9 gnu)
(guix build syscalls)
(rnrs bytevectors))) (rnrs bytevectors)))
(start (start
(with-imported-modules `((guix build syscalls) (with-imported-modules imported-modules
,@imported-modules)
#~(lambda () #~(lambda ()
(define (clear-echo termios)
(set-field termios (termios-local-flags)
(logand (lognot (local-flags ECHO))
(termios-local-flags termios))))
(define (self-quoting? x) (define (self-quoting? x)
(letrec-syntax ((one-of (syntax-rules () (letrec-syntax ((one-of (syntax-rules ()
((_) #f) ((_) #f)
@ -112,13 +105,8 @@
(dynamic-wind (dynamic-wind
(const #t) (const #t)
(lambda () (lambda ()
(let* ((repl (open-file #$device "r+0")) (let ((repl (open-file #$device "r+0"))
(termios (tcgetattr (fileno repl)))
(console (open-file "/dev/console" "r+0"))) (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. ;; Redirect output to the console.
(close-fdes 1) (close-fdes 1)
(close-fdes 2) (close-fdes 2)