diff options
| -rw-r--r-- | gnu/build/linux-initrd.scm | 77 | ||||
| -rw-r--r-- | gnu/system/linux-initrd.scm | 63 |
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) |