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_hlen_version buf ((4 lsl 4) + 5 + (options_len / 4));
set_id buf t.id;
set_off buf t.off;
set_ttl buf t.ttl;
set_proto buf t.proto;
set_src buf t.src;
set_dst buf t.dst;
Cstruct.blit t.options 0 buf sizeof_ipv4 (Cstruct.length t.options);
set_len buf (sizeof_ipv4 + options_len + payload_len);
let checksum = Tcpip_checksum.ones_complement @@ Cstruct.sub buf 0 (20 + options_len) in
set_checksum 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_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_hlen_version buf |> length_of_hlen_version in
let len = get_len buf in
if len < sizeof_ipv4 then
Error (Printf.sprintf
"total length %d is smaller than minimum header length" len)
else if len < hlen then
Error (Printf.sprintf
"total length %d is smaller than stated header length %d"
len 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 = get_src buf
and dst = get_dst buf
and id = get_id buf
and off = get_off buf
and ttl = get_ttl buf
and proto = get_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 parse buf options_end =
let payload_len = Ipv4_wire.get_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_checksum transport_packet with
| n when (=) 0 @@ compare n 0x0000 -> true
| _ ->
check ipv4_header ~proto (Cstruct.length transport_packet)
end