me
/
guix
Archived
1
0
Fork 0
Code

gnu: Switch to 'with-imported-modules'. 

* gnu/services.scm (directory-union): Use 'with-imported-modules'
instead of the '#:modules' argument of 'computed-file'.
* gnu/services/base.scm (udev-rules-union): Likewise.
* gnu/services/dbus.scm (system-service-directory): Likewise.
* gnu/services/desktop.scm (wrapped-dbus-service):
(polkit-directory): Likewise.
* gnu/services/networking.scm (tor-configuration->torrc): Likewise.
* gnu/services/xorg.scm (xorg-configuration-directory): Likewise.
* gnu/system/install.scm (self-contained-tarball): Likewise.
* gnu/system/linux-container.scm (container-script): Likewise.
* gnu/system/linux-initrd.scm (expression->initrd): Likewise, and
remove #:modules parameter.
(flat-linux-module-directory): Use 'with-imported-modules'.
(base-initrd): Likewise.
* gnu/system/locale.scm (locale-directory): Likewise.
* gnu/system/shadow.scm (default-skeletons): Likewise.
* gnu/system/vm.scm (expression->derivation-in-linux-vm): Likewise.
* gnu/tests/base.scm (run-basic-test): Likewise.
* gnu/tests/install.scm (run-install): Likewise.
* doc/guix.texi (Initial RAM Disk): Update 'expression->initrd'
documentation.
master
Ludovic Courtès 2016-07-03 23:11:40 +02:00
parent 0bb9929eaa
commit 4ee96a7912
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
15 changed files with 600 additions and 605 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
doc/guix.texi
View File

