diff options
| author | Maxim Cournoyer <maxim.cournoyer@gmail.com> | 2017-04-25 01:46:05 +0900 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2017-05-30 21:56:20 +0200 |
| commit | facac292808d11d5e6ea528cc7dbe93595f62c9b (patch) | |
| tree | c39613fb242433b7b842272d0a74ccc6351b84d3 | |
| parent | a30188f561af3f84a1da687dffb4192e621929fc (diff) | |
| download | guix-facac292808d11d5e6ea528cc7dbe93595f62c9b.tar.gz | |
build-system/gnu: 'compress-documentation' phase handles double symlinks.
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. See <http://bugs.gnu.org/26771>. * guix/build/gnu-build-system.scm (compress-documentation) [points-to-symbolic-link?]: New procedure. [maybe-compress-directory]: Use `points-to-symbolic-link?' to filter out symbolic links that shouldn't be retargetted, and re-order the calls to `retarget-symlink' and `documentation-compressor'. Co-authored-by: Ludovic Courtès <ludo@gnu.org>
| -rw-r--r-- | guix/build/gnu-build-system.scm | 36 |
1 files changed, 30 insertions, 6 deletions
diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm index 1786e2e3c9..09f272edee 100644 --- a/guix/build/gnu-build-system.scm +++ b/guix/build/gnu-build-system.scm @@ -521,6 +521,25 @@ DOCUMENTATION-COMPRESSOR-FLAGS." ;; Return #t if FILE has hard links. (> (stat:nlink (lstat file)) 1)) + (define (points-to-symlink? symlink) + ;; Return #t if SYMLINK points to another symbolic link. + (let* ((target (readlink symlink)) + (target-absolute (if (string-prefix? "/" target) + target + (string-append (dirname symlink) + "/" target)))) + (catch 'system-error + (lambda () + (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) + (apply throw args)))))) + (define (maybe-compress-directory directory regexp) (or (not (directory-exists? directory)) (match (find-files directory regexp) @@ -538,12 +557,17 @@ DOCUMENTATION-COMPRESSOR-FLAGS." ;; 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 (symlink) + (and (not (points-to-symlink? symlink)) + (string-match regexp symlink))) + symlinks)) + (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") |