diff --git a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/strip.scrbl b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/strip.scrbl index 7ce04e174f..d35b3fcf09 100644 --- a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/strip.scrbl +++ b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/strip.scrbl @@ -203,7 +203,11 @@ 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. +@litchar{@"@"loader_path/} reference. On Unix, when an +unmoved file for @racket[move-foreign-libs] is an ELF file whose +RPATH configuration is @litchar{$ORIGIN:} followed by the path +to the main installation's library directory as reported by +@racket[(find-lib-dir)], then its RPATH value is set to @litchar{$ORIGIN}. @defmodule[pkg/strip]{The @racketmodname[pkg/strip] module provides support for copying a package-style directory to a given destination diff --git a/pkgs/racket-pkgs/racket-doc/scribblings/raco/setup.scrbl b/pkgs/racket-pkgs/racket-doc/scribblings/raco/setup.scrbl index 358a57e128..cf0d54ea91 100644 --- a/pkgs/racket-pkgs/racket-doc/scribblings/raco/setup.scrbl +++ b/pkgs/racket-pkgs/racket-doc/scribblings/raco/setup.scrbl @@ -614,7 +614,13 @@ Optional @filepath{info.rkt} fields trigger additional actions by 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.} + library reference is updated to an absolute path. + + On Unix, when an ELF file is copied, if the copied file includes an + RPATH setting of @litchar{$ORIGIN} and the file is being installed + to a user-specific location, then the file's RPATH is adjusted to + @litchar{$ORIGIN:} followed by the path to the main installation's + library directory as reported by @racket[(find-lib-dir)].} @item{@indexed-racket[move-foreign-libs] : @racket[(listof (and/c path-string? relative-path?))] --- Like @racket[copy-foreign-libs], diff --git a/racket/collects/compiler/private/elf.rkt b/racket/collects/compiler/private/elf.rkt index 4c3a04a0b1..f22de45490 100644 --- a/racket/collects/compiler/private/elf.rkt +++ b/racket/collects/compiler/private/elf.rkt @@ -1,7 +1,9 @@ #lang racket/base (provide add-racket-section - adjust-racket-section-size) + adjust-racket-section-size + get-rpath + set-rpath) (define 32BIT 1) (define 64BIT 2) @@ -12,14 +14,42 @@ (define SECTION-ALIGN 16) ; conservative? (define SHT_PROGBITS 1) +(define SHT_NOBITS 8) + +(define DT_HASH 4) +(define DT_STRTAB 5) +(define DT_SYMTAB 6) +(define DT_RELA 7) +(define DT_STRSZ 10) +(define DT_INIT 12) +(define DT_FINI 13) +(define DT_RPATH 15) +(define DT_REL 17) +(define DT_JMPREL 23) +(define DT_GNU_HASH #x6ffffef5) +(define DT_VERNEED #x6ffffffe) +(define DT_VERSYM #x6ffffff0) + +(define dynamic-adjusts + (list DT_HASH + DT_STRTAB + DT_SYMTAB + DT_RELA + DT_REL + DT_INIT + DT_FINI + DT_JMPREL + DT_GNU_HASH + DT_VERNEED + DT_VERSYM)) (struct elf (ph-offset ph-esize ph-ecount sh-offset sh-esize sh-ecount class format sh-str-index) #:transparent) -(struct section (name-offset offset size) +(struct section (name-offset addr offset size type) #:transparent) -(struct program (offset size) +(struct program (offset vaddr paddr size) #:transparent) (define (copy-port-bytes amt in out) @@ -44,19 +74,67 @@ v (+ v (- align d))))) +(define (stop) (raise "unexpected input")) + +(define (do-read-a-byte p) + (let ([v (read-byte p)]) + (when (eof-object? v) + (stop)) + v)) + +(define (do-read-word format p) + (let ([a (do-read-a-byte p)] + [b (do-read-a-byte p)] + [c (do-read-a-byte p)] + [d (do-read-a-byte p)]) + (cond + [(= format LITTLEEND) + (bitwise-ior a + (arithmetic-shift b 8) + (arithmetic-shift c 16) + (arithmetic-shift d 24))] + [else + (bitwise-ior d + (arithmetic-shift c 8) + (arithmetic-shift b 16) + (arithmetic-shift a 24))]))) + +(define (do-read-xword class format p) + (if (= class 32BIT) + (do-read-word format p) + (let ([b (read-bytes 8 p)]) + (if (and (bytes? b) (= 8 (bytes-length b))) + (integer-bytes->integer b #f (= format BIGEND)) + (stop))))) + + +(define (do-write-word v format out) + (if (= format LITTLEEND) + (begin + (write-byte (bitwise-and v #xFF) out) + (write-byte (bitwise-and (arithmetic-shift v -8) #xFF) out) + (write-byte (bitwise-and (arithmetic-shift v -16) #xFF) out) + (write-byte (bitwise-and (arithmetic-shift v -24) #xFF) out)) + (begin + (write-byte (bitwise-and (arithmetic-shift v -24) #xFF) out) + (write-byte (bitwise-and (arithmetic-shift v -16) #xFF) out) + (write-byte (bitwise-and (arithmetic-shift v -8) #xFF) out) + (write-byte (bitwise-and v #xFF) out)))) + +(define (do-write-xword v class format out) + (if (= class 32BIT) + (do-write-word v format out) + (display (integer->integer-bytes v 8 #f (= format BIGEND)) + out))) + (define (read-elf p fail-k k #:dump? [dump? #f]) - (define (stop) (raise "unexpected input")) (define (expect b) (eq? b (read-byte p))) (define (skip n) (for ([i (in-range n)]) (when (eof-object? (read-byte p)) (stop)))) - (define (read-a-byte) - (let ([v (read-byte p)]) - (when (eof-object? v) - (stop)) - v)) + (define (read-a-byte) (do-read-a-byte p)) (define (skip-half) (skip 2)) (define (skip-word) (skip 4)) (define (show v) (displayln v) v) @@ -79,30 +157,9 @@ (stop)) ;; Set up multi-byte reading --------------- (let* ([read-word - (lambda () - (let ([a (read-a-byte)] - [b (read-a-byte)] - [c (read-a-byte)] - [d (read-a-byte)]) - (cond - [(= format LITTLEEND) - (bitwise-ior a - (arithmetic-shift b 8) - (arithmetic-shift c 16) - (arithmetic-shift d 24))] - [else - (bitwise-ior d - (arithmetic-shift c 8) - (arithmetic-shift b 16) - (arithmetic-shift a 24))])))] + (lambda () (do-read-word format p))] [read-xword - (lambda () - (if (= class 32BIT) - (read-word) - (let ([b (read-bytes 8 p)]) - (if (and (bytes? b) (= 8 (bytes-length b))) - (integer-bytes->integer b #f (= format BIGEND)) - (stop)))))] + (lambda () (do-read-xword class format p))] [read-half (lambda () (let ([a (read-a-byte)] @@ -148,7 +205,7 @@ [info (read-word)] [align (read-xword)] [esize (read-xword)]) - (section name-offset offset size)))]) + (section name-offset addr offset size type)))]) ;; Read program headers ------------------------ (let ([programs (for/list ([i (in-range ph-ecount)]) @@ -161,7 +218,7 @@ [vaddr (read-addr)] [paddr (read-addr)] [file-size (read-xword)]) - (program offset file-size)))]) + (program offset vaddr paddr file-size)))]) ;; Load strings from string section ------------------------ (let* ([str-section (list-ref sections sh-str-index)] [strs (begin @@ -180,6 +237,26 @@ sections programs str-section strs)))))))))) +(define (find-section name sections strs) + (define len (bytes-length strs)) + (define name-len (bytes-length name)) + (for/or ([s (in-list sections)]) + (and (bytes=? name + (subbytes strs + (min (section-name-offset s) + len) + (min (+ (section-name-offset s) + name-len) + len))) + s))) + +(define (find-section-by-offset offset sections) + (for/or ([s (in-list sections)]) + (and (offset . >= . (section-offset s)) + (offset . < . (+ (section-offset s) + (section-size s))) + s))) + (define (add-racket-section src-file dest-file section-name get-data) (call-with-input-file* src-file @@ -188,133 +265,204 @@ in (lambda () (values #f #f #f #f)) (lambda (elf sections programs str-section strs) - (let ([new-sec-pos (+ (elf-sh-offset elf) - (* (elf-sh-esize elf) (elf-sh-ecount elf)))] - [new-sec-delta (round-up (elf-sh-esize elf) SECTION-ALIGN)] - [new-str-pos (+ (section-offset str-section) - (section-size str-section))] - [new-str-delta (round-up (add1 (bytes-length section-name)) - SECTION-ALIGN)] - [total-size (file-size src-file)] - [class (elf-class elf)] - [format (elf-format elf)]) - (let-values ([(a-pos a-delta b-pos b-delta) - (if (new-sec-pos . < . new-str-pos) - (values new-sec-pos new-sec-delta - new-str-pos new-str-delta) - (values new-str-pos new-str-delta - new-sec-pos new-sec-delta))] - [(data decl-len mid) (get-data (+ total-size new-str-delta new-sec-delta))]) - (call-with-output-file* - dest-file - #:exists 'truncate - (lambda (out) - (let* ([write-word - (lambda (v) - (if (= format LITTLEEND) - (begin - (write-byte (bitwise-and v #xFF) out) - (write-byte (bitwise-and (arithmetic-shift v -8) #xFF) out) - (write-byte (bitwise-and (arithmetic-shift v -16) #xFF) out) - (write-byte (bitwise-and (arithmetic-shift v -24) #xFF) out)) - (begin - (write-byte (bitwise-and (arithmetic-shift v -24) #xFF) out) - (write-byte (bitwise-and (arithmetic-shift v -16) #xFF) out) - (write-byte (bitwise-and (arithmetic-shift v -8) #xFF) out) - (write-byte (bitwise-and v #xFF) out))))] - [write-xword - (lambda (v) - (if (= class 32BIT) - (write-word v) - (display (integer->integer-bytes v 8 #f (= format BIGEND)) - out)))] - [write-addr (lambda (v) (write-xword v))] - [write-off (lambda (v) (write-xword v))] - [write-half - (lambda (v) - (if (= format LITTLEEND) - (begin - (write-byte (bitwise-and v #xFF) out) - (write-byte (bitwise-and (arithmetic-shift v -8) #xFF) out)) - (begin - (write-byte (bitwise-and (arithmetic-shift v -8) #xFF) out) - (write-byte (bitwise-and v #xFF) out))))] - [adjust (lambda (offset) - (if (offset . >= . a-pos) - (if (offset . >= . b-pos) - (+ offset a-delta b-delta) - (+ offset a-delta)) - offset))] - [adjust* (lambda (offset) - (add1 (adjust (sub1 offset))))] - [at-class (lambda (a b) (if (= class 32BIT) a b))]) - - (file-position in 0) - (copy-port-bytes a-pos in out) - (write-n-bytes a-delta out) - (copy-port-bytes (- b-pos a-pos) in out) - (write-n-bytes b-delta out) - (copy-port-bytes (- total-size b-pos) in out) - - ;; Write new section: - (file-position out (adjust* new-sec-pos)) - (write-word (section-size str-section)) - (write-word SHT_PROGBITS) - (write-xword 0) ; flags - (write-addr 0) ; addr - (write-off (+ total-size new-sec-delta new-str-delta)) - (write-xword (bytes-length data)) - (write-word 0) ; link - (write-word 0) ; info - (write-xword 1) ; align - (write-xword 0) ; esize + (let ([total-size (file-size src-file)]) + (expand-elf in dest-file + elf sections programs str-section strs total-size + section-name + get-data + null + void))))))) - ;; Write new string: - (file-position out (adjust* new-str-pos)) - (write-bytes section-name out) +(define (expand-elf in dest-file + ;; Current state parted from `in`: + elf sections programs str-section strs total-size + ;; New state: + section-name ; #f or name of new section + get-data ; get data for new section (if any) + ;; expansions must be after section headers, must + ;; not be at the version beginning of a section, + ;; and beware of extending sections that need + ;; ".dynamic" support (such as the ".dynstr" section, + ;; which is currently supported here): + expansions ; list of (list position delta) + finish) + (define num-new-sections (if section-name 1 0)) + (let ([new-sec-pos (+ (* num-new-sections (elf-sh-offset elf)) + (* (elf-sh-esize elf) (elf-sh-ecount elf)))] + [new-sec-delta (round-up (* num-new-sections (elf-sh-esize elf)) + SECTION-ALIGN)] + [new-str-pos (+ (section-offset str-section) + (section-size str-section))] + [new-str-delta (if section-name + (round-up (add1 (bytes-length section-name)) + SECTION-ALIGN) + 0)] + [class (elf-class elf)] + [format (elf-format elf)]) + (let-values ([(expansions) + ;; Make expansions a sorted list of (list pos delta), + ;; including a 0-length expansion at the end: + (sort + (list* + (list total-size 0) + (list new-sec-pos new-sec-delta) + (list new-str-pos new-str-delta) + expansions) + < + #:key car)] + [(data decl-len mid) + ;; The `decl-len` and `mid` returns are ignored + ;; and returned as-s + (if get-data + (get-data (+ total-size new-str-delta new-sec-delta)) + (values #"" 0 0))]) + (define vm-expansions (filter + values + (for/list ([expansion (in-list expansions)]) + (define s (find-section-by-offset (car expansion) sections)) + (and s (list (+ (section-addr s) + (- (car expansion) (section-offset s))) + (cadr expansion)))))) + (call-with-output-file* + dest-file + #:exists 'truncate + (lambda (out) + (let* ([write-word + (lambda (v) (do-write-word v format out))] + [write-xword + (lambda (v) (do-write-xword v class format out))] + [write-addr (lambda (v) (write-xword v))] + [write-off (lambda (v) (write-xword v))] + [write-half + (lambda (v) + (if (= format LITTLEEND) + (begin + (write-byte (bitwise-and v #xFF) out) + (write-byte (bitwise-and (arithmetic-shift v -8) #xFF) out)) + (begin + (write-byte (bitwise-and (arithmetic-shift v -8) #xFF) out) + (write-byte (bitwise-and v #xFF) out))))] + [read-word + (lambda () (do-read-word format in))] + [read-xword + (lambda () (do-read-xword class format in))] + [xword-size (if (= class 32BIT) 4 8)] + [adjust/cmp (lambda (offset expansions >?) + (+ offset + (for/fold ([delta 0]) ([expansion (in-list expansions)]) + (if (offset . >? . (car expansion)) + (+ delta (cadr expansion)) + delta))))] + [adjust (lambda (offset) (adjust/cmp offset expansions >=))] + [adjust* (lambda (offset) (adjust/cmp offset expansions >))] + [vm-adjust (lambda (offset) (adjust/cmp offset vm-expansions >=))] + [at-class (lambda (a b) (if (= class 32BIT) a b))]) + + (file-position in 0) + (for/fold ([pos 0]) ([expansion (in-list expansions)]) + (copy-port-bytes (- (car expansion) pos) in out) + (write-n-bytes (cadr expansion) out) + (car expansion)) + + (when section-name + ;; Write new section header: + (file-position out (adjust* new-sec-pos)) + (write-word (section-size str-section)) + (write-word SHT_PROGBITS) + (write-xword 0) ; flags + (write-addr 0) ; addr + (write-off (adjust total-size)) ; at end + (write-xword (bytes-length data)) + (write-word 0) ; link + (write-word 0) ; info + (write-xword 1) ; align + (write-xword 0) ; esize - ;; Fix section-header and program-header offsets: - (file-position out (at-class 28 32)) - (write-off (adjust (elf-ph-offset elf))) - (write-off (adjust (elf-sh-offset elf))) + ;; Write new string for section name: + (file-position out (adjust* new-str-pos)) + (write-bytes section-name out)) - ;; Increment section count: - (file-position out (at-class 48 60)) - (write-half (add1 (length sections))) + ;; Fix section-header and program-header offsets: + (file-position out (at-class 28 32)) + (write-off (adjust (elf-ph-offset elf))) + (write-off (adjust (elf-sh-offset elf))) - ;; Increment string section size: - (file-position out (adjust (+ (elf-sh-offset elf) - (* (elf-sh-str-index elf) - (elf-sh-esize elf)) - (at-class 20 32)))) - (write-xword (+ (section-size str-section) new-str-delta)) + (when section-name + ;; Increment section count: + (file-position out (at-class 48 60)) + (write-half (add1 (length sections))) - ;; Fix up section offsets: - (for ([s (in-list sections)] - [i (in-naturals)]) - (let ([offset (section-offset s)]) - (when (offset . > . a-pos) - (file-position out (adjust (+ (elf-sh-offset elf) - (* i (elf-sh-esize elf)) - (at-class 16 24)))) - (write-off (adjust offset))))) + ;; Increment string section size: + (file-position out (adjust (+ (elf-sh-offset elf) + (* (elf-sh-str-index elf) + (elf-sh-esize elf)) + (at-class 20 32)))) + (write-xword (+ (section-size str-section) new-str-delta))) - ;; Fix up program offsets: - (for ([p (in-list programs)] - [i (in-naturals)]) - (let ([offset (program-offset p)]) - (when (offset . > . a-pos) - (file-position out (adjust (+ (elf-ph-offset elf) - (* i (elf-ph-esize elf)) - (at-class 4 8)))) - (write-off (adjust offset))))) - - ;; Write new section data: - (let ([dest (+ total-size new-sec-delta new-str-delta)]) - (file-position out dest) - (write-bytes data out) - - (values dest (+ dest (bytes-length data)) decl-len mid)))))))))))) + ;; Fix up section offsets and sizes: + (define (new-section-size s) + (- (adjust* (+ (section-offset s) (section-size s))) + (adjust (section-offset s)))) + (for ([s (in-list sections)] + [i (in-naturals)]) + (let ([addr (section-addr s)] + [offset (section-offset s)]) + (file-position out (adjust (+ (elf-sh-offset elf) + (* i (elf-sh-esize elf)) + (at-class 14 16)))) + (write-addr (vm-adjust addr)) + (write-off (adjust offset)) + + (unless (= SHT_NOBITS (section-type s)) + (define new-size (new-section-size s)) + (unless (= new-size (section-size s)) + (write-xword new-size))))) + + ;; Fix up program offsets: + (for ([p (in-list programs)] + [i (in-naturals)]) + (let ([offset (program-offset p)] + [vaddr (program-vaddr p)] + [paddr (program-paddr p)]) + (file-position out (adjust (+ (elf-ph-offset elf) + (* i (elf-ph-esize elf)) + (at-class 4 8)))) + (write-off (adjust offset)) + (write-off (vm-adjust vaddr)) + (write-off (vm-adjust paddr)))) + + ;; Fix up ".dynamic", if any: + (define dynamic (find-section #".dynamic\0" sections strs)) + (when dynamic + (file-position in (section-offset dynamic)) + (for ([i (in-range 0 (section-size dynamic) (* 2 xword-size))]) + (define tag (read-xword)) + (define val (read-xword)) + (define dest-pos (adjust (+ i (section-offset dynamic) xword-size))) + (cond + [(memq tag dynamic-adjusts) ; DT_HASH, DT_STRTAB, etc. + (define new-val (vm-adjust val)) + (unless (= val new-val) + (file-position out dest-pos) + (write-xword new-val))] + [(= tag DT_STRSZ) + (define s (find-section #".dynstr\0" sections strs)) + (unless s (error "could not find .dynstr")) + (define new-size (new-section-size s)) + (unless (= new-size (section-size s)) + (file-position out dest-pos) + (write-xword new-size))]))) + + (begin0 + ;; Write new section data, producing result: + (let ([dest (adjust total-size)]) + (file-position out dest) + (write-bytes data out) + + (values dest (+ dest (bytes-length data)) decl-len mid)) + + ;; Any final writes: + (finish out adjust adjust*)))))))) (define (adjust-racket-section-size src-file name-regexp new-size) (define fixup @@ -358,3 +506,101 @@ src-file #:exists 'update fixup))) + +(define (get-rpath src-file) + (call-with-input-file* + src-file + (lambda (in) + (read-elf + in + (lambda () #f) + (lambda (elf sections programs str-section strs) + (and elf + (let ([s (find-section #".dynamic\0" sections strs)] + [s2 (find-section #".dynstr\0" sections strs)]) + (and s + s2 + (let () + (define-values (rpath rpath-pos) + (find-rpath in elf s)) + (and rpath + (let () + (file-position in (section-offset s2)) + (define m (regexp-match #rx#"^[^\0]*" in rpath)) + (and m (car m))))))))))))) + +(define (find-rpath in elf s) + (define class (elf-class elf)) + (define format (elf-format elf)) + (define xword-size (if (= class 32BIT) 4 8)) + (file-position in (section-offset s)) + (for/fold ([rpath #f] [rpath-pos #f]) + ([i (in-range 0 (section-size s) (* 2 xword-size))]) + (define tag (do-read-xword class format in)) + (define val (do-read-xword class format in)) + (cond + [(= tag DT_RPATH) + (values val (+ i xword-size (section-offset s)))] + [else + (values rpath rpath-pos)]))) + +(define (set-rpath src-file dest-file rpath) + (define (fail why) (error 'set-rpath "could not set RT_RPATH; ~a" why)) + (call-with-input-file* + src-file + (lambda (in) + (read-elf + in + (lambda () #f) + (lambda (elf sections programs str-section strs) + (unless elf (fail "not ELF")) + (let ([dynamic (find-section #".dynamic\0" sections strs)] + [dynstr (find-section #".dynstr\0" sections strs)]) + (unless dynamic (fail "no .dynamic")) + (unless dynstr (fail "no .dynstr")) + (define-values (rpath-index rpath-pos) + (find-rpath in elf dynamic)) + (define strtab (section-offset dynstr)) + + ;; Easy case is when there is enough space counting 0s after + ;; the current setting, which happens when we (or `chrpath`) + ;; shrink an rpath: + (file-position in (+ strtab rpath-index)) + (define avail-len (bytes-length (car (regexp-match #rx#"^[^\0]*\0*" in)))) + (cond + [(avail-len . > . (bytes-length rpath)) + ;; Copy src to dest, then fixup + (copy-file src-file dest-file #t) + (call-with-output-file* + dest-file + #:exists 'update + (lambda (out) + (file-position out (+ strtab rpath-index)) + (write-bytes rpath out) + ;; zero out remaining space: + (write-bytes (make-bytes (- avail-len (bytes-length rpath))) out) + (void)))] + [else + ;; Hard case, where we need to add a new string: + (define new-str-pos + ;; New pos is just before last nul byte, to make sure it's + ;; within the section: + (sub1 (+ (section-offset dynstr) (section-size dynstr)))) + (expand-elf in dest-file + elf sections programs str-section strs (file-size src-file) + ;; No new section: + #f #f + ;; Add rpath at end of dynstrs: + (list + (list new-str-pos (+ (bytes-length rpath) 1))) + (lambda (out adjust adjust*) + ;; Write new dynstr: + (file-position out (adjust* new-str-pos)) + (write-byte 0 out) + (write-bytes rpath out) + + ;; Update RT_RPATH + (file-position out (adjust rpath-pos)) + (do-write-xword (section-size dynstr) + (elf-class elf) (elf-format elf) + out)))]))))))) diff --git a/racket/collects/pkg/strip.rkt b/racket/collects/pkg/strip.rkt index f9299a8c94..6c603b8bd4 100644 --- a/racket/collects/pkg/strip.rkt +++ b/racket/collects/pkg/strip.rkt @@ -9,7 +9,8 @@ racket/list racket/set racket/format - setup/private/dylib) + setup/private/dylib + setup/private/elf) (provide generate-stripped-directory fixup-local-redirect-reference @@ -408,7 +409,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 fixup) + (define (unmove-tag tag find-dir fixup copy-one-file) (when info (define l (info tag (lambda () null))) (for ([f (in-list l)]) @@ -417,16 +418,24 @@ (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) - uncopied) + (define src (build-path (find-dir) f)) + (if (file-exists? src) + (copy-one-file src uncopied) + (copy-directory/files src 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) + (case (system-type) + [(macosx) + adjust-dylib-path/uninstall] + [else void]) + (case (system-type) + [(unix) + copy-file/uninstall-elf-rpath] + [else + copy-file])) + (unmove-tag 'move-shared-files find-user-share-dir void copy-file) + (unmove-tag 'move-man-pages find-user-man-dir void copy-file) (unmove-in dir dest-dir)) (unmove dir dest-dir)) diff --git a/racket/collects/setup/private/elf.rkt b/racket/collects/setup/private/elf.rkt new file mode 100644 index 0000000000..33dd449530 --- /dev/null +++ b/racket/collects/setup/private/elf.rkt @@ -0,0 +1,26 @@ +#lang racket/base +(require compiler/private/elf + setup/dirs) + +(provide copy-file/install-elf-rpath + copy-file/uninstall-elf-rpath) + +(define (make-rpath) + (bytes-append #"$ORIGIN:" + (path->bytes (find-lib-dir)))) + +(define (copy-file/install-elf-rpath src dest) + (define rpath (get-rpath src)) + (cond + [(equal? rpath #"$ORIGIN") + (set-rpath src dest (make-rpath))] + [else + (copy-file src dest)])) + +(define (copy-file/uninstall-elf-rpath src dest) + (define rpath (get-rpath src)) + (cond + [(equal? rpath (make-rpath)) + (set-rpath src dest #"$ORIGIN")] + [else + (copy-file src dest)])) diff --git a/racket/collects/setup/setup-core.rkt b/racket/collects/setup/setup-core.rkt index ba3a64c598..6cba74b232 100644 --- a/racket/collects/setup/setup-core.rkt +++ b/racket/collects/setup/setup-core.rkt @@ -34,6 +34,7 @@ "private/cc-struct.rkt" "link.rkt" "private/dylib.rkt" + "private/elf.rkt" "private/pkg-deps.rkt" "collection-name.rkt" (only-in pkg/lib pkg-directory @@ -1574,7 +1575,8 @@ check-entry build-dest-path this-platform? - fixup-lib) + fixup-lib + copy-user-lib) (define (make-libs-step) (setup-printf #f (format "--- installing ~a ---" whats)) (define installed-libs (make-hash)) @@ -1625,7 +1627,9 @@ (let-values ([(base name dir?) (split-path dest)]) (when (path? base) (make-directory* base))) (if (file-exists? src) - (copy-file src dest) + (if (cc-main? cc) + (copy-file src dest) + (copy-user-lib src dest)) (copy-directory/files src dest))) src) @@ -1746,9 +1750,14 @@ (error "entry is not a list of relative path strings:" l))) build-path this-platform? - (if (eq? 'macosx (system-type)) - adjust-dylib-path/install - void))) + (case (system-type) + [(macosx) + adjust-dylib-path/install] + [else void]) + (case (system-type) + [(unix) + copy-file/install-elf-rpath] + [else void]))) (define make-shares-step (make-copy/move-step "shared file" @@ -1765,7 +1774,8 @@ (error "entry is not a list of relative path strings:" l))) build-path this-platform? - void)) + void + copy-file)) (define make-mans-step (make-copy/move-step "man page" @@ -1790,7 +1800,8 @@ (bytes->path-element (bytes-append #"man" (filename-extension n))) n)) (lambda (info) #t) - void)) + void + copy-file)) ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Package-dependency checking ;;