From 7da95264f196d1c5dfa01654e87a319bce458cc1 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Wed, 17 Oct 2012 22:51:08 +0200
Subject: utils: Add `mkdir-p'; use it.

* guix/build/utils.scm (mkdir-p): New procedure.

* distro/packages/base.scm (gnu-make-boot0, gcc-boot0-wrapped,
  ld-wrapper-boot3, %static-binaries, %guile-static-stripped): Use it.
* distro/packages/typesetting.scm (lout): Likewise.
---
 guix/build/utils.scm | 26 ++++++++++++++++++++++++++
 1 file changed, 26 insertions(+)

(limited to 'guix')

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 @@
   #: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 @@
      (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.
-- 
cgit v1.2.3