diff options
author | Ludovic Courtès <ludo@gnu.org> | 2015-11-16 14:16:22 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2015-11-16 14:22:58 +0100 |
commit | 9c88f655e6533e2f84ebf7ee546596c85031441d (patch) | |
tree | d9e4050177eed6d78a5b1590ff768cc09727c7c5 | |
parent | 6a7e1a180b79b722bbac606234103f78259e2e9b (diff) | |
download | guix-9c88f655e6533e2f84ebf7ee546596c85031441d.tar guix-9c88f655e6533e2f84ebf7ee546596c85031441d.tar.gz |
graft: Graft files in a deterministic order.
* guix/build/graft.scm (rewrite-directory)[rewrite-leaf]: Change to take
a single parameter. Add call to 'lstat'. Factorize result of
'destination'.
Use 'find-files' instead of 'file-system-fold'.
-rw-r--r-- | guix/build/graft.scm | 60 |
1 files changed, 26 insertions, 34 deletions
diff --git a/guix/build/graft.scm b/guix/build/graft.scm index 55f0f9410d..d29e671c67 100644 --- a/guix/build/graft.scm +++ b/guix/build/graft.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -21,7 +21,6 @@ #:use-module (rnrs bytevectors) #:use-module (rnrs io ports) #:use-module (ice-9 match) - #:use-module (ice-9 ftw) #:export (replace-store-references rewrite-directory)) @@ -93,38 +92,31 @@ file name pairs." (define (destination file) (string-append output (string-drop file prefix-len))) - (define (rewrite-leaf file stat result) - (case (stat:type stat) - ((symlink) - (let ((target (readlink file))) - (symlink (call-with-output-string - (lambda (output) - (replace-store-references (open-input-string target) - output mapping - store))) - (destination file)))) - ((regular) - (with-fluids ((%default-port-encoding #f)) - (call-with-input-file file - (lambda (input) - (call-with-output-file (destination file) - (lambda (output) - (replace-store-references input output mapping - store) - (chmod output (stat:perms stat)))))))) - (else - (error "unsupported file type" stat)))) + (define (rewrite-leaf file) + (let ((stat (lstat file)) + (dest (destination file))) + (mkdir-p (dirname dest)) + (case (stat:type stat) + ((symlink) + (let ((target (readlink file))) + (symlink (call-with-output-string + (lambda (output) + (replace-store-references (open-input-string target) + output mapping + store))) + dest))) + ((regular) + (with-fluids ((%default-port-encoding #f)) + (call-with-input-file file + (lambda (input) + (call-with-output-file dest + (lambda (output) + (replace-store-references input output mapping + store) + (chmod output (stat:perms stat)))))))) + (else + (error "unsupported file type" stat))))) - (file-system-fold (const #t) - rewrite-leaf - (lambda (directory stat result) ;down - (mkdir (destination directory))) - (const #t) ;up - (const #f) ;skip - (lambda (file stat errno result) ;error - (error "read error" file stat errno)) - #f - directory - lstat)) + (for-each rewrite-leaf (find-files directory))) ;;; graft.scm ends here |