elf patches

0001-convenience.patch

From 8702d7db348351b63d7ff41ca3fba7cf82e737aa Mon Sep 17 00:00:00 2001
From: death <death@adeht.org>
Date: Sat, 27 Apr 2019 04:10:46 +0300
Subject: [PATCH 1/2] convenience

---
 elf.lisp  | 81 ++++++++++++++++++++++++++++++-------------------------
 util.lisp |  4 +++
 2 files changed, 49 insertions(+), 36 deletions(-)

diff --git a/elf.lisp b/elf.lisp
index 114a142..d56918c 100644
--- a/elf.lisp
+++ b/elf.lisp
@@ -1,11 +1,9 @@
 ;;; elf.lisp --- A Common Lisp library for manipulating ELF files
 
 ;; Copyright (C) 2011-2013  Eric Schulte
-
 ;; Licensed under the Gnu Public License Version 3 or later
 
 ;;; Commentary
-
 ;; See [ELF.txt](ELF.txt) for more information on the elf format.
 ;; Much of the code in `elf.lisp` is a direct translation of the elf
 ;; data structures described in the ELF.txt document augmented with
@@ -836,6 +834,12 @@
    (name :initarg :name :accessor name)
    (data :initarg :data :reader data :writer set-data)))
 
+(defmethod print-object ((section section) stream)
+  (print-unreadable-object (section stream :type t)
+    (with-slots (name) section
+      (format stream "~S" name)))
+  section)
+
 (defmethod offset ((sec section))
   (offset (or (sh sec) (ph sec))))
 
@@ -1305,7 +1309,7 @@ Note: the output should resemble the output of readelf -r."
             (let ((syms (symbols elf)))
               (format t sec-f name (offset sh) (length data))
               (format t rel-h)
-              (mapcar
+              (mapc
                (lambda (rel) ;; offset info type sym.name
                  (format t rel-f
                          (offset rel)
@@ -1350,28 +1354,29 @@ Note: the output should resemble the output of readelf -r."
                          (if (string= ".dynstr" (name tab)) dynstr strtab)
                          (name sym)))))))))
 
