パケットキャプチャファイルを簡単にいじれる何かがほしかった

Wiresharkやtcpdump -wで出力されるpcapファイルをこねこねできる何か。
なかなかいいのがないので作ってみようと思いました。
jNetPcapとか使うの難しくてめんどそうだし、Clojureのバイナリパーサとしてはbuffyとかありますが、痒い所に手が届きません。

そこで、簡単に使えるバイナリパーサを作って、パケットキャプチャを読み書きできる何かを作ろうというわけです。

方針

機能として実現したいもの

• サイズ計算：電文内のサイズフィールドをもとに、可変サイズのフィールドを簡単に扱いたい
• ビットフィールド：IPヘッダとかにある4ビットのフィールドを整数として簡単に扱いたい
• バリデーション：読み込んでいるバイナリが途中で間違っていないか簡単に確認できる仕組みがほしい
• 分岐：IPパケットとARPパケットとかで分岐して処理できるようにしたい
• unsignedを扱いたい
• エンディアン：pcapファイルのGlobalHeaderやRecordHeaderの部分がLEで電文の部分がBEだったりするので

これらの機能を簡単にエレガントに実装したい・・・です

バイナリフレームの定義

バイナリフレームについて、フィールドごとに型:サイズ 名前:バリデーション関数を定義できることを目指します。
サイズとバリデーション関数は省略可能とします。
TCPヘッダの定義としては、以下のようになります。

tcpheader.clj

(def-frame :TcpHeader
  :uint16 :SourcePort
  :uint16 :DestinationPort
  :int32 :SequenceNumber
  :int32 :AcknowledgmentNumber
  [4 3 9] [:DataOffset:ge5? :Reserved:zero? :ControlBits]
  :uint16 :Window
  :int16 :Checksum
  :int16 :UrgentPointer
  "int32:(- DataOffset 5)" :Options)

型は整数を表すint8 uint8 int16 uint16 int32 uint32と、ビットフィールドを表すベクタ[～]と、バイナリを表すbytesを扱えるようにします。
※ビットフィールドは合計が8の倍数かつ合計が64までの制限あり

サイズについては、(- DataOffset 5)のように前のほうにあるフィールドの値を参照して設定できるようにします。
※整数でなくtrue/falseでの指定もあるけど後ほど・・・

