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

raco dist: signing repairs for ARM Mac OS

Browse Source
This commit is contained in:
Matthew Flatt 2020-12-22 15:55:47 -07:00
parent d7e9628caf
commit cc9fc20a07
3 changed files with 128 additions and 109 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
pkgs/compiler-test/tests/compiler/embed/test.rkt
View File

@ -67,7 +67,7 @@
(define (prepare exe src) (define (prepare exe src)
(printf/flush "Making ~a with ~a...\n" exe src) (printf/flush "Making ~a with ~a...\n" exe src)
(when (file-exists? exe) (when (file-exists? exe)
(call-with-retries (lambda () (delete-file exe))))) (call-with-retries (lambda () (delete-file exe)))))
(define (try-one-exe exe expect mred?) (define (try-one-exe exe expect mred?)
(printf/flush "Running ~a\n" exe) (printf/flush "Running ~a\n" exe)

19
racket/collects/compiler/distribute.rkt
View File

@ -8,6 +8,7 @@
pkg/path pkg/path
setup/main-collects setup/main-collects
"private/macfw.rkt" "private/macfw.rkt"
"private/mach-o.rkt"
"private/windlldir.rkt" "private/windlldir.rkt"
"private/elf.rkt" "private/elf.rkt"
"private/collects-path.rkt" "private/collects-path.rkt"
@ -132,6 +133,9 @@
(build-path collects-dir f))) (build-path collects-dir f)))
(directory-list dir))) (directory-list dir)))
copy-collects) copy-collects)
;; Remove signatures, if any
(when (eq? 'macosx (cross-system-type))
(for-each remove-signature binaries))
;; Patch binaries to find libs ;; Patch binaries to find libs
(when executables? (when executables?
(patch-binaries binaries types)) (patch-binaries binaries types))
@ -169,6 +173,9 @@
exts-dir exts-dir
relative-exts-dir relative-exts-dir
relative->binary-relative) relative->binary-relative)
;; Add signatures, if needed
(when (eq? 'macosx (cross-system-type))
(for-each add-ad-hoc-signature binaries))
;; Restore executable permissions: ;; Restore executable permissions:
(when old-permss (when old-permss
(map done-writable binaries old-permss)) (map done-writable binaries old-permss))
@ -307,15 +314,15 @@
(memq (car types) '(gracketcgc gracket3m gracketcs))) (memq (car types) '(gracketcgc gracket3m gracketcs)))
;; Special case for single GRacket app: ;; Special case for single GRacket app:
(update-framework-path "@executable_path/../Frameworks/" (update-framework-path "@executable_path/../Frameworks/"
(car binaries) (car binaries)
#t) #t)
;; General case: ;; General case:
(for-each (lambda (b type) (for-each (lambda (b type)
(update-framework-path (if (memq type '(racketcgc racket3m racketcs)) (update-framework-path (if (memq type '(racketcgc racket3m racketcs))
"@executable_path/../lib/" "@executable_path/../lib/"
"@executable_path/../../../lib/" ) "@executable_path/../../../lib/" )
b b
(memq type '(gracketcgc gracket3m gracketcs)))) (memq type '(gracketcgc gracket3m gracketcs))))
binaries types))] binaries types))]
[(unix) [(unix)
(for-each (lambda (b type) (for-each (lambda (b type)

216
racket/collects/compiler/private/mach-o.rkt
View File

@ -290,108 +290,120 @@
;; Adjust the number of load commands: ;; Adjust the number of load commands:
(write-ulong (+ total-cnt (if segdata 1 0) (if code-signature-pos -1 0)) out) (write-ulong (+ total-cnt (if segdata 1 0) (if code-signature-pos -1 0)) out)
(write-ulong (+ cmdssz (- code-signature-lc-sz) new-cmd-sz) out) (write-ulong (+ cmdssz (- code-signature-lc-sz) new-cmd-sz) out)
(when segdata (cond
;; Write the new command: [segdata
(file-position out link-edit-pos) ;; Write the new command:
(write-ulong (if link-edit-64? #x19 1) out) ; LC_SEGMENT[_64] (file-position out link-edit-pos)
(write-ulong new-cmd-sz out) (write-ulong (if link-edit-64? #x19 1) out) ; LC_SEGMENT[_64]
(display (pad-segment-name segment-name) out) (write-ulong new-cmd-sz out)
((if link-edit-64? write-xulong write-ulong) out-addr out) (display (pad-segment-name segment-name) out)
((if link-edit-64? write-xulong write-ulong) outlen out) ((if link-edit-64? write-xulong write-ulong) out-addr out)
((if link-edit-64? write-xulong write-ulong) out-offset out) ((if link-edit-64? write-xulong write-ulong) outlen out)
((if link-edit-64? write-xulong write-ulong) outlen out) ((if link-edit-64? write-xulong write-ulong) out-offset out)
(write-ulong 0 out) ; maxprot ((if link-edit-64? write-xulong write-ulong) outlen out)
(write-ulong 0 out) ; minprot (write-ulong 0 out) ; maxprot
(write-ulong 0 out) (write-ulong 0 out) ; minprot
(write-ulong 4 out) ; 4 means SG_NORELOC (write-ulong 0 out)
;; Shift command positions (write-ulong 4 out) ; 4 means SG_NORELOC
(unless sym-tab-pos ;; Shift command positions
(error 'mach-o "symtab position not found")) (unless sym-tab-pos
(when (sym-tab-pos . > . link-edit-pos) (error 'mach-o "symtab position not found"))
(set! sym-tab-pos (+ sym-tab-pos new-cmd-sz))) (when (sym-tab-pos . > . link-edit-pos)
(unless dysym-pos (set! sym-tab-pos (+ sym-tab-pos new-cmd-sz)))
(error 'mach-o "dysym position not found")) (unless dysym-pos
(when (dysym-pos . > . link-edit-pos) (error 'mach-o "dysym position not found"))
(set! dysym-pos (+ dysym-pos new-cmd-sz))) (when (dysym-pos . > . link-edit-pos)
(when hints-pos (set! dysym-pos (+ dysym-pos new-cmd-sz)))
(when (hints-pos . > . link-edit-pos) (when hints-pos
(set! hints-pos (+ hints-pos new-cmd-sz)))) (when (hints-pos . > . link-edit-pos)
(when function-starts-pos (set! hints-pos (+ hints-pos new-cmd-sz))))
(when (function-starts-pos . > . link-edit-pos) (when function-starts-pos
(set! function-starts-pos (+ function-starts-pos new-cmd-sz)))) (when (function-starts-pos . > . link-edit-pos)
(when data-in-code-pos (set! function-starts-pos (+ function-starts-pos new-cmd-sz))))
(when (data-in-code-pos . > . link-edit-pos) (when data-in-code-pos
(set! data-in-code-pos (+ data-in-code-pos new-cmd-sz)))) (when (data-in-code-pos . > . link-edit-pos)
(when code-sign-drs-pos (set! data-in-code-pos (+ data-in-code-pos new-cmd-sz))))
(when (code-sign-drs-pos . > . link-edit-pos) (when code-sign-drs-pos
(set! code-sign-drs-pos (+ code-sign-drs-pos new-cmd-sz)))) (when (code-sign-drs-pos . > . link-edit-pos)
(set! link-edit-pos (+ link-edit-pos new-cmd-sz)) (set! code-sign-drs-pos (+ code-sign-drs-pos new-cmd-sz))))
(when move-link-edit? (set! link-edit-pos (+ link-edit-pos new-cmd-sz))
;; Update link-edit segment entry: (when move-link-edit?
(file-position out (+ link-edit-pos 24)) ;; Update link-edit segment entry:
((if link-edit-64? write-xulong write-ulong) (+ link-edit-addr outlen) out) (file-position out (+ link-edit-pos 24))
((if link-edit-64? write-xulong write-ulong) link-edit-vmlen out) ((if link-edit-64? write-xulong write-ulong) (+ link-edit-addr outlen) out)
;; (printf "Update to ~a\n" (+ out-offset outlen)) ((if link-edit-64? write-xulong write-ulong) link-edit-vmlen out)
((if link-edit-64? write-xulong write-ulong) (+ out-offset outlen) out) ;; (printf "Update to ~a\n" (+ out-offset outlen))
((if link-edit-64? write-xulong write-ulong) (- link-edit-len code-signature-size) out) ((if link-edit-64? write-xulong write-ulong) (+ out-offset outlen) out)
;; Read link-edit segment: ((if link-edit-64? write-xulong write-ulong) (- link-edit-len code-signature-size) out)
(file-position p link-edit-offset) ;; Read link-edit segment:
(let ([link-edit (read-bytes (- link-edit-len code-signature-size) p)]) (file-position p link-edit-offset)
;; Write link-edit data in new location: (let ([link-edit (read-bytes (- link-edit-len code-signature-size) p)])
(file-position out (+ link-edit-offset outlen)) ;; Write link-edit data in new location:
(display link-edit out)) (file-position out (+ link-edit-offset outlen))
;; Shift symbol-table pointer: (display link-edit out))
(file-position p (+ sym-tab-pos 8)) ;; Shift symbol-table pointer:
(let ([symtab-offset (read-ulong p)] (file-position p (+ sym-tab-pos 8))
[_ (read-ulong p)] (let ([symtab-offset (read-ulong p)]
[symstr-offset (read-ulong p)]) [_ (read-ulong p)]
(file-position out (+ sym-tab-pos 8)) [symstr-offset (read-ulong p)])
(write-ulong (+ symtab-offset outlen) out) (file-position out (+ sym-tab-pos 8))
(file-position out (+ sym-tab-pos 16)) (write-ulong (+ symtab-offset outlen) out)
(write-ulong (+ symstr-offset outlen) out)) (file-position out (+ sym-tab-pos 16))
;; Shift dysym pointers: (write-ulong (+ symstr-offset outlen) out))
(for-each (lambda (delta) ;; Shift dysym pointers:
(file-position p (+ dysym-pos delta)) (for-each (lambda (delta)
(let ([offset (read-ulong p)]) (file-position p (+ dysym-pos delta))
(unless (zero? offset) (let ([offset (read-ulong p)])
(file-position out (+ dysym-pos delta)) (unless (zero? offset)
(write-ulong (+ offset outlen) out)))) (file-position out (+ dysym-pos delta))
'(32 40 48 56 64 72)) (write-ulong (+ offset outlen) out))))
;; Shift hints pointer: '(32 40 48 56 64 72))
(when hints-pos ;; Shift hints pointer:
(file-position p (+ hints-pos 8)) (when hints-pos
(let ([hints-offset (read-ulong p)]) (file-position p (+ hints-pos 8))
(file-position out (+ hints-pos 8)) (let ([hints-offset (read-ulong p)])
(write-ulong (+ hints-offset outlen) out))) (file-position out (+ hints-pos 8))
;; Shift function starts: (write-ulong (+ hints-offset outlen) out)))
(when function-starts-pos ;; Shift function starts:
(file-position p (+ function-starts-pos 8)) (when function-starts-pos
(write-ulong (+ function-starts-offset outlen) out)) (file-position p (+ function-starts-pos 8))
;; Shift data-in-code: (write-ulong (+ function-starts-offset outlen) out))
(when data-in-code-pos ;; Shift data-in-code:
(file-position p (+ data-in-code-pos 8)) (when data-in-code-pos
(write-ulong (+ data-in-code-offset outlen) out)) (file-position p (+ data-in-code-pos 8))
;; Shift code-sign drs: (write-ulong (+ data-in-code-offset outlen) out))
(when code-sign-drs-pos ;; Shift code-sign drs:
(file-position p (+ code-sign-drs-pos 8)) (when code-sign-drs-pos
(write-ulong (+ code-sign-drs-offset outlen) out)) (file-position p (+ code-sign-drs-pos 8))
;; Shift dyld-info offs (write-ulong (+ code-sign-drs-offset outlen) out))
(when dyld-info-pos ;; Shift dyld-info offs
(let ([update (lambda (n) (when dyld-info-pos
(unless (< (vector-ref dyld-info-offs n) out-offset) (let ([update (lambda (n)
(file-position out (+ dyld-info-pos new-cmd-sz 8 (* n 8))) (unless (< (vector-ref dyld-info-offs n) out-offset)
(write-ulong (+ (vector-ref dyld-info-offs n) outlen) out)))]) (file-position out (+ dyld-info-pos new-cmd-sz 8 (* n 8)))
(update 0) (write-ulong (+ (vector-ref dyld-info-offs n) outlen) out)))])
(update 1) (update 0)
(update 2) (update 1)
(update 3) (update 2)
(update 4)))) (update 3)
;; Write segdata to former link-data offset: (update 4))))
(file-position out out-offset) ;; Write segdata to former link-data offset:
(display segdata out) (file-position out out-offset)
(display (make-bytes (- outlen (bytes-length segdata)) 0) out)) (display segdata out)
;; Adjust file size (display (make-bytes (- outlen (bytes-length segdata)) 0) out)
(file-truncate out (+ link-edit-offset link-edit-len (- code-signature-size) outlen)) ;; Adjust file size
(file-truncate out (+ link-edit-offset link-edit-len (- code-signature-size) outlen))]
[code-signature-pos
;; Shrink linkedit size, since signature is going away
(let* ([file-pos (+ link-edit-pos 8 16 (* 1 (if link-edit-64? 8 4)))]
[link-edit-len (- linkedit-limit-offset link-edit-offset)]
[link-edit-vm-len (round-up-page link-edit-len machine-id)])
(file-position out file-pos)
((if link-edit-64? write-xulong write-ulong) link-edit-vmlen out)
(file-position out (+ file-pos (* 2 (if link-edit-64? 8 4))))
((if link-edit-64? write-xulong write-ulong) link-edit-len out)
;; Adjust file size
(file-truncate out (+ link-edit-offset link-edit-len)))])
;; Result is offset where data was written: ;; Result is offset where data was written:
out-offset)))) out-offset))))
(lambda () (lambda ()