Commit 59bf377f authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

Fix tmpize-pathname to address race condition (lp#1483948).

Have it use ASDF3.1-era get-temporary-file instead of ASDF2-like
add-pathname-suffix, so if two cl-launch scripts try to compile
at the same time, it causes extra work but not failure or corruption
(at least on reasonable OS).

This does NOT address the issue of extensions that fail to use
tmpize-pathname and rename-file-overwriting-target.
parent 341fe1f3
......@@ -672,8 +672,7 @@ it will filter them appropriately."
(unless (use-ecl-byte-compiler-p)
(or object-file
#+ecl(compile-file-pathname output-file :type :object)
#+clasp (compile-file-pathname output-file :output-type :object)
)))
#+clasp (compile-file-pathname output-file :output-type :object))))
#+mkcl
(object-file
(or object-file
......
......@@ -584,7 +584,8 @@ Finally, the file will be deleted, unless the KEEP argument when CALL-FUNCTION'e
:with results = ()
:for counter :from (random (expt 36 #-gcl 8 #+gcl 5))
:for pathname = (parse-native-namestring
(format nil "~A~36R~@[~A~]~@[.~A~]" prefix counter suffix type))
(format nil "~A~36R~@[~A~]~@[.~A~]"
prefix 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
......@@ -672,8 +673,13 @@ Further KEYS can be passed to MAKE-PATHNAME."
:defaults pathname keys))
(defun tmpize-pathname (x)
"Return a new pathname modified from X by adding a trivial deterministic suffix"
(add-pathname-suffix x "-TMP"))
"Return a new pathname modified from X by adding a trivial random suffix.
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))))
(defun call-with-staging-pathname (pathname fun)
"Calls FUN with a staging pathname, and atomically
......@@ -691,4 +697,3 @@ For the latter case, we ought pick a random suffix and atomically open it."
(defmacro with-staging-pathname ((pathname-var &optional (pathname-value pathname-var)) &body body)
"Trivial syntax wrapper for CALL-WITH-STAGING-PATHNAME"
`(call-with-staging-pathname ,pathname-value #'(lambda (,pathname-var) ,@body))))
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment