nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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.
This commit is contained in:
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.
@deffn {Monadic Procedure} expression->initrd @var{exp} @
[#:guile %guile-static-stripped] [#:name "guile-initrd"] @
[#:modules '()]
[#:guile %guile-static-stripped] [#:name "guile-initrd"]
Return a derivation that builds a Linux initrd (a gzipped cpio archive)
containing @var{guile} and that evaluates @var{exp}, a G-expression,
upon booting. All the derivations referenced by @var{exp} are
automatically copied to the initrd.
@var{modules} is a list of Guile module names to be embedded in the
initrd.
@end deffn
@node GRUB Configuration

4
gnu/services.scm
View File

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

12
gnu/services/base.scm
View File

@ -1138,6 +1138,8 @@ 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
item of @var{packages}."
(define build
(with-imported-modules '((guix build union)
(guix build utils))
#~(begin
(use-modules (guix build union)
(guix build utils)
@ -1155,15 +1157,14 @@ item of @var{packages}."
(mkdir-p (string-append #$output "/lib/udev"))
(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
#:modules '((guix build union)
(guix build utils))))
(computed-file "udev-rules" build))
(define (udev-rule file-name contents)
"Return a directory with a udev rule file FILE-NAME containing CONTENTS."
(computed-file file-name
(with-imported-modules '((guix build utils))
#~(begin
(use-modules (guix build utils))
@ -1174,8 +1175,7 @@ item of @var{packages}."
(call-with-output-file
(string-append rules.d "/" #$file-name)
(lambda (port)
(display #$contents port))))
#:modules '((guix build utils))))
(display #$contents port)))))))
(define kvm-udev-rule
;; Return a directory with a udev rule that changes the group of /dev/kvm to

7
gnu/services/dbus.scm
View File

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

13
gnu/services/desktop.scm
View File

@ -91,7 +91,8 @@ is set to @var{value} when the bus daemon launches it."
(string-append #$service "/" #$program)
(cdr (command-line))))))
(computed-file (string-append (package-name service) "-wrapper")
(define build
(with-imported-modules '((guix build utils))
#~(begin
(use-modules (guix build utils))
@ -113,8 +114,10 @@ is set to @var{value} when the bus daemon launches it."
_ original-program arguments)
(string-append "Exec=" #$wrapper arguments
"\n"))))
(find-files #$output "\\.service$")))
#:modules '((guix build utils))))
(find-files #$output "\\.service$")))))
(computed-file (string-append (package-name service) "-wrapper")
build))
;;;
@ -408,6 +411,7 @@ Users need to be in the @code{lp} group to access the D-Bus service.
(define (polkit-directory packages)
"Return a directory containing an @file{actions} and possibly a
@file{rules.d} sub-directory, for use as @file{/etc/polkit-1}."
(with-imported-modules '((guix build union))
(computed-file "etc-polkit-1"
#~(begin
(use-modules (guix build union) (srfi srfi-26))
@ -415,8 +419,7 @@ Users need to be in the @code{lp} group to access the D-Bus service.
(union-build #$output
(map (cut string-append <>
"/share/polkit-1")
(list #$@packages))))
#:modules '((guix build union))))
(list #$@packages)))))))
(define polkit-etc-files
(match-lambda

6
gnu/services/networking.scm
View File

@ -1,5 +1,5 @@
;;; 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 © 2016 Efraim Flashner <efraim@flashner.co.il>
;;;
@ -345,6 +345,7 @@ keep the system clock synchronized with that of @var{servers}."
(($ <tor-configuration> tor config-file services)
(computed-file
"torrc"
(with-imported-modules '((guix build utils))
#~(begin
(use-modules (guix build utils)
(ice-9 match))
@ -376,8 +377,7 @@ HiddenServicePort ~a ~a~%"
(call-with-input-file #$config-file
(lambda (input)
(dump-port input port)))
#t)))
#:modules '((guix build utils))))))
#t))))))))
(define (tor-shepherd-service config)
"Return a <shepherd-service> running TOR."

4
gnu/services/xorg.scm
View File

@ -158,6 +158,7 @@ EndSection
"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
in @var{modules}."
(with-imported-modules '((guix build utils))
(computed-file "xorg.conf.d"
#~(begin
(use-modules (guix build utils)
@ -177,8 +178,7 @@ in @var{modules}."
(string-append #$output "/"
(basename file))))
files)
#t)
#:modules '((guix build utils))))
#t))))
(define* (xorg-start-command #:key
(guile (canonical-package guile-2.0))

27
gnu/system/install.scm
View File

@ -55,6 +55,9 @@ under /root/.guix-profile where GUIX is installed."
(manifest
(list (package->manifest-entry guix))))))
(define build
(with-imported-modules '((guix build utils)
(guix build store-copy)
(gnu build install))
#~(begin
(use-modules (guix build utils)
(gnu build install))
@ -64,8 +67,9 @@ under /root/.guix-profile where GUIX is installed."
(setenv "PATH"
(string-append #$guix "/sbin:" #$tar "/bin:" #$xz "/bin"))
;; Note: there is not much to gain here with deduplication and there
;; is the overhead of the '.links' directory, so turn it off.
;; Note: there is not much to gain here with deduplication and
;; there is the overhead of the '.links' directory, so turn it
;; off.
(populate-single-profile-directory %root
#:profile #$profile
#:closure "profile"
@ -87,20 +91,17 @@ under /root/.guix-profile where GUIX is installed."
"--check-links"
"-cvf" #$output
;; Avoid adding / and /var to the tarball,
;; so that the ownership and permissions of those
;; Avoid adding / and /var to the tarball, so
;; that the ownership and permissions of those
;; directories will not be overwritten when
;; extracting the archive. Do not include /root
;; because the root account might have a different
;; home directory.
;; because the root account might have a
;; different home directory.
"./var/guix"
(string-append "." (%store-directory)))))))
(string-append "." (%store-directory))))))))
(gexp->derivation "guix-tarball.tar.xz" build
#:references-graphs `(("profile" ,profile))
#:modules '((guix build utils)
(guix build store-copy)
(gnu build install)))))
#:references-graphs `(("profile" ,profile)))))
(define (log-to-info)
@ -212,6 +213,7 @@ the user's target storage device rather than on the RAM disk."
(define directory
(computed-file "configuration-templates"
(with-imported-modules '((guix build utils))
#~(begin
(mkdir #$output)
(for-each (lambda (file target)
@ -224,8 +226,7 @@ the user's target storage device rather than on the RAM disk."
'("bare-bones.scm"
"desktop.scm"
"lightweight-desktop.scm"))
#t)
#:modules '((guix build utils))))
#t))))
`(("configuration" ,directory)))

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

@ -87,6 +87,13 @@ that will be shared with the host system."
#:container? #t)))
(define script
(with-imported-modules '((guix config)
(guix 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))
@ -102,15 +109,6 @@ that will be shared with the host system."
;; users and groups, which is sufficient for most cases.
;;
;; See: http://www.freedesktop.org/software/systemd/man/systemd-nspawn.html#--private-users=
#:host-uids 65536)))
#:host-uids 65536))))
(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))))))
(gexp->script "run-container" script))))

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

@ -55,21 +55,21 @@
(guile %guile-static-stripped)
(gzip gzip)
(name "guile-initrd")
(system (%current-system))
(modules '()))
(system (%current-system)))
"Return a derivation that builds a Linux initrd (a gzipped cpio archive)
containing GUILE and that evaluates EXP, a G-expression, upon booting. All
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."
the derivations referenced by EXP are automatically copied to the initrd."
;; General Linux overview in `Documentation/early-userspace/README' and
;; `Documentation/filesystems/ramfs-rootfs-initramfs.txt'.
(mlet %store-monad ((init (gexp->script "init" exp
#:modules modules
#:guile guile)))
(define builder
(with-imported-modules '((guix cpio)
(guix build utils)
(guix build store-copy)
(gnu build linux-initrd))
#~(begin
(use-modules (gnu build linux-initrd))
@ -79,19 +79,18 @@ MODULES is a list of Guile module names to be embedded in the initrd."
#:init #$init
;; Copy everything INIT refers to into the initrd.
#:references-graphs '("closure")
#:gzip (string-append #$gzip "/bin/gzip"))))
#:gzip (string-append #$gzip "/bin/gzip")))))
(gexp->derivation name builder
#:modules '((guix cpio)
(guix build utils)
(guix build store-copy)
(gnu build linux-initrd))
#:references-graphs `(("closure" ,init)))))
(define (flat-linux-module-directory linux modules)
"Return a flat directory containing the Linux kernel modules listed in
MODULES and taken from LINUX."
(define build-exp
(with-imported-modules '((guix build utils)
(guix elf)
(gnu build linux-modules))
#~(begin
(use-modules (ice-9 match) (ice-9 regex)
(srfi srfi-1)
@ -128,12 +127,9 @@ MODULES and taken from LINUX."
(copy-file module
(string-append #$output "/"
(basename module))))
(delete-duplicates modules))))
(delete-duplicates modules)))))
(gexp->derivation "linux-modules" build-exp
#:modules '((guix build utils)
(guix elf)
(gnu build linux-modules))))
(gexp->derivation "linux-modules" build-exp))
(define* (base-initrd file-systems
#:key
@ -227,6 +223,13 @@ loaded at boot time in the order in which they appear."
(mlet %store-monad ((kodir (flat-linux-module-directory linux
linux-modules)))
(expression->initrd
(with-imported-modules '((guix build bournish)
(guix build utils)
(guix build syscalls)
(gnu build linux-boot)
(gnu build linux-modules)
(gnu build file-systems)
(guix elf))
#~(begin
(use-modules (gnu build linux-boot)
(guix build utils)
@ -251,14 +254,7 @@ loaded at boot time in the order in which they appear."
#:linux-modules '#$linux-modules
#:linux-module-directory '#$kodir
#:qemu-guest-networking? #$qemu-networking?
#:volatile-root? '#$volatile-root?))
#: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)))))
#:volatile-root? '#$volatile-root?)))
#:name "base-initrd")))
;;; linux-initrd.scm ends here

4
gnu/system/locale.scm
View File

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

14
gnu/system/shadow.scm
View File

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

4
gnu/system/vm.scm
View File

@ -155,6 +155,7 @@ made available under the /xchg CIFS share."
(define builder
;; Code that launches the VM that evaluates EXP.
(with-imported-modules modules
#~(begin
(use-modules (guix build utils)
(gnu build vm))
@ -176,13 +177,12 @@ made available under the /xchg CIFS share."
#:make-disk-image? #$make-disk-image?
#:disk-image-format #$disk-image-format
#:disk-image-size #$disk-image-size
#:references-graphs graphs))))
#:references-graphs graphs)))))
(gexp->derivation name builder
;; TODO: Require the "kvm" feature.
#:system system
#:env-vars env-vars
#:modules modules
#:guile-for-build guile-for-build
#:references-graphs references-graphs)))

18
gnu/tests/base.scm
View File

@ -70,6 +70,7 @@
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>."
(define test
(with-imported-modules '((gnu build marionette))
#~(begin
(use-modules (gnu build marionette)
(srfi srfi-1)
@ -185,10 +186,9 @@ info --version")
(file-exists? "tty1.ppm")))
(test-end)
(exit (= (test-runner-fail-count (test-runner-current)) 0))))
(exit (= (test-runner-fail-count (test-runner-current)) 0)))))
(gexp->derivation name test
#:modules '((gnu build marionette))))
(gexp->derivation name test))
(define %test-basic-os
(system-test
@ -243,6 +243,7 @@ functionality tests.")
(command (system-qemu-image/shared-store-script
os #:graphic? #f)))
(define test
(with-imported-modules '((gnu build marionette))
#~(begin
(use-modules (gnu build marionette)
(srfi srfi-64)
@ -300,10 +301,9 @@ functionality tests.")
(wait-for-file "/root/witness-touch"))
(test-end)
(exit (= (test-runner-fail-count (test-runner-current)) 0))))
(exit (= (test-runner-fail-count (test-runner-current)) 0)))))
(gexp->derivation name test
#:modules '((gnu build marionette)))))
(gexp->derivation name test)))
(define %test-mcron
(system-test
@ -355,6 +355,7 @@ functionality tests.")
".local"))
(define test
(with-imported-modules '((gnu build marionette))
#~(begin
(use-modules (gnu build marionette)
(srfi srfi-1)
@ -435,10 +436,9 @@ functionality tests.")
(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
#:modules '((gnu build marionette)))))
(gexp->derivation "nss-mdns" test)))
(define %test-nss-mdns
(system-test

8
gnu/tests/install.scm
View File

@ -119,6 +119,8 @@ TARGET-SIZE bytes containing the installed system."
os (list target))
#:disk-image-size (* 1500 MiB))))
(define install
(with-imported-modules '((guix build utils)
(gnu build marionette))
#~(begin
(use-modules (guix build utils)
(gnu build marionette))
@ -178,11 +180,9 @@ cp /etc/litl-config.scm /mnt/etc/config.scm
guix system init /mnt/etc/config.scm /mnt --no-substitutes
sync
reboot\n"))
marionette))))
marionette)))))
(gexp->derivation "installation" install
#:modules '((guix build utils)
(gnu build marionette)))))
(gexp->derivation "installation" install)))
(define %test-installed-os