Avoid FFI temp dependency in path caps
ober
0102fe23ca9be33adcee47e0893f3427a3796bc0
--- a/lib/std/os/path-caps.ss +++ b/lib/std/os/path-caps.ss @@ -25,8 +25,7 @@ find-repo-root) (import (chezscheme) - (only (jerboa core) def defstruct try catch) - (only (std os temp) make-temporary-directory)) + (only (jerboa core) def defstruct try catch)) (defstruct path-capability-resolver-rec (cache temp-dirs make-temp workspace project-root home temp-prefix temp-root)) @@ -106,18 +105,35 @@ (if (safe-name-char? ch) ch #\_))) (lp (+ i 1))])))) + (def temp-counter 0) + + (def (next-temp-suffix!) + (set! temp-counter (+ temp-counter 1)) + (string-append + (number->string (random 1000000000)) + "-" + (number->string temp-counter))) + (def (default-make-temp r tag) - (let* ([safe (sanitize-name tag)] - [tmpl (join (path-capability-resolver-rec-temp-root r) - (string-append - (path-capability-resolver-rec-temp-prefix r) - safe - "-XXXXXX"))] - [path (make-temporary-directory tmpl)]) - (path-capability-resolver-rec-temp-dirs-set! - r - (cons path (path-capability-resolver-rec-temp-dirs r))) - path)) + (let ([safe (sanitize-name tag)]) + (let lp ([attempts 0]) + (when (> attempts 100) + (error 'path-capability-resolve "could not create temp directory" tag)) + (let ([path (join (path-capability-resolver-rec-temp-root r) + (string-append + (path-capability-resolver-rec-temp-prefix r) + safe + "-" + (next-temp-suffix!)))]) + (try + (begin + (mkdir path) + (path-capability-resolver-rec-temp-dirs-set! + r + (cons path (path-capability-resolver-rec-temp-dirs r))) + path) + (catch (e) + (lp (+ attempts 1)))))))) (def (resolver-make-temp r tag) (let ([mk (path-capability-resolver-rec-make-temp r)])