Binary Utils

complex-rule-codec-example.clj

(def npdu
  (util-b/complex-rule-codec
   :version      :ubyte
   :control-octet (util-b/complex-bytes
                   :ubyte [{:bits     1
                            :name     :layer
                            :enum-map {:network 1
                                       :apdu    0}}
                           nil ;;reserved
                           :dest-present?
                           nil ;;reserved
                           :source-present?
                           :reply-expected?
                           {:bits     2
                            :name     :priority
                            :enum-map e/priorities}])
   :message-type  {:present-if {:control-octet {:layer :network}}
                   :codec      (b/enum :ubyte e/message-types
                                       :lenient? true)}
   :dnet          {:codec       (b/enum :ushort-be {:global 0xFFFF} :lenient? true)
                   :present-if  [{:control-octet {:dest-present? true}}
                                 {:message-type :who-is-router-to-network}]
                   :optional-if {:message-type :who-is-router-to-network}}
   :dlen          {:codec      (b/enum :ubyte {:broadcast 0} :lenient? true)
                   :present-if {:control-octet {:dest-present? true}}}
   :dadr          {:length-ref :dlen
                   :present-if {:control-octet {:dest-present? true}}
                   :absent-if  {:dlen :broadcast}}
   :snet          {:codec      :ushort-be
                   :present-if {:control-octet {:source-present? true}}}
   :slen          {:codec      (b/enum :ubyte {:invalid 0} :lenient? true)
                   :present-if {:control-octet {:source-present? true}}}
   :sadr          {:length-ref :slen
                   :present-if {:control-octet {:source-present? true}}
                   :absent-if  {:slen :invalid}}
   :hop-count     {:codec      :ubyte
                   :present-if {:control-octet {:dest-present? true}}}
   :vendor-id     {:codec     :short-be
                   :absent-if data/vendor-id-absent?}
   :apdu          {:present-if {:control-octet {:layer :apdu}}
                   :codec      apdu}

   :number-of-ports {:present-if {:message-type :initialize-routing-table}
                     :codec      :ubyte}

   :network-number   {:present-if [{:message-type :establish-connection-to-network}
                                   {:message-type :disconnect-connection-to-network}]
                      :codec      :ushort}
   :termination-time {:present-if {:message-type :establish-connection-to-network}
                      :codec      (b/enum :ubyte {:permanent 0} :lenient? true)}))

util.binary.clj

(ns util.binary
  (:require [org.clojars.smee.binary.core :as b]
            [util.core :as util]
            [taoensso.encore :as encore])
  (:import org.clojars.smee.binary.core.BinaryIO))

(defn bits->int [data]
  (first (reduce (fn [[returned index] val]
                   (if (or (true? val) (= val 1))
                     [(bit-set returned index) (inc index)]
                     [returned (inc index)]))
                 [0 0]
                 (reverse data))))

