1#lang racket/base
2(require compiler/private/mach-o
3         setup/dirs)
4
5(provide adjust-dylib-path/install
6         adjust-dylib-path/uninstall)
7
8(define (adjust-dylib-path p adjust)
9  (cond
10   [(directory-exists? p)
11    ;; Find Mach-O files in the framework and adjust them:
12    (for ([f (in-list (directory-list p #:build? #t))])
13      (adjust-dylib-path f adjust))]
14   [(file-exists? p)
15    (define magic (call-with-input-file*
16                   p
17                   (lambda (i)
18                     (define bstr (read-bytes 4 i))
19                     (and (bytes? bstr)
20                          (= 4 (bytes-length bstr))
21                          (integer-bytes->integer bstr #f)))))
22    (case magic
23      [(#xfeedface #xfeedfacf)
24       ;; Found a Mach-o file; get a list of all referenced dylibs,
25       ;; and adjust each one:
26       (define libs (get/set-dylib-path p #rx"." #f))
27       (define-values (base name dir?) (split-path p))
28       (for ([lib (in-list libs)])
29         (define new-lib (adjust lib base))
30         (when new-lib
31           (get/set-dylib-path p (regexp-quote lib) new-lib)))])]))
32
33;; ----------------------------------------
34
35(define (adjust-dylib-path/install p)
36  (adjust-dylib-path p relative-to-absolute))
37
38(define (relative-to-absolute ref dir)
39  (and (regexp-match? #rx#"^@loader_path/" ref)
40       (let ()
41         (define p (bytes->path (subbytes ref 13)))
42         (and (not (file-exists? (build-path dir p)))
43              (for/or ([dir (in-list (get-lib-search-dirs))])
44                (define full-p (build-path dir p))
45                (and (file-exists? full-p)
46                     (path->bytes full-p)))))))
47
48;; ----------------------------------------
49
50(define (adjust-dylib-path/uninstall p)
51  (adjust-dylib-path p absolute-to-relative))
52
53(define (absolute-to-relative ref in-dir)
54  (for/or ([dir (in-list (get-lib-search-dirs))])
55    (define dir-bstr (path->bytes dir))
56    (and (regexp-match? (bytes-append #"^" (regexp-quote dir-bstr))
57                        ref)
58         (bytes-append #"@loader_path"
59                       (subbytes ref (bytes-length dir-bstr))))))
60