summaryrefslogtreecommitdiff
path: root/tests/run.scm
blob: b0e8e463a9aab65695fcd7f6d458f79b5ae0b5aa (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
(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)) (ldx (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)))

              ("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)
           (lambda () (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-end "BPF assembler")

(test-exit)