raco setup: fix ".dylib" references on install

If a Mach-O file installed with `{copy,move}-foreign-libs` has a
"@loader_path/" reference to a library that is installed in a
different target directory (normally because it's from a package that
is installed in a different scope), then change "@loader_path/" to an
absolute-path reference to that target.

pkgs/racket-pkgs/racket-doc/pkg/scribblings/strip.scrbl

@@ -192,15 +192,18 @@ package}, it performs the @filepath{.html} file updating of a
 (added if it does not exist already) is adjusted to define
 @racket[package-content-state] as @racket[(list 'built (version))].
 
-Finally, creating a @tech{binary package}, @tech{binary library package},
+Finally, creating a @tech{binary package}, @tech{binary library
-or @tech{built package}
+package}, or @tech{built package} ``unmoves'' files that were
-``unmoves'' files that were installed via @racket[move-foreign-libs],
+installed via @racket[move-foreign-libs], @racket[move-shared-files],
-@racket[move-shared-files], or @racket[move-man-pages] definitions in
+or @racket[move-man-pages] definitions in an @filepath{info.rkt} file,
-an @filepath{info.rkt} file, retrieving them if they are not present
+retrieving them if they are not present at referenced location but are
-at referenced location but are present in a user-specific target
+present in a user-specific target directory (i.e., the directory
-directory (i.e., the directory reported by @racket[find-user-lib-dir],
+reported by @racket[find-user-lib-dir], @racket[find-user-share-dir],
-@racket[find-user-share-dir], or @racket[find-user-man-dir],
+or @racket[find-user-man-dir], respectively). On Mac OS X, when an
-respectively).
+unmoved file for @racket[move-foreign-libs] is a Mach-O file that
+includes a reference to another library in one of the directories reported by
+@racket[(get-lib-search-dirs)], then the reference is changed to a
+@litchar{@"@"loader_path/} reference.
 
 @defmodule[pkg/strip]{The @racketmodname[pkg/strip] module provides
 support for copying a package-style directory to a given destination

pkgs/racket-pkgs/racket-doc/scribblings/raco/setup.scrbl

@@ -608,7 +608,13 @@ Optional @filepath{info.rkt} fields trigger additional actions by
    path-string? relative-path?))] --- Files to copy into a
    directory where foreign libraries are found by @racket[ffi-lib].
    If @racket[install-platform] is defined, then the files are copied
-   only if the current platform matches the definition.}
+   only if the current platform matches the definition.
+
+   On Mac OS X, when a Mach-O file is copied, if the copied file
+   includes a library reference that starts @litchar{@"@"loader_path/},
+   and if the referenced library exists in a different location among
+   the paths listed by @racket[(get-lib-search-dirs)], then the
+   library reference is updated to an absolute path.}
 
  @item{@indexed-racket[move-foreign-libs] : @racket[(listof (and/c
    path-string? relative-path?))] --- Like @racket[copy-foreign-libs],

racket/collects/compiler/private/macfw.rkt

@@ -42,8 +42,8 @@
     (let ([v (get/set-dylib-path dest
 				 (byte-regexp (string->bytes/utf-8 p))
 				 #f)])
-      (if v
+      (if (pair? v)
-	  (bytes->string/utf-8 v)
+	  (bytes->string/utf-8 (car v))
 	  (begin
             (eprintf "warning: cannot find existing link for ~a in ~a\n"
                      p dest)

racket/collects/compiler/private/mach-o.rkt

@@ -357,13 +357,13 @@
           (check-same exe-id (read-ulong p))
           (read-ulong p)
           (read-ulong p)
-          (check-same #x2 (read-ulong p))
+          (read-ulong p) ; 2 is executable, etc.
           (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])
+            (let loop ([cnt cnt] [base 0] [delta 0] [result null])
               (if (zero? cnt)
                   result
                   (let ([pos (file-position p)]
@@ -410,7 +410,7 @@
                                    (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))
+                                 (loop (sub1 cnt) pos delta (cons segname result)))
                                (begin
                                  (file-position p (+ pos sz))
                                  (loop (sub1 cnt) base delta result)))))]

racket/collects/pkg/strip.rkt

@@ -8,7 +8,8 @@
          racket/path
          racket/list
          racket/set
-         racket/format)
+         racket/format
+         setup/private/dylib)
 
 (provide generate-stripped-directory
          fixup-local-redirect-reference
@@ -407,7 +408,7 @@
         (unmove d (build-path dest-dir f)))))
   (define (unmove dir dest-dir)
     (define info (get-info/full dir #:namespace metadata-ns))
-    (define (unmove-tag tag find-dir)
+    (define (unmove-tag tag find-dir fixup)
       (when info
         (define l (info tag (lambda () null)))
         (for ([f (in-list l)])
@@ -415,11 +416,17 @@
                      (not (directory-exists? (build-path dir f)))
                      (or (file-exists? (build-path (find-dir) f))
                          (directory-exists? (build-path (find-dir) f))))
+            (define uncopied (build-path dest-dir f))
             (copy-directory/files (build-path (find-dir) f)
-                                  (build-path dest-dir f))))))
+                                  uncopied)
-    (unmove-tag 'move-foreign-libs find-user-lib-dir)
+            (fixup uncopied)))))
-    (unmove-tag 'move-shared-files find-user-share-dir)
+
-    (unmove-tag 'move-man-pages find-user-man-dir)
+    (unmove-tag 'move-foreign-libs find-user-lib-dir
+                (if (eq? 'macosx (system-type))
+                    adjust-dylib-path/uninstall
+                    void))
+    (unmove-tag 'move-shared-files find-user-share-dir void)
+    (unmove-tag 'move-man-pages find-user-man-dir void)
     (unmove-in dir dest-dir))
   (unmove dir dest-dir))
 

racket/collects/setup/dirs.rkt

@@ -326,7 +326,11 @@
                                         (build-path dir r)
                                         r)))
                             p))))]
