Skip to content

Instantly share code, notes, and snippets.

Created December 6, 2012 18:42
What would you like to do?
;; -*- mode:common-lisp -*-
(defun map-file (filename &rest flags)
"Maps FILENAME, returns the opened stream, base aligned address and length."
(let ((s (apply #'open filename :mapped t flags)))
(values s (slot-value s 'excl::buffer) (file-length s))))
;; Read unaligned little-endian numbers
(defun read-u8 (base off)
(sys:memref base off 0 :unsigned-byte))
(defun read-u16 (base off)
(+ (sys:memref base off 0 :unsigned-byte)
(ash (sys:memref base off 1 :unsigned-byte) 8)))
(defun read-u32 (base off)
(+ (sys:memref base off 0 :unsigned-byte)
(ash (sys:memref base off 1 :unsigned-byte) 8)
(ash (sys:memref base off 2 :unsigned-byte) 16)
(ash (sys:memref base off 3 :unsigned-byte) 24)))
;; Fetch string from memory
(defun read-str (base off len)
(native-to-string (+ (ff:aligned-to-address base) off) :length len))
(defun find-end-of-central-directory (base size)
"Find the end-of-central-directory record, returns the offset of the first
central directory, and the number of central directory records."
(macrolet ((search-for (byte success fail)
`(cond ((= off 0) (error "Zip central directory not found"))
((= (read-u8 base off) ,byte) (,success (- off 1)))
(t (,fail (- off 1))))))
(labels ((byte1 (off) (search-for #x06 byte2 byte1))
(byte2 (off) (search-for #x05 byte3 byte1))
(byte3 (off) (search-for #x4b byte4 byte1))
(byte4 (off) (search-for #x50 done byte1))
(done (off)
(incf off)
(unless (= (read-u16 base (+ off 4)) 0) ; # of this disk
(error "Multi-disk archive isn't supported"))
(values (read-u32 base (+ off 16)) ; offset of central directory
(read-u16 base (+ off 10))))) ; # of central directory recs
(byte1 (- size 1)))))
(defun read-central-directory-record (base off)
"Read a central directory record at offset OFF, returns a list of next offset and infos."
(unless (= (read-u32 base off) #x02014b50)
(error "Corrupted central directory record at offset ~s (~x)" off (read-u32 base off)))
(let ((version-made (read-u16 base (+ off 4)))
(version-required (read-u16 base (+ off 6)))
(compression-method (read-u16 base (+ off 10)))
(uncompressed-size (read-u16 base (+ off 24)))
(filename-len (read-u16 base (+ off 28)))
(extra-len (read-u16 base (+ off 30)))
(comment-len (read-u16 base (+ off 32))))
(list (+ off 46 filename-len extra-len comment-len)
(read-str base (+ off 46) filename-len)
(case compression-method
(0 'uncompressed)
(1 'unshrinking)
((2 3 4 5) `(expanding ,compression-method))
(6 'imploding)
(7 'tokenizing)
(8 'deflating)
(9 'enhanced-deflating)
(12 'bzip2)
(14 'lzma)
(97 'wavpack)
(98 'ppmd)
(otherwise `(unknown ,compression-method)))
(defun parse-central-directory (base size)
(multiple-value-bind (off count) (find-end-of-central-directory base size)
(format t "offset=~x count=~s~%" off count)
(loop for i from 0 below count
for (next . info) = (read-central-directory-record base off)
collect info
do (setf off next))))
(defun zipinfo (filename)
(multiple-value-bind (stream base size) (map-file filename)
(unwind-protect (parse-central-directory base size)
(close stream))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment