;;; -*- Mode: LISP; Package: :cl-user; BASE: 10; Syntax: ANSI-Common-Lisp; ;-*- ;;; ;;; Touched: Tue Apr 20 17:49:49 2004 IST, madhu ;;; Time-stamp: <2004-04-29 15:59:33> ;;; Bugs-To: ;;; See-for-eg: ftp://ftp.uu.net/pub/archiving/zip/doc/appnote-970311-iz.zip #-nil (progn (require 'binary-types #-nil "binary-types-0.90/binary-types") (provide 'binary-types)) (defpackage "ZIPP" (:use :cl :binary-types) (:export)) (in-package "ZIPP") (setq *endian* :little-endian) (define-unsigned u64 8) (defvar *zip-type* nil "assoc of header (magic . class) for registered Zip-file elements" ) (defmacro define-zip-type (name (magic) &rest plist) "specify a Zip-file element header---as a zip-type class" (loop with binary-type = (intern (concatenate 'string (symbol-name name) "-RECORD")) for (slot desc) on plist by #'cddr if (consp desc) do (assert (and (eq (car desc) 'variable-size) (cadr desc))) and collect slot into cslots and collect (cadr desc) into csizes else collect (list slot nil :binary-type (ecase desc (4-bytes 'u32) (2-bytes 'u16) (8-bytes 'u64))) into blargs finally (return `(progn (define-binary-struct ,binary-type nil ,@blargs) (defclass ,name nil ((magic :initform ,magic :allocation :class) (binary-record-name :initform ',binary-type :allocation :class) (binary-record :initform nil) ,@(mapcar (lambda (slot) (list slot :initform nil)) cslots))) (defmethod print-object ((obj ,name) stream) (print-unreadable-object (obj stream :type t :identity t) (with-slots (binary-record ,@cslots) obj (format stream ,(loop for slot in cslots nconc (list "~@[ " (symbol-name slot) " ~W~]") into fmt finally (return (apply #'concatenate 'string "~@[ ~W~]" fmt))) binary-record ,@cslots)))) (defmethod read-zip ((obj ,name) stream) (with-slots (binary-record binary-record-name ,@cslots) OBJ (setf binary-record (read-binary binary-record-name stream)) (with-slots ,csizes binary-record ,@(loop for size in csizes for slot in cslots collect `(unless (zerop ,size) (setf ,slot (read-binary-string stream :size ,size)))))) obj) (let ((entry (assoc ,magic *zip-type*))) (cond (entry (setf (cdr entry) ',name)) (t (push (cons ,magic ',name) *zip-type*)))) )))) ;;; ---------------------------------------------------------------------- ;;; ;;; Info-ZIP appnote.txt, 20011203: ;; Overall .ZIP file format: ;; ;; [local file header 1] ;; [file data 1] ;; [data descriptor 1] ;; . ;; . ;; . ;; [local file header n] ;; [file data n] ;; [data descriptor n] ;; [central directory] ;; [zip64 end of central directory record] ;; [zip64 end of central directory locator] ;; [end of central directory record] ;; ;; A. Local file header: ;; (define-zip-type local-file-header ; local-file-header-signature 4-bytes (#x04034b50) version-needed-to-extract 2-bytes general-purpose-bit-flag 2-bytes compression-method 2-bytes last-mod-file-time 2-bytes last-mod-file-date 2-bytes crc-32 4-bytes compressed-size 4-bytes uncompressed-size 4-bytes file-name-length 2-bytes extra-field-length 2-bytes file-name (variable-size file-name-length) extra-field (variable-size extra-field-length)) ;; ;; B. File data ;; Immediately following the local header for a file ;; is the compressed or stored data for the file. ;; The series of [local file header][file data][data ;; descriptor] repeats for each file in the .ZIP archive. ;; ;; C. Data descriptor: ;; ;; [Info-ZIP discrepancy: ;; The Info-ZIP zip program starts the data descriptor with a 4-byte ;; PK-style signature. Despite the specification, none of the PKWARE ;; programs supports the data descriptor. PKZIP 4.0 -fix function ;; (and PKZIPFIX 2.04) ignores the data descriptor info even when bit 3 ;; of the general purpose bit flag is set. ;; (define-zip-type data-descriptor ; data-descriptor-signature 4-bytes (#x08074b50) crc-32 4-bytes compressed-size 4-bytes uncompressed-size 4-bytes) ;; ;; D. Central directory structure: ;; ;; [file header 1] ;; . ;; . ;; . ;; [file header n] ;; [digital signature] ;; ;; File header: ;; (define-zip-type file-header ; central-file-header-signature 4-bytes ; (#x02014b50) version-made-by 2-bytes version-needed-to-extract 2-bytes general-purpose-bit-flag 2-bytes compression-method 2-bytes last-mod-file-time 2-bytes last-mod-file-date 2-bytes crc-32 4-bytes compressed-size 4-bytes uncompressed-size 4-bytes file-name-length 2-bytes extra-field-length 2-bytes file-comment-length 2-bytes disk-number-start 2-bytes internal-file-attributes 2-bytes external-file-attributes 4-bytes relative-offset-of-local-header 4-bytes file-name (variable-size file-name-length) extra-field (variable-size extra-field-length) file-comment (variable-size file-comment-length)) (define-zip-type digital-signatue ; header-signature 4-bytes ; (#x05054b50) size-of-data 2-bytes signature-data (variable-size size-of-data)) ;; ;; E. Zip64 end of central directory record ;; (define-zip-type zip64-end-of-central-directory-record ; zip64-end-of-central-dir-signature ; 4-bytes (#x06064b50) size-of-zip64-end-of-central-directory-record 8-bytes version-made-by 2-bytes version-needed-to-extract 2-bytes number-of-this-disk 4-bytes number-of-the-disk-with-the-start-of-the-central-directory 4-bytes total-number-of-entries-in-the-central-directory-on-this-disk 8-bytes total-number-of-entries-in-the-central-directory 8-bytes size-of-the-central-directory 8-bytes offset-of-start-of-central-directory-with-respect-to-the-starting-disk-number 8-bytes ; zip64-extensible-data-sector (variable-size) ) ;; ;; F. Zip64 end of central directory locator ;; (define-zip-type zip64-end-of-central-directory-locator ; zip64-end-of-central-dir-locator-signature ; 4-bytes (#x07064b50) number-of-the-disk-with-the-start-of-the-zip64-end-of-central-directory 4-bytes relative-offset-of-the-zip64-end-of-central-directory-record 8-bytes total-number-of-disks 4-bytes) ;; ;; G. End of central directory record: ;; (define-zip-type end-of-central-directory-record ; end-of-central-dir-signature 4-bytes ; (#x06054b50) number-of-this-disk 2-bytes number-of-the-disk-with-the-start-of-the-central-directory 2-bytes total-number-of-entries-in-the-central-directory-on-this-disk 2-bytes total-number-of-entries-in-the-central-directory 2-bytes size-of-the-central-directory 4-bytes offset-of-start-of-central-directory-with-respect-to-the-starting-disk-number 4-bytes .ZIP-file-comment-length 2-bytes .ZIP-file-comment (variable-size .ZIP-file-comment-length)) ;;; ---------------------------------------------------------------------- ;;; ;;; (defmethod read-zip :after ((obj local-file-header) stream) ; skip filedata (with-slots (binary-record) obj (with-slots (compressed-size) binary-record (warn "skipping ~d bytes of data" compressed-size) (let ((fp (file-position stream))) (assert (file-position stream (+ compressed-size fp))) (assert (= (file-position stream) (+ compressed-size fp))))))) (define-condition bad-zip (parse-error simple-error) ((encapsulated :initarg :original-error :accessor original-error :type condition))) (defmacro find-zip-type (magic &environment env) "return an instance of the zip-type class corresponding to MAGIC" `(handler-bind ((error (lambda (c) (error 'bad-zip :format-control "no zip-type registered for magic #x~X" :format-arguments '(,magic) :original-error c)))) (make-instance (find-class (cdr (assoc ,magic *zip-type*)) t ,env)))) (defun read-zip-file (stream) (loop with plist-stats = nil for magic = (read-binary 'u32 stream) for obj = (find-zip-type magic) for zip-type = (class-name (class-of obj)) do (read-zip obj stream) (warn "read object ~a" obj) (incf (getf plist-stats zip-type 0)) (when (eq zip-type 'END-OF-CENTRAL-DIRECTORY-RECORD) (return plist-stats)))) #+nil (with-open-file (zipfile "a.zip" :direction :input :element-type '(unsigned-byte 8)) (read-zip-file zipfile))