From 22ef06b801b284760b4ffd9587ea1a3dffd31baa Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 18 May 2017 11:35:45 +0200 Subject: union: Gracefully handle dangling symlinks in the input. Fixes . Reported by Pjotr Prins . * 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. --- guix/build/union.scm | 43 +++++++++++++++++++++++-------------------- 1 file changed, 23 insertions(+), 20 deletions(-) (limited to 'guix') 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)) -- cgit v1.2.3