me/guix
Archived
1
0
Fork 0
Code Activity

tests: 'marionette-service-type' nows takes a <marionette-configuration>.

Browse source 
* gnu/tests.scm (<marionette-configuration>): New record type.
(marionette-shepherd-service): Argument now is a <marionette-configuration>.
(marionette-operating-system): Adjust accordingly.  Add #:requirements
parameter and honor it.
This commit is contained in:
Ludovic Courtès 2016-06-27 21:09:08 +02:00
parent 858d372c98
commit 037f9e07cd
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 98 additions and 73 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

47
gnu/tests.scm
View file

@ -27,7 +27,13 @@
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9 gnu)
#:use-module (ice-9 match)
#:export (marionette-service-type
#:export (marionette-configuration
marionette-configuration?
marionette-configuration-device
marionette-configuration-imported-modules
marionette-configuration-requirements
marionette-service-type
marionette-operating-system
define-os-with-source
@ -50,14 +56,26 @@
;;;
;;; Code:
(define (marionette-shepherd-service imported-modules)
"Return the Shepherd service for the marionette REPL"
(define device
"/dev/hvc0")
(define-record-type* <marionette-configuration>
marionette-configuration make-marionette-configuration
marionette-configuration?
(device marionette-configuration-device ;string
(default "/dev/hvc0"))
(imported-modules marionette-configuration-imported-modules
(default '()))
(requirements marionette-configuration-requirements ;list of symbols
(default '())))
(define (marionette-shepherd-service config)
"Return the Shepherd service for the marionette REPL"
(match config
(($ <marionette-configuration> device imported-modules requirement)
(list (shepherd-service
(provision '(marionette))
(requirement '(udev)) ;so that DEVICE is available
;; Always depend on UDEV so that DEVICE is available.
(requirement `(udev ,@requirement))
(modules '((ice-9 match)
(srfi srfi-9 gnu)
(guix build syscalls)
@ -124,7 +142,7 @@
(primitive-exit 1))))
(pid
pid))))
(stop #~(make-kill-destructor)))))
(stop #~(make-kill-destructor)))))))
(define marionette-service-type
;; This is the type of the "marionette" service, allowing a guest system to
@ -136,12 +154,19 @@
marionette-shepherd-service)))))
(define* (marionette-operating-system os
#:key (imported-modules '()))
"Return a marionetteed variant of OS such that OS can be used as a marionette
in a virtual machine--i.e., controlled from the host system."
#:key
(imported-modules '())
(requirements '()))
"Return a marionetteed variant of OS such that OS can be used as a
marionette in a virtual machine--i.e., controlled from the host system. The
marionette service in the guest is started after the Shepherd services listed
in REQUIREMENTS."
(operating-system
(inherit os)
(services (cons (service marionette-service-type imported-modules)
(services (cons (service marionette-service-type
(marionette-configuration
(requirements requirements)
(imported-modules imported-modules)))
(operating-system-user-services os)))))
(define-syntax define-os-with-source