Source file ipv4_packet.ml
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
176
177
178
179
180
type t = {
src : Ipaddr.V4.t;
dst : Ipaddr.V4.t;
id : Cstruct.uint16;
off : Cstruct.uint16;
ttl : Cstruct.uint8;
proto : Cstruct.uint8;
options : Cstruct.t;
}
type protocol = [
| `ICMP
| `TCP
| `UDP ]
let pp fmt t =
Format.fprintf fmt "IPv4 packet %a -> %a: id %04x, off %d proto %d, ttl %d, options %a"
Ipaddr.V4.pp t.src Ipaddr.V4.pp t.dst t.id t.off t.proto t.ttl Cstruct.hexdump_pp t.options
let equal {src; dst; id; off; ttl; proto; options} q =
src = q.src &&
dst = q.dst &&
id = q.id &&
off = q.off &&
ttl = q.ttl &&
proto = q.proto &&
Cstruct.equal options q.options
module Marshal = struct
open Ipv4_wire
type error = string
let protocol_to_int = function
| `ICMP -> 1
| `TCP -> 6
| `UDP -> 17
let ~src ~dst ~proto len =
let proto = protocol_to_int proto in
let ph = Cstruct.create 12 in
let numify = Ipaddr.V4.to_int32 in
Cstruct.BE.set_uint32 ph 0 (numify src);
Cstruct.BE.set_uint32 ph 4 (numify dst);
Cstruct.set_uint8 ph 8 0;
Cstruct.set_uint8 ph 9 proto;
Cstruct.BE.set_uint16 ph 10 len;
ph
let unsafe_fill ~payload_len t buf =
let nearest_4 n = match n mod 4 with
| 0 -> n
| k -> (4 - k) + n
in
let options_len = nearest_4 @@ Cstruct.length t.options in
set_ipv4_hlen_version buf ((4 lsl 4) + 5 + (options_len / 4));
set_ipv4_id buf t.id;
set_ipv4_off buf t.off;
set_ipv4_ttl buf t.ttl;
set_ipv4_proto buf t.proto;
set_ipv4_src buf (Ipaddr.V4.to_int32 t.src);
set_ipv4_dst buf (Ipaddr.V4.to_int32 t.dst);
Cstruct.blit t.options 0 buf sizeof_ipv4 (Cstruct.length t.options);
set_ipv4_len buf (sizeof_ipv4 + options_len + payload_len);
let checksum = Tcpip_checksum.ones_complement @@ Cstruct.sub buf 0 (20 + options_len) in
set_ipv4_csum buf checksum
let into_cstruct ~payload_len t buf =
if Cstruct.length buf < (sizeof_ipv4 + Cstruct.length t.options) then
Error "Not enough space for IPv4 header"
else
Ok (unsafe_fill ~payload_len t buf)
let make_cstruct ~payload_len t =
let nearest_4 n = match n mod 4 with
| 0 -> n
| k -> (4 - k) + n
in
let options_len = nearest_4 @@ Cstruct.length t.options in
let buf = Cstruct.create (sizeof_ipv4 + options_len) in
Cstruct.memset buf 0x00;
unsafe_fill ~payload_len t buf;
buf
end
module Unmarshal = struct
type error = string
let int_to_protocol = function
| 1 -> Some `ICMP
| 6 -> Some `TCP
| 17 -> Some `UDP
| _ -> None
let ( let* ) = Result.bind
let buf =
let open Ipv4_wire in
let check_version buf =
let version n = (n land 0xf0) in
match get_ipv4_hlen_version buf |> version with
| 0x40 -> Ok ()
| n -> Error (Printf.sprintf "IPv4 presented with a packet that claims a different IP version: %x" n)
in
let size_check buf =
if (Cstruct.length buf < sizeof_ipv4) then Error "buffer sent to IPv4 parser had size < 20"
else Ok ()
in
let buf =
let length_of_hlen_version n = (n land 0x0f) * 4 in
let hlen = get_ipv4_hlen_version buf |> length_of_hlen_version in
if (get_ipv4_len buf) < sizeof_ipv4 then
Error (Printf.sprintf
"total length %d is smaller than minimum header length"
(get_ipv4_len buf))
else if get_ipv4_len buf < hlen then
Error (Printf.sprintf
"total length %d is smaller than stated header length %d"
(get_ipv4_len buf) hlen)
else if hlen < sizeof_ipv4 then
Error (Printf.sprintf "IPv4 header claimed to have size < 20: %d" hlen)
else if Cstruct.length buf < hlen then
Error (Printf.sprintf "IPv4 packet w/length %d claimed to have header of size %d" (Cstruct.length buf) hlen)
else Ok hlen
in
let parse buf options_end =
let src = Ipaddr.V4.of_int32 (get_ipv4_src buf) in
let dst = Ipaddr.V4.of_int32 (get_ipv4_dst buf) in
let id = get_ipv4_id buf in
let off = get_ipv4_off buf in
let ttl = get_ipv4_ttl buf in
let proto = get_ipv4_proto buf in
let options =
if options_end > sizeof_ipv4 then (Cstruct.sub buf sizeof_ipv4 (options_end - sizeof_ipv4))
else (Cstruct.create 0)
in
Ok ({src; dst; id; off; ttl; proto; options;}, options_end)
in
let* () = size_check buf in
let* () = check_version buf in
let* hl = get_header_length buf in
parse buf hl
let of_cstruct buf =
let open Ipv4_wire in
let parse buf options_end =
let payload_len = (get_ipv4_len buf) - options_end in
let payload_available = Cstruct.length buf - options_end in
if payload_available < payload_len then (
Error (Printf.sprintf "Payload buffer (%d bytes) too small to contain payload (of size %d from header)" payload_available payload_len)
) else (
let payload = Cstruct.sub buf options_end payload_len in
Ok payload
)
in
let* , options_end = header_of_cstruct buf in
let* payload = parse buf options_end in
Ok (header, payload)
let verify_transport_checksum ~proto ~ ~transport_packet =
let check ~proto len =
try
let ph = Marshal.pseudoheader ~src:ipv4_header.src ~dst:ipv4_header.dst ~proto len in
let calculated_checksum = Tcpip_checksum.ones_complement_list [ph ; transport_packet] in
0 = compare 0x0000 calculated_checksum
with
| Invalid_argument _ -> false
in
match proto with
| `TCP ->
check ipv4_header ~proto (Cstruct.length transport_packet)
| `UDP ->
match Udp_wire.get_udp_checksum transport_packet with
| n when (=) 0 @@ compare n 0x0000 -> true
| _ ->
check ipv4_header ~proto (Cstruct.length transport_packet)
end