Commit a03d5e8535a3eb0665eebcb258a5d98f0726d002 - ocaml-ipaddr

New upstream version 5.0.1 Stephane Glondu 3 years ago

34 changed file(s) with 2051 addition(s) and 1967 deletion(s). Raw diff Collapse all Expand all

-4

~~.gitignore~~ less more

0		_build
1		*.install
2		*/.merlin
3		.*.swp

-18

~~.travis.yml~~ less more

0		language: c
1		sudo: false
2		services:
3		- docker
4		install: wget https://raw.githubusercontent.com/ocaml/ocaml-travisci-skeleton/master/.travis-docker.sh
5		script: bash ./.travis-docker.sh
6		env:
7		global:
8		- PACKAGE="ipaddr"
9		- PINS="ipaddr:. macaddr:. ipaddr-sexp:. macaddr-sexp:. ipaddr-cstruct:. macaddr-cstruct:."
10		matrix:
11		- DISTRO=debian-stable OCAML_VERSION=4.04
12		- DISTRO=ubuntu OCAML_VERSION=4.05
13		- DISTRO=alpine OCAML_VERSION=4.06
14		- DISTRO=fedora OCAML_VERSION=4.07
15		- DISTRO=alpine OCAML_VERSION=4.08
16		- DISTRO=alpine OCAML_VERSION=4.09
17		- DISTRO=alpine OCAML_VERSION=4.10

-1

CHANGES.md less more

