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

Windows: fix PE update for ".rsrc" not at end

Browse Source 
Support creating executables when the base executable has
sections after ".rsrc", as long as there's room to add
a section to the section table. The new resource data is
written to the end of the file and vitrual space, but the
old space needs to be recorded as a section to keep them
contiguous.

MSVC 2015 puts a ".reloc" section after ".rsrc".
This commit is contained in:
Matthew Flatt 2016-03-30 16:24:54 -07:00
parent 153e19edc5
commit a4d569ae31
1 changed files with 37 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
racket/collects/compiler/private/pe-rsrc.rkt
View File

@ -35,6 +35,8 @@
(define-logger pe-rsrc) (define-logger pe-rsrc)
(define SECTION-HEADER-SIZE 40)
(define (skip-to-image-headers-after-signature p) (define (skip-to-image-headers-after-signature p)
;; p is expected to be a file port ;; p is expected to be a file port
(define dos-sig (word->integer p)) (define dos-sig (word->integer p))
@ -50,8 +52,9 @@
(error 'pe-rsrc "bad PE signature ~x" sig)) (error 'pe-rsrc "bad PE signature ~x" sig))
pos)) pos))
(struct pe (sections section-alignment file-alignment (struct pe (sections section-count-pos section-alignment file-alignment
image-size-pos section-start-pos rsrc-offset rsrc-virtual-addr rsrc-size)) image-size-pos section-start-pos
rsrc-offset rsrc-virtual-addr rsrc-size))
(struct section (name virtual-size virtual-addr (struct section (name virtual-size virtual-addr
file-length file-position file-length file-position
characteristics) characteristics)
@ -60,6 +63,7 @@
(define (read-pe p) (define (read-pe p)
(let ([pos (skip-to-image-headers-after-signature p)]) (let ([pos (skip-to-image-headers-after-signature p)])
(word->integer p) ; skip machine (word->integer p) ; skip machine
(define section-count-pos (+ pos 6))
(let ([num-sections (word->integer p)] (let ([num-sections (word->integer p)]
[_ (begin (dword->integer p) ; date time stamp [_ (begin (dword->integer p) ; date time stamp
(dword->integer p) ; symbol table - 0 for modern exes (dword->integer p) ; symbol table - 0 for modern exes
@ -108,7 +112,8 @@
(z (word->integer p)) ; num relocations (zero) (z (word->integer p)) ; num relocations (zero)
(z (word->integer p)) ; num line numbers (zero) (z (word->integer p)) ; num line numbers (zero)
(dword->integer p))) ; characteristics (dword->integer p))) ; characteristics
(sloop (add1 i) (+ section-pos 40)))))) (sloop (add1 i) (+ section-pos SECTION-HEADER-SIZE))))))
section-count-pos
section-alignment section-alignment
file-alignment file-alignment
image-size-pos image-size-pos
@ -395,6 +400,8 @@
1)])) 1)]))
(define (update-sections pe new-sections o) (define (update-sections pe new-sections o)
(file-position o (pe-section-count-pos pe))
(integer->word (length new-sections) o)
(file-position o (pe-section-start-pos pe)) (file-position o (pe-section-start-pos pe))
(for ([s (in-list new-sections)]) (for ([s (in-list new-sections)])
(write-bytes (section-name s) o) (write-bytes (section-name s) o)
@ -431,6 +438,17 @@
(integer->dword len o)))] (integer->dword len o)))]
[else [else
(log-pe-rsrc-debug "moving resources to end") (log-pe-rsrc-debug "moving resources to end")
(define earliest-section-file-position
(for/fold ([p (section-file-position (car (pe-sections pe)))]) ([s (in-list (pe-sections pe))])
(min p (section-file-position s))))
(log-pe-rsrc-debug "earliest section at ~x" earliest-section-file-position)
(unless (> earliest-section-file-position
(+ (* SECTION-HEADER-SIZE (length (pe-sections pe)))
(pe-section-start-pos pe)))
(error 'update-resources "no room for a new section header"))
(define new-virtual-addr (define new-virtual-addr
(same-alignment (same-alignment
(section-virtual-addr s) (section-virtual-addr s)
@ -462,13 +480,21 @@
new-position) new-position)
(define new-sections (define new-sections
(sort (for/list ([s2 (in-list (pe-sections pe))]) (sort (cons
(if (eq? s s2) (section
(section (section-name s) #".DROPpe\0"
new-virtual-size new-virtual-addr (section-virtual-size s)
new-file-size new-position (section-virtual-addr s)
(section-characteristics s)) (section-file-length s)
s2)) (section-file-position s)
(section-characteristics s))
(for/list ([s2 (in-list (pe-sections pe))])
(if (eq? s s2)
(section (section-name s)
new-virtual-size new-virtual-addr
new-file-size new-position
(section-characteristics s))
s2)))
< <
#:key section-virtual-addr)) #:key section-virtual-addr))