(use test matchable bitstring srfi-13)

(include "../bpf-assembler.scm")

(import bpf-assembler)

(test-begin "BPF assembler")

(test-group "single instruction assembly/disassembly invariance"
  (for-each (lambda (expr)
              (test (->string expr)
                    expr
                    (car (bpf-bytecode->exprs
                          (exprs->bpf-bytecode (list expr))))))
            `(;; load word into accumulator register
              (ld len) (ld 1) (ld (mem 1)) (ld (pkt 1)) (ld (pkt x 1))
              ;; load byte/halfword into accumulator register
              (ldb (pkt 1)) (ldb (pkt x 1)) (ldh (pkt 1)) (ldh (pkt x 1))
              ;; load index register
              (ldx len) (ldx 1) (ldx (mem 1))
              ;; load index register w/ byte, with packet 4*-index hack
              (ldxb (pkt 4* 1))
              ;; store accumulator/index register
              (st (mem 1)) (stx (mem 1))
              ;; jump unconditionally (sometimes called JA instead of JMP)
              (jmp 1) (jmp 0)
              ;; Jump conditionally on comparison of acc w/ immediate or idx
              (jeq 0 2 3) (jeq 1 2 3) (jeq x 2 3)
              (jgt 0 2 3) (jgt 1 2 3) (jgt x 2 3)
              (jge 0 2 3) (jge 1 2 3) (jge x 2 3)
              ;; Jump if bit # from immediate/index register is set in acc
              (jset 0 2 3) (jset 1 2 3) (jset x 2 3)
              ;; ALU instructions: operates on acc w/ immediate or index
              (add 1) (add x) (sub 1) (sub x) (mul 1) (mul x) (div 1) (div x)
              (or 1) (or x) (and 1) (and x) (lsh 1) (lsh x) (rsh 1) (rsh x)
              ;; Negate accumulator (no operands)
              (neg)
              ;; Return # of bytes in acc or idx registers or immediate
              (ret 1) (ret a) (ret x)
              ;; Transfer value between accumulator and index
              (tax) (txa))))

(test-group "Invalid opcode/addressing mode combinations"
  (for-each (match-lambda
              ((subgroup-name exprs ...)
               (test-group subgroup-name
                 (for-each (lambda (expr)
                             (test-error
                              (->string expr)
                              (car (bpf-bytecode->exprs
                                    (exprs->bpf-bytecode (list expr))))))
                           exprs))))
            `(("load of word into accumulator from invalid types"
               (ld x) (ld a) (ld (pkt 4* 1)))
              ("load of halfword into accumulator from invalid types"
               (ldh len) (ldh x) (ldh a) (ldh (pkt 4* 1)))
              ("load of byte into accumulator from invalid types"
               (ldb len) (ldb x) (ldb a) (ldb (pkt 4* 1)))
              ("load of word into index from invalid types"
               (ldx (pkt 1)) (ldx a) (ldx x) (ldx (pkt 1)) (ldx (pkt x 1)))
              ("load of byte into index from invalid types"
               (ldxb len) (ldxb 1) (ldxb (mem 1)) (ldxb (pkt 1)) (ldxb (pkt x 1)))

              ("store of accumulator into memory must be immediate memory index"
               (st 1) (st len) (st a) (st x) (st (mem x 1))
               (st (pkt 1)) (st (pkt 4* 1)))
              ("store of index into memory must be immediate memory index"
               (stx 1) (stx len) (stx a) (stx x) (stx (mem x 1))
               (stx (pkt 1)) (stx (pkt 4* 1)))

              ("bogus jump types and negative labels"
               (jmp x) (jmp a) (jmp (mem 1)) (jmp len) (jmp -1) (jeq -1 1 2))

              ("unconditional jumps can't work conditionally"
               (jmp 1 2 3) (jmp x 2 3))

              ("bogus unconditional jumps"
               (jmp (mem 1) 2 3) (jmp len 2 3) (jmp a 2 3))

              ("conditional jumps can't work unconditionally"
               (jeq 1) (jeq x) (jgt 1) (jgt x) (jge 1) (jge x) (jset 1) (jset x))

              ;; Only test add, the rest are defined identically
              ("diadic ALU instructions with disallowed operands"
               (add a) (add (mem 1)) (add (pkt 1)) (add (pkt x 1)) (add (pkt 4* 1)))
              
              ("monadic instructions with operands"
               (neg 1) (neg x) (neg a) (neg (mem 1))
               ;; Only do txa, tax is defined identically
               (txa 1) (txa x) (txa a) (txa (mem 1)))
              
              ("returning non-immediate, non-register values"
               (ret (mem 1)) (ret (pkt 1)) (ret (pkt x 1)) (ret (pkt 4* 1))))))

