From 5affb68478efa0b5b580f45f9fcbb118e4894a39 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Tue, 28 Apr 2015 15:27:33 -0600 Subject: [PATCH] raco exe: fix handling of unwritable source executable Make the executable writable while it's patched for new content. Closes PR 15008 Merge to v6.2 --- racket/collects/compiler/embed.rkt | 21 ++++++++++++++++++++- 1 file changed, 20 insertions(+), 1 deletion(-) diff --git a/racket/collects/compiler/embed.rkt b/racket/collects/compiler/embed.rkt index df735ed3b1..4a4afdd7e1 100644 --- a/racket/collects/compiler/embed.rkt +++ b/racket/collects/compiler/embed.rkt @@ -1358,6 +1358,7 @@ (when (file-exists? dest) (delete-file dest))) (raise x))]) + (define old-perms (ensure-writable dest-exe)) (when (and (eq? 'macosx (system-type)) (not unix-starter?)) (let ([m (or (assq 'framework-root aux) @@ -1654,7 +1655,8 @@ (let ([m (and (eq? 'windows (system-type)) (assq 'subsystem aux))]) (when m - (set-subsystem dest-exe (cdr m)))))]))))))))) + (set-subsystem dest-exe (cdr m)))))])))) + (done-writable dest-exe old-perms)))))) ;; For Mac OS X GRacket, the actual executable is deep inside the ;; nominal executable bundle @@ -1664,3 +1666,20 @@ [(list? p) (map mac-mred-collects-path-adjust p)] [(relative-path? p) (build-path 'up 'up 'up p)] [else p])) + +;; Returns #f (no change needed) or old permissions +(define (ensure-writable dest-exe) + (cond + [(member 'write (file-or-directory-permissions dest-exe)) + ;; No change needed + #f] + [else + (define old-perms + (file-or-directory-permissions dest-exe 'bits)) + (file-or-directory-permissions dest-exe (bitwise-ior old-perms #o200)) + old-perms])) + +;; Restores old permissions (if not #f) +(define (done-writable dest-exe old-perms) + (when old-perms + (file-or-directory-permissions dest-exe old-perms)))