非圧縮gzipファイル作成
冬休み(中に終わらせたい)の取り組み、gzip圧縮/解凍器作成の２。
前回は、RFC 1951(日本語訳)で定義されているDEFLATEフォーマットに準拠したデータを作成するのに必要な符号長の制限付きのハフマン符号化アルゴリズムを実装した。
今回はDEFLATEに関する残りの部分は後回しにして、先にgzipファイルの作成部分を実装することにする。
gzip
gzipの仕様は、RFC1952(日本語訳)で定義されている。
gzipファイルフォーマットの概要は下記の通り。※ 正確なものは上記リンクを参照
- gzipファイルは、"メンバー"(圧縮データ集合)の列からなる。
- 各"メンバー"は以下のフィールドを(次の順番で)含む
- ID1,ID2: gzipファイルであることを示すID
- CM(Compression Method): 圧縮方式(通常はDEFLATEが指定される)
- FLG(FLaGs): 各種フラグ
- MTIME(Modification TIMe): 圧縮が開始された時刻
- XFL(eXtra FLags): CMごとに異なる拡張フラグ
- OS: 圧縮が行われたOS
- ※ FLGの各フラグの値によっては、ここにいくつかのフィールドが加わる。詳細はRFC1952を参照。
- 圧縮データ:CMで示された圧縮方式によって圧縮されたデータ
- CRC32: 圧縮元データのCRC32による循環冗長検査値
- ISIZE(Input SIZE): 圧縮元データのサイズ % 0x100000000
次が、これをもとに作成したgzipのメンバー読込み関数。
※ ただし、まだ圧縮データの解凍を行う方法がないので、圧縮データ、CRC32、ISIZEフィールドの読込みは行っていない。
;; gzipメンバーを一つ分読み込む ;; XXX: 不完全。圧縮データの解凍、CRC32・ISIZEフィールドの読込みは行っていない。 (defun read-gzip-member (binary-input-stream &aux (in binary-input-stream)) ;; ID1, ID2 (let ((id1 (read-byte in)) (id2 (read-byte in))) (assert (and (= id1 #x1F) (= id2 #x8B))) ;; gzipメンバーは、ID1=0x1F、ID2=0x8Bで始まらなければならない (format *error-output* "~&ID1: ~X, ID2: ~X~%" id1 id2)) ;; Compression Method: 8=deflate (let ((cm (read-byte in))) (assert (= 8 cm)) ;; RFC1952を見る限り、現時点(2009/01/03)で使えるCMは8=deflateだけのよう (0-7は予約) (format *error-output* "Compression Method: ~D~%" cm)) ;; Flags (multiple-value-bind (text hcrc extra name comment rsv1 rsv2 rsv3) (read-flags in) ; read-flags関数は下で定義 (assert (not (or rsv1 rsv2 rsv3))) ; 予約されている三つのフラグは、false(未セット)でなければならない (format *error-output* "Flags:~%") (format *error-output* "~:{ ~A: ~:[false~;true~]~%~}" `((text ,text) (hcrc ,hcrc) (extra ,extra) (name ,name) (comment ,comment))) ;; Modification Time (let ((mtime (+ (ash (read-byte in) 0) (ash (read-byte in) 8) (ash (read-byte in) 16) (ash (read-byte in) 24)))) (multiple-value-bind (second minute hour date month year) (decode-universal-time (+ mtime (encode-universal-time 0 0 0 1 1 1970))) ; 1970/01/01 00:00:00からの経過秒数 (format *error-output* "Modification Time: ~D/~D/~D ~D:~D:~D~%" year month date hour minute second))) ;; Extra Flags (format *error-output* "Extra Flag: ~X~%" (read-byte in)) ;; Operating System (format *error-output* "OS: ~A~%" (get-os-name (read-byte in))) ; get-os-nameは下で定義 ;; Extra Length (when extra ; extraフラグがセットされている場合は、xlenフィールドと拡張フィールドが追加される (let ((len (+ (ash (read-byte in) 0) (ash (read-byte in) 8)))) (format *error-output* "Extra length: ~D bytes~%" len) (dotimes (i len) (read-byte in)))) ; XXX: 今回は扱わないので読み捨てる ;; Name (when name ; nameフラグがセットされている場合は、0終端のlatin1文字列を圧縮元のファイル名として読み込む (format *error-output* "Name: ~A~%" (read-latin1-string in))) ; read-latin1-stringは下で定義 ;; Comment (when comment ; commentフラグがセットされている場合は、0終端のlatin1文字列をコメントとして読み込む (format *error-output* "Comment: ~A~%" (read-latin1-string in))) ; read-latin1-stringは下で定義 ;; Compressed Data ※ TODO: 圧縮データを読み込む ;; CRC32 ※ TODO: CRC32値を読込み、チェックを行う ;; Input Size ※ TODO: 圧縮元データサイズ(のモジュロ2^32)を読込み、チェックを行う )) ;;; 補助関数群 (defun read-flags (in) (let ((flg (read-byte in))) (values-list (loop FOR i FROM 0 TO 7 COLLECT (ldb-test (byte 1 i) flg))))) (defun get-os-name (n) (case n (0 "FAT filesystem (MS-DOS, OS/2, NT/Win32)") (1 "Amiga") (2 "VMS (or OpenVMS)") (3 "Unix") (4 "VM/CMS") (5 "Atari TOS") (6 "HPFS filesystem (OS/2,NT)") (7 "Macintosh") (8 "Z-System") (9 "CP/M") (10 "TOPS-20") (11 "NTFS filesystem (NT)") (12 "QDOS") (13 "Acorn RISCOS") (255 "Unknown") (otherwise (format nil "Invalid value(~D)" n)))) (defun read-latin1-string (in) ;; XXX: 文字を内部的にユニコードとして表現していない処理系では以下のコードは不正(ex. ecl) (map 'string 'code-char (loop FOR b = (read-byte in) UNTIL (zerop b) COLLECT b)))
関数の実行結果。
参照: octet
;; 【準備】 ;; 以下のコマンドを実行して、gzipファイルを作成しておく ;; $ gzip -cf /path/to/kokoro > kokoro.gz # 『こころ』をgzipコマンドで圧縮 (with-open-file (in "kokoro.gz" :element-type 'octet) (read-gzip-member in)) Compression Method: 8 Flags: TEXT: false HCRC: false EXTRA: false NAME: true COMMENT: false Modification Time: 2010/1/2 14:35:31 Extra Flag: 0 OS: Unix Name: kokoro --> NIL
非圧縮gzipファイル作成
gzipの仕様はだいたい分かったので、次に簡単なgzipファイルを作成してみる。
圧縮データの作成部分には、DEFLATEの仕様の中で定義されている入力データを非圧縮のままに出力する方法を用いることにする。
この方法(およびDEFLATEフォーマット)の概要は、次のようになる。※ こっちに関しても詳細及び正確なものは、RFC1951を参照のこと
には、入力データを非圧縮のままで出力する方法も定義されているので、
- DEFLATEデータは、ブロックの列からなる
- 非圧縮データブロックは、以下の五つのフィールドから構成される
- BFINAL: このブロックが最後のブロックかどうかのフラグ。1bit、最後のブロックなら1。
- BTYPE: 圧縮タイプ。2bit、非圧縮は00。※ 次のバイト(8bit)境界までの入力データは無視される
- LEN: 非圧縮データのサイズ。2byte。
- NLEN: LENの補数。2byte。
- データ: LENサイズ分のリテラル(非圧縮)データ。
これをもとに作成したのが、次の関数。
;;;;;;;;;;;;;;; ;;;; 補助関数群 ;; アナフォリックwhile (defmacro a.while (expr &body body) `(loop FOR it = ,expr WHILE IT DO ,@body)) ;; nバイトのデータを出力する (defun write-n-byte (n value binary-output-stream) ;; gzipはリトルエンディアン (dotimes (i n) (write-byte (ldb (byte 8 (* i 8)) value) binary-output-stream))) ;; 最小限必要なgzipのヘッダーを出力する (defun write-default-gzip-header (#1=binary-output-stream) (write-byte #x1F #1#) ; ID1 (write-byte #x8B #1#) ; ID2 (write-byte #x08 #1#) ; Compression Method: deflate (write-byte #x00 #1#) ; Flags (write-n-byte 4 #x00000000 #1#) ; Modification Time (write-byte #x00 #1#) ; Extra Flags (write-byte #xFF #1#)) ; Operating System(OS): unknown ;; gzipのフッター(CRC32,ISIZE)を出力する (defun write-gzip-footer (crc isize #1=binary-output-stream) (write-n-byte 4 crc #1#) (write-n-byte 4 isize #1#)) ;; 非圧縮DEFLATEデータブロックを出力する (defun write-uncompressed-deflate-block (data-octets last? #1=binary-output-stream) (write-byte (if last? #b00000001 #b00000000) #1#) ; BFINAL(1) and BTYPE(2) and padding bits (let ((len (fill-pointer data-octets))) (write-n-byte 2 len #1#) ; LEN (write-n-byte 2 (- #xFFFF len) #1#) ; NLEN (write-sequence data-octets #1#))) ; LITERAL DATA ;;;;;;;;;;;;;;;;; ;;;; メインの関数 ;; source-fileに、gzip圧縮(非圧縮)を施してdestination-fileに保存する (defun make-uncompressed-gzip-file (source-file destination-file) (with-open-file (in source-file :element-type 'octet) (with-open-file (out destination-file :element-type 'octet :direction :output :if-exists :supersede) ;; headerを書き込む (write-default-gzip-header out) ;; dataを書き込む (let ((buf (make-array #xFFFF :element-type 'octet :fill-pointer 0))) (a.while (read-byte in nil nil) ;; 64KBごとに、一つのデータブロックを出力する (when (= #xFFFF (fill-pointer buf)) (write-uncompressed-deflate-block buf nil out) (setf (fill-pointer buf) 0)) ; バッファを空にする (vector-push it buf)) ;; 残りのデータブロックを出力する (write-uncompressed-deflate-block buf t out)) ;; footerを書き込む (write-gzip-footer (crc (read-binary-file source-file)) ; CRC: crc関数の定義は末尾を参照 (mod (file-length in) #x100000000) ; ISIZE out))))
実行例。
> (make-uncompressed-gzip-file "/path/to/kokoro" "kokoro.my.gz") --> NIL
# 解凍した場合 $ gzip -cd kokoro.my.gz | head こころ 夏目漱石 ------------------------------------------------------- 【テキスト中に現れる記号について】 《》：ルビ （例）私《わたくし》はその人を常に先生と呼んでいた ｜：ルビの付く文字列の始まりを特定する記号 # 解凍しない場合: 最初がばける $ head kokoro.my.gz ^_���こころ 夏目漱石 ------------------------------------------------------- 【テキスト中に現れる記号について】 《》：ルビ （例）私《わたくし》はその人を常に先生と呼んでいた ｜：ルビの付く文字列の始まりを特定する記号
とりあえず完成。
圧縮はしていないけど、上の関数が作成するgzipファイルも、一応RFC1952及びRFC1951の仕様に準拠してはいる。
crc関数
make-uncompressed-gzip-file関数の中で使われているcrc関数の定義。
RFC1951「8.付録: CRCコードサンプル」に掲載されているC言語の関数のcommon lispへの翻訳。遅い。
(defun make-crc-table () (let ((table (make-array #x100 :element-type '(unsigned-byte 64)))) (dotimes (i #x100) (let ((c i)) (dotimes (k 8) (if (ldb-test (byte 1 0) c) (setf c (logxor #xEDB88320 (ash c -1))) (setf c (ash c -1)))) (setf (aref table i) c))) table)) (let ((crc-table (make-crc-table))) (defun update-crc (crc octets) (let ((c (logxor crc #xffffffff))) (loop FOR v ACROSS octets DO (setf c (logxor (aref crc-table (ldb (byte 8 0) (logxor c v))) (ash c -8)))) (logxor c #xffffffff)))) (defun crc (octets) (update-crc 0 octets))
