Loading uiop/stream.lisp +12 −10 Original line number Diff line number Diff line Loading @@ -576,16 +576,17 @@ Finally, the file will be deleted, unless the KEEP argument when CALL-FUNCTION'e (check-type direction (member :output :io)) (assert (or want-stream-p want-pathname-p)) (loop :with prefix = (native-namestring (ensure-absolute-pathname :with prefix-pn = (ensure-absolute-pathname (or prefix "tmp") (or (ensure-pathname directory :namestring :native :ensure-directory t) #'temporary-directory))) :with results = () #'temporary-directory)) :with prefix-nns = (native-namestring prefix-pn) :with results = (progn (ensure-directories-exist prefix-pn) ()) :for counter :from (random (expt 36 #-gcl 8 #+gcl 5)) :for pathname = (parse-native-namestring (format nil "~A~36R~@[~A~]~@[.~A~]" prefix counter suffix (unless (eq type :unspecific) type))) prefix-nns counter suffix (unless (eq type :unspecific) type))) :for okp = nil :do ;; TODO: on Unix, do something about umask ;; TODO: on Unix, audit the code so we make sure it uses O_CREAT|O_EXCL Loading @@ -594,6 +595,7 @@ Finally, the file will be deleted, unless the KEEP argument when CALL-FUNCTION'e ;; Can we at least design some hook? (unwind-protect (progn (ensure-directories-exist pathname) (with-open-file (stream pathname :direction direction :element-type element-type Loading Loading @@ -677,9 +679,9 @@ Further KEYS can be passed to MAKE-PATHNAME." A new empty file with said temporary pathname is created, to ensure there is no clash with any concurrent process attempting the same thing." (let* ((px (ensure-pathname x)) (prefix (if-let (n (pathname-name px)) (strcat n "-tmp") "tmp"))) (get-temporary-file :directory (pathname-directory-pathname px) :prefix prefix :type (pathname-type px)))) (prefix (if-let (n (pathname-name px)) (strcat n "-tmp") "tmp")) (directory (translate-logical-pathname (pathname-directory-pathname px)))) (get-temporary-file :directory directory :prefix prefix :type (pathname-type px)))) (defun call-with-staging-pathname (pathname fun) "Calls FUN with a staging pathname, and atomically Loading Loading
uiop/stream.lisp +12 −10 Original line number Diff line number Diff line Loading @@ -576,16 +576,17 @@ Finally, the file will be deleted, unless the KEEP argument when CALL-FUNCTION'e (check-type direction (member :output :io)) (assert (or want-stream-p want-pathname-p)) (loop :with prefix = (native-namestring (ensure-absolute-pathname :with prefix-pn = (ensure-absolute-pathname (or prefix "tmp") (or (ensure-pathname directory :namestring :native :ensure-directory t) #'temporary-directory))) :with results = () #'temporary-directory)) :with prefix-nns = (native-namestring prefix-pn) :with results = (progn (ensure-directories-exist prefix-pn) ()) :for counter :from (random (expt 36 #-gcl 8 #+gcl 5)) :for pathname = (parse-native-namestring (format nil "~A~36R~@[~A~]~@[.~A~]" prefix counter suffix (unless (eq type :unspecific) type))) prefix-nns counter suffix (unless (eq type :unspecific) type))) :for okp = nil :do ;; TODO: on Unix, do something about umask ;; TODO: on Unix, audit the code so we make sure it uses O_CREAT|O_EXCL Loading @@ -594,6 +595,7 @@ Finally, the file will be deleted, unless the KEEP argument when CALL-FUNCTION'e ;; Can we at least design some hook? (unwind-protect (progn (ensure-directories-exist pathname) (with-open-file (stream pathname :direction direction :element-type element-type Loading Loading @@ -677,9 +679,9 @@ Further KEYS can be passed to MAKE-PATHNAME." A new empty file with said temporary pathname is created, to ensure there is no clash with any concurrent process attempting the same thing." (let* ((px (ensure-pathname x)) (prefix (if-let (n (pathname-name px)) (strcat n "-tmp") "tmp"))) (get-temporary-file :directory (pathname-directory-pathname px) :prefix prefix :type (pathname-type px)))) (prefix (if-let (n (pathname-name px)) (strcat n "-tmp") "tmp")) (directory (translate-logical-pathname (pathname-directory-pathname px)))) (get-temporary-file :directory directory :prefix prefix :type (pathname-type px)))) (defun call-with-staging-pathname (pathname fun) "Calls FUN with a staging pathname, and atomically Loading