make raco distribute
work with non-writable exe
Closes PR 15214 Merge to v6.4
This commit is contained in:
parent
be82c27db3
commit
9498bdd80f
|
@ -11,7 +11,8 @@
|
||||||
"private/macfw.rkt"
|
"private/macfw.rkt"
|
||||||
"private/windlldir.rkt"
|
"private/windlldir.rkt"
|
||||||
"private/elf.rkt"
|
"private/elf.rkt"
|
||||||
"private/collects-path.rkt")
|
"private/collects-path.rkt"
|
||||||
|
"private/write-perm.rkt")
|
||||||
|
|
||||||
(provide assemble-distribution)
|
(provide assemble-distribution)
|
||||||
|
|
||||||
|
@ -59,6 +60,10 @@
|
||||||
orig-binaries
|
orig-binaries
|
||||||
sub-dirs
|
sub-dirs
|
||||||
types)]
|
types)]
|
||||||
|
[old-permss (and executables?
|
||||||
|
(eq? (system-type) 'unix)
|
||||||
|
(for/list ([b (in-list binaries)])
|
||||||
|
(ensure-writable b)))]
|
||||||
[single-mac-app? (and executables?
|
[single-mac-app? (and executables?
|
||||||
(eq? 'macosx (cross-system-type))
|
(eq? 'macosx (cross-system-type))
|
||||||
(= 1 (length types))
|
(= 1 (length types))
|
||||||
|
@ -150,6 +155,9 @@
|
||||||
exts-dir
|
exts-dir
|
||||||
relative-exts-dir
|
relative-exts-dir
|
||||||
relative->binary-relative)
|
relative->binary-relative)
|
||||||
|
;; Restore executable permissions:
|
||||||
|
(when old-permss
|
||||||
|
(map done-writable binaries old-permss))
|
||||||
;; Done!
|
;; Done!
|
||||||
(void))))))
|
(void))))))
|
||||||
|
|
||||||
|
|
|
@ -21,6 +21,7 @@
|
||||||
"private/pe-rsrc.rkt"
|
"private/pe-rsrc.rkt"
|
||||||
"private/collects-path.rkt"
|
"private/collects-path.rkt"
|
||||||
"private/configdir.rkt"
|
"private/configdir.rkt"
|
||||||
|
"private/write-perm.rkt"
|
||||||
"find-exe.rkt")
|
"find-exe.rkt")
|
||||||
|
|
||||||
|
|
||||||
|
@ -1804,20 +1805,3 @@
|
||||||
[(list? p) (map mac-mred-collects-path-adjust p)]
|
[(list? p) (map mac-mred-collects-path-adjust p)]
|
||||||
[(relative-path? p) (build-path 'up 'up 'up p)]
|
[(relative-path? p) (build-path 'up 'up 'up p)]
|
||||||
[else 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)))
|
|
||||||
|
|
21
racket/collects/compiler/private/write-perm.rkt
Normal file
21
racket/collects/compiler/private/write-perm.rkt
Normal file
|
@ -0,0 +1,21 @@
|
||||||
|
#lang racket/base
|
||||||
|
|
||||||
|
(provide ensure-writable
|
||||||
|
done-writable)
|
||||||
|
|
||||||
|
;; 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)))
|
Loading…
Reference in New Issue
Block a user