(defn bit-ints->byte-ints
  [ints]
  (->> ints
       (into [])
       (partition 8)
       (map #(map {0 false 1 true} %))
       (map bits->int)))

(defn min-octets-signed-int
  "Optimized version of `min-octets-signed-int-any-length` for typical values"
  [value]

  (cond (<= -128 value 127)               1
        (<= -32768 value 32767)           2
        (<= -8388608 value 8388607)       3
        (<= -2147483648 value 2147483647) 4))

(defn min-octets-signed-int-any-length
  "Slower version of `min-octets-signed-int` because I'm too lazy to hardcode more
  ranges"
  [value]

  (-> (if (pos-int? value)
        (inc value)
        value)
      (* 2)
      Math/abs
      util/log2
      (/ 8)
      Math/ceil
      int))

(defn min-octets-unsigned-int
  [value]

  (some-> value
          Math/abs
          Long/toHexString
          count
          (/ 2)
          Math/ceil
          int))

(defn min-octets-string
  [value]

  (some-> value
          (.getBytes "UTF-8")
          count))

(defn int->bit-array
  [value & [bit-count]]

  (let [min-bits  (* 8 (min-octets-unsigned-int value))
        bit-count (or bit-count min-bits)]

    (reduce (fn [returned index]
            (cons (-> value
                      (bit-shift-right index)
                      (bit-and 1))
                  returned))
          []
          (range bit-count))))

(defn int->byte-array
  [int-value & [length]]

  (let [length (or length (min-octets-unsigned-int int-value))]
    (->> (-> int-value
             BigInteger/valueOf
             .toByteArray
             reverse
             (concat (repeat 0)))
         (take length)
         (into [])
         reverse)))

(defn bit-bools->bytes [bools]
  (-> (bits->int bools)
      BigInteger/valueOf
      .toByteArray))

(defn bytes->num
  "https://gist.github.com/pingles/1235344"
  [data]
  (reduce bit-or
          (map-indexed (fn [i x]
                         (bit-shift-left (bit-and x 0x0FF)
                                         (* 8 (- (count data) i 1))))
                       data)))

(defn bit-count->byte-count
  [bit-count]

  (int (Math/ceil (/ bit-count 8))))

(defn evaluate-condition
  [value-map condition]

  (cond
    (fn? condition)   (condition value-map)
    (coll? condition) (util/map-is-subset?* condition value-map)
    :else             (throw (ex-info "Condition not a function or a map!" condition))))

(defn codec? [value]

  (or (keyword? value)
      (instance? BinaryIO value)
      (not (map? value))))

(defn param-present?
  [value-map {:keys [present-if absent-if] :as param-config}]

  (let [present? (if (some? present-if) (evaluate-condition value-map present-if) true)
        absent?  (if (some? absent-if) (evaluate-condition value-map absent-if) false)]
    (or (codec? param-config)
        (and present? (not absent?)))))

(defn param-optional?
  [value-map {:keys [optional-if] :as param-config}]

  (if (some? optional-if) (evaluate-condition value-map optional-if) false))

(defn decode-config-map
  [value {:keys [bits enum-map lenient?] :as config-item}]

  (cond enum-map   ((#'b/strict-map (clojure.set/map-invert enum-map) lenient?)
                    value)
        (= bits 1) ({1 true 0 false} value)
        :else      value))

(defn encode-config-map
  [given-value {:keys [bits enum-map lenient? bits] :as config-item}]

  (let [value (cond enum-map   ((#'b/strict-map enum-map lenient?)
                                given-value)
                    (= bits 1) ({true 1 false 0} given-value given-value)
                    :else      given-value)]
    (when-not (number? value)
      (throw (ex-info "Cannot cast to bit-array!" {:value       value
                                                   :config-item config-item})))
    (int->bit-array value bits)))

(defn encode-complex-bytes
  [given-map config-list]

  (reduce (fn [encoded-bits {:keys [name] :as config-item}]
            (->> (cond (and (map? config-item)
                            (param-present? given-map config-item))
                       (let [given-value (get given-map name)]
                         (encode-config-map given-value config-item))

                       (keyword? config-item)
                       ({false [0] true [1]} (get given-map config-item))

                       (nil? config-item) [0]
                       :else              [])
                 (concat encoded-bits)))
          []
          config-list))

(defn get-bit-count
  [config]

  (let [bool-bit-count    (->> config (filter keyword?) count)
        complex-bit-count (->> config (filter map?) (map :bits) (apply +))
        skipped-bit-count (->> config (filter nil?) count)]
    (+ bool-bit-count complex-bit-count skipped-bit-count)))

(defn decode-complex-bytes
  [given-bits config]

  (-> (reduce (fn [[remaining-bits decoded] {:keys [bits name] :as config-item}]
                (cond (and (map? config-item)
                           (param-present? decoded config-item))
                      (let [value            (-> (take bits remaining-bits)
                                                 bits->int
                                                 (decode-config-map config-item))
                            remaining-bits   (nthrest remaining-bits bits)
                            decoded          (merge decoded {name value})]
                        [remaining-bits decoded])

                      (keyword? config-item)
                      [(rest remaining-bits)
                       (assoc decoded config-item (= 1 (first remaining-bits)))]

                      (nil? config-item) [(rest remaining-bits) decoded]
                      :else              [remaining-bits decoded]))
              [given-bits {}]
              config)
      second))

(defn post-decode-complex-bytes
  [config]

  (fn [bytes]
    (let [bit-count (get-bit-count config)
          bits      (int->bit-array bytes bit-count)]
      (decode-complex-bytes bits config))))

(defn pre-encode-complex-bytes
  [config]

  (fn [given-map]
    (-> (encode-complex-bytes given-map config)
        bits->int)))

(defn complex-bytes
  [codec config]

  (b/compile-codec codec
                   (pre-encode-complex-bytes config)
                   (post-decode-complex-bytes config)))

(defn map-header-codec [codec header]
  (b/compile-codec codec
                   #(dissoc % (keys header))
                   #(merge % header)))

(defn map-header->body [codec]
  (fn [header] (map-header-codec codec header)))

(defn enum-header->body [decision-key decision-map]
  (fn [header]
    (map-header-codec (->> (get header decision-key)
                           (get decision-map)
                           (b/ordered-map :content))
                      header)))

(defn body->map-header [header-keys]
  (fn [body] (select-keys body header-keys)))

(defn get-param-codec
  [value-map {:keys [codec-ref codec-map codec length-ref] :as param-config}]

  (let [given-codec (cond (codec? param-config)     param-config
                          codec                     codec
                          length-ref                (b/repeated :ubyte :length (get value-map length-ref))
                          (and codec-ref codec-map) (->> (get value-map codec-ref)
                                                         (get codec-map)))
        final-codec (if (fn? given-codec)
                      (given-codec value-map)
                      given-codec)]

    (when (nil? final-codec)
      (throw (ex-info "No codec given!" {:param-config param-config
                                         :value-map    value-map})))

    final-codec))

(defn writable?
  [value-map param-key param-config]

  (and (get value-map param-key)
       (param-present? value-map param-config)))

(defn complex-rule-codec
  [& kvs]
  (reify BinaryIO
    (read-data [_ big-in little-in]
      (encore/reduce-kvs (fn [decoded-map param-key param-config]
                           (if (param-present? decoded-map param-config)
                             (try (some-> (get-param-codec decoded-map param-config)
                                          (b/read-data big-in little-in)
                                          (as-> v (assoc decoded-map param-key v)))
                                  (catch java.io.EOFException e
                                    (if (param-optional? decoded-map param-config)
                                      decoded-map
                                      (throw e))))
                             decoded-map))
                         {}
                         kvs))

    (write-data [_ big-out little-out value-map]
      (encore/run-kvs! (fn [param-key param-config]
                         (when (writable? value-map param-key param-config)
                           (let [codec (get-param-codec value-map param-config)]
                             (->> (get value-map param-key)
                                  (b/write-data codec big-out little-out)))))
                       kvs))))

(defn decode-bytes
  [codec value length]

  (->> (int->byte-array value length)
       byte-array
       java.io.ByteArrayInputStream.
       (b/decode codec)))

(defn encode-bytes
  [codec value]
  (let [baos (java.io.ByteArrayOutputStream.)
        _    (b/encode codec baos value)
        arr  (.toByteArray baos)]
    [arr (mapv b/byte->ubyte (seq arr))]))

(def encode-ubytes (comp second encode-bytes))
(def encode-byte-array (comp first encode-bytes))
(defn decode-byte-array [codec arr] (b/decode codec (java.io.ByteArrayInputStream. arr)))
(defn get-byte-length [codec value] (-> (encode-byte-array codec value) count))

(defn do-roundtrip [codec value & [do-not-decode?]]
  (let [[arr encoded-ubytes] (encode-bytes codec value)
        decoded              (if (not do-not-decode?) (decode-byte-array codec arr))]
    {:encoded encoded-ubytes
     :value   value
     :decoded decoded}))

util.core.clj

(defn apply-any-subset-value-fn
  [superset-val subset-val-or-fn]

  (if (or (and (fn? subset-val-or-fn)
               (subset-val-or-fn superset-val))
          (= superset-val subset-val-or-fn))
    superset-val
    :not-matched))

(defn map-is-subset?
  [subset-map superset-map]

  (or (nil? subset-map)
      (= superset-map (encore/nested-merge-with apply-any-subset-value-fn
                                                superset-map subset-map))))

(defn map-is-subset?*
  "Gives you the option to pass a sequence of maps, and will return true if any of
  them are a subset. This is useful for specifying multiple valid matching and
  non-matching conditions"
  [subset-map-s superset-map]

  (if (sequential? subset-map-s)
    (some true? (map #(map-is-subset? % superset-map) subset-map-s))
    (map-is-subset? subset-map-s superset-map)))