パケットキャプチャファイルを簡単にいじれる何かがほしかった ref: http://qiita.com/kurogelee/items/1d934e08048c6fca1ae3

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)

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)))

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))))

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)

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)

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

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])

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)

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)))])))