Add Unix archive parsing
ober
cd85f6b07e255503f6e9e79d051f93db2f8823ee
--- a/docs/plan.md +++ b/docs/plan.md @@ -56,6 +56,8 @@ reference material and parity targets. disassembly. - `(jasm object coff)` can parse initial COFF/PE headers and section tables. The shared CLI object path can disassemble executable COFF sections. +- `(jasm object archive)` can parse Unix archives and list member names, offsets, + and sizes through the shared `headers`/`sections` CLI path. ## Core Architecture @@ -267,8 +269,8 @@ Required: Support Unix archives: -- global header -- member headers +- global header. Initial parser is implemented. +- member headers. Initial parser is implemented. - long filenames - symbol table members - nested object iteration Binary files a/jasm and b/jasm differ new file mode 100644 --- /dev/null +++ b/lib/jasm/object/archive.ss @@ -0,0 +1,156 @@ +#!chezscheme + +(library (jasm object archive) + (export + read-archive-bytevector + read-archive-file + archive-object? + archive-object-members + archive-member? + archive-member-index + archive-member-name + archive-member-offset + archive-member-size + archive-member-bytes) + + (import (chezscheme)) + + (define (make-archive-object members bytes) + (vector 'archive-object members bytes)) + + (define (archive-object? x) + (and (vector? x) + (= (vector-length x) 3) + (eq? (vector-ref x 0) 'archive-object))) + + (define (archive-object-members obj) (vector-ref obj 1)) + (define (archive-object-bytes obj) (vector-ref obj 2)) + + (define (make-archive-member index name offset size) + (vector 'archive-member index name offset size)) + + (define (archive-member? x) + (and (vector? x) + (= (vector-length x) 5) + (eq? (vector-ref x 0) 'archive-member))) + + (define (archive-member-index member) (vector-ref member 1)) + (define (archive-member-name member) (vector-ref member 2)) + (define (archive-member-offset member) (vector-ref member 3)) + (define (archive-member-size member) (vector-ref member 4)) + + (define (bv-len bv) (bytevector-length bv)) + + (define (require-range who bv offset size) + (when (or (< offset 0) + (< size 0) + (> (+ offset size) (bv-len bv))) + (error who "archive data is truncated" offset size (bv-len bv)))) + + (define (u8 bv offset) + (require-range 'read-archive-bytevector bv offset 1) + (bytevector-u8-ref bv offset)) + + (define (slice-bytevector bv offset size) + (require-range 'archive-member-bytes bv offset size) + (let ([out (make-bytevector size 0)]) + (bytevector-copy! bv offset out 0 size) + out)) + + (define (read-file-bytevector path) + (let ([port (open-file-input-port path)]) + (let ([bytes (get-bytevector-all port)]) + (close-port port) + bytes))) + + (define (read-fixed-string bv offset size) + (require-range 'read-archive-bytevector bv offset size) + (let loop ([i 0] [chars '()]) + (if (= i size) + (list->string (reverse chars)) + (loop (+ i 1) (cons (integer->char (u8 bv (+ offset i))) chars))))) + + (define (space? c) + (or (char=? c #\space) (char=? c #\tab) (char=? c #\newline) (char=? c #\return))) + + (define (trim-right s) + (let loop ([i (- (string-length s) 1)]) + (cond + [(< i 0) ""] + [(space? (string-ref s i)) (loop (- i 1))] + [else (substring s 0 (+ i 1))]))) + + (define (trim-left s) + (let ([n (string-length s)]) + (let loop ([i 0]) + (cond + [(= i n) ""] + [(space? (string-ref s i)) (loop (+ i 1))] + [else (substring s i n)])))) + + (define (trim s) + (trim-left (trim-right s))) + + (define (string-prefix? prefix s) + (let ([n (string-length prefix)]) + (and (>= (string-length s) n) + (string=? (substring s 0 n) prefix)))) + + (define (strip-trailing-slash s) + (let ([n (string-length s)]) + (if (and (> n 0) (char=? (string-ref s (- n 1)) #\/)) + (substring s 0 (- n 1)) + s))) + + (define (read-decimal-field bv offset size) + (let ([n (string->number (trim (read-fixed-string bv offset size)))]) + (unless n (error 'read-archive-bytevector "invalid archive numeric field" offset size)) + n)) + + (define (archive-magic? bv) + (and (>= (bv-len bv) 8) + (string=? (read-fixed-string bv 0 8) "!<arch>\n"))) + + (define (parse-member-name bv raw data-offset size) + (let ([name (trim raw)]) + (cond + [(string-prefix? "#1/" name) + (let* ([name-size (string->number (substring name 3 (string-length name)))] + [member-name (read-fixed-string bv data-offset name-size)]) + (list member-name (+ data-offset name-size) (- size name-size)))] + [else + (list (strip-trailing-slash name) data-offset size)]))) + + (define (read-archive-bytevector bv) + (unless (archive-magic? bv) + (error 'read-archive-bytevector "not a Unix archive")) + (let loop ([offset 8] [index 0] [members '()]) + (if (>= offset (bv-len bv)) + (make-archive-object (reverse members) bv) + (begin + (require-range 'read-archive-bytevector bv offset 60) + (unless (and (= (u8 bv (+ offset 58)) (char->integer #\`)) + (= (u8 bv (+ offset 59)) (char->integer #\newline))) + (error 'read-archive-bytevector "invalid archive member terminator" offset)) + (let* ([raw-name (read-fixed-string bv offset 16)] + [size (read-decimal-field bv (+ offset 48) 10)] + [data-offset (+ offset 60)] + [name-info (parse-member-name bv raw-name data-offset size)] + [name (list-ref name-info 0)] + [member-offset (list-ref name-info 1)] + [member-size (list-ref name-info 2)] + [next (+ data-offset size)] + [padded-next (if (odd? next) (+ next 1) next)]) + (require-range 'read-archive-bytevector bv member-offset member-size) + (loop padded-next + (+ index 1) + (cons (make-archive-member index name member-offset member-size) + members))))))) + + (define (read-archive-file path) + (read-archive-bytevector (read-file-bytevector path))) + + (define (archive-member-bytes obj member) + (slice-bytevector (archive-object-bytes obj) + (archive-member-offset member) + (archive-member-size member)))) --- a/main.ss +++ b/main.ss @@ -4,7 +4,8 @@ (jasm disasm) (jasm object elf) (jasm object macho) - (jasm object coff)) + (jasm object coff) + (jasm object archive)) (define (usage) (display "Usage:\n") @@ -48,6 +49,8 @@ (cond [(bytevector-prefix? bytes '(#x7f #x45 #x4c #x46)) (read-elf-bytevector bytes path)] + [(bytevector-prefix? bytes '(#x21 #x3c #x61 #x72 #x63 #x68 #x3e #x0a)) + (read-archive-bytevector bytes)] [(or (bytevector-prefix? bytes '(#xcf #xfa #xed #xfe)) (bytevector-prefix? bytes '(#xfe #xed #xfa #xcf))) (read-macho-bytevector bytes path)] @@ -150,6 +153,12 @@ (display "Sections: ") (display (length (coff-object-sections obj))) (newline)] + [(archive-object? obj) + (display "Format: Unix archive") + (newline) + (display "Members: ") + (display (length (archive-object-members obj))) + (newline)] [else (error 'jasm "unsupported object record" obj)])) (define (print-elf-section-row section) @@ -210,6 +219,19 @@ [(elf-object? obj) (print-elf-sections obj)] [(macho-object? obj) (print-macho-sections obj)] [(coff-object? obj) (for-each print-coff-section-row (coff-object-sections obj))] + [(archive-object? obj) + (for-each + (lambda (member) + (display "[") + (display (archive-member-index member)) + (display "] ") + (display (archive-member-name member)) + (display "\toff=") + (display (hex-number (archive-member-offset member))) + (display "\tsize=") + (display (hex-number (archive-member-size member))) + (newline)) + (archive-object-members obj))] [else (error 'jasm "unsupported object record" obj)])) (define (section-name-by-index obj index) --- a/tests/test-jasm.ss +++ b/tests/test-jasm.ss @@ -5,7 +5,8 @@ (jasm format) (jasm object elf) (jasm object macho) - (jasm object coff)) + (jasm object coff) + (jasm object archive)) (define pass 0) (define fail 0) @@ -211,6 +212,29 @@ (put-ascii! #x100 (string #\x55 #\xc3 #\x90 #\x90 #\xc3)) bv)) +(define (sample-archive) + (let ([bv (make-bytevector 72 (char->integer #\space))]) + (define (put8! offset value) + (bytevector-u8-set! bv offset (modulo value #x100))) + (define (put-ascii! offset s) + (let ([n (string-length s)]) + (let loop ([i 0]) + (when (< i n) + (put8! (+ offset i) (char->integer (string-ref s i))) + (loop (+ i 1)))))) + (put-ascii! 0 "!<arch>\n") + (put-ascii! 8 "foo.o/") + (put-ascii! 24 "0") + (put-ascii! 36 "0") + (put-ascii! 42 "0") + (put-ascii! 48 "100644") + (put-ascii! 56 "3") + (put8! 66 (char->integer #\`)) + (put8! 67 (char->integer #\newline)) + (put-ascii! 68 "abc") + (put8! 71 (char->integer #\newline)) + bv)) + (printf "--- jasm tests ---~%") (test "hex parser" @@ -352,6 +376,16 @@ (bytevector->u8-list (coff-section-bytes obj text))) '(85 195 144 144 195)) +(test "archive members" + (let* ([obj (read-archive-bytevector (sample-archive))] + [member (car (archive-object-members obj))]) + (list (archive-object? obj) + (archive-member? member) + (archive-member-name member) + (archive-member-size member) + (bytevector->u8-list (archive-member-bytes obj member)))) + '(#t #t "foo.o" 3 (97 98 99))) + (test "instruction records are vector-backed" (let ([insn (car (disassemble-bytevector 'x86-64 (hex-string->bytevector "55")))]) (list (instruction? insn)