From e8277f90c88be9d65b948c299620fd9d6d9b28ae Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Wed, 24 Jun 2015 17:41:43 +0200
Subject: 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.
---
 gnu/build/linux-initrd.scm | 72 ++++++++++++++++++++++------------------------
 1 file changed, 35 insertions(+), 37 deletions(-)

(limited to 'gnu/build')

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"))
 
-- 
cgit v1.2.3