Add make-temp-dir and friends

spork/sh.janet

@@ -171,3 +171,95 @@
   "Output a string with all arguments correctly quoted"
   [& args]
   (string/join (map shell-quote args) " "))
+
+# https://learn.microsoft.com/en-us/windows/win32/api/fileapi/nf-fileapi-gettemppath2w
+(defn windows-temp-root
+  ``
+  Try to determine a temporary directory for a Windows system.
+  ``
+  []
+  (os/getenv "TMP"
+             (os/getenv "TEMP"
+                        (os/getenv "USERPROFILE"
+                                   (os/getenv "WINDIR")))))
+
+
+# https://en.cppreference.com/w/cpp/filesystem/temp_directory_path
+(defn posix-temp-root
+  ``
+  Try to determine a temporary directory for a POSIX system.
+  ``
+  []
+  (os/getenv "TMPDIR"
+             (os/getenv "TMP"
+                        (os/getenv "TEMP"
+                                   (os/getenv "TEMPDIR" "/tmp")))))
+
+(defn temp-root
+  ``
+  Try to determine a temporary directory for the current system.
+  ``
+  []
+  (case (os/which)
+    # see comment above function definition
+    :windows (windows-temp-root)
+    # XXX: unsure
+    :mingw "/tmp"
+    # XXX: unsure, but https://cygwin.com/cygwin-ug-net/setup-env.html
+    :cygwin "/tmp"
+    # https://ss64.com/mac/syntax-env_vars.html
+    :macos (os/getenv "TMPDIR")
+    # https://emscripten.org/docs/api_reference/Filesystem-API.html
+    :web "/tmp"
+    # https://en.wikipedia.org/wiki/Filesystem_Hierarchy_Standard
+    :linux "/tmp"
+    # https://www.freebsd.org/cgi/man.cgi?query=hier&sektion=7
+    :freebsd "/tmp"
+    # https://man.openbsd.org/hier.7
+    :openbsd "/tmp"
+    # https://man.netbsd.org/hier.7
+    :netbsd "/tmp"
+    # https://leaf.dragonflybsd.org/cgi/web-man?command=hier&section=7
+    :dragonfly "/tmp"
+    # based on the *bsd info above, following seems reasonable
+    :bsd "/tmp"
+    # see comment above function definition
+    :posix (posix-temp-root)
+    (errorf "unrecognized os: %n" (os/which))))
+
+(defn make-temp-dir
+  ``
+  Tries to create a new subdirectory of a system-specific temporary
+  directory.  Optional argument `template` is used to specify a
+  template for the new subdirectory's name.  Each forward slash (`/`)
+  in the template is replaced with some hex value (0-9, a-f) to result
+  in a candidate name.  The default value of `template` is `//////`.
+  Optional argument `tries` is the maximum number of subdirectory
+  creation attempts.  The default value of `tries` is 5.  Upon
+  success, returns the full path of the newly created subdirectory.
+  ``
+  [&opt template tries]
+  (default template "//////")
+  (default tries 5)
+  (assert (not (empty? template))
+          "template should be a non-empty string")
+  (assert (and (nat? tries) (pos? tries))
+          (string/format "tries should be a positive integer, not: %d"
+                         tries))
+  (def tmp-root (temp-root))
+  (assert (= :directory (os/stat tmp-root :mode))
+          (string/format "failed to find temp root `%s` for os `%s"
+                         tmp-root (os/which)))
+  (def rng (math/rng (os/cryptorand 8)))
+  (defn rand-hex [_] (string/format "%x" (math/rng-int rng 16)))
+  (var ret nil)
+  (for i 0 tries
+    (def cand-path
+      (path/join tmp-root (string/replace-all "/" rand-hex template)))
+    (when (os/mkdir cand-path)
+      (set ret cand-path)
+      (break ret)))
+  (when (not ret)
+    (errorf "failed to create new temp directory after %d tries" tries))
+  (path/abspath ret))
+

test/suite0017.janet

@@ -39,4 +39,105 @@
           (sh/split ` "c d \" f" ' y z'  a b a\ b --cflags `)
           @["c d \" f" " y z" "a" "b" "a b" "--cflags"]))
 
