;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2018, 2020 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
#:key
(compress? #t)
(gzip "gzip"))
- "Write a cpio archive containing DIRECTORY to file OUTPUT. When
-COMPRESS? is true, compress it using GZIP. On success, return OUTPUT."
+ "Write a cpio archive containing DIRECTORY to file OUTPUT, with reset
+timestamps in the archive. When COMPRESS? is true, compress it using GZIP.
+On success, return OUTPUT."
;; Note: as per `ramfs-rootfs-initramfs.txt', always add directory entries
;; before the files that are inside of it: "The Linux kernel cpio
;; directories."
(define files
- ;; XXX: Use a deterministic order.
- (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)))
+ ;; Use 'sort' so that (1) the order of files is deterministic, and (2)
+ ;; directories appear before the files they contain.
+ (sort (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)
+ string<?))
(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))
+ (cpio:write-cpio-archive files port
+ #:file->header cpio:file->cpio-header*)))
+
+ (if compress?
+ ;; 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)
(mkdir "contents")
;; Copy the closures of all the items referenced in REFERENCES-GRAPHS.
- (populate-store references-graphs "contents")
+ (populate-store references-graphs "contents"
+ #:deduplicate? #f)
(with-directory-excursion "contents"
;; Make '/init'.
(symlink (string-append guile "/bin/guile") "proc/self/exe")
(readlink "proc/self/exe")
- ;; Reset the timestamps of all the files that will make it in the initrd.
- (for-each (lambda (file)
- (unless (eq? 'symlink (stat:type (lstat file)))
- (utime file 0 0 0 0)))
- (find-files "." ".*"))
-
(write-cpio-archive output "." #:gzip gzip))
+ ;; Make sure directories are writable so we can delete files.
+ (for-each make-file-writable
+ (find-files "contents"
+ (lambda (file stat)
+ (eq? 'directory (stat:type stat)))
+ #:directories? #t))
(delete-file-recursively "contents"))
;;; linux-initrd.scm ends here