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

raco exe: fix handling of unwritable source executable

Browse Source 
Make the executable writable while it's patched for new content.

Closes PR 15008

Merge to v6.2
This commit is contained in:
Matthew Flatt 2015-04-28 15:27:33 -06:00
parent 423aa06426
commit 5affb68478
1 changed files with 20 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
racket/collects/compiler/embed.rkt
View File

@ -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)))