summaryrefslogtreecommitdiff
path: root/guix/build/union.scm
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-18 11:38:48 +0200
commit22ef06b801b284760b4ffd9587ea1a3dffd31baa (patch)
treeadb65b28be5230783c3fb20db6a65ac9f32b64ea /guix/build/union.scm
parent41f76ae08a7a830cdeb1eaac271d714cb58fbce3 (diff)
downloadguix-patches-22ef06b801b284760b4ffd9587ea1a3dffd31baa.tar
guix-patches-22ef06b801b284760b4ffd9587ea1a3dffd31baa.tar.gz
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/build/union.scm')
-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))