ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-13 18:36:14 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

graft: Graft files in a deterministic order.

Browse source 
* 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'.
This commit is contained in:
Ludovic Courtès 2015-11-16 14:16:22 +01:00
parent 6a7e1a180b
commit 9c88f655e6
1 changed files with 26 additions and 34 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

26
guix/build/graft.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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. ;;; This file is part of GNU Guix.
;;; ;;;
@ -21,7 +21,6 @@ (define-module (guix build graft)
#:use-module (rnrs bytevectors) #:use-module (rnrs bytevectors)
#:use-module (rnrs io ports) #:use-module (rnrs io ports)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 ftw)
#:export (replace-store-references #:export (replace-store-references
rewrite-directory)) rewrite-directory))
@ -93,7 +92,10 @@ (define prefix-len
(define (destination file) (define (destination file)
(string-append output (string-drop file prefix-len))) (string-append output (string-drop file prefix-len)))
(define (rewrite-leaf file stat result) (define (rewrite-leaf file)
(let ((stat (lstat file))
(dest (destination file)))
(mkdir-p (dirname dest))
(case (stat:type stat) (case (stat:type stat)
((symlink) ((symlink)
(let ((target (readlink file))) (let ((target (readlink file)))
@ -102,29 +104,19 @@ (define (rewrite-leaf file stat result)
(replace-store-references (open-input-string target) (replace-store-references (open-input-string target)
output mapping output mapping
store))) store)))
(destination file)))) dest)))
((regular) ((regular)
(with-fluids ((%default-port-encoding #f)) (with-fluids ((%default-port-encoding #f))
(call-with-input-file file (call-with-input-file file
(lambda (input) (lambda (input)
(call-with-output-file (destination file) (call-with-output-file dest
(lambda (output) (lambda (output)
(replace-store-references input output mapping (replace-store-references input output mapping
store) store)
(chmod output (stat:perms stat)))))))) (chmod output (stat:perms stat))))))))
(else (else
(error "unsupported file type" stat)))) (error "unsupported file type" stat)))))
(file-system-fold (const #t) (for-each rewrite-leaf (find-files directory)))
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))
;;; graft.scm ends here ;;; graft.scm ends here