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'.master
Ludovic Courtès
parent
70608adb4a
commit
1621cf97aa
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
Loading…
Reference in New Issue