diff options
Diffstat (limited to 'gnu/build')
| -rw-r--r-- | gnu/build/linux-initrd.scm | 72 |
1 files changed, 35 insertions, 37 deletions
diff --git a/gnu/build/linux-initrd.scm b/gnu/build/linux-initrd.scm index 54639bd319..2c148836f3 100644 --- a/gnu/build/linux-initrd.scm +++ b/gnu/build/linux-initrd.scm @@ -1,5 +1,5 @@ ;;; 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. ;;; @@ -17,12 +17,12 @@ ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (gnu build linux-initrd) + #:use-module ((guix cpio) #:prefix cpio:) #:use-module (guix build utils) #:use-module (guix build store-copy) #:use-module (system base compile) #:use-module (rnrs bytevectors) #:use-module ((system foreign) #:select (sizeof)) - #:use-module (ice-9 popen) #:use-module (ice-9 ftw) #:export (write-cpio-archive build-initrd)) @@ -38,42 +38,42 @@ (define* (write-cpio-archive output directory #:key (compress? #t) - (cpio "cpio") (gzip "gzip")) - "Write a cpio archive containing DIRECTORY to file OUTPUT, using CPIO. When + (gzip "gzip")) + "Write a cpio archive containing DIRECTORY to file OUTPUT. When COMPRESS? is true, compress it using GZIP. On success, return OUTPUT." - ;; Note: don't use '--no-absolute-filenames' since that strips leading - ;; slashes from symlink targets. - (let ((pipe (open-pipe* OPEN_WRITE cpio "-o" "-O" output - "-H" "newc" "--null"))) - (define (print0 file) - (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." + ;; 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. - (file-system-fold (const #t) - (lambda (file stat result) ; leaf - (print0 file)) - (lambda (dir stat result) ; down - (unless (string=? dir directory) - (print0 dir))) - (const #f) ; up - (const #f) ; skip - (const #f) - #f - directory) - - (and (zero? (close-pipe pipe)) - (or (not compress?) - (and (zero? (system* gzip "--best" output)) - (rename-file (string-append output ".gz") - output)) - output)))) + (reverse + (file-system-fold (const #t) ;enter? + (lambda (file stat result) ;leaf + (cons file result)) + (lambda (dir stat result) ;down + (if (string=? dir directory) + result + (cons dir result))) + (lambda (file stat result) + result) + (const #f) ;skip + (const #f) ;error + '() + directory))) + + (call-with-output-file output + (lambda (port) + (cpio:write-cpio-archive files port))) + + (or (not compress?) + (and (zero? (system* gzip "--best" output)) + (rename-file (string-append output ".gz") + output)) + output)) (define (cache-compiled-file-name file) "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 guile init (references-graphs '()) - (cpio "cpio") (gzip "gzip")) "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 @@ -134,8 +133,7 @@ REFERENCES-GRAPHS." (utime file 0 0 0 0))) (find-files "." ".*")) - (write-cpio-archive output "." - #:cpio cpio #:gzip gzip)) + (write-cpio-archive output "." #:gzip gzip)) (delete-file-recursively "contents")) |