summary refs log tree commit diff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2015-11-16 14:16:22 +0100
committerLudovic Courtès <ludo@gnu.org>2015-11-16 14:22:58 +0100
commit9c88f655e6533e2f84ebf7ee546596c85031441d (patch)
treed9e4050177eed6d78a5b1590ff768cc09727c7c5
parent6a7e1a180b79b722bbac606234103f78259e2e9b (diff)
downloadguix-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.scm60
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