(test-group "multi-instruction assembly/disassembly invariance"
  (for-each (match-lambda
              ((description . exprs)
               (test description
                     exprs
                     (bpf-bytecode->exprs (exprs->bpf-bytecode exprs)))))
            `(("simple load and return" (ld 1234) (ret 10))

              ("src localhost program"
               (ldh (pkt 12))
               (jeq #x0800 0 2)
               (ld  (pkt 26))
               (jeq #x7f000001 4 5)
               (jeq #x0806 1 0)
               (jeq #x8035 0 3)
               (ld  (pkt 28))
               (jeq #x7f000001 0 1)
               (ret 65535)
               (ret 0)))))

(test-group "decimal bytecode reader"
  (test "src localhost"
        `((ldh (pkt 12))
          (jeq #x0800 0 2)
          (ld  (pkt 26))
          (jeq #x7f000001 4 5)
          (jeq #x0806 1 0)
          (jeq #x8035 0 3)
          (ld  (pkt 28))
          (jeq #x7f000001 0 1)
          (ret 65535)
          (ret 0))
        ;; String generated w/ tcpdump -ddd 'src localhost'
        (bpf-bytecode->exprs
         (with-input-from-string
             (string-join
              `("10"
                "40 0 0 12"
                "21 0 2 2048"
                "32 0 0 26"
                "21 4 5 2130706433"
                "21 1 0 2054"
                "21 0 3 32821"
                "32 0 0 28"
                "21 0 1 2130706433"
                "6 0 0 65535"
                "6 0 0 0")
              "\n" 'suffix)
           read-decimal-bpf-bytecode)))
  (test "unoptimised connection creation/teardown dump"
        `((ldh  (pkt 12))
          (jeq  #x0800 0 37)
          (ldh  (pkt 12))
          (jeq  #x86dd 0 2)
          (ldb  (pkt 20))
          (jeq  #x06 4 0)
          (ldh  (pkt 12))
          (jeq  #x0800 0 31)
          (ldb  (pkt 23))
          (jeq  #x06 0 29)
          (ldh  (pkt 20))
          (jset #x1fff 27 0)
          (ld   #x0d)
          (st   (mem 0))
          (ldxb (pkt 4* 14))
          (ld   (mem 0))
          (add  x)
          (tax)
          (ldb  (pkt x 14))
          (st   (mem 1))
          (ld   #x02)
          (st   (mem 2))
          (ld   #x01)
          (st   (mem 3))
          (ldx  (mem 3))
          (ld   (mem 2))
          (or   x)
          (st   (mem 3))
          (ldx  (mem 3))
          (ld   (mem 1))
          (and  x)
          (st   (mem 3))
          (ld   #x00)
          (st   (mem 4))
          (ldx  (mem 4))
          (ld   (mem 3))
          (sub  x)
          (jeq  #x00 1 0)
          (ret  65535)
          (ret  0))
        ;; tcpdump -Oddd 'tcp[tcpflags] & (tcp-syn|tcp-fin) != 0'
        (bpf-bytecode->exprs
         (with-input-from-string
             (string-join
              `("40"
                "40 0 0 12"
                "21 0 37 2048"
                "40 0 0 12"
                "21 0 2 34525"
                "48 0 0 20"
                "21 4 0 6"
                "40 0 0 12"
                "21 0 31 2048"
                "48 0 0 23"
                "21 0 29 6"
                "40 0 0 20"
                "69 27 0 8191"
                "0 0 0 13"
                "2 0 0 0"
                "177 0 0 14"
                "96 0 0 0"
                "12 0 0 0"
                "7 0 0 0"
                "80 0 0 14"
                "2 0 0 1"
                "0 0 0 2"
                "2 0 0 2"
                "0 0 0 1"
                "2 0 0 3"
                "97 0 0 3"
                "96 0 0 2"
                "76 0 0 0"
                "2 0 0 3"
                "97 0 0 3"
                "96 0 0 1"
                "92 0 0 0"
                "2 0 0 3"
                "0 0 0 0"
                "2 0 0 4"
                "97 0 0 4"
                "96 0 0 3"
                "28 0 0 0"
                "21 1 0 0"
                "6 0 0 65535"
                "6 0 0 0")
              "\n" 'suffix)
           read-decimal-bpf-bytecode))))

(test-group "decimal bytecode writer"
  (test "src localhost"
        ;; String generated w/ tcpdump -ddd 'src localhost'
        (string-join
         `("10"
           "40 0 0 12"
           "21 0 2 2048"
           "32 0 0 26"
           "21 4 5 2130706433"
           "21 1 0 2054"
           "21 0 3 32821"
           "32 0 0 28"
           "21 0 1 2130706433"
           "6 0 0 65535"
           "6 0 0 0")
         "\n" 'suffix)
        (with-output-to-string
          (lambda ()
            (write-decimal-bpf-bytecode
             (exprs->bpf-bytecode
              `((ldh (pkt 12))
                (jeq #x0800 0 2)
                (ld  (pkt 26))
                (jeq #x7f000001 4 5)
                (jeq #x0806 1 0)
                (jeq #x8035 0 3)
                (ld  (pkt 28))
                (jeq #x7f000001 0 1)
                (ret 65535)
                (ret 0)))))))

  (test "unoptimised connection creation/teardown dump"
        (string-join
         `("40"
           "40 0 0 12"
           "21 0 37 2048"
           "40 0 0 12"
           "21 0 2 34525"
           "48 0 0 20"
           "21 4 0 6"
           "40 0 0 12"
           "21 0 31 2048"
           "48 0 0 23"
           "21 0 29 6"
           "40 0 0 20"
           "69 27 0 8191"
           "0 0 0 13"
           "2 0 0 0"
           "177 0 0 14"
           "96 0 0 0"
           "12 0 0 0"
           "7 0 0 0"
           "80 0 0 14"
           "2 0 0 1"
           "0 0 0 2"
           "2 0 0 2"
           "0 0 0 1"
           "2 0 0 3"
           "97 0 0 3"
           "96 0 0 2"
           "76 0 0 0"
           "2 0 0 3"
           "97 0 0 3"
           "96 0 0 1"
           "92 0 0 0"
           "2 0 0 3"
           "0 0 0 0"
           "2 0 0 4"
           "97 0 0 4"
           "96 0 0 3"
           "28 0 0 0"
           "21 1 0 0"
           "6 0 0 65535"
           "6 0 0 0")
         "\n" 'suffix)
        ;; tcpdump -Oddd 'tcp[tcpflags] & (tcp-syn|tcp-fin) != 0'
        (with-output-to-string
          (lambda ()
            (write-decimal-bpf-bytecode
             (exprs->bpf-bytecode
              `((ldh  (pkt 12))
                (jeq  #x0800 0 37)
                (ldh  (pkt 12))
                (jeq  #x86dd 0 2)
                (ldb  (pkt 20))
                (jeq  #x06 4 0)
                (ldh  (pkt 12))
                (jeq  #x0800 0 31)
                (ldb  (pkt 23))
                (jeq  #x06 0 29)
                (ldh  (pkt 20))
                (jset #x1fff 27 0)
                (ld   #x0d)
                (st   (mem 0))
                (ldxb (pkt 4* 14))
                (ld   (mem 0))
                (add  x)
                (tax)
                (ldb  (pkt x 14))
                (st   (mem 1))
                (ld   #x02)
                (st   (mem 2))
                (ld   #x01)
                (st   (mem 3))
                (ldx  (mem 3))
                (ld   (mem 2))
                (or   x)
                (st   (mem 3))
                (ldx  (mem 3))
                (ld   (mem 1))
                (and  x)
                (st   (mem 3))
                (ld   #x00)
                (st   (mem 4))
                (ldx  (mem 4))
                (ld   (mem 3))
                (sub  x)
                (jeq  #x00 1 0)
                (ret  65535)
                (ret  0))))))))

(test-end "BPF assembler")

(test-exit)