1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00

rewrite ensure-writable-dir to not be racy

* module/system/base/compile.scm (ensure-writable-dir): Rewrite to not
  be racy.
This commit is contained in:
Andy Wingo 2011-03-29 11:40:05 +02:00
parent 9dadfa47b0
commit 56dbc8a899

View file

@ -68,16 +68,27 @@
x
(lookup-language x)))
;; Throws an exception if `dir' is not writable. The double-stat is OK,
;; as this is only used during compilation.
;; Throws an exception if `dir' is not writable. The mkdir occurs
;; before the check, so that we avoid races (possibly due to parallel
;; compilation).
;;
(define (ensure-writable-dir dir)
(if (file-exists? dir)
(if (access? dir W_OK)
#t
(error "directory not writable" dir))
(begin
(ensure-writable-dir (dirname dir))
(mkdir dir))))
(catch 'system-error
(lambda ()
(mkdir dir))
(lambda (k subr fmt args rest)
(let ((errno (and (pair? rest) (car rest))))
(cond
((eqv? errno EEXIST)
(let ((st (stat dir)))
(if (or (not (eq? (stat:type st) 'directory))
(not (access? dir W_OK)))
(error "directory not writable" dir))))
((eqv? errno ENOENT)
(ensure-writable-dir (dirname dir))
(ensure-writable-dir dir))
(else
(throw k subr fmt args rest)))))))
;;; This function is among the trickiest I've ever written. I tried many
;;; variants. In the end, simple is best, of course.