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

raco setup: fix ".dylib" references on install

Browse Source 
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.
This commit is contained in:
Matthew Flatt 2014-08-25 17:13:40 -06:00
parent 986b5c39cd
commit 3943826b70
8 changed files with 117 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
pkgs/racket-pkgs/racket-doc/pkg/scribblings/strip.scrbl
View File

@ -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},
or @tech{built package}
``unmoves'' files that were installed via @racket[move-foreign-libs],
@racket[move-shared-files], or @racket[move-man-pages] definitions in
an @filepath{info.rkt} file, retrieving them if they are not present
at referenced location but are present in a user-specific target
directory (i.e., the directory reported by @racket[find-user-lib-dir],
@racket[find-user-share-dir], or @racket[find-user-man-dir],
respectively).
Finally, creating a @tech{binary package}, @tech{binary library
package}, or @tech{built package} ``unmoves'' files that were
installed via @racket[move-foreign-libs], @racket[move-shared-files],
or @racket[move-man-pages] definitions in an @filepath{info.rkt} file,
retrieving them if they are not present at referenced location but are
present in a user-specific target directory (i.e., the directory
reported by @racket[find-user-lib-dir], @racket[find-user-share-dir],
or @racket[find-user-man-dir], respectively). On Mac OS X, when an
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

8
pkgs/racket-pkgs/racket-doc/scribblings/raco/setup.scrbl
View File

@ -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],

4
racket/collects/compiler/private/macfw.rkt
View File

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

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

@ -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)))))]

21
racket/collects/pkg/strip.rkt
View File

@ -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))))
(copy-directory/files (build-path (find-dir) f)
(build-path dest-dir f))))))
(unmove-tag 'move-foreign-libs find-user-lib-dir)
(unmove-tag 'move-shared-files find-user-share-dir)
(unmove-tag 'move-man-pages find-user-man-dir)
(define uncopied (build-path dest-dir f))
(copy-directory/files (build-path (find-dir) f)
uncopied)
(fixup uncopied)))))
(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))

6
racket/collects/setup/dirs.rkt
View File

@ -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

59
racket/collects/setup/private/dylib.rkt Normal file
View File

@ -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))))))

20
racket/collects/setup/setup-core.rkt
View File

@ -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 ;;