futurile/guix-play
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

graft: Remove work-around for old guile.

Browse Source 
* guix/build/graft.scm (mkdir-p*): Remove function.
(rewrite-directory): Switch from mkdir-p* to mkdir-p.

Change-Id: Ib6a80648d271c19093c05af84acb967e069ccc19
This commit is contained in:
Efraim Flashner 2024-04-09 13:06:55 +03:00
parent d007b64356
commit 20c4e778a9
No known key found for this signature in database
GPG Key ID: 41AAE7DCCA3D8351
1 changed files with 2 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
guix/build/graft.scm
View File

@ -312,33 +312,6 @@ an exception is caught."
(print-exception port #f key args) (print-exception port #f key args)
(primitive-exit 1)))))) (primitive-exit 1))))))
;; We need this as long as we support Guile < 2.0.13.
(define* (mkdir-p* dir #:optional (mode #o755))
"This is a variant of 'mkdir-p' that works around
<http://bugs.gnu.org/24659> by passing MODE explicitly in each 'mkdir' call."
(define absolute?
(string-prefix? "/" dir))
(define not-slash
(char-set-complement (char-set #\/)))
(let loop ((components (string-tokenize dir not-slash))
(root (if absolute?
""
".")))
(match components
((head tail ...)
(let ((path (string-append root "/" head)))
(catch 'system-error
(lambda ()
(mkdir path mode)
(loop tail path))
(lambda args
(if (= EEXIST (system-error-errno args))
(loop tail path)
(apply throw args))))))
(() #t))))
(define* (rewrite-directory directory output mapping (define* (rewrite-directory directory output mapping
#:optional (store (%store-directory))) #:optional (store (%store-directory)))
"Copy DIRECTORY to OUTPUT, replacing strings according to MAPPING, a list of "Copy DIRECTORY to OUTPUT, replacing strings according to MAPPING, a list of
@ -387,7 +360,7 @@ file name pairs."
(define (rewrite-leaf file) (define (rewrite-leaf file)
(let ((stat (lstat file)) (let ((stat (lstat file))
(dest (destination file))) (dest (destination file)))
(mkdir-p* (dirname dest)) (mkdir-p (dirname dest))
(case (stat:type stat) (case (stat:type stat)
((symlink) ((symlink)
(let ((target (readlink file))) (let ((target (readlink file)))
@ -406,7 +379,7 @@ file name pairs."
store) store)
(chmod output (stat:perms stat))))))) (chmod output (stat:perms stat)))))))
((directory) ((directory)
(mkdir-p* dest)) (mkdir-p dest))
(else (else
(error "unsupported file type" stat))))) (error "unsupported file type" stat)))))