[bug#68242] [PATCH 1/5] utils: Lower xz compression memory usage limit to 20%.

[bug#68242] [PATCH 1/5] utils: Lower xz compression memory usage limit to 20%.

[Maxim Cournoyer]

There were sometimes out of memory errors on the Berlin build farm, especially
for i686 or arm machines having less memory.

* guix/build/utils.scm (%xz-parallel-args): Reduce --memlimit value from 50%
to 20%.

Change-Id: If848bed92ef4c42d11a96057e59ee51a019d0573
---

 guix/build/utils.scm | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/guix/build/utils.scm b/guix/build/utils.scm
index 8e630ad586..e87066cc02 100644
--- a/guix/build/utils.scm
+++ b/guix/build/utils.scm
@@ -186,7 +186,7 @@ (define (tarball? file-name)
 (define (%xz-parallel-args)
   "The xz arguments required to enable bit-reproducible, multi-threaded
 compression."
-  (list "--memlimit=50%"
+  (list "--memlimit=20%"
         (format #f "--threads=~a" (max 2 (parallel-job-count)))))
 
 \f
-- 
2.41.0

[bug#68242] [PATCH 2/5] compression: Enable zstd parallel compression.

[Maxim Cournoyer]

* gnu/compression.scm (%compressors) [zstd]: Provide the --threads argument.

Change-Id: I4e8dfe725d1b0721c0016c3013b9e609fee94367
---

 gnu/compression.scm | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/gnu/compression.scm b/gnu/compression.scm
index 0418e80a15..6e48de5979 100644
--- a/gnu/compression.scm
+++ b/gnu/compression.scm
@@ -56,7 +56,8 @@ (define %compressors
                     ;; The default level 3 compresses better than gzip in a
                     ;; fraction of the time, while the highest level 19
                     ;; (de)compresses more slowly and worse than xz.
-                    #~(list #+(file-append zstd "/bin/zstd") "-3"))
+                    #~(list #+(file-append zstd "/bin/zstd") "-3"
+                            (format #f "--threads=~a" (parallel-job-count))))
         (compressor "none" "" #f)))
 
 (define (lookup-compressor name)
-- 
2.41.0

[bug#68242] [PATCH 3/5] packages: Repack patched source archives via zstd by default.

[Maxim Cournoyer]

* guix/build/utils.scm (compressor): Register zst file name extension.
* guix/packages.scm (%standard-patch-inputs): Add zstd.
(patch-and-repack): Rename tarxz-name nested procedure to tar-file-name, and
accept a new 'ext' argument; adjust accordingly.  Add zstd binding, and
replace the XZ_DEFAULTS environment variable with ZSTD_NBTHREADS.  Fallback to
xz when zstd is not available.

Change-Id: I614a6be8c87a4a0858eadce616c51d8e9b9fc020
---

 guix/build/utils.scm |  1 +
 guix/packages.scm    | 50 +++++++++++++++++++++++++-------------------
 2 files changed, 30 insertions(+), 21 deletions(-)

diff --git a/guix/build/utils.scm b/guix/build/utils.scm
index e87066cc02..9c1e19f6d8 100644
--- a/guix/build/utils.scm
+++ b/guix/build/utils.scm
@@ -177,6 +177,7 @@ (define (compressor file-name)
         ((string-suffix? "lz"  file-name)  "lzip")
         ((string-suffix? "zip" file-name)  "unzip")
         ((string-suffix? "xz"  file-name)  "xz")
+        ((string-suffix? "zst" file-name)  "zstd")
         (else #f)))                ;no compression used/unknown file extension
 
 (define (tarball? file-name)
diff --git a/guix/packages.scm b/guix/packages.scm
index cb8db925f8..ce1ba7c53a 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -5,7 +5,7 @@
 ;;; Copyright © 2016 Alex Kost <alezost@gmail.com>
 ;;; Copyright © 2017, 2019, 2020, 2022 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2019 Marius Bakke <mbakke@fastmail.com>
-;;; Copyright © 2020, 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2020, 2021, 2024 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2021 Chris Marusich <cmmarusich@gmail.com>
 ;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be>
 ;;; Copyright © 2022 jgart <jgart@dismail.de>
@@ -862,6 +862,7 @@ (define (%standard-patch-inputs system)
                          (module-ref (resolve-interface module) var))))))
     `(("tar"   ,(ref '(gnu packages base) 'tar))
       ("xz"    ,(ref '(gnu packages compression) 'xz))
+      ("zstd"  ,(ref '(gnu packages compression) 'zstd))
       ("bzip2" ,(ref '(gnu packages compression) 'bzip2))
       ("gzip"  ,(ref '(gnu packages compression) 'gzip))
       ("lzip"  ,(ref '(gnu packages compression) 'lzip))
@@ -926,31 +927,35 @@ (define* (patch-and-repack source patches
     ;; Return true if DIRECTORY is a checkout (git, svn, etc).
     (string-suffix? "-checkout" directory))
 
-  (define (tarxz-name file-name)
-    ;; Return a '.tar.xz' file name based on FILE-NAME.
+  (define (tar-file-name file-name ext)
+    ;; Return a '$filename.tar.$ext' file name based on FILE-NAME and EXT.
     (let ((base (if (numeric-extension? file-name)
                     original-file-name
                     (file-sans-extension file-name))))
       (string-append base
                      (if (equal? (file-extension base) "tar")
-                         ".xz"
-                         ".tar.xz"))))
+                         (string-append "." ext)
+                         (string-append ".tar." ext)))))
 
   (define instantiate-patch
     (match-lambda
-      ((? string? patch)                          ;deprecated
+      ((? string? patch)                ;deprecated
        (local-file patch #:recursive? #t))
-      ((? struct? patch)                          ;origin, local-file, etc.
+      ((? struct? patch)                ;origin, local-file, etc.
        patch)))
 
-  (let ((tar     (lookup-input "tar"))
-        (gzip    (lookup-input "gzip"))
-        (bzip2   (lookup-input "bzip2"))
-        (lzip    (lookup-input "lzip"))
-        (xz      (lookup-input "xz"))
-        (patch   (lookup-input "patch"))
-        (comp    (and=> (compressor source-file-name) lookup-input))
-        (patches (map instantiate-patch patches)))
+  (let* ((tar     (lookup-input "tar"))
+         (gzip    (lookup-input "gzip"))
+         (bzip2   (lookup-input "bzip2"))
+         (lzip    (lookup-input "lzip"))
+         (xz      (lookup-input "xz"))
+         (zstd    (or (lookup-input "zstd")
+                      ;; Fallback to xz in case zstd is not available, such as
+                      ;; for bootstrap packages.
+                      xz))
+         (patch   (lookup-input "patch"))
+         (comp    (and=> (compressor source-file-name) lookup-input))
+         (patches (map instantiate-patch patches)))
     (define build
       (with-imported-modules '((guix build utils))
         #~(begin
@@ -1028,12 +1033,12 @@ (define* (patch-and-repack source patches
                           locale (system-error-errno args)))))
 
             (setenv "PATH"
-                    (string-append #+xz "/bin"
+                    (string-append #+zstd "/bin"
                                    (if #+comp
                                        (string-append ":" #+comp "/bin")
                                        "")))
 
-            (setenv "XZ_DEFAULTS" (string-join (%xz-parallel-args)))
+            (setenv "ZSTD_NBTHREADS" (number->string (parallel-job-count)))
 
             ;; SOURCE may be either a directory, a tarball or a simple file.
             (let ((name (strip-store-file-name #+source))
@@ -1088,10 +1093,13 @@ (define* (patch-and-repack source patches
                (else                    ;single uncompressed file
                 (copy-file file #$output)))))))
 
-    (let ((name (if (or (checkout? original-file-name)
-                        (not (compressor original-file-name)))
-                    original-file-name
-                    (tarxz-name original-file-name))))
+    (let* ((ext (if zstd
+                    "zst"               ;usual case
+                    "xz"))              ;zstd-less bootstrap-origin
+           (name (if (or (checkout? original-file-name)
+                         (not (compressor original-file-name)))
+                     original-file-name
+                     (tar-file-name original-file-name ext))))
       (gexp->derivation name build
                         #:graft? #f
                         #:system system
-- 
2.41.0

[bug#68242] [PATCH 4/5] build: gnu-build-system: Compress man pages with zstd.

[Maxim Cournoyer]

The aim is to improve the efficiency of computing the man pages database,
which must decompress the man pages.  Zstd is faster than gzip, especially for
decompression, and has a similar compression ratio.

* gnu/packages/commencement.scm (%final-inputs): Add zstd.
* guix/build/gnu-build-system.scm
(compress-documentation) Update doc.
<info-compressor, info-compressor-flags, man-compressor, man-compressor-flags>
<man-compressor-file-extension>: New arguments.
<compressed-documentation-extension>: Rename argument to...
<info-compressor-file-extension>: ... this.  Add an 'extension' argument to
the retarget-symlink nested procedure.  Use new arguments in nested
'maybe-compress' procedure.

Change-Id: Ibaad4658f8e5151633714d263d9198f56d255020
---

 gnu/packages/commencement.scm   |  3 +-
 guix/build/gnu-build-system.scm | 73 +++++++++++++++++++++------------
 2 files changed, 49 insertions(+), 27 deletions(-)

diff --git a/gnu/packages/commencement.scm b/gnu/packages/commencement.scm
index ae1c91f0d0..51c26339ef 100644
--- a/gnu/packages/commencement.scm
+++ b/gnu/packages/commencement.scm
@@ -3492,7 +3492,8 @@ (define-public %final-inputs
                               (native-inputs
                                (list (if (target-hurd?)
                                          glibc-utf8-locales-final/hurd
-                                         glibc-utf8-locales-final)))))))
+                                         glibc-utf8-locales-final)))))
+                   ("zstd" ,zstd)))
           ("sed" ,sed-final)
           ("grep" ,grep-final)
           ("xz" ,xz-final)
diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm
index 51b8f9acbf..ff9b123ae6 100644
--- a/guix/build/gnu-build-system.scm
+++ b/guix/build/gnu-build-system.scm
@@ -2,7 +2,7 @@
 ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2018 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2020 Brendan Tildesley <mail@brendan.scot>
-;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2021, 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -644,21 +644,36 @@ (define* (reset-gzip-timestamps #:key outputs #:allow-other-keys)
     (((names . directories) ...)
      (for-each process-directory directories))))
 
-(define* (compress-documentation #:key outputs
+(define* (compress-documentation #:key
+                                 outputs
                                  (compress-documentation? #t)
-                                 (documentation-compressor "gzip")
-                                 (documentation-compressor-flags
+                                 (info-compressor "gzip")
+                                 (info-compressor-flags
                                   '("--best" "--no-name"))
-                                 (compressed-documentation-extension ".gz")
+                                 (info-compressor-file-extension ".gz")
+                                 (man-compressor (if (which "zstd")
+                                                     "zstd"
+                                                     info-compressor))
+                                 (man-compressor-flags
+                                  (if (which "zstd")
+                                      (list "-19" "--rm"
+                                            "--threads" (string->number
+                                                         (parallel-job-count)))
+                                      info-compressor-flags))
+                                 (man-compressor-file-extension
+                                  (if (which "zstd")
+                                      ".zst"
+                                      info-compressor-file-extension))
                                  #:allow-other-keys)
-  "When COMPRESS-DOCUMENTATION? is true, compress man pages and Info files
-found in OUTPUTS using DOCUMENTATION-COMPRESSOR, called with
-DOCUMENTATION-COMPRESSOR-FLAGS."
-  (define (retarget-symlink link)
+  "When COMPRESS-INFO-MANUALS? is true, compress Info files found in OUTPUTS
+using INFO-COMPRESSOR, called with INFO-COMPRESSOR-FLAGS.  Similarly, when
+COMPRESS-MAN-PAGES? is true, compress man pages files found in OUTPUTS using
+MAN-COMPRESSOR, using MAN-COMPRESSOR-FLAGS."
+  (define (retarget-symlink link extension)
     (let ((target (readlink link)))
       (delete-file link)
-      (symlink (string-append target compressed-documentation-extension)
-               (string-append link compressed-documentation-extension))))
+      (symlink (string-append target extension)
+               (string-append link extension))))
 
   (define (has-links? file)
     ;; Return #t if FILE has hard links.
@@ -676,23 +691,23 @@ (define* (compress-documentation #:key outputs
           (symbolic-link? target-absolute))
         (lambda args
           (if (= ENOENT (system-error-errno args))
-              (begin
-                (format (current-error-port)
-                        "The symbolic link '~a' target is missing: '~a'\n"
-                        symlink target-absolute)
-                #f)
+              (format (current-error-port)
+                      "The symbolic link '~a' target is missing: '~a'\n"
+                      symlink target-absolute)
               (apply throw args))))))
 
-  (define (maybe-compress-directory directory regexp)
+  (define (maybe-compress-directory directory regexp
+                                    compressor
+                                    compressor-flags
+                                    compressor-extension)
     (when (directory-exists? directory)
       (match (find-files directory regexp)
-        (()                                     ;nothing to compress
+        (()                             ;nothing to compress
          #t)
-        ((files ...)                            ;one or more files
+        ((files ...)                    ;one or more files
          (format #t
                  "compressing documentation in '~a' with ~s and flags ~s~%"
-                 directory documentation-compressor
-                 documentation-compressor-flags)
+                 directory compressor compressor-flags)
          (call-with-values
              (lambda ()
                (partition symbolic-link? files))
@@ -702,20 +717,26 @@ (define* (compress-documentation #:key outputs
              ;; unchanged ('gzip' would refuse to compress them anyway.)
              ;; Also, do not retarget symbolic links pointing to other
              ;; symbolic links, since these are not compressed.
-             (for-each retarget-symlink
+             (for-each (cut retarget-symlink <> compressor-extension)
                        (filter (lambda (symlink)
                                  (and (not (points-to-symlink? symlink))
                                       (string-match regexp symlink)))
                                symlinks))
-             (apply invoke documentation-compressor
-                    (append documentation-compressor-flags
+             (apply invoke compressor
+                    (append compressor-flags
                             (remove has-links? regular-files)))))))))
 
   (define (maybe-compress output)
     (maybe-compress-directory (string-append output "/share/man")
-                              "\\.[0-9]+$")
+                              "\\.[0-9]+$"
+                              man-compressor
+                              man-compressor-flags
+                              man-compressor-file-extension)
     (maybe-compress-directory (string-append output "/share/info")
-                              "\\.info(-[0-9]+)?$"))
+                              "\\.info(-[0-9]+)?$"
+                              info-compressor
+                              info-compressor-flags
+                              info-compressor-file-extension))
 
   (if compress-documentation?
       (match outputs
-- 
2.41.0

[bug#68242] [PATCH 5/5] man-db: Add support for zstd compressed man pages.

[Maxim Cournoyer]

* guix/man-db.scm (<mandb-entry>): Adjust comment.
(abbreviate-file-name): Adjust regexp.
(gz-compressed?, zstd-compressed?): New predicates.
(entry->string): Use them.
(man-page->entry): Adjust doc.  Use input port reader appropriate to the
compression type, if any.
(man-files): Adjust regexp.
(mandb-entries): Adjust link resolving predicate.
* guix/profiles.scm (manual-database): Add guile-zlib extension.

Change-Id: I6336e46e2d324c520a7d15d6cafd12bbf43c5b09
---

 guix/man-db.scm   | 45 +++++++++++++++++++++++++++++++++++----------
 guix/profiles.scm |  8 ++++++--
 2 files changed, 41 insertions(+), 12 deletions(-)

diff --git a/guix/man-db.scm b/guix/man-db.scm
index 7d9707a592..12887ce400 100644
--- a/guix/man-db.scm
+++ b/guix/man-db.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2022, 2024 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -18,6 +19,7 @@
 
 (define-module (guix man-db)
   #:use-module (zlib)
+  #:use-module (zstd)
   #:use-module ((guix build utils) #:select (find-files))
   #:use-module (gdbm)                             ;gdbm-ffi
   #:use-module (srfi srfi-9)
@@ -48,7 +50,7 @@ (define-module (guix man-db)
 (define-record-type <mandb-entry>
   (mandb-entry file-name name section synopsis kind)
   mandb-entry?
-  (file-name mandb-entry-file-name)               ;e.g., "../abiword.1.gz"
+  (file-name mandb-entry-file-name)               ;e.g., "../abiword.1.zst"
   (name      mandb-entry-name)                    ;e.g., "ABIWORD"
   (section   mandb-entry-section)                 ;number
   (synopsis  mandb-entry-synopsis)                ;string
@@ -63,7 +65,7 @@ (define (mandb-entry<? entry1 entry2)
             (string<? (basename file1) (basename file2))))))))
 
 (define abbreviate-file-name
-  (let ((man-file-rx (make-regexp "(.+)\\.[0-9][a-z]?(\\.gz)?$")))
+  (let ((man-file-rx (make-regexp "(.+)\\.[0-9][a-z]?(\\.(gz|zst))?$")))
     (lambda (file)
       (match (regexp-exec man-file-rx (basename file))
         (#f
@@ -71,6 +73,14 @@ (define abbreviate-file-name
         (matches
          (match:substring matches 1))))))
 
+(define (gzip-compressed? file-name)
+  "True if FILE-NAME is suffixed with the '.gz' file extension."
+  (string-suffix? ".gz" file-name))
+
+(define (zstd-compressed? file-name)
+  "True if FILE-NAME is suffixed with the '.zst' file extension."
+  (string-suffix? ".zst" file-name))
+
 (define (entry->string entry)
   "Return the wire format for ENTRY as a string."
   (match entry
@@ -92,7 +102,11 @@ (define (entry->string entry)
 
                     "\t-\t-\t"
 
-                    (if (string-suffix? ".gz" file) "gz" "")
+                    (cond
+                     ((gzip-compressed? file) "gz")
+                     ((zstd-compressed? file) "zst")
+                     (else ""))
+
                     "\t"
 
                     synopsis "\x00"))))
@@ -148,7 +162,8 @@ (define (read-synopsis port)
        (loop (cons line lines))))))
 
 (define* (man-page->entry file #:optional (resolve identity))
-  "Parse FILE, a gzipped man page, and return a <mandb-entry> for it."
+  "Parse FILE, a gzip or zstd compressed man page, and return a <mandb-entry>
+for it."
   (define (string->number* str)
     (if (and (string-prefix? "\"" str)
              (> (string-length str) 1)
@@ -156,8 +171,13 @@ (define* (man-page->entry file #:optional (resolve identity))
         (string->number (string-drop (string-drop-right str 1) 1))
         (string->number str)))
 
-  ;; Note: This works for both gzipped and uncompressed files.
-  (call-with-gzip-input-port (open-file file "r0")
+  (define call-with-input-port*
+    (cond
+     ((gzip-compressed? file) call-with-gzip-input-port)
+     ((zstd-compressed? file) call-with-zstd-input-port)
+     (else call-with-port)))
+
+  (call-with-input-port* (open-file file "r0")
     (lambda (port)
       (let loop ((name     #f)
                  (section  #f)
@@ -191,14 +211,19 @@ (define* (man-page->entry file #:optional (resolve identity))
 (define (man-files directory)
   "Return the list of man pages found under DIRECTORY, recursively."
   ;; Filter the list to ensure that broken symlinks are excluded.
-  (filter file-exists? (find-files directory "\\.[0-9][a-z]?(\\.gz)?$")))
+  (filter file-exists?
+          (find-files directory "\\.[0-9][a-z]?(\\.(gz|zst))?$")))
 
 (define (mandb-entries directory)
   "Return mandb entries for the man pages found under DIRECTORY, recursively."
   (map (lambda (file)
          (man-page->entry file
                           (lambda (link)
-                            (let ((file (string-append directory "/" link
-                                                       ".gz")))
-                              (and (file-exists? file) file)))))
+                            (let ((file-gz (string-append directory "/" link
+                                                          ".gz"))
+                                  (file-zst (string-append directory "/" link
+                                                           ".zst")))
+                              (and (or (file-exists? file-gz)
+                                       (file-exists? file-zst) file)
+                                   file)))))
        (man-files directory)))
diff --git a/guix/profiles.scm b/guix/profiles.scm
index da7790d819..7fa5dab62a 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -7,7 +7,7 @@
 ;;; Copyright © 2016, 2017, 2018, 2019, 2021, 2022 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
 ;;; Copyright © 2017 Huang Ying <huang.ying.caritas@gmail.com>
-;;; Copyright © 2017, 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2017, 2021, 2024 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2019 Kyle Meyer <kyle@kyleam.com>
 ;;; Copyright © 2019 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2020 Danny Milosavljevic <dannym@scratchpost.org>
@@ -1701,6 +1701,9 @@ (define* (manual-database manifest #:optional system)
   (define guile-zlib
     (module-ref (resolve-interface '(gnu packages guile)) 'guile-zlib))
 
+  (define guile-zstd
+    (module-ref (resolve-interface '(gnu packages guile)) 'guile-zstd))
+
   (define modules
     (delete '(guix config)
             (source-module-closure `((guix build utils)
@@ -1709,7 +1712,8 @@ (define* (manual-database manifest #:optional system)
   (define build
     (with-imported-modules modules
       (with-extensions (list gdbm-ffi           ;for (guix man-db)
-                             guile-zlib)
+                             guile-zlib
+                             guile-zstd)
         #~(begin
             (use-modules (guix man-db)
                          (guix build utils)
-- 
2.41.0