diff --git a/spork/sh.janet b/spork/sh.janet index 7051b9a..bf11f39 100644 --- a/spork/sh.janet +++ b/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§ion=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)) + diff --git a/test/suite0017.janet b/test/suite0017.janet index 423bc4d..32b0139 100644 --- a/test/suite0017.janet +++ b/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)