Source file mirage_protocols.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
module Ethernet = struct
type error = [ `Exceeds_mtu ]
let pp_error ppf = function
| `Exceeds_mtu -> Fmt.string ppf "exceeds MTU"
type proto = [ `ARP | `IPv4 | `IPv6 ]
let pp_proto ppf = function
| `ARP -> Fmt.string ppf "ARP"
| `IPv4 -> Fmt.string ppf "IPv4"
| `IPv6 -> Fmt.string ppf "IPv6"
end
module Ip = struct
type error = [
| `No_route of string (** can't send a message to that destination *)
| `Would_fragment
]
let pp_error ppf = function
| `No_route s -> Fmt.pf ppf "no route to destination: %s" s
| `Would_fragment -> Fmt.string ppf "would fragment"
type proto = [ `TCP | `UDP | `ICMP ]
let pp_proto ppf = function
| `TCP -> Fmt.string ppf "TCP"
| `UDP -> Fmt.string ppf "UDP"
| `ICMP -> Fmt.string ppf "ICMP"
end
module Arp = struct
type error = [
| `Timeout (** Failed to establish a mapping between an IP and a link-level address *)
]
let pp_error ppf = function
| `Timeout -> Fmt.pf ppf "could not determine a link-level address for the IP address given"
end
module Tcp = struct
type error = [ `Timeout | `Refused]
type write_error = [ error | Mirage_flow.write_error]
let pp_error ppf = function
| `Timeout -> Fmt.string ppf "connection attempt timed out"
| `Refused -> Fmt.string ppf "connection attempt was refused"
let pp_write_error ppf = function
| #Mirage_flow.write_error as e -> Mirage_flow.pp_write_error ppf e
| #error as e -> pp_error ppf e
end
module type ETHERNET = sig
type error = private [> Ethernet.error]
val pp_error: error Fmt.t
type t
val disconnect : t -> unit Lwt.t
val write: t -> ?src:Macaddr.t -> Macaddr.t -> Ethernet.proto -> ?size:int ->
(Cstruct.t -> int) -> (unit, error) result Lwt.t
val mac: t -> Macaddr.t
val mtu: t -> int
val input:
arpv4:(Cstruct.t -> unit Lwt.t) ->
ipv4:(Cstruct.t -> unit Lwt.t) ->
ipv6:(Cstruct.t -> unit Lwt.t) ->
t -> Cstruct.t -> unit Lwt.t
end
module type ARP = sig
type t
val disconnect : t -> unit Lwt.t
type error = private [> Arp.error]
val pp_error: error Fmt.t
val pp : t Fmt.t
val get_ips : t -> Ipaddr.V4.t list
val set_ips : t -> Ipaddr.V4.t list -> unit Lwt.t
val remove_ip : t -> Ipaddr.V4.t -> unit Lwt.t
val add_ip : t -> Ipaddr.V4.t -> unit Lwt.t
val query : t -> Ipaddr.V4.t -> (Macaddr.t, error) result Lwt.t
val input : t -> Cstruct.t -> unit Lwt.t
end
module type IP = sig
type error = private [> Ip.error]
val pp_error: error Fmt.t
type ipaddr
val pp_ipaddr : ipaddr Fmt.t
type t
val disconnect : t -> unit Lwt.t
type callback = src:ipaddr -> dst:ipaddr -> Cstruct.t -> unit Lwt.t
val input:
t ->
tcp:callback -> udp:callback -> default:(proto:int -> callback) ->
Cstruct.t -> unit Lwt.t
val write: t -> ?fragment:bool -> ?ttl:int ->
?src:ipaddr -> ipaddr -> Ip.proto -> ?size:int -> (Cstruct.t -> int) ->
Cstruct.t list -> (unit, error) result Lwt.t
val src: t -> dst:ipaddr -> ipaddr
val get_ip: t -> ipaddr list
val mtu: t -> dst:ipaddr -> int
end
module type IPV4 = IP with type ipaddr = Ipaddr.V4.t
module type IPV6 = IP with type ipaddr = Ipaddr.V6.t
module type ICMP = sig
type t
val disconnect : t -> unit Lwt.t
type ipaddr
type error
val pp_error: error Fmt.t
val input : t -> src:ipaddr -> dst:ipaddr -> Cstruct.t -> unit Lwt.t
val write : t -> ?src:ipaddr -> dst:ipaddr -> ?ttl:int -> Cstruct.t -> (unit, error) result Lwt.t
end
module type ICMPV4 = ICMP with type ipaddr = Ipaddr.V4.t
module type ICMPV6 = ICMP with type ipaddr = Ipaddr.V6.t
module type UDP = sig
type error
val pp_error: error Fmt.t
type ipaddr
type t
val disconnect : t -> unit Lwt.t
type callback = src:ipaddr -> dst:ipaddr -> src_port:int -> Cstruct.t -> unit Lwt.t
val listen : t -> port:int -> callback -> unit
val unlisten : t -> port:int -> unit
val input: t -> src:ipaddr -> dst:ipaddr -> Cstruct.t -> unit Lwt.t
val write: ?src:ipaddr -> ?src_port:int -> ?ttl:int -> dst:ipaddr -> dst_port:int -> t -> Cstruct.t ->
(unit, error) result Lwt.t
end
module type UDPV4 = UDP with type ipaddr = Ipaddr.V4.t
module type UDPV6 = UDP with type ipaddr = Ipaddr.V6.t
module Keepalive = struct
type t = {
after: Duration.t;
interval: Duration.t;
probes: int;
}
end
module type TCP = sig
type error = private [> Tcp.error]
type write_error = private [> Tcp.write_error]
type ipaddr
type flow
type t
val disconnect : t -> unit Lwt.t
include Mirage_flow.S with
type flow := flow
and type error := error
and type write_error := write_error
val dst: flow -> ipaddr * int
val write_nodelay: flow -> Cstruct.t -> (unit, write_error) result Lwt.t
val writev_nodelay: flow -> Cstruct.t list -> (unit, write_error) result Lwt.t
val create_connection: ?keepalive:Keepalive.t -> t -> ipaddr * int -> (flow, error) result Lwt.t
val listen : t -> port:int -> ?keepalive:Keepalive.t -> (flow -> unit Lwt.t) -> unit
val unlisten : t -> port:int -> unit
val input: t -> src:ipaddr -> dst:ipaddr -> Cstruct.t -> unit Lwt.t
end
module type TCPV4 = TCP with type ipaddr = Ipaddr.V4.t
module type TCPV6 = TCP with type ipaddr = Ipaddr.V6.t