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

setup and pkg create: adjust ELF RPATH on install and uninstall

Browse Source 
Allow a library installed as user-specific to refer to libraries
installed installation-wide.
This commit is contained in:
Matthew Flatt 2014-10-09 10:36:55 -06:00
parent 079ea21dab
commit bd29411579
6 changed files with 475 additions and 173 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -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 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 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 @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 @defmodule[pkg/strip]{The @racketmodname[pkg/strip] module provides
support for copying a package-style directory to a given destination support for copying a package-style directory to a given destination

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

@ -614,7 +614,13 @@ Optional @filepath{info.rkt} fields trigger additional actions by
includes a library reference that starts @litchar{@"@"loader_path/}, includes a library reference that starts @litchar{@"@"loader_path/},
and if the referenced library exists in a different location among and if the referenced library exists in a different location among
the paths listed by @racket[(get-lib-search-dirs)], then the 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 @item{@indexed-racket[move-foreign-libs] : @racket[(listof (and/c
path-string? relative-path?))] --- Like @racket[copy-foreign-libs], path-string? relative-path?))] --- Like @racket[copy-foreign-libs],

556
racket/collects/compiler/private/elf.rkt
View File

@ -1,7 +1,9 @@
#lang racket/base #lang racket/base
(provide add-racket-section (provide add-racket-section
adjust-racket-section-size) adjust-racket-section-size
get-rpath
set-rpath)
(define 32BIT 1) (define 32BIT 1)
(define 64BIT 2) (define 64BIT 2)
@ -12,14 +14,42 @@
(define SECTION-ALIGN 16) ; conservative? (define SECTION-ALIGN 16) ; conservative?
(define SHT_PROGBITS 1) (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 (struct elf (ph-offset ph-esize ph-ecount
sh-offset sh-esize sh-ecount sh-offset sh-esize sh-ecount
class format sh-str-index) class format sh-str-index)
#:transparent) #:transparent)
(struct section (name-offset offset size) (struct section (name-offset addr offset size type)
#:transparent) #:transparent)
(struct program (offset size) (struct program (offset vaddr paddr size)
#:transparent) #:transparent)
(define (copy-port-bytes amt in out) (define (copy-port-bytes amt in out)
@ -44,19 +74,67 @@
v v
(+ v (- align d))))) (+ 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 (read-elf p fail-k k #:dump? [dump? #f])
(define (stop) (raise "unexpected input"))
(define (expect b) (define (expect b)
(eq? b (read-byte p))) (eq? b (read-byte p)))
(define (skip n) (define (skip n)
(for ([i (in-range n)]) (for ([i (in-range n)])
(when (eof-object? (read-byte p)) (when (eof-object? (read-byte p))
(stop)))) (stop))))
(define (read-a-byte) (define (read-a-byte) (do-read-a-byte p))
(let ([v (read-byte p)])
(when (eof-object? v)
(stop))
v))
(define (skip-half) (skip 2)) (define (skip-half) (skip 2))
(define (skip-word) (skip 4)) (define (skip-word) (skip 4))
(define (show v) (displayln v) v) (define (show v) (displayln v) v)
@ -79,30 +157,9 @@
(stop)) (stop))
;; Set up multi-byte reading --------------- ;; Set up multi-byte reading ---------------
(let* ([read-word (let* ([read-word
(lambda () (lambda () (do-read-word format p))]
(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))])))]
[read-xword [read-xword
(lambda () (lambda () (do-read-xword class format p))]
(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)))))]
[read-half [read-half
(lambda () (lambda ()
(let ([a (read-a-byte)] (let ([a (read-a-byte)]
@ -148,7 +205,7 @@
[info (read-word)] [info (read-word)]
[align (read-xword)] [align (read-xword)]
[esize (read-xword)]) [esize (read-xword)])
(section name-offset offset size)))]) (section name-offset addr offset size type)))])
;; Read program headers ------------------------ ;; Read program headers ------------------------
(let ([programs (let ([programs
(for/list ([i (in-range ph-ecount)]) (for/list ([i (in-range ph-ecount)])
@ -161,7 +218,7 @@
[vaddr (read-addr)] [vaddr (read-addr)]
[paddr (read-addr)] [paddr (read-addr)]
[file-size (read-xword)]) [file-size (read-xword)])
(program offset file-size)))]) (program offset vaddr paddr file-size)))])
;; Load strings from string section ------------------------ ;; Load strings from string section ------------------------
(let* ([str-section (list-ref sections sh-str-index)] (let* ([str-section (list-ref sections sh-str-index)]
[strs (begin [strs (begin
@ -180,6 +237,26 @@
sections programs sections programs
str-section strs)))))))))) 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) (define (add-racket-section src-file dest-file section-name get-data)
(call-with-input-file* (call-with-input-file*
src-file src-file
@ -188,133 +265,204 @@
in in
(lambda () (values #f #f #f #f)) (lambda () (values #f #f #f #f))
(lambda (elf sections programs str-section strs) (lambda (elf sections programs str-section strs)
(let ([new-sec-pos (+ (elf-sh-offset elf) (let ([total-size (file-size src-file)])
(* (elf-sh-esize elf) (elf-sh-ecount elf)))] (expand-elf in dest-file
[new-sec-delta (round-up (elf-sh-esize elf) SECTION-ALIGN)] elf sections programs str-section strs total-size
[new-str-pos (+ (section-offset str-section) section-name
(section-size str-section))] get-data
[new-str-delta (round-up (add1 (bytes-length section-name)) null
SECTION-ALIGN)] void)))))))
[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
;; Write new string: (define (expand-elf in dest-file
(file-position out (adjust* new-str-pos)) ;; Current state parted from `in`:
(write-bytes section-name out) 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: ;; Write new string for section name:
(file-position out (at-class 28 32)) (file-position out (adjust* new-str-pos))
(write-off (adjust (elf-ph-offset elf))) (write-bytes section-name out))
(write-off (adjust (elf-sh-offset elf)))
;; Increment section count: ;; Fix section-header and program-header offsets:
(file-position out (at-class 48 60)) (file-position out (at-class 28 32))
(write-half (add1 (length sections))) (write-off (adjust (elf-ph-offset elf)))
(write-off (adjust (elf-sh-offset elf)))
;; Increment string section size: (when section-name
(file-position out (adjust (+ (elf-sh-offset elf) ;; Increment section count:
(* (elf-sh-str-index elf) (file-position out (at-class 48 60))
(elf-sh-esize elf)) (write-half (add1 (length sections)))
(at-class 20 32))))
(write-xword (+ (section-size str-section) new-str-delta))
;; Fix up section offsets: ;; Increment string section size:
(for ([s (in-list sections)] (file-position out (adjust (+ (elf-sh-offset elf)
[i (in-naturals)]) (* (elf-sh-str-index elf)
(let ([offset (section-offset s)]) (elf-sh-esize elf))
(when (offset . > . a-pos) (at-class 20 32))))
(file-position out (adjust (+ (elf-sh-offset elf) (write-xword (+ (section-size str-section) new-str-delta)))
(* i (elf-sh-esize elf))
(at-class 16 24))))
(write-off (adjust offset)))))
;; Fix up program offsets: ;; Fix up section offsets and sizes:
(for ([p (in-list programs)] (define (new-section-size s)
[i (in-naturals)]) (- (adjust* (+ (section-offset s) (section-size s)))
(let ([offset (program-offset p)]) (adjust (section-offset s))))
(when (offset . > . a-pos) (for ([s (in-list sections)]
(file-position out (adjust (+ (elf-ph-offset elf) [i (in-naturals)])
(* i (elf-ph-esize elf)) (let ([addr (section-addr s)]
(at-class 4 8)))) [offset (section-offset s)])
(write-off (adjust offset))))) (file-position out (adjust (+ (elf-sh-offset elf)
(* i (elf-sh-esize elf))
;; Write new section data: (at-class 14 16))))
(let ([dest (+ total-size new-sec-delta new-str-delta)]) (write-addr (vm-adjust addr))
(file-position out dest) (write-off (adjust offset))
(write-bytes data out)
(unless (= SHT_NOBITS (section-type s))
(values dest (+ dest (bytes-length data)) decl-len mid)))))))))))) (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 (adjust-racket-section-size src-file name-regexp new-size)
(define fixup (define fixup
@ -358,3 +506,101 @@
src-file src-file
#:exists 'update #:exists 'update
fixup))) 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)))])))))))

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

