mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 21:38:07 -05:00
gnu: Use 'gexp->file' in conjunction with 'with-imported-modules'.
* gnu/services.scm (activation-script): Remove code to set '%load-path' and use 'with-imported-modules' instead. (cleanup-gexp): Likewise. * gnu/system/vm.scm (%vm-module-closure): New variable. (expression->derivation-in-linux-vm): Remove #:modules. [loader]: Remove code to set '%load-path'. [builder]: Use %VM-MODULE-CLOSURE. (qemu-image): Use 'with-imported-modules'.
This commit is contained in:
Ludovic Courtès
parent
2b4185792d
commit
fd12989398
2 changed files with 92 additions and 114 deletions
|
|
@ -238,18 +238,9 @@ (define %boot-service
|
|||
(define (cleanup-gexp _)
|
||||
"Return as a monadic value a gexp to clean up /tmp and similar places upon
|
||||
boot."
|
||||
(define %modules
|
||||
'((guix build utils)))
|
||||
|
||||
(mlet %store-monad ((modules (imported-modules %modules))
|
||||
(compiled (compiled-modules %modules)))
|
||||
(with-monad %store-monad
|
||||
(with-imported-modules '((guix build utils))
|
||||
(return #~(begin
|
||||
(eval-when (expand load eval)
|
||||
;; Make sure 'use-modules' below succeeds.
|
||||
(set! %load-path (cons #$modules %load-path))
|
||||
(set! %load-compiled-path
|
||||
(cons #$compiled %load-compiled-path)))
|
||||
|
||||
(use-modules (guix build utils))
|
||||
|
||||
;; Clean out /tmp and /var/run.
|
||||
|
|
@ -273,7 +264,7 @@ (define %modules
|
|||
(mkdir "/tmp")
|
||||
(chmod "/tmp" #o1777)
|
||||
(mkdir "/var/run")
|
||||
(chmod "/var/run" #o755)))))))
|
||||
(chmod "/var/run" #o755))))))))
|
||||
|
||||
(define cleanup-service-type
|
||||
;; Service that cleans things up in /tmp and similar.
|
||||
|
|
@ -337,17 +328,10 @@ (define (service-activations)
|
|||
(cut gexp->file "activate-service" <>)
|
||||
gexps))
|
||||
|
||||
(mlet* %store-monad ((actions (service-activations))
|
||||
(modules (imported-modules %modules))
|
||||
(compiled (compiled-modules %modules)))
|
||||
(mlet* %store-monad ((actions (service-activations)))
|
||||
(gexp->file "activate"
|
||||
(with-imported-modules %modules
|
||||
#~(begin
|
||||
(eval-when (expand load eval)
|
||||
;; Make sure 'use-modules' below succeeds.
|
||||
(set! %load-path (cons #$modules %load-path))
|
||||
(set! %load-compiled-path
|
||||
(cons #$compiled %load-compiled-path)))
|
||||
|
||||
(use-modules (gnu build activation))
|
||||
|
||||
;; Make sure /bin/sh is valid and current.
|
||||
|
|
@ -359,7 +343,7 @@ (define (service-activations)
|
|||
(for-each primitive-load '#$actions)
|
||||
|
||||
;; Set up /run/current-system.
|
||||
(activate-current-system)))))
|
||||
(activate-current-system))))))
|
||||
|
||||
(define (gexps->activation-gexp gexps)
|
||||
"Return a gexp that runs the activation script containing GEXPS."
|
||||
|
|
|
|||
|
|
@ -90,14 +90,9 @@ (define %linux-vm-file-systems
|
|||
(options "trans=virtio")
|
||||
(check? #f))))
|
||||
|
||||
(define* (expression->derivation-in-linux-vm name exp
|
||||
#:key
|
||||
(system (%current-system))
|
||||
(linux linux-libre)
|
||||
initrd
|
||||
(qemu qemu-minimal)
|
||||
(env-vars '())
|
||||
(modules
|
||||
(define %vm-module-closure
|
||||
;; The closure of (gnu build vm), roughly.
|
||||
;; FIXME: Compute it automatically.
|
||||
'((gnu build vm)
|
||||
(gnu build install)
|
||||
(gnu build linux-boot)
|
||||
|
|
@ -109,6 +104,14 @@ (define* (expression->derivation-in-linux-vm name exp
|
|||
(guix build syscalls)
|
||||
(guix build bournish)
|
||||
(guix build store-copy)))
|
||||
|
||||
(define* (expression->derivation-in-linux-vm name exp
|
||||
#:key
|
||||
(system (%current-system))
|
||||
(linux linux-libre)
|
||||
initrd
|
||||
(qemu qemu-minimal)
|
||||
(env-vars '())
|
||||
(guile-for-build
|
||||
(%guile-for-build))
|
||||
|
||||
|
|
@ -128,23 +131,13 @@ (define* (expression->derivation-in-linux-vm name exp
|
|||
DISK-IMAGE-FORMAT (e.g., 'qcow2' or 'raw'), of DISK-IMAGE-SIZE bytes and
|
||||
return it.
|
||||
|
||||
MODULES is the set of modules imported in the execution environment of EXP.
|
||||
|
||||
When REFERENCES-GRAPHS is true, it must be a list of file name/store path
|
||||
pairs, as for `derivation'. The files containing the reference graphs are
|
||||
made available under the /xchg CIFS share."
|
||||
(mlet* %store-monad
|
||||
((module-dir (imported-modules modules))
|
||||
(compiled (compiled-modules modules))
|
||||
(user-builder (gexp->file "builder-in-linux-vm" exp))
|
||||
((user-builder (gexp->file "builder-in-linux-vm" exp))
|
||||
(loader (gexp->file "linux-vm-loader"
|
||||
#~(begin
|
||||
(set! %load-path
|
||||
(cons #$module-dir %load-path))
|
||||
(set! %load-compiled-path
|
||||
(cons #$compiled
|
||||
%load-compiled-path))
|
||||
(primitive-load #$user-builder))))
|
||||
#~(primitive-load #$user-builder)))
|
||||
(coreutils -> (canonical-package coreutils))
|
||||
(initrd (if initrd ; use the default initrd?
|
||||
(return initrd)
|
||||
|
|
@ -155,7 +148,7 @@ (define* (expression->derivation-in-linux-vm name exp
|
|||
|
||||
(define builder
|
||||
;; Code that launches the VM that evaluates EXP.
|
||||
(with-imported-modules modules
|
||||
(with-imported-modules %vm-module-closure
|
||||
#~(begin
|
||||
(use-modules (guix build utils)
|
||||
(gnu build vm))
|
||||
|
|
@ -212,6 +205,7 @@ (define* (qemu-image #:key
|
|||
the image."
|
||||
(expression->derivation-in-linux-vm
|
||||
name
|
||||
(with-imported-modules %vm-module-closure
|
||||
#~(begin
|
||||
(use-modules (gnu build vm)
|
||||
(guix build utils))
|
||||
|
|
@ -250,7 +244,7 @@ (define* (qemu-image #:key
|
|||
(initialize-hard-disk "/dev/vda"
|
||||
#:partitions partitions
|
||||
#:grub.cfg #$grub-configuration)
|
||||
(reboot))))
|
||||
(reboot)))))
|
||||
#:system system
|
||||
#:make-disk-image? #t
|
||||
#:disk-image-size disk-image-size
|
||||
|
|
|
|||
Loading…
Reference in a new issue