summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2017-05-18 11:35:45 +0200
committerLudovic Courtès <ludo@gnu.org>2017-05-20 10:17:14 +0200
commit36c99429a3638305c16f1e6f5e087daa174d249c (patch)
treed136f763a920b276ea60500e677005bc5e72f669 /guix
parent51fe9cd38d4d64b5fade8a899d5323da0e217d5c (diff)
union: Gracefully handle dangling symlinks in the input.
Fixes <http://bugs.gnu.org/26949>. Reported by Pjotr Prins <pjotr.public12@thebird.nl>. * guix/build/union.scm (file-is-directory?): Return #f when FILE does not exist or is a dangling symlink. (file=?): Pass #f as a second argument to 'stat'; return #f when both ST1 or ST2 is #f. * tests/profiles.scm (test-equalm): New macro. ("union vs. dangling symlink"): New test.
Diffstat (limited to 'guix')
-rw-r--r--guix/build/union.scm43
1 files changed, 23 insertions, 20 deletions
diff --git a/guix/build/union.scm b/guix/build/union.scm
index a2ea72e1f5..18167fa3e3 100644
--- a/guix/build/union.scm
+++ b/guix/build/union.scm
@@ -47,31 +47,34 @@
(loop (cons file files)))))))
(define (file-is-directory? file)
- (eq? 'directory (stat:type (stat file))))
+ (match (stat file #f)
+ (#f #f) ;maybe a dangling symlink
+ (st (eq? 'directory (stat:type st)))))
(define (file=? file1 file2)
"Return #t if FILE1 and FILE2 are regular files and their contents are
identical, #f otherwise."
- (let ((st1 (stat file1))
- (st2 (stat file2)))
+ (let ((st1 (stat file1 #f))
+ (st2 (stat file2 #f)))
;; When deduplication is enabled, identical files share the same inode.
- (or (= (stat:ino st1) (stat:ino st2))
- (and (eq? (stat:type st1) 'regular)
- (eq? (stat:type st2) 'regular)
- (= (stat:size st1) (stat:size st2))
- (call-with-input-file file1
- (lambda (port1)
- (call-with-input-file file2
- (lambda (port2)
- (define len 8192)
- (define buf1 (make-bytevector len))
- (define buf2 (make-bytevector len))
- (let loop ()
- (let ((n1 (get-bytevector-n! port1 buf1 0 len))
- (n2 (get-bytevector-n! port2 buf2 0 len)))
- (and (equal? n1 n2)
- (or (eof-object? n1)
- (loop)))))))))))))
+ (and st1 st2
+ (or (= (stat:ino st1) (stat:ino st2))
+ (and (eq? (stat:type st1) 'regular)
+ (eq? (stat:type st2) 'regular)
+ (= (stat:size st1) (stat:size st2))
+ (call-with-input-file file1
+ (lambda (port1)
+ (call-with-input-file file2
+ (lambda (port2)
+ (define len 8192)
+ (define buf1 (make-bytevector len))
+ (define buf2 (make-bytevector len))
+ (let loop ()
+ (let ((n1 (get-bytevector-n! port1 buf1 0 len))
+ (n2 (get-bytevector-n! port2 buf2 0 len)))
+ (and (equal? n1 n2)
+ (or (eof-object? n1)
+ (loop))))))))))))))
(define* (union-build output inputs
#:key (log-port (current-error-port))