0		## v5.0.0
	0	## v5.0.1 (2020-09-30)
	1
	2	* Fix V4.Prefix.broadcast and last with /32 prefixes (#102 @verbosemode)
	3
	4	## v5.0.0 (2020-06-16)
1	5
2	6	* Do not zero out the non-prefix-length part of the address in
3	7	`{V4,V6}.Prefix.t` (#99 @hannesm)

+14

-0

README.md less more

41	41	- `ipaddr-sexp`: S-expression converters for Ipaddr.
42	42	- `macaddr-sexp`: S-expression converters for Macaddr.
43	43
	44	## Installation and development
	45
	46	The packages are released to the opam-repository. An `opam install ipaddr`
	47	(or any other above mentioned package) will install it. If you want to install
	48	the latest development commit, `opam pin add ipaddr --dev` will do this.
	49
	50	A local build, after a `git clone` can be done with `dune build`, a
	51	`dune runtest` compiles and executes the testsuite. If dependencies are missing,
	52	`opam install (-t) --deps-only .` in the cloned directory will install them.
	53
	54	The auto-formatter [`ocamlformat`](https://github.com/ocaml-ppx/ocamlformat) is
	55	used, please execute `dune build @fmt --auto-promote` before submitting a pull
	56	request.
	57
44	58	## Contact
45	59
46	60	- Issues: <https://github.com/mirage/ocaml-ipaddr/issues>

-0

dune-project less more

0	0	(lang dune 1.9)
1	1	(name ipaddr)
	2	(version v5.0.1)
2	3	(allow_approximate_merlin)
	4	(using fmt 1.1)

-3

ipaddr-cstruct.opam less more

	0	version: "5.0.1"
0	1	opam-version: "2.0"
1	2	maintainer: "anil@recoil.org"
2	3	authors: ["David Sheets" "Anil Madhavapeddy" "Hugo Heuzard"]

8	9	bug-reports: "https://github.com/mirage/ocaml-ipaddr/issues"
9	10	depends: [
10	11	"ocaml" {>= "4.04.0"}
11		"dune"
12		"ipaddr" {=version}
	12	"dune" {>= "1.9.0"}
	13	"ipaddr" {= version}
13	14	"cstruct"
14	15	]
15	16	build: [

20	21	dev-repo: "git+https://github.com/mirage/ocaml-ipaddr.git"
21	22	description: """
22	23	Cstruct convertions for macaddr
23		"""
	24	"""⏎

-4

ipaddr-sexp.opam less more

	0	version: "5.0.1"
0	1	opam-version: "2.0"
1	2	maintainer: "anil@recoil.org"
2	3	authors: ["David Sheets" "Anil Madhavapeddy" "Hugo Heuzard"]

12	13	bug-reports: "https://github.com/mirage/ocaml-ipaddr/issues"
13	14	depends: [
14	15	"ocaml" {>= "4.04.0"}
15		"dune"
16		"ipaddr"
17		"ipaddr-cstruct" {with-test}
	16	"dune" {>= "1.9.0"}
	17	"ipaddr" {= version}
	18	"ipaddr-cstruct" {with-test & = version}
18	19	"ounit" {with-test}
19	20	"ppx_sexp_conv" {>= "v0.9.0"}
20	21	]

23	24	["dune" "build" "-p" name "-j" jobs]
24	25	["dune" "runtest" "-p" name "-j" jobs] {with-test}
25	26	]
26		dev-repo: "git+https://github.com/mirage/ocaml-ipaddr.git"
	27	dev-repo: "git+https://github.com/mirage/ocaml-ipaddr.git"⏎

-3

ipaddr.opam less more

	0	version: "5.0.1"
0	1	opam-version: "2.0"
1	2	maintainer: "anil@recoil.org"
2	3	authors: ["David Sheets" "Anil Madhavapeddy" "Hugo Heuzard"]

27	28	bug-reports: "https://github.com/mirage/ocaml-ipaddr/issues"
28	29	depends: [
29	30	"ocaml" {>= "4.04.0"}
30		"dune"
31		"macaddr" {=version}
	31	"dune" {>= "1.9.0"}
	32	"macaddr" {= version}
32	33	"stdlib-shims"
33	34	"domain-name" {>= "0.3.0"}
34	35	"ounit" {with-test}

39	40	["dune" "build" "-p" name "-j" jobs]
40	41	["dune" "runtest" "-p" name "-j" jobs] {with-test}
41	42	]
42		dev-repo: "git+https://github.com/mirage/ocaml-ipaddr.git"
	43	dev-repo: "git+https://github.com/mirage/ocaml-ipaddr.git"⏎

+13

-11

lib/dune less more

0	0	(library
1		(name ipaddr)
	1	(name ipaddr)
2	2	(public_name ipaddr)
3	3	(modules ipaddr)
4	4	(libraries macaddr domain-name stdlib-shims))
5	5
6	6	(library
7		(name macaddr)
	7	(name macaddr)
8	8	(public_name macaddr)
9	9	(modules macaddr))
10	10
11	11	(library
12		(name ipaddr_sexp)
	12	(name ipaddr_sexp)
13	13	(public_name ipaddr-sexp)
14	14	(modules ipaddr_sexp)
15		(preprocess (pps ppx_sexp_conv))
	15	(preprocess
	16	(pps ppx_sexp_conv))
16	17	(libraries ipaddr sexplib0))
17	18
18	19	(library
19		(name macaddr_sexp)
	20	(name macaddr_sexp)
20	21	(public_name macaddr-sexp)
21	22	(modules macaddr_sexp)
22		(preprocess (pps ppx_sexp_conv))
	23	(preprocess
	24	(pps ppx_sexp_conv))
23	25	(libraries macaddr sexplib0))
24	26
25	27	(library
26		(name ipaddr_unix)
	28	(name ipaddr_unix)
27	29	(public_name ipaddr.unix)
28	30	(modules ipaddr_unix)
29	31	(libraries unix ipaddr))
30	32
31	33	(library
32		(name ipaddr_cstruct)
	34	(name ipaddr_cstruct)
33	35	(public_name ipaddr-cstruct)
34	36	(modules ipaddr_cstruct)
35	37	(libraries ipaddr cstruct))
36	38
37	39	(library
38		(name macaddr_cstruct)
	40	(name macaddr_cstruct)
39	41	(public_name macaddr-cstruct)
40	42	(modules macaddr_cstruct)
41	43	(libraries macaddr cstruct))
42	44
43	45	(library
44		(name ipaddr_top)
	46	(name ipaddr_top)
45	47	(public_name ipaddr.top)
46	48	(modules ipaddr_top)
47	49	(libraries macaddr.top ipaddr compiler-libs))
48	50
49	51	(library
50		(name macaddr_top)
	52	(name macaddr_top)
51	53	(public_name macaddr.top)
52	54	(modules macaddr_top)
53	55	(libraries macaddr compiler-libs))

+559

-564

lib/ipaddr.ml less more

16	16
17	17	exception Parse_error of string * string
18	18
19		type scope =
20		\| Point
21		\| Interface
22		\| Link
23		\| Admin
24		\| Site
25		\| Organization
26		\| Global
	19	type scope = Point \| Interface \| Link \| Admin \| Site \| Organization \| Global
27	20
28	21	let try_with_result fn a =
29		try Ok (fn a)
30		with Parse_error (msg, _) -> Error (`Msg ("Ipaddr: " ^ msg))
31
32		let failwith_msg = function
33		\| Ok x -> x
34		\| Error (`Msg m) -> failwith m
	22	try Ok (fn a) with Parse_error (msg, _) -> Error (`Msg ("Ipaddr: " ^ msg))
	23
	24	let failwith_msg = function Ok x -> x \| Error (`Msg m) -> failwith m
35	25
36	26	let map_result v f = match v with Ok v -> Ok (f v) \| Error _ as e -> e
37	27
38	28	let string_of_scope = function
39		\| Point -> "point"
40		\| Interface -> "interface"
41		\| Link -> "link"
42		\| Admin -> "admin"
43		\| Site -> "site"
44		\| Organization -> "organization"
45		\| Global -> "global"
	29	\| Point -> "point"
	30	\| Interface -> "interface"
	31	\| Link -> "link"
	32	\| Admin -> "admin"
	33	\| Site -> "site"
	34	\| Organization -> "organization"
	35	\| Global -> "global"
46	36
47	37	let scope_of_string = function
48		\| "point" -> Ok Point
49		\| "interface" -> Ok Interface
50		\| "link" -> Ok Link
51		\| "admin" -> Ok Admin
52		\| "site" -> Ok Site
53		\| "organization" -> Ok Organization
54		\| "global" -> Ok Global
55		\| s -> Error (`Msg ("unknown scope: " ^ s))
56
57		let pp_scope fmt s =
58		Format.pp_print_string fmt (string_of_scope s)
59
60		let (~\|) = Int32.of_int
61		let (\|~) = Int32.to_int
62		let (&&&) x y = Int32.logand x y
63		let (\|\|\|) x y = Int32.logor x y
64		let (<\|<) x y = Int32.shift_left x y
65		let (>\|>) x y = Int32.shift_right_logical x y
66		let (>!) x y = (x >\|> y) &&& 0xFF_l
67		let (<!) x y = (x &&& 0xFF_l) <\|< y
	38	\| "point" -> Ok Point
	39	\| "interface" -> Ok Interface
	40	\| "link" -> Ok Link
	41	\| "admin" -> Ok Admin
	42	\| "site" -> Ok Site
	43	\| "organization" -> Ok Organization
	44	\| "global" -> Ok Global
	45	\| s -> Error (`Msg ("unknown scope: " ^ s))
	46
	47	let pp_scope fmt s = Format.pp_print_string fmt (string_of_scope s)
	48
	49	let ( ~\| ) = Int32.of_int
	50
	51	let ( \|~ ) = Int32.to_int
	52
	53	let ( &&& ) x y = Int32.logand x y
	54
	55	let ( \|\|\| ) x y = Int32.logor x y
	56
	57	let ( <\|< ) x y = Int32.shift_left x y
	58
	59	let ( >\|> ) x y = Int32.shift_right_logical x y
	60
	61	let ( >! ) x y = x >\|> y &&& 0xFF_l
	62
	63	let ( <! ) x y = x &&& 0xFF_l <\|< y
68	64
69	65	let need_more x = Parse_error ("not enough data", x)
70	66
71	67	let char_0 = int_of_char '0'
	68
72	69	let char_a = int_of_char 'a'
	70
73	71	let char_A = int_of_char 'A'
74	72
75		let int_of_char c = match c with
76		\| '0'..'9' -> Stdlib.int_of_char c - char_0
77		\| 'a'..'f' -> 10 + Stdlib.int_of_char c - char_a
78		\| 'A'..'F' -> 10 + Stdlib.int_of_char c - char_A
	73	let int_of_char c =
	74	match c with
	75	\| '0' .. '9' -> Stdlib.int_of_char c - char_0
	76	\| 'a' .. 'f' -> 10 + Stdlib.int_of_char c - char_a
	77	\| 'A' .. 'F' -> 10 + Stdlib.int_of_char c - char_A
79	78	\| _ -> -1
80	79
81	80	let bad_char i s =
82		let msg = Printf.sprintf "invalid character '%c' at %d" s.[i] i
83		in Parse_error (msg, s)
84
85		let is_number base n = n >=0 && n < base
	81	let msg = Printf.sprintf "invalid character '%c' at %d" s.[i] i in
	82	Parse_error (msg, s)
	83
	84	let is_number base n = n >= 0 && n < base
86	85
87	86	let parse_int base s i =
88	87	let len = String.length s in
89	88	let rec next prev =
90	89	let j = !i in
91	90	if j >= len then prev
92		else let c = s.[j] in
93		let k = int_of_char c in
94		if is_number base k
95		then (incr i; next (prev*base + k))
96		else prev
	91	else
	92	let c = s.[j] in
	93	let k = int_of_char c in
	94	if is_number base k then (
	95	incr i;
	96	next ((prev * base) + k))
	97	else prev
97	98	in
98	99	let i = !i in
99		if i < len
100		then if is_number base (int_of_char s.[i])
101		then next 0
102		else raise (bad_char i s)
	100	if i < len then
	101	if is_number base (int_of_char s.[i]) then next 0 else raise (bad_char i s)
103	102	else raise (need_more s)
104	103
105	104	let parse_dec_int s i = parse_int 10 s i
	105
106	106	let parse_hex_int s i = parse_int 16 s i
	107
107	108	let expect_char s i c =
108		if !i < String.length s
109		then if s.[!i] <> c then raise (bad_char !i s) else incr i
	109	if !i < String.length s then
	110	if s.[!i] <> c then raise (bad_char !i s) else incr i
110	111	else raise (need_more s)
111		let expect_end s i =
112		if String.length s <= !i
113		then ()
114		else raise (bad_char !i s)
	112
	113	let expect_end s i = if String.length s <= !i then () else raise (bad_char !i s)
115	114
116	115	let hex_char_of_int = function
117		\| 0 -> '0'
118		\| 1 -> '1'
119		\| 2 -> '2'
120		\| 3 -> '3'
121		\| 4 -> '4'
122		\| 5 -> '5'
123		\| 6 -> '6'
124		\| 7 -> '7'
125		\| 8 -> '8'
126		\| 9 -> '9'
	116	\| 0 -> '0'
	117	\| 1 -> '1'
	118	\| 2 -> '2'
	119	\| 3 -> '3'
	120	\| 4 -> '4'
	121	\| 5 -> '5'
	122	\| 6 -> '6'
	123	\| 7 -> '7'
	124	\| 8 -> '8'
	125	\| 9 -> '9'
127	126	\| 10 -> 'a'
128	127	\| 11 -> 'b'
129	128	\| 12 -> 'c'
130	129	\| 13 -> 'd'
131	130	\| 14 -> 'e'
132	131	\| 15 -> 'f'
133		\| _ -> raise (Invalid_argument "not a hex int")
	132	\| _ -> raise (Invalid_argument "not a hex int")
134	133
135	134	let hex_string_of_int32 i = String.make 1 (hex_char_of_int (Int32.to_int i))
136	135
137	136	module V4 = struct
138	137	type t = int32
139	138
140		let compare a b = (* ignore the sign *)
	139	let compare a b =
	140	(* ignore the sign *)
141	141	let c = Int32.compare (a >\|> 1) (b >\|> 1) in
142	142	if c = 0 then Int32.compare (a &&& 1l) (b &&& 1l) else c
143	143
144		let make a b c d =
145		((~\| a <! 24) \|\|\| (~\| b <! 16)) \|\|\| ((~\| c <! 8) \|\|\| (~\| d <! 0))
	144	let make a b c d = ~\|a <! 24 \|\|\| (~\|b <! 16) \|\|\| (~\|c <! 8 \|\|\| (~\|d <! 0))
146	145
147	146	(* parsing *)
148	147

155	154	expect_char s i '.';
156	155	let d = parse_dec_int s i in
157	156	let valid a = a land 0xff <> a in
158		if valid a
159		then raise (Parse_error ("first octet out of bounds", s))
160		else if valid b
161		then raise (Parse_error ("second octet out of bounds", s))
162		else if valid c
163		then raise (Parse_error ("third octet out of bounds", s))
164		else if valid d
165		then raise (Parse_error ("fourth octet out of bounds", s))
	157	if valid a then raise (Parse_error ("first octet out of bounds", s))
	158	else if valid b then raise (Parse_error ("second octet out of bounds", s))
	159	else if valid c then raise (Parse_error ("third octet out of bounds", s))
	160	else if valid d then raise (Parse_error ("fourth octet out of bounds", s))
166	161	else make a b c d
167	162
168	163	(* string conversion *)

185	180	to_buffer b i;
186	181	Buffer.contents b
187	182
188		let pp ppf i =
189		Format.fprintf ppf "%s" (to_string i)
	183	let pp ppf i = Format.fprintf ppf "%s" (to_string i)
190	184
191	185	(* Octets conversion *)
192	186
193		let of_octets_exn ?(off=0) bs =
	187	let of_octets_exn ?(off = 0) bs =
194	188	try
195	189	make
196		(Char.code bs.[0 + off])
197		(Char.code bs.[1 + off])
198		(Char.code bs.[2 + off])
199		(Char.code bs.[3 + off])
	190	(Char.code bs.[0 + off])
	191	(Char.code bs.[1 + off])
	192	(Char.code bs.[2 + off])
	193	(Char.code bs.[3 + off])
200	194	with _ -> raise (need_more bs)
201	195
202	196	let of_octets ?off bs = try_with_result (of_octets_exn ?off) bs
203	197
204		let write_octets_exn ?(off=0) i b =
	198	let write_octets_exn ?(off = 0) i b =
205	199	try
206		Bytes.set b (0 + off) (Char.chr ((\|~) (i >! 24)));
207		Bytes.set b (1 + off) (Char.chr ((\|~) (i >! 16)));
208		Bytes.set b (2 + off) (Char.chr ((\|~) (i >! 8)));
209		Bytes.set b (3 + off) (Char.chr ((\|~) (i >! 0)))
	200	Bytes.set b (0 + off) (Char.chr (( \|~ ) (i >! 24)));
	201	Bytes.set b (1 + off) (Char.chr (( \|~ ) (i >! 16)));
	202	Bytes.set b (2 + off) (Char.chr (( \|~ ) (i >! 8)));
	203	Bytes.set b (3 + off) (Char.chr (( \|~ ) (i >! 0)))
210	204	with _ -> raise (need_more (Bytes.to_string b))
211	205
212	206	let write_octets ?off i bs = try_with_result (write_octets_exn ?off i) bs
213	207
214	208	let to_octets i =
215	209	String.init 4 (function
216		\| 0 -> Char.chr ((\|~) (i >! 24))
217		\| 1 -> Char.chr ((\|~) (i >! 16))
218		\| 2 -> Char.chr ((\|~) (i >! 8))
219		\| 3 -> Char.chr ((\|~) (i >! 0))
	210	\| 0 -> Char.chr (( \|~ ) (i >! 24))
	211	\| 1 -> Char.chr (( \|~ ) (i >! 16))
	212	\| 2 -> Char.chr (( \|~ ) (i >! 8))
	213	\| 3 -> Char.chr (( \|~ ) (i >! 0))
220	214	\| _ -> assert false)
221	215
222	216	(* Int32 *)
223	217	let of_int32 i = i
	218
224	219	let to_int32 i = i
225	220
226	221	(* Int16 *)
227		let of_int16 (a,b) = (~\| a <\|< 16) \|\|\| (~\| b)
228		let to_int16 a = ((\|~) (a >\|> 16), (\|~) (a &&& 0xFF_FF_l))
	222	let of_int16 (a, b) = ~\|a <\|< 16 \|\|\| ~\|b
	223
	224	let to_int16 a = (( \|~ ) (a >\|> 16), ( \|~ ) (a &&& 0xFF_FF_l))
229	225
230	226	(* MAC *)
231	227	(* {{:http://tools.ietf.org/html/rfc1112#section-6.2}RFC 1112}. *)

234	230	Bytes.set macb 0 (Char.chr 0x01);
235	231	Bytes.set macb 1 (Char.chr 0x00);
236	232	Bytes.set macb 2 (Char.chr 0x5E);
237		Bytes.set macb 3 (Char.chr ((\|~) (i >\|> 16 &&& 0x7F_l)));
238		Bytes.set macb 4 (Char.chr ((\|~) (i >! 8)));
239		Bytes.set macb 5 (Char.chr ((\|~) (i >! 0)));
	233	Bytes.set macb 3 (Char.chr (( \|~ ) (i >\|> 16 &&& 0x7F_l)));
	234	Bytes.set macb 4 (Char.chr (( \|~ ) (i >! 8)));
	235	Bytes.set macb 5 (Char.chr (( \|~ ) (i >! 0)));
240	236	Macaddr.of_octets_exn (Bytes.to_string macb)
241	237
242	238	(* Host *)
243	239	let to_domain_name i =
244		let name = [
245		Int32.to_string (i >! 0);
246		Int32.to_string (i >! 8);
247		Int32.to_string (i >! 16);
248		Int32.to_string (i >! 24);
249		"in-addr";
250		"arpa" ]
	240	let name =
	241	[
	242	Int32.to_string (i >! 0);
	243	Int32.to_string (i >! 8);
	244	Int32.to_string (i >! 16);
	245	Int32.to_string (i >! 24);
	246	"in-addr";
	247	"arpa";
	248	]
251	249	in
252	250	Domain_name.(host_exn (of_strings_exn name))
253	251
254	252	let of_domain_name n =
255	253	match Domain_name.to_strings n with
256		\| [ a ; b ; c ; d ; in_addr ; arpa ] when
257		Domain_name.(equal_label arpa "arpa" && equal_label in_addr "in-addr") ->
258		begin
	254	\| [ a; b; c; d; in_addr; arpa ]
	255	when Domain_name.(
	256	equal_label arpa "arpa" && equal_label in_addr "in-addr") -> (
259	257	let conv bits data =
260	258	let i = Int32.of_int (parse_dec_int data (ref 0)) in
261	259	if i > 0xFFl then
262	260	raise (Parse_error ("label with a too big number", data))
263		else
264		i <! bits
	261	else i <! bits
265	262	in
266	263	try
267	264	let ( + ) = Int32.add in
268		Some ((conv 0 a) + (conv 8 b) + (conv 16 c) + (conv 24 d))
269		with
270		\| Parse_error _ -> None
271		end
	265	Some (conv 0 a + conv 8 b + conv 16 c + conv 24 d)
	266	with Parse_error _ -> None)
272	267	\| _ -> None
273	268
274	269	let succ t =
275	270	if Int32.equal t 0xFF_FF_FF_FFl then
276	271	Error (`Msg "Ipaddr: highest address has been reached")
277		else
278		Ok (Int32.succ t)
	272	else Ok (Int32.succ t)
279	273
280	274	let pred t =
281	275	if Int32.equal t 0x00_00_00_00l then
282	276	Error (`Msg "Ipaddr: lowest address has been reached")
283		else
284		Ok (Int32.pred t)
	277	else Ok (Int32.pred t)
285	278
286	279	(* constant *)
287	280
288		let any = make 0 0 0 0
289		let unspecified = make 0 0 0 0
290		let broadcast = make 255 255 255 255
291		let localhost = make 127 0 0 1
292		let nodes = make 224 0 0 1
293		let routers = make 224 0 0 2
	281	let any = make 0 0 0 0
	282
	283	let unspecified = make 0 0 0 0
	284
	285	let broadcast = make 255 255 255 255
	286
	287	let localhost = make 127 0 0 1
	288
	289	let nodes = make 224 0 0 1
	290
	291	let routers = make 224 0 0 2
294	292
295	293	module Prefix = struct
296	294	type addr = t
	295
297	296	type t = addr * int
298	297
299		let compare (pre,sz) (pre',sz') =
	298	let compare (pre, sz) (pre', sz') =
300	299	let c = compare pre pre' in
301	300	if c = 0 then Stdlib.compare sz sz' else c
302	301

305	304	let mask sz =
306	305	if sz <= 0 then 0_l
307	306	else if sz >= 32 then 0x0_FF_FF_FF_FF_l
308		else 0x0_FF_FF_FF_FF_l <\|< (32 - sz)
309
310		let prefix (pre,sz) = (pre &&& (mask sz), sz)
311
312		let make sz pre = (pre,sz)
313
314		let network_address (pre,sz) addr =
315		(pre &&& (mask sz)) \|\|\| (addr &&& Int32.lognot (mask sz))
	307	else 0x0_FF_FF_FF_FF_l <\|< 32 - sz
	308
	309	let prefix (pre, sz) = (pre &&& mask sz, sz)
	310
	311	let make sz pre = (pre, sz)
	312
	313	let network_address (pre, sz) addr =
	314	pre &&& mask sz \|\|\| (addr &&& Int32.lognot (mask sz))
316	315
317	316	(* string conversion *)
318	317

320	319	let quad = of_string_raw s i in
321	320	expect_char s i '/';
322	321	let p = parse_dec_int s i in
323		if p > 32 \|\| p < 0
324		then raise (Parse_error ("invalid prefix size", s));
325		(p,quad)
	322	if p > 32 \|\| p < 0 then raise (Parse_error ("invalid prefix size", s));
	323	(p, quad)
326	324
327	325	let of_string_raw s i =
328		let (p,quad) = _of_string_raw s i in
	326	let p, quad = _of_string_raw s i in
329	327	make p quad
330	328
331	329	let _of_string_exn s =

334	332	expect_end s i;
335	333	res
336	334
337		let of_string_exn s = let (p,quad) = _of_string_exn s in make p quad
	335	let of_string_exn s =
	336	let p, quad = _of_string_exn s in
	337	make p quad
338	338
339	339	let of_string s = try_with_result of_string_exn s
340	340
341	341	let _of_netmask_exn ~netmask address =
342	342	let rec find_greatest_one bits i =
343		if bits = 0_l then i-1 else find_greatest_one (bits >\|> 1) (i+1)
	343	if bits = 0_l then i - 1 else find_greatest_one (bits >\|> 1) (i + 1)
344	344	in
345		let one = netmask &&& (Int32.neg netmask) in
346		let sz = 32 - (find_greatest_one one (if one = 0_l then 33 else 0)) in
347		if netmask <> (mask sz)
348		then raise (Parse_error ("invalid netmask",to_string netmask))
	345	let one = netmask &&& Int32.neg netmask in
	346	let sz = 32 - find_greatest_one one (if one = 0_l then 33 else 0) in
	347	if netmask <> mask sz then
	348	raise (Parse_error ("invalid netmask", to_string netmask))
349	349	else make sz address
350	350
351	351	let of_netmask_exn ~netmask ~address = _of_netmask_exn ~netmask address

353	353	let of_netmask ~netmask ~address =
354	354	try_with_result (_of_netmask_exn ~netmask) address
355	355
356		let to_buffer buf (pre,sz) = Printf.bprintf buf "%a/%d" to_buffer pre sz
	356	let to_buffer buf (pre, sz) = Printf.bprintf buf "%a/%d" to_buffer pre sz
357	357
358	358	let to_string subnet =
359	359	let b = Buffer.create 18 in
360	360	to_buffer b subnet;
361	361	Buffer.contents b
362	362
363		let pp ppf i =
364		Format.fprintf ppf "%s" (to_string i)
365
366		let mem ip (pre,sz) =
	363	let pp ppf i = Format.fprintf ppf "%s" (to_string i)
	364
	365	let mem ip (pre, sz) =
367	366	let m = mask sz in
368		(ip &&& m) = (pre &&& m)
369
370		let subset ~subnet:(pre1,sz1) ~network:(pre2,sz2) =
371		sz1 >= sz2 && mem pre1 (pre2,sz2)
	367	ip &&& m = (pre &&& m)
	368
	369	let subset ~subnet:(pre1, sz1) ~network:(pre2, sz2) =
	370	sz1 >= sz2 && mem pre1 (pre2, sz2)
372	371
373	372	let of_addr ip = make 32 ip
374	373
375		let global = make 0 (ip 0 0 0 0)
376		let relative = make 8 (ip 0 0 0 0)
377		let loopback = make 8 (ip 127 0 0 0)
378		let link = make 16 (ip 169 254 0 0)
379		let multicast = make 4 (ip 224 0 0 0)
380		let multicast_org = make 14 (ip 239 192 0 0)
	374	let global = make 0 (ip 0 0 0 0)
	375
	376	let relative = make 8 (ip 0 0 0 0)
	377
	378	let loopback = make 8 (ip 127 0 0 0)
	379
	380	let link = make 16 (ip 169 254 0 0)
	381
	382	let multicast = make 4 (ip 224 0 0 0)
	383
	384	let multicast_org = make 14 (ip 239 192 0 0)
	385
381	386	let multicast_admin = make 16 (ip 239 255 0 0)
382		let multicast_link = make 24 (ip 224 0 0 0)
	387
	388	let multicast_link = make 24 (ip 224 0 0 0)
	389
383	390	(* http://tools.ietf.org/html/rfc2365 *)
384	391
385		let private_10 = make 8 (ip 10 0 0 0)
386		let private_172 = make 12 (ip 172 16 0 0)
	392	let private_10 = make 8 (ip 10 0 0 0)
	393
	394	let private_172 = make 12 (ip 172 16 0 0)
	395
387	396	let private_192 = make 16 (ip 192 168 0 0)
388	397
389		let private_blocks = [
390		loopback ; link ; private_10 ; private_172 ; private_192
391		]
392
393		let broadcast (pre,sz) = pre \|\|\| (0x0_FF_FF_FF_FF_l >\|> sz)
394		let network (pre,sz) = pre &&& mask sz
395		let address (addr,_) = addr
396		let bits (_,sz) = sz
	398	let private_blocks =
	399	[ loopback; link; private_10; private_172; private_192 ]
	400
	401	let broadcast (pre, sz) =
	402	Int32.logor pre (Int32.logxor (mask sz) 0xFF_FF_FF_FFl)
	403
	404	let network (pre, sz) = pre &&& mask sz
	405
	406	let address (addr, _) = addr
	407
	408	let bits (_, sz) = sz
	409
397	410	let netmask subnet = mask (bits subnet)
398	411
399		let first (_,sz as cidr) =
400		if sz > 30 then
401		network cidr
402		else
403		network cidr \|> succ \|> failwith_msg
404
405		let last (_,sz as cidr) =
406		if sz > 30 then
407		broadcast cidr
408		else
409		broadcast cidr \|> pred \|> failwith_msg
	412	let first ((_, sz) as cidr) =
	413	if sz > 30 then network cidr else network cidr \|> succ \|> failwith_msg
	414
	415	let last ((_, sz) as cidr) =
	416	if sz > 30 then broadcast cidr else broadcast cidr \|> pred \|> failwith_msg
410	417	end
411	418
412	419	(* TODO: this could be optimized with something trie-like *)

418	425	else if i = unspecified then Point
419	426	else if i = broadcast then Admin
420	427	else if mem Prefix.relative then Admin
421		else if mem Prefix.multicast
422		then (if mem Prefix.multicast_org then Organization
	428	else if mem Prefix.multicast then
	429	if mem Prefix.multicast_org then Organization
423	430	else if mem Prefix.multicast_admin then Admin
424	431	else if mem Prefix.multicast_link then Link
425		else Global)
	432	else Global
426	433	else Global
427	434
428		let is_global i = (scope i) = Global
	435	let is_global i = scope i = Global
	436
429	437	let is_multicast i = Prefix.(mem i multicast)
430		let is_private i = (scope i) <> Global
	438
	439	let is_private i = scope i <> Global
431	440	end
432	441
433	442	module B128 = struct
434	443	type t = int32 * int32 * int32 * int32
435	444
436	445	let of_int64 (a, b) =
437		Int64.(
438		to_int32 (shift_right_logical a 32),
439		to_int32 a,
440		to_int32 (shift_right_logical b 32),
441		to_int32 b)
442		let to_int64 (a,b,c,d) =
443		Int64.(
444		logor (shift_left (of_int32 a) 32) (of_int32 b),
445		logor (shift_left (of_int32 c) 32) (of_int32 d))
	446	Int64.
	447	( to_int32 (shift_right_logical a 32),
	448	to_int32 a,
	449	to_int32 (shift_right_logical b 32),
	450	to_int32 b )
	451
	452	let to_int64 (a, b, c, d) =
	453	Int64.
	454	( logor (shift_left (of_int32 a) 32) (of_int32 b),
	455	logor (shift_left (of_int32 c) 32) (of_int32 d) )
446	456
447	457	let of_int32 x = x
	458
448	459	let to_int32 x = x
449	460
450	461	let of_int16 (a, b, c, d, e, f, g, h) =
451		V4.of_int16 (a,b),
452		V4.of_int16 (c,d),
453		V4.of_int16 (e,f),
454		V4.of_int16 (g,h)
455
456		let to_int16 (x,y,z,t) =
457		let a,b = V4.to_int16 x
458		and c,d = V4.to_int16 y
459		and e,f = V4.to_int16 z
460		and g,h = V4.to_int16 t
	462	( V4.of_int16 (a, b),
	463	V4.of_int16 (c, d),
	464	V4.of_int16 (e, f),
	465	V4.of_int16 (g, h) )
	466
	467	let to_int16 (x, y, z, t) =
	468	let a, b = V4.to_int16 x
	469	and c, d = V4.to_int16 y
	470	and e, f = V4.to_int16 z
	471	and g, h = V4.to_int16 t in
	472	(a, b, c, d, e, f, g, h)
	473
	474	let write_octets_exn ?(off = 0) (a, b, c, d) byte =
	475	V4.write_octets_exn ~off a byte;
	476	V4.write_octets_exn ~off:(off + 4) b byte;
	477	V4.write_octets_exn ~off:(off + 8) c byte;
	478	V4.write_octets_exn ~off:(off + 12) d byte
	479
	480	let compare (a1, b1, c1, d1) (a2, b2, c2, d2) =
	481	match V4.compare a1 a2 with
	482	\| 0 -> (
	483	match V4.compare b1 b2 with
	484	\| 0 -> ( match V4.compare c1 c2 with 0 -> V4.compare d1 d2 \| n -> n)
	485	\| n -> n)
	486	\| n -> n
	487
	488	let logand (a1, b1, c1, d1) (a2, b2, c2, d2) =
	489	(a1 &&& a2, b1 &&& b2, c1 &&& c2, d1 &&& d2)
	490
	491	let logor (a1, b1, c1, d1) (a2, b2, c2, d2) =
	492	(a1 \|\|\| a2, b1 \|\|\| b2, c1 \|\|\| c2, d1 \|\|\| d2)
	493
	494	let lognot (a, b, c, d) = Int32.(lognot a, lognot b, lognot c, lognot d)
	495
	496	let succ (a, b, c, d) =
	497	let cb (n, tl) v =
	498	match n with
	499	\| 0l -> (0l, v :: tl)
	500	\| n ->
	501	let n = if Int32.equal v 0xFF_FF_FF_FFl then n else 0l in
	502	(n, Int32.succ v :: tl)
461	503	in
462		(a,b,c,d,e,f,g,h)
463
464		let write_octets_exn ?(off=0) (a,b,c,d) byte =
465		V4.write_octets_exn ~off a byte;
466		V4.write_octets_exn ~off:(off+4) b byte;
467		V4.write_octets_exn ~off:(off+8) c byte;
468		V4.write_octets_exn ~off:(off+12) d byte
469
470		let compare (a1,b1,c1,d1) (a2,b2,c2,d2) =
471		match V4.compare a1 a2 with
472		\| 0 -> begin
473		match V4.compare b1 b2 with
474		\| 0 -> begin
475		match V4.compare c1 c2 with
476		\| 0 -> V4.compare d1 d2
477		\| n -> n end
478		\| n -> n end
479		\| n -> n
480
481		let logand (a1,b1,c1,d1) (a2,b2,c2,d2) =
482		(a1 &&& a2, b1 &&& b2, c1 &&& c2, d1 &&& d2)
483
484		let logor (a1,b1,c1,d1) (a2,b2,c2,d2) =
485		(a1 \|\|\| a2, b1 \|\|\| b2, c1 \|\|\| c2, d1 \|\|\| d2)
486
487		let lognot (a,b,c,d) = Int32.(lognot a, lognot b, lognot c, lognot d)
488
489		let succ (a,b,c,d) =
490		let cb (n,tl) v =
	504	match List.fold_left cb (1l, []) [ d; c; b; a ] with
	505	\| 0l, [ a; b; c; d ] -> Ok (of_int32 (a, b, c, d))
	506	\| n, [ _; _; _; _ ] when n > 0l ->
	507	Error (`Msg "Ipaddr: highest address has been reached")
	508	\| _ -> Error (`Msg "Ipaddr: unexpected error with B128")
	509
	510	let pred (a, b, c, d) =
	511	let cb (n, tl) v =
491	512	match n with
492		\| 0l -> (0l,v::tl)
	513	\| 0l -> (0l, v :: tl)
493	514	\| n ->
494		let n =
495		if Int32.equal v 0xFF_FF_FF_FFl then
496		n
497		else
498		0l
499		in
500		(n,Int32.succ v::tl)
	515	let n = if v = 0x00_00_00_00l then n else 0l in
	516	(n, Int32.pred v :: tl)
501	517	in
502		match List.fold_left cb (1l,[]) [d;c;b;a] with
503		\| 0l, [a;b;c;d] -> Ok (of_int32 (a,b,c,d))
504		\| n, [_;_;_;_] when n > 0l ->
505		Error (`Msg "Ipaddr: highest address has been reached")
	518	match List.fold_left cb (-1l, []) [ d; c; b; a ] with
	519	\| 0l, [ a; b; c; d ] -> Ok (of_int32 (a, b, c, d))
	520	\| n, [ _; _; _; _ ] when n < 0l ->
	521	Error (`Msg "Ipaddr: lowest address has been reached")
506	522	\| _ -> Error (`Msg "Ipaddr: unexpected error with B128")
507	523
508		let pred (a,b,c,d) =
509		let cb (n,tl) v =
510		match n with
511		\| 0l -> (0l,v::tl)
512		\| n ->
513		let n =
514		if v = 0x00_00_00_00l then
515		n
516		else
517		0l
518		in
519		(n,Int32.pred v::tl)
520		in
521		match List.fold_left cb (-1l,[]) [d;c;b;a] with
522		\| 0l, [a;b;c;d] -> Ok (of_int32 (a,b,c,d))
523		\| n, [_;_;_;_] when n < 0l ->
524		Error (`Msg "Ipaddr: lowest address has been reached")
525		\| _ -> Error (`Msg "Ipaddr: unexpected error with B128")
526
527		let shift_right (a,b,c,d) sz =
528		let rec loop (a,b,c,d) sz =
529		if sz < 32 then (sz, (a,b,c,d))
530		else loop (0l,a,b,c) (sz - 32)
531		in
532		let (sz, (a,b,c,d)) = loop (a,b,c,d) sz in
533		let fn (saved,tl) part =
534		let new_saved = Int32.logand part (0xFF_FF_FF_FFl >\|> sz) in
535		let new_part = (part >\|> sz) \|\|\| (saved <\|< 32 - sz) in
536		(new_saved, new_part::tl)
537		in
538		match List.fold_left fn (0l,[]) [a;b;c;d] with
539		\| _, [d;c;b;a] -> Ok (of_int32 (a, b, c, d))
540		\| _ -> Error (`Msg "Ipaddr: unexpected error with B128.shift_right")
	524	(* result is unspecified if sz < 0 *)
	525	let shift_right (a, b, c, d) sz =
	526	if sz < 0 \|\| sz > 128 then
	527	Error (`Msg "Ipaddr: unexpected argument sz (must be >= 0 and < 128)")
	528	else
	529	let rec loop (a, b, c, d) sz =
	530	if sz < 32 then (sz, (a, b, c, d)) else loop (0l, a, b, c) (sz - 32)
	531	in
	532	let sz, (a, b, c, d) = loop (a, b, c, d) sz in
	533	let fn (saved, tl) part =
	534	let new_saved = Int32.logand part (0xFF_FF_FF_FFl >\|> sz) in
	535	let new_part = part >\|> sz \|\|\| (saved <\|< 32 - sz) in
	536	(new_saved, new_part :: tl)
	537	in
	538	match List.fold_left fn (0l, []) [ a; b; c; d ] with
	539	\| _, [ d; c; b; a ] -> Ok (of_int32 (a, b, c, d))
	540	\| _ -> Error (`Msg "Ipaddr: unexpected error with B128.shift_right")
541	541	end
542	542
543	543	module V6 = struct
544	544	include B128
545	545
546	546	(* TODO: Perhaps represent with bytestring? *)
547		let make a b c d e f g h = of_int16 (a,b,c,d,e,f,g,h)
	547	let make a b c d e f g h = of_int16 (a, b, c, d, e, f, g, h)
548	548
549	549	(* parsing *)
550	550	let parse_ipv6 s i =
551		let compressed = ref false in (* :: *)
	551	let compressed = ref false in
	552	(* :: *)
552	553	let len = String.length s in
553		if len < !i + 1 then (raise (need_more s));
554		let use_bracket = s.[!i] = '['; in
	554	if len < !i + 1 then raise (need_more s);
	555	let use_bracket = s.[!i] = '[' in
555	556	if use_bracket then incr i;
556		if len < !i + 2 then (raise (need_more s));
	557	if len < !i + 2 then raise (need_more s);
557	558	(* check if it starts with :: *)
558	559	let l =
559		if s.[!i] = ':' then begin
	560	if s.[!i] = ':' then (
560	561	incr i;
561		if s.[!i] = ':' then begin
	562	if s.[!i] = ':' then (
562	563	compressed := true;
563	564	incr i;
564		[-1]
565		end
566		else
567		raise (bad_char !i s);
568		end
	565	[ -1 ])
	566	else raise (bad_char !i s))
569	567	else []
570	568	in
571	569
572	570	let rec loop nb acc =
573	571	if nb >= 8 then acc
574		else if !i >= len
575		then acc
	572	else if !i >= len then acc
576	573	else
577	574	let pos = !i in
578	575	let x = try parse_hex_int s i with _ -> -1 in
579	576	if x < 0 then acc
580		else if nb = 7
581		then x::acc
582		else if !i < len && s.[!i] = ':'
583		then begin
	577	else if nb = 7 then x :: acc
	578	else if !i < len && s.[!i] = ':' then (
584	579	incr i;
585		if !i < len
586		then if s.[!i] = ':'
587		then
588		if !compressed then (decr i; x::acc) (* trailing :: *)
589		else begin
590		compressed:=true;
	580	if !i < len then
	581	if s.[!i] = ':' then
	582	if !compressed then (
	583	decr i;
	584	x :: acc (* trailing :: *))
	585	else (
	586	compressed := true;
591	587	incr i;
592		loop (nb + 2) (-1::x::acc)
593		end
594		else begin
595		if is_number 16 (int_of_char s.[!i])
596		then loop (nb+1) (x::acc)
597		else raise (bad_char !i s)
598		end
599		else raise (need_more s)
600		end
601		else if !i < len && s.[!i] = '.'
602		then begin
603		i:= pos;
	588	loop (nb + 2) (-1 :: x :: acc))
	589	else if is_number 16 (int_of_char s.[!i]) then
	590	loop (nb + 1) (x :: acc)
	591	else raise (bad_char !i s)
	592	else raise (need_more s))
	593	else if !i < len && s.[!i] = '.' then (
	594	i := pos;
604	595	let v4 = V4.of_string_raw s i in
605		let (hi,lo) = V4.to_int16 v4 in
606		lo :: hi :: acc
607		end
608		else x::acc
	596	let hi, lo = V4.to_int16 v4 in
	597	lo :: hi :: acc)
	598	else x :: acc
609	599	in
610	600
611	601	let res = loop (List.length l) l in
612	602	let res_len = List.length res in
613		if res_len > 8
614		then raise (Parse_error ("too many components",s))
615		else if res_len = 0
616		then raise (need_more s)
	603	if res_len > 8 then raise (Parse_error ("too many components", s))
	604	else if res_len = 0 then raise (need_more s)
617	605	else
618	606	let a = Array.make 8 0 in
619	607	let missing =
620		if !compressed
621		then 8 - (res_len - 1)
622		else if res_len <> 8
623		then
624		if !i < len
625		then raise (bad_char !i s)
626		else raise (need_more s)
	608	if !compressed then 8 - (res_len - 1)
	609	else if res_len <> 8 then
	610	if !i < len then raise (bad_char !i s) else raise (need_more s)
627	611	else 0
628	612	in
629		let _ = List.fold_left (fun i x ->
630		if x = -1
631		then i - missing
632		else begin
633		if x land 0xffff <> x
634		then raise (Parse_error
635		(Printf.sprintf "component %d out of bounds" i, s));
636		a.(i) <- x;
637		i - 1
638		end
639		) 7 res in
640		(if use_bracket then expect_char s i ']');
	613	let _ =
	614	List.fold_left
	615	(fun i x ->
	616	if x = -1 then i - missing
	617	else (
	618	if x land 0xffff <> x then
	619	raise
	620	(Parse_error (Printf.sprintf "component %d out of bounds" i, s));
	621	a.(i) <- x;
	622	i - 1))
	623	7 res
	624	in
	625	if use_bracket then expect_char s i ']';
641	626	a
642	627
643	628	(* string conversion *)

656	641
657	642	(* http://tools.ietf.org/html/rfc5952 *)
658	643	let to_buffer buf addr =
659
660		let (a,b,c,d,e,f,g,h) as comp = to_int16 addr in
661
662		let v4 = match comp with
663		\| (0,0,0,0,0,0xffff,_,_) -> true
664		\| _ -> false
	644	let ((a, b, c, d, e, f, g, h) as comp) = to_int16 addr in
	645
	646	let v4 =
	647	match comp with 0, 0, 0, 0, 0, 0xffff, _, _ -> true \| _ -> false
665	648	in
666	649
667	650	let rec loop elide zeros acc = function
668	651	\| 0 :: xs -> loop elide (zeros - 1) acc xs
669		\| n :: xs when zeros = 0 -> loop elide 0 (n::acc) xs
670		\| n :: xs -> loop (min elide zeros) 0 (n::zeros::acc) xs
	652	\| n :: xs when zeros = 0 -> loop elide 0 (n :: acc) xs
	653	\| n :: xs -> loop (min elide zeros) 0 (n :: zeros :: acc) xs
671	654	\| [] ->
672		let elide = min elide zeros in
673		(if elide < -1 then Some elide else None),
674		(if zeros = 0 then acc else zeros::acc)
	655	let elide = min elide zeros in
	656	( (if elide < -1 then Some elide else None),
	657	if zeros = 0 then acc else zeros :: acc )
675	658	in
676	659
677		let elide,l = loop 0 0 [] [h;g;f;e;d;c;b;a] in
678		assert(match elide with Some x when x < -8 -> false \| _ -> true);
	660	let elide, l = loop 0 0 [] [ h; g; f; e; d; c; b; a ] in
	661	assert (match elide with Some x when x < -8 -> false \| _ -> true);
679	662
680	663	let rec cons_zeros l x =
681		if x >= 0 then l else cons_zeros (Some 0::l) (x+1)
	664	if x >= 0 then l else cons_zeros (Some 0 :: l) (x + 1)
682	665	in
683	666
684		let _,lrev = List.fold_left (fun (patt, l) x ->
685		if Some x = patt
686		then (None, (None::l))
687		else if x < 0
688		then (patt, (cons_zeros l x))
689		else (patt, ((Some x)::l))
690		) (elide, []) l in
	667	let _, lrev =
	668	List.fold_left
	669	(fun (patt, l) x ->
	670	if Some x = patt then (None, None :: l)
	671	else if x < 0 then (patt, cons_zeros l x)
	672	else (patt, Some x :: l))
	673	(elide, []) l
	674	in
691	675
692	676	let rec fill = function
693		\| [Some hi;Some lo] when v4 ->
694		let addr = V4.of_int16 (hi, lo) in
695		V4.to_buffer buf addr
696		\| None::xs -> Buffer.add_string buf "::"; fill xs
697		\| [Some n] -> Printf.bprintf buf "%x" n
698		\| (Some n)::None::xs -> Printf.bprintf buf "%x::" n; fill xs
699		\| (Some n)::xs -> Printf.bprintf buf "%x:" n; fill xs
	677	\| [ Some hi; Some lo ] when v4 ->
	678	let addr = V4.of_int16 (hi, lo) in
	679	V4.to_buffer buf addr
	680	\| None :: xs ->
	681	Buffer.add_string buf "::";
	682	fill xs
	683	\| [ Some n ] -> Printf.bprintf buf "%x" n
	684	\| Some n :: None :: xs ->
	685	Printf.bprintf buf "%x::" n;
	686	fill xs
	687	\| Some n :: xs ->
	688	Printf.bprintf buf "%x:" n;
	689	fill xs
700	690	\| [] -> ()
701		in fill (List.rev lrev)
	691	in
	692	fill (List.rev lrev)
702	693
703	694	let to_string l =
704	695	let buf = Buffer.create 39 in
705	696	to_buffer buf l;
706	697	Buffer.contents buf
707	698
708		let pp ppf i =
709		Format.fprintf ppf "%s" (to_string i)
	699	let pp ppf i = Format.fprintf ppf "%s" (to_string i)
710	700
711	701	(* byte conversion *)
712	702
713		let of_octets_exn ?(off=0) bs = (* TODO : from cstruct *)
	703	let of_octets_exn ?(off = 0) bs =
	704	(* TODO : from cstruct *)
714	705	let hihi = V4.of_octets_exn ~off bs in
715		let hilo = V4.of_octets_exn ~off:(off+4) bs in
716		let lohi = V4.of_octets_exn ~off:(off+8) bs in
717		let lolo = V4.of_octets_exn ~off:(off+12) bs in
	706	let hilo = V4.of_octets_exn ~off:(off + 4) bs in
	707	let lohi = V4.of_octets_exn ~off:(off + 8) bs in
	708	let lolo = V4.of_octets_exn ~off:(off + 12) bs in
718	709	of_int32 (hihi, hilo, lohi, lolo)
719	710
720	711	let of_octets ?off bs = try_with_result (of_octets_exn ?off) bs

729	720	(* MAC *)
730	721	(* {{:https://tools.ietf.org/html/rfc2464#section-7}RFC 2464}. *)
731	722	let multicast_to_mac i =
732		let (_,_,_,i) = to_int32 i in
	723	let _, _, _, i = to_int32 i in
733	724	let macb = Bytes.create 6 in
734	725	Bytes.set macb 0 (Char.chr 0x33);
735	726	Bytes.set macb 1 (Char.chr 0x33);
736		Bytes.set macb 2 (Char.chr ((\|~) (i >! 24)));
737		Bytes.set macb 3 (Char.chr ((\|~) (i >! 16)));
738		Bytes.set macb 4 (Char.chr ((\|~) (i >! 8)));
739		Bytes.set macb 5 (Char.chr ((\|~) (i >! 0)));
	727	Bytes.set macb 2 (Char.chr (( \|~ ) (i >! 24)));
	728	Bytes.set macb 3 (Char.chr (( \|~ ) (i >! 16)));
	729	Bytes.set macb 4 (Char.chr (( \|~ ) (i >! 8)));
	730	Bytes.set macb 5 (Char.chr (( \|~ ) (i >! 0)));
740	731	Macaddr.of_octets_exn (Bytes.to_string macb)
741	732
742	733	(* Host *)
743		let to_domain_name (a,b,c,d) =
744		let name = [
745		hex_string_of_int32 ((d >\|> 0) &&& 0xF_l);
746		hex_string_of_int32 ((d >\|> 4) &&& 0xF_l);
747		hex_string_of_int32 ((d >\|> 8) &&& 0xF_l);
748		hex_string_of_int32 ((d >\|> 12) &&& 0xF_l);
749		hex_string_of_int32 ((d >\|> 16) &&& 0xF_l);
750		hex_string_of_int32 ((d >\|> 20) &&& 0xF_l);
751		hex_string_of_int32 ((d >\|> 24) &&& 0xF_l);
752		hex_string_of_int32 ((d >\|> 28) &&& 0xF_l);
753		hex_string_of_int32 ((c >\|> 0) &&& 0xF_l);
754		hex_string_of_int32 ((c >\|> 4) &&& 0xF_l);
755		hex_string_of_int32 ((c >\|> 8) &&& 0xF_l);
756		hex_string_of_int32 ((c >\|> 12) &&& 0xF_l);
757		hex_string_of_int32 ((c >\|> 16) &&& 0xF_l);
758		hex_string_of_int32 ((c >\|> 20) &&& 0xF_l);
759		hex_string_of_int32 ((c >\|> 24) &&& 0xF_l);
760		hex_string_of_int32 ((c >\|> 28) &&& 0xF_l);
761		hex_string_of_int32 ((b >\|> 0) &&& 0xF_l);
762		hex_string_of_int32 ((b >\|> 4) &&& 0xF_l);
763		hex_string_of_int32 ((b >\|> 8) &&& 0xF_l);
764		hex_string_of_int32 ((b >\|> 12) &&& 0xF_l);
765		hex_string_of_int32 ((b >\|> 16) &&& 0xF_l);
766		hex_string_of_int32 ((b >\|> 20) &&& 0xF_l);
767		hex_string_of_int32 ((b >\|> 24) &&& 0xF_l);
768		hex_string_of_int32 ((b >\|> 28) &&& 0xF_l);
769		hex_string_of_int32 ((a >\|> 0) &&& 0xF_l);
770		hex_string_of_int32 ((a >\|> 4) &&& 0xF_l);
771		hex_string_of_int32 ((a >\|> 8) &&& 0xF_l);
772		hex_string_of_int32 ((a >\|> 12) &&& 0xF_l);
773		hex_string_of_int32 ((a >\|> 16) &&& 0xF_l);
774		hex_string_of_int32 ((a >\|> 20) &&& 0xF_l);
775		hex_string_of_int32 ((a >\|> 24) &&& 0xF_l);
776		hex_string_of_int32 ((a >\|> 28) &&& 0xF_l);
777		"ip6";
778		"arpa"
779		]
	734	let to_domain_name (a, b, c, d) =
	735	let name =
	736	[
	737	hex_string_of_int32 (d >\|> 0 &&& 0xF_l);
	738	hex_string_of_int32 (d >\|> 4 &&& 0xF_l);
	739	hex_string_of_int32 (d >\|> 8 &&& 0xF_l);
	740	hex_string_of_int32 (d >\|> 12 &&& 0xF_l);
	741	hex_string_of_int32 (d >\|> 16 &&& 0xF_l);
	742	hex_string_of_int32 (d >\|> 20 &&& 0xF_l);
	743	hex_string_of_int32 (d >\|> 24 &&& 0xF_l);
	744	hex_string_of_int32 (d >\|> 28 &&& 0xF_l);
	745	hex_string_of_int32 (c >\|> 0 &&& 0xF_l);
	746	hex_string_of_int32 (c >\|> 4 &&& 0xF_l);
	747	hex_string_of_int32 (c >\|> 8 &&& 0xF_l);
	748	hex_string_of_int32 (c >\|> 12 &&& 0xF_l);
	749	hex_string_of_int32 (c >\|> 16 &&& 0xF_l);
	750	hex_string_of_int32 (c >\|> 20 &&& 0xF_l);
	751	hex_string_of_int32 (c >\|> 24 &&& 0xF_l);
	752	hex_string_of_int32 (c >\|> 28 &&& 0xF_l);
	753	hex_string_of_int32 (b >\|> 0 &&& 0xF_l);
	754	hex_string_of_int32 (b >\|> 4 &&& 0xF_l);
	755	hex_string_of_int32 (b >\|> 8 &&& 0xF_l);
	756	hex_string_of_int32 (b >\|> 12 &&& 0xF_l);
	757	hex_string_of_int32 (b >\|> 16 &&& 0xF_l);
	758	hex_string_of_int32 (b >\|> 20 &&& 0xF_l);
	759	hex_string_of_int32 (b >\|> 24 &&& 0xF_l);
	760	hex_string_of_int32 (b >\|> 28 &&& 0xF_l);
	761	hex_string_of_int32 (a >\|> 0 &&& 0xF_l);
	762	hex_string_of_int32 (a >\|> 4 &&& 0xF_l);
	763	hex_string_of_int32 (a >\|> 8 &&& 0xF_l);
	764	hex_string_of_int32 (a >\|> 12 &&& 0xF_l);
	765	hex_string_of_int32 (a >\|> 16 &&& 0xF_l);
	766	hex_string_of_int32 (a >\|> 20 &&& 0xF_l);
	767	hex_string_of_int32 (a >\|> 24 &&& 0xF_l);
	768	hex_string_of_int32 (a >\|> 28 &&& 0xF_l);
	769	"ip6";
	770	"arpa";
	771	]
780	772	in
781	773	Domain_name.(host_exn (of_strings_exn name))
782	774

790	782	let d = drop_label_exn ~rev ~amount:24 n'
791	783	and c = drop_label_exn ~amount:8 (drop_label_exn ~rev ~amount:16 n')
792	784	and b = drop_label_exn ~amount:16 (drop_label_exn ~rev ~amount:8 n')
793		and a = drop_label_exn ~amount:24 n'
794		in
	785	and a = drop_label_exn ~amount:24 n' in
795	786	let t b d =
796	787	let v = Int32.of_int (parse_hex_int d (ref 0)) in
797		if v > 0xFl then
798		raise (Parse_error ("number in label too big", d))
799		else
800		v <\|< b
	788	if v > 0xFl then raise (Parse_error ("number in label too big", d))
	789	else v <\|< b
801	790	in
802	791	let f d =
803		List.fold_left (fun (acc, b) d -> Int32.add acc (t b d), b + 4)
	792	List.fold_left
	793	(fun (acc, b) d -> (Int32.add acc (t b d), b + 4))
804	794	(0l, 0) (to_strings d)
805	795	in
806	796	try
807	797	let a', _ = f a and b', _ = f b and c', _ = f c and d', _ = f d in
808	798	Some (a', b', c', d')
809		with
810		\| Parse_error _ -> None
811		else
812		None
813		else
814		None
	799	with Parse_error _ -> None
	800	else None
	801	else None
815	802
816	803	(* constant *)
817	804
818		let unspecified = make 0 0 0 0 0 0 0 0
819		let localhost = make 0 0 0 0 0 0 0 1
820		let interface_nodes = make 0xff01 0 0 0 0 0 0 1
821		let link_nodes = make 0xff02 0 0 0 0 0 0 1
	805	let unspecified = make 0 0 0 0 0 0 0 0
	806
	807	let localhost = make 0 0 0 0 0 0 0 1
	808
	809	let interface_nodes = make 0xff01 0 0 0 0 0 0 1
	810
	811	let link_nodes = make 0xff02 0 0 0 0 0 0 1
	812
822	813	let interface_routers = make 0xff01 0 0 0 0 0 0 2
823		let link_routers = make 0xff02 0 0 0 0 0 0 2
824		let site_routers = make 0xff05 0 0 0 0 0 0 2
	814
	815	let link_routers = make 0xff02 0 0 0 0 0 0 2
	816
	817	let site_routers = make 0xff05 0 0 0 0 0 0 2
825	818
826	819	module Prefix = struct
827	820	type addr = t
	821
828	822	type t = addr * int
829	823
830		let compare (pre,sz) (pre',sz') =
	824	let compare (pre, sz) (pre', sz') =
831	825	let c = compare pre pre' in
832	826	if c = 0 then Stdlib.compare sz sz' else c
833	827

835	829
836	830	let _full =
837	831	let f = 0x0_FFFF_FFFF_l in
838		f,f,f,f
839
840		let mask sz = V4.Prefix.(
841		mask (sz - 0),
842		mask (sz - 32),
843		mask (sz - 64),
844		mask (sz - 96))
845
846		let prefix (pre,sz) = (logand pre (mask sz),sz)
847
848		let make sz pre = (pre,sz)
849
850		let network_address (pre,sz) addr =
	832	(f, f, f, f)
	833
	834	let mask sz =
	835	V4.Prefix.(mask (sz - 0), mask (sz - 32), mask (sz - 64), mask (sz - 96))
	836
	837	let prefix (pre, sz) = (logand pre (mask sz), sz)
	838
	839	let make sz pre = (pre, sz)
	840
	841	let network_address (pre, sz) addr =
851	842	logor (logand pre (mask sz)) (logand addr (lognot (mask sz)))
852	843
853	844	let _of_string_raw s i =
854	845	let v6 = of_string_raw s i in
855	846	expect_char s i '/';
856	847	let p = parse_dec_int s i in
857		if p > 128 \|\| p < 0
858		then raise (Parse_error ("invalid prefix size", s));
	848	if p > 128 \|\| p < 0 then raise (Parse_error ("invalid prefix size", s));
859	849	(p, v6)
860	850
861	851	let of_string_raw s i =
862		let (p,v6) = _of_string_raw s i in
	852	let p, v6 = _of_string_raw s i in
863	853	make p v6
864	854
865	855	let _of_string_exn s =

868	858	expect_end s i;
869	859	res
870	860
871		let of_string_exn s = let (p,v6) = _of_string_exn s in make p v6
	861	let of_string_exn s =
	862	let p, v6 = _of_string_exn s in
	863	make p v6
872	864
873	865	let of_string s = try_with_result of_string_exn s
874	866

878	870	V4.Prefix.bits (V4.Prefix.of_netmask_exn ~netmask ~address:V4.any)
879	871	in
880	872	match netmask with
881		\| (0_l,0_l,0_l,0_l) -> 0
882		\| (lsw ,0_l ,0_l ,0_l) -> bits lsw
883		\| (-1_l,lsw ,0_l ,0_l) -> bits lsw + 32
884		\| (-1_l,-1_l,lsw ,0_l) -> bits lsw + 64
885		\| (-1_l,-1_l,-1_l,lsw) -> bits lsw + 96
	873	\| 0_l, 0_l, 0_l, 0_l -> 0
	874	\| lsw, 0_l, 0_l, 0_l -> bits lsw
	875	\| -1_l, lsw, 0_l, 0_l -> bits lsw + 32
	876	\| -1_l, -1_l, lsw, 0_l -> bits lsw + 64
	877	\| -1_l, -1_l, -1_l, lsw -> bits lsw + 96
886	878	\| _ -> raise (Parse_error ("invalid netmask", to_string netmask))
887	879	in
888	880	make nm address

892	884	let of_netmask ~netmask ~address =
893	885	try_with_result (_of_netmask_exn ~netmask) address
894	886
895		let to_buffer buf (pre,sz) =
896		Printf.bprintf buf "%a/%d" to_buffer pre sz
	887	let to_buffer buf (pre, sz) = Printf.bprintf buf "%a/%d" to_buffer pre sz
897	888
898	889	let to_string subnet =
899	890	let buf = Buffer.create 43 in
900	891	to_buffer buf subnet;
901	892	Buffer.contents buf
902	893
903		let pp ppf i =
904		Format.fprintf ppf "%s" (to_string i)
905
906		let mem ip (pre,sz) =
	894	let pp ppf i = Format.fprintf ppf "%s" (to_string i)
	895
	896	let mem ip (pre, sz) =
907	897	let m = mask sz in
908	898	logand ip m = logand pre m
909	899
910		let subset ~subnet:(pre1,sz1) ~network:(pre2,sz2) =
911		sz1 >= sz2 && mem pre1 (pre2,sz2)
	900	let subset ~subnet:(pre1, sz1) ~network:(pre2, sz2) =
	901	sz1 >= sz2 && mem pre1 (pre2, sz2)
912	902
913	903	let of_addr ip = make 128 ip
914	904
915		let global_unicast_001 = make 3 (ip 0x2000 0 0 0 0 0 0 0)
916		let link = make 64 (ip 0xfe80 0 0 0 0 0 0 0)
917		let unique_local = make 7 (ip 0xfc00 0 0 0 0 0 0 0)
918		let multicast = make 8 (ip 0xff00 0 0 0 0 0 0 0)
919		let ipv4_mapped = make 96 (ip 0 0 0 0 0 0xffff 0 0)
920		let noneui64_interface = make 3 (ip 0x0000 0 0 0 0 0 0 0)
921		let solicited_node = make 104 (ip 0xff02 0 0 0 0 1 0xff00 0)
922
923		let network (pre,sz) = logand pre (mask sz)
924		let address (addr,_) = addr
925		let bits (_,sz) = sz
	905	let global_unicast_001 = make 3 (ip 0x2000 0 0 0 0 0 0 0)
	906
	907	let link = make 64 (ip 0xfe80 0 0 0 0 0 0 0)
	908
	909	let unique_local = make 7 (ip 0xfc00 0 0 0 0 0 0 0)
	910
	911	let multicast = make 8 (ip 0xff00 0 0 0 0 0 0 0)
	912
	913	let ipv4_mapped = make 96 (ip 0 0 0 0 0 0xffff 0 0)
	914
	915	let noneui64_interface = make 3 (ip 0x0000 0 0 0 0 0 0 0)
	916
	917	let solicited_node = make 104 (ip 0xff02 0 0 0 0 1 0xff00 0)
	918
	919	let network (pre, sz) = logand pre (mask sz)
	920
	921	let address (addr, _) = addr
	922
	923	let bits (_, sz) = sz
	924
926	925	let netmask subnet = mask (bits subnet)
927	926
928		let first (_,sz as cidr) =
929		if sz > 126 then
930		network cidr
931		else
932		network cidr \|> succ \|> failwith_msg
933
934		let last (_,sz as cidr) =
935		let ffff = ip 0xffff 0xffff 0xffff 0xffff
936		0xffff 0xffff 0xffff 0xffff in
	927	let first ((_, sz) as cidr) =
	928	if sz > 126 then network cidr else network cidr \|> succ \|> failwith_msg
	929
	930	let last ((_, sz) as cidr) =
	931	let ffff = ip 0xffff 0xffff 0xffff 0xffff 0xffff 0xffff 0xffff 0xffff in
937	932	logor (network cidr) (shift_right ffff sz \|> failwith_msg)
938	933	end
939	934

941	936	let scope i =
942	937	let mem = Prefix.mem i in
943	938	if mem Prefix.global_unicast_001 then Global
944		else if mem Prefix.ipv4_mapped
945		(* rfc says they are technically global but... *)
946		then V4.scope (let (_,_,_,v4) = to_int32 i in V4.of_int32 v4)
	939	else if
	940	mem Prefix.ipv4_mapped (* rfc says they are technically global but... *)
	941	then
	942	V4.scope
	943	(let _, _, _, v4 = to_int32 i in
	944	V4.of_int32 v4)
947	945	else if mem Prefix.multicast then
948		let (x,_,_,_,_,_,_,_) = to_int16 i in
	946	let x, _, _, _, _, _, _, _ = to_int16 i in
949	947	match x land 0xf with
950	948	\| 0 -> Point
951	949	\| 1 -> Interface

962	960	else Global
963	961
964	962	let link_address_of_mac =
965		let c b i = Char.code (String.get b i) in
	963	let c b i = Char.code b.[i] in
966	964	fun mac ->
967	965	let bmac = Macaddr.to_octets mac in
968	966	let c_0 = c bmac 0 lxor 2 in
969		let addr = make 0 0 0 0
970		(c_0 lsl 8 + c bmac 1)
971		(c bmac 2 lsl 8 + 0xff )
972		(0xfe00 + c bmac 3)
973		(c bmac 4 lsl 8 + c bmac 5)
	967	let addr =
	968	make 0 0 0 0
	969	((c_0 lsl 8) + c bmac 1)
	970	((c bmac 2 lsl 8) + 0xff)
	971	(0xfe00 + c bmac 3)
	972	((c bmac 4 lsl 8) + c bmac 5)
974	973	in
975	974	Prefix.(network_address link addr)
976	975
977		let is_global i = (scope i) = Global
	976	let is_global i = scope i = Global
	977
978	978	let is_multicast i = Prefix.(mem i multicast)
979		let is_private i = (scope i) <> Global
	979
	980	let is_private i = scope i <> Global
980	981	end
981	982
982		type ('v4,'v6) v4v6 = V4 of 'v4 \| V6 of 'v6
983		type t = (V4.t,V6.t) v4v6
984
985		let compare a b = match a,b with
	983	type ('v4, 'v6) v4v6 = V4 of 'v4 \| V6 of 'v6
	984
	985	type t = (V4.t, V6.t) v4v6
	986
	987	let compare a b =
	988	match (a, b) with
986	989	\| V4 a, V4 b -> V4.compare a b
987	990	\| V6 a, V6 b -> V6.compare a b
988	991	\| V4 _, V6 _ -> -1
989	992	\| V6 _, V4 _ -> 1
990	993
991		let to_string = function
992		\| V4 x -> V4.to_string x
993		\| V6 x -> V6.to_string x
	994	let to_string = function V4 x -> V4.to_string x \| V6 x -> V6.to_string x
994	995
995	996	let to_buffer buf = function
996	997	\| V4 x -> V4.to_buffer buf x
997	998	\| V6 x -> V6.to_buffer buf x
998	999
999		let pp ppf i =
1000		Format.fprintf ppf "%s" (to_string i)
	1000	let pp ppf i = Format.fprintf ppf "%s" (to_string i)
1001	1001
1002	1002	let of_string_raw s offset =
1003	1003	let len = String.length s in
1004	1004	if len < !offset + 1 then raise (need_more s);
1005	1005	match s.[0] with
1006		\| '[' -> V6 (V6.of_string_raw s offset)
1007		\| _ ->
	1006	\| '[' -> V6 (V6.of_string_raw s offset)
	1007	\| _ -> (
1008	1008	let pos = !offset in
1009	1009	try V4 (V4.of_string_raw s offset)
1010		with Parse_error (v4_msg,_) ->
	1010	with Parse_error (v4_msg, _) -> (
1011	1011	offset := pos;
1012	1012	try V6 (V6.of_string_raw s offset)
1013		with Parse_error(v6_msg,s) ->
1014		let msg = Printf.sprintf
1015		"not an IPv4 address: %s\nnot an IPv6 address: %s"
1016		v4_msg v6_msg
1017		in raise (Parse_error (msg,s))
	1013	with Parse_error (v6_msg, s) ->
	1014	let msg =
	1015	Printf.sprintf "not an IPv4 address: %s\nnot an IPv6 address: %s"
	1016	v4_msg v6_msg
	1017	in
	1018	raise (Parse_error (msg, s))))
1018	1019
1019	1020	let of_string_exn s = of_string_raw s (ref 0)
1020	1021
1021	1022	let of_string s = try_with_result of_string_exn s
1022	1023
1023	1024	let v6_of_v4 v4 =
1024		V6.(Prefix.(network_address ipv4_mapped (of_int32 (0l,0l,0l,v4))))
	1025	V6.(Prefix.(network_address ipv4_mapped (of_int32 (0l, 0l, 0l, v4))))
1025	1026
1026	1027	let v4_of_v6 v6 =
1027		if V6.Prefix.(mem v6 ipv4_mapped)
1028		then let (_,_,_,v4) = V6.to_int32 v6 in Some V4.(of_int32 v4)
	1028	if V6.Prefix.(mem v6 ipv4_mapped) then
	1029	let _, _, _, v4 = V6.to_int32 v6 in
	1030	Some V4.(of_int32 v4)
1029	1031	else None
1030	1032
1031	1033	let to_v4 = function V4 v4 -> Some v4 \| V6 v6 -> v4_of_v6 v6

1034	1036
1035	1037	let scope = function V4 v4 -> V4.scope v4 \| V6 v6 -> V6.scope v6
1036	1038
1037		let is_global = function
1038		\| V4 v4 -> V4.is_global v4
1039		\| V6 v6 -> V6.is_global v6
	1039	let is_global = function V4 v4 -> V4.is_global v4 \| V6 v6 -> V6.is_global v6
1040	1040
1041	1041	let is_multicast = function
1042	1042	\| V4 v4 -> V4.is_multicast v4

1056	1056
1057	1057	let of_domain_name n =
1058	1058	match Domain_name.count_labels n with
1059		\| 6 ->
1060		begin match V4.of_domain_name n with
1061		\| None -> None
1062		\| Some x -> Some (V4 x)
1063		end
1064		\| 34 ->
1065		begin match V6.of_domain_name n with
1066		\| None -> None
1067		\| Some x -> Some (V6 x)
1068		end
	1059	\| 6 -> (
	1060	match V4.of_domain_name n with None -> None \| Some x -> Some (V4 x))
	1061	\| 34 -> (
	1062	match V6.of_domain_name n with None -> None \| Some x -> Some (V6 x))
1069	1063	\| _ -> None
1070	1064
1071	1065	let succ = function

1082	1076	end
1083	1077
1084	1078	type addr = t
1085		type t = (V4.Prefix.t,V6.Prefix.t) v4v6
1086
1087		let compare a b = match a,b with
1088		\| V4 a , V4 b -> V4.Prefix.compare a b
1089		\| V6 a , V6 b -> V6.Prefix.compare a b
1090		\| V4 _ , V6 _ -> -1
1091		\| V6 _ , V4 _ -> 1
	1079
	1080	type t = (V4.Prefix.t, V6.Prefix.t) v4v6
	1081
	1082	let compare a b =
	1083	match (a, b) with
	1084	\| V4 a, V4 b -> V4.Prefix.compare a b
	1085	\| V6 a, V6 b -> V6.Prefix.compare a b
	1086	\| V4 _, V6 _ -> -1
	1087	\| V6 _, V4 _ -> 1
1092	1088
1093	1089	let of_string_raw s offset =
1094	1090	let len = String.length s in
1095	1091	if len < !offset + 1 then raise (need_more s);
1096	1092	match s.[0] with
1097		\| '[' -> V6 (V6.Prefix.of_string_raw s offset)
1098		\| _ ->
	1093	\| '[' -> V6 (V6.Prefix.of_string_raw s offset)
	1094	\| _ -> (
1099	1095	let pos = !offset in
1100	1096	try V4 (V4.Prefix.of_string_raw s offset)
1101		with Parse_error (v4_msg,_) ->
	1097	with Parse_error (v4_msg, _) -> (
1102	1098	offset := pos;
1103	1099	try V6 (V6.Prefix.of_string_raw s offset)
1104		with Parse_error(v6_msg,s) ->
1105		let msg = Printf.sprintf
1106		"not an IPv4 prefix: %s\nnot an IPv6 prefix: %s"
	1100	with Parse_error (v6_msg, s) ->
	1101	let msg =
	1102	Printf.sprintf "not an IPv4 prefix: %s\nnot an IPv6 prefix: %s"
1107	1103	v4_msg v6_msg
1108		in raise (Parse_error (msg,s))
	1104	in
	1105	raise (Parse_error (msg, s))))
1109	1106
1110	1107	let of_string_exn s = of_string_raw s (ref 0)
1111	1108
1112	1109	let of_string s = try_with_result of_string_exn s
1113	1110
1114		let v6_of_v4 v4 = V6.Prefix.make
1115		(96 + V4.Prefix.bits v4)
1116		(v6_of_v4 (V4.Prefix.network v4))
1117
1118		let v4_of_v6 v6 = match v4_of_v6 (V6.Prefix.network v6) with
	1111	let v6_of_v4 v4 =
	1112	V6.Prefix.make (96 + V4.Prefix.bits v4) (v6_of_v4 (V4.Prefix.network v4))
	1113
	1114	let v4_of_v6 v6 =
	1115	match v4_of_v6 (V6.Prefix.network v6) with
1119	1116	\| Some v4 -> Some (V4.Prefix.make (V6.Prefix.bits v6 - 96) v4)
1120	1117	\| None -> None
1121	1118

1148	1145	\| V4 p -> V4 (V4.Prefix.netmask p)
1149	1146	\| V6 p -> V6 (V6.Prefix.netmask p)
1150	1147
1151		let pp ppf i =
1152		Format.fprintf ppf "%s" (to_string i)
	1148	let pp ppf i = Format.fprintf ppf "%s" (to_string i)
1153	1149
1154	1150	let first = function
1155	1151	\| V4 p -> V4 (V4.Prefix.first p)

1158	1154	let last = function
1159	1155	\| V4 p -> V4 (V4.Prefix.last p)
1160	1156	\| V6 p -> V6 (V6.Prefix.last p)
1161
1162	1157	end

+442

-452

lib/ipaddr.mli less more

17	17
18	18	(** A library for manipulation of IP address representations.
19	19
20		{e %%VERSION%% - {{:%%PKG_HOMEPAGE%% }homepage}} *)
21
22		(** [Parse_error (err,packet)] is raised when parsing of the IP
23		address syntax fails. [err] contains a human-readable error
24		and [packet] is the original octet list that failed to parse. *)
	20	{e v5.0.1 - {{:https://github.com/mirage/ocaml-ipaddr} homepage}} *)
	21
25	22	exception Parse_error of string * string
	23	(** [Parse_error (err,packet)] is raised when parsing of the IP address syntax
	24	fails. [err] contains a human-readable error and [packet] is the original
	25	octet list that failed to parse. *)
26	26
27	27	(** Type of ordered address scope classifications *)
28		type scope =
29		\| Point
30		\| Interface
31		\| Link
32		\| Admin
33		\| Site
34		\| Organization
35		\| Global
36
37		(** [string_of_scope scope] returns a human-readable representation
38		of {!scope}. *)
	28	type scope = Point \| Interface \| Link \| Admin \| Site \| Organization \| Global
	29
39	30	val string_of_scope : scope -> string
40
41		(** [scope_of_string s] returns a {!scope} from a string representation
42		of [s]. Valid string values for [s] can be obtained via {!string_of_scope}. *)
43		val scope_of_string : string -> (scope, [> `Msg of string]) result
44
45		(** [pp_scope fmt scope] outputs a human-readable representation
46		of {!scope} to the [fmt] formatter. *)
47		val pp_scope : Format.formatter -> scope -> unit [@@ocaml.toplevel_printer]
	31	(** [string_of_scope scope] returns a human-readable representation of {!scope}. *)
	32
	33	val scope_of_string : string -> (scope, [> `Msg of string ]) result
	34	(** [scope_of_string s] returns a {!scope} from a string representation of [s].
	35	Valid string values for [s] can be obtained via {!string_of_scope}. *)
	36
	37	val pp_scope : Format.formatter -> scope -> unit
	38	[@@ocaml.toplevel_printer]
	39	(** [pp_scope fmt scope] outputs a human-readable representation of {!scope} to
	40	the [fmt] formatter. *)
48	41
49	42	(** A collection of functions for IPv4 addresses. *)
50	43	module V4 : sig
	44	type t
51	45	(** Type of the internet protocol v4 address of a host *)
52		type t
53
54		(** Converts the low bytes of four int values into an abstract {! V4.t }. *)
	46
55	47	val make : int -> int -> int -> int -> t
	48	(** Converts the low bytes of four int values into an abstract {!V4.t}. *)
56	49
57	50	(** {3 Text string conversion}
58		These manipulate human-readable IPv4 addresses (for example [192.168.1.2]). *)
59
	51
	52	These manipulate human-readable IPv4 addresses (for example
	53	[192.168.1.2]). *)
	54
	55	val of_string : string -> (t, [> `Msg of string ]) result
60	56	(** [of_string s] is the address {!t} represented by the human-readable IPv4
61	57	address [s]. Returns a human-readable error string if parsing failed. *)
62		val of_string : string -> (t, [> `Msg of string ]) result
63
	58
	59	val of_string_exn : string -> t
64	60	(** [of_string_exn s] is the address {!t} represented as a human-readable IPv4
65	61	address [s]. Raises {!Parse_error} if [s] is not exactly 4 bytes long. *)
66		val of_string_exn : string -> t
67
	62
	63	val of_string_raw : string -> int ref -> t
68	64	(** [of_string_raw s off] acts as {!of_string_exn} but takes as an extra
69		argument the offset into the string for reading. [off] will be
70		mutated to an unspecified value during the function call. [s] will
71		a {!Parse_error} exception if it is an invalid or truncated IP address. *)
72		val of_string_raw : string -> int ref -> t
73
74		(** [to_string ipv4] is the dotted decimal string representation
75		of [ipv4], i.e. [XXX.XX.X.XXX]. *)
	65	argument the offset into the string for reading. [off] will be mutated to
	66	an unspecified value during the function call. [s] will a {!Parse_error}
	67	exception if it is an invalid or truncated IP address. *)
	68
76	69	val to_string : t -> string
77
	70	(** [to_string ipv4] is the dotted decimal string representation of [ipv4],
	71	i.e. [XXX.XX.X.XXX]. *)
	72
	73	val to_buffer : Buffer.t -> t -> unit
78	74	(** [to_buffer buf ipv4] writes the string representation of [ipv4] into the
79	75	buffer [buf]. *)
80		val to_buffer : Buffer.t -> t -> unit
81
82		(** [pp f ipv4] outputs a human-readable representation of [ipv4] to
83		the formatter [f]. *)
84		val pp : Format.formatter -> t -> unit [@@ocaml.toplevel_printer]
	76
	77	val pp : Format.formatter -> t -> unit
	78	[@@ocaml.toplevel_printer]
	79	(** [pp f ipv4] outputs a human-readable representation of [ipv4] to the
	80	formatter [f]. *)
85	81
86	82	(** {3 Octets conversion}
87		These manipulate IPv4 addresses represented as a sequence of
88		four bytes. (e.g for example [0xc0a80102] will be the representation
89		of the human-readable [192.168.1.2] address. *)
90
	83
	84	These manipulate IPv4 addresses represented as a sequence of four bytes.
	85	(e.g for example [0xc0a80102] will be the representation of the
	86	human-readable [192.168.1.2] address. *)
	87
	88	val of_octets : ?off:int -> string -> (t, [> `Msg of string ]) result
91	89	(** [of_octets ?off s] is the address {!t} represented by the IPv4 octets
92		represented by [s] starting from offset [off] within the string.
93		[s] must be at least [off+4] bytes long.
94		Returns a human-readable error string if parsing fails.
95		[off] defaults to 0. *)
96		val of_octets : ?off:int -> string -> (t, [> `Msg of string ]) result
97
98		(** [of_octets_exn ipv4_octets] is the IPv4 address represented
99		by [ipv4_octets] starting from offset [off] within the string.
100		Raises {!Parse_error} if [ipv4_octets] is not at least [off+4] bytes long.
101		[off] defaults to 0. *)
	90	represented by [s] starting from offset [off] within the string. [s] must
	91	be at least [off+4] bytes long. Returns a human-readable error string if
	92	parsing fails. [off] defaults to 0. *)
	93
102	94	val of_octets_exn : ?off:int -> string -> t
103
	95	(** [of_octets_exn ipv4_octets] is the IPv4 address represented by
	96	[ipv4_octets] starting from offset [off] within the string. Raises
	97	{!Parse_error} if [ipv4_octets] is not at least [off+4] bytes long. [off]
	98	defaults to 0. *)
	99
	100	val write_octets :
	101	?off:int -> t -> bytes -> (unit, [> `Msg of string ]) result
104	102	(** [write_octets ?off ipv4 b] writes the [ipv4] as octets to [b] starting
105		from offset [off]. [b] must be at least [off+4] long or an error is
106		returned. *)
107		val write_octets : ?off:int -> t -> bytes -> (unit, [> `Msg of string ]) result
108
	103	from offset [off]. [b] must be at least [off+4] long or an error is
	104	returned. *)
	105
	106	val write_octets_exn : ?off:int -> t -> bytes -> unit
109	107	(** [write_octets_exn ?off ipv4 b] writes the [ipv4] as octets to [b] starting
110		from offset [off]. [b] must be at least [off+4] long or a
111		{!Parse_error} is raised. *)
112		val write_octets_exn : ?off:int -> t -> bytes -> unit
113
	108	from offset [off]. [b] must be at least [off+4] long or a {!Parse_error}
	109	is raised. *)
	110
	111	val to_octets : t -> string
114	112	(** [to_octets ipv4] returns the 4 bytes representing the [ipv4] octets. *)
115		val to_octets : t -> string
116	113
117	114	(** {3 Int conversion} *)
118	115
119		(** [of_int32 ipv4_packed] is the address represented by
120		[ipv4_packed]. *)
121	116	val of_int32 : int32 -> t
122
	117	(** [of_int32 ipv4_packed] is the address represented by [ipv4_packed]. *)
	118
	119	val to_int32 : t -> int32
123	120	(** [to_int32 ipv4] is the 32-bit packed encoding of [ipv4]. *)
124		val to_int32 : t -> int32
125
126		(** [of_int16 ipv4_packed] is the address represented by
127		[ipv4_packed]. *)
128		val of_int16 : (int * int) -> t
129
	121
	122	val of_int16 : int * int -> t
	123	(** [of_int16 ipv4_packed] is the address represented by [ipv4_packed]. *)
	124
	125	val to_int16 : t -> int * int
130	126	(** [to_int16 ipv4] is the 16-bit packed encoding of [ipv4]. *)
131		val to_int16 : t -> int * int
132	127
133	128	(** {3 MAC conversion} *)
134	129
135		(** [multicast_to_mac ipv4] is the MAC address corresponding to the
136		multicast address [ipv4]. Described by
137		{{:http://tools.ietf.org/html/rfc1112#section-6.2}RFC 1112}. *)
138	130	val multicast_to_mac : t -> Macaddr.t
	131	(** [multicast_to_mac ipv4] is the MAC address corresponding to the multicast
	132	address [ipv4]. Described by
	133	{{:http://tools.ietf.org/html/rfc1112#section-6.2} RFC 1112}. *)
139	134
140	135	(** {3 Host conversion} *)
141	136
142		(** [to_domain_name ipv4] is the domain name label list for reverse
143		lookups of [ipv4]. This includes the [.in-addr.arpa] suffix. *)
144	137	val to_domain_name : t -> [ `host ] Domain_name.t
145
	138	(** [to_domain_name ipv4] is the domain name label list for reverse lookups of
	139	[ipv4]. This includes the [.in-addr.arpa] suffix. *)
	140
	141	val of_domain_name : 'a Domain_name.t -> t option
146	142	(** [of_domain_name name] is [Some t] if the [name] has an [.in-addr.arpa]
147	143	suffix, and an IPv4 address prefixed. *)
148		val of_domain_name : 'a Domain_name.t -> t option
149	144
150	145	(** {3 Utility functions} *)
151	146
152		(** [succ ipv4] is ip address next to [ipv4].
153		Returns a human-readable error string if it's already the highest address. *)
154	147	val succ : t -> (t, [> `Msg of string ]) result
155
156		(** [pred ipv4] is ip address before [ipv4].
157		Returns a human-readable error string if it's already the lowest address. *)
	148	(** [succ ipv4] is ip address next to [ipv4]. Returns a human-readable error
	149	string if it's already the highest address. *)
	150
158	151	val pred : t -> (t, [> `Msg of string ]) result
	152	(** [pred ipv4] is ip address before [ipv4]. Returns a human-readable error
	153	string if it's already the lowest address. *)
159	154
160	155	(** {3 Common addresses} *)
161	156
	157	val any : t
162	158	(** [any] is 0.0.0.0. *)
163		val any : t
164
	159
	160	val unspecified : t
165	161	(** [unspecified] is 0.0.0.0. *)
166		val unspecified : t
167
	162
	163	val broadcast : t
168	164	(** [broadcast] is 255.255.255.255. *)
169		val broadcast : t
170
	165
	166	val nodes : t
171	167	(** [nodes] is 224.0.0.1. *)
172		val nodes : t
173
	168
	169	val routers : t
174	170	(** [routers] is 224.0.0.2. *)
175		val routers : t
176
	171
	172	val localhost : t
177	173	(** [localhost] is 127.0.0.1. *)
178		val localhost : t
179	174
180	175	(** A module for manipulating IPv4 network prefixes (CIDR). *)
181	176	module Prefix : sig
182	177	type addr = t
183	178
	179	type t
184	180	(** Type of a internet protocol subnet: an address and prefix length. *)
185		type t
186
	181
	182	val mask : int -> addr
187	183	(** [mask n] is the pseudo-address of an [n] bit subnet mask. *)
188		val mask : int -> addr
189
	184
	185	val make : int -> addr -> t
190	186	(** [make n addr] is the cidr of [addr] with [n] bits prefix. *)
191		val make : int -> addr -> t
192
	187
	188	val prefix : t -> t
193	189	(** [prefix cidr] is the subnet prefix of [cidr] where all non-prefix bits
194	190	set to 0. *)
195		val prefix : t -> t
196
197		(** [network_address cidr addr] is the address with prefix [cidr]
198		and suffix from [addr].
199		See <http://tools.ietf.org/html/rfc4291#section-2.3>. *)
	191
200	192	val network_address : t -> addr -> addr
201
202		(** [of_string cidr] is the subnet prefix represented by the CIDR
203		string, [cidr]. Returns a human-readable parsing error message
204		if [cidr] is not a valid representation of a CIDR notation routing
205		prefix. *)
206		val of_string : string -> (t, [> `Msg of string ]) result
207
	193	(** [network_address cidr addr] is the address with prefix [cidr] and suffix
	194	from [addr]. See <http://tools.ietf.org/html/rfc4291#section-2.3>. *)
	195
	196	val of_string : string -> (t, [> `Msg of string ]) result
	197	(** [of_string cidr] is the subnet prefix represented by the CIDR string,
	198	[cidr]. Returns a human-readable parsing error message if [cidr] is not
	199	a valid representation of a CIDR notation routing prefix. *)
	200
	201	val of_string_exn : string -> t
208	202	(** [of_string_exn cidr] is the subnet prefix represented by the CIDR
209	203	string, [cidr]. Raises [Parse_error] if [cidr] is not a valid
210	204	representation of a CIDR notation routing prefix. *)
211		val of_string_exn : string -> t
212
213		(** Same as {!of_string_exn} but takes as an extra argument the offset
214		into the string for reading. *)
	205
215	206	val of_string_raw : string -> int ref -> t
216
217		(** [to_string cidr] is the CIDR notation string representation
218		of [cidr], i.e. [XXX.XX.X.XXX/XX]. *)
	207	(** Same as {!of_string_exn} but takes as an extra argument the offset into
	208	the string for reading. *)
	209
219	210	val to_string : t -> string
220
221		(** [pp f cidr] outputs a human-readable representation of [cidr]
222		to the formatter [f]. *)
223		val pp : Format.formatter -> t -> unit [@@ocaml.toplevel_printer]
224
225		(** [to_buffer buf cidr] writes the string representation
226		of [cidr] into the buffer [buf]. *)
	211	(** [to_string cidr] is the CIDR notation string representation of [cidr],
	212	i.e. [XXX.XX.X.XXX/XX]. *)
	213
	214	val pp : Format.formatter -> t -> unit
	215	[@@ocaml.toplevel_printer]
	216	(** [pp f cidr] outputs a human-readable representation of [cidr] to the
	217	formatter [f]. *)
	218
227	219	val to_buffer : Buffer.t -> t -> unit
228
	220	(** [to_buffer buf cidr] writes the string representation of [cidr] into the
	221	buffer [buf]. *)
	222
	223	val of_netmask_exn : netmask:addr -> address:addr -> t
229	224	(** [of_netmask_exn ~netmask ~address] is the subnet prefix of [address]
230	225	with netmask [netmask]. *)
231		val of_netmask_exn : netmask:addr -> address:addr -> t
232
233		(** [of_netmask ~netmask ~address] is the cidr of [address] with
234		netmask [netmask]. *)
235		val of_netmask : netmask:addr -> address:addr ->
236		(t, [> `Msg of string ]) result
237
	226
	227	val of_netmask :
	228	netmask:addr -> address:addr -> (t, [> `Msg of string ]) result
	229	(** [of_netmask ~netmask ~address] is the cidr of [address] with netmask
	230	[netmask]. *)
	231
	232	val mem : addr -> t -> bool
238	233	(** [mem ip subnet] checks whether [ip] is found within [subnet]. *)
239		val mem : addr -> t -> bool
240
241		(** [subset ~subnet ~network] checks whether [subnet] is contained
242		within [network]. *)
	234
243	235	val subset : subnet:t -> network:t -> bool
244
245		(** [of_addr ip] create a subnet composed of only one address, [ip].
246		It is the same as [make 32 ip]. *)
	236	(** [subset ~subnet ~network] checks whether [subnet] is contained within
	237	[network]. *)
	238
247	239	val of_addr : addr -> t
248
	240	(** [of_addr ip] create a subnet composed of only one address, [ip]. It is
	241	the same as [make 32 ip]. *)
	242
	243	val global : t
249	244	(** The default route, all addresses in IPv4-space, 0.0.0.0/0. *)
250		val global : t
251
	245
	246	val loopback : t
252	247	(** The host loopback network, 127.0.0.0/8. *)
253		val loopback : t
254
	248
	249	val link : t
255	250	(** The local-link network, 169.254.0.0/16. *)
256		val link : t
257
	251
	252	val relative : t
258	253	(** The relative addressing network, 0.0.0.0/8. *)
259		val relative : t
260
	254
	255	val multicast : t
261	256	(** The multicast network, 224.0.0.0/4. *)
262		val multicast : t
263
	257
	258	val private_10 : t
264	259	(** The private subnet with 10 as first octet, 10.0.0.0/8. *)
265		val private_10 : t
266
	260
	261	val private_172 : t
267	262	(** The private subnet with 172 as first octet, 172.16.0.0/12. *)
268		val private_172 : t
269
	263
	264	val private_192 : t
270	265	(** The private subnet with 192 as first octet, 192.168.0.0/16. *)
271		val private_192 : t
272
273		(** The privately addressable networks: [loopback], [link],
274		[private_10], [private_172], [private_192]. *)
	266
275	267	val private_blocks : t list
276
	268	(** The privately addressable networks: [loopback], [link], [private_10],
	269	[private_172], [private_192]. *)
	270
	271	val broadcast : t -> addr
277	272	(** [broadcast subnet] is the broadcast address for [subnet]. *)
278		val broadcast : t -> addr
279
	273
	274	val network : t -> addr
280	275	(** [network subnet] is the address for [subnet]. *)
281		val network : t -> addr
282
	276
	277	val netmask : t -> addr
283	278	(** [netmask subnet] is the netmask for [subnet]. *)
284		val netmask : t -> addr
285
	279
	280	val address : t -> addr
286	281	(** [address cidr] is the address for [cidr]. *)
287		val address : t -> addr
288
	282
	283	val bits : t -> int
289	284	(** [bits cidr] is the bit size of the [cidr] prefix. *)
290		val bits : t -> int
291
	285
	286	val first : t -> addr
292	287	(** [first cidr] is first valid unicast address in this [cidr]. *)
293		val first : t -> addr
294
	288
	289	val last : t -> addr
295	290	(** [last cidr] is last valid unicast address in this [cidr]. *)
296		val last : t -> addr
297	291
298	292	include Map.OrderedType with type t := t
299	293	end
300	294
301		(** [scope ipv4] is the classification of [ipv4] by the {! scope }
302		hierarchy. *)
303	295	val scope : t -> scope
304
	296	(** [scope ipv4] is the classification of [ipv4] by the {!scope} hierarchy. *)
	297
	298	val is_global : t -> bool
305	299	(** [is_global ipv4] is a predicate indicating whether [ipv4] globally
306	300	addresses a node. *)
307		val is_global : t -> bool
308
	301
	302	val is_multicast : t -> bool
309	303	(** [is_multicast ipv4] is a predicate indicating whether [ipv4] is a
310	304	multicast address. *)
311		val is_multicast : t -> bool
312
	305
	306	val is_private : t -> bool
313	307	(** [is_private ipv4] is a predicate indicating whether [ipv4] privately
314	308	addresses a node. *)
315		val is_private : t -> bool
316	309
317	310	include Map.OrderedType with type t := t
318	311	end
319	312
320
321	313	(** A collection of functions for IPv6 addresses. *)
322	314	module V6 : sig
	315	type t
323	316	(** Type of the internet protocol v6 address of a host *)
324		type t
325
326		(** Converts the low bytes of eight int values into an abstract
327		{! V6.t }. *)
	317
328	318	val make : int -> int -> int -> int -> int -> int -> int -> int -> t
	319	(** Converts the low bytes of eight int values into an abstract {!V6.t}. *)
329	320
330	321	(** {3 Text string conversion} *)
331	322
332		(** [of_string_exn ipv6_string] is the address represented
333		by [ipv6_string]. Raises {!Parse_error} if [ipv6_string] is not a
334		valid representation of an IPv6 address. *)
335	323	val of_string_exn : string -> t
336
337		(** Same as [of_string_exn] but returns an option type instead of raising
338		an exception. *)
	324	(** [of_string_exn ipv6_string] is the address represented by [ipv6_string].
	325	Raises {!Parse_error} if [ipv6_string] is not a valid representation of an
	326	IPv6 address. *)
	327
339	328	val of_string : string -> (t, [> `Msg of string ]) result
340
341		(** Same as [of_string_exn] but takes as an extra argument the offset into
342		the string for reading. *)
	329	(** Same as [of_string_exn] but returns an option type instead of raising an
	330	exception. *)
	331
343	332	val of_string_raw : string -> int ref -> t
344
345		(** [to_string ipv6] is the string representation of [ipv6],
346		i.e. [XXX:XX:X::XXX:XX]. *)
	333	(** Same as [of_string_exn] but takes as an extra argument the offset into the
	334	string for reading. *)
	335
347	336	val to_string : t -> string
348
	337	(** [to_string ipv6] is the string representation of [ipv6], i.e.
	338	[XXX:XX:X::XXX:XX]. *)
	339
	340	val to_buffer : Buffer.t -> t -> unit
349	341	(** [to_buffer buf ipv6] writes the string representation of [ipv6] into the
350	342	buffer [buf]. *)
351		val to_buffer : Buffer.t -> t -> unit
352
353		(** [pp f ipv6] outputs a human-readable representation of [ipv6] to
354		the formatter [f]. *)
355		val pp : Format.formatter -> t -> unit [@@ocaml.toplevel_printer]
	343
	344	val pp : Format.formatter -> t -> unit
	345	[@@ocaml.toplevel_printer]
	346	(** [pp f ipv6] outputs a human-readable representation of [ipv6] to the
	347	formatter [f]. *)
356	348
357	349	(** {3 Octets conversion} *)
358	350
359		(** [of_octets_exn ?off ipv6_octets] is the address represented
360		by [ipv6_octets], starting from offset [off].
361		Raises {!Parse_error} if [ipv6_octets] is not a valid representation of
362		an IPv6 address. *)
363	351	val of_octets_exn : ?off:int -> string -> t
364
365		(** Same as {!of_octets_exn} but returns an result type instead of raising
366		an exception. *)
	352	(** [of_octets_exn ?off ipv6_octets] is the address represented by
	353	[ipv6_octets], starting from offset [off]. Raises {!Parse_error} if
	354	[ipv6_octets] is not a valid representation of an IPv6 address. *)
	355
367	356	val of_octets : ?off:int -> string -> (t, [> `Msg of string ]) result
368
369		(** [write_octets_exn ?off ipv6 b] writes 16 bytes that encode [ipv6] into [b] starting
370		from offset [off] within [b]. [b] must be at least [off+16] bytes long or
371		a {!Parse_error} exception will be raised. *)
	357	(** Same as {!of_octets_exn} but returns an result type instead of raising an
	358	exception. *)
	359
372	360	val write_octets_exn : ?off:int -> t -> bytes -> unit
373
374		(** [write_octets ?off ipv6 b] writes 16 bytes that encode [ipv6] into [b] starting
375		from offset [off] within [b]. [b] must be at least [off+16] bytes long or
376		an error is returned. *)
377		val write_octets : ?off:int -> t -> bytes -> (unit, [> `Msg of string ]) result
378
	361	(** [write_octets_exn ?off ipv6 b] writes 16 bytes that encode [ipv6] into [b]
	362	starting from offset [off] within [b]. [b] must be at least [off+16] bytes
	363	long or a {!Parse_error} exception will be raised. *)
	364
	365	val write_octets :
	366	?off:int -> t -> bytes -> (unit, [> `Msg of string ]) result
	367	(** [write_octets ?off ipv6 b] writes 16 bytes that encode [ipv6] into [b]
	368	starting from offset [off] within [b]. [b] must be at least [off+16] bytes
	369	long or an error is returned. *)
	370
	371	val to_octets : t -> string
379	372	(** [to_octets ipv6] returns the 16 bytes representing the [ipv6] octets. *)
380		val to_octets : t -> string
381	373
382	374	(** {3 Int conversion} *)
383	375
	376	val of_int64 : int64 * int64 -> t
384	377	(** [of_int64 (ho, lo)] is the IPv6 address represented by two int64. *)
385		val of_int64 : int64 * int64 -> t
386
	378
	379	val to_int64 : t -> int64 * int64
387	380	(** [to_int64 ipv6] is the 128-bit packed encoding of [ipv6]. *)
388		val to_int64 : t -> int64 * int64
389
	381
	382	val of_int32 : int32 * int32 * int32 * int32 -> t
390	383	(** [of_int32 (a, b, c, d)] is the IPv6 address represented by four int32. *)
391		val of_int32 : int32 * int32 * int32 * int32 -> t
392
	384
	385	val to_int32 : t -> int32 * int32 * int32 * int32
393	386	(** [to_int32 ipv6] is the 128-bit packed encoding of [ipv6]. *)
394		val to_int32 : t -> int32 * int32 * int32 * int32
395
	387
	388	val of_int16 : int * int * int * int * int * int * int * int -> t
396	389	(** [of_int16 (a, b, c, d, e, f, g, h)] is the IPv6 address represented by
397	390	eight 16-bit int. *)
398		val of_int16 : int * int * int * int * int * int * int * int -> t
399
	391
	392	val to_int16 : t -> int * int * int * int * int * int * int * int
400	393	(** [to_int16 ipv6] is the 128-bit packed encoding of [ipv6]. *)
401		val to_int16 : t -> int * int * int * int * int * int * int * int
402	394
403	395	(** {3 MAC conversion} *)
404	396
405		(** [multicast_to_mac ipv6] is the MAC address corresponding to the
406		multicast address [ipv6]. Described by
407		{{:https://tools.ietf.org/html/rfc2464#section-7}RFC 2464}. *)
408	397	val multicast_to_mac : t -> Macaddr.t
	398	(** [multicast_to_mac ipv6] is the MAC address corresponding to the multicast
	399	address [ipv6]. Described by
	400	{{:https://tools.ietf.org/html/rfc2464#section-7} RFC 2464}. *)
409	401
410	402	(** {3 Host conversion} *)
411	403
412		(** [to_domain_name ipv6] is the domain name label list for reverse
413		lookups of [ipv6]. This includes the [.ip6.arpa] suffix. *)
414	404	val to_domain_name : t -> [ `host ] Domain_name.t
415
416		(** [of_domain_name name] is [Some t] if the [name] has an [.ip6.arpa]
417		suffix, and an IPv6 address prefixed. *)
	405	(** [to_domain_name ipv6] is the domain name label list for reverse lookups of
	406	[ipv6]. This includes the [.ip6.arpa] suffix. *)
	407
418	408	val of_domain_name : 'a Domain_name.t -> t option
	409	(** [of_domain_name name] is [Some t] if the [name] has an [.ip6.arpa] suffix,
	410	and an IPv6 address prefixed. *)
419	411
420	412	(** {3 Utility functions} *)
421	413
422		(** [succ ipv6] is ip address next to [ipv6]. Returns a human-readable
423		error string if it's already the highest address. *)
424	414	val succ : t -> (t, [> `Msg of string ]) result
425
426		(** [pred ipv6] is ip address before [ipv6]. Returns a human-readable
427		error string if it's already the lowest address. *)
	415	(** [succ ipv6] is ip address next to [ipv6]. Returns a human-readable error
	416	string if it's already the highest address. *)
	417
428	418	val pred : t -> (t, [> `Msg of string ]) result
	419	(** [pred ipv6] is ip address before [ipv6]. Returns a human-readable error
	420	string if it's already the lowest address. *)
429	421
430	422	(** {3 Common addresses} *)
431	423
	424	val unspecified : t
432	425	(** [unspecified] is ::. *)
433		val unspecified : t
434
	426
	427	val localhost : t
435	428	(** [localhost] is ::1. *)
436		val localhost : t
437
	429
	430	val interface_nodes : t
438	431	(** [interface_nodes] is ff01::01. *)
439		val interface_nodes : t
440
	432
	433	val link_nodes : t
441	434	(** [link_nodes] is ff02::01. *)
442		val link_nodes : t
443
	435
	436	val interface_routers : t
444	437	(** [interface_routers] is ff01::02. *)
445		val interface_routers : t
446
	438
	439	val link_routers : t
447	440	(** [link_routers] is ff02::02. *)
448		val link_routers : t
449
	441
	442	val site_routers : t
450	443	(** [site_routers] is ff05::02. *)
451		val site_routers : t
452	444
453	445	(** A module for manipulating IPv6 network prefixes (CIDR). *)
454	446	module Prefix : sig
455	447	type addr = t
456	448
	449	type t
457	450	(** Type of a internet protocol subnet: an address and a prefix length. *)
458		type t
459
	451
	452	val mask : int -> addr
460	453	(** [mask n] is the pseudo-address of an [n] bit subnet mask. *)
461		val mask : int -> addr
462
	454
	455	val make : int -> addr -> t
463	456	(** [make n addr] is the cidr of [addr] with [n] bit prefix. *)
464		val make : int -> addr -> t
465
	457
	458	val prefix : t -> t
466	459	(** [prefix cidr] is the subnet prefix of [cidr] where all non-prefix bits
467	460	set to 0. *)
468		val prefix : t -> t
469
470		(** [network_address cidr addr] is the address with prefix [cidr]
471		and suffix from [addr].
472		See <http://tools.ietf.org/html/rfc4291#section-2.3>. *)
	461
473	462	val network_address : t -> addr -> addr
474
	463	(** [network_address cidr addr] is the address with prefix [cidr] and suffix
	464	from [addr]. See <http://tools.ietf.org/html/rfc4291#section-2.3>. *)
	465
	466	val of_string_exn : string -> t
475	467	(** [of_string_exn cidr] is the subnet prefix represented by the CIDR
476	468	string, [cidr]. Raises {!Parse_error} if [cidr] is not a valid
477	469	representation of a CIDR notation routing prefix. *)
478		val of_string_exn : string -> t
479
480		(** Same as {!of_string_exn} but returns a result type instead of raising
481		an exception. *)
	470
482	471	val of_string : string -> (t, [> `Msg of string ]) result
483
484		(** Same as {!of_string_exn} but takes as an extra argument the offset
485		into the string for reading. *)
	472	(** Same as {!of_string_exn} but returns a result type instead of raising an
	473	exception. *)
	474
486	475	val of_string_raw : string -> int ref -> t
487
488		(** [to_string cidr] is the CIDR notation string representation
489		of [cidr], i.e. XXX:XX:X::XXX/XX. *)
	476	(** Same as {!of_string_exn} but takes as an extra argument the offset into
	477	the string for reading. *)
	478
490	479	val to_string : t -> string
491
492		(** [pp f cidr] outputs a human-readable representation of [cidr]
493		to the formatter [f]. *)
494		val pp : Format.formatter -> t -> unit [@@ocaml.toplevel_printer]
495
496		(** [to_buffer buf cidr] writes the string representation
497		of [cidr] to the buffer [buf]. *)
	480	(** [to_string cidr] is the CIDR notation string representation of [cidr],
	481	i.e. XXX:XX:X::XXX/XX. *)
	482
	483	val pp : Format.formatter -> t -> unit
	484	[@@ocaml.toplevel_printer]
	485	(** [pp f cidr] outputs a human-readable representation of [cidr] to the
	486	formatter [f]. *)
	487
498	488	val to_buffer : Buffer.t -> t -> unit
499
	489	(** [to_buffer buf cidr] writes the string representation of [cidr] to the
	490	buffer [buf]. *)
	491
	492	val of_netmask_exn : netmask:addr -> address:addr -> t
500	493	(** [of_netmask_exn ~netmask ~address] is the subnet prefix of [address]
501	494	with netmask [netmask]. *)
502		val of_netmask_exn : netmask:addr -> address:addr -> t
503
504		(** [of_netmask ~netmask ~address] is the cidr of [address] with
505		netmask [netmask]. *)
506		val of_netmask : netmask:addr -> address:addr ->
507		(t, [> `Msg of string ]) result
508
	495
	496	val of_netmask :
	497	netmask:addr -> address:addr -> (t, [> `Msg of string ]) result
	498	(** [of_netmask ~netmask ~address] is the cidr of [address] with netmask
	499	[netmask]. *)
	500
	501	val mem : addr -> t -> bool
509	502	(** [mem ip subnet] checks whether [ip] is found within [subnet]. *)
510		val mem : addr -> t -> bool
511
512		(** [subset ~subnet ~network] checks whether [subnet] is contained
513		within [network]. *)
	503
514	504	val subset : subnet:t -> network:t -> bool
515
516		(** [of_addr ip] create a subnet composed of only one address, [ip].
517		It is the same as [make 128 ip]. *)
	505	(** [subset ~subnet ~network] checks whether [subnet] is contained within
	506	[network]. *)
	507
518	508	val of_addr : addr -> t
519
	509	(** [of_addr ip] create a subnet composed of only one address, [ip]. It is
	510	the same as [make 128 ip]. *)
	511
	512	val global_unicast_001 : t
520	513	(** Global Unicast 001, 2000::/3. *)
521		val global_unicast_001 : t
522
	514
	515	val unique_local : t
523	516	(** The Unique Local Unicast (ULA), fc00::/7. *)
524		val unique_local : t
525
	517
	518	val link : t
526	519	(** Link-Local Unicast, fe80::/64. *)
527		val link : t
528
	520
	521	val multicast : t
529	522	(** The multicast network, ff00::/8. *)
530		val multicast : t
531
	523
	524	val ipv4_mapped : t
532	525	(** IPv4-mapped addresses, ::ffff:0:0/96. *)
533		val ipv4_mapped : t
534
	526
	527	val noneui64_interface : t
535	528	(** Global Unicast addresses that don't use Modified EUI64 interface
536	529	identifiers, ::/3. *)
537		val noneui64_interface : t
538
	530
	531	val solicited_node : t
539	532	(** Solicited-Node multicast addresses *)
540		val solicited_node : t
541
	533
	534	val network : t -> addr
542	535	(** [network subnet] is the address for [subnet]. *)
543		val network : t -> addr
544
	536
	537	val netmask : t -> addr
545	538	(** [netmask subnet] is the netmask for [subnet]. *)
546		val netmask : t -> addr
547
	539
	540	val address : t -> addr
548	541	(** [address cidr] is the address for [cidr]. *)
549		val address : t -> addr
550
	542
	543	val bits : t -> int
551	544	(** [bits subnet] is the bit size of the [subnet] prefix. *)
552		val bits : t -> int
553
	545
	546	val first : t -> addr
554	547	(** [first subnet] is first valid unicast address in this [subnet]. *)
555		val first : t -> addr
556
	548
	549	val last : t -> addr
557	550	(** [last subnet] is last valid unicast address in this [subnet]. *)
558		val last : t -> addr
559	551
560	552	include Map.OrderedType with type t := t
561	553	end
562	554
563		(** [scope ipv6] is the classification of [ipv6] by the {! scope }
564		hierarchy. *)
565	555	val scope : t -> scope
566
567		(** [link_address_of_mac mac] is the link-local address for an
568		Ethernet interface derived by the IEEE MAC -> EUI-64 map with
569		the Universal/Local bit complemented for IPv6.
570		@see <https://tools.ietf.org/html/rfc2464#section-4> RFC 2464
571		*)
	556	(** [scope ipv6] is the classification of [ipv6] by the {!scope} hierarchy. *)
	557
572	558	val link_address_of_mac : Macaddr.t -> t
573
	559	(** [link_address_of_mac mac] is the link-local address for an Ethernet
	560	interface derived by the IEEE MAC -> EUI-64 map with the Universal/Local
	561	bit complemented for IPv6.
	562
	563	@see <https://tools.ietf.org/html/rfc2464#section-4> RFC 2464 *)
	564
	565	val is_global : t -> bool
574	566	(** [is_global ipv6] is a predicate indicating whether [ipv6] globally
575	567	addresses a node. *)
576		val is_global : t -> bool
577
	568
	569	val is_multicast : t -> bool
578	570	(** [is_multicast ipv6] is a predicate indicating whether [ipv6] is a
579	571	multicast address. *)
580		val is_multicast : t -> bool
581
	572
	573	val is_private : t -> bool
582	574	(** [is_private ipv6] is a predicate indicating whether [ipv6] privately
583	575	addresses a node. *)
584		val is_private : t -> bool
585	576
586	577	include Map.OrderedType with type t := t
587	578	end
588	579
589	580	(** Type of either an IPv4 value or an IPv6 value *)
590		type ('v4,'v6) v4v6 = V4 of 'v4 \| V6 of 'v6
591
	581	type ('v4, 'v6) v4v6 = V4 of 'v4 \| V6 of 'v6
	582
	583	type t = (V4.t, V6.t) v4v6
592	584	(** Type of any IP address *)
593		type t = (V4.t,V6.t) v4v6
594
	585
	586	val to_string : t -> string
595	587	(** [to_string addr] is the text string representation of [addr]. *)
596		val to_string : t -> string
597
	588
	589	val to_buffer : Buffer.t -> t -> unit
598	590	(** [to_buffer buf addr] writes the text string representation of [addr] into
599	591	[buf]. *)
600		val to_buffer : Buffer.t -> t -> unit
601
602		(** [pp f ip] outputs a human-readable representation of [ip] to the
603		formatter [f]. *)
604		val pp : Format.formatter -> t -> unit [@@ocaml.toplevel_printer]
605
606		(** [of_string_exn s] parses [s] as an IPv4 or IPv6 address.
607		Raises {!Parse_error} if [s] is not a valid string representation of an IP
608		address. *)
	592
	593	val pp : Format.formatter -> t -> unit
	594	[@@ocaml.toplevel_printer]
	595	(** [pp f ip] outputs a human-readable representation of [ip] to the formatter
	596	[f]. *)
	597
609	598	val of_string_exn : string -> t
610
	599	(** [of_string_exn s] parses [s] as an IPv4 or IPv6 address. Raises
	600	{!Parse_error} if [s] is not a valid string representation of an IP address. *)
	601
	602	val of_string : string -> (t, [> `Msg of string ]) result
611	603	(** Same as {!of_string_exn} but returns a result type instead of raising an
612	604	exception. *)
613		val of_string : string -> (t, [> `Msg of string ]) result
614
615		(** Same as [of_string_exn] but takes as an extra argument the offset into
616		the string for reading. *)
	605
617	606	val of_string_raw : string -> int ref -> t
618
619		(** [v4_of_v6 ipv6] is the IPv4 representation of the IPv6 address [ipv6].
620		If [ipv6] is not an IPv4-mapped address, None is returned. *)
	607	(** Same as [of_string_exn] but takes as an extra argument the offset into the
	608	string for reading. *)
	609
621	610	val v4_of_v6 : V6.t -> V4.t option
622
	611	(** [v4_of_v6 ipv6] is the IPv4 representation of the IPv6 address [ipv6]. If
	612	[ipv6] is not an IPv4-mapped address, None is returned. *)
	613
	614	val to_v4 : t -> V4.t option
623	615	(** [to_v4 addr] is the IPv4 representation of [addr]. *)
624		val to_v4 : t -> V4.t option
625
	616
	617	val v6_of_v4 : V4.t -> V6.t
626	618	(** [v6_of_v4 ipv4] is the IPv6 representation of the IPv4 address [ipv4]. *)
627		val v6_of_v4 : V4.t -> V6.t
628
	619
	620	val to_v6 : t -> V6.t
629	621	(** [to_v6 addr] is the IPv6 representation of [addr]. *)
630		val to_v6 : t -> V6.t
631
632		(** [scope addr] is the classification of [addr] by the {! scope }
633		hierarchy. *)
	622
634	623	val scope : t -> scope
635
636		(** [is_global addr] is a predicate indicating whether [addr] globally
637		addresses a node. *)
	624	(** [scope addr] is the classification of [addr] by the {!scope} hierarchy. *)
	625
638	626	val is_global : t -> bool
639
640		(** [is_multicast addr] is a predicate indicating whether [addr] is a
641		multicast address. *)
	627	(** [is_global addr] is a predicate indicating whether [addr] globally addresses
	628	a node. *)
	629
642	630	val is_multicast : t -> bool
643
	631	(** [is_multicast addr] is a predicate indicating whether [addr] is a multicast
	632	address. *)
	633
	634	val is_private : t -> bool
644	635	(** [is_private addr] is a predicate indicating whether [addr] privately
645	636	addresses a node. *)
646		val is_private : t -> bool
647
648		(** [multicast_to_mac addr] is the MAC address corresponding to the
649		multicast address [addr]. See {!V4.multicast_to_mac} and
650		{!V6.multicast_to_mac}.*)
	637
651	638	val multicast_to_mac : t -> Macaddr.t
652
653		(** [to_domain_name addr] is the domain name label list for reverse
654		lookups of [addr]. This includes the [.in-addr.arpa] or [.ip6.arpa] suffix. *)
	639	(** [multicast_to_mac addr] is the MAC address corresponding to the multicast
	640	address [addr]. See {!V4.multicast_to_mac} and {!V6.multicast_to_mac}.*)
	641
655	642	val to_domain_name : t -> [ `host ] Domain_name.t
656
	643	(** [to_domain_name addr] is the domain name label list for reverse lookups of
	644	[addr]. This includes the [.in-addr.arpa] or [.ip6.arpa] suffix. *)
	645
	646	val of_domain_name : 'a Domain_name.t -> t option
657	647	(** [of_domain_name name] is [Some t] if the [name] has an [.in-addr.arpa] or
658	648	[ip6.arpa] suffix, and an IP address prefixed. *)
659		val of_domain_name : 'a Domain_name.t -> t option
660
661		(** [succ addr] is ip address next to [addr]. Returns a human-readable
662		error string if it's already the highest address. *)
	649
663	650	val succ : t -> (t, [> `Msg of string ]) result
664
665		(** [pred addr] is ip address before [addr]. Returns a human-readable
666		error string if it's already the lowest address. *)
	651	(** [succ addr] is ip address next to [addr]. Returns a human-readable error
	652	string if it's already the highest address. *)
	653
667	654	val pred : t -> (t, [> `Msg of string ]) result
	655	(** [pred addr] is ip address before [addr]. Returns a human-readable error
	656	string if it's already the lowest address. *)
668	657
669	658	module Prefix : sig
670	659	type addr = t
671	660
	661	type t = (V4.Prefix.t, V6.Prefix.t) v4v6
672	662	(** Type of a internet protocol subnet *)
673		type t = (V4.Prefix.t, V6.Prefix.t) v4v6
674
	663
	664	val to_string : t -> string
675	665	(** [to_string subnet] is the text string representation of [subnet]. *)
676		val to_string : t -> string
677
	666
	667	val to_buffer : Buffer.t -> t -> unit
678	668	(** [to_buffer buf subnet] writes the text string representation of [subnet]
679	669	into [buf]. *)
680		val to_buffer : Buffer.t -> t -> unit
681
682		(** [pp f subnet] outputs a human-readable representation of [subnet]
683		to the formatter [f]. *)
684		val pp : Format.formatter -> t -> unit [@@ocaml.toplevel_printer]
685
686		(** [of_string_exn cidr] is the subnet prefix represented by the CIDR
687		string, [cidr]. Raises {!Parse_error} if [cidr] is not a valid
688		representation of a CIDR notation routing prefix. *)
	670
	671	val pp : Format.formatter -> t -> unit
	672	[@@ocaml.toplevel_printer]
	673	(** [pp f subnet] outputs a human-readable representation of [subnet] to the
	674	formatter [f]. *)
	675
689	676	val of_string_exn : string -> t
690
691		(** Same as {!of_string_exn} but returns a result type instead of raising
692		an exception. *)
693		val of_string : string -> (t, [> `Msg of string]) result
694
695		(** Same as {!of_string_exn} but takes as an extra argument the offset
696		into the string for reading. *)
	677	(** [of_string_exn cidr] is the subnet prefix represented by the CIDR string,
	678	[cidr]. Raises {!Parse_error} if [cidr] is not a valid representation of a
	679	CIDR notation routing prefix. *)
	680
	681	val of_string : string -> (t, [> `Msg of string ]) result
	682	(** Same as {!of_string_exn} but returns a result type instead of raising an
	683	exception. *)
	684
697	685	val of_string_raw : string -> int ref -> t
698
699		(** [v4_of_v6 ipv6] is the IPv4 representation of the IPv6 subnet [ipv6].
700		If [ipv6] is not an IPv4-mapped subnet, None is returned. *)
	686	(** Same as {!of_string_exn} but takes as an extra argument the offset into
	687	the string for reading. *)
	688
701	689	val v4_of_v6 : V6.Prefix.t -> V4.Prefix.t option
702
	690	(** [v4_of_v6 ipv6] is the IPv4 representation of the IPv6 subnet [ipv6]. If
	691	[ipv6] is not an IPv4-mapped subnet, None is returned. *)
	692
	693	val to_v4 : t -> V4.Prefix.t option
703	694	(** [to_v4 subnet] is the IPv4 representation of [subnet]. *)
704		val to_v4 : t -> V4.Prefix.t option
705
	695
	696	val v6_of_v4 : V4.Prefix.t -> V6.Prefix.t
706	697	(** [v6_of_v4 ipv4] is the IPv6 representation of the IPv4 subnet [ipv4]. *)
707		val v6_of_v4 : V4.Prefix.t -> V6.Prefix.t
708
	698
	699	val to_v6 : t -> V6.Prefix.t
709	700	(** [to_v6 subnet] is the IPv6 representation of [subnet]. *)
710		val to_v6 : t -> V6.Prefix.t
711
	701
	702	val mem : addr -> t -> bool
712	703	(** [mem ip subnet] checks whether [ip] is found within [subnet]. *)
713		val mem : addr -> t -> bool
714
715		(** [subset ~subnet ~network] checks whether [subnet] is contained
716		within [network]. *)
	704
717	705	val subset : subnet:t -> network:t -> bool
718
	706	(** [subset ~subnet ~network] checks whether [subnet] is contained within
	707	[network]. *)
	708
	709	val of_addr : addr -> t
719	710	(** [of_addr ip] create a subnet composed of only one address, [ip].*)
720		val of_addr : addr -> t
721
	711
	712	val network : t -> addr
722	713	(** [network subnet] is the address for [subnet]. *)
723		val network : t -> addr
724
	714
	715	val netmask : t -> addr
725	716	(** [netmask subnet] is the netmask for [subnet]. *)
726		val netmask : t -> addr
727
	717
	718	val first : t -> addr
728	719	(** [first subnet] is first valid unicast address in this [subnet]. *)
729		val first : t -> addr
730
	720
	721	val last : t -> addr
731	722	(** [last subnet] is last valid unicast address in this [subnet]. *)
732		val last : t -> addr
733	723
734	724	include Map.OrderedType with type t := t
735	725	end

-7

lib/ipaddr_cstruct.ml less more

22	22	with Ipaddr.Parse_error (msg, _) -> Error (`Msg ("Ipaddr: " ^ msg))
23	23
24	24	module V4 = struct
25
26	25	let of_cstruct_exn cs =
27	26	let len = Cstruct.len cs in
28	27	if len < 4 then raise (need_more (Cstruct.to_string cs));
29	28	Ipaddr.V4.of_int32 (Cstruct.BE.get_uint32 cs 0)
30	29
31		let of_cstruct cs =
32		try_with_result of_cstruct_exn cs
	30	let of_cstruct cs = try_with_result of_cstruct_exn cs
33	31
34	32	let write_cstruct_exn i cs =
35	33	let len = Cstruct.len cs in

40	38	let cs = allocator 4 in
41	39	write_cstruct_exn i cs;
42	40	cs
43
44	41	end
45	42
46	43	module V6 = struct
47
48	44	open Ipaddr.V6
49	45
50	46	let of_cstruct_exn cs =

56	52	let lolo = Cstruct.BE.get_uint32 cs 12 in
57	53	of_int32 (hihi, hilo, lohi, lolo)
58	54
59		let of_cstruct cs =
60		try_with_result of_cstruct_exn cs
	55	let of_cstruct cs = try_with_result of_cstruct_exn cs
61	56
62	57	let write_cstruct_exn i cs =
63	58	let len = Cstruct.len cs in

+20

-22

lib/ipaddr_cstruct.mli less more

19	19
20	20	(** Ipv4 address conversions *)
21	21	module V4 : sig
	22	val of_cstruct : Cstruct.t -> (Ipaddr.V4.t, [> `Msg of string ]) result
	23	(** [of_cstruct c] parses the first 4 octets of [c] into an IPv4 address. *)
22	24
23		(** [of_cstruct c] parses the first 4 octets of [c] into an IPv4 address. *)
24		val of_cstruct : Cstruct.t -> (Ipaddr.V4.t, [> `Msg of string ]) result
25
	25	val of_cstruct_exn : Cstruct.t -> Ipaddr.V4.t
26	26	(** [of_cstruct_exn] parses the first 4 octets of [c] into an IPv4 address.
27	27	Raises {!Ipaddr.Parse_failure} on error. *)
28		val of_cstruct_exn : Cstruct.t -> Ipaddr.V4.t
29	28
30		(** [to_cstruct ipv4] is a cstruct of length 4 encoding [ipv4].
31		The cstruct is allocated using [allocator]. If [allocator] is
32		not provided, [Cstruct.create] is used. *)
33		val to_cstruct: ?allocator:(int -> Cstruct.t) -> Ipaddr.V4.t -> Cstruct.t
	29	val to_cstruct : ?allocator:(int -> Cstruct.t) -> Ipaddr.V4.t -> Cstruct.t
	30	(** [to_cstruct ipv4] is a cstruct of length 4 encoding [ipv4]. The cstruct is
	31	allocated using [allocator]. If [allocator] is not provided,
	32	[Cstruct.create] is used. *)
34	33
35		(** [write_cstruct_exn ipv4 cs] writes 4 bytes into [cs] representing
36		the [ipv4] address octets. Raises {!Ipaddr.Parse_error} if [cs]
37		is not at least 4 bytes long. *)
38	34	val write_cstruct_exn : Ipaddr.V4.t -> Cstruct.t -> unit
	35	(** [write_cstruct_exn ipv4 cs] writes 4 bytes into [cs] representing the
	36	[ipv4] address octets. Raises {!Ipaddr.Parse_error} if [cs] is not at
	37	least 4 bytes long. *)
39	38	end
40	39
41	40	(** Ipv6 address conversions *)
42	41	module V6 : sig
	42	val of_cstruct : Cstruct.t -> (Ipaddr.V6.t, [> `Msg of string ]) result
	43	(** [of_cstruct c] parses the first 16 octets of [c] into an IPv6 address. *)
43	44
44		(** [of_cstruct c] parses the first 16 octets of [c] into an IPv6 address. *)
45		val of_cstruct : Cstruct.t -> (Ipaddr.V6.t, [> `Msg of string ]) result
46
	45	val of_cstruct_exn : Cstruct.t -> Ipaddr.V6.t
47	46	(** [of_cstruct_exn] parses the first 16 octets of [c] into an IPv6 address.
48	47	Raises {!Ipaddr.Parse_failure} on error. *)
49		val of_cstruct_exn : Cstruct.t -> Ipaddr.V6.t
50	48
51		(** [to_cstruct ipv6] is a cstruct of length 16 encoding [ipv6].
52		The cstruct is allocated using [allocator]. If [allocator] is
53		not provided, [Cstruct.create] is used. *)
54		val to_cstruct: ?allocator:(int -> Cstruct.t) -> Ipaddr.V6.t -> Cstruct.t
	49	val to_cstruct : ?allocator:(int -> Cstruct.t) -> Ipaddr.V6.t -> Cstruct.t
	50	(** [to_cstruct ipv6] is a cstruct of length 16 encoding [ipv6]. The cstruct
	51	is allocated using [allocator]. If [allocator] is not provided,
	52	[Cstruct.create] is used. *)
55	53
56		(** [write_cstruct_exn ipv6 cs] writes 16 bytes into [cs] representing
57		the [ipv6] address octets. Raises {!Ipaddr.Parse_error} if [cs]
58		is not at least 16 bytes long. *)
59	54	val write_cstruct_exn : Ipaddr.V6.t -> Cstruct.t -> unit
	55	(** [write_cstruct_exn ipv6 cs] writes 16 bytes into [cs] representing the
	56	[ipv6] address octets. Raises {!Ipaddr.Parse_error} if [cs] is not at
	57	least 16 bytes long. *)
60	58	end

-1

lib/ipaddr_sexp.ml less more

19	19	let of_sexp fn = function
20	20	\| Sexp.List _ -> failwith "expecting sexp atom"
21	21	\| Sexp.Atom s -> (
22		match fn s with Ok r -> r \| Error (`Msg msg) -> failwith msg )
	22	match fn s with Ok r -> r \| Error (`Msg msg) -> failwith msg)
23	23
24	24	let to_sexp fn t = Sexp.Atom (fn t)
25	25

+19

-23

lib/ipaddr_sexp.mli less more

14	14	*
15	15	*)
16	16
17		(** serialisers to and from {!Ipaddr} and s-expression {!Sexplib0} format
18
19		To use these with ppx-based derivers, simply replace the reference to the
20		{!Ipaddr} type definition with {!Ipaddr_sexp} instead. That will import the
21		sexp-conversion functions, and the actual type definitions are simply aliases
22		to the corresponding type within {!Ipaddr}. For example, you might do:
	17	(** serialisers to and from {!Ipaddr} and s-expression {!Sexplib0} format
23	18
24		{[
25		type t = {
26		ip: Ipaddr_sexp.t;
27		mac: Macaddr_sexp.t;
28		} [@@deriving sexp]
29		]}
	19	To use these with ppx-based derivers, simply replace the reference to the
	20	{!Ipaddr} type definition with {!Ipaddr_sexp} instead. That will import the
	21	sexp-conversion functions, and the actual type definitions are simply
	22	aliases to the corresponding type within {!Ipaddr}. For example, you might
	23	do:
30	24
31		The actual types of the records will be aliases to the main library types,
32		and there will be two new functions available as converters.
	25	{[
	26	type t = { ip : Ipaddr_sexp.t; mac : Macaddr_sexp.t } [@@deriving sexp]
	27	]}
33	28
34		{[
35		type t = {
36		ip: Ipaddr.t;
37		mac: Macaddr.t;
38		}
39		val sexp_of_t : t -> Sexplib0.t
40		val t_of_sexp : Sexplib0.t -> t
41		]}
42		*)
	29	The actual types of the records will be aliases to the main library types,
	30	and there will be two new functions available as converters.
	31
	32	{[
	33	type t = { ip : Ipaddr.t; mac : Macaddr.t }
	34
	35	val sexp_of_t : t -> Sexplib0.t
	36
	37	val t_of_sexp : Sexplib0.t -> t
	38	]} *)
43	39
44	40	type t = Ipaddr.t
45	41

+12

-11

lib/ipaddr_top.ml less more

0		let printers = [
1		"Ipaddr.pp";
2		"Ipaddr.Prefix.pp";
3		"Ipaddr.V4.pp";
4		"Ipaddr.V4.Prefix.pp";
5		"Ipaddr.V6.pp";
6		"Ipaddr.V6.Prefix.pp";
7		"Macaddr.pp";
8		]
	0	let printers =
	1	[
	2	"Ipaddr.pp";
	3	"Ipaddr.Prefix.pp";
	4	"Ipaddr.V4.pp";
	5	"Ipaddr.V4.Prefix.pp";
	6	"Ipaddr.V6.pp";
	7	"Ipaddr.V6.Prefix.pp";
	8	"Macaddr.pp";
	9	]
9	10
10		let eval_string
11		?(print_outcome = false) ?(err_formatter = Format.err_formatter) str =
	11	let eval_string ?(print_outcome = false) ?(err_formatter = Format.err_formatter)
	12	str =
12	13	let lexbuf = Lexing.from_string str in
13	14	let phrase = !Toploop.parse_toplevel_phrase lexbuf in
14	15	Toploop.execute_phrase print_outcome err_formatter phrase

-0

lib/ipaddr_top.mli less more

0	0	val printers : string list
	1
1	2	val eval_string :
2	3	?print_outcome:bool -> ?err_formatter:Format.formatter -> string -> bool
	4
3	5	val install_printers : string list -> bool

-20

lib/ipaddr_unix.ml less more

14	14	*
15	15	*)
16	16
17		let to_inet_addr t =
18		Unix.inet_addr_of_string (Ipaddr.to_string t)
	17	let to_inet_addr t = Unix.inet_addr_of_string (Ipaddr.to_string t)
19	18
20		let of_inet_addr t =
21		Ipaddr.of_string_exn (Unix.string_of_inet_addr t)
	19	let of_inet_addr t = Ipaddr.of_string_exn (Unix.string_of_inet_addr t)
22	20
23	21	module V4 = struct
	22	let to_inet_addr t = Unix.inet_addr_of_string (Ipaddr.V4.to_string t)
24	23
25		let to_inet_addr t =
26		Unix.inet_addr_of_string (Ipaddr.V4.to_string t)
	24	let of_inet_addr_exn t = Ipaddr.V4.of_string_exn (Unix.string_of_inet_addr t)
27	25
28		let of_inet_addr_exn t =
29		Ipaddr.V4.of_string_exn (Unix.string_of_inet_addr t)
30
31		let of_inet_addr t =
32		try Some (of_inet_addr_exn t)
33		with _ -> None
	26	let of_inet_addr t = try Some (of_inet_addr_exn t) with _ -> None
34	27	end
35	28
36	29	module V6 = struct
	30	let to_inet_addr t = Unix.inet_addr_of_string (Ipaddr.V6.to_string t)
37	31
38		let to_inet_addr t =
39		Unix.inet_addr_of_string (Ipaddr.V6.to_string t)
	32	let of_inet_addr_exn t = Ipaddr.V6.of_string_exn (Unix.string_of_inet_addr t)
40	33
41		let of_inet_addr_exn t =
42		Ipaddr.V6.of_string_exn (Unix.string_of_inet_addr t)
43
44		let of_inet_addr t =
45		try Some (of_inet_addr_exn t)
46		with _ -> None
	34	let of_inet_addr t = try Some (of_inet_addr_exn t) with _ -> None
47	35	end

+21

-24

lib/ipaddr_unix.mli less more

16	16
17	17	(** Convert to and from [Unix] to [Ipaddr] representations
18	18
19		{e %%VERSION%% - {{:%%PKG_HOMEPAGE%% }homepage}} *)
	19	{e v5.0.1 - {{:https://github.com/mirage/ocaml-ipaddr} homepage}} *)
20	20
21		(** [to_inet_addr ip] is the {! Unix.inet_addr} equivalent of the
22		IPv4 or IPv6 address [ip]. *)
23	21	val to_inet_addr : Ipaddr.t -> Unix.inet_addr
	22	(** [to_inet_addr ip] is the {!Unix.inet_addr} equivalent of the IPv4 or IPv6
	23	address [ip]. *)
24	24
25		(** [of_inet_addr ip] is the {! Ipaddr.t} equivalent of the
26		{! Unix.inet_addr} [ip]. *)
27	25	val of_inet_addr : Unix.inet_addr -> Ipaddr.t
	26	(** [of_inet_addr ip] is the {!Ipaddr.t} equivalent of the {!Unix.inet_addr}
	27	[ip]. *)
28	28
29	29	module V4 : sig
	30	val to_inet_addr : Ipaddr.V4.t -> Unix.inet_addr
	31	(** [to_inet_addr ip] is the {!Unix.inet_addr} equivalent of the IPv4 address
	32	[ip]. *)
30	33
31		(** [to_inet_addr ip] is the {! Unix.inet_addr} equivalent of the
32		IPv4 address [ip]. *)
33		val to_inet_addr : Ipaddr.V4.t -> Unix.inet_addr
	34	val of_inet_addr_exn : Unix.inet_addr -> Ipaddr.V4.t
	35	(** [of_inet_addr_exn ip] is the {!Ipaddr.t} equivalent of the
	36	{!Unix.inet_addr} [ip] IPv4 address. Raises {!Ipaddr.Parse_error} if [ip]
	37	is not a valid representation of an IPv4 address. *)
34	38
35		(** [of_inet_addr_exn ip] is the {! Ipaddr.t} equivalent of the
36		{!Unix.inet_addr} [ip] IPv4 address. Raises {! Ipaddr.Parse_error} if
37		[ip] is not a valid representation of an IPv4 address. *)
38		val of_inet_addr_exn : Unix.inet_addr -> Ipaddr.V4.t
39
	39	val of_inet_addr : Unix.inet_addr -> Ipaddr.V4.t option
40	40	(** Same as [of_inet_addr_exn] but returns an option type instead of raising
41	41	an exception. *)
42		val of_inet_addr : Unix.inet_addr -> Ipaddr.V4.t option
43	42	end
44	43
45	44	module V6 : sig
	45	val to_inet_addr : Ipaddr.V6.t -> Unix.inet_addr
	46	(** [to_inet_addr ip] is the {!Unix.inet_addr} equivalent of the IPv6 address
	47	[ip]. *)
46	48
47		(** [to_inet_addr ip] is the {! Unix.inet_addr} equivalent of the
48		IPv6 address [ip]. *)
49		val to_inet_addr : Ipaddr.V6.t -> Unix.inet_addr
	49	val of_inet_addr_exn : Unix.inet_addr -> Ipaddr.V6.t
	50	(** [of_inet_addr_exn ip] is the {!Ipaddr.t} equivalent of the
	51	{!Unix.inet_addr} [ip] IPv6 address. Raises {!Ipaddr.Parse_error} if [ip]
	52	is not a valid representation of an IPv6 address. *)
50	53
51
52		(** [of_inet_addr_exn ip] is the {! Ipaddr.t} equivalent of the
53		{!Unix.inet_addr} [ip] IPv6 address. Raises {! Ipaddr.Parse_error} if
54		[ip] is not a valid representation of an IPv6 address. *)
55		val of_inet_addr_exn : Unix.inet_addr -> Ipaddr.V6.t
56
	54	val of_inet_addr : Unix.inet_addr -> Ipaddr.V6.t option
57	55	(** Same as [of_inet_addr_exn] but returns an option type instead of raising
58	56	an exception. *)
59		val of_inet_addr : Unix.inet_addr -> Ipaddr.V6.t option
60	57	end

+37

-48

lib/macaddr.ml less more

19	19	let need_more x = Parse_error ("not enough data", x)
20	20
21	21	let try_with_result fn a =
22		try Ok (fn a)
23		with Parse_error (msg, _) -> Error (`Msg ("Macaddr: " ^ msg))
	22	try Ok (fn a) with Parse_error (msg, _) -> Error (`Msg ("Macaddr: " ^ msg))
24	23
25	24	type t = Bytes.t (* length 6 only *)
26	25

28	27
29	28	(* Raw MAC address off the wire (network endian) *)
30	29	let of_octets_exn x =
31		if String.length x <> 6
32		then raise (Parse_error ("MAC is exactly 6 bytes", x))
	30	if String.length x <> 6 then raise (Parse_error ("MAC is exactly 6 bytes", x))
33	31	else Bytes.of_string x
34	32
35	33	let of_octets x = try_with_result of_octets_exn x
36	34
37	35	let int_of_hex_char c =
38	36	let c = int_of_char (Char.uppercase_ascii c) - 48 in
39		if c > 9
40		then if c > 16
41		then c - 7 (* upper hex offset *)
42		else -1 (* :;<=>?@ *)
	37	if c > 9 then
	38	if c > 16 then c - 7 (* upper hex offset ) else -1 ( :;<=>?@ *)
43	39	else c
44	40
45		let is_hex i = i >=0 && i < 16
	41	let is_hex i = i >= 0 && i < 16
46	42
47	43	let bad_char i s =
48		let msg = Printf.sprintf "invalid character '%c' at %d" s.[i] i
49		in Parse_error (msg, s)
	44	let msg = Printf.sprintf "invalid character '%c' at %d" s.[i] i in
	45	Parse_error (msg, s)
50	46
51	47	let parse_hex_int term s i =
52	48	let len = String.length s in
53	49	let rec hex prev =
54	50	let j = !i in
55	51	if j >= len then prev
56		else let c = s.[j] in
57		let k = int_of_hex_char c in
58		if is_hex k
59		then (incr i; hex ((prev lsl 4) + k))
60		else if List.mem c term
61		then prev
62		else raise (bad_char j s)
	52	else
	53	let c = s.[j] in
	54	let k = int_of_hex_char c in
	55	if is_hex k then (
	56	incr i;
	57	hex ((prev lsl 4) + k))
	58	else if List.mem c term then prev
	59	else raise (bad_char j s)
63	60	in
64	61	let i = !i in
65		if i < len
66		then if is_hex (int_of_hex_char s.[i])
67		then hex 0
68		else raise (bad_char i s)
	62	if i < len then
	63	if is_hex (int_of_hex_char s.[i]) then hex 0 else raise (bad_char i s)
69	64	else raise (need_more s)
70	65
71	66	let parse_sextuple s i =
72	67	let m = Bytes.create 6 in
73	68	try
74	69	let p = !i in
75		Bytes.set m 0 (Char.chr (parse_hex_int [':';'-'] s i));
76		if !i >= String.length s
77		then raise (need_more s)
	70	Bytes.set m 0 (Char.chr (parse_hex_int [ ':'; '-' ] s i));
	71	if !i >= String.length s then raise (need_more s)
78	72	else
79		let sep = [s.[!i]] in
80		(if !i - p <> 2 then raise (Parse_error ("hex pairs required",s)));
	73	let sep = [ s.[!i] ] in
	74	if !i - p <> 2 then raise (Parse_error ("hex pairs required", s));
81	75	incr i;
82		for k=1 to 4 do
	76	for k = 1 to 4 do
83	77	let p = !i in
84	78	Bytes.set m k (Char.chr (parse_hex_int sep s i));
85		(if !i - p <> 2 then raise (Parse_error ("hex pairs required",s)));
86		incr i;
	79	if !i - p <> 2 then raise (Parse_error ("hex pairs required", s));
	80	incr i
87	81	done;
88	82	let p = !i in
89	83	Bytes.set m 5 (Char.chr (parse_hex_int [] s i));
90		(if !i - p <> 2 then raise (Parse_error ("hex pairs required",s)));
	84	if !i - p <> 2 then raise (Parse_error ("hex pairs required", s));
91	85	m
92	86	with Invalid_argument _ ->
93		raise (Parse_error ("address segment too large",s))
	87	raise (Parse_error ("address segment too large", s))
94	88
95	89	(* Read a MAC address colon-separated string *)
96	90	let of_string_exn x = parse_sextuple x (ref 0)

99	93
100	94	let chri x i = Char.code (Bytes.get x i)
101	95
102		let to_string ?(sep=':') x =
103		Printf.sprintf "%02x%c%02x%c%02x%c%02x%c%02x%c%02x"
104		(chri x 0) sep
105		(chri x 1) sep
106		(chri x 2) sep
107		(chri x 3) sep
108		(chri x 4) sep
109		(chri x 5)
	96	let to_string ?(sep = ':') x =
	97	Printf.sprintf "%02x%c%02x%c%02x%c%02x%c%02x%c%02x" (chri x 0) sep (chri x 1)
	98	sep (chri x 2) sep (chri x 3) sep (chri x 4) sep (chri x 5)
110	99
111	100	let to_octets x = Bytes.to_string x
112	101
113		let pp ppf i =
114		Format.fprintf ppf "%s" (to_string i)
	102	let pp ppf i = Format.fprintf ppf "%s" (to_string i)
115	103
116	104	let broadcast = Bytes.make 6 '\255'
117	105
118	106	let make_local bytegenf =
119	107	let x = Bytes.create 6 in
120	108	(* set locally administered and unicast bits *)
121		Bytes.set x 0 (Char.chr ((((bytegenf 0) lor 2) lsr 1) lsl 1));
122		for i = 1 to 5 do Bytes.set x i (Char.chr (bytegenf i)) done;
	109	Bytes.set x 0 (Char.chr (((bytegenf 0 lor 2) lsr 1) lsl 1));
	110	for i = 1 to 5 do
	111	Bytes.set x i (Char.chr (bytegenf i))
	112	done;
123	113	x
124	114
125		let get_oui x =
126		((chri x 0) lsl 16) lor ((chri x 1) lsl 8) lor (chri x 2)
	115	let get_oui x = (chri x 0 lsl 16) lor (chri x 1 lsl 8) lor chri x 2
127	116
128		let is_local x = (((chri x 0) lsr 1) land 1) = 1
	117	let is_local x = (chri x 0 lsr 1) land 1 = 1
129	118
130		let is_unicast x = ((chri x 0) land 1) = 0
	119	let is_unicast x = chri x 0 land 1 = 0

+28

-28

lib/macaddr.mli less more

15	15
16	16	(** A library for manipulation of MAC address representations.
17	17
18		{e %%VERSION%% - {{:%%PKG_HOMEPAGE%% }homepage}} *)
	18	{e v5.0.1 - {{:https://github.com/mirage/ocaml-ipaddr} homepage}} *)
19	19
20		(** [Parse_error (err,packet)] is raised when parsing of the MAC
21		address syntax fails. [err] contains a human-readable error
22		and [packet] is the original octet list that failed to parse. *)
23	20	exception Parse_error of string * string
	21	(** [Parse_error (err,packet)] is raised when parsing of the MAC address syntax
	22	fails. [err] contains a human-readable error and [packet] is the original
	23	octet list that failed to parse. *)
24	24
	25	type t
25	26	(** Type of the hardware address (MAC) of an ethernet interface. *)
26		type t
27	27
28	28	(** {2 Functions converting MAC addresses to/from octets/string} *)
29	29
30		(** [of_octets_exn buf] is the hardware address extracted from
31		[buf]. Raises [Parse_error] if [buf] has not length 6. *)
32	30	val of_octets_exn : string -> t
	31	(** [of_octets_exn buf] is the hardware address extracted from [buf]. Raises
	32	[Parse_error] if [buf] has not length 6. *)
33	33
34		(** Same as {!of_octets_exn} but returns a result type instead of
35		raising an exception. *)
36		val of_octets : string -> (t, [> `Msg of string]) result
	34	val of_octets : string -> (t, [> `Msg of string ]) result
	35	(** Same as {!of_octets_exn} but returns a result type instead of raising an
	36	exception. *)
37	37
38		(** [of_string_exn mac_string] is the human-readable hardware address represented by
39		[mac_string]. Raises {!Parse_error} if [mac_string] is not a
	38	val of_string_exn : string -> t
	39	(** [of_string_exn mac_string] is the human-readable hardware address
	40	represented by [mac_string]. Raises {!Parse_error} if [mac_string] is not a
40	41	valid representation of a MAC address. *)
41		val of_string_exn : string -> t
42	42
	43	val of_string : string -> (t, [> `Msg of string ]) result
43	44	(** Same as {!of_string_exn} but returns a result type instead of raising an
44	45	exception. *)
45		val of_string : string -> (t, [> `Msg of string]) result
46	46
47		(** [to_octets mac_addr] is a string of size 6 encoding [mac_addr] as a
48		sequence of bytes. *)
49	47	val to_octets : t -> string
	48	(** [to_octets mac_addr] is a string of size 6 encoding [mac_addr] as a sequence
	49	of bytes. *)
50	50
	51	val to_string : ?sep:char -> t -> string
51	52	(** [to_string ?(sep=':') mac_addr] is the [sep]-separated string representation
52	53	of [mac_addr], i.e. [xx:xx:xx:xx:xx:xx]. *)
53		val to_string : ?sep:char -> t -> string
54	54
55		(** [pp f mac_addr] outputs a human-readable representation of [mac_addr] to
56		the formatter [f]. *)
57		val pp : Format.formatter -> t -> unit [@@ocaml.toplevel_printer]
	55	val pp : Format.formatter -> t -> unit
	56	[@@ocaml.toplevel_printer]
	57	(** [pp f mac_addr] outputs a human-readable representation of [mac_addr] to the
	58	formatter [f]. *)
58	59
	60	val broadcast : t
59	61	(** [broadcast] is [ff:ff:ff:ff:ff:ff]. *)
60		val broadcast : t
61	62
62		(** [make_local bytegen] creates a unicast, locally administered MAC
63		address given a function mapping octet offset to octet value. *)
64	63	val make_local : (int -> int) -> t
	64	(** [make_local bytegen] creates a unicast, locally administered MAC address
	65	given a function mapping octet offset to octet value. *)
65	66
	67	val get_oui : t -> int
66	68	(** [get_oui macaddr] is the integer organization identifier for [macaddr]. *)
67		val get_oui : t -> int
68	69
69		(** [is_local macaddr] is the predicate on the locally administered bit
70		of [macaddr]. *)
71	70	val is_local : t -> bool
	71	(** [is_local macaddr] is the predicate on the locally administered bit of
	72	[macaddr]. *)
72	73
73		(** [is_unicast macaddr] the is the predicate on the unicast bit of
74		[macaddr]. *)
75	74	val is_unicast : t -> bool
	75	(** [is_unicast macaddr] the is the predicate on the unicast bit of [macaddr]. *)
76	76
77	77	include Map.OrderedType with type t := t

-5

lib/macaddr_cstruct.ml less more

20	20	with Macaddr.Parse_error (msg, _) -> Error (`Msg ("Macaddr: " ^ msg))
21	21
22	22	let of_cstruct_exn cs =
23		if Cstruct.len cs <> 6
24		then raise (Macaddr.Parse_error ("MAC is exactly 6 bytes", Cstruct.to_string cs))
	23	if Cstruct.len cs <> 6 then
	24	raise (Macaddr.Parse_error ("MAC is exactly 6 bytes", Cstruct.to_string cs))
25	25	else Cstruct.to_string cs \|> Macaddr.of_octets_exn
26	26
27		let of_cstruct cs =
28		try_with_result of_cstruct_exn cs
	27	let of_cstruct cs = try_with_result of_cstruct_exn cs
29	28
30		let write_cstruct_exn (mac:Macaddr.t) cs =
	29	let write_cstruct_exn (mac : Macaddr.t) cs =
31	30	let len = Cstruct.len cs in
32	31	let mac = Macaddr.to_octets mac in
33	32	if len <> 6 then raise (Macaddr.Parse_error ("MAC is exactly 6 bytes", mac));

-10

lib/macaddr_cstruct.mli less more

17	17
18	18	(** Convert to and from Cstructs and MAC address. *)
19	19
	20	val of_cstruct : Cstruct.t -> (Macaddr.t, [> `Msg of string ]) result
20	21	(** [of_cstruct c] parses the 6 octets of [c] into a MAC address. *)
21		val of_cstruct : Cstruct.t -> (Macaddr.t, [> `Msg of string ]) result
22	22
23		(** [of_cstruct_exn] parses the 6 octets of [c] into a MAC address.
24		Raises {!Macaddr.Parse_failure} on error. *)
25	23	val of_cstruct_exn : Cstruct.t -> Macaddr.t
	24	(** [of_cstruct_exn] parses the 6 octets of [c] into a MAC address. Raises
	25	{!Macaddr.Parse_failure} on error. *)
26	26
27		(** [to_cstruct mac] is a cstruct of length 4 encoding [ipv4].
28		The cstruct is allocated using [allocator]. If [allocator] is
29		not provided, [Cstruct.create] is used. *)
30		val to_cstruct: ?allocator:(int -> Cstruct.t) -> Macaddr.t -> Cstruct.t
	27	val to_cstruct : ?allocator:(int -> Cstruct.t) -> Macaddr.t -> Cstruct.t
	28	(** [to_cstruct mac] is a cstruct of length 4 encoding [ipv4]. The cstruct is
	29	allocated using [allocator]. If [allocator] is not provided,
	30	[Cstruct.create] is used. *)
31	31
32		(** [write_cstruct_exn mac cs] writes 6 bytes into [cs] representing
33		the [mac] address octets. Raises {!Macaddr.Parse_error} if [cs]
34		is not 6 bytes long. *)
35	32	val write_cstruct_exn : Macaddr.t -> Cstruct.t -> unit
	33	(** [write_cstruct_exn mac cs] writes 6 bytes into [cs] representing the [mac]
	34	address octets. Raises {!Macaddr.Parse_error} if [cs] is not 6 bytes long. *)

-1

lib/macaddr_sexp.ml less more

19	19	let of_sexp fn = function
20	20	\| Sexp.List _ -> failwith "expecting sexp atom"
21	21	\| Sexp.Atom s -> (
22		match fn s with Ok r -> r \| Error (`Msg msg) -> failwith msg )
	22	match fn s with Ok r -> r \| Error (`Msg msg) -> failwith msg)
23	23
24	24	let to_sexp fn t = Sexp.Atom (fn t)
25	25

+17

-22

lib/macaddr_sexp.mli less more

16	16
17	17	(** serialisers to and from {!Macaddr} and s-expression {!Sexplib0} format
18	18
19		To use these with ppx-based derivers, simply replace the reference to the
20		{!Macaddr} type definition with {!Macaddr_sexp} instead. That will import the
21		sexp-conversion functions, and the actual type definitions are simply aliases
22		to the corresponding type within {!Ipaddr}. For example, you might do:
	19	To use these with ppx-based derivers, simply replace the reference to the
	20	{!Macaddr} type definition with {!Macaddr_sexp} instead. That will import
	21	the sexp-conversion functions, and the actual type definitions are simply
	22	aliases to the corresponding type within {!Ipaddr}. For example, you might
	23	do:
23	24
24		{[
25		type t = {
26		ip: Ipaddr_sexp.t;
27		mac: Macaddr_sexp.t;
28		} [@@deriving sexp]
29		]}
	25	{[
	26	type t = { ip : Ipaddr_sexp.t; mac : Macaddr_sexp.t } [@@deriving sexp]
	27	]}
30	28
31		The actual types of the records will be aliases to the main library types,
32		and there will be two new functions available as converters.
	29	The actual types of the records will be aliases to the main library types,
	30	and there will be two new functions available as converters.
33	31
34		{[
35		type t = {
36		ip: Ipaddr.t;
37		mac: Macaddr.t;
38		}
39		val sexp_of_t : t -> Sexplib0.t
40		val t_of_sexp : Sexplib0.t -> t
41		]}
42		*)
	32	{[
	33	type t = { ip : Ipaddr.t; mac : Macaddr.t }
	34
	35	val sexp_of_t : t -> Sexplib0.t
	36
	37	val t_of_sexp : Sexplib0.t -> t
	38	]} *)
43	39
44	40	type t = Macaddr.t
45	41

48	44	val t_of_sexp : Sexplib0.Sexp.t -> Macaddr.t
49	45
50	46	val compare : Macaddr.t -> Macaddr.t -> int
51

-5

lib/macaddr_top.ml less more

0		let printers = [
1		"Macaddr.pp";
2		]
	0	let printers = [ "Macaddr.pp" ]
3	1
4		let eval_string
5		?(print_outcome = false) ?(err_formatter = Format.err_formatter) str =
	2	let eval_string ?(print_outcome = false) ?(err_formatter = Format.err_formatter)
	3	str =
6	4	let lexbuf = Lexing.from_string str in
7	5	let phrase = !Toploop.parse_toplevel_phrase lexbuf in
8	6	Toploop.execute_phrase print_outcome err_formatter phrase

+11

-5

lib_test/dune less more

0		(rule (copy# ../lib/ipaddr_sexp.ml ipaddr_sexp.ml))
1		(rule (copy# ../lib/macaddr_sexp.ml macaddr_sexp.ml))
2		(rule (copy# ../lib/ipaddr.ml ipaddr_internal.ml))
	0	(rule
	1	(copy# ../lib/ipaddr_sexp.ml ipaddr_sexp.ml))
3	2
	3	(rule
	4	(copy# ../lib/macaddr_sexp.ml macaddr_sexp.ml))
	5
	6	(rule
	7	(copy# ../lib/ipaddr.ml ipaddr_internal.ml))
4	8
5	9	(library
6	10	(name test_macaddr_sexp)
7	11	(wrapped false)
8	12	(modules macaddr_sexp)
9		(preprocess (pps ppx_sexp_conv))
	13	(preprocess
	14	(pps ppx_sexp_conv))
10	15	(libraries macaddr sexplib0))
11	16
12	17	(library
13	18	(name test_ipaddr_sexp)
14	19	(wrapped false)
15	20	(modules ipaddr_sexp)
16		(preprocess (pps ppx_sexp_conv))
	21	(preprocess
	22	(pps ppx_sexp_conv))
17	23	(libraries ipaddr sexplib0))
18	24
19	25	(test

+718

-586

lib_test/test_ipaddr.ml less more

17	17	open OUnit
18	18	open Ipaddr
19	19
20		let error s msg = s, Parse_error (msg,s)
	20	let error s msg = (s, Parse_error (msg, s))
	21
21	22	let need_more s = error s "not enough data"
	23
22	24	let bad_char i s =
23	25	error s (Printf.sprintf "invalid character '%c' at %d" s.[i] i)
24	26
25		let (>>=) v f = match v with Ok v -> f v \| Error _ as e -> e
	27	let ( >>= ) v f = match v with Ok v -> f v \| Error _ as e -> e
26	28
27	29	let assert_raises ~msg exn test_fn =
28	30	assert_raises ~msg exn (fun () ->
29		try test_fn ()
30		with rtexn -> begin
31		(if exn <> rtexn then (
32		Printf.eprintf "Stacktrace for '%s':\n%!" msg;
33		Printexc.print_backtrace stderr;
34		));
35		raise rtexn
36		end)
	31	try test_fn ()
	32	with rtexn ->
	33	if exn <> rtexn then (
	34	Printf.eprintf "Stacktrace for '%s':\n%!" msg;
	35	Printexc.print_backtrace stderr);
	36	raise rtexn)
37	37
38	38	module Test_v4 = struct
39	39	let test_string_rt () =
40		let addrs = [
41		"192.168.0.1", "192.168.0.1";
42		] in
43		List.iter (fun (addr,rt) ->
44		let os = V4.of_string_exn addr in
45		let ts = V4.to_string os in
46		assert_equal ~msg:addr ts rt;
47		let os = Ipaddr_sexp.(V4.t_of_sexp (V4.sexp_of_t os)) in
48		let ts = V4.to_string os in
49		assert_equal ~msg:addr ts rt;
50		) addrs
	40	let addrs = [ ("192.168.0.1", "192.168.0.1") ] in
	41	List.iter
	42	(fun (addr, rt) ->
	43	let os = V4.of_string_exn addr in
	44	let ts = V4.to_string os in
	45	assert_equal ~msg:addr ts rt;
	46	let os = Ipaddr_sexp.(V4.t_of_sexp (V4.sexp_of_t os)) in
	47	let ts = V4.to_string os in
	48	assert_equal ~msg:addr ts rt)
	49	addrs
51	50
52	51	let test_string_rt_bad () =
53		let addrs = [
54		need_more "192.168.0";
55		bad_char 11 "192.168.0.1.1";
56		error "192.268.2.1" "second octet out of bounds";
57		bad_char 4 "192. 168.1.1";
58		bad_char 4 "192..0.1";
59		bad_char 3 "192,168.0.1";
60		] in
61		List.iter (fun (addr,exn) ->
62		assert_raises ~msg:addr exn (fun () -> V4.of_string_exn addr)
63		) addrs
	52	let addrs =
	53	[
	54	need_more "192.168.0";
	55	bad_char 11 "192.168.0.1.1";
	56	error "192.268.2.1" "second octet out of bounds";
	57	bad_char 4 "192. 168.1.1";
	58	bad_char 4 "192..0.1";
	59	bad_char 3 "192,168.0.1";
	60	]
	61	in
	62	List.iter
	63	(fun (addr, exn) ->
	64	assert_raises ~msg:addr exn (fun () -> V4.of_string_exn addr))
	65	addrs
64	66
65	67	let test_string_raw_rt () =
66		let addrs = [
67		("IP: 192.168.0.1!!!",4), ("192.168.0.1",15);
68		("IP: 192.168.0.1.1!!!",4), ("192.168.0.1",15);
69		] in
70		List.iter (fun ((addr,off),result) ->
71		let c = ref off in
72		let os = V4.of_string_raw addr c in
73		let ts = V4.to_string os in
74		assert_equal ~msg:addr (ts,!c) result
75		) addrs
	68	let addrs =
	69	[
	70	(("IP: 192.168.0.1!!!", 4), ("192.168.0.1", 15));
	71	(("IP: 192.168.0.1.1!!!", 4), ("192.168.0.1", 15));
	72	]
	73	in
	74	List.iter
	75	(fun ((addr, off), result) ->
	76	let c = ref off in
	77	let os = V4.of_string_raw addr c in
	78	let ts = V4.to_string os in
	79	assert_equal ~msg:addr (ts, !c) result)
	80	addrs
76	81
77	82	let test_string_raw_rt_bad () =
78		let addrs = [
79		(let s = "IP: 192.168.0!!!" in
80		(s,4), (Parse_error ("invalid character '!' at 13",s), 13));
81		] in
82		List.iter (fun ((addr,off),(exn,cursor)) ->
83		let c = ref off in
84		assert_raises ~msg:addr exn (fun () -> V4.of_string_raw addr c);
85		assert_equal ~msg:(Printf.sprintf "%s cursor <> %d (%d)" addr cursor !c)
86		!c cursor
87		) addrs
	83	let addrs =
	84	[
	85	(let s = "IP: 192.168.0!!!" in
	86	((s, 4), (Parse_error ("invalid character '!' at 13", s), 13)));
	87	]
	88	in
	89	List.iter
	90	(fun ((addr, off), (exn, cursor)) ->
	91	let c = ref off in
	92	assert_raises ~msg:addr exn (fun () -> V4.of_string_raw addr c);
	93	assert_equal
	94	~msg:(Printf.sprintf "%s cursor <> %d (%d)" addr cursor !c)
	95	!c cursor)
	96	addrs
88	97
89	98	let test_bytes_rt () =
90	99	let addr = "\254\099\003\128" in
91	100	assert_equal ~msg:(String.escaped addr)
92		V4.(to_octets (of_octets_exn addr)) addr
	101	V4.(to_octets (of_octets_exn addr))
	102	addr
93	103
94	104	let test_bytes_rt_bad () =
95		let addrs = [
96		need_more "\254\099\003";
97		] in
98		List.iter (fun (addr,exn) ->
99		assert_raises ~msg:(String.escaped addr) exn
100		(fun () -> V4.of_octets_exn addr)
101		) addrs
	105	let addrs = [ need_more "\254\099\003" ] in
	106	List.iter
	107	(fun (addr, exn) ->
	108	assert_raises ~msg:(String.escaped addr) exn (fun () ->
	109	V4.of_octets_exn addr))
	110	addrs
102	111
103	112	let test_int32_rt () =
104	113	let addr = 0x0_F0_AB_00_01_l in
105		assert_equal ~msg:(Printf.sprintf "%08lX" addr)
106		V4.(to_int32 (of_int32 addr)) addr
	114	assert_equal
	115	~msg:(Printf.sprintf "%08lX" addr)
	116	V4.(to_int32 (of_int32 addr))
	117	addr
107	118
108	119	let test_prefix_string_rt () =
109		let subnets = [
110		"192.168.0.0/24", "192.168.0.0/24";
111		"0.0.0.0/0", "0.0.0.0/0";
112		"192.168.0.1/24", "192.168.0.0/24";
113		"192.168.0.0/0", "0.0.0.0/0";
114		] in
115		List.iter (fun (subnet,rt) ->
116		let os = V4.Prefix.of_string_exn subnet \|> V4.Prefix.prefix in
117		let ts = V4.Prefix.to_string os in
118		assert_equal ~msg:subnet ts rt;
119		let os = Ipaddr_sexp.(V4.Prefix.(t_of_sexp (sexp_of_t os))) in
120		let ts = V4.Prefix.to_string os in
121		assert_equal ~msg:subnet ts rt;
122		) subnets
	120	let subnets =
	121	[
	122	("192.168.0.0/24", "192.168.0.0/24");
	123	("0.0.0.0/0", "0.0.0.0/0");
	124	("192.168.0.1/24", "192.168.0.0/24");
	125	("192.168.0.0/0", "0.0.0.0/0");
	126	]
	127	in
	128	List.iter
	129	(fun (subnet, rt) ->
	130	let os = V4.Prefix.of_string_exn subnet \|> V4.Prefix.prefix in
	131	let ts = V4.Prefix.to_string os in
	132	assert_equal ~msg:subnet ts rt;
	133	let os = Ipaddr_sexp.(V4.Prefix.(t_of_sexp (sexp_of_t os))) in
	134	let ts = V4.Prefix.to_string os in
	135	assert_equal ~msg:subnet ts rt)
	136	subnets
123	137
124	138	let test_prefix_string_rt_bad () =
125		let subnets = [
126		bad_char 9 "192.168.0/24";
127		bad_char 10 "192.168.0./24";
128		error "192.168.0.0/33" "invalid prefix size";
129		bad_char 14 "192.168.0.0/30/1";
130		bad_char 12 "192.168.0.0/-1";
131		] in
132		List.iter (fun (subnet,exn) ->
133		assert_raises ~msg:subnet exn (fun () -> V4.Prefix.of_string_exn subnet)
134		) subnets
	139	let subnets =
	140	[
	141	bad_char 9 "192.168.0/24";
	142	bad_char 10 "192.168.0./24";
	143	error "192.168.0.0/33" "invalid prefix size";
	144	bad_char 14 "192.168.0.0/30/1";
	145	bad_char 12 "192.168.0.0/-1";
	146	]
	147	in
	148	List.iter
	149	(fun (subnet, exn) ->
	150	assert_raises ~msg:subnet exn (fun () -> V4.Prefix.of_string_exn subnet))
	151	subnets
135	152
136	153	let test_network_address_rt () =
137		let netaddrs = [
138		"192.168.0.1/24", "192.168.0.0/24", "192.168.0.1";
139		] in
140		List.iter (fun (netaddr,net,addr) ->
141		let netv4 = V4.Prefix.of_string_exn net in
142		let addrv4 = V4.of_string_exn addr in
143		let cidr = V4.Prefix.of_string_exn netaddr in
144		let prefix = V4.Prefix.prefix cidr
145		and v4 = V4.Prefix.address cidr
146		in
147		assert_equal ~msg:(net^" <> "^(V4.Prefix.to_string prefix)) netv4 prefix;
148		assert_equal ~msg:(addr^" <> "^(V4.to_string v4)) addrv4 v4;
149		let addrstr = V4.Prefix.to_string cidr in
150		assert_equal ~msg:(netaddr^" <> "^addrstr) netaddr addrstr;
151		) netaddrs
	154	let netaddrs = [ ("192.168.0.1/24", "192.168.0.0/24", "192.168.0.1") ] in
	155	List.iter
	156	(fun (netaddr, net, addr) ->
	157	let netv4 = V4.Prefix.of_string_exn net in
	158	let addrv4 = V4.of_string_exn addr in
	159	let cidr = V4.Prefix.of_string_exn netaddr in
	160	let prefix = V4.Prefix.prefix cidr and v4 = V4.Prefix.address cidr in
	161	assert_equal
	162	~msg:(net ^ " <> " ^ V4.Prefix.to_string prefix)
	163	netv4 prefix;
	164	assert_equal ~msg:(addr ^ " <> " ^ V4.to_string v4) addrv4 v4;
	165	let addrstr = V4.Prefix.to_string cidr in
	166	assert_equal ~msg:(netaddr ^ " <> " ^ addrstr) netaddr addrstr)
	167	netaddrs
152	168
153	169	let test_prefix_broadcast () =
154		let pairs = [
155		"192.168.0.0/16", "192.168.255.255";
156		"192.168.0.0/24", "192.168.0.255";
157		"192.168.1.1/24", "192.168.1.255";
158		"192.168.0.128/29", "192.168.0.135";
159		"0.0.0.0/0", "255.255.255.255";
160		] in
161		List.iter (fun (subnet,bcast) ->
162		let r = V4.(to_string (Prefix.(broadcast (of_string_exn subnet)))) in
163		assert_equal ~msg:(subnet ^ " <> " ^ r) r bcast
164		) pairs
	170	let pairs =
	171	[
	172	("192.168.0.0/16", "192.168.255.255");
	173	("192.168.0.0/24", "192.168.0.255");
	174	("192.168.1.1/24", "192.168.1.255");
	175	("192.168.0.128/29", "192.168.0.135");
	176	("192.168.0.0/31", "192.168.0.1");
	177	("192.168.0.0/32", "192.168.0.0");
	178	("0.0.0.0/0", "255.255.255.255");
	179	]
	180	in
	181	List.iter
	182	(fun (subnet, bcast) ->
	183	let r = V4.(to_string Prefix.(broadcast (of_string_exn subnet))) in
	184	assert_equal ~msg:(subnet ^ " <> " ^ r) r bcast)
	185	pairs
165	186
166	187	let test_prefix_bits () =
167		let pairs = V4.Prefix.([
168		global, 0;
169		loopback, 8;
170		link, 16;
171		relative, 8;
172		multicast, 4;
173		private_10, 8;
174		private_172, 12;
175		private_192, 16;
176		]) in
177		List.iter (fun (subnet,bits) ->
178		let msg = (V4.Prefix.to_string subnet) ^ " <> " ^ (string_of_int bits) in
179		assert_equal ~msg (V4.Prefix.bits subnet) bits
180		) pairs
	188	let pairs =
	189	V4.Prefix.
	190	[
	191	(global, 0);
	192	(loopback, 8);
	193	(link, 16);
	194	(relative, 8);
	195	(multicast, 4);
	196	(private_10, 8);
	197	(private_172, 12);
	198	(private_192, 16);
	199	]
	200	in
	201	List.iter
	202	(fun (subnet, bits) ->
	203	let msg = V4.Prefix.to_string subnet ^ " <> " ^ string_of_int bits in
	204	assert_equal ~msg (V4.Prefix.bits subnet) bits)
	205	pairs
181	206
182	207	let test_prefix_netmask () =
183		let nets = [
184		"192.168.0.1/32","255.255.255.255";
185		"192.168.0.1/31","255.255.255.254";
186		"192.168.0.1/1", "128.0.0.0";
187		"192.168.0.1/0", "0.0.0.0";
188		] in
189		List.iter (fun (net_str,nm_str) ->
190		let cidr = V4.Prefix.of_string_exn net_str in
191		let prefix = V4.Prefix.prefix cidr
192		and address = V4.Prefix.address cidr
193		in
194		let netmask = V4.Prefix.netmask prefix in
195		let nnm_str = V4.to_string netmask in
196		let msg = Printf.sprintf "netmask %s <> %s" nnm_str nm_str in
197		assert_equal ~msg nnm_str nm_str;
198		let prefix = V4.Prefix.of_netmask_exn ~netmask ~address in
199		let nns = V4.Prefix.to_string prefix in
200		let msg = Printf.sprintf "%s is %s under netmask iso" net_str nns in
201		assert_equal ~msg net_str nns
202		) nets
	208	let nets =
	209	[
	210	("192.168.0.1/32", "255.255.255.255");
	211	("192.168.0.1/31", "255.255.255.254");
	212	("192.168.0.1/1", "128.0.0.0");
	213	("192.168.0.1/0", "0.0.0.0");
	214	]
	215	in
	216	List.iter
	217	(fun (net_str, nm_str) ->
	218	let cidr = V4.Prefix.of_string_exn net_str in
	219	let prefix = V4.Prefix.prefix cidr
	220	and address = V4.Prefix.address cidr in
	221	let netmask = V4.Prefix.netmask prefix in
	222	let nnm_str = V4.to_string netmask in
	223	let msg = Printf.sprintf "netmask %s <> %s" nnm_str nm_str in
	224	assert_equal ~msg nnm_str nm_str;
	225	let prefix = V4.Prefix.of_netmask_exn ~netmask ~address in
	226	let nns = V4.Prefix.to_string prefix in
	227	let msg = Printf.sprintf "%s is %s under netmask iso" net_str nns in
	228	assert_equal ~msg net_str nns)
	229	nets
203	230
204	231	let test_prefix_netmask_bad () =
205		let bad_masks = [
206		error "127.255.255.255" "invalid netmask";
207		error "255.255.254.128" "invalid netmask";
208		] in
209		List.iter (fun (nm_str,exn) ->
210		let netmask = V4.of_string_exn nm_str in
211		let address = V4.of_string_exn "192.168.0.1" in
212		assert_raises ~msg:nm_str exn
213		(fun () -> V4.Prefix.of_netmask_exn ~netmask ~address)
214		) bad_masks
	232	let bad_masks =
	233	[
	234	error "127.255.255.255" "invalid netmask";
	235	error "255.255.254.128" "invalid netmask";
	236	]
	237	in
	238	List.iter
	239	(fun (nm_str, exn) ->
	240	let netmask = V4.of_string_exn nm_str in
	241	let address = V4.of_string_exn "192.168.0.1" in
	242	assert_raises ~msg:nm_str exn (fun () ->
	243	V4.Prefix.of_netmask_exn ~netmask ~address))
	244	bad_masks
215	245
216	246	let test_scope () =
217	247	let ip = V4.of_string_exn in
218	248	(let is subnet addr = V4.Prefix.(mem addr subnet) in)
219	249	let is_scope scop addr = scop = V4.scope addr in
220		let ships = V4.([
221		unspecified, "global", is_global, false;
222		unspecified, "multicast", is_multicast, false;
223		unspecified, "point", is_scope Point, true;
224		localhost, "global", is_global, false;
225		localhost, "multicast", is_multicast, false;
226		localhost, "interface", is_scope Interface, true;
227		broadcast, "global", is_global, false;
228		broadcast, "multicast", is_multicast, false;
229		broadcast, "admin", is_scope Admin, true;
230		nodes, "global", is_global, false;
231		nodes, "multicast", is_multicast, true;
232		nodes, "interface", is_scope Link, true;
233		routers, "global", is_global, false;
234		routers, "multicast", is_multicast, true;
235		routers, "link", is_scope Link, true;
236		ip "192.168.0.1", "private", is_private, true;
237		ip "10.3.21.155", "private", is_private, true;
238		ip "172.16.0.0", "private", is_private, true;
239		ip "172.31.255.255", "private", is_private, true;
240		ip "172.15.255.255", "private", is_private, false;
241		ip "172.32.0.0", "private", is_private, false;
242		]) in
243		List.iter (fun (addr,lbl,pred,is_mem) ->
244		let mems = if is_mem then "" else " not" in
245		let msg = (V4.to_string addr)^" is"^mems^" in "^lbl in
246		assert_equal ~msg (pred addr) is_mem
247		) ships
	250	let ships =
	251	V4.
	252	[
	253	(unspecified, "global", is_global, false);
	254	(unspecified, "multicast", is_multicast, false);
	255	(unspecified, "point", is_scope Point, true);
	256	(localhost, "global", is_global, false);
	257	(localhost, "multicast", is_multicast, false);
	258	(localhost, "interface", is_scope Interface, true);
	259	(broadcast, "global", is_global, false);
	260	(broadcast, "multicast", is_multicast, false);
	261	(broadcast, "admin", is_scope Admin, true);
	262	(nodes, "global", is_global, false);
	263	(nodes, "multicast", is_multicast, true);
	264	(nodes, "interface", is_scope Link, true);
	265	(routers, "global", is_global, false);
	266	(routers, "multicast", is_multicast, true);
	267	(routers, "link", is_scope Link, true);
	268	(ip "192.168.0.1", "private", is_private, true);
	269	(ip "10.3.21.155", "private", is_private, true);
	270	(ip "172.16.0.0", "private", is_private, true);
	271	(ip "172.31.255.255", "private", is_private, true);
	272	(ip "172.15.255.255", "private", is_private, false);
	273	(ip "172.32.0.0", "private", is_private, false);
	274	]
	275	in
	276	List.iter
	277	(fun (addr, lbl, pred, is_mem) ->
	278	let mems = if is_mem then "" else " not" in
	279	let msg = V4.to_string addr ^ " is" ^ mems ^ " in " ^ lbl in
	280	assert_equal ~msg (pred addr) is_mem)
	281	ships
248	282
249	283	let test_map () =
250		let module M = Map.Make(V4) in
	284	let module M = Map.Make (V4) in
251	285	let m = M.add (V4.of_string_exn "1.0.0.1") "min" M.empty in
252	286	let m = M.add (V4.of_string_exn "254.254.254.254") "the greatest host" m in
253	287	let m = M.add (V4.of_string_exn "1.0.0.1") "the least host" m in
254	288	assert_equal ~msg:"size" (M.cardinal m) 2;
255		let (min_key, min_val) = M.min_binding m in
256		assert_equal ~msg:("min is '" ^ min_val ^"'") (min_key, min_val)
	289	let min_key, min_val = M.min_binding m in
	290	assert_equal
	291	~msg:("min is '" ^ min_val ^ "'")
	292	(min_key, min_val)
257	293	(V4.of_string_exn "1.0.0.1", "the least host");
258	294	assert_equal ~msg:"max" (M.max_binding m)
259	295	(V4.of_string_exn "254.254.254.254", "the greatest host")
260	296
261	297	let test_prefix_map () =
262		let module M = Map.Make(V4.Prefix) in
	298	let module M = Map.Make (V4.Prefix) in
263	299	let of_string s = s \|> V4.Prefix.of_string_exn \|> V4.Prefix.prefix in
264	300	let m = M.add (of_string "0.0.0.0/0") "everyone" M.empty in
265	301	let m = M.add (of_string "192.0.0.0/1") "weirdos" m in

272	308	assert_equal ~msg:"max" (M.max_binding m)
273	309	(V4.Prefix.of_string_exn "254.0.0.0/8", "top-end");
274	310	assert_equal ~msg:"third"
275		(M.find (V4.Prefix.of_string_exn "128.0.0.0/1") m) "high-bitters"
	311	(M.find (V4.Prefix.of_string_exn "128.0.0.0/1") m)
	312	"high-bitters"
276	313
277	314	let test_special_addr () =
278	315	assert_equal ~msg:"broadcast" V4.broadcast V4.Prefix.(broadcast global);
279		assert_equal ~msg:"any" V4.any V4.Prefix.(network global);
	316	assert_equal ~msg:"any" V4.any V4.Prefix.(network global);
280	317	assert_equal ~msg:"localhost" true V4.(Prefix.(mem localhost loopback))
281	318
282	319	let test_multicast_mac () =
283	320	let ip = V4.of_octets_exn "\xff\xbf\x9f\x8f" in
284	321	let multicast = V4.Prefix.(network_address multicast ip) in
285		let unicast_mac_str = Macaddr.to_string (V4.multicast_to_mac ip) in
	322	let unicast_mac_str = Macaddr.to_string (V4.multicast_to_mac ip) in
286	323	let multicast_mac_str = Macaddr.to_string (V4.multicast_to_mac multicast) in
287	324	let mac_str = "01:00:5e:3f:9f:8f" in
288		assert_equal ~msg:("unicast_mac "^unicast_mac_str^" <> "^mac_str)
289		unicast_mac_str mac_str;
290		assert_equal ~msg:("multicast_mac "^multicast_mac_str^" <> "^mac_str)
	325	assert_equal
	326	~msg:("unicast_mac " ^ unicast_mac_str ^ " <> " ^ mac_str)
	327	unicast_mac_str mac_str;
	328	assert_equal
	329	~msg:("multicast_mac " ^ multicast_mac_str ^ " <> " ^ mac_str)
291	330	multicast_mac_str mac_str
292	331
293	332	let test_domain_name () =

296	335	Domain_name.(host_exn (of_string_exn "16.32.64.128.in-addr.arpa"))
297	336	in
298	337	assert_equal ~cmp:Domain_name.equal ~msg:"to_domain_name"
299		(V4.to_domain_name ip) name ;
	338	(V4.to_domain_name ip) name;
300	339	assert_equal ~msg:"of_domain_name" (V4.of_domain_name name) (Some ip)
301	340
302	341	let test_cstruct_rt () =
303	342	let addr = "\254\099\003\128" in
304	343	assert_equal ~msg:(String.escaped addr)
305		(Cstruct.to_string Ipaddr_cstruct.V4.(to_cstruct (of_cstruct_exn (Cstruct.of_string addr)))) addr
	344	(Cstruct.to_string
	345	Ipaddr_cstruct.V4.(
	346	to_cstruct (of_cstruct_exn (Cstruct.of_string addr))))
	347	addr
306	348
307	349	let test_cstruct_rt_bad () =
308		let addrs = [
309		need_more "\254\099\003";
310		] in
311		List.iter (fun (addr,exn) ->
312		assert_raises ~msg:(String.escaped addr) exn
313		(fun () -> Ipaddr_cstruct.V4.of_cstruct_exn (Cstruct.of_string addr))
314		) addrs
	350	let addrs = [ need_more "\254\099\003" ] in
	351	List.iter
	352	(fun (addr, exn) ->
	353	assert_raises ~msg:(String.escaped addr) exn (fun () ->
	354	Ipaddr_cstruct.V4.of_cstruct_exn (Cstruct.of_string addr)))
	355	addrs
315	356
316	357	let test_prefix_mem () =
317	358	let ip = V4.of_string_exn in
318	359	let prefix = V4.Prefix.of_string_exn in
319		let ships = [
320		ip "10.0.0.7", prefix "10.0.0.0/29", true;
321		ip "172.16.255.254", prefix "172.16.255.254/31", true;
322		ip "192.168.0.1", prefix "0.0.0.0/0", true;
323		ip "192.168.0.1", V4.Prefix.private_192, true;
324		ip "255.255.255.255", prefix "255.255.255.255/32", true;
325		ip "192.0.2.1", prefix "192.0.2.0/32", false;
326		ip "192.0.2.1", prefix "192.0.0.0/23", false;
327		ip "255.255.255.255", prefix "0.0.0.0/1", false;
328		] in
329		List.iter (fun (addr,subnet,is_mem) ->
330		let msg = Printf.sprintf "%s is%s in %s"
331		(V4.to_string addr) (if is_mem then "" else " not") (V4.Prefix.to_string subnet)
332		in
333		assert_equal ~msg (V4.Prefix.mem addr subnet) is_mem
334		) ships
	360	let ships =
	361	[
	362	(ip "10.0.0.7", prefix "10.0.0.0/29", true);
	363	(ip "172.16.255.254", prefix "172.16.255.254/31", true);
	364	(ip "192.168.0.1", prefix "0.0.0.0/0", true);
	365	(ip "192.168.0.1", V4.Prefix.private_192, true);
	366	(ip "255.255.255.255", prefix "255.255.255.255/32", true);
	367	(ip "192.0.2.1", prefix "192.0.2.0/32", false);
	368	(ip "192.0.2.1", prefix "192.0.0.0/23", false);
	369	(ip "255.255.255.255", prefix "0.0.0.0/1", false);
	370	]
	371	in
	372	List.iter
	373	(fun (addr, subnet, is_mem) ->
	374	let msg =
	375	Printf.sprintf "%s is%s in %s" (V4.to_string addr)
	376	(if is_mem then "" else " not")
	377	(V4.Prefix.to_string subnet)
	378	in
	379	assert_equal ~msg (V4.Prefix.mem addr subnet) is_mem)
	380	ships
335	381
336	382	let test_succ_pred () =
337	383	let open V4 in

342	388	let assert_equal = assert_equal ~printer in
343	389	let ip1 = of_string_exn "0.0.0.0" in
344	390	let ip2 = of_string_exn "255.255.255.255" in
345		assert_equal ~msg:"succ 0.0.0.0"
346		(of_string "0.0.0.1") (succ ip1);
	391	assert_equal ~msg:"succ 0.0.0.0" (of_string "0.0.0.1") (succ ip1);
347	392	assert_equal ~msg:"succ 255.255.255.255"
348		(Error (`Msg "Ipaddr: highest address has been reached")) (succ ip2);
	393	(Error (`Msg "Ipaddr: highest address has been reached"))
	394	(succ ip2);
349	395	assert_equal ~msg:"succ (succ 255.255.255.255)"
350	396	(Error (`Msg "Ipaddr: highest address has been reached"))
351	397	(succ ip2 >>= succ);
352	398	assert_equal ~msg:"pred 0.0.0.0"
353		(Error (`Msg "Ipaddr: lowest address has been reached")) (pred ip1);
	399	(Error (`Msg "Ipaddr: lowest address has been reached"))
	400	(pred ip1);
354	401	()
355	402
356	403	let test_prefix_first_last () =

375	422	(Ipaddr.V4.of_string_exn "169.254.169.254")
376	423	(last (of_string_exn "169.254.169.254/32"))
377	424
378		let suite = "Test V4" >::: [
379		"string_rt" >:: test_string_rt;
380		"string_rt_bad" >:: test_string_rt_bad;
381		"string_raw_rt" >:: test_string_raw_rt;
382		"string_raw_rt_bad" >:: test_string_raw_rt_bad;
383		"bytes_rt" >:: test_bytes_rt;
384		"bytes_rt_bad" >:: test_bytes_rt_bad;
385		"cstruct_rt" >:: test_cstruct_rt;
386		"cstruct_rt_bad" >:: test_cstruct_rt_bad;
387		"int32_rt" >:: test_int32_rt;
388		"prefix_string_rt" >:: test_prefix_string_rt;
389		"prefix_string_rt_bad" >:: test_prefix_string_rt_bad;
390		"network_address_rt" >:: test_network_address_rt;
391		"prefix_broadcast" >:: test_prefix_broadcast;
392		"prefix_bits" >:: test_prefix_bits;
393		"prefix_netmask" >:: test_prefix_netmask;
394		"prefix_netmask_bad" >:: test_prefix_netmask_bad;
395		"scope" >:: test_scope;
396		"map" >:: test_map;
397		"prefix_map" >:: test_prefix_map;
398		"special_addr" >:: test_special_addr;
399		"multicast_mac" >:: test_multicast_mac;
400		"domain_name" >:: test_domain_name;
401		"prefix_mem" >:: test_prefix_mem;
402		"succ_pred" >:: test_succ_pred;
403		"prefix_first_last" >:: test_prefix_first_last;
404		]
	425	let suite =
	426	"Test V4"
	427	>::: [
	428	"string_rt" >:: test_string_rt;
	429	"string_rt_bad" >:: test_string_rt_bad;
	430	"string_raw_rt" >:: test_string_raw_rt;
	431	"string_raw_rt_bad" >:: test_string_raw_rt_bad;
	432	"bytes_rt" >:: test_bytes_rt;
	433	"bytes_rt_bad" >:: test_bytes_rt_bad;
	434	"cstruct_rt" >:: test_cstruct_rt;
	435	"cstruct_rt_bad" >:: test_cstruct_rt_bad;
	436	"int32_rt" >:: test_int32_rt;
	437	"prefix_string_rt" >:: test_prefix_string_rt;
	438	"prefix_string_rt_bad" >:: test_prefix_string_rt_bad;
	439	"network_address_rt" >:: test_network_address_rt;
	440	"prefix_broadcast" >:: test_prefix_broadcast;
	441	"prefix_bits" >:: test_prefix_bits;
	442	"prefix_netmask" >:: test_prefix_netmask;
	443	"prefix_netmask_bad" >:: test_prefix_netmask_bad;
	444	"scope" >:: test_scope;
	445	"map" >:: test_map;
	446	"prefix_map" >:: test_prefix_map;
	447	"special_addr" >:: test_special_addr;
	448	"multicast_mac" >:: test_multicast_mac;
	449	"domain_name" >:: test_domain_name;
	450	"prefix_mem" >:: test_prefix_mem;
	451	"succ_pred" >:: test_succ_pred;
	452	"prefix_first_last" >:: test_prefix_first_last;
	453	]
405	454	end
406
407	455
408	456	module Test_v6 = struct
409	457	let test_string_rt () =
410		let addrs = [
411		"2001:db8::ff00:42:8329","2001:db8::ff00:42:8329";
412		"::ffff:192.168.1.1", "::ffff:192.168.1.1";
413		"::", "::";
414		"[::]", "::";
415		"1:1:1:1::1:1:1", "1:1:1:1:0:1:1:1";
416		"0:0:0:1:1:0:0:0", "::1:1:0:0:0";
417		"0:0:0:1:1::", "::1:1:0:0:0";
418		"::1:0:0:0:0", "0:0:0:1::";
419		"FE80::", "fe80::";
420		"::192.168.0.1", "::c0a8:1";
421		] in
422		List.iter (fun (addr,rt) ->
423		let os = V6.of_string_exn addr in
424		let ts = V6.to_string os in
425		assert_equal ~msg:(addr^" <> "^rt^" ("^ts^")") ts rt;
426		let os = Ipaddr_sexp.(V6.t_of_sexp (V6.sexp_of_t os)) in
427		let ts = V6.to_string os in
428		assert_equal ~msg:(addr^" <> "^rt^" ("^ts^")") ts rt;
429		) addrs
	458	let addrs =
	459	[
	460	("2001:db8::ff00:42:8329", "2001:db8::ff00:42:8329");
	461	("::ffff:192.168.1.1", "::ffff:192.168.1.1");
	462	("::", "::");
	463	("[::]", "::");
	464	("1:1:1:1::1:1:1", "1:1:1:1:0:1:1:1");
	465	("0:0:0:1:1:0:0:0", "::1:1:0:0:0");
	466	("0:0:0:1:1::", "::1:1:0:0:0");
	467	("::1:0:0:0:0", "0:0:0:1::");
	468	("FE80::", "fe80::");
	469	("::192.168.0.1", "::c0a8:1");
	470	]
	471	in
	472	List.iter
	473	(fun (addr, rt) ->
	474	let os = V6.of_string_exn addr in
	475	let ts = V6.to_string os in
	476	assert_equal ~msg:(addr ^ " <> " ^ rt ^ " (" ^ ts ^ ")") ts rt;
	477	let os = Ipaddr_sexp.(V6.t_of_sexp (V6.sexp_of_t os)) in
	478	let ts = V6.to_string os in
	479	assert_equal ~msg:(addr ^ " <> " ^ rt ^ " (" ^ ts ^ ")") ts rt)
	480	addrs
430	481
431	482	let test_string_rt_bad () =
432		let addrs = [
433		need_more "[";
434		need_more "[:";
435		need_more "[]"; (* ? *)
436		need_more ":";
437		need_more "[::";
438		bad_char 4 "::1:g:f";
439		bad_char 3 "::1::";
440		bad_char 4 "1::2::3";
441		need_more "1:2:3:4:5:6:7";
442		bad_char 15 "1:2:3:4:5:6:7:8:9";
443		bad_char 15 "1:2:3:4:5:6:7:8::";
444		error "12345::12:2" "component 0 out of bounds";
445		bad_char 1 ":1";
446		] in
447		List.iter (fun (addr,exn) ->
448		assert_raises ~msg:addr exn (fun () -> V6.of_string_exn addr)
449		) addrs
	483	let addrs =
	484	[
	485	need_more "[";
	486	need_more "[:";
	487	need_more "[]";
	488	(* ? *)
	489	need_more ":";
	490	need_more "[::";
	491	bad_char 4 "::1:g:f";
	492	bad_char 3 "::1::";
	493	bad_char 4 "1::2::3";
	494	need_more "1:2:3:4:5:6:7";
	495	bad_char 15 "1:2:3:4:5:6:7:8:9";
	496	bad_char 15 "1:2:3:4:5:6:7:8::";
	497	error "12345::12:2" "component 0 out of bounds";
	498	bad_char 1 ":1";
	499	]
	500	in
	501	List.iter
	502	(fun (addr, exn) ->
	503	assert_raises ~msg:addr exn (fun () -> V6.of_string_exn addr))
	504	addrs
450	505
451	506	let test_string_raw_rt () =
452		let addrs = [
453		("IP: 2001:db8::ff00:42:8329!",4), ("2001:db8::ff00:42:8329",26);
454		("IP: ::ffff:192.168.1.1 ",4), ("::ffff:192.168.1.1",22);
455		("IP: :::",4), ("::",6);
456		("IP: [::]:",4), ("::",8);
457		("IP: 1:1:1:1::1:1:1:1",4), ("1:1:1:1:0:1:1:1",18);
458		("IP: ::1:1:0:0:0::g",4), ("::1:1:0:0:0",15);
459		] in
460		List.iter (fun ((addr,off),(result,cursor)) ->
461		let c = ref off in
462		let os = V6.of_string_raw addr c in
463		let ts = V6.to_string os in
464		let msg = Printf.sprintf "%s at %d: %s at %d <> %s at %d"
465		addr off result cursor ts !c
466		in assert_equal ~msg (ts,!c) (result,cursor)
467		) addrs
	507	let addrs =
	508	[
	509	(("IP: 2001:db8::ff00:42:8329!", 4), ("2001:db8::ff00:42:8329", 26));
	510	(("IP: ::ffff:192.168.1.1 ", 4), ("::ffff:192.168.1.1", 22));
	511	(("IP: :::", 4), ("::", 6));
	512	(("IP: [::]:", 4), ("::", 8));
	513	(("IP: 1:1:1:1::1:1:1:1", 4), ("1:1:1:1:0:1:1:1", 18));
	514	(("IP: ::1:1:0:0:0::g", 4), ("::1:1:0:0:0", 15));
	515	]
	516	in
	517	List.iter
	518	(fun ((addr, off), (result, cursor)) ->
	519	let c = ref off in
	520	let os = V6.of_string_raw addr c in
	521	let ts = V6.to_string os in
	522	let msg =
	523	Printf.sprintf "%s at %d: %s at %d <> %s at %d" addr off result cursor
	524	ts !c
	525	in
	526	assert_equal ~msg (ts, !c) (result, cursor))
	527	addrs
468	528
469	529	let test_string_raw_rt_bad () =
470		let error (s,c) msg c' = (s,c), (Parse_error (msg,s),c') in
	530	let error (s, c) msg c' = ((s, c), (Parse_error (msg, s), c')) in
471	531	let need_more loc = error loc "not enough data" in
472		let bad_char i (s,c) =
473		error (s,c) (Printf.sprintf "invalid character '%c' at %d" s.[i] i) i
474		in
475		let addrs = [
476		need_more ("IP: [] ",4) 5;
477		bad_char 5 ("IP: : ",4);
478		bad_char 7 ("IP: [:: ",4);
479		bad_char 17 ("IP: 1:2:3:4:5:6:7 ",4);
480		error ("IP: 12345::12:2 ",4) "component 0 out of bounds" 15;
481		bad_char 5 ("IP: :1 ",4);
482		need_more ("IP: ::1:1:0:0:0:",4) 16;
483		bad_char 8 ("IP: ::1:g:f ",4);
484		] in
485		List.iter (fun ((addr,off),(exn,cursor)) ->
486		let c = ref off in
487		assert_raises ~msg:addr exn (fun () -> V6.of_string_raw addr c);
488		assert_equal ~msg:(Printf.sprintf "%s cursor <> %d (%d)" addr cursor !c)
489		!c cursor
490		) addrs
	532	let bad_char i (s, c) =
	533	error (s, c) (Printf.sprintf "invalid character '%c' at %d" s.[i] i) i
	534	in
	535	let addrs =
	536	[
	537	need_more ("IP: [] ", 4) 5;
	538	bad_char 5 ("IP: : ", 4);
	539	bad_char 7 ("IP: [:: ", 4);
	540	bad_char 17 ("IP: 1:2:3:4:5:6:7 ", 4);
	541	error ("IP: 12345::12:2 ", 4) "component 0 out of bounds" 15;
	542	bad_char 5 ("IP: :1 ", 4);
	543	need_more ("IP: ::1:1:0:0:0:", 4) 16;
	544	bad_char 8 ("IP: ::1:g:f ", 4);
	545	]
	546	in
	547	List.iter
	548	(fun ((addr, off), (exn, cursor)) ->
	549	let c = ref off in
	550	assert_raises ~msg:addr exn (fun () -> V6.of_string_raw addr c);
	551	assert_equal
	552	~msg:(Printf.sprintf "%s cursor <> %d (%d)" addr cursor !c)
	553	!c cursor)
	554	addrs
491	555
492	556	let test_bytes_rt () =
493	557	let addr =

497	561	assert_equal ~msg:(String.escaped addr) V6.(to_octets v6) addr
498	562
499	563	let test_bytes_rt_bad () =
500		let addrs = [
501		need_more "\000\000\000\000\000\000\000\000\000\000\255\255\192\168\001";
502		] in
503		List.iter (fun (addr,exn) ->
504		assert_raises ~msg:(String.escaped addr) exn
505		(fun () -> V6.of_octets_exn addr)
506		) addrs
	564	let addrs =
	565	[
	566	need_more "\000\000\000\000\000\000\000\000\000\000\255\255\192\168\001";
	567	]
	568	in
	569	List.iter
	570	(fun (addr, exn) ->
	571	assert_raises ~msg:(String.escaped addr) exn (fun () ->
	572	V6.of_octets_exn addr))
	573	addrs
507	574
508	575	let test_cstruct_rt () =
509	576	let addr =
510	577	"\000\000\000\000\000\000\000\000\000\000\255\255\192\168\000\001"
511	578	in
512	579	let v6 = Ipaddr_cstruct.V6.of_cstruct_exn (Cstruct.of_string addr) in
513		assert_equal ~msg:(String.escaped addr) (Cstruct.to_string Ipaddr_cstruct.V6.(to_cstruct v6)) addr
	580	assert_equal ~msg:(String.escaped addr)
	581	(Cstruct.to_string Ipaddr_cstruct.V6.(to_cstruct v6))
	582	addr
514	583
515	584	let test_cstruct_rt_bad () =
516		let addrs = [
517		need_more "\000\000\000\000\000\000\000\000\000\000\255\255\192\168\001";
518		] in
519		List.iter (fun (addr,exn) ->
520		assert_raises ~msg:(String.escaped addr) exn
521		(fun () -> Ipaddr_cstruct.V6.of_cstruct_exn (Cstruct.of_string addr))
522		) addrs
	585	let addrs =
	586	[
	587	need_more "\000\000\000\000\000\000\000\000\000\000\255\255\192\168\001";
	588	]
	589	in
	590	List.iter
	591	(fun (addr, exn) ->
	592	assert_raises ~msg:(String.escaped addr) exn (fun () ->
	593	Ipaddr_cstruct.V6.of_cstruct_exn (Cstruct.of_string addr)))
	594	addrs
523	595
524	596	let test_int32_rt () =
525		let (a,b,c,d) as addr =
526		0x2001_0665_l, 0x0000_0000_l, 0xff00_00ff_l, 0xfe00_0001_l
527		in
528		assert_equal ~msg:(Printf.sprintf "%08lx %08lx %08lx %08lx" a b c d)
529		V6.(to_int32 (of_int32 addr)) addr
	597	let ((a, b, c, d) as addr) =
	598	(0x2001_0665_l, 0x0000_0000_l, 0xff00_00ff_l, 0xfe00_0001_l)
	599	in
	600	assert_equal
	601	~msg:(Printf.sprintf "%08lx %08lx %08lx %08lx" a b c d)
	602	V6.(to_int32 (of_int32 addr))
	603	addr
530	604
531	605	let test_prefix_string_rt () =
532		let subnets = [
533		"2000::/3", "2000::/3";
534		"c012::/2", "c000::/2";
535		"ffff:ffff:ffff::ffff/0", "::/0";
536		"::/0", "::/0";
537		"::/128", "::/128";
538		"::1/128", "::1/128";
539		"::/64", "::/64";
540		"[::]/64", "::/64";
541		] in
542		List.iter (fun (subnet,rt) ->
543		let os = V6.Prefix.of_string_exn subnet \|> V6.Prefix.prefix in
544		let ts = V6.Prefix.to_string os in
545		assert_equal ~msg:subnet ts rt;
546		let os = Ipaddr_sexp.(V6.Prefix.(t_of_sexp (sexp_of_t os))) in
547		let ts = V6.Prefix.to_string os in
548		assert_equal ~msg:subnet ts rt;
549		) subnets
	606	let subnets =
	607	[
	608	("2000::/3", "2000::/3");
	609	("c012::/2", "c000::/2");
	610	("ffff:ffff:ffff::ffff/0", "::/0");
	611	("::/0", "::/0");
	612	("::/128", "::/128");
	613	("::1/128", "::1/128");
	614	("::/64", "::/64");
	615	("[::]/64", "::/64");
	616	]
	617	in
	618	List.iter
	619	(fun (subnet, rt) ->
	620	let os = V6.Prefix.of_string_exn subnet \|> V6.Prefix.prefix in
	621	let ts = V6.Prefix.to_string os in
	622	assert_equal ~msg:subnet ts rt;
	623	let os = Ipaddr_sexp.(V6.Prefix.(t_of_sexp (sexp_of_t os))) in
	624	let ts = V6.Prefix.to_string os in
	625	assert_equal ~msg:subnet ts rt)
	626	subnets
550	627
551	628	let test_prefix_string_rt_bad () =
552		let subnets = [
553		need_more "/24";
554		need_more "::";
555		error "::/130" "invalid prefix size";
556		bad_char 5 "::/30/1";
557		bad_char 7 "2000::/-1";
558		bad_char 5 "1::3:/4";
559		] in
560		List.iter (fun (subnet,exn) ->
561		assert_raises ~msg:subnet exn (fun () -> V6.Prefix.of_string_exn subnet)
562		) subnets
	629	let subnets =
	630	[
	631	need_more "/24";
	632	need_more "::";
	633	error "::/130" "invalid prefix size";
	634	bad_char 5 "::/30/1";
	635	bad_char 7 "2000::/-1";
	636	bad_char 5 "1::3:/4";
	637	]
	638	in
	639	List.iter
	640	(fun (subnet, exn) ->
	641	assert_raises ~msg:subnet exn (fun () -> V6.Prefix.of_string_exn subnet))
	642	subnets
563	643
564	644	let test_network_address_rt () =
565		let netaddrs = [
566		"::1/24", "::/24", "::1";
567		] in
568		List.iter (fun (netaddr,net,addr) ->
569		let netv4 = V6.Prefix.of_string_exn net in
570		let addrv4 = V6.of_string_exn addr in
571		let cidr = V6.Prefix.of_string_exn netaddr in
572		let prefix = V6.Prefix.prefix cidr
573		and v4 = V6.Prefix.address cidr
574		in
575		let prefix = V6.Prefix.prefix prefix in
576		assert_equal ~msg:(net^" <> "^(V6.Prefix.to_string prefix)) netv4 prefix;
577		assert_equal ~msg:(addr^" <> "^(V6.to_string v4)) addrv4 v4;
578		let addrstr = V6.Prefix.to_string cidr in
579		assert_equal ~msg:(netaddr^" <> "^addrstr) netaddr addrstr;
580		) netaddrs
	645	let netaddrs = [ ("::1/24", "::/24", "::1") ] in
	646	List.iter
	647	(fun (netaddr, net, addr) ->
	648	let netv4 = V6.Prefix.of_string_exn net in
	649	let addrv4 = V6.of_string_exn addr in
	650	let cidr = V6.Prefix.of_string_exn netaddr in
	651	let prefix = V6.Prefix.prefix cidr and v4 = V6.Prefix.address cidr in
	652	let prefix = V6.Prefix.prefix prefix in
	653	assert_equal
	654	~msg:(net ^ " <> " ^ V6.Prefix.to_string prefix)
	655	netv4 prefix;
	656	assert_equal ~msg:(addr ^ " <> " ^ V6.to_string v4) addrv4 v4;
	657	let addrstr = V6.Prefix.to_string cidr in
	658	assert_equal ~msg:(netaddr ^ " <> " ^ addrstr) netaddr addrstr)
	659	netaddrs
581	660
582	661	let test_prefix_bits () =
583		let pairs = V6.Prefix.([
584		global_unicast_001, 3;
585		link, 64;
586		unique_local, 7;
587		multicast, 8;
588		ipv4_mapped, 96;
589		noneui64_interface, 3;
590		]) in
591		List.iter (fun (subnet,bits) ->
592		let msg = (V6.Prefix.to_string subnet) ^ " <> bits "
593		^ (string_of_int bits) in
594		assert_equal ~msg (V6.Prefix.bits subnet) bits
595		) pairs
	662	let pairs =
	663	V6.Prefix.
	664	[
	665	(global_unicast_001, 3);
	666	(link, 64);
	667	(unique_local, 7);
	668	(multicast, 8);
	669	(ipv4_mapped, 96);
	670	(noneui64_interface, 3);
	671	]
	672	in
	673	List.iter
	674	(fun (subnet, bits) ->
	675	let msg =
	676	V6.Prefix.to_string subnet ^ " <> bits " ^ string_of_int bits
	677	in
	678	assert_equal ~msg (V6.Prefix.bits subnet) bits)
	679	pairs
596	680
597	681	let test_prefix_netmask () =
598		let nets = [
599		"8::1/128","ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff";
600		"8::1/127","ffff:ffff:ffff:ffff:ffff:ffff:ffff:fffe";
601		"8::1/96", "ffff:ffff:ffff:ffff:ffff:ffff::";
602		"8::1/64", "ffff:ffff:ffff:ffff::";
603		"8::1/32", "ffff:ffff::";
604		"8::1/1", "8000::";
605		"8::1/0", "::";
606		] in
607		List.iter (fun (net_str,nm_str) ->
608		let cidr = V6.Prefix.of_string_exn net_str in
609		let prefix = V6.Prefix.prefix cidr
610		and address = V6.Prefix.address cidr
611		in
612		let netmask = V6.Prefix.netmask prefix in
613		let nnm_str = V6.to_string netmask in
614		let msg = Printf.sprintf "netmask %s <> %s" nnm_str nm_str in
615		assert_equal ~msg nnm_str nm_str;
616		let prefix = V6.Prefix.of_netmask_exn ~netmask ~address in
617		let nns = V6.Prefix.to_string prefix in
618		let msg = Printf.sprintf "%s is %s under netmask iso" net_str nns in
619		assert_equal ~msg net_str nns
620		) nets
	682	let nets =
	683	[
	684	("8::1/128", "ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff");
	685	("8::1/127", "ffff:ffff:ffff:ffff:ffff:ffff:ffff:fffe");
	686	("8::1/96", "ffff:ffff:ffff:ffff:ffff:ffff::");
	687	("8::1/64", "ffff:ffff:ffff:ffff::");
	688	("8::1/32", "ffff:ffff::");
	689	("8::1/1", "8000::");
	690	("8::1/0", "::");
	691	]
	692	in
	693	List.iter
	694	(fun (net_str, nm_str) ->
	695	let cidr = V6.Prefix.of_string_exn net_str in
	696	let prefix = V6.Prefix.prefix cidr
	697	and address = V6.Prefix.address cidr in
	698	let netmask = V6.Prefix.netmask prefix in
	699	let nnm_str = V6.to_string netmask in
	700	let msg = Printf.sprintf "netmask %s <> %s" nnm_str nm_str in
	701	assert_equal ~msg nnm_str nm_str;
	702	let prefix = V6.Prefix.of_netmask_exn ~netmask ~address in
	703	let nns = V6.Prefix.to_string prefix in
	704	let msg = Printf.sprintf "%s is %s under netmask iso" net_str nns in
	705	assert_equal ~msg net_str nns)
	706	nets
621	707
622	708	let test_prefix_netmask_bad () =
623		let bad_masks = [
624		error "7fff:ffff:ffff:ffff:ffff:ffff:ffff:ffff" "invalid netmask";
625		error "ffff:ffff:ffff:ffff:ffff:fffe:8000:0" "invalid netmask";
626		error "ffff:ffff:ffff:fffe:8000::" "invalid netmask";
627		error "ffff:fffe:8000::" "invalid netmask";
628		] in
629		List.iter (fun (nm_str,exn) ->
630		let netmask = V6.of_string_exn nm_str in
631		let address = V6.of_string_exn "::" in
632		assert_raises ~msg:nm_str exn
633		(fun () -> V6.Prefix.of_netmask_exn ~netmask ~address)
634		) bad_masks
	709	let bad_masks =
	710	[
	711	error "7fff:ffff:ffff:ffff:ffff:ffff:ffff:ffff" "invalid netmask";
	712	error "ffff:ffff:ffff:ffff:ffff:fffe:8000:0" "invalid netmask";
	713	error "ffff:ffff:ffff:fffe:8000::" "invalid netmask";
	714	error "ffff:fffe:8000::" "invalid netmask";
	715	]
	716	in
	717	List.iter
	718	(fun (nm_str, exn) ->
	719	let netmask = V6.of_string_exn nm_str in
	720	let address = V6.of_string_exn "::" in
	721	assert_raises ~msg:nm_str exn (fun () ->
	722	V6.Prefix.of_netmask_exn ~netmask ~address))
	723	bad_masks
635	724
636	725	let test_scope () =
637	726	let localhost_v4 = V6.of_string_exn "::ffff:127.0.0.1" in
638	727	let is subnet addr = V6.Prefix.(mem addr subnet) in
639	728	let is_scope scop addr = scop = V6.scope addr in
640		let ships = V6.([
641		unspecified, "global", is_global, false;
642		unspecified, "multicast", is_multicast, false;
643		unspecified, "point", is_scope Point, true;
644		localhost, "global", is_global, false;
645		localhost, "multicast", is_multicast, false;
646		localhost, "interface", is_scope Interface, true;
647		interface_nodes, "global", is_global, false;
648		interface_nodes, "multicast", is_multicast, true;
649		interface_nodes, "interface", is_scope Interface, true;
650		link_nodes, "global", is_global, false;
651		link_nodes, "multicast", is_multicast, true;
652		link_nodes, "link", is_scope Link, true;
653		link_routers, "global", is_global, false;
654		link_routers, "multicast", is_multicast, true;
655		link_routers, "link", is_scope Link, true;
656		localhost_v4, "global", is_global, false;
657		localhost_v4, "multicast", is_multicast, false;
658		localhost_v4, "ipv4", is Prefix.ipv4_mapped, true;
659		localhost_v4, "noneui64", is Prefix.noneui64_interface, true;
660		localhost_v4, "global_001",is Prefix.global_unicast_001, false;
661		localhost_v4, "interface", is_scope Interface, true;
662		]) in
663		List.iter (fun (addr,lbl,pred,is_mem) ->
664		let mems = if is_mem then "" else " not" in
665		let msg = (V6.to_string addr)^" is"^mems^" in "^lbl in
666		assert_equal ~msg (pred addr) is_mem
667		) ships
	729	let ships =
	730	V6.
	731	[
	732	(unspecified, "global", is_global, false);
	733	(unspecified, "multicast", is_multicast, false);
	734	(unspecified, "point", is_scope Point, true);
	735	(localhost, "global", is_global, false);
	736	(localhost, "multicast", is_multicast, false);
	737	(localhost, "interface", is_scope Interface, true);
	738	(interface_nodes, "global", is_global, false);
	739	(interface_nodes, "multicast", is_multicast, true);
	740	(interface_nodes, "interface", is_scope Interface, true);
	741	(link_nodes, "global", is_global, false);
	742	(link_nodes, "multicast", is_multicast, true);
	743	(link_nodes, "link", is_scope Link, true);
	744	(link_routers, "global", is_global, false);
	745	(link_routers, "multicast", is_multicast, true);
	746	(link_routers, "link", is_scope Link, true);
	747	(localhost_v4, "global", is_global, false);
	748	(localhost_v4, "multicast", is_multicast, false);
	749	(localhost_v4, "ipv4", is Prefix.ipv4_mapped, true);
	750	(localhost_v4, "noneui64", is Prefix.noneui64_interface, true);
	751	(localhost_v4, "global_001", is Prefix.global_unicast_001, false);
	752	(localhost_v4, "interface", is_scope Interface, true);
	753	]
	754	in
	755	List.iter
	756	(fun (addr, lbl, pred, is_mem) ->
	757	let mems = if is_mem then "" else " not" in
	758	let msg = V6.to_string addr ^ " is" ^ mems ^ " in " ^ lbl in
	759	assert_equal ~msg (pred addr) is_mem)
	760	ships
668	761
669	762	let test_map () =
670		let module M = Map.Make(V6) in
	763	let module M = Map.Make (V6) in
671	764	let maxs = "ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff" in
672	765	let m = M.add (V6.of_string_exn "::0:0") "min" M.empty in
673	766	let m = M.add (V6.of_string_exn maxs) "the greatest host" m in
674	767	let m = M.add (V6.of_string_exn "::") "the least host" m in
675	768	assert_equal ~msg:"size" (M.cardinal m) 2;
676		let (min_key, min_val) = M.min_binding m in
677		assert_equal ~msg:("min is '" ^ min_val ^"'") (min_key, min_val)
	769	let min_key, min_val = M.min_binding m in
	770	assert_equal
	771	~msg:("min is '" ^ min_val ^ "'")
	772	(min_key, min_val)
678	773	(V6.of_string_exn "::0:0:0", "the least host");
679	774	assert_equal ~msg:"max" (M.max_binding m)
680	775	(V6.of_string_exn maxs, "the greatest host")
681	776
682	777	let test_prefix_map () =
683		let module M = Map.Make(V6.Prefix) in
	778	let module M = Map.Make (V6.Prefix) in
684	779	let of_string s = s \|> V6.Prefix.of_string_exn \|> V6.Prefix.prefix in
685	780	let m = M.add (of_string "::ffff:0.0.0.0/0") "everyone" M.empty in
686	781	let m = M.add (of_string "::ffff:192.0.0.0/1") "weirdos" m in

693	788	assert_equal ~msg:"max" (M.max_binding m)
694	789	(of_string "::ffff:254.0.0.0/8", "top-end");
695	790	assert_equal ~msg:"third"
696		(M.find (of_string "::ffff:128.0.0.0/1") m) "high-bitters"
	791	(M.find (of_string "::ffff:128.0.0.0/1") m)
	792	"high-bitters"
697	793
698	794	let test_multicast_mac () =
699	795	let on = 0xFFFF in
700	796	let ip = V6.make on on on on on 0xFFFF 0xFEFE 0xFDFD in
701		let unicast = V6.Prefix.(network_address global_unicast_001 ip) in
	797	let unicast = V6.Prefix.(network_address global_unicast_001 ip) in
702	798	let multicast = V6.Prefix.(network_address multicast ip) in
703		let unicast_mac_str = Macaddr.to_string (V6.multicast_to_mac unicast) in
	799	let unicast_mac_str = Macaddr.to_string (V6.multicast_to_mac unicast) in
704	800	let multicast_mac_str = Macaddr.to_string (V6.multicast_to_mac multicast) in
705	801	let mac_str = "33:33:fe:fe:fd:fd" in
706		assert_equal ~msg:("unicast_mac "^unicast_mac_str^" <> "^mac_str)
707		unicast_mac_str mac_str;
708		assert_equal ~msg:("multicast_mac "^multicast_mac_str^" <> "^mac_str)
	802	assert_equal
	803	~msg:("unicast_mac " ^ unicast_mac_str ^ " <> " ^ mac_str)
	804	unicast_mac_str mac_str;
	805	assert_equal
	806	~msg:("multicast_mac " ^ multicast_mac_str ^ " <> " ^ mac_str)
709	807	multicast_mac_str mac_str
710	808
711	809	let test_domain_name () =

715	813	in
716	814	let name = Domain_name.(host_exn (of_string_exn name)) in
717	815	assert_equal ~cmp:Domain_name.equal ~msg:"to_domain_name"
718		(V6.to_domain_name ip) name ;
	816	(V6.to_domain_name ip) name;
719	817	assert_equal ~msg:"of_domain_name" (V6.of_domain_name name) (Some ip)
720	818
721	819	let test_link_address_of_mac () =
722	820	let mac = Macaddr.of_string_exn "34-56-78-9A-BC-DE" in
723	821	let ip_str = V6.(to_string (link_address_of_mac mac)) in
724	822	let expected = "fe80::3656:78ff:fe9a:bcde" in
725		assert_equal ~msg:("link_address_of_mac "^ip_str^" <> "^expected)
	823	assert_equal
	824	~msg:("link_address_of_mac " ^ ip_str ^ " <> " ^ expected)
726	825	ip_str expected
727	826
728	827	let test_succ_pred () =

736	835	let ip2 = of_string_exn "ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff" in
737	836	let ip3 = of_string_exn "::2" in
738	837	assert_equal ~msg:"succ ::" (of_string "::1") (succ ip1);
739		assert_equal ~msg:"succ (succ ::)"
740		(of_string "::2") (succ ip1 >>= succ);
	838	assert_equal ~msg:"succ (succ ::)" (of_string "::2") (succ ip1 >>= succ);
741	839	assert_equal ~msg:"succ ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff"
742		(Error (`Msg "Ipaddr: highest address has been reached")) (succ ip2);
743		assert_equal ~msg:"pred ::2" (of_string "::1") (pred ip3) ;
744		assert_equal ~msg:"pred ::ffff:ffff"
745		(of_string "::ffff:fffd")
	840	(Error (`Msg "Ipaddr: highest address has been reached"))
	841	(succ ip2);
	842	assert_equal ~msg:"pred ::2" (of_string "::1") (pred ip3);
	843	assert_equal ~msg:"pred ::ffff:ffff" (of_string "::ffff:fffd")
746	844	(of_string "::ffff:ffff" >>= pred >>= pred);
747	845	assert_equal ~msg:"pred ::"
748		(Error (`Msg "Ipaddr: lowest address has been reached")) (pred ip1);
	846	(Error (`Msg "Ipaddr: lowest address has been reached"))
	847	(pred ip1);
749	848	assert_equal ~msg:"pred (succ ::2)" (Ok ip3) (succ ip3 >>= pred)
750	849
751	850	let test_first_last () =

753	852	let open Prefix in
754	853	let ip_of_string = V6.of_string_exn in
755	854	let assert_equal = assert_equal ~printer:V6.to_string in
756		assert_equal ~msg:"first ::/64"
757		(ip_of_string "::1") (first @@ of_string_exn "::/64");
758		assert_equal ~msg:"first ::ff00/120"
759		(ip_of_string "::ff01") (first @@ of_string_exn "::ff00/120");
760		assert_equal ~msg:"first ::aaa0/127"
761		(ip_of_string "::aaa0") (first @@ of_string_exn "::aaa0/127");
	855	assert_equal ~msg:"first ::/64" (ip_of_string "::1")
	856	(first @@ of_string_exn "::/64");
	857	assert_equal ~msg:"first ::ff00/120" (ip_of_string "::ff01")
	858	(first @@ of_string_exn "::ff00/120");
	859	assert_equal ~msg:"first ::aaa0/127" (ip_of_string "::aaa0")
	860	(first @@ of_string_exn "::aaa0/127");
762	861	assert_equal ~msg:"first ::aaa0/128" (ip_of_string "::aaa0")
763	862	(first @@ of_string_exn "::aaa0/128");
764		assert_equal ~msg:"last ::/64" (ip_of_string "::ffff:ffff:ffff:ffff")
	863	assert_equal ~msg:"last ::/64"
	864	(ip_of_string "::ffff:ffff:ffff:ffff")
765	865	(last @@ of_string_exn "::/64");
766	866	assert_equal ~msg:"last ::/120" (ip_of_string "::ff")
767	867	(last @@ of_string_exn "::/120");
768	868	assert_equal ~msg:"last ::/112" (ip_of_string "::ffff")
769	869	(last @@ of_string_exn "::/112");
770		assert_equal ~msg:"last ::bbbb:eeee:0000:0000/64" (ip_of_string "::ffff:ffff:ffff:ffff")
	870	assert_equal ~msg:"last ::bbbb:eeee:0000:0000/64"
	871	(ip_of_string "::ffff:ffff:ffff:ffff")
771	872	(last @@ of_string_exn "::bbbb:eeee:0000:0000/64");
772	873	assert_equal ~msg:"last ::aaa0/127" (ip_of_string "::aaa1")
773	874	(last @@ of_string_exn "::aaa0/127");
774	875	assert_equal ~msg:"last ::aaa0/128" (ip_of_string "::aaa0")
775	876	(last @@ of_string_exn "::aaa0/128")
776	877
777		let suite = "Test V6" >::: [
778		"string_rt" >:: test_string_rt;
779		"string_rt_bad" >:: test_string_rt_bad;
780		"string_raw_rt" >:: test_string_raw_rt;
781		"string_raw_rt_bad" >:: test_string_raw_rt_bad;
782		"bytes_rt" >:: test_bytes_rt;
783		"bytes_rt_bad" >:: test_bytes_rt_bad;
784		"cstruct_rt" >:: test_cstruct_rt;
785		"cstruct_rt_bad" >:: test_cstruct_rt_bad;
786		"int32_rt" >:: test_int32_rt;
787		"prefix_string_rt" >:: test_prefix_string_rt;
788		"prefix_string_rt_bad" >:: test_prefix_string_rt_bad;
789		"network_address_rt" >:: test_network_address_rt;
790		"prefix_bits" >:: test_prefix_bits;
791		"prefix_netmask" >:: test_prefix_netmask;
792		"prefix_netmask_bad" >:: test_prefix_netmask_bad;
793		"scope" >:: test_scope;
794		"map" >:: test_map;
795		"prefix_map" >:: test_prefix_map;
796		"multicast_mac" >:: test_multicast_mac;
797		"domain_name" >:: test_domain_name;
798		"link_address_of_mac" >:: test_link_address_of_mac;
799		"succ_pred" >:: test_succ_pred;
800		"first_last" >:: test_first_last;
801		]
	878	let suite =
	879	"Test V6"
	880	>::: [
	881	"string_rt" >:: test_string_rt;
	882	"string_rt_bad" >:: test_string_rt_bad;
	883	"string_raw_rt" >:: test_string_raw_rt;
	884	"string_raw_rt_bad" >:: test_string_raw_rt_bad;
	885	"bytes_rt" >:: test_bytes_rt;
	886	"bytes_rt_bad" >:: test_bytes_rt_bad;
	887	"cstruct_rt" >:: test_cstruct_rt;
	888	"cstruct_rt_bad" >:: test_cstruct_rt_bad;
	889	"int32_rt" >:: test_int32_rt;
	890	"prefix_string_rt" >:: test_prefix_string_rt;
	891	"prefix_string_rt_bad" >:: test_prefix_string_rt_bad;
	892	"network_address_rt" >:: test_network_address_rt;
	893	"prefix_bits" >:: test_prefix_bits;
	894	"prefix_netmask" >:: test_prefix_netmask;
	895	"prefix_netmask_bad" >:: test_prefix_netmask_bad;
	896	"scope" >:: test_scope;
	897	"map" >:: test_map;
	898	"prefix_map" >:: test_prefix_map;
	899	"multicast_mac" >:: test_multicast_mac;
	900	"domain_name" >:: test_domain_name;
	901	"link_address_of_mac" >:: test_link_address_of_mac;
	902	"succ_pred" >:: test_succ_pred;
	903	"first_last" >:: test_first_last;
	904	]
802	905	end
803	906
804	907	let test_string_raw_rt () =
805		let addrs = [
806		("IP: 192.168.0.0!!",4), ("192.168.0.0",15);
807		("IP: 192:168:0::!!",4), ("192:168::",15);
808		("IP: [192:168::]!!",4), ("192:168::",15);
809		] in
810		List.iter (fun ((addr,off),(result,cursor)) ->
811		let c = ref off in
812		let os = of_string_raw addr c in
813		let ts = to_string os in
814		let msg = Printf.sprintf "%s at %d: %s at %d <> %s at %d"
815		addr off result cursor ts !c
816		in assert_equal ~msg (ts,!c) (result,cursor)
817		) addrs
	908	let addrs =
	909	[
	910	(("IP: 192.168.0.0!!", 4), ("192.168.0.0", 15));
	911	(("IP: 192:168:0::!!", 4), ("192:168::", 15));
	912	(("IP: [192:168::]!!", 4), ("192:168::", 15));
	913	]
	914	in
	915	List.iter
	916	(fun ((addr, off), (result, cursor)) ->
	917	let c = ref off in
	918	let os = of_string_raw addr c in
	919	let ts = to_string os in
	920	let msg =
	921	Printf.sprintf "%s at %d: %s at %d <> %s at %d" addr off result cursor
	922	ts !c
	923	in
	924	assert_equal ~msg (ts, !c) (result, cursor))
	925	addrs
818	926
819	927	let test_string_raw_rt_bad () =
820		let error (s,c) msg c' = (s,c), (Parse_error (msg,s),c') in
821		let addrs = [
822		error ("IP: ::192.168 ",4) "not an IPv4 address: invalid character ':' at 4\nnot an IPv6 address: invalid character ' ' at 13" 13;
823		error ("IP: [::192.168] ",4) "not an IPv4 address: invalid character '[' at 4\nnot an IPv6 address: invalid character ']' at 14" 14; (* ? *)
824		error ("IP: 192:168::3.5 ",4) "not an IPv4 address: invalid character ':' at 7\nnot an IPv6 address: invalid character ' ' at 16" 16;
825		] in
826		List.iter (fun ((addr,off),(exn,cursor)) ->
827		let c = ref off in
828		assert_raises ~msg:addr exn (fun () -> of_string_raw addr c);
829		assert_equal ~msg:(Printf.sprintf "%s cursor <> %d (%d)" addr cursor !c)
830		!c cursor
831		) addrs
	928	let error (s, c) msg c' = ((s, c), (Parse_error (msg, s), c')) in
	929	let addrs =
	930	[
	931	error ("IP: ::192.168 ", 4)
	932	"not an IPv4 address: invalid character ':' at 4\n\
	933	not an IPv6 address: invalid character ' ' at 13" 13;
	934	error ("IP: [::192.168] ", 4)
	935	"not an IPv4 address: invalid character '[' at 4\n\
	936	not an IPv6 address: invalid character ']' at 14" 14;
	937	(* ? *)
	938	error ("IP: 192:168::3.5 ", 4)
	939	"not an IPv4 address: invalid character ':' at 7\n\
	940	not an IPv6 address: invalid character ' ' at 16" 16;
	941	]
	942	in
	943	List.iter
	944	(fun ((addr, off), (exn, cursor)) ->
	945	let c = ref off in
	946	assert_raises ~msg:addr exn (fun () -> of_string_raw addr c);
	947	assert_equal
	948	~msg:(Printf.sprintf "%s cursor <> %d (%d)" addr cursor !c)
	949	!c cursor)
	950	addrs
832	951
833	952	let test_map () =
834		let module M = Map.Make(Ipaddr) in
	953	let module M = Map.Make (Ipaddr) in
835	954	let maxv6 = "ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff" in
836	955	let maxv4 = "254.254.254.254" in
837	956	let m = M.add (of_string_exn maxv4) "the greatest host v4" M.empty in

841	960	let m = M.add (of_string_exn "1.0.0.1") "minv4" m in
842	961	let m = M.add (of_string_exn "1.0.0.1") "the least host v4" m in
843	962	assert_equal ~msg:"size" (M.cardinal m) 4;
844		let (min_key, min_val) = M.min_binding m in
845		assert_equal ~msg:("min is '" ^ min_val ^"'") (min_key, min_val)
	963	let min_key, min_val = M.min_binding m in
	964	assert_equal
	965	~msg:("min is '" ^ min_val ^ "'")
	966	(min_key, min_val)
846	967	(of_string_exn "1.0.0.1", "the least host v4");
847	968	assert_equal ~msg:"max" (M.max_binding m)
848	969	(of_string_exn maxv6, "the greatest host v6")
849	970
850	971	let test_prefix_mem () =
851	972	let ip = of_string_exn in
852		let ships = [
853		ip "192.168.0.1", V4 V4.Prefix.private_192, true;
854		ip "192.168.0.1", Prefix.of_string_exn "::ffff:0:0/96", true;
855		ip "192.168.0.1", Prefix.of_string_exn "::ffff:0:0/95", true;
856		ip "192.168.0.1", Prefix.of_string_exn "::ffff:0:0/97", false;
857		ip "192.168.0.1", Prefix.of_string_exn "::ffff:128.0.0.0/97", true;
858		ip "::ffff:10.0.0.1", V4 V4.Prefix.private_10, true;
859		ip "::fffe:10.0.0.1", V4 V4.Prefix.private_10, false;
860		] in
861		List.iter (fun (addr,subnet,is_mem) ->
862		let msg = Printf.sprintf "%s is%s in %s"
863		(to_string addr) (if is_mem then "" else " not") (Prefix.to_string subnet)
864		in
865		assert_equal ~msg (Prefix.mem addr subnet) is_mem
866		) ships
	973	let ships =
	974	[
	975	(ip "192.168.0.1", V4 V4.Prefix.private_192, true);
	976	(ip "192.168.0.1", Prefix.of_string_exn "::ffff:0:0/96", true);
	977	(ip "192.168.0.1", Prefix.of_string_exn "::ffff:0:0/95", true);
	978	(ip "192.168.0.1", Prefix.of_string_exn "::ffff:0:0/97", false);
	979	(ip "192.168.0.1", Prefix.of_string_exn "::ffff:128.0.0.0/97", true);
	980	(ip "::ffff:10.0.0.1", V4 V4.Prefix.private_10, true);
	981	(ip "::fffe:10.0.0.1", V4 V4.Prefix.private_10, false);
	982	]
	983	in
	984	List.iter
	985	(fun (addr, subnet, is_mem) ->
	986	let msg =
	987	Printf.sprintf "%s is%s in %s" (to_string addr)
	988	(if is_mem then "" else " not")
	989	(Prefix.to_string subnet)
	990	in
	991	assert_equal ~msg (Prefix.mem addr subnet) is_mem)
	992	ships
867	993
868	994	let test_prefix_subset () =
869	995	let pre = Prefix.of_string_exn in
870		let ships = [
871		pre "10.0.0.1/32", pre "10.0.0.1/32", true;
872		pre "10.0.0.1/32", pre "10.0.0.2/32", false;
873		pre "10.0.0.3/32", pre "10.0.0.2/31", true;
874		pre "10.0.0.2/31", pre "10.0.0.3/32", false;
875		pre "10.0.10.0/24", V4 V4.Prefix.private_10, true;
876		V4 V4.Prefix.private_10, pre "10.0.10.0/24", false;
877		] in
878		List.iter (fun (subnet1,subnet2,is_subset) ->
879		let msg = Printf.sprintf "%s is%s subset of %s"
880		(Prefix.to_string subnet1)
881		(if is_subset then "" else " not")
882		(Prefix.to_string subnet2)
883		in
884		assert_equal ~msg
885		(Prefix.subset ~subnet:subnet1 ~network:subnet2) is_subset
886		) ships
887
888		let suite = "Test Generic Addresses" >::: [
889		"string_raw_rt" >:: test_string_raw_rt;
890		"string_raw_rt_bad" >:: test_string_raw_rt_bad;
891		"map" >:: test_map;
892		"prefix_mem" >:: test_prefix_mem;
893		"prefix_subset" >:: test_prefix_subset;
894		]
	996	let ships =
	997	[
	998	(pre "10.0.0.1/32", pre "10.0.0.1/32", true);
	999	(pre "10.0.0.1/32", pre "10.0.0.2/32", false);
	1000	(pre "10.0.0.3/32", pre "10.0.0.2/31", true);
	1001	(pre "10.0.0.2/31", pre "10.0.0.3/32", false);
	1002	(pre "10.0.10.0/24", V4 V4.Prefix.private_10, true);
	1003	(V4 V4.Prefix.private_10, pre "10.0.10.0/24", false);
	1004	]
	1005	in
	1006	List.iter
	1007	(fun (subnet1, subnet2, is_subset) ->
	1008	let msg =
	1009	Printf.sprintf "%s is%s subset of %s" (Prefix.to_string subnet1)
	1010	(if is_subset then "" else " not")
	1011	(Prefix.to_string subnet2)
	1012	in
	1013	assert_equal ~msg
	1014	(Prefix.subset ~subnet:subnet1 ~network:subnet2)
	1015	is_subset)
	1016	ships
	1017
	1018	let suite =
	1019	"Test Generic Addresses"
	1020	>::: [
	1021	"string_raw_rt" >:: test_string_raw_rt;
	1022	"string_raw_rt_bad" >:: test_string_raw_rt_bad;
	1023	"map" >:: test_map;
	1024	"prefix_mem" >:: test_prefix_mem;
	1025	"prefix_subset" >:: test_prefix_subset;
	1026	]
895	1027
896	1028	;;
897	1029	let _results = run_test_tt_main Test_v4.suite in

+14

-22

lib_test/test_ipaddr_b128.ml less more

24	24	\| Error (`Msg e) -> Printf.sprintf "Error `Msg \"%s\"" e
25	25	in
26	26	let assert_equal = assert_equal ~printer in
27		assert_equal ~msg:":: >> 32"
28		(of_string "::")
	27	assert_equal ~msg:":: >> 32" (of_string "::")
29	28	(B128.shift_right (of_string_exn "::ffff:ffff") 32);
30		assert_equal ~msg:"::aaaa:bbbb:ffff:ffff >> 32"
31		(of_string "::aaaa:bbbb")
	29	assert_equal ~msg:"::aaaa:bbbb:ffff:ffff >> 32" (of_string "::aaaa:bbbb")
32	30	(B128.shift_right (of_string_exn "::aaaa:bbbb:ffff:ffff") 32);
33		assert_equal ~msg:"::aaaa:bbbb:ffff:ffff >> 40"
34		(of_string "::aa:aabb")
35		(B128.shift_right (of_string_exn "::aaaa:bbbb:ffff:ffff") 40);
36		assert_equal ~msg:"::ffff >> 2"
37		(of_string "::3fff")
38		(B128.shift_right (of_string_exn "::ffff") 2);
39		assert_equal ~msg:"ffff:: >> 128"
40		(of_string "::")
41		(B128.shift_right (of_string_exn "ffff::") 128);
42		assert_equal ~msg:"aaaa:bbbb:cccc:dddd:: >> 120"
43		(of_string "::aa")
44		(B128.shift_right (of_string_exn "aaaa:bbbb:cccc:dddd::") 120);
	31	assert_equal ~msg:"::aaaa:bbbb:ffff:ffff >> 40" (of_string "::aa:aabb")
	32	(B128.shift_right (of_string_exn "::aaaa:bbbb:ffff:ffff") 40);
	33	assert_equal ~msg:"::ffff >> 2" (of_string "::3fff")
	34	(B128.shift_right (of_string_exn "::ffff") 2);
	35	assert_equal ~msg:"ffff:: >> 128" (of_string "::")
	36	(B128.shift_right (of_string_exn "ffff::") 128);
	37	assert_equal ~msg:"aaaa:bbbb:cccc:dddd:: >> 120" (of_string "::aa")
	38	(B128.shift_right (of_string_exn "aaaa:bbbb:cccc:dddd::") 120);
45	39	assert_equal ~msg:"ffff:: >> 140"
46		(of_string "::")
47		(B128.shift_right (of_string_exn "ffff::") 140);
	40	(Error (`Msg "Ipaddr: unexpected argument sz (must be >= 0 and < 128)"))
	41	(B128.shift_right (of_string_exn "ffff::") 140);
48	42	assert_equal ~msg:"::ffff:ffff >> -8"
49		(of_string "::")
	43	(Error (`Msg "Ipaddr: unexpected argument sz (must be >= 0 and < 128)"))
50	44	(B128.shift_right (of_string_exn "::ffff:ffff") (-8))
51	45
52		let suite = "Test B128 module" >::: [
53		"shift_right" >:: test_shift_right;
54		]
	46	let suite = "Test B128 module" >::: [ "shift_right" >:: test_shift_right ]
55	47
56	48	;;
57	49	let _results = run_test_tt_main suite in

+54

-49

lib_test/test_macaddr.ml less more

18	18	open Macaddr
19	19
20	20	let test_string_rt () =
21		let addrs = [
22		"ca:fe:ba:be:ee:ee", ':';
23		"ca-fe-ba-be-ee-ee", '-';
24		] in
25		List.iter (fun (addr,sep) ->
26		let os = of_string_exn addr in
27		let ts = to_string ~sep os in
28		assert_equal ~msg:(addr ^ " <> " ^ ts) ts addr;
29		let os = Macaddr_sexp.(t_of_sexp (sexp_of_t os)) in
30		let ts = to_string ~sep os in
31		assert_equal ~msg:(addr ^ " <> " ^ ts) ts addr;
32		) addrs
	21	let addrs = [ ("ca:fe:ba:be:ee:ee", ':'); ("ca-fe-ba-be-ee-ee", '-') ] in
	22	List.iter
	23	(fun (addr, sep) ->
	24	let os = of_string_exn addr in
	25	let ts = to_string ~sep os in
	26	assert_equal ~msg:(addr ^ " <> " ^ ts) ts addr;
	27	let os = Macaddr_sexp.(t_of_sexp (sexp_of_t os)) in
	28	let ts = to_string ~sep os in
	29	assert_equal ~msg:(addr ^ " <> " ^ ts) ts addr)
	30	addrs
33	31
34	32	let assert_result_failure ~msg a =
35		match a with
36		\| Ok _ -> assert_failure msg
37		\| Error (`Msg _) -> ()
	33	match a with Ok _ -> assert_failure msg \| Error (`Msg _) -> ()
38	34
39	35	let test_string_rt_bad () =
40		let addrs = [
41		"ca:fe:ba:be:ee:e";
42		"ca:fe:ba:be:ee:eee";
43		"ca:fe:ba:be:eeee";
44		"ca:fe:ba:be:ee::ee";
45		"ca:fe:ba:be:e:eee";
46		"ca:fe:ba:be:ee-ee";
47		] in
	36	let addrs =
	37	[
	38	"ca:fe:ba:be:ee:e";
	39	"ca:fe:ba:be:ee:eee";
	40	"ca:fe:ba:be:eeee";
	41	"ca:fe:ba:be:ee::ee";
	42	"ca:fe:ba:be:e:eee";
	43	"ca:fe:ba:be:ee-ee";
	44	]
	45	in
48	46	List.iter (fun addr -> assert_result_failure ~msg:addr (of_string addr)) addrs
49	47
50	48	let test_bytes_rt () =

52	50	assert_equal ~msg:(String.escaped addr) (to_octets (of_octets_exn addr)) addr
53	51
54	52	let test_bytes_rt_bad () =
55		let addrs = [
56		"\254\099\003\128\000";
57		"\254\099\003\128\000\000\233";
58		] in
59		List.iter (fun addr ->
60		assert_result_failure ~msg:(String.escaped addr) (of_octets addr)) addrs
	53	let addrs = [ "\254\099\003\128\000"; "\254\099\003\128\000\000\233" ] in
	54	List.iter
	55	(fun addr ->
	56	assert_result_failure ~msg:(String.escaped addr) (of_octets addr))
	57	addrs
61	58
62	59	let test_cstruct_rt () =
63	60	let open Macaddr_cstruct in
64	61	let addr = "\254\099\003\128\000\000" in
65	62	assert_equal ~msg:(String.escaped addr)
66		(Cstruct.to_string (to_cstruct (of_cstruct_exn (Cstruct.of_string addr)))) addr
	63	(Cstruct.to_string (to_cstruct (of_cstruct_exn (Cstruct.of_string addr))))
	64	addr
67	65
68		let error s = s, Parse_error ("MAC is exactly 6 bytes",s)
	66	let error s = (s, Parse_error ("MAC is exactly 6 bytes", s))
69	67
70	68	let test_cstruct_rt_bad () =
71	69	let open Macaddr_cstruct in
72		let addrs = [
73		error "\254\099\003\128\000";
74		error "\254\099\003\128\000\000\233";
75		] in
76		List.iter (fun (addr,exn) ->
77		assert_raises ~msg:(String.escaped addr) exn (fun () -> of_cstruct_exn (Cstruct.of_string addr))) addrs
	70	let addrs =
	71	[ error "\254\099\003\128\000"; error "\254\099\003\128\000\000\233" ]
	72	in
	73	List.iter
	74	(fun (addr, exn) ->
	75	assert_raises ~msg:(String.escaped addr) exn (fun () ->
	76	of_cstruct_exn (Cstruct.of_string addr)))
	77	addrs
78	78
79	79	let test_make_local () =
80	80	let () = Random.self_init () in

83	83	assert_equal ~msg:"is_local" (is_local local_addr) true;
84	84	assert_equal ~msg:"is_unicast" (is_unicast local_addr) true;
85	85	assert_equal ~msg:"localize" (to_octets local_addr).[0] (Char.chr 254);
86		for i=1 to 5 do
87		assert_equal ~msg:("addr.["^(string_of_int i)^"]")
88		(to_octets local_addr).[i] (Char.chr (bytegen i))
	86	for i = 1 to 5 do
	87	assert_equal
	88	~msg:("addr.[" ^ string_of_int i ^ "]")
	89	(to_octets local_addr).[i]
	90	(Char.chr (bytegen i))
89	91	done;
90	92	assert_equal ~msg:"get_oui" (get_oui local_addr)
91	93	((254 lsl 16) + (254 lsl 8) + 253)
92	94
93		let suite = "Test" >::: [
94		"string_rt" >:: test_string_rt;
95		"string_rt_bad" >:: test_string_rt_bad;
96		"bytes_rt" >:: test_bytes_rt;
97		"bytes_rt_bad" >:: test_bytes_rt_bad;
98		"cstruct_rt" >:: test_cstruct_rt;
99		"cstruct_rt_bad" >:: test_cstruct_rt_bad;
100		"make_local" >:: test_make_local;
101		]
	95	let suite =
	96	"Test"
	97	>::: [
	98	"string_rt" >:: test_string_rt;
	99	"string_rt_bad" >:: test_string_rt_bad;
	100	"bytes_rt" >:: test_bytes_rt;
	101	"bytes_rt_bad" >:: test_bytes_rt_bad;
	102	"cstruct_rt" >:: test_cstruct_rt;
	103	"cstruct_rt_bad" >:: test_cstruct_rt_bad;
	104	"make_local" >:: test_make_local;
	105	]
	106
102	107	;;
103	108	run_test_tt_main suite

+10

-9

lib_test/test_ppx.ml less more

15	15	*)
16	16
17	17	type t = {
18		ip: Ipaddr_sexp.t;
19		ipv6: Ipaddr_sexp.V6.t;
20		ipv6p: Ipaddr_sexp.V6.Prefix.t;
21		ipv4: Ipaddr_sexp.V4.t;
22		ipv4p: Ipaddr_sexp.V4.Prefix.t;
23		scope: Ipaddr_sexp.scope;
24		mac: Macaddr_sexp.t;
25		ipp: Ipaddr_sexp.Prefix.t;
26		} [@@deriving sexp]
	18	ip : Ipaddr_sexp.t;
	19	ipv6 : Ipaddr_sexp.V6.t;
	20	ipv6p : Ipaddr_sexp.V6.Prefix.t;
	21	ipv4 : Ipaddr_sexp.V4.t;
	22	ipv4p : Ipaddr_sexp.V4.Prefix.t;
	23	scope : Ipaddr_sexp.scope;
	24	mac : Macaddr_sexp.t;
	25	ipp : Ipaddr_sexp.Prefix.t;
	26	}
	27	[@@deriving sexp]

-3

macaddr-cstruct.opam less more

	0	version: "5.0.1"
0	1	opam-version: "2.0"
1	2	maintainer: "anil@recoil.org"
2	3	authors: ["David Sheets" "Anil Madhavapeddy" "Hugo Heuzard"]

8	9	bug-reports: "https://github.com/mirage/ocaml-ipaddr/issues"
9	10	depends: [
10	11	"ocaml" {>= "4.04.0"}
11		"dune"
12		"macaddr" {=version}
	12	"dune" {>= "1.9.0"}
	13	"macaddr" {= version}
13	14	"cstruct"
14	15	]
15	16	build: [

20	21	dev-repo: "git+https://github.com/mirage/ocaml-ipaddr.git"
21	22	description: """
22	23	Cstruct convertions for macaddr
23		"""
	24	"""⏎

-4

macaddr-sexp.opam less more

	0	version: "5.0.1"
0	1	opam-version: "2.0"
1	2	maintainer: "anil@recoil.org"
2	3	authors: ["David Sheets" "Anil Madhavapeddy" "Hugo Heuzard"]

8	9	bug-reports: "https://github.com/mirage/ocaml-ipaddr/issues"
9	10	depends: [
10	11	"ocaml" {>= "4.04.0"}
11		"dune"
12		"macaddr"
13		"macaddr-cstruct" {with-test}
	12	"dune" {>= "1.9.0"}
	13	"macaddr" {= version}
	14	"macaddr-cstruct" {with-test & = version}
14	15	"ounit" {with-test}
15	16	"ppx_sexp_conv" {>= "v0.9.0"}
16	17	]

23	24	dev-repo: "git+https://github.com/mirage/ocaml-ipaddr.git"
24	25	description: """
25	26	Sexp convertions for macaddr
26		"""
	27	"""⏎

-2

macaddr.opam less more

	0	version: "5.0.1"
0	1	opam-version: "2.0"
1	2	maintainer: "anil@recoil.org"
2	3	authors: ["David Sheets" "Anil Madhavapeddy" "Hugo Heuzard"]

8	9	bug-reports: "https://github.com/mirage/ocaml-ipaddr/issues"
9	10	depends: [
10	11	"ocaml" {>= "4.04.0"}
11		"dune"
	12	"dune" {>= "1.9.0"}
12	13	"ounit" {with-test}
13	14	"ppx_sexp_conv" {with-test & >= "v0.9.0"}
14	15	]

28	29	* MAC-48 (Ethernet) address support
29	30	* `Macaddr` is a `Map.OrderedType`
30	31	* All types have sexplib serializers/deserializers optionally via the `Macaddr_sexp` library.
31		"""
	32	"""⏎