forked from mirage/qubes-mirage-firewall
-
Notifications
You must be signed in to change notification settings - Fork 1
/
fw_utils.ml
48 lines (38 loc) · 1.18 KB
/
fw_utils.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
(* Copyright (C) 2015, Thomas Leonard <thomas.leonard@unikernel.com>
See the README file for details. *)
(** General utility functions. *)
module IpMap = struct
include Map.Make(Ipaddr.V4)
let find x map =
try Some (find x map)
with Not_found -> None
end
module Int = struct
type t = int
let compare (a:t) (b:t) = compare a b
end
module IntSet = Set.Make(Int)
module IntMap = Map.Make(Int)
(** An Ethernet interface. *)
class type interface = object
method my_mac : Macaddr.t
method writev : Ethif_wire.ethertype -> Cstruct.t list -> unit Lwt.t
method my_ip : Ipaddr.V4.t
method other_ip : Ipaddr.V4.t
end
(** An Ethernet interface connected to a clientVM. *)
class type client_link = object
inherit interface
method other_mac : Macaddr.t
end
(** An Ethernet header from [src]'s MAC address to [dst]'s with an IPv4 payload. *)
let eth_header ethertype ~src ~dst =
Ethif_packet.Marshal.make_cstruct { Ethif_packet.source = src; destination = dst; ethertype }
let error fmt =
let err s = Failure s in
Printf.ksprintf err fmt
let return = Lwt.return
let fail = Lwt.fail
let or_raise msg pp = function
| Ok x -> x
| Error e -> failwith (Fmt.strf "%s: %a" msg pp e)