From: "Ludovic Courtès" <ludo@gnu.org>
To: 31633@debbugs.gnu.org
Subject: [bug#31633] [PATCH 7/7] vm: Use 'with-extensions'.
Date: Mon, 28 May 2018 23:59:30 +0200 [thread overview]
Message-ID: <20180528215930.23621-7-ludo@gnu.org> (raw)
In-Reply-To: <20180528215930.23621-1-ludo@gnu.org>
* gnu/system/vm.scm (system-docker-image)[build]: Use
'with-extensions'. Remove 'add-to-load-path' calls.
---
gnu/system/vm.scm | 93 +++++++++++++++++++++++------------------------
1 file changed, 46 insertions(+), 47 deletions(-)
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 4cffc71d7..66c6773c6 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -411,58 +411,57 @@ should set REGISTER-CLOSURES? to #f."
(eval-when (expand load eval)
(define %libgcrypt
#+(file-append libgcrypt "/lib/libgcrypt"))))))
+
(mlet %store-monad ((os-drv (operating-system-derivation os #:container? #t))
(name -> (string-append name ".tar.gz"))
(graph -> "system-graph"))
(define build
- (with-imported-modules `(,@(source-module-closure '((guix docker)
- (guix build utils)
- (gnu build vm))
- #:select? not-config?)
- (guix build store-copy)
- ((guix config) => ,config))
- #~(begin
- ;; Guile-JSON is required by (guix docker).
- (add-to-load-path
- (string-append #+guile-json "/share/guile/site/"
- (effective-version)))
- (use-modules (guix docker)
- (guix build utils)
- (gnu build vm)
- (srfi srfi-19)
- (guix build store-copy))
+ (with-extensions (list guile-json) ;for (guix docker)
+ (with-imported-modules `(,@(source-module-closure
+ '((guix docker)
+ (guix build utils)
+ (gnu build vm))
+ #:select? not-config?)
+ (guix build store-copy)
+ ((guix config) => ,config))
+ #~(begin
+ (use-modules (guix docker)
+ (guix build utils)
+ (gnu build vm)
+ (srfi srfi-19)
+ (guix build store-copy))
- (let* ((inputs '#$(append (list tar)
- (if register-closures?
- (list guix)
- '())))
- ;; This initializer requires elevated privileges that are
- ;; not normally available in the build environment (e.g.,
- ;; it needs to create device nodes). In order to obtain
- ;; such privileges, we run it as root in a VM.
- (initialize (root-partition-initializer
- #:closures '(#$graph)
- #:register-closures? #$register-closures?
- #:system-directory #$os-drv
- ;; De-duplication would fail due to
- ;; cross-device link errors, so don't do it.
- #:deduplicate? #f))
- ;; Even as root in a VM, the initializer would fail due to
- ;; lack of privileges if we use a root-directory that is on
- ;; a file system that is shared with the host (e.g., /tmp).
- (root-directory "/guixsd-system-root"))
- (set-path-environment-variable "PATH" '("bin" "sbin") inputs)
- (mkdir root-directory)
- (initialize root-directory)
- (build-docker-image
- (string-append "/xchg/" #$name) ;; The output file.
- (cons* root-directory
- (call-with-input-file (string-append "/xchg/" #$graph)
- read-reference-graph))
- #$os-drv
- #:compressor '(#+(file-append gzip "/bin/gzip") "-9n")
- #:creation-time (make-time time-utc 0 1)
- #:transformations `((,root-directory -> "")))))))
+ (let* ((inputs '#$(append (list tar)
+ (if register-closures?
+ (list guix)
+ '())))
+ ;; This initializer requires elevated privileges that are
+ ;; not normally available in the build environment (e.g.,
+ ;; it needs to create device nodes). In order to obtain
+ ;; such privileges, we run it as root in a VM.
+ (initialize (root-partition-initializer
+ #:closures '(#$graph)
+ #:register-closures? #$register-closures?
+ #:system-directory #$os-drv
+ ;; De-duplication would fail due to
+ ;; cross-device link errors, so don't do it.
+ #:deduplicate? #f))
+ ;; Even as root in a VM, the initializer would fail due to
+ ;; lack of privileges if we use a root-directory that is on
+ ;; a file system that is shared with the host (e.g., /tmp).
+ (root-directory "/guixsd-system-root"))
+ (set-path-environment-variable "PATH" '("bin" "sbin") inputs)
+ (mkdir root-directory)
+ (initialize root-directory)
+ (build-docker-image
+ (string-append "/xchg/" #$name) ;; The output file.
+ (cons* root-directory
+ (call-with-input-file (string-append "/xchg/" #$graph)
+ read-reference-graph))
+ #$os-drv
+ #:compressor '(#+(file-append gzip "/bin/gzip") "-9n")
+ #:creation-time (make-time time-utc 0 1)
+ #:transformations `((,root-directory -> ""))))))))
(expression->derivation-in-linux-vm
name
;; The VM's initrd Guile doesn't support dlopen, but our "build" gexp
--
2.17.0
next prev parent reply other threads:[~2018-05-28 22:00 UTC|newest]
Thread overview: 10+ messages / expand[flat|nested] mbox.gz Atom feed top
2018-05-28 21:56 [bug#31633] [PATCH 0/7] Add 'with-extensions' for gexps Ludovic Courtès
2018-05-28 21:59 ` [bug#31633] [PATCH 1/7] gexp: Add 'with-extensions' Ludovic Courtès
2018-05-28 21:59 ` [bug#31633] [PATCH 2/7] pack: Use 'with-extensions' when referring to (guix docker) Ludovic Courtès
2018-05-28 21:59 ` [bug#31633] [PATCH 3/7] tests: ssh: Use 'with-extensions' Ludovic Courtès
2018-05-28 21:59 ` [bug#31633] [PATCH 4/7] bootloader: grub: Simplify 'svg->png' Ludovic Courtès
2018-05-28 21:59 ` [bug#31633] [PATCH 5/7] bootloader: grub: Use 'with-extensions' Ludovic Courtès
2018-05-28 21:59 ` [bug#31633] [PATCH 6/7] profiles: " Ludovic Courtès
2018-05-28 21:59 ` Ludovic Courtès [this message]
2018-06-01 7:37 ` [bug#31633] [PATCH 0/7] Add 'with-extensions' for gexps Danny Milosavljevic
2018-06-01 13:42 ` bug#31633: " Ludovic Courtès
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://guix.gnu.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20180528215930.23621-7-ludo@gnu.org \
--to=ludo@gnu.org \
--cc=31633@debbugs.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).