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