unofficial mirror of bug-guile@gnu.org 
 help / color / mirror / Atom feed
* bug#44186: Recursive mkdir
       [not found] ` <86sga420pw.fsf@gmail.com>
@ 2020-10-23 22:00   ` divoplade
  2020-10-23 22:07     ` zimoun
                       ` (2 more replies)
  0 siblings, 3 replies; 13+ messages in thread
From: divoplade @ 2020-10-23 22:00 UTC (permalink / raw)
  To: 44186; +Cc: 44130, zimoun

[-- Attachment #1: Type: text/plain, Size: 891 bytes --]

Dear guile,

I have slightly modified the mkdir function so that it takes a third
argument to try to create the intermediate directories when calling
mkdir, in effect acting as "mkdir -p".

However, I could not make the test suite run the ports test, on which I
added the test for the new behavior. Is it expected? How do I run it?

In the mean time, here is the WIP version of the patch.

Best regards,

divoplade

Le vendredi 23 octobre 2020 à 21:36 +0200, zimoun a écrit :
> salut,
> 
> On Thu, 22 Oct 2020 at 01:29, divoplade <d@divoplade.fr> wrote:
> 
> > 1. Lobby guile to provide this function out of the box (this will
> > take
> > time);
> 
> This path seems the one to go.  It will take less time than running
> Guile on Windows. ;-)
> 
> The only issue is that your code will depend on Guile 3.0.x where
> x>4.  
> 
> Otherwise, why is it not possible to send a patch to Guile?

