common-lisp
CommonLisp
More than 5 years have passed since last update.

メールに添付しているzipファイルが暗号化されているかどうかを判定したいので、zipファイルを読み込んで解析する処理を作ってみます。


バイナリファイルの読み込み

まずはバイナリファイルを読み込むところから始めます。

(defun read-binary-file (path)

(with-open-file (in path :element-type '(unsigned-byte 8))
(let ((bin (make-array (file-length in) :element-type '(unsigned-byte 8))))
(read-sequence bin in)
bin)))

ファイルサイズ分のメモリを確保してそこに一気に読み込むやり方です。これはvectorで返ってくるので、あとでlistにしておきます。とりあえずは何でもlistで作って遅かったら対策を考えます。


LISP programmers know the value of everything and the cost of nothing.


(coerce (read-binary-file #p"/tmp/tmp.zip") 'list)


zipフォーマットの定義

zipフォーマットの仕様に則ってクラスを定義します。

http://www.pkware.com/documents/casestudies/APPNOTE.TXT

とりあえずローカルファイルヘッダのみ。

(defclass <zip-header> ()

((version-extract)
(flag)
(compression)
(time)
(date)
(crc32)
(compressed-size)
(uncompressed-size)
(filename-length)
(extrafield-length)
(filename)
(extrafield)
(data)))

extrafield-lengthまでは各値のサイズが決まっているので、指定した値にリストを分割してくれる関数があるとうれしいです。

(defun take-list (list num)

(labels ((take-n (list num acc)
(if (or (<= num 0)
(null list))
(values (nreverse acc) list)
(take-n (cdr list) (1- num) (cons (car list) acc)))))
(take-n list num '())))

take-listはリストから指定したサイズだけ切り出す関数です。多値で結果を返します。

CL-USER> (take-list '(1 2 3 4 5) 3)

(1 2 3)
(4 5)

これを使うと、次の関数が定義できます。

(defun split-group (list num-list &key (rest nil))

(labels ((split-n (list num-list acc)
(cond ((or (and (not rest)
(or (null list)
(null num-list)))
(and rest
(null list)))
(nreverse acc))
((and rest
(null num-list))
(nreverse (cons list acc)))
(t
(multiple-value-bind (taken-list rest-list)
(take-list list (car num-list))
(split-n rest-list (cdr num-list) (cons taken-list acc)))))))
(split-n list num-list '())))

split-groupが今回欲しい関数です。指定したサイズのリストを渡すと、そのサイズにリストを分割してくれます。

CL-USER> (split-group '(1 2 3 4 5 6 7 8 9 10) '(1 2 3 4))

((1) (2 3) (4 5 6) (7 8 9 10))

restフラグは分割後のリストの余りの取扱いを決めます。

nilならばあまりを捨て、tならばあまりを最後に追加します。

CL-USER> (split-group '(1 2 3 4 5 6 7 8 9 10) '(1 2 3) :rest nil)

((1) (2 3) (4 5 6))
CL-USER> (split-group '(1 2 3 4 5 6 7 8 9 10) '(1 2 3) :rest t)
((1) (2 3) (4 5 6) (7 8 9 10))


フラグなので -p というパラメータの方が良いのか



リトルエンディアン

zipはリトルエンディアンを使っているので、実際の値に戻す関数が必要です。

(defun little-endian-to-num (list)

(loop for x in list
for idx upfrom 0
sum (ash x (* idx 8))))

CL-USER> (little-endian-to-num '(1 2))

513

ここで渡している (1 2) は\x0201をリトルエンディアンで表現した値です。


ローカルファイルヘッダの読み込み

ここまでくるとローカルファイルヘッダのパースができます。

方法としては、まずサイズが決まっているextrafield-lengthまでパースし、残りをfilename-length、extrafield-length、compressed-sizeで定義してあるサイズ分読み込みます。

(defun read-zip-header (data)

(let ((items (split-group data '(4 ; signature
2 ; version needed to extract
2 ; general purpose bit flag
2 ; compression method
2 ; last mod file time
2 ; last mod file date
4 ; crc-32
4 ; compressed size
4 ; uncompressed size
2 ; file name length
2 ; extra field length
)
:rest t ; file name, extra field, data
))
(inst (make-instance '<zip-header>)))
(setf (slot-value inst 'version-extract) (little-endian-to-num (nth 1 items)))
(setf (slot-value inst 'flag) (little-endian-to-num (nth 2 items)))
(setf (slot-value inst 'compression) (little-endian-to-num (nth 3 items)))
(setf (slot-value inst 'time) (little-endian-to-num (nth 4 items)))
(setf (slot-value inst 'date) (little-endian-to-num (nth 5 items)))
(setf (slot-value inst 'crc32) (little-endian-to-num (nth 6 items)))
(setf (slot-value inst 'compressed-size) (little-endian-to-num (nth 7 items)))
(setf (slot-value inst 'uncompressed-size) (little-endian-to-num (nth 8 items)))
(setf (slot-value inst 'filename-length) (little-endian-to-num (nth 9 items)))
(setf (slot-value inst 'extrafield-length) (little-endian-to-num (nth 10 items)))

;; ここまでがサイズが決まっているextrafield-lengthまでのパース
;; ここからが各項目で読み込んだサイズでパースをする部分

(let ((rest-items (split-group (nth 11 items) `(,(slot-value inst 'filename-length)
,(slot-value inst 'extrafield-length)
,(slot-value inst 'compressed-size))
:rest t)))
(setf (slot-value inst 'filename) (nth 0 rest-items))
(setf (slot-value inst 'extrafield) (nth 1 rest-items))
(setf (slot-value inst 'data) (nth 2 rest-items))

(values inst (nth 3 rest-items)))))
;; 戻りは<zip-header>インスタンスと、残りの部分の多値


テスト

CL-USER> (setf *zip* (read-zip-header (coerce (read-binary-file #p"/home/shingo/test.zip") 'list)))

#<<ZIP-HEADER> #x3020014A551D>
CL-USER> (slot-value *zip* 'filename)
(116 101 115 116 46 116 120 116)
CL-USER> (format t "~{~A~}" (map 'list #'code-char (slot-value *zip* 'filename)))
test.txt
NIL
CL-USER> (slot-value *zip* 'compressed-size)
5
CL-USER> (slot-value *zip* 'uncompressed-size)
5
CL-USER> ;; 圧縮前と圧縮後でサイズが同じなので非圧縮
; No value
CL-USER> (slot-value *zip* 'data)
(116 101 115 116 10)
CL-USER> (format t "~{~A~}" (map 'list #'code-char (slot-value *zip* 'data)))
test
NIL

そういえば、当初の目的だった暗号化されているかされていないかは、flagの1ビット目を見れば分かります。

CL-USER> (slot-value *zip* 'flag)

0

0なので暗号化されていません。

とりあえずは先頭のファイルだけ暗号化されているかどうかを判別することができました。zipファイルは格納してあるファイルごとに暗号化する/しないを指定できるので、これではまだ不十分です。次回以降にそこの対応を行っていきます。