@ -9,7 +9,8 @@
racket/list racket/list
racket/set racket/set
racket/format racket/format
setup/private/dylib) setup/private/dylib
setup/private/elf)
(provide generate-stripped-directory (provide generate-stripped-directory
fixup-local-redirect-reference fixup-local-redirect-reference
@ -408,7 +409,7 @@
(unmove d (build-path dest-dir f))))) (unmove d (build-path dest-dir f)))))
(define (unmove dir dest-dir) (define (unmove dir dest-dir)
(define info (get-info/full dir #:namespace metadata-ns)) (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 (when info
(define l (info tag (lambda () null))) (define l (info tag (lambda () null)))
(for ([f (in-list l)]) (for ([f (in-list l)])
@ -417,16 +418,24 @@
(or (file-exists? (build-path (find-dir) f)) (or (file-exists? (build-path (find-dir) f))
(directory-exists? (build-path (find-dir) f)))) (directory-exists? (build-path (find-dir) f))))
(define uncopied (build-path dest-dir f)) (define uncopied (build-path dest-dir f))
(copy-directory/files (build-path (find-dir) f) (define src (build-path (find-dir) f))
uncopied) (if (file-exists? src)
(copy-one-file src uncopied)
(copy-directory/files src uncopied))
(fixup uncopied))))) (fixup uncopied)))))
(unmove-tag 'move-foreign-libs find-user-lib-dir (unmove-tag 'move-foreign-libs find-user-lib-dir
(if (eq? 'macosx (system-type)) (case (system-type)
adjust-dylib-path/uninstall [(macosx)
void)) adjust-dylib-path/uninstall]
(unmove-tag 'move-shared-files find-user-share-dir void) [else void])
(unmove-tag 'move-man-pages find-user-man-dir 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-in dir dest-dir))
(unmove dir dest-dir)) (unmove dir dest-dir))

26
racket/collects/setup/private/elf.rkt Normal file
View File

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

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

@ -34,6 +34,7 @@
"private/cc-struct.rkt" "private/cc-struct.rkt"
"link.rkt" "link.rkt"
"private/dylib.rkt" "private/dylib.rkt"
"private/elf.rkt"
"private/pkg-deps.rkt" "private/pkg-deps.rkt"
"collection-name.rkt" "collection-name.rkt"
(only-in pkg/lib pkg-directory (only-in pkg/lib pkg-directory
@ -1574,7 +1575,8 @@
check-entry check-entry
build-dest-path build-dest-path
this-platform? this-platform?
fixup-lib) fixup-lib
copy-user-lib)
(define (make-libs-step) (define (make-libs-step)
(setup-printf #f (format "--- installing ~a ---" whats)) (setup-printf #f (format "--- installing ~a ---" whats))
(define installed-libs (make-hash)) (define installed-libs (make-hash))
@ -1625,7 +1627,9 @@
(let-values ([(base name dir?) (split-path dest)]) (let-values ([(base name dir?) (split-path dest)])
(when (path? base) (make-directory* base))) (when (path? base) (make-directory* base)))
(if (file-exists? src) (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))) (copy-directory/files src dest)))
src) src)
@ -1746,9 +1750,14 @@
(error "entry is not a list of relative path strings:" l))) (error "entry is not a list of relative path strings:" l)))
build-path build-path
this-platform? this-platform?
(if (eq? 'macosx (system-type)) (case (system-type)
adjust-dylib-path/install [(macosx)
void))) adjust-dylib-path/install]
[else void])
(case (system-type)
[(unix)
copy-file/install-elf-rpath]
[else void])))
(define make-shares-step (define make-shares-step
(make-copy/move-step "shared file" (make-copy/move-step "shared file"
@ -1765,7 +1774,8 @@
(error "entry is not a list of relative path strings:" l))) (error "entry is not a list of relative path strings:" l)))
build-path build-path
this-platform? this-platform?
void)) void
copy-file))
(define make-mans-step (define make-mans-step
(make-copy/move-step "man page" (make-copy/move-step "man page"
@ -1790,7 +1800,8 @@
(bytes->path-element (bytes-append #"man" (filename-extension n))) (bytes->path-element (bytes-append #"man" (filename-extension n)))
n)) n))
(lambda (info) #t) (lambda (info) #t)
void)) void
copy-file))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Package-dependency checking ;; ;; Package-dependency checking ;;