[-- Attachment #2: 0001-mkdir-Add-an-optional-argument-recursive-to-create-t.patch --]
[-- Type: text/x-patch, Size: 7683 bytes --]

From d69f24617290c4a875ff2356ca229bf1659feafe Mon Sep 17 00:00:00 2001
From: divoplade <d@divoplade.fr>
Date: Fri, 23 Oct 2020 22:44:36 +0200
Subject: [PATCH] mkdir: Add an optional argument, recursive, to create the
 intermediates

2020-10-23 divoplade <d@divoplade.fr>
	* libguile/filesys.c: include eq.h, so we can compare strings.
	* libguile/filesys.c (scm_mkdir): add an optional argument,
	recursive, to create the intermediate directories if they do not
	exist.
	* libguile/filesys.h (scm_mkdir): add the optional argument to
	the prototype.
	* doc/ref/posix.texi (mkdir): document the new optional
	argument.
	* NEWS: say there is a new argument.
	* test-suite/tests/ports.test: add a test suite to check
	recursive mkdir.
---
 NEWS                        |  5 +++++
 doc/ref/posix.texi          |  7 +++++--
 libguile/filesys.c          | 39 ++++++++++++++++++++++++++++++++++--
 libguile/filesys.h          |  2 +-
 test-suite/tests/ports.test | 40 +++++++++++++++++++++++++++++++++++++
 5 files changed, 88 insertions(+), 5 deletions(-)

diff --git a/NEWS b/NEWS
index 694449202..765f3d2a3 100644
--- a/NEWS
+++ b/NEWS
@@ -16,6 +16,11 @@ O(1) dispatch time, regardless of the length of the chain.  This
 optimization is also unlocked in many cases for `match' expressions with
 many similar clauses whose first differentiator are constants.
 
+** Additional optional argument in `mkdir' to create the directory recursively
+
+When the third argument to mkdir is true, the intermediate directories
+are created.
+
 * Incompatible changes
 
 ** `copy' read-option removed
diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index f34c5222d..db0cdeae0 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -878,12 +878,15 @@ Create a symbolic link named @var{newpath} with the value (i.e., pointing to)
 @var{oldpath}.  The return value is unspecified.
 @end deffn
 
-@deffn {Scheme Procedure} mkdir path [mode]
-@deffnx {C Function} scm_mkdir (path, mode)
+@deffn {Scheme Procedure} mkdir path [mode [recursive]]
+@deffnx {C Function} scm_mkdir (path, mode, recursive)
 Create a new directory named by @var{path}.  If @var{mode} is omitted
 then the permissions of the directory are set to @code{#o777}
 masked with the current umask (@pxref{Processes, @code{umask}}).
 Otherwise they are set to the value specified with @var{mode}.
+If @var{recursive} is true, also try to create the intermediate missing
+directories. If an error happens, the created directories are left in
+place.
 The return value is unspecified.
 @end deffn
 
diff --git a/libguile/filesys.c b/libguile/filesys.c
index 39bfd38cc..a3c26cfe0 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -82,6 +82,7 @@
 #include "async.h"
 #include "boolean.h"
 #include "dynwind.h"
+#include "eq.h"
 #include "fdes-finalizers.h"
 #include "feature.h"
 #include "fports.h"
@@ -1271,12 +1272,15 @@ SCM_DEFINE (scm_getcwd, "getcwd", 0, 0, 0,
 #undef FUNC_NAME
 #endif /* HAVE_GETCWD */
 
-SCM_DEFINE (scm_mkdir, "mkdir", 1, 1, 0,
-            (SCM path, SCM mode),
+SCM_DEFINE (scm_mkdir, "mkdir", 1, 2, 0,
+            (SCM path, SCM mode, SCM recursive),
 	    "Create a new directory named by @var{path}.  If @var{mode} is omitted\n"
 	    "then the permissions of the directory are set to @code{#o777}\n"
 	    "masked with the current umask (@pxref{Processes, @code{umask}}).\n"
 	    "Otherwise they are set to the value specified with @var{mode}.\n"
+            "If @var{recursive} is true, also try tocreate the intermediate missing\n"
+            "directories. If an error happens, the created directories are left\n"
+            "in place.\n"
 	    "The return value is unspecified.")
 #define FUNC_NAME s_scm_mkdir
 {
@@ -1285,6 +1289,37 @@ SCM_DEFINE (scm_mkdir, "mkdir", 1, 1, 0,
 
   c_mode = SCM_UNBNDP (mode) ? 0777 : scm_to_uint (mode);
 
+  if (scm_is_true (recursive))
+    {
+      /* Record in paths all intermediate directory names up to the
+         root. The root is reached when the dirname of the current
+         directory is equal to the directory. */
+      SCM paths = SCM_EOL;
+      SCM current_name = path;
+      SCM parent_name = scm_dirname (current_name);
+      while (!scm_is_true (scm_equal_p (parent_name, current_name)))
+        {
+          paths = scm_cons (parent_name, paths);
+          current_name = parent_name;
+          parent_name = scm_dirname (current_name);
+        }
+      if (scm_is_true (scm_equal_p (current_name, scm_from_utf8_string ("."))))
+        {
+          /* If the root is '.', then also make the current working
+             directory the same way. */
+          scm_mkdir (scm_getcwd (), mode, recursive);
+        }
+      while (!scm_is_null (paths))
+        {
+          SCM dir = scm_car (paths);
+          /* Ignore the errors. If one mkdir fails, the final
+             STRING_SYSCALL at the end of this function will fail
+             too. */
+          STRING_SYSCALL (dir, c_dir, mkdir (c_dir, c_mode));
+          paths = scm_cdr (paths);
+        }
+    }
+
   STRING_SYSCALL (path, c_path, rv = mkdir (c_path, c_mode));
   if (rv != 0)
     SCM_SYSERROR;
diff --git a/libguile/filesys.h b/libguile/filesys.h
index f870ee434..011cc5d1d 100644
--- a/libguile/filesys.h
+++ b/libguile/filesys.h
@@ -49,7 +49,7 @@ SCM_API SCM scm_stat (SCM object, SCM exception_on_error);
 SCM_API SCM scm_link (SCM oldpath, SCM newpath);
 SCM_API SCM scm_rename (SCM oldname, SCM newname);
 SCM_API SCM scm_delete_file (SCM str);
-SCM_API SCM scm_mkdir (SCM path, SCM mode);
+SCM_API SCM scm_mkdir (SCM path, SCM mode, SCM recursive);
 SCM_API SCM scm_rmdir (SCM path);
 SCM_API SCM scm_directory_stream_p (SCM obj);
 SCM_API SCM scm_opendir (SCM dirname);
diff --git a/test-suite/tests/ports.test b/test-suite/tests/ports.test
index 31fb2b0a8..c2b8b0596 100644
--- a/test-suite/tests/ports.test
+++ b/test-suite/tests/ports.test
@@ -2020,6 +2020,46 @@
           (not (string-index (%search-load-path (basename (test-file)))
                              #\\))))))
 
+(with-test-prefix "recursive mkdir"
+
+  (pass-if "Relative recursive mkdir creates the chain of directories"
+    (let ((dir "./nested/relative/subdirectory"))
+      (mkdir dir #o777 dir #t)
+      (let ((ok
+             (catch #t
+               (lambda ()
+                 (with-output-to-file "./nested/relative/subdirectory/file"
+                   (lambda ()
+                     (display "The directories have been created!")
+                     #t)))
+               (lambda (error . args)
+                 #f))))
+        (when ok
+          (delete-file "./nested/relative/subdirectory/file")
+          (rmdir "./nested/relative/subdirectory")
+          (rmdir "./nested/relative")
+          (rmdir "./nested"))
+        ok)))
+
+  (pass-if "Absolute recursive mkdir creates the chain of directories"
+    (let ((dir (string-append %temporary-directory "/nested/absolute/subdirectory")))
+      (mkdir dir #o777 dir #t)
+      (let ((ok
+             (catch #t
+               (lambda ()
+                 (with-output-to-file (string-append dir "/file")
+                   (lambda ()
+                     (display "The directories have been created!")
+                     #t)))
+               (lambda (error . args)
+                 #f))))
+        (when ok
+          (delete-file (string-append dir "/file"))
+          (rmdir (string-append %temporary-directory "/nested/absolute/subdirectory"))
+          (rmdir (string-append %temporary-directory "/nested/absolute"))
+          (rmdir (string-append %temporary-directory "/nested")))
+        ok))))
+
 (delete-file (test-file))
 
 ;;; Local Variables:
-- 
2.28.0


^ permalink raw reply related	[flat|nested] 13+ messages in thread

* bug#44186: Recursive mkdir
  2020-10-23 22:00   ` bug#44186: Recursive mkdir divoplade
@ 2020-10-23 22:07     ` zimoun
  2020-10-23 23:32       ` Bengt Richter
       [not found]     ` <handler.44186.B.16034904223692.ack@debbugs.gnu.org>
  2020-10-26 21:05     ` Leo Prikler
  2 siblings, 1 reply; 13+ messages in thread
From: zimoun @ 2020-10-23 22:07 UTC (permalink / raw)
  To: divoplade; +Cc: 44186

Dear,

On Sat, 24 Oct 2020 at 00:00, divoplade <d@divoplade.fr> wrote:

> I have slightly modified the mkdir function so that it takes a third
> argument to try to create the intermediate directories when calling
> mkdir, in effect acting as "mkdir -p".
>
> However, I could not make the test suite run the ports test, on which I
> added the test for the new behavior. Is it expected? How do I run it?
>
> In the mean time, here is the WIP version of the patch.

[...]

> > Otherwise, why is it not possible to send a patch to Guile?

The discussion started here:

     <http://issues.guix.gnu.org/issue/44130>

All the best,
simon





^ permalink raw reply	[flat|nested] 13+ messages in thread

* bug#44186: Recursive mkdir
       [not found]     ` <handler.44186.B.16034904223692.ack@debbugs.gnu.org>
@ 2020-10-23 22:46       ` divoplade
  0 siblings, 0 replies; 13+ messages in thread
From: divoplade @ 2020-10-23 22:46 UTC (permalink / raw)
  To: 44186

[-- Attachment #1: Type: text/plain, Size: 136 bytes --]

I also added a keyword argument to the output functions so that they
can create the directory of the file if needed. What do you think?

[-- Attachment #2: 0002-Use-the-recursive-mkdir-function-in-file-output-proc.patch --]
[-- Type: text/x-patch, Size: 8257 bytes --]

From 0e6c74700d2eeb2142ff17ecdb0973806cf79b68 Mon Sep 17 00:00:00 2001
From: divoplade <d@divoplade.fr>
Date: Sat, 24 Oct 2020 00:35:01 +0200
Subject: [PATCH 2/2] Use the recursive mkdir function in file output
 procedures

2020-10-23 divoplade <d@divoplade.fr>
	* module/ice-9/ports.scm (open-output-file): add a recursive
	keyword to try to recursively create the directory of the output
	file.
	* module/ice-9/ports.scm (call-with-output-file): same.
	* module/ice-9/ports.scm (with-output-to-file): same.
	* module/ice-9/ports.scm (with-error-to-file): same.
	* doc/ref/api-io.texi: document the new keyword argument for
	opening output files.
	* NEWS: indicate that the open output function can now create
	the filename directory if it does not exist.
---
 NEWS                   |  6 +++++-
 doc/ref/api-io.texi    | 16 ++++++++++++----
 module/ice-9/ports.scm | 28 ++++++++++++++++++----------
 3 files changed, 35 insertions(+), 15 deletions(-)

diff --git a/NEWS b/NEWS
index 765f3d2a3..f302f5fdc 100644
--- a/NEWS
+++ b/NEWS
@@ -19,7 +19,11 @@ many similar clauses whose first differentiator are constants.
 ** Additional optional argument in `mkdir' to create the directory recursively
 
 When the third argument to mkdir is true, the intermediate directories
-are created.
+are created. This behavior is included in open-output-file,
+call-with-output-file, with-output-to-file and with-error-to-file by
+adding a keyword argument
+#:recursive which, when set to #t, creates the directories before trying
+to open the file.
 
 * Incompatible changes
 
diff --git a/doc/ref/api-io.texi b/doc/ref/api-io.texi
index ecbd35585..7409e6699 100644
--- a/doc/ref/api-io.texi
+++ b/doc/ref/api-io.texi
@@ -1036,13 +1036,15 @@ for @code{open-file}.  Equivalent to
 
 @rnindex open-output-file
 @deffn {Scheme Procedure} open-output-file filename @
-       [#:encoding=#f] [#:binary=#f]
+       [#:encoding=#f] [#:binary=#f] [#:recursive=#f]
 
 Open @var{filename} for output.  If @var{binary} is true, open the port
 in binary mode, otherwise use text mode.  @var{encoding} specifies the
 character encoding as described above for @code{open-file}.  Equivalent
 to
 @lisp
+(when recursive
+  (mkdir (dirname @var{filename}) #o777 #t))
 (open-file @var{filename}
            (if @var{binary} "wb" "w")
            #:encoding @var{encoding})
@@ -1052,7 +1054,7 @@ to
 @deffn {Scheme Procedure} call-with-input-file filename proc @
         [#:guess-encoding=#f] [#:encoding=#f] [#:binary=#f]
 @deffnx {Scheme Procedure} call-with-output-file filename proc @
-        [#:encoding=#f] [#:binary=#f]
+        [#:encoding=#f] [#:binary=#f] [#:recursive=#f]
 @rnindex call-with-input-file
 @rnindex call-with-output-file
 Open @var{filename} for input or output, and call @code{(@var{proc}
@@ -1065,14 +1067,17 @@ When @var{proc} returns, the port is closed.  If @var{proc} does not
 return (e.g.@: if it throws an error), then the port might not be
 closed automatically, though it will be garbage collected in the usual
 way if not otherwise referenced.
+
+If @var{recursive} is true, create @var{filename}'s directory and all
+its parents.
 @end deffn
 
 @deffn {Scheme Procedure} with-input-from-file filename thunk @
         [#:guess-encoding=#f] [#:encoding=#f] [#:binary=#f]
 @deffnx {Scheme Procedure} with-output-to-file filename thunk @
-        [#:encoding=#f] [#:binary=#f]
+        [#:encoding=#f] [#:binary=#f] [#:recursive=#f]
 @deffnx {Scheme Procedure} with-error-to-file filename thunk @
-        [#:encoding=#f] [#:binary=#f]
+        [#:encoding=#f] [#:binary=#f] [#:recursive=#f]
 @rnindex with-input-from-file
 @rnindex with-output-to-file
 Open @var{filename} and call @code{(@var{thunk})} with the new port
@@ -1095,6 +1100,9 @@ exited via an exception or new continuation.  This ensures it's still
 ready for use if @var{thunk} is re-entered by a captured continuation.
 Of course the port is always garbage collected and closed in the usual
 way when no longer referenced anywhere.
+
+If @var{recursive} is true, then @var{filename}'s directory and all its
+parents are created.
 @end deffn
 
 @deffn {Scheme Procedure} port-mode port
diff --git a/module/ice-9/ports.scm b/module/ice-9/ports.scm
index dbc7ef7a7..08ba0cff9 100644
--- a/module/ice-9/ports.scm
+++ b/module/ice-9/ports.scm
@@ -413,11 +413,15 @@ cannot be opened, an error is signalled."
              #:encoding encoding
              #:guess-encoding guess-encoding))
 
-(define* (open-output-file file #:key (binary #f) (encoding #f))
+(define* (open-output-file file #:key (binary #f) (encoding #f) (recursive #f))
   "Takes a string naming an output file to be created and returns an
 output port capable of writing characters to a new file by that
 name.  If the file cannot be opened, an error is signalled.  If a
-file with the given name already exists, the effect is unspecified."
+file with the given name already exists, the effect is unspecified.
+If @var{recursive} is true, recursively create the directory of
+@var{file}."
+  (when recursive
+    (mkdir (dirname file) #o777 #t))
   (open-file file (if binary "wb" "w")
              #:encoding encoding))
 
@@ -447,7 +451,7 @@ never again be used for a read or write operation."
         (close-input-port p)
         (apply values vals)))))
 
-(define* (call-with-output-file file proc #:key (binary #f) (encoding #f))
+(define* (call-with-output-file file proc #:key (binary #f) (encoding #f) (recursive #f))
   "PROC should be a procedure of one argument, and FILE should be a
 string naming a file.  The behaviour is unspecified if the file
 already exists. These procedures call PROC
@@ -457,8 +461,9 @@ signalled.  If the procedure returns, then the port is closed
 automatically and the values yielded by the procedure are returned.
 If the procedure does not return, then the port will not be closed
 automatically unless it is possible to prove that the port will
-never again be used for a read or write operation."
-  (let ((p (open-output-file file #:binary binary #:encoding encoding)))
+never again be used for a read or write operation. When RECURSIVE is
+true, create FILE's directory and all its parents."
+  (let ((p (open-output-file file #:binary binary #:encoding encoding #:recursive recursive)))
     (call-with-values
       (lambda () (proc p))
       (lambda vals
@@ -494,7 +499,7 @@ procedures, their behavior is implementation dependent."
    #:encoding encoding
    #:guess-encoding guess-encoding))
 
-(define* (with-output-to-file file thunk #:key (binary #f) (encoding #f))
+(define* (with-output-to-file file thunk #:key (binary #f) (encoding #f) (recursive #f))
   "THUNK must be a procedure of no arguments, and FILE must be a
 string naming a file.  The effect is unspecified if the file already exists.
 The file is opened for output, an output port connected to it is made
@@ -503,13 +508,15 @@ and the THUNK is called with no arguments.
 When the THUNK returns, the port is closed and the previous
 default is restored.  Returns the values yielded by THUNK.  If an
 escape procedure is used to escape from the continuation of these
-procedures, their behavior is implementation dependent."
+procedures, their behavior is implementation dependent. When RECURSIVE
+is true, the directory of FILE and all its parents are created."
   (call-with-output-file file
    (lambda (p) (with-output-to-port p thunk))
    #:binary binary
-   #:encoding encoding))
+   #:encoding encoding
+   #:recursive recursive))
 
-(define* (with-error-to-file file thunk #:key (binary #f) (encoding #f))
+(define* (with-error-to-file file thunk #:key (binary #f) (encoding #f) (recursive #f))
   "THUNK must be a procedure of no arguments, and FILE must be a
 string naming a file.  The effect is unspecified if the file already exists.
 The file is opened for output, an output port connected to it is made
@@ -522,7 +529,8 @@ procedures, their behavior is implementation dependent."
   (call-with-output-file file
    (lambda (p) (with-error-to-port p thunk))
    #:binary binary
-   #:encoding encoding))
+   #:encoding encoding
+   #:recursive recursive))
 
 (define (call-with-input-string string proc)
   "Calls the one-argument procedure @var{proc} with a newly created
-- 
2.28.0


[-- Attachment #3: 0001-mkdir-Add-an-optional-argument-recursive-to-create-t.patch --]
[-- Type: text/x-patch, Size: 7689 bytes --]

From 6b6920e05b2afefc3729bd60760c26d2476f5c82 Mon Sep 17 00:00:00 2001
From: divoplade <d@divoplade.fr>
Date: Fri, 23 Oct 2020 22:44:36 +0200
Subject: [PATCH 1/2] mkdir: Add an optional argument, recursive, to create the
 intermediates

2020-10-23 divoplade <d@divoplade.fr>
	* libguile/filesys.c: include eq.h, so we can compare strings.
	* libguile/filesys.c (scm_mkdir): add an optional argument,
	recursive, to create the intermediate directories if they do not
	exist.
	* libguile/filesys.h (scm_mkdir): add the optional argument to
	the prototype.
	* doc/ref/posix.texi (mkdir): document the new optional
	argument.
	* NEWS: say there is a new argument.
	* test-suite/tests/ports.test: add a test suite to check
	recursive mkdir.
---
 NEWS                        |  5 +++++
 doc/ref/posix.texi          |  7 +++++--
 libguile/filesys.c          | 39 ++++++++++++++++++++++++++++++++++--
 libguile/filesys.h          |  2 +-
 test-suite/tests/ports.test | 40 +++++++++++++++++++++++++++++++++++++
 5 files changed, 88 insertions(+), 5 deletions(-)

diff --git a/NEWS b/NEWS
index 694449202..765f3d2a3 100644
--- a/NEWS
+++ b/NEWS
@@ -16,6 +16,11 @@ O(1) dispatch time, regardless of the length of the chain.  This
 optimization is also unlocked in many cases for `match' expressions with
 many similar clauses whose first differentiator are constants.
 
+** Additional optional argument in `mkdir' to create the directory recursively
+
+When the third argument to mkdir is true, the intermediate directories
+are created.
+
 * Incompatible changes
 
 ** `copy' read-option removed
diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index f34c5222d..db0cdeae0 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -878,12 +878,15 @@ Create a symbolic link named @var{newpath} with the value (i.e., pointing to)
 @var{oldpath}.  The return value is unspecified.
 @end deffn
 
-@deffn {Scheme Procedure} mkdir path [mode]
-@deffnx {C Function} scm_mkdir (path, mode)
+@deffn {Scheme Procedure} mkdir path [mode [recursive]]
+@deffnx {C Function} scm_mkdir (path, mode, recursive)
 Create a new directory named by @var{path}.  If @var{mode} is omitted
 then the permissions of the directory are set to @code{#o777}
 masked with the current umask (@pxref{Processes, @code{umask}}).
 Otherwise they are set to the value specified with @var{mode}.
+If @var{recursive} is true, also try to create the intermediate missing
+directories. If an error happens, the created directories are left in
+place.
 The return value is unspecified.
 @end deffn
 
diff --git a/libguile/filesys.c b/libguile/filesys.c
index 39bfd38cc..a3c26cfe0 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -82,6 +82,7 @@
 #include "async.h"
 #include "boolean.h"
 #include "dynwind.h"
+#include "eq.h"
 #include "fdes-finalizers.h"
 #include "feature.h"
 #include "fports.h"
@@ -1271,12 +1272,15 @@ SCM_DEFINE (scm_getcwd, "getcwd", 0, 0, 0,
 #undef FUNC_NAME
 #endif /* HAVE_GETCWD */
 
-SCM_DEFINE (scm_mkdir, "mkdir", 1, 1, 0,
-            (SCM path, SCM mode),
+SCM_DEFINE (scm_mkdir, "mkdir", 1, 2, 0,
+            (SCM path, SCM mode, SCM recursive),
 	    "Create a new directory named by @var{path}.  If @var{mode} is omitted\n"
 	    "then the permissions of the directory are set to @code{#o777}\n"
 	    "masked with the current umask (@pxref{Processes, @code{umask}}).\n"
 	    "Otherwise they are set to the value specified with @var{mode}.\n"
+            "If @var{recursive} is true, also try tocreate the intermediate missing\n"
+            "directories. If an error happens, the created directories are left\n"
+            "in place.\n"
 	    "The return value is unspecified.")
 #define FUNC_NAME s_scm_mkdir
 {
@@ -1285,6 +1289,37 @@ SCM_DEFINE (scm_mkdir, "mkdir", 1, 1, 0,
 
   c_mode = SCM_UNBNDP (mode) ? 0777 : scm_to_uint (mode);
 
+  if (scm_is_true (recursive))
+    {
+      /* Record in paths all intermediate directory names up to the
+         root. The root is reached when the dirname of the current
+         directory is equal to the directory. */
+      SCM paths = SCM_EOL;
+      SCM current_name = path;
+      SCM parent_name = scm_dirname (current_name);
+      while (!scm_is_true (scm_equal_p (parent_name, current_name)))
+        {
+          paths = scm_cons (parent_name, paths);
+          current_name = parent_name;
+          parent_name = scm_dirname (current_name);
+        }
+      if (scm_is_true (scm_equal_p (current_name, scm_from_utf8_string ("."))))
+        {
+          /* If the root is '.', then also make the current working
+             directory the same way. */
+          scm_mkdir (scm_getcwd (), mode, recursive);
+        }
+      while (!scm_is_null (paths))
+        {
+          SCM dir = scm_car (paths);
+          /* Ignore the errors. If one mkdir fails, the final
+             STRING_SYSCALL at the end of this function will fail
+             too. */
+          STRING_SYSCALL (dir, c_dir, mkdir (c_dir, c_mode));
+          paths = scm_cdr (paths);
+        }
+    }
+
   STRING_SYSCALL (path, c_path, rv = mkdir (c_path, c_mode));
   if (rv != 0)
     SCM_SYSERROR;
diff --git a/libguile/filesys.h b/libguile/filesys.h
index f870ee434..011cc5d1d 100644
--- a/libguile/filesys.h
+++ b/libguile/filesys.h
@@ -49,7 +49,7 @@ SCM_API SCM scm_stat (SCM object, SCM exception_on_error);
 SCM_API SCM scm_link (SCM oldpath, SCM newpath);
 SCM_API SCM scm_rename (SCM oldname, SCM newname);
 SCM_API SCM scm_delete_file (SCM str);
-SCM_API SCM scm_mkdir (SCM path, SCM mode);
+SCM_API SCM scm_mkdir (SCM path, SCM mode, SCM recursive);
 SCM_API SCM scm_rmdir (SCM path);
 SCM_API SCM scm_directory_stream_p (SCM obj);
 SCM_API SCM scm_opendir (SCM dirname);
diff --git a/test-suite/tests/ports.test b/test-suite/tests/ports.test
index 31fb2b0a8..4a247240e 100644
--- a/test-suite/tests/ports.test
+++ b/test-suite/tests/ports.test
@@ -2022,6 +2022,46 @@
 
 (delete-file (test-file))
 
+(with-test-prefix "recursive mkdir"
+
+  (pass-if "Relative recursive mkdir creates the chain of directories"
+    (let ((dir "./nested/relative/subdirectory"))
+      (mkdir dir #o777 #t)
+      (let ((ok
+             (catch #t
+               (lambda ()
+                 (with-output-to-file "./nested/relative/subdirectory/file"
+                   (lambda ()
+                     (display "The directories have been created!")
+                     #t)))
+               (lambda (error . args)
+                 #f))))
+        (when ok
+          (delete-file "./nested/relative/subdirectory/file")
+          (rmdir "./nested/relative/subdirectory")
+          (rmdir "./nested/relative")
+          (rmdir "./nested"))
+        ok)))
+
+  (pass-if "Absolute recursive mkdir creates the chain of directories"
+    (let ((dir (string-append %temporary-directory "/nested/absolute/subdirectory")))
+      (mkdir dir #o777 #t)
+      (let ((ok
+             (catch #t
+               (lambda ()
+                 (with-output-to-file (string-append dir "/file")
+                   (lambda ()
+                     (display "The directories have been created!")
+                     #t)))
+               (lambda (error . args)
+                 #f))))
+        (when ok
+          (delete-file (string-append dir "/file"))
+          (rmdir (string-append %temporary-directory "/nested/absolute/subdirectory"))
+          (rmdir (string-append %temporary-directory "/nested/absolute"))
+          (rmdir (string-append %temporary-directory "/nested")))
+        ok))))
+
 ;;; Local Variables:
 ;;; eval: (put 'test-decoding-error 'scheme-indent-function 3)
 ;;; eval: (put 'with-load-path 'scheme-indent-function 1)
-- 
2.28.0


^ permalink raw reply related	[flat|nested] 13+ messages in thread

* bug#44186: Recursive mkdir
  2020-10-23 22:07     ` zimoun
@ 2020-10-23 23:32       ` Bengt Richter
  2020-10-24  6:17         ` divoplade
  0 siblings, 1 reply; 13+ messages in thread
From: Bengt Richter @ 2020-10-23 23:32 UTC (permalink / raw)
  To: zimoun; +Cc: 44186, divoplade

Hi,

On +2020-10-24 00:07:19 +0200, zimoun wrote:
> Dear,
> 
> On Sat, 24 Oct 2020 at 00:00, divoplade <d@divoplade.fr> wrote:
> 
> > I have slightly modified the mkdir function so that it takes a third
> > argument to try to create the intermediate directories when calling
> > mkdir, in effect acting as "mkdir -p".
> >
> > However, I could not make the test suite run the ports test, on which I
> > added the test for the new behavior. Is it expected? How do I run it?
> >
> > In the mean time, here is the WIP version of the patch.
> 
> [...]
> 
> > > Otherwise, why is it not possible to send a patch to Guile?
> 
> The discussion started here:
> 
>      <http://issues.guix.gnu.org/issue/44130>
> 
> All the best,
> simon
> 
> 
> 
An alternate solution could be programmed using ffi, as documented in [1], n'est-ce pas?
What would guix best-practice guidance say about that?

[1] info guile ffi
-- 
Regards,
Bengt Richter





^ permalink raw reply	[flat|nested] 13+ messages in thread

* bug#44186: Recursive mkdir
  2020-10-23 23:32       ` Bengt Richter
@ 2020-10-24  6:17         ` divoplade
  2020-10-25  4:13           ` Bengt Richter
  0 siblings, 1 reply; 13+ messages in thread
From: divoplade @ 2020-10-24  6:17 UTC (permalink / raw)
  To: Bengt Richter, zimoun; +Cc: 44186

Hello,

Le samedi 24 octobre 2020 à 01:32 +0200, Bengt Richter a écrit :
> An alternate solution could be programmed using ffi, as documented in
> [1], n'est-ce pas?
To be clear, you would rather have that function as guile code rather
than extending the C function? I'm OK with that, but in which file
should I put that function? My instinct was to put the code near the
mkdir function, and that happened to be in a C file, so I went C.

> What would guix best-practice guidance say about that?
I'm not sure to follow, now this is a guile matter, guix has nothing to
do about it. I'm sorry I messed a few things up with the mailing lists
(I should have listened to them, "don't cross the streams"). Could you
elaborate?

Best regards,

divoplade






^ permalink raw reply	[flat|nested] 13+ messages in thread

* bug#44186: Recursive mkdir
  2020-10-24  6:17         ` divoplade
@ 2020-10-25  4:13           ` Bengt Richter
  2020-10-25  7:45             ` Ricardo Wurmus
  0 siblings, 1 reply; 13+ messages in thread
From: Bengt Richter @ 2020-10-25  4:13 UTC (permalink / raw)
  To: divoplade; +Cc: 44186, zimoun

Hi divoplade,

On +2020-10-24 08:17:47 +0200, divoplade wrote:
> Hello,
> 
> Le samedi 24 octobre 2020 à 01:32 +0200, Bengt Richter a écrit :
> > An alternate solution could be programmed using ffi, as documented in
> > [1], n'est-ce pas?
> To be clear, you would rather have that function as guile code rather
> than extending the C function? I'm OK with that, but in which file
> should I put that function? My instinct was to put the code near the
> mkdir function, and that happened to be in a C file, so I went C.
>
Seems logical, and probably where I'd go, but please be careful!
Don't make a C version of this hack:
┌───────────────────────────────────────────────────────────────────────────────┐
│ (define (my-mkdir-p path . ignore) (system (string-append "mkdir -p " path))) │
└───────────────────────────────────────────────────────────────────────────────┘
You can then write (my-mkdir-p "foo-dir/bar-dir") and it'll do the job.

But it's definitely safer to skip the hack and write
┌─────────────────────────────────────┐
│ (system "mkdir -p foo-dir/bar-dir") │
└─────────────────────────────────────┘
and not give anything a chance to inject something bad via unsanitized parameters.
E.g.,
┌─────────────────────────────────────┐
│ (my-mkdir-p "here/below;tree here") │
│ here                                │
│ └── below                           │
└─────────────────────────────────────┘
It does the intended, so no suspicous change in that part, and 
my-mkdir-p looks innocent enough. (Did you notice the danger? ;)

Well, introducing something like this, but more subtle,
could be the first move by a mole  working for
<insert favorite bogeyman organization>
to compromise or disrupt/discredit GNU FLOSS competition.

Is that unhappy thought too paranoid?
I hope so, but I'm not convinced  ;/

> > What would guix best-practice guidance say about that?
> I'm not sure to follow, now this is a guile matter, guix has nothing to
> do about it. I'm sorry I messed a few things up with the mailing lists
> (I should have listened to them, "don't cross the streams"). Could you
> elaborate?
>
Sorry, you are right: it does become a guile matter, but...

... it also becomes part of guix if it's part of the guile version
a guix version depends on, so thereby it becomes a guix quality/security item
to be careful about.

So I was wondering whether guix architects have preferences
for where and how a function should be implemented, all things considered.

> Best regards,
> 
> divoplade
> 
-- 
Regards,
Bengt Richter





^ permalink raw reply	[flat|nested] 13+ messages in thread

* bug#44186: Recursive mkdir
  2020-10-25  4:13           ` Bengt Richter
@ 2020-10-25  7:45             ` Ricardo Wurmus
  2020-10-25  9:07               ` divoplade
  0 siblings, 1 reply; 13+ messages in thread
From: Ricardo Wurmus @ 2020-10-25  7:45 UTC (permalink / raw)
  To: Bengt Richter; +Cc: 44186, d, zimon.toutoune


Bengt Richter <bokr@bokr.com> writes:

> Hi divoplade,
>
> On +2020-10-24 08:17:47 +0200, divoplade wrote:
>> Hello,
>> 
>> Le samedi 24 octobre 2020 à 01:32 +0200, Bengt Richter a écrit :
>> > An alternate solution could be programmed using ffi, as documented in
>> > [1], n'est-ce pas?
>> To be clear, you would rather have that function as guile code rather
>> than extending the C function? I'm OK with that, but in which file
>> should I put that function? My instinct was to put the code near the
>> mkdir function, and that happened to be in a C file, so I went C.

We should all be writing fewer lines of C code and more Scheme :)

> Seems logical, and probably where I'd go, but please be careful!
> Don't make a C version of this hack:
> ┌───────────────────────────────────────────────────────────────────────────────┐
> │ (define (my-mkdir-p path . ignore) (system (string-append "mkdir -p " path))) │
> └───────────────────────────────────────────────────────────────────────────────┘
> You can then write (my-mkdir-p "foo-dir/bar-dir") and it'll do the job.
>
> But it's definitely safer to skip the hack and write
> ┌─────────────────────────────────────┐
> │ (system "mkdir -p foo-dir/bar-dir") │
> └─────────────────────────────────────┘
> and not give anything a chance to inject something bad via unsanitized
> parameters.

Use “system*” instead of “system” when you need to work with
user-provided values.  For mkdir-p, however, using any variant of
“system” is inelegant.

-- 
Ricardo

^ permalink raw reply	[flat|nested] 13+ messages in thread

* bug#44186: Recursive mkdir
  2020-10-25  7:45             ` Ricardo Wurmus
@ 2020-10-25  9:07               ` divoplade
  2020-10-25 10:44                 ` divoplade
  0 siblings, 1 reply; 13+ messages in thread
From: divoplade @ 2020-10-25  9:07 UTC (permalink / raw)
  To: Ricardo Wurmus, Bengt Richter; +Cc: 44186, zimoun

[-- Attachment #1: Type: text/plain, Size: 883 bytes --]

Hello!

Le dimanche 25 octobre 2020 à 08:45 +0100, Ricardo Wurmus a écrit :
> > > To be clear, you would rather have that function as guile code
> > > rather
> > > than extending the C function? I'm OK with that, but in which
> > > file
> > > should I put that function? My instinct was to put the code near
> > > the
> > > mkdir function, and that happened to be in a C file, so I went C.
> 
> We should all be writing fewer lines of C code and more Scheme :)

OK, but where do I put the function? There is a posix.scm, but this
function is not posix, and posix.scm does not seem to export functions.

By default I will put it in ports.scm, because it is useful for open-
output-directory.

Also, I still cannot run the ports tests! How do I do it? Also test-
out-of-memory fails, but it also fails on master.

Attached, the new version for you to read!

Best regards,

divoplade

[-- Attachment #2: 0002-Use-the-recursive-mkdir-function-in-file-output-proc.patch --]
[-- Type: text/x-patch, Size: 10251 bytes --]

From 29c98e8371a32b11c0c13f8fa91628aeedc117bf Mon Sep 17 00:00:00 2001
From: divoplade <d@divoplade.fr>
Date: Sat, 24 Oct 2020 00:35:01 +0200
Subject: [PATCH 2/2] Use the recursive mkdir function in file output
 procedures

2020-10-25 divoplade <d@divoplade.fr>
	* module/ice-9/ports.scm (open-output-file): add a mkdir keyword
	to try to recursively create the directory of the output file.
	* module/ice-9/ports.scm (call-with-output-file): same.
	* module/ice-9/ports.scm (with-output-to-file): same.
	* module/ice-9/ports.scm (with-error-to-file): same.
	* doc/ref/api-io.texi: document the new keyword argument for
	opening output files.
	* NEWS: indicate that the open output function can now create
	the filename directory if it does not exist.
---
 NEWS                   |  6 +++-
 doc/ref/api-io.texi    | 16 ++++++---
 module/ice-9/ports.scm | 75 ++++++++++++++++++++++--------------------
 3 files changed, 57 insertions(+), 40 deletions(-)

diff --git a/NEWS b/NEWS
index 94a3f3154..09e06a7ba 100644
--- a/NEWS
+++ b/NEWS
@@ -19,7 +19,11 @@ many similar clauses whose first differentiator are constants.
 ** New function mkdir-recursive
 
 This function will try and create the directory and parent directories,
-up to a directory that can be opened or the root.
+up to a directory that can be opened or the root. This behavior is
+included in open-output-file, call-with-output-file, with-output-to-file
+and with-error-to-file by adding a keyword argument `#:mkdir' which,
+when set to `#t', creates the directories before trying to open the
+file.
 
 * Incompatible changes
 
diff --git a/doc/ref/api-io.texi b/doc/ref/api-io.texi
index ecbd35585..dabceb646 100644
--- a/doc/ref/api-io.texi
+++ b/doc/ref/api-io.texi
@@ -1036,13 +1036,15 @@ for @code{open-file}.  Equivalent to
 
 @rnindex open-output-file
 @deffn {Scheme Procedure} open-output-file filename @
-       [#:encoding=#f] [#:binary=#f]
+       [#:encoding=#f] [#:binary=#f] [#:mkdir=#f]
 
 Open @var{filename} for output.  If @var{binary} is true, open the port
 in binary mode, otherwise use text mode.  @var{encoding} specifies the
 character encoding as described above for @code{open-file}.  Equivalent
 to
 @lisp
+(when @var{mkdir}
+  (mkdir-recursive (dirname @var{filename})))
 (open-file @var{filename}
            (if @var{binary} "wb" "w")
            #:encoding @var{encoding})
@@ -1052,7 +1054,7 @@ to
 @deffn {Scheme Procedure} call-with-input-file filename proc @
         [#:guess-encoding=#f] [#:encoding=#f] [#:binary=#f]
 @deffnx {Scheme Procedure} call-with-output-file filename proc @
-        [#:encoding=#f] [#:binary=#f]
+        [#:encoding=#f] [#:binary=#f] [#:mkdir=#f]
 @rnindex call-with-input-file
 @rnindex call-with-output-file
 Open @var{filename} for input or output, and call @code{(@var{proc}
@@ -1065,14 +1067,17 @@ When @var{proc} returns, the port is closed.  If @var{proc} does not
 return (e.g.@: if it throws an error), then the port might not be
 closed automatically, though it will be garbage collected in the usual
 way if not otherwise referenced.
+
+If @var{mkdir} is true, create @var{filename}'s directory and all
+its parents.
 @end deffn
 
 @deffn {Scheme Procedure} with-input-from-file filename thunk @
         [#:guess-encoding=#f] [#:encoding=#f] [#:binary=#f]
 @deffnx {Scheme Procedure} with-output-to-file filename thunk @
-        [#:encoding=#f] [#:binary=#f]
+        [#:encoding=#f] [#:binary=#f] [#:mkdir=#f]
 @deffnx {Scheme Procedure} with-error-to-file filename thunk @
-        [#:encoding=#f] [#:binary=#f]
+        [#:encoding=#f] [#:binary=#f] [#:mkdir=#f]
 @rnindex with-input-from-file
 @rnindex with-output-to-file
 Open @var{filename} and call @code{(@var{thunk})} with the new port
@@ -1095,6 +1100,9 @@ exited via an exception or new continuation.  This ensures it's still
 ready for use if @var{thunk} is re-entered by a captured continuation.
 Of course the port is always garbage collected and closed in the usual
 way when no longer referenced anywhere.
+
+If @var{mkdir} is true, then @var{filename}'s directory and all its
+parents are created.
 @end deffn
 
 @deffn {Scheme Procedure} port-mode port
diff --git a/module/ice-9/ports.scm b/module/ice-9/ports.scm
index 3ed289e43..579c503f6 100644
--- a/module/ice-9/ports.scm
+++ b/module/ice-9/ports.scm
@@ -446,11 +446,14 @@ opened) and that will need to be created."
       (make-dirs (cdr dirs))))
   (make-dirs (trace-dirs '() name)))
 
-(define* (open-output-file file #:key (binary #f) (encoding #f))
+(define* (open-output-file file #:key (binary #f) (encoding #f) (mkdir #f))
   "Takes a string naming an output file to be created and returns an
-output port capable of writing characters to a new file by that
-name.  If the file cannot be opened, an error is signalled.  If a
-file with the given name already exists, the effect is unspecified."
+output port capable of writing characters to a new file by that name.
+If the file cannot be opened, an error is signalled.  If a file with the
+given name already exists, the effect is unspecified.  If @var{mkdir} is
+true, recursively create the directory of @var{file}."
+  (when mkdir
+    (mkdir-p (dirname file)))
   (open-file file (if binary "wb" "w")
              #:encoding encoding))
 
@@ -480,18 +483,18 @@ never again be used for a read or write operation."
         (close-input-port p)
         (apply values vals)))))
 
-(define* (call-with-output-file file proc #:key (binary #f) (encoding #f))
+(define* (call-with-output-file file proc #:key (binary #f) (encoding #f) (mkdir #f))
   "PROC should be a procedure of one argument, and FILE should be a
-string naming a file.  The behaviour is unspecified if the file
-already exists. These procedures call PROC
-with one argument: the port obtained by opening the named file for
-input or output.  If the file cannot be opened, an error is
-signalled.  If the procedure returns, then the port is closed
-automatically and the values yielded by the procedure are returned.
-If the procedure does not return, then the port will not be closed
-automatically unless it is possible to prove that the port will
-never again be used for a read or write operation."
-  (let ((p (open-output-file file #:binary binary #:encoding encoding)))
+string naming a file.  The behaviour is unspecified if the file already
+exists. These procedures call PROC with one argument: the port obtained
+by opening the named file for input or output.  If the file cannot be
+opened, an error is signalled.  If the procedure returns, then the port
+is closed automatically and the values yielded by the procedure are
+returned.  If the procedure does not return, then the port will not be
+closed automatically unless it is possible to prove that the port will
+never again be used for a read or write operation. When MKDIR is true,
+create FILE's directory and all its parents."
+  (let ((p (open-output-file file #:binary binary #:encoding encoding #:mkdir mkdir)))
     (call-with-values
       (lambda () (proc p))
       (lambda vals
@@ -527,35 +530,37 @@ procedures, their behavior is implementation dependent."
    #:encoding encoding
    #:guess-encoding guess-encoding))
 
-(define* (with-output-to-file file thunk #:key (binary #f) (encoding #f))
-  "THUNK must be a procedure of no arguments, and FILE must be a
-string naming a file.  The effect is unspecified if the file already exists.
+(define* (with-output-to-file file thunk #:key (binary #f) (encoding #f) (mkdir #f))
+  "THUNK must be a procedure of no arguments, and FILE must be a string
+naming a file.  The effect is unspecified if the file already exists.
 The file is opened for output, an output port connected to it is made
-the default value returned by `current-output-port',
-and the THUNK is called with no arguments.
-When the THUNK returns, the port is closed and the previous
-default is restored.  Returns the values yielded by THUNK.  If an
-escape procedure is used to escape from the continuation of these
-procedures, their behavior is implementation dependent."
+the default value returned by `current-output-port', and the THUNK is
+called with no arguments.  When the THUNK returns, the port is closed
+and the previous default is restored.  Returns the values yielded by
+THUNK.  If an escape procedure is used to escape from the continuation
+of these procedures, their behavior is implementation dependent. When
+MKDIR is true, the directory of FILE and all its parents are created."
   (call-with-output-file file
    (lambda (p) (with-output-to-port p thunk))
    #:binary binary
-   #:encoding encoding))
+   #:encoding encoding
+   #:mkdir mkdir))
 
-(define* (with-error-to-file file thunk #:key (binary #f) (encoding #f))
-  "THUNK must be a procedure of no arguments, and FILE must be a
-string naming a file.  The effect is unspecified if the file already exists.
+(define* (with-error-to-file file thunk #:key (binary #f) (encoding #f) (mkdir #f))
+  "THUNK must be a procedure of no arguments, and FILE must be a string
+naming a file.  The effect is unspecified if the file already exists.
 The file is opened for output, an output port connected to it is made
-the default value returned by `current-error-port',
-and the THUNK is called with no arguments.
-When the THUNK returns, the port is closed and the previous
-default is restored.  Returns the values yielded by THUNK.  If an
-escape procedure is used to escape from the continuation of these
-procedures, their behavior is implementation dependent."
+the default value returned by `current-error-port', and the THUNK is
+called with no arguments.  When the THUNK returns, the port is closed
+and the previous default is restored.  Returns the values yielded by
+THUNK.  If an escape procedure is used to escape from the continuation
+of these procedures, their behavior is implementation dependent. When
+MKDIR is true, the directory of FILE and all its parents are created."
   (call-with-output-file file
    (lambda (p) (with-error-to-port p thunk))
    #:binary binary
-   #:encoding encoding))
+   #:encoding encoding
+   #:mkdir mkdir))
 
 (define (call-with-input-string string proc)
   "Calls the one-argument procedure @var{proc} with a newly created
-- 
2.28.0


[-- Attachment #3: 0001-ports-Add-mkdir-recursive.patch --]
[-- Type: text/x-patch, Size: 6509 bytes --]

From c7884be2c81f9739bec334fbc263384584a93096 Mon Sep 17 00:00:00 2001
From: divoplade <d@divoplade.fr>
Date: Fri, 23 Oct 2020 22:44:36 +0200
Subject: [PATCH 1/2] ports: Add mkdir-recursive

2020-10-25 divoplade <d@divoplade.fr>
	* module/ice-9/ports.scm: add a function, mkdir-recursive, to
	create the chain of directories.
	* doc/ref/posix.texi: document the new function mkdir-recursive.
	* NEWS: mention the new function.
	* test-suite/tests/ports.test: add a test suite to check
	recursive mkdir.
---
 NEWS                        |  5 +++++
 doc/ref/posix.texi          | 15 ++++++++++----
 module/ice-9/ports.scm      | 33 ++++++++++++++++++++++++++++++
 test-suite/tests/ports.test | 40 +++++++++++++++++++++++++++++++++++++
 4 files changed, 89 insertions(+), 4 deletions(-)

diff --git a/NEWS b/NEWS
index 694449202..94a3f3154 100644
--- a/NEWS
+++ b/NEWS
@@ -16,6 +16,11 @@ O(1) dispatch time, regardless of the length of the chain.  This
 optimization is also unlocked in many cases for `match' expressions with
 many similar clauses whose first differentiator are constants.
 
+** New function mkdir-recursive
+
+This function will try and create the directory and parent directories,
+up to a directory that can be opened or the root.
+
 * Incompatible changes
 
 ** `copy' read-option removed
diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index f34c5222d..cb9943977 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -881,10 +881,17 @@ Create a symbolic link named @var{newpath} with the value (i.e., pointing to)
 @deffn {Scheme Procedure} mkdir path [mode]
 @deffnx {C Function} scm_mkdir (path, mode)
 Create a new directory named by @var{path}.  If @var{mode} is omitted
-then the permissions of the directory are set to @code{#o777}
-masked with the current umask (@pxref{Processes, @code{umask}}).
-Otherwise they are set to the value specified with @var{mode}.
-The return value is unspecified.
+then the permissions of the directory are set to @code{#o777} masked
+with the current umask (@pxref{Processes, @code{umask}}).  Otherwise
+they are set to the value specified with @var{mode}.  The return value
+is unspecified.
+@end deffn
+
+@deffn {Scheme Procedure} mkdir-recursive @var{path} [mode]
+Create the directory named @var{path}, with the optional given
+@var{mode}, as for @code{mkdir}. Create all parent directories up to a
+directory that can be opened, or the root. The chain of directories is
+not cleaned in case of an error.
 @end deffn
 
 @deffn {Scheme Procedure} rmdir path
diff --git a/module/ice-9/ports.scm b/module/ice-9/ports.scm
index dbc7ef7a7..3ed289e43 100644
--- a/module/ice-9/ports.scm
+++ b/module/ice-9/ports.scm
@@ -105,6 +105,7 @@
             OPEN_READ OPEN_WRITE OPEN_BOTH
             *null-device*
             open-input-file
+            mkdir-recursive
             open-output-file
             open-io-file
             call-with-input-file
@@ -413,6 +414,38 @@ cannot be opened, an error is signalled."
              #:encoding encoding
              #:guess-encoding guess-encoding))
 
+(define (mkdir-recursive name)
+  "Create the parent directories of @var{name}, up to a directory that
+can be opened, or up to the root."
+  (define (trace-dirs job name)
+    "Record all the directories that do not exist (i.e. that cannot be
+opened) and that will need to be created."
+    (catch 'system-error
+      (lambda ()
+        (closedir (opendir name))
+        job)
+      (lambda (error . args)
+        (let ((dir (dirname name)))
+          (if (string=? dir name)
+              ;; This is either the root of the file system, or the
+              ;; current working directory. If the current directory
+              ;; does not exist, calling (getcwd) is an error, so we
+              ;; cannot know where it is in order to create
+              ;; it. Otherwise we would call (trace-dirs job
+              ;; (getcwd)). So now we assume that dir and name is the
+              ;; root, and they do not need to be created.
+              job
+              (trace-dirs (cons name job) dir))))))
+  (define (make-dirs dirs)
+    (unless (null? dirs)
+      (catch 'system-error
+        (lambda ()
+          (mkdir (car dirs)))
+        (lambda (error . args)
+          #t))
+      (make-dirs (cdr dirs))))
+  (make-dirs (trace-dirs '() name)))
+
 (define* (open-output-file file #:key (binary #f) (encoding #f))
   "Takes a string naming an output file to be created and returns an
 output port capable of writing characters to a new file by that
diff --git a/test-suite/tests/ports.test b/test-suite/tests/ports.test
index 31fb2b0a8..ab696195b 100644
--- a/test-suite/tests/ports.test
+++ b/test-suite/tests/ports.test
@@ -2022,6 +2022,46 @@
 
 (delete-file (test-file))
 
+(with-test-prefix "recursive mkdir"
+
+  (pass-if "Relative recursive mkdir creates the chain of directories"
+    (let ((dir "./nested/relative/subdirectory"))
+      (mkdir-recursive dir)
+      (let ((ok
+             (catch #t
+               (lambda ()
+                 (with-output-to-file "./nested/relative/subdirectory/file"
+                   (lambda ()
+                     (display "The directories have been created!")
+                     #t)))
+               (lambda (error . args)
+                 #f))))
+        (when ok
+          (delete-file "./nested/relative/subdirectory/file")
+          (rmdir "./nested/relative/subdirectory")
+          (rmdir "./nested/relative")
+          (rmdir "./nested"))
+        ok)))
+
+  (pass-if "Absolute recursive mkdir creates the chain of directories"
+    (let ((dir (string-append %temporary-directory "/nested/absolute/subdirectory")))
+      (mkdir-recursive dir)
+      (let ((ok
+             (catch #t
+               (lambda ()
+                 (with-output-to-file (string-append dir "/file")
+                   (lambda ()
+                     (display "The directories have been created!")
+                     #t)))
+               (lambda (error . args)
+                 #f))))
+        (when ok
+          (delete-file (string-append dir "/file"))
+          (rmdir (string-append %temporary-directory "/nested/absolute/subdirectory"))
+          (rmdir (string-append %temporary-directory "/nested/absolute"))
+          (rmdir (string-append %temporary-directory "/nested")))
+        ok))))
+
 ;;; Local Variables:
 ;;; eval: (put 'test-decoding-error 'scheme-indent-function 3)
 ;;; eval: (put 'with-load-path 'scheme-indent-function 1)
-- 
2.28.0


^ permalink raw reply related	[flat|nested] 13+ messages in thread

* bug#44186: Recursive mkdir
  2020-10-25  9:07               ` divoplade
@ 2020-10-25 10:44                 ` divoplade
  0 siblings, 0 replies; 13+ messages in thread
From: divoplade @ 2020-10-25 10:44 UTC (permalink / raw)
  To: Ricardo Wurmus, Bengt Richter; +Cc: 44186, zimoun

[-- Attachment #1: Type: text/plain, Size: 1737 bytes --]

So, after a bit of bikeshedding on #guile, it turns out that the
controversy moved to the second commit.

Here is the justification for it.

When a program user wants to save data to a file, if the place where to
save the file does not exist yet, there will be an error: "cannot
create file or directory". That's puzzling to the user, because, yes,
the user wants to create that file.  If the error is a little more
precise, it will be something in the line of "Please create directory
blah/blah/blah before invoking this program".

So, the user will wonder why the program was not able to create
blah/blah/blah itself, create it, and re-run the program. This is more
work for the user, work that could have been easily handled by the
program.

Good behaving programs should (recursively) create the directory before
trying to write to a file specified by the user. That include log files
for a daemon, for instance. Emacs org-mode babel tangling uses a
:mkdirp t for a similar reason. In order to simplify the development of
such programs, and in order to avoid bugs where the developer forgot to
call (mkdir-recursive (dirname output-file)) before (open-output-file,
call-with-output-file or with-output-to-file, while still keeping
compatibility of the other programs, I propose to add a keyword
argument to these functions. 

There are also worries that this keyword will not be of much use and
will clutter the implementation. I am willing to bet that this keyword
will be more used than, for instance, #:guess-encoding, which is
available in all the corresponding input functions.

I also simplified the mkdir-recursive function, to be closer to 
https://gitlab.com/leoprikler/guile-filesystem/-/blob/master/ice-9/filesystem.scm
.

[-- Attachment #2: 0002-Use-the-recursive-mkdir-function-in-file-output-proc.patch --]
[-- Type: text/x-patch, Size: 10231 bytes --]

From d825e09dac796ed69d083feb6a033b68b66de499 Mon Sep 17 00:00:00 2001
From: divoplade <d@divoplade.fr>
Date: Sat, 24 Oct 2020 00:35:01 +0200
Subject: [PATCH 2/2] Use the recursive mkdir function in file output
 procedures

2020-10-25 divoplade <d@divoplade.fr>
	* module/ice-9/ports.scm (open-output-file): add a mkdir keyword
	to try to recursively create the directory of the output file.
	* module/ice-9/ports.scm (call-with-output-file): same.
	* module/ice-9/ports.scm (with-output-to-file): same.
	* module/ice-9/ports.scm (with-error-to-file): same.
	* doc/ref/api-io.texi: document the new keyword argument for
	opening output files.
	* NEWS: indicate that the open output function can now create
	the filename directory if it does not exist.
---
 NEWS                   |  6 +++-
 doc/ref/api-io.texi    | 16 ++++++---
 module/ice-9/ports.scm | 75 ++++++++++++++++++++++--------------------
 3 files changed, 57 insertions(+), 40 deletions(-)

diff --git a/NEWS b/NEWS
index 94a3f3154..09e06a7ba 100644
--- a/NEWS
+++ b/NEWS
@@ -19,7 +19,11 @@ many similar clauses whose first differentiator are constants.
 ** New function mkdir-recursive
 
 This function will try and create the directory and parent directories,
-up to a directory that can be opened or the root.
+up to a directory that can be opened or the root. This behavior is
+included in open-output-file, call-with-output-file, with-output-to-file
+and with-error-to-file by adding a keyword argument `#:mkdir' which,
+when set to `#t', creates the directories before trying to open the
+file.
 
 * Incompatible changes
 
diff --git a/doc/ref/api-io.texi b/doc/ref/api-io.texi
index ecbd35585..dabceb646 100644
--- a/doc/ref/api-io.texi
+++ b/doc/ref/api-io.texi
@@ -1036,13 +1036,15 @@ for @code{open-file}.  Equivalent to
 
 @rnindex open-output-file
 @deffn {Scheme Procedure} open-output-file filename @
-       [#:encoding=#f] [#:binary=#f]
+       [#:encoding=#f] [#:binary=#f] [#:mkdir=#f]
 
 Open @var{filename} for output.  If @var{binary} is true, open the port
 in binary mode, otherwise use text mode.  @var{encoding} specifies the
 character encoding as described above for @code{open-file}.  Equivalent
 to
 @lisp
+(when @var{mkdir}
+  (mkdir-recursive (dirname @var{filename})))
 (open-file @var{filename}
            (if @var{binary} "wb" "w")
            #:encoding @var{encoding})
@@ -1052,7 +1054,7 @@ to
 @deffn {Scheme Procedure} call-with-input-file filename proc @
         [#:guess-encoding=#f] [#:encoding=#f] [#:binary=#f]
 @deffnx {Scheme Procedure} call-with-output-file filename proc @
-        [#:encoding=#f] [#:binary=#f]
+        [#:encoding=#f] [#:binary=#f] [#:mkdir=#f]
 @rnindex call-with-input-file
 @rnindex call-with-output-file
 Open @var{filename} for input or output, and call @code{(@var{proc}
@@ -1065,14 +1067,17 @@ When @var{proc} returns, the port is closed.  If @var{proc} does not
 return (e.g.@: if it throws an error), then the port might not be
 closed automatically, though it will be garbage collected in the usual
 way if not otherwise referenced.
+
+If @var{mkdir} is true, create @var{filename}'s directory and all
+its parents.
 @end deffn
 
 @deffn {Scheme Procedure} with-input-from-file filename thunk @
         [#:guess-encoding=#f] [#:encoding=#f] [#:binary=#f]
 @deffnx {Scheme Procedure} with-output-to-file filename thunk @
-        [#:encoding=#f] [#:binary=#f]
+        [#:encoding=#f] [#:binary=#f] [#:mkdir=#f]
 @deffnx {Scheme Procedure} with-error-to-file filename thunk @
-        [#:encoding=#f] [#:binary=#f]
+        [#:encoding=#f] [#:binary=#f] [#:mkdir=#f]
 @rnindex with-input-from-file
 @rnindex with-output-to-file
 Open @var{filename} and call @code{(@var{thunk})} with the new port
@@ -1095,6 +1100,9 @@ exited via an exception or new continuation.  This ensures it's still
 ready for use if @var{thunk} is re-entered by a captured continuation.
 Of course the port is always garbage collected and closed in the usual
 way when no longer referenced anywhere.
+
+If @var{mkdir} is true, then @var{filename}'s directory and all its
+parents are created.
 @end deffn
 
 @deffn {Scheme Procedure} port-mode port
diff --git a/module/ice-9/ports.scm b/module/ice-9/ports.scm
index d85e48107..78a31619e 100644
--- a/module/ice-9/ports.scm
+++ b/module/ice-9/ports.scm
@@ -425,11 +425,14 @@ directory, or up to the root."
           #t
           (mkdir-recursive (dirname name))))))
 
-(define* (open-output-file file #:key (binary #f) (encoding #f))
+(define* (open-output-file file #:key (binary #f) (encoding #f) (mkdir #f))
   "Takes a string naming an output file to be created and returns an
-output port capable of writing characters to a new file by that
-name.  If the file cannot be opened, an error is signalled.  If a
-file with the given name already exists, the effect is unspecified."
+output port capable of writing characters to a new file by that name.
+If the file cannot be opened, an error is signalled.  If a file with the
+given name already exists, the effect is unspecified.  If @var{mkdir} is
+true, recursively create the directory of @var{file}."
+  (when mkdir
+    (mkdir-p (dirname file)))
   (open-file file (if binary "wb" "w")
              #:encoding encoding))
 
@@ -459,18 +462,18 @@ never again be used for a read or write operation."
         (close-input-port p)
         (apply values vals)))))
 
-(define* (call-with-output-file file proc #:key (binary #f) (encoding #f))
+(define* (call-with-output-file file proc #:key (binary #f) (encoding #f) (mkdir #f))
   "PROC should be a procedure of one argument, and FILE should be a
-string naming a file.  The behaviour is unspecified if the file
-already exists. These procedures call PROC
-with one argument: the port obtained by opening the named file for
-input or output.  If the file cannot be opened, an error is
-signalled.  If the procedure returns, then the port is closed
-automatically and the values yielded by the procedure are returned.
-If the procedure does not return, then the port will not be closed
-automatically unless it is possible to prove that the port will
-never again be used for a read or write operation."
-  (let ((p (open-output-file file #:binary binary #:encoding encoding)))
+string naming a file.  The behaviour is unspecified if the file already
+exists. These procedures call PROC with one argument: the port obtained
+by opening the named file for input or output.  If the file cannot be
+opened, an error is signalled.  If the procedure returns, then the port
+is closed automatically and the values yielded by the procedure are
+returned.  If the procedure does not return, then the port will not be
+closed automatically unless it is possible to prove that the port will
+never again be used for a read or write operation. When MKDIR is true,
+create FILE's directory and all its parents."
+  (let ((p (open-output-file file #:binary binary #:encoding encoding #:mkdir mkdir)))
     (call-with-values
       (lambda () (proc p))
       (lambda vals
@@ -506,35 +509,37 @@ procedures, their behavior is implementation dependent."
    #:encoding encoding
    #:guess-encoding guess-encoding))
 
-(define* (with-output-to-file file thunk #:key (binary #f) (encoding #f))
-  "THUNK must be a procedure of no arguments, and FILE must be a
-string naming a file.  The effect is unspecified if the file already exists.
+(define* (with-output-to-file file thunk #:key (binary #f) (encoding #f) (mkdir #f))
+  "THUNK must be a procedure of no arguments, and FILE must be a string
+naming a file.  The effect is unspecified if the file already exists.
 The file is opened for output, an output port connected to it is made
-the default value returned by `current-output-port',
-and the THUNK is called with no arguments.
-When the THUNK returns, the port is closed and the previous
-default is restored.  Returns the values yielded by THUNK.  If an
-escape procedure is used to escape from the continuation of these
-procedures, their behavior is implementation dependent."
+the default value returned by `current-output-port', and the THUNK is
+called with no arguments.  When the THUNK returns, the port is closed
+and the previous default is restored.  Returns the values yielded by
+THUNK.  If an escape procedure is used to escape from the continuation
+of these procedures, their behavior is implementation dependent. When
+MKDIR is true, the directory of FILE and all its parents are created."
   (call-with-output-file file
    (lambda (p) (with-output-to-port p thunk))
    #:binary binary
-   #:encoding encoding))
+   #:encoding encoding
+   #:mkdir mkdir))
 
-(define* (with-error-to-file file thunk #:key (binary #f) (encoding #f))
-  "THUNK must be a procedure of no arguments, and FILE must be a
-string naming a file.  The effect is unspecified if the file already exists.
+(define* (with-error-to-file file thunk #:key (binary #f) (encoding #f) (mkdir #f))
+  "THUNK must be a procedure of no arguments, and FILE must be a string
+naming a file.  The effect is unspecified if the file already exists.
 The file is opened for output, an output port connected to it is made
-the default value returned by `current-error-port',
-and the THUNK is called with no arguments.
-When the THUNK returns, the port is closed and the previous
-default is restored.  Returns the values yielded by THUNK.  If an
-escape procedure is used to escape from the continuation of these
-procedures, their behavior is implementation dependent."
+the default value returned by `current-error-port', and the THUNK is
+called with no arguments.  When the THUNK returns, the port is closed
+and the previous default is restored.  Returns the values yielded by
+THUNK.  If an escape procedure is used to escape from the continuation
+of these procedures, their behavior is implementation dependent. When
+MKDIR is true, the directory of FILE and all its parents are created."
   (call-with-output-file file
    (lambda (p) (with-error-to-port p thunk))
    #:binary binary
-   #:encoding encoding))
+   #:encoding encoding
+   #:mkdir mkdir))
 
 (define (call-with-input-string string proc)
   "Calls the one-argument procedure @var{proc} with a newly created
-- 
2.28.0


[-- Attachment #3: 0001-ports-Add-mkdir-recursive.patch --]
[-- Type: text/x-patch, Size: 5542 bytes --]

From 1a0bf46864ccbac742c5d97205d68b43d0448719 Mon Sep 17 00:00:00 2001
From: divoplade <d@divoplade.fr>
Date: Fri, 23 Oct 2020 22:44:36 +0200
Subject: [PATCH 1/2] ports: Add mkdir-recursive

2020-10-25 divoplade <d@divoplade.fr>
	* module/ice-9/ports.scm: add a function, mkdir-recursive, to
	create the chain of directories.
	* doc/ref/posix.texi: document the new function mkdir-recursive.
	* NEWS: mention the new function.
	* test-suite/tests/ports.test: add a test suite to check
	recursive mkdir.
---
 NEWS                        |  5 +++++
 doc/ref/posix.texi          | 15 ++++++++++----
 module/ice-9/ports.scm      | 12 +++++++++++
 test-suite/tests/ports.test | 40 +++++++++++++++++++++++++++++++++++++
 4 files changed, 68 insertions(+), 4 deletions(-)

diff --git a/NEWS b/NEWS
index 694449202..94a3f3154 100644
--- a/NEWS
+++ b/NEWS
@@ -16,6 +16,11 @@ O(1) dispatch time, regardless of the length of the chain.  This
 optimization is also unlocked in many cases for `match' expressions with
 many similar clauses whose first differentiator are constants.
 
+** New function mkdir-recursive
+
+This function will try and create the directory and parent directories,
+up to a directory that can be opened or the root.
+
 * Incompatible changes
 
 ** `copy' read-option removed
diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index f34c5222d..cb9943977 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -881,10 +881,17 @@ Create a symbolic link named @var{newpath} with the value (i.e., pointing to)
 @deffn {Scheme Procedure} mkdir path [mode]
 @deffnx {C Function} scm_mkdir (path, mode)
 Create a new directory named by @var{path}.  If @var{mode} is omitted
-then the permissions of the directory are set to @code{#o777}
-masked with the current umask (@pxref{Processes, @code{umask}}).
-Otherwise they are set to the value specified with @var{mode}.
-The return value is unspecified.
+then the permissions of the directory are set to @code{#o777} masked
+with the current umask (@pxref{Processes, @code{umask}}).  Otherwise
+they are set to the value specified with @var{mode}.  The return value
+is unspecified.
+@end deffn
+
+@deffn {Scheme Procedure} mkdir-recursive @var{path} [mode]
+Create the directory named @var{path}, with the optional given
+@var{mode}, as for @code{mkdir}. Create all parent directories up to a
+directory that can be opened, or the root. The chain of directories is
+not cleaned in case of an error.
 @end deffn
 
 @deffn {Scheme Procedure} rmdir path
diff --git a/module/ice-9/ports.scm b/module/ice-9/ports.scm
index dbc7ef7a7..d85e48107 100644
--- a/module/ice-9/ports.scm
+++ b/module/ice-9/ports.scm
@@ -105,6 +105,7 @@
             OPEN_READ OPEN_WRITE OPEN_BOTH
             *null-device*
             open-input-file
+            mkdir-recursive
             open-output-file
             open-io-file
             call-with-input-file
@@ -413,6 +414,17 @@ cannot be opened, an error is signalled."
              #:encoding encoding
              #:guess-encoding guess-encoding))
 
+(define (mkdir-recursive name)
+  "Create the parent directories of @var{name}, up to an existing
+directory, or up to the root."
+  (catch 'system-error
+    (lambda ()
+      (mkdir name))
+    (lambda error
+      (if (= EEXIST (system-error-errno error))
+          #t
+          (mkdir-recursive (dirname name))))))
+
 (define* (open-output-file file #:key (binary #f) (encoding #f))
   "Takes a string naming an output file to be created and returns an
 output port capable of writing characters to a new file by that
diff --git a/test-suite/tests/ports.test b/test-suite/tests/ports.test
index 31fb2b0a8..ab696195b 100644
--- a/test-suite/tests/ports.test
+++ b/test-suite/tests/ports.test
@@ -2022,6 +2022,46 @@
 
 (delete-file (test-file))
 
+(with-test-prefix "recursive mkdir"
+
+  (pass-if "Relative recursive mkdir creates the chain of directories"
+    (let ((dir "./nested/relative/subdirectory"))
+      (mkdir-recursive dir)
+      (let ((ok
+             (catch #t
+               (lambda ()
+                 (with-output-to-file "./nested/relative/subdirectory/file"
+                   (lambda ()
+                     (display "The directories have been created!")
+                     #t)))
+               (lambda (error . args)
+                 #f))))
+        (when ok
+          (delete-file "./nested/relative/subdirectory/file")
+          (rmdir "./nested/relative/subdirectory")
+          (rmdir "./nested/relative")
+          (rmdir "./nested"))
+        ok)))
+
+  (pass-if "Absolute recursive mkdir creates the chain of directories"
+    (let ((dir (string-append %temporary-directory "/nested/absolute/subdirectory")))
+      (mkdir-recursive dir)
+      (let ((ok
+             (catch #t
+               (lambda ()
+                 (with-output-to-file (string-append dir "/file")
+                   (lambda ()
+                     (display "The directories have been created!")
+                     #t)))
+               (lambda (error . args)
+                 #f))))
+        (when ok
+          (delete-file (string-append dir "/file"))
+          (rmdir (string-append %temporary-directory "/nested/absolute/subdirectory"))
+          (rmdir (string-append %temporary-directory "/nested/absolute"))
+          (rmdir (string-append %temporary-directory "/nested")))
+        ok))))
+
 ;;; Local Variables:
 ;;; eval: (put 'test-decoding-error 'scheme-indent-function 3)
 ;;; eval: (put 'with-load-path 'scheme-indent-function 1)
-- 
2.28.0


^ permalink raw reply related	[flat|nested] 13+ messages in thread

* bug#44186: Recursive mkdir
  2020-10-23 22:00   ` bug#44186: Recursive mkdir divoplade
  2020-10-23 22:07     ` zimoun
       [not found]     ` <handler.44186.B.16034904223692.ack@debbugs.gnu.org>
@ 2020-10-26 21:05     ` Leo Prikler
  2020-10-27  7:01       ` divoplade
  2 siblings, 1 reply; 13+ messages in thread
From: Leo Prikler @ 2020-10-26 21:05 UTC (permalink / raw)
  To: d; +Cc: 44186

Hello, divoplade,

> So, after a bit of bikeshedding on #guile, it turns out that the
> controversy moved to the second commit.
Not quite, the second commit just needlessly complicates a patch, that
should not be that complicated in the first place.
When posting a patch to the mailing list, you should do your best to
ensure, that all of your code works as intended (alas, I am getting
ahead of myself here a bit).  It is easier to prove this for *just*
mkdir-p/mkdir-recursive rather than having to test all your wrappers as
well.  You have been pretty adamant, that you need those wrappers, but
they can easily be written in whichever library actually ends up using
them as well, so you're just creating more work for yourself for little
gain.  That's the point I was trying to make in the IRC.

> Here is the justification for it.
> 
> When a program user wants to save data to a file, if the place where
> to
> save the file does not exist yet, there will be an error: "cannot
> create file or directory". That's puzzling to the user, because, yes,
> the user wants to create that file.  If the error is a little more
> precise, it will be something in the line of "Please create directory
> blah/blah/blah before invoking this program".
> 
> So, the user will wonder why the program was not able to create
> blah/blah/blah itself, create it, and re-run the program. This is
> more
> work for the user, work that could have been easily handled by the
> program.
That would be a nice story in a vacuum, but in practice few systems
work like that.  Python errors in a similar way to Guile, but with a
nicer message.  So does plain Node JS.  On the part of Node with all of
its single package modules, even there the equivalent to your versions
of open-output-file is one package[1] removed from the built-in fs
module.

> Good behaving programs should (recursively) create the directory
> before
> trying to write to a file specified by the user. That include log
> files
> for a daemon, for instance. Emacs org-mode babel tangling uses a
> :mkdirp t for a similar reason. In order to simplify the development
> of
> such programs, and in order to avoid bugs where the developer forgot
> to
> call (mkdir-recursive (dirname output-file)) before (open-output-
> file,
> call-with-output-file or with-output-to-file, while still keeping
> compatibility of the other programs, I propose to add a keyword
> argument to these functions. 
The programming of such procedures would not get simpler by inlining
mkdir-p into open-file.  Instead, programs written that way would be
harder to understand, as the implicit creation of such directories
outside of functions that explicitly exist for this implicit creation
will cause (some) confusion as to whether or not implicit creation of
directories can/will take place and whether that is actually wanted in
this context and erroring is not an acceptable alternative.

The addition of mkdir-p/mkdir-recursive/make-directories alone would
already enable a writer of org-mode tangle to write whichever helper
they need for their (in my opinion rather specific) use case in 2
lines. 

> I also simplified the mkdir-recursive function, to be closer to 
> https://gitlab.com/leoprikler/guile-filesystem/-/blob/master/ice-9/filesystem.scm
> .
I'd prefer it if you didn't credit me for messing up your code. ;)
The reason my version works, is because (ice-9 filesystem) has a
working implementation of file-ancestors, which it uses to create all
ancestors in order.  The part you've copied only creates one such
directory.  With the changes you've made, the directory, that does get
created, is the first one in the tree, which does not exist.  I'm
surprised, that this test passes for you, because it does not pass for
me.

On a somewhat related note, I am getting closer to a 0.1.0 release of
(ice-9 filesystem), which I'll then pitch to the Guix mailing lists. 
Being an outside module, that means you can use it with Guile versions
earlier than 3.0.5, which at least in my eyes sounds like a better
solution to your problem of not being able to implement org-babel in
Guile.

Regards, Leo

[1] https://www.npmjs.com/package/fse






^ permalink raw reply	[flat|nested] 13+ messages in thread

* bug#44186: Recursive mkdir
  2020-10-26 21:05     ` Leo Prikler
@ 2020-10-27  7:01       ` divoplade
  2020-10-27  9:19         ` Leo Prikler
  0 siblings, 1 reply; 13+ messages in thread
From: divoplade @ 2020-10-27  7:01 UTC (permalink / raw)
  To: Leo Prikler; +Cc: 44186

[-- Attachment #1: Type: text/plain, Size: 1343 bytes --]

Hello,

I think I have made my point for the second commit. I intend this
change to be user-centric: it would be better to confuse the developer
of a guile program than the user of said program. Anyway, this will not
confuse anyone because creating the directory is not the default
behavior.

As for the first commit:

Le lundi 26 octobre 2020 à 22:05 +0100, Leo Prikler a écrit :
> I'd prefer it if you didn't credit me for messing up your code. ;)
> The reason my version works, is because (ice-9 filesystem) has a
> working implementation of file-ancestors, which it uses to create all
> ancestors in order.  The part you've copied only creates one such
> directory.  With the changes you've made, the directory, that does
> get
> created, is the first one in the tree, which does not exist.  I'm
> surprised, that this test passes for you, because it does not pass
> for
> me.

Exactly, it does not pass the test, because I still can't run them.
That's one of my open questions (the other being: in which file do I
write the code, I feel the ports module is not the best place). How do
you run the tests? When I run "make check", I get 1 of 39 tests failed,
the test-out-of-memory test. It does not even try to run the ports
test.

So until I can check it, my work can only be understood as "work in
progress".

Best regards,

divoplade

[-- Attachment #2: 0002-Use-the-recursive-mkdir-function-in-file-output-proc.patch --]
[-- Type: text/x-patch, Size: 11751 bytes --]

From ce1eb42ab2db13235e2de71d10529daacdf9df87 Mon Sep 17 00:00:00 2001
From: divoplade <d@divoplade.fr>
Date: Sat, 24 Oct 2020 00:35:01 +0200
Subject: [PATCH 2/2] Use the recursive mkdir function in file output
 procedures

2020-10-25 divoplade <d@divoplade.fr>
	* module/ice-9/ports.scm (open-output-file): add a mkdir keyword
	to try to recursively create the directory of the output file.
	* module/ice-9/ports.scm (call-with-output-file): same.
	* module/ice-9/ports.scm (with-output-to-file): same.
	* module/ice-9/ports.scm (with-error-to-file): same.
	* doc/ref/api-io.texi: document the new keyword argument for
	opening output files.
	* NEWS: indicate that the open output function can now create
	the filename directory if it does not exist.
---
 NEWS                   |  6 +++-
 doc/ref/api-io.texi    | 38 ++++++++++++++-------
 module/ice-9/ports.scm | 75 ++++++++++++++++++++++--------------------
 3 files changed, 71 insertions(+), 48 deletions(-)

diff --git a/NEWS b/NEWS
index 94a3f3154..09e06a7ba 100644
--- a/NEWS
+++ b/NEWS
@@ -19,7 +19,11 @@ many similar clauses whose first differentiator are constants.
 ** New function mkdir-recursive
 
 This function will try and create the directory and parent directories,
-up to a directory that can be opened or the root.
+up to a directory that can be opened or the root. This behavior is
+included in open-output-file, call-with-output-file, with-output-to-file
+and with-error-to-file by adding a keyword argument `#:mkdir' which,
+when set to `#t', creates the directories before trying to open the
+file.
 
 * Incompatible changes
 
diff --git a/doc/ref/api-io.texi b/doc/ref/api-io.texi
index ecbd35585..0c6beec20 100644
--- a/doc/ref/api-io.texi
+++ b/doc/ref/api-io.texi
@@ -1036,13 +1036,16 @@ for @code{open-file}.  Equivalent to
 
 @rnindex open-output-file
 @deffn {Scheme Procedure} open-output-file filename @
-       [#:encoding=#f] [#:binary=#f]
+       [#:encoding=#f] [#:binary=#f] [#:mkdir=#f]
 
 Open @var{filename} for output.  If @var{binary} is true, open the port
 in binary mode, otherwise use text mode.  @var{encoding} specifies the
-character encoding as described above for @code{open-file}.  Equivalent
-to
+character encoding as described above for @code{open-file}.  If
+@var{mkdir} is true, recursively create the directory of @var{filename}
+if it does not exist first.  Equivalent to
 @lisp
+(when @var{mkdir}
+  (mkdir-recursive (dirname @var{filename})))
 (open-file @var{filename}
            (if @var{binary} "wb" "w")
            #:encoding @var{encoding})
@@ -1052,12 +1055,14 @@ to
 @deffn {Scheme Procedure} call-with-input-file filename proc @
         [#:guess-encoding=#f] [#:encoding=#f] [#:binary=#f]
 @deffnx {Scheme Procedure} call-with-output-file filename proc @
-        [#:encoding=#f] [#:binary=#f]
+        [#:encoding=#f] [#:binary=#f] [#:mkdir=#f]
 @rnindex call-with-input-file
 @rnindex call-with-output-file
 Open @var{filename} for input or output, and call @code{(@var{proc}
-port)} with the resulting port.  Return the value returned by
-@var{proc}.  @var{filename} is opened as per @code{open-input-file} or
+port)} with the resulting port.  For @var{call-with-output-file}, if
+@var{mkdir} is true, create the directory of @var{filename} recursively
+if it does not exist first.  Return the value returned by @var{proc}.
+@var{filename} is opened as per @code{open-input-file} or
 @code{open-output-file} respectively, and an error is signaled if it
 cannot be opened.
 
@@ -1065,22 +1070,28 @@ When @var{proc} returns, the port is closed.  If @var{proc} does not
 return (e.g.@: if it throws an error), then the port might not be
 closed automatically, though it will be garbage collected in the usual
 way if not otherwise referenced.
+
+If @var{mkdir} is true, create @var{filename}'s directory and all
+its parents.
 @end deffn
 
 @deffn {Scheme Procedure} with-input-from-file filename thunk @
         [#:guess-encoding=#f] [#:encoding=#f] [#:binary=#f]
 @deffnx {Scheme Procedure} with-output-to-file filename thunk @
-        [#:encoding=#f] [#:binary=#f]
+        [#:encoding=#f] [#:binary=#f] [#:mkdir=#f]
 @deffnx {Scheme Procedure} with-error-to-file filename thunk @
-        [#:encoding=#f] [#:binary=#f]
+        [#:encoding=#f] [#:binary=#f] [#:mkdir=#f]
 @rnindex with-input-from-file
 @rnindex with-output-to-file
 Open @var{filename} and call @code{(@var{thunk})} with the new port
 setup as respectively the @code{current-input-port},
-@code{current-output-port}, or @code{current-error-port}.  Return the
-value returned by @var{thunk}.  @var{filename} is opened as per
-@code{open-input-file} or @code{open-output-file} respectively, and an
-error is signaled if it cannot be opened.
+@code{current-output-port}, or @code{current-error-port}.  For
+@var{with-output-to-file} and @var{with-error-to-file}, if @var{mkdir}
+is true, recursively create the directory of @var{filename} if it does
+not exist first.  Return the value returned by @var{thunk}.
+@var{filename} is opened as per @code{open-input-file} or
+@code{open-output-file} respectively, and an error is signaled if it
+cannot be opened.
 
 When @var{thunk} returns, the port is closed and the previous setting
 of the respective current port is restored.
@@ -1095,6 +1106,9 @@ exited via an exception or new continuation.  This ensures it's still
 ready for use if @var{thunk} is re-entered by a captured continuation.
 Of course the port is always garbage collected and closed in the usual
 way when no longer referenced anywhere.
+
+If @var{mkdir} is true, then @var{filename}'s directory and all its
+parents are created.
 @end deffn
 
 @deffn {Scheme Procedure} port-mode port
diff --git a/module/ice-9/ports.scm b/module/ice-9/ports.scm
index ed074238b..0ea048e23 100644
--- a/module/ice-9/ports.scm
+++ b/module/ice-9/ports.scm
@@ -429,11 +429,14 @@ directory, or up to the root."
           (lambda error
             #t))))))
 
-(define* (open-output-file file #:key (binary #f) (encoding #f))
+(define* (open-output-file file #:key (binary #f) (encoding #f) (mkdir #f))
   "Takes a string naming an output file to be created and returns an
-output port capable of writing characters to a new file by that
-name.  If the file cannot be opened, an error is signalled.  If a
-file with the given name already exists, the effect is unspecified."
+output port capable of writing characters to a new file by that name.
+If the file cannot be opened, an error is signalled.  If a file with the
+given name already exists, the effect is unspecified.  If @var{mkdir} is
+true, recursively create the directory of @var{file}."
+  (when mkdir
+    (mkdir-p (dirname file)))
   (open-file file (if binary "wb" "w")
              #:encoding encoding))
 
@@ -463,18 +466,18 @@ never again be used for a read or write operation."
         (close-input-port p)
         (apply values vals)))))
 
-(define* (call-with-output-file file proc #:key (binary #f) (encoding #f))
+(define* (call-with-output-file file proc #:key (binary #f) (encoding #f) (mkdir #f))
   "PROC should be a procedure of one argument, and FILE should be a
-string naming a file.  The behaviour is unspecified if the file
-already exists. These procedures call PROC
-with one argument: the port obtained by opening the named file for
-input or output.  If the file cannot be opened, an error is
-signalled.  If the procedure returns, then the port is closed
-automatically and the values yielded by the procedure are returned.
-If the procedure does not return, then the port will not be closed
-automatically unless it is possible to prove that the port will
-never again be used for a read or write operation."
-  (let ((p (open-output-file file #:binary binary #:encoding encoding)))
+string naming a file.  The behaviour is unspecified if the file already
+exists. These procedures call PROC with one argument: the port obtained
+by opening the named file for input or output.  If the file cannot be
+opened, an error is signalled.  If the procedure returns, then the port
+is closed automatically and the values yielded by the procedure are
+returned.  If the procedure does not return, then the port will not be
+closed automatically unless it is possible to prove that the port will
+never again be used for a read or write operation. When MKDIR is true,
+create FILE's directory and all its parents."
+  (let ((p (open-output-file file #:binary binary #:encoding encoding #:mkdir mkdir)))
     (call-with-values
       (lambda () (proc p))
       (lambda vals
@@ -510,35 +513,37 @@ procedures, their behavior is implementation dependent."
    #:encoding encoding
    #:guess-encoding guess-encoding))
 
-(define* (with-output-to-file file thunk #:key (binary #f) (encoding #f))
-  "THUNK must be a procedure of no arguments, and FILE must be a
-string naming a file.  The effect is unspecified if the file already exists.
+(define* (with-output-to-file file thunk #:key (binary #f) (encoding #f) (mkdir #f))
+  "THUNK must be a procedure of no arguments, and FILE must be a string
+naming a file.  The effect is unspecified if the file already exists.
 The file is opened for output, an output port connected to it is made
-the default value returned by `current-output-port',
-and the THUNK is called with no arguments.
-When the THUNK returns, the port is closed and the previous
-default is restored.  Returns the values yielded by THUNK.  If an
-escape procedure is used to escape from the continuation of these
-procedures, their behavior is implementation dependent."
+the default value returned by `current-output-port', and the THUNK is
+called with no arguments.  When the THUNK returns, the port is closed
+and the previous default is restored.  Returns the values yielded by
+THUNK.  If an escape procedure is used to escape from the continuation
+of these procedures, their behavior is implementation dependent. When
+MKDIR is true, the directory of FILE and all its parents are created."
   (call-with-output-file file
    (lambda (p) (with-output-to-port p thunk))
    #:binary binary
-   #:encoding encoding))
+   #:encoding encoding
+   #:mkdir mkdir))
 
-(define* (with-error-to-file file thunk #:key (binary #f) (encoding #f))
-  "THUNK must be a procedure of no arguments, and FILE must be a
-string naming a file.  The effect is unspecified if the file already exists.
+(define* (with-error-to-file file thunk #:key (binary #f) (encoding #f) (mkdir #f))
+  "THUNK must be a procedure of no arguments, and FILE must be a string
+naming a file.  The effect is unspecified if the file already exists.
 The file is opened for output, an output port connected to it is made
-the default value returned by `current-error-port',
-and the THUNK is called with no arguments.
-When the THUNK returns, the port is closed and the previous
-default is restored.  Returns the values yielded by THUNK.  If an
-escape procedure is used to escape from the continuation of these
-procedures, their behavior is implementation dependent."
+the default value returned by `current-error-port', and the THUNK is
+called with no arguments.  When the THUNK returns, the port is closed
+and the previous default is restored.  Returns the values yielded by
+THUNK.  If an escape procedure is used to escape from the continuation
+of these procedures, their behavior is implementation dependent. When
+MKDIR is true, the directory of FILE and all its parents are created."
   (call-with-output-file file
    (lambda (p) (with-error-to-port p thunk))
    #:binary binary
-   #:encoding encoding))
+   #:encoding encoding
+   #:mkdir mkdir))
 
 (define (call-with-input-string string proc)
   "Calls the one-argument procedure @var{proc} with a newly created
-- 
2.29.1


[-- Attachment #3: 0001-ports-Add-mkdir-recursive.patch --]
[-- Type: text/x-patch, Size: 5656 bytes --]

From c15b9fff1bcd90848c6c16a9e2e5cfa30337ace7 Mon Sep 17 00:00:00 2001
From: divoplade <d@divoplade.fr>
Date: Fri, 23 Oct 2020 22:44:36 +0200
Subject: [PATCH 1/2] ports: Add mkdir-recursive

2020-10-25 divoplade <d@divoplade.fr>
	* module/ice-9/ports.scm: add a function, mkdir-recursive, to
	create the chain of directories.
	* doc/ref/posix.texi: document the new function mkdir-recursive.
	* NEWS: mention the new function.
	* test-suite/tests/ports.test: add a test suite to check
	recursive mkdir.
---
 NEWS                        |  5 +++++
 doc/ref/posix.texi          | 15 ++++++++++----
 module/ice-9/ports.scm      | 16 +++++++++++++++
 test-suite/tests/ports.test | 40 +++++++++++++++++++++++++++++++++++++
 4 files changed, 72 insertions(+), 4 deletions(-)

diff --git a/NEWS b/NEWS
index 694449202..94a3f3154 100644
--- a/NEWS
+++ b/NEWS
@@ -16,6 +16,11 @@ O(1) dispatch time, regardless of the length of the chain.  This
 optimization is also unlocked in many cases for `match' expressions with
 many similar clauses whose first differentiator are constants.
 
+** New function mkdir-recursive
+
+This function will try and create the directory and parent directories,
+up to a directory that can be opened or the root.
+
 * Incompatible changes
 
 ** `copy' read-option removed
diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index f34c5222d..cb9943977 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -881,10 +881,17 @@ Create a symbolic link named @var{newpath} with the value (i.e., pointing to)
 @deffn {Scheme Procedure} mkdir path [mode]
 @deffnx {C Function} scm_mkdir (path, mode)
 Create a new directory named by @var{path}.  If @var{mode} is omitted
-then the permissions of the directory are set to @code{#o777}
-masked with the current umask (@pxref{Processes, @code{umask}}).
-Otherwise they are set to the value specified with @var{mode}.
-The return value is unspecified.
+then the permissions of the directory are set to @code{#o777} masked
+with the current umask (@pxref{Processes, @code{umask}}).  Otherwise
+they are set to the value specified with @var{mode}.  The return value
+is unspecified.
+@end deffn
+
+@deffn {Scheme Procedure} mkdir-recursive @var{path} [mode]
+Create the directory named @var{path}, with the optional given
+@var{mode}, as for @code{mkdir}. Create all parent directories up to a
+directory that can be opened, or the root. The chain of directories is
+not cleaned in case of an error.
 @end deffn
 
 @deffn {Scheme Procedure} rmdir path
diff --git a/module/ice-9/ports.scm b/module/ice-9/ports.scm
index dbc7ef7a7..ed074238b 100644
--- a/module/ice-9/ports.scm
+++ b/module/ice-9/ports.scm
@@ -105,6 +105,7 @@
             OPEN_READ OPEN_WRITE OPEN_BOTH
             *null-device*
             open-input-file
+            mkdir-recursive
             open-output-file
             open-io-file
             call-with-input-file
@@ -413,6 +414,21 @@ cannot be opened, an error is signalled."
              #:encoding encoding
              #:guess-encoding guess-encoding))
 
+(define (mkdir-recursive name)
+  "Create the parent directories of @var{name}, up to an existing
+directory, or up to the root."
+  (catch 'system-error
+    (lambda ()
+      (mkdir name))
+    (lambda error
+      (unless (= EEXIST (system-error-errno error))
+        (mkdir-recursive (dirname name))
+        (catch 'system-error
+          (lambda ()
+            (mkdir name))
+          (lambda error
+            #t))))))
+
 (define* (open-output-file file #:key (binary #f) (encoding #f))
   "Takes a string naming an output file to be created and returns an
 output port capable of writing characters to a new file by that
diff --git a/test-suite/tests/ports.test b/test-suite/tests/ports.test
index 31fb2b0a8..ab696195b 100644
--- a/test-suite/tests/ports.test
+++ b/test-suite/tests/ports.test
@@ -2022,6 +2022,46 @@
 
 (delete-file (test-file))
 
+(with-test-prefix "recursive mkdir"
+
+  (pass-if "Relative recursive mkdir creates the chain of directories"
+    (let ((dir "./nested/relative/subdirectory"))
+      (mkdir-recursive dir)
+      (let ((ok
+             (catch #t
+               (lambda ()
+                 (with-output-to-file "./nested/relative/subdirectory/file"
+                   (lambda ()
+                     (display "The directories have been created!")
+                     #t)))
+               (lambda (error . args)
+                 #f))))
+        (when ok
+          (delete-file "./nested/relative/subdirectory/file")
+          (rmdir "./nested/relative/subdirectory")
+          (rmdir "./nested/relative")
+          (rmdir "./nested"))
+        ok)))
+
+  (pass-if "Absolute recursive mkdir creates the chain of directories"
+    (let ((dir (string-append %temporary-directory "/nested/absolute/subdirectory")))
+      (mkdir-recursive dir)
+      (let ((ok
+             (catch #t
+               (lambda ()
+                 (with-output-to-file (string-append dir "/file")
+                   (lambda ()
+                     (display "The directories have been created!")
+                     #t)))
+               (lambda (error . args)
+                 #f))))
+        (when ok
+          (delete-file (string-append dir "/file"))
+          (rmdir (string-append %temporary-directory "/nested/absolute/subdirectory"))
+          (rmdir (string-append %temporary-directory "/nested/absolute"))
+          (rmdir (string-append %temporary-directory "/nested")))
+        ok))))
+
 ;;; Local Variables:
 ;;; eval: (put 'test-decoding-error 'scheme-indent-function 3)
 ;;; eval: (put 'with-load-path 'scheme-indent-function 1)
-- 
2.29.1


^ permalink raw reply related	[flat|nested] 13+ messages in thread

* bug#44186: Recursive mkdir
  2020-10-27  7:01       ` divoplade
@ 2020-10-27  9:19         ` Leo Prikler
  2020-10-27 10:21           ` divoplade
  0 siblings, 1 reply; 13+ messages in thread
From: Leo Prikler @ 2020-10-27  9:19 UTC (permalink / raw)
  To: divoplade; +Cc: 44186

Hello,

Am Dienstag, den 27.10.2020, 08:01 +0100 schrieb divoplade:
> I think I have made my point for the second commit. I intend this
> change to be user-centric: it would be better to confuse the
> developer
> of a guile program than the user of said program. Anyway, this will
> not
> confuse anyone because creating the directory is not the default
> behavior.
I am very not pleased with this distinction of "user" and "developer". 
Even assuming there is some, it would be wiser not to confuse the
latter, as then they can assure on their own terms, that the former
won't be confused either.  When you've reached the point, where "even"
the latter can't tell you what exactly will happen, how exactly are you
going to ensure the former won't be confused in the event something
*does* go wrong?  Spoiler warning: Returning #t on error won't actually
fix them.

> As for the first commit:
> 
> Le lundi 26 octobre 2020 à 22:05 +0100, Leo Prikler a écrit :
> > I'd prefer it if you didn't credit me for messing up your code. ;)
> > The reason my version works, is because (ice-9 filesystem) has a
> > working implementation of file-ancestors, which it uses to create
> > all
> > ancestors in order.  The part you've copied only creates one such
> > directory.  With the changes you've made, the directory, that does
> > get
> > created, is the first one in the tree, which does not exist.  I'm
> > surprised, that this test passes for you, because it does not pass
> > for
> > me.
> 
> Exactly, it does not pass the test, because I still can't run them.
That's one way to see it.  For the record, I didn't actually run your
test, but instead copied your code as well as a test into a separate
file rather than building all of guile.  That's an easier way of
prototyping.

> In which file do I write the code, I feel the ports module is not the
> best place.
That's because it isn't.  The only reason you could be led to putting
it there is because of your insistence on the second patch (recall,
that it is not at all needed) along with possibly a belief, that the
only reason to recursively make a directory is to put files at their
root, which is also wrong.

As I have been suggesting multiple times already, you could potentially
maybe drop your second patch without making much impact on those
developers and users, who receive an error when opening a file port
without ensuring the parent directory to exist.  That would allow you
to put mkdir-recursive into the posix module (and test it along with
it) even if it isn't strictly POSIX.  If that's not your cup of tea and
you have more than just mkdir-recursive to add, you might want to put
it into a different module.

Please also note, that Guile also doesn't particularly need *your*
implementation of mkdir-p (or mine for that matter).  Ludovic Courtès,
who you might remember being a co-maintainer along with Andy Wingo,
wrote mkdir-p for GNU Guix, so whether or not it gets included here is
much rather a question of whether or not they want to relicense it
under the LGPL.

> How do you run the tests? When I run "make check", I get 1 of 39
> tests failed, the test-out-of-memory test. It does not even try to
> run the ports test.
Have a look at test-suite/Makefile.am.

Regards, Leo






^ permalink raw reply	[flat|nested] 13+ messages in thread

* bug#44186: Recursive mkdir
  2020-10-27  9:19         ` Leo Prikler
@ 2020-10-27 10:21           ` divoplade
  0 siblings, 0 replies; 13+ messages in thread
From: divoplade @ 2020-10-27 10:21 UTC (permalink / raw)
  To: Leo Prikler; +Cc: 44186

[-- Attachment #1: Type: text/plain, Size: 1000 bytes --]

Le mardi 27 octobre 2020 à 10:19 +0100, Leo Prikler a écrit :
> Returning #t on error won't actually
> fix them.
Do you mean that ignoring errors on mkdir when there has been a called
to mkdir-recursive just before is not OK? I agree, it's better if
mkdir-recursive fails if one element of the chain can't be created,
even if the parent exists or has been created. I updated the function.

> That would allow you
> to put mkdir-recursive into the posix module (and test it along with
> it) even if it isn't strictly POSIX.

So, that's what I did; the code is now in the posix module.

> > How do you run the tests? When I run "make check", I get 1 of 39
> > tests failed, the test-out-of-memory test. It does not even try to
> > run the ports test.
> Have a look at test-suite/Makefile.am.

(Now the relevant test is posix.test, not ports.test anymore)

I found it: I just needed to run the ./check-guile script. Now, both
recusive mkdir tests in posix.test run smoothly.

Best regards,

divoplade

[-- Attachment #2: 0002-Use-the-recursive-mkdir-function-in-file-output-proc.patch --]
[-- Type: text/x-patch, Size: 11805 bytes --]

From 3c43cd66b8d0d1ada76b19f0b073b7fee0c107c7 Mon Sep 17 00:00:00 2001
From: divoplade <d@divoplade.fr>
Date: Sat, 24 Oct 2020 00:35:01 +0200
Subject: [PATCH 2/2] Use the recursive mkdir function in file output
 procedures

2020-10-25 divoplade <d@divoplade.fr>
	* module/ice-9/ports.scm (open-output-file): add a mkdir keyword
	to try to recursively create the directory of the output file.
	* module/ice-9/ports.scm (call-with-output-file): same.
	* module/ice-9/ports.scm (with-output-to-file): same.
	* module/ice-9/ports.scm (with-error-to-file): same.
	* doc/ref/api-io.texi: document the new keyword argument for
	opening output files.
	* NEWS: indicate that the open output function can now create
	the filename directory if it does not exist.
---
 NEWS                   |  6 +++-
 doc/ref/api-io.texi    | 38 ++++++++++++++-------
 module/ice-9/ports.scm | 75 ++++++++++++++++++++++--------------------
 3 files changed, 71 insertions(+), 48 deletions(-)

diff --git a/NEWS b/NEWS
index 94a3f3154..09e06a7ba 100644
--- a/NEWS
+++ b/NEWS
@@ -19,7 +19,11 @@ many similar clauses whose first differentiator are constants.
 ** New function mkdir-recursive
 
 This function will try and create the directory and parent directories,
-up to a directory that can be opened or the root.
+up to a directory that can be opened or the root. This behavior is
+included in open-output-file, call-with-output-file, with-output-to-file
+and with-error-to-file by adding a keyword argument `#:mkdir' which,
+when set to `#t', creates the directories before trying to open the
+file.
 
 * Incompatible changes
 
diff --git a/doc/ref/api-io.texi b/doc/ref/api-io.texi
index ecbd35585..0c6beec20 100644
--- a/doc/ref/api-io.texi
+++ b/doc/ref/api-io.texi
@@ -1036,13 +1036,16 @@ for @code{open-file}.  Equivalent to
 
 @rnindex open-output-file
 @deffn {Scheme Procedure} open-output-file filename @
-       [#:encoding=#f] [#:binary=#f]
+       [#:encoding=#f] [#:binary=#f] [#:mkdir=#f]
 
 Open @var{filename} for output.  If @var{binary} is true, open the port
 in binary mode, otherwise use text mode.  @var{encoding} specifies the
-character encoding as described above for @code{open-file}.  Equivalent
-to
+character encoding as described above for @code{open-file}.  If
+@var{mkdir} is true, recursively create the directory of @var{filename}
+if it does not exist first.  Equivalent to
 @lisp
+(when @var{mkdir}
+  (mkdir-recursive (dirname @var{filename})))
 (open-file @var{filename}
            (if @var{binary} "wb" "w")
            #:encoding @var{encoding})
@@ -1052,12 +1055,14 @@ to
 @deffn {Scheme Procedure} call-with-input-file filename proc @
         [#:guess-encoding=#f] [#:encoding=#f] [#:binary=#f]
 @deffnx {Scheme Procedure} call-with-output-file filename proc @
-        [#:encoding=#f] [#:binary=#f]
+        [#:encoding=#f] [#:binary=#f] [#:mkdir=#f]
 @rnindex call-with-input-file
 @rnindex call-with-output-file
 Open @var{filename} for input or output, and call @code{(@var{proc}
-port)} with the resulting port.  Return the value returned by
-@var{proc}.  @var{filename} is opened as per @code{open-input-file} or
+port)} with the resulting port.  For @var{call-with-output-file}, if
+@var{mkdir} is true, create the directory of @var{filename} recursively
+if it does not exist first.  Return the value returned by @var{proc}.
+@var{filename} is opened as per @code{open-input-file} or
 @code{open-output-file} respectively, and an error is signaled if it
 cannot be opened.
 
@@ -1065,22 +1070,28 @@ When @var{proc} returns, the port is closed.  If @var{proc} does not
 return (e.g.@: if it throws an error), then the port might not be
 closed automatically, though it will be garbage collected in the usual
 way if not otherwise referenced.
+
+If @var{mkdir} is true, create @var{filename}'s directory and all
+its parents.
 @end deffn
 
 @deffn {Scheme Procedure} with-input-from-file filename thunk @
         [#:guess-encoding=#f] [#:encoding=#f] [#:binary=#f]
 @deffnx {Scheme Procedure} with-output-to-file filename thunk @
-        [#:encoding=#f] [#:binary=#f]
+        [#:encoding=#f] [#:binary=#f] [#:mkdir=#f]
 @deffnx {Scheme Procedure} with-error-to-file filename thunk @
-        [#:encoding=#f] [#:binary=#f]
+        [#:encoding=#f] [#:binary=#f] [#:mkdir=#f]
 @rnindex with-input-from-file
 @rnindex with-output-to-file
 Open @var{filename} and call @code{(@var{thunk})} with the new port
 setup as respectively the @code{current-input-port},
-@code{current-output-port}, or @code{current-error-port}.  Return the
-value returned by @var{thunk}.  @var{filename} is opened as per
-@code{open-input-file} or @code{open-output-file} respectively, and an
-error is signaled if it cannot be opened.
+@code{current-output-port}, or @code{current-error-port}.  For
+@var{with-output-to-file} and @var{with-error-to-file}, if @var{mkdir}
+is true, recursively create the directory of @var{filename} if it does
+not exist first.  Return the value returned by @var{thunk}.
+@var{filename} is opened as per @code{open-input-file} or
+@code{open-output-file} respectively, and an error is signaled if it
+cannot be opened.
 
 When @var{thunk} returns, the port is closed and the previous setting
 of the respective current port is restored.
@@ -1095,6 +1106,9 @@ exited via an exception or new continuation.  This ensures it's still
 ready for use if @var{thunk} is re-entered by a captured continuation.
 Of course the port is always garbage collected and closed in the usual
 way when no longer referenced anywhere.
+
+If @var{mkdir} is true, then @var{filename}'s directory and all its
+parents are created.
 @end deffn
 
 @deffn {Scheme Procedure} port-mode port
diff --git a/module/ice-9/ports.scm b/module/ice-9/ports.scm
index dbc7ef7a7..463479f2b 100644
--- a/module/ice-9/ports.scm
+++ b/module/ice-9/ports.scm
@@ -413,11 +413,14 @@ cannot be opened, an error is signalled."
              #:encoding encoding
              #:guess-encoding guess-encoding))
 
-(define* (open-output-file file #:key (binary #f) (encoding #f))
+(define* (open-output-file file #:key (binary #f) (encoding #f) (mkdir #f))
   "Takes a string naming an output file to be created and returns an
-output port capable of writing characters to a new file by that
-name.  If the file cannot be opened, an error is signalled.  If a
-file with the given name already exists, the effect is unspecified."
+output port capable of writing characters to a new file by that name.
+If the file cannot be opened, an error is signalled.  If a file with the
+given name already exists, the effect is unspecified.  If @var{mkdir} is
+true, recursively create the directory of @var{file}."
+  (when mkdir
+    (mkdir-recursive (dirname file)))
   (open-file file (if binary "wb" "w")
              #:encoding encoding))
 
@@ -447,18 +450,18 @@ never again be used for a read or write operation."
         (close-input-port p)
         (apply values vals)))))
 
-(define* (call-with-output-file file proc #:key (binary #f) (encoding #f))
+(define* (call-with-output-file file proc #:key (binary #f) (encoding #f) (mkdir #f))
   "PROC should be a procedure of one argument, and FILE should be a
-string naming a file.  The behaviour is unspecified if the file
-already exists. These procedures call PROC
-with one argument: the port obtained by opening the named file for
-input or output.  If the file cannot be opened, an error is
-signalled.  If the procedure returns, then the port is closed
-automatically and the values yielded by the procedure are returned.
-If the procedure does not return, then the port will not be closed
-automatically unless it is possible to prove that the port will
-never again be used for a read or write operation."
-  (let ((p (open-output-file file #:binary binary #:encoding encoding)))
+string naming a file.  The behaviour is unspecified if the file already
+exists. These procedures call PROC with one argument: the port obtained
+by opening the named file for input or output.  If the file cannot be
+opened, an error is signalled.  If the procedure returns, then the port
+is closed automatically and the values yielded by the procedure are
+returned.  If the procedure does not return, then the port will not be
+closed automatically unless it is possible to prove that the port will
+never again be used for a read or write operation. When MKDIR is true,
+create FILE's directory and all its parents."
+  (let ((p (open-output-file file #:binary binary #:encoding encoding #:mkdir mkdir)))
     (call-with-values
       (lambda () (proc p))
       (lambda vals
@@ -494,35 +497,37 @@ procedures, their behavior is implementation dependent."
    #:encoding encoding
    #:guess-encoding guess-encoding))
 
-(define* (with-output-to-file file thunk #:key (binary #f) (encoding #f))
-  "THUNK must be a procedure of no arguments, and FILE must be a
-string naming a file.  The effect is unspecified if the file already exists.
+(define* (with-output-to-file file thunk #:key (binary #f) (encoding #f) (mkdir #f))
+  "THUNK must be a procedure of no arguments, and FILE must be a string
+naming a file.  The effect is unspecified if the file already exists.
 The file is opened for output, an output port connected to it is made
-the default value returned by `current-output-port',
-and the THUNK is called with no arguments.
-When the THUNK returns, the port is closed and the previous
-default is restored.  Returns the values yielded by THUNK.  If an
-escape procedure is used to escape from the continuation of these
-procedures, their behavior is implementation dependent."
+the default value returned by `current-output-port', and the THUNK is
+called with no arguments.  When the THUNK returns, the port is closed
+and the previous default is restored.  Returns the values yielded by
+THUNK.  If an escape procedure is used to escape from the continuation
+of these procedures, their behavior is implementation dependent. When
+MKDIR is true, the directory of FILE and all its parents are created."
   (call-with-output-file file
    (lambda (p) (with-output-to-port p thunk))
    #:binary binary
-   #:encoding encoding))
+   #:encoding encoding
+   #:mkdir mkdir))
 
-(define* (with-error-to-file file thunk #:key (binary #f) (encoding #f))
-  "THUNK must be a procedure of no arguments, and FILE must be a
-string naming a file.  The effect is unspecified if the file already exists.
+(define* (with-error-to-file file thunk #:key (binary #f) (encoding #f) (mkdir #f))
+  "THUNK must be a procedure of no arguments, and FILE must be a string
+naming a file.  The effect is unspecified if the file already exists.
 The file is opened for output, an output port connected to it is made
-the default value returned by `current-error-port',
-and the THUNK is called with no arguments.
-When the THUNK returns, the port is closed and the previous
-default is restored.  Returns the values yielded by THUNK.  If an
-escape procedure is used to escape from the continuation of these
-procedures, their behavior is implementation dependent."
+the default value returned by `current-error-port', and the THUNK is
+called with no arguments.  When the THUNK returns, the port is closed
+and the previous default is restored.  Returns the values yielded by
+THUNK.  If an escape procedure is used to escape from the continuation
+of these procedures, their behavior is implementation dependent. When
+MKDIR is true, the directory of FILE and all its parents are created."
   (call-with-output-file file
    (lambda (p) (with-error-to-port p thunk))
    #:binary binary
-   #:encoding encoding))
+   #:encoding encoding
+   #:mkdir mkdir))
 
 (define (call-with-input-string string proc)
   "Calls the one-argument procedure @var{proc} with a newly created
-- 
2.29.1


[-- Attachment #3: 0001-ports-Add-mkdir-recursive.patch --]
[-- Type: text/x-patch, Size: 5237 bytes --]

From c87973b9b11eeb90c9d08d00b3e7c13facd60d82 Mon Sep 17 00:00:00 2001
From: divoplade <d@divoplade.fr>
Date: Fri, 23 Oct 2020 22:44:36 +0200
Subject: [PATCH 1/2] ports: Add mkdir-recursive

2020-10-25 divoplade <d@divoplade.fr>
	* module/ice-9/posix.scm: add a function, mkdir-recursive, to
	create the chain of directories.
	* doc/ref/posix.texi: document the new function mkdir-recursive.
	* NEWS: mention the new function.
	* test-suite/tests/posix.test: add a test suite to check
	recursive mkdir.
---
 NEWS                        |  5 ++++
 doc/ref/posix.texi          | 15 ++++++++----
 module/ice-9/posix.scm      | 11 +++++++++
 test-suite/tests/posix.test | 47 +++++++++++++++++++++++++++++++++++++
 4 files changed, 74 insertions(+), 4 deletions(-)

diff --git a/NEWS b/NEWS
index 694449202..94a3f3154 100644
--- a/NEWS
+++ b/NEWS
@@ -16,6 +16,11 @@ O(1) dispatch time, regardless of the length of the chain.  This
 optimization is also unlocked in many cases for `match' expressions with
 many similar clauses whose first differentiator are constants.
 
+** New function mkdir-recursive
+
+This function will try and create the directory and parent directories,
+up to a directory that can be opened or the root.
+
 * Incompatible changes
 
 ** `copy' read-option removed
diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index f34c5222d..cb9943977 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -881,10 +881,17 @@ Create a symbolic link named @var{newpath} with the value (i.e., pointing to)
 @deffn {Scheme Procedure} mkdir path [mode]
 @deffnx {C Function} scm_mkdir (path, mode)
 Create a new directory named by @var{path}.  If @var{mode} is omitted
-then the permissions of the directory are set to @code{#o777}
-masked with the current umask (@pxref{Processes, @code{umask}}).
-Otherwise they are set to the value specified with @var{mode}.
-The return value is unspecified.
+then the permissions of the directory are set to @code{#o777} masked
+with the current umask (@pxref{Processes, @code{umask}}).  Otherwise
+they are set to the value specified with @var{mode}.  The return value
+is unspecified.
+@end deffn
+
+@deffn {Scheme Procedure} mkdir-recursive @var{path} [mode]
+Create the directory named @var{path}, with the optional given
+@var{mode}, as for @code{mkdir}. Create all parent directories up to a
+directory that can be opened, or the root. The chain of directories is
+not cleaned in case of an error.
 @end deffn
 
 @deffn {Scheme Procedure} rmdir path
diff --git a/module/ice-9/posix.scm b/module/ice-9/posix.scm
index b00267665..c43ed5a27 100644
--- a/module/ice-9/posix.scm
+++ b/module/ice-9/posix.scm
@@ -73,3 +73,14 @@
 
 (define (getgrnam name) (getgr name))
 (define (getgrgid id) (getgr id))
+
+(define (mkdir-recursive name)
+  "Create the parent directories of @var{name}, up to an existing
+directory, or up to the root."
+  (catch 'system-error
+    (lambda ()
+      (mkdir name))
+    (lambda error
+      (unless (= EEXIST (system-error-errno error))
+        (mkdir-recursive (dirname name))
+        (mkdir name)))))
diff --git a/test-suite/tests/posix.test b/test-suite/tests/posix.test
index aa0dbc1b2..063bf205b 100644
--- a/test-suite/tests/posix.test
+++ b/test-suite/tests/posix.test
@@ -276,3 +276,50 @@
                ;; or not is system-defined, so it's possible it just works.
                (string? (crypt "pass" "$X$abc")))
              (lambda _ #t)))))
+
+;;
+;; recursive mkdir
+;;
+
+(with-test-prefix "recursive mkdir"
+
+  (pass-if "Relative recursive mkdir creates the chain of directories"
+    (let ((dir "./nested/relative/subdirectory"))
+      (mkdir-recursive dir)
+      (let ((ok
+             (catch #t
+               (lambda ()
+                 (with-output-to-file "./nested/relative/subdirectory/file"
+                   (lambda ()
+                     (display "The directories have been created!")
+                     #t)))
+               (lambda (error . args)
+                 #f))))
+        (when ok
+          (delete-file "./nested/relative/subdirectory/file")
+          (rmdir "./nested/relative/subdirectory")
+          (rmdir "./nested/relative")
+          (rmdir "./nested"))
+        ok)))
+
+  (pass-if "Absolute recursive mkdir creates the chain of directories"
+    (let* ((%temporary-directory
+            (string-append (or (getenv "TMPDIR") "/tmp") "/guile-posix-test."
+                           (number->string (getpid))))
+           (dir (string-append %temporary-directory "/nested/absolute/subdirectory")))
+      (mkdir-recursive dir)
+      (let ((ok
+             (catch #t
+               (lambda ()
+                 (with-output-to-file (string-append dir "/file")
+                   (lambda ()
+                     (display "The directories have been created!")
+                     #t)))
+               (lambda (error . args)
+                 #f))))
+        (when ok
+          (delete-file (string-append dir "/file"))
+          (rmdir (string-append %temporary-directory "/nested/absolute/subdirectory"))
+          (rmdir (string-append %temporary-directory "/nested/absolute"))
+          (rmdir (string-append %temporary-directory "/nested")))
+        ok))))
-- 
2.29.1


^ permalink raw reply related	[flat|nested] 13+ messages in thread

end of thread, other threads:[~2020-10-27 10:21 UTC | newest]

Thread overview: 13+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
     [not found] <6ff632f5c1e378647cecc7177b7018fb8a0ee6d4.camel@divoplade.fr>
     [not found] ` <86sga420pw.fsf@gmail.com>
2020-10-23 22:00   ` bug#44186: Recursive mkdir divoplade
2020-10-23 22:07     ` zimoun
2020-10-23 23:32       ` Bengt Richter
2020-10-24  6:17         ` divoplade
2020-10-25  4:13           ` Bengt Richter
2020-10-25  7:45             ` Ricardo Wurmus
2020-10-25  9:07               ` divoplade
2020-10-25 10:44                 ` divoplade
     [not found]     ` <handler.44186.B.16034904223692.ack@debbugs.gnu.org>
2020-10-23 22:46       ` divoplade
2020-10-26 21:05     ` Leo Prikler
2020-10-27  7:01       ` divoplade
2020-10-27  9:19         ` Leo Prikler
2020-10-27 10:21           ` divoplade

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).