diff options
Diffstat (limited to 'gnu/system')
-rw-r--r-- | gnu/system/image.scm | 2 | ||||
-rw-r--r-- | gnu/system/linux-initrd.scm | 72 | ||||
-rw-r--r-- | gnu/system/shadow.scm | 12 |
3 files changed, 53 insertions, 33 deletions
diff --git a/gnu/system/image.scm b/gnu/system/image.scm index 36f56e237d..19c99a3dfa 100644 --- a/gnu/system/image.scm +++ b/gnu/system/image.scm @@ -141,7 +141,7 @@ (match (package-transitive-propagated-inputs package) (((labels packages) ...) packages)))) - (list guile-gcrypt guile-sqlite3))) + (list guile-gcrypt guile-sqlite3 guile-zlib))) (define-syntax-rule (with-imported-modules* gexp* ...) (with-extensions gcrypt-sqlite3&co diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm index 0971ec29e2..b8a30c0abc 100644 --- a/gnu/system/linux-initrd.scm +++ b/gnu/system/linux-initrd.scm @@ -77,6 +77,9 @@ the derivations referenced by EXP are automatically copied to the initrd." (program-file "init" exp #:guile guile)) (define builder + ;; Do not use "guile-zlib" extension here, otherwise it would drag the + ;; non-static "zlib" package to the initrd closure. It is not needed + ;; anyway because the modules are stored uncompressed within the initrd. (with-imported-modules (source-module-closure '((gnu build linux-initrd))) #~(begin @@ -111,34 +114,49 @@ the derivations referenced by EXP are automatically copied to the initrd." (define (flat-linux-module-directory linux modules) "Return a flat directory containing the Linux kernel modules listed in MODULES and taken from LINUX." - (define build-exp - (with-imported-modules (source-module-closure - '((gnu build linux-modules))) - #~(begin - (use-modules (gnu build linux-modules) - (srfi srfi-1) - (srfi srfi-26)) - - (define module-dir - (string-append #$linux "/lib/modules")) + (define imported-modules + (source-module-closure '((gnu build linux-modules) + (guix build utils)))) - (define modules - (let* ((lookup (cut find-module-file module-dir <>)) - (modules (map lookup '#$modules))) - (append modules - (recursive-module-dependencies modules - #:lookup-module lookup)))) - - (mkdir #$output) - (for-each (lambda (module) - (format #t "copying '~a'...~%" module) - (copy-file module - (string-append #$output "/" - (basename module)))) - (delete-duplicates modules)) - - ;; Hyphen or underscore? This database tells us. - (write-module-name-database #$output)))) + (define build-exp + (with-imported-modules imported-modules + (with-extensions (list guile-zlib) + #~(begin + (use-modules (gnu build linux-modules) + (guix build utils) + (srfi srfi-1) + (srfi srfi-26)) + + (define module-dir + (string-append #$linux "/lib/modules")) + + (define modules + (let* ((lookup (cut find-module-file module-dir <>)) + (modules (map lookup '#$modules))) + (append modules + (recursive-module-dependencies + modules + #:lookup-module lookup)))) + + (define (maybe-uncompress file) + ;; If FILE is a compressed module, uncompress it, as the initrd + ;; is already gzipped as a whole. + (cond + ((string-contains file ".ko.gz") + (invoke #+(file-append gzip "/bin/gunzip") file)))) + + (mkdir #$output) + (for-each (lambda (module) + (let ((out-module + (string-append #$output "/" + (basename module)))) + (format #t "copying '~a'...~%" module) + (copy-file module out-module) + (maybe-uncompress out-module))) + (delete-duplicates modules)) + + ;; Hyphen or underscore? This database tells us. + (write-module-name-database #$output))))) (computed-file "linux-modules" build-exp)) diff --git a/gnu/system/shadow.scm b/gnu/system/shadow.scm index a69339bc07..f642d250b0 100644 --- a/gnu/system/shadow.scm +++ b/gnu/system/shadow.scm @@ -34,6 +34,7 @@ #:use-module ((gnu packages admin) #:select (shadow)) #:use-module (gnu packages bash) + #:use-module (gnu packages guile) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) @@ -324,11 +325,12 @@ accounts among ACCOUNTS+GROUPS." (start (with-imported-modules (source-module-closure '((gnu build activation) (gnu system accounts))) - #~(lambda () - (activate-user-home - (map sexp->user-account - (list #$@(map user-account->gexp accounts)))) - #t))) ;success + (with-extensions (list guile-zlib) + #~(lambda () + (activate-user-home + (map sexp->user-account + (list #$@(map user-account->gexp accounts)))) + #t)))) ;success (documentation "Create user home directories.")))) (define (shells-file shells) |