example.lisp

   1 ;;;;------------------------------------------------------------------
   2 ;;;;
   3 ;;;;    Copyright (C) 200120001999,
   4 ;;;;    Department of Computer Science, University of Tromsø, Norway
   5 ;;;;
   6 ;;;; Filename:      example.lisp
   7 ;;;; Description:
   8 ;;;; Author:        Frode Vatvedt Fjeld <frodef@acm.org>
   9 ;;;; Created at:    Wed Dec  8 15:15:06 1999
  10 ;;;; Distribution:  See the accompanying file COPYING.
  11 ;;;;
  12 ;;;; $Id: example.lisp,v 1.1.1.1 2004/01/13 11:13:13 ffjeld Exp $
  13 ;;;;
  14 ;;;;------------------------------------------------------------------
  15
  16 (defpackage "EXAMPLE"
  17   (:use "COMMON-LISP" "BINARY-TYPES")
  18   (:export run))
  19
  20 (in-package "EXAMPLE")
  21
  22 ;;; ELF basic types
  23 (define-unsigned word 4)
  24 (define-signed sword  4)
  25 (define-unsigned addr 4)
  26 (define-unsigned off  4)
  27 (define-unsigned half 2)
  28
  29 ;;; Mapping from ELF symbols to BT:*ENDIAN* values
  30 (defun elf-data-to-endian (elf-data)
  31   (ecase elf-data
  32     ((elf-data-2lsb) :little-endian)
  33     ((elf-data-2msb) :big-endian)))
  34
  35 (defconstant +ELF-MAGIC+ '(#x7f #\E #\L #\F))
  36
  37 ;;; ELF file header structure
  38 (define-binary-class elf-header ()
  39   ((e-ident
  40     :binary-type (define-binary-struct e-ident ()
  41                    (ei-magic nil :binary-type
  42                              (define-binary-struct ei-magic ()
  43                                (ei-mag0 0 :binary-type u8)
  44                                (ei-mag1 #\null :binary-type char8)
  45                                (ei-mag2 #\null :binary-type char8)
  46                                (ei-mag3 #\null :binary-type char8)))
  47                    (ei-class nil :binary-type
  48                              (define-enum ei-class (u8)
  49                                elf-class-none 0
  50                                elf-class-32   1
  51                                elf-class-64   2))
  52                    (ei-data nil :binary-type
  53                             (define-enum ei-data (u8)
  54                               elf-data-none 0
  55                               elf-data-2lsb 1
  56                               elf-data-2msb 2))
  57                    (ei-version 0 :binary-type u8)
  58                    (padding nil :binary-type 1)
  59                    (ei-name "" :binary-type
  60                             (define-null-terminated-string ei-name 8))))
  61    (e-type
  62     :binary-type (define-enum e-type (half)
  63                    et-none 0
  64                    et-rel  1
  65                    et-exec 2
  66                    et-dyn  3
  67                    et-core 4
  68                    et-loproc #xff00
  69                    et-hiproc #xffff))
  70    (e-machine
  71     :binary-type (define-enum e-machine (half)
  72                    em-none  0
  73                    em-m32   1
  74                    em-sparc 2
  75                    em-386   3
  76                    em-68k   4
  77                    em-88k   5
  78                    em-860   7
  79                    em-mips  8))
  80    (e-version   :binary-type word)
  81    (e-entry     :binary-type addr)
  82    (e-phoff     :binary-type off)
  83    (e-shoff     :binary-type off)
  84    (e-flags     :binary-type word)
  85    (e-ehsize    :binary-type half)
  86    (e-phentsize :binary-type half)
  87    (e-phnum     :binary-type half)
  88    (e-shentsize :binary-type half)
  89    (e-shnum     :binary-type half)
  90    (e-shstrndx  :binary-type half)))
  91
  92 (define-condition elf32-reader-error (error)
  93   ((stream :initarg :stream :reader elf32-parse-error-stream)
  94    (message :initarg :message :reader elf32-parse-error-message))
  95   (:report (lambda (condition stream)
  96              (princ (elf32-parse-error-message condition)
  97                     stream))))
  98
  99 (define-condition elf32-wrong-magic (elf32-reader-error)
 100   ((magic :initarg :magic :reader elf32-wrong-magic-magic)))
 101
 102 (define-condition elf32-wrong-class (elf32-reader-error)
 103   ((class :initarg :class :reader elf32-wrong-class-class)))
 104
 105 (defun read-elf-file-header (stream)
 106   "Returns an ELF-HEADER and the file's endianess."
 107   (let ((header (read-binary 'elf-header stream :stop 'e-type)))
 108     (with-slots (ei-data ei-class ei-magic)
 109         (slot-value header 'e-ident)
 110       (let* ((binary-types:*endian* (elf-data-to-endian ei-data))
 111              (magic (mapcar #'(lambda (slot-name)
 112                                 (slot-value ei-magic slot-name))
 113                             (binary-record-slot-names 'ei-magic))))
 114         ;; Check that file is in fact 32-bit ELF
 115         (unless (equal +ELF-MAGIC+ magic)
 116           (error 'elf32-wrong-magic
 117                  :stream stream
 118                  :message (format nil "file doesn't match ELF-MAGIC: ~A" magic)
 119                  :magic magic))
 120         (unless (eq 'elf-class-32 ei-class)
 121           (error 'elf32-wrong-class
 122                  :stream stream
 123                  :message (format nil "file is not 32-bit ELF (~A)" ei-class)
 124                  :class ei-class))
 125         ;; Read the rest of the file-header and merge it with what
 126         ;; we've allready got.
 127         (let ((rest (read-binary 'elf-header stream :start 'e-type)))
 128           (dolist (slot-name (binary-record-slot-names 'elf-header))
 129             (unless (slot-boundp header slot-name)
 130               (setf (slot-value header slot-name)
 131                 (slot-value rest slot-name))))
 132           (values header binary-types:*endian*))))))
 133
 134 (defun run (path)
 135   (with-binary-file (stream path :direction :input)
 136     (let ((elf-header (read-elf-file-header stream)))
 137       (format t "~&ELF header for \"~A\":~:{~&~12@A: ~S~}~%" path
 138               (mapcar #'(lambda (slot-name)
 139                           (list slot-name
 140                                 (slot-value elf-header slot-name)))
 141                       (binary-record-slot-names 'elf-header)))
 142       elf-header)))
 143
 144 #+unix
 145 (run "/bin/ls")
 146