Simple zipfile decoding

zipfile.lisp

;; Presupposes the binary parser from fwoar.lisputils/bin-parser: https://github.com/fiddlerwoaroof/fwoar.lisputils/blob/master/bin-parser.lisp

(uiop:define-package :fwoar.zipfile
    (:mix :cl :fwoar.lisputils :fwoar.bin-parser)
  (:export ))
(in-package :fwoar.zipfile)

(defparameter *zip-local-file-header*
  '((signature 4) (version 2) (flags 2) (compression 2 le->int) (mod-time 2) (mod-date 2) (crc-32 4)
    (compressed-size 4 le->int)
    (uncompressed-size 4 le->int)
    (file-name-length 2 le->int)
    (extra-field-length 2 le->int)
    (file-name file-name-length babel:octets-to-string)
    (extra-field extra-field-length)))

(defun decode-file-data (metadata s)
  (let ((crc-32 (le->int (cdr (assoc 'crc-32 metadata))))
        (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..."))
    (let ((compressed-data (read-bytes compressed-size s)))
      (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)))