Package: guix-patches;
Reported by: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
Date: Thu, 4 Jan 2024 15:18:01 UTC
Severity: normal
Tags: patch
Done: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
Bug is archived. No further changes may be made.
View this message in rfc822 format
From: Maxim Cournoyer <maxim.cournoyer <at> gmail.com> To: 68242 <at> debbugs.gnu.org Cc: Maxim Cournoyer <maxim.cournoyer <at> gmail.com> Subject: [bug#68242] [PATCH core-updates v2 4/5] build: gnu-build-system: Compress man pages with zstd. Date: Fri, 5 Jan 2024 14:52:53 -0500
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
---
Changes in v2:
- Turn string->number into number->string
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..2f0ffe36fc 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 <at> gnu.org>
;;; Copyright © 2018 Mark H Weaver <mhw <at> netris.org>
;;; Copyright © 2020 Brendan Tildesley <mail <at> brendan.scot>
-;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
+;;; Copyright © 2021, 2022 Maxim Cournoyer <maxim.cournoyer <at> 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" (number->string
+ (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
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.