From 5f940e462e6d057ea065b8ae1e606db7d8ca75a9 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Tue, 27 Nov 2018 08:35:00 -0700 Subject: [PATCH] call-with-atomic-output-file: option to make Windows moves more atomic 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. --- .../scribblings/reference/filesystem.scrbl | 30 ++++++++++++---- .../collects/compiler/private/cm-minimal.rkt | 35 ++++++++++++++++-- racket/collects/racket/file.rkt | 36 ++++++++++++++----- 3 files changed, 83 insertions(+), 18 deletions(-) diff --git a/pkgs/racket-doc/scribblings/reference/filesystem.scrbl b/pkgs/racket-doc/scribblings/reference/filesystem.scrbl index 87ac4fdfbd..5c31f4c9c7 100644 --- a/pkgs/racket-doc/scribblings/reference/filesystem.scrbl +++ b/pkgs/racket-doc/scribblings/reference/filesystem.scrbl @@ -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?] diff --git a/racket/collects/compiler/private/cm-minimal.rkt b/racket/collects/compiler/private/cm-minimal.rkt index d7cc96e2fc..08ffdc63f0 100644 --- a/racket/collects/compiler/private/cm-minimal.rkt +++ b/racket/collects/compiler/private/cm-minimal.rkt @@ -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)]) diff --git a/racket/collects/racket/file.rkt b/racket/collects/racket/file.rkt index a9501e043c..dede15faf8 100644 --- a/racket/collects/racket/file.rkt +++ b/racket/collects/racket/file.rkt @@ -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)