elf-file.lisp

   1
   2 (in-package :cl-elf)
   3
   4 (declaim (optimize (debug 3)
   5                    (safety 3)
   6                    (compilation-speed 0)
   7                    (speed 0)))
   8
   9 ;; -- handy things ----------------------------------------------------------
  10
  11 (defmacro once-only ((&rest names) &body body)
  12   (let ((gensyms (loop for n in names collect (gensym))))
  13     `(let (,@(loop for g in gensyms collect `(,g (gensym))))
  14       `(let (,,@(loop for g in gensyms for n in names collect ``(,,g ,,n)))
  15         ,(let (,@(loop for n in names for g in gensyms collect `(,n ,g)))
  16            ,@body)))))
  17
  18 (defmacro with-gensyms ((&rest names) &body body)
  19   `(let ,(loop for n in names collect `(,n (gensym)))
  20      ,@body))
  21
  22 (defun remove-nils (lst)
  23   "eliminate elements where nil"
  24   (let ((acc nil))
  25     (dolist (x lst (nreverse acc))
  26       (when x (push x acc)))))
  27
  28
  29 (defgeneric section-of (elf index))
  30
  31 (defgeneric (setf section-of) (value elf index))
  32
  33 (defgeneric offset-of (section))
  34
  35 (defgeneric entry-size-of (section))
  36
  37 (defgeneric size-of (section))
  38
  39 (defgeneric elf-type-of (section))
  40
  41 (defgeneric elf-entry-type-of (section))
  42
  43 (defgeneric elf-entry-type-class-of (section))
  44
  45 (defgeneric get-entry (section  &key elf-file index offset)
  46   (:documentation "Extract an entry from a section by index or offset"))
  47
  48 (defgeneric get-offset-from-index (section index))
  49
  50 (defgeneric make-rel-entry (elf-rel-info-entry &key section elf-file))
  51
  52 (defgeneric elf-section-name (elf index))
  53
  54 ;; -- elf-file -------------------------------------------------------------
  55
  56 ;; higher level structure for an elf file
  57 (defclass elf-file (buffered-data-mixin)
  58   ((header :accessor header-of :initform nil
  59            :documentation "Header of file")
  60    (sections :accessor sections-of :initform
  61              (make-array 0 :adjustable t :fill-pointer 0))))
  62
  63 ;; a few convienence methods to save needless repetition
  64
  65
  66 (defmacro buffered-data-excursion ((buffer pos) &rest body)
  67   "Ecexcute body, with buffered-pos-of elf at pos then restore it"
  68   (once-only (buffer)
  69     (with-gensyms (old-pos)
  70       `(let*
  71          ((,old-pos (buffer-pos-of ,buffer)))
  72          (setf
  73           (buffer-pos-of ,buffer) ,pos)
  74          (prog1
  75              (progn ,@body)
  76            (setf
  77             (buffer-pos-of ,buffer) ,old-pos))))))
  78
  79 (defmethod section-of ((elf elf-file)  index)
  80   (elt (sections-of elf) index))
  81
  82 (defmethod (setf section-of) (value (elf elf-file) index)
  83   (setf (elt (sections-of elf) index) value))
  84
  85
  86 ;; -- elf-section -------------------------------------------------------------
  87
  88 (defclass elf-section (buffered-data-mixin)
  89   ((header :accessor header-of :initform 0)
  90    (name :initform nil :accessor name-of))
  91    (:documentation "Object that represents a generic elf section"))
  92
  93
  94 (defmethod offset-of ((section elf-section))
  95   "Return the offset to the actual section data in the file."
  96   (sh-offset-of  (header-of section)))
  97
  98 (defmethod entry-size-of ((section elf-section))
  99   (sh-entsize-of (header-of section)))
 100
 101 (defmethod size-of ((section elf-section))
 102   (sh-size-of (header-of section)))
 103
 104 (defmethod initialize-instance :after ((section elf-section) &key elf index)
 105   (check-type elf elf-file)
 106   (let* ((elf-header (header-of elf))
 107          (section-header-offset
 108           (+ (e-shoff-of elf-header)
 109              (* index (e-shentsize-of elf-header)))))
 110     ;; move buffer pointer to start of section header
 111     (setf (buffer-pos-of elf)
 112           section-header-offset)
 113     ;; read in the section header
 114     (setf (header-of section)
 115           (read-value 'elf32-section-header elf))
 116     ;; grab the actual section itself now we know where it is via header
 117     (setf (buffered-data-of section)
 118                      (subseq (buffered-data-of elf)
 119                              (offset-of section)
 120                              (+ (offset-of section)
 121                                 (size-of section))))))
 122
 123
 124 (defmethod elf-type-of ((section elf-section))
 125   (sh-type-of (header-of section)))
 126
 127 (defclass elf-string-section (elf-section)
 128   ()
 129   (:documentation "Specialist class for elf string section"))
 130
 131 (defclass elf-symbol-section (elf-section)
 132   ()
 133   (:documentation "Specialist class for elf symbol section"))
 134
 135 (defclass elf-relinfo-section (elf-section)
 136   ()
 137   (:documentation "Specialist class for elf relocation info section"))
 138
 139 (defclass elf-relainfo-section (elf-section)
 140   ()
 141   (:documentation "Speciallist class for elf address relocation info section"))
 142
 143
 144 ;; -entries -----------------------------------------------------------------------------
 145
 146
 147 (defmethod elf-entry-type-of ((section elf-section))
 148   "Given the section, return the type used to read an entry from it via read-value"
 149   (let
 150       ((section-entry-types
 151         (list (cons +SHT_NULL+  'u8)
 152          (cons +SHT_STRTAB+  'asciiz)
 153          (cons +SHT_PROGBITS+  'u8)
 154          (cons +SHT_NOTE+  'asciiz)
 155          (cons +SHT_SYMTAB+  'elf-sym)
 156          (cons +SHT_REL+  'elf-rel)
 157          (cons +SHT_RELA+  'elf-rela))))
 158     (or
 159      (cdr (assoc (elf-type-of section) section-entry-types))
 160      'u8)))
 161
 162
 163 (defmethod elf-entry-type-class-of ((section elf-section))
 164   "Given the section, return the class that should be used to represent that section"
 165   (let
 166       ((section-entry-classes
 167         (list (cons +SHT_NULL+ 'elf-section)
 168          (cons +SHT_STRTAB+  'elf-string-section)
 169          (cons +SHT_PROGBITS+  'elf-section)
 170          (cons +SHT_NOTE+ 'elf-string-section)
 171          (cons +SHT_SYMTAB+ 'elf-symbol-section)
 172          (cons +SHT_REL+ 'elf-relinfo-section)
 173          (cons +SHT_RELA+ 'elf-relainfo-section))))
 174     (or
 175      (cdr (assoc (elf-type-of section) section-entry-classes))
 176      'elf-section)))
 177
 178
 179 (defmethod get-offset-from-index ((section elf-section)  index)
 180   "Given an index into a section calclate the offset it represents."
 181   (* index (entry-size-of section)))
 182
 183 (defmacro with-real-offset (real-offset-sym (section index offset) &rest body)
 184   "Use real-offset-sym to represent the actual offset represented by
 185 either index or offset into the section in body."
 186   (once-only (index)
 187     `(let* ((,real-offset-sym
 188              (if ,index
 189                  (* ,index (entry-size-of ,section))
 190                  ,offset)))
 191        ,@body)))
 192
 193 ;; -- exctrating entries from sections ---------------------------------------------
 194
 195
 196 (defmethod get-entry ((section elf-section) &key elf-file index offset)
 197   "Retrieve an entry from an elf-section via either an index or an offset."
 198   (declare (ignore elf-file))
 199   (assert (or (null offset) (null index)))
 200   (assert (or offset index))
 201   ;; this will fire if you try to index an unindexable section
 202   (assert (or (null index)
 203               (and index
 204                    (not (zerop (entry-size-of section))))))
 205   (with-real-offset real-offset
 206     (section index offset)
 207     (buffered-data-excursion
 208      (section real-offset)
 209          (read-value
 210           (elf-entry-type-of section)
 211           section))))
 212
 213 ;; -- strings from string sections ---------------------------------------------------
 214
 215 (defmethod get-entry ((section elf-string-section) &key elf-file index offset)
 216   "Retrieve an string from an appropiate section via an offset."
 217   (call-next-method section :elf-file elf-file :index index :offset offset)
 218   ;; you can't index these
 219   (assert (and (integerp offset) (null index)))
 220   (buffered-data-excursion
 221    (section offset)
 222     (read-value 'asciiz section)))
 223
 224 (defun make-entry-extractor (elf &key section-index)
 225   "Create and return a function to extract an entry from the given section."
 226   (lambda (offset)
 227     (get-entry (section-of elf section-index) :elf-file elf :offset offset)))
 228
 229  ;; -- symbol entries from symbol sections  -----------------------------------------
 230
 231 (defclass elf-symbol ()
 232   ((name :initarg :name :reader name-of)
 233    (entry :initarg :entry :reader entry-of)))
 234
 235 (defmethod get-entry ((section elf-symbol-section) &key elf-file index offset)
 236   "Extract a symbol from a symbol section."
 237   (let* ((elf-symbol (call-next-method section :elf-file elf-file :index index :offset offset))
 238          (string-extractor
 239           (make-entry-extractor
 240            elf-file
 241            :section-index (sh-link-of (header-of section)))))
 242     (make-instance 'elf-symbol
 243                    :name
 244                    (funcall string-extractor (st-name-of elf-symbol))
 245                    ;; to do - things with value, size, etc?
 246                    :entry
 247                    elf-symbol)))
 248
 249
 250 ;; -- relocation info entries from relocation info sections -------------------------
 251
 252 (defclass elf-rel-info ()
 253   ((rel-section-index :accessor rel-section-index-of
 254                       :initarg :rel-section-index
 255                       :documentation "Index of section this relocation affects.")
 256    (offset :accessor offset-of
 257            :initarg :offset
 258            :documentation "Offset into section where relocation is applied")
 259    (relocation-type :accessor relocation-type-of
 260                     :initarg :relocation-type
 261                     :documentation "Type of relocation to apply")
 262    (symbol :accessor symbol-of
 263            :initarg :symbol
 264            :documentation "Symbol associated with this relocation.")))
 265
 266
 267 (defmethod make-rel-entry ((elf-rel-info-entry elf-rel-info) &key section elf-file)
 268   (labels
 269       ((rel-type (rel-entry)
 270          (logand (r-info-of rel-entry) #XFF))
 271        (rel-sym (rel-entry)
 272          (ash (r-info-of rel-entry) -8)))
 273     (make-instance 'elf-rel-info
 274                    :rel-section-index (sh-info-of (header-of section))
 275                    :offset (r-offset-of elf-rel-info-entry)
 276                    :symbol (get-entry
 277                             (section-of elf-file
 278                                         (sh-link-of (header-of section)))
 279                             :index (rel-sym elf-rel-info-entry))
 280                    :type (rel-type elf-rel-info-entry))))
 281
 282 ;; -- relocation info entries with addends from relocation info sections -----------------
 283
 284 (defmethod get-entry ((section elf-relinfo-section)  &key elf-file index offset)
 285   "Extract a relocation symbol from a relocation section"
 286   (let ((elf-rel-info-entry
 287          (call-next-method section :elf-file elf-file
 288                                    :index index
 289                                    :offset offset)))
 290     (make-rel-entry elf-rel-info-entry
 291                     :elf-file elf-file
 292                     :section section)))
 293
 294
 295 (defclass elf-rela-info (elf-rel-info)
 296   ((addend
 297     :accessor addend-of
 298     :initarg :addend))
 299   (:documentation "Represents a relocation info record with an addend"))
 300
 301 (defmethod update-instance-for-different-class :after ((old elf-rel-info)
 302                                                         (new elf-rela-info)
 303                                                        &key addend)
 304   "Convert a plain relocation record into one with an addend."
 305   (setf (addend-of new) addend))
 306
 307 (defmethod make-rel-entry ((rel-entry elf-rela-info) &key section elf-file)
 308   (let ((result (call-next-method rel-entry :section section :elf-file elf-file)))
 309     (change-class result 'elf-rela-info :addend (r-addend-of result))))
 310
 311 (defmethod get-entry ((section elf-relainfo-section)  &key elf-file index offset)
 312   "Extract a relocation symbol from a relocation section with addends"
 313   (let* ((elf-rela-info-entry
 314          (call-next-method section :elf-file elf-file
 315                                    :index index
 316                                    :offset offset))
 317          (result (make-rel-entry elf-rela-info-entry
 318                                  :elf-file elf-file
 319                                  :section section)))
 320     result))
 321
 322
 323
 324 ;; --- extract name of a section --------------------------------------------------
 325
 326
 327 (defmethod elf-section-name ((elf elf-file) index)
 328   "Return the name of a section, given the index."
 329   (let
 330       ((string-section-index (e-shstrndx-of (header-of  elf))))
 331    (get-entry  (aref (sections-of elf) string-section-index)
 332                :offset (sh-name-of (header-of (aref (sections-of elf) index))))))
 333
 334
 335 ;; actually read an elf file --------------------------------------------------------
 336
 337
 338 (defmethod initialize-instance :after ((elf elf-file) &key filepath)
 339   "Actually read an elf file and process the sections."
 340     (labels
 341         ((read-header ()
 342            "Read and set the elf file header"
 343            (setf (buffer-pos-of elf) 0)
 344            (setf (header-of elf)
 345                  (read-value 'elf-header elf)))
 346
 347          ;; create n empty sections for each section in the elf file
 348          (create-sections (section-count)
 349            "Create the sections in the elf file, specialising them as we go along."
 350            (loop
 351               for section-index from 0 below section-count
 352               do (let
 353                      ((section (make-instance 'elf-section :elf elf :index section-index)))
 354                    (change-class section (elf-entry-type-class-of section))
 355                    (vector-push-extend section (sections-of elf)))))
 356
 357          (set-section-names ()
 358            (loop
 359               for section-index from 0 below (e-shnum-of (header-of elf))
 360               do (let ((section (section-of elf section-index)))
 361                    (setf (name-of section)
 362                          (elf-section-name elf section-index))))))
 363
 364
 365       ;; defmethod read-elf file
 366       (read-buffered-data elf :filepath filepath)
 367       (read-header)
 368       (create-sections (e-shnum-of (header-of elf)))))
 369
 370