@ -10016,15 +10016,11 @@ program. That gives a lot of flexibility. The
program to run in that initrd. program to run in that initrd.
@deffn {Monadic Procedure} expression->initrd @var{exp} @ @deffn {Monadic Procedure} expression->initrd @var{exp} @
[#:guile %guile-static-stripped] [#:name "guile-initrd"] @ [#:guile %guile-static-stripped] [#:name "guile-initrd"]
[#:modules '()]
Return a derivation that builds a Linux initrd (a gzipped cpio archive) Return a derivation that builds a Linux initrd (a gzipped cpio archive)
containing @var{guile} and that evaluates @var{exp}, a G-expression, containing @var{guile} and that evaluates @var{exp}, a G-expression,
upon booting. All the derivations referenced by @var{exp} are upon booting. All the derivations referenced by @var{exp} are
automatically copied to the initrd. automatically copied to the initrd.
@var{modules} is a list of Guile module names to be embedded in the
initrd.
@end deffn @end deffn
@node GRUB Configuration @node GRUB Configuration

8
gnu/services.scm
View File

@ -309,10 +309,10 @@ file."
one) one)
(_ (_
(computed-file name (computed-file name
#~(begin (with-imported-modules '((guix build union))
(use-modules (guix build union)) #~(begin
(union-build #$output '#$things)) (use-modules (guix build union))
#:modules '((guix build union)))))) (union-build #$output '#$things)))))))
(define* (activation-service->script service) (define* (activation-service->script service)
"Return as a monadic value the activation script for SERVICE, a service of "Return as a monadic value the activation script for SERVICE, a service of

56
gnu/services/base.scm
View File

@ -1138,44 +1138,44 @@ archive}). If that is not the case, the service will fail to start."
"Return the union of the @code{lib/udev/rules.d} directories found in each "Return the union of the @code{lib/udev/rules.d} directories found in each
item of @var{packages}." item of @var{packages}."
(define build (define build
#~(begin (with-imported-modules '((guix build union)
(use-modules (guix build union) (guix build utils))
(guix build utils) #~(begin
(srfi srfi-1) (use-modules (guix build union)
(srfi srfi-26)) (guix build utils)
(srfi srfi-1)
(srfi srfi-26))
(define %standard-locations (define %standard-locations
'("/lib/udev/rules.d" "/libexec/udev/rules.d")) '("/lib/udev/rules.d" "/libexec/udev/rules.d"))
(define (rules-sub-directory directory) (define (rules-sub-directory directory)
;; Return the sub-directory of DIRECTORY containing udev rules, or ;; Return the sub-directory of DIRECTORY containing udev rules, or
;; #f if none was found. ;; #f if none was found.
(find directory-exists? (find directory-exists?
(map (cut string-append directory <>) %standard-locations))) (map (cut string-append directory <>) %standard-locations)))
(mkdir-p (string-append #$output "/lib/udev")) (mkdir-p (string-append #$output "/lib/udev"))
(union-build (string-append #$output "/lib/udev/rules.d") (union-build (string-append #$output "/lib/udev/rules.d")
(filter-map rules-sub-directory '#$packages)))) (filter-map rules-sub-directory '#$packages)))))
(computed-file "udev-rules" build (computed-file "udev-rules" build))
#:modules '((guix build union)
(guix build utils))))
(define (udev-rule file-name contents) (define (udev-rule file-name contents)
"Return a directory with a udev rule file FILE-NAME containing CONTENTS." "Return a directory with a udev rule file FILE-NAME containing CONTENTS."
(computed-file file-name (computed-file file-name
#~(begin (with-imported-modules '((guix build utils))
(use-modules (guix build utils)) #~(begin
(use-modules (guix build utils))
(define rules.d (define rules.d
(string-append #$output "/lib/udev/rules.d")) (string-append #$output "/lib/udev/rules.d"))
(mkdir-p rules.d) (mkdir-p rules.d)
(call-with-output-file (call-with-output-file
(string-append rules.d "/" #$file-name) (string-append rules.d "/" #$file-name)
(lambda (port) (lambda (port)
(display #$contents port)))) (display #$contents port)))))))
#:modules '((guix build utils))))
(define kvm-udev-rule (define kvm-udev-rule
;; Return a directory with a udev rule that changes the group of /dev/kvm to ;; Return a directory with a udev rule that changes the group of /dev/kvm to

37
gnu/services/dbus.scm
View File

@ -46,26 +46,27 @@
"Return the system service directory, containing @code{.service} files for "Return the system service directory, containing @code{.service} files for
all the services that may be activated by the daemon." all the services that may be activated by the daemon."
(computed-file "dbus-system-services" (computed-file "dbus-system-services"
#~(begin (with-imported-modules '((guix build utils))
(use-modules (guix build utils) #~(begin
(srfi srfi-1)) (use-modules (guix build utils)
(srfi srfi-1))
(define files (define files
(append-map (lambda (service) (append-map (lambda (service)
(find-files (string-append (find-files
service (string-append
"/share/dbus-1/system-services") service
"\\.service$")) "/share/dbus-1/system-services")
(list #$@services))) "\\.service$"))
(list #$@services)))
(mkdir #$output) (mkdir #$output)
(for-each (lambda (file) (for-each (lambda (file)
(symlink file (symlink file
(string-append #$output "/" (string-append #$output "/"
(basename file)))) (basename file))))
files) files)
#t) #t))))
#:modules '((guix build utils))))
(define (dbus-configuration-directory services) (define (dbus-configuration-directory services)
"Return a directory contains the @code{system-local.conf} file for DBUS that "Return a directory contains the @code{system-local.conf} file for DBUS that

65
gnu/services/desktop.scm
View File

@ -91,30 +91,33 @@ is set to @var{value} when the bus daemon launches it."
(string-append #$service "/" #$program) (string-append #$service "/" #$program)
(cdr (command-line)))))) (cdr (command-line))))))
(define build
(with-imported-modules '((guix build utils))
#~(begin
(use-modules (guix build utils))
(define service-directory
"/share/dbus-1/system-services")
(mkdir-p (dirname (string-append #$output
service-directory)))
(copy-recursively (string-append #$service
service-directory)
(string-append #$output
service-directory))
(symlink (string-append #$service "/etc") ;for etc/dbus-1
(string-append #$output "/etc"))
(for-each (lambda (file)
(substitute* file
(("Exec[[:blank:]]*=[[:blank:]]*([[:graph:]]+)(.*)$"
_ original-program arguments)
(string-append "Exec=" #$wrapper arguments
"\n"))))
(find-files #$output "\\.service$")))))
(computed-file (string-append (package-name service) "-wrapper") (computed-file (string-append (package-name service) "-wrapper")
#~(begin build))
(use-modules (guix build utils))
(define service-directory
"/share/dbus-1/system-services")
(mkdir-p (dirname (string-append #$output
service-directory)))
(copy-recursively (string-append #$service
service-directory)
(string-append #$output
service-directory))
(symlink (string-append #$service "/etc") ;for etc/dbus-1
(string-append #$output "/etc"))
(for-each (lambda (file)
(substitute* file
(("Exec[[:blank:]]*=[[:blank:]]*([[:graph:]]+)(.*)$"
_ original-program arguments)
(string-append "Exec=" #$wrapper arguments
"\n"))))
(find-files #$output "\\.service$")))
#:modules '((guix build utils))))
;;; ;;;
@ -408,15 +411,15 @@ Users need to be in the @code{lp} group to access the D-Bus service.
(define (polkit-directory packages) (define (polkit-directory packages)
"Return a directory containing an @file{actions} and possibly a "Return a directory containing an @file{actions} and possibly a
@file{rules.d} sub-directory, for use as @file{/etc/polkit-1}." @file{rules.d} sub-directory, for use as @file{/etc/polkit-1}."
(computed-file "etc-polkit-1" (with-imported-modules '((guix build union))
#~(begin (computed-file "etc-polkit-1"
(use-modules (guix build union) (srfi srfi-26)) #~(begin
(use-modules (guix build union) (srfi srfi-26))
(union-build #$output (union-build #$output
(map (cut string-append <> (map (cut string-append <>
"/share/polkit-1") "/share/polkit-1")
(list #$@packages)))) (list #$@packages)))))))
#:modules '((guix build union))))
(define polkit-etc-files (define polkit-etc-files
(match-lambda (match-lambda

50
gnu/services/networking.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
;;; ;;;
@ -345,39 +345,39 @@ keep the system clock synchronized with that of @var{servers}."
(($ <tor-configuration> tor config-file services) (($ <tor-configuration> tor config-file services)
(computed-file (computed-file
"torrc" "torrc"
#~(begin (with-imported-modules '((guix build utils))
(use-modules (guix build utils) #~(begin
(ice-9 match)) (use-modules (guix build utils)
(ice-9 match))
(call-with-output-file #$output (call-with-output-file #$output
(lambda (port) (lambda (port)
(display "\ (display "\
# The beginning was automatically added. # The beginning was automatically added.
User tor User tor
DataDirectory /var/lib/tor DataDirectory /var/lib/tor
Log notice syslog\n" port) Log notice syslog\n" port)
(for-each (match-lambda (for-each (match-lambda
((service (ports hosts) ...) ((service (ports hosts) ...)
(format port "\ (format port "\
HiddenServiceDir /var/lib/tor/hidden-services/~a~%" HiddenServiceDir /var/lib/tor/hidden-services/~a~%"
service) service)
(for-each (lambda (tcp-port host) (for-each (lambda (tcp-port host)
(format port "\ (format port "\
HiddenServicePort ~a ~a~%" HiddenServicePort ~a ~a~%"
tcp-port host)) tcp-port host))
ports hosts))) ports hosts)))
'#$(map (match-lambda '#$(map (match-lambda
(($ <hidden-service> name mapping) (($ <hidden-service> name mapping)
(cons name mapping))) (cons name mapping)))
services)) services))
;; Append the user's config file. ;; Append the user's config file.
(call-with-input-file #$config-file (call-with-input-file #$config-file
(lambda (input) (lambda (input)
(dump-port input port))) (dump-port input port)))
#t))) #t))))))))
#:modules '((guix build utils))))))
(define (tor-shepherd-service config) (define (tor-shepherd-service config)
"Return a <shepherd-service> running TOR." "Return a <shepherd-service> running TOR."

38
gnu/services/xorg.scm
View File

@ -158,27 +158,27 @@ EndSection
"Return a directory that contains the @code{.conf} files for X.org that "Return a directory that contains the @code{.conf} files for X.org that
includes the @code{share/X11/xorg.conf.d} directories of each package listed includes the @code{share/X11/xorg.conf.d} directories of each package listed
in @var{modules}." in @var{modules}."
(computed-file "xorg.conf.d" (with-imported-modules '((guix build utils))
#~(begin (computed-file "xorg.conf.d"
(use-modules (guix build utils) #~(begin
(srfi srfi-1)) (use-modules (guix build utils)
(srfi srfi-1))
(define files (define files
(append-map (lambda (module) (append-map (lambda (module)
(find-files (string-append (find-files (string-append
module module
"/share/X11/xorg.conf.d") "/share/X11/xorg.conf.d")
"\\.conf$")) "\\.conf$"))
(list #$@modules))) (list #$@modules)))
(mkdir #$output) (mkdir #$output)
(for-each (lambda (file) (for-each (lambda (file)
(symlink file (symlink file
(string-append #$output "/" (string-append #$output "/"
(basename file)))) (basename file))))
files) files)
#t) #t))))
#:modules '((guix build utils))))
(define* (xorg-start-command #:key (define* (xorg-start-command #:key
(guile (canonical-package guile-2.0)) (guile (canonical-package guile-2.0))

105
gnu/system/install.scm
View File

@ -55,52 +55,53 @@ under /root/.guix-profile where GUIX is installed."
(manifest (manifest
(list (package->manifest-entry guix)))))) (list (package->manifest-entry guix))))))
(define build (define build
#~(begin (with-imported-modules '((guix build utils)
(use-modules (guix build utils) (guix build store-copy)
(gnu build install)) (gnu build install))
#~(begin
(use-modules (guix build utils)
(gnu build install))
(define %root "root") (define %root "root")
(setenv "PATH" (setenv "PATH"
(string-append #$guix "/sbin:" #$tar "/bin:" #$xz "/bin")) (string-append #$guix "/sbin:" #$tar "/bin:" #$xz "/bin"))
;; Note: there is not much to gain here with deduplication and there ;; Note: there is not much to gain here with deduplication and
;; is the overhead of the '.links' directory, so turn it off. ;; there is the overhead of the '.links' directory, so turn it
(populate-single-profile-directory %root ;; off.
#:profile #$profile (populate-single-profile-directory %root
#:closure "profile" #:profile #$profile
#:deduplicate? #f) #:closure "profile"
#:deduplicate? #f)
;; Create the tarball. Use GNU format so there's no file name ;; Create the tarball. Use GNU format so there's no file name
;; length limitation. ;; length limitation.
(with-directory-excursion %root (with-directory-excursion %root
(zero? (system* "tar" "--xz" "--format=gnu" (zero? (system* "tar" "--xz" "--format=gnu"
;; Avoid non-determinism in the archive. Use ;; Avoid non-determinism in the archive. Use
;; mtime = 1, not zero, because that is what the ;; mtime = 1, not zero, because that is what the
;; daemon does for files in the store (see the ;; daemon does for files in the store (see the
;; 'mtimeStore' constant in local-store.cc.) ;; 'mtimeStore' constant in local-store.cc.)
"--sort=name" "--sort=name"
"--mtime=@1" ;for files in /var/guix "--mtime=@1" ;for files in /var/guix
"--owner=root:0" "--owner=root:0"
"--group=root:0" "--group=root:0"
"--check-links" "--check-links"
"-cvf" #$output "-cvf" #$output
;; Avoid adding / and /var to the tarball, ;; Avoid adding / and /var to the tarball, so
;; so that the ownership and permissions of those ;; that the ownership and permissions of those
;; directories will not be overwritten when ;; directories will not be overwritten when
;; extracting the archive. Do not include /root ;; extracting the archive. Do not include /root
;; because the root account might have a different ;; because the root account might have a
;; home directory. ;; different home directory.
"./var/guix" "./var/guix"
(string-append "." (%store-directory))))))) (string-append "." (%store-directory))))))))
(gexp->derivation "guix-tarball.tar.xz" build (gexp->derivation "guix-tarball.tar.xz" build
#:references-graphs `(("profile" ,profile)) #:references-graphs `(("profile" ,profile)))))
#:modules '((guix build utils)
(guix build store-copy)
(gnu build install)))))
(define (log-to-info) (define (log-to-info)
@ -212,20 +213,20 @@ the user's target storage device rather than on the RAM disk."
(define directory (define directory
(computed-file "configuration-templates" (computed-file "configuration-templates"
#~(begin (with-imported-modules '((guix build utils))
(mkdir #$output) #~(begin
(for-each (lambda (file target) (mkdir #$output)
(copy-file file (for-each (lambda (file target)
(string-append #$output "/" (copy-file file
target))) (string-append #$output "/"
'(#$(file "bare-bones.tmpl") target)))
#$(file "desktop.tmpl") '(#$(file "bare-bones.tmpl")
#$(file "lightweight-desktop.tmpl")) #$(file "desktop.tmpl")
'("bare-bones.scm" #$(file "lightweight-desktop.tmpl"))
"desktop.scm" '("bare-bones.scm"
"lightweight-desktop.scm")) "desktop.scm"
#t) "lightweight-desktop.scm"))
#:modules '((guix build utils)))) #t))))
`(("configuration" ,directory))) `(("configuration" ,directory)))

48
gnu/system/linux-container.scm
View File

@ -87,30 +87,28 @@ that will be shared with the host system."
#:container? #t))) #:container? #t)))
(define script (define script
#~(begin (with-imported-modules '((guix config)
(use-modules (gnu build linux-container) (guix utils)
(guix build utils)) (guix build utils)
(guix build syscalls)
(guix build bournish)
(gnu build file-systems)
(gnu build linux-container))
#~(begin
(use-modules (gnu build linux-container)
(guix build utils))
(call-with-container '#$specs (call-with-container '#$specs
(lambda () (lambda ()
(setenv "HOME" "/root") (setenv "HOME" "/root")
(setenv "TMPDIR" "/tmp") (setenv "TMPDIR" "/tmp")
(setenv "GUIX_NEW_SYSTEM" #$os-drv) (setenv "GUIX_NEW_SYSTEM" #$os-drv)
(for-each mkdir-p '("/run" "/bin" "/etc" "/home" "/var")) (for-each mkdir-p '("/run" "/bin" "/etc" "/home" "/var"))
(primitive-load (string-append #$os-drv "/boot"))) (primitive-load (string-append #$os-drv "/boot")))
;; A range of 65536 uid/gids is used to cover 16 bits worth of ;; A range of 65536 uid/gids is used to cover 16 bits worth of
;; users and groups, which is sufficient for most cases. ;; users and groups, which is sufficient for most cases.
;; ;;
;; See: http://www.freedesktop.org/software/systemd/man/systemd-nspawn.html#--private-users= ;; See: http://www.freedesktop.org/software/systemd/man/systemd-nspawn.html#--private-users=
#:host-uids 65536))) #:host-uids 65536))))
(gexp->script "run-container" script (gexp->script "run-container" script))))
#:modules '((ice-9 match)
(srfi srfi-98)
(guix config)
(guix utils)
(guix build utils)
(guix build syscalls)
(guix build bournish)
(gnu build file-systems)
(gnu build linux-container))))))

170
gnu/system/linux-initrd.scm
View File

@ -55,85 +55,81 @@
(guile %guile-static-stripped) (guile %guile-static-stripped)
(gzip gzip) (gzip gzip)
(name "guile-initrd") (name "guile-initrd")
(system (%current-system)) (system (%current-system)))
(modules '()))
"Return a derivation that builds a Linux initrd (a gzipped cpio archive) "Return a derivation that builds a Linux initrd (a gzipped cpio archive)
containing GUILE and that evaluates EXP, a G-expression, upon booting. All containing GUILE and that evaluates EXP, a G-expression, upon booting. All
the derivations referenced by EXP are automatically copied to the initrd. the derivations referenced by EXP are automatically copied to the initrd."
MODULES is a list of Guile module names to be embedded in the initrd."
;; General Linux overview in `Documentation/early-userspace/README' and ;; General Linux overview in `Documentation/early-userspace/README' and
;; `Documentation/filesystems/ramfs-rootfs-initramfs.txt'. ;; `Documentation/filesystems/ramfs-rootfs-initramfs.txt'.
(mlet %store-monad ((init (gexp->script "init" exp (mlet %store-monad ((init (gexp->script "init" exp
#:modules modules
#:guile guile))) #:guile guile)))
(define builder (define builder
#~(begin (with-imported-modules '((guix cpio)
(use-modules (gnu build linux-initrd)) (guix build utils)
(guix build store-copy)
(gnu build linux-initrd))
#~(begin
(use-modules (gnu build linux-initrd))
(mkdir #$output) (mkdir #$output)
(build-initrd (string-append #$output "/initrd") (build-initrd (string-append #$output "/initrd")
#:guile #$guile #:guile #$guile
#:init #$init #:init #$init
;; Copy everything INIT refers to into the initrd. ;; Copy everything INIT refers to into the initrd.
#:references-graphs '("closure") #:references-graphs '("closure")
#:gzip (string-append #$gzip "/bin/gzip")))) #:gzip (string-append #$gzip "/bin/gzip")))))
(gexp->derivation name builder (gexp->derivation name builder
#:modules '((guix cpio) #:references-graphs `(("closure" ,init)))))
(guix build utils)
(guix build store-copy)
(gnu build linux-initrd))
#:references-graphs `(("closure" ,init)))))
(define (flat-linux-module-directory linux modules) (define (flat-linux-module-directory linux modules)
"Return a flat directory containing the Linux kernel modules listed in "Return a flat directory containing the Linux kernel modules listed in
MODULES and taken from LINUX." MODULES and taken from LINUX."
(define build-exp (define build-exp
#~(begin (with-imported-modules '((guix build utils)
(use-modules (ice-9 match) (ice-9 regex) (guix elf)
(srfi srfi-1) (gnu build linux-modules))
(guix build utils) #~(begin
(gnu build linux-modules)) (use-modules (ice-9 match) (ice-9 regex)
(srfi srfi-1)
(guix build utils)
(gnu build linux-modules))
(define (string->regexp str) (define (string->regexp str)
;; Return a regexp that matches STR exactly. ;; Return a regexp that matches STR exactly.
(string-append "^" (regexp-quote str) "$")) (string-append "^" (regexp-quote str) "$"))
(define module-dir (define module-dir
(string-append #$linux "/lib/modules")) (string-append #$linux "/lib/modules"))
(define (lookup module) (define (lookup module)
(let ((name (ensure-dot-ko module))) (let ((name (ensure-dot-ko module)))
(match (find-files module-dir (string->regexp name)) (match (find-files module-dir (string->regexp name))
((file) ((file)
file) file)
(() (()
(error "module not found" name module-dir)) (error "module not found" name module-dir))
((_ ...) ((_ ...)
(error "several modules by that name" (error "several modules by that name"
name module-dir))))) name module-dir)))))
(define modules (define modules
(let ((modules (map lookup '#$modules))) (let ((modules (map lookup '#$modules)))
(append modules (append modules
(recursive-module-dependencies modules (recursive-module-dependencies modules
#:lookup-module lookup)))) #:lookup-module lookup))))
(mkdir #$output) (mkdir #$output)
(for-each (lambda (module) (for-each (lambda (module)
(format #t "copying '~a'...~%" module) (format #t "copying '~a'...~%" module)
(copy-file module (copy-file module
(string-append #$output "/" (string-append #$output "/"
(basename module)))) (basename module))))
(delete-duplicates modules)))) (delete-duplicates modules)))))
(gexp->derivation "linux-modules" build-exp (gexp->derivation "linux-modules" build-exp))
#:modules '((guix build utils)
(guix elf)
(gnu build linux-modules))))
(define* (base-initrd file-systems (define* (base-initrd file-systems
#:key #:key
@ -227,38 +223,38 @@ loaded at boot time in the order in which they appear."
(mlet %store-monad ((kodir (flat-linux-module-directory linux (mlet %store-monad ((kodir (flat-linux-module-directory linux
linux-modules))) linux-modules)))
(expression->initrd (expression->initrd
#~(begin (with-imported-modules '((guix build bournish)
(use-modules (gnu build linux-boot) (guix build utils)
(guix build utils) (guix build syscalls)
(guix build bournish) ;add the 'bournish' meta-command (gnu build linux-boot)
(srfi srfi-26) (gnu build linux-modules)
(gnu build file-systems)
(guix elf))
#~(begin
(use-modules (gnu build linux-boot)
(guix build utils)
(guix build bournish) ;add the 'bournish' meta-command
(srfi srfi-26)
;; FIXME: The following modules are for ;; FIXME: The following modules are for
;; LUKS-DEVICE-MAPPING. We should instead propagate ;; LUKS-DEVICE-MAPPING. We should instead propagate
;; this info via gexps. ;; this info via gexps.
((gnu build file-systems) ((gnu build file-systems)
#:select (find-partition-by-luks-uuid)) #:select (find-partition-by-luks-uuid))
(rnrs bytevectors)) (rnrs bytevectors))
(with-output-to-port (%make-void-port "w") (with-output-to-port (%make-void-port "w")
(lambda () (lambda ()
(set-path-environment-variable "PATH" '("bin" "sbin") (set-path-environment-variable "PATH" '("bin" "sbin")
'#$helper-packages))) '#$helper-packages)))
(boot-system #:mounts '#$(map file-system->spec file-systems) (boot-system #:mounts '#$(map file-system->spec file-systems)
#:pre-mount (lambda () #:pre-mount (lambda ()
(and #$@device-mapping-commands)) (and #$@device-mapping-commands))
#:linux-modules '#$linux-modules #:linux-modules '#$linux-modules
#:linux-module-directory '#$kodir #:linux-module-directory '#$kodir
#:qemu-guest-networking? #$qemu-networking? #:qemu-guest-networking? #$qemu-networking?
#:volatile-root? '#$volatile-root?)) #:volatile-root? '#$volatile-root?)))
#:name "base-initrd" #:name "base-initrd")))
#:modules '((guix build bournish)
(guix build utils)
(guix build syscalls)
(gnu build linux-boot)
(gnu build linux-modules)
(gnu build file-systems)
(guix elf)))))
;;; linux-initrd.scm ends here ;;; linux-initrd.scm ends here

8
gnu/system/locale.scm
View File

@ -154,10 +154,10 @@ data format changes between libc versions."
#:libc libc)) #:libc libc))
libcs))) libcs)))
(gexp->derivation "locale-multiple-versions" (gexp->derivation "locale-multiple-versions"
#~(begin (with-imported-modules '((guix build union))
(use-modules (guix build union)) #~(begin
(union-build #$output (list #$@dirs))) (use-modules (guix build union))
#:modules '((guix build union)) (union-build #$output (list #$@dirs))))
#:local-build? #t #:local-build? #t
#:substitutable? #f))))) #:substitutable? #f)))))

64
gnu/system/shadow.scm
View File

@ -139,10 +139,11 @@
`(fontconfig (dir "/run/current-system/profile/share/fonts"))) `(fontconfig (dir "/run/current-system/profile/share/fonts")))
(define copy-guile-wm (define copy-guile-wm
#~(begin (with-imported-modules '((guix build utils))
(use-modules (guix build utils)) #~(begin
(copy-file (car (find-files #$guile-wm "wm-init-sample.scm")) (use-modules (guix build utils))
#$output))) (copy-file (car (find-files #$guile-wm "wm-init-sample.scm"))
#$output))))
(let ((profile (plain-file "bash_profile" "\ (let ((profile (plain-file "bash_profile" "\
# Honor per-interactive-shell startup file # Honor per-interactive-shell startup file
@ -176,27 +177,26 @@ alias ll='ls -l'\n"))
(zlogin (plain-file "zlogin" "\ (zlogin (plain-file "zlogin" "\
# Honor system-wide environment variables # Honor system-wide environment variables
source /etc/profile\n")) source /etc/profile\n"))
(guile-wm (computed-file "guile-wm" copy-guile-wm (guile-wm (computed-file "guile-wm" copy-guile-wm))
#:modules '((guix build utils))))
(xdefaults (plain-file "Xdefaults" "\ (xdefaults (plain-file "Xdefaults" "\
XTerm*utf8: always XTerm*utf8: always
XTerm*metaSendsEscape: true\n")) XTerm*metaSendsEscape: true\n"))
(fonts.conf (computed-file (fonts.conf (computed-file
"fonts.conf" "fonts.conf"
#~(begin (with-imported-modules '((guix build utils))
(use-modules (guix build utils) #~(begin
(sxml simple)) (use-modules (guix build utils)
(sxml simple))
(define dir (define dir
(string-append #$output (string-append #$output
"/fontconfig")) "/fontconfig"))
(mkdir-p dir) (mkdir-p dir)
(call-with-output-file (string-append dir (call-with-output-file (string-append dir
"/fonts.conf") "/fonts.conf")
(lambda (port) (lambda (port)
(sxml->xml '#$fonts.conf-content port)))) (sxml->xml '#$fonts.conf-content port)))))))
#:modules '((guix build utils))))
(gdbinit (plain-file "gdbinit" "\ (gdbinit (plain-file "gdbinit" "\
# Tell GDB where to look for separate debugging files. # Tell GDB where to look for separate debugging files.
set debug-file-directory ~/.guix-profile/lib/debug\n"))) set debug-file-directory ~/.guix-profile/lib/debug\n")))
@ -211,22 +211,22 @@ set debug-file-directory ~/.guix-profile/lib/debug\n")))
(define (skeleton-directory skeletons) (define (skeleton-directory skeletons)
"Return a directory containing SKELETONS, a list of name/derivation tuples." "Return a directory containing SKELETONS, a list of name/derivation tuples."
(computed-file "skel" (computed-file "skel"
#~(begin (with-imported-modules '((guix build utils))
(use-modules (ice-9 match) #~(begin
(guix build utils)) (use-modules (ice-9 match)
(guix build utils))
(mkdir #$output) (mkdir #$output)
(chdir #$output) (chdir #$output)
;; Note: copy the skeletons instead of symlinking ;; Note: copy the skeletons instead of symlinking
;; them like 'file-union' does, because 'useradd' ;; them like 'file-union' does, because 'useradd'
;; would just copy the symlinks as is. ;; would just copy the symlinks as is.
(for-each (match-lambda (for-each (match-lambda
((target source) ((target source)
(copy-recursively source target))) (copy-recursively source target)))
'#$skeletons) '#$skeletons)
#t) #t))))
#:modules '((guix build utils))))
(define (assert-valid-users/groups users groups) (define (assert-valid-users/groups users groups)
"Raise an error if USERS refer to groups not listed in GROUPS." "Raise an error if USERS refer to groups not listed in GROUPS."

40
gnu/system/vm.scm
View File

@ -155,34 +155,34 @@ made available under the /xchg CIFS share."
(define builder (define builder
;; Code that launches the VM that evaluates EXP. ;; Code that launches the VM that evaluates EXP.
#~(begin (with-imported-modules modules
(use-modules (guix build utils) #~(begin
(gnu build vm)) (use-modules (guix build utils)
(gnu build vm))
(let ((inputs '#$(list qemu coreutils)) (let ((inputs '#$(list qemu coreutils))
(linux (string-append #$linux "/bzImage")) (linux (string-append #$linux "/bzImage"))
(initrd (string-append #$initrd "/initrd")) (initrd (string-append #$initrd "/initrd"))
(loader #$loader) (loader #$loader)
(graphs '#$(match references-graphs (graphs '#$(match references-graphs
(((graph-files . _) ...) graph-files) (((graph-files . _) ...) graph-files)
(_ #f)))) (_ #f))))
(set-path-environment-variable "PATH" '("bin") inputs) (set-path-environment-variable "PATH" '("bin") inputs)
(load-in-linux-vm loader (load-in-linux-vm loader
#:output #$output #:output #$output
#:linux linux #:initrd initrd #:linux linux #:initrd initrd
#:memory-size #$memory-size #:memory-size #$memory-size
#:make-disk-image? #$make-disk-image? #:make-disk-image? #$make-disk-image?
#:disk-image-format #$disk-image-format #:disk-image-format #$disk-image-format
#:disk-image-size #$disk-image-size #:disk-image-size #$disk-image-size
#:references-graphs graphs)))) #:references-graphs graphs)))))
(gexp->derivation name builder (gexp->derivation name builder
;; TODO: Require the "kvm" feature. ;; TODO: Require the "kvm" feature.
#:system system #:system system
#:env-vars env-vars #:env-vars env-vars
#:modules modules
#:guile-for-build guile-for-build #:guile-for-build guile-for-build
#:references-graphs references-graphs))) #:references-graphs references-graphs)))

442
gnu/tests/base.scm
View File

@ -70,125 +70,125 @@
using COMMAND, a gexp that evaluates to a list of strings. Compare some using COMMAND, a gexp that evaluates to a list of strings. Compare some
properties of running system to what's declared in OS, an <operating-system>." properties of running system to what's declared in OS, an <operating-system>."
(define test (define test
#~(begin (with-imported-modules '((gnu build marionette))
(use-modules (gnu build marionette) #~(begin
(srfi srfi-1) (use-modules (gnu build marionette)
(srfi srfi-26) (srfi srfi-1)
(srfi srfi-64) (srfi srfi-26)
(ice-9 match)) (srfi srfi-64)
(ice-9 match))
(define marionette (define marionette
(make-marionette #$command)) (make-marionette #$command))
(mkdir #$output) (mkdir #$output)
(chdir #$output) (chdir #$output)
(test-begin "basic") (test-begin "basic")
(test-assert "uname" (test-assert "uname"
(match (marionette-eval '(uname) marionette) (match (marionette-eval '(uname) marionette)
(#("Linux" host-name version _ architecture) (#("Linux" host-name version _ architecture)
(and (string=? host-name (and (string=? host-name
#$(operating-system-host-name os)) #$(operating-system-host-name os))
(string-prefix? #$(package-version (string-prefix? #$(package-version
(operating-system-kernel os)) (operating-system-kernel os))
version) version)
(string-prefix? architecture %host-type))))) (string-prefix? architecture %host-type)))))
(test-assert "shell and user commands" (test-assert "shell and user commands"
;; Is everything in $PATH? ;; Is everything in $PATH?
(zero? (marionette-eval '(system " (zero? (marionette-eval '(system "
. /etc/profile . /etc/profile
set -e -x set -e -x
guix --version guix --version
ls --version ls --version
grep --version grep --version
info --version") info --version")
marionette))) marionette)))
(test-assert "accounts" (test-assert "accounts"
(let ((users (marionette-eval '(begin (let ((users (marionette-eval '(begin
(use-modules (ice-9 match)) (use-modules (ice-9 match))
(let loop ((result '())) (let loop ((result '()))
(match (getpw) (match (getpw)
(#f (reverse result)) (#f (reverse result))
(x (loop (cons x result)))))) (x (loop (cons x result))))))
marionette))) marionette)))
(lset= string=? (lset= string=?
(map passwd:name users) (map passwd:name users)
(list (list
#$@(map user-account-name #$@(map user-account-name
(operating-system-user-accounts os)))))) (operating-system-user-accounts os))))))
(test-assert "shepherd services" (test-assert "shepherd services"
(let ((services (marionette-eval '(begin (let ((services (marionette-eval '(begin
(use-modules (gnu services herd)) (use-modules (gnu services herd))
(call-with-values current-services (call-with-values current-services
append)) append))
marionette))) marionette)))
(lset= eq? (lset= eq?
(pk 'services services) (pk 'services services)
'(root #$@(operating-system-shepherd-service-names os))))) '(root #$@(operating-system-shepherd-service-names os)))))
(test-equal "login on tty1" (test-equal "login on tty1"
"root\n" "root\n"
(begin (begin
(marionette-control "sendkey ctrl-alt-f1" marionette) (marionette-control "sendkey ctrl-alt-f1" marionette)
;; Wait for the 'term-tty1' service to be running (using ;; Wait for the 'term-tty1' service to be running (using
;; 'start-service' is the simplest and most reliable way to do ;; 'start-service' is the simplest and most reliable way to do
;; that.) ;; that.)
(marionette-eval
'(begin
(use-modules (gnu services herd))
(start-service 'term-tty1))
marionette)
;; Now we can type.
(marionette-type "root\n\nid -un > logged-in\n" marionette)
;; It can take a while before the shell commands are executed.
(let loop ((i 0))
(unless (or (file-exists? "/root/logged-in") (> i 15))
(sleep 1)
(loop (+ i 1))))
(marionette-eval '(use-modules (rnrs io ports)) marionette)
(marionette-eval '(call-with-input-file "/root/logged-in"
get-string-all)
marionette)))
(test-assert "host name resolution"
(match (marionette-eval
'(begin
;; Wait for nscd or our requests go through it.
(use-modules (gnu services herd))
(start-service 'nscd)
(list (getaddrinfo "localhost")
(getaddrinfo #$(operating-system-host-name os))))
marionette)
((((? vector?) ..1) ((? vector?) ..1))
#t)
(x
(pk 'failure x #f))))
(test-equal "host not found"
#f
(marionette-eval (marionette-eval
'(begin '(false-if-exception (getaddrinfo "does-not-exist"))
(use-modules (gnu services herd)) marionette))
(start-service 'term-tty1))
marionette)
;; Now we can type. (test-assert "screendump"
(marionette-type "root\n\nid -un > logged-in\n" marionette) (begin
(marionette-control (string-append "screendump " #$output
"/tty1.ppm")
marionette)
(file-exists? "tty1.ppm")))
;; It can take a while before the shell commands are executed. (test-end)
(let loop ((i 0)) (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
(unless (or (file-exists? "/root/logged-in") (> i 15))
(sleep 1)
(loop (+ i 1))))
(marionette-eval '(use-modules (rnrs io ports)) marionette)
(marionette-eval '(call-with-input-file "/root/logged-in"
get-string-all)
marionette)))
(test-assert "host name resolution" (gexp->derivation name test))
(match (marionette-eval
'(begin
;; Wait for nscd or our requests go through it.
(use-modules (gnu services herd))
(start-service 'nscd)
(list (getaddrinfo "localhost")
(getaddrinfo #$(operating-system-host-name os))))
marionette)
((((? vector?) ..1) ((? vector?) ..1))
#t)
(x
(pk 'failure x #f))))
(test-equal "host not found"
#f
(marionette-eval
'(false-if-exception (getaddrinfo "does-not-exist"))
marionette))
(test-assert "screendump"
(begin
(marionette-control (string-append "screendump " #$output
"/tty1.ppm")
marionette)
(file-exists? "tty1.ppm")))
(test-end)
(exit (= (test-runner-fail-count (test-runner-current)) 0))))
(gexp->derivation name test
#:modules '((gnu build marionette))))
(define %test-basic-os (define %test-basic-os
(system-test (system-test
@ -243,67 +243,67 @@ functionality tests.")
(command (system-qemu-image/shared-store-script (command (system-qemu-image/shared-store-script
os #:graphic? #f))) os #:graphic? #f)))
(define test (define test
#~(begin (with-imported-modules '((gnu build marionette))
(use-modules (gnu build marionette) #~(begin
(srfi srfi-64) (use-modules (gnu build marionette)
(ice-9 match)) (srfi srfi-64)
(ice-9 match))
(define marionette (define marionette
(make-marionette (list #$command))) (make-marionette (list #$command)))
(define (wait-for-file file) (define (wait-for-file file)
;; Wait until FILE exists in the guest; 'read' its content and ;; Wait until FILE exists in the guest; 'read' its content and
;; return it. ;; return it.
(marionette-eval (marionette-eval
`(let loop ((i 10)) `(let loop ((i 10))
(cond ((file-exists? ,file) (cond ((file-exists? ,file)
(call-with-input-file ,file read)) (call-with-input-file ,file read))
((> i 0) ((> i 0)
(sleep 1) (sleep 1)
(loop (- i 1))) (loop (- i 1)))
(else (else
(error "file didn't show up" ,file)))) (error "file didn't show up" ,file))))
marionette)) marionette))
(mkdir #$output) (mkdir #$output)
(chdir #$output) (chdir #$output)
(test-begin "mcron") (test-begin "mcron")
(test-eq "service running" (test-eq "service running"
'running! 'running!
(marionette-eval (marionette-eval
'(begin '(begin
(use-modules (gnu services herd)) (use-modules (gnu services herd))
(start-service 'mcron) (start-service 'mcron)
'running!) 'running!)
marionette)) marionette))
;; Make sure root's mcron job runs, has its cwd set to "/root", and ;; Make sure root's mcron job runs, has its cwd set to "/root", and
;; runs with the right UID/GID. ;; runs with the right UID/GID.
(test-equal "root's job" (test-equal "root's job"
'(0 0) '(0 0)
(wait-for-file "/root/witness")) (wait-for-file "/root/witness"))
;; Likewise for Alice's job. We cannot know what its GID is since ;; Likewise for Alice's job. We cannot know what its GID is since
;; it's chosen by 'groupadd', but it's strictly positive. ;; it's chosen by 'groupadd', but it's strictly positive.
(test-assert "alice's job" (test-assert "alice's job"
(match (wait-for-file "/home/alice/witness") (match (wait-for-file "/home/alice/witness")
((1000 gid) ((1000 gid)
(>= gid 100)))) (>= gid 100))))
;; Last, the job that uses a command; allows us to test whether ;; Last, the job that uses a command; allows us to test whether
;; $PATH is sane. (Note that 'marionette-eval' stringifies objects ;; $PATH is sane. (Note that 'marionette-eval' stringifies objects
;; that don't have a read syntax, hence the string.) ;; that don't have a read syntax, hence the string.)
(test-equal "root's job with command" (test-equal "root's job with command"
"#<eof>" "#<eof>"
(wait-for-file "/root/witness-touch")) (wait-for-file "/root/witness-touch"))
(test-end) (test-end)
(exit (= (test-runner-fail-count (test-runner-current)) 0)))) (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
(gexp->derivation name test (gexp->derivation name test)))
#:modules '((gnu build marionette)))))
(define %test-mcron (define %test-mcron
(system-test (system-test
@ -355,90 +355,90 @@ functionality tests.")
".local")) ".local"))
(define test (define test
#~(begin (with-imported-modules '((gnu build marionette))
(use-modules (gnu build marionette) #~(begin
(srfi srfi-1) (use-modules (gnu build marionette)
(srfi srfi-64) (srfi srfi-1)
(ice-9 match)) (srfi srfi-64)
(ice-9 match))
(define marionette (define marionette
(make-marionette (list #$run))) (make-marionette (list #$run)))
(mkdir #$output) (mkdir #$output)
(chdir #$output) (chdir #$output)
(test-begin "avahi") (test-begin "avahi")
(test-assert "wait for services" (test-assert "wait for services"
(marionette-eval (marionette-eval
'(begin '(begin
(use-modules (gnu services herd)) (use-modules (gnu services herd))
(start-service 'nscd) (start-service 'nscd)
;; XXX: Work around a race condition in nscd: nscd creates its ;; XXX: Work around a race condition in nscd: nscd creates its
;; PID file before it is listening on its socket. ;; PID file before it is listening on its socket.
(let ((sock (socket PF_UNIX SOCK_STREAM 0))) (let ((sock (socket PF_UNIX SOCK_STREAM 0)))
(let try () (let try ()
(catch 'system-error (catch 'system-error
(lambda () (lambda ()
(connect sock AF_UNIX "/var/run/nscd/socket") (connect sock AF_UNIX "/var/run/nscd/socket")
(close-port sock) (close-port sock)
(format #t "nscd is ready~%")) (format #t "nscd is ready~%"))
(lambda args (lambda args
(format #t "waiting for nscd...~%") (format #t "waiting for nscd...~%")
(usleep 500000) (usleep 500000)
(try))))) (try)))))
;; Wait for the other useful things. ;; Wait for the other useful things.
(start-service 'avahi-daemon) (start-service 'avahi-daemon)
(start-service 'networking) (start-service 'networking)
#t) #t)
marionette)) marionette))
(test-equal "avahi-resolve-host-name" (test-equal "avahi-resolve-host-name"
0 0
(marionette-eval (marionette-eval
'(system* '(system*
"/run/current-system/profile/bin/avahi-resolve-host-name" "/run/current-system/profile/bin/avahi-resolve-host-name"
"-v" #$mdns-host-name) "-v" #$mdns-host-name)
marionette)) marionette))
(test-equal "avahi-browse" (test-equal "avahi-browse"
0 0
(marionette-eval (marionette-eval
'(system* "avahi-browse" "-avt") '(system* "avahi-browse" "-avt")
marionette)) marionette))
(test-assert "getaddrinfo .local" (test-assert "getaddrinfo .local"
;; Wait for the 'avahi-daemon' service and perform a resolution. ;; Wait for the 'avahi-daemon' service and perform a resolution.
(match (marionette-eval (match (marionette-eval
'(getaddrinfo #$mdns-host-name) '(getaddrinfo #$mdns-host-name)
marionette) marionette)
(((? vector? addrinfos) ..1) (((? vector? addrinfos) ..1)
(pk 'getaddrinfo addrinfos) (pk 'getaddrinfo addrinfos)
(and (any (lambda (ai) (and (any (lambda (ai)
(= AF_INET (addrinfo:fam ai))) (= AF_INET (addrinfo:fam ai)))
addrinfos) addrinfos)
(any (lambda (ai) (any (lambda (ai)
(= AF_INET6 (addrinfo:fam ai))) (= AF_INET6 (addrinfo:fam ai)))
addrinfos))))) addrinfos)))))
(test-assert "gethostbyname .local" (test-assert "gethostbyname .local"
(match (pk 'gethostbyname (match (pk 'gethostbyname
(marionette-eval '(gethostbyname #$mdns-host-name) (marionette-eval '(gethostbyname #$mdns-host-name)
marionette)) marionette))
((? vector? result) ((? vector? result)
(and (string=? (hostent:name result) #$mdns-host-name) (and (string=? (hostent:name result) #$mdns-host-name)
(= (hostent:addrtype result) AF_INET))))) (= (hostent:addrtype result) AF_INET)))))
(test-end) (test-end)
(exit (= (test-runner-fail-count (test-runner-current)) 0)))) (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
(gexp->derivation "nss-mdns" test (gexp->derivation "nss-mdns" test)))
#:modules '((gnu build marionette)))))
(define %test-nss-mdns (define %test-nss-mdns
(system-test (system-test

68
gnu/tests/install.scm
View File

@ -119,43 +119,45 @@ TARGET-SIZE bytes containing the installed system."
os (list target)) os (list target))
#:disk-image-size (* 1500 MiB)))) #:disk-image-size (* 1500 MiB))))
(define install (define install
#~(begin (with-imported-modules '((guix build utils)
(use-modules (guix build utils) (gnu build marionette))
(gnu build marionette)) #~(begin
(use-modules (guix build utils)
(gnu build marionette))
(set-path-environment-variable "PATH" '("bin") (set-path-environment-variable "PATH" '("bin")
(list #$qemu-minimal)) (list #$qemu-minimal))
(system* "qemu-img" "create" "-f" "qcow2" (system* "qemu-img" "create" "-f" "qcow2"
#$output #$(number->string target-size)) #$output #$(number->string target-size))
(define marionette (define marionette
(make-marionette (make-marionette
(cons (which #$(qemu-command system)) (cons (which #$(qemu-command system))
(cons* "-no-reboot" "-m" "800" (cons* "-no-reboot" "-m" "800"
"-drive" "-drive"
(string-append "file=" #$image (string-append "file=" #$image
",if=virtio,readonly") ",if=virtio,readonly")
"-drive" "-drive"
(string-append "file=" #$output ",if=virtio") (string-append "file=" #$output ",if=virtio")
(if (file-exists? "/dev/kvm") (if (file-exists? "/dev/kvm")
'("-enable-kvm") '("-enable-kvm")
'()))))) '())))))
(pk 'uname (marionette-eval '(uname) marionette)) (pk 'uname (marionette-eval '(uname) marionette))
;; Wait for tty1. ;; Wait for tty1.
(marionette-eval '(begin (marionette-eval '(begin
(use-modules (gnu services herd)) (use-modules (gnu services herd))
(start 'term-tty1)) (start 'term-tty1))
marionette) marionette)
(marionette-eval '(call-with-output-file "/etc/litl-config.scm" (marionette-eval '(call-with-output-file "/etc/litl-config.scm"
(lambda (port) (lambda (port)
(write '#$%minimal-os-source port))) (write '#$%minimal-os-source port)))
marionette) marionette)
(exit (marionette-eval '(zero? (system " (exit (marionette-eval '(zero? (system "
. /etc/profile . /etc/profile
set -e -x; set -e -x;
guix --version guix --version
@ -178,11 +180,9 @@ cp /etc/litl-config.scm /mnt/etc/config.scm
guix system init /mnt/etc/config.scm /mnt --no-substitutes guix system init /mnt/etc/config.scm /mnt --no-substitutes
sync sync
reboot\n")) reboot\n"))
marionette)))) marionette)))))
(gexp->derivation "installation" install (gexp->derivation "installation" install)))
#:modules '((guix build utils)
(gnu build marionette)))))
(define %test-installed-os (define %test-installed-os