バリデーション関数は(def-validator :ge5? #(<= 5 %))のようにしてあらかじめ定義して使えるようにします。

以下、これらの定義方法でもってバイナリフレームの定義をしていきます。

pcapファイルのヘッダ

pcapファイルには1つのGlobalHeaderが先頭にあり、その後にパケットごとにRecordHeaderとパケット内容が続いていきます。

pcap-header.clj

(def-frame :GlobalHeaderFirst
  :uint32 :magic_number) ;magic number

(def-frame :GlobalHeaderRest
  :uint16 :version_major ;major version number
  :uint16 :version_minor ;minor version number
  :int32 :thiszone       ;GMT to local correction
  :uint32 :sigfigs       ;accuracy of timestamps
  :uint32 :snaplen       ;max length of captured packets, in octets
  :uint32 :network)      ;data link type

(def-frame :RecordHeader
  :uint32 :ts_sec    ;timestamp seconds
  :uint32 :ts_usec   ;timestamp microseconds
  :uint32 :incl_len  ;number of octets of packet saved in file
  :uint32 :orig_len) ;actual length of packet

GlobalHeaderのmagic_numberが0xd4c3b2a1の場合、GlobalHeaderとRecordHeaderの部分がリトルエンディアンになります。（電文はビッグエンディアン）
※パケット内容の定義については後ほど

ネットワークヘッダの定義

上のGlobalHeaderRestのnetworkが1のとき、パケット内容にはEthernetフレームが入っています。その前提で進めます。

EthernetとIPv4とTCPヘッダの定義は以下のとおり

header.clj

(def-frame :Ethernet2Header
  :int8:6 :DestinationAddress
  :int8:6 :SourceAddress
  :uint16 :EtherType)

(def-frame :Ipv4Header
  [4 4] ["Version:#(= 4 %)" :IHL:ge5?]
  :int8 :TOS
  :uint16 :TL
  :int16 :Identification
  [3 13] [:Flags :FragmentOffset]
  :uint8 :TTL
  :uint8 :Protocol
  :int16 :HeaderChecksum
  :uint8:4 :SourceAddress
  :uint8:4 :DestinationAddress
  "int32:(- IHL 5)" :Options)

(def-frame :TcpHeader
  :uint16 :SourcePort
  :uint16 :DestinationPort
  :int32 :SequenceNumber
  :int32 :AcknowledgmentNumber
  [4 3 9] [:DataOffset:ge5? :Reserved:zero? :ControlBits]
  :uint16 :Window
  :int16 :Checksum
  :int16 :UrgentPointer
  "int32:(- DataOffset 5)" :Options)

パケット内容の部分の定義

ether.clj

(def-frame :EtherRecord
  :RecordHeader :header
  :Ethernet2Frame :ether)

(def-frame :Ethernet2Frame
  :Ethernet2Header :header
  "Ipv4Frame:(= EtherType 0x0800)" :ipv4
  "ArpFrame:(= EtherType 0x0806)" :arp
  "bytes:(if (not-any? #(= EtherType %) [0x0800 0x0806]) (- incl_len 14) false)" :unknown)

Ethernetフレームとして、IPv4とARPフレームを扱う例です。
サイズの部分をtrue/falseで指定すると配列でない型を表すようにして、分岐を実現できるようにしています。
EtherTypeはEthernet2Headerの中で定義されていて、その値によって分岐するということです。

残りは以下のとおり

body.clj

(def-frame :Ipv4Frame
  :Ipv4Header :header
  "IcmpFrame:(= Protocol 1)" :icmp
  "TcpFrame:(= Protocol 6)" :tcp
  "bytes:(if (not-any? #(= Protocol %) [1 6]) (- incl_len 14 (* 4 IHL)) false)" :unknown)

(def-frame :ArpFrame
  :uint16 :HTYPE
  :uint16 :PTYPE
  :uint8 :HLEN
  :uint8 :PLEN
  :int16 :OPER
  :int8:6 :SHA
  :uint8:4 :SPA
  :int8:6 :THA
  :uint8:4 :TPA
  "bytes:(- incl_len 42)" :padding)

(def-frame :TcpFrame
  :TcpHeader :header
  "bytes:(- incl_len 14 (* 4 (+ IHL DataOffset)))" :payload)

(def-frame :IcmpFrame
  :uint8 :type
  :int8 :code
  :int16 :checksum
  "bytes:(- incl_len 18 (* 4 IHL))" :others)

実現するためのコード

以上のような定義にもとづいて、バイナリを読み込んでマップを出力する機能と、逆にマップからバイナリを書き込む機能が、空行入れても250行程度でできました。
＃もっと短くエレガントな書き方できればいいなあ
＃あんまりテストできてないけど・・・

使い方は

sample.clj

(def pcap (io/input-stream "sample.pcap"))
(read-binary-frame pcap :GlobalHeaderFirst)
(read-binary-frame pcap :GlobalHeaderRest :le-frames [:GlobalHeaderRest])
(read-binary-frame pcap :EtherRecord :le-frames [:RecordHeader])

のような感じです。（実際には:EtherRecordの読み込みを複数回することになります）

まずは、ユーティリティ系の関数を定義します。

util.clj

(ns bin-parser.util)

(def << bit-shift-left)
(def >> bit-shift-right)
(def >>> unsigned-bit-shift-right)

(defn bit-mask [value bit]
  {:pre [(<= 1 bit 64)]}
  (bit-and value (>>> -1 (- 64 bit))))

(defn constantly-true [& _] true)
(defn ->symbol [x] (symbol (name x)))
(defn map->vec [map] (vec (apply concat map)))

(defn exact-get [map key]
  (if-let [[k v] (find map key)]
    v
    (throw (IllegalArgumentException. (str key " not found")))))

(defmacro bswap! [x f & args]
  `(set! ~x (~f ~x ~@args)))

(defn areverse-byte [^bytes bytea]
  (let [len (alength bytea)]
    (areduce bytea i ret (byte-array len)
             (do (aset-byte ret (- len i 1) (aget bytea i)) ret))))

(defn unsigned [^bytes bytea]
  {:pre [(<= 1 (alength bytea) 7)]}
  (areduce bytea i ret 0
           (bit-or (<< ret 8) (bit-and 0xff (aget bytea i)))))

(defn signed [^bytes bytea]
  {:pre [(<= 1 (alength bytea) 8)]}
  (areduce bytea i ret (if (neg? (aget bytea 0)) -1 0)
           (bit-or (<< ret 8) (bit-and 0xff (aget bytea i)))))

(defn ^bytes ->bytes [^long len ^long value]
  {:pre [(<= 1 len 8)]}
  (byte-array
   (reduce (fn [a i] (conj a (>> value (* (- len i 1) 8)))) [] (range len))))

(defn split-once [string sep]
  (let [s (name string)
        i (.indexOf s sep)]
    (if (neg? i)
      [s nil]
      [(subs s 0 i) (subs s (+ i (count sep)))])))

exact-getはgetできなかったら例外を投げるやつです。
bswap!は動的変数(bindingを使うアレ)用のswap!です。
areverse-byteはbyte配列用のreverseです。
unsignedとsignedはbyte配列から整数への変換です。
->bytesは整数から指定長のbyte配列への変換です。
split-onceは文字列を1回だけsplitするやつです。

ここまでで約50行

フレーム定義部分のコード

framesはdef-frameしたときの定義の保存場所です。
size-symbolsはサイズの部分のsymbolを保存しておく場所です。
(- DataOffset 5)とサイズ定義があったら-とDataOffsetが入ります。（-は不要なんだけど）
validatorsはdef-validatorしたときの定義の保存場所です。

core_1.clj

(ns bin-parser.core
  (:require [bin-parser.util :refer :all])
  (:import [java.io InputStream OutputStream IOException]))

(def ^:private frames (atom {}))
(def ^:private size-symbols (atom #{}))
(def ^:private validators (atom {}))

;; Frame
(defn def-validator [validator-name f]
  (swap! validators assoc (->symbol validator-name) f))

(defn- split-field-item [item]
  (let [[base suffix] (split-once item ":")
        suffix (when suffix (read-string suffix))]
    [(keyword base) suffix]))

(defn- split-field-name [item]
  (let [[base func] (split-field-item item)
        func (if (nil? func)
               constantly-true
               (eval (list 'let (map->vec @validators) func)))]
    [base func]))

(defn- check-bits [bit-pattern names]
  {:pre [(zero? (mod (apply + bit-pattern) 8))
         (<= (apply + bit-pattern) 64)
         (= (count bit-pattern) (count names))]}
  true)

(defn- find-size-symbols [field-type]
  (let [[_ size] (split-field-item field-type)]
    (swap! size-symbols into (filter symbol? (flatten size)))))

(defn def-frame [frame-name & field-type+names]
  {:pre [(even? (count field-type+names))]}
  (let [fields (partition 2 field-type+names)
        array (volatile! [])]
    (doseq [[type name] fields]
      (if (sequential? type)
        (check-bits type name)
        (find-size-symbols type))
      (let [field (if (sequential? type)
                    (list* type nil (apply map list (map split-field-name name)))
                    (concat (split-field-item type) (split-field-name name)))]
        (vswap! array conj (vec field))))
    (swap! frames assoc (keyword frame-name) @array)))

ここまでで約100行

読み込みと書き込み部分

残り約150行ですが、全部説明は難しいのでいくつかだけ。
*env*にはsize-symbolsに存在するフィールドの値を:varsに入れていくことで、サイズの計算(解決)をできるようにしています。
read-fieldで(bswap! *env* assoc :error th)のようにして、read-frameのdoseqで:while (not (:error *env*))のようにしているのは、読み込み途中でエラーが起こった時に、どこまで読み込めてるかデバッグしやすくするためです。

core_2.clj

;; Read/Write
(def ^:private primitives
  {:int8 [1 nil]
   :uint8 [1 :unsigned]
   :int16 [2 nil]
   :uint16 [2 :unsigned]
   :int32 [4 nil]
   :uint32 [4 :unsigned]})

(declare ^:private ^:dynamic *env*)

(defn- get-frame-fields [frame-name]
  (exact-get @frames (keyword frame-name)))

(defn- calc-size [[_ size :as field]]
  (let [size (if (nil? size) true size)]
    (assoc field 1 (eval (list 'let (map->vec (:vars *env*)) size)))))

(defn- add-var [field-name value]
  (let [sym (->symbol field-name)]
    (when (contains? @size-symbols sym)
      (bswap! *env* assoc-in [:vars sym] value))))

(defn- set-invalid-error [n v]
  (bswap! *env* assoc :error
          (IllegalArgumentException. (str "invalid " n " value " v))))

(defn- map+ [wrap? f c1 & colls]
  (if (sequential? c1)
    (apply map f c1 colls)
    (let [v (apply f c1 colls)]
      (if wrap? [v] v))))

;; Read
(defn- read-bytes [size]
  (let [^InputStream in (:in *env*)
        bytea (byte-array size)
        len (.read in bytea)]
    (when (not= len size) (throw (IOException. (str len " != " size))))
    bytea))

(declare read-frame)
(defn- read-one [[type]]
  (if-let [[size unsigned?] (get primitives type)]
    (let [bytea (read-bytes size)
          bytea (if (:le? *env*) (areverse-byte bytea) bytea)]
      (if unsigned? (unsigned bytea) (signed bytea)))
    (read-frame type)))

(defn- read-array [[type size :as field]]
  (if (= type :bytes)
    (read-bytes size)
    (mapv (fn [_] (read-one field)) (range size))))

(defn- read-bits [[bit-pattern]]
  (let [bit-size (apply + bit-pattern)
        byte-size (/ bit-size 8)
        bytea (read-bytes byte-size)
        offsets (map #(- bit-size %) (reductions + bit-pattern))]
    (map #(-> (signed bytea) (>> %1) (bit-mask %2)) offsets bit-pattern)))

(defn- read-field [[type size :as field]]
  (try
    ((cond
      (sequential? type) read-bits
      (integer? size) read-array
      :else read-one) field)
    (catch Throwable th
      (bswap! *env* assoc :error th)
      nil)))

(defn- read-frame [frame-name]
  (bswap! *env* assoc :le? ((:le-frames *env*) (keyword frame-name)))
  (let [obj (volatile! {})]
    (doseq [field (get-frame-fields frame-name)
            :let [[type size name func :as field] (calc-size field)]
            :when size
            :let [value (read-field field)]
            :while (not (:error *env*))
            [n f v] (map+ true list name func value)]
      (if (f v)
        (do (vswap! obj assoc n v) (add-var n v))
        (set-invalid-error n v)))
    @obj))

(defn read-binary-frame [in-stream frame-name & {:keys [:le-frames]}]
  (binding [*env* {:in in-stream :vars {} :le-frames (set le-frames)}]
    (let [value (read-frame frame-name)]
      (when-let [e (:error *env*)]
        (throw e))
      value)))

;; Write
(defn- write-bytes [^bytes bytea]
  (let [^OutputStream out (:out *env*)]
    (.write out bytea)))

(declare write-frame)
(defn- write-one [[type] value]
  (if-let [[size unsigned?] (get primitives type)]
    (let [bytea (->bytes size value)
          bytea (if (:le? *env*) (areverse-byte bytea) bytea)]
      (write-bytes bytea))
    (write-frame type value)))

(defn- write-array [[type size :as field] value]
  (assert (= (count value) size))
  (if (= type :bytes)
    (write-bytes value)
    (doseq [v value]
      (write-one field v))))

(defn- write-bits [[bit-pattern] values]
  (let [bit-size (apply + bit-pattern)
        byte-size (/ bit-size 8)
        offsets (map #(- bit-size %) (reductions + bit-pattern))
        v (apply bit-or (map #(-> (bit-mask %1 %2) (<< %3))
                             values bit-pattern offsets))]
    (write-bytes (->bytes byte-size v))))

(defn- write-field [[type size :as field] value]
  ((cond
    (sequential? type) write-bits
    (integer? size) write-array
    :else write-one) field value))

(defn- write-frame [frame-name obj]
  (bswap! *env* assoc :le? ((:le-frames *env*) (keyword frame-name)))
  (doseq [field (get-frame-fields frame-name)
          :let [[type size name func :as field] (calc-size field)]
          :when size
          :while (not (:error *env*))
          :let [value (map+ false #(get obj %) name)]]
    (doseq [[n f v] (map+ true list name func value)]
      (if (f v)
        (add-var n v)
        (set-invalid-error n v)))
    (when-not (:error *env*)
      (write-field field value))))

(defn write-binary-frame [out-stream frame-name obj & {:keys [:le-frames]}]
  (binding [*env* {:out out-stream :vars {} :le-frames (set le-frames)}]
    (write-frame frame-name obj)
    (when-let [e (:error *env*)]
      (throw e))))

作ってみた感想など

適当に書く分にはいいのですが、きれいに書くのは難しいなあと思いました。
Clojureでコードを大量に書く場合のベストプラクティスのようなものってあるんでしょうか？
若干、行を短くするために汎用化しすぎているような気もしています。
これらについて何かの参考になれば幸いです。