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
let mac_of_multicast ip =
let ipb = Ipaddr.V4.to_octets ip in
let macb = Bytes.create 6 in
Bytes.set macb 0 (Char.chr 0x01);
Bytes.set macb 1 (Char.chr 0x00);
Bytes.set macb 2 (Char.chr 0x5E);
Bytes.set macb 3 (Char.chr ((Char.code ipb.[1]) land 0x7F));
Bytes.set macb 4 (String.get ipb 2);
Bytes.set macb 5 (String.get ipb 3);
Macaddr.of_octets_exn (Bytes.to_string macb)
type routing_error = [ `Local | `Gateway ]
module Make(Log : Logs.LOG) (A : Arp.S) = struct
open Lwt.Infix
let destination_mac network gateway arp = function
|ip when Ipaddr.V4.(compare ip broadcast) = 0
|| Ipaddr.V4.(compare ip any) = 0
|| Ipaddr.V4.(compare (Prefix.broadcast network) ip) = 0 ->
Lwt.return @@ Ok Macaddr.broadcast
|ip when Ipaddr.V4.is_multicast ip ->
Lwt.return @@ Ok (mac_of_multicast ip)
|ip when Ipaddr.V4.Prefix.mem ip network ->
A.query arp ip >|= begin function
| Ok mac -> Ok mac
| Error `Timeout ->
Log.info (fun f ->
f "IP.output: could not determine link-layer address for local \
network (%a) ip %a" Ipaddr.V4.Prefix.pp network
Ipaddr.V4.pp ip);
Error `Local
| Error e ->
Log.info (fun f -> f "IP.output: %a" A.pp_error e);
Error `Local
end
|ip ->
match gateway with
| None ->
Log.info (fun f ->
f "IP.output: no route to %a (no default gateway is configured)"
Ipaddr.V4.pp ip);
Lwt.return (Error `Gateway)
| Some gateway ->
A.query arp gateway >|= function
| Ok mac -> Ok mac
| Error `Timeout ->
Log.info (fun f ->
f "IP.output: could not send to %a: failed to contact gateway %a"
Ipaddr.V4.pp ip Ipaddr.V4.pp gateway);
Error `Gateway
| Error e ->
Log.info (fun f -> f "IP.output: %a" A.pp_error e);
Error `Gateway
end