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".
master
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
;;; 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.
;;;
@ -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
;; <http://www.linux-kvm.org/page/VMchannel_Requirements#Invocation>.
"-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)

View File

@ -1,5 +1,5 @@
;;; 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 Tobias Geerinckx-Rice <me@tobias.gr>
;;;
@ -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,13 +105,8 @@
(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))
(let ((repl (open-file #$device "r+0"))
(console (open-file "/dev/console" "r+0")))
;; Redirect output to the console.
(close-fdes 1)
(close-fdes 2)