#lang racket/base (provide add-plt-segment get/set-dylib-path) (define exe-id (if (equal? (path->bytes (system-library-subpath #f)) #"x86_64-macosx") #xFeedFacf #xFeedFace)) (define (read-ulong p) (integer-bytes->integer (read-bytes 4 p) #f)) (define (read-xulong p) (integer-bytes->integer (read-bytes 8 p) #f)) (define (write-ulong v out) (display (integer->integer-bytes v 4 #f) out)) (define (write-xulong v out) (display (integer->integer-bytes v 8 #f) out)) (define (check-same a b) (unless (= a b) (error 'check-same "not: ~e ~e" a b))) (define (round-up-page v) (bitwise-and #xFFFFF000 (+ v #xFFF))) (define (mult-of-4 n) (let ([m (modulo n 4)]) (if (zero? m) n (+ n (- 4 m))))) (define move-link-edit? #t) (define (add-plt-segment file segdata) (let-values ([(p out) (open-input-output-file file #:exists 'update)]) (dynamic-wind void (lambda () (file-stream-buffer-mode out 'none) (check-same exe-id (read-ulong p)) (read-ulong p) (read-ulong p) (check-same #x2 (read-ulong p)) (let* ([cnt (read-ulong p)] [cmdssz (read-ulong p)] [min-used (round-up-page cmdssz)] [sym-tab-pos #f] [dysym-pos #f] [hints-pos #f] [link-edit-64? #f] [link-edit-pos #f] [link-edit-addr 0] [link-edit-offset 0] [link-edit-len 0] [dyld-info-pos #f] [dyld-info-offs #f]) ;; (printf "~a cmds, length 0x~x\n" cnt cmdssz) (read-ulong p) ; flags (when (equal? exe-id #xFeedFacf) (read-ulong p)) ; extra reserved word for 64-bit header (let loop ([cnt cnt]) (unless (zero? cnt) (let ([pos (file-position p)] [cmd (read-ulong p)] [sz (read-ulong p)]) ;; (printf "~x (~a)\n" cmd sz) (case cmd [(1 #x19) ; #x19 is 64-bit variant ;; Segment (let ([64? (equal? cmd #x19)]) (let ([segname (read-bytes 16 p)] [vmaddr ((if 64? read-xulong read-ulong) p)] [vmlen ((if 64? read-xulong read-ulong) p)] [offset ((if 64? read-xulong read-ulong) p)] [len ((if 64? read-xulong read-ulong) p)]) ;; (printf "~s\n" segname) (when (equal? segname #"__LINKEDIT\0\0\0\0\0\0") (set! link-edit-64? 64?) (set! link-edit-pos pos) (set! link-edit-addr vmaddr) (set! link-edit-offset offset) (set! link-edit-len len) (when (link-edit-len . < . 0) (error "bad LINKEDIT length"))) ;; (printf " 0x~x 0x~x -> 0x~x 0x~x\n" offset len vmaddr vmlen) (read-ulong p) (read-ulong p) (let ([nsects (read-ulong p)]) (read-ulong p) (let loop ([nsects nsects]) (unless (zero? nsects) (let ([sect (read-bytes 16 p)] [seg (read-bytes 16 p)] [vmaddr ((if 64? read-xulong read-ulong) p)] [vmsz ((if 64? read-xulong read-ulong) p)] [offset (read-ulong p)] [align (read-ulong p)] [reloff (read-ulong p)] [nreloc (read-ulong p)] [flags (read-ulong p)]) (when ((+ offset vmsz) . > . (+ cmdssz (if (equal? exe-id #xFeedFacf) 32 28))) (when (offset . < . min-used) ;; (printf " new min!\n") (set! min-used offset))) ;; (printf " ~s,~s 0x~x 0x~x\n" seg sect offset vmsz) (read-ulong p) (read-ulong p) (when 64? (read-ulong p))) (loop (sub1 nsects)))))))] [(2) ;; Symbol table (set! sym-tab-pos pos)] [(#xB) ;; Dysym (set! dysym-pos pos)] [(#x16) ;; 2-level hints table (set! hints-pos pos)] [(#x22 #x80000022) ;; LC_DYLD_INFO (let ([rebaseoff (read-ulong p)] [rebasesize (read-ulong p)] [bindoff (read-ulong p)] [bindsize (read-ulong p)] [weakbindoff (read-ulong p)] [weakbindsize (read-ulong p)] [lazybindoff (read-ulong p)] [lazybindsize (read-ulong p)] [exportbindoff (read-ulong p)] [exportbindsize (read-ulong p)]) (set! dyld-info-pos pos) (set! dyld-info-offs (vector bindoff weakbindoff lazybindoff exportbindoff)))] [else (void)]) (file-position p (+ pos sz)) (loop (sub1 cnt))))) ;; (printf "Start offset: 0x~x\n" min-used) (let ([end-cmd (+ cmdssz (if (equal? exe-id #xFeedFacf) 32 28))] [new-cmd-sz (if link-edit-64? 72 56)] [outlen (round-up-page (bytes-length segdata))] [out-offset (if move-link-edit? link-edit-offset (+ link-edit-offset (round-up-page link-edit-len)))] [out-addr (+ link-edit-addr (round-up-page link-edit-len))]) (unless ((+ end-cmd new-cmd-sz) . < . min-used) (error 'check-header "no room for a new section load command (current end is ~a; min used is ~a)" end-cmd min-used)) ;; Shift commands starting with link-edit command: (unless link-edit-pos (error "LINKEDIT not found")) (file-position p link-edit-pos) (let ([s (read-bytes (- end-cmd link-edit-pos) p)]) (file-position out (+ link-edit-pos new-cmd-sz)) (display s out)) (file-position out 16) ;; Increment the number of load commands: (write-ulong (+ cnt 1) out) (write-ulong (+ cmdssz new-cmd-sz) out) ;; Write the new command: (file-position out link-edit-pos) (write-ulong (if link-edit-64? #x19 1) out) ; LC_SEGMENT[_64] (write-ulong new-cmd-sz out) (display #"__PLTSCHEME\0\0\0\0\0" out) ((if link-edit-64? write-xulong write-ulong) out-addr out) ((if link-edit-64? write-xulong write-ulong) outlen out) ((if link-edit-64? write-xulong write-ulong) out-offset out) ((if link-edit-64? write-xulong write-ulong) outlen out) (write-ulong 0 out) (write-ulong 0 out) (write-ulong 0 out) (write-ulong 4 out) ; 4 means SG_NORELOC ;; Shift command positions (unless sym-tab-pos (error 'mach-o "symtab position not found")) (when (sym-tab-pos . > . link-edit-pos) (set! sym-tab-pos (+ sym-tab-pos new-cmd-sz))) (unless dysym-pos (error 'mach-o "dysym position not found")) (when (dysym-pos . > . link-edit-pos) (set! dysym-pos (+ dysym-pos new-cmd-sz))) (when hints-pos (when (hints-pos . > . link-edit-pos) (set! hints-pos (+ hints-pos new-cmd-sz)))) (set! link-edit-pos (+ link-edit-pos new-cmd-sz)) (when move-link-edit? ;; Update link-edit segment entry: (file-position out (+ link-edit-pos (if link-edit-64? 40 32))) ;; (printf "Update to ~a\n" (+ out-offset outlen)) ((if link-edit-64? write-xulong write-ulong) (+ out-offset outlen) out) ;; Read link-edit segment: (file-position p link-edit-offset) (let ([link-edit (read-bytes link-edit-len p)]) ;; Write link-edit data in new location: (file-position out (+ link-edit-offset outlen)) (display link-edit out)) ;; Shift symbol-table pointer: (file-position p (+ sym-tab-pos 8)) (let ([symtab-offset (read-ulong p)] [_ (read-ulong p)] [symstr-offset (read-ulong p)]) (file-position out (+ sym-tab-pos 8)) (write-ulong (+ symtab-offset outlen) out) (file-position out (+ sym-tab-pos 16)) (write-ulong (+ symstr-offset outlen) out)) ;; Shift dysym pointers: (for-each (lambda (delta) (file-position p (+ dysym-pos delta)) (let ([offset (read-ulong p)]) (unless (zero? offset) (file-position out (+ dysym-pos delta)) (write-ulong (+ offset outlen) out)))) '(32 40 48 56 64 72)) ;; Shift hints pointer: (when hints-pos (file-position p (+ hints-pos 8)) (let ([hints-offset (read-ulong p)]) (file-position out (+ hints-pos 8)) (write-ulong (+ hints-offset outlen) out))) ;; Shift dyld-info offs (when dyld-info-pos (let ([update (lambda (n) (unless (< (vector-ref dyld-info-offs n) out-offset) (file-position out (+ dyld-info-pos new-cmd-sz 16 (* n 8))) (write-ulong (+ (vector-ref dyld-info-offs n) outlen) out)))]) (update 0) (update 1) (update 2) (update 3)))) ;; Write segdata to former link-data offset: (file-position out out-offset) (display segdata out) (display (make-bytes (- outlen (bytes-length segdata)) 0) out) ;; Result is offset where data was written: out-offset))) (lambda () (close-input-port p) (close-output-port out))))) (define (fix-offset p pos out d base delta) (when (and out (not (zero? delta))) (file-position p (+ pos d)) (let ([offset (read-ulong p)]) (when (offset . > . base) (file-position out (+ pos d)) (write-ulong (+ offset delta) out) (flush-output out))))) (define (get/set-dylib-path file rx new-path) (let-values ([(p out) (if new-path (open-input-output-file file #:exists 'update) (values (open-input-file file) #f))]) (dynamic-wind void (lambda () (check-same exe-id (read-ulong p)) (read-ulong p) (read-ulong p) (check-same #x2 (read-ulong p)) (let* ([cnt (read-ulong p)] [cmdssz (read-ulong p)]) (read-ulong p) (when (equal? exe-id #xFeedFacf) (read-ulong p)) (let loop ([cnt cnt][base 0][delta 0][result #f]) (if (zero? cnt) result (let ([pos (file-position p)] [cmd (read-ulong p)] [sz (read-ulong p)]) (case cmd [(#xC) ;; LC_LOAD_DYLIB (let ([offset (read-ulong p)]) (file-position p (+ pos offset)) (let* ([namelen (- sz offset)] [segname (read-bytes namelen p)] [segname (car (regexp-match #rx#"^[^\0]*" segname))]) (if (regexp-match rx segname) (let* ([newnamelen (and out (mult-of-4 (+ 1 (bytes-length new-path))))] [delta (if out (- newnamelen namelen) 0)]) (when out (unless (zero? delta) ;; We assume that there's enough header room to ;; extend this load command, because the binary ;; was linked with -headerpad_max_install_names (file-position out (+ pos 4)) (write-ulong (+ sz delta) out) (flush-output out) ;; Shift rest of load commands by delta (let ([end (+ cmdssz 56)]) (file-position p (+ pos sz)) (let ([s (read-bytes (- end (+ pos sz)) p)]) (file-position out (+ pos sz delta)) (write-bytes s out) (when (negative? delta) ;; zero-out now-unneeded space: (write-bytes (make-bytes (- delta) 0) out)) (flush-output out)) ;; Change load-commands size in header: (file-position out 20) (write-ulong (+ cmdssz delta) out) (flush-output out))) (file-position out (+ pos offset)) (write-bytes new-path out) (write-bytes (make-bytes (- newnamelen (bytes-length new-path)) 0) out) (flush-output out)) (file-position p (+ pos sz delta)) (loop (sub1 cnt) pos delta segname)) (begin (file-position p (+ pos sz)) (loop (sub1 cnt) base delta result)))))] [else (file-position p (+ pos sz)) (loop (sub1 cnt) base delta result)])))))) (lambda () (close-input-port p) (when out (close-output-port out))))))