#!/usr/bin/env -S junkie -c
; vim:syntax=scheme filetype=scheme expandtab
Or just run: junkie -c this_file

This small example will dump all transactions that can be seen in a set of CSV
files named tcp-XYZ.csv, dns-XYZ.csv, flow-XYZ.csv, web-XYZ.csv and
traffic-XYZ.csv, where XYZ are timestamp of the first entry in the file.  A new
file will be created every $CSV_DURATION seconds (60 by default).
!#

(define-module (dump-transactions))
(use-modules ((junkie netmatch nettrack) :renamer (symbol-prefix-proc 'nt:))
             (junkie defs)
             (junkie tools)
             (junkie runtime)
             (ice-9 threads)
             (rnrs records syntactic))

(define (getenv-default def s) (or (getenv s) def))

(set-log-file (string-append (getenv-default "." "LOG_DIR") "/junkie.log"))
;(set-log-level log-debug "guile")
;(set-log-level log-err "mutex")
;(set-log-level log-err "proto")

(define csv-dir (getenv-default "." "CSV_DIR"))
(define csv-duration (string->number (getenv-default "60" "CSV_DURATION")))

(define-record-type (timed-filedes make-timed-filedes-ll timed-filedes?)
  (fields prefix (mutable name) (mutable fd) (mutable start-ts)))

; redefine make-timed-filedes for default arguments:
(define (make-timed-filedes prefix)
  (make-timed-filedes-ll prefix "" #f 0))

(define (close-timed-filedes tfd)
  (slog log-debug "Closing dump fd ~a" (timed-filedes-prefix tfd))
  (let* ((cur-fd (timed-filedes-fd tfd)))
    (if (port? cur-fd)
      (let* ((old-name (timed-filedes-name tfd))
             (fin-name (string-drop-right old-name 4))) ; drop ".tmp"
        (rename-file old-name fin-name)
        (close-port cur-fd)))
    (timed-filedes-fd-set! tfd #f)))

(define (reopen-timed-filedes tfd new-ts)
  (slog log-debug "Reopening dump fd ~a" (timed-filedes-prefix tfd))
  (let* ((new-name (string-append csv-dir "/"
                                  (timed-filedes-prefix tfd) "-"
                                  (number->string new-ts) ".csv.tmp"))
         (new-fd (open-file new-name "alb"))) ; append, line buffered, binary
    (close-timed-filedes tfd)
    (timed-filedes-fd-set! tfd new-fd)
    (timed-filedes-start-ts-set! tfd new-ts)
    (timed-filedes-name-set! tfd new-name)))

(define (maybe-reopen-timed-filedes tfd new-ts)
  (if (>= new-ts (+ (timed-filedes-start-ts tfd) csv-duration))
    (reopen-timed-filedes tfd new-ts)))

(define tcp-tfd (make-timed-filedes "tcp"))
(define dns-tfd (make-timed-filedes "dns"))
(define flow-tfd (make-timed-filedes "flow"))
(define web-tfd (make-timed-filedes "web"))
(define traffic-tfd (make-timed-filedes "traffic"))
(define x509-tfd (make-timed-filedes "x509"))
(define tls-tfd (make-timed-filedes "tls"))

(define (close-all)
  (close-timed-filedes tcp-tfd)
  (close-timed-filedes dns-tfd)
  (close-timed-filedes flow-tfd)
  (close-timed-filedes web-tfd)
  (close-timed-filedes traffic-tfd)
  (close-timed-filedes x509-tfd)
  (close-timed-filedes tls-tfd))

(define (dump-next-value out next . rest)
  (display next out)
  (if (null? rest) (write-char #\newline out)
      (begin (write-char #\tab out)
             (apply dump-next-value out rest))))

; Ports are not thread safe:
(define dump-lock (make-mutex))
(define (dump tfd ts . args)
  (with-mutex dump-lock
    (maybe-reopen-timed-filedes tfd (inexact->exact (round ts)))
    (apply dump-next-value (timed-filedes-fd tfd)
           (cons ts args)))) ; also dump the TS as the first field

(define null "<NULL>")
(define (or-null v)
  (if (eqv? v 0) null v))

(define (vlan vlan-id)
  (if (or (< vlan-id 0) (> vlan-id 4095))
      null
      vlan-id))

(define-public (print-web device vlan-id client-mac client-ip server-mac
                          server-ip server-port qry-method err-code
                          qry-start dt qry-host url)
  (let ((dt (/ dt 1000000.))) ; convert microsecs to secs
    (dump web-tfd
          (timestamp->float qry-start)
          device
          (vlan vlan-id)
          (eth->string client-mac)
          (ip->string client-ip)
          (eth->string server-mac)
          (ip->string server-ip)
          server-port
          (http-method->string qry-method)
          err-code
          dt
          qry-host
          url)))

(define-public (print-dns device vlan-id client-mac client-ip server-mac
                          server-ip server-port err-code qry-start dt
                          qry-name)
  (let ((dt (/ dt 1000000.))) ; convert microsecs to secs
    (dump dns-tfd
          (timestamp->float qry-start)
          device
          (vlan vlan-id)
          (eth->string client-mac)
          (ip->string client-ip)
          (eth->string server-mac)
          (ip->string server-ip)
          server-port
          err-code
          dt
          qry-name)))

(define-public (print-traffic device vlan-id ts-start ts-stop count eth-src
                              eth-dst eth-proto eth-pld eth-mtu ip-src
                              ip-dst ip-proto ip-pld port-src port-dst
                              l4-pld)
  (dump traffic-tfd
        (timestamp->float ts-start)
        (timestamp->float ts-stop)
        device
        count
        (vlan vlan-id)
        (eth->string eth-src)
        (eth->string eth-dst)
        (eth-proto->string eth-proto)
        eth-pld
        eth-mtu
        (if ip-src (ip->string ip-src) null)
        (if ip-dst (ip->string ip-dst) null)
        (if (eqv? 0 ip-proto) null (ip-proto->string ip-proto))
        (or-null ip-pld)
        (or-null port-src)
        (or-null port-dst)
        l4-pld))

(define-public (print-tcp device vlan-id client-mac client-ip server-mac
                          server-ip client-port server-port sock-syn num-syns
                          dt)
  (let ((dt (/ dt 1000000.))) ; convert microsecs to secs
    (dump tcp-tfd
          (timestamp->float sock-syn)
          device
          (vlan vlan-id)
          (eth->string client-mac)
          (ip->string client-ip)
          client-port
          (eth->string server-mac)
          (ip->string server-ip)
          server-port
          num-syns
          dt))) ; dt measures the connection time

(define-public (print-flow device vlan-id eth-src ip-src eth-dst ip-dst
                           ip-proto port-src port-dst ts-start ts-stop
                           count pld)
  (dump flow-tfd
        (timestamp->float ts-start)
        (timestamp->float ts-stop)
        device
        (vlan vlan-id)
        (eth->string eth-src)
        (ip->string ip-src)
        (eth->string eth-dst)
        (ip->string ip-dst)
        (ip-proto->string ip-proto)
        port-src
        port-dst
        count
        pld))

(define-public (print-tls ts device vlan-id client-mac client-ip server-mac
                          server-ip server-port cipher-suite
                          compress-algorithm sni)
  (dump tls-tfd
        (timestamp->float ts)
        device
        (vlan vlan-id)
        (eth->string client-mac)
        (ip->string client-ip)
        (eth->string server-mac)
        (ip->string server-ip)
        server-port
        (tls-cipher-suite->string cipher-suite)
        (tls-compress-algo->string compress-algorithm)
        sni))

(define-public (print-x509 ts device vlan-id client-mac client-ip server-mac
                           server-ip server-port cert-num num-certs
                           serial-number not-before not-after subject issuer)
  (dump x509-tfd
        (timestamp->float ts)
        device
        (vlan vlan-id)
        (eth->string client-mac)
        (ip->string client-ip)
        (eth->string server-mac)
        (ip->string server-ip)
        server-port
        cert-num
        num-certs
        serial-number
        (ber-time->string not-before)
        (ber-time->string not-after)
        subject
        issuer))

(define nt-http (nt:compile "http-response-time"
  '([(err-code uint)
     (client-ip ip)
     (server-ip ip)
     (client-mac mac)
     (server-mac mac)
     (device uint)
     (vlan uint)
     (client-port uint)
     (server-port uint)
     (qry-start timestamp)
     (qry-stop timestamp)
     (qry-method uint)
     (url str)
     (qry-host str)]
    [(http-answer
       (on-entry (apply (dump-transactions) print-web device vlan client-mac client-ip server-mac server-ip server-port qry-method err-code qry-start (- qry-stop qry-start) qry-host url)))
     (web-qry
       (index-size 5024)
       (timeout 60000000))]
    ; edges
    [(root web-qry
        (match (cap eth ip tcp http) (if
                                       (set? http.method)
                                       (do
                                         (client-ip := ip.src)
                                         (client-mac := eth.src)
                                         (client-port := tcp.src-port)
                                         (server-ip := ip.dst)
                                         (server-mac := eth.dst)
                                         (device := cap.dev)
                                         (vlan := eth.vlan)
                                         (server-port := tcp.dst-port)
                                         (qry-start := cap.ts)
                                         (qry-method := http.method)
                                         (if (set? http.host)
                                             (qry-host := http.host)
                                             (qry-host := ""))
                                         (if (set? http.url)
                                             (url := http.url)
                                             (url := ""))
                                         #t)))
        (dst-index-on () client-port)
        spawn)
     (web-qry http-answer
        (match (cap ip tcp http) (if
                                   (and (ip.src == server-ip)
                                        (ip.dst == client-ip)
                                        (tcp.dst-port == client-port)
                                        (tcp.src-port == server-port)
                                        (set? http.status)
                                        (cap.ts >= qry-start))
                                   (do
                                     (qry-stop := cap.ts)
                                     (err-code := http.status)
                                     #t)))
        (src-index-on (tcp) tcp.dst-port))])))

(define nt-dns (nt:compile "dns-response-time"
  '([(err-code uint)
     (client-ip ip)
     (server-ip ip)
     (client-mac mac)
     (server-mac mac)
     (server-port uint)
     (device uint)
     (vlan uint)
     (qry-start timestamp)
     (qry-stop timestamp)
     (qry-name str)]
    [(dns-answer
       (on-entry (apply (dump-transactions) print-dns device vlan client-mac client-ip server-mac server-ip server-port err-code qry-start (- qry-stop qry-start) qry-name)))
     (dns-query
       (index-size 5024)
       (timeout 10000000))]
    ; edges
    [(root dns-query
        (match (cap eth ip udp dns) (if
                                  dns.query
                                  (do
                                    (client-ip := ip.src)
                                    (client-mac := eth.src)
                                    (server-ip := ip.dst)
                                    (server-mac := eth.dst)
                                    (server-port := udp.src-port)
                                    (device := cap.dev)
                                    (vlan := eth.vlan)
                                    (txid := dns.txid)
                                    (qry-name := dns.name)
                                    (qry-start := cap.ts)
                                    #t)))
        (dst-index-on () txid)
        spawn)
     (dns-query dns-answer
        (match (cap ip dns) (if
                              (and
                                (ip.src == server-ip)
                                (ip.dst == client-ip)
                                (dns.txid == txid)
                                (cap.ts >= qry-start))
                              (do
                                (qry-stop := cap.ts)
                                (err-code := dns.err-code)
                                #t)))
        (src-index-on (dns) dns.txid))])))

(define nt-eth (nt:compile "eth-traffic"
  '([(device uint)
     (vlan uint)
     (eth-src mac)
     (eth-dst mac)
     (eth-proto uint)
     (eth-pld uint)
     (ip-src ip)
     (ip-dst ip)
     (ip-proto uint)
     (ip-pld uint)
     (port-src uint)
     (port-dst uint)
     (l4-pld uint)
     (ts-start timestamp)
     (ts-stop timestamp)
     (count uint)
     (eth-mtu uint)]
    [(traffic-eth-end
       (on-entry (apply (dump-transactions) print-traffic device vlan ts-start ts-stop count eth-src eth-dst eth-proto eth-pld eth-mtu #f #f 0 0 0 0 0)))
     (traffic-eth
       (index-size 5024)
       (timeout 0))
     (traffic-ip-end
       (on-entry (apply (dump-transactions) print-traffic device vlan ts-start ts-stop count eth-src eth-dst eth-proto eth-pld eth-mtu ip-src ip-dst ip-proto ip-pld 0 0 0)))
     (traffic-ip
       (index-size 5024)
       (timeout 0))
     (traffic-l4-end
       (on-entry (apply (dump-transactions) print-traffic device vlan ts-start ts-stop count eth-src eth-dst eth-proto eth-pld eth-mtu ip-src ip-dst ip-proto ip-pld port-src port-dst l4-pld)))
     (traffic-tcp
       (index-size 8192)
       (timeout 0))
     (traffic-udp
       (index-size 8192)
       (timeout 0))]
    ; edges
    [; ETH
     (root traffic-eth ; we place this one first so that it's checked last
        (on full-parse)
        (match (cap eth) (do
                           (eth-src := eth.src)
                           (eth-dst := eth.dst)
                           (device := cap.dev)
                           (vlan := eth.vlan)
                           (eth-proto := eth.protocol)
                           (ts-start := cap.ts)
                           (ts-stop := cap.ts)
                           (eth-pld := eth.payload)
                           (eth-mtu := eth.payload)
                           (count := 1)
                           #t))
        (dst-index-on () (hash eth-src))
        spawn
        grab) ; no need to match traffic-eth->traffic-eth
     (traffic-eth traffic-eth
        (on full-parse)
        (match (cap eth) (if
                           (and (eth-src == eth.src)
                                (eth-dst == eth.dst)
                                (device == cap.dev)
                                (vlan == eth.vlan)
                                (eth-proto == eth.protocol))
                           (do
                             (count := (count + 1))
                             (eth-pld := (eth-pld + eth.payload))
                             (eth-mtu := (max eth-mtu eth.payload))
                             (ts-stop := cap.ts)
                             #t)))
        (src-index-on (eth) (hash eth.src))
        grab) ; prevent root->traffic-eth
     (traffic-eth traffic-eth-end
        (on full-parse)
        (older 60000000)) ; do not prevent root->traffic-eth edge to match as well (thus reporting this packet payload)
     ; other IP
     (root traffic-ip ; for other ip traffic
        (on full-parse)
        (match (cap eth ip) (do
                              (eth-src := eth.src)
                              (eth-dst := eth.dst)
                              (device := cap.dev)
                              (vlan := eth.vlan)
                              (eth-proto := eth.protocol)
                              (ts-start := cap.ts)
                              (ts-stop := cap.ts)
                              (eth-pld := eth.payload)
                              (eth-mtu := eth.payload)
                              (ip-pld := ip.payload)
                              (ip-src := ip.src)
                              (ip-dst := ip.dst)
                              (ip-proto := ip.proto)
                              (count := 1)
                              #t))
        (dst-index-on () (hash ip-src ip-dst))
        spawn
        grab)
     (traffic-ip traffic-ip
        (on full-parse)
        (match (cap eth ip) (if
                              (and (eth-src == eth.src)
                                   (eth-dst == eth.dst)
                                   (device == cap.dev)
                                   (vlan == eth.vlan)
                                   (eth-proto == eth.protocol)
                                   (ip-src == ip.src)
                                   (ip-dst == ip.dst)
                                   (ip-proto == ip.proto))
                              (do
                                (count := (count + 1))
                                (eth-pld := (eth-pld + eth.payload))
                                (eth-mtu := (max eth-mtu eth.payload))
                                (ts-stop := cap.ts)
                                (ip-pld := (ip-pld + ip.payload))
                                #t)))
        (src-index-on (ip) (hash ip.src ip.dst))
        grab)
     (traffic-ip traffic-ip-end
        (on full-parse)
        (older 60000000))
     ; TCP
     (root traffic-tcp
        (on full-parse)
        (match (cap eth ip tcp) (do
                                  (eth-src := eth.src)
                                  (eth-dst := eth.dst)
                                  (device := cap.dev)
                                  (vlan := eth.vlan)
                                  (eth-proto := eth.protocol)
                                  (ts-start := cap.ts)
                                  (ts-stop := cap.ts)
                                  (eth-pld := eth.payload)
                                  (eth-mtu := eth.payload)
                                  (ip-pld := ip.payload)
                                  (ip-src := ip.src)
                                  (ip-dst := ip.dst)
                                  (ip-proto := ip.proto)
                                  (port-src := tcp.src-port)
                                  (port-dst := tcp.dst-port)
                                  (l4-pld := tcp.payload)
                                  (count := 1)
                                  #t))
        (dst-index-on () (hash ip-src ip-dst port-src port-dst))
        spawn
        grab)
     (traffic-tcp traffic-tcp
        (on full-parse)
        (match (cap eth ip tcp) (if
                                  (and (eth-src == eth.src)
                                       (eth-dst == eth.dst)
                                       (device == cap.dev)
                                       (vlan == eth.vlan)
                                       (eth-proto == eth.protocol)
                                       (ip-src == ip.src)
                                       (ip-dst == ip.dst)
                                       (ip-proto == ip.proto)
                                       (port-src == tcp.src-port)
                                       (port-dst == tcp.dst-port))
                                  (do
                                    (count := (count + 1))
                                    (eth-pld := (eth-pld + eth.payload))
                                    (eth-mtu := (max eth-mtu eth.payload))
                                    (ts-stop := cap.ts)
                                    (ip-pld := (ip-pld + ip.payload))
                                    (l4-pld := (l4-pld + tcp.payload))
                                    #t)))
        (src-index-on (ip tcp) (hash ip.src ip.dst tcp.src-port tcp.dst-port))
        grab)
     (traffic-tcp traffic-l4-end
        (on full-parse)
        (older 60000000))
     ; UDP
     (root traffic-udp
        (on full-parse)
        (match (cap eth ip udp) (do
                                  (eth-src := eth.src)
                                  (eth-dst := eth.dst)
                                  (device := cap.dev)
                                  (vlan := eth.vlan)
                                  (eth-proto := eth.protocol)
                                  (ts-start := cap.ts)
                                  (ts-stop := cap.ts)
                                  (eth-pld := eth.payload)
                                  (eth-mtu := eth.payload)
                                  (ip-pld := ip.payload)
                                  (ip-src := ip.src)
                                  (ip-dst := ip.dst)
                                  (ip-proto := ip.proto)
                                  (port-src := udp.src-port)
                                  (port-dst := udp.dst-port)
                                  (l4-pld := udp.payload)
                                  (count := 1)
                                  #t))
        (dst-index-on () (hash ip-src ip-dst port-src port-dst))
        spawn
        grab)
     (traffic-udp traffic-udp
        (on full-parse)
        (match (cap eth ip udp) (if
                                  (and (eth-src == eth.src)
                                       (eth-dst == eth.dst)
                                       (device == cap.dev)
                                       (vlan == eth.vlan)
                                       (eth-proto == eth.protocol)
                                       (ip-src == ip.src)
                                       (ip-dst == ip.dst)
                                       (ip-proto == ip.proto)
                                       (port-src == udp.src-port)
                                       (port-dst == udp.dst-port))
                                  (do
                                    (count := (count + 1))
                                    (eth-pld := (eth-pld + eth.payload))
                                    (eth-mtu := (max eth-mtu eth.payload))
                                    (ts-stop := cap.ts)
                                    (ip-pld := (ip-pld + ip.payload))
                                    (l4-pld := (l4-pld + udp.payload))
                                    #t)))
        (src-index-on (ip udp) (hash ip.src ip.dst udp.src-port udp.dst-port))
        grab)
     (traffic-udp traffic-l4-end
        (on full-parse)
        (older 60000000))])))

; To report all TCP cnx establishment
(define nt-tcp (nt:compile "tcp-cnxs"
  '([(client-ip ip)
     (server-ip ip)
     (client-mac mac)
     (server-mac mac)
     (client-port uint)
     (server-port uint)
     (device uint)
     (vlan uint)
     (sock-syn timestamp)
     (sock-ack timestamp)
     (num-syns uint)]
    [(tcp-opened
       (on-entry (apply (dump-transactions) print-tcp device vlan client-mac client-ip server-mac server-ip client-port server-port sock-syn num-syns (sock-ack - sock-syn))))
     (tcp-connecting
       (on-timeout (apply (dump-transactions) print-tcp device vlan client-mac client-ip server-mac server-ip client-port server-port sock-syn num-syns (sock-ack - sock-syn)))
       (index-size 20000)
       ; timeout an outstanding SYN after 80s
       (timeout 80000000))]
    ; edges
    [(root tcp-connecting
        (match (cap eth ip tcp) (if
                                  tcp.syn
                                  (do
                                    (client-port := tcp.src-port)
                                    (client-ip := ip.src)
                                    (client-mac := eth.src)
                                    (server-port := tcp.dst-port)
                                    (server-ip := ip.dst)
                                    (server-mac := eth.dst)
                                    (device := cap.dev)
                                    (vlan := eth.vlan)
                                    (sock-syn := cap.ts)
                                    (sock-ack := cap.ts) ; FIXME: 0 instead
                                    (num-syns := 1)
                                    #t)))
        (dst-index-on () (hash client-ip client-port server-ip server-port))
        spawn)
     (tcp-connecting tcp-connecting ; other syns are merely counted
        (match (cap ip tcp) (if
                          (and
                            tcp.syn
                            (ip.src == client-ip)
                            (ip.dst == server-ip)
                            (tcp.src-port == client-port)
                            (tcp.dst-port == server-port))
                          (do
                            (num-syns := (num-syns + 1))
                            #t)))
        (src-index-on (ip tcp) (hash ip.src tcp.src-port ip.dst tcp.dst-port))
        grab)
     (tcp-connecting tcp-connecting ; and the other way around
        (match (cap ip tcp) (if
                          (and
                            tcp.syn
                            (ip.src == server-ip)
                            (ip.dst == client-ip)
                            (tcp.src-port == server-port)
                            (tcp.dst-port == client-port))
                          (do
                            (num-syns := (num-syns + 1))
                            #t)))
        (src-index-on (ip tcp) (hash ip.dst tcp.dst-port ip.src tcp.src-port))
        grab)
     (tcp-connecting tcp-opened ; when the client ack something (ie. the other syn)
        (match (cap ip tcp) (if
                          (and
                            tcp.ack
                            (ip.src == client-ip)
                            (ip.dst == server-ip)
                            (tcp.src-port == client-port)
                            (tcp.dst-port == server-port))
                          (do
                            (sock-ack := cap.ts)
                            #t)))
        (src-index-on (ip tcp) (hash ip.src tcp.src-port ip.dst tcp.dst-port))
        (dst-index-on () (hash client-ip client-port server-ip server-port))
        grab)])))

; To report all TCP/UDP data transfers (for callflow)
(define nt-flow (nt:compile "l4-data"
  '([(src-ip ip)
     (dst-ip ip)
     (src-mac mac)
     (dst-mac mac)
     (src-port uint)
     (dst-port uint)
     (ip-proto uint)
     (device uint)
     (vlan uint)
     (start timestamp)
     (stop timestamp)
     (num-pkts uint)
     (pld uint)]
    [(tcp-tx
       (on-timeout (apply (dump-transactions) print-flow device vlan src-mac src-ip dst-mac dst-ip ip-proto src-port dst-port start stop num-pkts pld))
       (index-size 20000)
       ; timeout an outstanding tcp tx after 500ms
       (timeout 500000))
     (udp-tx
       (on-timeout (apply (dump-transactions) print-flow device vlan src-mac src-ip dst-mac dst-ip ip-proto src-port dst-port start stop num-pkts pld))
       (index-size 20000)
       ; timeout an outstanding udp tx after 500ms
       (timeout 500000))
     (dt-end
       (on-entry (apply (dump-transactions) print-flow device vlan src-mac src-ip dst-mac dst-ip ip-proto src-port dst-port start stop num-pkts pld)))]
    ; edges
    [(root tcp-tx
        (match (cap eth ip tcp) (if
                                  (tcp.payload > 0)
                                  (do
                                    (src-port := tcp.src-port)
                                    (src-ip := ip.src)
                                    (src-mac := eth.src)
                                    (dst-port := tcp.dst-port)
                                    (dst-ip := ip.dst)
                                    (dst-mac := eth.dst)
                                    (device := cap.dev)
                                    (vlan := eth.vlan)
                                    (ip-proto := ip.proto)
                                    (start := cap.ts)
                                    (stop := cap.ts)
                                    (num-pkts := 1)
                                    (pld := tcp.payload)
                                    #t)))
        (dst-index-on () (hash src-ip src-port dst-ip dst-port))
        spawn)
     (tcp-tx tcp-tx ; new packet in same direction
        (match (cap ip tcp) (if
                              (and
                                (tcp.payload > 0)
                                (ip.src == src-ip)
                                (ip.dst == dst-ip)
                                (tcp.src-port == src-port)
                                (tcp.dst-port == dst-port))
                              (do
                                (stop := cap.ts)
                                (num-pkts := (num-pkts + 1))
                                (pld := (pld + tcp.payload))
                                #t)))
        (src-index-on (ip tcp) (hash ip.src tcp.src-port ip.dst tcp.dst-port))
        grab)
     (tcp-tx dt-end ; packet in the other direction
        (match (ip tcp) (and
                          (tcp.payload > 0)
                          (ip.src == dst-ip)
                          (ip.dst == src-ip)
                          (tcp.src-port == dst-port)
                          (tcp.dst-port == src-port)))
        (src-index-on (ip tcp) (hash ip.dst tcp.dst-port ip.src tcp.src-port))
        ; no grab
        )
     (root udp-tx
        (match (cap eth ip udp) (if
                                  (udp.payload > 0)
                                  (do
                                    (src-port := udp.src-port)
                                    (src-ip := ip.src)
                                    (src-mac := eth.src)
                                    (dst-port := udp.dst-port)
                                    (dst-ip := ip.dst)
                                    (dst-mac := eth.dst)
                                    (device := cap.dev)
                                    (vlan := eth.vlan)
                                    (ip-proto := ip.proto)
                                    (start := cap.ts)
                                    (stop := cap.ts)
                                    (num-pkts := 1)
                                    (pld := udp.payload)
                                    #t)))
        (dst-index-on () (hash src-ip src-port dst-ip dst-port))
        spawn)
     (udp-tx udp-tx ; new packet in same direction
        (match (cap ip udp) (if
                              (and
                                (udp.payload > 0)
                                (ip.src == src-ip)
                                (ip.dst == dst-ip)
                                (udp.src-port == src-port)
                                (udp.dst-port == dst-port))
                              (do
                                (stop := cap.ts)
                                (num-pkts := (num-pkts + 1))
                                (pld := (pld + udp.payload))
                                #t)))
        (src-index-on (ip udp) (hash ip.src udp.src-port ip.dst udp.dst-port))
        grab)
     (udp-tx dt-end ; packet in the other direction
        (match (ip udp) (and
                          (udp.payload > 0)
                          (ip.src == dst-ip)
                          (ip.dst == src-ip)
                          (udp.src-port == dst-port)
                          (udp.dst-port == src-port)))
        (src-index-on (ip udp) (hash ip.dst udp.dst-port ip.src udp.src-port))
        ; no grab
        )])))

(define nt-x509 (nt:compile "x509"
  '([(device uint)
     (vlan uint)
     (client-mac mac)
     (server-mac mac)
     (client-ip ip)
     (server-ip ip)
     (server-port uint)
     (ts timestamp)
     (num-certs uint)
     (serial-number-0 ber-uint)
     (not-before-0 ber-time)
     (not-after-0 ber-time)
     (subject-0 str)
     (issuer-0 str)
     (serial-number-1 ber-uint)
     (not-before-1 ber-time)
     (not-after-1 ber-time)
     (subject-1 str)
     (issuer-1 str)
     (serial-number-2 ber-uint)
     (not-before-2 ber-time)
     (not-after-2 ber-time)
     (subject-2 str)
     (issuer-2 str)
     (serial-number-3 ber-uint)
     (not-before-3 ber-time)
     (not-after-3 ber-time)
     (subject-3 str)
     (issuer-3 str)]
    [(tls-handshake
       (on-entry
         (do
           (if (> num-certs 0)
             (apply (dump-transactions)
                    print-x509 ts device vlan client-mac client-ip server-mac server-ip server-port
                    0 num-certs serial-number-0 not-before-0 not-after-0 subject-0 issuer-0))
           (if (> num-certs 1)
             (apply (dump-transactions)
                    print-x509 ts device vlan client-mac client-ip server-mac server-ip server-port
                    1 num-certs serial-number-1 not-before-1 not-after-1 subject-1 issuer-1))
           (if (> num-certs 2)
             (apply (dump-transactions)
                    print-x509 ts device vlan client-mac client-ip server-mac server-ip server-port
                    2 num-certs serial-number-2 not-before-2 not-after-2 subject-2 issuer-2))
           (if (> num-certs 3)
             (apply (dump-transactions)
                    print-x509 ts device vlan client-mac client-ip server-mac server-ip server-port
                    3 num-certs serial-number-3 not-before-3 not-after-3 subject-3 issuer-3)))))]
    ; edges
    [(root tls-handshake
        (match (cap eth ip tcp tls) (if
                                      (set? tls.num-certs)
                                      (do
                                        (client-ip := ip.dst)
                                        (client-mac := eth.dst)
                                        (server-ip := ip.src)
                                        (server-mac := eth.src)
                                        (server-port := tcp.src-port)
                                        (device := cap.dev)
                                        (vlan := eth.vlan)
                                        (ts := cap.ts)
                                        (num-certs := tls.num-certs)
                                        (if (> tls.num-certs 0)
                                          (do
                                            (serial-number-0 := tls.serial-number-0)
                                            (not-before-0 := tls.not-before-0)
                                            (not-after-0 := tls.not-after-0)
                                            (subject-0 := tls.subject-0)
                                            (issuer-0 := tls.issuer-0)
                                            #t))
                                        (if (> tls.num-certs 1)
                                          (do
                                            (serial-number-1 := tls.serial-number-1)
                                            (not-before-1 := tls.not-before-1)
                                            (not-after-1 := tls.not-after-1)
                                            (subject-1 := tls.subject-1)
                                            (issuer-1 := tls.issuer-1)
                                            #t))
                                        (if (> tls.num-certs 2)
                                          (do
                                            (serial-number-2 := tls.serial-number-2)
                                            (not-before-2 := tls.not-before-2)
                                            (not-after-2 := tls.not-after-2)
                                            (subject-2 := tls.subject-2)
                                            (issuer-2 := tls.issuer-2)
                                            #t))
                                        (if (> tls.num-certs 3)
                                          (do
                                            (serial-number-3 := tls.serial-number-3)
                                            (not-before-3 := tls.not-before-3)
                                            (not-after-3 := tls.not-after-3)
                                            (subject-3 := tls.subject-3)
                                            (issuer-3 := tls.issuer-3)
                                            #t))
                                        #t)))
        spawn)])))

(define nt-tls (nt:compile "tls"
  '([(device uint)
     (vlan uint)
     (client-mac mac)
     (server-mac mac)
     (client-ip ip)
     (server-ip ip)
     (server-port uint)
     (ts timestamp)
     (cipher-suite uint)
     (compress-algorithm uint)
     (sni str)]
    [(tls-handshake
       (on-entry
         (do
           (apply (dump-transactions)
                  print-tls ts device vlan client-mac client-ip server-mac server-ip server-port
                  cipher-suite compress-algorithm sni))))]
    ; edges
    [(root tls-handshake
        (match (cap eth ip tcp tls)
               (do
                 (if
                   (set? tls.sni)
                   (sni := tls.sni)
                   (sni := ""))
                 (if
                   (set? tls.cipher-suite)
                   (do
                     (client-ip := ip.dst)
                     (client-mac := eth.dst)
                     (server-ip := ip.src)
                     (server-mac := eth.src)
                     (server-port := tcp.src-port)
                     (device := cap.dev)
                     (vlan := eth.vlan)
                     (ts := cap.ts)
                     (cipher-suite := tls.cipher-suite)
                     (compress-algorithm := tls.compress-algorithm)
                     #t))))
        spawn)])))

(set-collapse-vlans #f)
(set-collapse-ifaces #f)

(nettrack-start nt-http)
(nettrack-start nt-dns)
(nettrack-start nt-eth)
(nettrack-start nt-tcp)
(nettrack-start nt-flow)
(nettrack-start nt-x509)
(nettrack-start nt-tls)

(start-repl-server)

(let ((ifaces (getenv-default "eth0" "SNIFF_IFACES"))
      (capfilter (getenv-default "" "SNIFF_CAPTURE_FILTER")))
  (if (file-exists? ifaces)
    (begin
      (set-quit-when-done #f)
      (open-pcap ifaces #f capfilter)
      (while (not (null? (iface-names)))
             (sleep 1))
      (slog log-info "Finished playing pcap file")
      (close-all)
      (exit 0))
    (begin
      (set-ifaces ifaces #:capfilter capfilter)
      (if (null? (iface-names))
        (slog log-crit "It seams SNIFF_IFACES (~a) matches no ifaces" ifaces)))))