(address . guix-patches@gnu.org)
87h9116osr.fsf@gmail.com
Hello Guix!
This patch fixes a small defect in compress-documentation phase of our
gnu-build-system. The phase could create dangling manual
page symlinks in the case those were recursive.
One package which exhibited the issue is Gimp; you might have noticed
the `find-files' error message when the manual page database gets
created on a profile generation as a consequence of that.
Here's the Gimp example in some more details:
* The manual pages under share/man/man1 before the documentation is
compressed:
gimp.1 -> gimp-2.8.1
gimp-2.8.1
gimp-console.1 -> gimp-console-2.8.1
gimp-console-2.8.1 -> gimp-2.8.1
gimptool-2.0.1
* After the documentation is compressed:
gimp.1 -> gimp-2.8.1.gz
gimp-2.8.1.gz
gimp-console.1 -> gimp-console-2.8.1.gz
gimp-console-2.8.1 -> gimp-2.8.1.gz
gimptool-2.0.1.gz
We can see that the gimp-console.1 link now points to an unexisting
file. To correct the problem, a `points-to-symbolic-link?' predicate is
added and its negation is used to filter out the links which shouldn't
be retargetted.
I didn't test this by rebuilding the world; rather, I exercised the
`compress-documentation' function at the REPL, feeding it a copied gimp
derivation output as it appeared before the problematic
compress-documentation phase.
It should be applied to core-updates since it triggers a rebuild of all
the packages using the GNU build system.
Maxim
From 81b5ade74a7debbde30a98ac5dc884844f6dfeb7 Mon Sep 17 00:00:00 2001
From: Maxim Cournoyer <maxim.cournoyer@gmail.com>
Date: Tue, 25 Apr 2017 01:46:05 +0900
Subject: [PATCH] build-system/gnu: Fix compress-documentation phase
The compress-documentation phase was breaking recursive symbolic links used
for manuals, which was made visible by the `find-files' call in the recently
added `manual-database' profile hook.
* guix/build/gnu-build-system.scm (retarget-symblink)[link]: Rename to
`symbolic-link' (`link' is a Guile function).
(points-to-symbolic-link?): Add predicate.
(maybe-compress-directory): Rename `symlinks' to `symbolic-links', use
`points-to-symbolic-link?' to filter out symbolic links which shouldn't be
retargetted and re-order the calls to `retarget-symlink' and `documentation-compressor'.
---
guix/build/gnu-build-system.scm | 47 ++++++++++++++++++++++++++++++-----------
1 file changed, 35 insertions(+), 12 deletions(-)
Toggle diff (75 lines)
diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm
index 1786e2e3c9..778b514375 100644
--- a/guix/build/gnu-build-system.scm
+++ b/guix/build/gnu-build-system.scm
@@ -511,16 +511,34 @@ and 'man/'. This phase moves directories to the right place if needed."
"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)
- (let ((target (readlink link)))
- (delete-file link)
- (symlink (string-append target compressed-documentation-extension)
- link)))
+ (define (retarget-symlink symbolic-link)
+ (let ((target (readlink symbolic-link)))
+ (delete-file symbolic-link)
+ (symlink (string-append target
+ compressed-documentation-extension)
+ symbolic-link)))
(define (has-links? file)
;; Return #t if FILE has hard links.
(> (stat:nlink (lstat file)) 1))
+ (define (points-to-symbolic-link? symbolic-link)
+ ;; Return #t if SYMBOLIC-LINK points to another symbolic link.
+ (let* ((target (readlink symbolic-link))
+ (target-absolute (if (string-prefix? "/" target)
+ (target)
+ (string-join `(,(dirname symbolic-link) ,target)
+ "/"))))
+ (catch 'system-error
+ (lambda ()
+ (symbolic-link? target-absolute))
+ (lambda args
+ (if (= ENOENT (system-error-errno args))
+ (format (current-error-port) "The symbolic link '~a' target is
+missing: '~a'\n" symbolic-link target-absolute)
+ (apply throw args))
+ #f))))
+
(define (maybe-compress-directory directory regexp)
(or (not (directory-exists? directory))
(match (find-files directory regexp)
@@ -534,16 +552,21 @@ DOCUMENTATION-COMPRESSOR-FLAGS."
(call-with-values
(lambda ()
(partition symbolic-link? files))
- (lambda (symlinks regular-files)
+ (lambda (symbolic-links regular-files)
;; Compress the non-symlink files, and adjust symlinks to refer
;; to the compressed files. Leave files that have hard links
;; unchanged ('gzip' would refuse to compress them anyway.)
- (and (zero? (apply system* documentation-compressor
- (append documentation-compressor-flags
- (remove has-links? regular-files))))
- (every retarget-symlink
- (filter (cut string-match regexp <>)
- symlinks)))))))))
+ ;; Also, do not retarget symbolic links pointing to other
+ ;; symbolic links, since these are not compressed.
+ (and (every retarget-symlink
+ (filter (lambda (s)
+ (and (not (points-to-symbolic-link? s))
+ (string-match regexp s)))
+ symbolic-links))
+ (zero?
+ (apply system* documentation-compressor
+ (append documentation-compressor-flags
+ (remove has-links? regular-files)))))))))))
(define (maybe-compress output)
(and (maybe-compress-directory (string-append output "/share/man")
--
2.12.2
-----BEGIN PGP SIGNATURE-----
iQIzBAEBCAAdFiEEJ9WGpPiQCFQyn/CfEmDkZILmNWIFAlkK3fQACgkQEmDkZILm
NWJeaBAAnW2fw/tM8au+/35OiB+ezwLtPxpSR87rDF/fa5m67Z4Xt2t0epKgC5FJ
nBg6jhdPo515FQ8XRoD6fk3v4TPefSL1TTnZbT29j/u2mFgNHWqnEW395FJKBKEM
nL+8pVB5khWbR8v7lkCfuUGfG2c3EC2Xf8zeY2KVTQi57ock+oo+zRHBre8DmLnm
G888LJkCJ/BjSJZbjhGu4ujhAkD+d3DfrtN6ODlN3eXBNrfMnzXiwfqe+INdbtmp
llsbPr/IAkhLLDm/Yuu8Mj4xSbCVakpZcuhNOSwj95kzrC0S9rjYkJhjKVU3/PPI
QLncwFmgAg9ZYKapoyz5jjzk2favrMgL4KXJUkMc+3PO7eKRWqsdojhTjryYAeC9
IVbo4iCnW7xEqEHsAu85jJAmGKlYdxmE4nIKAYymMrU9Zyqneg73r5+ElEZCxCSw
f2f77bLXw/Ji7RvFECMbsuscCC+3upwqA1Afft/8904LPrCQ5sJaelEeks2iKxHI
KvDv0wogiAFE0aVEktJJFP5FBtnNZgxzKuatt5Q+3LyUdDYtLyoGtR41xF6Ju1ZA
djWh1OI4GAReAcNSyf7eimoMrBHmmNjgH9xZtq5O+wRyepv1JlHdcQvfAcvM9ZTt
5p2jC9hcj9hVCEXxTnZn/Pn2jImVZTV/zg1i47f9M6HeGzTrur4=
=o41X
-----END PGP SIGNATURE-----