From unknown Sun Sep 07 21:36:12 2025 Content-Disposition: inline Content-Transfer-Encoding: quoted-printable MIME-Version: 1.0 X-Mailer: MIME-tools 5.509 (Entity 5.509) Content-Type: text/plain; charset=utf-8 From: bug#42123 <42123@debbugs.gnu.org> To: bug#42123 <42123@debbugs.gnu.org> Subject: Status: [PATCH] linux-libre: Enable module compression. Reply-To: bug#42123 <42123@debbugs.gnu.org> Date: Mon, 08 Sep 2025 04:36:12 +0000 retitle 42123 [PATCH] linux-libre: Enable module compression. reassign 42123 guix-patches submitter 42123 Mathieu Othacehe severity 42123 normal tag 42123 patch thanks From debbugs-submit-bounces@debbugs.gnu.org Mon Jun 29 10:24:52 2020 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 To: guix-patches@gnu.org Subject: [PATCH] linux-libre: Enable module compression. 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 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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-Spam-Score: 0.7 (/) X-Debbugs-Envelope-To: submit Cc: Mathieu Othacehe X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -2.3 (--) 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. -- 2.26.2 From debbugs-submit-bounces@debbugs.gnu.org Tue Jun 30 03:31:22 2020 Received: (at 42123) by debbugs.gnu.org; 30 Jun 2020 07:31:22 +0000 Received: from localhost ([127.0.0.1]:50102 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jqAji-0007J7-9c for submit@debbugs.gnu.org; Tue, 30 Jun 2020 03:31:22 -0400 Received: from eggs.gnu.org ([209.51.188.92]:60162) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jqAjd-0007Is-Vb for 42123@debbugs.gnu.org; Tue, 30 Jun 2020 03:31:20 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:46557) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jqAjY-0005KN-NK for 42123@debbugs.gnu.org; Tue, 30 Jun 2020 03:31:12 -0400 Received: from lfbn-ann-1-356-169.w86-200.abo.wanadoo.fr ([86.200.73.169]:51954 helo=meru) by fencepost.gnu.org with esmtpsa (TLS1.2:RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1jqAjX-00067S-MR for 42123@debbugs.gnu.org; Tue, 30 Jun 2020 03:31:12 -0400 From: Mathieu Othacehe To: 42123@debbugs.gnu.org Subject: Re: [bug#42123] [PATCH] linux-libre: Enable module compression. References: <20200629142434.21308-1-othacehe@gnu.org> Date: Tue, 30 Jun 2020 09:31:06 +0200 In-Reply-To: <20200629142434.21308-1-othacehe@gnu.org> (Mathieu Othacehe's message of "Mon, 29 Jun 2020 16:24:34 +0200") Message-ID: <87a70l103p.fsf@gnu.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.3 (gnu/linux) MIME-Version: 1.0 Content-Type: text/plain X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 42123 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -3.3 (---) Hello, There's at least one issue with this one. When running the "installation-os" test, I have this backtrace: --8<---------------cut here---------------start------------->8--- + guix system init /mnt/etc/config.scm /mnt --no-substitutes The following derivations will be built: /gnu/store/rlq93i0ahllyvmjxk14w3snmqsv7bsvg-system.drv /gnu/store/28cfjshgch8jyixmwv3q0x1ybniwlvf5-parameters.drv /gnu/store/vk3rw7qwm7p0ldy34cadzgczxx2hc5xf-raw-initrd.drv /gnu/store/w219h1ia74bkplvr622f0b8qxyi9xw7y-provenance.drv /gnu/store/z56pp4bw5hif9mh856cckqvfnvykaybh-profile.drv /gnu/store/xalv7fm73cpyyi3zyvy1zlb26nfi1fb6-module-import-compiled.drv /gnu/store/rmpwh65ypvv1805zwmcir8gk9b53c4gz-module-import-compiled.drv /gnu/store/l9ixrby1zjqvdc719lyvfp9n9n4hb5pv-grub.cfg.drv The following profile hook will be built: /gnu/store/92giwj2f8jyq90l20q19vcvds18v9xf4-linux-module-database.drv building /gnu/store/w219h1ia74bkplvr622f0b8qxyi9xw7y-provenance.drv... building /gnu/store/k4m2pj7sadz4vv5aaz40f68gaa4mw36b-Python-3.5.9.tar.xz.drv... \builder for `/gnu/store/k4m2pj7sadz4vv5aaz40f68gaa4mw36b-Python-3.5.9.tar.xz.drv' failed to produce output path `/gnu/store/f99fblkzb6ip268sg096shhs7wzjyp55-Python-3.5.9.tar.xz' build of /gnu/store/k4m2pj7sadz4vv5aaz40f68gaa4mw36b-Python-3.5.9.tar.xz.drv failed View build log at '/var/log/guix/drvs/k4/m2pj7sadz4vv5aaz40f68gaa4mw36b-Python-3.5.9.tar.xz.drv.bz2'. cannot build derivation `/gnu/store/9l09n8d6ick1nsjvchysys3hdgq7ynfr-Python-3.5.9.tar.xz.drv': 1 dependencies couldn't be built building /gnu/store/wd9giqyfcfm1wgc6rscl3m9i30hg6rcs-bash-2.05b.tar.gz.drv... cannot build derivation `/gnu/store/66q0r5cr3j1cbwckx5zvi0wv4cp3kxgl-python-minimal-3.5.9.drv': 1 dependencies couldn't be built cannot build derivation `/gnu/store/c2ly303cbslks8hx3811wa91wahqr295-glibc-2.31.drv': 1 dependencies couldn't be built building /gnu/store/h1p3962y3bmv1zgwsng1gb4c7caryj82-config.scm.drv... cannot build derivation `/gnu/store/97vna9jgn19hyfx24s2kd6c3wywg22wl-e2fsprogs-1.45.6.drv': 1 dependencies couldn't be built cannot build derivation `/gnu/store/r4dg2iypidr067kyddg90z07arrxp3h6-e2fsck-static-1.45.6.drv': 1 dependencies couldn't be built cannot build derivation `/gnu/store/64f1y8njbd8bppl61fm6dhljnlgmh3h2-init.drv': 1 dependencies couldn't be built building /gnu/store/6v5f1ry0pbhm2a1v5v8b773qpncnf6rr-module-import-compiled.drv... cannot build derivation `/gnu/store/vk3rw7qwm7p0ldy34cadzgczxx2hc5xf-raw-initrd.drv': 1 dependencies couldn't be built cannot build derivation `/gnu/store/l9ixrby1zjqvdc719lyvfp9n9n4hb5pv-grub.cfg.drv': 1 dependencies couldn't be built guix system: error: build of `/gnu/store/l9ixrby1zjqvdc719lyvfp9n9n4hb5pv-grub.cfg.drv' failed environment variable `PATH' set to `/gnu/store/a2b10x6h8j8qgsrcqip06xhnbssa0k25-qemu-minimal-5.0.0/bin' --8<---------------cut here---------------end--------------->8--- For some reason, something triggers a build of the initrd (instead of using the gcrooted one). I guess it's related to the addition of "zlib" and "gzip" to the initrd inputs, but I don't understand why. Someone? Thanks, Mathieu From debbugs-submit-bounces@debbugs.gnu.org Thu Jul 02 06:23:14 2020 Received: (at 42123) by debbugs.gnu.org; 2 Jul 2020 10:23:14 +0000 Received: from localhost ([127.0.0.1]:54422 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jqwN8-0000XW-4D for submit@debbugs.gnu.org; Thu, 02 Jul 2020 06:23:14 -0400 Received: from eggs.gnu.org ([209.51.188.92]:53362) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jqwN3-0000XF-T0 for 42123@debbugs.gnu.org; Thu, 02 Jul 2020 06:23:13 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:58268) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jqwMy-0006lv-K9; Thu, 02 Jul 2020 06:23:04 -0400 Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=53938 helo=ribbon) by fencepost.gnu.org with esmtpsa (TLS1.2:RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1jqwMx-0004JP-R7; Thu, 02 Jul 2020 06:23:04 -0400 From: =?utf-8?Q?Ludovic_Court=C3=A8s?= To: Mathieu Othacehe Subject: Re: [bug#42123] [PATCH] linux-libre: Enable module compression. References: <20200629142434.21308-1-othacehe@gnu.org> Date: Thu, 02 Jul 2020 12:23:01 +0200 In-Reply-To: <20200629142434.21308-1-othacehe@gnu.org> (Mathieu Othacehe's message of "Mon, 29 Jun 2020 16:24:34 +0200") Message-ID: <87366atdve.fsf@gnu.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.3 (gnu/linux) MIME-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 42123 Cc: Mathieu Othacehe , 42123@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -3.3 (---) Hi! Mathieu Othacehe skribis: > This commit enables GZIP compression for linux-libre kernel modules, redu= cing > 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' extens= ion, > (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 th= at > zlib bindings are available because they may be used in > 'write-module-device-database'. Also make sure that the initrd only conta= ins > uncompressed module files. Nice! I do think that gzip is more appropriate than xz here, also in terms of memory requirements. Perhaps you can do this in two patches: first the linux-initrd bits, and 2nd the linux-libre changes. > 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") =E2=80=98string-suffix?=E2=80=99 would be more accurate. > + (call-with-input-file file > + (lambda (port) > + (call-with-gzip-input-port port get-bytevector-all)))) =E2=80=98call-with-input-file=E2=80=99 creates a buffered port, which could= be problematic, although =E2=80=98make-gzip-input-port=E2=80=99 checks that. To be safe, you=E2=80=99d do (open-file file "r0") with a dynwind. > +(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\")." Please mention COMPRESSION in the docstring. > (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 corresp= onding > '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.*$"))) Should we refine this regexp (there are a couple of places like this)? There other Scheme bits LGTM! (I don=E2=80=99t really know about Linux-libre but you do!) Ludo=E2=80=99. From debbugs-submit-bounces@debbugs.gnu.org Mon Jul 06 04:49:09 2020 Received: (at 42123) by debbugs.gnu.org; 6 Jul 2020 08:49:09 +0000 Received: from localhost ([127.0.0.1]:33585 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jsMoH-0005xZ-1B for submit@debbugs.gnu.org; Mon, 06 Jul 2020 04:49:09 -0400 Received: from eggs.gnu.org ([209.51.188.92]:52322) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jsMoF-0005xL-JF for 42123@debbugs.gnu.org; Mon, 06 Jul 2020 04:49:07 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:50414) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jsMoA-0001BF-9e; Mon, 06 Jul 2020 04:49:02 -0400 Received: from lfbn-ann-1-356-169.w86-200.abo.wanadoo.fr ([86.200.73.169]:37076 helo=meru) by fencepost.gnu.org with esmtpsa (TLS1.2:RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1jsMo9-0001Dk-IG; Mon, 06 Jul 2020 04:49:02 -0400 From: Mathieu Othacehe To: Ludovic =?utf-8?Q?Court=C3=A8s?= Subject: Re: [bug#42123] [PATCH] linux-libre: Enable module compression. References: <20200629142434.21308-1-othacehe@gnu.org> <87366atdve.fsf@gnu.org> Date: Mon, 06 Jul 2020 10:48:58 +0200 In-Reply-To: <87366atdve.fsf@gnu.org> ("Ludovic \=\?utf-8\?Q\?Court\=C3\=A8s\=22'\?\= \=\?utf-8\?Q\?s\?\= message of "Thu, 02 Jul 2020 12:23:01 +0200") Message-ID: <87lfjx6nb9.fsf@gnu.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.3 (gnu/linux) MIME-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 42123 Cc: 42123@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -3.3 (---) Hey Ludo, > There other Scheme bits LGTM! > > (I don=E2=80=99t really know about Linux-libre but you do!) Thanks a lot for reviewing :) I took all your remarks into account. Regarding the test issue I'm describing in this thread, I now have an understanding of the situation. Adding (guix zlib) as a dependency of (gnu build linux-modules) also drags (guix config). That's an issue because there are a lot of derivations including (gnu build linux-modules) without deleting/mocking (guix config). That's for instance the case with "expression->initrd", and it explains why the installation test is trying to rebuild the initrd. I see two solutions here: * Delete/mock (guix config) in every derivation including (gnu build linux-modules) or any other build module that includes it. Not ideal because there are quite numerous. * Do not use (guix zlib) but a raw "gzip -cd" pipe in (gnu build linux-modules). It works but it way slower. =20=20 A third solution would be nice here :) WDYT? Thanks, Mathieu From debbugs-submit-bounces@debbugs.gnu.org Mon Jul 06 08:21:12 2020 Received: (at 42123) by debbugs.gnu.org; 6 Jul 2020 12:21:12 +0000 Received: from localhost ([127.0.0.1]:33721 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jsQ7U-0004kD-JJ for submit@debbugs.gnu.org; Mon, 06 Jul 2020 08:21:12 -0400 Received: from eggs.gnu.org ([209.51.188.92]:40760) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jsQ7P-0004jw-Kr for 42123@debbugs.gnu.org; Mon, 06 Jul 2020 08:21:11 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:53479) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jsQ7K-0000yP-CH for 42123@debbugs.gnu.org; Mon, 06 Jul 2020 08:21:02 -0400 Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=50986 helo=ribbon) by fencepost.gnu.org with esmtpsa (TLS1.2:RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1jsQ7J-0000TH-88; Mon, 06 Jul 2020 08:21:01 -0400 From: =?utf-8?Q?Ludovic_Court=C3=A8s?= To: Mathieu Othacehe Subject: Re: [bug#42123] [PATCH] linux-libre: Enable module compression. References: <20200629142434.21308-1-othacehe@gnu.org> <87366atdve.fsf@gnu.org> <87lfjx6nb9.fsf@gnu.org> Date: Mon, 06 Jul 2020 14:20:58 +0200 In-Reply-To: <87lfjx6nb9.fsf@gnu.org> (Mathieu Othacehe's message of "Mon, 06 Jul 2020 10:48:58 +0200") Message-ID: <873664ltqt.fsf@gnu.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.3 (gnu/linux) MIME-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 42123 Cc: 42123@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -3.3 (---) Hello! Mathieu Othacehe skribis: > Adding (guix zlib) as a dependency of (gnu build linux-modules) also > drags (guix config). That's an issue because there are a lot of > derivations including (gnu build linux-modules) without deleting/mocking > (guix config). > > That's for instance the case with "expression->initrd", and it explains > why the installation test is trying to rebuild the initrd. > > I see two solutions here: > > * Delete/mock (guix config) in every derivation including (gnu build > linux-modules) or any other build module that includes it. Not ideal > because there are quite numerous. > > * Do not use (guix zlib) but a raw "gzip -cd" pipe in (gnu build > linux-modules). It works but it way slower. I don=E2=80=99t have other ideas, but both solutions sound good to me. Usi= ng (guix zlib) is slightly more =E2=80=9Celegant=E2=80=9D IMO, but no big deal= . I don=E2=80=99t expect any significant difference from the use of in-process decompression, unless we really have to go and decompress many modules in a row. Thanks, Ludo=E2=80=99. From debbugs-submit-bounces@debbugs.gnu.org Mon Jul 06 10:23:38 2020 Received: (at 42123) by debbugs.gnu.org; 6 Jul 2020 14:23:38 +0000 Received: from localhost ([127.0.0.1]:34612 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jsS1x-0007tK-Ug for submit@debbugs.gnu.org; Mon, 06 Jul 2020 10:23:38 -0400 Received: from eggs.gnu.org ([209.51.188.92]:37560) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jsS1t-0007t5-Hw for 42123@debbugs.gnu.org; Mon, 06 Jul 2020 10:23:36 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:55625) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jsS1n-00027g-Tt; Mon, 06 Jul 2020 10:23:27 -0400 Received: from lfbn-ann-1-356-169.w86-200.abo.wanadoo.fr ([86.200.73.169]:40520 helo=meru) by fencepost.gnu.org with esmtpsa (TLS1.2:RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1jsS1m-00080S-H5; Mon, 06 Jul 2020 10:23:27 -0400 From: Mathieu Othacehe To: Ludovic =?utf-8?Q?Court=C3=A8s?= Subject: Re: [bug#42123] [PATCH] linux-libre: Enable module compression. References: <20200629142434.21308-1-othacehe@gnu.org> <87366atdve.fsf@gnu.org> <87lfjx6nb9.fsf@gnu.org> <873664ltqt.fsf@gnu.org> Date: Mon, 06 Jul 2020 16:23:23 +0200 In-Reply-To: <873664ltqt.fsf@gnu.org> ("Ludovic \=\?utf-8\?Q\?Court\=C3\=A8s\=22'\?\= \=\?utf-8\?Q\?s\?\= message of "Mon, 06 Jul 2020 14:20:58 +0200") Message-ID: <878sfw7mec.fsf@gnu.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.3 (gnu/linux) MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 42123 Cc: 42123@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -3.3 (---) --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Hey, > I don=E2=80=99t have other ideas, but both solutions sound good to me. U= sing > (guix zlib) is slightly more =E2=80=9Celegant=E2=80=9D IMO, but no big de= al. I don=E2=80=99t > expect any significant difference from the use of in-process > decompression, unless we really have to go and decompress many modules > in a row. Creating the initrd implies to create the module name database, and it ends-up decompressing every single module. Using the in-process method it takes 2 seconds, using the second method 30 seconds. So, I opted for the first solution as you suggested. Here's an attached patch that fixes the situation. Thanks, Mathieu --=-=-= Content-Type: text/x-diff; charset=utf-8 Content-Disposition: inline; filename=import.patch Content-Transfer-Encoding: quoted-printable >From 8bbf343510091fad4a08758e0115a70410c1c8d7 Mon Sep 17 00:00:00 2001 From: Mathieu Othacehe Date: Mon, 6 Jul 2020 16:04:21 +0200 Subject: [PATCH] self: Add with-imported-modules+config and use it. Introduce "with-imported-modules+config" and use it to replace every call to "with-imported-modules" that would trigger an import of (guix config) modul= e. * guix/self.scm (not-config?): New procedure, (with-imported-modules+config): new macro. * guix/profiles.scm (linux-module-database): Replace with-imported-modules = by with-imported-modules+config. * gnu/system/shadow.scm (account-shepherd-service): Ditto. * gnu/system/linux-initrd.scm (raw-initrd): Ditto. * gnu/services/base.scm (default-serial-port): Ditto, (file-system-shepherd-service): ditto, (udev-shepherd-service): ditto. * gnu/services.scm (activation-script): Ditto. * gnu/machine/ssh.scm (machine-check-initrd-modules): Ditto. --- gnu/machine/ssh.scm | 8 ++++---- gnu/services.scm | 6 +++--- gnu/services/base.scm | 11 +++++------ gnu/system/linux-initrd.scm | 12 ++++++------ gnu/system/shadow.scm | 6 +++--- guix/profiles.scm | 6 +++--- guix/self.scm | 24 ++++++++++++++++++++++++ 7 files changed, 48 insertions(+), 25 deletions(-) diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm index 4148639292..7369eb2136 100644 --- a/gnu/machine/ssh.scm +++ b/gnu/machine/ssh.scm @@ -33,6 +33,7 @@ #:use-module (guix records) #:use-module (guix remote) #:use-module (guix scripts system reconfigure) + #:use-module (guix self) #:use-module (guix ssh) #:use-module (guix store) #:use-module (guix utils) @@ -246,10 +247,9 @@ not available in the initrd." (define (missing-modules fs) (define remote-exp (let ((device (file-system-device fs))) - (with-imported-modules (source-module-closure - '((gnu build file-systems) - (gnu build linux-modules) - (gnu system uuid))) + (with-imported-modules+config '((gnu build file-systems) + (gnu build linux-modules) + (gnu system uuid)) #~(begin (use-modules (gnu build file-systems) (gnu build linux-modules) diff --git a/gnu/services.scm b/gnu/services.scm index f6dc56d940..4d7371cd78 100644 --- a/gnu/services.scm +++ b/gnu/services.scm @@ -28,6 +28,7 @@ #:use-module (guix combinators) #:use-module (guix channels) #:use-module (guix describe) + #:use-module (guix self) #:use-module (guix sets) #:use-module (guix ui) #:use-module ((guix utils) #:select (source-properties->location)) @@ -542,9 +543,8 @@ ACTIVATION-SCRIPT-TYPE." (map (cut program-file "activate-service.scm" <>) gexps)) =20 (program-file "activate.scm" - (with-imported-modules (source-module-closure - '((gnu build activation) - (guix build utils))) + (with-imported-modules+config '((gnu build activation) + (guix build utils)) #~(begin (use-modules (gnu build activation) (guix build utils)) diff --git a/gnu/services/base.scm b/gnu/services/base.scm index 6ea7ef8e7e..94dfeb2315 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -30,6 +30,7 @@ ;;; along with GNU Guix. If not, see . =20 (define-module (gnu services base) + #:use-module (guix self) #:use-module (guix store) #:use-module (guix deprecation) #:use-module (gnu services) @@ -832,8 +833,8 @@ the message of the day, among other things." (define (default-serial-port) "Return a gexp that determines a reasonable default serial port to use as the tty. This is primarily useful for headless systems." - (with-imported-modules (source-module-closure - '((gnu build linux-boot))) ;for 'find-long-optio= ns' + (with-imported-modules+config + '((gnu build linux-boot)) ;for 'find-long-options' #~(begin ;; console=3Ddevice,options ;; device: can be tty0, ttyS0, lp0, ttyUSB0 (serial). @@ -886,8 +887,7 @@ to use as the tty. This is primarily useful for headle= ss systems." =20 (modules '((ice-9 match) (gnu build linux-boot))) (start - (with-imported-modules (source-module-closure - '((gnu build linux-boot))) + (with-imported-modules+config '((gnu build linux-boot)) #~(lambda args (let ((defaulted-tty #$(or tty (default-serial-port)))) (apply @@ -1935,8 +1935,7 @@ item of @var{packages}." =20 (documentation "Populate the /dev directory, dynamically.") (start - (with-imported-modules (source-module-closure - '((gnu build linux-boot))) + (with-imported-modules+config '((gnu build linux-boot)) #~(lambda () (define udevd ;; 'udevd' from eudev. diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm index 99ec82246b..8779ef58d7 100644 --- a/gnu/system/linux-initrd.scm +++ b/gnu/system/linux-initrd.scm @@ -28,6 +28,7 @@ #:use-module ((guix derivations) #:select (derivation->output-path)) #:use-module (guix modules) + #:use-module (guix self) #:use-module (gnu packages compression) #:use-module (gnu packages disk) #:use-module (gnu packages linux) @@ -214,12 +215,11 @@ upon error." (flat-linux-module-directory linux linux-modules)) =20 (expression->initrd - (with-imported-modules (source-module-closure - '((gnu build linux-boot) - (guix build utils) - (guix build bournish) - (gnu system file-systems) - (gnu build file-systems))) + (with-imported-modules+config '((gnu build linux-boot) + (guix build utils) + (guix build bournish) + (gnu system file-systems) + (gnu build file-systems)) #~(begin (use-modules (gnu build linux-boot) (gnu system file-systems) diff --git a/gnu/system/shadow.scm b/gnu/system/shadow.scm index a69339bc07..e140f06913 100644 --- a/gnu/system/shadow.scm +++ b/gnu/system/shadow.scm @@ -22,6 +22,7 @@ (define-module (gnu system shadow) #:use-module (guix records) #:use-module (guix gexp) + #:use-module (guix self) #:use-module (guix store) #:use-module (guix modules) #:use-module (guix sets) @@ -321,9 +322,8 @@ accounts among ACCOUNTS+GROUPS." (one-shot? #t) (modules '((gnu build activation) (gnu system accounts))) - (start (with-imported-modules (source-module-closure - '((gnu build activation) - (gnu system accounts))) + (start (with-imported-modules+config '((gnu build activation) + (gnu system accounts)) #~(lambda () (activate-user-home (map sexp->user-account diff --git a/guix/profiles.scm b/guix/profiles.scm index f34f73e17e..f11e400dd3 100644 --- a/guix/profiles.scm +++ b/guix/profiles.scm @@ -40,6 +40,7 @@ #:use-module (guix gexp) #:use-module (guix modules) #:use-module (guix monads) + #:use-module (guix self) #:use-module (guix store) #:use-module (ice-9 vlist) #:use-module (ice-9 match) @@ -1205,9 +1206,8 @@ This is meant to be used as a profile hook." (define kmod ; lazy reference (module-ref (resolve-interface '(gnu packages linux)) 'kmod)) (define build - (with-imported-modules (source-module-closure - '((guix build utils) - (gnu build linux-modules))) + (with-imported-modules+config '((guix build utils) + (gnu build linux-modules)) #~(begin (use-modules (ice-9 ftw) (ice-9 match) diff --git a/guix/self.scm b/guix/self.scm index e1350a7403..82bb55f8e7 100644 --- a/guix/self.scm +++ b/guix/self.scm @@ -33,6 +33,8 @@ #:use-module (srfi srfi-35) #:use-module (ice-9 match) #:export (make-config.scm + not-config? + with-imported-modules+config whole-package ;for internal use in 'guix p= ull' compiled-guix guix-derivation)) @@ -1063,6 +1065,24 @@ Info manual." ;; made relative to a nonexistent anonymous module. #:splice? #t)) =20 +(define not-config? + ;; Select (guix =E2=80=A6) and (gnu =E2=80=A6) modules, except (guix con= fig). + (match-lambda + (('guix 'config) #f) + (('guix rest ...) #t) + (('gnu rest ...) #t) + (rest #f))) + +(define-syntax-rule (with-imported-modules+config modules exp ...) + "Import the closure of MODULES and evaluate EXP within this context. If= the +(guix config) module is part of the closure, it is not selected. This mod= ule +is always replaced by a mocked-one, created by MAKE-CONFIG.SCM pocedure." + (with-imported-modules `(,@(source-module-closure + modules + #:select? not-config?) + ((guix config) =3D> ,(make-config.scm))) + exp ...)) + ;;; ;;; Building. @@ -1213,3 +1233,7 @@ is not supported." (if guix (lower-object guix) (return #f))))) + +;; Local Variables: +;; eval: (put 'with-imported-modules+config 'scheme-indent-function 2) +;; End: --=20 2.24.0 --=-=-=-- From debbugs-submit-bounces@debbugs.gnu.org Mon Jul 06 16:14:03 2020 Received: (at 42123) by debbugs.gnu.org; 6 Jul 2020 20:14:03 +0000 Received: from localhost ([127.0.0.1]:34919 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jsXV5-0008Jp-9Q for submit@debbugs.gnu.org; Mon, 06 Jul 2020 16:14:03 -0400 Received: from eggs.gnu.org ([209.51.188.92]:60940) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jsXV1-0008IH-EG for 42123@debbugs.gnu.org; Mon, 06 Jul 2020 16:14:01 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:33235) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jsXUw-000661-6C for 42123@debbugs.gnu.org; Mon, 06 Jul 2020 16:13:54 -0400 Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=55076 helo=ribbon) by fencepost.gnu.org with esmtpsa (TLS1.2:RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1jsXUu-0000yk-Ul; Mon, 06 Jul 2020 16:13:53 -0400 From: =?utf-8?Q?Ludovic_Court=C3=A8s?= To: Mathieu Othacehe Subject: Re: [bug#42123] [PATCH] linux-libre: Enable module compression. References: <20200629142434.21308-1-othacehe@gnu.org> <87366atdve.fsf@gnu.org> <87lfjx6nb9.fsf@gnu.org> <873664ltqt.fsf@gnu.org> <878sfw7mec.fsf@gnu.org> X-URL: http://www.fdn.fr/~lcourtes/ X-Revolutionary-Date: 19 Messidor an 228 de la =?utf-8?Q?R=C3=A9volution?= X-PGP-Key-ID: 0x090B11993D9AEBB5 X-PGP-Key: http://www.fdn.fr/~lcourtes/ludovic.asc X-PGP-Fingerprint: 3CE4 6455 8A84 FDC6 9DB4 0CFB 090B 1199 3D9A EBB5 X-OS: x86_64-pc-linux-gnu Date: Mon, 06 Jul 2020 22:13:50 +0200 In-Reply-To: <878sfw7mec.fsf@gnu.org> (Mathieu Othacehe's message of "Mon, 06 Jul 2020 16:23:23 +0200") Message-ID: <871rloiept.fsf@gnu.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.3 (gnu/linux) MIME-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 42123 Cc: 42123@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -3.3 (---) Hi, Mathieu Othacehe skribis: >> I don=E2=80=99t have other ideas, but both solutions sound good to me. = Using >> (guix zlib) is slightly more =E2=80=9Celegant=E2=80=9D IMO, but no big d= eal. I don=E2=80=99t >> expect any significant difference from the use of in-process >> decompression, unless we really have to go and decompress many modules >> in a row. > > Creating the initrd implies to create the module name database, and it > ends-up decompressing every single module. Using the in-process method > it takes 2 seconds, using the second method 30 seconds. Woow, interesting. > So, I opted for the first solution as you suggested. Here's an attached > patch that fixes the situation. [...] > From 8bbf343510091fad4a08758e0115a70410c1c8d7 Mon Sep 17 00:00:00 2001 > From: Mathieu Othacehe > Date: Mon, 6 Jul 2020 16:04:21 +0200 > Subject: [PATCH] self: Add with-imported-modules+config and use it. > > Introduce "with-imported-modules+config" and use it to replace every call= to > "with-imported-modules" that would trigger an import of (guix config) mod= ule. > > * guix/self.scm (not-config?): New procedure, > (with-imported-modules+config): new macro. > * guix/profiles.scm (linux-module-database): Replace with-imported-module= s by > with-imported-modules+config. > * gnu/system/shadow.scm (account-shepherd-service): Ditto. > * gnu/system/linux-initrd.scm (raw-initrd): Ditto. > * gnu/services/base.scm (default-serial-port): Ditto, > (file-system-shepherd-service): ditto, > (udev-shepherd-service): ditto. > * gnu/services.scm (activation-script): Ditto. > * gnu/machine/ssh.scm (machine-check-initrd-modules): Ditto. [...] > diff --git a/guix/self.scm b/guix/self.scm > index e1350a7403..82bb55f8e7 100644 > --- a/guix/self.scm > +++ b/guix/self.scm > @@ -33,6 +33,8 @@ > #:use-module (srfi srfi-35) > #:use-module (ice-9 match) > #:export (make-config.scm > + not-config? > + with-imported-modules+config > whole-package ;for internal use in 'guix= pull' > compiled-guix > guix-derivation)) > @@ -1063,6 +1065,24 @@ Info manual." > ;; made relative to a nonexistent anonymous module. > #:splice? #t)) >=20=20 > +(define not-config? > + ;; Select (guix =E2=80=A6) and (gnu =E2=80=A6) modules, except (guix c= onfig). > + (match-lambda > + (('guix 'config) #f) > + (('guix rest ...) #t) > + (('gnu rest ...) #t) > + (rest #f))) > + > +(define-syntax-rule (with-imported-modules+config modules exp ...) > + "Import the closure of MODULES and evaluate EXP within this context. = If the > +(guix config) module is part of the closure, it is not selected. This m= odule > +is always replaced by a mocked-one, created by MAKE-CONFIG.SCM pocedure." > + (with-imported-modules `(,@(source-module-closure > + modules > + #:select? not-config?) > + ((guix config) =3D> ,(make-config.scm))) > + exp ...)) Two remarks: I feel that this is not the best place for it, and I think we should add (guix config) if and only if it=E2=80=99s actually part of the closure. For the name I=E2=80=99m tempted by a simpler but less descriptive option. That would give us: (define-syntax-rule (with-imported-modules* modules exp ...) (let ((closure (source-module-closure modules #:select? not-config?))) (with-imported-modules (map (match-lambda (('guix 'config) =E2=80=A6) (module module)) closure) exp ...))) WDYT? As for the location=E2=80=A6 I think the reason things are like this is to = avoid having everything depend on (guix self), but maybe that=E2=80=99s OK after = all? If the zlib bindings were an external package, things would be easier because we wouldn=E2=80=99t have to do this (guix config) dance. More generally, we should look at all the uses of (guix config) and see whether/how we can get rid of them. But I digress=E2=80=A6 Thoughts? Thank you, Ludo=E2=80=99. From debbugs-submit-bounces@debbugs.gnu.org Tue Jul 07 03:32:55 2020 Received: (at 42123) by debbugs.gnu.org; 7 Jul 2020 07:32:55 +0000 Received: from localhost ([127.0.0.1]:35423 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jsi63-0002Ns-55 for submit@debbugs.gnu.org; Tue, 07 Jul 2020 03:32:55 -0400 Received: from eggs.gnu.org ([209.51.188.92]:33008) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jsi62-0002Nf-4e for 42123@debbugs.gnu.org; Tue, 07 Jul 2020 03:32:54 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:41671) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jsi5w-00082F-3O; Tue, 07 Jul 2020 03:32:48 -0400 Received: from [2a01:e0a:fa:a50:f999:25a:74b3:2067] (port=53170 helo=meru) by fencepost.gnu.org with esmtpsa (TLS1.2:RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1jsi5u-0003GC-IV; Tue, 07 Jul 2020 03:32:47 -0400 From: Mathieu Othacehe To: Ludovic =?utf-8?Q?Court=C3=A8s?= Subject: Re: [bug#42123] [PATCH] linux-libre: Enable module compression. References: <20200629142434.21308-1-othacehe@gnu.org> <87366atdve.fsf@gnu.org> <87lfjx6nb9.fsf@gnu.org> <873664ltqt.fsf@gnu.org> <878sfw7mec.fsf@gnu.org> <871rloiept.fsf@gnu.org> Date: Tue, 07 Jul 2020 09:32:43 +0200 In-Reply-To: <871rloiept.fsf@gnu.org> ("Ludovic \=\?utf-8\?Q\?Court\=C3\=A8s\=22'\?\= \=\?utf-8\?Q\?s\?\= message of "Mon, 06 Jul 2020 22:13:50 +0200") Message-ID: <874kqjn5k4.fsf@gnu.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.3 (gnu/linux) MIME-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 42123 Cc: 42123@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -3.3 (---) Hey Ludo! > As for the location=E2=80=A6 I think the reason things are like this is t= o avoid > having everything depend on (guix self), but maybe that=E2=80=99s OK afte= r all? > > If the zlib bindings were an external package, things would be easier > because we wouldn=E2=80=99t have to do this (guix config) dance. > > More generally, we should look at all the uses of (guix config) and see > whether/how we can get rid of them. > > But I digress=E2=80=A6 Thoughts? Thanks for your quick feedback. Given the time I spent debugging this issue, I agree that this (guix config) module thing is hard to deal with. If it works for you, I could create three new Guile libraries: * Guile-libz * Guile-liblz * Guile-xz or maybe just, * Guile-compression It would help us getting rid of (guix config) as you proposed. WDYT? Thanks, Mathieu From debbugs-submit-bounces@debbugs.gnu.org Thu Jul 09 03:56:48 2020 Received: (at 42123) by debbugs.gnu.org; 9 Jul 2020 07:56:48 +0000 Received: from localhost ([127.0.0.1]:39717 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jtRQF-0003gj-QS for submit@debbugs.gnu.org; Thu, 09 Jul 2020 03:56:48 -0400 Received: from eggs.gnu.org ([209.51.188.92]:49340) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jtRQF-0003gY-54 for 42123@debbugs.gnu.org; Thu, 09 Jul 2020 03:56:47 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:51411) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jtRQ9-0003E0-RI for 42123@debbugs.gnu.org; Thu, 09 Jul 2020 03:56:41 -0400 Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=59938 helo=ribbon) by fencepost.gnu.org with esmtpsa (TLS1.2:RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1jtRQ8-0006CH-FP; Thu, 09 Jul 2020 03:56:41 -0400 From: =?utf-8?Q?Ludovic_Court=C3=A8s?= To: Mathieu Othacehe Subject: Re: [bug#42123] [PATCH] linux-libre: Enable module compression. References: <20200629142434.21308-1-othacehe@gnu.org> <87366atdve.fsf@gnu.org> <87lfjx6nb9.fsf@gnu.org> <873664ltqt.fsf@gnu.org> <878sfw7mec.fsf@gnu.org> <871rloiept.fsf@gnu.org> <874kqjn5k4.fsf@gnu.org> X-URL: http://www.fdn.fr/~lcourtes/ X-Revolutionary-Date: 22 Messidor an 228 de la =?utf-8?Q?R=C3=A9volution?= X-PGP-Key-ID: 0x090B11993D9AEBB5 X-PGP-Key: http://www.fdn.fr/~lcourtes/ludovic.asc X-PGP-Fingerprint: 3CE4 6455 8A84 FDC6 9DB4 0CFB 090B 1199 3D9A EBB5 X-OS: x86_64-pc-linux-gnu Date: Thu, 09 Jul 2020 09:56:38 +0200 In-Reply-To: <874kqjn5k4.fsf@gnu.org> (Mathieu Othacehe's message of "Tue, 07 Jul 2020 09:32:43 +0200") Message-ID: <874kqhcea1.fsf@gnu.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.3 (gnu/linux) MIME-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 42123 Cc: 42123@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -3.3 (---) Hi, Mathieu Othacehe skribis: > If it works for you, I could create three new Guile libraries: > > * Guile-libz > * Guile-liblz > * Guile-xz If I may :-), it should be guile-zlib and guile-lzlib to match upstream names. (We don=E2=80=99t have bindings to XZ though.) > or maybe just, > > * Guile-compression Yeah it=E2=80=99s tempting, though OTOH users would be forced to pull every= thing even if they only care about one of these. Dunno. Hall should come in handy to build those libs! I guess people will be happy to have them available outside Guix. > It would help us getting rid of (guix config) as you proposed. Yeah. Thank you! Ludo=E2=80=99. From debbugs-submit-bounces@debbugs.gnu.org Mon Jul 27 12:24:34 2020 Received: (at 42123) by debbugs.gnu.org; 27 Jul 2020 16:24:34 +0000 Received: from localhost ([127.0.0.1]:55546 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1k05vN-0006To-Fq for submit@debbugs.gnu.org; Mon, 27 Jul 2020 12:24:34 -0400 Received: from eggs.gnu.org ([209.51.188.92]:37514) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1k05vH-0006TW-Ms for 42123@debbugs.gnu.org; Mon, 27 Jul 2020 12:24:24 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:60954) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1k05vB-0003AH-NB; Mon, 27 Jul 2020 12:24:13 -0400 Received: from [2a01:cb18:832e:5f00:9858:4478:ae33:b452] (port=42298 helo=cervin) by fencepost.gnu.org with esmtpsa (TLS1.2:RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1k05vA-0006Dc-QT; Mon, 27 Jul 2020 12:24:13 -0400 From: Mathieu Othacehe To: Ludovic =?utf-8?Q?Court=C3=A8s?= Subject: Re: [bug#42123] [PATCH] linux-libre: Enable module compression. References: <20200629142434.21308-1-othacehe@gnu.org> <87366atdve.fsf@gnu.org> <87lfjx6nb9.fsf@gnu.org> <873664ltqt.fsf@gnu.org> <878sfw7mec.fsf@gnu.org> <871rloiept.fsf@gnu.org> <874kqjn5k4.fsf@gnu.org> <874kqhcea1.fsf@gnu.org> Date: Mon, 27 Jul 2020 18:24:09 +0200 In-Reply-To: <874kqhcea1.fsf@gnu.org> ("Ludovic \=\?utf-8\?Q\?Court\=C3\=A8s\=22'\?\= \=\?utf-8\?Q\?s\?\= message of "Thu, 09 Jul 2020 09:56:38 +0200") Message-ID: <87v9i9exjq.fsf@gnu.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.3 (gnu/linux) MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 42123 Cc: 42123@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) --=-=-= Content-Type: text/plain Hey hey, > Hall should come in handy to build those libs! I guess people will be > happy to have them available outside Guix. > >> It would help us getting rid of (guix config) as you proposed. So as you suggested I created "guile-zlib" and "guile-lzlib" which was the easy part. The other part is the hard to digest, attached patch. I tested it running "make check", "make as-derivation", "./pre-inst-env guix build guix". Hope I didn't miss something. Please, tell me what you think :) Thanks, Mathieu --=-=-= Content-Type: text/x-diff; charset=utf-8 Content-Disposition: inline; filename=0001-Use-guile-zlib-and-guile-lzlib-instead-of-guix-confi.patch Content-Transfer-Encoding: quoted-printable >From d0f23078d1963f9aa8facda0fb3ae40e1e8c3cf2 Mon Sep 17 00:00:00 2001 From: Mathieu Othacehe Date: Mon, 27 Jul 2020 16:36:39 +0200 Subject: [PATCH] Use "guile-zlib" and "guile-lzlib" instead of (guix config= ). * Makefile.am (MODULES): Remove guix/zlib.scm and guix/lzlib.scm, (SCM_TESTS): remove tests/zlib.scm, tests/lzlib.scm. * build-aux/build-self.scm (make-config.scm): Remove unused %libz variable. * configure.ac: Remove LIBZ and LIBLZ variables and check instead for Guile-zlib and Guile-lzlib. * doc/guix.texi ("Requirements"): Remove zlib requirement and add Guile-zlib and Guile-lzlib instead. * gnu/packages/package-management.scm (guix)[native-inputs]: Add "guile-zli= b" and "guile-lzlib", [inputs]: remove "zlib" and "lzlib", [propagated-inputs]: ditto, [arguments]: add "guile-zlib" and "guile-lzlib" to Guile load path. * guix/build/download-nar.scm: Use (zlib) instead of (guix zlib). * guix/config.scm.in (%libz, %liblz): Remove them. * guix/cvs-download.scm (cvs-fetch): Do not stub (guix config) in imported modules list, instead add "guile-zlib" to the extension list. * guix/git-download.scm (git-fetch): Ditto. * guix/gnu-maintenance.scm: Use (zlib) instead of (guix zlib). * guix/hg-download.scm (hg-fetch): Do not stub (guix config) in imported modules list, instead add "guile-zlib" to the extension list. * guix/lzlib.scm: Remove it. * guix/man-db.scm: Use (zlib) instead of (guix zlib). * guix/profiles.scm (manual-database): Do not stub (guix config) in imported modules list, instead add "guile-zlib" to the extension list. * guix/scripts/publish.scm: Use (zlib) instead of (guix zlib) and (lzlib) instead of (guix lzlib), (string->compression-type, effective-compression): do not check for zlib and lzlib availability. * guix/scripts/substitute.scm (%compression-methods): Do not check for lzlib availability. * guix/self.scm (specification->package): Add "guile-zlib" and "guile-lzlib" and remove "zlib" and "lzlib", (compiled-guix): remove "zlib" and "lzlib" arguments and add guile-zlib and guile-lzlib to the dependencies, also do not pass "zlib" and "lzlib" to "make-config.scm" procedure, (make-config.scm): remove "zlib" and "lzlib" arguments as well as %libz and %liblz variables. * guix/utils.scm (lzip-port): Use (lzlib) instead of (guix lzlib) and do not check for lzlib availability. * guix/zlib.scm: Remove it. * m4/guix.m4 (GUIX_LIBZ_LIBDIR, GUIX_LIBLZ_FILE_NAME): Remove them. * tests/lzlib.scm: Use (zlib) instead of (guix zlib) and (lzlib) instead of (guix lzlib), and do not check for zlib and lzlib availability. * tests/publish.scm: Ditto. * tests/substitute.scm: Do not check for lzlib availability. * tests/utils.scm: Ditto. * tests/zlib.scm: Remove it. --- Makefile.am | 6 +- build-aux/build-self.scm | 8 +- configure.ac | 33 +- doc/guix.texi | 3 +- gnu/packages/package-management.scm | 13 +- guix/build/download-nar.scm | 2 +- guix/config.scm.in | 8 - guix/cvs-download.scm | 39 +- guix/git-download.scm | 29 +- guix/gnu-maintenance.scm | 2 +- guix/hg-download.scm | 37 +- guix/lzlib.scm | 709 ---------------------------- guix/man-db.scm | 2 +- guix/profiles.scm | 23 +- guix/scripts/publish.scm | 15 +- guix/scripts/substitute.scm | 3 +- guix/self.scm | 32 +- guix/utils.scm | 9 +- guix/zlib.scm | 241 ---------- m4/guix.m4 | 26 - tests/lzlib.scm | 120 ----- tests/publish.scm | 28 +- tests/substitute.scm | 4 +- tests/utils.scm | 3 +- tests/zlib.scm | 62 --- 25 files changed, 100 insertions(+), 1357 deletions(-) delete mode 100644 guix/lzlib.scm delete mode 100644 guix/zlib.scm delete mode 100644 tests/lzlib.scm delete mode 100644 tests/zlib.scm diff --git a/Makefile.am b/Makefile.am index 1e2c26f5ac..24654db471 100644 --- a/Makefile.am +++ b/Makefile.am @@ -109,8 +109,6 @@ MODULES =3D \ guix/cache.scm \ guix/cve.scm \ guix/workers.scm \ - guix/zlib.scm \ - guix/lzlib.scm \ guix/build-system.scm \ guix/build-system/android-ndk.scm \ guix/build-system/ant.scm \ @@ -423,7 +421,6 @@ SCM_TESTS =3D \ tests/import-utils.scm \ tests/inferior.scm \ tests/lint.scm \ - tests/lzlib.scm \ tests/modules.scm \ tests/monads.scm \ tests/nar.scm \ @@ -462,8 +459,7 @@ SCM_TESTS =3D \ tests/upstream.scm \ tests/utils.scm \ tests/uuid.scm \ - tests/workers.scm \ - tests/zlib.scm + tests/workers.scm =20 SH_TESTS =3D \ tests/guix-build.sh \ diff --git a/build-aux/build-self.scm b/build-aux/build-self.scm index e2495919d5..4b6e2bfae5 100644 --- a/build-aux/build-self.scm +++ b/build-aux/build-self.scm @@ -71,7 +71,7 @@ (variables rest ...)))))) (variables %localstatedir %storedir %sysconfdir %system))) =20 -(define* (make-config.scm #:key zlib gzip xz bzip2 +(define* (make-config.scm #:key gzip xz bzip2 (package-name "GNU Guix") (package-version "0") (bug-report-address "bug-guix@gnu.org") @@ -133,11 +133,7 @@ (define %bzip2 #+(and bzip2 (file-append bzip2 "/bin/bzip2"))) (define %xz - #+(and xz (file-append xz "/bin/xz"))) - - (define %libz - #+(and zlib - (file-append zlib "/lib/libz"))))))) + #+(and xz (file-append xz "/bin/xz"))))))) =20 ;;; diff --git a/configure.ac b/configure.ac index 7675eef7c4..5d549cc3af 100644 --- a/configure.ac +++ b/configure.ac @@ -141,6 +141,18 @@ if test "x$guix_cv_have_recent_guile_gcrypt" !=3D "xye= s"; then AC_MSG_ERROR([A recent Guile-Gcrypt could not be found; please install i= t.]) fi =20 +dnl Check for Guile-zlib. +GUILE_MODULE_AVAILABLE([have_guile_zlib], [(zlib)]) +if test "x$have_guile_zlib" !=3D "xyes"; then + AC_MSG_ERROR([Guile-zlib is missing; please install it.]) +fi + +dnl Check for Guile-lzlib. +GUILE_MODULE_AVAILABLE([have_guile_lzlib], [(lzlib)]) +if test "x$have_guile_lzlib" !=3D "xyes"; then + AC_MSG_ERROR([Guile-lzlib is missing; please install it.]) +fi + dnl Guile-newt is used by the graphical installer. GUILE_MODULE_AVAILABLE([have_guile_newt], [(newt)]) =20 @@ -245,27 +257,6 @@ esac AC_SUBST([LIBGCRYPT_PREFIX]) AC_SUBST([LIBGCRYPT_LIBDIR]) =20 -dnl Library name of zlib suitable for 'dynamic-link'. -GUIX_LIBZ_LIBDIR([libz_libdir]) -if test "x$libz_libdir" =3D "x"; then - LIBZ=3D"libz" -else - LIBZ=3D"$libz_libdir/libz" -fi -AC_MSG_CHECKING([for zlib's shared library name]) -AC_MSG_RESULT([$LIBZ]) -AC_SUBST([LIBZ]) - -dnl Library name of lzlib suitable for 'dynamic-link'. -GUIX_LIBLZ_FILE_NAME([LIBLZ]) -if test "x$LIBLZ" =3D "x"; then - LIBLZ=3D"liblz" -else - # Strip the .so or .so.1 extension since that's what 'dynamic-link' expe= cts. - LIBLZ=3D"`echo $LIBLZ | sed -es'/\.so\(\.[[0-9.]]\+\)\?//g'`" -fi -AC_SUBST([LIBLZ]) - dnl Check for Guile-SSH, for the (guix ssh) module. GUIX_CHECK_GUILE_SSH AM_CONDITIONAL([HAVE_GUILE_SSH], diff --git a/doc/guix.texi b/doc/guix.texi index d4557b360a..502dd7547b 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -778,12 +778,13 @@ Guile,, gnutls-guile, GnuTLS-Guile}); @item @uref{https://notabug.org/guile-sqlite3/guile-sqlite3, Guile-SQLite3}, ver= sion 0.1.0 or later; +@item @uref{https://notabug.org/guile-zlib/guile-zlib, Guile-zlib}; +@item @uref{https://notabug.org/guile-lzlib/guile-lzlib, Guile-lzlib}; @item @c FIXME: Specify a version number once a release has been made. @uref{https://gitlab.com/guile-git/guile-git, Guile-Git}, from August 2017 or later; @item @uref{https://savannah.nongnu.org/projects/guile-json/, Guile-JSON} = 3.x; -@item @url{https://zlib.net, zlib}; @item @url{https://www.gnu.org/software/make/, GNU Make}. @end itemize =20 diff --git a/gnu/packages/package-management.scm b/gnu/packages/package-man= agement.scm index 277b125809..7c42f842cb 100644 --- a/gnu/packages/package-management.scm +++ b/gnu/packages/package-management.scm @@ -278,6 +278,8 @@ $(prefix)/etc/init.d\n"))) (gcrypt (assoc-ref inputs "guile-gcrypt")) (json (assoc-ref inputs "guile-json")) (sqlite (assoc-ref inputs "guile-sqlite3")) + (zlib (assoc-ref inputs "guile-zlib")) + (lzlib (assoc-ref inputs "guile-lzlib")) (git (assoc-ref inputs "guile-git")) (bs (assoc-ref inputs "guile-bytestructures")) @@ -285,7 +287,7 @@ $(prefix)/etc/init.d\n"))) (gnutls (assoc-ref inputs "gnutls")) (locales (assoc-ref inputs "glibc-utf8-loca= les")) (deps (list gcrypt json sqlite gnutls - git bs ssh)) + git bs ssh zlib lzlib)) (effective (read-line (open-pipe* OPEN_READ @@ -325,6 +327,8 @@ $(prefix)/etc/init.d\n"))) ("guile-gcrypt" ,guile-gcrypt) ("guile-json" ,guile-json-4) ("guile-sqlite3" ,guile-sqlite3) + ("guile-zlib" ,guile-zlib) + ("guile-lzlib" ,guile-lzlib) ("guile-ssh" ,guile-ssh) ("guile-git" ,guile-git) =20 @@ -341,9 +345,6 @@ $(prefix)/etc/init.d\n"))) (inputs `(("bzip2" ,bzip2) ("gzip" ,gzip) - ("zlib" ,zlib) ;for 'guix publish' - ("lzlib" ,lzlib) ;for 'guix publish' and 'guix substit= ute' - ("sqlite" ,sqlite) ("libgcrypt" ,libgcrypt) =20 @@ -377,7 +378,9 @@ $(prefix)/etc/init.d\n"))) ("guile-json" ,guile-json-4) ("guile-sqlite3" ,guile-sqlite3) ("guile-ssh" ,guile-ssh) - ("guile-git" ,guile-git))) + ("guile-git" ,guile-git) + ("guile-zlib" ,guile-zlib) + ("guile-lzlib" ,guile-lzlib))) =20 (home-page "https://www.gnu.org/software/guix/") (synopsis "Functional package manager for installed software package= s and versions") diff --git a/guix/build/download-nar.scm b/guix/build/download-nar.scm index 377e428341..8f67bc9c9c 100644 --- a/guix/build/download-nar.scm +++ b/guix/build/download-nar.scm @@ -20,7 +20,7 @@ #:use-module (guix build download) #:use-module (guix build utils) #:use-module ((guix serialization) #:hide (dump-port*)) - #:use-module (guix zlib) + #:use-module (zlib) #:use-module (guix progress) #:use-module (web uri) #:use-module (srfi srfi-11) diff --git a/guix/config.scm.in b/guix/config.scm.in index 0ada0f3c38..b2901735d8 100644 --- a/guix/config.scm.in +++ b/guix/config.scm.in @@ -33,8 +33,6 @@ %config-directory =20 %system - %libz - %liblz %gzip %bzip2 %xz)) @@ -88,12 +86,6 @@ (define %system "@guix_system@") =20 -(define %libz - "@LIBZ@") - -(define %liblz - "@LIBLZ@") - (define %gzip "@GZIP@") =20 diff --git a/guix/cvs-download.scm b/guix/cvs-download.scm index cb42103aae..76b3eac739 100644 --- a/guix/cvs-download.scm +++ b/guix/cvs-download.scm @@ -60,35 +60,26 @@ "Return a fixed-output derivation that fetches REF, a object. The output is expected to have recursive hash HASH of type HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if #f." - (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 guile-zlib + (module-ref (resolve-interface '(gnu packages guile)) 'guile-zlib)) =20 (define modules - (cons `((guix config) =3D> ,config.scm) - (delete '(guix config) - (source-module-closure '((guix build cvs) - (guix build download-nar)))))) + (delete '(guix config) + (source-module-closure '((guix build cvs) + (guix build download-nar))))) (define build (with-imported-modules modules - #~(begin - (use-modules (guix build cvs) - (guix build download-nar)) + (with-extensions (list guile-zlib) + #~(begin + (use-modules (guix build cvs) + (guix build download-nar)) =20 - (or (cvs-fetch '#$(cvs-reference-root-directory ref) - '#$(cvs-reference-module ref) - '#$(cvs-reference-revision ref) - #$output - #:cvs-command (string-append #+cvs "/bin/cvs")) - (download-nar #$output))))) + (or (cvs-fetch '#$(cvs-reference-root-directory ref) + '#$(cvs-reference-module ref) + '#$(cvs-reference-revision ref) + #$output + #:cvs-command (string-append #+cvs "/bin/cvs")) + (download-nar #$output)))))) =20 (mlet %store-monad ((guile (package->derivation guile system))) (gexp->derivation (or name "cvs-checkout") build diff --git a/guix/git-download.scm b/guix/git-download.scm index 71ea1031c5..90634a8c4c 100644 --- a/guix/git-download.scm +++ b/guix/git-download.scm @@ -84,35 +84,26 @@ HASH-ALGO (a symbol). Use NAME as the file name, or a = generic name if #f." ("tar" ,(module-ref (resolve-interface '(gnu packages base)) 'tar))))) =20 - (define zlib - (module-ref (resolve-interface '(gnu packages compression)) 'zlib)) - (define guile-json (module-ref (resolve-interface '(gnu packages guile)) 'guile-json-3)) =20 + (define guile-zlib + (module-ref (resolve-interface '(gnu packages guile)) 'guile-zlib)) + (define gnutls (module-ref (resolve-interface '(gnu packages tls)) 'gnutls)) =20 - (define config.scm - (scheme-file "config.scm" - #~(begin - (define-module (guix config) - #:export (%libz)) - - (define %libz - #+(file-append zlib "/lib/libz"))))) - (define modules - (cons `((guix config) =3D> ,config.scm) - (delete '(guix config) - (source-module-closure '((guix build git) - (guix build utils) - (guix build download-nar) - (guix swh)))))) + (delete '(guix config) + (source-module-closure '((guix build git) + (guix build utils) + (guix build download-nar) + (guix swh))))) =20 (define build (with-imported-modules modules - (with-extensions (list guile-json gnutls) ;for (guix swh) + (with-extensions (list guile-json gnutls ;for (guix swh) + guile-zlib) #~(begin (use-modules (guix build git) (guix build utils) diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm index cd7109002b..08b2bcf758 100644 --- a/guix/gnu-maintenance.scm +++ b/guix/gnu-maintenance.scm @@ -36,7 +36,7 @@ #:use-module (guix records) #:use-module (guix upstream) #:use-module (guix packages) - #:use-module (guix zlib) + #:use-module (zlib) #:export (gnu-package-name gnu-package-mundane-name gnu-package-copyright-holder diff --git a/guix/hg-download.scm b/guix/hg-download.scm index 4cdc1a780a..694105ceba 100644 --- a/guix/hg-download.scm +++ b/guix/hg-download.scm @@ -60,35 +60,26 @@ "Return a fixed-output derivation that fetches REF, a object. The output is expected to have recursive hash HASH of type HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if #f." - (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 guile-zlib + (module-ref (resolve-interface '(gnu packages guile)) 'guile-zlib)) =20 (define modules - (cons `((guix config) =3D> ,config.scm) - (delete '(guix config) - (source-module-closure '((guix build hg) - (guix build download-nar)))))) + (delete '(guix config) + (source-module-closure '((guix build hg) + (guix build download-nar))))) =20 (define build (with-imported-modules modules - #~(begin - (use-modules (guix build hg) - (guix build download-nar)) + (with-extensions (list guile-zlib) + #~(begin + (use-modules (guix build hg) + (guix build download-nar)) =20 - (or (hg-fetch '#$(hg-reference-url ref) - '#$(hg-reference-changeset ref) - #$output - #:hg-command (string-append #+hg "/bin/hg")) - (download-nar #$output))))) + (or (hg-fetch '#$(hg-reference-url ref) + '#$(hg-reference-changeset ref) + #$output + #:hg-command (string-append #+hg "/bin/hg")) + (download-nar #$output)))))) =20 (mlet %store-monad ((guile (package->derivation guile system))) (gexp->derivation (or name "hg-checkout") build diff --git a/guix/lzlib.scm b/guix/lzlib.scm deleted file mode 100644 index 2fc326ba34..0000000000 --- a/guix/lzlib.scm +++ /dev/null @@ -1,709 +0,0 @@ -;;; GNU Guix --- Functional package management for GNU -;;; Copyright =C2=A9 2019 Pierre Neidhardt -;;; Copyright =C2=A9 2019, 2020 Ludovic Court=C3=A8s -;;; -;;; This file is part of GNU Guix. -;;; -;;; GNU Guix is free software; you can redistribute it and/or modify it -;;; under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 3 of the License, or (at -;;; your option) any later version. -;;; -;;; GNU Guix is distributed in the hope that it will be useful, but -;;; WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with GNU Guix. If not, see . - -(define-module (guix lzlib) - #:use-module (rnrs bytevectors) - #:use-module (rnrs arithmetic bitwise) - #:use-module (ice-9 binary-ports) - #:use-module (ice-9 match) - #:use-module (system foreign) - #:use-module (guix config) - #:use-module (srfi srfi-11) - #:export (lzlib-available? - make-lzip-input-port - make-lzip-output-port - make-lzip-input-port/compressed - call-with-lzip-input-port - call-with-lzip-output-port - %default-member-length-limit - %default-compression-level - dictionary-size+match-length-limit)) - -;;; Commentary: -;;; -;;; Bindings to the lzlib / liblz API. Some convenience functions are also -;;; provided (see the export). -;;; -;;; While the bindings are complete, the convenience functions only support -;;; single member archives. To decompress single member archives, we loop -;;; until lz-decompress-read returns 0. This is simpler. To support mult= iple -;;; members properly, we need (among others) to call lz-decompress-finish = and -;;; loop over lz-decompress-read until lz-decompress-finished? returns #t. -;;; Otherwise a multi-member archive starting with an empty member would o= nly -;;; decompress the empty member and stop there, resulting in truncated out= put. - -;;; Code: - -(define %lzlib - ;; File name of lzlib's shared library. When updating via 'guix pull', - ;; '%liblz' might be undefined so protect against it. - (delay (dynamic-link (if (defined? '%liblz) - %liblz - "liblz")))) - -(define (lzlib-available?) - "Return true if lzlib is available, #f otherwise." - (false-if-exception (force %lzlib))) - -(define (lzlib-procedure ret name parameters) - "Return a procedure corresponding to C function NAME in liblz, or #f if -either lzlib or the function could not be found." - (match (false-if-exception (dynamic-func name (force %lzlib))) - ((? pointer? ptr) - (pointer->procedure ret ptr parameters)) - (#f - #f))) - -(define-wrapped-pointer-type - ;; Scheme counterpart of the 'LZ_Decoder' opaque type. - lz-decoder? - pointer->lz-decoder - lz-decoder->pointer - (lambda (obj port) - (format port "#" - (number->string (object-address obj) 16)))) - -(define-wrapped-pointer-type - ;; Scheme counterpart of the 'LZ_Encoder' opaque type. - lz-encoder? - pointer->lz-encoder - lz-encoder->pointer - (lambda (obj port) - (format port "#" - (number->string (object-address obj) 16)))) - -;; From lzlib.h -(define %error-number-ok 0) -(define %error-number-bad-argument 1) -(define %error-number-mem-error 2) -(define %error-number-sequence-error 3) -(define %error-number-header-error 4) -(define %error-number-unexpected-eof 5) -(define %error-number-data-error 6) -(define %error-number-library-error 7) - - -;; Compression bindings. - -(define lz-compress-open - (let ((proc (lzlib-procedure '* "LZ_compress_open" (list int int uint64)= )) - ;; member-size is an "unsigned long long", and the C standard guar= antees - ;; a minimum range of 0..2^64-1. - (unlimited-size (- (expt 2 64) 1))) - (lambda* (dictionary-size match-length-limit #:optional (member-size u= nlimited-size)) - "Initialize the internal stream state for compression and returns a -pointer that can only be used as the encoder argument for the other -lz-compress functions, or a null pointer if the encoder could not be -allocated. - -See the manual: (lzlib) Compression functions." - (let ((encoder-ptr (proc dictionary-size match-length-limit member-s= ize))) - (if (not (=3D (lz-compress-error encoder-ptr) -1)) - (pointer->lz-encoder encoder-ptr) - (throw 'lzlib-error 'lz-compress-open)))))) - -(define lz-compress-close - (let ((proc (lzlib-procedure int "LZ_compress_close" '(*)))) - (lambda (encoder) - "Close encoder. ENCODER can no longer be used as an argument to any -lz-compress function. " - (let ((ret (proc (lz-encoder->pointer encoder)))) - (if (=3D ret -1) - (throw 'lzlib-error 'lz-compress-close ret) - ret))))) - -(define lz-compress-finish - (let ((proc (lzlib-procedure int "LZ_compress_finish" '(*)))) - (lambda (encoder) - "Tell that all the data for this member have already been written (w= ith -the `lz-compress-write' function). It is safe to call `lz-compress-finish= ' as -many times as needed. After all the produced compressed data have been re= ad -with `lz-compress-read' and `lz-compress-member-finished?' returns #t, a n= ew -member can be started with 'lz-compress-restart-member'." - (let ((ret (proc (lz-encoder->pointer encoder)))) - (if (=3D ret -1) - (throw 'lzlib-error 'lz-compress-finish (lz-compress-error enc= oder)) - ret))))) - -(define lz-compress-restart-member - (let ((proc (lzlib-procedure int "LZ_compress_restart_member" (list '* u= int64)))) - (lambda (encoder member-size) - "Start a new member in a multimember data stream. -Call this function only after `lz-compress-member-finished?' indicates tha= t the -current member has been fully read (with the `lz-compress-read' function)." - (let ((ret (proc (lz-encoder->pointer encoder) member-size))) - (if (=3D ret -1) - (throw 'lzlib-error 'lz-compress-restart-member - (lz-compress-error encoder)) - ret))))) - -(define lz-compress-sync-flush - (let ((proc (lzlib-procedure int "LZ_compress_sync_flush" (list '*)))) - (lambda (encoder) - "Make available to `lz-compress-read' all the data already written w= ith -the `LZ-compress-write' function. First call `lz-compress-sync-flush'. T= hen -call 'lz-compress-read' until it returns 0. - -Repeated use of `LZ-compress-sync-flush' may degrade compression ratio, -so use it only when needed. " - (let ((ret (proc (lz-encoder->pointer encoder)))) - (if (=3D ret -1) - (throw 'lzlib-error 'lz-compress-sync-flush - (lz-compress-error encoder)) - ret))))) - -(define lz-compress-read - (let ((proc (lzlib-procedure int "LZ_compress_read" (list '* '* int)))) - (lambda* (encoder lzfile-bv #:optional (start 0) (count (bytevector-le= ngth lzfile-bv))) - "Read up to COUNT bytes from the encoder stream, storing the results= in LZFILE-BV. -Return the number of uncompressed bytes written, a positive integer." - (let ((ret (proc (lz-encoder->pointer encoder) - (bytevector->pointer lzfile-bv start) - count))) - (if (=3D ret -1) - (throw 'lzlib-error 'lz-compress-read (lz-compress-error encod= er)) - ret))))) - -(define lz-compress-write - (let ((proc (lzlib-procedure int "LZ_compress_write" (list '* '* int)))) - (lambda* (encoder bv #:optional (start 0) (count (bytevector-length bv= ))) - "Write up to COUNT bytes from BV to the encoder stream. Return the -number of uncompressed bytes written, a strictly positive integer." - (let ((ret (proc (lz-encoder->pointer encoder) - (bytevector->pointer bv start) - count))) - (if (< ret 0) - (throw 'lzlib-error 'lz-compress-write (lz-compress-error enco= der)) - ret))))) - -(define lz-compress-write-size - (let ((proc (lzlib-procedure int "LZ_compress_write_size" '(*)))) - (lambda (encoder) - "The maximum number of bytes that can be immediately written through= the -`lz-compress-write' function. - -It is guaranteed that an immediate call to `lz-compress-write' will accept= a -SIZE up to the returned number of bytes. " - (let ((ret (proc (lz-encoder->pointer encoder)))) - (if (=3D ret -1) - (throw 'lzlib-error 'lz-compress-write-size (lz-compress-error= encoder)) - ret))))) - -(define lz-compress-error - (let ((proc (lzlib-procedure int "LZ_compress_errno" '(*)))) - (lambda (encoder) - "ENCODER can be a Scheme object or a pointer." - (let* ((error-number (proc (if (lz-encoder? encoder) - (lz-encoder->pointer encoder) - encoder)))) - error-number)))) - -(define lz-compress-finished? - (let ((proc (lzlib-procedure int "LZ_compress_finished" '(*)))) - (lambda (encoder) - "Return #t if all the data have been read and `lz-compress-close' can -be safely called. Otherwise return #f." - (let ((ret (proc (lz-encoder->pointer encoder)))) - (match ret - (1 #t) - (0 #f) - (_ (throw 'lzlib-error 'lz-compress-finished? (lz-compress-error= encoder)))))))) - -(define lz-compress-member-finished? - (let ((proc (lzlib-procedure int "LZ_compress_member_finished" '(*)))) - (lambda (encoder) - "Return #t if the current member, in a multimember data stream, has -been fully read and 'lz-compress-restart-member' can be safely called. -Otherwise return #f." - (let ((ret (proc (lz-encoder->pointer encoder)))) - (match ret - (1 #t) - (0 #f) - (_ (throw 'lzlib-error 'lz-compress-member-finished? (lz-compres= s-error encoder)))))))) - -(define lz-compress-data-position - (let ((proc (lzlib-procedure uint64 "LZ_compress_data_position" '(*)))) - (lambda (encoder) - "Return the number of input bytes already compressed in the current -member." - (let ((ret (proc (lz-encoder->pointer encoder)))) - (if (=3D ret -1) - (throw 'lzlib-error 'lz-compress-data-position - (lz-compress-error encoder)) - ret))))) - -(define lz-compress-member-position - (let ((proc (lzlib-procedure uint64 "LZ_compress_member_position" '(*)))) - (lambda (encoder) - "Return the number of compressed bytes already produced, but perhaps -not yet read, in the current member." - (let ((ret (proc (lz-encoder->pointer encoder)))) - (if (=3D ret -1) - (throw 'lzlib-error 'lz-compress-member-position - (lz-compress-error encoder)) - ret))))) - -(define lz-compress-total-in-size - (let ((proc (lzlib-procedure uint64 "LZ_compress_total_in_size" '(*)))) - (lambda (encoder) - "Return the total number of input bytes already compressed." - (let ((ret (proc (lz-encoder->pointer encoder)))) - (if (=3D ret -1) - (throw 'lzlib-error 'lz-compress-total-in-size - (lz-compress-error encoder)) - ret))))) - -(define lz-compress-total-out-size - (let ((proc (lzlib-procedure uint64 "LZ_compress_total_out_size" '(*)))) - (lambda (encoder) - "Return the total number of compressed bytes already produced, but -perhaps not yet read." - (let ((ret (proc (lz-encoder->pointer encoder)))) - (if (=3D ret -1) - (throw 'lzlib-error 'lz-compress-total-out-size - (lz-compress-error encoder)) - ret))))) - - -;; Decompression bindings. - -(define lz-decompress-open - (let ((proc (lzlib-procedure '* "LZ_decompress_open" '()))) - (lambda () - "Initializes the internal stream state for decompression and returns= a -pointer that can only be used as the decoder argument for the other -lz-decompress functions, or a null pointer if the decoder could not be -allocated. - -See the manual: (lzlib) Decompression functions." - (let ((decoder-ptr (proc))) - (if (not (=3D (lz-decompress-error decoder-ptr) -1)) - (pointer->lz-decoder decoder-ptr) - (throw 'lzlib-error 'lz-decompress-open)))))) - -(define lz-decompress-close - (let ((proc (lzlib-procedure int "LZ_decompress_close" '(*)))) - (lambda (decoder) - "Close decoder. DECODER can no longer be used as an argument to any -lz-decompress function. " - (let ((ret (proc (lz-decoder->pointer decoder)))) - (if (=3D ret -1) - (throw 'lzlib-error 'lz-decompress-close ret) - ret))))) - -(define lz-decompress-finish - (let ((proc (lzlib-procedure int "LZ_decompress_finish" '(*)))) - (lambda (decoder) - "Tell that all the data for this stream have already been written (w= ith -the `lz-decompress-write' function). It is safe to call -`lz-decompress-finish' as many times as needed." - (let ((ret (proc (lz-decoder->pointer decoder)))) - (if (=3D ret -1) - (throw 'lzlib-error 'lz-decompress-finish (lz-decompress-error= decoder)) - ret))))) - -(define lz-decompress-reset - (let ((proc (lzlib-procedure int "LZ_decompress_reset" '(*)))) - (lambda (decoder) - "Reset the internal state of DECODER as it was just after opening it -with the `lz-decompress-open' function. Data stored in the internal buffe= rs -is discarded. Position counters are set to 0." - (let ((ret (proc (lz-decoder->pointer decoder)))) - (if (=3D ret -1) - (throw 'lzlib-error 'lz-decompress-reset - (lz-decompress-error decoder)) - ret))))) - -(define lz-decompress-sync-to-member - (let ((proc (lzlib-procedure int "LZ_decompress_sync_to_member" '(*)))) - (lambda (decoder) - "Reset the error state of DECODER and enters a search state that las= ts -until a new member header (or the end of the stream) is found. After a -successful call to `lz-decompress-sync-to-member', data written with -`lz-decompress-write' will be consumed and 'lz-decompress-read' will retur= n 0 -until a header is found. - -This function is useful to discard any data preceding the first member, or= to -discard the rest of the current member, for example in case of a data -error. If the decoder is already at the beginning of a member, this funct= ion -does nothing." - (let ((ret (proc (lz-decoder->pointer decoder)))) - (if (=3D ret -1) - (throw 'lzlib-error 'lz-decompress-sync-to-member - (lz-decompress-error decoder)) - ret))))) - -(define lz-decompress-read - (let ((proc (lzlib-procedure int "LZ_decompress_read" (list '* '* int)))) - (lambda* (decoder file-bv #:optional (start 0) (count (bytevector-leng= th file-bv))) - "Read up to COUNT bytes from the decoder stream, storing the results= in FILE-BV. -Return the number of uncompressed bytes written, a non-negative positive i= nteger." - (let ((ret (proc (lz-decoder->pointer decoder) - (bytevector->pointer file-bv start) - count))) - (if (< ret 0) - (throw 'lzlib-error 'lz-decompress-read (lz-decompress-error d= ecoder)) - ret))))) - -(define lz-decompress-write - (let ((proc (lzlib-procedure int "LZ_decompress_write" (list '* '* int))= )) - (lambda* (decoder bv #:optional (start 0) (count (bytevector-length bv= ))) - "Write up to COUNT bytes from BV to the decoder stream. Return the -number of uncompressed bytes written, a non-negative integer." - (let ((ret (proc (lz-decoder->pointer decoder) - (bytevector->pointer bv start) - count))) - (if (< ret 0) - (throw 'lzlib-error 'lz-decompress-write (lz-decompress-error = decoder)) - ret))))) - -(define lz-decompress-write-size - (let ((proc (lzlib-procedure int "LZ_decompress_write_size" '(*)))) - (lambda (decoder) - "Return the maximum number of bytes that can be immediately written -through the `lz-decompress-write' function. - -It is guaranteed that an immediate call to `lz-decompress-write' will acce= pt a -SIZE up to the returned number of bytes. " - (let ((ret (proc (lz-decoder->pointer decoder)))) - (if (=3D ret -1) - (throw 'lzlib-error 'lz-decompress-write-size (lz-decompress-e= rror decoder)) - ret))))) - -(define lz-decompress-error - (let ((proc (lzlib-procedure int "LZ_decompress_errno" '(*)))) - (lambda (decoder) - "DECODER can be a Scheme object or a pointer." - (let* ((error-number (proc (if (lz-decoder? decoder) - (lz-decoder->pointer decoder) - decoder)))) - error-number)))) - -(define lz-decompress-finished? - (let ((proc (lzlib-procedure int "LZ_decompress_finished" '(*)))) - (lambda (decoder) - "Return #t if all the data have been read and `lz-decompress-close' = can -be safely called. Otherwise return #f." - (let ((ret (proc (lz-decoder->pointer decoder)))) - (match ret - (1 #t) - (0 #f) - (_ (throw 'lzlib-error 'lz-decompress-finished? (lz-decompress-e= rror decoder)))))))) - -(define lz-decompress-member-finished? - (let ((proc (lzlib-procedure int "LZ_decompress_member_finished" '(*)))) - (lambda (decoder) - "Return #t if the current member, in a multimember data stream, has -been fully read and `lz-decompress-restart-member' can be safely called. -Otherwise return #f." - (let ((ret (proc (lz-decoder->pointer decoder)))) - (match ret - (1 #t) - (0 #f) - (_ (throw 'lzlib-error 'lz-decompress-member-finished? (lz-decom= press-error decoder)))))))) - -(define lz-decompress-member-version - (let ((proc (lzlib-procedure int "LZ_decompress_member_version" '(*)))) - (lambda (decoder) - (let ((ret (proc (lz-decoder->pointer decoder)))) - "Return the version of current member from member header." - (if (=3D ret -1) - (throw 'lzlib-error 'lz-decompress-data-position - (lz-decompress-error decoder)) - ret))))) - -(define lz-decompress-dictionary-size - (let ((proc (lzlib-procedure int "LZ_decompress_dictionary_size" '(*)))) - (lambda (decoder) - (let ((ret (proc (lz-decoder->pointer decoder)))) - "Return the dictionary size of current member from member header." - (if (=3D ret -1) - (throw 'lzlib-error 'lz-decompress-member-position - (lz-decompress-error decoder)) - ret))))) - -(define lz-decompress-data-crc - (let ((proc (lzlib-procedure unsigned-int "LZ_decompress_data_crc" '(*))= )) - (lambda (decoder) - (let ((ret (proc (lz-decoder->pointer decoder)))) - "Return the 32 bit Cyclic Redundancy Check of the data decompressed -from the current member. The returned value is valid only when -`lz-decompress-member-finished' returns #t. " - (if (=3D ret -1) - (throw 'lzlib-error 'lz-decompress-member-position - (lz-decompress-error decoder)) - ret))))) - -(define lz-decompress-data-position - (let ((proc (lzlib-procedure uint64 "LZ_decompress_data_position" '(*)))) - (lambda (decoder) - "Return the number of decompressed bytes already produced, but perha= ps -not yet read, in the current member." - (let ((ret (proc (lz-decoder->pointer decoder)))) - (if (=3D ret -1) - (throw 'lzlib-error 'lz-decompress-data-position - (lz-decompress-error decoder)) - ret))))) - -(define lz-decompress-member-position - (let ((proc (lzlib-procedure uint64 "LZ_decompress_member_position" '(*)= ))) - (lambda (decoder) - "Return the number of input bytes already decompressed in the current -member." - (let ((ret (proc (lz-decoder->pointer decoder)))) - (if (=3D ret -1) - (throw 'lzlib-error 'lz-decompress-member-position - (lz-decompress-error decoder)) - ret))))) - -(define lz-decompress-total-in-size - (let ((proc (lzlib-procedure uint64 "LZ_decompress_total_in_size" '(*)))) - (lambda (decoder) - (let ((ret (proc (lz-decoder->pointer decoder)))) - "Return the total number of input bytes already compressed." - (if (=3D ret -1) - (throw 'lzlib-error 'lz-decompress-total-in-size - (lz-decompress-error decoder)) - ret))))) - -(define lz-decompress-total-out-size - (let ((proc (lzlib-procedure uint64 "LZ_decompress_total_out_size" '(*))= )) - (lambda (decoder) - (let ((ret (proc (lz-decoder->pointer decoder)))) - "Return the total number of compressed bytes already produced, but -perhaps not yet read." - (if (=3D ret -1) - (throw 'lzlib-error 'lz-decompress-total-out-size - (lz-decompress-error decoder)) - ret))))) - - -;; High level functions. - -(define* (lzread! decoder port bv - #:optional (start 0) (count (bytevector-length bv))) - "Read up to COUNT bytes from PORT into BV at offset START. Return the -number of uncompressed bytes actually read; it is zero if COUNT is zero or= if -the end-of-stream has been reached." - (define (feed-decoder! decoder) - ;; Feed DECODER with data read from PORT. - (match (get-bytevector-n port (lz-decompress-write-size decoder)) - ((? eof-object? eof) eof) - (bv (lz-decompress-write decoder bv)))) - - (let loop ((read 0) - (start start)) - (cond ((< read count) - (match (lz-decompress-read decoder bv start (- count read)) - (0 (cond ((lz-decompress-finished? decoder) - read) - ((eof-object? (feed-decoder! decoder)) - (lz-decompress-finish decoder) - (loop read start)) - (else ;read again - (loop read start)))) - (n (loop (+ read n) (+ start n))))) - (else - read)))) - -(define (lzwrite! encoder source source-offset source-count - target target-offset target-count) - "Write up to SOURCE-COUNT bytes from SOURCE to ENCODER, and read up to -TARGET-COUNT bytes into TARGET at TARGET-OFFSET. Return two values: the -number of bytes read from SOURCE, and the number of bytes written to TARGE= T, -possibly zero." - (define read - (if (> (lz-compress-write-size encoder) 0) - (match (lz-compress-write encoder source source-offset source-coun= t) - (0 (lz-compress-finish encoder) 0) - (n n)) - 0)) - - (define written - (lz-compress-read encoder target target-offset target-count)) - - (values read written)) - -(define* (lzwrite encoder bv lz-port - #:optional (start 0) (count (bytevector-length bv))) - "Write up to COUNT bytes from BV at offset START into LZ-PORT. Return -the number of uncompressed bytes written, a non-negative integer." - (let ((written 0) - (read 0)) - (while (and (< 0 (lz-compress-write-size encoder)) - (< written count)) - (set! written (+ written - (lz-compress-write encoder bv (+ start written) (- = count written))))) - (when (=3D written 0) - (lz-compress-finish encoder)) - (let ((lz-bv (make-bytevector written))) - (let loop ((rd 0)) - (set! rd (lz-compress-read encoder lz-bv 0 (bytevector-length lz-b= v))) - (put-bytevector lz-port lz-bv 0 rd) - (set! read (+ read rd)) - (unless (=3D rd 0) - (loop rd)))) - ;; `written' is the total byte count of uncompressed data. - written)) - - -;;; -;;; Port interface. -;;; - -;; Alist of (levels (dictionary-size match-length-limit)). 0 is the faste= st. -;; See bbexample.c in lzlib's source. -(define %compression-levels - `((0 65535 16) - (1 ,(bitwise-arithmetic-shift-left 1 20) 5) - (2 ,(bitwise-arithmetic-shift-left 3 19) 6) - (3 ,(bitwise-arithmetic-shift-left 1 21) 8) - (4 ,(bitwise-arithmetic-shift-left 3 20) 12) - (5 ,(bitwise-arithmetic-shift-left 1 22) 20) - (6 ,(bitwise-arithmetic-shift-left 1 23) 36) - (7 ,(bitwise-arithmetic-shift-left 1 24) 68) - (8 ,(bitwise-arithmetic-shift-left 3 23) 132) - (9 ,(bitwise-arithmetic-shift-left 1 25) 273))) - -(define %default-compression-level - 6) - -(define (dictionary-size+match-length-limit level) - "Return two values: the dictionary size for LEVEL, and its match-length -limit. LEVEL must be a compression level, an integer between 0 and 9." - (match (assv-ref %compression-levels level) - ((dictionary-size match-length-limit) - (values dictionary-size match-length-limit)))) - -(define* (make-lzip-input-port port) - "Return an input port that decompresses data read from PORT, a file port. -PORT is automatically closed when the resulting port is closed." - (define decoder (lz-decompress-open)) - - (define (read! bv start count) - (lzread! decoder port bv start count)) - - (make-custom-binary-input-port "lzip-input" read! #f #f - (lambda () - (lz-decompress-close decoder) - (close-port port)))) - -(define* (make-lzip-output-port port - #:key - (level %default-compression-level)) - "Return an output port that compresses data at the given LEVEL, using PO= RT, -a file port, as its sink. PORT is automatically closed when the resulting -port is closed." - (define encoder - (call-with-values (lambda () (dictionary-size+match-length-limit level= )) - lz-compress-open)) - - (define (write! bv start count) - (lzwrite encoder bv port start count)) - - (make-custom-binary-output-port "lzip-output" write! #f #f - (lambda () - (lz-compress-finish encoder) - ;; "lz-read" the trailing metadata add= ed by `lz-compress-finish'. - (let ((lz-bv (make-bytevector (* 64 10= 24)))) - (let loop ((rd 0)) - (set! rd (lz-compress-read encoder= lz-bv 0 (bytevector-length lz-bv))) - (put-bytevector port lz-bv 0 rd) - (unless (=3D rd 0) - (loop rd)))) - (lz-compress-close encoder) - (close-port port)))) - -(define* (make-lzip-input-port/compressed port - #:key - (level %default-compression-leve= l)) - "Return an input port that compresses data read from PORT, with the give= n LEVEL. -PORT is automatically closed when the resulting port is closed." - (define encoder - (call-with-values (lambda () (dictionary-size+match-length-limit level= )) - lz-compress-open)) - - (define input-buffer (make-bytevector 8192)) - (define input-len 0) - (define input-offset 0) - - (define input-eof? #f) - - (define (read! bv start count) - (cond - (input-eof? - (match (lz-compress-read encoder bv start count) - (0 (if (lz-compress-finished? encoder) - 0 - (read! bv start count))) - (n n))) - ((=3D input-offset input-len) - (match (get-bytevector-n! port input-buffer 0 - (bytevector-length input-buffer)) - ((? eof-object?) - (set! input-eof? #t) - (lz-compress-finish encoder)) - (count - (set! input-offset 0) - (set! input-len count))) - (read! bv start count)) - (else - (let-values (((read written) - (lzwrite! encoder - input-buffer input-offset - (- input-len input-offset) - bv start count))) - (set! input-offset (+ input-offset read)) - - ;; Make sure we don't return zero except on EOF. - (if (=3D 0 written) - (read! bv start count) - written))))) - - (make-custom-binary-input-port "lzip-input/compressed" - read! #f #f - (lambda () - (close-port port)))) - -(define* (call-with-lzip-input-port port proc) - "Call PROC with a port that wraps PORT and decompresses data read from i= t. -PORT is closed upon completion." - (let ((lzip (make-lzip-input-port port))) - (dynamic-wind - (const #t) - (lambda () - (proc lzip)) - (lambda () - (close-port lzip))))) - -(define* (call-with-lzip-output-port port proc - #:key - (level %default-compression-level)) - "Call PROC with an output port that wraps PORT and compresses data. POR= T is -close upon completion." - (let ((lzip (make-lzip-output-port port - #:level level))) - (dynamic-wind - (const #t) - (lambda () - (proc lzip)) - (lambda () - (close-port lzip))))) - -;;; lzlib.scm ends here diff --git a/guix/man-db.scm b/guix/man-db.scm index 4cef874f8b..a6528e4431 100644 --- a/guix/man-db.scm +++ b/guix/man-db.scm @@ -17,7 +17,7 @@ ;;; along with GNU Guix. If not, see . =20 (define-module (guix man-db) - #:use-module (guix zlib) + #:use-module (zlib) #:use-module ((guix build utils) #:select (find-files)) #:use-module (gdbm) ;gdbm-ffi #:use-module (srfi srfi-9) diff --git a/guix/profiles.scm b/guix/profiles.scm index 0619e735fb..6b2344270e 100644 --- a/guix/profiles.scm +++ b/guix/profiles.scm @@ -1412,27 +1412,18 @@ the entries in MANIFEST." (module-ref (resolve-interface '(gnu packages guile)) 'guile-gdbm-ffi)) =20 - (define zlib - (module-ref (resolve-interface '(gnu packages compression)) 'zlib)) - - (define config.scm - (scheme-file "config.scm" - #~(begin - (define-module #$'(guix config) ;placate Geiser - #:export (%libz)) - - (define %libz - #+(file-append zlib "/lib/libz"))))) + (define guile-zlib + (module-ref (resolve-interface '(gnu packages guile)) 'guile-zlib)) =20 (define modules - (cons `((guix config) =3D> ,config.scm) - (delete '(guix config) - (source-module-closure `((guix build utils) - (guix man-db)))))) + (delete '(guix config) + (source-module-closure `((guix build utils) + (guix man-db))))) =20 (define build (with-imported-modules modules - (with-extensions (list gdbm-ffi) ;for (guix man-db) + (with-extensions (list gdbm-ffi ;for (guix man-db) + guile-zlib) #~(begin (use-modules (guix man-db) (guix build utils) diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm index a00f08f9d9..61542f83a0 100644 --- a/guix/scripts/publish.scm +++ b/guix/scripts/publish.scm @@ -50,10 +50,9 @@ #:use-module (guix workers) #:use-module (guix store) #:use-module ((guix serialization) #:select (write-file)) - #:use-module (guix zlib) - #:autoload (guix lzlib) (lzlib-available? - call-with-lzip-output-port - make-lzip-output-port) + #:use-module (zlib) + #:autoload (lzlib) (call-with-lzip-output-port + make-lzip-output-port) #:use-module (guix cache) #:use-module (guix ui) #:use-module (guix scripts) @@ -880,8 +879,8 @@ blocking." "Return a symbol denoting the compression method expressed by STRING; re= turn #f if STRING doesn't match any supported method." (match string - ("gzip" (and (zlib-available?) 'gzip)) - ("lzip" (and (lzlib-available?) 'lzip)) + ("gzip" 'gzip) + ("lzip" 'lzip) (_ #f))) =20 (define (effective-compression requested-type compressions) @@ -1032,9 +1031,7 @@ methods, return the applicable compression." opts) (() ;; Default to fast & low compression. - (list (if (zlib-available?) - %default-gzip-compression - %no-compression))) + (list %default-gzip-compression)) (lst (reverse lst)))) (address (let ((addr (assoc-ref opts 'address))) (make-socket-address (sockaddr:fam addr) diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm index ba2b2d2d4e..f9d19fd735 100755 --- a/guix/scripts/substitute.scm +++ b/guix/scripts/substitute.scm @@ -41,7 +41,6 @@ #:use-module (guix progress) #:use-module ((guix build syscalls) #:select (set-thread-name)) - #:autoload (guix lzlib) (lzlib-available?) #:use-module (ice-9 rdelim) #:use-module (ice-9 regex) #:use-module (ice-9 match) @@ -912,7 +911,7 @@ authorized substitutes." ;; Known compression methods and a thunk to determine whether they're ;; supported. See 'decompressed-port' in (guix utils). `(("gzip" . ,(const #t)) - ("lzip" . ,lzlib-available?) + ("lzip" . ,(const #t)) ("xz" . ,(const #t)) ("bzip2" . ,(const #t)) ("none" . ,(const #t)))) diff --git a/guix/self.scm b/guix/self.scm index f70b1ecdd8..6a1640acdf 100644 --- a/guix/self.scm +++ b/guix/self.scm @@ -53,10 +53,10 @@ ("guile-ssh" (ref '(gnu packages ssh) 'guile-ssh)) ("guile-git" (ref '(gnu packages guile) 'guile-git)) ("guile-sqlite3" (ref '(gnu packages guile) 'guile-sqlite3)) + ("guile-zlib" (ref '(gnu packages guile) 'guile-zlib)) + ("guile-lzlib" (ref '(gnu packages guile) 'guile-lzlib)) ("guile-gcrypt" (ref '(gnu packages gnupg) 'guile-gcrypt)) ("gnutls" (ref '(gnu packages tls) 'guile3.0-gnutls)) - ("zlib" (ref '(gnu packages compression) 'zlib)) - ("lzlib" (ref '(gnu packages compression) 'lzlib)) ("gzip" (ref '(gnu packages compression) 'gzip)) ("bzip2" (ref '(gnu packages compression) 'bzip2)) ("xz" (ref '(gnu packages compression) 'xz)) @@ -727,8 +727,6 @@ Info manual." (name (string-append "guix-" version)) (guile-version (effective-version)) (guile-for-build (default-guile)) - (zlib (specification->package "zlib")) - (lzlib (specification->package "lzlib")) (gzip (specification->package "gzip")) (bzip2 (specification->package "bzip2")) (xz (specification->package "xz")) @@ -746,6 +744,12 @@ Info manual." (define guile-sqlite3 (specification->package "guile-sqlite3")) =20 + (define guile-zlib + (specification->package "guile-zlib")) + + (define guile-lzlib + (specification->package "guile-lzlib")) + (define guile-gcrypt (specification->package "guile-gcrypt")) =20 @@ -757,7 +761,7 @@ Info manual." (cons (list "x" package) (package-transitive-propagated-inputs packa= ge))) (list guile-gcrypt gnutls guile-git guile-json - guile-ssh guile-sqlite3)) + guile-ssh guile-sqlite3 guile-zlib guile-lzli= b)) (((labels packages _ ...) ...) packages))) =20 @@ -884,9 +888,7 @@ Info manual." '() #:extra-modules `(((guix config) - =3D> ,(make-config.scm #:zlib zlib - #:lzlib lzlib - #:gzip gzip + =3D> ,(make-config.scm #:gzip gzip #:bzip2 bzip2 #:xz xz #:package-name @@ -983,7 +985,7 @@ Info manual." (variables rest ...)))))) (variables %localstatedir %storedir %sysconfdir))) =20 -(define* (make-config.scm #:key zlib lzlib gzip xz bzip2 +(define* (make-config.scm #:key gzip xz bzip2 (package-name "GNU Guix") (package-version "0") (bug-report-address "bug-guix@gnu.org") @@ -1004,8 +1006,6 @@ Info manual." %state-directory %store-database-directory %config-directory - %libz - %liblz %gzip %bzip2 %xz)) @@ -1048,15 +1048,7 @@ Info manual." (define %bzip2 #+(and bzip2 (file-append bzip2 "/bin/bzip2"))) (define %xz - #+(and xz (file-append xz "/bin/xz"))) - - (define %libz - #+(and zlib - (file-append zlib "/lib/libz"))) - - (define %liblz - #+(and lzlib - (file-append lzlib "/lib/liblz")))) + #+(and xz (file-append xz "/bin/xz")))) =20 ;; Guile 2.0 *requires* the 'define-module' to be at the ;; top-level or the 'toplevel-ref' in the resulting .go fil= e are diff --git a/guix/utils.scm b/guix/utils.scm index 436c5cd093..1eb42944a9 100644 --- a/guix/utils.scm +++ b/guix/utils.scm @@ -206,13 +206,8 @@ buffered data is lost." (define (lzip-port proc port . args) "Return the lzip port produced by calling PROC (a symbol) on PORT and AR= GS. Raise an error if lzlib support is missing." - (let* ((lzlib (false-if-exception (resolve-interface '(guix lzlib)= ))) - (supported? (and lzlib - ((module-ref lzlib 'lzlib-available?))))) - (if supported? - (let ((make-port (module-ref lzlib proc))) - (values (make-port port) '())) - (error "lzip compression not supported" lzlib)))) + (let ((make-port (module-ref (resolve-interface '(lzlib)) proc))) + (values (make-port port) '()))) =20 (define (decompressed-port compression input) "Return an input port where INPUT is decompressed according to COMPRESSI= ON, diff --git a/guix/zlib.scm b/guix/zlib.scm deleted file mode 100644 index 3bd0ad86c9..0000000000 --- a/guix/zlib.scm +++ /dev/null @@ -1,241 +0,0 @@ -;;; GNU Guix --- Functional package management for GNU -;;; Copyright =C2=A9 2016, 2017 Ludovic Court=C3=A8s -;;; -;;; This file is part of GNU Guix. -;;; -;;; GNU Guix is free software; you can redistribute it and/or modify it -;;; under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 3 of the License, or (at -;;; your option) any later version. -;;; -;;; GNU Guix is distributed in the hope that it will be useful, but -;;; WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with GNU Guix. If not, see . - -(define-module (guix zlib) - #:use-module (rnrs bytevectors) - #:use-module (ice-9 binary-ports) - #:use-module (ice-9 match) - #:use-module (system foreign) - #:use-module (guix config) - #:export (zlib-available? - make-gzip-input-port - make-gzip-output-port - call-with-gzip-input-port - call-with-gzip-output-port - %default-buffer-size - %default-compression-level)) - -;;; Commentary: -;;; -;;; Bindings to the gzip-related part of zlib's API. The main limitation = of -;;; this API is that it requires a file descriptor as the source or sink. -;;; -;;; Code: - -(define %zlib - ;; File name of zlib's shared library. When updating via 'guix pull', - ;; '%libz' might be undefined so protect against it. - (delay (dynamic-link (if (defined? '%libz) - %libz - "libz")))) - -(define (zlib-available?) - "Return true if zlib is available, #f otherwise." - (false-if-exception (force %zlib))) - -(define (zlib-procedure ret name parameters) - "Return a procedure corresponding to C function NAME in libz, or #f if -either zlib or the function could not be found." - (match (false-if-exception (dynamic-func name (force %zlib))) - ((? pointer? ptr) - (pointer->procedure ret ptr parameters)) - (#f - #f))) - -(define-wrapped-pointer-type - ;; Scheme counterpart of the 'gzFile' opaque type. - gzip-file? - pointer->gzip-file - gzip-file->pointer - (lambda (obj port) - (format port "#" - (number->string (object-address obj) 16)))) - -(define gzerror - (let ((proc (zlib-procedure '* "gzerror" '(* *)))) - (lambda (gzfile) - (let* ((errnum* (make-bytevector (sizeof int))) - (ptr (proc (gzip-file->pointer gzfile) - (bytevector->pointer errnum*)))) - (values (bytevector-sint-ref errnum* 0 - (native-endianness) (sizeof int)) - (pointer->string ptr)))))) - -(define gzdopen - (let ((proc (zlib-procedure '* "gzdopen" (list int '*)))) - (lambda (fd mode) - "Open file descriptor FD as a gzip stream with the given MODE. MODE= must -be a string denoting the how FD is to be opened, such as \"r\" for reading= or -\"w9\" for writing data compressed at level 9 to FD. Calling 'gzclose' al= so -closes FD." - (let ((result (proc fd (string->pointer mode)))) - (if (null-pointer? result) - (throw 'zlib-error 'gzdopen) - (pointer->gzip-file result)))))) - -(define gzread! - (let ((proc (zlib-procedure int "gzread" (list '* '* unsigned-int)))) - (lambda* (gzfile bv #:optional (start 0) (count (bytevector-length bv)= )) - "Read up to COUNT bytes from GZFILE into BV at offset START. Return= the -number of uncompressed bytes actually read; it is zero if COUNT is zero or= if -the end-of-stream has been reached." - (let ((ret (proc (gzip-file->pointer gzfile) - (bytevector->pointer bv start) - count))) - (if (< ret 0) - (throw 'zlib-error 'gzread! ret) - ret))))) - -(define gzwrite - (let ((proc (zlib-procedure int "gzwrite" (list '* '* unsigned-int)))) - (lambda* (gzfile bv #:optional (start 0) (count (bytevector-length bv)= )) - "Write up to COUNT bytes from BV at offset START into GZFILE. Return -the number of uncompressed bytes written, a strictly positive integer." - (let ((ret (proc (gzip-file->pointer gzfile) - (bytevector->pointer bv start) - count))) - (if (<=3D ret 0) - (throw 'zlib-error 'gzwrite ret) - ret))))) - -(define gzbuffer! - (let ((proc (zlib-procedure int "gzbuffer" (list '* unsigned-int)))) - (lambda (gzfile size) - "Change the internal buffer size of GZFILE to SIZE bytes." - (let ((ret (proc (gzip-file->pointer gzfile) size))) - (unless (zero? ret) - (throw 'zlib-error 'gzbuffer! ret)))))) - -(define gzeof? - (let ((proc (zlib-procedure int "gzeof" '(*)))) - (lambda (gzfile) - "Return true if the end-of-file has been reached on GZFILE." - (not (zero? (proc (gzip-file->pointer gzfile))))))) - -(define gzclose - (let ((proc (zlib-procedure int "gzclose" '(*)))) - (lambda (gzfile) - "Close GZFILE." - (let ((ret (proc (gzip-file->pointer gzfile)))) - (unless (zero? ret) - (throw 'zlib-error 'gzclose ret (gzerror gzfile))))))) - - - -;;; -;;; Port interface. -;;; - -(define %default-buffer-size - ;; Default buffer size, as documented in . - 8192) - -(define %default-compression-level - ;; Z_DEFAULT_COMPRESSION. - -1) - -(define* (make-gzip-input-port port #:key (buffer-size %default-buffer-siz= e)) - "Return an input port that decompresses data read from PORT, a file port. -PORT is automatically closed when the resulting port is closed. BUFFER-SI= ZE -is the size in bytes of the internal buffer, 8 KiB by default; using a lar= ger -buffer increases decompression speed. An error is thrown if PORT contains -buffered input, which would be lost (and is lost anyway)." - (define gzfile - (match (drain-input port) - ("" ;PORT's buffer is empty - ;; 'gzclose' will eventually close the file descriptor beneath PORT. - ;; 'close-port' on PORT would get EBADF if 'gzclose' already closed= it, - ;; so that's no good; revealed ports are no good either because they - ;; leak (see ); calling 'close-port' af= ter - ;; 'gzclose' doesn't work either because it leads to a race conditi= on - ;; (see ). So we dup and close PORT ri= ght - ;; away. - (gzdopen (dup (fileno port)) "r")) - (_ - ;; This is unrecoverable but it's better than having the buffered i= nput - ;; be lost, leading to unclear end-of-file or corrupt-data errors d= own - ;; the path. - (throw 'zlib-error 'make-gzip-input-port - "port contains buffered input" port)))) - - (define (read! bv start count) - (gzread! gzfile bv start count)) - - (unless (=3D buffer-size %default-buffer-size) - (gzbuffer! gzfile buffer-size)) - - (close-port port) ;we no longer need it - (make-custom-binary-input-port "gzip-input" read! #f #f - (lambda () - (gzclose gzfile)))) - -(define* (make-gzip-output-port port - #:key - (level %default-compression-level) - (buffer-size %default-buffer-size)) - "Return an output port that compresses data at the given LEVEL, using PO= RT, -a file port, as its sink. PORT is automatically closed when the resulting -port is closed." - (define gzfile - (begin - (force-output port) ;empty PORT's buffer - (gzdopen (dup (fileno port)) - (string-append "w" (number->string level))))) - - (define (write! bv start count) - (gzwrite gzfile bv start count)) - - (unless (=3D buffer-size %default-buffer-size) - (gzbuffer! gzfile buffer-size)) - - (close-port port) - (make-custom-binary-output-port "gzip-output" write! #f #f - (lambda () - (gzclose gzfile)))) - -(define* (call-with-gzip-input-port port proc - #:key (buffer-size %default-buffer-siz= e)) - "Call PROC with a port that wraps PORT and decompresses data read from i= t. -PORT is closed upon completion. The gzip internal buffer size is set to -BUFFER-SIZE bytes." - (let ((gzip (make-gzip-input-port port #:buffer-size buffer-size))) - (dynamic-wind - (const #t) - (lambda () - (proc gzip)) - (lambda () - (close-port gzip))))) - -(define* (call-with-gzip-output-port port proc - #:key - (level %default-compression-level) - (buffer-size %default-buffer-size)) - "Call PROC with an output port that wraps PORT and compresses data. POR= T is -close upon completion. The gzip internal buffer size is set to BUFFER-SIZE -bytes." - (let ((gzip (make-gzip-output-port port - #:level level - #:buffer-size buffer-size))) - (dynamic-wind - (const #t) - (lambda () - (proc gzip)) - (lambda () - (close-port gzip))))) - -;;; zlib.scm ends here diff --git a/m4/guix.m4 b/m4/guix.m4 index cce03045db..b7bf74ccc8 100644 --- a/m4/guix.m4 +++ b/m4/guix.m4 @@ -342,32 +342,6 @@ AC_DEFUN([GUIX_LIBGCRYPT_LIBDIR], [ $1=3D"$guix_cv_libgcrypt_libdir" ]) =20 -dnl GUIX_LIBZ_LIBDIR VAR -dnl -dnl Attempt to determine libz's LIBDIR; store the result in VAR. -AC_DEFUN([GUIX_LIBZ_LIBDIR], [ - AC_REQUIRE([PKG_PROG_PKG_CONFIG]) - AC_CACHE_CHECK([zlib's library directory], - [guix_cv_libz_libdir], - [guix_cv_libz_libdir=3D"`$PKG_CONFIG zlib --variable=3Dlibdir 2> /dev/= null`"]) - $1=3D"$guix_cv_libz_libdir" -]) - -dnl GUIX_LIBLZ_FILE_NAME VAR -dnl -dnl Attempt to determine liblz's absolute file name; store the result in V= AR. -AC_DEFUN([GUIX_LIBLZ_FILE_NAME], [ - AC_REQUIRE([PKG_PROG_PKG_CONFIG]) - AC_CACHE_CHECK([lzlib's file name], - [guix_cv_liblz_libdir], - [old_LIBS=3D"$LIBS" - LIBS=3D"-llz" - AC_LINK_IFELSE([AC_LANG_SOURCE([int main () { return LZ_decompress_op= en(); }])], - [guix_cv_liblz_libdir=3D"`ldd conftest$EXEEXT | grep liblz | sed '-= es/.*=3D> \(.*\) .*$/\1/g'`"]) - LIBS=3D"$old_LIBS"]) - $1=3D"$guix_cv_liblz_libdir" -]) - dnl GUIX_CURRENT_LOCALSTATEDIR dnl dnl Determine the localstatedir of an existing Guix installation and set diff --git a/tests/lzlib.scm b/tests/lzlib.scm deleted file mode 100644 index 63d1e15641..0000000000 --- a/tests/lzlib.scm +++ /dev/null @@ -1,120 +0,0 @@ -;;; GNU Guix --- Functional package management for GNU -;;; Copyright =C2=A9 2019 Pierre Neidhardt -;;; -;;; This file is part of GNU Guix. -;;; -;;; GNU Guix is free software; you can redistribute it and/or modify it -;;; under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 3 of the License, or (at -;;; your option) any later version. -;;; -;;; GNU Guix is distributed in the hope that it will be useful, but -;;; WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with GNU Guix. If not, see . - -(define-module (test-lzlib) - #:use-module (guix lzlib) - #:use-module (guix tests) - #:use-module (srfi srfi-64) - #:use-module (rnrs bytevectors) - #:use-module (rnrs io ports) - #:use-module (ice-9 match)) - -;; Test the (guix lzlib) module. - -(define-syntax-rule (test-assert* description exp) - (begin - (unless (lzlib-available?) - (test-skip 1)) - (test-assert description exp))) - -(test-begin "lzlib") - -(define (compress-and-decompress data) - "DATA must be a bytevector." - (pk "Uncompressed bytes:" (bytevector-length data)) - (match (pipe) - ((parent . child) - (match (primitive-fork) - (0 ;compress - (dynamic-wind - (const #t) - (lambda () - (close-port parent) - (call-with-lzip-output-port child - (lambda (port) - (put-bytevector port data)))) - (lambda () - (primitive-exit 0)))) - (pid ;decompress - (begin - (close-port child) - (let ((received (call-with-lzip-input-port parent - (lambda (port) - (get-bytevector-all port))))) - (match (waitpid pid) - ((_ . status) - (pk "Status" status) - (pk "Length data" (bytevector-length data) "received" (byte= vector-length received)) - ;; The following loop is a debug helper. - (let loop ((i 0)) - (if (and (< i (bytevector-length received)) - (=3D (bytevector-u8-ref received i) - (bytevector-u8-ref data i))) - (loop (+ 1 i)) - (pk "First diff at index" i))) - (and (zero? status) - (port-closed? parent) - (bytevector=3D? received data))))))))))) - -(test-assert* "null bytevector" - (compress-and-decompress (make-bytevector (+ (random 100000) - (* 20 1024))))) - -(test-assert* "random bytevector" - (compress-and-decompress (random-bytevector (+ (random 100000) - (* 20 1024))))) -(test-assert* "small bytevector" - (compress-and-decompress (random-bytevector 127))) - -(test-assert* "1 bytevector" - (compress-and-decompress (random-bytevector 1))) - -(test-assert* "Bytevector of size relative to Lzip internal buffers (2 * d= ictionary)" - (compress-and-decompress - (random-bytevector - (* 2 (dictionary-size+match-length-limit %default-compression-level)))= )) - -(test-assert* "Bytevector of size relative to Lzip internal buffers (64KiB= )" - (compress-and-decompress (random-bytevector (* 64 1024)))) - -(test-assert* "Bytevector of size relative to Lzip internal buffers (64KiB= -1)" - (compress-and-decompress (random-bytevector (1- (* 64 1024))))) - -(test-assert* "Bytevector of size relative to Lzip internal buffers (64KiB= +1)" - (compress-and-decompress (random-bytevector (1+ (* 64 1024))))) - -(test-assert* "Bytevector of size relative to Lzip internal buffers (1MiB)" - (compress-and-decompress (random-bytevector (* 1024 1024)))) - -(test-assert* "Bytevector of size relative to Lzip internal buffers (1MiB-= 1)" - (compress-and-decompress (random-bytevector (1- (* 1024 1024))))) - -(test-assert* "Bytevector of size relative to Lzip internal buffers (1MiB+= 1)" - (compress-and-decompress (random-bytevector (1+ (* 1024 1024))))) - -(test-assert* "make-lzip-input-port/compressed" - (let* ((len (pk 'len (+ 10 (random 4000 %seed)))) - (data (random-bytevector len)) - (compressed (make-lzip-input-port/compressed - (open-bytevector-input-port data))) - (result (call-with-lzip-input-port compressed - get-bytevector-all))) - (pk (bytevector-length result) (bytevector-length data)) - (bytevector=3D? result data))) - -(test-end) diff --git a/tests/publish.scm b/tests/publish.scm index e43310ef00..1c3b2785fb 100644 --- a/tests/publish.scm +++ b/tests/publish.scm @@ -35,8 +35,8 @@ #:use-module ((guix serialization) #:select (restore-file)) #:use-module (gcrypt pk-crypto) #:use-module ((guix pki) #:select (%public-key-file %private-key-file)) - #:use-module (guix zlib) - #:use-module (guix lzlib) + #:use-module (zlib) + #:use-module (lzlib) #:use-module (web uri) #:use-module (web client) #:use-module (web response) @@ -204,8 +204,6 @@ References: ~%" (call-with-input-string nar (cut restore-file <> temp))) (call-with-input-file temp read-string)))) =20 -(unless (zlib-available?) - (test-skip 1)) (test-equal "/nar/gzip/*" "bar" (call-with-temporary-output-file @@ -217,8 +215,6 @@ References: ~%" (cut restore-file <> temp))) (call-with-input-file temp read-string)))) =20 -(unless (zlib-available?) - (test-skip 1)) (test-equal "/nar/gzip/* is really gzip" %gzip-magic-bytes ;; Since 'gzdopen' (aka. 'call-with-gzip-input-port') transparently reads @@ -229,8 +225,6 @@ References: ~%" (string-append "/nar/gzip/" (basename %item)))))) (get-bytevector-n nar (bytevector-length %gzip-magic-bytes)))) =20 -(unless (lzlib-available?) - (test-skip 1)) (test-equal "/nar/lzip/*" "bar" (call-with-temporary-output-file @@ -242,8 +236,6 @@ References: ~%" (cut restore-file <> temp))) (call-with-input-file temp read-string)))) =20 -(unless (zlib-available?) - (test-skip 1)) (test-equal "/*.narinfo with compression" `(("StorePath" . ,%item) ("URL" . ,(string-append "nar/gzip/" (basename %item))) @@ -264,8 +256,6 @@ References: ~%" (_ #f))) (recutils->alist body))))) =20 -(unless (lzlib-available?) - (test-skip 1)) (test-equal "/*.narinfo with lzip compression" `(("StorePath" . ,%item) ("URL" . ,(string-append "nar/lzip/" (basename %item))) @@ -286,8 +276,6 @@ References: ~%" (_ #f))) (recutils->alist body))))) =20 -(unless (zlib-available?) - (test-skip 1)) (test-equal "/*.narinfo for a compressed file" '("none" "nar") ;compression-less nar ;; Assume 'guix publish -C' is already running on port 6799. @@ -300,8 +288,6 @@ References: ~%" (list (assoc-ref info "Compression") (dirname (assoc-ref info "URL"))))) =20 -(unless (and (zlib-available?) (lzlib-available?)) - (test-skip 1)) (test-equal "/*.narinfo with lzip + gzip" `((("StorePath" . ,%item) ("URL" . ,(string-append "nar/gzip/" (basename %item))) @@ -411,8 +397,6 @@ References: ~%" (call-with-input-string "" port-sha256)))))) (response-code (http-get uri)))) =20 -(unless (zlib-available?) - (test-skip 1)) (test-equal "with cache" (list #t `(("StorePath" . ,%item) @@ -469,8 +453,6 @@ References: ~%" (stat:size (stat nar))) (response-code uncompressed))))))))) =20 -(unless (and (zlib-available?) (lzlib-available?)) - (test-skip 1)) (test-equal "with cache, lzip + gzip" '(200 200 404) (call-with-temporary-directory @@ -515,8 +497,6 @@ References: ~%" (response-code (http-get uncompressed)))))))))) =20 -(unless (zlib-available?) - (test-skip 1)) (let ((item (add-text-to-store %store "fake-compressed-thing.tar.gz" (random-text)))) (test-equal "with cache, uncompressed" @@ -596,9 +576,7 @@ References: ~%" (item (add-text-to-store %store "random" (random-text))) (part (store-path-hash-part item)) (url (string-append base part ".narinfo")) - (cached (string-append cache - (if (zlib-available?) - "/gzip/" "/none/") + (cached (string-append cache "/gzip/" (basename item) ".narinfo")) (response (http-get url))) diff --git a/tests/substitute.scm b/tests/substitute.scm index a4246aff82..6560612c40 100644 --- a/tests/substitute.scm +++ b/tests/substitute.scm @@ -29,7 +29,6 @@ #:use-module ((guix store) #:select (%store-prefix)) #:use-module ((guix ui) #:select (guix-warning-port)) #:use-module ((guix utils) #:select (call-with-compressed-output-port)) - #:use-module ((guix lzlib) #:select (lzlib-available?)) #:use-module ((guix build utils) #:select (mkdir-p delete-file-recursively dump-port)) #:use-module (guix tests http) @@ -508,8 +507,7 @@ System: mips64el-linux\n"))) (let ((nar (string-append %main-substitute-directory "/example.nar"))) (compress nar (string-append nar ".gz") 'gzip) - (when (lzlib-available?) - (compress nar (string-append nar ".lz") 'lzip))) + (compress nar (string-append nar ".lz") 'lzip)) =20 (parameterize ((substitute-urls (list (string-append "file://" diff --git a/tests/utils.scm b/tests/utils.scm index f78ec356bd..009e2121ab 100644 --- a/tests/utils.scm +++ b/tests/utils.scm @@ -23,7 +23,6 @@ #:use-module (guix utils) #:use-module ((guix store) #:select (%store-prefix store-path-package-na= me)) #:use-module ((guix search-paths) #:select (string-tokenize*)) - #:use-module ((guix lzlib) #:select (lzlib-available?)) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-64) @@ -215,7 +214,7 @@ skip these tests." =20 (for-each test-compression/decompression '(gzip xz lzip) - (list (const #t) (const #t) lzlib-available?)) + (list (const #t) (const #t) (const #t))) =20 ;; This is actually in (guix store). (test-equal "store-path-package-name" diff --git a/tests/zlib.scm b/tests/zlib.scm deleted file mode 100644 index 7c595a422c..0000000000 --- a/tests/zlib.scm +++ /dev/null @@ -1,62 +0,0 @@ -;;; GNU Guix --- Functional package management for GNU -;;; Copyright =C2=A9 2016, 2019 Ludovic Court=C3=A8s -;;; -;;; This file is part of GNU Guix. -;;; -;;; GNU Guix is free software; you can redistribute it and/or modify it -;;; under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 3 of the License, or (at -;;; your option) any later version. -;;; -;;; GNU Guix is distributed in the hope that it will be useful, but -;;; WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with GNU Guix. If not, see . - -(define-module (test-zlib) - #:use-module (guix zlib) - #:use-module (guix tests) - #:use-module (srfi srfi-64) - #:use-module (rnrs bytevectors) - #:use-module (rnrs io ports) - #:use-module (ice-9 match)) - -;; Test the (guix zlib) module. - -(test-begin "zlib") - -(unless (zlib-available?) - (test-skip 1)) -(test-assert "compression/decompression pipe" - (let ((data (random-bytevector (+ (random 10000) - (* 20 1024))))) - (match (pipe) - ((parent . child) - (match (primitive-fork) - (0 ;compress - (dynamic-wind - (const #t) - (lambda () - (close-port parent) - (call-with-gzip-output-port child - (lambda (port) - (put-bytevector port data)))) - (lambda () - (primitive-exit 0)))) - (pid ;decompress - (begin - (close-port child) - (let ((received (call-with-gzip-input-port parent - (lambda (port) - (get-bytevector-all port)) - #:buffer-size (* 64 1024)))) - (match (waitpid pid) - ((_ . status) - (and (zero? status) - (port-closed? parent) - (bytevector=3D? received data)))))))))))) - -(test-end) --=20 2.26.2 --=-=-=-- From debbugs-submit-bounces@debbugs.gnu.org Tue Jul 28 18:16:18 2020 Received: (at 42123) by debbugs.gnu.org; 28 Jul 2020 22:16:18 +0000 Received: from localhost ([127.0.0.1]:59358 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1k0XtS-00053f-DT for submit@debbugs.gnu.org; Tue, 28 Jul 2020 18:16:18 -0400 Received: from eggs.gnu.org ([209.51.188.92]:45024) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1k0XtQ-00053O-0m for 42123@debbugs.gnu.org; Tue, 28 Jul 2020 18:16:17 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:34063) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1k0XtK-0004qf-Pq for 42123@debbugs.gnu.org; Tue, 28 Jul 2020 18:16:10 -0400 Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=48394 helo=ribbon) by fencepost.gnu.org with esmtpsa (TLS1.2:RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1k0XtJ-0005cn-FF; Tue, 28 Jul 2020 18:16:09 -0400 From: =?utf-8?Q?Ludovic_Court=C3=A8s?= To: Mathieu Othacehe Subject: Re: [bug#42123] [PATCH] linux-libre: Enable module compression. References: <20200629142434.21308-1-othacehe@gnu.org> <87366atdve.fsf@gnu.org> <87lfjx6nb9.fsf@gnu.org> <873664ltqt.fsf@gnu.org> <878sfw7mec.fsf@gnu.org> <871rloiept.fsf@gnu.org> <874kqjn5k4.fsf@gnu.org> <874kqhcea1.fsf@gnu.org> <87v9i9exjq.fsf@gnu.org> X-URL: http://www.fdn.fr/~lcourtes/ X-Revolutionary-Date: 11 Thermidor an 228 de la =?utf-8?Q?R=C3=A9volution?= X-PGP-Key-ID: 0x090B11993D9AEBB5 X-PGP-Key: http://www.fdn.fr/~lcourtes/ludovic.asc X-PGP-Fingerprint: 3CE4 6455 8A84 FDC6 9DB4 0CFB 090B 1199 3D9A EBB5 X-OS: x86_64-pc-linux-gnu Date: Wed, 29 Jul 2020 00:16:07 +0200 In-Reply-To: <87v9i9exjq.fsf@gnu.org> (Mathieu Othacehe's message of "Mon, 27 Jul 2020 18:24:09 +0200") Message-ID: <87tuxrqo9k.fsf@gnu.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.3 (gnu/linux) MIME-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 42123 Cc: 42123@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -3.3 (---) Hi! Mathieu Othacehe skribis: > So as you suggested I created "guile-zlib" and "guile-lzlib" which was > the easy part. The other part is the hard to digest, attached patch. Thanks for doing that! (I figured David Thompson had one wrapping the low-level bits of zlib: . We should probably incorporate that.) > I tested it running "make check", "make as-derivation", "./pre-inst-env > guix build guix". Hope I didn't miss something. Nice! > Please, tell me what you think :) Just a quick review because I=E2=80=99m headed for a break. :-) > From d0f23078d1963f9aa8facda0fb3ae40e1e8c3cf2 Mon Sep 17 00:00:00 2001 > From: Mathieu Othacehe > Date: Mon, 27 Jul 2020 16:36:39 +0200 > Subject: [PATCH] Use "guile-zlib" and "guile-lzlib" instead of (guix conf= ig). > > * Makefile.am (MODULES): Remove guix/zlib.scm and guix/lzlib.scm, > (SCM_TESTS): remove tests/zlib.scm, tests/lzlib.scm. > * build-aux/build-self.scm (make-config.scm): Remove unused %libz variabl= e. > * configure.ac: Remove LIBZ and LIBLZ variables and check instead for > Guile-zlib and Guile-lzlib. > * doc/guix.texi ("Requirements"): Remove zlib requirement and add Guile-z= lib > and Guile-lzlib instead. > * gnu/packages/package-management.scm (guix)[native-inputs]: Add "guile-z= lib" > and "guile-lzlib", > [inputs]: remove "zlib" and "lzlib", > [propagated-inputs]: ditto, > [arguments]: add "guile-zlib" and "guile-lzlib" to Guile load path. > * guix/build/download-nar.scm: Use (zlib) instead of (guix zlib). > * guix/config.scm.in (%libz, %liblz): Remove them. > * guix/cvs-download.scm (cvs-fetch): Do not stub (guix config) in imported > modules list, instead add "guile-zlib" to the extension list. > * guix/git-download.scm (git-fetch): Ditto. > * guix/gnu-maintenance.scm: Use (zlib) instead of (guix zlib). > * guix/hg-download.scm (hg-fetch): Do not stub (guix config) in imported > modules list, instead add "guile-zlib" to the extension list. > * guix/lzlib.scm: Remove it. > * guix/man-db.scm: Use (zlib) instead of (guix zlib). > * guix/profiles.scm (manual-database): Do not stub (guix config) in impor= ted > modules list, instead add "guile-zlib" to the extension list. > * guix/scripts/publish.scm: Use (zlib) instead of (guix zlib) and (lzlib) > instead of (guix lzlib), > (string->compression-type, effective-compression): do not check for zlib = and > lzlib availability. > * guix/scripts/substitute.scm (%compression-methods): Do not check for lz= lib > availability. > * guix/self.scm (specification->package): Add "guile-zlib" and "guile-lzl= ib" > and remove "zlib" and "lzlib", > (compiled-guix): remove "zlib" and "lzlib" arguments and add guile-zlib a= nd > guile-lzlib to the dependencies, also do not pass "zlib" and "lzlib" to > "make-config.scm" procedure, > (make-config.scm): remove "zlib" and "lzlib" arguments as well as %libz a= nd > %liblz variables. > * guix/utils.scm (lzip-port): Use (lzlib) instead of (guix lzlib) and do = not > check for lzlib availability. > * guix/zlib.scm: Remove it. > * m4/guix.m4 (GUIX_LIBZ_LIBDIR, GUIX_LIBLZ_FILE_NAME): Remove them. > * tests/lzlib.scm: Use (zlib) instead of (guix zlib) and (lzlib) > instead of (guix lzlib), and do not check for zlib and lzlib availability. > * tests/publish.scm: Ditto. > * tests/substitute.scm: Do not check for lzlib availability. > * tests/utils.scm: Ditto. > * tests/zlib.scm: Remove it. This can be decomposed in several steps: 1. We can start using =E2=80=98guile-zlib=E2=80=99 as extensions for gexp= s: in (guix scripts pack), (guix download), etc. Easy, no risk. 2. Use guile-zlib & co. in Guix itself: (guix scripts substitute), (guix scripts publish), etc. Keep (guix zlib) and (guix lzlib) in parallel. 3. Update =E2=80=98guix=E2=80=99 package with these two new dependencies. 4. Remove uses (guix zlib) and (guix lzlib), adjust build machinery and doc. 5. Adjust (guix self) and related code. This is a bit touchy. Perhaps there=E2=80=99s a couple of steps that can be merged, but having a = split along these lines would be clearer and better for our peace of mind. > --- a/build-aux/build-self.scm > +++ b/build-aux/build-self.scm > @@ -71,7 +71,7 @@ > (variables rest ...)))))) > (variables %localstatedir %storedir %sysconfdir %system))) >=20=20 > -(define* (make-config.scm #:key zlib gzip xz bzip2 > +(define* (make-config.scm #:key gzip xz bzip2 > (package-name "GNU Guix") > (package-version "0") > (bug-report-address "bug-guix@gnu.org") This is OK. > @@ -133,11 +133,7 @@ > (define %bzip2 > #+(and bzip2 (file-append bzip2 "/bin/bzip2"))) > (define %xz > - #+(and xz (file-append xz "/bin/xz"))) > - > - (define %libz > - #+(and zlib > - (file-append zlib "/lib/libz"))))))) > + #+(and xz (file-append xz "/bin/xz"))))))) I think it=E2=80=99s OK too, but we have to keep in mind that this code can= be run by a past Guix that expects =E2=80=98%libz=E2=80=99. Normally it=E2=80= =99s OK because the modules needed by =E2=80=98compute-guix-derivation=E2=80=99 do not rely on = =E2=80=98%libz=E2=80=99 and (guix zlib). One test would be something like: guix time-machine --commit=3D6298c3ffd9654d3231a6f25390b056483e8f407c -- \ pull -p /tmp/test --url=3D/path/to/local/repo --branch=3Dthe-branch This will check that 1.0.0 can indeed pull this new repo. The rest LGTM. Thanks a lot for all the work! Ludo=E2=80=99, who=E2=80=99s going to be away the coming weeks. From debbugs-submit-bounces@debbugs.gnu.org Thu Aug 06 09:45:04 2020 Received: (at 42123) by debbugs.gnu.org; 6 Aug 2020 13:45:04 +0000 Received: from localhost ([127.0.0.1]:53465 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1k3gCe-0007BI-Ah for submit@debbugs.gnu.org; Thu, 06 Aug 2020 09:45:04 -0400 Received: from eggs.gnu.org ([209.51.188.92]:43648) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1k3gCZ-0007AS-Im for 42123@debbugs.gnu.org; Thu, 06 Aug 2020 09:45:02 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:51090) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1k3gCT-0003ax-FC; Thu, 06 Aug 2020 09:44:53 -0400 Received: from lfbn-ann-1-356-169.w86-200.abo.wanadoo.fr ([86.200.73.169]:51036 helo=meru) by fencepost.gnu.org with esmtpsa (TLS1.2:RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1k3gCS-0005rA-24; Thu, 06 Aug 2020 09:44:52 -0400 From: Mathieu Othacehe To: Ludovic =?utf-8?Q?Court=C3=A8s?= Subject: Re: [bug#42123] [PATCH] linux-libre: Enable module compression. References: <20200629142434.21308-1-othacehe@gnu.org> <87366atdve.fsf@gnu.org> <87lfjx6nb9.fsf@gnu.org> <873664ltqt.fsf@gnu.org> <878sfw7mec.fsf@gnu.org> <871rloiept.fsf@gnu.org> <874kqjn5k4.fsf@gnu.org> <874kqhcea1.fsf@gnu.org> <87v9i9exjq.fsf@gnu.org> <87tuxrqo9k.fsf@gnu.org> Date: Thu, 06 Aug 2020 15:44:48 +0200 In-Reply-To: <87tuxrqo9k.fsf@gnu.org> ("Ludovic \=\?utf-8\?Q\?Court\=C3\=A8s\=22'\?\= \=\?utf-8\?Q\?s\?\= message of "Wed, 29 Jul 2020 00:16:07 +0200") Message-ID: <871rkjvqgf.fsf@gnu.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.3 (gnu/linux) MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 42123 Cc: 42123@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -3.3 (---) --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Hey Ludo! > This can be decomposed in several steps: > > 1. We can start using =E2=80=98guile-zlib=E2=80=99 as extensions for ge= xps: in (guix > scripts pack), (guix download), etc. Easy, no risk. There's an attached patch that should cover this first step. An issue here is that (guix build download-nar) is built in both "make" and "guix pull" commands, so I cannot use a bare: --8<---------------cut here---------------start------------->8--- #:use-module (zlib) --8<---------------cut here---------------end--------------->8--- so, I used: --8<---------------cut here---------------start------------->8--- #:autoload (zlib) (call-with-gzip-input-port) --8<---------------cut here---------------end--------------->8--- that seems to work but produces a lot of warnings when running "make". Would it be acceptable as a first step? > > 2. Use guile-zlib & co. in Guix itself: (guix scripts substitute), > (guix scripts publish), etc. Keep (guix zlib) and (guix lzlib) in > parallel. I'm not sure how it can work without step 4. For me, including (zlib) in Guix itself requires that build machinery and (guix self) are updated, but maybe I'm missing something. > > 3. Update =E2=80=98guix=E2=80=99 package with these two new dependencie= s. Seems fair! > The rest LGTM. Thanks a lot for all the work! Thanks for having a look :) Mathieu --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=0001-Use-guile-zlib-extension-in-build-side-code.patch >From 680e19137d22204f34b00336a3cb98a02397b0f9 Mon Sep 17 00:00:00 2001 From: Mathieu Othacehe Date: Thu, 6 Aug 2020 15:00:01 +0200 Subject: [PATCH] Use guile-zlib extension in build-side code. * Makefile.am (MODULES): Move guix/build/download-nar.scm to ... (MODULES_NOT_COMPILED): ... here. * guix/build/download-nar.scm: Use (zlib) instead of (guix zlib). * guix/cvs-download.scm (cvs-fetch): Do not stub (guix config) in imported modules list, instead add "guile-zlib" to the extension list. * guix/git-download.scm (git-fetch): Ditto. * guix/hg-download.scm (hg-fetch): Do not stub (guix config) in imported modules list, instead add "guile-zlib" to the extension list. --- guix/build/download-nar.scm | 2 +- guix/cvs-download.scm | 39 ++++++++++++++----------------------- guix/git-download.scm | 29 ++++++++++----------------- guix/hg-download.scm | 37 +++++++++++++---------------------- 4 files changed, 40 insertions(+), 67 deletions(-) diff --git a/guix/build/download-nar.scm b/guix/build/download-nar.scm index 377e428341..867f3c10bb 100644 --- a/guix/build/download-nar.scm +++ b/guix/build/download-nar.scm @@ -20,7 +20,7 @@ #:use-module (guix build download) #:use-module (guix build utils) #:use-module ((guix serialization) #:hide (dump-port*)) - #:use-module (guix zlib) + #:autoload (zlib) (call-with-gzip-input-port) #:use-module (guix progress) #:use-module (web uri) #:use-module (srfi srfi-11) diff --git a/guix/cvs-download.scm b/guix/cvs-download.scm index cb42103aae..76b3eac739 100644 --- a/guix/cvs-download.scm +++ b/guix/cvs-download.scm @@ -60,35 +60,26 @@ "Return a fixed-output derivation that fetches REF, a object. The output is expected to have recursive hash HASH of type HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if #f." - (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 guile-zlib + (module-ref (resolve-interface '(gnu packages guile)) 'guile-zlib)) (define modules - (cons `((guix config) => ,config.scm) - (delete '(guix config) - (source-module-closure '((guix build cvs) - (guix build download-nar)))))) + (delete '(guix config) + (source-module-closure '((guix build cvs) + (guix build download-nar))))) (define build (with-imported-modules modules - #~(begin - (use-modules (guix build cvs) - (guix build download-nar)) + (with-extensions (list guile-zlib) + #~(begin + (use-modules (guix build cvs) + (guix build download-nar)) - (or (cvs-fetch '#$(cvs-reference-root-directory ref) - '#$(cvs-reference-module ref) - '#$(cvs-reference-revision ref) - #$output - #:cvs-command (string-append #+cvs "/bin/cvs")) - (download-nar #$output))))) + (or (cvs-fetch '#$(cvs-reference-root-directory ref) + '#$(cvs-reference-module ref) + '#$(cvs-reference-revision ref) + #$output + #:cvs-command (string-append #+cvs "/bin/cvs")) + (download-nar #$output)))))) (mlet %store-monad ((guile (package->derivation guile system))) (gexp->derivation (or name "cvs-checkout") build diff --git a/guix/git-download.scm b/guix/git-download.scm index 71ea1031c5..90634a8c4c 100644 --- a/guix/git-download.scm +++ b/guix/git-download.scm @@ -84,35 +84,26 @@ HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if #f." ("tar" ,(module-ref (resolve-interface '(gnu packages base)) 'tar))))) - (define zlib - (module-ref (resolve-interface '(gnu packages compression)) 'zlib)) - (define guile-json (module-ref (resolve-interface '(gnu packages guile)) 'guile-json-3)) + (define guile-zlib + (module-ref (resolve-interface '(gnu packages guile)) 'guile-zlib)) + (define gnutls (module-ref (resolve-interface '(gnu packages tls)) 'gnutls)) - (define config.scm - (scheme-file "config.scm" - #~(begin - (define-module (guix config) - #:export (%libz)) - - (define %libz - #+(file-append zlib "/lib/libz"))))) - (define modules - (cons `((guix config) => ,config.scm) - (delete '(guix config) - (source-module-closure '((guix build git) - (guix build utils) - (guix build download-nar) - (guix swh)))))) + (delete '(guix config) + (source-module-closure '((guix build git) + (guix build utils) + (guix build download-nar) + (guix swh))))) (define build (with-imported-modules modules - (with-extensions (list guile-json gnutls) ;for (guix swh) + (with-extensions (list guile-json gnutls ;for (guix swh) + guile-zlib) #~(begin (use-modules (guix build git) (guix build utils) diff --git a/guix/hg-download.scm b/guix/hg-download.scm index 4cdc1a780a..694105ceba 100644 --- a/guix/hg-download.scm +++ b/guix/hg-download.scm @@ -60,35 +60,26 @@ "Return a fixed-output derivation that fetches REF, a object. The output is expected to have recursive hash HASH of type HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if #f." - (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 guile-zlib + (module-ref (resolve-interface '(gnu packages guile)) 'guile-zlib)) (define modules - (cons `((guix config) => ,config.scm) - (delete '(guix config) - (source-module-closure '((guix build hg) - (guix build download-nar)))))) + (delete '(guix config) + (source-module-closure '((guix build hg) + (guix build download-nar))))) (define build (with-imported-modules modules - #~(begin - (use-modules (guix build hg) - (guix build download-nar)) + (with-extensions (list guile-zlib) + #~(begin + (use-modules (guix build hg) + (guix build download-nar)) - (or (hg-fetch '#$(hg-reference-url ref) - '#$(hg-reference-changeset ref) - #$output - #:hg-command (string-append #+hg "/bin/hg")) - (download-nar #$output))))) + (or (hg-fetch '#$(hg-reference-url ref) + '#$(hg-reference-changeset ref) + #$output + #:hg-command (string-append #+hg "/bin/hg")) + (download-nar #$output)))))) (mlet %store-monad ((guile (package->derivation guile system))) (gexp->derivation (or name "hg-checkout") build -- 2.26.2 --=-=-=-- From debbugs-submit-bounces@debbugs.gnu.org Sun Aug 23 12:27:56 2020 Received: (at 42123) by debbugs.gnu.org; 23 Aug 2020 16:27:56 +0000 Received: from localhost ([127.0.0.1]:54991 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1k9sqa-0006uw-0L for submit@debbugs.gnu.org; Sun, 23 Aug 2020 12:27:56 -0400 Received: from eggs.gnu.org ([209.51.188.92]:55344) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1k9sqX-0006uk-U3 for 42123@debbugs.gnu.org; Sun, 23 Aug 2020 12:27:54 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:55455) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1k9sqS-0002WX-Mk for 42123@debbugs.gnu.org; Sun, 23 Aug 2020 12:27:48 -0400 Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=38330 helo=ribbon) by fencepost.gnu.org with esmtpsa (TLS1.2:RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1k9sqQ-0003b0-St; Sun, 23 Aug 2020 12:27:47 -0400 From: =?utf-8?Q?Ludovic_Court=C3=A8s?= To: Mathieu Othacehe Subject: Re: [bug#42123] [PATCH] linux-libre: Enable module compression. References: <20200629142434.21308-1-othacehe@gnu.org> <87366atdve.fsf@gnu.org> <87lfjx6nb9.fsf@gnu.org> <873664ltqt.fsf@gnu.org> <878sfw7mec.fsf@gnu.org> <871rloiept.fsf@gnu.org> <874kqjn5k4.fsf@gnu.org> <874kqhcea1.fsf@gnu.org> <87v9i9exjq.fsf@gnu.org> <87tuxrqo9k.fsf@gnu.org> <871rkjvqgf.fsf@gnu.org> X-URL: http://www.fdn.fr/~lcourtes/ X-Revolutionary-Date: 7 Fructidor an 228 de la =?utf-8?Q?R=C3=A9volution?= X-PGP-Key-ID: 0x090B11993D9AEBB5 X-PGP-Key: http://www.fdn.fr/~lcourtes/ludovic.asc X-PGP-Fingerprint: 3CE4 6455 8A84 FDC6 9DB4 0CFB 090B 1199 3D9A EBB5 X-OS: x86_64-pc-linux-gnu Date: Sun, 23 Aug 2020 18:27:45 +0200 In-Reply-To: <871rkjvqgf.fsf@gnu.org> (Mathieu Othacehe's message of "Thu, 06 Aug 2020 15:44:48 +0200") Message-ID: <87ft8dba4e.fsf@gnu.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.3 (gnu/linux) MIME-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 42123 Cc: 42123@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -3.3 (---) Hello! Apologies for the holiday-induced delay! Mathieu Othacehe skribis: >> This can be decomposed in several steps: >> >> 1. We can start using =E2=80=98guile-zlib=E2=80=99 as extensions for g= exps: in (guix >> scripts pack), (guix download), etc. Easy, no risk. > > There's an attached patch that should cover this first step. An issue > here is that (guix build download-nar) is built in both "make" and "guix > pull" commands, so I cannot use a bare: > > #:use-module (zlib) > > > so, I used: > > #:autoload (zlib) (call-with-gzip-input-port) > > that seems to work but produces a lot of warnings when running > "make". Would it be acceptable as a first step? Yeah, sounds good to me. >> 2. Use guile-zlib & co. in Guix itself: (guix scripts substitute), >> (guix scripts publish), etc. Keep (guix zlib) and (guix lzlib) in >> parallel. > > I'm not sure how it can work without step 4. For me, including (zlib) in > Guix itself requires that build machinery and (guix self) are updated, > but maybe I'm missing something. Hmm you must be right. Well in that case you can do these in lockstep. Sorry for the confusion! > From 680e19137d22204f34b00336a3cb98a02397b0f9 Mon Sep 17 00:00:00 2001 > From: Mathieu Othacehe > Date: Thu, 6 Aug 2020 15:00:01 +0200 > Subject: [PATCH] Use guile-zlib extension in build-side code. > > * Makefile.am (MODULES): Move guix/build/download-nar.scm to ... > (MODULES_NOT_COMPILED): ... here. > * guix/build/download-nar.scm: Use (zlib) instead of (guix zlib). > * guix/cvs-download.scm (cvs-fetch): Do not stub (guix config) in imported > modules list, instead add "guile-zlib" to the extension list. > * guix/git-download.scm (git-fetch): Ditto. > * guix/hg-download.scm (hg-fetch): Do not stub (guix config) in imported > modules list, instead add "guile-zlib" to the extension list. LGTM! Glad we=E2=80=99re making progress on this front, thanks a lot! Ludo=E2=80=99. From debbugs-submit-bounces@debbugs.gnu.org Mon Aug 24 07:38:17 2020 Received: (at 42123) by debbugs.gnu.org; 24 Aug 2020 11:38:17 +0000 Received: from localhost ([127.0.0.1]:56333 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1kAAno-0002Z8-UT for submit@debbugs.gnu.org; Mon, 24 Aug 2020 07:38:17 -0400 Received: from eggs.gnu.org ([209.51.188.92]:38922) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1kAAnn-0002Yu-R3 for 42123@debbugs.gnu.org; Mon, 24 Aug 2020 07:38:16 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:42839) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1kAAni-0002AI-8H; Mon, 24 Aug 2020 07:38:10 -0400 Received: from [2a01:e0a:19b:d9a0:51fc:698d:e660:b966] (port=57832 helo=cervin) by fencepost.gnu.org with esmtpsa (TLS1.2:RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1kAAnh-0004BR-De; Mon, 24 Aug 2020 07:38:09 -0400 From: Mathieu Othacehe To: Ludovic =?utf-8?Q?Court=C3=A8s?= Subject: Re: [bug#42123] [PATCH] linux-libre: Enable module compression. References: <20200629142434.21308-1-othacehe@gnu.org> <87366atdve.fsf@gnu.org> <87lfjx6nb9.fsf@gnu.org> <873664ltqt.fsf@gnu.org> <878sfw7mec.fsf@gnu.org> <871rloiept.fsf@gnu.org> <874kqjn5k4.fsf@gnu.org> <874kqhcea1.fsf@gnu.org> <87v9i9exjq.fsf@gnu.org> <87tuxrqo9k.fsf@gnu.org> <871rkjvqgf.fsf@gnu.org> <87ft8dba4e.fsf@gnu.org> Date: Mon, 24 Aug 2020 13:38:07 +0200 In-Reply-To: <87ft8dba4e.fsf@gnu.org> ("Ludovic \=\?utf-8\?Q\?Court\=C3\=A8s\=22'\?\= \=\?utf-8\?Q\?s\?\= message of "Sun, 23 Aug 2020 18:27:45 +0200") Message-ID: <871rjwe0kg.fsf@gnu.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.3 (gnu/linux) MIME-Version: 1.0 Content-Type: text/plain X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 42123 Cc: 42123@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -3.3 (---) Hey, > Apologies for the holiday-induced delay! Glad to see you back! > Hmm you must be right. Well in that case you can do these in lockstep. > Sorry for the confusion! So, I did proceed in two steps: * Pushed the build-side patch as e9f8a7e21579fd2833dfca6830e21f886a79a9ca. * Pushed the rest as 4c0c65acfade63ce0549115d19db4b639c1e9992. As you suggested before, I tested the "guix pull" from 1.0.0 revision, which seems to work fine. Thanks, Mathieu From debbugs-submit-bounces@debbugs.gnu.org Mon Aug 24 10:03:26 2020 Received: (at 42123) by debbugs.gnu.org; 24 Aug 2020 14:03:26 +0000 Received: from localhost ([127.0.0.1]:58703 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1kAD4I-00079E-J0 for submit@debbugs.gnu.org; Mon, 24 Aug 2020 10:03:26 -0400 Received: from eggs.gnu.org ([209.51.188.92]:53058) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1kAD4F-00078z-HL for 42123@debbugs.gnu.org; Mon, 24 Aug 2020 10:03:25 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:45184) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1kAD4A-0007LS-AT for 42123@debbugs.gnu.org; Mon, 24 Aug 2020 10:03:18 -0400 Received: from [2001:660:6102:320:e120:2c8f:8909:cdfe] (port=40868 helo=ribbon) by fencepost.gnu.org with esmtpsa (TLS1.2:RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1kAD49-0000O6-AI; Mon, 24 Aug 2020 10:03:17 -0400 From: =?utf-8?Q?Ludovic_Court=C3=A8s?= To: Mathieu Othacehe Subject: Re: [bug#42123] [PATCH] linux-libre: Enable module compression. References: <20200629142434.21308-1-othacehe@gnu.org> <87366atdve.fsf@gnu.org> <87lfjx6nb9.fsf@gnu.org> <873664ltqt.fsf@gnu.org> <878sfw7mec.fsf@gnu.org> <871rloiept.fsf@gnu.org> <874kqjn5k4.fsf@gnu.org> <874kqhcea1.fsf@gnu.org> <87v9i9exjq.fsf@gnu.org> <87tuxrqo9k.fsf@gnu.org> <871rkjvqgf.fsf@gnu.org> <87ft8dba4e.fsf@gnu.org> <871rjwe0kg.fsf@gnu.org> X-URL: http://www.fdn.fr/~lcourtes/ X-Revolutionary-Date: 8 Fructidor an 228 de la =?utf-8?Q?R=C3=A9volution?= X-PGP-Key-ID: 0x090B11993D9AEBB5 X-PGP-Key: http://www.fdn.fr/~lcourtes/ludovic.asc X-PGP-Fingerprint: 3CE4 6455 8A84 FDC6 9DB4 0CFB 090B 1199 3D9A EBB5 X-OS: x86_64-pc-linux-gnu Date: Mon, 24 Aug 2020 16:03:15 +0200 In-Reply-To: <871rjwe0kg.fsf@gnu.org> (Mathieu Othacehe's message of "Mon, 24 Aug 2020 13:38:07 +0200") Message-ID: <87364c5efw.fsf@gnu.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.3 (gnu/linux) MIME-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 42123 Cc: 42123@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -3.3 (---) Hi! Mathieu Othacehe skribis: > So, I did proceed in two steps: > > * Pushed the build-side patch as e9f8a7e21579fd2833dfca6830e21f886a79a9ca. > * Pushed the rest as 4c0c65acfade63ce0549115d19db4b639c1e9992. > > As you suggested before, I tested the "guix pull" from 1.0.0 revision, > which seems to work fine. Awesome, thanks a lot! Ludo=E2=80=99. From debbugs-submit-bounces@debbugs.gnu.org Tue Aug 25 06:30:17 2020 Received: (at 42123-done) by debbugs.gnu.org; 25 Aug 2020 10:30:17 +0000 Received: from localhost ([127.0.0.1]:60398 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1kAWDZ-0002Kz-8p for submit@debbugs.gnu.org; Tue, 25 Aug 2020 06:30:17 -0400 Received: from eggs.gnu.org ([209.51.188.92]:46176) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1kAWDW-0002EG-U9 for 42123-done@debbugs.gnu.org; Tue, 25 Aug 2020 06:30:15 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:35273) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1kAWDQ-00066K-Tr; Tue, 25 Aug 2020 06:30:08 -0400 Received: from [2a01:e0a:19b:d9a0:51fc:698d:e660:b966] (port=40884 helo=cervin) by fencepost.gnu.org with esmtpsa (TLS1.2:RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1kAWDO-000571-NV; Tue, 25 Aug 2020 06:30:07 -0400 From: Mathieu Othacehe To: Ludovic =?utf-8?Q?Court=C3=A8s?= Subject: Re: [bug#42123] [PATCH] linux-libre: Enable module compression. References: <20200629142434.21308-1-othacehe@gnu.org> <87366atdve.fsf@gnu.org> <87lfjx6nb9.fsf@gnu.org> <873664ltqt.fsf@gnu.org> <878sfw7mec.fsf@gnu.org> <871rloiept.fsf@gnu.org> <874kqjn5k4.fsf@gnu.org> <874kqhcea1.fsf@gnu.org> <87v9i9exjq.fsf@gnu.org> <87tuxrqo9k.fsf@gnu.org> <871rkjvqgf.fsf@gnu.org> <87ft8dba4e.fsf@gnu.org> <871rjwe0kg.fsf@gnu.org> <87364c5efw.fsf@gnu.org> Date: Tue, 25 Aug 2020 12:30:04 +0200 In-Reply-To: <87364c5efw.fsf@gnu.org> ("Ludovic \=\?utf-8\?Q\?Court\=C3\=A8s\=22'\?\= \=\?utf-8\?Q\?s\?\= message of "Mon, 24 Aug 2020 16:03:15 +0200") Message-ID: <87tuwrt3v7.fsf@gnu.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.3 (gnu/linux) MIME-Version: 1.0 Content-Type: text/plain X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 42123-done Cc: 42123-done@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -3.3 (---) Hey, >> As you suggested before, I tested the "guix pull" from 1.0.0 revision, >> which seems to work fine. > > Awesome, thanks a lot! I just pushed Linux module compression support with 755f365b02b42a5d1e8ef3000dadef069553a478 and 5fe12be0dd03d1a316343549f8c131d931f21a9a. The build-side module (gnu build linux-modules) now uses (zlib) module. This means that derivations that effectively rely on reading compressed modules (such as "linux-modules"), need to add "guile-zlib" as an extension. Thanks, Mathieu From unknown Sun Sep 07 21:36:12 2025 Received: (at fakecontrol) by fakecontrolmessage; To: internal_control@debbugs.gnu.org From: Debbugs Internal Request Subject: Internal Control Message-Id: bug archived. Date: Tue, 22 Sep 2020 11:24:06 +0000 User-Agent: Fakemail v42.6.9 # This is a fake control message. # # The action: # bug archived. thanks # This fakemail brought to you by your local debbugs # administrator