Loading uiop/stream.lisp +12 −10 Original line number Original line 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)) (check-type direction (member :output :io)) (assert (or want-stream-p want-pathname-p)) (assert (or want-stream-p want-pathname-p)) (loop (loop :with prefix = (native-namestring :with prefix-pn = (ensure-absolute-pathname (ensure-absolute-pathname (or prefix "tmp") (or prefix "tmp") (or (ensure-pathname directory :namestring :native :ensure-directory t) (or (ensure-pathname directory :namestring :native :ensure-directory t) #'temporary-directory)) #'temporary-directory))) :with prefix-nns = (native-namestring prefix-pn) :with results = () :with results = (progn (ensure-directories-exist prefix-pn) ()) :for counter :from (random (expt 36 #-gcl 8 #+gcl 5)) :for counter :from (random (expt 36 #-gcl 8 #+gcl 5)) :for pathname = (parse-native-namestring :for pathname = (parse-native-namestring (format nil "~A~36R~@[~A~]~@[.~A~]" (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 :for okp = nil :do ;; TODO: on Unix, do something about umask ;; TODO: on Unix, do something about umask ;; TODO: on Unix, audit the code so we make sure it uses O_CREAT|O_EXCL ;; 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? ;; Can we at least design some hook? (unwind-protect (unwind-protect (progn (progn (ensure-directories-exist pathname) (with-open-file (stream pathname (with-open-file (stream pathname :direction direction :direction direction :element-type element-type :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 A new empty file with said temporary pathname is created, to ensure there is no clash with any concurrent process attempting the same thing." clash with any concurrent process attempting the same thing." (let* ((px (ensure-pathname x)) (let* ((px (ensure-pathname x)) (prefix (if-let (n (pathname-name px)) (strcat n "-tmp") "tmp"))) (prefix (if-let (n (pathname-name px)) (strcat n "-tmp") "tmp")) (get-temporary-file (directory (translate-logical-pathname (pathname-directory-pathname px)))) :directory (pathname-directory-pathname px) :prefix prefix :type (pathname-type px)))) (get-temporary-file :directory directory :prefix prefix :type (pathname-type px)))) (defun call-with-staging-pathname (pathname fun) (defun call-with-staging-pathname (pathname fun) "Calls FUN with a staging pathname, and atomically "Calls FUN with a staging pathname, and atomically Loading Loading
uiop/stream.lisp +12 −10 Original line number Original line 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)) (check-type direction (member :output :io)) (assert (or want-stream-p want-pathname-p)) (assert (or want-stream-p want-pathname-p)) (loop (loop :with prefix = (native-namestring :with prefix-pn = (ensure-absolute-pathname (ensure-absolute-pathname (or prefix "tmp") (or prefix "tmp") (or (ensure-pathname directory :namestring :native :ensure-directory t) (or (ensure-pathname directory :namestring :native :ensure-directory t) #'temporary-directory)) #'temporary-directory))) :with prefix-nns = (native-namestring prefix-pn) :with results = () :with results = (progn (ensure-directories-exist prefix-pn) ()) :for counter :from (random (expt 36 #-gcl 8 #+gcl 5)) :for counter :from (random (expt 36 #-gcl 8 #+gcl 5)) :for pathname = (parse-native-namestring :for pathname = (parse-native-namestring (format nil "~A~36R~@[~A~]~@[.~A~]" (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 :for okp = nil :do ;; TODO: on Unix, do something about umask ;; TODO: on Unix, do something about umask ;; TODO: on Unix, audit the code so we make sure it uses O_CREAT|O_EXCL ;; 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? ;; Can we at least design some hook? (unwind-protect (unwind-protect (progn (progn (ensure-directories-exist pathname) (with-open-file (stream pathname (with-open-file (stream pathname :direction direction :direction direction :element-type element-type :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 A new empty file with said temporary pathname is created, to ensure there is no clash with any concurrent process attempting the same thing." clash with any concurrent process attempting the same thing." (let* ((px (ensure-pathname x)) (let* ((px (ensure-pathname x)) (prefix (if-let (n (pathname-name px)) (strcat n "-tmp") "tmp"))) (prefix (if-let (n (pathname-name px)) (strcat n "-tmp") "tmp")) (get-temporary-file (directory (translate-logical-pathname (pathname-directory-pathname px)))) :directory (pathname-directory-pathname px) :prefix prefix :type (pathname-type px)))) (get-temporary-file :directory directory :prefix prefix :type (pathname-type px)))) (defun call-with-staging-pathname (pathname fun) (defun call-with-staging-pathname (pathname fun) "Calls FUN with a staging pathname, and atomically "Calls FUN with a staging pathname, and atomically Loading