setup and pkg create: adjust ELF RPATH on install and uninstall
Allow a library installed as user-specific to refer to libraries installed installation-wide.
This commit is contained in:
Matthew Flatt
parent
079ea21dab
commit
bd29411579
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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],
|
||||
|
|
|
|||
|
|
@ -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,46 +265,72 @@
|
|||
in
|
||||
(lambda () (values #f #f #f #f))
|
||||
(lambda (elf sections programs str-section strs)
|
||||
(let ([new-sec-pos (+ (elf-sh-offset elf)
|
||||
(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)))))))
|
||||
|
||||
(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 (elf-sh-esize elf) SECTION-ALIGN)]
|
||||
[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 (round-up (add1 (bytes-length section-name))
|
||||
SECTION-ALIGN)]
|
||||
[total-size (file-size src-file)]
|
||||
[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 ([(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))])
|
||||
(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)
|
||||
(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))))]
|
||||
(lambda (v) (do-write-word v format out))]
|
||||
[write-xword
|
||||
(lambda (v)
|
||||
(if (= class 32BIT)
|
||||
(write-word v)
|
||||
(display (integer->integer-bytes v 8 #f (= format BIGEND))
|
||||
out)))]
|
||||
(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
|
||||
|
|
@ -239,45 +342,52 @@
|
|||
(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))))]
|
||||
[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)
|
||||
(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)
|
||||
(for/fold ([pos 0]) ([expansion (in-list expansions)])
|
||||
(copy-port-bytes (- (car expansion) pos) in out)
|
||||
(write-n-bytes (cadr expansion) out)
|
||||
(car expansion))
|
||||
|
||||
;; Write new section:
|
||||
(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 (+ total-size new-sec-delta new-str-delta))
|
||||
(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
|
||||
|
||||
;; Write new string:
|
||||
;; Write new string for section name:
|
||||
(file-position out (adjust* new-str-pos))
|
||||
(write-bytes section-name out)
|
||||
(write-bytes section-name out))
|
||||
|
||||
;; 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)))
|
||||
|
||||
(when section-name
|
||||
;; Increment section count:
|
||||
(file-position out (at-class 48 60))
|
||||
(write-half (add1 (length sections)))
|
||||
|
|
@ -287,34 +397,72 @@
|
|||
(* (elf-sh-str-index elf)
|
||||
(elf-sh-esize elf))
|
||||
(at-class 20 32))))
|
||||
(write-xword (+ (section-size str-section) new-str-delta))
|
||||
(write-xword (+ (section-size str-section) new-str-delta)))
|
||||
|
||||
;; Fix up section offsets:
|
||||
;; 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 ([offset (section-offset s)])
|
||||
(when (offset . > . a-pos)
|
||||
(let ([addr (section-addr s)]
|
||||
[offset (section-offset s)])
|
||||
(file-position out (adjust (+ (elf-sh-offset elf)
|
||||
(* i (elf-sh-esize elf))
|
||||
(at-class 16 24))))
|
||||
(write-off (adjust offset)))))
|
||||
(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)])
|
||||
(when (offset . > . a-pos)
|
||||
(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 (adjust offset))
|
||||
(write-off (vm-adjust vaddr))
|
||||
(write-off (vm-adjust paddr))))
|
||||
|
||||
;; Write new section data:
|
||||
(let ([dest (+ total-size new-sec-delta new-str-delta)])
|
||||
;; 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))))))))))))
|
||||
(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)))])))))))
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
||||
|
|
|
|||
26
racket/collects/setup/private/elf.rkt
Normal file
26
racket/collects/setup/private/elf.rkt
Normal 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)]))
|
||||
|
|
@ -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)
|
||||
(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 ;;
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user