linux-initrd: Use (guix cpio) instead of GNU cpio.

* gnu/build/linux-initrd.scm (write-cpio-archive): Remove 'open-pipe*' and
  related calls.  Compute list of files in 'files' variable.  Use
  'cpio:write-cpio-archive'.  Remove #:cpio parameter.
  (build-initrd): Remove #:cpio parameter.
* gnu/system/linux-initrd.scm (expression->initrd): Likewise, and adjust
  BUILDER accordingly.  Add (guix cpio) to #:modules.
This commit is contained in:
Ludovic Courtès 2015-06-24 17:41:43 +02:00
parent 7a18c3cc10
commit e8277f90c8
2 changed files with 36 additions and 40 deletions

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -17,12 +17,12 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu build linux-initrd) (define-module (gnu build linux-initrd)
#:use-module ((guix cpio) #:prefix cpio:)
#:use-module (guix build utils) #:use-module (guix build utils)
#:use-module (guix build store-copy) #:use-module (guix build store-copy)
#:use-module (system base compile) #:use-module (system base compile)
#:use-module (rnrs bytevectors) #:use-module (rnrs bytevectors)
#:use-module ((system foreign) #:select (sizeof)) #:use-module ((system foreign) #:select (sizeof))
#:use-module (ice-9 popen)
#:use-module (ice-9 ftw) #:use-module (ice-9 ftw)
#:export (write-cpio-archive #:export (write-cpio-archive
build-initrd)) build-initrd))
@ -38,42 +38,42 @@
(define* (write-cpio-archive output directory (define* (write-cpio-archive output directory
#:key #:key
(compress? #t) (compress? #t)
(cpio "cpio") (gzip "gzip")) (gzip "gzip"))
"Write a cpio archive containing DIRECTORY to file OUTPUT, using CPIO. When "Write a cpio archive containing DIRECTORY to file OUTPUT. When
COMPRESS? is true, compress it using GZIP. On success, return OUTPUT." COMPRESS? is true, compress it using GZIP. On success, return OUTPUT."
;; Note: don't use '--no-absolute-filenames' since that strips leading ;; Note: as per `ramfs-rootfs-initramfs.txt', always add directory entries
;; slashes from symlink targets. ;; before the files that are inside of it: "The Linux kernel cpio
(let ((pipe (open-pipe* OPEN_WRITE cpio "-o" "-O" output ;; extractor won't create files in a directory that doesn't exist, so the
"-H" "newc" "--null"))) ;; directory entries must go before the files that go in those
(define (print0 file) ;; directories."
(format pipe "~a\0" file))
;; Note: as per `ramfs-rootfs-initramfs.txt', always add directory entries
;; before the files that are inside of it: "The Linux kernel cpio
;; extractor won't create files in a directory that doesn't exist, so the
;; directory entries must go before the files that go in those
;; directories."
(define files
;; XXX: Use a deterministic order. ;; XXX: Use a deterministic order.
(file-system-fold (const #t) (reverse
(lambda (file stat result) ; leaf (file-system-fold (const #t) ;enter?
(print0 file)) (lambda (file stat result) ;leaf
(lambda (dir stat result) ; down (cons file result))
(unless (string=? dir directory) (lambda (dir stat result) ;down
(print0 dir))) (if (string=? dir directory)
(const #f) ; up result
(const #f) ; skip (cons dir result)))
(const #f) (lambda (file stat result)
#f result)
directory) (const #f) ;skip
(const #f) ;error
'()
directory)))
(and (zero? (close-pipe pipe)) (call-with-output-file output
(or (not compress?) (lambda (port)
(and (zero? (system* gzip "--best" output)) (cpio:write-cpio-archive files port)))
(rename-file (string-append output ".gz")
output)) (or (not compress?)
output)))) (and (zero? (system* gzip "--best" output))
(rename-file (string-append output ".gz")
output))
output))
(define (cache-compiled-file-name file) (define (cache-compiled-file-name file)
"Return the file name of the in-cache .go file for FILE, relative to the "Return the file name of the in-cache .go file for FILE, relative to the
@ -105,7 +105,6 @@ This is similar to what 'compiled-file-name' in (system base compile) does."
#:key #:key
guile init guile init
(references-graphs '()) (references-graphs '())
(cpio "cpio")
(gzip "gzip")) (gzip "gzip"))
"Write an initial RAM disk (initrd) to OUTPUT. The initrd starts the script "Write an initial RAM disk (initrd) to OUTPUT. The initrd starts the script
at INIT, running GUILE. It contains all the items referred to by at INIT, running GUILE. It contains all the items referred to by
@ -134,8 +133,7 @@ REFERENCES-GRAPHS."
(utime file 0 0 0 0))) (utime file 0 0 0 0)))
(find-files "." ".*")) (find-files "." ".*"))
(write-cpio-archive output "." (write-cpio-archive output "." #:gzip gzip))
#:cpio cpio #:gzip gzip))
(delete-file-recursively "contents")) (delete-file-recursively "contents"))

@ -25,7 +25,6 @@
#:select (%store-prefix)) #:select (%store-prefix))
#:use-module ((guix derivations) #:use-module ((guix derivations)
#:select (derivation->output-path)) #:select (derivation->output-path))
#:use-module (gnu packages cpio)
#:use-module (gnu packages compression) #:use-module (gnu packages compression)
#:use-module (gnu packages linux) #:use-module (gnu packages linux)
#:use-module (gnu packages guile) #:use-module (gnu packages guile)
@ -51,7 +50,6 @@
(define* (expression->initrd exp (define* (expression->initrd exp
#:key #:key
(guile %guile-static-stripped) (guile %guile-static-stripped)
(cpio cpio)
(gzip gzip) (gzip gzip)
(name "guile-initrd") (name "guile-initrd")
(system (%current-system)) (system (%current-system))
@ -78,11 +76,11 @@ MODULES is a list of Guile module names to be embedded in the initrd."
#: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")
#:cpio (string-append #$cpio "/bin/cpio")
#:gzip (string-append #$gzip "/bin/gzip")))) #:gzip (string-append #$gzip "/bin/gzip"))))
(gexp->derivation name builder (gexp->derivation name builder
#:modules '((guix build utils) #:modules '((guix cpio)
(guix build utils)
(guix build store-copy) (guix build store-copy)
(gnu build linux-initrd)) (gnu build linux-initrd))
#:references-graphs `(("closure" ,init))))) #:references-graphs `(("closure" ,init)))))