summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2014-09-08 23:20:34 +0200
committerLudovic Courtès <ludo@gnu.org>2014-09-08 23:47:28 +0200
commit1621cf97aa0b0e19a53366479abe19f602f5f9da (patch)
tree3f76e07eb8ae088ecdbf6cd80edce6fe6e4b9ffe
parent70608adb4a054438a9dee4abcf63858f3d0dfded (diff)
downloadpatches-1621cf97aa0b0e19a53366479abe19f602f5f9da.tar
patches-1621cf97aa0b0e19a53366479abe19f602f5f9da.tar.gz
linux-initrd: Move initrd creation code to (guix build linux-initrd).
* gnu/build/linux-initrd.scm (cache-compiled-file-name, compile-to-cache, build-initrd): New procedures. * gnu/system/linux-initrd.scm (expression->initrd)[builder]: Remove code now moved above. Use 'build-initrd'.
-rw-r--r--gnu/build/linux-initrd.scm77
-rw-r--r--gnu/system/linux-initrd.scm63
2 files changed, 84 insertions, 56 deletions
diff --git a/gnu/build/linux-initrd.scm b/gnu/build/linux-initrd.scm
index bf60137e8f..2c0acb200e 100644
--- a/gnu/build/linux-initrd.scm
+++ b/gnu/build/linux-initrd.scm
@@ -17,9 +17,15 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu build linux-initrd)
+ #: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))
+ #:export (write-cpio-archive
+ build-initrd))
;;; Commentary:
;;;
@@ -69,4 +75,73 @@ COMPRESS? is true, compress it using GZIP. On success, return OUTPUT."
output))
output))))
+(define (cache-compiled-file-name file)
+ "Return the file name of the in-cache .go file for FILE, relative to the
+current directory.
+
+This is similar to what 'compiled-file-name' in (system base compile) does."
+ (let loop ((file file))
+ (let ((target (false-if-exception (readlink file))))
+ (if target
+ (loop target)
+ (format #f ".cache/guile/ccache/~a-~a-~a-~a/~a"
+ (effective-version)
+ (if (eq? (native-endianness) (endianness little))
+ "LE"
+ "BE")
+ (sizeof '*)
+ (effective-version)
+ file)))))
+
+(define (compile-to-cache file)
+ "Compile FILE to the cache."
+ (let ((compiled-file (cache-compiled-file-name file)))
+ (mkdir-p (dirname compiled-file))
+ (compile-file file
+ #:opts %auto-compilation-options
+ #:output-file compiled-file)))
+
+(define* (build-initrd output
+ #:key
+ guile init
+ linux-module-directory
+ (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
+REFERENCES-GRAPHS, plus the Linux modules from LINUX-MODULE-DIRECTORY."
+ (mkdir "contents")
+
+ ;; Copy the closures of all the items referenced in REFERENCES-GRAPHS.
+ (populate-store references-graphs "contents")
+
+ (with-directory-excursion "contents"
+ ;; Copy Linux modules.
+ (mkdir "modules")
+ (copy-recursively linux-module-directory "modules")
+
+ ;; Make '/init'.
+ (symlink init "init")
+
+ ;; Compile it.
+ (compile-to-cache "init")
+
+ ;; Allow Guile to find out where it is (XXX). See
+ ;; 'guile-relocatable.patch'.
+ (mkdir-p "proc/self")
+ (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 "."
+ #:cpio cpio #:gzip gzip))
+
+ (delete-file-recursively "contents"))
+
;;; linux-initrd.scm ends here
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index b05cfc5bcd..c2c8722ebb 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -81,64 +81,17 @@ initrd."
(length to-copy)))
(define builder
- ;; TODO: Move most of this code to (gnu build linux-initrd).
#~(begin
- (use-modules (gnu build linux-initrd)
- (guix build utils)
- (guix build store-copy)
- (system base compile)
- (rnrs bytevectors)
- ((system foreign) #:select (sizeof)))
+ (use-modules (gnu build linux-initrd))
(mkdir #$output)
- (mkdir "contents")
-
- (with-directory-excursion "contents"
- ;; Copy Linux modules.
- (mkdir "modules")
- (copy-recursively #$module-dir "modules")
-
- ;; Populate the initrd's store.
- (with-directory-excursion ".."
- (populate-store '#$graph-files "contents"))
-
- ;; Make '/init'.
- (symlink #$init "init")
-
- ;; Compile it.
- (let* ((init (readlink "init"))
- (scm-dir (string-append "share/guile/" (effective-version)))
- (go-dir (format #f ".cache/guile/ccache/~a-~a-~a-~a/~a"
- (effective-version)
- (if (eq? (native-endianness) (endianness little))
- "LE"
- "BE")
- (sizeof '*)
- (effective-version)
- (dirname init))))
- (mkdir-p go-dir)
- (compile-file init
- #:opts %auto-compilation-options
- #:output-file (string-append go-dir "/"
- (basename init)
- ".go")))
-
- ;; This hack allows Guile to find out where it is. See
- ;; 'guile-relocatable.patch'.
- (mkdir-p "proc/self")
- (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 (string-append #$output "/initrd") "."
- #:cpio (string-append #$cpio "/bin/cpio")
- #:gzip (string-append #$gzip "/bin/gzip")))))
+ (build-initrd (string-append #$output "/initrd")
+ #:guile #$guile
+ #:init #$init
+ #:references-graphs '#$graph-files
+ #:linux-module-directory #$module-dir
+ #:cpio (string-append #$cpio "/bin/cpio")
+ #:gzip (string-append #$gzip "/bin/gzip"))))
(gexp->derivation name builder
#:modules '((guix build utils)