+(defun list-file-layout (elf)
+  (mapcar (lambda-bind ((offset size data))
+                       (list offset
+                             ;; an identifier for the section data
+                             (cond
+                               ((numberp data) (name (nth data (sections elf))))
+                               ((stringp data) data)
+                               ((vectorp data) :filler)
+                               (t data))
+                             ;; the size in the file
+                             (let ((sec (cond
+                                          ((numberp data)(nth data (sections elf)))
+                                          ((stringp data) (named-section elf data))
+                                          (t nil))))
+                               (+ offset (if (and sec (equal :nobits (type sec)))
+                                             0
+                                             size)))))
+          (ordering elf)))
+
 (defun show-file-layout (elf)
   "Show the layout of the elements of an elf file with binary offset."
-  (let ((layout
-         (mapcar (lambda-bind ((offset size data))
-                   (list offset
-                         ;; an identifier for the section data
-                         (cond
-                           ((numberp data) (name (nth data (sections elf))))
-                           ((stringp data) data)
-                           ((vectorp data) :filler)
-                           (t data))
-                         ;; the size in the file
-                         (let ((sec (cond
-                                      ((numberp data)(nth data (sections elf)))
-                                      ((stringp data) (named-section elf data))
-                                      (t nil))))
-                           (+ offset (if (and sec (equal :nobits (type sec)))
-                                         0
-                                         size)))))
-                 (ordering elf))))
-    (format t "~:{~&~8a ~18a ~8a~}~%" (cons (list 'offset 'contents 'end)
-                                            layout))))
+  (format t "~:{~&~8a ~18a ~8a~}~%" (cons (list 'offset 'contents 'end)
+                                          (list-file-layout elf))))
 
 (defun memory-sorted-sections (elf)
   "Return the sections of the ELF file sorted by their order in memory.
@@ -1386,7 +1391,7 @@ Each element of the resulting list is a triplet of (offset size header)."
                    (list (vaddr head) (memsz head) head)))
                program-table)
        (when section-table
-         (mapcar (lambda (sec) 
+         (mapcar (lambda (sec)
                    (when (or (not (zerop (address (sh sec))))
                              (and (zerop (address (sh sec)))
                                   (member (flags (sh sec))
@@ -1396,22 +1401,26 @@ Each element of the resulting list is a triplet of (offset size header)."
                  sections))))
      #'< :key #'car)))
 
+(defun list-memory-layout (elf)
+  (mapcar
+   (lambda (trio)
+     (bind (((beg size header) trio))
+       (list beg
+             (cond
+               ((subtypep (type-of header) (program-header-type))
+                (type header))
+               ((subtypep (type-of header) 'section)
+                (name header)))
+             (+ beg size))))
+   (memory-sorted-sections elf)))
+
 (defun show-memory-layout (elf)
   "Show the layout of the elements of an elf file with binary offset."
   (format t "~&addr     contents          end     ~%")
   (format t "-------------------------------------~%")
-  (mapc
-   (lambda (trio)
-     (bind (((beg size header) trio))
-       (format t "~&0x~x ~18a 0x~x~%"
-               beg
-               (cond
-                 ((subtypep (type-of header) (program-header-type))
-                  (type header))
-                 ((subtypep (type-of header) 'section)
-                  (name header)))
-               (+ beg size))))
-   (memory-sorted-sections elf))
+  (mapc (lambda-bind ((addr contents end))
+                     (format t "~&0x~6,'0x ~18a 0x~6,'0x~%" addr contents end))
+        (list-memory-layout elf))
   nil)
 
 (defgeneric file-offset-of-ea (elf ea)
diff --git a/util.lisp b/util.lisp
index d06e25b..08038a3 100644
--- a/util.lisp
+++ b/util.lisp
@@ -134,6 +134,10 @@ Optional argument OUT specifies an output stream."
        (list slot val)))
    (mapcar #'my-slot-definition-name (my-class-slots (class-of hd)))))
 
+(defun list-it (hd)
+  "Return the fields of an elf, section, or program header."
+  (show-it hd :out nil))
+
 (defun equal-it (obj1 obj2 &optional trace)
   "Equal over objects and lists."
   (let ((trace1 (concatenate 'list (list obj1 obj2) trace)))
-- 
2.24.1

0002-disassembly-using-SB-CAPSTONE-ugly-hack.patch

From cf353869ce787cccc7fc19a6a16f6bfdb513bd8b Mon Sep 17 00:00:00 2001
From: death <death@adeht.org>
Date: Sat, 27 Apr 2019 04:11:23 +0300
Subject: [PATCH 2/2] disassembly using SB-CAPSTONE (ugly hack)

---
 disassemblable.lisp | 127 ++++++++++++++++++++++++++++++++++++++++++++
 elf.asd             |   3 +-
 2 files changed, 129 insertions(+), 1 deletion(-)

diff --git a/disassemblable.lisp b/disassemblable.lisp
index c6dfd15..350cb25 100644
--- a/disassemblable.lisp
+++ b/disassemblable.lisp
@@ -4,6 +4,9 @@
 ;;; Disassembly classes and functions
 (defclass disassemblable (elf) ())
 
+#+sbcl
+(defclass capstone (disassemblable) ())
+
 (defclass objdump (disassemblable) ())
 
 (defclass csurf (disassemblable)
@@ -149,3 +152,127 @@ Where `machine' is the elf header field.")
   (with-open-stream (instrs (decode (named-section elf section-name)))
     (loop :for line = (read-line instrs nil :eof t) :until (eq line :eof)
        :collect (from-string (make-instance 'tsl-instruction) line))))
+
+
+;;; Disassembly functions using SB-CAPSTONE (assuming X86-64)
+
+#+sbcl
+(defun copy-c-string (src dest &aux (index 0))
+  (loop (let ((b (sb-sys:sap-ref-8 src index)))
+          (when (= b 0)
+            (setf (fill-pointer dest) index)
+            (return))
+          (setf (char dest index) (code-char b))
+          (incf index))))
+
+#+sbcl
+(defun c-bytes (sap size)
+  (let ((s (make-array size :element-type '(unsigned-byte 8))))
+    (dotimes (i size)
+      (setf (aref s i)
+            (sb-sys:sap-ref-8 sap i)))
+    s))
+
+#+sbcl
+(defun parse-capstone-operand (string &aux p)
+  (cond ((starts-with-subseq "0x" string)
+         (parse-integer string :radix 16 :start 2))
+        ((starts-with-subseq "[" string)
+         (list :deref (parse-capstone-operand (subseq string 1 (1- (length string))))))
+        ((starts-with-subseq "byte ptr " string)
+         (list :byte (parse-capstone-operand (subseq string 9))))
+        ((starts-with-subseq "word ptr " string)
+         (list :word (parse-capstone-operand (subseq string 9))))
+        ((starts-with-subseq "dword ptr " string)
+         (list :dword (parse-capstone-operand (subseq string 10))))
+        ((starts-with-subseq "qword ptr " string)
+         (list :qword (parse-capstone-operand (subseq string 10))))
+        ((starts-with-subseq "tbyte ptr " string)
+         (list :tbyte (parse-capstone-operand (subseq string 10))))
+        ((starts-with-subseq "cs:" string)
+         (list (list :seg :cs) (parse-capstone-operand (subseq string 3))))
+        ((starts-with-subseq "ds:" string)
+         (list (list :seg :ds) (parse-capstone-operand (subseq string 3))))
+        ((starts-with-subseq "es:" string)
+         (list (list :seg :es) (parse-capstone-operand (subseq string 3))))
+        ((starts-with-subseq "fs:" string)
+         (list (list :seg :fs) (parse-capstone-operand (subseq string 3))))
+        ((starts-with-subseq "gs:" string)
+         (list (list :seg :gs) (parse-capstone-operand (subseq string 3))))
+        ((setq p (search " + " string))
+         (list :+
+               (parse-capstone-operand (subseq string 0 p))
+               (parse-capstone-operand (subseq string (+ p 3)))))
+        ((setq p (search " - " string))
+         (list :-
+               (parse-capstone-operand (subseq string 0 p))
+               (parse-capstone-operand (subseq string (+ p 3)))))
+        ((setq p (search "*" string))
+         (list :*
+               (parse-capstone-operand (subseq string 0 p))
+               (parse-capstone-operand (subseq string (1+ p)))))
+        ((every #'digit-char-p string)
+         (parse-integer string))
+        (t
+         (make-keyword (string-upcase string)))))
+
+#+sbcl
+(defun parse-capstone-operands (operands)
+  (if (equal operands "")
+      nil
+      (mapcar (lambda (s) (parse-capstone-operand (string-trim " " s)))
+              (split-sequence:split-sequence #\, operands))))
+
+#+sbcl
+(defun capstone-disassemble-bytes (bytes size)
+  (let ((instructions '()))
+    (sb-sys:with-pinned-objects (bytes)
+      (let* ((base (sb-sys:vector-sap bytes))
+             (target '(:x86-64 :little-endian))
+             (insn-addr (sb-sys:sap-int base))
+             (starting-vaddr 0))
+        (multiple-value-bind (return-code handle)
+            (sb-capstone:cs-open-for-target target)
+          (declare (ignore return-code))
+          (sb-capstone:cs-option handle sb-capstone:cs-opt-detail sb-capstone:cs-opt-on)
+          (let ((insn (sb-capstone:cs-malloc handle))
+                (mnemonic (make-array 31 :element-type 'base-char :fill-pointer t))
+                (operands (make-array 159 :element-type 'base-char :fill-pointer t)))
+            (sb-alien:with-alien ((paddr sb-alien:unsigned)
+                                  (vaddr sb-alien:unsigned)
+                                  (remaining sb-alien:unsigned))
+              (setq paddr insn-addr
+                    vaddr starting-vaddr
+                    remaining size)
+              (loop
+               (multiple-value-bind (successful new-paddr new-remaining new-vaddr)
+                   (sb-capstone:cs-disasm-iter handle paddr remaining vaddr insn)
+                 (setf paddr new-paddr
+                       remaining new-remaining
+                       vaddr new-vaddr)
+                 (unless successful
+                   (return))
+                 (copy-c-string
+                  (sb-alien:alien-sap (sb-alien:slot insn 'sb-capstone:insn-mnemonic))
+                  mnemonic)
+                 (copy-c-string
+                  (sb-alien:alien-sap (sb-alien:slot insn 'sb-capstone:insn-operands))
+                  operands)
+                 (push
+                  (list
+                   (c-bytes
+                    (sb-alien:alien-sap (sb-alien:slot insn 'sb-capstone:insn-bytes))
+                    (sb-alien:slot insn 'sb-capstone:insn-size))
+                   (list*
+                    (make-keyword (string-upcase mnemonic))
+                    (parse-capstone-operands operands)))
+                  instructions))))
+            (sb-capstone:cs-free insn 1)
+            (sb-capstone:cs-close handle)))))
+    (nreverse instructions)))
+
+#+sbcl
+(defmethod disassemble-section ((elf capstone) section-name)
+  (let ((section (named-section elf section-name)))
+    (capstone-disassemble-bytes (data section)
+                                (length (data section)))))
diff --git a/elf.asd b/elf.asd
index 49845ee..7241c73 100644
--- a/elf.asd
+++ b/elf.asd
@@ -10,7 +10,8 @@
                split-sequence
                #-ecl trivial-shell
                cl-ppcre
-               flexi-streams)
+               flexi-streams
+               #+sbcl sb-capstone)
   :components ((:file "package")
                (:file "util" :depends-on ("package"))
                (:file "elf" :depends-on ("package" "util"))
-- 
2.24.1