Add initial Mach-O object parsing
Jaime Fournier <jaimef@linbsd.org>
2f435dc2fd88145fc78d93dcbb3800ec32a42499
diff --git a/Makefile b/Makefile
index 9eb1814..5b045b0 100644
--- a/Makefile
+++ b/Makefile
@@ -22,6 +22,7 @@ binary: test
test-binary: binary
test -x ./$(BINARY)
file ./$(BINARY)
+ ./$(BINARY) headers ./$(BINARY)
./$(BINARY) raw --arch x86-64 --syntax intel --hex '55 48 89 e5 c3'
./$(BINARY) raw --arch aarch64 --hex '20 00 80 d2 c0 03 5f d6'
$(SCHEME) --libdirs $(LIBDIRS) --script tests/write-raw-bytes.ss ./.jasm-raw.bin
diff --git a/docs/plan.md b/docs/plan.md
index 7a347a8..a2025a3 100644
--- a/docs/plan.md
+++ b/docs/plan.md
@@ -48,6 +48,9 @@ reference material and parity targets.
executable sections or a selected section by name.
- Raw CLI mode accepts byte input from `--hex` or `--file`. The reusable
bytevector API supports `max-bytes` and `stop-address` limits.
+- `(jasm object macho)` can parse 64-bit Mach-O headers and `LC_SEGMENT_64`
+ section tables. The CLI detects ELF vs. Mach-O for `headers`, `sections`, and
+ executable-section disassembly.
## Core Architecture
@@ -230,10 +233,11 @@ Implement after ELF.
Required:
-- 64-bit Mach-O first.
+- 64-bit Mach-O first. Initial header and `LC_SEGMENT_64` section parsing is
+ implemented.
- Universal/fat binaries.
-- Load commands.
-- Segments and sections.
+- Load commands. Initial `LC_SEGMENT_64` support is implemented.
+- Segments and sections. Initial parser is implemented.
- Symbol table.
- String table.
- Dysymtab.
diff --git a/jasm b/jasm
index 31f1e00..0bab9a2 100755
Binary files a/jasm and b/jasm differ
diff --git a/lib/jasm/object/macho.ss b/lib/jasm/object/macho.ss
new file mode 100644
index 0000000..0308aba
--- /dev/null
+++ b/lib/jasm/object/macho.ss
@@ -0,0 +1,217 @@
+#!chezscheme
+
+(library (jasm object macho)
+ (export
+ read-macho-bytevector
+ read-macho-file
+ macho-object?
+ macho-object-endian
+ macho-object-cpu-type
+ macho-object-architecture
+ macho-object-file-type
+ macho-object-sections
+ macho-section?
+ macho-section-index
+ macho-section-segment
+ macho-section-name
+ macho-section-full-name
+ macho-section-flags
+ macho-section-address
+ macho-section-offset
+ macho-section-size
+ macho-section-align
+ macho-section-executable?
+ macho-section-by-name
+ macho-executable-sections
+ macho-section-bytes)
+
+ (import (chezscheme))
+
+ (define (make-macho-object endian cpu-type file-type sections path bytes)
+ (vector 'macho-object endian cpu-type file-type sections path bytes))
+
+ (define (macho-object? x)
+ (and (vector? x)
+ (= (vector-length x) 7)
+ (eq? (vector-ref x 0) 'macho-object)))
+
+ (define (macho-object-endian obj) (vector-ref obj 1))
+ (define (macho-object-cpu-type obj) (vector-ref obj 2))
+ (define (macho-object-file-type obj) (vector-ref obj 3))
+ (define (macho-object-sections obj) (vector-ref obj 4))
+ (define (macho-object-path obj) (vector-ref obj 5))
+ (define (macho-object-bytes obj) (vector-ref obj 6))
+
+ (define (make-macho-section index segment name flags address offset size align)
+ (vector 'macho-section index segment name flags address offset size align))
+
+ (define (macho-section? x)
+ (and (vector? x)
+ (= (vector-length x) 9)
+ (eq? (vector-ref x 0) 'macho-section)))
+
+ (define (macho-section-index section) (vector-ref section 1))
+ (define (macho-section-segment section) (vector-ref section 2))
+ (define (macho-section-name section) (vector-ref section 3))
+ (define (macho-section-flags section) (vector-ref section 4))
+ (define (macho-section-address section) (vector-ref section 5))
+ (define (macho-section-offset section) (vector-ref section 6))
+ (define (macho-section-size section) (vector-ref section 7))
+ (define (macho-section-align section) (vector-ref section 8))
+
+ (define (macho-section-full-name section)
+ (string-append (macho-section-segment section) "," (macho-section-name section)))
+
+ (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 "Mach-O data is truncated" offset size (bv-len bv))))
+
+ (define (u8 bv offset)
+ (require-range 'read-macho-bytevector bv offset 1)
+ (bytevector-u8-ref bv offset))
+
+ (define (u32 bv offset endian)
+ (require-range 'read-macho-bytevector bv offset 4)
+ (let ([b0 (u8 bv offset)]
+ [b1 (u8 bv (+ offset 1))]
+ [b2 (u8 bv (+ offset 2))]
+ [b3 (u8 bv (+ offset 3))])
+ (if (eq? endian 'little)
+ (+ b0
+ (* b1 #x100)
+ (* b2 #x10000)
+ (* b3 #x1000000))
+ (+ (* b0 #x1000000)
+ (* b1 #x10000)
+ (* b2 #x100)
+ b3))))
+
+ (define (u64 bv offset endian)
+ (require-range 'read-macho-bytevector bv offset 8)
+ (if (eq? endian 'little)
+ (+ (u32 bv offset endian)
+ (* (u32 bv (+ offset 4) endian) #x100000000))
+ (+ (* (u32 bv offset endian) #x100000000)
+ (u32 bv (+ offset 4) endian))))
+
+ (define (slice-bytevector bv offset size)
+ (require-range 'macho-section-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-macho-bytevector bv offset size)
+ (let loop ([i 0] [chars '()])
+ (cond
+ [(= i size) (list->string (reverse chars))]
+ [(zero? (u8 bv (+ offset i))) (list->string (reverse chars))]
+ [else (loop (+ i 1) (cons (integer->char (u8 bv (+ offset i))) chars))])))
+
+ (define (macho-object-architecture obj)
+ (case (macho-object-cpu-type obj)
+ [(#x01000007) 'x86-64]
+ [(#x0100000c) 'aarch64]
+ [else (error 'macho-object-architecture "unsupported Mach-O CPU type" (macho-object-cpu-type obj))]))
+
+ (define (parse-section-64 endian bv offset index)
+ (make-macho-section
+ index
+ (read-fixed-string bv (+ offset 16) 16)
+ (read-fixed-string bv offset 16)
+ (u32 bv (+ offset 64) endian)
+ (u64 bv (+ offset 32) endian)
+ (u32 bv (+ offset 48) endian)
+ (u64 bv (+ offset 40) endian)
+ (u32 bv (+ offset 52) endian)))
+
+ (define (parse-segment-64 endian bv offset section-index)
+ (let* ([nsects (u32 bv (+ offset 64) endian)]
+ [section-base (+ offset 72)])
+ (let loop ([i 0] [index section-index] [sections '()])
+ (if (= i nsects)
+ (cons index (reverse sections))
+ (let ([section-offset (+ section-base (* i 80))])
+ (loop (+ i 1)
+ (+ index 1)
+ (cons (parse-section-64 endian bv section-offset index)
+ sections)))))))
+
+ (define (parse-load-commands endian bv ncmds)
+ (let loop ([i 0] [offset 32] [section-index 0] [sections '()])
+ (if (= i ncmds)
+ (reverse sections)
+ (let* ([cmd (u32 bv offset endian)]
+ [cmdsize (u32 bv (+ offset 4) endian)])
+ (require-range 'read-macho-bytevector bv offset cmdsize)
+ (if (= cmd #x19)
+ (let* ([result (parse-segment-64 endian bv offset section-index)]
+ [next-index (car result)]
+ [new-sections (cdr result)])
+ (loop (+ i 1)
+ (+ offset cmdsize)
+ next-index
+ (append (reverse new-sections) sections)))
+ (loop (+ i 1)
+ (+ offset cmdsize)
+ section-index
+ sections))))))
+
+ (define (read-macho-bytevector bv . maybe-path)
+ (let ([path (if (null? maybe-path) #f (car maybe-path))])
+ (require-range 'read-macho-bytevector bv 0 32)
+ (let* ([magic-le (u32 bv 0 'little)]
+ [magic-be (u32 bv 0 'big)]
+ [endian (cond
+ [(= magic-le #xfeedfacf) 'little]
+ [(= magic-be #xfeedfacf) 'big]
+ [else (error 'read-macho-bytevector "unsupported Mach-O magic")])]
+ [cpu-type (u32 bv 4 endian)]
+ [file-type (u32 bv 12 endian)]
+ [ncmds (u32 bv 16 endian)]
+ [sizeofcmds (u32 bv 20 endian)])
+ (require-range 'read-macho-bytevector bv 32 sizeofcmds)
+ (make-macho-object endian
+ cpu-type
+ file-type
+ (parse-load-commands endian bv ncmds)
+ path
+ bv))))
+
+ (define (read-macho-file path)
+ (read-macho-bytevector (read-file-bytevector path) path))
+
+ (define (macho-section-executable? section)
+ (not (zero? (bitwise-and (macho-section-flags section) #x80000400))))
+
+ (define (macho-section-by-name obj name)
+ (let loop ([sections (macho-object-sections obj)])
+ (cond
+ [(null? sections) #f]
+ [(or (string=? (macho-section-name (car sections)) name)
+ (string=? (macho-section-full-name (car sections)) name))
+ (car sections)]
+ [else (loop (cdr sections))])))
+
+ (define (macho-executable-sections obj)
+ (let loop ([sections (macho-object-sections obj)] [out '()])
+ (cond
+ [(null? sections) (reverse out)]
+ [(macho-section-executable? (car sections))
+ (loop (cdr sections) (cons (car sections) out))]
+ [else (loop (cdr sections) out)])))
+
+ (define (macho-section-bytes obj section)
+ (slice-bytevector (macho-object-bytes obj)
+ (macho-section-offset section)
+ (macho-section-size section))))
diff --git a/main.ss b/main.ss
index b671c8d..69213de 100644
--- a/main.ss
+++ b/main.ss
@@ -1,6 +1,6 @@
#!chezscheme
-(import (chezscheme) (jasm disasm) (jasm object elf))
+(import (chezscheme) (jasm disasm) (jasm object elf) (jasm object macho))
(define (usage)
(display "Usage:\n")
@@ -30,6 +30,25 @@
(close-port port)
bytes)))
+(define (bytevector-prefix? bv bytes)
+ (and (>= (bytevector-length bv) (length bytes))
+ (let loop ([i 0] [bytes bytes])
+ (cond
+ [(null? bytes) #t]
+ [(= (bytevector-u8-ref bv i) (car bytes))
+ (loop (+ i 1) (cdr bytes))]
+ [else #f]))))
+
+(define (read-object-file path)
+ (let ([bytes (read-file-bytevector path)])
+ (cond
+ [(bytevector-prefix? bytes '(#x7f #x45 #x4c #x46))
+ (read-elf-bytevector bytes path)]
+ [(or (bytevector-prefix? bytes '(#xcf #xfa #xed #xfe))
+ (bytevector-prefix? bytes '(#xfe #xed #xfa #xcf)))
+ (read-macho-bytevector bytes path)]
+ [else (error 'jasm "unsupported object file format" path)])))
+
(define (option-cons key value options)
(if value (cons (cons key value) options) options))
@@ -87,7 +106,31 @@
(display (length (elf-object-sections obj)))
(newline))
-(define (print-section-row section)
+(define (print-macho-headers obj)
+ (display "Format: Mach-O 64 ")
+ (display (macho-object-endian obj))
+ (newline)
+ (display "CPU: ")
+ (guard (exn [#t (display "unsupported")])
+ (display (macho-object-architecture obj)))
+ (display " (")
+ (display (hex-number (macho-object-cpu-type obj)))
+ (display ")")
+ (newline)
+ (display "File type: ")
+ (display (macho-object-file-type obj))
+ (newline)
+ (display "Sections: ")
+ (display (length (macho-object-sections obj)))
+ (newline))
+
+(define (print-object-headers obj)
+ (cond
+ [(elf-object? obj) (print-elf-headers obj)]
+ [(macho-object? obj) (print-macho-headers obj)]
+ [else (error 'jasm "unsupported object record" obj)]))
+
+(define (print-elf-section-row section)
(display "[")
(display (elf-section-index section))
(display "] ")
@@ -104,8 +147,32 @@
(display (hex-number (elf-section-flags section)))
(newline))
+(define (print-macho-section-row section)
+ (display "[")
+ (display (macho-section-index section))
+ (display "] ")
+ (display (macho-section-full-name section))
+ (display "\taddr=")
+ (display (hex-number (macho-section-address section)))
+ (display "\toff=")
+ (display (hex-number (macho-section-offset section)))
+ (display "\tsize=")
+ (display (hex-number (macho-section-size section)))
+ (display "\tflags=")
+ (display (hex-number (macho-section-flags section)))
+ (newline))
+
(define (print-elf-sections obj)
- (for-each print-section-row (elf-object-sections obj)))
+ (for-each print-elf-section-row (elf-object-sections obj)))
+
+(define (print-macho-sections obj)
+ (for-each print-macho-section-row (macho-object-sections obj)))
+
+(define (print-object-sections obj)
+ (cond
+ [(elf-object? obj) (print-elf-sections obj)]
+ [(macho-object? obj) (print-macho-sections obj)]
+ [else (error 'jasm "unsupported object record" obj)]))
(define (section-name-by-index obj index)
(if (and (>= index 0) (< index (length (elf-object-sections obj))))
@@ -162,6 +229,42 @@
(for-each (lambda (relocation) (print-relocation-row obj relocation))
(elf-object-relocations obj)))
+(define (object-architecture obj)
+ (cond
+ [(elf-object? obj) (elf-object-architecture obj)]
+ [(macho-object? obj) (macho-object-architecture obj)]
+ [else (error 'jasm "unsupported object record" obj)]))
+
+(define (object-section-by-name obj name)
+ (cond
+ [(elf-object? obj) (elf-section-by-name obj name)]
+ [(macho-object? obj) (macho-section-by-name obj name)]
+ [else (error 'jasm "unsupported object record" obj)]))
+
+(define (object-executable-sections obj)
+ (cond
+ [(elf-object? obj) (elf-executable-sections obj)]
+ [(macho-object? obj) (macho-executable-sections obj)]
+ [else (error 'jasm "unsupported object record" obj)]))
+
+(define (object-section-name section)
+ (cond
+ [(elf-section? section) (elf-section-name section)]
+ [(macho-section? section) (macho-section-full-name section)]
+ [else (error 'jasm "unsupported section record" section)]))
+
+(define (object-section-address section)
+ (cond
+ [(elf-section? section) (elf-section-address section)]
+ [(macho-section? section) (macho-section-address section)]
+ [else (error 'jasm "unsupported section record" section)]))
+
+(define (object-section-bytes obj section)
+ (cond
+ [(elf-object? obj) (elf-section-bytes obj section)]
+ [(macho-object? obj) (macho-section-bytes obj section)]
+ [else (error 'jasm "unsupported object record" obj)]))
+
(define (one-file args command-name)
(cond
[(null? args) (error 'jasm (string-append command-name " requires a file"))]
@@ -219,24 +322,24 @@
(cond
[(null? args)
(unless file (error 'jasm "object requires a file"))
- (let* ([obj (read-elf-file file)]
- [resolved-arch (if arch arch (elf-object-architecture obj))]
+ (let* ([obj (read-object-file file)]
+ [resolved-arch (if arch arch (object-architecture obj))]
[sections (if section-name
- (let ([section (elf-section-by-name obj section-name)])
+ (let ([section (object-section-by-name obj section-name)])
(unless section (error 'jasm "section not found" section-name))
(list section))
- (elf-executable-sections obj))])
+ (object-executable-sections obj))])
(for-each
(lambda (section)
(display "Disassembly of section ")
- (display (elf-section-name section))
+ (display (object-section-name section))
(display ":")
(newline)
(display (disassemble->string
resolved-arch
- (elf-section-bytes obj section)
+ (object-section-bytes obj section)
(list (cons 'syntax syntax)
- (cons 'address (elf-section-address section)))))
+ (cons 'address (object-section-address section)))))
(newline))
sections))]
[(string=? (car args) "--arch")
@@ -257,16 +360,22 @@
(loop (cdr args) arch syntax section-name (car args))])))
(define (parse-headers args)
- (print-elf-headers (read-elf-file (one-file args "headers"))))
+ (print-object-headers (read-object-file (one-file args "headers"))))
(define (parse-sections args)
- (print-elf-sections (read-elf-file (one-file args "sections"))))
+ (print-object-sections (read-object-file (one-file args "sections"))))
(define (parse-symbols args)
- (print-elf-symbols (read-elf-file (one-file args "symbols"))))
+ (let ([obj (read-object-file (one-file args "symbols"))])
+ (unless (elf-object? obj)
+ (error 'jasm "symbols are currently implemented for ELF objects"))
+ (print-elf-symbols obj)))
(define (parse-relocs args)
- (print-elf-relocations (read-elf-file (one-file args "relocs"))))
+ (let ([obj (read-object-file (one-file args "relocs"))])
+ (unless (elf-object? obj)
+ (error 'jasm "relocs are currently implemented for ELF objects"))
+ (print-elf-relocations obj)))
(define (main args)
(guard (exn [#t
diff --git a/tests/test-jasm.ss b/tests/test-jasm.ss
index 7d9707d..06ccafe 100644
--- a/tests/test-jasm.ss
+++ b/tests/test-jasm.ss
@@ -1,6 +1,6 @@
#!chezscheme
-(import (chezscheme) (jasm disasm) (jasm format) (jasm object elf))
+(import (chezscheme) (jasm disasm) (jasm format) (jasm object elf) (jasm object macho))
(define pass 0)
(define fail 0)
@@ -109,6 +109,55 @@
(put-bytevector port bv)
(close-port port)))
+(define (sample-macho64le)
+ (let ([bv (make-bytevector #x200 0)])
+ (define (put8! offset value)
+ (bytevector-u8-set! bv offset (modulo value #x100)))
+ (define (put32le! offset value)
+ (put8! offset value)
+ (put8! (+ offset 1) (quotient value #x100))
+ (put8! (+ offset 2) (quotient value #x10000))
+ (put8! (+ offset 3) (quotient value #x1000000)))
+ (define (put64le! offset value)
+ (put32le! offset (modulo value #x100000000))
+ (put32le! (+ offset 4) (quotient value #x100000000)))
+ (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))))))
+ (put32le! 0 #xfeedfacf)
+ (put32le! 4 #x0100000c)
+ (put32le! 8 0)
+ (put32le! 12 1)
+ (put32le! 16 1)
+ (put32le! 20 152)
+ (put32le! 24 0)
+ (put32le! 28 0)
+ (put32le! #x20 #x19)
+ (put32le! #x24 152)
+ (put-ascii! #x28 "__TEXT")
+ (put64le! #x38 #x1000)
+ (put64le! #x40 #x100)
+ (put64le! #x48 #x100)
+ (put64le! #x50 4)
+ (put32le! #x58 5)
+ (put32le! #x5c 5)
+ (put32le! #x60 1)
+ (put32le! #x64 0)
+ (put-ascii! #x68 "__text")
+ (put-ascii! #x78 "__TEXT")
+ (put64le! #x88 #x1000)
+ (put64le! #x90 4)
+ (put32le! #x98 #x100)
+ (put32le! #x9c 2)
+ (put32le! #xa0 0)
+ (put32le! #xa4 0)
+ (put32le! #xa8 #x80000400)
+ (put-ascii! #x100 (string #\xc0 #\x03 #\x5f #\xd6))
+ bv))
+
(printf "--- jasm tests ---~%")
(test "hex parser"
@@ -191,6 +240,25 @@
result))
'(elf64 ".text"))
+(test "mach-o section discovery"
+ (let* ([obj (read-macho-bytevector (sample-macho64le))]
+ [text (macho-section-by-name obj "__TEXT,__text")])
+ (list (macho-object? obj)
+ (macho-object-endian obj)
+ (macho-object-architecture obj)
+ (macho-section? text)
+ (macho-section-full-name text)
+ (macho-section-address text)
+ (macho-section-executable? text)
+ (map macho-section-full-name (macho-executable-sections obj))))
+ '(#t little aarch64 #t "__TEXT,__text" 4096 #t ("__TEXT,__text")))
+
+(test "mach-o section bytes"
+ (let* ([obj (read-macho-bytevector (sample-macho64le))]
+ [text (macho-section-by-name obj "__text")])
+ (bytevector->u8-list (macho-section-bytes obj text)))
+ '(192 3 95 214))
+
(test "instruction records are vector-backed"
(let ([insn (car (disassemble-bytevector 'x86-64 (hex-string->bytevector "55")))])
(list (instruction? insn)