-
Notifications
You must be signed in to change notification settings - Fork 15
Tutorial: Using LISP BINARY to Edit or Remove EXIF Data in JPEG Files.
This tutorial is intended to show you how to use LISP-BINARY to build a program to remove EXIF metadata from JPEG files. EXIF metadata can contain various compromising pieces of information, such as the GPS coordinates where the picture was taken, and the make/model of the camera (or phone).
The code shown here actually parses EXIF, so you could adapt it to alter the metadata instead of removing it.
Since EXIF data in JPEG files is found in an embedded TIFF file, you will also be writing a TIFF reader/writer.
The program doesn't attempt to deal with the actual pixel data, except by copying it byte for byte to the output file.
This tutorial assumes you are already familiar with Common Lisp, and that you already have Quicklisp, EMACS, and SLIME set up.
At the REPL prompt:
CL-USER> (ql:quickload :lisp-binary)
Then, create a package for the project in the source buffer (exif.lisp):
(defpackage :exif
(:use :common-lisp :lisp-binary :lisp-binary-utils))
(in-package :exif)
Finally, command the REPL to go into the new package:
CL-USER> (in-package :exif)
EXIF>
To get at the EXIF data, you don't need to implement the whole JPEG specification. All you need is to get the first few "segments", as they call them, until you get to the one with the EXIF data. Then you can read the rest of the file as just a byte array.
Each segment of a JPEG file begins with a tag that identifies what kind of segment it is. The segment has the following format:
First, two octets for the magic number and the code:
FF cc
Then, depending on the value of cc, an integer of either 16 bits or 32 bits, or nothing at all. If it's a 16-bit integer, it's the length, otherwise it's something called the restart interval. This can be represented in Lisp-Binary as follows:
;; NOT THE FINAL IMPLEMENTATION
(defbinary jpeg-generic-tag (:byte-order :big-endian)
(magic #xff :type (magic :actual-type (unsigned-byte 8)
:value #xff))
(code 0 :type (unsigned-byte 8))
(length-or-restart-interval
0 :type (eval
(case code
(#xdd '(unsigned-byte 32)) ;; It's either a restart interval,
((#xd8 #xd0 #xd1 #xd2 #xd3 #xd4 #xd5 #xd6 #xd7
#xd9)
'null) ;; ...nothing at all,
(otherwise
'(unsigned-byte 16)))))) ;; ...or a length.
This generates a (defstruct jpeg-generic-tag ...) form, along with implementations of the methods READ-BINARY and WRITE-BINARY. These methods read or write their struct sequentially, in this case starting with the magic field.
The magic field uses the magic type:
(magic :actual-type (unsigned-byte 8)
:value #xff)
What that does is tell Lisp-Binary to read an (unsigned-byte 8) (ie, an octet) and raise a condition
of type LISP-BINARY:BAD-MAGIC-VALUE if the value is not equal to FF hex (255 decimal). In the event that this condition is raised, the restart CONTINUE will be defined so that you can ignore it, although I've found that when this exception gets thrown, it's a sign that the file isn't being read correctly.
The code field is just an uninteresting byte (LISP-BINARY will read it with read-integer), and then we have the length-or-restart-interval field. For its :type, it has what looks like an eval statement, but if you look carefully, you'll see that the argument is not quoted.
The eval here is not the Lisp function eval, but the EVAL Type Specifier. The expression given as an argument will be evaluated every time a jpeg-generic-tag is read, and must create the name of the type that needs to be read. After the type is determined, then READ-BINARY will read that type, and WRITE-BINARY will write it. In this particular case,
we check if the code indicates that this tag falls into one of three categories:
- The tag requires the 32-bit restart interval instead of a 16-bit length
- The tag has no trailing integer at all (ie, has a
NULLtype). - The tag has a 16-bit length.
The NULL type is special. It indicates that the field is to be skipped entirely. It is neither read nor
written, and the corresponding slot is set to NIL when READ-BINARY creates it.
It would be nice if we could separate the length field from the restart-interval tag. The NULL type makes this possible:
;; STILL NOT THE FINAL IMPLEMENTATION
(defbinary jpeg-generic-tag (:byte-order :big-endian)
(magic #xff :type (magic :actual-type (unsigned-byte 8)
:value #xff))
(code 0 :type (unsigned-byte 8))
(length 0 :type (eval
(case code
((#xd8 #xd0 #xd1 #xd2 #xd3 #xd4 #xd5 #xd6 #xd7
#xd9 #xdd)
'null) ;; Don't read it as a LENGTH if it's not a LENGTH.
(otherwise
'(unsigned-byte 16)))))
(restart-interval nil :type (eval
(if (= code #xdd)
'(unsigned-byte 32)
'null))))
Finally, it would be useful to know how many bytes into the file the tag and the
length field appear. The location of the tag is useful mainly for debugging purposes,
but we need the location of the length field to be able to correctly write the JPEG
file back to disk.
The FILE-POSITION type is another special type that doesn't read or write anything to/from disk. Instead, the reader/writer takes the current file position using CL:FILE-POSITION and puts it into the member variable. A FILE-POSITION field acts like an invisible tag.
;; Final implementation. You can copy and paste this.
(defbinary jpeg-generic-tag (:byte-order :big-endian)
(offset 0 :type file-position)
(magic #xff :type (magic :actual-type (unsigned-byte 8)
:value #xff))
(code 0 :type (unsigned-byte 8))
(length-offset 0 :type file-position)
(length 0 :type (eval
(case code
((#xd8 #xd0 #xd1 #xd2 #xd3 #xd4 #xd5 #xd6 #xd7
#xd9 #xdd)
'null)
(otherwise
'(unsigned-byte 16)))))
(restart-interval nil :type (eval
(if (= code #xdd)
'(unsigned-byte 32)
'null))))
The simplest possible way to describe a JPEG segment is as follows:
;; NOT THE FINAL IMPLEMENTATION
(defbinary jpeg-generic-segment (:byte-order :big-endian)
(tag nil :type jpeg-generic-tag)
(contents-position 0 :type file-position)
(contents nil :type (eval
(cond ((null (slot-value tag 'length))
'null)
(t `(simple-array (unsigned-byte 8) (,(- (slot-value tag 'length) 2))))))))
The above first reads a jpeg-generic-tag (defined above), then it either reads
the contents or it doesn't depending on whether the tag's length field was NIL.
You can try it at the REPL. Here is the JPEG file I'll be using in these examples:
EXIF> (defparameter *stream* (open-binary #P"airfield.jpg"))
*STREAM*
EXIF> (read-binary 'jpeg-generic-segment *stream*)
#S(JPEG-GENERIC-SEGMENT
:TAG #S(JPEG-GENERIC-TAG
:OFFSET 0
:MAGIC 255
:CODE 216
:LENGTH-OFFSET 2
:LENGTH NIL
:RESTART-INTERVAL NIL)
:CONTENTS-POSITION 2
:CONTENTS NIL)
2
EXIF> `(read-binary 'jpeg-generic-segment stream)
#S(JPEG-GENERIC-SEGMENT
:TAG #S(JPEG-GENERIC-TAG
:OFFSET 2
:MAGIC 255
:CODE 225
:LENGTH-OFFSET 4
:LENGTH 33656
:RESTART-INTERVAL NIL)
:CONTENTS-POSITION 6
:CONTENTS #(69 120 105 102 0 0 77 77 0 42 0 0 0 8 0 7 1 15 0 2 0 0 0 7 0 0 0
98 1 16 0 2 0 0 0 5 0 0 0 106 1 26 0 5 0 0 0 1 0 0 0 112 1 27 0
5 0 0 0 1 0 0 0 120 1 40 0 3 0 0 0 1 0 2 0 0 2 19 0 3 0 0 0 1 0
1 0 0 135 105 0 4 0 0 0 1 0 0 0 128 0 0 1 76 72 85 65 87 69 73 0
0 77 56 54 53 0 0 0 0 0 72 0 0 0 1 0 0 0 72 0 0 0 1 0 10 144 0 0
7 0 0 0 4 48 50 50 48 144 3 0 2 0 0 0 20 0 0 0 254 144 4 0 2 0 0
Bytes edited out for brevity
203 199 163 82 180 36 29 241 22 192 229 131 48 192 255 0 26 21
132 253 6 203 166 205 113 251 212 141 182 158 114 88 96 211 35
179 185 131 12 176 190 225 221 15 63 165 92 75 187 173 129 11 13
159 221 221 129 254 20 137 46 9 84 125 174 15 35 111 245 167 204
237 98 28 87 204 167 231 56 225 145 189 212 241 82 110 101 76
244 30 228 154 150 123 169 100 56 124 184 30 170 42 21 187 40
167 32 0 123 116 163 94 193 107 117 25 18 71 35 14 54 119 220
167 24 20 160 177 124 71 48 113 219 204 226 167 55 173 32 93 176
166 222 153 207 90 116 144 171 227 49 133 39 144 114 104 109 245
29 180 208 3 74 152 222 209 101 79 59 64 108 254 34 129 38 225
196 74 79 169 53 11 195 34 156 4 99 143 238 176 233 73 229 249
67 228 59 164 238 172 192 226 150 227 179 69 129 6 224 100 199
151 143 65 154 107 237 49 130 146 228 231 158 58 213 51 246 166
96 37 66 232 125 7 242 164 54 240 68 227 23 37 27 169 83 205 52
188 195 71 178 47 52 139 41 85 87 17 175 0 140 103 241 168 204
74 28 18 7 150 58 241 75 111 36 48 149 43 137 92 117 96 216 169
228 185 142 102 249 99 224 245 80 67 12 254 53 37 36 127 255
217))
33658
EXIF> (file-position *stream* 0) ;; Go back to the beginning
Calling read-binary repeatedly will give you each successive segment in the file, until you get to a certain point, and then you'll get a BAD-MAGIC-VALUE error.
The CODE value above indicates which segment contains the EXIF data. It will be one of the segments that has a CODE of 225, which indicates a JPEG "APP1" segment.
Not every "APP1" segment is EXIF data, however, so we'll need to parse all "APP1" segments, but any other segment can just be read as a bunch of bytes, since we don't care what's in them.
If the APP1 segment is the one containing the EXIF data, then it will contain a TIFF header. The first thing in this header is a byte-order, for which it will be convenient to use an enum:
(define-enum tiff-byte-order 2 (:byte-order :little-endian)
(:little-endian #x4949)
(:big-endian #x4d4d))
define-enum works like C's enum construct. You can either explicitly specify each value
using parentheses (shown above), or leave out the parentheses. Details here.
TIFF format cannot be handled using a static byte order like we've used for all
the JPEG headers. :byte-order :dynamic tells the library that whenever the byte-order of
something is in question, it needs to consult the lisp-binary:*byte-order* variable.
We can override the default reader for the byte-order slot so that it also sets
the *byte-order* special variable, so that everything that follows is read in the
correct byte order:
(defbinary tiff (:byte-order :dynamic)
(byte-order 0 :type tiff-byte-order :reader (lambda (stream)
(values
(setf *byte-order* (read-binary-type 'tiff-byte-order stream))
2)))
(magic 42 :type (magic :actual-type (unsigned-byte 16)
:value 42))
(offset-ptr 0 :type file-position)
(first-image-file-directory-offset 0 :type (unsigned-byte 32)))
It is now possible to get our first look at our JPEG file's EXIF header. Recall the second segment in the file:
#S(JPEG-GENERIC-SEGMENT
:TAG #S(JPEG-GENERIC-TAG
:OFFSET 2
:MAGIC 255
:CODE 225
:LENGTH-OFFSET 4
:LENGTH 33656
:RESTART-INTERVAL NIL)
:CONTENTS-POSITION 6
:CONTENTS #(69 120 105 102 0 0 77 77 0 42 0 0 0 8 0 7 1 15 0 2 0 0 0 7 0 0 0
....
The CONTENTS-POSITION field was of type FILE-POSITION, meaning it was the position of the next byte to be read just before the CONTENTS were read. A 6-byte magic number will start there, so the TIFF data will be at position 12.
EXIF> (file-position *stream* 12)
T
EXIF> (read-binary 'tiff *stream*)
#S(TIFF
:BYTE-ORDER :BIG-ENDIAN
:MAGIC 42
:OFFSET-PTR 16
:FIRST-IMAGE-FILE-DIRECTORY-OFFSET 8)
8
The first-image-file-directory offset points to another important structure in TIFF format. Every offset
within the embedded TIFF file will be relative to the beginning of the TIFF header. So that 8 is really
8 + 12 = 20.
We can tell LISP-BINARY to keep track of this for us by starting the TIFF structure with a BASE-POINTER:
(defbinary tiff (:byte-order :dynamic)
(tiff-base-pointer 0 :type base-pointer)
(byte-order 0 :type tiff-byte-order :reader (lambda (stream)
(values
(setf *byte-order* (read-binary-type 'tiff-byte-order stream))
2)))
(magic 42 :type (magic :actual-type (unsigned-byte 16)
:value 42))
(offset-ptr 0 :type file-position)
(first-image-file-directory-offset 0 :type (unsigned-byte 32)))
Base-pointers are just like file-positions, except they're stored in a global variable that allows other
DEFBINARY definitions to refer to it.
The first-image-file-directory slot points to an instance of the following structure:
(defbinary tiff-image-file-directory
(:align 2 :byte-order :dynamic)
(directory-entries #() :type (counted-array 2 directory-entry))
(next-directory-offset 0 :type (unsigned-byte 32)))
The definition above uses a new LISP-BINARY type, counted-array. It also depends on a type called directory-entry.
A simplified version of directory-entry looks like this:
(defbinary directory-entry (:byte-order :dynamic)
(file-position 0 :type file-position)
(tag 0 :type (unsigned-byte 16))
(type 0 :type (unsigned-byte 16))
(count 0 :type (unsigned-byte 32))
(value 0 :type (unsigned-byte 32)))
This, unfortunately, isn't very useful. The value, for instance, can have varying lengths up to 4 bytes,
but if it has any length other than 4, then it must be followed by padding bytes to keep the total length
of the struct the same (total 12 octets). Sometimes, the value is really an offset that points to the
actual value. The final definition of value as found in the demo will require 38 lines of code.
The type slot could be an enum:
(define-enum tiff-type 2 (:byte-order :dynamic)
(:unsigned-byte 1)
:ascii
:unsigned-short
:unsigned-long
:unsigned-rational ;; Two unsigned-longs
:signed-byte
:undefined
:signed-short
:signed-long
:signed-rational
:single-float
:double-float)
TIFF format supports rational numbers, represented as two 32-bit integers one after the other. We need a reader and writer to convert these to Lisp rational numbers:
(defun read-rational (type stream)
"Reads both :SIGNED-RATIONAL and :UNSIGNED-RATIONAL, which must be specified in the TYPE argument."
(let-values* ((signed (ecase type
(:unsigned-rational nil)
(:signed-rational t)))
((numerator numerator-bytes) (read-integer 4 stream :byte-order *byte-order*
:signed signed))
((denominator denominator-bytes) (read-integer 4 stream :byte-order *byte-order*
:signed signed)))
(values (/ numerator denominator)
(+ numerator-bytes denominator-bytes))))
(defun write-rational (value type stream)
(let* ((signed (ecase type
(:unsigned-rational nil)
(:signed-rational t))))
(+
(write-integer (numerator value) 4 stream :byte-order *byte-order*
:signed signed)
(write-integer (denominator value) 4 stream :byte-order *byte-order*
:signed signed))))
We will also need to frequently convert between our TIFF-TYPE enum and the
corresponding DEFBINARY types (including a CUSTOM type to handle :signed-rational
and :unsigned-rational):
(defun tiff-type->defbinary-type (type)
(ecase type
((:unsigned-long :undefined) '(unsigned-byte 32))
(:signed-long '(signed-byte 32))
(:double-float 'double-float)
(:single-float 'single-float)
(:ascii '(terminated-string 1))
((:signed-rational :unsigned-rational)
`(custom :reader (lambda (stream)
(read-rational ,type stream))
:writer (lambda (obj stream)
(write-rational obj ,type stream))))
(:signed-byte '(signed-byte 8))
(:unsigned-byte '(unsigned-byte 8))
(:signed-short '(signed-byte 16))
(:unsigned-short '(unsigned-byte 16))))
There are also cases where we need to suppress LISP-BINARY's writer:
(defun no-writer (obj stream)
(declare (ignore obj stream))
0)
TIFF format often makes use of pointers to '0'. Often, this will be a pointer to an Image File Directory, which is what is found at offset 0 from the beginning of the TIFF header. Not catching these will result in infinite recursion.
(defun ensure-non-null-pointer (pointer-value)
(assert (/= 0 pointer-value)))
The final definition of directory-entry:
(defbinary directory-entry (:byte-order :dynamic)
(file-position 0 :type file-position)
(tag 0 :type (unsigned-byte 16))
(type 0 :type tiff-type)
(count 0 :type (unsigned-byte 32)
;; This custom writer ensures that the COUNT remains
;; synced with the length of the VALUE below.
:writer (lambda (obj stream)
(declare (ignore obj))
(setf count (if (eq type :ascii)
(1+ (length value))
(if (or (listp value)
(vectorp value))
(length value)
1)))
(write-integer count 4 stream :byte-order *byte-order*)))
;; The VALUE depends on both the TYPE and the COUNT. The total number of
;; bytes needed to store the VALUE is given by (size of the type) * (count).
;; If this size is > 4 bytes, then the type of the VALUE must resolve to:
;;
;; (pointer :pointer-type (unsigned-byte 32)
;; :data-type the-actual-type-of-the-value
;; :base-pointer 'tiff-base-pointer
;; :region-tag 'tiff-region)
;;
;; The BASE-POINTER is declared at the beginning of the TIFF type definition,
;; and tells the LISP-BINARY library that the pointer is an offset that
;; begins at the BASE-POINTER.
;;
;; The REGION-TAG is used in writing the pointer. The region tag named
;; TIFF-REGION is also declared in the TIFF type definition, and determines
;; where the data being pointed to will end up going. The value is merely
;; STORED when the pointer is written, and it gets written to disk when the
;; REGION-TAG is reached.
(value 0 :type (eval
(cond
;; This tells LISP-BINARY that strings with a count <= 4
;; (which includes the terminating NUL) will fit inside
;; the VALUE, so we don't need a pointer.
((and (eq type :ascii)
(<= count 4))
(tiff-type->defbinary-type :ascii))
;; This tells LISP-BINARY that byte arrays with
;; count <= 4 and short arrays with count <= 2
;; will fit within the VALUE.
((or (and (member type '(:signed-byte :unsigned-byte))
(<= count 4)
(> count 1))
(and (member type '(:signed-short :unsigned-short))
(= count 2)))
`(simple-array ,(tiff-type->defbinary-type type)
(,count)))
;; This makes any other array type into a pointer.
((> count 1)
`(pointer :pointer-type (unsigned-byte 32)
:data-type ,(if (eq type :ascii)
(tiff-type->defbinary-type :ascii)
`(simple-array ,(tiff-type->defbinary-type type) (,count)))
:base-pointer-name 'tiff-base-pointer
:validator #'ensure-non-null-pointer
:region-tag 'tiff-region))
;; Certain tags mark their value as being an
;; unsigned long, but they should really be treated
;; as pointers to Image File Directories.
((member tag '(34665 ;; EXIF
34853 ;; GPS
40965)) ;; Interoperability
`(pointer :pointer-type (unsigned-byte 32)
:data-type tiff-image-file-directory
:base-pointer-name 'tiff-base-pointer
:validator #'ensure-non-null-pointer
:region-tag 'tiff-region))
(t
(case type
((:undefined)
'(unsigned-byte 32))
;; Some types are just plain too big to fit in the VALUE.
;; Generate pointers to them.
((:double-float :signed-rational :unsigned-rational :ascii)
`(pointer :pointer-type (unsigned-byte 32)
:data-type ,(tiff-type->defbinary-type type)
:base-pointer-name 'tiff-base-pointer
:validator #'ensure-non-null-pointer
:region-tag 'tiff-region))
;; Some types will fit just fine.
(otherwise (tiff-type->defbinary-type type)))))))
;; If the VALUE doesn't use 32 bits, then it must be padded. The PADDING
;; is an unsigned integer that fills in the space not used by the VALUE.
(padding 0 :type (eval (if (> count 1)
'null
(ecase type
(:ascii
(if (>= count 4)
'null
`(unsigned-byte ,(* 8 (- 4 count)))))
((:unsigned-long :unsigned-rational :signed-rational :double-float :signed-long
:single-float :undefined)
'null)
((:signed-byte :unsigned-byte)
'(unsigned-byte 24))
((:signed-short :unsigned-short)
'(unsigned-byte 16)))))))
Be sure to look at the wiki page on Automatic Pointer Resolution. It includes a compact example that demonstrates base pointers, data pointers, and region tags.
(defvar *exif-header* #x457869660000)
(defbinary jpeg-app1-body (:byte-order :big-endian)
(exif-header 0 :type (unsigned-byte 48))
(body nil :type (eval (if (= exif-header *exif-header*)
'tiff
'null))))
(defbinary jpeg-generic-segment (:byte-order :big-endian)
(file-position 0 :type file-position)
(tag nil :type jpeg-generic-tag)
(contents nil :type (eval
(cond ((= (slot-value tag 'code) 225)
'jpeg-app1-body)
((null (slot-value tag 'length))
'null)
(t `(simple-array (unsigned-byte 8) (,(- (slot-value tag 'length) 2)))))))
(buffer nil :type (eval
(if (or (and (jpeg-app1-body-p contents)
(tiff-p (slot-value contents 'body)))
(jpeg-tag-no-length-p tag))
'null
`(simple-array (unsigned-byte 8) (,(- (slot-value tag 'length) 8)))))))
zzzzzzz
(defbinary tiff (:byte-order :dynamic :preserve-*byte-order* nil)
(tiff-base-pointer 0 :type base-pointer)
(byte-order 0 :type tiff-byte-order :reader (lambda (stream)
(values
(setf *byte-order* (read-enum 'tiff-byte-order stream))
2)))
(magic 42 :type (magic :actual-type (unsigned-byte 16)
:value 42))
(offset-ptr 0 :type file-position)
(first-image-file-directory-offset 0 :type (unsigned-byte 32))
(image-directories nil :type (custom
:reader (lambda (stream)
(let* ((next-directory nil)
(byte-count 0)
(directories
(with-file-position (0 stream)
(loop for offset = first-image-file-directory-offset
then (slot-value next-directory 'next-directory-offset)
until (= offset 0)
collect (progn
(file-position stream (+ offset tiff-base-pointer))
(setf next-directory
(multiple-value-bind (dir bytes)
(read-binary 'tiff-image-file-directory stream)
(incf byte-count bytes)
dir)))))))
(values directories byte-count)))
:writer (lambda (obj stream)
(declare (ignore obj))
(force-output stream)
(let ((real-offset (file-length stream)))
(with-file-position (offset-ptr stream)
(write-integer (- real-offset tiff-base-pointer) 4 stream :byte-order *byte-order*)
(setf first-image-file-directory-offset (- real-offset tiff-base-pointer))
(file-position stream real-offset)
(loop for (dir . more-dirs) on image-directories sum
(let ((bytes (write-binary dir stream))
(new-eof (file-position stream)))
(force-output stream)
(file-position stream (- new-eof 4))
(write-integer (if more-dirs
(- new-eof tiff-base-pointer)
0) 4 stream :byte-order *byte-order*)
bytes)))))))
(tiff-region 0 :type (region-tag :base-pointer-name 'tiff-base-pointer)))
(defbinary jpeg-generic-segment (:byte-order :big-endian)
(file-position 0 :type file-position)
(tag nil :type jpeg-generic-tag)
(contents nil :type (eval
(cond ((= (slot-value tag 'code) 225)
'jpeg-app1-body)
((null (slot-value tag 'length))
'null)
(t `(simple-array (unsigned-byte 8) (,(- (slot-value tag 'length) 2)))))))
(buffer nil :type (eval
(if (or (and (jpeg-app1-body-p contents)
(tiff-p (slot-value contents 'body)))
(jpeg-tag-no-length-p tag))
'null
`(simple-array (unsigned-byte 8) (,(- (slot-value tag 'length) 8))))))
(file-positioner nil :type (custom :reader
(lambda (stream)
(values
(and (not (jpeg-tag-no-length-p tag))
(file-position stream
(+ (slot-value tag 'length-offset)
(slot-value tag 'length))))
0))
:writer
(lambda (obj stream)
(declare (ignore obj))
(if (jpeg-tag-no-length-p tag)
(let ((end-position (file-position stream)))
(with-file-position ((slot-value tag 'length-offset) stream)
(write-integer (- end-position (slot-value tag 'length-offset))
2 stream :byte-order :big-endian)))
0)))))