diff --git a/pkgs/racket-doc/scribblings/reference/filesystem.scrbl b/pkgs/racket-doc/scribblings/reference/filesystem.scrbl index 25fb12de9e..87ac4fdfbd 100644 --- a/pkgs/racket-doc/scribblings/reference/filesystem.scrbl +++ b/pkgs/racket-doc/scribblings/reference/filesystem.scrbl @@ -303,6 +303,16 @@ permission change if the deletion fails. On Windows, @racket[delete-file] can delete a symbolic link, but not a junction. Use @racket[delete-directory] to delete a junction. +On Windows, beware that if a file is deleted while it remains in use +by some process (e.g., a background search indexer), then the file's +content will eventually go away, but the file's name remains occupied +until the file is no longer used. As long as the name remains +occupied, attempts to open, delete, or replace the file will trigger a +permission error (as opposed to a file-exists error). A common +technique to avoid this pitfall is to move the file to a generated +temporary name before deleting it. See also +@racket[delete-directory/files]. + @history[#:changed "6.1.1.7" @elem{Changed Windows behavior to use @racket[current-force-delete-permissions].}]} @@ -332,7 +342,16 @@ typically fail on Windows. See also @racket[call-with-atomic-output-file]. If @racket[old] is a link, the link is renamed rather than the destination of the link, and it counts as a file for replacing any -existing @racket[new].} +existing @racket[new]. + +On Windows, beware that a directory cannot be renamed if any file +within the directory is open. That constraint is particularly +problematic if a search indexer is running in the background (as in +the default Windows configuration). A possible workaround is to +combine @racket[copy-directory/files] and +@racket[delete-directory/files], since the latter can deal with open +files, although that sequence is obviously not atomic and temporarily +duplicates files.} @defproc*[([(file-or-directory-modify-seconds [path path-string?] @@ -1001,7 +1020,17 @@ raised if @racket[path] does not exist. If @racket[must-exist?] is false, then @racket[delete-directory/files] succeeds if @racket[path] does not exist (but a failure is possible if @racket[path] initially exists and is removed by another thread or process before -@racket[delete-directory/files] deletes it).} +@racket[delete-directory/files] deletes it). + +On Windows, @racket[delete-directory/files] attempts to move a file +into the temporary-file directory before deleting it, which avoids +problems caused by deleting a file that is currently open (e.g., by a +search indexer running as a background process). If the move attempt +fails (e.g., because the temporary directory is on a different drive +than the file), then the file is deleted directly with +@racket[delete-file]. + +@history[#:changed "7.0" @elem{Added Windows-specific file deletion.}]} @defproc[(find-files [predicate (path? . -> . any/c)] diff --git a/racket/collects/pkg/private/path.rkt b/racket/collects/pkg/private/path.rkt index feaeaa1a1b..ad302b1a27 100644 --- a/racket/collects/pkg/private/path.rkt +++ b/racket/collects/pkg/private/path.rkt @@ -2,7 +2,8 @@ (require racket/path racket/file racket/list - racket/function) + racket/function + "rename-dir.rkt") (provide (all-defined-out)) @@ -55,15 +56,15 @@ ;; pick a new name: (loop (string->path (format "sub~a" i)) (add1 i))] [(not (equal? sub orig-sub)) - (rename-file-or-directory (build-path pkg-dir orig-sub) - (build-path pkg-dir sub)) + (rename-directory (build-path pkg-dir orig-sub) + (build-path pkg-dir sub)) sub] [else sub]))) ;; Move content of `sub` out: (define sub-path (apply build-path (cons sub (cdr path)))) (for ([f (in-list sub-l)]) - (rename-file-or-directory (build-path pkg-dir sub-path f) - (build-path pkg-dir f))) + (rename-directory (build-path pkg-dir sub-path f) + (build-path pkg-dir f))) ;; Remove directory that we moved files out of: (delete-directory/files (build-path pkg-dir sub))) diff --git a/racket/collects/pkg/private/remove.rkt b/racket/collects/pkg/private/remove.rkt index 18ad59db28..18b00183a8 100644 --- a/racket/collects/pkg/private/remove.rkt +++ b/racket/collects/pkg/private/remove.rkt @@ -11,7 +11,8 @@ "params.rkt" "print.rkt" "get-info.rkt" - "trash.rkt") + "trash.rkt" + "rename-dir.rkt") (provide remove-package pkg-remove) @@ -64,7 +65,7 @@ (select-trash-dest pkg-name)) => (lambda (trash-dest) (printf/flush "Moving ~a to trash: ~a\n" pkg-name trash-dest) - (rename-file-or-directory pkg-dir trash-dest))] + (rename-directory pkg-dir trash-dest))] [else (delete-directory/files pkg-dir)])]))) diff --git a/racket/collects/pkg/private/rename-dir.rkt b/racket/collects/pkg/private/rename-dir.rkt new file mode 100644 index 0000000000..5b81b8e4ec --- /dev/null +++ b/racket/collects/pkg/private/rename-dir.rkt @@ -0,0 +1,24 @@ +#lang racket/base +(require racket/file) + +(provide rename-directory) + +(define (rename-directory old-path new-path) + (cond + [(eq? 'windows (system-type)) + (with-handlers* ([(lambda (exn) + (and (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 + (lambda (exn) + ;; ERROR_ACCESS_DENIED can mean that a file within the + ;; directory is open. We can't just rename the directory + ;; in that case, but we can copy it. + (copy-directory/files old-path new-path + #:keep-modify-seconds? #t + #:preserve-links? #t) + (delete-directory/files old-path))]) + (rename-file-or-directory old-path new-path))] + [else + (rename-file-or-directory old-path new-path)])) diff --git a/racket/collects/racket/file.rkt b/racket/collects/racket/file.rkt index ffc28d1df6..a9501e043c 100644 --- a/racket/collects/racket/file.rkt +++ b/racket/collects/racket/file.rkt @@ -53,7 +53,7 @@ (let loop ([path path]) (cond [(or (link-exists? path) (file-exists? path)) - (delete-file path)] + (delete-file* path)] [(directory-exists? path) (for-each (lambda (e) (loop (build-path path e))) (directory-list path)) @@ -62,6 +62,24 @@ (when must-exist? (raise-not-a-file-or-directory 'delete-directory/files path))]))) +(define (delete-file* path) + (cond + [(eq? 'windows (system-type)) + ;; Deleting a file doesn't remove the file name from the + ;; parent directory until all references are closed, and + ;; other processes (like the search indexer) might open + ;; files. So, try to move a file to the temp directory, + ;; then delete from there. That way, the enclosing directory + ;; can still be deleted. The move might fail if the + ;; temp directory is on a different volume, though. + (define tmp (make-temporary-file)) + (unless (with-handlers ([exn:fail:filesystem? (lambda (x) #f)]) + (rename-file-or-directory path tmp #t) + #t) + (delete-file path)) + (delete-file tmp)] + [else (delete-file path)])) + (define (raise-not-a-file-or-directory who path) (raise (make-exn:fail:filesystem @@ -172,16 +190,35 @@ base-dir)) (let ([tmpdir (find-system-path 'temp-dir)]) (let loop ([s (current-seconds)] - [ms (inexact->exact (truncate (current-inexact-milliseconds)))]) + [ms (inexact->exact (truncate (current-inexact-milliseconds)))] + [tries 0]) (let ([name (let ([n (format template (format "~a~a" s ms))]) (cond [base-dir (build-path base-dir n)] [(relative-path? n) (build-path tmpdir n)] [else n]))]) - (with-handlers ([exn:fail:filesystem:exists? + (with-handlers ([(lambda (exn) + (or (exn:fail:filesystem:exists? exn) + (and (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 + ;; On Windows, if the target path refers to a file + ;; that has been deleted but is still open + ;; somehere, then an access-denied error is reported + ;; instead of a file-exists error; there appears + ;; to be no way to detect that it was really a + ;; file-still-exists error. Try again for a while. + ;; There's still a small chance that this will + ;; fail, but it's vanishingly small at 32 tries. + ;; If ERROR_ACCESS_DENIED really is the right + ;; error (e.g., because the target directory is not + ;; writable), we'll take longer to get there. + (tries . < . 32)))))) (lambda (x) ;; try again with a new name (loop (- s (random 10)) - (+ ms (random 10))))]) + (+ ms (random 10)) + (add1 tries)))]) (if copy-from (if (eq? copy-from 'directory) (make-directory name) diff --git a/racket/src/rktio/rktio_fs.c b/racket/src/rktio/rktio_fs.c index eb967911b5..8fee4fc672 100644 --- a/racket/src/rktio/rktio_fs.c +++ b/racket/src/rktio/rktio_fs.c @@ -699,7 +699,7 @@ static rktio_identity_t *get_identity(rktio_t *rktio, rktio_fd_t *fd, const char if (!wp) return 0; fdh = CreateFileW(wp, 0, /* not even read access => just get info */ - FILE_SHARE_READ | FILE_SHARE_WRITE, + FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE, NULL, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS