My working unpac space for OCaml projects in development
Merge opam/patches/ipaddr
+5341
+5
vendor/opam/ipaddr/.ocamlformat
+5
vendor/opam/ipaddr/.ocamlformat
+330
vendor/opam/ipaddr/CHANGES.md
+330
vendor/opam/ipaddr/CHANGES.md
···
1
+
## v5.6.1 (2025-08-01)
2
+
3
+
* Add Ipaddr.Prefix.bits (#125 @psafont)
4
+
5
+
## v5.6.0 (2024-05-22)
6
+
7
+
* Add host and subnet Seq.t iterators for Ipaddr.V4.prefix, Ipaddr.V6.Prefix
8
+
and Ipaddr.Prefix (#107 @verbosemode @dinosaure)
9
+
* Ipaddr.V4.compare: use Int32.unsigned_compare, as provided since OCaml 4.08
10
+
(#118 @reynir)
11
+
* Ipaddr.V6.t is a string, not a byte vector anymore (so it is immutable)
12
+
(#119 @reynir, restoring 4.08 compatibility #121)
13
+
* Provide Ipaddr.Prefix.address (since 5.0.0, Ipaddr.V4.Prefix.address and
14
+
Ipaddr.V6.Prefix.address have been provided, but Ipaddr.Prefix.address was
15
+
forgotten) (#122 @hannesm)
16
+
* Fix further docstrings (#123, fixes #81, @hannesm @reynir)
17
+
18
+
## v5.5.0 (2023-03-31)
19
+
20
+
* add `Ipaddr` `of_octet` functions (#117, @ryangibb).
21
+
22
+
## v5.4.0 (2023-03-13)
23
+
24
+
* Use Bytes.t for IPv6 addresses (#115 @verbosemode, fixes #16 @dsheets)
25
+
* Also fixes `V6.to_int64` (reported by @RyanGibb in #113)
26
+
27
+
## v5.3.1 (2022-07-04)
28
+
29
+
* Remove stdlib-shims dependency, require OCaml 4.08+ (@hannesm, #112)
30
+
* Switch to ounit2 (@Alessandro-Barbieri, #111)
31
+
32
+
## v5.3.0 (2022-03-04)
33
+
34
+
* Add `with_port_of_string` function (@dinosaure, @hannesm, #108)
35
+
* **breaking-change** Be restrictive on `Ipaddr.of_string` (@dinosaure, @hannesm, #109)
36
+
Before this release, `Ipaddr.of_string` accepts remaining bytes and returns
37
+
a valid value such as `"127.0.0.1aaaa"` is valid. Now, `ipaddr` does not
38
+
accept a string with remaining bytes.
39
+
40
+
## v5.2.0 (2021-09-11)
41
+
42
+
* Use Cstruct.length instead of deprecated Cstruct.len (#106, @hannesm)
43
+
* Provide instantiated functors Set, Map, V4.Set, V4.Map, V6.Set, V6.Map
44
+
(#106, @hannesm)
45
+
46
+
## v5.1.0 (2021-06-08)
47
+
48
+
* Reject octal notation in IPv4 (cve-2021-29921, #104, @jsachs)
49
+
* CI fixes, upgrade to ocamlformat 0.18 (@hannesm)
50
+
51
+
## v5.0.1 (2020-09-30)
52
+
53
+
* Fix V4.Prefix.broadcast and last with /32 prefixes (#102 @verbosemode)
54
+
55
+
## v5.0.0 (2020-06-16)
56
+
57
+
* Do not zero out the non-prefix-length part of the address in
58
+
`{V4,V6}.Prefix.t` (#99 @hannesm)
59
+
Removed `{V4,V6}.Prefix.of_address_string{,_exn}` and
60
+
`{V4,V6}.Prefix.to_address_{string.buffer}`
61
+
62
+
To port code:
63
+
- if you rely on `Prefix.of_string` to zero out the non-prefix-length address
64
+
bits, call `Prefix.prefix : t -> t` subsequently.
65
+
- `Prefix.of_address_string{,_exn}` can be replaced by
66
+
`Prefix.of_string{,_exn}`, to retrieve the address use
67
+
`Prefix.address : t -> addr`.
68
+
- The `Prefix.to_address_{string,buffer}` can be replaced by
69
+
`Prefix.to_{string,buffer}`, where `Prefix.t` already contains the IP
70
+
address to be printed.
71
+
- Instead of passing `{V4,V6}.t * {V4,V6}.Prefix.t` for an
72
+
address and subnet configuration, `{V4,V6}.Prefix.t` is sufficient.
73
+
74
+
* Implement `{V4,V6,}.succ`, `{V4,V6,}.pred`, `{V4,V6}.Prefix.first`, and
75
+
`{V4,V6}.Prefix.last` functions (#94 @NightBlues)
76
+
77
+
* Rename `Prefix.of_netmask` to `Prefix.of_netmask_exn` with labelled
78
+
arguments (~netmask and ~address), provide `Prefix.of_netmask` which returns
79
+
a (t, [> `Msg of string ]) result value (#95 @hannesm)
80
+
81
+
* Fix undefined behaviour of `V4.Prefix.mem` with a CIDR with prefix length 0
82
+
(#98 @verbosemode)
83
+
84
+
* Use stdlib-shims to prevent deprecation warnings on OCaml 4.08
85
+
(@avsm)
86
+
87
+
* Remove unnecessary "sexplib0" dependency (#95 @hannesm)
88
+
89
+
* Remove "{build}" directive from "dune" dependency (#93 @CraigFe)
90
+
91
+
## v4.0.0 (2019-07-12)
92
+
93
+
* Rename the `to/from_bytes` functions to refer to `octets`
94
+
instead. This distinguishes the meaning of human-readable
95
+
addresses (`string`s in this library) and byte-packed
96
+
representations(`octet`s in this library) from the OCaml
97
+
`bytes` type that represents mutable strings.
98
+
99
+
Porting code should just be a matter of renaming functions
100
+
such as:
101
+
- `Ipaddr.of_bytes` becomes `Ipaddr.of_octets`
102
+
- `Macaddr.to_bytes` becomes `Macaddr.to_octets`
103
+
104
+
* Introduce new `write_octets` functions that can write
105
+
octet representations of IPv4/v6 into an existing bytestring.
106
+
107
+
* Use the `domain-name` library to produce domain names
108
+
from IP addresses.
109
+
110
+
* Remove the `ipaddr.sexp` and `macaddr.sexp` ocamlfind
111
+
subpackages and instead have `ipaddr-sexp` and `macaddr-sexp`
112
+
to match the opam package names.
113
+
114
+
* Add new `Ipaddr_cstruct` and `Macaddr_cstruct` libraries
115
+
for conversion to/from cstructs (#36 @nojb @avsm)
116
+
117
+
## v3.1.0 (2019-03-02)
118
+
119
+
* Do not leak a `Not_found` exception when parsing `[:`
120
+
in IPv6 and instead raise `Parse_error` as other errors
121
+
do (found by fuzz testing in #84 by @dinosaure)
122
+
* Install automatic toplevel printers for the Ipaddr
123
+
types via `[@@ocaml.toplevel_printer]`. This enables
124
+
utop to automatically install the printers (@avsm)
125
+
126
+
## 3.0.0 (2019-01-02)
127
+
128
+
This release features several backwards incompatible changes,
129
+
but ones that should increase the portability and robustness
130
+
of the library.
131
+
132
+
* Remove the sexp serialisers from the main interface in favour
133
+
of `pp` functions. Use the `Ipaddr_sexp` module if you still
134
+
need a sexp serialiser.
135
+
136
+
To use these with ppx-based derivers, simply replace the
137
+
reference to the `Ipaddr` type definition with `Ipaddr_sexp`.
138
+
That will import the sexp-conversion functions, and the actual
139
+
type definitions are simply aliases to the corresponding type
140
+
within `Ipaddr`. For example, you might do:
141
+
142
+
```
143
+
type t = {
144
+
ip: Ipaddr_sexp.t;
145
+
mac: Macaddr_sexp.t;
146
+
} [@@deriving sexp]
147
+
```
148
+
149
+
The actual types of the records will be aliases to the main
150
+
library types, and there will be two new functions available
151
+
as converters. The signature after ppx has run will be:
152
+
153
+
```
154
+
type t = {
155
+
ip: Ipaddr.t;
156
+
mac: Macaddr.t;
157
+
}
158
+
val sexp_of_t : t -> Sexplib0.t
159
+
val t_of_sexp : Sexplib0.t -> t
160
+
```
161
+
162
+
* Break out the `Macaddr` module into a separate opam package so
163
+
that the `Ipaddr` module can be wrapped. Use the `macaddr`
164
+
opam library now if you need just the MAC address functionality.
165
+
166
+
* Replace all the `of_string/bytes` functions that formerly returned
167
+
option types with the `Rresult` result types instead. This stops
168
+
the cause of the exception from being swallowed, and the error
169
+
message in the new functions can be displayed usefully.
170
+
171
+
* In the `Ipaddr.V6.to_string` and `to_buffer` functions, remove the
172
+
optional labelled argument `v4` and always output v4-mapped strings
173
+
as recommended by RFC5952. (#80 by @hannesm).
174
+
175
+
* Remove `pp_hum` which was deprecated in 2.9.0.
176
+
177
+
* Sexplib0 is now used which is more lightweight tha the full
178
+
Sexplib library. Minimum OCaml version is now 4.04.0+ as a result
179
+
of this dependency.
180
+
181
+
* Improvements to the ocamldoc formatting strings for better
182
+
layout and odoc compatibility.
183
+
184
+
## 2.9.0 (2018-12-11)
185
+
186
+
* Add `pp` functions for prettyprinting and deprecate `pp_hum` variants.
187
+
The two functions are currently the same, so porting is just a matter
188
+
of replacing existing uses of `pp_hum` with `pp` (#71 @verbosemode)
189
+
* Fix deprecation warnings on newer OCaml standard libraries (#74 @cfcs).
190
+
* Fix `base-unix` depopt to be a real dependency (#68 @rgrinberg).
191
+
* Fix missing `sexplib` dependency (#66 #67 @bmillwood).
192
+
* Port to Dune from jbuilder and update opam metadata to 2.0 format (#76 @avsm).
193
+
* Remove unused variable and bindings warnings in the implementation and
194
+
signatures (#76 @avsm)
195
+
* Fix toplevel handling of the `ipaddr.top` package by linking
196
+
to compiler-libs instead of compiler-libs.toplevel (#76 @avsm based on
197
+
fix in mirage/ocaml-uri#130 by @yallop)
198
+
* Update Travis to test latest distros by using their aliases (#76 @avsm)
199
+
* Upgrade opam metadata to the 2.0 format (#76 @avsm)
200
+
201
+
## 2.8.0 (2017-06-01)
202
+
203
+
* Port to Jbuilder (#65 @vbmithr @avsm).
204
+
There should be no observable changes, except that `Ipaddr_unix` is now
205
+
in a separate subdirectory. This means that packages that implicitly
206
+
depended on the module without including the ocamlfind `ipaddr.unix`
207
+
package may now fail. Just adding the ocamlfind dependency will fix it,
208
+
and is backwards compatible with older Ipaddr releases.
209
+
* Minimum version of OCaml required is now 4.03.0 (formerly was 4.02.2),
210
+
due to the use of recent `ppx_sexp_conv` with Jbuilder also having that
211
+
as the minimum supported compiler version.
212
+
213
+
## 2.7.2 (2017-02-16)
214
+
215
+
* Fix a missing findlib toploop package (#61 from Vincent Bernardoff)
216
+
217
+
## 2.7.1 (2016-11-16)
218
+
219
+
* Use topkg for build (#60 from Jochen Bartl)
220
+
221
+
## 2.7.0 (2016-02-14)
222
+
223
+
* Remove `sexplib.syntax`, `type_conv` deps and camlp4 transitive dependency
224
+
* Add `ppx_sexp_conv` dependency
225
+
* Require OCaml 4.02.2+
226
+
* Add `Ipaddr.Prefix.subset`, `Ipaddr.V4.Prefix.subset` and `Ipaddr.V6.subset`
227
+
predicates to test containment of subnets (#52 from @seliopou)
228
+
229
+
## 2.6.1 (2015-02-20)
230
+
231
+
* Fix findlib requires in oasis to restore pre-4.02.1 compatibility
232
+
233
+
## 2.6.0 (2015-02-19)
234
+
235
+
* Change IPv6 link-local address prefix from fe80::/10 to fe80::/64. (#39)
236
+
* Remove type bytes = string alias (potentially breaking)
237
+
* Turn on -safe-string (#41)
238
+
* {V4,V6}.`to_bytes_raw` now uses Bytes.t rather than string (potentially breaking)
239
+
* Add multicast MAC conversions from RFC 1112 and RFC 2464
240
+
* Add `to_domain_name` conversions to DNS label lists (in-addr.arpa and ip6.arpa)
241
+
* Add `V6.interface_routers`, `V6.site_routers`, and `V6.Prefix.solicited_node`
242
+
* Add `V6.link_address_of_mac` to convert a MAC into a link local IP address
243
+
244
+
## 2.5.0 (2014-05-27)
245
+
246
+
* Add `with sexp` (de)serializers to all of the Ipaddr and Macaddr types. (#31)
247
+
248
+
## 2.4.0 (2014-02-11)
249
+
250
+
* Add `Ipaddr.V6.Prefix.of_netmask` for conversion from an IPv6
251
+
address/netmask to prefix (useful for some binary interfaces). See #27.
252
+
* Add `Ipaddr.V6.Prefix.netmask` to generate a netmask address from a
253
+
prefix (useful for some binary interfaces). See #27.
254
+
* Add `Ipaddr.Prefix.network` for generic prefix -> address conversion
255
+
* Add `Ipaddr.Prefix.netmask` for generic prefix -> netmask conversion
256
+
257
+
## 2.3.0 (2014-02-05)
258
+
259
+
* Add `Ipaddr.V4.Prefix.of_netmask` for conversion from an
260
+
address/netmask to prefix
261
+
* Add `Ipaddr.V4.Prefix.netmask` to generate a netmask address from a prefix
262
+
263
+
## 2.2.0 (2014-01-27)
264
+
265
+
* Add an [Ipaddr_unix] module to convert to-and-from the standard library.
266
+
* Add a toplevel pretty printer in the `ipaddr.top` package.
267
+
268
+
## 2.1.0 (2014-01-20)
269
+
270
+
* Add `of_string_raw` to `Ipaddr.V4.Prefix` and `Ipaddr.V6.Prefix`
271
+
* Add `of_addr` to `Ipaddr.V4.Prefix` and `Ipaddr.V6.Prefix`
272
+
* Add type `('v4,'v6) v4v6` to `Ipaddr` to represent version disjuncts
273
+
* Add `Ipaddr.Prefix` module for generic prefix manipulation
274
+
275
+
## 2.0.0 (2014-01-17)
276
+
277
+
* Change `Ipaddr.V4.make` to accept `int` rather than `int32` (breaking)
278
+
* Add IPv6 support
279
+
* Add generic IP address support
280
+
* Add type `scope` for classifying address scopes
281
+
* Add `Ipaddr.V4.of_string_raw` for parsing inside of larger strings
282
+
* Add `Ipaddr.V4.to_int16` and `Ipaddr.V4.of_int16`
283
+
* Add `unspecified`, `nodes`, and `routers` constants to `Ipaddr.V4`
284
+
* Add `Ipaddr.V4.Prefix.network_address` to put an address into a subnet
285
+
* Add `of_address_string_exn`, `of_address_string`, `to_address_string`,
286
+
`to_address_buffer` to `Ipaddr.V4.Prefix` to parse/print combined addr/prefix
287
+
* Add `multicast_org`, `multicast_admin`, `multicast_link` subnet constants to
288
+
`Ipaddr.V4.Prefix`
289
+
* Add `Ipaddr.V4.scope` to classify IPv4 addresses
290
+
* Add `Ipaddr.V4.is_global` and `Ipaddr.V4.is_multicast` predicates
291
+
* Add optional `sep:char` argument to `Macaddr.to_string`
292
+
* Remove internal use of Scanf.scanf
293
+
294
+
## 1.0.0 (2013-10-16)
295
+
296
+
* Add Travis-CI testing scripts.
297
+
* Include debug symbols and annot files by default.
298
+
299
+
## 0.2.3 (2013-09-20)
300
+
301
+
* Add `Ipaddr.V4.Prefix.bits` function to produce bits of prefix from prefix.
302
+
303
+
## 0.2.2 (2013-08-07)
304
+
305
+
* Add `Macaddr.make_local` function to create local unicast MAC
306
+
addresses from an octet generation function.
307
+
* Add `Macaddr.get_oui` accessor to extract the Organizationally Unique
308
+
Identifier as an integer.
309
+
* Add `Macaddr.is_local` predicate to test for a locally administered address.
310
+
* Add `Macaddr.is_unicast` predicate to test for a unicast MAC address.
311
+
312
+
## 0.2.1 (2013-08-01)
313
+
* Add `Ipaddr.V4.any`, `Ipaddr.V4.broadcast`, `Ipaddr.V4.localhost`
314
+
special constant addresses.
315
+
* Add `Ipaddr.V4.Prefix.global` (0.0.0.0/0) subnet constant.
316
+
* Add `Ipaddr.V4.Prefix.network` function to produce subnet address from prefix.
317
+
318
+
## 0.2.0 (2013-08-01)
319
+
* Add `Macaddr` module for handling MAC-48 (Ethernet) addresses.
320
+
* `Ipaddr.Parse_error` now contains both the error condition and the
321
+
failing input.
322
+
* Add ocamldoc-compatible comments on all interfaces.
323
+
324
+
## 0.1.1 (2013-07-31)
325
+
* Add loopback and link local addresses to the private blocks.
326
+
* Fix build system so Makefile is generated by OASIS.
327
+
328
+
## 0.1.0 (2013-07-24)
329
+
* Initial public release.
330
+
* Includes IPv4 and IPv4 CIDR prefix support.
+16
vendor/opam/ipaddr/LICENSE.md
+16
vendor/opam/ipaddr/LICENSE.md
···
1
+
ISC License
2
+
3
+
Copyright (c) 2013-2015 David Sheets <sheets@alum.mit.edu>
4
+
Copyright (c) 2010-2011, 2014 Anil Madhavapeddy <anil@recoil.org>
5
+
6
+
Permission to use, copy, modify, and distribute this software for any
7
+
purpose with or without fee is hereby granted, provided that the above
8
+
copyright notice and this permission notice appear in all copies.
9
+
10
+
THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
11
+
WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
12
+
MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
13
+
ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
14
+
WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
15
+
ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
16
+
OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+13
vendor/opam/ipaddr/Makefile
+13
vendor/opam/ipaddr/Makefile
+64
vendor/opam/ipaddr/README.md
+64
vendor/opam/ipaddr/README.md
···
1
+
# ipaddr: IP and MAC address manipulation
2
+
3
+
A library for manipulation of IP and MAC address representations.
4
+
5
+
Features:
6
+
7
+
* ounit2-based tests
8
+
* IPv4 and IPv6 support
9
+
* IPv4 and IPv6 CIDR prefix support
10
+
* IPv4 and IPv6 [CIDR-scoped address](http://tools.ietf.org/html/rfc4291#section-2.3) support
11
+
* `Ipaddr.V4` and `Ipaddr.V4.Prefix` modules are `Map.OrderedType`
12
+
* `Ipaddr.V6` and `Ipaddr.V6.Prefix` modules are `Map.OrderedType`
13
+
* `Ipaddr` and `Ipaddr.Prefix` modules are `Map.OrderedType`
14
+
* `Ipaddr_unix` in findlib subpackage `ipaddr.unix` provides compatibility with the standard library `Unix` module
15
+
* `Ipaddr_top` in findlib subpackage `ipaddr.top` provides top-level pretty printers
16
+
* IP address scope classification
17
+
* IPv4-mapped addresses in IPv6 (::ffff:0:0/96) are an embedding of IPv4
18
+
* MAC-48 (Ethernet) address support
19
+
* `Macaddr` is a `Map.OrderedType`
20
+
* All types have sexplib serializers/deserializers optionally via the `Ipaddr_sexp` and `Macaddr_sexp` libraries.
21
+
22
+
## Usage
23
+
24
+
There are the following opam packages included:
25
+
26
+
- `ipaddr`: the `Ipaddr` and associated modules
27
+
- `ipaddr-sexp`
28
+
- `ipaddr-cstruct`
29
+
- `macaddr`: the `Macaddr` and associated modules.
30
+
- `macaddr-sexp`
31
+
- `macaddr-cstruct`
32
+
33
+
There are the following ocamlfind libraries included as part of this
34
+
repository, included as part of the respective opam packages.
35
+
36
+
- `ipaddr`: The `Ipaddr` module for IPv4/6 manipulation.
37
+
- `ipaddr.top`: Toplevel printers for Ipaddr.
38
+
- `ipaddr-cstruct`: The `Ipaddr_cstruct` module
39
+
- `macaddr`: The `Macaddr` module for MAC address manipulation.
40
+
- `macaddr.top`: Toplevel printers for Macaddr.
41
+
- `macaddr-cstruct`: The `Macaddr_cstruct` module
42
+
- `ipaddr-sexp`: S-expression converters for Ipaddr.
43
+
- `macaddr-sexp`: S-expression converters for Macaddr.
44
+
45
+
## Installation and development
46
+
47
+
The packages are released to the opam-repository. An `opam install ipaddr`
48
+
(or any other above mentioned package) will install it. If you want to install
49
+
the latest development commit, `opam pin add ipaddr --dev` will do this.
50
+
51
+
A local build, after a `git clone` can be done with `dune build`, a
52
+
`dune runtest` compiles and executes the testsuite. If dependencies are missing,
53
+
`opam install (-t) --deps-only .` in the cloned directory will install them.
54
+
55
+
The auto-formatter [`ocamlformat`](https://github.com/ocaml-ppx/ocamlformat) is
56
+
used, please execute `dune build @fmt --auto-promote` before submitting a pull
57
+
request.
58
+
59
+
## Contact
60
+
61
+
- Issues: <https://github.com/mirage/ocaml-ipaddr/issues>
62
+
- E-mail: <mirageos-devel@lists.xenproject.org>
63
+
- API Documentation: <http://docs.mirage.io/ipaddr/>
64
+
- Discussion: <https://discuss.ocaml.org> with the `mirageos` tag.
+4
vendor/opam/ipaddr/dune-project
+4
vendor/opam/ipaddr/dune-project
+25
vendor/opam/ipaddr/ipaddr-cstruct.opam
+25
vendor/opam/ipaddr/ipaddr-cstruct.opam
···
1
+
opam-version: "2.0"
2
+
maintainer: "anil@recoil.org"
3
+
authors: ["David Sheets" "Anil Madhavapeddy" "Hugo Heuzard"]
4
+
synopsis: "A library for manipulation of IP address representations using Cstructs"
5
+
license: "ISC"
6
+
tags: ["org:mirage" "org:xapi-project"]
7
+
homepage: "https://github.com/mirage/ocaml-ipaddr"
8
+
doc: "https://mirage.github.io/ocaml-ipaddr/"
9
+
bug-reports: "https://github.com/mirage/ocaml-ipaddr/issues"
10
+
depends: [
11
+
"ocaml" {>= "4.08.0"}
12
+
"dune" {>= "1.9.0"}
13
+
"ipaddr" {= version}
14
+
"cstruct" {>= "6.0.0"}
15
+
]
16
+
build: [
17
+
["dune" "subst"] {dev}
18
+
["dune" "build" "-p" name "-j" jobs]
19
+
["dune" "runtest" "-p" name "-j" jobs] {with-test}
20
+
]
21
+
dev-repo: "git+https://github.com/mirage/ocaml-ipaddr.git"
22
+
description: """
23
+
Cstruct convertions for macaddr
24
+
"""
25
+
x-maintenance-intent: [ "(latest)" ]
+29
vendor/opam/ipaddr/ipaddr-sexp.opam
+29
vendor/opam/ipaddr/ipaddr-sexp.opam
···
1
+
opam-version: "2.0"
2
+
maintainer: "anil@recoil.org"
3
+
authors: ["David Sheets" "Anil Madhavapeddy" "Hugo Heuzard"]
4
+
synopsis: "A library for manipulation of IP address representations using sexp"
5
+
description: """
6
+
Sexp convertions for ipaddr
7
+
"""
8
+
9
+
license: "ISC"
10
+
tags: ["org:mirage" "org:xapi-project"]
11
+
homepage: "https://github.com/mirage/ocaml-ipaddr"
12
+
doc: "https://mirage.github.io/ocaml-ipaddr/"
13
+
bug-reports: "https://github.com/mirage/ocaml-ipaddr/issues"
14
+
depends: [
15
+
"ocaml" {>= "4.08.0"}
16
+
"dune" {>= "1.9.0"}
17
+
"ipaddr" {= version}
18
+
"ipaddr-cstruct" {with-test & = version}
19
+
"ounit2" {with-test}
20
+
"ppx_sexp_conv" {>= "v0.9.0"}
21
+
"sexplib0"
22
+
]
23
+
build: [
24
+
["dune" "subst"] {dev}
25
+
["dune" "build" "-p" name "-j" jobs]
26
+
["dune" "runtest" "-p" name "-j" jobs] {with-test}
27
+
]
28
+
dev-repo: "git+https://github.com/mirage/ocaml-ipaddr.git"
29
+
x-maintenance-intent: [ "(latest)" ]
+43
vendor/opam/ipaddr/ipaddr.opam
+43
vendor/opam/ipaddr/ipaddr.opam
···
1
+
opam-version: "2.0"
2
+
maintainer: "anil@recoil.org"
3
+
authors: ["David Sheets" "Anil Madhavapeddy" "Hugo Heuzard"]
4
+
synopsis: "A library for manipulation of IP (and MAC) address representations"
5
+
description: """
6
+
Features:
7
+
* Depends only on sexplib (conditionalization under consideration)
8
+
* ounit2-based tests
9
+
* IPv4 and IPv6 support
10
+
* IPv4 and IPv6 CIDR prefix support
11
+
* IPv4 and IPv6 [CIDR-scoped address](http://tools.ietf.org/html/rfc4291#section-2.3) support
12
+
* `Ipaddr.V4` and `Ipaddr.V4.Prefix` modules are `Map.OrderedType`
13
+
* `Ipaddr.V6` and `Ipaddr.V6.Prefix` modules are `Map.OrderedType`
14
+
* `Ipaddr` and `Ipaddr.Prefix` modules are `Map.OrderedType`
15
+
* `Ipaddr_unix` in findlib subpackage `ipaddr.unix` provides compatibility with the standard library `Unix` module
16
+
* `Ipaddr_top` in findlib subpackage `ipaddr.top` provides top-level pretty printers (requires compiler-libs default since OCaml 4.0)
17
+
* IP address scope classification
18
+
* IPv4-mapped addresses in IPv6 (::ffff:0:0/96) are an embedding of IPv4
19
+
* MAC-48 (Ethernet) address support
20
+
* `Macaddr` is a `Map.OrderedType`
21
+
* All types have sexplib serializers/deserializers
22
+
"""
23
+
24
+
license: "ISC"
25
+
tags: ["org:mirage" "org:xapi-project"]
26
+
homepage: "https://github.com/mirage/ocaml-ipaddr"
27
+
doc: "https://mirage.github.io/ocaml-ipaddr/"
28
+
bug-reports: "https://github.com/mirage/ocaml-ipaddr/issues"
29
+
depends: [
30
+
"ocaml" {>= "4.08.0"}
31
+
"dune" {>= "1.9.0"}
32
+
"macaddr" {= version}
33
+
"domain-name" {>= "0.3.0"}
34
+
"ounit2" {with-test}
35
+
"ppx_sexp_conv" {with-test & >= "v0.9.0"}
36
+
]
37
+
build: [
38
+
["dune" "subst"] {dev}
39
+
["dune" "build" "-p" name "-j" jobs]
40
+
["dune" "runtest" "-p" name "-j" jobs] {with-test}
41
+
]
42
+
dev-repo: "git+https://github.com/mirage/ocaml-ipaddr.git"
43
+
x-maintenance-intent: [ "(latest)" ]
+56
vendor/opam/ipaddr/lib/dune
+56
vendor/opam/ipaddr/lib/dune
···
1
+
(library
2
+
(name ipaddr)
3
+
(public_name ipaddr)
4
+
(modules ipaddr)
5
+
(libraries macaddr domain-name))
6
+
7
+
(library
8
+
(name macaddr)
9
+
(public_name macaddr)
10
+
(modules macaddr))
11
+
12
+
(library
13
+
(name ipaddr_sexp)
14
+
(public_name ipaddr-sexp)
15
+
(modules ipaddr_sexp)
16
+
(preprocess
17
+
(pps ppx_sexp_conv))
18
+
(libraries ipaddr sexplib0))
19
+
20
+
(library
21
+
(name macaddr_sexp)
22
+
(public_name macaddr-sexp)
23
+
(modules macaddr_sexp)
24
+
(preprocess
25
+
(pps ppx_sexp_conv))
26
+
(libraries macaddr sexplib0))
27
+
28
+
(library
29
+
(name ipaddr_unix)
30
+
(public_name ipaddr.unix)
31
+
(modules ipaddr_unix)
32
+
(libraries unix ipaddr))
33
+
34
+
(library
35
+
(name ipaddr_cstruct)
36
+
(public_name ipaddr-cstruct)
37
+
(modules ipaddr_cstruct)
38
+
(libraries ipaddr cstruct))
39
+
40
+
(library
41
+
(name macaddr_cstruct)
42
+
(public_name macaddr-cstruct)
43
+
(modules macaddr_cstruct)
44
+
(libraries macaddr cstruct))
45
+
46
+
(library
47
+
(name ipaddr_top)
48
+
(public_name ipaddr.top)
49
+
(modules ipaddr_top)
50
+
(libraries macaddr.top ipaddr compiler-libs))
51
+
52
+
(library
53
+
(name macaddr_top)
54
+
(public_name macaddr.top)
55
+
(modules macaddr_top)
56
+
(libraries macaddr compiler-libs))
+1378
vendor/opam/ipaddr/lib/ipaddr.ml
+1378
vendor/opam/ipaddr/lib/ipaddr.ml
···
1
+
(*
2
+
* Copyright (c) 2013-2015 David Sheets <sheets@alum.mit.edu>
3
+
*
4
+
* Permission to use, copy, modify, and distribute this software for any
5
+
* purpose with or without fee is hereby granted, provided that the above
6
+
* copyright notice and this permission notice appear in all copies.
7
+
*
8
+
* THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
9
+
* WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
10
+
* MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
11
+
* ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
12
+
* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
13
+
* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
14
+
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
15
+
*
16
+
*)
17
+
18
+
exception Parse_error of string * string
19
+
20
+
type scope = Point | Interface | Link | Admin | Site | Organization | Global
21
+
22
+
let try_with_result fn a =
23
+
try Ok (fn a) with Parse_error (msg, _) -> Error (`Msg ("Ipaddr: " ^ msg))
24
+
25
+
let failwith_msg = function Ok x -> x | Error (`Msg m) -> failwith m
26
+
27
+
let string_of_scope = function
28
+
| Point -> "point"
29
+
| Interface -> "interface"
30
+
| Link -> "link"
31
+
| Admin -> "admin"
32
+
| Site -> "site"
33
+
| Organization -> "organization"
34
+
| Global -> "global"
35
+
36
+
let scope_of_string = function
37
+
| "point" -> Ok Point
38
+
| "interface" -> Ok Interface
39
+
| "link" -> Ok Link
40
+
| "admin" -> Ok Admin
41
+
| "site" -> Ok Site
42
+
| "organization" -> Ok Organization
43
+
| "global" -> Ok Global
44
+
| s -> Error (`Msg ("unknown scope: " ^ s))
45
+
46
+
let pp_scope fmt s = Format.pp_print_string fmt (string_of_scope s)
47
+
let ( ~| ) = Int32.of_int
48
+
let ( |~ ) = Int32.to_int
49
+
let ( &&& ) x y = Int32.logand x y
50
+
let ( ||| ) x y = Int32.logor x y
51
+
let ( <|< ) x y = Int32.shift_left x y
52
+
let ( >|> ) x y = Int32.shift_right_logical x y
53
+
let ( >! ) x y = x >|> y &&& 0xFF_l
54
+
let ( <! ) x y = x &&& 0xFF_l <|< y
55
+
let need_more x = Parse_error ("not enough data", x)
56
+
let char_0 = int_of_char '0'
57
+
let char_a = int_of_char 'a'
58
+
let char_A = int_of_char 'A'
59
+
60
+
let int_of_char c =
61
+
match c with
62
+
| '0' .. '9' -> Stdlib.int_of_char c - char_0
63
+
| 'a' .. 'f' -> 10 + Stdlib.int_of_char c - char_a
64
+
| 'A' .. 'F' -> 10 + Stdlib.int_of_char c - char_A
65
+
| _ -> -1
66
+
67
+
let bad_char i s =
68
+
let msg = Printf.sprintf "invalid character '%c' at %d" s.[i] i in
69
+
Parse_error (msg, s)
70
+
71
+
let octal_notation s =
72
+
let msg = Printf.sprintf "octal notation disallowed" in
73
+
Parse_error (msg, s)
74
+
75
+
let is_number base n = n >= 0 && n < base
76
+
77
+
let parse_int base s i =
78
+
let len = String.length s in
79
+
let rec next prev =
80
+
let j = !i in
81
+
if j >= len then prev
82
+
else
83
+
let c = s.[j] in
84
+
let k = int_of_char c in
85
+
if is_number base k then (
86
+
incr i;
87
+
next ((prev * base) + k))
88
+
else prev
89
+
in
90
+
let i = !i in
91
+
if i < len then
92
+
if is_number base (int_of_char s.[i]) then next 0 else raise (bad_char i s)
93
+
else raise (need_more s)
94
+
95
+
let parse_dec_int s i = parse_int 10 s i
96
+
let parse_hex_int s i = parse_int 16 s i
97
+
98
+
let expect_char s i c =
99
+
if !i < String.length s then
100
+
if s.[!i] <> c then raise (bad_char !i s) else incr i
101
+
else raise (need_more s)
102
+
103
+
let expect_end s i = if String.length s <= !i then () else raise (bad_char !i s)
104
+
105
+
let reject_octal s i =
106
+
if !i + 1 < String.length s then
107
+
if s.[!i] == '0' && is_number 10 (int_of_char s.[!i + 1]) then
108
+
raise (octal_notation s)
109
+
110
+
module V4 = struct
111
+
type t = int32
112
+
113
+
let compare = Int32.unsigned_compare
114
+
let make a b c d = ~|a <! 24 ||| (~|b <! 16) ||| (~|c <! 8 ||| (~|d <! 0))
115
+
116
+
(* parsing *)
117
+
118
+
let parse_dotted_quad s i =
119
+
reject_octal s i;
120
+
let a = parse_dec_int s i in
121
+
expect_char s i '.';
122
+
reject_octal s i;
123
+
let b = parse_dec_int s i in
124
+
expect_char s i '.';
125
+
reject_octal s i;
126
+
let c = parse_dec_int s i in
127
+
expect_char s i '.';
128
+
reject_octal s i;
129
+
let d = parse_dec_int s i in
130
+
let valid a = a land 0xff <> a in
131
+
if valid a then raise (Parse_error ("first octet out of bounds", s))
132
+
else if valid b then raise (Parse_error ("second octet out of bounds", s))
133
+
else if valid c then raise (Parse_error ("third octet out of bounds", s))
134
+
else if valid d then raise (Parse_error ("fourth octet out of bounds", s))
135
+
else make a b c d
136
+
137
+
(* string conversion *)
138
+
139
+
let of_string_raw = parse_dotted_quad
140
+
141
+
let of_string_exn s =
142
+
let o = ref 0 in
143
+
let x = of_string_raw s o in
144
+
expect_end s o;
145
+
x
146
+
147
+
let of_string s = try_with_result of_string_exn s
148
+
149
+
let with_port_of_string ~default s =
150
+
try
151
+
let len = String.length s and o = ref 0 in
152
+
let ipv4 = of_string_raw s o in
153
+
if !o < len && s.[!o] = ':' then (
154
+
incr o;
155
+
let port = parse_dec_int s o in
156
+
expect_end s o;
157
+
Ok (ipv4, port))
158
+
else (
159
+
expect_end s o;
160
+
Ok (ipv4, default))
161
+
with Parse_error (msg, _) -> Error (`Msg ("Ipaddr: " ^ msg))
162
+
163
+
let to_buffer b i =
164
+
Printf.bprintf b "%ld.%ld.%ld.%ld" (i >! 24) (i >! 16) (i >! 8) (i >! 0)
165
+
166
+
let to_string i =
167
+
let b = Buffer.create 15 in
168
+
to_buffer b i;
169
+
Buffer.contents b
170
+
171
+
let pp ppf i = Format.fprintf ppf "%s" (to_string i)
172
+
173
+
(* Octets conversion *)
174
+
175
+
let of_octets_exn ?(off = 0) bs =
176
+
try
177
+
make
178
+
(Char.code bs.[0 + off])
179
+
(Char.code bs.[1 + off])
180
+
(Char.code bs.[2 + off])
181
+
(Char.code bs.[3 + off])
182
+
with _ -> raise (need_more bs)
183
+
184
+
let of_octets ?off bs = try_with_result (of_octets_exn ?off) bs
185
+
186
+
let write_octets_exn ?(off = 0) i b =
187
+
try
188
+
Bytes.set b (0 + off) (Char.chr (( |~ ) (i >! 24)));
189
+
Bytes.set b (1 + off) (Char.chr (( |~ ) (i >! 16)));
190
+
Bytes.set b (2 + off) (Char.chr (( |~ ) (i >! 8)));
191
+
Bytes.set b (3 + off) (Char.chr (( |~ ) (i >! 0)))
192
+
with _ -> raise (need_more (Bytes.to_string b))
193
+
194
+
let write_octets ?off i bs = try_with_result (write_octets_exn ?off i) bs
195
+
196
+
let to_octets i =
197
+
String.init 4 (function
198
+
| 0 -> Char.chr (( |~ ) (i >! 24))
199
+
| 1 -> Char.chr (( |~ ) (i >! 16))
200
+
| 2 -> Char.chr (( |~ ) (i >! 8))
201
+
| 3 -> Char.chr (( |~ ) (i >! 0))
202
+
| _ -> assert false)
203
+
204
+
(* Int32 *)
205
+
let of_int32 i = i
206
+
let to_int32 i = i
207
+
208
+
(* Int16 *)
209
+
let of_int16 (a, b) = ~|a <|< 16 ||| ~|b
210
+
let to_int16 a = (( |~ ) (a >|> 16), ( |~ ) (a &&& 0xFF_FF_l))
211
+
212
+
(* MAC *)
213
+
(* {{:http://tools.ietf.org/html/rfc1112#section-6.2}RFC 1112}. *)
214
+
let multicast_to_mac i =
215
+
let macb = Bytes.create 6 in
216
+
Bytes.set macb 0 (Char.chr 0x01);
217
+
Bytes.set macb 1 (Char.chr 0x00);
218
+
Bytes.set macb 2 (Char.chr 0x5E);
219
+
Bytes.set macb 3 (Char.chr (( |~ ) (i >|> 16 &&& 0x7F_l)));
220
+
Bytes.set macb 4 (Char.chr (( |~ ) (i >! 8)));
221
+
Bytes.set macb 5 (Char.chr (( |~ ) (i >! 0)));
222
+
Macaddr.of_octets_exn (Bytes.to_string macb)
223
+
224
+
(* Host *)
225
+
let to_domain_name i =
226
+
let name =
227
+
[
228
+
Int32.to_string (i >! 0);
229
+
Int32.to_string (i >! 8);
230
+
Int32.to_string (i >! 16);
231
+
Int32.to_string (i >! 24);
232
+
"in-addr";
233
+
"arpa";
234
+
]
235
+
in
236
+
Domain_name.(host_exn (of_strings_exn name))
237
+
238
+
let of_domain_name n =
239
+
match Domain_name.to_strings n with
240
+
| [ a; b; c; d; in_addr; arpa ]
241
+
when Domain_name.(
242
+
equal_label arpa "arpa" && equal_label in_addr "in-addr") -> (
243
+
let conv bits data =
244
+
let i = Int32.of_int (parse_dec_int data (ref 0)) in
245
+
if i > 0xFFl then
246
+
raise (Parse_error ("label with a too big number", data))
247
+
else i <! bits
248
+
in
249
+
try
250
+
let ( + ) = Int32.add in
251
+
Some (conv 0 a + conv 8 b + conv 16 c + conv 24 d)
252
+
with Parse_error _ -> None)
253
+
| _ -> None
254
+
255
+
let succ t =
256
+
if Int32.equal t 0xFF_FF_FF_FFl then
257
+
Error (`Msg "Ipaddr: highest address has been reached")
258
+
else Ok (Int32.succ t)
259
+
260
+
let pred t =
261
+
if Int32.equal t 0x00_00_00_00l then
262
+
Error (`Msg "Ipaddr: lowest address has been reached")
263
+
else Ok (Int32.pred t)
264
+
265
+
(* constant *)
266
+
267
+
let any = make 0 0 0 0
268
+
let unspecified = make 0 0 0 0
269
+
let broadcast = make 255 255 255 255
270
+
let localhost = make 127 0 0 1
271
+
let nodes = make 224 0 0 1
272
+
let routers = make 224 0 0 2
273
+
274
+
module Prefix = struct
275
+
type addr = t
276
+
type t = addr * int
277
+
278
+
let compare (pre, sz) (pre', sz') =
279
+
let c = compare pre pre' in
280
+
if c = 0 then Stdlib.compare sz sz' else c
281
+
282
+
let ip = make
283
+
284
+
let mask sz =
285
+
if sz <= 0 then 0_l
286
+
else if sz >= 32 then 0x0_FF_FF_FF_FF_l
287
+
else 0x0_FF_FF_FF_FF_l <|< 32 - sz
288
+
289
+
let prefix (pre, sz) = (pre &&& mask sz, sz)
290
+
let make sz pre = (pre, sz)
291
+
292
+
let network_address (pre, sz) addr =
293
+
pre &&& mask sz ||| (addr &&& Int32.lognot (mask sz))
294
+
295
+
(* string conversion *)
296
+
297
+
let _of_string_raw s i =
298
+
let quad = of_string_raw s i in
299
+
expect_char s i '/';
300
+
let p = parse_dec_int s i in
301
+
if p > 32 || p < 0 then raise (Parse_error ("invalid prefix size", s));
302
+
(p, quad)
303
+
304
+
let of_string_raw s i =
305
+
let p, quad = _of_string_raw s i in
306
+
make p quad
307
+
308
+
let _of_string_exn s =
309
+
let i = ref 0 in
310
+
let res = _of_string_raw s i in
311
+
expect_end s i;
312
+
res
313
+
314
+
let of_string_exn s =
315
+
let p, quad = _of_string_exn s in
316
+
make p quad
317
+
318
+
let of_string s = try_with_result of_string_exn s
319
+
320
+
let _of_netmask_exn ~netmask address =
321
+
let rec find_greatest_one bits i =
322
+
if bits = 0_l then i - 1 else find_greatest_one (bits >|> 1) (i + 1)
323
+
in
324
+
let one = netmask &&& Int32.neg netmask in
325
+
let sz = 32 - find_greatest_one one (if one = 0_l then 33 else 0) in
326
+
if netmask <> mask sz then
327
+
raise (Parse_error ("invalid netmask", to_string netmask))
328
+
else make sz address
329
+
330
+
let of_netmask_exn ~netmask ~address = _of_netmask_exn ~netmask address
331
+
332
+
let of_netmask ~netmask ~address =
333
+
try_with_result (_of_netmask_exn ~netmask) address
334
+
335
+
let to_buffer buf (pre, sz) = Printf.bprintf buf "%a/%d" to_buffer pre sz
336
+
337
+
let to_string subnet =
338
+
let b = Buffer.create 18 in
339
+
to_buffer b subnet;
340
+
Buffer.contents b
341
+
342
+
let pp ppf i = Format.fprintf ppf "%s" (to_string i)
343
+
344
+
let mem ip (pre, sz) =
345
+
let m = mask sz in
346
+
ip &&& m = (pre &&& m)
347
+
348
+
let subset ~subnet:(pre1, sz1) ~network:(pre2, sz2) =
349
+
sz1 >= sz2 && mem pre1 (pre2, sz2)
350
+
351
+
let of_addr ip = make 32 ip
352
+
let global = make 0 (ip 0 0 0 0)
353
+
let relative = make 8 (ip 0 0 0 0)
354
+
let loopback = make 8 (ip 127 0 0 0)
355
+
let link = make 16 (ip 169 254 0 0)
356
+
let multicast = make 4 (ip 224 0 0 0)
357
+
let multicast_org = make 14 (ip 239 192 0 0)
358
+
let multicast_admin = make 16 (ip 239 255 0 0)
359
+
let multicast_link = make 24 (ip 224 0 0 0)
360
+
361
+
(* http://tools.ietf.org/html/rfc2365 *)
362
+
363
+
let private_10 = make 8 (ip 10 0 0 0)
364
+
let private_172 = make 12 (ip 172 16 0 0)
365
+
let private_192 = make 16 (ip 192 168 0 0)
366
+
367
+
let private_blocks =
368
+
[ loopback; link; private_10; private_172; private_192 ]
369
+
370
+
let broadcast (pre, sz) =
371
+
Int32.logor pre (Int32.logxor (mask sz) 0xFF_FF_FF_FFl)
372
+
373
+
let network (pre, sz) = pre &&& mask sz
374
+
let address (addr, _) = addr
375
+
let bits (_, sz) = sz
376
+
let netmask subnet = mask (bits subnet)
377
+
let hostmask cidr = Int32.logxor (netmask cidr) 0xFF_FF_FF_FFl
378
+
379
+
let first ((_, sz) as cidr) =
380
+
if sz > 30 then network cidr else network cidr |> succ |> failwith_msg
381
+
382
+
let last ((_, sz) as cidr) =
383
+
if sz > 30 then broadcast cidr else broadcast cidr |> pred |> failwith_msg
384
+
385
+
let hosts ?(usable = true) ((_, sz) as cidr) =
386
+
let rec iter_seq start stop =
387
+
if compare (start, 32) (stop, 32) > 0 then Seq.Nil
388
+
else
389
+
match succ start with
390
+
| Ok start_succ -> Seq.Cons (start, fun () -> iter_seq start_succ stop)
391
+
| Error _ -> Seq.Cons (start, fun () -> Seq.Nil)
392
+
in
393
+
if usable && sz = 32 then fun () -> Seq.Nil
394
+
else
395
+
let start, stop =
396
+
if usable then (first cidr, last cidr)
397
+
else (network cidr, broadcast cidr)
398
+
in
399
+
fun () -> iter_seq start stop
400
+
401
+
let subnets n ((_, sz) as cidr) =
402
+
let rec iter_seq start stop steps =
403
+
if compare (start, 32) (stop, 32) > 0 then Seq.Nil
404
+
else
405
+
let prefix = make n start in
406
+
let start_succ = Int32.add start steps in
407
+
if start_succ = 0l then Seq.Cons (prefix, fun () -> Seq.Nil)
408
+
else Seq.Cons (prefix, fun () -> iter_seq start_succ stop steps)
409
+
in
410
+
if sz > n || n > 32 then fun () -> Seq.Nil
411
+
else
412
+
let start = network cidr in
413
+
let stop = broadcast cidr in
414
+
let steps = Int32.add (hostmask cidr) 1l >|> n - sz in
415
+
fun () -> iter_seq start stop steps
416
+
end
417
+
418
+
(* TODO: this could be optimized with something trie-like *)
419
+
let scope i =
420
+
let mem = Prefix.mem i in
421
+
if mem Prefix.loopback then Interface
422
+
else if mem Prefix.link then Link
423
+
else if List.exists mem Prefix.private_blocks then Organization
424
+
else if i = unspecified then Point
425
+
else if i = broadcast then Admin
426
+
else if mem Prefix.relative then Admin
427
+
else if mem Prefix.multicast then
428
+
if mem Prefix.multicast_org then Organization
429
+
else if mem Prefix.multicast_admin then Admin
430
+
else if mem Prefix.multicast_link then Link
431
+
else Global
432
+
else Global
433
+
434
+
let is_global i = scope i = Global
435
+
let is_multicast i = Prefix.(mem i multicast)
436
+
let is_private i = scope i <> Global
437
+
438
+
module Set = Set.Make (struct
439
+
type nonrec t = t
440
+
441
+
let compare (a : t) (b : t) = compare a b
442
+
end)
443
+
444
+
module Map = Map.Make (struct
445
+
type nonrec t = t
446
+
447
+
let compare (a : t) (b : t) = compare a b
448
+
end)
449
+
end
450
+
451
+
module S128 : sig
452
+
exception Overflow
453
+
454
+
type t
455
+
456
+
val zero : t [@@ocaml.warning "-32"]
457
+
val max_int : t
458
+
val compare : t -> t -> int
459
+
val equal : t -> t -> bool
460
+
val fold_left : ('a -> int -> 'a) -> 'a -> t -> 'a
461
+
val of_octets_exn : string -> t
462
+
val to_octets : t -> string
463
+
val of_int64 : int64 * int64 -> t
464
+
val to_int64 : t -> int64 * int64
465
+
val of_int32 : int32 * int32 * int32 * int32 -> t
466
+
val to_int32 : t -> int32 * int32 * int32 * int32
467
+
val of_int16 : int * int * int * int * int * int * int * int -> t
468
+
val to_int16 : t -> int * int * int * int * int * int * int * int
469
+
val add_exn : t -> t -> t [@@ocaml.warning "-32"]
470
+
val pred_exn : t -> t [@@ocaml.warning "-32"]
471
+
val add : t -> t -> t option
472
+
val logand : t -> t -> t
473
+
val logor : t -> t -> t
474
+
val logxor : t -> t -> t
475
+
val lognot : t -> t
476
+
477
+
module Byte : sig
478
+
val get_lsbits : int -> int -> int [@@ocaml.warning "-32"]
479
+
val get_msbits : int -> int -> int [@@ocaml.warning "-32"]
480
+
val set_msbits : int -> int -> int -> int [@@ocaml.warning "-32"]
481
+
val fold_left : ('a -> bool -> 'a) -> 'a -> int -> 'a
482
+
end
483
+
484
+
val shift_right : t -> int -> t
485
+
val shift_left : t -> int -> t
486
+
val write_octets_exn : ?off:int -> t -> bytes -> unit
487
+
val succ_exn : t -> t
488
+
val succ : t -> (t, [> `Msg of string ]) result
489
+
val pred : t -> (t, [> `Msg of string ]) result
490
+
end = struct
491
+
exception Overflow
492
+
493
+
type t = string
494
+
495
+
let mk_zero () = Bytes.make 16 '\x00'
496
+
let zero = Bytes.unsafe_to_string (mk_zero ())
497
+
let max_int = String.make 16 '\xff'
498
+
let compare = String.compare
499
+
let equal = String.equal
500
+
501
+
let fold_left f init s =
502
+
(* With OCaml>=4.13.0:
503
+
[String.fold_left (fun acc c -> f acc (Char.code c)) init s] *)
504
+
let a = ref init in
505
+
for i = 0 to 15 do
506
+
a := f !a (Char.code (String.get s i))
507
+
done;
508
+
!a
509
+
510
+
let iteri_right2 f x y =
511
+
for i = 15 downto 0 do
512
+
let x' = Char.code (String.get x i) in
513
+
let y' = Char.code (String.get y i) in
514
+
f i x' y'
515
+
done
516
+
517
+
let of_octets_exn s =
518
+
if String.length s <> 16 then invalid_arg "not 16 bytes long";
519
+
s
520
+
521
+
let to_octets = Fun.id
522
+
523
+
let of_int64 (a, b) =
524
+
let b' = mk_zero () in
525
+
Bytes.set_int64_be b' 0 a;
526
+
Bytes.set_int64_be b' 8 b;
527
+
Bytes.unsafe_to_string b'
528
+
529
+
let to_int64 s =
530
+
(* with OCaml>=4.13, use String.get_int64_be *)
531
+
let b = Bytes.unsafe_of_string s in
532
+
(Bytes.get_int64_be b 0, Bytes.get_int64_be b 8)
533
+
534
+
let of_int32 (a, b, c, d) =
535
+
let b' = mk_zero () in
536
+
Bytes.set_int32_be b' 0 a;
537
+
Bytes.set_int32_be b' 4 b;
538
+
Bytes.set_int32_be b' 8 c;
539
+
Bytes.set_int32_be b' 12 d;
540
+
Bytes.unsafe_to_string b'
541
+
542
+
let to_int32 s =
543
+
(* with OCaml>=4.13, use String.get_int32_be *)
544
+
let b = Bytes.unsafe_of_string s in
545
+
( Bytes.get_int32_be b 0,
546
+
Bytes.get_int32_be b 4,
547
+
Bytes.get_int32_be b 8,
548
+
Bytes.get_int32_be b 12 )
549
+
550
+
let of_int16 (a, b, c, d, e, f, g, h) =
551
+
let b' = mk_zero () in
552
+
Bytes.set_uint16_be b' 0 a;
553
+
Bytes.set_uint16_be b' 2 b;
554
+
Bytes.set_uint16_be b' 4 c;
555
+
Bytes.set_uint16_be b' 6 d;
556
+
Bytes.set_uint16_be b' 8 e;
557
+
Bytes.set_uint16_be b' 10 f;
558
+
Bytes.set_uint16_be b' 12 g;
559
+
Bytes.set_uint16_be b' 14 h;
560
+
Bytes.unsafe_to_string b'
561
+
562
+
let to_int16 s =
563
+
(* with OCaml>=4.13, use String.get_uint16_be *)
564
+
let b = Bytes.unsafe_of_string s in
565
+
( Bytes.get_uint16_be b 0,
566
+
Bytes.get_uint16_be b 2,
567
+
Bytes.get_uint16_be b 4,
568
+
Bytes.get_uint16_be b 6,
569
+
Bytes.get_uint16_be b 8,
570
+
Bytes.get_uint16_be b 10,
571
+
Bytes.get_uint16_be b 12,
572
+
Bytes.get_uint16_be b 14 )
573
+
574
+
let add_exn x y =
575
+
let b = mk_zero () in
576
+
let carry = ref 0 in
577
+
iteri_right2
578
+
(fun i x' y' ->
579
+
let sum = x' + y' + !carry in
580
+
if sum >= 256 then (
581
+
carry := 1;
582
+
Bytes.set_uint8 b i (sum - 256))
583
+
else (
584
+
carry := 0;
585
+
Bytes.set_uint8 b i sum))
586
+
x y;
587
+
if !carry <> 0 then raise Overflow else Bytes.unsafe_to_string b
588
+
589
+
let add x y = try Some (add_exn x y) with Overflow -> None
590
+
591
+
let pred_exn x =
592
+
if equal x zero then raise Overflow;
593
+
let b = Bytes.of_string x in
594
+
let rec go i =
595
+
Bytes.set_uint8 b i (Char.code (String.get x i) - 1);
596
+
if Char.code (String.get x i) = 0 then go (Stdlib.pred i)
597
+
in
598
+
go 15;
599
+
Bytes.unsafe_to_string b
600
+
601
+
let logand x y =
602
+
let b = mk_zero () in
603
+
iteri_right2 (fun i x y -> Bytes.set_uint8 b i (x land y)) x y;
604
+
Bytes.unsafe_to_string b
605
+
606
+
let logor x y =
607
+
let b = mk_zero () in
608
+
iteri_right2 (fun i x y -> Bytes.set_uint8 b i (x lor y)) x y;
609
+
Bytes.unsafe_to_string b
610
+
611
+
let logxor x y =
612
+
let b = mk_zero () in
613
+
iteri_right2 (fun i x y -> Bytes.set_uint8 b i (x lxor y)) x y;
614
+
Bytes.unsafe_to_string b
615
+
616
+
let lognot x =
617
+
let b = mk_zero () in
618
+
String.iteri
619
+
(fun i _ -> Bytes.set_uint8 b i (lnot (Char.code (String.get x i))))
620
+
x;
621
+
Bytes.unsafe_to_string b
622
+
623
+
module Byte = struct
624
+
(* Extract the [n] least significant bits from [i] *)
625
+
let get_lsbits n i =
626
+
if n <= 0 || n > 8 then invalid_arg "out of bounds";
627
+
i land ((1 lsl n) - 1)
628
+
629
+
(* Extract the [n] most significant bits from [i] *)
630
+
let get_msbits n i =
631
+
if n <= 0 || n > 8 then invalid_arg "out of bounds";
632
+
(i land (255 lsl (8 - n))) lsr (8 - n)
633
+
634
+
(* Set value [x] in [i]'s [n] most significant bits *)
635
+
let set_msbits n x i =
636
+
if n < 0 || n > 8 then raise (Invalid_argument "n must be >= 0 && <= 8")
637
+
else if n = 0 then i
638
+
else if n = 8 then x
639
+
else (x lsl (8 - n)) lor i
640
+
641
+
(* set bits are represented as true *)
642
+
let fold_left f a i =
643
+
let bitmask = ref 0b1000_0000 in
644
+
let a' = ref a in
645
+
for _ = 0 to 7 do
646
+
a' := f !a' (i land !bitmask > 0);
647
+
bitmask := !bitmask lsr 1
648
+
done;
649
+
!a'
650
+
end
651
+
652
+
let shift_right x n =
653
+
match n with
654
+
| 0 -> x
655
+
| 128 -> zero
656
+
| n when n > 0 && n < 128 ->
657
+
let b = mk_zero () in
658
+
let shift_bytes, shift_bits = (n / 8, n mod 8) in
659
+
(if shift_bits = 0 then
660
+
Bytes.blit_string x 0 b shift_bytes (16 - shift_bytes)
661
+
else
662
+
let carry = ref 0 in
663
+
for i = 0 to 15 - shift_bytes do
664
+
let x' = Char.code (String.get x i) in
665
+
let new_carry = Byte.get_lsbits shift_bits x' in
666
+
let shifted_value = x' lsr shift_bits in
667
+
let new_value = Byte.set_msbits shift_bits !carry shifted_value in
668
+
Bytes.set_uint8 b (i + shift_bytes) new_value;
669
+
carry := new_carry
670
+
done);
671
+
Bytes.unsafe_to_string b
672
+
| _ -> raise (Invalid_argument "n must be >= 0 && <= 128")
673
+
674
+
let shift_left x n =
675
+
match n with
676
+
| 0 -> x
677
+
| 128 -> zero
678
+
| n when n > 0 && n < 128 ->
679
+
let b = mk_zero () in
680
+
let shift_bytes, shift_bits = (n / 8, n mod 8) in
681
+
(if shift_bits = 0 then
682
+
Bytes.blit_string x shift_bytes b 0 (16 - shift_bytes)
683
+
else
684
+
let carry = ref 0 in
685
+
for i = 15 downto 0 + shift_bytes do
686
+
let x' = Char.code (String.get x i) in
687
+
let new_carry = Byte.get_msbits shift_bits x' in
688
+
let shifted_value = x' lsl shift_bits in
689
+
let new_value = shifted_value lor !carry in
690
+
Bytes.set_uint8 b (i - shift_bytes) new_value;
691
+
carry := new_carry
692
+
done);
693
+
Bytes.unsafe_to_string b
694
+
| _ -> raise (Invalid_argument "n must be >= 0 && <= 128")
695
+
696
+
let write_octets_exn ?(off = 0) s dest =
697
+
if Bytes.length dest - off < 16 then
698
+
raise (Parse_error ("larger including offset than target bytes", s))
699
+
else Bytes.blit_string s 0 dest off (String.length s)
700
+
701
+
let succ_exn x = add_exn x (of_int64 (0L, 1L))
702
+
703
+
let succ x =
704
+
try Ok (succ_exn x)
705
+
with Overflow -> Error (`Msg "Ipaddr: highest address has been reached")
706
+
707
+
let pred x =
708
+
try Ok (pred_exn x)
709
+
with Overflow | Invalid_argument _ ->
710
+
Error (`Msg "Ipaddr: lowest address has been reached")
711
+
end
712
+
713
+
module V6 = struct
714
+
include S128
715
+
716
+
let make a b c d e f g h = of_int16 (a, b, c, d, e, f, g, h)
717
+
718
+
(* parsing *)
719
+
let parse_ipv6 s i =
720
+
let compressed = ref false in
721
+
(* :: *)
722
+
let len = String.length s in
723
+
if len < !i + 1 then raise (need_more s);
724
+
let use_bracket = s.[!i] = '[' in
725
+
if use_bracket then incr i;
726
+
if len < !i + 2 then raise (need_more s);
727
+
(* check if it starts with :: *)
728
+
let l =
729
+
if s.[!i] = ':' then (
730
+
incr i;
731
+
if s.[!i] = ':' then (
732
+
compressed := true;
733
+
incr i;
734
+
[ -1 ])
735
+
else raise (bad_char !i s))
736
+
else []
737
+
in
738
+
739
+
let rec loop nb acc =
740
+
if nb >= 8 then acc
741
+
else if !i >= len then acc
742
+
else
743
+
let pos = !i in
744
+
let x = try parse_hex_int s i with _ -> -1 in
745
+
if x < 0 then acc
746
+
else if nb = 7 then x :: acc
747
+
else if !i < len && s.[!i] = ':' then (
748
+
incr i;
749
+
if !i < len then
750
+
if s.[!i] = ':' then
751
+
if !compressed then (
752
+
decr i;
753
+
x :: acc (* trailing :: *))
754
+
else (
755
+
compressed := true;
756
+
incr i;
757
+
loop (nb + 2) (-1 :: x :: acc))
758
+
else if is_number 16 (int_of_char s.[!i]) then
759
+
loop (nb + 1) (x :: acc)
760
+
else raise (bad_char !i s)
761
+
else raise (need_more s))
762
+
else if !i < len && s.[!i] = '.' then (
763
+
i := pos;
764
+
let v4 = V4.of_string_raw s i in
765
+
let hi, lo = V4.to_int16 v4 in
766
+
lo :: hi :: acc)
767
+
else x :: acc
768
+
in
769
+
770
+
let res = loop (List.length l) l in
771
+
let res_len = List.length res in
772
+
if res_len > 8 then raise (Parse_error ("too many components", s))
773
+
else if res_len = 0 then raise (need_more s)
774
+
else
775
+
let a = Array.make 8 0 in
776
+
let missing =
777
+
if !compressed then 8 - (res_len - 1)
778
+
else if res_len <> 8 then
779
+
if !i < len then raise (bad_char !i s) else raise (need_more s)
780
+
else 0
781
+
in
782
+
let _ =
783
+
List.fold_left
784
+
(fun i x ->
785
+
if x = -1 then i - missing
786
+
else (
787
+
if x land 0xffff <> x then
788
+
raise
789
+
(Parse_error (Printf.sprintf "component %d out of bounds" i, s));
790
+
a.(i) <- x;
791
+
i - 1))
792
+
7 res
793
+
in
794
+
if use_bracket then expect_char s i ']';
795
+
a
796
+
797
+
(* string conversion *)
798
+
799
+
let of_string_raw s offset =
800
+
let a = parse_ipv6 s offset in
801
+
make a.(0) a.(1) a.(2) a.(3) a.(4) a.(5) a.(6) a.(7)
802
+
803
+
let of_string_exn s =
804
+
let o = ref 0 in
805
+
let x = of_string_raw s o in
806
+
expect_end s o;
807
+
x
808
+
809
+
let of_string s = try_with_result of_string_exn s
810
+
811
+
let with_port_of_string ~default s =
812
+
let len = String.length s and o = ref 0 in
813
+
try
814
+
let ipv6 = of_string_raw s o in
815
+
if !o < len && s.[!o] = ':' then (
816
+
incr o;
817
+
let port = parse_dec_int s o in
818
+
expect_end s o;
819
+
Ok (ipv6, port))
820
+
else (
821
+
expect_end s o;
822
+
Ok (ipv6, default))
823
+
with Parse_error (msg, _) -> Error (`Msg ("Ipaddr: " ^ msg))
824
+
825
+
(* http://tools.ietf.org/html/rfc5952 *)
826
+
let to_buffer buf addr =
827
+
let ((a, b, c, d, e, f, g, h) as comp) = to_int16 addr in
828
+
829
+
let v4 =
830
+
match comp with 0, 0, 0, 0, 0, 0xffff, _, _ -> true | _ -> false
831
+
in
832
+
833
+
let rec loop elide zeros acc = function
834
+
| 0 :: xs -> loop elide (zeros - 1) acc xs
835
+
| n :: xs when zeros = 0 -> loop elide 0 (n :: acc) xs
836
+
| n :: xs -> loop (min elide zeros) 0 (n :: zeros :: acc) xs
837
+
| [] ->
838
+
let elide = min elide zeros in
839
+
( (if elide < -1 then Some elide else None),
840
+
if zeros = 0 then acc else zeros :: acc )
841
+
in
842
+
843
+
let elide, l = loop 0 0 [] [ h; g; f; e; d; c; b; a ] in
844
+
assert (match elide with Some x when x < -8 -> false | _ -> true);
845
+
846
+
let rec cons_zeros l x =
847
+
if x >= 0 then l else cons_zeros (Some 0 :: l) (x + 1)
848
+
in
849
+
850
+
let _, lrev =
851
+
List.fold_left
852
+
(fun (patt, l) x ->
853
+
if Some x = patt then (None, None :: l)
854
+
else if x < 0 then (patt, cons_zeros l x)
855
+
else (patt, Some x :: l))
856
+
(elide, []) l
857
+
in
858
+
859
+
let rec fill = function
860
+
| [ Some hi; Some lo ] when v4 ->
861
+
let addr = V4.of_int16 (hi, lo) in
862
+
V4.to_buffer buf addr
863
+
| None :: xs ->
864
+
Buffer.add_string buf "::";
865
+
fill xs
866
+
| [ Some n ] -> Printf.bprintf buf "%x" n
867
+
| Some n :: None :: xs ->
868
+
Printf.bprintf buf "%x::" n;
869
+
fill xs
870
+
| Some n :: xs ->
871
+
Printf.bprintf buf "%x:" n;
872
+
fill xs
873
+
| [] -> ()
874
+
in
875
+
fill (List.rev lrev)
876
+
877
+
let to_string l =
878
+
let buf = Buffer.create 39 in
879
+
to_buffer buf l;
880
+
Buffer.contents buf
881
+
882
+
let pp ppf i = Format.fprintf ppf "%s" (to_string i)
883
+
884
+
(* byte conversion *)
885
+
886
+
let of_octets_exn ?(off = 0) bs =
887
+
if String.length bs - off < 16 then raise (need_more bs)
888
+
else S128.of_octets_exn (String.sub bs off 16)
889
+
890
+
let of_octets ?off bs = try_with_result (of_octets_exn ?off) bs
891
+
let write_octets ?off i bs = try_with_result (write_octets_exn ?off i) bs
892
+
let to_octets = S128.to_octets
893
+
894
+
(* MAC *)
895
+
(* {{:https://tools.ietf.org/html/rfc2464#section-7}RFC 2464}. *)
896
+
let multicast_to_mac s =
897
+
let macb = Bytes.make 6 (Char.chr 0x33) in
898
+
Bytes.blit_string (S128.to_octets s) 12 macb 2 4;
899
+
Macaddr.of_octets_exn (Bytes.to_string macb)
900
+
901
+
(* Host *)
902
+
let to_domain_name b =
903
+
let hexstr_of_int = Printf.sprintf "%x" in
904
+
let name =
905
+
S128.fold_left
906
+
(fun acc b ->
907
+
let x = hexstr_of_int (b land ((1 lsl 4) - 1)) in
908
+
let y = hexstr_of_int (b lsr 4) in
909
+
x :: y :: acc)
910
+
[ "ip6"; "arpa" ] b
911
+
in
912
+
Domain_name.(host_exn (of_strings_exn name))
913
+
914
+
let of_domain_name n =
915
+
let int_of_char_string = function
916
+
| "0" -> 0
917
+
| "1" -> 1
918
+
| "2" -> 2
919
+
| "3" -> 3
920
+
| "4" -> 4
921
+
| "5" -> 5
922
+
| "6" -> 6
923
+
| "7" -> 7
924
+
| "8" -> 8
925
+
| "9" -> 9
926
+
| "a" -> 10
927
+
| "b" -> 11
928
+
| "c" -> 12
929
+
| "d" -> 13
930
+
| "e" -> 14
931
+
| "f" -> 15
932
+
| _ -> failwith "int_of_char_string: invalid hexadecimal string"
933
+
in
934
+
let labels = Domain_name.to_array n in
935
+
if
936
+
Array.length labels = 34
937
+
&& Domain_name.equal_label labels.(0) "arpa"
938
+
&& Domain_name.equal_label labels.(1) "ip6"
939
+
then
940
+
let b = Bytes.create 16 in
941
+
try
942
+
for bi = 0 to 15 do
943
+
let i = 2 * Int.succ bi in
944
+
let x = int_of_char_string labels.(i) in
945
+
let y = int_of_char_string labels.(i + 1) in
946
+
Bytes.set_uint8 b bi (Int.logor (Int.shift_left x 4) y)
947
+
done;
948
+
Some (S128.of_octets_exn (Bytes.unsafe_to_string b))
949
+
with Failure _ -> None
950
+
else None
951
+
952
+
(* constant *)
953
+
954
+
let unspecified = make 0 0 0 0 0 0 0 0
955
+
let localhost = make 0 0 0 0 0 0 0 1
956
+
let interface_nodes = make 0xff01 0 0 0 0 0 0 1
957
+
let link_nodes = make 0xff02 0 0 0 0 0 0 1
958
+
let interface_routers = make 0xff01 0 0 0 0 0 0 2
959
+
let link_routers = make 0xff02 0 0 0 0 0 0 2
960
+
let site_routers = make 0xff05 0 0 0 0 0 0 2
961
+
962
+
module Prefix = struct
963
+
type addr = t
964
+
type t = addr * int
965
+
966
+
let compare (pre, sz) (pre', sz') =
967
+
let c = compare pre pre' in
968
+
if c = 0 then Stdlib.compare sz sz' else c
969
+
970
+
let ip = make
971
+
let mask sz = shift_left max_int (128 - sz)
972
+
let prefix (pre, sz) = (logand pre (mask sz), sz)
973
+
let make sz pre = (pre, sz)
974
+
975
+
let network_address (pre, sz) addr =
976
+
logor (logand pre (mask sz)) (logand addr (lognot (mask sz)))
977
+
978
+
let _of_string_raw s i =
979
+
let v6 = of_string_raw s i in
980
+
expect_char s i '/';
981
+
let p = parse_dec_int s i in
982
+
if p > 128 || p < 0 then raise (Parse_error ("invalid prefix size", s));
983
+
(p, v6)
984
+
985
+
let of_string_raw s i =
986
+
let p, v6 = _of_string_raw s i in
987
+
make p v6
988
+
989
+
let _of_string_exn s =
990
+
let i = ref 0 in
991
+
let res = _of_string_raw s i in
992
+
expect_end s i;
993
+
res
994
+
995
+
let of_string_exn s =
996
+
let p, v6 = _of_string_exn s in
997
+
make p v6
998
+
999
+
let of_string s = try_with_result of_string_exn s
1000
+
1001
+
let _of_netmask_exn ~netmask address =
1002
+
let count_bits bits is_last_bit_set i =
1003
+
S128.Byte.fold_left
1004
+
(fun (a, is_last_bit_set) e ->
1005
+
match (is_last_bit_set, e) with
1006
+
| true, false | false, false -> (a, false)
1007
+
| true, true -> (a + 1, true)
1008
+
| false, true ->
1009
+
(* netmask is not contiguous *)
1010
+
raise (Parse_error ("invalid netmask", to_string netmask)))
1011
+
(bits, is_last_bit_set) i
1012
+
in
1013
+
let nm_bits_set, _ =
1014
+
S128.fold_left
1015
+
(fun (a, is_last_bit_set) e -> count_bits a is_last_bit_set e)
1016
+
(0, true) netmask
1017
+
in
1018
+
make nm_bits_set address
1019
+
1020
+
let of_netmask_exn ~netmask ~address = _of_netmask_exn ~netmask address
1021
+
1022
+
let of_netmask ~netmask ~address =
1023
+
try_with_result (_of_netmask_exn ~netmask) address
1024
+
1025
+
let to_buffer buf (pre, sz) = Printf.bprintf buf "%a/%d" to_buffer pre sz
1026
+
1027
+
let to_string subnet =
1028
+
let buf = Buffer.create 43 in
1029
+
to_buffer buf subnet;
1030
+
Buffer.contents buf
1031
+
1032
+
let pp ppf i = Format.fprintf ppf "%s" (to_string i)
1033
+
1034
+
let mem ip (pre, sz) =
1035
+
let m = mask sz in
1036
+
logand ip m = logand pre m
1037
+
1038
+
let subset ~subnet:(pre1, sz1) ~network:(pre2, sz2) =
1039
+
sz1 >= sz2 && mem pre1 (pre2, sz2)
1040
+
1041
+
let of_addr ip = make 128 ip
1042
+
let global_unicast_001 = make 3 (ip 0x2000 0 0 0 0 0 0 0)
1043
+
let link = make 64 (ip 0xfe80 0 0 0 0 0 0 0)
1044
+
let unique_local = make 7 (ip 0xfc00 0 0 0 0 0 0 0)
1045
+
let multicast = make 8 (ip 0xff00 0 0 0 0 0 0 0)
1046
+
let ipv4_mapped = make 96 (ip 0 0 0 0 0 0xffff 0 0)
1047
+
let noneui64_interface = make 3 (ip 0x0000 0 0 0 0 0 0 0)
1048
+
let solicited_node = make 104 (ip 0xff02 0 0 0 0 1 0xff00 0)
1049
+
let network (pre, sz) = logand pre (mask sz)
1050
+
let address (addr, _) = addr
1051
+
let bits (_, sz) = sz
1052
+
let netmask subnet = mask (bits subnet)
1053
+
let hostmask cidr = S128.logxor (netmask cidr) S128.max_int
1054
+
1055
+
let first ((_, sz) as cidr) =
1056
+
if sz > 126 then network cidr else network cidr |> succ |> failwith_msg
1057
+
1058
+
let last ((_, sz) as cidr) =
1059
+
let ffff = S128.max_int in
1060
+
logor (network cidr) (S128.shift_right ffff sz)
1061
+
1062
+
let hosts ?(usable = true) ((_, sz) as cidr) =
1063
+
let rec iter_seq start stop =
1064
+
if S128.compare start stop > 0 then Seq.Nil
1065
+
else
1066
+
match succ start with
1067
+
| Ok start_succ -> Seq.Cons (start, fun () -> iter_seq start_succ stop)
1068
+
| Error _ -> Seq.Cons (start, fun () -> Seq.Nil)
1069
+
in
1070
+
if usable && sz = 128 then fun () -> Seq.Nil
1071
+
else
1072
+
let start, stop =
1073
+
if usable then (first cidr, last cidr) else (network cidr, last cidr)
1074
+
in
1075
+
fun () -> iter_seq start stop
1076
+
1077
+
let subnets n ((_, sz) as cidr) =
1078
+
let rec iter_seq start stop steps =
1079
+
if S128.compare start stop > 0 then Seq.Nil
1080
+
else
1081
+
let prefix = make n start in
1082
+
if S128.equal start stop then Seq.Cons (prefix, fun () -> Seq.Nil)
1083
+
else
1084
+
match S128.add start steps with
1085
+
| None -> Seq.Cons (prefix, fun () -> Seq.Nil)
1086
+
| Some start_succ ->
1087
+
Seq.Cons (prefix, fun () -> iter_seq start_succ stop steps)
1088
+
in
1089
+
if sz > n || n > 128 then fun () -> Seq.Nil
1090
+
else
1091
+
let start = network cidr in
1092
+
let stop = last cidr in
1093
+
let steps = S128.(succ_exn (shift_right (hostmask cidr) (n - sz))) in
1094
+
fun () -> iter_seq start stop steps
1095
+
end
1096
+
1097
+
(* TODO: This could be optimized with something trie-like *)
1098
+
let scope i =
1099
+
let mem = Prefix.mem i in
1100
+
if mem Prefix.global_unicast_001 then Global
1101
+
else if
1102
+
mem Prefix.ipv4_mapped (* rfc says they are technically global but... *)
1103
+
then
1104
+
V4.scope
1105
+
(let _, _, _, v4 = to_int32 i in
1106
+
V4.of_int32 v4)
1107
+
else if mem Prefix.multicast then
1108
+
let x, _, _, _, _, _, _, _ = to_int16 i in
1109
+
match x land 0xf with
1110
+
| 0 -> Point
1111
+
| 1 -> Interface
1112
+
| 2 | 3 -> Link
1113
+
| 4 -> Admin
1114
+
| 5 | 6 | 7 -> Site
1115
+
| 8 | 9 | 10 | 11 | 12 | 13 -> Organization
1116
+
| 14 | 15 -> Global
1117
+
| _ -> assert false
1118
+
else if mem Prefix.link then Link
1119
+
else if mem Prefix.unique_local then Global
1120
+
else if i = localhost then Interface
1121
+
else if i = unspecified then Point
1122
+
else Global
1123
+
1124
+
let link_address_of_mac =
1125
+
let c b i = Char.code b.[i] in
1126
+
fun mac ->
1127
+
let bmac = Macaddr.to_octets mac in
1128
+
let c_0 = c bmac 0 lxor 2 in
1129
+
let addr =
1130
+
make 0 0 0 0
1131
+
((c_0 lsl 8) + c bmac 1)
1132
+
((c bmac 2 lsl 8) + 0xff)
1133
+
(0xfe00 + c bmac 3)
1134
+
((c bmac 4 lsl 8) + c bmac 5)
1135
+
in
1136
+
Prefix.(network_address link addr)
1137
+
1138
+
let is_global i = scope i = Global
1139
+
let is_multicast i = Prefix.(mem i multicast)
1140
+
let is_private i = scope i <> Global
1141
+
1142
+
module Set = Set.Make (struct
1143
+
type nonrec t = t
1144
+
1145
+
let compare (a : t) (b : t) = compare a b
1146
+
end)
1147
+
1148
+
module Map = Map.Make (struct
1149
+
type nonrec t = t
1150
+
1151
+
let compare (a : t) (b : t) = compare a b
1152
+
end)
1153
+
end
1154
+
1155
+
type ('v4, 'v6) v4v6 = V4 of 'v4 | V6 of 'v6
1156
+
type t = (V4.t, V6.t) v4v6
1157
+
1158
+
let compare a b =
1159
+
match (a, b) with
1160
+
| V4 a, V4 b -> V4.compare a b
1161
+
| V6 a, V6 b -> V6.compare a b
1162
+
| V4 _, V6 _ -> -1
1163
+
| V6 _, V4 _ -> 1
1164
+
1165
+
module Set = Set.Make (struct
1166
+
type nonrec t = t
1167
+
1168
+
let compare (a : t) (b : t) = compare a b
1169
+
end)
1170
+
1171
+
module Map = Map.Make (struct
1172
+
type nonrec t = t
1173
+
1174
+
let compare (a : t) (b : t) = compare a b
1175
+
end)
1176
+
1177
+
let to_string = function V4 x -> V4.to_string x | V6 x -> V6.to_string x
1178
+
1179
+
let to_buffer buf = function
1180
+
| V4 x -> V4.to_buffer buf x
1181
+
| V6 x -> V6.to_buffer buf x
1182
+
1183
+
let pp ppf i = Format.fprintf ppf "%s" (to_string i)
1184
+
1185
+
let of_string_raw s offset =
1186
+
let len = String.length s in
1187
+
if len < !offset + 1 then raise (need_more s);
1188
+
match s.[0] with
1189
+
| '[' -> V6 (V6.of_string_raw s offset)
1190
+
| _ -> (
1191
+
let pos = !offset in
1192
+
try V4 (V4.of_string_raw s offset)
1193
+
with Parse_error (v4_msg, _) -> (
1194
+
offset := pos;
1195
+
try V6 (V6.of_string_raw s offset)
1196
+
with Parse_error (v6_msg, s) ->
1197
+
let msg =
1198
+
Printf.sprintf "not an IPv4 address: %s\nnot an IPv6 address: %s"
1199
+
v4_msg v6_msg
1200
+
in
1201
+
raise (Parse_error (msg, s))))
1202
+
1203
+
let of_string_exn s =
1204
+
let o = ref 0 in
1205
+
let x = of_string_raw s o in
1206
+
expect_end s o;
1207
+
x
1208
+
1209
+
let of_string s = try_with_result of_string_exn s
1210
+
1211
+
let with_port_of_string ~default s =
1212
+
let len = String.length s and o = ref 0 in
1213
+
try
1214
+
let ipv6 = of_string_raw s o in
1215
+
if !o < len && s.[!o] = ':' then (
1216
+
incr o;
1217
+
let port = parse_dec_int s o in
1218
+
expect_end s o;
1219
+
Ok (ipv6, port))
1220
+
else (
1221
+
expect_end s o;
1222
+
Ok (ipv6, default))
1223
+
with Parse_error (msg, _) -> Error (`Msg ("Ipaddr: " ^ msg))
1224
+
1225
+
let of_octets_exn bs =
1226
+
match String.length bs with
1227
+
| 4 -> V4 (V4.of_octets_exn bs)
1228
+
| 16 -> V6 (V6.of_octets_exn bs)
1229
+
| _ -> raise (Parse_error ("octets must be of length 4 or 16", bs))
1230
+
1231
+
let of_octets bs = try_with_result of_octets_exn bs
1232
+
let to_octets i = match i with V4 p -> V4.to_octets p | V6 p -> V6.to_octets p
1233
+
1234
+
let v6_of_v4 v4 =
1235
+
V6.(Prefix.(network_address ipv4_mapped (of_int32 (0l, 0l, 0l, v4))))
1236
+
1237
+
let v4_of_v6 v6 =
1238
+
if V6.Prefix.(mem v6 ipv4_mapped) then
1239
+
let _, _, _, v4 = V6.to_int32 v6 in
1240
+
Some V4.(of_int32 v4)
1241
+
else None
1242
+
1243
+
let to_v4 = function V4 v4 -> Some v4 | V6 v6 -> v4_of_v6 v6
1244
+
let to_v6 = function V4 v4 -> v6_of_v4 v4 | V6 v6 -> v6
1245
+
let scope = function V4 v4 -> V4.scope v4 | V6 v6 -> V6.scope v6
1246
+
let is_global = function V4 v4 -> V4.is_global v4 | V6 v6 -> V6.is_global v6
1247
+
1248
+
let is_multicast = function
1249
+
| V4 v4 -> V4.is_multicast v4
1250
+
| V6 v6 -> V6.is_multicast v6
1251
+
1252
+
let is_private = function
1253
+
| V4 v4 -> V4.is_private v4
1254
+
| V6 v6 -> V6.is_private v6
1255
+
1256
+
let multicast_to_mac = function
1257
+
| V4 v4 -> V4.multicast_to_mac v4
1258
+
| V6 v6 -> V6.multicast_to_mac v6
1259
+
1260
+
let to_domain_name = function
1261
+
| V4 v4 -> V4.to_domain_name v4
1262
+
| V6 v6 -> V6.to_domain_name v6
1263
+
1264
+
let of_domain_name n =
1265
+
match Domain_name.count_labels n with
1266
+
| 6 -> (
1267
+
match V4.of_domain_name n with None -> None | Some x -> Some (V4 x))
1268
+
| 34 -> (
1269
+
match V6.of_domain_name n with None -> None | Some x -> Some (V6 x))
1270
+
| _ -> None
1271
+
1272
+
let succ = function
1273
+
| V4 addr -> Result.map (fun v -> V4 v) (V4.succ addr)
1274
+
| V6 addr -> Result.map (fun v -> V6 v) (V6.succ addr)
1275
+
1276
+
let pred = function
1277
+
| V4 addr -> Result.map (fun v -> V4 v) (V4.pred addr)
1278
+
| V6 addr -> Result.map (fun v -> V6 v) (V6.pred addr)
1279
+
1280
+
module Prefix = struct
1281
+
module Addr = struct
1282
+
let to_v6 = to_v6
1283
+
end
1284
+
1285
+
type addr = t
1286
+
type t = (V4.Prefix.t, V6.Prefix.t) v4v6
1287
+
1288
+
let compare a b =
1289
+
match (a, b) with
1290
+
| V4 a, V4 b -> V4.Prefix.compare a b
1291
+
| V6 a, V6 b -> V6.Prefix.compare a b
1292
+
| V4 _, V6 _ -> -1
1293
+
| V6 _, V4 _ -> 1
1294
+
1295
+
let of_string_raw s offset =
1296
+
let len = String.length s in
1297
+
if len < !offset + 1 then raise (need_more s);
1298
+
match s.[0] with
1299
+
| '[' -> V6 (V6.Prefix.of_string_raw s offset)
1300
+
| _ -> (
1301
+
let pos = !offset in
1302
+
try V4 (V4.Prefix.of_string_raw s offset)
1303
+
with Parse_error (v4_msg, _) -> (
1304
+
offset := pos;
1305
+
try V6 (V6.Prefix.of_string_raw s offset)
1306
+
with Parse_error (v6_msg, s) ->
1307
+
let msg =
1308
+
Printf.sprintf "not an IPv4 prefix: %s\nnot an IPv6 prefix: %s"
1309
+
v4_msg v6_msg
1310
+
in
1311
+
raise (Parse_error (msg, s))))
1312
+
1313
+
let of_string_exn s =
1314
+
let o = ref 0 in
1315
+
let x = of_string_raw s o in
1316
+
expect_end s o;
1317
+
x
1318
+
1319
+
let of_string s = try_with_result of_string_exn s
1320
+
1321
+
let v6_of_v4 v4 =
1322
+
V6.Prefix.make (96 + V4.Prefix.bits v4) (v6_of_v4 (V4.Prefix.network v4))
1323
+
1324
+
let v4_of_v6 v6 =
1325
+
match v4_of_v6 (V6.Prefix.network v6) with
1326
+
| Some v4 -> Some (V4.Prefix.make (V6.Prefix.bits v6 - 96) v4)
1327
+
| None -> None
1328
+
1329
+
let to_v4 = function V4 v4 -> Some v4 | V6 v6 -> v4_of_v6 v6
1330
+
let to_v6 = function V4 v4 -> v6_of_v4 v4 | V6 v6 -> v6
1331
+
let mem ip prefix = V6.Prefix.mem (Addr.to_v6 ip) (to_v6 prefix)
1332
+
1333
+
let subset ~subnet ~network =
1334
+
V6.Prefix.subset ~subnet:(to_v6 subnet) ~network:(to_v6 network)
1335
+
1336
+
let of_addr = function
1337
+
| V4 p -> V4 (V4.Prefix.of_addr p)
1338
+
| V6 p -> V6 (V6.Prefix.of_addr p)
1339
+
1340
+
let to_string = function
1341
+
| V4 p -> V4.Prefix.to_string p
1342
+
| V6 p -> V6.Prefix.to_string p
1343
+
1344
+
let to_buffer buf = function
1345
+
| V4 p -> V4.Prefix.to_buffer buf p
1346
+
| V6 p -> V6.Prefix.to_buffer buf p
1347
+
1348
+
let network = function
1349
+
| V4 p -> V4 (V4.Prefix.network p)
1350
+
| V6 p -> V6 (V6.Prefix.network p)
1351
+
1352
+
let netmask = function
1353
+
| V4 p -> V4 (V4.Prefix.netmask p)
1354
+
| V6 p -> V6 (V6.Prefix.netmask p)
1355
+
1356
+
let address = function
1357
+
| V4 p -> V4 (V4.Prefix.address p)
1358
+
| V6 p -> V6 (V6.Prefix.address p)
1359
+
1360
+
let bits = function V4 p -> V4.Prefix.bits p | V6 p -> V6.Prefix.bits p
1361
+
let pp ppf i = Format.fprintf ppf "%s" (to_string i)
1362
+
1363
+
let first = function
1364
+
| V4 p -> V4 (V4.Prefix.first p)
1365
+
| V6 p -> V6 (V6.Prefix.first p)
1366
+
1367
+
let last = function
1368
+
| V4 p -> V4 (V4.Prefix.last p)
1369
+
| V6 p -> V6 (V6.Prefix.last p)
1370
+
1371
+
let hosts ?(usable = true) = function
1372
+
| V4 p -> V4 (V4.Prefix.hosts ~usable p)
1373
+
| V6 p -> V6 (V6.Prefix.hosts ~usable p)
1374
+
1375
+
let subnets n = function
1376
+
| V4 p -> V4 (V4.Prefix.subnets n p)
1377
+
| V6 p -> V6 (V6.Prefix.subnets n p)
1378
+
end
+811
vendor/opam/ipaddr/lib/ipaddr.mli
+811
vendor/opam/ipaddr/lib/ipaddr.mli
···
1
+
(*
2
+
* Copyright (c) 2019 Anil Madhavapeddy <anil@recoil.org>
3
+
* Copyright (c) 2013-2015 David Sheets <sheets@alum.mit.edu>
4
+
*
5
+
* Permission to use, copy, modify, and distribute this software for any
6
+
* purpose with or without fee is hereby granted, provided that the above
7
+
* copyright notice and this permission notice appear in all copies.
8
+
*
9
+
* THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
10
+
* WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
11
+
* MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
12
+
* ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
13
+
* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
14
+
* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
15
+
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
16
+
*
17
+
*)
18
+
19
+
(** A library for manipulation of IP address representations.
20
+
21
+
{e %%VERSION%% - {{:%%PKG_HOMEPAGE%%} homepage}} *)
22
+
23
+
exception Parse_error of string * string
24
+
(** [Parse_error (err,packet)] is raised when parsing of the IP address syntax
25
+
fails. [err] contains a human-readable error and [packet] is the original
26
+
octet list that failed to parse. *)
27
+
28
+
(** Type of ordered address scope classifications *)
29
+
type scope = Point | Interface | Link | Admin | Site | Organization | Global
30
+
31
+
val string_of_scope : scope -> string
32
+
(** [string_of_scope scope] returns a human-readable representation of {!scope}. *)
33
+
34
+
val scope_of_string : string -> (scope, [> `Msg of string ]) result
35
+
(** [scope_of_string s] returns a {!scope} from a string representation of [s].
36
+
Valid string values for [s] can be obtained via {!string_of_scope}. *)
37
+
38
+
val pp_scope : Format.formatter -> scope -> unit
39
+
[@@ocaml.toplevel_printer]
40
+
(** [pp_scope fmt scope] outputs a human-readable representation of {!scope} to
41
+
the [fmt] formatter. *)
42
+
43
+
(** A collection of functions for IPv4 addresses. *)
44
+
module V4 : sig
45
+
type t
46
+
(** Type of the internet protocol v4 address of a host *)
47
+
48
+
val make : int -> int -> int -> int -> t
49
+
(** Converts the low bytes of four int values into an abstract {!V4.t}. *)
50
+
51
+
(** {3 Text string conversion}
52
+
53
+
These manipulate human-readable IPv4 addresses (for example
54
+
[192.168.1.2]). *)
55
+
56
+
val of_string : string -> (t, [> `Msg of string ]) result
57
+
(** [of_string s] is the address {!t} represented by the human-readable IPv4
58
+
address [s]. Returns a human-readable error string if parsing failed. *)
59
+
60
+
val of_string_exn : string -> t
61
+
(** [of_string_exn s] is the address {!t} represented as a human-readable IPv4
62
+
address [s]. Raises {!Parse_error} if [s] is invalid or truncated. *)
63
+
64
+
val of_string_raw : string -> int ref -> t
65
+
(** [of_string_raw s off] acts as {!of_string_exn} but takes as an extra
66
+
argument the offset into the string for reading. [off] will be mutated to
67
+
an unspecified value during the function call. [s] will a {!Parse_error}
68
+
exception if it is an invalid or truncated IP address. *)
69
+
70
+
val with_port_of_string :
71
+
default:int -> string -> (t * int, [> `Msg of string ]) result
72
+
(** [with_port_of_string ~default s] is the address {!t} represented by the
73
+
human-readble IPv4 address [s] with a possibly port [:<port>] (otherwise,
74
+
we take the [default] value). *)
75
+
76
+
val to_string : t -> string
77
+
(** [to_string ipv4] is the dotted decimal string representation of [ipv4],
78
+
i.e. [XXX.XX.X.XXX]. *)
79
+
80
+
val to_buffer : Buffer.t -> t -> unit
81
+
(** [to_buffer buf ipv4] writes the string representation of [ipv4] into the
82
+
buffer [buf]. *)
83
+
84
+
val pp : Format.formatter -> t -> unit
85
+
[@@ocaml.toplevel_printer]
86
+
(** [pp f ipv4] outputs a human-readable representation of [ipv4] to the
87
+
formatter [f]. *)
88
+
89
+
(** {3 Octets conversion}
90
+
91
+
These manipulate IPv4 addresses represented as a sequence of four bytes.
92
+
(e.g for example [0xc0a80102] will be the representation of the
93
+
human-readable [192.168.1.2] address. *)
94
+
95
+
val of_octets : ?off:int -> string -> (t, [> `Msg of string ]) result
96
+
(** [of_octets ?off s] is the IPv4 address {!t} represented by the octets in
97
+
[s] starting from offset [off] within the string. Returns a human-readable
98
+
error string if [s] is not at least [off+4] bytes long. [off] defaults to
99
+
0. *)
100
+
101
+
val of_octets_exn : ?off:int -> string -> t
102
+
(** [of_octets_exn ipv4_octets] is the IPv4 address represented by
103
+
[ipv4_octets] starting from offset [off]. Raises {!Parse_error} if
104
+
[ipv4_octets] is not at least [off+4] bytes long. [off] defaults to 0. *)
105
+
106
+
val write_octets :
107
+
?off:int -> t -> bytes -> (unit, [> `Msg of string ]) result
108
+
(** [write_octets ?off ipv4 b] writes the [ipv4] as octets to [b] starting
109
+
from offset [off]. [b] must be at least [off+4] long or an error is
110
+
returned. *)
111
+
112
+
val write_octets_exn : ?off:int -> t -> bytes -> unit
113
+
(** [write_octets_exn ?off ipv4 b] writes the [ipv4] as octets to [b] starting
114
+
from offset [off]. [b] must be at least [off+4] long or a {!Parse_error}
115
+
is raised. *)
116
+
117
+
val to_octets : t -> string
118
+
(** [to_octets ipv4] returns the 4 bytes representing the [ipv4] octets. *)
119
+
120
+
(** {3 Int conversion} *)
121
+
122
+
val of_int32 : int32 -> t
123
+
(** [of_int32 ipv4_packed] is the address represented by [ipv4_packed]. *)
124
+
125
+
val to_int32 : t -> int32
126
+
(** [to_int32 ipv4] is the 32-bit packed encoding of [ipv4]. *)
127
+
128
+
val of_int16 : int * int -> t
129
+
(** [of_int16 ipv4_packed] is the address represented by [ipv4_packed]. *)
130
+
131
+
val to_int16 : t -> int * int
132
+
(** [to_int16 ipv4] is the 16-bit packed encoding of [ipv4]. *)
133
+
134
+
(** {3 MAC conversion} *)
135
+
136
+
val multicast_to_mac : t -> Macaddr.t
137
+
(** [multicast_to_mac ipv4] is the MAC address corresponding to the multicast
138
+
address [ipv4]. Described by
139
+
{{:http://tools.ietf.org/html/rfc1112#section-6.2} RFC 1112}. *)
140
+
141
+
(** {3 Host conversion} *)
142
+
143
+
val to_domain_name : t -> [ `host ] Domain_name.t
144
+
(** [to_domain_name ipv4] is the domain name label list for reverse lookups of
145
+
[ipv4]. This includes the [.in-addr.arpa] suffix. *)
146
+
147
+
val of_domain_name : 'a Domain_name.t -> t option
148
+
(** [of_domain_name name] is [Some t] if the [name] has an [.in-addr.arpa]
149
+
suffix, and an IPv4 address prefixed. *)
150
+
151
+
(** {3 Utility functions} *)
152
+
153
+
val succ : t -> (t, [> `Msg of string ]) result
154
+
(** [succ ipv4] is ip address next to [ipv4]. Returns a human-readable error
155
+
string if it's already the highest address. *)
156
+
157
+
val pred : t -> (t, [> `Msg of string ]) result
158
+
(** [pred ipv4] is ip address before [ipv4]. Returns a human-readable error
159
+
string if it's already the lowest address. *)
160
+
161
+
(** {3 Common addresses} *)
162
+
163
+
val any : t
164
+
(** [any] is 0.0.0.0. *)
165
+
166
+
val unspecified : t
167
+
(** [unspecified] is 0.0.0.0. *)
168
+
169
+
val broadcast : t
170
+
(** [broadcast] is 255.255.255.255. *)
171
+
172
+
val nodes : t
173
+
(** [nodes] is 224.0.0.1. *)
174
+
175
+
val routers : t
176
+
(** [routers] is 224.0.0.2. *)
177
+
178
+
val localhost : t
179
+
(** [localhost] is 127.0.0.1. *)
180
+
181
+
(** A module for manipulating IPv4 network prefixes (CIDR). *)
182
+
module Prefix : sig
183
+
type addr = t
184
+
185
+
type t
186
+
(** Type of a internet protocol subnet: an address and prefix length. *)
187
+
188
+
val mask : int -> addr
189
+
(** [mask n] is the pseudo-address of an [n] bit subnet mask. *)
190
+
191
+
val make : int -> addr -> t
192
+
(** [make n addr] is the cidr of [addr] with [n] bits prefix. *)
193
+
194
+
val prefix : t -> t
195
+
(** [prefix cidr] is the subnet prefix of [cidr] where all non-prefix bits
196
+
set to 0. *)
197
+
198
+
val network_address : t -> addr -> addr
199
+
(** [network_address cidr addr] is the address with prefix [cidr] and suffix
200
+
from [addr]. See <http://tools.ietf.org/html/rfc4291#section-2.3>. *)
201
+
202
+
val of_string : string -> (t, [> `Msg of string ]) result
203
+
(** [of_string cidr] is the subnet prefix represented by the CIDR string,
204
+
[cidr]. Returns a human-readable parsing error message if [cidr] is not
205
+
a valid representation of a CIDR notation routing prefix. *)
206
+
207
+
val of_string_exn : string -> t
208
+
(** [of_string_exn cidr] is the subnet prefix represented by the CIDR
209
+
string, [cidr]. Raises [Parse_error] if [cidr] is not a valid
210
+
representation of a CIDR notation routing prefix. *)
211
+
212
+
val of_string_raw : string -> int ref -> t
213
+
(** Same as {!of_string_exn} but takes as an extra argument the offset into
214
+
the string for reading. *)
215
+
216
+
val to_string : t -> string
217
+
(** [to_string cidr] is the CIDR notation string representation of [cidr],
218
+
i.e. [XXX.XX.X.XXX/XX]. *)
219
+
220
+
val pp : Format.formatter -> t -> unit
221
+
[@@ocaml.toplevel_printer]
222
+
(** [pp f cidr] outputs a human-readable representation of [cidr] to the
223
+
formatter [f]. *)
224
+
225
+
val to_buffer : Buffer.t -> t -> unit
226
+
(** [to_buffer buf cidr] writes the string representation of [cidr] into the
227
+
buffer [buf]. *)
228
+
229
+
val of_netmask_exn : netmask:addr -> address:addr -> t
230
+
(** [of_netmask_exn ~netmask ~address] is the subnet prefix of [address]
231
+
with netmask [netmask]. *)
232
+
233
+
val of_netmask :
234
+
netmask:addr -> address:addr -> (t, [> `Msg of string ]) result
235
+
(** [of_netmask ~netmask ~address] is the cidr of [address] with netmask
236
+
[netmask]. *)
237
+
238
+
val mem : addr -> t -> bool
239
+
(** [mem ip subnet] checks whether [ip] is found within [subnet]. *)
240
+
241
+
val subset : subnet:t -> network:t -> bool
242
+
(** [subset ~subnet ~network] checks whether [subnet] is contained within
243
+
[network]. *)
244
+
245
+
val of_addr : addr -> t
246
+
(** [of_addr ip] create a subnet composed of only one address, [ip]. It is
247
+
the same as [make 32 ip]. *)
248
+
249
+
val global : t
250
+
(** The default route, all addresses in IPv4-space, 0.0.0.0/0. *)
251
+
252
+
val loopback : t
253
+
(** The host loopback network, 127.0.0.0/8. *)
254
+
255
+
val link : t
256
+
(** The local-link network, 169.254.0.0/16. *)
257
+
258
+
val relative : t
259
+
(** The relative addressing network, 0.0.0.0/8. *)
260
+
261
+
val multicast : t
262
+
(** The multicast network, 224.0.0.0/4. *)
263
+
264
+
val private_10 : t
265
+
(** The private subnet with 10 as first octet, 10.0.0.0/8. *)
266
+
267
+
val private_172 : t
268
+
(** The private subnet with 172 as first octet, 172.16.0.0/12. *)
269
+
270
+
val private_192 : t
271
+
(** The private subnet with 192 as first octet, 192.168.0.0/16. *)
272
+
273
+
val private_blocks : t list
274
+
(** The privately addressable networks: [loopback], [link], [private_10],
275
+
[private_172], [private_192]. *)
276
+
277
+
val broadcast : t -> addr
278
+
(** [broadcast subnet] is the broadcast address for [subnet]. *)
279
+
280
+
val network : t -> addr
281
+
(** [network subnet] is the address for [subnet]. *)
282
+
283
+
val netmask : t -> addr
284
+
(** [netmask subnet] is the netmask for [subnet]. *)
285
+
286
+
val address : t -> addr
287
+
(** [address cidr] is the address for [cidr]. *)
288
+
289
+
val bits : t -> int
290
+
(** [bits cidr] is the bit size of the [cidr] prefix. *)
291
+
292
+
val first : t -> addr
293
+
(** [first cidr] is first valid unicast address in this [cidr]. *)
294
+
295
+
val last : t -> addr
296
+
(** [last cidr] is last valid unicast address in this [cidr]. *)
297
+
298
+
val hosts : ?usable:bool -> t -> addr Seq.t
299
+
(** [hosts cidr] is the sequence of host addresses in this [cidr]. By
300
+
default, network and broadcast addresses are omitted. This can be
301
+
changed by setting [usable] to false. *)
302
+
303
+
val subnets : int -> t -> t Seq.t
304
+
(** [subnets n cidr] is the sequence of subnets of [cidr] with a prefix
305
+
length of [n]. *)
306
+
307
+
include Map.OrderedType with type t := t
308
+
end
309
+
310
+
val scope : t -> scope
311
+
(** [scope ipv4] is the classification of [ipv4] by the {!scope} hierarchy. *)
312
+
313
+
val is_global : t -> bool
314
+
(** [is_global ipv4] is a predicate indicating whether [ipv4] globally
315
+
addresses a node. *)
316
+
317
+
val is_multicast : t -> bool
318
+
(** [is_multicast ipv4] is a predicate indicating whether [ipv4] is a
319
+
multicast address. *)
320
+
321
+
val is_private : t -> bool
322
+
(** [is_private ipv4] is a predicate indicating whether [ipv4] privately
323
+
addresses a node. *)
324
+
325
+
include Map.OrderedType with type t := t
326
+
module Set : Set.S with type elt := t
327
+
module Map : Map.S with type key := t
328
+
end
329
+
330
+
(** A collection of functions for IPv6 addresses. *)
331
+
module V6 : sig
332
+
type t
333
+
(** Type of the internet protocol v6 address of a host *)
334
+
335
+
val make : int -> int -> int -> int -> int -> int -> int -> int -> t
336
+
(** Converts the low bytes of eight int values into an abstract {!V6.t}. *)
337
+
338
+
(** {3 Text string conversion} *)
339
+
340
+
val of_string : string -> (t, [> `Msg of string ]) result
341
+
(** [of_string ipv6_string] is the address represented by the human-readable
342
+
IPv6 address [ipv6_string]. Returns a human-readable error string if
343
+
parsing failed. *)
344
+
345
+
val of_string_exn : string -> t
346
+
(** [of_string_exn ipv6_string] is the address represented by the
347
+
human-readable IPv6 address [ipv6_string]. Raises {!Parse_error} if
348
+
[ipv6_string] is invalid or truncated. *)
349
+
350
+
val with_port_of_string :
351
+
default:int -> string -> (t * int, [> `Msg of string ]) result
352
+
(** [with_port_of_string ~default ipv6_string] is the address represented by
353
+
[ipv6_string] with a possibly [:<port>] (otherwise, we take the [default]
354
+
value). Due to the [':'] separator, the user should expand [ipv6_string]
355
+
to let us to consider the last [:<port>] as a port. In other words:
356
+
357
+
- [::1:8080] returns the IPv6 [::1:8080] with the [default] port
358
+
- [0:0:0:0:0:0:0:1:8080] returns [::1] with the port [8080]. *)
359
+
360
+
val of_string_raw : string -> int ref -> t
361
+
(** Same as [of_string_exn] but takes as an extra argument the offset into the
362
+
string for reading. [off] will be mutated to an unspecified value during
363
+
the function call. Raises {!Parse_error} if it is an invalid or truncated
364
+
IP address. *)
365
+
366
+
val to_string : t -> string
367
+
(** [to_string ipv6] is the string representation of [ipv6], i.e.
368
+
[XXX:XX:X::XXX:XX]. *)
369
+
370
+
val to_buffer : Buffer.t -> t -> unit
371
+
(** [to_buffer buf ipv6] writes the string representation of [ipv6] into the
372
+
buffer [buf]. *)
373
+
374
+
val pp : Format.formatter -> t -> unit
375
+
[@@ocaml.toplevel_printer]
376
+
(** [pp f ipv6] outputs a human-readable representation of [ipv6] to the
377
+
formatter [f]. *)
378
+
379
+
(** {3 Octets conversion} *)
380
+
381
+
val of_octets : ?off:int -> string -> (t, [> `Msg of string ]) result
382
+
(** [of_octets ?off s] is the IPv6 address {!t} represented by the octets [s]
383
+
starting from offset [off] within the string. Returns a human-readable
384
+
error string if [s] is not at least [off+16] bytes long. [off] defaults to
385
+
0. *)
386
+
387
+
val of_octets_exn : ?off:int -> string -> t
388
+
(** [of_octets_exn ?off ipv6_octets] is the IPv6 address represented by
389
+
[ipv6_octets], starting from offset [off]. Raises {!Parse_error} if
390
+
[ipv6_octets] is not at least [off+16] bytes long. [off] defaults to 0. *)
391
+
392
+
val write_octets_exn : ?off:int -> t -> bytes -> unit
393
+
(** [write_octets_exn ?off ipv6 b] writes 16 bytes that encode [ipv6] into [b]
394
+
starting from offset [off] within [b]. [b] must be at least [off+16] bytes
395
+
long or a {!Parse_error} exception will be raised. *)
396
+
397
+
val write_octets :
398
+
?off:int -> t -> bytes -> (unit, [> `Msg of string ]) result
399
+
(** [write_octets ?off ipv6 b] writes 16 bytes that encode [ipv6] into [b]
400
+
starting from offset [off] within [b]. [b] must be at least [off+16] bytes
401
+
long or an error is returned. *)
402
+
403
+
val to_octets : t -> string
404
+
(** [to_octets ipv6] returns the 16 bytes representing the [ipv6] octets. *)
405
+
406
+
(** {3 Int conversion} *)
407
+
408
+
val of_int64 : int64 * int64 -> t
409
+
(** [of_int64 (ho, lo)] is the IPv6 address represented by two int64. *)
410
+
411
+
val to_int64 : t -> int64 * int64
412
+
(** [to_int64 ipv6] is the 128-bit packed encoding of [ipv6]. *)
413
+
414
+
val of_int32 : int32 * int32 * int32 * int32 -> t
415
+
(** [of_int32 (a, b, c, d)] is the IPv6 address represented by four int32. *)
416
+
417
+
val to_int32 : t -> int32 * int32 * int32 * int32
418
+
(** [to_int32 ipv6] is the 128-bit packed encoding of [ipv6]. *)
419
+
420
+
val of_int16 : int * int * int * int * int * int * int * int -> t
421
+
(** [of_int16 (a, b, c, d, e, f, g, h)] is the IPv6 address represented by
422
+
eight 16-bit int. *)
423
+
424
+
val to_int16 : t -> int * int * int * int * int * int * int * int
425
+
(** [to_int16 ipv6] is the 128-bit packed encoding of [ipv6]. *)
426
+
427
+
(** {3 MAC conversion} *)
428
+
429
+
val multicast_to_mac : t -> Macaddr.t
430
+
(** [multicast_to_mac ipv6] is the MAC address corresponding to the multicast
431
+
address [ipv6]. Described by
432
+
{{:https://tools.ietf.org/html/rfc2464#section-7} RFC 2464}. *)
433
+
434
+
(** {3 Host conversion} *)
435
+
436
+
val to_domain_name : t -> [ `host ] Domain_name.t
437
+
(** [to_domain_name ipv6] is the domain name label list for reverse lookups of
438
+
[ipv6]. This includes the [.ip6.arpa] suffix. *)
439
+
440
+
val of_domain_name : 'a Domain_name.t -> t option
441
+
(** [of_domain_name name] is [Some t] if the [name] has an [.ip6.arpa] suffix,
442
+
and an IPv6 address prefixed. *)
443
+
444
+
(** {3 Utility functions} *)
445
+
446
+
val succ : t -> (t, [> `Msg of string ]) result
447
+
(** [succ ipv6] is ip address next to [ipv6]. Returns a human-readable error
448
+
string if it's already the highest address. *)
449
+
450
+
val pred : t -> (t, [> `Msg of string ]) result
451
+
(** [pred ipv6] is ip address before [ipv6]. Returns a human-readable error
452
+
string if it's already the lowest address. *)
453
+
454
+
(** {3 Common addresses} *)
455
+
456
+
val unspecified : t
457
+
(** [unspecified] is ::. *)
458
+
459
+
val localhost : t
460
+
(** [localhost] is ::1. *)
461
+
462
+
val interface_nodes : t
463
+
(** [interface_nodes] is ff01::01. *)
464
+
465
+
val link_nodes : t
466
+
(** [link_nodes] is ff02::01. *)
467
+
468
+
val interface_routers : t
469
+
(** [interface_routers] is ff01::02. *)
470
+
471
+
val link_routers : t
472
+
(** [link_routers] is ff02::02. *)
473
+
474
+
val site_routers : t
475
+
(** [site_routers] is ff05::02. *)
476
+
477
+
(** A module for manipulating IPv6 network prefixes (CIDR). *)
478
+
module Prefix : sig
479
+
type addr = t
480
+
481
+
type t
482
+
(** Type of a internet protocol subnet: an address and a prefix length. *)
483
+
484
+
val mask : int -> addr
485
+
(** [mask n] is the pseudo-address of an [n] bit subnet mask. *)
486
+
487
+
val make : int -> addr -> t
488
+
(** [make n addr] is the cidr of [addr] with [n] bit prefix. *)
489
+
490
+
val prefix : t -> t
491
+
(** [prefix cidr] is the subnet prefix of [cidr] where all non-prefix bits
492
+
set to 0. *)
493
+
494
+
val network_address : t -> addr -> addr
495
+
(** [network_address cidr addr] is the address with prefix [cidr] and suffix
496
+
from [addr]. See <http://tools.ietf.org/html/rfc4291#section-2.3>. *)
497
+
498
+
val of_string_exn : string -> t
499
+
(** [of_string_exn cidr] is the subnet prefix represented by the CIDR
500
+
string, [cidr]. Raises {!Parse_error} if [cidr] is not a valid
501
+
representation of a CIDR notation routing prefix. *)
502
+
503
+
val of_string : string -> (t, [> `Msg of string ]) result
504
+
(** Same as {!of_string_exn} but returns a result type instead of raising an
505
+
exception. *)
506
+
507
+
val of_string_raw : string -> int ref -> t
508
+
(** Same as {!of_string_exn} but takes as an extra argument the offset into
509
+
the string for reading. *)
510
+
511
+
val to_string : t -> string
512
+
(** [to_string cidr] is the CIDR notation string representation of [cidr],
513
+
i.e. XXX:XX:X::XXX/XX. *)
514
+
515
+
val pp : Format.formatter -> t -> unit
516
+
[@@ocaml.toplevel_printer]
517
+
(** [pp f cidr] outputs a human-readable representation of [cidr] to the
518
+
formatter [f]. *)
519
+
520
+
val to_buffer : Buffer.t -> t -> unit
521
+
(** [to_buffer buf cidr] writes the string representation of [cidr] to the
522
+
buffer [buf]. *)
523
+
524
+
val of_netmask_exn : netmask:addr -> address:addr -> t
525
+
(** [of_netmask_exn ~netmask ~address] is the subnet prefix of [address]
526
+
with netmask [netmask]. *)
527
+
528
+
val of_netmask :
529
+
netmask:addr -> address:addr -> (t, [> `Msg of string ]) result
530
+
(** [of_netmask ~netmask ~address] is the cidr of [address] with netmask
531
+
[netmask]. *)
532
+
533
+
val mem : addr -> t -> bool
534
+
(** [mem ip subnet] checks whether [ip] is found within [subnet]. *)
535
+
536
+
val subset : subnet:t -> network:t -> bool
537
+
(** [subset ~subnet ~network] checks whether [subnet] is contained within
538
+
[network]. *)
539
+
540
+
val of_addr : addr -> t
541
+
(** [of_addr ip] create a subnet composed of only one address, [ip]. It is
542
+
the same as [make 128 ip]. *)
543
+
544
+
val global_unicast_001 : t
545
+
(** Global Unicast 001, 2000::/3. *)
546
+
547
+
val unique_local : t
548
+
(** The Unique Local Unicast (ULA), fc00::/7. *)
549
+
550
+
val link : t
551
+
(** Link-Local Unicast, fe80::/64. *)
552
+
553
+
val multicast : t
554
+
(** The multicast network, ff00::/8. *)
555
+
556
+
val ipv4_mapped : t
557
+
(** IPv4-mapped addresses, ::ffff:0:0/96. *)
558
+
559
+
val noneui64_interface : t
560
+
(** Global Unicast addresses that don't use Modified EUI64 interface
561
+
identifiers, ::/3. *)
562
+
563
+
val solicited_node : t
564
+
(** Solicited-Node multicast addresses *)
565
+
566
+
val network : t -> addr
567
+
(** [network subnet] is the address for [subnet]. *)
568
+
569
+
val netmask : t -> addr
570
+
(** [netmask subnet] is the netmask for [subnet]. *)
571
+
572
+
val address : t -> addr
573
+
(** [address cidr] is the address for [cidr]. *)
574
+
575
+
val bits : t -> int
576
+
(** [bits subnet] is the bit size of the [subnet] prefix. *)
577
+
578
+
val first : t -> addr
579
+
(** [first subnet] is first valid unicast address in this [subnet]. *)
580
+
581
+
val last : t -> addr
582
+
(** [last subnet] is last valid unicast address in this [subnet]. *)
583
+
584
+
val hosts : ?usable:bool -> t -> addr Seq.t
585
+
(** [hosts subnet] is the sequence of host addresses in this [subnet]. By
586
+
default the Subnet-Router anycast address is omitted. This can be
587
+
changed by setting [usable] to false. *)
588
+
589
+
val subnets : int -> t -> t Seq.t
590
+
(** [subnets n subnet] is the sequence of subnets of [subnet] with a prefix
591
+
length of [n]. *)
592
+
593
+
include Map.OrderedType with type t := t
594
+
end
595
+
596
+
val scope : t -> scope
597
+
(** [scope ipv6] is the classification of [ipv6] by the {!scope} hierarchy. *)
598
+
599
+
val link_address_of_mac : Macaddr.t -> t
600
+
(** [link_address_of_mac mac] is the link-local address for an Ethernet
601
+
interface derived by the IEEE MAC -> EUI-64 map with the Universal/Local
602
+
bit complemented for IPv6.
603
+
604
+
@see <https://tools.ietf.org/html/rfc2464#section-4> RFC 2464 *)
605
+
606
+
val is_global : t -> bool
607
+
(** [is_global ipv6] is a predicate indicating whether [ipv6] globally
608
+
addresses a node. *)
609
+
610
+
val is_multicast : t -> bool
611
+
(** [is_multicast ipv6] is a predicate indicating whether [ipv6] is a
612
+
multicast address. *)
613
+
614
+
val is_private : t -> bool
615
+
(** [is_private ipv6] is a predicate indicating whether [ipv6] privately
616
+
addresses a node. *)
617
+
618
+
include Map.OrderedType with type t := t
619
+
module Set : Set.S with type elt := t
620
+
module Map : Map.S with type key := t
621
+
end
622
+
623
+
(** Type of either an IPv4 value or an IPv6 value *)
624
+
type ('v4, 'v6) v4v6 = V4 of 'v4 | V6 of 'v6
625
+
626
+
type t = (V4.t, V6.t) v4v6
627
+
(** Type of any IP address *)
628
+
629
+
val to_string : t -> string
630
+
(** [to_string addr] is the text string representation of [addr]. *)
631
+
632
+
val to_buffer : Buffer.t -> t -> unit
633
+
(** [to_buffer buf addr] writes the text string representation of [addr] into
634
+
[buf]. *)
635
+
636
+
val pp : Format.formatter -> t -> unit
637
+
[@@ocaml.toplevel_printer]
638
+
(** [pp f ip] outputs a human-readable representation of [ip] to the formatter
639
+
[f]. *)
640
+
641
+
val of_string_exn : string -> t
642
+
(** [of_string_exn s] parses [s] as an IPv4 or IPv6 address. Raises
643
+
{!Parse_error} if [s] is not a valid string representation of an IP address. *)
644
+
645
+
val of_string : string -> (t, [> `Msg of string ]) result
646
+
(** Same as {!of_string_exn} but returns a result type instead of raising an
647
+
exception. *)
648
+
649
+
val of_string_raw : string -> int ref -> t
650
+
(** Same as [of_string_exn] but takes as an extra argument the offset into the
651
+
string for reading. *)
652
+
653
+
val with_port_of_string :
654
+
default:int -> string -> (t * int, [> `Msg of string ]) result
655
+
(** [with_port_of_string ~default s] parses [s] as an IPv4 or IPv6 address with
656
+
a possible port seperated by a [':'] (if not, we use [default]). For IPv6,
657
+
due to the [':'] separator, only a full expansion of the IPv6 plus the port
658
+
lets us to interpret the last [:<int>] as the port. In other words:
659
+
660
+
- [::1:8080] returns the IPv6 [::1:8080] with the [default] port
661
+
- [0:0:0:0:0:0:0:1:8080] returns [::1] with the port [8080]. *)
662
+
663
+
val of_octets_exn : string -> t
664
+
(** [of_octets_exn octets] is the address {!t} represented by [octets]. The
665
+
[octets] must be 4 bytes long for a {!V4} or 16 if a {!V6}. Raises
666
+
{!Parse_error} if [octets] is not a valid representation of an address. *)
667
+
668
+
val of_octets : string -> (t, [> `Msg of string ]) result
669
+
(** Same as {!of_octets_exn} but returns a result type instead of raising an
670
+
exception. *)
671
+
672
+
val to_octets : t -> string
673
+
(** [to_octets addr] returns the bytes representing the [addr] octets, which
674
+
will be 4 bytes long if addr is a {!V4} or 16 if a {!V6}. *)
675
+
676
+
val v4_of_v6 : V6.t -> V4.t option
677
+
(** [v4_of_v6 ipv6] is the IPv4 representation of the IPv6 address [ipv6]. If
678
+
[ipv6] is not an IPv4-mapped address, None is returned. *)
679
+
680
+
val to_v4 : t -> V4.t option
681
+
(** [to_v4 addr] is the IPv4 representation of [addr]. *)
682
+
683
+
val v6_of_v4 : V4.t -> V6.t
684
+
(** [v6_of_v4 ipv4] is the IPv6 representation of the IPv4 address [ipv4]. *)
685
+
686
+
val to_v6 : t -> V6.t
687
+
(** [to_v6 addr] is the IPv6 representation of [addr]. *)
688
+
689
+
val scope : t -> scope
690
+
(** [scope addr] is the classification of [addr] by the {!scope} hierarchy. *)
691
+
692
+
val is_global : t -> bool
693
+
(** [is_global addr] is a predicate indicating whether [addr] globally addresses
694
+
a node. *)
695
+
696
+
val is_multicast : t -> bool
697
+
(** [is_multicast addr] is a predicate indicating whether [addr] is a multicast
698
+
address. *)
699
+
700
+
val is_private : t -> bool
701
+
(** [is_private addr] is a predicate indicating whether [addr] privately
702
+
addresses a node. *)
703
+
704
+
val multicast_to_mac : t -> Macaddr.t
705
+
(** [multicast_to_mac addr] is the MAC address corresponding to the multicast
706
+
address [addr]. See {!V4.multicast_to_mac} and {!V6.multicast_to_mac}.*)
707
+
708
+
val to_domain_name : t -> [ `host ] Domain_name.t
709
+
(** [to_domain_name addr] is the domain name label list for reverse lookups of
710
+
[addr]. This includes the [.in-addr.arpa] or [.ip6.arpa] suffix. *)
711
+
712
+
val of_domain_name : 'a Domain_name.t -> t option
713
+
(** [of_domain_name name] is [Some t] if the [name] has an [.in-addr.arpa] or
714
+
[ip6.arpa] suffix, and an IP address prefixed. *)
715
+
716
+
val succ : t -> (t, [> `Msg of string ]) result
717
+
(** [succ addr] is ip address next to [addr]. Returns a human-readable error
718
+
string if it's already the highest address. *)
719
+
720
+
val pred : t -> (t, [> `Msg of string ]) result
721
+
(** [pred addr] is ip address before [addr]. Returns a human-readable error
722
+
string if it's already the lowest address. *)
723
+
724
+
module Prefix : sig
725
+
type addr = t
726
+
727
+
type t = (V4.Prefix.t, V6.Prefix.t) v4v6
728
+
(** Type of a internet protocol subnet *)
729
+
730
+
val to_string : t -> string
731
+
(** [to_string subnet] is the text string representation of [subnet]. *)
732
+
733
+
val to_buffer : Buffer.t -> t -> unit
734
+
(** [to_buffer buf subnet] writes the text string representation of [subnet]
735
+
into [buf]. *)
736
+
737
+
val pp : Format.formatter -> t -> unit
738
+
[@@ocaml.toplevel_printer]
739
+
(** [pp f subnet] outputs a human-readable representation of [subnet] to the
740
+
formatter [f]. *)
741
+
742
+
val of_string_exn : string -> t
743
+
(** [of_string_exn cidr] is the subnet prefix represented by the CIDR string,
744
+
[cidr]. Raises {!Parse_error} if [cidr] is not a valid representation of a
745
+
CIDR notation routing prefix. *)
746
+
747
+
val of_string : string -> (t, [> `Msg of string ]) result
748
+
(** Same as {!of_string_exn} but returns a result type instead of raising an
749
+
exception. *)
750
+
751
+
val of_string_raw : string -> int ref -> t
752
+
(** Same as {!of_string_exn} but takes as an extra argument the offset into
753
+
the string for reading. *)
754
+
755
+
val v4_of_v6 : V6.Prefix.t -> V4.Prefix.t option
756
+
(** [v4_of_v6 ipv6] is the IPv4 representation of the IPv6 subnet [ipv6]. If
757
+
[ipv6] is not an IPv4-mapped subnet, None is returned. *)
758
+
759
+
val to_v4 : t -> V4.Prefix.t option
760
+
(** [to_v4 subnet] is the IPv4 representation of [subnet]. *)
761
+
762
+
val v6_of_v4 : V4.Prefix.t -> V6.Prefix.t
763
+
(** [v6_of_v4 ipv4] is the IPv6 representation of the IPv4 subnet [ipv4]. *)
764
+
765
+
val to_v6 : t -> V6.Prefix.t
766
+
(** [to_v6 subnet] is the IPv6 representation of [subnet]. *)
767
+
768
+
val mem : addr -> t -> bool
769
+
(** [mem ip subnet] checks whether [ip] is found within [subnet]. *)
770
+
771
+
val subset : subnet:t -> network:t -> bool
772
+
(** [subset ~subnet ~network] checks whether [subnet] is contained within
773
+
[network]. *)
774
+
775
+
val of_addr : addr -> t
776
+
(** [of_addr ip] create a subnet composed of only one address, [ip].*)
777
+
778
+
val network : t -> addr
779
+
(** [network subnet] is the address for [subnet]. *)
780
+
781
+
val netmask : t -> addr
782
+
(** [netmask subnet] is the netmask for [subnet]. *)
783
+
784
+
val address : t -> addr
785
+
(** [address cidr] is the address for [cidr]. *)
786
+
787
+
val bits : t -> int
788
+
(** [bits cidr] is the bit size of the [cidr] prefix. *)
789
+
790
+
val first : t -> addr
791
+
(** [first subnet] is first valid unicast address in this [subnet]. *)
792
+
793
+
val last : t -> addr
794
+
(** [last subnet] is last valid unicast address in this [subnet]. *)
795
+
796
+
val hosts : ?usable:bool -> t -> (V4.t Seq.t, V6.t Seq.t) v4v6
797
+
(** [hosts cidr] is the sequence of host addresses in this [cidr]. By default,
798
+
the network and broadcast addresses are omitted for IPv4. In the case of
799
+
IPv6, the Subnet-Router anycast address is omitted by default. This can be
800
+
changed by setting [usable] to false. *)
801
+
802
+
val subnets : int -> t -> (V4.Prefix.t Seq.t, V6.Prefix.t Seq.t) v4v6
803
+
(** [subnets n cidr] is the sequence of subnets of [cidr] with a prefix length
804
+
of [n]. *)
805
+
806
+
include Map.OrderedType with type t := t
807
+
end
808
+
809
+
include Map.OrderedType with type t := t
810
+
module Set : Set.S with type elt := t
811
+
module Map : Map.S with type key := t
+63
vendor/opam/ipaddr/lib/ipaddr_cstruct.ml
+63
vendor/opam/ipaddr/lib/ipaddr_cstruct.ml
···
1
+
(*
2
+
* Copyright (c) 2019 Anil Madhavapeddy
3
+
* Copyright (c) 2014 Nicolás Ojeda Bär
4
+
*
5
+
* Permission to use, copy, modify, and distribute this software for any
6
+
* purpose with or without fee is hereby granted, provided that the above
7
+
* copyright notice and this permission notice appear in all copies.
8
+
*
9
+
* THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
10
+
* WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
11
+
* MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
12
+
* ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
13
+
* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
14
+
* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
15
+
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
16
+
*
17
+
*)
18
+
19
+
let need_more x = Ipaddr.Parse_error ("not enough data", x)
20
+
21
+
let try_with_result fn a =
22
+
try Ok (fn a)
23
+
with Ipaddr.Parse_error (msg, _) -> Error (`Msg ("Ipaddr: " ^ msg))
24
+
25
+
module V4 = struct
26
+
let of_cstruct_exn cs =
27
+
let len = Cstruct.length cs in
28
+
if len < 4 then raise (need_more (Cstruct.to_string cs));
29
+
Ipaddr.V4.of_int32 (Cstruct.BE.get_uint32 cs 0)
30
+
31
+
let of_cstruct cs = try_with_result of_cstruct_exn cs
32
+
33
+
let write_cstruct_exn i cs =
34
+
let len = Cstruct.length cs in
35
+
if len < 4 then raise (need_more (Cstruct.to_string cs));
36
+
Cstruct.BE.set_uint32 cs 0 (Ipaddr.V4.to_int32 i)
37
+
38
+
let to_cstruct ?(allocator = Cstruct.create) i =
39
+
let cs = allocator 4 in
40
+
write_cstruct_exn i cs;
41
+
cs
42
+
end
43
+
44
+
module V6 = struct
45
+
open Ipaddr.V6
46
+
47
+
let of_cstruct_exn cs =
48
+
let len = Cstruct.length cs in
49
+
if len < 16 then raise (need_more (Cstruct.to_string cs));
50
+
of_octets_exn (Cstruct.to_string ~len:16 cs)
51
+
52
+
let of_cstruct cs = try_with_result of_cstruct_exn cs
53
+
54
+
let write_cstruct_exn i cs =
55
+
let len = Cstruct.length cs in
56
+
if len < 16 then raise (need_more (Cstruct.to_string cs));
57
+
Cstruct.blit_from_string (to_octets i) 0 cs 0 16
58
+
59
+
let to_cstruct ?(allocator = Cstruct.create) i =
60
+
let cs = allocator 16 in
61
+
write_cstruct_exn i cs;
62
+
cs
63
+
end
+59
vendor/opam/ipaddr/lib/ipaddr_cstruct.mli
+59
vendor/opam/ipaddr/lib/ipaddr_cstruct.mli
···
1
+
(*
2
+
* Copyright (c) 2019 Anil Madhavapeddy
3
+
* Copyright (c) 2014 Nicolás Ojeda Bär
4
+
*
5
+
* Permission to use, copy, modify, and distribute this software for any
6
+
* purpose with or without fee is hereby granted, provided that the above
7
+
* copyright notice and this permission notice appear in all copies.
8
+
*
9
+
* THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
10
+
* WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
11
+
* MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
12
+
* ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
13
+
* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
14
+
* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
15
+
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
16
+
*
17
+
*)
18
+
19
+
(** Convert to and from Cstructs and IP addresses *)
20
+
21
+
(** Ipv4 address conversions *)
22
+
module V4 : sig
23
+
val of_cstruct : Cstruct.t -> (Ipaddr.V4.t, [> `Msg of string ]) result
24
+
(** [of_cstruct c] parses the first 4 octets of [c] into an IPv4 address. *)
25
+
26
+
val of_cstruct_exn : Cstruct.t -> Ipaddr.V4.t
27
+
(** [of_cstruct_exn] parses the first 4 octets of [c] into an IPv4 address.
28
+
Raises {!Ipaddr.Parse_failure} on error. *)
29
+
30
+
val to_cstruct : ?allocator:(int -> Cstruct.t) -> Ipaddr.V4.t -> Cstruct.t
31
+
(** [to_cstruct ipv4] is a cstruct of length 4 encoding [ipv4]. The cstruct is
32
+
allocated using [allocator]. If [allocator] is not provided,
33
+
[Cstruct.create] is used. *)
34
+
35
+
val write_cstruct_exn : Ipaddr.V4.t -> Cstruct.t -> unit
36
+
(** [write_cstruct_exn ipv4 cs] writes 4 bytes into [cs] representing the
37
+
[ipv4] address octets. Raises {!Ipaddr.Parse_error} if [cs] is not at
38
+
least 4 bytes long. *)
39
+
end
40
+
41
+
(** Ipv6 address conversions *)
42
+
module V6 : sig
43
+
val of_cstruct : Cstruct.t -> (Ipaddr.V6.t, [> `Msg of string ]) result
44
+
(** [of_cstruct c] parses the first 16 octets of [c] into an IPv6 address. *)
45
+
46
+
val of_cstruct_exn : Cstruct.t -> Ipaddr.V6.t
47
+
(** [of_cstruct_exn] parses the first 16 octets of [c] into an IPv6 address.
48
+
Raises {!Ipaddr.Parse_failure} on error. *)
49
+
50
+
val to_cstruct : ?allocator:(int -> Cstruct.t) -> Ipaddr.V6.t -> Cstruct.t
51
+
(** [to_cstruct ipv6] is a cstruct of length 16 encoding [ipv6]. The cstruct
52
+
is allocated using [allocator]. If [allocator] is not provided,
53
+
[Cstruct.create] is used. *)
54
+
55
+
val write_cstruct_exn : Ipaddr.V6.t -> Cstruct.t -> unit
56
+
(** [write_cstruct_exn ipv6 cs] writes 16 bytes into [cs] representing the
57
+
[ipv6] address octets. Raises {!Ipaddr.Parse_error} if [cs] is not at
58
+
least 16 bytes long. *)
59
+
end
+91
vendor/opam/ipaddr/lib/ipaddr_sexp.ml
+91
vendor/opam/ipaddr/lib/ipaddr_sexp.ml
···
1
+
(*
2
+
* Copyright (c) 2018 Anil Madhavapeddy <anil@recoil.org>
3
+
*
4
+
* Permission to use, copy, modify, and distribute this software for any
5
+
* purpose with or without fee is hereby granted, provided that the above
6
+
* copyright notice and this permission notice appear in all copies.
7
+
*
8
+
* THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
9
+
* WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
10
+
* MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
11
+
* ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
12
+
* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
13
+
* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
14
+
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
15
+
*
16
+
*)
17
+
18
+
open Sexplib0
19
+
20
+
let of_sexp fn = function
21
+
| Sexp.List _ -> failwith "expecting sexp atom"
22
+
| Sexp.Atom s -> (
23
+
match fn s with Ok r -> r | Error (`Msg msg) -> failwith msg)
24
+
25
+
let to_sexp fn t = Sexp.Atom (fn t)
26
+
27
+
module V4 = struct
28
+
module I = Ipaddr.V4
29
+
30
+
type t = I.t
31
+
32
+
let sexp_of_t = to_sexp I.to_string
33
+
let t_of_sexp = of_sexp I.of_string
34
+
let compare = I.compare
35
+
36
+
module Prefix = struct
37
+
module I = Ipaddr.V4.Prefix
38
+
39
+
type addr = I.addr
40
+
type t = I.t
41
+
42
+
let sexp_of_t = to_sexp I.to_string
43
+
let t_of_sexp = of_sexp I.of_string
44
+
let compare = I.compare
45
+
end
46
+
end
47
+
48
+
module V6 = struct
49
+
module I = Ipaddr.V6
50
+
51
+
type t = I.t
52
+
53
+
let sexp_of_t = to_sexp I.to_string
54
+
let t_of_sexp = of_sexp I.of_string
55
+
let compare = I.compare
56
+
57
+
module Prefix = struct
58
+
module I = Ipaddr.V6.Prefix
59
+
60
+
type addr = I.addr
61
+
type t = I.t
62
+
63
+
let sexp_of_t = to_sexp I.to_string
64
+
let t_of_sexp = of_sexp I.of_string
65
+
let compare = I.compare
66
+
end
67
+
end
68
+
69
+
module I = Ipaddr
70
+
71
+
type t = I.t
72
+
73
+
let sexp_of_t = to_sexp I.to_string
74
+
let t_of_sexp = of_sexp I.of_string
75
+
let compare = I.compare
76
+
77
+
type scope = I.scope
78
+
79
+
let sexp_of_scope = to_sexp I.string_of_scope
80
+
let scope_of_sexp = of_sexp I.scope_of_string
81
+
82
+
module Prefix = struct
83
+
module I = Ipaddr.Prefix
84
+
85
+
type addr = I.addr
86
+
type t = I.t
87
+
88
+
let sexp_of_t = to_sexp I.to_string
89
+
let t_of_sexp = of_sexp I.of_string
90
+
let compare = I.compare
91
+
end
+92
vendor/opam/ipaddr/lib/ipaddr_sexp.mli
+92
vendor/opam/ipaddr/lib/ipaddr_sexp.mli
···
1
+
(*
2
+
* Copyright (c) 2018 Anil Madhavapeddy <anil@recoil.org>
3
+
*
4
+
* Permission to use, copy, modify, and distribute this software for any
5
+
* purpose with or without fee is hereby granted, provided that the above
6
+
* copyright notice and this permission notice appear in all copies.
7
+
*
8
+
* THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
9
+
* WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
10
+
* MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
11
+
* ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
12
+
* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
13
+
* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
14
+
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
15
+
*
16
+
*)
17
+
18
+
(** serialisers to and from {!Ipaddr} and s-expression {!Sexplib0} format
19
+
20
+
To use these with ppx-based derivers, simply replace the reference to the
21
+
{!Ipaddr} type definition with {!Ipaddr_sexp} instead. That will import the
22
+
sexp-conversion functions, and the actual type definitions are simply
23
+
aliases to the corresponding type within {!Ipaddr}. For example, you might
24
+
do:
25
+
26
+
{[
27
+
type t = { ip : Ipaddr_sexp.t; mac : Macaddr_sexp.t } [@@deriving sexp]
28
+
]}
29
+
30
+
The actual types of the records will be aliases to the main library types,
31
+
and there will be two new functions available as converters.
32
+
33
+
{[
34
+
type t = { ip : Ipaddr.t; mac : Macaddr.t }
35
+
36
+
val sexp_of_t : t -> Sexplib0.t
37
+
val t_of_sexp : Sexplib0.t -> t
38
+
]} *)
39
+
40
+
type t = Ipaddr.t
41
+
42
+
val sexp_of_t : Ipaddr.t -> Sexplib0.Sexp.t
43
+
val t_of_sexp : Sexplib0.Sexp.t -> Ipaddr.t
44
+
val compare : Ipaddr.t -> Ipaddr.t -> int
45
+
46
+
type scope = Ipaddr.scope
47
+
48
+
val sexp_of_scope : Ipaddr.scope -> Sexplib0.Sexp.t
49
+
val scope_of_sexp : Sexplib0.Sexp.t -> Ipaddr.scope
50
+
51
+
module V4 : sig
52
+
type t = Ipaddr.V4.t
53
+
54
+
val sexp_of_t : Ipaddr.V4.t -> Sexplib0.Sexp.t
55
+
val t_of_sexp : Sexplib0.Sexp.t -> Ipaddr.V4.t
56
+
val compare : Ipaddr.V4.t -> Ipaddr.V4.t -> int
57
+
58
+
module Prefix : sig
59
+
type addr = Ipaddr.V4.Prefix.addr
60
+
type t = Ipaddr.V4.Prefix.t
61
+
62
+
val sexp_of_t : Ipaddr.V4.Prefix.t -> Sexplib0.Sexp.t
63
+
val t_of_sexp : Sexplib0.Sexp.t -> Ipaddr.V4.Prefix.t
64
+
val compare : Ipaddr.V4.Prefix.t -> Ipaddr.V4.Prefix.t -> int
65
+
end
66
+
end
67
+
68
+
module V6 : sig
69
+
type t = Ipaddr.V6.t
70
+
71
+
val sexp_of_t : Ipaddr.V6.t -> Sexplib0.Sexp.t
72
+
val t_of_sexp : Sexplib0.Sexp.t -> Ipaddr.V6.t
73
+
val compare : Ipaddr.V6.t -> Ipaddr.V6.t -> int
74
+
75
+
module Prefix : sig
76
+
type addr = Ipaddr.V6.Prefix.addr
77
+
type t = Ipaddr.V6.Prefix.t
78
+
79
+
val sexp_of_t : Ipaddr.V6.Prefix.t -> Sexplib0.Sexp.t
80
+
val t_of_sexp : Sexplib0.Sexp.t -> Ipaddr.V6.Prefix.t
81
+
val compare : Ipaddr.V6.Prefix.t -> Ipaddr.V6.Prefix.t -> int
82
+
end
83
+
end
84
+
85
+
module Prefix : sig
86
+
type addr = Ipaddr.Prefix.addr
87
+
type t = Ipaddr.Prefix.t
88
+
89
+
val sexp_of_t : Ipaddr.Prefix.t -> Sexplib0.Sexp.t
90
+
val t_of_sexp : Sexplib0.Sexp.t -> Ipaddr.Prefix.t
91
+
val compare : Ipaddr.Prefix.t -> Ipaddr.Prefix.t -> int
92
+
end
+26
vendor/opam/ipaddr/lib/ipaddr_top.ml
+26
vendor/opam/ipaddr/lib/ipaddr_top.ml
···
1
+
let printers =
2
+
[
3
+
"Ipaddr.pp";
4
+
"Ipaddr.Prefix.pp";
5
+
"Ipaddr.V4.pp";
6
+
"Ipaddr.V4.Prefix.pp";
7
+
"Ipaddr.V6.pp";
8
+
"Ipaddr.V6.Prefix.pp";
9
+
"Macaddr.pp";
10
+
]
11
+
12
+
let eval_string ?(print_outcome = false) ?(err_formatter = Format.err_formatter)
13
+
str =
14
+
let lexbuf = Lexing.from_string str in
15
+
let phrase = !Toploop.parse_toplevel_phrase lexbuf in
16
+
Toploop.execute_phrase print_outcome err_formatter phrase
17
+
18
+
let rec install_printers = function
19
+
| [] -> true
20
+
| printer :: printers ->
21
+
let cmd = Printf.sprintf "#install_printer %s;;" printer in
22
+
eval_string cmd && install_printers printers
23
+
24
+
let () =
25
+
if not (install_printers printers) then
26
+
Format.eprintf "Problem installing Ipaddr-printers@."
+6
vendor/opam/ipaddr/lib/ipaddr_top.mli
+6
vendor/opam/ipaddr/lib/ipaddr_top.mli
+31
vendor/opam/ipaddr/lib/ipaddr_unix.ml
+31
vendor/opam/ipaddr/lib/ipaddr_unix.ml
···
1
+
(*
2
+
* Copyright (c) 2014 Anil Madhavapeddy <anil@recoil.org>
3
+
*
4
+
* Permission to use, copy, modify, and distribute this software for any
5
+
* purpose with or without fee is hereby granted, provided that the above
6
+
* copyright notice and this permission notice appear in all copies.
7
+
*
8
+
* THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
9
+
* WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
10
+
* MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
11
+
* ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
12
+
* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
13
+
* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
14
+
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
15
+
*
16
+
*)
17
+
18
+
let to_inet_addr t = Unix.inet_addr_of_string (Ipaddr.to_string t)
19
+
let of_inet_addr t = Ipaddr.of_string_exn (Unix.string_of_inet_addr t)
20
+
21
+
module V4 = struct
22
+
let to_inet_addr t = Unix.inet_addr_of_string (Ipaddr.V4.to_string t)
23
+
let of_inet_addr_exn t = Ipaddr.V4.of_string_exn (Unix.string_of_inet_addr t)
24
+
let of_inet_addr t = try Some (of_inet_addr_exn t) with _ -> None
25
+
end
26
+
27
+
module V6 = struct
28
+
let to_inet_addr t = Unix.inet_addr_of_string (Ipaddr.V6.to_string t)
29
+
let of_inet_addr_exn t = Ipaddr.V6.of_string_exn (Unix.string_of_inet_addr t)
30
+
let of_inet_addr t = try Some (of_inet_addr_exn t) with _ -> None
31
+
end
+58
vendor/opam/ipaddr/lib/ipaddr_unix.mli
+58
vendor/opam/ipaddr/lib/ipaddr_unix.mli
···
1
+
(*
2
+
* Copyright (c) 2014 Anil Madhavapeddy <anil@recoil.org>
3
+
*
4
+
* Permission to use, copy, modify, and distribute this software for any
5
+
* purpose with or without fee is hereby granted, provided that the above
6
+
* copyright notice and this permission notice appear in all copies.
7
+
*
8
+
* THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
9
+
* WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
10
+
* MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
11
+
* ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
12
+
* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
13
+
* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
14
+
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
15
+
*
16
+
*)
17
+
18
+
(** Convert to and from [Unix] to [Ipaddr] representations
19
+
20
+
{e %%VERSION%% - {{:%%PKG_HOMEPAGE%%} homepage}} *)
21
+
22
+
val to_inet_addr : Ipaddr.t -> Unix.inet_addr
23
+
(** [to_inet_addr ip] is the {!Unix.inet_addr} equivalent of the IPv4 or IPv6
24
+
address [ip]. *)
25
+
26
+
val of_inet_addr : Unix.inet_addr -> Ipaddr.t
27
+
(** [of_inet_addr ip] is the {!Ipaddr.t} equivalent of the {!Unix.inet_addr}
28
+
[ip]. *)
29
+
30
+
module V4 : sig
31
+
val to_inet_addr : Ipaddr.V4.t -> Unix.inet_addr
32
+
(** [to_inet_addr ip] is the {!Unix.inet_addr} equivalent of the IPv4 address
33
+
[ip]. *)
34
+
35
+
val of_inet_addr_exn : Unix.inet_addr -> Ipaddr.V4.t
36
+
(** [of_inet_addr_exn ip] is the {!Ipaddr.t} equivalent of the
37
+
{!Unix.inet_addr} [ip] IPv4 address. Raises {!Ipaddr.Parse_error} if [ip]
38
+
is not a valid representation of an IPv4 address. *)
39
+
40
+
val of_inet_addr : Unix.inet_addr -> Ipaddr.V4.t option
41
+
(** Same as [of_inet_addr_exn] but returns an option type instead of raising
42
+
an exception. *)
43
+
end
44
+
45
+
module V6 : sig
46
+
val to_inet_addr : Ipaddr.V6.t -> Unix.inet_addr
47
+
(** [to_inet_addr ip] is the {!Unix.inet_addr} equivalent of the IPv6 address
48
+
[ip]. *)
49
+
50
+
val of_inet_addr_exn : Unix.inet_addr -> Ipaddr.V6.t
51
+
(** [of_inet_addr_exn ip] is the {!Ipaddr.t} equivalent of the
52
+
{!Unix.inet_addr} [ip] IPv6 address. Raises {!Ipaddr.Parse_error} if [ip]
53
+
is not a valid representation of an IPv6 address. *)
54
+
55
+
val of_inet_addr : Unix.inet_addr -> Ipaddr.V6.t option
56
+
(** Same as [of_inet_addr_exn] but returns an option type instead of raising
57
+
an exception. *)
58
+
end
+98
vendor/opam/ipaddr/lib/macaddr.ml
+98
vendor/opam/ipaddr/lib/macaddr.ml
···
1
+
(*
2
+
* Copyright (c) 2010 Anil Madhavapeddy <anil@recoil.org>
3
+
* Copyright (c) 2014 David Sheets <sheets@alum.mit.edu>
4
+
*
5
+
* Permission to use, copy, modify, and distribute this software for any
6
+
* purpose with or without fee is hereby granted, provided that the above
7
+
* copyright notice and this permission notice appear in all copies.
8
+
*
9
+
* THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
10
+
* WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
11
+
* MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
12
+
* ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
13
+
* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
14
+
* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
15
+
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
16
+
*)
17
+
18
+
exception Parse_error of string * string
19
+
20
+
let need_more x = Parse_error ("not enough data", x)
21
+
22
+
let try_with_result fn a =
23
+
try Ok (fn a) with Parse_error (msg, _) -> Error (`Msg ("Macaddr: " ^ msg))
24
+
25
+
type t = string (* length 6 only *)
26
+
27
+
let compare = String.compare
28
+
29
+
(* Raw MAC address off the wire (network endian) *)
30
+
let of_octets_exn x =
31
+
if String.length x <> 6 then raise (Parse_error ("MAC is exactly 6 bytes", x))
32
+
else x
33
+
34
+
let of_octets x = try_with_result of_octets_exn x
35
+
36
+
exception Invalid_hex_digit of char
37
+
38
+
let hex_digit c =
39
+
match Char.uppercase_ascii c with
40
+
| '0' .. '9' as c -> Char.code c - 48
41
+
| 'A' .. 'F' as c -> Char.code c - 55
42
+
| c -> raise_notrace (Invalid_hex_digit c)
43
+
44
+
let hex_byte x i =
45
+
(hex_digit (String.get x i) lsl 4) + hex_digit (String.get x (succ i))
46
+
47
+
(* Read a MAC address colon-separated string *)
48
+
let of_string_exn x =
49
+
if String.length x < (2 * 6) + 5 then raise (need_more x);
50
+
if String.length x <> (2 * 6) + 5 then
51
+
raise (Parse_error ("macaddr string is too long", x));
52
+
let m = Bytes.create 6 in
53
+
try
54
+
for i = 0 to 5 do
55
+
Bytes.set_uint8 m i (hex_byte x (3 * i))
56
+
done;
57
+
let sep = x.[2] in
58
+
(match sep with
59
+
| ':' | '-' -> ()
60
+
| _ ->
61
+
raise
62
+
(Parse_error (Printf.sprintf "Invalid macaddr separator: %C" sep, x)));
63
+
for i = 1 to 4 do
64
+
if x.[(3 * i) + 2] <> sep then
65
+
raise
66
+
(Parse_error
67
+
( Printf.sprintf "Invalid macaddr separator, first was %C, now %C"
68
+
sep
69
+
x.[(3 * i) + 2],
70
+
x ))
71
+
done;
72
+
Bytes.unsafe_to_string m
73
+
with Invalid_hex_digit c ->
74
+
raise (Parse_error (Printf.sprintf "Invalid macaddr hex digit: %C" c, x))
75
+
76
+
let of_string x = try_with_result of_string_exn x
77
+
let chri x i = Char.code x.[i]
78
+
79
+
let to_string ?(sep = ':') x =
80
+
Printf.sprintf "%02x%c%02x%c%02x%c%02x%c%02x%c%02x" (chri x 0) sep (chri x 1)
81
+
sep (chri x 2) sep (chri x 3) sep (chri x 4) sep (chri x 5)
82
+
83
+
let to_octets x = x
84
+
let pp ppf i = Format.fprintf ppf "%s" (to_string i)
85
+
let broadcast = String.make 6 '\255'
86
+
87
+
let make_local bytegenf =
88
+
let x = Bytes.create 6 in
89
+
(* set locally administered and unicast bits *)
90
+
Bytes.set x 0 (Char.chr (((bytegenf 0 lor 2) lsr 1) lsl 1));
91
+
for i = 1 to 5 do
92
+
Bytes.set x i (Char.chr (bytegenf i))
93
+
done;
94
+
Bytes.unsafe_to_string x
95
+
96
+
let get_oui x = (chri x 0 lsl 16) lor (chri x 1 lsl 8) lor chri x 2
97
+
let is_local x = (chri x 0 lsr 1) land 1 = 1
98
+
let is_unicast x = chri x 0 land 1 = 0
+78
vendor/opam/ipaddr/lib/macaddr.mli
+78
vendor/opam/ipaddr/lib/macaddr.mli
···
1
+
(*
2
+
* Copyright (c) 2010-2011 Anil Madhavapeddy <anil@recoil.org>
3
+
*
4
+
* Permission to use, copy, modify, and distribute this software for any
5
+
* purpose with or without fee is hereby granted, provided that the above
6
+
* copyright notice and this permission notice appear in all copies.
7
+
*
8
+
* THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
9
+
* WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
10
+
* MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
11
+
* ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
12
+
* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
13
+
* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
14
+
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
15
+
*)
16
+
17
+
(** A library for manipulation of MAC address representations.
18
+
19
+
{e %%VERSION%% - {{:%%PKG_HOMEPAGE%%} homepage}} *)
20
+
21
+
exception Parse_error of string * string
22
+
(** [Parse_error (err,packet)] is raised when parsing of the MAC address syntax
23
+
fails. [err] contains a human-readable error and [packet] is the original
24
+
octet list that failed to parse. *)
25
+
26
+
type t
27
+
(** Type of the hardware address (MAC) of an ethernet interface. *)
28
+
29
+
(** {2 Functions converting MAC addresses to/from octets/string} *)
30
+
31
+
val of_octets_exn : string -> t
32
+
(** [of_octets_exn buf] is the hardware address extracted from [buf]. Raises
33
+
[Parse_error] if [buf] has not length 6. *)
34
+
35
+
val of_octets : string -> (t, [> `Msg of string ]) result
36
+
(** Same as {!of_octets_exn} but returns a result type instead of raising an
37
+
exception. *)
38
+
39
+
val of_string_exn : string -> t
40
+
(** [of_string_exn mac_string] is the human-readable hardware address
41
+
represented by [mac_string]. Raises {!Parse_error} if [mac_string] is not a
42
+
valid representation of a MAC address. *)
43
+
44
+
val of_string : string -> (t, [> `Msg of string ]) result
45
+
(** Same as {!of_string_exn} but returns a result type instead of raising an
46
+
exception. *)
47
+
48
+
val to_octets : t -> string
49
+
(** [to_octets mac_addr] is a string of size 6 encoding [mac_addr] as a sequence
50
+
of bytes. *)
51
+
52
+
val to_string : ?sep:char -> t -> string
53
+
(** [to_string ?(sep=':') mac_addr] is the [sep]-separated string representation
54
+
of [mac_addr], i.e. [xx:xx:xx:xx:xx:xx]. *)
55
+
56
+
val pp : Format.formatter -> t -> unit
57
+
[@@ocaml.toplevel_printer]
58
+
(** [pp f mac_addr] outputs a human-readable representation of [mac_addr] to the
59
+
formatter [f]. *)
60
+
61
+
val broadcast : t
62
+
(** [broadcast] is [ff:ff:ff:ff:ff:ff]. *)
63
+
64
+
val make_local : (int -> int) -> t
65
+
(** [make_local bytegen] creates a unicast, locally administered MAC address
66
+
given a function mapping octet offset to octet value. *)
67
+
68
+
val get_oui : t -> int
69
+
(** [get_oui macaddr] is the integer organization identifier for [macaddr]. *)
70
+
71
+
val is_local : t -> bool
72
+
(** [is_local macaddr] is the predicate on the locally administered bit of
73
+
[macaddr]. *)
74
+
75
+
val is_unicast : t -> bool
76
+
(** [is_unicast macaddr] the is the predicate on the unicast bit of [macaddr]. *)
77
+
78
+
include Map.OrderedType with type t := t
+39
vendor/opam/ipaddr/lib/macaddr_cstruct.ml
+39
vendor/opam/ipaddr/lib/macaddr_cstruct.ml
···
1
+
(*
2
+
* Copyright (c) 2019 Anil Madhavapeddy
3
+
* Copyright (c) 2014 Nicolás Ojeda Bär
4
+
*
5
+
* Permission to use, copy, modify, and distribute this software for any
6
+
* purpose with or without fee is hereby granted, provided that the above
7
+
* copyright notice and this permission notice appear in all copies.
8
+
*
9
+
* THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
10
+
* WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
11
+
* MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
12
+
* ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
13
+
* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
14
+
* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
15
+
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
16
+
*
17
+
*)
18
+
19
+
let try_with_result fn a =
20
+
try Ok (fn a)
21
+
with Macaddr.Parse_error (msg, _) -> Error (`Msg ("Macaddr: " ^ msg))
22
+
23
+
let of_cstruct_exn cs =
24
+
if Cstruct.length cs <> 6 then
25
+
raise (Macaddr.Parse_error ("MAC is exactly 6 bytes", Cstruct.to_string cs))
26
+
else Cstruct.to_string cs |> Macaddr.of_octets_exn
27
+
28
+
let of_cstruct cs = try_with_result of_cstruct_exn cs
29
+
30
+
let write_cstruct_exn (mac : Macaddr.t) cs =
31
+
let len = Cstruct.length cs in
32
+
let mac = Macaddr.to_octets mac in
33
+
if len <> 6 then raise (Macaddr.Parse_error ("MAC is exactly 6 bytes", mac));
34
+
Cstruct.blit_from_string mac 0 cs 0 6
35
+
36
+
let to_cstruct ?(allocator = Cstruct.create) mac =
37
+
let cs = allocator 6 in
38
+
write_cstruct_exn mac cs;
39
+
cs
+35
vendor/opam/ipaddr/lib/macaddr_cstruct.mli
+35
vendor/opam/ipaddr/lib/macaddr_cstruct.mli
···
1
+
(*
2
+
* Copyright (c) 2019 Anil Madhavapeddy
3
+
* Copyright (c) 2014 Nicolás Ojeda Bär
4
+
*
5
+
* Permission to use, copy, modify, and distribute this software for any
6
+
* purpose with or without fee is hereby granted, provided that the above
7
+
* copyright notice and this permission notice appear in all copies.
8
+
*
9
+
* THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
10
+
* WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
11
+
* MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
12
+
* ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
13
+
* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
14
+
* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
15
+
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
16
+
*
17
+
*)
18
+
19
+
(** Convert to and from Cstructs and MAC address. *)
20
+
21
+
val of_cstruct : Cstruct.t -> (Macaddr.t, [> `Msg of string ]) result
22
+
(** [of_cstruct c] parses the 6 octets of [c] into a MAC address. *)
23
+
24
+
val of_cstruct_exn : Cstruct.t -> Macaddr.t
25
+
(** [of_cstruct_exn] parses the 6 octets of [c] into a MAC address. Raises
26
+
{!Macaddr.Parse_failure} on error. *)
27
+
28
+
val to_cstruct : ?allocator:(int -> Cstruct.t) -> Macaddr.t -> Cstruct.t
29
+
(** [to_cstruct mac] is a cstruct of length 4 encoding [ipv4]. The cstruct is
30
+
allocated using [allocator]. If [allocator] is not provided,
31
+
[Cstruct.create] is used. *)
32
+
33
+
val write_cstruct_exn : Macaddr.t -> Cstruct.t -> unit
34
+
(** [write_cstruct_exn mac cs] writes 6 bytes into [cs] representing the [mac]
35
+
address octets. Raises {!Macaddr.Parse_error} if [cs] is not 6 bytes long. *)
+31
vendor/opam/ipaddr/lib/macaddr_sexp.ml
+31
vendor/opam/ipaddr/lib/macaddr_sexp.ml
···
1
+
(*
2
+
* Copyright (c) 2018 Anil Madhavapeddy <anil@recoil.org>
3
+
*
4
+
* Permission to use, copy, modify, and distribute this software for any
5
+
* purpose with or without fee is hereby granted, provided that the above
6
+
* copyright notice and this permission notice appear in all copies.
7
+
*
8
+
* THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
9
+
* WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
10
+
* MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
11
+
* ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
12
+
* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
13
+
* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
14
+
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
15
+
*
16
+
*)
17
+
18
+
open Sexplib0
19
+
20
+
let of_sexp fn = function
21
+
| Sexp.List _ -> failwith "expecting sexp atom"
22
+
| Sexp.Atom s -> (
23
+
match fn s with Ok r -> r | Error (`Msg msg) -> failwith msg)
24
+
25
+
let to_sexp fn t = Sexp.Atom (fn t)
26
+
27
+
type t = Macaddr.t
28
+
29
+
let sexp_of_t = to_sexp Macaddr.to_string
30
+
let t_of_sexp = of_sexp Macaddr.of_string
31
+
let compare = Macaddr.compare
+44
vendor/opam/ipaddr/lib/macaddr_sexp.mli
+44
vendor/opam/ipaddr/lib/macaddr_sexp.mli
···
1
+
(*
2
+
* Copyright (c) 2018 Anil Madhavapeddy <anil@recoil.org>
3
+
*
4
+
* Permission to use, copy, modify, and distribute this software for any
5
+
* purpose with or without fee is hereby granted, provided that the above
6
+
* copyright notice and this permission notice appear in all copies.
7
+
*
8
+
* THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
9
+
* WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
10
+
* MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
11
+
* ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
12
+
* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
13
+
* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
14
+
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
15
+
*
16
+
*)
17
+
18
+
(** serialisers to and from {!Macaddr} and s-expression {!Sexplib0} format
19
+
20
+
To use these with ppx-based derivers, simply replace the reference to the
21
+
{!Macaddr} type definition with {!Macaddr_sexp} instead. That will import
22
+
the sexp-conversion functions, and the actual type definitions are simply
23
+
aliases to the corresponding type within {!Ipaddr}. For example, you might
24
+
do:
25
+
26
+
{[
27
+
type t = { ip : Ipaddr_sexp.t; mac : Macaddr_sexp.t } [@@deriving sexp]
28
+
]}
29
+
30
+
The actual types of the records will be aliases to the main library types,
31
+
and there will be two new functions available as converters.
32
+
33
+
{[
34
+
type t = { ip : Ipaddr.t; mac : Macaddr.t }
35
+
36
+
val sexp_of_t : t -> Sexplib0.t
37
+
val t_of_sexp : Sexplib0.t -> t
38
+
]} *)
39
+
40
+
type t = Macaddr.t
41
+
42
+
val sexp_of_t : Macaddr.t -> Sexplib0.Sexp.t
43
+
val t_of_sexp : Sexplib0.Sexp.t -> Macaddr.t
44
+
val compare : Macaddr.t -> Macaddr.t -> int
+17
vendor/opam/ipaddr/lib/macaddr_top.ml
+17
vendor/opam/ipaddr/lib/macaddr_top.ml
···
1
+
let printers = [ "Macaddr.pp" ]
2
+
3
+
let eval_string ?(print_outcome = false) ?(err_formatter = Format.err_formatter)
4
+
str =
5
+
let lexbuf = Lexing.from_string str in
6
+
let phrase = !Toploop.parse_toplevel_phrase lexbuf in
7
+
Toploop.execute_phrase print_outcome err_formatter phrase
8
+
9
+
let rec install_printers = function
10
+
| [] -> true
11
+
| printer :: printers ->
12
+
let cmd = Printf.sprintf "#install_printer %s;;" printer in
13
+
eval_string cmd && install_printers printers
14
+
15
+
let () =
16
+
if not (install_printers printers) then
17
+
Format.eprintf "Problem installing Macaddr-printers@."
+48
vendor/opam/ipaddr/lib_test/dune
+48
vendor/opam/ipaddr/lib_test/dune
···
1
+
(rule
2
+
(copy# ../lib/ipaddr_sexp.ml ipaddr_sexp.ml))
3
+
4
+
(rule
5
+
(copy# ../lib/macaddr_sexp.ml macaddr_sexp.ml))
6
+
7
+
(rule
8
+
(copy# ../lib/ipaddr.ml ipaddr_internal.ml))
9
+
10
+
(library
11
+
(name test_macaddr_sexp)
12
+
(wrapped false)
13
+
(modules macaddr_sexp)
14
+
(preprocess
15
+
(pps ppx_sexp_conv))
16
+
(libraries macaddr sexplib0))
17
+
18
+
(library
19
+
(name test_ipaddr_sexp)
20
+
(wrapped false)
21
+
(modules ipaddr_sexp)
22
+
(preprocess
23
+
(pps ppx_sexp_conv))
24
+
(libraries ipaddr sexplib0))
25
+
26
+
(test
27
+
(name test_ipaddr)
28
+
(package ipaddr-sexp)
29
+
(modules test_ipaddr)
30
+
(libraries ipaddr ipaddr-cstruct test_ipaddr_sexp ounit2))
31
+
32
+
(test
33
+
(name test_ipaddr_b128)
34
+
(package ipaddr-sexp)
35
+
(modules test_ipaddr_b128 ipaddr_internal)
36
+
(libraries ipaddr ipaddr-cstruct test_ipaddr_sexp ounit2))
37
+
38
+
(test
39
+
(name test_macaddr)
40
+
(package macaddr-sexp)
41
+
(modules test_macaddr)
42
+
(libraries macaddr macaddr-cstruct test_macaddr_sexp ounit2))
43
+
44
+
(test
45
+
(name test_ppx)
46
+
(modules test_ppx)
47
+
(package ipaddr-sexp)
48
+
(libraries ipaddr macaddr test_ipaddr_sexp test_macaddr_sexp ounit2))
+1319
vendor/opam/ipaddr/lib_test/test_ipaddr.ml
+1319
vendor/opam/ipaddr/lib_test/test_ipaddr.ml
···
1
+
(*
2
+
* Copyright (c) 2013-2014 David Sheets <sheets@alum.mit.edu>
3
+
*
4
+
* Permission to use, copy, modify, and distribute this software for any
5
+
* purpose with or without fee is hereby granted, provided that the above
6
+
* copyright notice and this permission notice appear in all copies.
7
+
*
8
+
* THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
9
+
* WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
10
+
* MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
11
+
* ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
12
+
* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
13
+
* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
14
+
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
15
+
*
16
+
*)
17
+
18
+
open OUnit
19
+
open Ipaddr
20
+
21
+
let error s msg = (s, Parse_error (msg, s))
22
+
let need_more s = error s "not enough data"
23
+
24
+
let bad_char i s =
25
+
error s (Printf.sprintf "invalid character '%c' at %d" s.[i] i)
26
+
27
+
let string_of_list f l = "[" ^ (List.map f l |> String.concat "; ") ^ "]"
28
+
let ( >>= ) v f = match v with Ok v -> f v | Error _ as e -> e
29
+
30
+
let assert_raises ~msg exn test_fn =
31
+
assert_raises ~msg exn (fun () ->
32
+
try test_fn ()
33
+
with rtexn ->
34
+
if exn <> rtexn then (
35
+
Printf.eprintf "Stacktrace for '%s':\n%!" msg;
36
+
Printexc.print_backtrace stderr);
37
+
raise rtexn)
38
+
39
+
module Test_v4 = struct
40
+
let test_string_rt () =
41
+
let addrs = [ ("192.168.0.1", "192.168.0.1") ] in
42
+
List.iter
43
+
(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
51
+
52
+
let test_string_rt_bad () =
53
+
let addrs =
54
+
[
55
+
need_more "192.168.0";
56
+
bad_char 11 "192.168.0.1.1";
57
+
error "192.268.2.1" "second octet out of bounds";
58
+
bad_char 4 "192. 168.1.1";
59
+
bad_char 4 "192..0.1";
60
+
bad_char 3 "192,168.0.1";
61
+
]
62
+
in
63
+
List.iter
64
+
(fun (addr, exn) ->
65
+
assert_raises ~msg:addr exn (fun () -> V4.of_string_exn addr))
66
+
addrs
67
+
68
+
let test_string_raw_rt () =
69
+
let addrs =
70
+
[
71
+
(("IP: 192.168.0.1!!!", 4), ("192.168.0.1", 15));
72
+
(("IP: 192.168.0.1.1!!!", 4), ("192.168.0.1", 15));
73
+
]
74
+
in
75
+
List.iter
76
+
(fun ((addr, off), result) ->
77
+
let c = ref off in
78
+
let os = V4.of_string_raw addr c in
79
+
let ts = V4.to_string os in
80
+
assert_equal ~msg:addr (ts, !c) result)
81
+
addrs
82
+
83
+
let test_string_raw_rt_bad () =
84
+
let addrs =
85
+
[
86
+
(let s = "IP: 192.168.0!!!" in
87
+
((s, 4), (Parse_error ("invalid character '!' at 13", s), 13)));
88
+
]
89
+
in
90
+
List.iter
91
+
(fun ((addr, off), (exn, cursor)) ->
92
+
let c = ref off in
93
+
assert_raises ~msg:addr exn (fun () -> V4.of_string_raw addr c);
94
+
assert_equal
95
+
~msg:(Printf.sprintf "%s cursor <> %d (%d)" addr cursor !c)
96
+
!c cursor)
97
+
addrs
98
+
99
+
let test_bytes_rt () =
100
+
let addr = "\254\099\003\128" in
101
+
assert_equal ~msg:(String.escaped addr)
102
+
V4.(to_octets (of_octets_exn addr))
103
+
addr
104
+
105
+
let test_bytes_rt_bad () =
106
+
let addrs = [ need_more "\254\099\003" ] in
107
+
List.iter
108
+
(fun (addr, exn) ->
109
+
assert_raises ~msg:(String.escaped addr) exn (fun () ->
110
+
V4.of_octets_exn addr))
111
+
addrs
112
+
113
+
let test_int32_rt () =
114
+
let addr = 0x0_F0_AB_00_01_l in
115
+
assert_equal
116
+
~msg:(Printf.sprintf "%08lX" addr)
117
+
V4.(to_int32 (of_int32 addr))
118
+
addr
119
+
120
+
let test_prefix_string_rt () =
121
+
let subnets =
122
+
[
123
+
("192.168.0.0/24", "192.168.0.0/24");
124
+
("0.0.0.0/0", "0.0.0.0/0");
125
+
("192.168.0.1/24", "192.168.0.0/24");
126
+
("192.168.0.0/0", "0.0.0.0/0");
127
+
]
128
+
in
129
+
List.iter
130
+
(fun (subnet, rt) ->
131
+
let os = V4.Prefix.of_string_exn subnet |> V4.Prefix.prefix in
132
+
let ts = V4.Prefix.to_string os in
133
+
assert_equal ~msg:subnet ts rt;
134
+
let os = Ipaddr_sexp.(V4.Prefix.(t_of_sexp (sexp_of_t os))) in
135
+
let ts = V4.Prefix.to_string os in
136
+
assert_equal ~msg:subnet ts rt)
137
+
subnets
138
+
139
+
let test_prefix_string_rt_bad () =
140
+
let subnets =
141
+
[
142
+
bad_char 9 "192.168.0/24";
143
+
bad_char 10 "192.168.0./24";
144
+
error "192.168.0.0/33" "invalid prefix size";
145
+
bad_char 14 "192.168.0.0/30/1";
146
+
bad_char 12 "192.168.0.0/-1";
147
+
]
148
+
in
149
+
List.iter
150
+
(fun (subnet, exn) ->
151
+
assert_raises ~msg:subnet exn (fun () -> V4.Prefix.of_string_exn subnet))
152
+
subnets
153
+
154
+
let test_network_address_rt () =
155
+
let netaddrs = [ ("192.168.0.1/24", "192.168.0.0/24", "192.168.0.1") ] in
156
+
List.iter
157
+
(fun (netaddr, net, addr) ->
158
+
let netv4 = V4.Prefix.of_string_exn net in
159
+
let addrv4 = V4.of_string_exn addr in
160
+
let cidr = V4.Prefix.of_string_exn netaddr in
161
+
let prefix = V4.Prefix.prefix cidr and v4 = V4.Prefix.address cidr in
162
+
assert_equal
163
+
~msg:(net ^ " <> " ^ V4.Prefix.to_string prefix)
164
+
netv4 prefix;
165
+
assert_equal ~msg:(addr ^ " <> " ^ V4.to_string v4) addrv4 v4;
166
+
let addrstr = V4.Prefix.to_string cidr in
167
+
assert_equal ~msg:(netaddr ^ " <> " ^ addrstr) netaddr addrstr)
168
+
netaddrs
169
+
170
+
let test_prefix_broadcast () =
171
+
let pairs =
172
+
[
173
+
("192.168.0.0/16", "192.168.255.255");
174
+
("192.168.0.0/24", "192.168.0.255");
175
+
("192.168.1.1/24", "192.168.1.255");
176
+
("192.168.0.128/29", "192.168.0.135");
177
+
("192.168.0.0/31", "192.168.0.1");
178
+
("192.168.0.0/32", "192.168.0.0");
179
+
("0.0.0.0/0", "255.255.255.255");
180
+
]
181
+
in
182
+
List.iter
183
+
(fun (subnet, bcast) ->
184
+
let r = V4.(to_string Prefix.(broadcast (of_string_exn subnet))) in
185
+
assert_equal ~msg:(subnet ^ " <> " ^ r) r bcast)
186
+
pairs
187
+
188
+
let test_prefix_bits () =
189
+
let pairs =
190
+
V4.Prefix.
191
+
[
192
+
(global, 0);
193
+
(loopback, 8);
194
+
(link, 16);
195
+
(relative, 8);
196
+
(multicast, 4);
197
+
(private_10, 8);
198
+
(private_172, 12);
199
+
(private_192, 16);
200
+
]
201
+
in
202
+
List.iter
203
+
(fun (subnet, bits) ->
204
+
let msg = V4.Prefix.to_string subnet ^ " <> " ^ string_of_int bits in
205
+
assert_equal ~msg (V4.Prefix.bits subnet) bits)
206
+
pairs
207
+
208
+
let test_prefix_netmask () =
209
+
let nets =
210
+
[
211
+
("192.168.0.1/32", "255.255.255.255");
212
+
("192.168.0.1/31", "255.255.255.254");
213
+
("192.168.0.1/1", "128.0.0.0");
214
+
("192.168.0.1/0", "0.0.0.0");
215
+
]
216
+
in
217
+
List.iter
218
+
(fun (net_str, nm_str) ->
219
+
let cidr = V4.Prefix.of_string_exn net_str in
220
+
let prefix = V4.Prefix.prefix cidr
221
+
and address = V4.Prefix.address cidr in
222
+
let netmask = V4.Prefix.netmask prefix in
223
+
let nnm_str = V4.to_string netmask in
224
+
let msg = Printf.sprintf "netmask %s <> %s" nnm_str nm_str in
225
+
assert_equal ~msg nnm_str nm_str;
226
+
let prefix = V4.Prefix.of_netmask_exn ~netmask ~address in
227
+
let nns = V4.Prefix.to_string prefix in
228
+
let msg = Printf.sprintf "%s is %s under netmask iso" net_str nns in
229
+
assert_equal ~msg net_str nns)
230
+
nets
231
+
232
+
let test_prefix_netmask_bad () =
233
+
let bad_masks =
234
+
[
235
+
error "127.255.255.255" "invalid netmask";
236
+
error "255.255.254.128" "invalid netmask";
237
+
]
238
+
in
239
+
List.iter
240
+
(fun (nm_str, exn) ->
241
+
let netmask = V4.of_string_exn nm_str in
242
+
let address = V4.of_string_exn "192.168.0.1" in
243
+
assert_raises ~msg:nm_str exn (fun () ->
244
+
V4.Prefix.of_netmask_exn ~netmask ~address))
245
+
bad_masks
246
+
247
+
let test_scope () =
248
+
let ip = V4.of_string_exn in
249
+
(*let is subnet addr = V4.Prefix.(mem addr subnet) in*)
250
+
let is_scope scop addr = scop = V4.scope addr in
251
+
let ships =
252
+
V4.
253
+
[
254
+
(unspecified, "global", is_global, false);
255
+
(unspecified, "multicast", is_multicast, false);
256
+
(unspecified, "point", is_scope Point, true);
257
+
(localhost, "global", is_global, false);
258
+
(localhost, "multicast", is_multicast, false);
259
+
(localhost, "interface", is_scope Interface, true);
260
+
(broadcast, "global", is_global, false);
261
+
(broadcast, "multicast", is_multicast, false);
262
+
(broadcast, "admin", is_scope Admin, true);
263
+
(nodes, "global", is_global, false);
264
+
(nodes, "multicast", is_multicast, true);
265
+
(nodes, "interface", is_scope Link, true);
266
+
(routers, "global", is_global, false);
267
+
(routers, "multicast", is_multicast, true);
268
+
(routers, "link", is_scope Link, true);
269
+
(ip "192.168.0.1", "private", is_private, true);
270
+
(ip "10.3.21.155", "private", is_private, true);
271
+
(ip "172.16.0.0", "private", is_private, true);
272
+
(ip "172.31.255.255", "private", is_private, true);
273
+
(ip "172.15.255.255", "private", is_private, false);
274
+
(ip "172.32.0.0", "private", is_private, false);
275
+
]
276
+
in
277
+
List.iter
278
+
(fun (addr, lbl, pred, is_mem) ->
279
+
let mems = if is_mem then "" else " not" in
280
+
let msg = V4.to_string addr ^ " is" ^ mems ^ " in " ^ lbl in
281
+
assert_equal ~msg (pred addr) is_mem)
282
+
ships
283
+
284
+
let test_map () =
285
+
let m = V4.Map.add (V4.of_string_exn "1.0.0.1") "min" V4.Map.empty in
286
+
let m =
287
+
V4.Map.add (V4.of_string_exn "254.254.254.254") "the greatest host" m
288
+
in
289
+
let m = V4.Map.add (V4.of_string_exn "1.0.0.1") "the least host" m in
290
+
assert_equal ~msg:"size" (V4.Map.cardinal m) 2;
291
+
let min_key, min_val = V4.Map.min_binding m in
292
+
assert_equal
293
+
~msg:("min is '" ^ min_val ^ "'")
294
+
(min_key, min_val)
295
+
(V4.of_string_exn "1.0.0.1", "the least host");
296
+
assert_equal ~msg:"max" (V4.Map.max_binding m)
297
+
(V4.of_string_exn "254.254.254.254", "the greatest host")
298
+
299
+
let test_prefix_map () =
300
+
let module M = Stdlib.Map.Make (V4.Prefix) in
301
+
let of_string s = s |> V4.Prefix.of_string_exn |> V4.Prefix.prefix in
302
+
let m = M.add (of_string "0.0.0.0/0") "everyone" M.empty in
303
+
let m = M.add (of_string "192.0.0.0/1") "weirdos" m in
304
+
let m = M.add (of_string "128.0.0.0/1") "high-bitters" m in
305
+
let m = M.add (of_string "254.0.0.0/8") "top-end" m in
306
+
let m = M.add (of_string "0.0.0.0/0") "iana" m in
307
+
assert_equal ~msg:"size" (M.cardinal m) 3;
308
+
assert_equal ~msg:"min" (M.min_binding m)
309
+
(V4.Prefix.of_string_exn "0.0.0.0/0", "iana");
310
+
assert_equal ~msg:"max" (M.max_binding m)
311
+
(V4.Prefix.of_string_exn "254.0.0.0/8", "top-end");
312
+
assert_equal ~msg:"third"
313
+
(M.find (V4.Prefix.of_string_exn "128.0.0.0/1") m)
314
+
"high-bitters"
315
+
316
+
let test_special_addr () =
317
+
assert_equal ~msg:"broadcast" V4.broadcast V4.Prefix.(broadcast global);
318
+
assert_equal ~msg:"any" V4.any V4.Prefix.(network global);
319
+
assert_equal ~msg:"localhost" true V4.(Prefix.(mem localhost loopback))
320
+
321
+
let test_multicast_mac () =
322
+
let ip = V4.of_octets_exn "\xff\xbf\x9f\x8f" in
323
+
let multicast = V4.Prefix.(network_address multicast ip) in
324
+
let unicast_mac_str = Macaddr.to_string (V4.multicast_to_mac ip) in
325
+
let multicast_mac_str = Macaddr.to_string (V4.multicast_to_mac multicast) in
326
+
let mac_str = "01:00:5e:3f:9f:8f" in
327
+
assert_equal
328
+
~msg:("unicast_mac " ^ unicast_mac_str ^ " <> " ^ mac_str)
329
+
unicast_mac_str mac_str;
330
+
assert_equal
331
+
~msg:("multicast_mac " ^ multicast_mac_str ^ " <> " ^ mac_str)
332
+
multicast_mac_str mac_str
333
+
334
+
let test_domain_name () =
335
+
let ip = V4.of_string_exn "128.64.32.16" in
336
+
let name =
337
+
Domain_name.(host_exn (of_string_exn "16.32.64.128.in-addr.arpa"))
338
+
in
339
+
assert_equal ~cmp:Domain_name.equal ~msg:"to_domain_name"
340
+
(V4.to_domain_name ip) name;
341
+
assert_equal ~msg:"of_domain_name" (V4.of_domain_name name) (Some ip)
342
+
343
+
let test_cstruct_rt () =
344
+
let addr = "\254\099\003\128" in
345
+
assert_equal ~msg:(String.escaped addr)
346
+
(Cstruct.to_string
347
+
Ipaddr_cstruct.V4.(
348
+
to_cstruct (of_cstruct_exn (Cstruct.of_string addr))))
349
+
addr
350
+
351
+
let test_cstruct_rt_bad () =
352
+
let addrs = [ need_more "\254\099\003" ] in
353
+
List.iter
354
+
(fun (addr, exn) ->
355
+
assert_raises ~msg:(String.escaped addr) exn (fun () ->
356
+
Ipaddr_cstruct.V4.of_cstruct_exn (Cstruct.of_string addr)))
357
+
addrs
358
+
359
+
let test_prefix_mem () =
360
+
let ip = V4.of_string_exn in
361
+
let prefix = V4.Prefix.of_string_exn in
362
+
let ships =
363
+
[
364
+
(ip "10.0.0.7", prefix "10.0.0.0/29", true);
365
+
(ip "172.16.255.254", prefix "172.16.255.254/31", true);
366
+
(ip "192.168.0.1", prefix "0.0.0.0/0", true);
367
+
(ip "192.168.0.1", V4.Prefix.private_192, true);
368
+
(ip "255.255.255.255", prefix "255.255.255.255/32", true);
369
+
(ip "192.0.2.1", prefix "192.0.2.0/32", false);
370
+
(ip "192.0.2.1", prefix "192.0.0.0/23", false);
371
+
(ip "255.255.255.255", prefix "0.0.0.0/1", false);
372
+
]
373
+
in
374
+
List.iter
375
+
(fun (addr, subnet, is_mem) ->
376
+
let msg =
377
+
Printf.sprintf "%s is%s in %s" (V4.to_string addr)
378
+
(if is_mem then "" else " not")
379
+
(V4.Prefix.to_string subnet)
380
+
in
381
+
assert_equal ~msg (V4.Prefix.mem addr subnet) is_mem)
382
+
ships
383
+
384
+
let test_succ_pred () =
385
+
let open V4 in
386
+
let printer = function
387
+
| Ok v -> Printf.sprintf "Ok %s" (to_string v)
388
+
| Error (`Msg e) -> Printf.sprintf "Error `Msg \"%s\"" e
389
+
in
390
+
let assert_equal = assert_equal ~printer in
391
+
let ip1 = of_string_exn "0.0.0.0" in
392
+
let ip2 = of_string_exn "255.255.255.255" in
393
+
assert_equal ~msg:"succ 0.0.0.0" (of_string "0.0.0.1") (succ ip1);
394
+
assert_equal ~msg:"succ 255.255.255.255"
395
+
(Error (`Msg "Ipaddr: highest address has been reached"))
396
+
(succ ip2);
397
+
assert_equal ~msg:"succ (succ 255.255.255.255)"
398
+
(Error (`Msg "Ipaddr: highest address has been reached"))
399
+
(succ ip2 >>= succ);
400
+
assert_equal ~msg:"pred 0.0.0.0"
401
+
(Error (`Msg "Ipaddr: lowest address has been reached"))
402
+
(pred ip1);
403
+
()
404
+
405
+
let test_prefix_first_last () =
406
+
let open V4.Prefix in
407
+
let assert_equal = assert_equal ~printer:V4.to_string in
408
+
assert_equal ~msg:"first 192.168.1.0/24"
409
+
(V4.of_string_exn "192.168.1.1")
410
+
(first (of_string_exn "192.168.1.0/24"));
411
+
assert_equal ~msg:"first 169.254.169.254/31"
412
+
(Ipaddr.V4.of_string_exn "169.254.169.254")
413
+
(first (of_string_exn "169.254.169.254/31"));
414
+
assert_equal ~msg:"first 169.254.169.254/32"
415
+
(Ipaddr.V4.of_string_exn "169.254.169.254")
416
+
(first (of_string_exn "169.254.169.254/32"));
417
+
assert_equal ~msg:"last 192.168.1.0/24"
418
+
(Ipaddr.V4.of_string_exn "192.168.1.254")
419
+
(last (of_string_exn "192.168.1.0/24"));
420
+
assert_equal ~msg:"last 169.254.169.254/31"
421
+
(Ipaddr.V4.of_string_exn "169.254.169.255")
422
+
(last (of_string_exn "169.254.169.254/31"));
423
+
assert_equal ~msg:"last 169.254.169.254/32"
424
+
(Ipaddr.V4.of_string_exn "169.254.169.254")
425
+
(last (of_string_exn "169.254.169.254/32"))
426
+
427
+
let test_reject_octal () =
428
+
let bad_addrs =
429
+
[
430
+
error "010.8.8.8" "octal notation disallowed";
431
+
error "8.010.8.8" "octal notation disallowed";
432
+
error "8.8.010.8" "octal notation disallowed";
433
+
error "8.8.8.010" "octal notation disallowed";
434
+
]
435
+
in
436
+
List.iter
437
+
(fun (addr, exn) ->
438
+
assert_raises ~msg:addr exn (fun () -> V4.of_string_exn addr))
439
+
bad_addrs
440
+
441
+
let test_reject_prefix_octal () =
442
+
let bad_addrs =
443
+
[
444
+
error "010.8.8.8/32" "octal notation disallowed";
445
+
error "8.010.8.8/32" "octal notation disallowed";
446
+
error "8.8.010.8/32" "octal notation disallowed";
447
+
error "8.8.8.010/32" "octal notation disallowed";
448
+
]
449
+
in
450
+
List.iter
451
+
(fun (addr, exn) ->
452
+
assert_raises ~msg:addr exn (fun () -> V4.Prefix.of_string_exn addr))
453
+
bad_addrs
454
+
455
+
let test_hosts () =
456
+
let nets =
457
+
[
458
+
("255.255.255.255/32", [ "255.255.255.255" ], false);
459
+
("255.255.255.255/32", [], true);
460
+
("255.255.255.254/31", [ "255.255.255.254"; "255.255.255.255" ], true);
461
+
("255.255.255.254/31", [ "255.255.255.254"; "255.255.255.255" ], false);
462
+
("255.255.255.252/30", [ "255.255.255.253"; "255.255.255.254" ], true);
463
+
( "255.255.255.252/30",
464
+
[
465
+
"255.255.255.252";
466
+
"255.255.255.253";
467
+
"255.255.255.254";
468
+
"255.255.255.255";
469
+
],
470
+
false );
471
+
( "192.0.2.0/29",
472
+
[
473
+
"192.0.2.0";
474
+
"192.0.2.1";
475
+
"192.0.2.2";
476
+
"192.0.2.3";
477
+
"192.0.2.4";
478
+
"192.0.2.5";
479
+
"192.0.2.6";
480
+
"192.0.2.7";
481
+
],
482
+
false );
483
+
( "192.0.2.0/29",
484
+
[
485
+
"192.0.2.1";
486
+
"192.0.2.2";
487
+
"192.0.2.3";
488
+
"192.0.2.4";
489
+
"192.0.2.5";
490
+
"192.0.2.6";
491
+
],
492
+
true );
493
+
]
494
+
in
495
+
List.iter
496
+
(fun (net, hosts, usable_flag) ->
497
+
let hosts = List.map V4.of_string_exn hosts in
498
+
let hosts_list =
499
+
List.of_seq
500
+
(V4.Prefix.hosts ~usable:usable_flag (V4.Prefix.of_string_exn net))
501
+
in
502
+
let msg =
503
+
Printf.sprintf
504
+
"incorrect sequence of hosts for %s (usable_flag: %b): %s" net
505
+
usable_flag
506
+
(string_of_list V4.to_string hosts_list)
507
+
in
508
+
assert_equal ~msg hosts_list hosts)
509
+
nets
510
+
511
+
let test_subnets () =
512
+
let nets =
513
+
[
514
+
("255.255.255.255/32", [], 24);
515
+
("192.0.2.0/24", [], 23);
516
+
("255.255.255.255/32", [ "255.255.255.255/32" ], 32);
517
+
( "255.255.255.254/31",
518
+
[ "255.255.255.254/32"; "255.255.255.255/32" ],
519
+
32 );
520
+
( "255.255.255.252/30",
521
+
[ "255.255.255.252/31"; "255.255.255.254/31" ],
522
+
31 );
523
+
("192.0.2.0/29", [ "192.0.2.0/30"; "192.0.2.4/30" ], 30);
524
+
("192.0.2.0/24", [ "192.0.2.0/25"; "192.0.2.128/25" ], 25);
525
+
("192.0.2.0/24", [ "192.0.2.0/24" ], 24);
526
+
("10.0.0.0/8", [ "10.0.0.0/9"; "10.128.0.0/9" ], 9);
527
+
]
528
+
in
529
+
List.iter
530
+
(fun (net, subnets, sz) ->
531
+
let subnets = List.map V4.Prefix.of_string_exn subnets in
532
+
let subnets_list =
533
+
List.of_seq (V4.Prefix.subnets sz (V4.Prefix.of_string_exn net))
534
+
in
535
+
let msg =
536
+
Printf.sprintf
537
+
"incorrect sequence of subnets for %s (prefix length: %i): %s" net
538
+
sz
539
+
(string_of_list V4.Prefix.to_string subnets_list)
540
+
in
541
+
assert_equal ~msg subnets_list subnets)
542
+
nets
543
+
544
+
let suite =
545
+
"Test V4"
546
+
>::: [
547
+
"string_rt" >:: test_string_rt;
548
+
"string_rt_bad" >:: test_string_rt_bad;
549
+
"string_raw_rt" >:: test_string_raw_rt;
550
+
"string_raw_rt_bad" >:: test_string_raw_rt_bad;
551
+
"bytes_rt" >:: test_bytes_rt;
552
+
"bytes_rt_bad" >:: test_bytes_rt_bad;
553
+
"cstruct_rt" >:: test_cstruct_rt;
554
+
"cstruct_rt_bad" >:: test_cstruct_rt_bad;
555
+
"int32_rt" >:: test_int32_rt;
556
+
"prefix_string_rt" >:: test_prefix_string_rt;
557
+
"prefix_string_rt_bad" >:: test_prefix_string_rt_bad;
558
+
"network_address_rt" >:: test_network_address_rt;
559
+
"prefix_broadcast" >:: test_prefix_broadcast;
560
+
"prefix_bits" >:: test_prefix_bits;
561
+
"prefix_netmask" >:: test_prefix_netmask;
562
+
"prefix_netmask_bad" >:: test_prefix_netmask_bad;
563
+
"scope" >:: test_scope;
564
+
"map" >:: test_map;
565
+
"prefix_map" >:: test_prefix_map;
566
+
"special_addr" >:: test_special_addr;
567
+
"multicast_mac" >:: test_multicast_mac;
568
+
"domain_name" >:: test_domain_name;
569
+
"prefix_mem" >:: test_prefix_mem;
570
+
"succ_pred" >:: test_succ_pred;
571
+
"prefix_first_last" >:: test_prefix_first_last;
572
+
"reject_octal" >:: test_reject_octal;
573
+
"reject_prefix_octal" >:: test_reject_prefix_octal;
574
+
"hosts" >:: test_hosts;
575
+
"subnets" >:: test_subnets;
576
+
]
577
+
end
578
+
579
+
module Test_v6 = struct
580
+
let test_string_rt () =
581
+
let addrs =
582
+
[
583
+
("2001:db8::ff00:42:8329", "2001:db8::ff00:42:8329");
584
+
("::ffff:192.168.1.1", "::ffff:192.168.1.1");
585
+
("::", "::");
586
+
("[::]", "::");
587
+
("1:1:1:1::1:1:1", "1:1:1:1:0:1:1:1");
588
+
("0:0:0:1:1:0:0:0", "::1:1:0:0:0");
589
+
("0:0:0:1:1::", "::1:1:0:0:0");
590
+
("::1:0:0:0:0", "0:0:0:1::");
591
+
("FE80::", "fe80::");
592
+
("::192.168.0.1", "::c0a8:1");
593
+
]
594
+
in
595
+
List.iter
596
+
(fun (addr, rt) ->
597
+
let os = V6.of_string_exn addr in
598
+
let ts = V6.to_string os in
599
+
assert_equal ~msg:(addr ^ " <> " ^ rt ^ " (" ^ ts ^ ")") ts rt;
600
+
let os = Ipaddr_sexp.(V6.t_of_sexp (V6.sexp_of_t os)) in
601
+
let ts = V6.to_string os in
602
+
assert_equal ~msg:(addr ^ " <> " ^ rt ^ " (" ^ ts ^ ")") ts rt)
603
+
addrs
604
+
605
+
let test_string_rt_bad () =
606
+
let addrs =
607
+
[
608
+
need_more "[";
609
+
need_more "[:";
610
+
need_more "[]";
611
+
(* ? *)
612
+
need_more ":";
613
+
need_more "[::";
614
+
bad_char 4 "::1:g:f";
615
+
bad_char 3 "::1::";
616
+
bad_char 4 "1::2::3";
617
+
need_more "1:2:3:4:5:6:7";
618
+
bad_char 15 "1:2:3:4:5:6:7:8:9";
619
+
bad_char 15 "1:2:3:4:5:6:7:8::";
620
+
error "12345::12:2" "component 0 out of bounds";
621
+
bad_char 1 ":1";
622
+
]
623
+
in
624
+
List.iter
625
+
(fun (addr, exn) ->
626
+
assert_raises ~msg:addr exn (fun () -> V6.of_string_exn addr))
627
+
addrs
628
+
629
+
let test_string_raw_rt () =
630
+
let addrs =
631
+
[
632
+
(("IP: 2001:db8::ff00:42:8329!", 4), ("2001:db8::ff00:42:8329", 26));
633
+
(("IP: ::ffff:192.168.1.1 ", 4), ("::ffff:192.168.1.1", 22));
634
+
(("IP: :::", 4), ("::", 6));
635
+
(("IP: [::]:", 4), ("::", 8));
636
+
(("IP: 1:1:1:1::1:1:1:1", 4), ("1:1:1:1:0:1:1:1", 18));
637
+
(("IP: ::1:1:0:0:0::g", 4), ("::1:1:0:0:0", 15));
638
+
]
639
+
in
640
+
List.iter
641
+
(fun ((addr, off), (result, cursor)) ->
642
+
let c = ref off in
643
+
let os = V6.of_string_raw addr c in
644
+
let ts = V6.to_string os in
645
+
let msg =
646
+
Printf.sprintf "%s at %d: %s at %d <> %s at %d" addr off result cursor
647
+
ts !c
648
+
in
649
+
assert_equal ~msg (ts, !c) (result, cursor))
650
+
addrs
651
+
652
+
let test_string_raw_rt_bad () =
653
+
let error (s, c) msg c' = ((s, c), (Parse_error (msg, s), c')) in
654
+
let need_more loc = error loc "not enough data" in
655
+
let bad_char i (s, c) =
656
+
error (s, c) (Printf.sprintf "invalid character '%c' at %d" s.[i] i) i
657
+
in
658
+
let addrs =
659
+
[
660
+
need_more ("IP: [] ", 4) 5;
661
+
bad_char 5 ("IP: : ", 4);
662
+
bad_char 7 ("IP: [:: ", 4);
663
+
bad_char 17 ("IP: 1:2:3:4:5:6:7 ", 4);
664
+
error ("IP: 12345::12:2 ", 4) "component 0 out of bounds" 15;
665
+
bad_char 5 ("IP: :1 ", 4);
666
+
need_more ("IP: ::1:1:0:0:0:", 4) 16;
667
+
bad_char 8 ("IP: ::1:g:f ", 4);
668
+
]
669
+
in
670
+
List.iter
671
+
(fun ((addr, off), (exn, cursor)) ->
672
+
let c = ref off in
673
+
assert_raises ~msg:addr exn (fun () -> V6.of_string_raw addr c);
674
+
assert_equal
675
+
~msg:(Printf.sprintf "%s cursor <> %d (%d)" addr cursor !c)
676
+
!c cursor)
677
+
addrs
678
+
679
+
let test_bytes_rt () =
680
+
let addr =
681
+
"\000\000\000\000\000\000\000\000\000\000\255\255\192\168\000\001"
682
+
in
683
+
let v6 = V6.of_octets_exn addr in
684
+
assert_equal ~printer:String.escaped ~msg:(String.escaped addr)
685
+
V6.(to_octets v6)
686
+
addr
687
+
688
+
let test_bytes_rt_bad () =
689
+
let addrs =
690
+
[
691
+
need_more "\000\000\000\000\000\000\000\000\000\000\255\255\192\168\001";
692
+
]
693
+
in
694
+
List.iter
695
+
(fun (addr, exn) ->
696
+
assert_raises ~msg:(String.escaped addr) exn (fun () ->
697
+
V6.of_octets_exn addr))
698
+
addrs
699
+
700
+
let test_cstruct_rt () =
701
+
let addr =
702
+
"\000\000\000\000\000\000\000\000\000\000\255\255\192\168\000\001"
703
+
in
704
+
let v6 = Ipaddr_cstruct.V6.of_cstruct_exn (Cstruct.of_string addr) in
705
+
assert_equal ~msg:(String.escaped addr)
706
+
(Cstruct.to_string Ipaddr_cstruct.V6.(to_cstruct v6))
707
+
addr
708
+
709
+
let test_cstruct_rt_bad () =
710
+
let addrs =
711
+
[
712
+
need_more "\000\000\000\000\000\000\000\000\000\000\255\255\192\168\001";
713
+
]
714
+
in
715
+
List.iter
716
+
(fun (addr, exn) ->
717
+
assert_raises ~msg:(String.escaped addr) exn (fun () ->
718
+
Ipaddr_cstruct.V6.of_cstruct_exn (Cstruct.of_string addr)))
719
+
addrs
720
+
721
+
let test_int32_rt () =
722
+
let ((a, b, c, d) as addr) =
723
+
(0x2001_0665_l, 0x0000_0000_l, 0xff00_00ff_l, 0xfe00_0001_l)
724
+
in
725
+
assert_equal
726
+
~msg:(Printf.sprintf "%08lx %08lx %08lx %08lx" a b c d)
727
+
V6.(to_int32 (of_int32 addr))
728
+
addr
729
+
730
+
let test_int64_rt () =
731
+
let tests =
732
+
[
733
+
(0x2a01_04f9_c011_87adL, 0x0_0_0_0L);
734
+
(0x0000_0000_8000_0000L, 0x0_0_0_0L);
735
+
]
736
+
in
737
+
List.iter
738
+
(fun ((a, b) as addr) ->
739
+
assert_equal
740
+
~msg:(Printf.sprintf "%016Lx %016Lx" a b)
741
+
V6.(to_int64 (of_int64 addr))
742
+
addr)
743
+
tests
744
+
745
+
let test_prefix_string_rt () =
746
+
let subnets =
747
+
[
748
+
("2000::/3", "2000::/3");
749
+
("c012::/2", "c000::/2");
750
+
("ffff:ffff:ffff::ffff/0", "::/0");
751
+
("::/0", "::/0");
752
+
("::/128", "::/128");
753
+
("::1/128", "::1/128");
754
+
("::/64", "::/64");
755
+
("[::]/64", "::/64");
756
+
]
757
+
in
758
+
List.iter
759
+
(fun (subnet, rt) ->
760
+
let os = V6.Prefix.of_string_exn subnet |> V6.Prefix.prefix in
761
+
let ts = V6.Prefix.to_string os in
762
+
assert_equal ~msg:subnet ts rt;
763
+
let os = Ipaddr_sexp.(V6.Prefix.(t_of_sexp (sexp_of_t os))) in
764
+
let ts = V6.Prefix.to_string os in
765
+
assert_equal ~msg:subnet ts rt)
766
+
subnets
767
+
768
+
let test_prefix_string_rt_bad () =
769
+
let subnets =
770
+
[
771
+
need_more "/24";
772
+
need_more "::";
773
+
error "::/130" "invalid prefix size";
774
+
bad_char 5 "::/30/1";
775
+
bad_char 7 "2000::/-1";
776
+
bad_char 5 "1::3:/4";
777
+
]
778
+
in
779
+
List.iter
780
+
(fun (subnet, exn) ->
781
+
assert_raises ~msg:subnet exn (fun () -> V6.Prefix.of_string_exn subnet))
782
+
subnets
783
+
784
+
let test_network_address_rt () =
785
+
let netaddrs = [ ("::1/24", "::/24", "::1") ] in
786
+
List.iter
787
+
(fun (netaddr, net, addr) ->
788
+
let netv4 = V6.Prefix.of_string_exn net in
789
+
let addrv4 = V6.of_string_exn addr in
790
+
let cidr = V6.Prefix.of_string_exn netaddr in
791
+
let prefix = V6.Prefix.prefix cidr and v4 = V6.Prefix.address cidr in
792
+
let prefix = V6.Prefix.prefix prefix in
793
+
assert_equal
794
+
~msg:(net ^ " <> " ^ V6.Prefix.to_string prefix)
795
+
netv4 prefix;
796
+
assert_equal ~msg:(addr ^ " <> " ^ V6.to_string v4) addrv4 v4;
797
+
let addrstr = V6.Prefix.to_string cidr in
798
+
assert_equal ~msg:(netaddr ^ " <> " ^ addrstr) netaddr addrstr)
799
+
netaddrs
800
+
801
+
let test_prefix_bits () =
802
+
let pairs =
803
+
V6.Prefix.
804
+
[
805
+
(global_unicast_001, 3);
806
+
(link, 64);
807
+
(unique_local, 7);
808
+
(multicast, 8);
809
+
(ipv4_mapped, 96);
810
+
(noneui64_interface, 3);
811
+
]
812
+
in
813
+
List.iter
814
+
(fun (subnet, bits) ->
815
+
let msg =
816
+
V6.Prefix.to_string subnet ^ " <> bits " ^ string_of_int bits
817
+
in
818
+
assert_equal ~msg (V6.Prefix.bits subnet) bits)
819
+
pairs
820
+
821
+
let test_prefix_netmask () =
822
+
let nets =
823
+
[
824
+
("8::1/128", "ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff");
825
+
("8::1/127", "ffff:ffff:ffff:ffff:ffff:ffff:ffff:fffe");
826
+
("8::1/96", "ffff:ffff:ffff:ffff:ffff:ffff::");
827
+
("8::1/64", "ffff:ffff:ffff:ffff::");
828
+
("8::1/32", "ffff:ffff::");
829
+
("8::1/1", "8000::");
830
+
("8::1/0", "::");
831
+
]
832
+
in
833
+
List.iter
834
+
(fun (net_str, nm_str) ->
835
+
let cidr = V6.Prefix.of_string_exn net_str in
836
+
let prefix = V6.Prefix.prefix cidr
837
+
and address = V6.Prefix.address cidr in
838
+
let netmask = V6.Prefix.netmask prefix in
839
+
let nnm_str = V6.to_string netmask in
840
+
let msg = Printf.sprintf "netmask %s <> %s" nnm_str nm_str in
841
+
assert_equal ~msg nnm_str nm_str;
842
+
let prefix = V6.Prefix.of_netmask_exn ~netmask ~address in
843
+
let nns = V6.Prefix.to_string prefix in
844
+
let msg = Printf.sprintf "%s is %s under netmask iso" net_str nns in
845
+
assert_equal ~msg net_str nns)
846
+
nets
847
+
848
+
let test_prefix_netmask_bad () =
849
+
let bad_masks =
850
+
[
851
+
error "7fff:ffff:ffff:ffff:ffff:ffff:ffff:ffff" "invalid netmask";
852
+
error "ffff:ffff:ffff:ffff:ffff:fffe:8000:0" "invalid netmask";
853
+
error "ffff:ffff:ffff:fffe:8000::" "invalid netmask";
854
+
error "ffff:fffe:8000::" "invalid netmask";
855
+
]
856
+
in
857
+
List.iter
858
+
(fun (nm_str, exn) ->
859
+
let netmask = V6.of_string_exn nm_str in
860
+
let address = V6.of_string_exn "::" in
861
+
assert_raises ~msg:nm_str exn (fun () ->
862
+
V6.Prefix.of_netmask_exn ~netmask ~address))
863
+
bad_masks
864
+
865
+
let test_scope () =
866
+
let localhost_v4 = V6.of_string_exn "::ffff:127.0.0.1" in
867
+
let is subnet addr = V6.Prefix.(mem addr subnet) in
868
+
let is_scope scop addr = scop = V6.scope addr in
869
+
let ships =
870
+
V6.
871
+
[
872
+
(unspecified, "global", is_global, false);
873
+
(unspecified, "multicast", is_multicast, false);
874
+
(unspecified, "point", is_scope Point, true);
875
+
(localhost, "global", is_global, false);
876
+
(localhost, "multicast", is_multicast, false);
877
+
(localhost, "interface", is_scope Interface, true);
878
+
(interface_nodes, "global", is_global, false);
879
+
(interface_nodes, "multicast", is_multicast, true);
880
+
(interface_nodes, "interface", is_scope Interface, true);
881
+
(link_nodes, "global", is_global, false);
882
+
(link_nodes, "multicast", is_multicast, true);
883
+
(link_nodes, "link", is_scope Link, true);
884
+
(link_routers, "global", is_global, false);
885
+
(link_routers, "multicast", is_multicast, true);
886
+
(link_routers, "link", is_scope Link, true);
887
+
(localhost_v4, "global", is_global, false);
888
+
(localhost_v4, "multicast", is_multicast, false);
889
+
(localhost_v4, "ipv4", is Prefix.ipv4_mapped, true);
890
+
(localhost_v4, "noneui64", is Prefix.noneui64_interface, true);
891
+
(localhost_v4, "global_001", is Prefix.global_unicast_001, false);
892
+
(localhost_v4, "interface", is_scope Interface, true);
893
+
]
894
+
in
895
+
List.iter
896
+
(fun (addr, lbl, pred, is_mem) ->
897
+
let mems = if is_mem then "" else " not" in
898
+
let msg = V6.to_string addr ^ " is" ^ mems ^ " in " ^ lbl in
899
+
assert_equal ~msg (pred addr) is_mem)
900
+
ships
901
+
902
+
let test_map () =
903
+
let maxs = "ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff" in
904
+
let m = V6.Map.add (V6.of_string_exn "::0:0") "min" V6.Map.empty in
905
+
let m = V6.Map.add (V6.of_string_exn maxs) "the greatest host" m in
906
+
let m = V6.Map.add (V6.of_string_exn "::") "the least host" m in
907
+
assert_equal ~msg:"size" (V6.Map.cardinal m) 2;
908
+
let min_key, min_val = V6.Map.min_binding m in
909
+
assert_equal
910
+
~msg:("min is '" ^ min_val ^ "'")
911
+
(min_key, min_val)
912
+
(V6.of_string_exn "::0:0:0", "the least host");
913
+
assert_equal ~msg:"max" (V6.Map.max_binding m)
914
+
(V6.of_string_exn maxs, "the greatest host")
915
+
916
+
let test_prefix_map () =
917
+
let module M = Stdlib.Map.Make (V6.Prefix) in
918
+
let of_string s = s |> V6.Prefix.of_string_exn |> V6.Prefix.prefix in
919
+
let m = M.add (of_string "::ffff:0.0.0.0/0") "everyone" M.empty in
920
+
let m = M.add (of_string "::ffff:192.0.0.0/1") "weirdos" m in
921
+
let m = M.add (of_string "::ffff:128.0.0.0/1") "high-bitters" m in
922
+
let m = M.add (of_string "::ffff:254.0.0.0/8") "top-end" m in
923
+
let m = M.add (of_string "::ffff:0.0.0.0/0") "iana" m in
924
+
assert_equal ~msg:"size" (M.cardinal m) 3;
925
+
assert_equal ~msg:"min" (M.min_binding m)
926
+
(of_string "::ffff:0.0.0.0/0", "iana");
927
+
assert_equal ~msg:"max" (M.max_binding m)
928
+
(of_string "::ffff:254.0.0.0/8", "top-end");
929
+
assert_equal ~msg:"third"
930
+
(M.find (of_string "::ffff:128.0.0.0/1") m)
931
+
"high-bitters"
932
+
933
+
let test_multicast_mac () =
934
+
let on = 0xFFFF in
935
+
let ip = V6.make on on on on on 0xFFFF 0xFEFE 0xFDFD in
936
+
let unicast = V6.Prefix.(network_address global_unicast_001 ip) in
937
+
let multicast = V6.Prefix.(network_address multicast ip) in
938
+
let unicast_mac_str = Macaddr.to_string (V6.multicast_to_mac unicast) in
939
+
let multicast_mac_str = Macaddr.to_string (V6.multicast_to_mac multicast) in
940
+
let mac_str = "33:33:fe:fe:fd:fd" in
941
+
assert_equal
942
+
~msg:("unicast_mac " ^ unicast_mac_str ^ " <> " ^ mac_str)
943
+
unicast_mac_str mac_str;
944
+
assert_equal
945
+
~msg:("multicast_mac " ^ multicast_mac_str ^ " <> " ^ mac_str)
946
+
multicast_mac_str mac_str
947
+
948
+
let test_domain_name () =
949
+
let ip = V6.of_string_exn "2a00:1450:4009:800::200e" in
950
+
let name =
951
+
"e.0.0.2.0.0.0.0.0.0.0.0.0.0.0.0.0.0.8.0.9.0.0.4.0.5.4.1.0.0.a.2.ip6.arpa"
952
+
in
953
+
let name = Domain_name.(host_exn (of_string_exn name)) in
954
+
assert_equal ~cmp:Domain_name.equal ~msg:"to_domain_name"
955
+
(V6.to_domain_name ip) name;
956
+
assert_equal ~msg:"of_domain_name" (V6.of_domain_name name) (Some ip)
957
+
958
+
let test_link_address_of_mac () =
959
+
let mac = Macaddr.of_string_exn "34-56-78-9A-BC-DE" in
960
+
let ip_str = V6.(to_string (link_address_of_mac mac)) in
961
+
let expected = "fe80::3656:78ff:fe9a:bcde" in
962
+
assert_equal
963
+
~msg:("link_address_of_mac " ^ ip_str ^ " <> " ^ expected)
964
+
ip_str expected
965
+
966
+
let test_succ_pred () =
967
+
let open V6 in
968
+
let printer = function
969
+
| Ok v -> Printf.sprintf "Ok %s" (V6.to_string v)
970
+
| Error (`Msg e) -> Printf.sprintf "Error `Msg \"%s\"" e
971
+
in
972
+
let assert_equal = assert_equal ~printer in
973
+
let ip1 = of_string_exn "::" in
974
+
let ip2 = of_string_exn "ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff" in
975
+
let ip3 = of_string_exn "::2" in
976
+
assert_equal ~msg:"succ ::" (of_string "::1") (succ ip1);
977
+
assert_equal ~msg:"succ (succ ::)" (of_string "::2") (succ ip1 >>= succ);
978
+
assert_equal ~msg:"succ ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff"
979
+
(Error (`Msg "Ipaddr: highest address has been reached"))
980
+
(succ ip2);
981
+
assert_equal ~msg:"pred ::2" (of_string "::1") (pred ip3);
982
+
assert_equal ~msg:"pred ::ffff:ffff" (of_string "::ffff:fffd")
983
+
(of_string "::ffff:ffff" >>= pred >>= pred);
984
+
assert_equal ~msg:"pred ::"
985
+
(Error (`Msg "Ipaddr: lowest address has been reached"))
986
+
(pred ip1);
987
+
assert_equal ~msg:"pred (succ ::2)" (Ok ip3) (succ ip3 >>= pred)
988
+
989
+
let test_first_last () =
990
+
let open V6 in
991
+
let open Prefix in
992
+
let ip_of_string = V6.of_string_exn in
993
+
let assert_equal = assert_equal ~printer:V6.to_string in
994
+
assert_equal ~msg:"first ::/64" (ip_of_string "::1")
995
+
(first @@ of_string_exn "::/64");
996
+
assert_equal ~msg:"first ::ff00/120" (ip_of_string "::ff01")
997
+
(first @@ of_string_exn "::ff00/120");
998
+
assert_equal ~msg:"first ::aaa0/127" (ip_of_string "::aaa0")
999
+
(first @@ of_string_exn "::aaa0/127");
1000
+
assert_equal ~msg:"first ::aaa0/128" (ip_of_string "::aaa0")
1001
+
(first @@ of_string_exn "::aaa0/128");
1002
+
assert_equal ~msg:"last ::/64"
1003
+
(ip_of_string "::ffff:ffff:ffff:ffff")
1004
+
(last @@ of_string_exn "::/64");
1005
+
assert_equal ~msg:"last ::/120" (ip_of_string "::ff")
1006
+
(last @@ of_string_exn "::/120");
1007
+
assert_equal ~msg:"last ::/112" (ip_of_string "::ffff")
1008
+
(last @@ of_string_exn "::/112");
1009
+
assert_equal ~msg:"last ::bbbb:eeee:0000:0000/64"
1010
+
(ip_of_string "::ffff:ffff:ffff:ffff")
1011
+
(last @@ of_string_exn "::bbbb:eeee:0000:0000/64");
1012
+
assert_equal ~msg:"last ::aaa0/127" (ip_of_string "::aaa1")
1013
+
(last @@ of_string_exn "::aaa0/127");
1014
+
assert_equal ~msg:"last ::aaa0/128" (ip_of_string "::aaa0")
1015
+
(last @@ of_string_exn "::aaa0/128")
1016
+
1017
+
let test_hosts () =
1018
+
let nets =
1019
+
[
1020
+
("2001:db8:0:ffff::/128", [ "2001:db8:0:ffff::" ], false);
1021
+
("2001:db8:0:ffff::/128", [], true);
1022
+
( "2001:db8:0:ffff::/127",
1023
+
[ "2001:db8:0:ffff::"; "2001:db8:0:ffff::1" ],
1024
+
false );
1025
+
( "2001:db8:0:ffff::/127",
1026
+
[ "2001:db8:0:ffff::"; "2001:db8:0:ffff::1" ],
1027
+
true );
1028
+
( "2001:db8:0:ffff::/126",
1029
+
[
1030
+
"2001:db8:0:ffff::";
1031
+
"2001:db8:0:ffff::1";
1032
+
"2001:db8:0:ffff::2";
1033
+
"2001:db8:0:ffff::3";
1034
+
],
1035
+
false );
1036
+
( "2001:db8:0:ffff::/126",
1037
+
[ "2001:db8:0:ffff::1"; "2001:db8:0:ffff::2"; "2001:db8:0:ffff::3" ],
1038
+
true );
1039
+
]
1040
+
in
1041
+
List.iter
1042
+
(fun (net, hosts, usable_flag) ->
1043
+
let hosts = List.map V6.of_string_exn hosts in
1044
+
let hosts_list =
1045
+
List.of_seq
1046
+
(V6.Prefix.hosts ~usable:usable_flag (V6.Prefix.of_string_exn net))
1047
+
in
1048
+
let msg =
1049
+
Printf.sprintf
1050
+
"incorrect sequence of hosts for %s (usable_flag: %b): %s" net
1051
+
usable_flag
1052
+
(string_of_list V6.to_string hosts_list)
1053
+
in
1054
+
assert_equal ~msg hosts_list hosts)
1055
+
nets
1056
+
1057
+
let test_subnets () =
1058
+
let nets =
1059
+
[
1060
+
("2001:db8:0:ffff::/128", [], 127);
1061
+
("2001:db8:0:ffff::/64", [], 63);
1062
+
("2001:db8:0:ffff::/128", [ "2001:db8:0:ffff::/128" ], 128);
1063
+
( "2001:db8:0:ffff::/127",
1064
+
[ "2001:db8:0:ffff::/128"; "2001:db8:0:ffff::1/128" ],
1065
+
128 );
1066
+
("::/0", [ "::/1"; "8000::/1" ], 1);
1067
+
("::/0", [ "::/2"; "4000::/2"; "8000::/2"; "c000::/2" ], 2);
1068
+
( "2001:db8:0:ffff::/126",
1069
+
[ "2001:db8:0:ffff::/127"; "2001:db8:0:ffff::2/127" ],
1070
+
127 );
1071
+
( "2001:db8:0:fff0::/60",
1072
+
[
1073
+
"2001:db8:0:fff0::/64";
1074
+
"2001:db8:0:fff1::/64";
1075
+
"2001:db8:0:fff2::/64";
1076
+
"2001:db8:0:fff3::/64";
1077
+
"2001:db8:0:fff4::/64";
1078
+
"2001:db8:0:fff5::/64";
1079
+
"2001:db8:0:fff6::/64";
1080
+
"2001:db8:0:fff7::/64";
1081
+
"2001:db8:0:fff8::/64";
1082
+
"2001:db8:0:fff9::/64";
1083
+
"2001:db8:0:fffa::/64";
1084
+
"2001:db8:0:fffb::/64";
1085
+
"2001:db8:0:fffc::/64";
1086
+
"2001:db8:0:fffd::/64";
1087
+
"2001:db8:0:fffe::/64";
1088
+
"2001:db8:0:ffff::/64";
1089
+
],
1090
+
64 );
1091
+
]
1092
+
in
1093
+
List.iter
1094
+
(fun (net, subnets, sz) ->
1095
+
let subnets = List.map V6.Prefix.of_string_exn subnets in
1096
+
let subnets_list =
1097
+
List.of_seq (V6.Prefix.subnets sz (V6.Prefix.of_string_exn net))
1098
+
in
1099
+
let msg =
1100
+
Printf.sprintf
1101
+
"incorrect sequence of subnets for %s (prefix length: %i): %s" net
1102
+
sz
1103
+
(string_of_list V6.Prefix.to_string subnets_list)
1104
+
in
1105
+
assert_equal ~msg subnets_list subnets)
1106
+
nets
1107
+
1108
+
let suite =
1109
+
"Test V6"
1110
+
>::: [
1111
+
"string_rt" >:: test_string_rt;
1112
+
"string_rt_bad" >:: test_string_rt_bad;
1113
+
"string_raw_rt" >:: test_string_raw_rt;
1114
+
"string_raw_rt_bad" >:: test_string_raw_rt_bad;
1115
+
"bytes_rt" >:: test_bytes_rt;
1116
+
"bytes_rt_bad" >:: test_bytes_rt_bad;
1117
+
"cstruct_rt" >:: test_cstruct_rt;
1118
+
"cstruct_rt_bad" >:: test_cstruct_rt_bad;
1119
+
"int32_rt" >:: test_int32_rt;
1120
+
"int64_rt" >:: test_int64_rt;
1121
+
"prefix_string_rt" >:: test_prefix_string_rt;
1122
+
"prefix_string_rt_bad" >:: test_prefix_string_rt_bad;
1123
+
"network_address_rt" >:: test_network_address_rt;
1124
+
"prefix_bits" >:: test_prefix_bits;
1125
+
"prefix_netmask" >:: test_prefix_netmask;
1126
+
"prefix_netmask_bad" >:: test_prefix_netmask_bad;
1127
+
"scope" >:: test_scope;
1128
+
"map" >:: test_map;
1129
+
"prefix_map" >:: test_prefix_map;
1130
+
"multicast_mac" >:: test_multicast_mac;
1131
+
"domain_name" >:: test_domain_name;
1132
+
"link_address_of_mac" >:: test_link_address_of_mac;
1133
+
"succ_pred" >:: test_succ_pred;
1134
+
"first_last" >:: test_first_last;
1135
+
"hosts" >:: test_hosts;
1136
+
"subnets" >:: test_subnets;
1137
+
]
1138
+
end
1139
+
1140
+
let test_string_raw_rt () =
1141
+
let addrs =
1142
+
[
1143
+
(("IP: 192.168.0.0!!", 4), ("192.168.0.0", 15));
1144
+
(("IP: 192:168:0::!!", 4), ("192:168::", 15));
1145
+
(("IP: [192:168::]!!", 4), ("192:168::", 15));
1146
+
]
1147
+
in
1148
+
List.iter
1149
+
(fun ((addr, off), (result, cursor)) ->
1150
+
let c = ref off in
1151
+
let os = of_string_raw addr c in
1152
+
let ts = to_string os in
1153
+
let msg =
1154
+
Printf.sprintf "%s at %d: %s at %d <> %s at %d" addr off result cursor
1155
+
ts !c
1156
+
in
1157
+
assert_equal ~msg (ts, !c) (result, cursor))
1158
+
addrs
1159
+
1160
+
let test_with_port_of_string () =
1161
+
let default = 8080 in
1162
+
let addrs =
1163
+
[
1164
+
("127.0.0.1", (Ipaddr.(V4 V4.localhost), default));
1165
+
("127.0.0.1:8080", (Ipaddr.(V4 V4.localhost), 8080));
1166
+
("127.0.0.1:4343", (Ipaddr.(V4 V4.localhost), 4343));
1167
+
("::1", (Ipaddr.(V6 V6.localhost), default));
1168
+
("0:0:0:0:0:0:0:1:8080", (Ipaddr.(V6 V6.localhost), 8080));
1169
+
("0:0:0:0:0:0:0:1:4343", (Ipaddr.(V6 V6.localhost), 4343));
1170
+
]
1171
+
in
1172
+
List.iter
1173
+
(fun (inet_addr, result) ->
1174
+
match Ipaddr.with_port_of_string ~default inet_addr with
1175
+
| Ok ((V4 ipv4, port) as result') ->
1176
+
let result'' = V4.with_port_of_string ~default inet_addr in
1177
+
let msg =
1178
+
Format.asprintf "%s <> %a:%d" inet_addr Ipaddr.V4.pp ipv4 port
1179
+
in
1180
+
assert_equal ~msg result result';
1181
+
assert_equal ~msg (Ok (ipv4, port)) result''
1182
+
| Ok ((V6 ipv6, port) as result') ->
1183
+
let result'' = V6.with_port_of_string ~default inet_addr in
1184
+
let msg =
1185
+
Format.asprintf "%s <> %a:%d" inet_addr Ipaddr.V6.pp ipv6 port
1186
+
in
1187
+
assert_equal ~msg result result';
1188
+
assert_equal ~msg (Ok (ipv6, port)) result''
1189
+
| Error (`Msg err) ->
1190
+
assert_failure (Format.asprintf "%s: %s" inet_addr err))
1191
+
addrs
1192
+
1193
+
let test_invalid_with_port_of_string () =
1194
+
let default = 8080 in
1195
+
let addrs =
1196
+
[
1197
+
"127.0.0.1:"; "127.0.0.1!8080"; "0:0:0:0:0:0:0:1!8080"; "0:0:0:0:0:0:0:1:";
1198
+
]
1199
+
in
1200
+
List.iter
1201
+
(fun inet_addr ->
1202
+
match
1203
+
( Ipaddr.with_port_of_string ~default inet_addr,
1204
+
Ipaddr.V4.with_port_of_string ~default inet_addr,
1205
+
Ipaddr.V4.with_port_of_string ~default inet_addr )
1206
+
with
1207
+
| Error _, Error _, Error _ -> ()
1208
+
| _ ->
1209
+
assert_failure
1210
+
(Format.asprintf "Unexpected valid inet_addr: %S" inet_addr))
1211
+
addrs
1212
+
1213
+
let test_string_raw_rt_bad () =
1214
+
let error (s, c) msg c' = ((s, c), (Parse_error (msg, s), c')) in
1215
+
let addrs =
1216
+
[
1217
+
error ("IP: ::192.168 ", 4)
1218
+
"not an IPv4 address: invalid character ':' at 4\n\
1219
+
not an IPv6 address: invalid character ' ' at 13" 13;
1220
+
error ("IP: [::192.168] ", 4)
1221
+
"not an IPv4 address: invalid character '[' at 4\n\
1222
+
not an IPv6 address: invalid character ']' at 14" 14;
1223
+
(* ? *)
1224
+
error ("IP: 192:168::3.5 ", 4)
1225
+
"not an IPv4 address: invalid character ':' at 7\n\
1226
+
not an IPv6 address: invalid character ' ' at 16" 16;
1227
+
]
1228
+
in
1229
+
List.iter
1230
+
(fun ((addr, off), (exn, cursor)) ->
1231
+
let c = ref off in
1232
+
assert_raises ~msg:addr exn (fun () -> of_string_raw addr c);
1233
+
assert_equal
1234
+
~msg:(Printf.sprintf "%s cursor <> %d (%d)" addr cursor !c)
1235
+
!c cursor)
1236
+
addrs
1237
+
1238
+
let test_map () =
1239
+
let maxv6 = "ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff" in
1240
+
let maxv4 = "254.254.254.254" in
1241
+
let m = Map.add (of_string_exn maxv4) "the greatest host v4" Map.empty in
1242
+
let m = Map.add (of_string_exn "::0:0") "minv6" m in
1243
+
let m = Map.add (of_string_exn maxv6) "the greatest host v6" m in
1244
+
let m = Map.add (of_string_exn "::") "the least host v6" m in
1245
+
let m = Map.add (of_string_exn "1.0.0.1") "minv4" m in
1246
+
let m = Map.add (of_string_exn "1.0.0.1") "the least host v4" m in
1247
+
assert_equal ~msg:"size" (Map.cardinal m) 4;
1248
+
let min_key, min_val = Map.min_binding m in
1249
+
assert_equal
1250
+
~msg:("min is '" ^ min_val ^ "'")
1251
+
(min_key, min_val)
1252
+
(of_string_exn "1.0.0.1", "the least host v4");
1253
+
assert_equal ~msg:"max" (Map.max_binding m)
1254
+
(of_string_exn maxv6, "the greatest host v6")
1255
+
1256
+
let test_prefix_mem () =
1257
+
let ip = of_string_exn in
1258
+
let ships =
1259
+
[
1260
+
(ip "192.168.0.1", V4 V4.Prefix.private_192, true);
1261
+
(ip "192.168.0.1", Prefix.of_string_exn "::ffff:0:0/96", true);
1262
+
(ip "192.168.0.1", Prefix.of_string_exn "::ffff:0:0/95", true);
1263
+
(ip "192.168.0.1", Prefix.of_string_exn "::ffff:0:0/97", false);
1264
+
(ip "192.168.0.1", Prefix.of_string_exn "::ffff:128.0.0.0/97", true);
1265
+
(ip "::ffff:10.0.0.1", V4 V4.Prefix.private_10, true);
1266
+
(ip "::fffe:10.0.0.1", V4 V4.Prefix.private_10, false);
1267
+
]
1268
+
in
1269
+
List.iter
1270
+
(fun (addr, subnet, is_mem) ->
1271
+
let msg =
1272
+
Printf.sprintf "%s is%s in %s" (to_string addr)
1273
+
(if is_mem then "" else " not")
1274
+
(Prefix.to_string subnet)
1275
+
in
1276
+
assert_equal ~msg (Prefix.mem addr subnet) is_mem)
1277
+
ships
1278
+
1279
+
let test_prefix_subset () =
1280
+
let pre = Prefix.of_string_exn in
1281
+
let ships =
1282
+
[
1283
+
(pre "10.0.0.1/32", pre "10.0.0.1/32", true);
1284
+
(pre "10.0.0.1/32", pre "10.0.0.2/32", false);
1285
+
(pre "10.0.0.3/32", pre "10.0.0.2/31", true);
1286
+
(pre "10.0.0.2/31", pre "10.0.0.3/32", false);
1287
+
(pre "10.0.10.0/24", V4 V4.Prefix.private_10, true);
1288
+
(V4 V4.Prefix.private_10, pre "10.0.10.0/24", false);
1289
+
]
1290
+
in
1291
+
List.iter
1292
+
(fun (subnet1, subnet2, is_subset) ->
1293
+
let msg =
1294
+
Printf.sprintf "%s is%s subset of %s" (Prefix.to_string subnet1)
1295
+
(if is_subset then "" else " not")
1296
+
(Prefix.to_string subnet2)
1297
+
in
1298
+
assert_equal ~msg
1299
+
(Prefix.subset ~subnet:subnet1 ~network:subnet2)
1300
+
is_subset)
1301
+
ships
1302
+
1303
+
let suite =
1304
+
"Test Generic Addresses"
1305
+
>::: [
1306
+
"string_raw_rt" >:: test_string_raw_rt;
1307
+
"string_raw_rt_bad" >:: test_string_raw_rt_bad;
1308
+
"map" >:: test_map;
1309
+
"prefix_mem" >:: test_prefix_mem;
1310
+
"prefix_subset" >:: test_prefix_subset;
1311
+
"with_port" >:: test_with_port_of_string;
1312
+
"invalid_with_port" >:: test_invalid_with_port_of_string;
1313
+
]
1314
+
;;
1315
+
1316
+
let _results = run_test_tt_main Test_v4.suite in
1317
+
let _results = run_test_tt_main Test_v6.suite in
1318
+
let _results = run_test_tt_main suite in
1319
+
()
+199
vendor/opam/ipaddr/lib_test/test_ipaddr_b128.ml
+199
vendor/opam/ipaddr/lib_test/test_ipaddr_b128.ml
···
1
+
(*
2
+
* Copyright (c) 2013-2014 David Sheets <sheets@alum.mit.edu>
3
+
*
4
+
* Permission to use, copy, modify, and distribute this software for any
5
+
* purpose with or without fee is hereby granted, provided that the above
6
+
* copyright notice and this permission notice appear in all copies.
7
+
*
8
+
* THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
9
+
* WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
10
+
* MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
11
+
* ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
12
+
* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
13
+
* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
14
+
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
15
+
*
16
+
*)
17
+
18
+
open OUnit
19
+
module B128 = Ipaddr_internal.S128
20
+
21
+
(* copied from test_ipaddr.ml *)
22
+
let assert_raises ~msg exn test_fn =
23
+
assert_raises ~msg exn (fun () ->
24
+
try test_fn ()
25
+
with rtexn ->
26
+
if exn <> rtexn then (
27
+
Printf.eprintf "Stacktrace for '%s':\n%!" msg;
28
+
Printexc.print_backtrace stderr);
29
+
raise rtexn)
30
+
31
+
let int_of_hex_char c =
32
+
match c with
33
+
| '0' .. '9' -> Char.code c - 48
34
+
| 'a' .. 'f' -> Char.code c - 87
35
+
| 'A' .. 'F' -> Char.code c - 55
36
+
| _ -> invalid_arg "char is not a valid hex digit"
37
+
38
+
let to_string (s : Ipaddr_internal.S128.t) =
39
+
let s : string = Obj.magic s in
40
+
List.init 16 (fun i -> Printf.sprintf "%.2x" (Char.code (String.get s i)))
41
+
|> String.concat ""
42
+
43
+
let of_string_exn s : B128.t =
44
+
if String.length s <> 32 then invalid_arg "not 32 chars long";
45
+
Bytes.init 16 (fun bi ->
46
+
let i = bi * 2 in
47
+
let x = int_of_hex_char s.[i + 1] and y = int_of_hex_char s.[i] in
48
+
char_of_int ((y lsl 4) + x))
49
+
|> Bytes.unsafe_to_string
50
+
|> Obj.magic
51
+
52
+
let assert_equal = assert_equal ~printer:to_string
53
+
54
+
let test_addition () =
55
+
(* simple addition *)
56
+
let d1 = B128.zero in
57
+
let d2 = of_string_exn "00000000000000000000000000000001" in
58
+
assert_equal ~msg:"adding one to zero is one" d2 (B128.add_exn d1 d2);
59
+
60
+
(* addition carry *)
61
+
let d1 = of_string_exn "000000000000000000ff000000000000" in
62
+
let d2 = of_string_exn "00000000000000000001000000000000" in
63
+
let d3 = of_string_exn "00000000000000000100000000000000" in
64
+
assert_equal ~msg:"test addition carry over" d3 (B128.add_exn d1 d2);
65
+
66
+
(* adding one to max_int overflows *)
67
+
let d1 = B128.max_int in
68
+
let d2 = of_string_exn "00000000000000000000000000000001" in
69
+
assert_raises ~msg:"adding one to max_int overflows" B128.Overflow (fun () ->
70
+
B128.add_exn d1 d2)
71
+
72
+
let test_pred () =
73
+
(* simple subtraction *)
74
+
let d1 = of_string_exn "00000000000000000000000000000001" in
75
+
let d2 = B128.zero in
76
+
assert_equal ~msg:"subtracting one from one is zero" d2 (B128.pred_exn d1);
77
+
78
+
(* subtract carry *)
79
+
let d1 = of_string_exn "00000000000000000000000000000300" in
80
+
let d2 = of_string_exn "000000000000000000000000000002ff" in
81
+
assert_equal ~msg:"test subtraction carry over" d2 (B128.pred_exn d1);
82
+
83
+
(* subtracting one from zero overflows *)
84
+
assert_raises ~msg:"subtracting one from min_int overflows" B128.Overflow
85
+
(fun () -> B128.pred_exn B128.zero)
86
+
87
+
let test_of_to_string () =
88
+
let s = "ff000000000000004200000000000001" in
89
+
OUnit.assert_equal ~msg:"input of of_string is equal to output of to_string" s
90
+
(of_string_exn s |> to_string)
91
+
92
+
let test_lognot () =
93
+
let d1 = of_string_exn "00000000000000000000000000000001" in
94
+
let d2 = of_string_exn "fffffffffffffffffffffffffffffffe" in
95
+
assert_equal ~msg:"lognot inverts bits" d2 (B128.lognot d1)
96
+
97
+
let test_shift_left () =
98
+
(* bit shift count, input, expected output *)
99
+
let test_shifts =
100
+
[
101
+
(1, "f0000000000000000000000000000000", "e0000000000000000000000000000000");
102
+
(1, "0000000000000000000000000000000f", "0000000000000000000000000000001e");
103
+
(1, "00000000000000000000000000000001", "00000000000000000000000000000002");
104
+
(2, "f0000000000000000000000000000000", "c0000000000000000000000000000000");
105
+
(2, "0000000000000000000000000000ffff", "0000000000000000000000000003fffc");
106
+
(8, "00000000000000000000000000000100", "00000000000000000000000000010000");
107
+
(9, "f0000000000000000000000000000000", "00000000000000000000000000000000");
108
+
( 64,
109
+
"00000000000000000000000000000001",
110
+
"00000000000000010000000000000000" );
111
+
( 127,
112
+
"00000000000000000000000000000001",
113
+
"80000000000000000000000000000000" );
114
+
( 128,
115
+
"00000000000000000000000000000001",
116
+
"00000000000000000000000000000000" );
117
+
]
118
+
in
119
+
List.iter
120
+
(fun (bits, input_value, expected_output) ->
121
+
assert_equal
122
+
~msg:(Printf.sprintf "shift left by %i" bits)
123
+
(of_string_exn expected_output)
124
+
(B128.shift_left (of_string_exn input_value) bits))
125
+
test_shifts
126
+
127
+
let test_shift_right () =
128
+
(* (bit shift count, input, expected output) *)
129
+
let test_shifts =
130
+
[
131
+
(1, "f0000000000000000000000000000000", "78000000000000000000000000000000");
132
+
(2, "f0000000000000000000000000000000", "3c000000000000000000000000000000");
133
+
(2, "0000000000000000000000000000ffff", "00000000000000000000000000003fff");
134
+
(2, "000000000000000000000000000ffff0", "0000000000000000000000000003fffc");
135
+
(8, "00000000000000000000000000000100", "00000000000000000000000000000001");
136
+
(9, "f0000000000000000000000000000000", "00780000000000000000000000000000");
137
+
( 32,
138
+
"000000000000000000000000ffffffff",
139
+
"00000000000000000000000000000000" );
140
+
( 32,
141
+
"0000000000000000aaaabbbbffffffff",
142
+
"000000000000000000000000aaaabbbb" );
143
+
( 40,
144
+
"0000000000000000aaaabbbbffffffff",
145
+
"00000000000000000000000000aaaabb" );
146
+
( 64,
147
+
"01000000000000000000000000000000",
148
+
"00000000000000000100000000000000" );
149
+
( 120,
150
+
"aaaabbbbccccdddd0000000000000000",
151
+
"000000000000000000000000000000aa" );
152
+
( 127,
153
+
"80000000000000000000000000000000",
154
+
"00000000000000000000000000000001" );
155
+
( 128,
156
+
"ffff0000000000000000000000000000",
157
+
"00000000000000000000000000000000" );
158
+
]
159
+
in
160
+
List.iter
161
+
(fun (bits, input_value, expected_output) ->
162
+
assert_equal
163
+
~msg:(Printf.sprintf "shift right by %i" bits)
164
+
(of_string_exn expected_output)
165
+
(B128.shift_right (of_string_exn input_value) bits))
166
+
test_shifts
167
+
168
+
let test_byte_module () =
169
+
let assert_equal = OUnit2.assert_equal ~printer:(Printf.sprintf "0x%x") in
170
+
assert_equal ~msg:"get 3 lsb" 0x00 (B128.Byte.get_lsbits 3 0x00);
171
+
assert_equal ~msg:"get 4 lsb" 0x0f (B128.Byte.get_lsbits 4 0xff);
172
+
assert_equal ~msg:"get 5 lsb" 0x10 (B128.Byte.get_lsbits 5 0x10);
173
+
assert_equal ~msg:"get 8 lsb" 0xff (B128.Byte.get_lsbits 8 0xff);
174
+
175
+
assert_equal ~msg:"get 3 msb" 0x0 (B128.Byte.get_msbits 3 0x00);
176
+
assert_equal ~msg:"get 4 msb" 0xf (B128.Byte.get_msbits 4 0xff);
177
+
assert_equal ~msg:"get 5 msb" 0x2 (B128.Byte.get_msbits 5 0x10);
178
+
assert_equal ~msg:"get 8 msb" 0xff (B128.Byte.get_msbits 8 0xff);
179
+
180
+
assert_equal ~msg:"set 3 msb" 0x20 (B128.Byte.set_msbits 3 0x1 0x00);
181
+
assert_equal ~msg:"set 4 msb" 0xa0 (B128.Byte.set_msbits 4 0xa 0x00);
182
+
assert_equal ~msg:"set 5 msb" 0x98 (B128.Byte.set_msbits 5 0x13 0x00);
183
+
assert_equal ~msg:"set 8 msb" 0xff (B128.Byte.set_msbits 8 0xff 0x00)
184
+
185
+
let suite =
186
+
"Test B128 module"
187
+
>::: [
188
+
"addition" >:: test_addition;
189
+
"pred" >:: test_pred;
190
+
"of_to_string" >:: test_of_to_string;
191
+
"lognot" >:: test_lognot;
192
+
"shift_left" >:: test_shift_left;
193
+
"shift_right" >:: test_shift_right;
194
+
"byte_module" >:: test_byte_module;
195
+
]
196
+
;;
197
+
198
+
let _results = run_test_tt_main suite in
199
+
()
+114
vendor/opam/ipaddr/lib_test/test_macaddr.ml
+114
vendor/opam/ipaddr/lib_test/test_macaddr.ml
···
1
+
(*
2
+
* Copyright (c) 2013-2014 David Sheets <sheets@alum.mit.edu>
3
+
*
4
+
* Permission to use, copy, modify, and distribute this software for any
5
+
* purpose with or without fee is hereby granted, provided that the above
6
+
* copyright notice and this permission notice appear in all copies.
7
+
*
8
+
* THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
9
+
* WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
10
+
* MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
11
+
* ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
12
+
* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
13
+
* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
14
+
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
15
+
*
16
+
*)
17
+
18
+
open OUnit
19
+
open Macaddr
20
+
21
+
let test_string_rt () =
22
+
let addrs = [ ("ca:fe:ba:be:ee:ee", ':'); ("ca-fe-ba-be-ee-ee", '-') ] in
23
+
List.iter
24
+
(fun (addr, sep) ->
25
+
let os = of_string_exn addr in
26
+
let ts = to_string ~sep os in
27
+
assert_equal ~msg:(addr ^ " <> " ^ ts) ts addr;
28
+
let os = Macaddr_sexp.(t_of_sexp (sexp_of_t os)) in
29
+
let ts = to_string ~sep os in
30
+
assert_equal ~msg:(addr ^ " <> " ^ ts) ts addr)
31
+
addrs
32
+
33
+
let assert_result_failure ~msg a =
34
+
match a with Ok _ -> assert_failure msg | Error (`Msg _) -> ()
35
+
36
+
let test_string_rt_bad () =
37
+
let addrs =
38
+
[
39
+
"ca:fe:ba:be:ee:e";
40
+
"ca:fe:ba:be:ee:eee";
41
+
"ca:fe:ba:be:eeee";
42
+
"ca:fe:ba:be:ee::ee";
43
+
"ca:fe:ba:be:e:eee";
44
+
"ca:fe:ba:be:ee-ee";
45
+
]
46
+
in
47
+
List.iter (fun addr -> assert_result_failure ~msg:addr (of_string addr)) addrs
48
+
49
+
let test_bytes_rt () =
50
+
let addr = "\254\099\003\128\000\000" in
51
+
assert_equal ~msg:(String.escaped addr) (to_octets (of_octets_exn addr)) addr
52
+
53
+
let test_bytes_rt_bad () =
54
+
let addrs = [ "\254\099\003\128\000"; "\254\099\003\128\000\000\233" ] in
55
+
List.iter
56
+
(fun addr ->
57
+
assert_result_failure ~msg:(String.escaped addr) (of_octets addr))
58
+
addrs
59
+
60
+
let test_cstruct_rt () =
61
+
let open Macaddr_cstruct in
62
+
let addr = "\254\099\003\128\000\000" in
63
+
assert_equal ~msg:(String.escaped addr)
64
+
(Cstruct.to_string (to_cstruct (of_cstruct_exn (Cstruct.of_string addr))))
65
+
addr
66
+
67
+
let error s = (s, Parse_error ("MAC is exactly 6 bytes", s))
68
+
69
+
let test_cstruct_rt_bad () =
70
+
let open Macaddr_cstruct in
71
+
let addrs =
72
+
[ error "\254\099\003\128\000"; error "\254\099\003\128\000\000\233" ]
73
+
in
74
+
List.iter
75
+
(fun (addr, exn) ->
76
+
assert_raises ~msg:(String.escaped addr) exn (fun () ->
77
+
of_cstruct_exn (Cstruct.of_string addr)))
78
+
addrs
79
+
80
+
let test_make_local () =
81
+
let () = Random.self_init () in
82
+
let bytegen i = if i = 0 then 253 else 255 - i in
83
+
let local_addr = make_local bytegen in
84
+
assert_equal ~msg:"is_local" (is_local local_addr) true;
85
+
assert_equal ~msg:"is_unicast" (is_unicast local_addr) true;
86
+
assert_equal ~msg:"localize" (to_octets local_addr).[0] (Char.chr 254);
87
+
for i = 1 to 5 do
88
+
assert_equal
89
+
~msg:("addr.[" ^ string_of_int i ^ "]")
90
+
(to_octets local_addr).[i]
91
+
(Char.chr (bytegen i))
92
+
done;
93
+
assert_equal ~msg:"get_oui" (get_oui local_addr)
94
+
((254 lsl 16) + (254 lsl 8) + 253)
95
+
96
+
let test_bad_sep_mix () =
97
+
let s = "00:11-22:33-44:55" in
98
+
assert_result_failure ~msg:s (of_string s)
99
+
100
+
let suite =
101
+
"Test"
102
+
>::: [
103
+
"string_rt" >:: test_string_rt;
104
+
"string_rt_bad" >:: test_string_rt_bad;
105
+
"bytes_rt" >:: test_bytes_rt;
106
+
"bytes_rt_bad" >:: test_bytes_rt_bad;
107
+
"cstruct_rt" >:: test_cstruct_rt;
108
+
"cstruct_rt_bad" >:: test_cstruct_rt_bad;
109
+
"make_local" >:: test_make_local;
110
+
"bad_sep_mix" >:: test_bad_sep_mix;
111
+
]
112
+
;;
113
+
114
+
run_test_tt_main suite
+28
vendor/opam/ipaddr/lib_test/test_ppx.ml
+28
vendor/opam/ipaddr/lib_test/test_ppx.ml
···
1
+
(*
2
+
* Copyright (c) 2018 Anil Madhavapeddy <anil@recoil.org>
3
+
*
4
+
* Permission to use, copy, modify, and distribute this software for any
5
+
* purpose with or without fee is hereby granted, provided that the above
6
+
* copyright notice and this permission notice appear in all copies.
7
+
*
8
+
* THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
9
+
* WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
10
+
* MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
11
+
* ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
12
+
* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
13
+
* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
14
+
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
15
+
*
16
+
*)
17
+
18
+
type t = {
19
+
ip : Ipaddr_sexp.t;
20
+
ipv6 : Ipaddr_sexp.V6.t;
21
+
ipv6p : Ipaddr_sexp.V6.Prefix.t;
22
+
ipv4 : Ipaddr_sexp.V4.t;
23
+
ipv4p : Ipaddr_sexp.V4.Prefix.t;
24
+
scope : Ipaddr_sexp.scope;
25
+
mac : Macaddr_sexp.t;
26
+
ipp : Ipaddr_sexp.Prefix.t;
27
+
}
28
+
[@@deriving sexp]
+25
vendor/opam/ipaddr/macaddr-cstruct.opam
+25
vendor/opam/ipaddr/macaddr-cstruct.opam
···
1
+
opam-version: "2.0"
2
+
maintainer: "anil@recoil.org"
3
+
authors: ["David Sheets" "Anil Madhavapeddy" "Hugo Heuzard"]
4
+
synopsis: "A library for manipulation of MAC address representations using Cstructs"
5
+
license: "ISC"
6
+
tags: ["org:mirage" "org:xapi-project"]
7
+
homepage: "https://github.com/mirage/ocaml-ipaddr"
8
+
doc: "https://mirage.github.io/ocaml-ipaddr/"
9
+
bug-reports: "https://github.com/mirage/ocaml-ipaddr/issues"
10
+
depends: [
11
+
"ocaml" {>= "4.08.0"}
12
+
"dune" {>= "1.9.0"}
13
+
"macaddr" {= version}
14
+
"cstruct" {>= "6.0.0"}
15
+
]
16
+
build: [
17
+
["dune" "subst"] {dev}
18
+
["dune" "build" "-p" name "-j" jobs]
19
+
["dune" "runtest" "-p" name "-j" jobs] {with-test}
20
+
]
21
+
dev-repo: "git+https://github.com/mirage/ocaml-ipaddr.git"
22
+
description: """
23
+
Cstruct convertions for macaddr
24
+
"""
25
+
x-maintenance-intent: [ "(latest)" ]
+29
vendor/opam/ipaddr/macaddr-sexp.opam
+29
vendor/opam/ipaddr/macaddr-sexp.opam
···
1
+
opam-version: "2.0"
2
+
maintainer: "anil@recoil.org"
3
+
authors: ["David Sheets" "Anil Madhavapeddy" "Hugo Heuzard"]
4
+
synopsis: "A library for manipulation of MAC address representations using sexp"
5
+
license: "ISC"
6
+
tags: ["org:mirage" "org:xapi-project"]
7
+
homepage: "https://github.com/mirage/ocaml-ipaddr"
8
+
doc: "https://mirage.github.io/ocaml-ipaddr/"
9
+
bug-reports: "https://github.com/mirage/ocaml-ipaddr/issues"
10
+
depends: [
11
+
"ocaml" {>= "4.08.0"}
12
+
"dune" {>= "1.9.0"}
13
+
"macaddr" {= version}
14
+
"macaddr-cstruct" {with-test & = version}
15
+
"ounit2" {with-test}
16
+
"ppx_sexp_conv" {>= "v0.9.0"}
17
+
"sexplib0"
18
+
]
19
+
conflicts: [ "ipaddr" {< "3.0.0"} ]
20
+
build: [
21
+
["dune" "subst"] {dev}
22
+
["dune" "build" "-p" name "-j" jobs]
23
+
["dune" "runtest" "-p" name "-j" jobs] {with-test}
24
+
]
25
+
dev-repo: "git+https://github.com/mirage/ocaml-ipaddr.git"
26
+
description: """
27
+
Sexp convertions for macaddr
28
+
"""
29
+
x-maintenance-intent: [ "(latest)" ]
+33
vendor/opam/ipaddr/macaddr.opam
+33
vendor/opam/ipaddr/macaddr.opam
···
1
+
opam-version: "2.0"
2
+
maintainer: "anil@recoil.org"
3
+
authors: ["David Sheets" "Anil Madhavapeddy" "Hugo Heuzard"]
4
+
synopsis: "A library for manipulation of MAC address representations"
5
+
license: "ISC"
6
+
tags: ["org:mirage" "org:xapi-project"]
7
+
homepage: "https://github.com/mirage/ocaml-ipaddr"
8
+
doc: "https://mirage.github.io/ocaml-ipaddr/"
9
+
bug-reports: "https://github.com/mirage/ocaml-ipaddr/issues"
10
+
depends: [
11
+
"ocaml" {>= "4.08.0"}
12
+
"dune" {>= "1.9.0"}
13
+
"ounit2" {with-test}
14
+
"ppx_sexp_conv" {with-test & >= "v0.9.0"}
15
+
]
16
+
conflicts: [ "ipaddr" {< "3.0.0"} ]
17
+
build: [
18
+
["dune" "subst"] {dev}
19
+
["dune" "build" "-p" name "-j" jobs]
20
+
["dune" "runtest" "-p" name "-j" jobs] {with-test}
21
+
]
22
+
dev-repo: "git+https://github.com/mirage/ocaml-ipaddr.git"
23
+
description: """
24
+
A library for manipulation of MAC address representations.
25
+
26
+
Features:
27
+
28
+
* ounit2-based tests
29
+
* MAC-48 (Ethernet) address support
30
+
* `Macaddr` is a `Map.OrderedType`
31
+
* All types have sexplib serializers/deserializers optionally via the `Macaddr_sexp` library.
32
+
"""
33
+
x-maintenance-intent: [ "(latest)" ]