elf-test.lisp

   1 ;;;; Silly emacs, this is -*- Lisp -*-
   2
   3 ;; TO DO -- relocation entries
   4
   5
   6 (in-package #:cl-elf)
   7
   8 (defparameter *test-elf-file*
   9   (make-instance 'elf-file
  10                  :filepath  (merge-pathnames #P"main.o")))
  11
  12
  13 (e-shstrndx-of (header-of *test-elf-file*))
  14
  15 (format t "Elf file has ~D sections." (length (sections-of *test-elf-file*)))
  16
  17
  18 (loop for section across (sections-of *test-elf-file*)
  19      do (format t "Section type ~X ~A ~A ~A (~A) is ~X bytes long~%"
  20                 (sh-type-of (header-of section))
  21                 (type-of section)
  22                 (elf-type-of section)
  23                 (elf-entry-type-class-of section)
  24                 (elf-entry-type-of section)
  25                 (size-of section)))
  26
  27 ;; test code
  28
  29 ;; ELF Header:
  30 ;;   Magic:   7f 45 4c 46 01 01 01 00 00 00 00 00 00 00 00 00
  31 ;;   Class:                             ELF32
  32 ;;   Data:                              2's complement, little endian
  33 ;;   Version:                           1 (current)
  34 ;;   OS/ABI:                            UNIX - System V
  35 ;;   ABI Version:                       0
  36 ;;   Type:                              REL (Relocatable file)
  37 ;;   Machine:                           Intel 80386
  38 ;;   Version:                           0x1
  39 ;;   Entry point address:               0x0
  40 ;;   Start of program headers:          0 (bytes into file)
  41 ;;   Start of section headers:          308 (bytes into file)
  42 ;;   Flags:                             0x0
  43 ;;   Size of this header:               52 (bytes)
  44 ;;   Size of program headers:           0 (bytes)
  45 ;;   Number of program headers:         0
  46 ;;   Size of section headers:           40 (bytes)
  47 ;;   Number of section headers:         11
  48 ;;   Section header string table index: 8
  49
  50
  51 ;; symbol related ---
  52
  53 ;; (defmacro slot-extract->flags (object slot extractor  &rest descriptions)
  54 ;;   (let ((slot-value-sym (gensym)))
  55 ;;     `(let ((,slot-value-sym (funcall ,extractor (slot-value ,object ,slot))))
  56 ;;        (remove-nils
  57 ;;         (list
  58 ;;          ,@(mapcar
  59 ;;             #'(lambda (description)
  60 ;;                 `(if
  61 ;;                   (not (zerop (logand ,slot-value-sym ,(car description))))
  62 ;;                   ,@(cdr description)))
  63 ;;             descriptions))))))
  64
  65 ;; (defun symbol-info-type-keywords (symbol-entry)
  66 ;;   (slot-extract->flags symbol-entry 'st-info
  67 ;;                        #'(lambda (x) (logand x #XF))
  68 ;;                        (+STT_NOTYPE+  :symbol-notype)
  69 ;;                        (+STT_OBJECT+  :symbol-data-object)
  70 ;;                        (+STT_FUNC+    :symbol-func)
  71 ;;                        (+STT_SECTION+ :symbol-section)
  72 ;;                        (+STT_FILE+    :symbol-file)
  73 ;;                        (+STT_COMMON+  :symbol-common)
  74 ;;                        (+STT_TLS+     :symbol-thread-local-storage)))
  75
  76 ;; (defun symbol-info-bind-keywords (symbol-entry)
  77 ;;   (slot-extract->flags symbol-entry 'st-info
  78 ;;                        #'(lambda (x) (ash x -4))
  79 ;;                        ;; This info is needed when parsing the symbol table
  80 ;;                        (+STB_LOCAL+  :symbol-bind-local)
  81 ;;                        (+STB_GLOBAL+ :symbol-bind-global)
  82 ;;                        (+STB_WEAK+   :symbol-bind-weak)))
  83
  84 ;; (defun symbol-info-keywords (symbol-entry)
  85 ;;   (list (symbol-info-type-keywords symbol-entry)
  86 ;;         (symbol-info-bind-keywords symbol-entry)))
  87
  88 ;; (defun extract-string (elf string-section-index offset)
  89 ;;   "Extract strings from the string section in an elf, identified by
  90 ;;    the given section index"
  91 ;;   (assert (< string-section-index (length (section-headers-of elf))))
  92 ;;   (let*
  93 ;;       ((elf-file (file-data-of elf))
  94 ;;        (string-section-header
  95 ;;         (nth string-section-index (section-headers-of elf)))
  96 ;;        (string-section-offset
  97 ;;         (slot-value string-section-header 'sh-offset)))
  98 ;;     (if (not (zerop offset))
  99 ;;           (elf-file-excursion
 100 ;;            elf
 101 ;;            (+ string-section-offset offset)
 102 ;;            (read-value 'asciiz elf-file))
 103 ;;           "*unnamed*")))
 104
 105
 106 ;; (defun extract-symbol (elf section-index symbol-offset)
 107 ;;   (assert (< section-index (length (section-headers-of elf))))
 108 ;;   (let ((section-header
 109 ;;          (elt (section-headers-of elf) section-index)))
 110 ;;     (let ((section-offset
 111 ;;            (slot-value section-header 'sh-offset)))
 112 ;;       (elf-file-excursion
 113 ;;        elf (+ section-offset symbol-offset)
 114 ;;        (read-value 'elf32-sym (file-data-of elf))))))
 115
 116 ;; (defclass elf-symbol-table-section (elf-section)
 117 ;;   ((string-table-of :initform 0)))
 118
 119 ;; (defun dump-symbol-table (elf section-index)
 120 ;;   (let
 121 ;;       ((section-header (elt (section-headers-of elf) section-index)))
 122 ;;     (let
 123 ;;         ((section-offset
 124 ;;           (slot-value section-header 'sh-offset))
 125 ;;          (section-size
 126 ;;           (slot-value section-header 'sh-size))
 127 ;;          (section-entsize
 128 ;;           (slot-value section-header 'sh-entsize)))
 129 ;;       (elf-file-excursion
 130 ;;        elf section-offset
 131 ;;        (let
 132 ;;            ((symbol-name-extractor
 133 ;;              (make-string-table-extractor
 134 ;;               elf
 135 ;;               (slot-value section-header 'sh-link))))
 136 ;;        (loop
 137 ;;           for offset = section-offset then (+ offset section-entsize)
 138 ;;           until (>= offset (+ section-offset section-size))
 139 ;;           do
 140 ;;             (let
 141 ;;                 ((symbtab-entry
 142 ;;                  (read-value 'elf32-sym (file-data-of elf))))
 143 ;;               (format t "Pos ~X  value ~A Size ~4,'0X Section ~2,'0X ~%"
 144 ;;                       (buffer-pos-of (file-data-of elf))
 145 ;;                       (funcall symbol-name-extractor (slot-value symbtab-entry 'st-name))
 146 ;;                       (slot-value symbtab-entry 'st-value)
 147 ;;                       (slot-value symbtab-entry 'st-size)
 148 ;;                       ;; to do - need flags from st-info
 149 ;;                       (slot-value symbtab-entry 'st-shndx))
 150 ;;                  ;; now we have symbtab-entry, do something with it
 151 ;;               )))))))
 152
 153 ;; (defun rel-type (rel-entry)
 154 ;;   (logand (slot-value rel-entry 'r-info) #XFF))
 155
 156 ;; (defun rel-sym (rel-entry)
 157 ;;   (ash (slot-value rel-entry 'r-info) -8))
 158
 159 ;; (defun relocation-info-type-keywords (relocation-entry)
 160 ;;   (slot-extract->flags relocation-entry 'r-info
 161 ;;                        #'rel-type
 162 ;;                        (+R_386_NONE+     :no-relocation)
 163 ;;                        (+R_386_32+           :direct-32-bit)
 164 ;;                        (+R_386_PC32+     :pc-relative-32-bit)
 165 ;;                        (+R_386_GOT32+            :got-entry-32-bit)
 166 ;;                        (+R_386_PLT32+            :plt-address-32bit)
 167 ;;                        (+R_386_COPY+     :copy-symbol-at-runtime)
 168 ;;                        (+R_386_GLOB_DAT+   :create-got-entry)
 169 ;;                        (+R_386_JMP_SLOT+   :create-plt-entry)
 170 ;;                        (+R_386_RELATIVE+   :ajust-by-program-base)
 171 ;;                        (+R_386_GOTOFF+           :got-32-bit-offset)
 172 ;;                        (+R_386_GOTPC+            :got-32-bit-pc-relative-offset)
 173 ;;                        (+R_386_32PLT+            :plt-32-bit)
 174 ;;                        (+R_386_TLS_TPOFF+  :static-tls-block-offset)
 175 ;;                        (+R_386_TLS_IE+           :got-entry-address-for-static-tls)
 176 ;;                        (+R_386_TLS_GOTIE+    :got-entry-for-static-tls)
 177 ;;                        (+R_386_TLS_LE+           :relative-offset-to-static-tls)
 178 ;;                        (+R_386_TLS_GD+           :gnu-32-general-dynamic-thread-data)
 179 ;;                        (+R_386_TLS_LDM+      :gnu-32-local-dynamic-thread-data)
 180 ;;                        (+R_386_16+           :direct-16-bit)
 181 ;;                        (+R_386_PC16+     :pc-relative-16-bit)
 182 ;;                        (+R_386_8+                :direct-8-bit)
 183 ;;                        (+R_386_PC8+      :pc-relative-8-bit)
 184 ;;                        (+R_386_TLS_GD_32+   :direct-32-bit-tls)
 185 ;;                        (+R_386_TLS_GD_PUSH+  :pushl-tls)
 186 ;;                        (+R_386_TLS_GD_CALL+  :call-tls)
 187 ;;                        (+R_386_TLS_GD_POP+   :popl-tls)
 188 ;;                        (+R_386_TLS_LDM_32+   :call-tls-ldw)
 189 ;;                        (+R_386_TLS_LDM_PUSH+ :popl-tls-ldw)
 190 ;;                        (+R_386_TLS_LDM_CALL+ :call-tls-ldw)
 191 ;;                        (+R_386_TLS_LDM_POP+  :popl-tls-ldw)
 192 ;;                        (+R_386_TLS_LDO_32+   :tls-relative-offset)
 193 ;;                        (+R_386_TLS_IE_32+    :got-neg-tls-offset)
 194 ;;                        (+R_386_TLS_LE_32+    :neg-tls-offset)
 195 ;;                        (+R_386_TLS_DTPMOD32+ :modue-id)
 196 ;;                        (+R_386_TLS_DTPOFF32+ :offset-in-tls)
 197 ;;                        (+R_386_TLS_TPOFF32+  :neg-offset-in-tls)))
 198
 199
 200 ;; (defun dump-relocation-entries (elf section-index &key (addends nil))
 201 ;;   (let
 202 ;;       ((section-header (elt (section-headers-of elf) section-index)))
 203 ;;     (let ((section-offset
 204 ;;            (slot-value section-header 'sh-offset))
 205 ;;           (section-size
 206 ;;            (slot-value section-header 'sh-size))
 207 ;;           (section-entsize
 208 ;;            (slot-value section-header 'sh-entsize))
 209 ;;           (symbol-table-section-index
 210 ;;            (slot-value section-header 'sh-info))
 211 ;;           (relocation-section-index
 212 ;;            (slot-value section-header 'sh-link)))
 213 ;;       (elf-file-excursion
 214 ;;        elf section-offset
 215 ;;        (format t "Relocation Entries: for section ~A using symbol-table ~A~%"
 216 ;;                (elt (section-names-of elf) relocation-section-index)
 217 ;;                (elt (section-names-of elf) symbol-table-section-index))
 218 ;;        (loop
 219 ;;           for offset = section-offset then (+ offset section-entsize)
 220 ;;           until (>= offset (+ section-offset section-size))
 221 ;;           do
 222 ;;             (let*
 223 ;;                 ((rel-entry
 224 ;;                   (if addends
 225 ;;                       (read-value 'elf32-rela-a (file-data-of elf))
 226 ;;                       (read-value 'elf32-rela (file-data-of elf))))
 227 ;;                  (rel-offset (slot-value rel-entry 'r-offset))
 228 ;;                  (rel-symbol-table-index (rel-sym rel-entry))
 229 ;;                  (rel-symbol-name-table-index
 230 ;;                   (slot-value
 231 ;;                    (elt (section-headers-of elf) symbol-table-index)
 232 ;;                    'sh-link))
 233 ;;                  (rel-symbol
 234 ;;                   (extract-symbol elf rel-symbol-table-index (slot-value rel-entry 'r-offset))))
 235 ;;             (format t "Pos ~X Offset ~X Sym ~X Type ~X Table ~A Name ~A ~%"
 236 ;;                     (buffer-pos-of (file-data-of elf))
 237 ;;                     rel-offset
 238 ;;                     rel-symbol-table-index
 239 ;;                     (rel-type rel-entry)
 240 ;;                     (elt (section-names-of elf) rel-symbol-table-index)
 241 ;;                     (extract-name elf
 242 ;;                                   (slot-value  rel-symbol-name-table-index)
 243 ;;                                   (slot-value rel-stbol 'st-name)))))))))
 244
 245 ;; (defun describe-elf-file-sections (elf-file)
 246 ;;   (let
 247 ;;       ((elf-header (header-of elf-file)))
 248 ;;     ;; etc..
 249 ;;     (format t "~A section headers~%" (slot-value elf-header 'e-shnum))
 250 ;;     (loop
 251 ;;        for section-name in (section-names-of elf-file)
 252 ;;        for section-header in (section-headers-of elf-file)
 253 ;;        for section-index from 0 below (length (section-headers-of elf-file))
 254 ;;        do
 255 ;;          (let
 256 ;;               ((section-type
 257 ;;                 (section-type->description section-header))
 258 ;;                (section-offset
 259 ;;                 (slot-value section-header 'sh-offset))
 260 ;;                (section-size
 261 ;;                 (slot-value section-header 'sh-size))
 262 ;;               (section-entsize
 263 ;;                (slot-value section-header 'sh-entsize)))
 264 ;;            (format t "~%<~A>~%" section-name)
 265 ;;            (format t "Type: ~A~%" section-type)
 266 ;;            (format t "Flags ~A~%" (section-flags->descriptions section-header))
 267 ;;            (format t "Offset ~X Size ~X Entry Size ~X Entries ~X~%"
 268 ;;                    section-offset section-size section-entsize
 269 ;;                    (if (not (zerop section-entsize))
 270 ;;                        (/ section-size section-entsize)
 271 ;;                        0))
 272 ;;            (case (section-type->keyword section-header)
 273 ;;              (:program-data
 274 ;;               (if (member :allocate-memory (section-flags->keywords section-header))
 275 ;;                   (hexdump-section elf-file section-index)))
 276 ;;              (:symbol-table
 277 ;;               (dump-symbol-table elf-file section-index))
 278 ;;              (:relocation-entries-no-addend
 279 ;;               (dump-relocation-entries elf-file section-index))
 280 ;;              (:relocation-entries
 281 ;;               (dump-relocation-entries elf-file section-index :addends t)))))))
 282
 283
 284
 285