suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

call-with-atomic-output-file: option to make Windows moves more atomic

Browse Source 
It most cases, it's more important for `compiler/cm` to reliably
replace a file that might be busy than to make the file update atomic.
To suport that kind of use, `call-with-atomic-output-file` implemented
a fairly reliable, multi-step, non-atomic process for replacing a file
on Windows.

For recompilation of bytecode in machine-independent form, however,
`compiler/cm` now really wants to atomically write a replacement
bytecode file. That's not generally possible on Windows (except on
NTFS with transactions, which are discouraged...), but MoveFileEx work
atomically in some cases and it's likely to work for the cases needed
by `compiler/cm`. Probably.

So, add a mode to `call-with-atomic-output-file` to get "more atomic"
updates on Windows. This mode is enabled by a callback that makes the
caller responsible for deciding what to do with the move fails, such
as waiting a while and trying again. And `compiler/cm` now waits a
while and tries again, up to a limit, which should be good enough for
recompilation.
This commit is contained in:
Matthew Flatt 2018-11-27 08:35:00 -07:00
parent b68866db0f
commit 5f940e462e
3 changed files with 83 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
pkgs/racket-doc/scribblings/reference/filesystem.scrbl
View File

@ -1240,14 +1240,17 @@ needed.}
@defproc[(call-with-atomic-output-file [file path-string?]
[proc ([port output-port?] [tmp-path path?] . -> . any)]
[#:security-guard security-guard (or/c #f security-guard?) #f])
[#:security-guard security-guard (or/c #f security-guard?) #f]
[#:rename-fail-handler rename-fail-handler (or/c #f (exn:fail:filesystem? path> . -> . any)) #f])
any]{
Opens a temporary file for writing in the same directory as
@racket[file], calls @racket[proc] to write to the temporary file, and
then atomically moves the temporary file in place of @racket[file].
The atomic move simply uses @racket[rename-file-or-directory] on Unix
and Mac OS, but it uses an extra rename step (see below) on Windows
then atomically (except on Windows) moves the temporary file in place of @racket[file].
The move simply uses @racket[rename-file-or-directory] on Unix
and Mac OS, and it uses @racket[rename-file-or-directory] on Windows
if @racket[rename-fail-handler] is provided; otherwise, on Windows,
the moves uses an extra rename step (see below) on Windows
to avoid problems due to concurrent readers of @racket[file].
The @racket[proc] function is called with an output port for the
@ -1259,11 +1262,24 @@ temporary files on exceptions.
Windows prevents programs from deleting or replacing files that are
open, but it allows renaming of open files. Therefore, on Windows,
@racket[call-with-atomic-output-file] creates a second temporary file
@racket[_extra-tmp-file], renames @racket[file] to
@racket[call-with-atomic-output-file] by default creates a second
temporary file @racket[_extra-tmp-file], renames @racket[file] to
@racket[_extra-tmp-file], renames the temporary file written by
@racket[proc] to @racket[file], and finally deletes
@racket[_extra-tmp-file].}
@racket[_extra-tmp-file]. Since that process is not atomic, however,
@racket[rename-file-or-directory] is used if
@racket[rename-fail-handler] is provided, where
@racket[rename-file-or-directory] has some chance of being atomic,
since that the source and destination of the moves will be in the same
directory; any filesystem exception while attempting to rename the
file is send to @racket[rename-fail-handler], which can
re-@racket[raise] the exception or simply return to try again, perhaps
after a delay. In addition to a filesystem exception, the
@racket[rename-fail-handler] procedure also receives the temporary
file path to be moved to @racket[path]. The
@racket[rename-fail-handler] argument is used only on Windows.
@history[#:changed "7.1.0.6" @elem{Added the @racket[#:rename-fail-handler] argument.}]}
@defproc[(get-preference [name symbol?]

35
racket/collects/compiler/private/cm-minimal.rkt
View File

@ -173,7 +173,14 @@
;; Attempt to delete, but give up if it doesn't work:
(with-handlers ([exn:fail:filesystem? void])
(when noisy? (trace-printf "deleting ~a" path))
(with-compiler-security-guard (delete-file path))))
(with-compiler-security-guard (delete-file* path))))
(define (delete-file* path)
(if (eq? 'windows (system-type))
;; Using `delete-directory/files` tries deleting by first moving
;; to the temporary folder:
(delete-directory/files path #:must-exist? #f)
(delete-file path)))
(define (compilation-failure path->mode roots path zo-name keep-zo-name date-path reason)
(unless (equal? zo-name keep-zo-name)
@ -185,7 +192,29 @@
(call-with-atomic-output-file
path
#:security-guard (pick-security-guard)
proc))
proc
;; On Windows, if some other process/place is reading the file, then
;; an atomic move cannot succeed. Pause and try again, up to a point,
;; then give up on atomicity.
#:rename-fail-handler (let ([amt 0.01])
(lambda (exn tmp-path)
(cond
[(and amt
(eq? 'windows (system-type))
(exn:fail:filesystem:errno? exn)
(let ([errno (exn:fail:filesystem:errno-errno exn)])
(and (eq? 'windows (cdr errno))
(eqv? (car errno) 5)))) ; ERROR_ACCESS_DENIED
(cond
[(< amt 0.5)
(sleep amt)
(set! amt (* 2 amt))]
[else
;; Give up an atomicity
(try-delete-file path)
;; And give up on trying to handle errors
(set! amt #f)])]
[else (raise exn)])))))
(define-syntax-rule
(with-compiler-security-guard expr)
@ -1047,7 +1076,7 @@
(define to-delete (path-add-extension (get-compilation-path path->mode roots path) #".zo"))
(when (file-exists? to-delete)
(trace-printf "deleting: ~s" to-delete)
(with-compiler-security-guard (delete-file to-delete))))]
(with-compiler-security-guard (delete-file* to-delete))))]
[(if cp->m
(not (equal? (current-path->mode) cp->m))
(let ([current-cfp (use-compiled-file-paths)])

36
racket/collects/racket/file.rkt
View File

@ -235,7 +235,8 @@
;; the file is reliably deleted if there's a break.
(define (call-with-atomic-output-file path
proc
#:security-guard [guard #f])
#:security-guard [guard #f]
#:rename-fail-handler [rename-fail-handler #f])
(unless (path-string? path)
(raise-argument-error 'call-with-atomic-output-file "path-string?" path))
(unless (and (procedure? proc)
@ -244,6 +245,10 @@
(unless (or (not guard)
(security-guard? guard))
(raise-argument-error 'call-with-atomic-output-file "(or/c #f security-guard?)" guard))
(unless (or (not rename-fail-handler)
(procedure? rename-fail-handler)
(procedure-arity-includes? rename-fail-handler 2))
(raise-argument-error 'call-with-atomic-output-file "(or/c #f (procedure-arity-includes/c 2))" rename-fail-handler))
(define (try-delete-file path [noisy? #t])
;; Attempt to delete, but give up if it doesn't work:
(with-handlers ([exn:fail:filesystem? void])
@ -268,13 +273,28 @@
(lambda ()
(parameterize ([current-security-guard (or guard (current-security-guard))])
(if ok?
(if (eq? (system-type) 'windows)
(let ([tmp-path2 (make-temporary-file "tmp~a" #f (path-only path))])
(with-handlers ([exn:fail:filesystem? void])
(rename-file-or-directory path tmp-path2 #t))
(rename-file-or-directory tmp-path path #t)
(try-delete-file tmp-path2))
(rename-file-or-directory tmp-path path #t))
(with-handlers ([void (lambda (exn)
(try-delete-file tmp-path)
(raise exn))])
(if (eq? (system-type) 'windows)
(cond
[rename-fail-handler
(let loop ()
(with-handlers* ([exn:fail:filesystem?
(lambda (exn)
(call-with-break-parameterization
bp
(lambda () (rename-fail-handler exn tmp-path)))
(loop))])
(rename-file-or-directory tmp-path path #t)
void))]
[else
(let ([tmp-path2 (make-temporary-file "tmp~a" #f (path-only path))])
(with-handlers ([exn:fail:filesystem? void])
(rename-file-or-directory path tmp-path2 #t))
(rename-file-or-directory tmp-path path #t)
(try-delete-file tmp-path2))])
(rename-file-or-directory tmp-path path #t)))
(try-delete-file tmp-path)))))))
(define (with-pref-params thunk)