forked from mirage/mirage
-
Notifications
You must be signed in to change notification settings - Fork 0
/
nettypes.ml
172 lines (136 loc) · 4.72 KB
/
nettypes.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
(*
* Copyright (c) 2010 Anil Madhavapeddy <anil@recoil.org>
*
* Permission to use, copy, modify, and distribute this software for any
* purpose with or without fee is hereby granted, provided that the above
* copyright notice and this permission notice appear in all copies.
*
* THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
* WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
* ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
*)
type bytes = string (* to differentiate from pretty-printed strings *)
type ethernet_mac = string (* length 6 only *)
(* Raw MAC address off the wire (network endian) *)
let ethernet_mac_of_bytes x =
assert(String.length x = 6);
x
(* Read a MAC address colon-separated string *)
let ethernet_mac_of_string x =
try
let s = String.create 6 in
Scanf.sscanf x "%2x:%2x:%2x:%2x:%2x:%2x"
(fun a b c d e f ->
s.[0] <- Char.chr a;
s.[1] <- Char.chr b;
s.[2] <- Char.chr c;
s.[3] <- Char.chr d;
s.[4] <- Char.chr e;
s.[5] <- Char.chr f;
);
Some s
with _ -> None
let ethernet_mac_to_string x =
let chri i = Char.code x.[i] in
Printf.sprintf "%02x:%02x:%02x:%02x:%02x:%02x"
(chri 0) (chri 1) (chri 2) (chri 3) (chri 4) (chri 5)
let ethernet_mac_to_bytes x = x
let ethernet_mac_broadcast = String.make 6 '\255'
type ipv4_addr = int32
let ipv4_addr_of_tuple (a,b,c,d) =
let (+) = Int32.add in
(Int32.shift_left a 24) +
(Int32.shift_left b 16) +
(Int32.shift_left c 8) + d
(* Read an IPv4 address dot-separated string *)
let ipv4_addr_of_string x =
let ip = ref None in
(try Scanf.sscanf x "%ld.%ld.%ld.%ld"
(fun a b c d -> ip := Some (ipv4_addr_of_tuple (a,b,c,d)));
with _ -> ());
!ip
(* Blank 0.0.0.0 IPv4 address *)
let ipv4_blank = 0l
(* Broadcast 255.255.255.255 IPv4 address *)
let ipv4_broadcast = ipv4_addr_of_tuple (255l,255l,255l,255l)
(* Localhost 127.0.0.1 ipv4 address *)
let ipv4_localhost = ipv4_addr_of_tuple (127l,0l,0l,1l)
let ipv4_addr_to_string s =
let (>!) x y = Int32.to_int (Int32.logand (Int32.shift_right x y) 255l) in
Printf.sprintf "%d.%d.%d.%d" (s >! 24) (s >! 16) (s >! 8) (s >! 0)
external ipv4_addr_of_uint32: int32 -> ipv4_addr = "%identity"
external ipv4_addr_to_uint32: ipv4_addr -> int32 = "%identity"
type ipv4_src = ipv4_addr option * int
type ipv4_dst = ipv4_addr * int
type arp = {
op: [ `Request |`Reply |`Unknown of int ];
sha: ethernet_mac;
spa: ipv4_addr;
tha: ethernet_mac;
tpa: ipv4_addr;
}
type peer_uid = int
exception Closed
module type FLOW = sig
(* Type of an individual flow *)
type t
(* Type that manages a collection of flows *)
type mgr
(* Type that identifies a flow source and destination endpoint *)
type src
type dst
(* Read and write to a flow *)
val read: t -> Bitstring.t option Lwt.t
val write: t -> Bitstring.t -> unit Lwt.t
val writev: t -> Bitstring.t list -> Bitstring.t Lwt.t
val close: t -> unit Lwt.t
(* Flow construction *)
val listen: mgr -> src -> (dst -> t -> unit Lwt.t) -> unit Lwt.t
val connect: mgr -> ?src:src -> dst -> (t -> 'a Lwt.t) -> 'a Lwt.t
end
module type DATAGRAM = sig
(* Datagram manager *)
type mgr
(* Identify flow and destination endpoints *)
type src
type dst
(* Types of msg *)
type msg
(* Receive and send functions *)
val recv : mgr -> src -> (dst -> msg -> unit Lwt.t) -> unit Lwt.t
val send : mgr -> ?src:src -> dst -> msg -> unit Lwt.t
end
module type CHANNEL = sig
type mgr
type t
type src
type dst
val read_char: t -> char Lwt.t
val read_until: t -> char -> (bool * Bitstring.t) Lwt.t
val read_some: ?len:int -> t -> Bitstring.t Lwt.t
val read_stream: ?len:int -> t -> Bitstring.t Lwt_stream.t
val read_crlf: t -> Bitstring.t Lwt.t
val write_char : t -> char -> unit Lwt.t
val write_string : t -> string -> unit Lwt.t
val write_bitstring : t -> Bitstring.t -> unit Lwt.t
val write_line : t -> string -> unit Lwt.t
val flush : t -> unit Lwt.t
val close : t -> unit Lwt.t
val listen : mgr -> src -> (dst -> t -> unit Lwt.t) -> unit Lwt.t
val connect : mgr -> ?src:src -> dst -> (t -> 'a Lwt.t) -> 'a Lwt.t
end
module type RPC = sig
type tx
type rx
type 'a req
type 'a res
type mgr
type src
type dst
val request : mgr -> ?src:src -> dst -> tx req -> rx res Lwt.t
val respond : mgr -> src -> (dst -> rx req -> tx res Lwt.t) -> unit Lwt.t
end