-              [rel (and exe (get/set-dylib-path exe "Racket" #f))])
+              [rel (and exe
+                        (let ([l (get/set-dylib-path exe "Racket" #f)])
+                          (if (null? l)
+                              #f
+                              (car l))))])
          (cond
           [(not rel) #f] ; no framework reference found!?
           [(regexp-match

racket/collects/setup/private/dylib.rkt

@@ -0,0 +1,59 @@
+#lang racket/base
+(require compiler/private/mach-o
+         setup/dirs)
+
+(provide adjust-dylib-path/install
+         adjust-dylib-path/uninstall)
+
+(define (adjust-dylib-path p adjust)
+  (cond
+   [(directory-exists? p)
+    ;; Find Mach-O files in the framework and adjust them:
+    (for ([f (in-list (directory-list p #:build? #t))])
+      (adjust-dylib-path f adjust))]
+   [(file-exists? p)
+    (define magic (call-with-input-file*
+                   p
+                   (lambda (i)
+                     (define bstr (read-bytes 4 i))
+                     (and (bytes? bstr)
+                          (= 4 (bytes-length bstr))
+                          (integer-bytes->integer bstr #f)))))
+    (case magic
+      [(#xfeedface #xfeedfacf)
+       ;; Found a Mach-o file; get a list of all referenced dylibs,
+       ;; and adjust each one:
+       (define libs (get/set-dylib-path p #rx"." #f))
+       (define-values (base name dir?) (split-path p))
+       (for ([lib (in-list libs)])
+         (define new-lib (adjust lib base))
+         (when new-lib
+           (get/set-dylib-path p (regexp-quote lib) new-lib)))])]))
+
+;; ----------------------------------------
+
+(define (adjust-dylib-path/install p)
+  (adjust-dylib-path p relative-to-absolute))
+
+(define (relative-to-absolute ref dir)
+  (and (regexp-match? #rx#"^@loader_path/" ref)
+       (let ()
+         (define p (bytes->path (subbytes ref 13)))
+         (and (not (file-exists? (build-path dir p)))
+              (for/or ([dir (in-list (get-lib-search-dirs))])
+                (define full-p (build-path dir p))
+                (and (file-exists? full-p)
+                     (path->bytes full-p)))))))
+
+;; ----------------------------------------
+
+(define (adjust-dylib-path/uninstall p)
+  (adjust-dylib-path p absolute-to-relative))
+
+(define (absolute-to-relative ref in-dir)
+  (for/or ([dir (in-list (get-lib-search-dirs))])
+    (define dir-bstr (path->bytes dir))
+    (and (regexp-match? (bytes-append #"^" (regexp-quote dir-bstr))
+                        ref)
+         (bytes-append #"@loader_path"
+                       (subbytes ref (bytes-length dir-bstr))))))

racket/collects/setup/setup-core.rkt

@@ -33,6 +33,7 @@
          "parallel-build.rkt"
          "private/cc-struct.rkt"
          "link.rkt"
+         "private/dylib.rkt"
          "private/pkg-deps.rkt"
          "collection-name.rkt"
          (only-in pkg/lib pkg-directory
@@ -1572,10 +1573,12 @@
                                receipt-at-dest?
                                check-entry
                                build-dest-path
-                               this-platform?)
+                               this-platform?
+                               fixup-lib)
     (define (make-libs-step)
       (setup-printf #f (format "--- installing ~a ---" whats))
       (define installed-libs (make-hash))
+      (define dests (make-hash))
       (for ([cc ccs-to-compile])
         (begin-record-error cc what/title
                             (define info (cc-info cc))
@@ -1617,6 +1620,7 @@
                                  (record-lib receipt-path lib-name (cc-collection cc) (cc-path cc))
                                  #t)
                                 (unless already?
+                                  (hash-set! dests dest #t)
                                   (delete-directory/files dest #:must-exist? #f)
                                   (let-values ([(base name dir?) (split-path dest)])
                                     (when (path? base) (make-directory* base)))
@@ -1644,7 +1648,8 @@
                      (find-user-target-dir)
                      (find-user-lib-dir)
                      installed-libs
-                     ccs-to-compile))))
+                     ccs-to-compile)))
+      (for-each fixup-lib (hash-keys dests)))
 
     (define (same-content? a b)
       (cond
@@ -1740,7 +1745,10 @@
                            (unless (list-of relative-path-string? l)
                              (error "entry is not a list of relative path strings:" l)))
                          build-path
-                         this-platform?))
+                         this-platform?
+                         (if (eq? 'macosx (system-type))
+                             adjust-dylib-path/install
+                             void)))
 
   (define make-shares-step
     (make-copy/move-step "shared file"
@@ -1756,7 +1764,8 @@
                            (unless (list-of relative-path-string? l)
                              (error "entry is not a list of relative path strings:" l)))
                          build-path
-                         this-platform?))
+                         this-platform?
+                         void))
 
   (define make-mans-step
     (make-copy/move-step "man page"
@@ -1780,7 +1789,8 @@
                            (build-path d 
                                        (bytes->path-element (bytes-append #"man" (filename-extension n)))
                                        n))
-                         (lambda (info) #t)))
+                         (lambda (info) #t)
+                         void))
 
   ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   ;;       Package-dependency checking         ;;