diff --git a/distro/packages/base.scm b/distro/packages/base.scm index 3a22b65f13..7fb26881e2 100644 --- a/distro/packages/base.scm +++ b/distro/packages/base.scm @@ -1481,8 +1481,7 @@ (define gnu-make-boot0 'install (lambda* (#:key outputs #:allow-other-keys) (let* ((out (assoc-ref outputs "out")) (bin (string-append out "/bin"))) - (mkdir out) - (mkdir bin) + (mkdir-p bin) (copy-file "make" (string-append bin "/make")))) %standard-phases)))) @@ -1709,7 +1708,7 @@ (define gcc-boot0-wrapped (out (assoc-ref %outputs "out")) (bindir (string-append out "/bin")) (triplet ,(boot-triplet system))) - (mkdir out) (mkdir bindir) + (mkdir-p bindir) (with-directory-excursion bindir (for-each (lambda (tool) (symlink (string-append binutils "/bin/" @@ -1807,7 +1806,7 @@ (define ld-wrapper-boot3 (assoc-ref %build-inputs "binutils") out) - (mkdir out) (mkdir bin) + (mkdir-p bin) (copy-file (assoc-ref %build-inputs "wrapper") ld) (substitute* ld (("@GUILE@") @@ -2020,7 +2019,7 @@ (define (copy-directory source destination) (let* ((out (assoc-ref %outputs "out")) (bin (string-append out "/bin"))) - (mkdir out) (mkdir bin) + (mkdir-p bin) ;; Copy Coreutils binaries. (let* ((coreutils (assoc-ref %build-inputs "coreutils")) @@ -2127,17 +2126,11 @@ (define (copy-recursively source destination) (let ((in (assoc-ref %build-inputs "guile")) (out (assoc-ref %outputs "out"))) - (mkdir out) - (mkdir (string-append out "/share")) - (mkdir (string-append out "/share/guile")) - (mkdir (string-append out "/share/guile/2.0")) + (mkdir-p (string-append out "/share/guile/2.0")) (copy-recursively (string-append in "/share/guile/2.0") (string-append out "/share/guile/2.0")) - (mkdir (string-append out "/lib")) - (mkdir (string-append out "/lib/guile")) - (mkdir (string-append out "/lib/guile/2.0")) - (mkdir (string-append out "/lib/guile/2.0/ccache")) + (mkdir-p (string-append out "/lib/guile/2.0/ccache")) (copy-recursively (string-append in "/lib/guile/2.0/ccache") (string-append out "/lib/guile/2.0/ccache")) diff --git a/distro/packages/typesetting.scm b/distro/packages/typesetting.scm index cd0eae1187..5ca33c628a 100644 --- a/distro/packages/typesetting.scm +++ b/distro/packages/typesetting.scm @@ -46,12 +46,10 @@ (define-public lout (("^MANDIR[[:blank:]]*=.*$") (string-append "MANDIR = " out "/man\n"))) (mkdir out) - (mkdir (string-append out "/bin")) ; TODO: use `mkdir-p' + (mkdir (string-append out "/bin")) (mkdir (string-append out "/lib")) (mkdir (string-append out "/man")) - (mkdir doc) - (mkdir (string-append doc "/doc")) - (mkdir (string-append doc "/doc/lout"))))) + (mkdir-p (string-append doc "/doc/lout"))))) (install-man-phase '(lambda* (#:key outputs #:allow-other-keys) (zero? (system* "make" "installman")))) diff --git a/guix/build/utils.scm b/guix/build/utils.scm index d1d3116c45..0543ab48d5 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -26,6 +26,7 @@ (define-module (guix build utils) #:use-module (rnrs io ports) #:export (directory-exists? with-directory-excursion + mkdir-p set-path-environment-variable search-path-as-string->list list->search-path-as-string @@ -62,6 +63,31 @@ (define-syntax-rule (with-directory-excursion dir body ...) (lambda () (chdir init))))) +(define (mkdir-p dir) + "Create directory DIR and all its ancestors." + (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) + (loop tail path)) + (lambda args + (if (= EEXIST (system-error-errno args)) + (loop tail path) + (apply throw args)))))) + (() #t)))) + ;;; ;;; Search paths.