mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-03 13:20:26 +02:00
Code Activity

rewrite ensure-writable-dir to not be racy

Browse source 
* 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
1 changed files with 20 additions and 9 deletions
Download patch file Download diff file Expand all files Collapse all files

29
module/system/base/compile.scm
View file

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