+(do
+  (def win32-env
+    {"TMP" (or (os/getenv "TMP") :nil)
+     "TEMP" (or (os/getenv "TEMP") :nil)
+     "USERPROFILE" (or (os/getenv "USERPROFILE") :nil)
+     "WINDIR" (or (os/getenv "WINDIR") :nil)})
+  (defn reset []
+    (eachk name win32-env (os/setenv name nil)))
+  (defn restore []
+    (eachk name win32-env
+      (def old-val (get win32-env name))
+      (os/setenv name (if (= :nil old-val) nil old-val))))
+  (defer (restore)
+    (reset)
+    (os/setenv "TMP" `C:\TEMP`)
+    (assert (= `C:\TEMP` (sh/windows-temp-root))
+            "TMP env var value for temp dir for windows")
+    (reset)
+    (os/setenv "TEMP" `C:\TEMP2`)
+    (assert (= `C:\TEMP2` (sh/windows-temp-root))
+            "TEMP env var value for temp dir for windows")
+    (reset)
+    (os/setenv "USERPROFILE" `C:\TEMPU`)
+    (assert (= `C:\TEMPU` (sh/windows-temp-root))
+            "USERPROFILE env var value for temp dir for windows")
+    (reset)
+    (os/setenv "WINDIR" `C:\WINDOWS`)
+    (assert (= `C:\WINDOWS` (sh/windows-temp-root))
+            "WINDIR env var value for temp dir for windows")))
+
+(do
+  (def posix-env
+    {"TMPDIR" (or (os/getenv "TMPDIR") :nil)
+     "TMP" (or (os/getenv "TMP") :nil)
+     "TEMP" (or (os/getenv "TEMP") :nil)
+     "TEMPDIR" (or (os/getenv "TEMPDIR") :nil)})
+  (defn reset []
+    (eachk name posix-env (os/setenv name nil)))
+  (defn restore []
+    (eachk name posix-env
+      (def old-val (get posix-env name))
+      (os/setenv name (if (= :nil old-val) nil old-val))))
+  (defer (restore)
+    (reset)
+    (os/setenv "TMPDIR" `/tmp`)
+    (assert (= `/tmp` (sh/posix-temp-root))
+            "TMPDIR env var value for temp dir for posix")
+    (reset)
+    (os/setenv "TMP" `/var/tmp`)
+    (assert (= `/var/tmp` (sh/posix-temp-root))
+            "TMP env var value for temp dir for posix")
+    (reset)
+    (os/setenv "TEMP" `/private/tmp`)
+    (assert (= `/private/tmp` (sh/posix-temp-root))
+            "TEMP env var value for temp dir for posix")
+    (reset)
+    (os/setenv "TEMPDIR" `/tmp`)
+    (assert (= `/tmp` (sh/posix-temp-root))
+            "TEMPDIR env var value for temp dir for posix")))
+
+(do
+  (def tmp-root (sh/temp-root))
+  (def unlikely-prefix "ReaLLyNotTooLikelYIHope")
+  (def n 3) # could vary this each time...
+  (def n-slashes (string/repeat "/" n))
+  (def a-path
+    (sh/make-temp-dir (string unlikely-prefix "-" n-slashes)))
+  (assert (= :directory (os/stat a-path :mode))
+          (string/format "temp dir created at: %s" a-path))
+  (assert (path/abspath? a-path)
+          "temp-dir path is an absolute path")
+  (assert (string/has-prefix? tmp-root a-path)
+          "temp-dir path starts with temp-root path")
+  (assert (has-value? (os/dir tmp-root) (path/basename a-path))
+          "temp dir created under temp-root")
+  (os/rmdir a-path)
+  (assert (peg/match ~(sequence (thru ,unlikely-prefix)
+                                "-"
+                                (repeat ,n :h))
+                     a-path)
+          "temp dir name matches template pattern"))
+
+(do
+  (def tmp-root (sh/temp-root))
+  (def unlikely-prefix "ReaLLyNotTooLikelYIHope-")
+  # pre-create 16 subdirs that would match a template
+  (loop [i :range [0 16]]
+    (def subdir-path
+      (path/join tmp-root
+                 (string unlikely-prefix (string/format "%x" i))))
+    (os/mkdir subdir-path))
+  # all subdirs that would match the template exist already
+  (assert-error "temp dir creation can fail"
+                (sh/make-temp-dir (string unlikely-prefix "/")))
+  # remove the test subdirs
+  (loop [i :range [0 16]]
+    (def subdir-path
+      (path/join tmp-root
+                 (string unlikely-prefix (string/format "%x" i))))
+    (os/rmdir subdir-path)))
+
 (end-suite)