From a1b30f99a87b497ddc4ee5d6e50dc465ebb13f19 Mon Sep 17 00:00:00 2001 From: Andy Patterson Date: Fri, 7 Oct 2016 17:57:08 -0400 Subject: build-system: Add asdf-build-system. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * guix/build-system/asdf.scm: New file. * guix/build/asdf-build-system.scm: New file. * guix/build/lisp-utils.scm: New file. * Makefile.am (MODULES): Add them. * doc/guix.texi (Build Systems): Document 'asdf-build-system'. Signed-off-by: 宋文武 --- guix/build/asdf-build-system.scm | 282 +++++++++++++++++++++++++++++++++ guix/build/lisp-utils.scm | 327 +++++++++++++++++++++++++++++++++++++++ 2 files changed, 609 insertions(+) create mode 100644 guix/build/asdf-build-system.scm create mode 100644 guix/build/lisp-utils.scm (limited to 'guix/build') diff --git a/guix/build/asdf-build-system.scm b/guix/build/asdf-build-system.scm new file mode 100644 index 0000000000..085d073dea --- /dev/null +++ b/guix/build/asdf-build-system.scm @@ -0,0 +1,282 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2016 Andy Patterson +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (guix build asdf-build-system) + #:use-module ((guix build gnu-build-system) #:prefix gnu:) + #:use-module (guix build utils) + #:use-module (guix build lisp-utils) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:use-module (ice-9 rdelim) + #:use-module (ice-9 receive) + #:use-module (ice-9 regex) + #:use-module (ice-9 match) + #:use-module (ice-9 format) + #:use-module (ice-9 ftw) + #:export (%standard-phases + %standard-phases/source + asdf-build + asdf-build/source)) + +;; Commentary: +;; +;; System for building ASDF packages; creating executable programs and images +;; from them. +;; +;; Code: + +(define %object-prefix "/lib") + +(define (source-install-prefix lisp) + (string-append %install-prefix "/" lisp "-source")) + +(define %system-install-prefix + (string-append %install-prefix "/systems")) + +(define (output-path->package-name path) + (package-name->name+version (strip-store-file-name path))) + +(define (outputs->name outputs) + (output-path->package-name + (assoc-ref outputs "out"))) + +(define (lisp-source-directory output lisp name) + (string-append output (source-install-prefix lisp) "/" name)) + +(define (source-directory output name) + (string-append output %install-prefix "/source/" name)) + +(define (library-directory output lisp) + (string-append output %object-prefix + "/" lisp)) + +(define (output-translation source-path + object-output + lisp) + "Return a translation for the system's source path +to it's binary output." + `((,source-path + :**/ :*.*.*) + (,(library-directory object-output lisp) + :**/ :*.*.*))) + +(define (source-asd-file output lisp name asd-file) + (string-append (lisp-source-directory output lisp name) "/" asd-file)) + +(define (copy-files-to-output outputs output name) + "Copy all files from OUTPUT to \"out\". Create an extra link to any +system-defining files in the source to a convenient location. This is done +before any compiling so that the compiled source locations will be valid." + (let* ((out (assoc-ref outputs output)) + (source (getcwd)) + (target (source-directory out name)) + (system-path (string-append out %system-install-prefix))) + (copy-recursively source target) + (mkdir-p system-path) + (for-each + (lambda (file) + (symlink file + (string-append system-path "/" (basename file)))) + (find-files target "\\.asd$")) + #t)) + +(define* (install #:key outputs #:allow-other-keys) + "Copy and symlink all the source files." + (copy-files-to-output outputs "out" (outputs->name outputs))) + +(define* (copy-source #:key outputs lisp #:allow-other-keys) + "Copy the source to \"out\"." + (let* ((out (assoc-ref outputs "out")) + (name (remove-lisp-from-name (output-path->package-name out) lisp)) + (install-path (string-append out %install-prefix))) + (copy-files-to-output outputs "out" name) + ;; Hide the files from asdf + (with-directory-excursion install-path + (rename-file "source" (string-append lisp "-source")) + (delete-file-recursively "systems"))) + #t) + +(define* (build #:key outputs inputs lisp asd-file + #:allow-other-keys) + "Compile the system." + (let* ((out (assoc-ref outputs "out")) + (name (remove-lisp-from-name (output-path->package-name out) lisp)) + (source-path (lisp-source-directory out lisp name)) + (translations (wrap-output-translations + `(,(output-translation source-path + out + lisp)))) + (asd-file (and=> asd-file (cut source-asd-file out lisp name <>)))) + + (setenv "ASDF_OUTPUT_TRANSLATIONS" + (replace-escaped-macros (format #f "~S" translations))) + + ;; We don't need this if we have the asd file, and it can mess with the + ;; load ordering we're trying to enforce + (unless asd-file + (prepend-to-source-registry (string-append source-path "//"))) + + (setenv "HOME" out) ; ecl's asdf sometimes wants to create $HOME/.cache + + (parameterize ((%lisp (string-append + (assoc-ref inputs lisp) "/bin/" lisp))) + (compile-system name lisp asd-file)) + + ;; As above, ecl will sometimes create this even though it doesn't use it + + (let ((cache-directory (string-append out "/.cache"))) + (when (directory-exists? cache-directory) + (delete-file-recursively cache-directory)))) + #t) + +(define* (check #:key lisp tests? outputs inputs asd-file + #:allow-other-keys) + "Test the system." + (let* ((name (remove-lisp-from-name (outputs->name outputs) lisp)) + (out (assoc-ref outputs "out")) + (asd-file (and=> asd-file (cut source-asd-file out lisp name <>)))) + (if tests? + (parameterize ((%lisp (string-append + (assoc-ref inputs lisp) "/bin/" lisp))) + (test-system name lisp asd-file)) + (format #t "test suite not run~%"))) + #t) + +(define* (patch-asd-files #:key outputs + inputs + lisp + special-dependencies + test-only-systems + #:allow-other-keys) + "Patch any asd files created by the compilation process so that they can +find their dependencies. Exclude any TEST-ONLY-SYSTEMS which were only +included to run tests. Add any SPECIAL-DEPENDENCIES which the LISP +implementation itself provides." + (let* ((out (assoc-ref outputs "out")) + (name (remove-lisp-from-name (output-path->package-name out) lisp)) + (registry (lset-difference + (lambda (input system) + (match input + ((name . path) (string=? name system)))) + (lisp-dependencies lisp inputs) + test-only-systems)) + (lisp-systems (map first registry))) + + (for-each + (lambda (asd-file) + (patch-asd-file asd-file registry lisp + (append lisp-systems special-dependencies))) + (find-files out "\\.asd$"))) + #t) + +(define* (symlink-asd-files #:key outputs lisp #:allow-other-keys) + "Create an extra reference to the system in a convenient location." + (let* ((out (assoc-ref outputs "out"))) + (for-each + (lambda (asd-file) + (substitute* asd-file + ((";;; Built for.*") "") ; remove potential non-determinism + (("^\\(DEFSYSTEM(.*)$" all end) (string-append "(asdf:defsystem" end))) + (receive (new-asd-file asd-file-directory) + (bundle-asd-file out asd-file lisp) + (mkdir-p asd-file-directory) + (symlink asd-file new-asd-file) + ;; Update the source registry for future phases which might want to + ;; use the newly compiled system. + (prepend-to-source-registry + (string-append asd-file-directory "/")))) + + (find-files (string-append out %object-prefix) "\\.asd$")) +) + #t) + +(define* (cleanup-files #:key outputs lisp + #:allow-other-keys) + "Remove any compiled files which are not a part of the final bundle." + (let ((out (assoc-ref outputs "out"))) + (match lisp + ("sbcl" + (for-each + (lambda (file) + (unless (string-suffix? "--system.fasl" file) + (delete-file file))) + (find-files out "\\.fasl$"))) + ("ecl" + (for-each delete-file + (append (find-files out "\\.fas$") + (find-files out "\\.o$") + (find-files out "\\.a$"))))) + + (with-directory-excursion (library-directory out lisp) + (for-each + (lambda (file) + (rename-file file + (string-append "./" (basename file)))) + (find-files ".")) + (for-each delete-file-recursively + (scandir "." + (lambda (file) + (and + (directory-exists? file) + (string<> "." file) + (string<> ".." file))))))) + #t) + +(define* (strip #:key lisp #:allow-other-keys #:rest args) + ;; stripping sbcl binaries removes their entry program and extra systems + (or (string=? lisp "sbcl") + (apply (assoc-ref gnu:%standard-phases 'strip) args))) + +(define %standard-phases/source + (modify-phases gnu:%standard-phases + (delete 'configure) + (delete 'check) + (delete 'build) + (replace 'install install))) + +(define %standard-phases + (modify-phases gnu:%standard-phases + (delete 'configure) + (delete 'install) + (replace 'build build) + (add-before 'build 'copy-source copy-source) + (replace 'check check) + (replace 'strip strip) + (add-after 'check 'link-dependencies patch-asd-files) + (add-after 'link-dependencies 'cleanup cleanup-files) + (add-after 'cleanup 'create-symlinks symlink-asd-files))) + +(define* (asdf-build #:key inputs + (phases %standard-phases) + #:allow-other-keys + #:rest args) + (apply gnu:gnu-build + #:inputs inputs + #:phases phases + args)) + +(define* (asdf-build/source #:key inputs + (phases %standard-phases/source) + #:allow-other-keys + #:rest args) + (apply gnu:gnu-build + #:inputs inputs + #:phases phases + args)) + +;;; asdf-build-system.scm ends here diff --git a/guix/build/lisp-utils.scm b/guix/build/lisp-utils.scm new file mode 100644 index 0000000000..55a07c7207 --- /dev/null +++ b/guix/build/lisp-utils.scm @@ -0,0 +1,327 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2016 Andy Patterson +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (guix build lisp-utils) + #:use-module (ice-9 format) + #:use-module (ice-9 match) + #:use-module (ice-9 regex) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:use-module (guix build utils) + #:export (%lisp + %install-prefix + lisp-eval-program + compile-system + test-system + replace-escaped-macros + generate-executable-wrapper-system + generate-executable-entry-point + generate-executable-for-system + patch-asd-file + bundle-install-prefix + lisp-dependencies + bundle-asd-file + remove-lisp-from-name + wrap-output-translations + prepend-to-source-registry + build-program + build-image)) + +;;; Commentary: +;;; +;;; Tools to evaluate lisp programs within a lisp session, generate wrapper +;;; systems for executables. Compile, test, and produce images for systems and +;;; programs, and link them with their dependencies. +;;; +;;; Code: + +(define %lisp + ;; File name of the Lisp compiler. + (make-parameter "lisp")) + +(define %install-prefix "/share/common-lisp") + +(define (bundle-install-prefix lisp) + (string-append %install-prefix "/" lisp "-bundle-systems")) + +(define (remove-lisp-from-name name lisp) + (string-drop name (1+ (string-length lisp)))) + +(define (wrap-output-translations translations) + `(:output-translations + ,@translations + :inherit-configuration)) + +(define (lisp-eval-program lisp program) + "Evaluate PROGRAM with a given LISP implementation." + (unless (zero? (apply system* + (lisp-invoke lisp (format #f "~S" program)))) + (error "lisp-eval-program failed!" lisp program))) + +(define (lisp-invoke lisp program) + "Return a list of arguments for system* determining how to invoke LISP +with PROGRAM." + (match lisp + ("sbcl" `(,(%lisp) "--non-interactive" "--eval" ,program)) + ("ecl" `(,(%lisp) "-eval" ,program "-eval" "(quit)")))) + +(define (asdf-load-all systems) + (map (lambda (system) + `(funcall + (find-symbol + (symbol-name :load-system) + (symbol-name :asdf)) + ,system)) + systems)) + +(define (compile-system system lisp asd-file) + "Use a lisp implementation to compile SYSTEM using asdf. Load ASD-FILE +first if SYSTEM is defined there." + (lisp-eval-program lisp + `(progn + (require :asdf) + (in-package :asdf) + ,@(if asd-file + `((load ,asd-file)) + '()) + (in-package :cl-user) + (funcall (find-symbol + (symbol-name :operate) + (symbol-name :asdf)) + (find-symbol + (symbol-name :compile-bundle-op) + (symbol-name :asdf)) + ,system) + (funcall (find-symbol + (symbol-name :operate) + (symbol-name :asdf)) + (find-symbol + (symbol-name :deliver-asd-op) + (symbol-name :asdf)) + ,system)))) + +(define (test-system system lisp asd-file) + "Use a lisp implementation to test SYSTEM using asdf. Load ASD-FILE first +if SYSTEM is defined there." + (lisp-eval-program lisp + `(progn + (require :asdf) + (in-package :asdf) + ,@(if asd-file + `((load ,asd-file)) + '()) + (in-package :cl-user) + (funcall (find-symbol + (symbol-name :test-system) + (symbol-name :asdf)) + ,system)))) + +(define (string->lisp-keyword . strings) + "Return a lisp keyword for the concatenation of STRINGS." + (string->symbol (apply string-append ":" strings))) + +(define (generate-executable-for-system type system lisp) + "Use LISP to generate an executable, whose TYPE can be \"image\" or +\"program\". The latter will always be standalone. Depends on having created +a \"SYSTEM-exec\" system which contains the entry program." + (lisp-eval-program + lisp + `(progn + (require :asdf) + (funcall (find-symbol + (symbol-name :operate) + (symbol-name :asdf)) + (find-symbol + (symbol-name ,(string->lisp-keyword type "-op")) + (symbol-name :asdf)) + ,(string-append system "-exec"))))) + +(define (generate-executable-wrapper-system system dependencies) + "Generates a system which can be used by asdf to produce an image or program +inside the current directory. The image or program will contain +DEPENDENCIES." + (with-output-to-file (string-append system "-exec.asd") + (lambda _ + (format #t "~y~%" + `(defsystem ,(string->lisp-keyword system "-exec") + :entry-point ,(string-append system "-exec:main") + :depends-on (:uiop + ,@(map string->lisp-keyword + dependencies)) + :components ((:file ,(string-append system "-exec")))))))) + +(define (generate-executable-entry-point system entry-program) + "Generates an entry point program from the list of lisp statements +ENTRY-PROGRAM for SYSTEM within the current directory." + (with-output-to-file (string-append system "-exec.lisp") + (lambda _ + (let ((system (string->lisp-keyword system "-exec"))) + (format #t "~{~y~%~%~}" + `((defpackage ,system + (:use :cl) + (:export :main)) + + (in-package ,system) + + (defun main () + (let ((arguments uiop:*command-line-arguments*)) + (declare (ignorable arguments)) + ,@entry-program)))))))) + +(define (wrap-perform-method lisp registry dependencies file-name) + "Creates a wrapper method which allows the system to locate its dependent +systems from REGISTRY, an alist of the same form as %outputs, which contains +lisp systems which the systems is dependent on. All DEPENDENCIES which the +system depends on will the be loaded before this system." + (let* ((system (string-drop-right (basename file-name) 4)) + (system-symbol (string->lisp-keyword system))) + + `(defmethod asdf:perform :before + (op (c (eql (asdf:find-system ,system-symbol)))) + (asdf/source-registry:ensure-source-registry) + ,@(map (match-lambda + ((name . path) + (let ((asd-file (string-append path + (bundle-install-prefix lisp) + "/" name ".asd"))) + `(setf + (gethash ,name + asdf/source-registry:*source-registry*) + ,(string->symbol "#p") + ,(bundle-asd-file path asd-file lisp))))) + registry) + ,@(map (lambda (system) + `(asdf:load-system ,(string->lisp-keyword system))) + dependencies)))) + +(define (patch-asd-file asd-file registry lisp dependencies) + "Patches ASD-FILE with a perform method as described in WRAP-PERFORM-METHOD." + (chmod asd-file #o644) + (let ((port (open-file asd-file "a"))) + (dynamic-wind + (lambda _ #t) + (lambda _ + (display + (replace-escaped-macros + (format #f "~%~y~%" + (wrap-perform-method lisp registry + dependencies asd-file))) + port)) + (lambda _ (close-port port)))) + (chmod asd-file #o444)) + +(define (lisp-dependencies lisp inputs) + "Determine which inputs are lisp system dependencies, by using the convention +that a lisp system dependency will resemble \"system-LISP\"." + (filter-map (match-lambda + ((name . value) + (and (string-prefix? lisp name) + (string<> lisp name) + `(,(remove-lisp-from-name name lisp) + . ,value)))) + inputs)) + +(define (bundle-asd-file output-path original-asd-file lisp) + "Find the symlinked bundle file for ORIGINAL-ASD-FILE by looking in +OUTPUT-PATH/share/common-lisp/LISP-bundle-systems/.asd. Returns two +values: the asd file itself and the directory in which it resides." + (let ((bundle-asd-path (string-append output-path + (bundle-install-prefix lisp)))) + (values (string-append bundle-asd-path "/" (basename original-asd-file)) + bundle-asd-path))) + +(define (replace-escaped-macros string) + "Replace simple lisp forms that the guile writer escapes, for example by +replacing #{#p}# with #p. Should only be used to replace truly simple forms +which are not nested." + (regexp-substitute/global #f "(#\\{)(\\S*)(\\}#)" string + 'pre 2 'post)) + +(define (prepend-to-source-registry path) + (setenv "CL_SOURCE_REGISTRY" + (string-append path ":" (or (getenv "CL_SOURCE_REGISTRY") "")))) + +(define* (build-program lisp program #:key inputs + (dependencies (list (basename program))) + entry-program + #:allow-other-keys) + "Generate an executable program containing all DEPENDENCIES, and which will +execute ENTRY-PROGRAM. The result is placed in PROGRAM. When executed, it +will run ENTRY-PROGRAM, a list of Common Lisp expressions in which `arguments' +has been bound to the command-line arguments which were passed." + (generate-executable lisp program + #:inputs inputs + #:dependencies dependencies + #:entry-program entry-program + #:type "program") + (let* ((name (basename program)) + (bin-directory (dirname program))) + (with-directory-excursion bin-directory + (rename-file (string-append name "-exec") + name))) + #t) + +(define* (build-image lisp image #:key inputs + (dependencies (list (basename image))) + #:allow-other-keys) + "Generate an image, possibly standalone, which contains all DEPENDENCIES, +placing the result in IMAGE.image." + (generate-executable lisp image + #:inputs inputs + #:dependencies dependencies + #:entry-program '(nil) + #:type "image") + (let* ((name (basename image)) + (bin-directory (dirname image))) + (with-directory-excursion bin-directory + (rename-file (string-append name "-exec--all-systems.image") + (string-append name ".image")))) + #t) + +(define* (generate-executable lisp out-file #:key inputs + dependencies + entry-program + type + #:allow-other-keys) + "Generate an executable by using asdf's TYPE-op, containing whithin the +image all DEPENDENCIES, and running ENTRY-PROGRAM in the case of an +executable." + (let* ((bin-directory (dirname out-file)) + (name (basename out-file))) + (mkdir-p bin-directory) + (with-directory-excursion bin-directory + (generate-executable-wrapper-system name dependencies) + (generate-executable-entry-point name entry-program)) + + (prepend-to-source-registry + (string-append bin-directory "/")) + + (setenv "ASDF_OUTPUT_TRANSLATIONS" + (replace-escaped-macros + (format + #f "~S" + (wrap-output-translations + `(((,bin-directory :**/ :*.*.*) + (,bin-directory :**/ :*.*.*))))))) + + (parameterize ((%lisp (string-append + (assoc-ref inputs lisp) "/bin/" lisp))) + (generate-executable-for-system type name lisp)) + + (delete-file (string-append bin-directory "/" name "-exec.asd")) + (delete-file (string-append bin-directory "/" name "-exec.lisp")))) -- cgit v1.2.3 From 813bcbc4eaa820821c3fc52e539c5244e192601c Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 10 Oct 2016 09:57:36 +0200 Subject: bournish: Add 'reboot' command. Suggested by Ricardo Wurmus. * guix/build/bournish.scm (reboot-command): New procedure. (%commands): Add it. --- guix/build/bournish.scm | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) (limited to 'guix/build') diff --git a/guix/build/bournish.scm b/guix/build/bournish.scm index 928bef5b9e..51dad17ba7 100644 --- a/guix/build/bournish.scm +++ b/guix/build/bournish.scm @@ -162,6 +162,17 @@ characters." (else `((@@ (guix build bournish) wc-command-implementation) ,@args)))) +(define (reboot-command . args) + "Emit code for 'reboot'." + ;; Normally Bournish is used in the initrd, where 'reboot' is provided + ;; directly by (guile-user). In other cases, just bail out. + `(if (defined? 'reboot) + (reboot) + (begin + (format (current-error-port) + "I don't know how to reboot, sorry about that!~%") + #f))) + (define (help-command . _) (display "\ Hello, this is Bournish, a minimal Bourne-like shell in Guile! @@ -189,7 +200,8 @@ commands such as 'ls' and 'cd'; it lacks globbing, pipes---everything.\n")) ("ls" ,ls-command) ("which" ,which-command) ("cat" ,cat-command) - ("wc" ,wc-command))) + ("wc" ,wc-command) + ("reboot" ,reboot-command))) (define (read-bournish port env) "Read a Bournish expression from PORT, and return the corresponding Scheme -- cgit v1.2.3 From d72267863382041b84a9712eea354882be72ef55 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 10 Oct 2016 21:36:58 +0200 Subject: grafts: Always make directories #o755. Fixes . Reported by Albin and Jeffrey Serio . * guix/build/graft.scm (mkdir-p*): New procedure. (rewrite-directory): Use it instead of 'mkdir-p'. --- guix/build/graft.scm | 30 ++++++++++++++++++++++++++++-- 1 file changed, 28 insertions(+), 2 deletions(-) (limited to 'guix/build') diff --git a/guix/build/graft.scm b/guix/build/graft.scm index b08b65b7cf..7025b72fea 100644 --- a/guix/build/graft.scm +++ b/guix/build/graft.scm @@ -210,6 +210,32 @@ an exception is caught." (print-exception port #f key args) (primitive-exit 1)))))) +(define* (mkdir-p* dir #:optional (mode #o755)) + "This is a variant of 'mkdir-p' that works around + 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 #:optional (store (%store-directory))) "Copy DIRECTORY to OUTPUT, replacing strings according to MAPPING, a list of @@ -258,7 +284,7 @@ file name pairs." (define (rewrite-leaf file) (let ((stat (lstat file)) (dest (destination file))) - (mkdir-p (dirname dest)) + (mkdir-p* (dirname dest)) (case (stat:type stat) ((symlink) (let ((target (readlink file))) @@ -277,7 +303,7 @@ file name pairs." store) (chmod output (stat:perms stat))))))) ((directory) - (mkdir-p dest)) + (mkdir-p* dest)) (else (error "unsupported file type" stat))))) -- cgit v1.2.3