linux-initrd: 'expression->initrd' returns the complete file name.

Previously 'expression->initrd' would return the directory that contains
the 'initrd' file; now it returns the complete file name for that file.

* gnu/system/linux-initrd.scm (expression->initrd)[builder]: Change
output file name to "initrd.cpio.gz".  Tail-call 'file-append' to return
the complete file name.
* gnu/system.scm (operating-system-initrd-file): Remove 'file-append'
call.
* gnu/build/linux-initrd.scm (write-cpio-archive): Check whether OUTPUT
already has the ".gz" suffix; rename if before invoking GZIP if it does,
and otherwise after.
* gnu/system/vm.scm (expression->derivation-in-linux-vm)[builder]: Do
not append "/initrd" to #$initrd.
This commit is contained in:
Ludovic Courtès 2018-11-21 16:19:09 +01:00
parent a29ce1f97d
commit d422cbb3d6
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
4 changed files with 28 additions and 16 deletions

View File

@ -72,11 +72,23 @@ COMPRESS? is true, compress it using GZIP. On success, return OUTPUT."
#:file->header cpio:file->cpio-header*)))
(or (not compress?)
;; Use '--no-name' so that gzip records neither a file name nor a time
;; stamp in its output.
(and (zero? (system* gzip "--best" "--no-name" output))
(rename-file (string-append output ".gz")
output))
;; Gzip insists on adding a '.gz' suffix and does nothing if the input
;; file already has that suffix. Shuffle files around to placate it.
(let* ((gz-suffix? (string-suffix? ".gz" output))
(sans-gz (if gz-suffix?
(string-drop-right output 3)
output)))
(when gz-suffix?
(rename-file output sans-gz))
;; Use '--no-name' so that gzip records neither a file name nor a time
;; stamp in its output.
(and (zero? (system* gzip "--best" "--no-name" sans-gz))
(begin
(unless gz-suffix?
(rename-file (string-append output ".gz") output))
output)))
output))
(define (cache-compiled-file-name file)

View File

@ -870,12 +870,11 @@ hardware-related operations as necessary when booting a Linux container."
(define make-initrd
(operating-system-initrd os))
(let ((initrd (make-initrd boot-file-systems
#:linux (operating-system-kernel os)
#:linux-modules
(operating-system-initrd-modules os)
#:mapped-devices mapped-devices)))
(file-append initrd "/initrd")))
(make-initrd boot-file-systems
#:linux (operating-system-kernel os)
#:linux-modules
(operating-system-initrd-modules os)
#:mapped-devices mapped-devices))
(define (locale-name->definition* name)
"Variant of 'locale-name->definition' that raises an error upon failure."

View File

@ -91,16 +91,17 @@ the derivations referenced by EXP are automatically copied to the initrd."
(lambda (port)
(simple-format port "~A\n" #$guile)))
(build-initrd (string-append #$output "/initrd")
(build-initrd (string-append #$output "/initrd.cpio.gz")
#:guile #$guile
#:init #$init
;; Copy everything INIT refers to into the initrd.
#:references-graphs '("closure")
#:gzip (string-append #$gzip "/bin/gzip")))))
(computed-file name builder
#:options
`(#:references-graphs (("closure" ,init)))))
(file-append (computed-file name builder
#:options
`(#:references-graphs (("closure" ,init))))
"/initrd.cpio.gz"))
(define (flat-linux-module-directory linux modules)
"Return a flat directory containing the Linux kernel modules listed in

View File

@ -213,7 +213,7 @@ made available under the /xchg CIFS share."
(let* ((inputs '#$(list qemu (canonical-package coreutils)))
(linux (string-append #$linux "/"
#$(system-linux-image-file-name)))
(initrd (string-append #$initrd "/initrd"))
(initrd #$initrd)
(loader #$loader)
(graphs '#$(match references-graphs
(((graph-files . _) ...) graph-files)