ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-12 09:56: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

60
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,38 +92,31 @@ (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)
(case (stat:type stat) (let ((stat (lstat file))
((symlink) (dest (destination file)))
(let ((target (readlink file))) (mkdir-p (dirname dest))
(symlink (call-with-output-string (case (stat:type stat)
(lambda (output) ((symlink)
(replace-store-references (open-input-string target) (let ((target (readlink file)))
output mapping (symlink (call-with-output-string
store))) (lambda (output)
(destination file)))) (replace-store-references (open-input-string target)
((regular) output mapping
(with-fluids ((%default-port-encoding #f)) store)))
(call-with-input-file file dest)))
(lambda (input) ((regular)
(call-with-output-file (destination file) (with-fluids ((%default-port-encoding #f))
(lambda (output) (call-with-input-file file
(replace-store-references input output mapping (lambda (input)
store) (call-with-output-file dest
(chmod output (stat:perms stat)))))))) (lambda (output)
(else (replace-store-references input output mapping
(error "unsupported file type" stat)))) store)
(chmod output (stat:perms stat))))))))
(else
(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