git.fiddlerwoaroof.com
zipfile.lisp
7c37909c
 (uiop:define-package :fwoar.zipfile
c83e027c
     (:mix :cl :fwoar.lisputils :fwoar.bin-parser)
7c37909c
   (:export ))
 (in-package :fwoar.zipfile)
 
c83e027c
 (defmacro defun* (name (&rest args) &body body)
   (let ((defs (cdr (assoc :where body))))
     `(defun ,name ,args
        (flet (,@defs)
          ,@(loop for form in body until (and (consp form) (eql :where (car form)))
a8cd04b5
                  collect form)))))
7c37909c
 
 (defun make-zipfile-stream (fn)
   (open fn :element-type '(unsigned-byte 8)))
 
 (defparameter *zip-local-file-header*
   '((signature 4)
     (version 2)
     (flags 2)
c83e027c
     (compression 2 fwoar.bin-parser:le->int)
7c37909c
     (mod-time 2)
     (mod-date 2)
     (crc-32 4)
c83e027c
     (compressed-size 4 fwoar.bin-parser:le->int)
     (uncompressed-size 4 fwoar.bin-parser:le->int)
     (file-name-length 2 fwoar.bin-parser:le->int)
     (extra-field-length 2 fwoar.bin-parser:le->int)
7c37909c
     (file-name file-name-length babel:octets-to-string)
     (extra-field extra-field-length)))
 
 (defun decode-file-data (metadata s)
c83e027c
   (let ((crc-32 (fwoar.bin-parser:le->int (cdr (assoc 'crc-32 metadata))))
7c37909c
         (compressed-size (cdr (assoc 'compressed-size metadata)))
         (uncompressed-size (cdr (assoc 'uncompressed-size metadata))))
     (when (= 0 (+ crc-32 compressed-size uncompressed-size))
       (error "bad zipfile: I don't support data descriptors yet..."))
     (format t "~&COMPRESSED-SIZE: ~a~%" compressed-size)
     (let ((compressed-data (read-bytes compressed-size s)))
       (format t "~&...~%")
       (values (serapeum:ecase-let (compression (cdr (assoc 'compression metadata)))
                 (0 compressed-data)
                 (8 (princ "decompress")
                    (chipz:decompress nil (chipz:make-dstate 'chipz:deflate) compressed-data))
                 (t (error "unsupported compression ~a" compression)))
               metadata))))
 
 (defun decode-a-file-if-name (pred s)
   (let ((metadata (extract *zip-local-file-header* s)))
     (values (if (funcall pred (cdr (assoc 'file-name metadata)))
                 (decode-file-data metadata s)
                 (progn (file-position s (+ (file-position s)
                                            (cdr (assoc 'compressed-size metadata))))
                        nil))
             metadata)))
 
 (defun decode-a-file (s)
   (let ((metadata (extract *zip-local-file-header* s)))
     (decode-file-data metadata s)))