From patchwork Mon Jun 29 14:24:34 2020 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Mathieu Othacehe X-Patchwork-Id: 22964 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 9D37027BBE3; Mon, 29 Jun 2020 15:25:10 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.8 required=5.0 tests=BAYES_00,DKIM_ADSP_CUSTOM_MED, DKIM_SIGNED,FREEMAIL_FROM,MAILING_LIST_MULTI,RCVD_IN_MSPIKE_H4, RCVD_IN_MSPIKE_WL,T_DKIM_INVALID,URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.2 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTP id B63CF27BBE1 for ; Mon, 29 Jun 2020 15:25:09 +0100 (BST) Received: from localhost ([::1]:58284 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jpuib-0000mL-9y for patchwork@mira.cbaines.net; Mon, 29 Jun 2020 10:25:09 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:43134) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1jpuiV-0000lz-0t for guix-patches@gnu.org; Mon, 29 Jun 2020 10:25:03 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:37487) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1jpuiU-0006jt-OK for guix-patches@gnu.org; Mon, 29 Jun 2020 10:25:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1jpuiU-0005bO-JR for guix-patches@gnu.org; Mon, 29 Jun 2020 10:25:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#42123] [PATCH] linux-libre: Enable module compression. Resent-From: Mathieu Othacehe Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Mon, 29 Jun 2020 14:25:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 42123 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 42123@debbugs.gnu.org Cc: Mathieu Othacehe X-Debbugs-Original-To: guix-patches@gnu.org Received: via spool by submit@debbugs.gnu.org id=B.159344069321506 (code B ref -1); Mon, 29 Jun 2020 14:25:02 +0000 Received: (at submit) by debbugs.gnu.org; 29 Jun 2020 14:24:53 +0000 Received: from localhost ([127.0.0.1]:49033 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jpuiK-0005am-9X for submit@debbugs.gnu.org; Mon, 29 Jun 2020 10:24:52 -0400 Received: from lists.gnu.org ([209.51.188.17]:56970) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jpuiG-0005ac-1I for submit@debbugs.gnu.org; Mon, 29 Jun 2020 10:24:50 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:43090) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1jpuiF-0000kD-RH for guix-patches@gnu.org; Mon, 29 Jun 2020 10:24:47 -0400 Received: from mail-wm1-x333.google.com ([2a00:1450:4864:20::333]:50951) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1jpuiD-0006dR-Dx; Mon, 29 Jun 2020 10:24:47 -0400 Received: by mail-wm1-x333.google.com with SMTP id l17so15594887wmj.0; Mon, 29 Jun 2020 07:24:44 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=from:to:cc:subject:date:message-id:mime-version :content-transfer-encoding; bh=DFCFm4M0vDcZaecLkrMsBA5BqBFl7O4QO1F7JcMfRo8=; b=NgJl3lPA8y+3Eph4ux5wqzHHprv35eGspJlcp4DxOL4X3rCWHNq+2IkABhWbczEf5w uHCNwIrAJGeCUhc3yb9UOT/gonXjuYU7ioUoKjF9Bd9fKAKcOaJb04sFkvb7KBakq6rO pqMEo066+wkhkxPvcv4Lrh0+oUBUNi05krHf6CX0VBdO/Ar64m1+LLY0TTioGtam5MPx IIVJ2YUQu3d845UC1iJlpOR3NFOCKVL6zNdmslO8ODwz5riYEvXfSj4Ku1Yd2rvTYioK AIIOgTyBIMDqkM9BcnIfTBTKf+RxGhJuwUlmOSLhGmbylpvxJejuKFGqXn5LKklH89go sF5w== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:cc:subject:date:message-id:mime-version :content-transfer-encoding; bh=DFCFm4M0vDcZaecLkrMsBA5BqBFl7O4QO1F7JcMfRo8=; b=QRsFmpLkup96TvyF5ukJ9zjpC7LrKkwRD/EIGqvsHL/oV5ZAK+HhOw+DAv7g9Lqaoh EMB8cCpfp3y/BfcRW23F/yy7xr9ROOTQkq5v1EgcWuUTDIfrtBwGb6gkbx79aAIDAKm1 PbneBvJjGD95cxrl3ZCiKHxodVyBLKOEylobDvyYzjSmaqrR0Lkm5t9ywJrX18lpndaq HC+54CKSa2Guztz4eZEjV2vcO+dmq7gatrdaUD/Yn9H+YrNGrInVbarRFjmmjlmuWmTw O27FM1IxA2o1m9JN3lyEtdhQ5UlRkjhNvUzhiri6p1zqhWLHOI76pwwlJwLD8Zg7GiFp 9TsA== X-Gm-Message-State: AOAM531+ey3hARbmdI/VQ4/rsL3D0zautXo6FNP2ychl5l5j5tqv6K7J XkWLcyDmGFc5T+4iB0l8Dh/0b2x+ X-Google-Smtp-Source: ABdhPJzuA7KgCpAxSpa/yMqRgfGF7lqrP8MxJlxDvR80kwbKQT/LJxNPC1IIN9jziuQQKutPlTDIlw== X-Received: by 2002:a1c:7e49:: with SMTP id z70mr16310156wmc.24.1593440681965; Mon, 29 Jun 2020 07:24:41 -0700 (PDT) Received: from meru.fronius.com (lfbn-ann-1-136-86.w86-200.abo.wanadoo.fr. [86.200.104.86]) by smtp.gmail.com with ESMTPSA id l1sm51089352wrb.31.2020.06.29.07.24.39 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 29 Jun 2020 07:24:41 -0700 (PDT) From: Mathieu Othacehe X-Google-Original-From: Mathieu Othacehe Date: Mon, 29 Jun 2020 16:24:34 +0200 Message-Id: <20200629142434.21308-1-othacehe@gnu.org> X-Mailer: git-send-email 2.26.2 MIME-Version: 1.0 Received-SPF: pass client-ip=2a00:1450:4864:20::333; envelope-from=m.othacehe@gmail.com; helo=mail-wm1-x333.google.com X-detected-operating-system: by eggs.gnu.org: No matching host in p0f cache. That's all we know. X-Spam_score_int: -20 X-Spam_score: -2.1 X-Spam_bar: -- X-Spam_report: (-2.1 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, FREEMAIL_FROM=0.001, RCVD_IN_DNSWL_NONE=-0.0001, SPF_HELO_NONE=0.001, SPF_PASS=-0.001, T_FILL_THIS_FORM_SHORT=0.01, URIBL_BLOCKED=0.001 autolearn=_AUTOLEARN X-Spam_action: no action X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches This commit enables GZIP compression for linux-libre kernel modules, reducing the size of linux-libre by 63% (165MB). The initrd modules are kept uncompressed as the initrd is already compressed as a whole. The linux-libre kernel also supports XZ compression, but as Guix does not have any available bindings for now, and the compression time is far more significant, GZIP seems to be a better option. * gnu/packages/aux-files/linux-libre/5.4-arm.conf: Enable GZ compression. * gnu/packages/aux-files/linux-libre/5.4-arm64.conf: Ditto. * gnu/packages/aux-files/linux-libre/5.4-i686.conf: Ditto. * gnu/packages/aux-files/linux-libre/5.4-x86_64.conf: Ditto. * gnu/build/linux-modules.scm (modinfo-section-contents): Use 'call-with-gzip-input-port' to read from a module file using '.gz' extension, (strip-extension): new procedure, (dot-ko): adapt to support compression, (ensure-dot-ko): ditto, (file-name->module-name): ditto, (find-module-file): ditto, (load-linux-module*): ditto, (module-name->file-name/guess): ditto, (module-name-lookup): ditto, (write-module-name-database): ditto, (write-module-alias-database): ditto, (write-module-device-database): ditto. * gnu/system/linux-initrd.scm (flat-linux-module-directory): Make sure that zlib bindings are available because they may be used in 'write-module-device-database'. Also make sure that the initrd only contains uncompressed module files. --- Hello, I think the commit message pretty much describes this change. Just wanted to add that it passes the loadable-kernel-modules-X tests. Thanks, Mathieu gnu/build/linux-modules.scm | 102 ++++++++++++------ .../aux-files/linux-libre/5.4-arm.conf | 4 +- .../aux-files/linux-libre/5.4-arm64.conf | 4 +- .../aux-files/linux-libre/5.4-i686.conf | 4 +- .../aux-files/linux-libre/5.4-x86_64.conf | 4 +- gnu/system/linux-initrd.scm | 38 +++++-- 6 files changed, 111 insertions(+), 45 deletions(-) diff --git a/gnu/build/linux-modules.scm b/gnu/build/linux-modules.scm index aa1c7cfeae..7c6945a881 100644 --- a/gnu/build/linux-modules.scm +++ b/gnu/build/linux-modules.scm @@ -21,6 +21,7 @@ (define-module (gnu build linux-modules) #:use-module (guix elf) #:use-module (guix glob) + #:use-module (guix zlib) #:use-module (guix build syscalls) #:use-module ((guix build utils) #:select (find-files invoke)) #:use-module (guix build union) @@ -97,7 +98,16 @@ string list." (define (modinfo-section-contents file) "Return the contents of the '.modinfo' section of FILE as a list of key/value pairs.." - (let* ((bv (call-with-input-file file get-bytevector-all)) + (define (get-bytevector file) + (cond + ((string-contains file ".ko.gz") + (call-with-input-file file + (lambda (port) + (call-with-gzip-input-port port get-bytevector-all)))) + (else + (call-with-input-file file get-bytevector-all)))) + + (let* ((bv (get-bytevector file)) (elf (parse-elf bv)) (section (elf-section-by-name elf ".modinfo")) (modinfo (section-contents elf section))) @@ -110,7 +120,7 @@ key/value pairs.." (define (module-formal-name file) "Return the module name of FILE as it appears in its info section. Usually the module name is the same as the base name of FILE, modulo hyphens and minus -the \".ko\" extension." +the \".ko[.gz|.xz]\" extension." (match (assq 'name (modinfo-section-contents file)) (('name . name) name) (#f #f))) @@ -171,14 +181,25 @@ modules that can be postloaded, of the soft dependencies of module FILE." (_ #f)) (modinfo-section-contents file)))) -(define dot-ko - (cut string-append <> ".ko")) - -(define (ensure-dot-ko name) - "Return NAME with a '.ko' prefix appended, unless it already has it." - (if (string-suffix? ".ko" name) +(define (strip-extension filename) + (let ((extension (string-index filename #\.))) + (if extension + (string-take filename extension) + filename))) + +(define (dot-ko name compression) + (let ((suffix (match compression + ('xz ".ko.xz") + ('gzip ".ko.gz") + (else ".ko")))) + (string-append name suffix))) + +(define (ensure-dot-ko name compression) + "Return NAME with a '.ko[.gz|.xz]' suffix appended, unless it already has +it." + (if (string-contains name ".ko") name - (dot-ko name))) + (dot-ko name compression))) (define (normalize-module-name module) "Return the \"canonical\" name for MODULE, replacing hyphens with @@ -191,9 +212,9 @@ underscores." module)) (define (file-name->module-name file) - "Return the module name corresponding to FILE, stripping the trailing '.ko' -and normalizing it." - (normalize-module-name (basename file ".ko"))) + "Return the module name corresponding to FILE, stripping the trailing +'.ko[.gz|.xz]' and normalizing it." + (normalize-module-name (strip-extension (basename file)))) (define (find-module-file directory module) "Lookup module NAME under DIRECTORY, and return its absolute file name. @@ -208,19 +229,19 @@ whereas file names often, but not always, use hyphens. Examples: ;; List of possible file names. XXX: It would of course be cleaner to ;; have a database that maps module names to file names and vice versa, ;; but everyone seems to be doing hacks like this one. Oh well! - (map ensure-dot-ko - (delete-duplicates - (list module - (normalize-module-name module) - (string-map (lambda (chr) ;converse of 'normalize-module-name' - (case chr - ((#\_) #\-) - (else chr))) - module))))) + (delete-duplicates + (list module + (normalize-module-name module) + (string-map (lambda (chr) ;converse of 'normalize-module-name' + (case chr + ((#\_) #\-) + (else chr))) + module)))) (match (find-files directory (lambda (file stat) - (member (basename file) names))) + (member (strip-extension + (basename file)) names))) ((file) file) (() @@ -290,8 +311,8 @@ not a file name." (recursive? #t) (lookup-module dot-ko) (black-list (module-black-list))) - "Load Linux module from FILE, the name of a '.ko' file; return true on -success, false otherwise. When RECURSIVE? is true, load its dependencies + "Load Linux module from FILE, the name of a '.ko[.gz|.xz]' file; return true +on success, false otherwise. When RECURSIVE? is true, load its dependencies first (à la 'modprobe'.) The actual files containing modules depended on are obtained by calling LOOKUP-MODULE with the module name. Modules whose name appears in BLACK-LIST are not loaded." @@ -523,16 +544,27 @@ are required to access DEVICE." ;;; Module databases. ;;; -(define (module-name->file-name/guess directory name) +(define* (module-name->file-name/guess directory name + #:key compression) "Guess the file name corresponding to NAME, a module name. That doesn't always work because sometimes underscores in NAME map to hyphens (e.g., \"input-leds.ko\"), sometimes not (e.g., \"mac_hid.ko\")." - (string-append directory "/" (ensure-dot-ko name))) + (string-append directory "/" (ensure-dot-ko name compression))) (define (module-name-lookup directory) "Return a one argument procedure that takes a module name (e.g., \"input_leds\") and returns its absolute file name (e.g., \"/.../input-leds.ko\")." + (define (guess-file-name name) + (let ((names (list + (module-name->file-name/guess directory name) + (module-name->file-name/guess directory name + #:compression 'xz) + (module-name->file-name/guess directory name + #:compression 'gzip)))) + (or (find file-exists? names) + (first names)))) + (catch 'system-error (lambda () (define mapping @@ -541,23 +573,23 @@ always work because sometimes underscores in NAME map to hyphens (e.g., (lambda (name) (or (assoc-ref mapping name) - (module-name->file-name/guess directory name)))) + (guess-file-name name)))) (lambda args (if (= ENOENT (system-error-errno args)) - (cut module-name->file-name/guess directory <>) + (cut guess-file-name <>) (apply throw args))))) (define (write-module-name-database directory) "Write a database that maps \"module names\" as they appear in the relevant -ELF section of '.ko' files, to actual file names. This format is +ELF section of '.ko[.gz|.xz]' files, to actual file names. This format is Guix-specific. It aims to deal with inconsistent naming, in particular hyphens vs. underscores." (define mapping (map (lambda (file) (match (module-formal-name file) - (#f (cons (basename file ".ko") file)) + (#f (cons (strip-extension (basename file)) file)) (name (cons name file)))) - (find-files directory "\\.ko$"))) + (find-files directory "\\.ko.*$"))) (call-with-output-file (string-append directory "/modules.name") (lambda (port) @@ -569,12 +601,12 @@ hyphens vs. underscores." (pretty-print mapping port)))) (define (write-module-alias-database directory) - "Traverse the '.ko' files in DIRECTORY and create the corresponding + "Traverse the '.ko[.gz|.xz]' files in DIRECTORY and create the corresponding 'modules.alias' file." (define aliases (map (lambda (file) (cons (file-name->module-name file) (module-aliases file))) - (find-files directory "\\.ko$"))) + (find-files directory "\\.ko.*$"))) (call-with-output-file (string-append directory "/modules.alias") (lambda (port) @@ -616,7 +648,7 @@ are found, return a tuple (DEVNAME TYPE MAJOR MINOR), otherwise return #f." (char-set-complement (char-set #\-))) (define (write-module-device-database directory) - "Traverse the '.ko' files in DIRECTORY and create the corresponding + "Traverse the '.ko[.gz|.xz]' files in DIRECTORY and create the corresponding 'modules.devname' file. This file contains information about modules that can be loaded on-demand, such as file system modules." (define aliases @@ -624,7 +656,7 @@ be loaded on-demand, such as file system modules." (match (aliases->device-tuple (module-aliases file)) (#f #f) (tuple (cons (file-name->module-name file) tuple)))) - (find-files directory "\\.ko$"))) + (find-files directory "\\.ko.*$"))) (call-with-output-file (string-append directory "/modules.devname") (lambda (port) diff --git a/gnu/packages/aux-files/linux-libre/5.4-arm.conf b/gnu/packages/aux-files/linux-libre/5.4-arm.conf index a54228643b..7c9ab94719 100644 --- a/gnu/packages/aux-files/linux-libre/5.4-arm.conf +++ b/gnu/packages/aux-files/linux-libre/5.4-arm.conf @@ -880,7 +880,9 @@ CONFIG_MODULE_FORCE_UNLOAD=y CONFIG_MODVERSIONS=y # CONFIG_MODULE_SRCVERSION_ALL is not set # CONFIG_MODULE_SIG is not set -# CONFIG_MODULE_COMPRESS is not set +CONFIG_MODULE_COMPRESS=y +CONFIG_MODULE_COMPRESS_GZIP=y +# CONFIG_MODULE_COMPRESS_XZ is not set # CONFIG_MODULE_ALLOW_MISSING_NAMESPACE_IMPORTS is not set # CONFIG_UNUSED_SYMBOLS is not set # CONFIG_TRIM_UNUSED_KSYMS is not set diff --git a/gnu/packages/aux-files/linux-libre/5.4-arm64.conf b/gnu/packages/aux-files/linux-libre/5.4-arm64.conf index fabd25c6a4..6520d1ddf2 100644 --- a/gnu/packages/aux-files/linux-libre/5.4-arm64.conf +++ b/gnu/packages/aux-files/linux-libre/5.4-arm64.conf @@ -781,7 +781,9 @@ CONFIG_MODVERSIONS=y CONFIG_ASM_MODVERSIONS=y # CONFIG_MODULE_SRCVERSION_ALL is not set # CONFIG_MODULE_SIG is not set -# CONFIG_MODULE_COMPRESS is not set +CONFIG_MODULE_COMPRESS=y +CONFIG_MODULE_COMPRESS_GZIP=y +# CONFIG_MODULE_COMPRESS_XZ is not set # CONFIG_MODULE_ALLOW_MISSING_NAMESPACE_IMPORTS is not set # CONFIG_UNUSED_SYMBOLS is not set # CONFIG_TRIM_UNUSED_KSYMS is not set diff --git a/gnu/packages/aux-files/linux-libre/5.4-i686.conf b/gnu/packages/aux-files/linux-libre/5.4-i686.conf index 50a41f6cc9..3727f9d486 100644 --- a/gnu/packages/aux-files/linux-libre/5.4-i686.conf +++ b/gnu/packages/aux-files/linux-libre/5.4-i686.conf @@ -850,7 +850,9 @@ CONFIG_MODVERSIONS=y CONFIG_ASM_MODVERSIONS=y CONFIG_MODULE_SRCVERSION_ALL=y # CONFIG_MODULE_SIG is not set -# CONFIG_MODULE_COMPRESS is not set +CONFIG_MODULE_COMPRESS=y +CONFIG_MODULE_COMPRESS_GZIP=y +# CONFIG_MODULE_COMPRESS_XZ is not set # CONFIG_MODULE_ALLOW_MISSING_NAMESPACE_IMPORTS is not set CONFIG_UNUSED_SYMBOLS=y CONFIG_MODULES_TREE_LOOKUP=y diff --git a/gnu/packages/aux-files/linux-libre/5.4-x86_64.conf b/gnu/packages/aux-files/linux-libre/5.4-x86_64.conf index 30fdc4e86a..be7a603af1 100644 --- a/gnu/packages/aux-files/linux-libre/5.4-x86_64.conf +++ b/gnu/packages/aux-files/linux-libre/5.4-x86_64.conf @@ -849,7 +849,9 @@ CONFIG_MODVERSIONS=y CONFIG_ASM_MODVERSIONS=y CONFIG_MODULE_SRCVERSION_ALL=y # CONFIG_MODULE_SIG is not set -# CONFIG_MODULE_COMPRESS is not set +CONFIG_MODULE_COMPRESS=y +CONFIG_MODULE_COMPRESS_GZIP=y +# CONFIG_MODULE_COMPRESS_XZ is not set # CONFIG_MODULE_ALLOW_MISSING_NAMESPACE_IMPORTS is not set CONFIG_UNUSED_SYMBOLS=y CONFIG_MODULES_TREE_LOOKUP=y diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm index 0971ec29e2..99ec82246b 100644 --- a/gnu/system/linux-initrd.scm +++ b/gnu/system/linux-initrd.scm @@ -111,11 +111,29 @@ 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 zlib + (module-ref (resolve-interface '(gnu packages compression)) 'zlib)) + + (define config.scm + (scheme-file "config.scm" + #~(begin + (define-module (guix config) + #:export (%libz)) + + (define %libz + #+(file-append zlib "/lib/libz"))))) + + (define imported-modules + (cons `((guix config) => ,config.scm) + (delete '(guix config) + (source-module-closure '((gnu build linux-modules) + (guix build utils)))))) + (define build-exp - (with-imported-modules (source-module-closure - '((gnu build linux-modules))) + (with-imported-modules imported-modules #~(begin (use-modules (gnu build linux-modules) + (guix build utils) (srfi srfi-1) (srfi srfi-26)) @@ -129,12 +147,20 @@ MODULES and taken from LINUX." (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) - (format #t "copying '~a'...~%" module) - (copy-file module - (string-append #$output "/" - (basename 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.