gzip.lisp

   1 ;;;; $Id: gzip.lisp,v 1.2 2007/12/20 16:30:03 xach Exp $
   2
   3 (in-package #:salza2)
   4
   5 (defvar *gzip-signature*
   6   (make-array 2
   7               :element-type '(unsigned-byte 8)
   8               :initial-contents '(#x1F #x8B)))
   9
  10 (defconstant +gzip-deflate-compression+ 8)
  11 (defconstant +gzip-fast-compression+ 4)
  12 (defconstant +gzip-flags+ 0)
  13 (defconstant +gzip-unix-os+ 3)
  14 (defconstant +gzip-mtime+ 0)
  15
  16 (defun gzip-write-u32 (value bitstream)
  17   ;; LSB
  18   (write-octet (ldb (byte 8 0) value) bitstream)
  19   (write-octet (ldb (byte 8 8) value) bitstream)
  20   (write-octet (ldb (byte 8 16) value) bitstream)
  21   (write-octet (ldb (byte 8 24) value) bitstream))
  22
  23 (defclass gzip-compressor (deflate-compressor)
  24   ((checksum
  25     :initarg :checksum
  26     :accessor checksum)
  27    (data-length
  28     :initarg :data-length
  29     :accessor data-length))
  30   (:default-initargs
  31    :checksum (make-instance 'crc32-checksum)
  32    :data-length 0))
  33
  34 (defmethod start-data-format :before ((compressor gzip-compressor))
  35   (let ((bitstream (bitstream compressor)))
  36     (write-octet-vector *gzip-signature* bitstream)
  37     (write-octet +gzip-deflate-compression+ bitstream)
  38     (write-octet +gzip-flags+ bitstream)
  39     (gzip-write-u32 +gzip-mtime+ bitstream)
  40     (write-octet +gzip-fast-compression+ bitstream)
  41     (write-octet +gzip-unix-os+ bitstream)))
  42
  43 (defmethod process-input :after ((compressor gzip-compressor)
  44                                  input start count)
  45   (incf (data-length compressor) count)
  46   (update (checksum compressor) input start count))
  47
  48 (defmethod finish-data-format :after ((compressor gzip-compressor))
  49   (let ((bitstream (bitstream compressor)))
  50     (gzip-write-u32 (result (checksum compressor)) bitstream)
  51     (gzip-write-u32 (data-length compressor) bitstream)))