ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-08 16:06:16 -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
;;; 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 @@ (define-module (guix build graft)
#: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 @@ (define prefix-len
(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