pax_global_header00006660000000000000000000000064144115552460014521gustar00rootroot0000000000000052 comment=234c6009a221e23a7dd4883756e6b2cc0d7c663b ocaml-ipaddr-5.5.0/000077500000000000000000000000001441155524600140645ustar00rootroot00000000000000ocaml-ipaddr-5.5.0/.gitignore000066400000000000000000000000441441155524600160520ustar00rootroot00000000000000_build *.install **/*.merlin .*.swp ocaml-ipaddr-5.5.0/.ocamlformat000066400000000000000000000002011441155524600163620ustar00rootroot00000000000000version = 0.25.1 profile = conventional break-infix = fit-or-vertical parse-docstrings = true indicate-multiline-delimiters = no ocaml-ipaddr-5.5.0/CHANGES.md000066400000000000000000000273231441155524600154650ustar00rootroot00000000000000## v5.5.0 (2023-03-31) * add `Ipaddr` `of_octet` functions (#117, @ryangibb). ## v5.4.0 (2023-03-13) * Use Bytes.t for IPv6 addresses (#115 @verbosemode, fixes #16 @dsheets) * Also fixes `V6.to_int64` (reported by @RyanGibb in #113) ## v5.3.1 (2022-07-04) * Remove stdlib-shims dependency, require OCaml 4.08+ (@hannesm, #112) * Switch to ounit2 (@Alessandro-Barbieri, #111) ## v5.3.0 (2022-03-04) * Add `with_port_of_string` function (@dinosaure, @hannesm, #108) * **breaking-change** Be restrictive on `Ipaddr.of_string` (@dinosaure, @hannesm, #109) Before this release, `Ipaddr.of_string` accepts remaining bytes and returns a valid value such as `"127.0.0.1aaaa"` is valid. Now, `ipaddr` does not accept a string with remaining bytes. ## v5.2.0 (2021-09-11) * Use Cstruct.length instead of deprecated Cstruct.len (#106, @hannesm) * Provide instantiated functors Set, Map, V4.Set, V4.Map, V6.Set, V6.Map (#106, @hannesm) ## v5.1.0 (2021-06-08) * Reject octal notation in IPv4 (cve-2021-29921, #104, @jsachs) * CI fixes, upgrade to ocamlformat 0.18 (@hannesm) ## v5.0.1 (2020-09-30) * Fix V4.Prefix.broadcast and last with /32 prefixes (#102 @verbosemode) ## v5.0.0 (2020-06-16) * Do not zero out the non-prefix-length part of the address in `{V4,V6}.Prefix.t` (#99 @hannesm) Removed `{V4,V6}.Prefix.of_address_string{,_exn}` and `{V4,V6}.Prefix.to_address_{string.buffer}` To port code: - if you rely on `Prefix.of_string` to zero out the non-prefix-length address bits, call `Prefix.prefix : t -> t` subsequently. - `Prefix.of_address_string{,_exn}` can be replaced by `Prefix.of_string{,_exn}`, to retrieve the address use `Prefix.address : t -> addr`. - The `Prefix.to_address_{string,buffer}` can be replaced by `Prefix.to_{string,buffer}`, where `Prefix.t` already contains the IP address to be printed. - Instead of passing `{V4,V6}.t * {V4,V6}.Prefix.t` for an address and subnet configuration, `{V4,V6}.Prefix.t` is sufficient. * Implement `{V4,V6,}.succ`, `{V4,V6,}.pred`, `{V4,V6}.Prefix.first`, and `{V4,V6}.Prefix.last` functions (#94 @NightBlues) * Rename `Prefix.of_netmask` to `Prefix.of_netmask_exn` with labelled arguments (~netmask and ~address), provide `Prefix.of_netmask` which returns a (t, [> `Msg of string ]) result value (#95 @hannesm) * Fix undefined behaviour of `V4.Prefix.mem` with a CIDR with prefix length 0 (#98 @verbosemode) * Use stdlib-shims to prevent deprecation warnings on OCaml 4.08 (@avsm) * Remove unnecessary "sexplib0" dependency (#95 @hannesm) * Remove "{build}" directive from "dune" dependency (#93 @CraigFe) ## v4.0.0 (2019-07-12) * Rename the `to/from_bytes` functions to refer to `octets` instead. This distinguishes the meaning of human-readable addresses (`string`s in this library) and byte-packed representations(`octet`s in this library) from the OCaml `bytes` type that represents mutable strings. Porting code should just be a matter of renaming functions such as: - `Ipaddr.of_bytes` becomes `Ipaddr.of_octets` - `Macaddr.to_bytes` becomes `Macaddr.to_octets` * Introduce new `write_octets` functions that can write octet representations of IPv4/v6 into an existing bytestring. * Use the `domain-name` library to produce domain names from IP addresses. * Remove the `ipaddr.sexp` and `macaddr.sexp` ocamlfind subpackages and instead have `ipaddr-sexp` and `macaddr-sexp` to match the opam package names. * Add new `Ipaddr_cstruct` and `Macaddr_cstruct` libraries for conversion to/from cstructs (#36 @nojb @avsm) ## v3.1.0 (2019-03-02) * Do not leak a `Not_found` exception when parsing `[:` in IPv6 and instead raise `Parse_error` as other errors do (found by fuzz testing in #84 by @dinosaure) * Install automatic toplevel printers for the Ipaddr types via `[@@ocaml.toplevel_printer]`. This enables utop to automatically install the printers (@avsm) ## 3.0.0 (2019-01-02) This release features several backwards incompatible changes, but ones that should increase the portability and robustness of the library. * Remove the sexp serialisers from the main interface in favour of `pp` functions. Use the `Ipaddr_sexp` module if you still need a sexp serialiser. To use these with ppx-based derivers, simply replace the reference to the `Ipaddr` type definition with `Ipaddr_sexp`. That will import the sexp-conversion functions, and the actual type definitions are simply aliases to the corresponding type within `Ipaddr`. For example, you might do: ``` type t = { ip: Ipaddr_sexp.t; mac: Macaddr_sexp.t; } [@@deriving sexp] ``` The actual types of the records will be aliases to the main library types, and there will be two new functions available as converters. The signature after ppx has run will be: ``` type t = { ip: Ipaddr.t; mac: Macaddr.t; } val sexp_of_t : t -> Sexplib0.t val t_of_sexp : Sexplib0.t -> t ``` * Break out the `Macaddr` module into a separate opam package so that the `Ipaddr` module can be wrapped. Use the `macaddr` opam library now if you need just the MAC address functionality. * Replace all the `of_string/bytes` functions that formerly returned option types with the `Rresult` result types instead. This stops the cause of the exception from being swallowed, and the error message in the new functions can be displayed usefully. * In the `Ipaddr.V6.to_string` and `to_buffer` functions, remove the optional labelled argument `v4` and always output v4-mapped strings as recommended by RFC5952. (#80 by @hannesm). * Remove `pp_hum` which was deprecated in 2.9.0. * Sexplib0 is now used which is more lightweight tha the full Sexplib library. Minimum OCaml version is now 4.04.0+ as a result of this dependency. * Improvements to the ocamldoc formatting strings for better layout and odoc compatibility. ## 2.9.0 (2018-12-11) * Add `pp` functions for prettyprinting and deprecate `pp_hum` variants. The two functions are currently the same, so porting is just a matter of replacing existing uses of `pp_hum` with `pp` (#71 @verbosemode) * Fix deprecation warnings on newer OCaml standard libraries (#74 @cfcs). * Fix `base-unix` depopt to be a real dependency (#68 @rgrinberg). * Fix missing `sexplib` dependency (#66 #67 @bmillwood). * Port to Dune from jbuilder and update opam metadata to 2.0 format (#76 @avsm). * Remove unused variable and bindings warnings in the implementation and signatures (#76 @avsm) * Fix toplevel handling of the `ipaddr.top` package by linking to compiler-libs instead of compiler-libs.toplevel (#76 @avsm based on fix in mirage/ocaml-uri#130 by @yallop) * Update Travis to test latest distros by using their aliases (#76 @avsm) * Upgrade opam metadata to the 2.0 format (#76 @avsm) ## 2.8.0 (2017-06-01) * Port to Jbuilder (#65 @vbmithr @avsm). There should be no observable changes, except that `Ipaddr_unix` is now in a separate subdirectory. This means that packages that implicitly depended on the module without including the ocamlfind `ipaddr.unix` package may now fail. Just adding the ocamlfind dependency will fix it, and is backwards compatible with older Ipaddr releases. * Minimum version of OCaml required is now 4.03.0 (formerly was 4.02.2), due to the use of recent `ppx_sexp_conv` with Jbuilder also having that as the minimum supported compiler version. ## 2.7.2 (2017-02-16) * Fix a missing findlib toploop package (#61 from Vincent Bernardoff) ## 2.7.1 (2016-11-16) * Use topkg for build (#60 from Jochen Bartl) ## 2.7.0 (2016-02-14) * Remove `sexplib.syntax`, `type_conv` deps and camlp4 transitive dependency * Add `ppx_sexp_conv` dependency * Require OCaml 4.02.2+ * Add `Ipaddr.Prefix.subset`, `Ipaddr.V4.Prefix.subset` and `Ipaddr.V6.subset` predicates to test containment of subnets (#52 from @seliopou) ## 2.6.1 (2015-02-20) * Fix findlib requires in oasis to restore pre-4.02.1 compatibility ## 2.6.0 (2015-02-19) * Change IPv6 link-local address prefix from fe80::/10 to fe80::/64. (#39) * Remove type bytes = string alias (potentially breaking) * Turn on -safe-string (#41) * {V4,V6}.`to_bytes_raw` now uses Bytes.t rather than string (potentially breaking) * Add multicast MAC conversions from RFC 1112 and RFC 2464 * Add `to_domain_name` conversions to DNS label lists (in-addr.arpa and ip6.arpa) * Add `V6.interface_routers`, `V6.site_routers`, and `V6.Prefix.solicited_node` * Add `V6.link_address_of_mac` to convert a MAC into a link local IP address ## 2.5.0 (2014-05-27) * Add `with sexp` (de)serializers to all of the Ipaddr and Macaddr types. (#31) ## 2.4.0 (2014-02-11) * Add `Ipaddr.V6.Prefix.of_netmask` for conversion from an IPv6 address/netmask to prefix (useful for some binary interfaces). See #27. * Add `Ipaddr.V6.Prefix.netmask` to generate a netmask address from a prefix (useful for some binary interfaces). See #27. * Add `Ipaddr.Prefix.network` for generic prefix -> address conversion * Add `Ipaddr.Prefix.netmask` for generic prefix -> netmask conversion ## 2.3.0 (2014-02-05) * Add `Ipaddr.V4.Prefix.of_netmask` for conversion from an address/netmask to prefix * Add `Ipaddr.V4.Prefix.netmask` to generate a netmask address from a prefix ## 2.2.0 (2014-01-27) * Add an [Ipaddr_unix] module to convert to-and-from the standard library. * Add a toplevel pretty printer in the `ipaddr.top` package. ## 2.1.0 (2014-01-20) * Add `of_string_raw` to `Ipaddr.V4.Prefix` and `Ipaddr.V6.Prefix` * Add `of_addr` to `Ipaddr.V4.Prefix` and `Ipaddr.V6.Prefix` * Add type `('v4,'v6) v4v6` to `Ipaddr` to represent version disjuncts * Add `Ipaddr.Prefix` module for generic prefix manipulation ## 2.0.0 (2014-01-17) * Change `Ipaddr.V4.make` to accept `int` rather than `int32` (breaking) * Add IPv6 support * Add generic IP address support * Add type `scope` for classifying address scopes * Add `Ipaddr.V4.of_string_raw` for parsing inside of larger strings * Add `Ipaddr.V4.to_int16` and `Ipaddr.V4.of_int16` * Add `unspecified`, `nodes`, and `routers` constants to `Ipaddr.V4` * Add `Ipaddr.V4.Prefix.network_address` to put an address into a subnet * Add `of_address_string_exn`, `of_address_string`, `to_address_string`, `to_address_buffer` to `Ipaddr.V4.Prefix` to parse/print combined addr/prefix * Add `multicast_org`, `multicast_admin`, `multicast_link` subnet constants to `Ipaddr.V4.Prefix` * Add `Ipaddr.V4.scope` to classify IPv4 addresses * Add `Ipaddr.V4.is_global` and `Ipaddr.V4.is_multicast` predicates * Add optional `sep:char` argument to `Macaddr.to_string` * Remove internal use of Scanf.scanf ## 1.0.0 (2013-10-16) * Add Travis-CI testing scripts. * Include debug symbols and annot files by default. ## 0.2.3 (2013-09-20) * Add `Ipaddr.V4.Prefix.bits` function to produce bits of prefix from prefix. ## 0.2.2 (2013-08-07) * Add `Macaddr.make_local` function to create local unicast MAC addresses from an octet generation function. * Add `Macaddr.get_oui` accessor to extract the Organizationally Unique Identifier as an integer. * Add `Macaddr.is_local` predicate to test for a locally administered address. * Add `Macaddr.is_unicast` predicate to test for a unicast MAC address. ## 0.2.1 (2013-08-01) * Add `Ipaddr.V4.any`, `Ipaddr.V4.broadcast`, `Ipaddr.V4.localhost` special constant addresses. * Add `Ipaddr.V4.Prefix.global` (0.0.0.0/0) subnet constant. * Add `Ipaddr.V4.Prefix.network` function to produce subnet address from prefix. ## 0.2.0 (2013-08-01) * Add `Macaddr` module for handling MAC-48 (Ethernet) addresses. * `Ipaddr.Parse_error` now contains both the error condition and the failing input. * Add ocamldoc-compatible comments on all interfaces. ## 0.1.1 (2013-07-31) * Add loopback and link local addresses to the private blocks. * Fix build system so Makefile is generated by OASIS. ## 0.1.0 (2013-07-24) * Initial public release. * Includes IPv4 and IPv4 CIDR prefix support. ocaml-ipaddr-5.5.0/LICENSE.md000066400000000000000000000015011441155524600154650ustar00rootroot00000000000000ISC License Copyright (c) 2013-2015 David Sheets Copyright (c) 2010-2011, 2014 Anil Madhavapeddy Permission to use, copy, modify, and distribute this software for any purpose with or without fee is hereby granted, provided that the above copyright notice and this permission notice appear in all copies. THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. ocaml-ipaddr-5.5.0/Makefile000066400000000000000000000001441441155524600155230ustar00rootroot00000000000000.PHONY: all clean all: dune build test: dune runtest doc: dune build @doc clean: dune clean ocaml-ipaddr-5.5.0/README.md000066400000000000000000000051661441155524600153530ustar00rootroot00000000000000# ipaddr: IP and MAC address manipulation A library for manipulation of IP and MAC address representations. Features: * ounit2-based tests * IPv4 and IPv6 support * IPv4 and IPv6 CIDR prefix support * IPv4 and IPv6 [CIDR-scoped address](http://tools.ietf.org/html/rfc4291#section-2.3) support * `Ipaddr.V4` and `Ipaddr.V4.Prefix` modules are `Map.OrderedType` * `Ipaddr.V6` and `Ipaddr.V6.Prefix` modules are `Map.OrderedType` * `Ipaddr` and `Ipaddr.Prefix` modules are `Map.OrderedType` * `Ipaddr_unix` in findlib subpackage `ipaddr.unix` provides compatibility with the standard library `Unix` module * `Ipaddr_top` in findlib subpackage `ipaddr.top` provides top-level pretty printers * IP address scope classification * IPv4-mapped addresses in IPv6 (::ffff:0:0/96) are an embedding of IPv4 * MAC-48 (Ethernet) address support * `Macaddr` is a `Map.OrderedType` * All types have sexplib serializers/deserializers optionally via the `Ipaddr_sexp` and `Macaddr_sexp` libraries. ## Usage There are the following opam packages included: - `ipaddr`: the `Ipaddr` and associated modules - `ipaddr-sexp` - `ipaddr-cstruct` - `macaddr`: the `Macaddr` and associated modules. - `macaddr-sexp` - `macaddr-cstruct` There are the following ocamlfind libraries included as part of this repository, included as part of the respective opam packages. - `ipaddr`: The `Ipaddr` module for IPv4/6 manipulation. - `ipaddr.top`: Toplevel printers for Ipaddr. - `ipaddr-cstruct`: The `Ipaddr_cstruct` module - `macaddr`: The `Macaddr` module for MAC address manipulation. - `macaddr.top`: Toplevel printers for Macaddr. - `macaddr-cstruct`: The `Macaddr_cstruct` module - `ipaddr-sexp`: S-expression converters for Ipaddr. - `macaddr-sexp`: S-expression converters for Macaddr. ## Installation and development The packages are released to the opam-repository. An `opam install ipaddr` (or any other above mentioned package) will install it. If you want to install the latest development commit, `opam pin add ipaddr --dev` will do this. A local build, after a `git clone` can be done with `dune build`, a `dune runtest` compiles and executes the testsuite. If dependencies are missing, `opam install (-t) --deps-only .` in the cloned directory will install them. The auto-formatter [`ocamlformat`](https://github.com/ocaml-ppx/ocamlformat) is used, please execute `dune build @fmt --auto-promote` before submitting a pull request. ## Contact - Issues: - E-mail: - API Documentation: - Discussion: with the `mirageos` tag. ocaml-ipaddr-5.5.0/dune-project000066400000000000000000000001111441155524600163770ustar00rootroot00000000000000(lang dune 1.9) (name ipaddr) (allow_approximate_merlin) (using fmt 1.1) ocaml-ipaddr-5.5.0/ipaddr-cstruct.opam000066400000000000000000000013631441155524600176750ustar00rootroot00000000000000opam-version: "2.0" maintainer: "anil@recoil.org" authors: ["David Sheets" "Anil Madhavapeddy" "Hugo Heuzard"] synopsis: "A library for manipulation of IP address representations using Cstructs" license: "ISC" tags: ["org:mirage" "org:xapi-project"] homepage: "https://github.com/mirage/ocaml-ipaddr" doc: "https://mirage.github.io/ocaml-ipaddr/" bug-reports: "https://github.com/mirage/ocaml-ipaddr/issues" depends: [ "ocaml" {>= "4.08.0"} "dune" {>= "1.9.0"} "ipaddr" {= version} "cstruct" {>= "6.0.0"} ] build: [ ["dune" "subst"] {dev} ["dune" "build" "-p" name "-j" jobs] ["dune" "runtest" "-p" name "-j" jobs] {with-test} ] dev-repo: "git+https://github.com/mirage/ocaml-ipaddr.git" description: """ Cstruct convertions for macaddr """ ocaml-ipaddr-5.5.0/ipaddr-sexp.opam000066400000000000000000000015021441155524600171600ustar00rootroot00000000000000opam-version: "2.0" maintainer: "anil@recoil.org" authors: ["David Sheets" "Anil Madhavapeddy" "Hugo Heuzard"] synopsis: "A library for manipulation of IP address representations using sexp" description: """ Sexp convertions for ipaddr """ license: "ISC" tags: ["org:mirage" "org:xapi-project"] homepage: "https://github.com/mirage/ocaml-ipaddr" doc: "https://mirage.github.io/ocaml-ipaddr/" bug-reports: "https://github.com/mirage/ocaml-ipaddr/issues" depends: [ "ocaml" {>= "4.08.0"} "dune" {>= "1.9.0"} "ipaddr" {= version} "ipaddr-cstruct" {with-test & = version} "ounit2" {with-test} "ppx_sexp_conv" {>= "v0.9.0"} "sexplib0" ] build: [ ["dune" "subst"] {dev} ["dune" "build" "-p" name "-j" jobs] ["dune" "runtest" "-p" name "-j" jobs] {with-test} ] dev-repo: "git+https://github.com/mirage/ocaml-ipaddr.git" ocaml-ipaddr-5.5.0/ipaddr.opam000066400000000000000000000033031441155524600162040ustar00rootroot00000000000000opam-version: "2.0" maintainer: "anil@recoil.org" authors: ["David Sheets" "Anil Madhavapeddy" "Hugo Heuzard"] synopsis: "A library for manipulation of IP (and MAC) address representations" description: """ Features: * Depends only on sexplib (conditionalization under consideration) * ounit2-based tests * IPv4 and IPv6 support * IPv4 and IPv6 CIDR prefix support * IPv4 and IPv6 [CIDR-scoped address](http://tools.ietf.org/html/rfc4291#section-2.3) support * `Ipaddr.V4` and `Ipaddr.V4.Prefix` modules are `Map.OrderedType` * `Ipaddr.V6` and `Ipaddr.V6.Prefix` modules are `Map.OrderedType` * `Ipaddr` and `Ipaddr.Prefix` modules are `Map.OrderedType` * `Ipaddr_unix` in findlib subpackage `ipaddr.unix` provides compatibility with the standard library `Unix` module * `Ipaddr_top` in findlib subpackage `ipaddr.top` provides top-level pretty printers (requires compiler-libs default since OCaml 4.0) * IP address scope classification * IPv4-mapped addresses in IPv6 (::ffff:0:0/96) are an embedding of IPv4 * MAC-48 (Ethernet) address support * `Macaddr` is a `Map.OrderedType` * All types have sexplib serializers/deserializers """ license: "ISC" tags: ["org:mirage" "org:xapi-project"] homepage: "https://github.com/mirage/ocaml-ipaddr" doc: "https://mirage.github.io/ocaml-ipaddr/" bug-reports: "https://github.com/mirage/ocaml-ipaddr/issues" depends: [ "ocaml" {>= "4.08.0"} "dune" {>= "1.9.0"} "macaddr" {= version} "domain-name" {>= "0.3.0"} "ounit2" {with-test} "ppx_sexp_conv" {with-test & >= "v0.9.0"} ] build: [ ["dune" "subst"] {dev} ["dune" "build" "-p" name "-j" jobs] ["dune" "runtest" "-p" name "-j" jobs] {with-test} ] dev-repo: "git+https://github.com/mirage/ocaml-ipaddr.git" ocaml-ipaddr-5.5.0/lib/000077500000000000000000000000001441155524600146325ustar00rootroot00000000000000ocaml-ipaddr-5.5.0/lib/dune000066400000000000000000000020311441155524600155040ustar00rootroot00000000000000(library (name ipaddr) (public_name ipaddr) (modules ipaddr) (libraries macaddr domain-name)) (library (name macaddr) (public_name macaddr) (modules macaddr)) (library (name ipaddr_sexp) (public_name ipaddr-sexp) (modules ipaddr_sexp) (preprocess (pps ppx_sexp_conv)) (libraries ipaddr sexplib0)) (library (name macaddr_sexp) (public_name macaddr-sexp) (modules macaddr_sexp) (preprocess (pps ppx_sexp_conv)) (libraries macaddr sexplib0)) (library (name ipaddr_unix) (public_name ipaddr.unix) (modules ipaddr_unix) (libraries unix ipaddr)) (library (name ipaddr_cstruct) (public_name ipaddr-cstruct) (modules ipaddr_cstruct) (libraries ipaddr cstruct)) (library (name macaddr_cstruct) (public_name macaddr-cstruct) (modules macaddr_cstruct) (libraries macaddr cstruct)) (library (name ipaddr_top) (public_name ipaddr.top) (modules ipaddr_top) (libraries macaddr.top ipaddr compiler-libs)) (library (name macaddr_top) (public_name macaddr.top) (modules macaddr_top) (libraries macaddr compiler-libs)) ocaml-ipaddr-5.5.0/lib/ipaddr.ml000066400000000000000000001105461441155524600164360ustar00rootroot00000000000000(* * Copyright (c) 2013-2015 David Sheets * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. * *) exception Parse_error of string * string type scope = Point | Interface | Link | Admin | Site | Organization | Global let try_with_result fn a = try Ok (fn a) with Parse_error (msg, _) -> Error (`Msg ("Ipaddr: " ^ msg)) let failwith_msg = function Ok x -> x | Error (`Msg m) -> failwith m let map_result v f = match v with Ok v -> Ok (f v) | Error _ as e -> e let string_of_scope = function | Point -> "point" | Interface -> "interface" | Link -> "link" | Admin -> "admin" | Site -> "site" | Organization -> "organization" | Global -> "global" let scope_of_string = function | "point" -> Ok Point | "interface" -> Ok Interface | "link" -> Ok Link | "admin" -> Ok Admin | "site" -> Ok Site | "organization" -> Ok Organization | "global" -> Ok Global | s -> Error (`Msg ("unknown scope: " ^ s)) let pp_scope fmt s = Format.pp_print_string fmt (string_of_scope s) let ( ~| ) = Int32.of_int let ( |~ ) = Int32.to_int let ( &&& ) x y = Int32.logand x y let ( ||| ) x y = Int32.logor x y let ( <|< ) x y = Int32.shift_left x y let ( >|> ) x y = Int32.shift_right_logical x y let ( >! ) x y = x >|> y &&& 0xFF_l let ( Stdlib.int_of_char c - char_0 | 'a' .. 'f' -> 10 + Stdlib.int_of_char c - char_a | 'A' .. 'F' -> 10 + Stdlib.int_of_char c - char_A | _ -> -1 let bad_char i s = let msg = Printf.sprintf "invalid character '%c' at %d" s.[i] i in Parse_error (msg, s) let octal_notation s = let msg = Printf.sprintf "octal notation disallowed" in Parse_error (msg, s) let is_number base n = n >= 0 && n < base let parse_int base s i = let len = String.length s in let rec next prev = let j = !i in if j >= len then prev else let c = s.[j] in let k = int_of_char c in if is_number base k then ( incr i; next ((prev * base) + k)) else prev in let i = !i in if i < len then if is_number base (int_of_char s.[i]) then next 0 else raise (bad_char i s) else raise (need_more s) let parse_dec_int s i = parse_int 10 s i let parse_hex_int s i = parse_int 16 s i let expect_char s i c = if !i < String.length s then if s.[!i] <> c then raise (bad_char !i s) else incr i else raise (need_more s) let expect_end s i = if String.length s <= !i then () else raise (bad_char !i s) let reject_octal s i = if !i + 1 < String.length s then if s.[!i] == '0' && is_number 10 (int_of_char s.[!i + 1]) then raise (octal_notation s) module V4 = struct type t = int32 let compare a b = (* ignore the sign *) let c = Int32.compare (a >|> 1) (b >|> 1) in if c = 0 then Int32.compare (a &&& 1l) (b &&& 1l) else c let make a b c d = ~|a a in if valid a then raise (Parse_error ("first octet out of bounds", s)) else if valid b then raise (Parse_error ("second octet out of bounds", s)) else if valid c then raise (Parse_error ("third octet out of bounds", s)) else if valid d then raise (Parse_error ("fourth octet out of bounds", s)) else make a b c d (* string conversion *) let of_string_raw = parse_dotted_quad let of_string_exn s = let o = ref 0 in let x = of_string_raw s o in expect_end s o; x let of_string s = try_with_result of_string_exn s let with_port_of_string ~default s = try let len = String.length s and o = ref 0 in let ipv4 = of_string_raw s o in if !o < len && s.[!o] = ':' then ( incr o; let port = parse_dec_int s o in expect_end s o; Ok (ipv4, port)) else ( expect_end s o; Ok (ipv4, default)) with Parse_error (msg, _) -> Error (`Msg ("Ipaddr: " ^ msg)) let to_buffer b i = Printf.bprintf b "%ld.%ld.%ld.%ld" (i >! 24) (i >! 16) (i >! 8) (i >! 0) let to_string i = let b = Buffer.create 15 in to_buffer b i; Buffer.contents b let pp ppf i = Format.fprintf ppf "%s" (to_string i) (* Octets conversion *) let of_octets_exn ?(off = 0) bs = try make (Char.code bs.[0 + off]) (Char.code bs.[1 + off]) (Char.code bs.[2 + off]) (Char.code bs.[3 + off]) with _ -> raise (need_more bs) let of_octets ?off bs = try_with_result (of_octets_exn ?off) bs let write_octets_exn ?(off = 0) i b = try Bytes.set b (0 + off) (Char.chr (( |~ ) (i >! 24))); Bytes.set b (1 + off) (Char.chr (( |~ ) (i >! 16))); Bytes.set b (2 + off) (Char.chr (( |~ ) (i >! 8))); Bytes.set b (3 + off) (Char.chr (( |~ ) (i >! 0))) with _ -> raise (need_more (Bytes.to_string b)) let write_octets ?off i bs = try_with_result (write_octets_exn ?off i) bs let to_octets i = String.init 4 (function | 0 -> Char.chr (( |~ ) (i >! 24)) | 1 -> Char.chr (( |~ ) (i >! 16)) | 2 -> Char.chr (( |~ ) (i >! 8)) | 3 -> Char.chr (( |~ ) (i >! 0)) | _ -> assert false) (* Int32 *) let of_int32 i = i let to_int32 i = i (* Int16 *) let of_int16 (a, b) = ~|a <|< 16 ||| ~|b let to_int16 a = (( |~ ) (a >|> 16), ( |~ ) (a &&& 0xFF_FF_l)) (* MAC *) (* {{:http://tools.ietf.org/html/rfc1112#section-6.2}RFC 1112}. *) let multicast_to_mac i = let macb = Bytes.create 6 in Bytes.set macb 0 (Char.chr 0x01); Bytes.set macb 1 (Char.chr 0x00); Bytes.set macb 2 (Char.chr 0x5E); Bytes.set macb 3 (Char.chr (( |~ ) (i >|> 16 &&& 0x7F_l))); Bytes.set macb 4 (Char.chr (( |~ ) (i >! 8))); Bytes.set macb 5 (Char.chr (( |~ ) (i >! 0))); Macaddr.of_octets_exn (Bytes.to_string macb) (* Host *) let to_domain_name i = let name = [ Int32.to_string (i >! 0); Int32.to_string (i >! 8); Int32.to_string (i >! 16); Int32.to_string (i >! 24); "in-addr"; "arpa"; ] in Domain_name.(host_exn (of_strings_exn name)) let of_domain_name n = match Domain_name.to_strings n with | [ a; b; c; d; in_addr; arpa ] when Domain_name.( equal_label arpa "arpa" && equal_label in_addr "in-addr") -> ( let conv bits data = let i = Int32.of_int (parse_dec_int data (ref 0)) in if i > 0xFFl then raise (Parse_error ("label with a too big number", data)) else i None) | _ -> None let succ t = if Int32.equal t 0xFF_FF_FF_FFl then Error (`Msg "Ipaddr: highest address has been reached") else Ok (Int32.succ t) let pred t = if Int32.equal t 0x00_00_00_00l then Error (`Msg "Ipaddr: lowest address has been reached") else Ok (Int32.pred t) (* constant *) let any = make 0 0 0 0 let unspecified = make 0 0 0 0 let broadcast = make 255 255 255 255 let localhost = make 127 0 0 1 let nodes = make 224 0 0 1 let routers = make 224 0 0 2 module Prefix = struct type addr = t type t = addr * int let compare (pre, sz) (pre', sz') = let c = compare pre pre' in if c = 0 then Stdlib.compare sz sz' else c let ip = make let mask sz = if sz <= 0 then 0_l else if sz >= 32 then 0x0_FF_FF_FF_FF_l else 0x0_FF_FF_FF_FF_l <|< 32 - sz let prefix (pre, sz) = (pre &&& mask sz, sz) let make sz pre = (pre, sz) let network_address (pre, sz) addr = pre &&& mask sz ||| (addr &&& Int32.lognot (mask sz)) (* string conversion *) let _of_string_raw s i = let quad = of_string_raw s i in expect_char s i '/'; let p = parse_dec_int s i in if p > 32 || p < 0 then raise (Parse_error ("invalid prefix size", s)); (p, quad) let of_string_raw s i = let p, quad = _of_string_raw s i in make p quad let _of_string_exn s = let i = ref 0 in let res = _of_string_raw s i in expect_end s i; res let of_string_exn s = let p, quad = _of_string_exn s in make p quad let of_string s = try_with_result of_string_exn s let _of_netmask_exn ~netmask address = let rec find_greatest_one bits i = if bits = 0_l then i - 1 else find_greatest_one (bits >|> 1) (i + 1) in let one = netmask &&& Int32.neg netmask in let sz = 32 - find_greatest_one one (if one = 0_l then 33 else 0) in if netmask <> mask sz then raise (Parse_error ("invalid netmask", to_string netmask)) else make sz address let of_netmask_exn ~netmask ~address = _of_netmask_exn ~netmask address let of_netmask ~netmask ~address = try_with_result (_of_netmask_exn ~netmask) address let to_buffer buf (pre, sz) = Printf.bprintf buf "%a/%d" to_buffer pre sz let to_string subnet = let b = Buffer.create 18 in to_buffer b subnet; Buffer.contents b let pp ppf i = Format.fprintf ppf "%s" (to_string i) let mem ip (pre, sz) = let m = mask sz in ip &&& m = (pre &&& m) let subset ~subnet:(pre1, sz1) ~network:(pre2, sz2) = sz1 >= sz2 && mem pre1 (pre2, sz2) let of_addr ip = make 32 ip let global = make 0 (ip 0 0 0 0) let relative = make 8 (ip 0 0 0 0) let loopback = make 8 (ip 127 0 0 0) let link = make 16 (ip 169 254 0 0) let multicast = make 4 (ip 224 0 0 0) let multicast_org = make 14 (ip 239 192 0 0) let multicast_admin = make 16 (ip 239 255 0 0) let multicast_link = make 24 (ip 224 0 0 0) (* http://tools.ietf.org/html/rfc2365 *) let private_10 = make 8 (ip 10 0 0 0) let private_172 = make 12 (ip 172 16 0 0) let private_192 = make 16 (ip 192 168 0 0) let private_blocks = [ loopback; link; private_10; private_172; private_192 ] let broadcast (pre, sz) = Int32.logor pre (Int32.logxor (mask sz) 0xFF_FF_FF_FFl) let network (pre, sz) = pre &&& mask sz let address (addr, _) = addr let bits (_, sz) = sz let netmask subnet = mask (bits subnet) let first ((_, sz) as cidr) = if sz > 30 then network cidr else network cidr |> succ |> failwith_msg let last ((_, sz) as cidr) = if sz > 30 then broadcast cidr else broadcast cidr |> pred |> failwith_msg end (* TODO: this could be optimized with something trie-like *) let scope i = let mem = Prefix.mem i in if mem Prefix.loopback then Interface else if mem Prefix.link then Link else if List.exists mem Prefix.private_blocks then Organization else if i = unspecified then Point else if i = broadcast then Admin else if mem Prefix.relative then Admin else if mem Prefix.multicast then if mem Prefix.multicast_org then Organization else if mem Prefix.multicast_admin then Admin else if mem Prefix.multicast_link then Link else Global else Global let is_global i = scope i = Global let is_multicast i = Prefix.(mem i multicast) let is_private i = scope i <> Global module Set = Set.Make (struct type nonrec t = t let compare (a : t) (b : t) = compare a b end) module Map = Map.Make (struct type nonrec t = t let compare (a : t) (b : t) = compare a b end) end module B128 = struct let int_of_hex_char c = match c with | '0' .. '9' -> Char.code c - 48 | 'a' .. 'f' -> Char.code c - 87 | 'A' .. 'F' -> Char.code c - 55 | _ -> invalid_arg "char is not a valid hex digit" exception Overflow type t = Bytes.t let zero () = Bytes.make 16 '\x00' let max_int () = Bytes.make 16 '\xff' let compare = Bytes.compare let fold_left f a b = let a' = ref a in for i = 0 to 15 do let x' = Bytes.get_uint8 b i in a' := f !a' x' done; !a' let iteri_right2 f x y = for i = 15 downto 0 do let x' = Bytes.get_uint8 x i in let y' = Bytes.get_uint8 y i in f i x' y' done let of_string_exn s = let l = String.length s in if l != 32 then invalid_arg "not 32 chars long" else let b = zero () in let bi = ref 15 in let i = ref (l - 1) in while !i >= 0 do let x = int_of_hex_char (String.get s !i) in let y = int_of_hex_char (String.get s (!i - 1)) in Bytes.set_uint8 b !bi ((y lsl 4) + x); i := !i - 2; bi := !bi - 1 done; b let to_string b = let l = ref [] in for i = 15 downto 0 do l := Printf.sprintf "%.2x" (Bytes.get_uint8 b i) :: !l done; String.concat "" !l [@@ocaml.warning "-32"] (* used in the tests *) let of_int64 (a, b) = let b' = zero () in Bytes.set_int64_be b' 0 a; Bytes.set_int64_be b' 8 b; b' let to_int64 b = (Bytes.get_int64_be b 0, Bytes.get_int64_be b 8) let of_int32 (a, b, c, d) = let b' = zero () in Bytes.set_int32_be b' 0 a; Bytes.set_int32_be b' 4 b; Bytes.set_int32_be b' 8 c; Bytes.set_int32_be b' 12 d; b' let to_int32 b = ( Bytes.get_int32_be b 0, Bytes.get_int32_be b 4, Bytes.get_int32_be b 8, Bytes.get_int32_be b 12 ) let of_int16 (a, b, c, d, e, f, g, h) = let b' = zero () in Bytes.set_uint16_be b' 0 a; Bytes.set_uint16_be b' 2 b; Bytes.set_uint16_be b' 4 c; Bytes.set_uint16_be b' 6 d; Bytes.set_uint16_be b' 8 e; Bytes.set_uint16_be b' 10 f; Bytes.set_uint16_be b' 12 g; Bytes.set_uint16_be b' 14 h; b' let to_int16 b = ( Bytes.get_uint16_be b 0, Bytes.get_uint16_be b 2, Bytes.get_uint16_be b 4, Bytes.get_uint16_be b 6, Bytes.get_uint16_be b 8, Bytes.get_uint16_be b 10, Bytes.get_uint16_be b 12, Bytes.get_uint16_be b 14 ) let add_exn x y = let b = zero () in let carry = ref 0 in iteri_right2 (fun i x' y' -> let sum = x' + y' + !carry in if sum >= 256 then ( carry := 1; Bytes.set_uint8 b i (sum - 256)) else ( carry := 0; Bytes.set_uint8 b i sum)) x y; if !carry <> 0 then raise Overflow else b let sub_exn x y = if Bytes.compare x y = -1 then raise Overflow else let b = zero () in let carry = ref 0 in iteri_right2 (fun i x' y' -> if x' < y' then ( Bytes.set_uint8 b i (256 + x' - y' - !carry); carry := 1) else ( Bytes.set_uint8 b i (x' - y' - !carry); carry := 0)) x y; if !carry <> 0 then raise Overflow else b let logand x y = let b = zero () in iteri_right2 (fun i x y -> Bytes.set_uint8 b i (x land y)) x y; b let logor x y = let b = zero () in iteri_right2 (fun i x y -> Bytes.set_uint8 b i (x lor y)) x y; b let lognot x = let b = zero () in Bytes.iteri (fun i _ -> Bytes.set_uint8 b i (lnot (Bytes.get_uint8 x i))) x; b module Byte = struct (* Extract the [n] least significant bits from [i] *) let get_lsbits n i = if n <= 0 || n > 8 then invalid_arg "out of bounds"; i land ((1 lsl n) - 1) (* Extract the [n] most significant bits from [i] *) let get_msbits n i = if n <= 0 || n > 8 then invalid_arg "out of bounds"; (i land (255 lsl (8 - n))) lsr (8 - n) (* Set value [x] in [i]'s [n] most significant bits *) let set_msbits n x i = if n < 0 || n > 8 then raise (Invalid_argument "n must be >= 0 && <= 8") else if n = 0 then i else if n = 8 then x else (x lsl (8 - n)) lor i (* set bits are represented as true *) let fold_left f a i = let bitmask = ref 0b1000_0000 in let a' = ref a in for _ = 0 to 7 do a' := f !a' (i land !bitmask > 0); bitmask := !bitmask lsr 1 done; !a' end let shift_right x n = match n with | 0 -> x | 128 -> zero () | n when n > 0 && n < 128 -> let b = zero () in let shift_bytes, shift_bits = (n / 8, n mod 8) in (if shift_bits = 0 then Bytes.blit x 0 b shift_bytes (16 - shift_bytes) else let carry = ref 0 in for i = 0 to 15 - shift_bytes do let x' = Bytes.get_uint8 x i in let new_carry = Byte.get_lsbits shift_bits x' in let shifted_value = x' lsr shift_bits in let new_value = Byte.set_msbits shift_bits !carry shifted_value in Bytes.set_uint8 b (i + shift_bytes) new_value; carry := new_carry done); b | _ -> raise (Invalid_argument "n must be >= 0 && <= 128") let shift_left x n = match n with | 0 -> x | 128 -> zero () | n when n > 0 && n < 128 -> let b = zero () in let shift_bytes, shift_bits = (n / 8, n mod 8) in (if shift_bits = 0 then Bytes.blit x shift_bytes b 0 (16 - shift_bytes) else let carry = ref 0 in for i = 15 downto 0 + shift_bytes do let x' = Bytes.get_uint8 x i in let new_carry = Byte.get_msbits shift_bits x' in let shifted_value = x' lsl shift_bits in let new_value = shifted_value lor !carry in Bytes.set_uint8 b (i - shift_bytes) new_value; carry := new_carry done); b | _ -> raise (Invalid_argument "n must be >= 0 && <= 128") let write_octets_exn ?(off = 0) b' byte = if Bytes.length b' + off > Bytes.length byte then raise (Parse_error ("larger including offset than target bytes", Bytes.to_string b')) else Bytes.blit b' 0 byte off (Bytes.length b') let succ b = try Ok (add_exn b (of_string_exn "00000000000000000000000000000001")) with Overflow -> Error (`Msg "Ipaddr: highest address has been reached") let pred b = try Ok (sub_exn b (of_string_exn "00000000000000000000000000000001")) with Overflow | Invalid_argument _ -> Error (`Msg "Ipaddr: lowest address has been reached") end module V6 = struct include B128 let make a b c d e f g h = of_int16 (a, b, c, d, e, f, g, h) (* parsing *) let parse_ipv6 s i = let compressed = ref false in (* :: *) let len = String.length s in if len < !i + 1 then raise (need_more s); let use_bracket = s.[!i] = '[' in if use_bracket then incr i; if len < !i + 2 then raise (need_more s); (* check if it starts with :: *) let l = if s.[!i] = ':' then ( incr i; if s.[!i] = ':' then ( compressed := true; incr i; [ -1 ]) else raise (bad_char !i s)) else [] in let rec loop nb acc = if nb >= 8 then acc else if !i >= len then acc else let pos = !i in let x = try parse_hex_int s i with _ -> -1 in if x < 0 then acc else if nb = 7 then x :: acc else if !i < len && s.[!i] = ':' then ( incr i; if !i < len then if s.[!i] = ':' then if !compressed then ( decr i; x :: acc (* trailing :: *)) else ( compressed := true; incr i; loop (nb + 2) (-1 :: x :: acc)) else if is_number 16 (int_of_char s.[!i]) then loop (nb + 1) (x :: acc) else raise (bad_char !i s) else raise (need_more s)) else if !i < len && s.[!i] = '.' then ( i := pos; let v4 = V4.of_string_raw s i in let hi, lo = V4.to_int16 v4 in lo :: hi :: acc) else x :: acc in let res = loop (List.length l) l in let res_len = List.length res in if res_len > 8 then raise (Parse_error ("too many components", s)) else if res_len = 0 then raise (need_more s) else let a = Array.make 8 0 in let missing = if !compressed then 8 - (res_len - 1) else if res_len <> 8 then if !i < len then raise (bad_char !i s) else raise (need_more s) else 0 in let _ = List.fold_left (fun i x -> if x = -1 then i - missing else ( if x land 0xffff <> x then raise (Parse_error (Printf.sprintf "component %d out of bounds" i, s)); a.(i) <- x; i - 1)) 7 res in if use_bracket then expect_char s i ']'; a (* string conversion *) let of_string_raw s offset = let a = parse_ipv6 s offset in make a.(0) a.(1) a.(2) a.(3) a.(4) a.(5) a.(6) a.(7) let of_string_exn s = let o = ref 0 in let x = of_string_raw s o in expect_end s o; x let of_string s = try_with_result of_string_exn s let with_port_of_string ~default s = let len = String.length s and o = ref 0 in try let ipv6 = of_string_raw s o in if !o < len && s.[!o] = ':' then ( incr o; let port = parse_dec_int s o in expect_end s o; Ok (ipv6, port)) else ( expect_end s o; Ok (ipv6, default)) with Parse_error (msg, _) -> Error (`Msg ("Ipaddr: " ^ msg)) (* http://tools.ietf.org/html/rfc5952 *) let to_buffer buf addr = let ((a, b, c, d, e, f, g, h) as comp) = to_int16 addr in let v4 = match comp with 0, 0, 0, 0, 0, 0xffff, _, _ -> true | _ -> false in let rec loop elide zeros acc = function | 0 :: xs -> loop elide (zeros - 1) acc xs | n :: xs when zeros = 0 -> loop elide 0 (n :: acc) xs | n :: xs -> loop (min elide zeros) 0 (n :: zeros :: acc) xs | [] -> let elide = min elide zeros in ( (if elide < -1 then Some elide else None), if zeros = 0 then acc else zeros :: acc ) in let elide, l = loop 0 0 [] [ h; g; f; e; d; c; b; a ] in assert (match elide with Some x when x < -8 -> false | _ -> true); let rec cons_zeros l x = if x >= 0 then l else cons_zeros (Some 0 :: l) (x + 1) in let _, lrev = List.fold_left (fun (patt, l) x -> if Some x = patt then (None, None :: l) else if x < 0 then (patt, cons_zeros l x) else (patt, Some x :: l)) (elide, []) l in let rec fill = function | [ Some hi; Some lo ] when v4 -> let addr = V4.of_int16 (hi, lo) in V4.to_buffer buf addr | None :: xs -> Buffer.add_string buf "::"; fill xs | [ Some n ] -> Printf.bprintf buf "%x" n | Some n :: None :: xs -> Printf.bprintf buf "%x::" n; fill xs | Some n :: xs -> Printf.bprintf buf "%x:" n; fill xs | [] -> () in fill (List.rev lrev) let to_string l = let buf = Buffer.create 39 in to_buffer buf l; Buffer.contents buf let pp ppf i = Format.fprintf ppf "%s" (to_string i) (* byte conversion *) let of_octets_exn ?(off = 0) bs = if String.length bs - off < 16 then raise (need_more bs) else let b = B128.zero () in Bytes.blit_string bs off b 0 16; b let of_octets ?off bs = try_with_result (of_octets_exn ?off) bs let write_octets ?off i bs = try_with_result (write_octets_exn ?off i) bs let to_octets = Bytes.to_string (* MAC *) (* {{:https://tools.ietf.org/html/rfc2464#section-7}RFC 2464}. *) let multicast_to_mac b = let macb = Bytes.make 6 (Char.chr 0x33) in Bytes.blit b 12 macb 2 4; Macaddr.of_octets_exn (Bytes.to_string macb) (* Host *) let to_domain_name b = let hexstr_of_int = Printf.sprintf "%x" in let rec aux_fold_left a i = if i = 16 then a else let x = hexstr_of_int (Bytes.get_uint8 b i land ((1 lsl 4) - 1)) in let y = hexstr_of_int (Bytes.get_uint8 b i lsr 4) in aux_fold_left (x :: y :: a) (i + 1) in let name = aux_fold_left [ "ip6"; "arpa" ] 0 in Domain_name.(host_exn (of_strings_exn name)) let of_domain_name n = let int_of_char_string = function | "0" -> 0 | "1" -> 1 | "2" -> 2 | "3" -> 3 | "4" -> 4 | "5" -> 5 | "6" -> 6 | "7" -> 7 | "8" -> 8 | "9" -> 9 | "a" -> 10 | "b" -> 11 | "c" -> 12 | "d" -> 13 | "e" -> 14 | "f" -> 15 | _ -> failwith "int_of_char_string: invalid hexadecimal string" in let labels = Domain_name.to_array n in if Array.length labels = 34 && Domain_name.equal_label labels.(0) "arpa" && Domain_name.equal_label labels.(1) "ip6" then let b = B128.zero () in let bi = ref 0 in let i = ref 2 in try while !i <= 32 do let x = int_of_char_string labels.(!i) in let y = int_of_char_string labels.(!i + 1) in Bytes.set_uint8 b !bi (Int.logor (Int.shift_left x 4) y); bi := !bi + 1; i := !i + 2 done; Some b with Failure _ -> None else None (* constant *) let unspecified = make 0 0 0 0 0 0 0 0 let localhost = make 0 0 0 0 0 0 0 1 let interface_nodes = make 0xff01 0 0 0 0 0 0 1 let link_nodes = make 0xff02 0 0 0 0 0 0 1 let interface_routers = make 0xff01 0 0 0 0 0 0 2 let link_routers = make 0xff02 0 0 0 0 0 0 2 let site_routers = make 0xff05 0 0 0 0 0 0 2 module Prefix = struct type addr = t type t = addr * int let compare (pre, sz) (pre', sz') = let c = compare pre pre' in if c = 0 then Stdlib.compare sz sz' else c let ip = make let mask sz = shift_left (max_int ()) (128 - sz) let prefix (pre, sz) = (logand pre (mask sz), sz) let make sz pre = (pre, sz) let network_address (pre, sz) addr = logor (logand pre (mask sz)) (logand addr (lognot (mask sz))) let _of_string_raw s i = let v6 = of_string_raw s i in expect_char s i '/'; let p = parse_dec_int s i in if p > 128 || p < 0 then raise (Parse_error ("invalid prefix size", s)); (p, v6) let of_string_raw s i = let p, v6 = _of_string_raw s i in make p v6 let _of_string_exn s = let i = ref 0 in let res = _of_string_raw s i in expect_end s i; res let of_string_exn s = let p, v6 = _of_string_exn s in make p v6 let of_string s = try_with_result of_string_exn s let _of_netmask_exn ~netmask address = let count_bits bits is_last_bit_set i = B128.Byte.fold_left (fun (a, is_last_bit_set) e -> match (is_last_bit_set, e) with | true, false | false, false -> (a, false) | true, true -> (a + 1, true) | false, true -> (* netmask is not contiguous *) raise (Parse_error ("invalid netmask", to_string netmask))) (bits, is_last_bit_set) i in let nm_bits_set, _ = B128.fold_left (fun (a, is_last_bit_set) e -> count_bits a is_last_bit_set e) (0, true) netmask in make nm_bits_set address let of_netmask_exn ~netmask ~address = _of_netmask_exn ~netmask address let of_netmask ~netmask ~address = try_with_result (_of_netmask_exn ~netmask) address let to_buffer buf (pre, sz) = Printf.bprintf buf "%a/%d" to_buffer pre sz let to_string subnet = let buf = Buffer.create 43 in to_buffer buf subnet; Buffer.contents buf let pp ppf i = Format.fprintf ppf "%s" (to_string i) let mem ip (pre, sz) = let m = mask sz in logand ip m = logand pre m let subset ~subnet:(pre1, sz1) ~network:(pre2, sz2) = sz1 >= sz2 && mem pre1 (pre2, sz2) let of_addr ip = make 128 ip let global_unicast_001 = make 3 (ip 0x2000 0 0 0 0 0 0 0) let link = make 64 (ip 0xfe80 0 0 0 0 0 0 0) let unique_local = make 7 (ip 0xfc00 0 0 0 0 0 0 0) let multicast = make 8 (ip 0xff00 0 0 0 0 0 0 0) let ipv4_mapped = make 96 (ip 0 0 0 0 0 0xffff 0 0) let noneui64_interface = make 3 (ip 0x0000 0 0 0 0 0 0 0) let solicited_node = make 104 (ip 0xff02 0 0 0 0 1 0xff00 0) let network (pre, sz) = logand pre (mask sz) let address (addr, _) = addr let bits (_, sz) = sz let netmask subnet = mask (bits subnet) let first ((_, sz) as cidr) = if sz > 126 then network cidr else network cidr |> succ |> failwith_msg let last ((_, sz) as cidr) = let ffff = B128.max_int () in logor (network cidr) (B128.shift_right ffff sz) end (* TODO: This could be optimized with something trie-like *) let scope i = let mem = Prefix.mem i in if mem Prefix.global_unicast_001 then Global else if mem Prefix.ipv4_mapped (* rfc says they are technically global but... *) then V4.scope (let _, _, _, v4 = to_int32 i in V4.of_int32 v4) else if mem Prefix.multicast then let x, _, _, _, _, _, _, _ = to_int16 i in match x land 0xf with | 0 -> Point | 1 -> Interface | 2 | 3 -> Link | 4 -> Admin | 5 | 6 | 7 -> Site | 8 | 9 | 10 | 11 | 12 | 13 -> Organization | 14 | 15 -> Global | _ -> assert false else if mem Prefix.link then Link else if mem Prefix.unique_local then Global else if i = localhost then Interface else if i = unspecified then Point else Global let link_address_of_mac = let c b i = Char.code b.[i] in fun mac -> let bmac = Macaddr.to_octets mac in let c_0 = c bmac 0 lxor 2 in let addr = make 0 0 0 0 ((c_0 lsl 8) + c bmac 1) ((c bmac 2 lsl 8) + 0xff) (0xfe00 + c bmac 3) ((c bmac 4 lsl 8) + c bmac 5) in Prefix.(network_address link addr) let is_global i = scope i = Global let is_multicast i = Prefix.(mem i multicast) let is_private i = scope i <> Global module Set = Set.Make (struct type nonrec t = t let compare (a : t) (b : t) = compare a b end) module Map = Map.Make (struct type nonrec t = t let compare (a : t) (b : t) = compare a b end) end type ('v4, 'v6) v4v6 = V4 of 'v4 | V6 of 'v6 type t = (V4.t, V6.t) v4v6 let compare a b = match (a, b) with | V4 a, V4 b -> V4.compare a b | V6 a, V6 b -> V6.compare a b | V4 _, V6 _ -> -1 | V6 _, V4 _ -> 1 module Set = Set.Make (struct type nonrec t = t let compare (a : t) (b : t) = compare a b end) module Map = Map.Make (struct type nonrec t = t let compare (a : t) (b : t) = compare a b end) let to_string = function V4 x -> V4.to_string x | V6 x -> V6.to_string x let to_buffer buf = function | V4 x -> V4.to_buffer buf x | V6 x -> V6.to_buffer buf x let pp ppf i = Format.fprintf ppf "%s" (to_string i) let of_string_raw s offset = let len = String.length s in if len < !offset + 1 then raise (need_more s); match s.[0] with | '[' -> V6 (V6.of_string_raw s offset) | _ -> ( let pos = !offset in try V4 (V4.of_string_raw s offset) with Parse_error (v4_msg, _) -> ( offset := pos; try V6 (V6.of_string_raw s offset) with Parse_error (v6_msg, s) -> let msg = Printf.sprintf "not an IPv4 address: %s\nnot an IPv6 address: %s" v4_msg v6_msg in raise (Parse_error (msg, s)))) let of_string_exn s = let o = ref 0 in let x = of_string_raw s o in expect_end s o; x let of_string s = try_with_result of_string_exn s let with_port_of_string ~default s = let len = String.length s and o = ref 0 in try let ipv6 = of_string_raw s o in if !o < len && s.[!o] = ':' then ( incr o; let port = parse_dec_int s o in expect_end s o; Ok (ipv6, port)) else ( expect_end s o; Ok (ipv6, default)) with Parse_error (msg, _) -> Error (`Msg ("Ipaddr: " ^ msg)) let of_octets_exn bs = match String.length bs with | 4 -> V4 (V4.of_octets_exn bs) | 16 -> V6 (V6.of_octets_exn bs) | _ -> raise (Parse_error ("octets must be of length 4 or 16", bs)) let of_octets bs = try_with_result of_octets_exn bs let to_octets i = match i with V4 p -> V4.to_octets p | V6 p -> V6.to_octets p let v6_of_v4 v4 = V6.(Prefix.(network_address ipv4_mapped (of_int32 (0l, 0l, 0l, v4)))) let v4_of_v6 v6 = if V6.Prefix.(mem v6 ipv4_mapped) then let _, _, _, v4 = V6.to_int32 v6 in Some V4.(of_int32 v4) else None let to_v4 = function V4 v4 -> Some v4 | V6 v6 -> v4_of_v6 v6 let to_v6 = function V4 v4 -> v6_of_v4 v4 | V6 v6 -> v6 let scope = function V4 v4 -> V4.scope v4 | V6 v6 -> V6.scope v6 let is_global = function V4 v4 -> V4.is_global v4 | V6 v6 -> V6.is_global v6 let is_multicast = function | V4 v4 -> V4.is_multicast v4 | V6 v6 -> V6.is_multicast v6 let is_private = function | V4 v4 -> V4.is_private v4 | V6 v6 -> V6.is_private v6 let multicast_to_mac = function | V4 v4 -> V4.multicast_to_mac v4 | V6 v6 -> V6.multicast_to_mac v6 let to_domain_name = function | V4 v4 -> V4.to_domain_name v4 | V6 v6 -> V6.to_domain_name v6 let of_domain_name n = match Domain_name.count_labels n with | 6 -> ( match V4.of_domain_name n with None -> None | Some x -> Some (V4 x)) | 34 -> ( match V6.of_domain_name n with None -> None | Some x -> Some (V6 x)) | _ -> None let succ = function | V4 addr -> map_result (V4.succ addr) (fun v -> V4 v) | V6 addr -> map_result (V6.succ addr) (fun v -> V6 v) let pred = function | V4 addr -> map_result (V4.pred addr) (fun v -> V4 v) | V6 addr -> map_result (V6.pred addr) (fun v -> V6 v) module Prefix = struct module Addr = struct let to_v6 = to_v6 end type addr = t type t = (V4.Prefix.t, V6.Prefix.t) v4v6 let compare a b = match (a, b) with | V4 a, V4 b -> V4.Prefix.compare a b | V6 a, V6 b -> V6.Prefix.compare a b | V4 _, V6 _ -> -1 | V6 _, V4 _ -> 1 let of_string_raw s offset = let len = String.length s in if len < !offset + 1 then raise (need_more s); match s.[0] with | '[' -> V6 (V6.Prefix.of_string_raw s offset) | _ -> ( let pos = !offset in try V4 (V4.Prefix.of_string_raw s offset) with Parse_error (v4_msg, _) -> ( offset := pos; try V6 (V6.Prefix.of_string_raw s offset) with Parse_error (v6_msg, s) -> let msg = Printf.sprintf "not an IPv4 prefix: %s\nnot an IPv6 prefix: %s" v4_msg v6_msg in raise (Parse_error (msg, s)))) let of_string_exn s = let o = ref 0 in let x = of_string_raw s o in expect_end s o; x let of_string s = try_with_result of_string_exn s let v6_of_v4 v4 = V6.Prefix.make (96 + V4.Prefix.bits v4) (v6_of_v4 (V4.Prefix.network v4)) let v4_of_v6 v6 = match v4_of_v6 (V6.Prefix.network v6) with | Some v4 -> Some (V4.Prefix.make (V6.Prefix.bits v6 - 96) v4) | None -> None let to_v4 = function V4 v4 -> Some v4 | V6 v6 -> v4_of_v6 v6 let to_v6 = function V4 v4 -> v6_of_v4 v4 | V6 v6 -> v6 let mem ip prefix = V6.Prefix.mem (Addr.to_v6 ip) (to_v6 prefix) let subset ~subnet ~network = V6.Prefix.subset ~subnet:(to_v6 subnet) ~network:(to_v6 network) let of_addr = function | V4 p -> V4 (V4.Prefix.of_addr p) | V6 p -> V6 (V6.Prefix.of_addr p) let to_string = function | V4 p -> V4.Prefix.to_string p | V6 p -> V6.Prefix.to_string p let to_buffer buf = function | V4 p -> V4.Prefix.to_buffer buf p | V6 p -> V6.Prefix.to_buffer buf p let network = function | V4 p -> V4 (V4.Prefix.network p) | V6 p -> V6 (V6.Prefix.network p) let netmask = function | V4 p -> V4 (V4.Prefix.netmask p) | V6 p -> V6 (V6.Prefix.netmask p) let pp ppf i = Format.fprintf ppf "%s" (to_string i) let first = function | V4 p -> V4 (V4.Prefix.first p) | V6 p -> V6 (V6.Prefix.first p) let last = function | V4 p -> V4 (V4.Prefix.last p) | V6 p -> V6 (V6.Prefix.last p) end ocaml-ipaddr-5.5.0/lib/ipaddr.mli000066400000000000000000000672061441155524600166130ustar00rootroot00000000000000(* * Copyright (c) 2019 Anil Madhavapeddy * Copyright (c) 2013-2015 David Sheets * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. * *) (** A library for manipulation of IP address representations. {e %%VERSION%% - {{:%%PKG_HOMEPAGE%%} homepage}} *) exception Parse_error of string * string (** [Parse_error (err,packet)] is raised when parsing of the IP address syntax fails. [err] contains a human-readable error and [packet] is the original octet list that failed to parse. *) (** Type of ordered address scope classifications *) type scope = Point | Interface | Link | Admin | Site | Organization | Global val string_of_scope : scope -> string (** [string_of_scope scope] returns a human-readable representation of {!scope}. *) val scope_of_string : string -> (scope, [> `Msg of string ]) result (** [scope_of_string s] returns a {!scope} from a string representation of [s]. Valid string values for [s] can be obtained via {!string_of_scope}. *) val pp_scope : Format.formatter -> scope -> unit [@@ocaml.toplevel_printer] (** [pp_scope fmt scope] outputs a human-readable representation of {!scope} to the [fmt] formatter. *) (** A collection of functions for IPv4 addresses. *) module V4 : sig type t (** Type of the internet protocol v4 address of a host *) val make : int -> int -> int -> int -> t (** Converts the low bytes of four int values into an abstract {!V4.t}. *) (** {3 Text string conversion} These manipulate human-readable IPv4 addresses (for example [192.168.1.2]). *) val of_string : string -> (t, [> `Msg of string ]) result (** [of_string s] is the address {!t} represented by the human-readable IPv4 address [s]. Returns a human-readable error string if parsing failed. *) val of_string_exn : string -> t (** [of_string_exn s] is the address {!t} represented as a human-readable IPv4 address [s]. Raises {!Parse_error} if [s] is not exactly 4 bytes long. *) val of_string_raw : string -> int ref -> t (** [of_string_raw s off] acts as {!of_string_exn} but takes as an extra argument the offset into the string for reading. [off] will be mutated to an unspecified value during the function call. [s] will a {!Parse_error} exception if it is an invalid or truncated IP address. *) val with_port_of_string : default:int -> string -> (t * int, [> `Msg of string ]) result (** [with_port_of_string ~default s] is the address {!t} represented by the human-readble IPv4 address [s] with a possibly port [:] (otherwise, we take the [default] value). *) val to_string : t -> string (** [to_string ipv4] is the dotted decimal string representation of [ipv4], i.e. [XXX.XX.X.XXX]. *) val to_buffer : Buffer.t -> t -> unit (** [to_buffer buf ipv4] writes the string representation of [ipv4] into the buffer [buf]. *) val pp : Format.formatter -> t -> unit [@@ocaml.toplevel_printer] (** [pp f ipv4] outputs a human-readable representation of [ipv4] to the formatter [f]. *) (** {3 Octets conversion} These manipulate IPv4 addresses represented as a sequence of four bytes. (e.g for example [0xc0a80102] will be the representation of the human-readable [192.168.1.2] address. *) val of_octets : ?off:int -> string -> (t, [> `Msg of string ]) result (** [of_octets ?off s] is the address {!t} represented by the IPv4 octets represented by [s] starting from offset [off] within the string. [s] must be at least [off+4] bytes long. Returns a human-readable error string if parsing fails. [off] defaults to 0. *) val of_octets_exn : ?off:int -> string -> t (** [of_octets_exn ipv4_octets] is the IPv4 address represented by [ipv4_octets] starting from offset [off] within the string. Raises {!Parse_error} if [ipv4_octets] is not at least [off+4] bytes long. [off] defaults to 0. *) val write_octets : ?off:int -> t -> bytes -> (unit, [> `Msg of string ]) result (** [write_octets ?off ipv4 b] writes the [ipv4] as octets to [b] starting from offset [off]. [b] must be at least [off+4] long or an error is returned. *) val write_octets_exn : ?off:int -> t -> bytes -> unit (** [write_octets_exn ?off ipv4 b] writes the [ipv4] as octets to [b] starting from offset [off]. [b] must be at least [off+4] long or a {!Parse_error} is raised. *) val to_octets : t -> string (** [to_octets ipv4] returns the 4 bytes representing the [ipv4] octets. *) (** {3 Int conversion} *) val of_int32 : int32 -> t (** [of_int32 ipv4_packed] is the address represented by [ipv4_packed]. *) val to_int32 : t -> int32 (** [to_int32 ipv4] is the 32-bit packed encoding of [ipv4]. *) val of_int16 : int * int -> t (** [of_int16 ipv4_packed] is the address represented by [ipv4_packed]. *) val to_int16 : t -> int * int (** [to_int16 ipv4] is the 16-bit packed encoding of [ipv4]. *) (** {3 MAC conversion} *) val multicast_to_mac : t -> Macaddr.t (** [multicast_to_mac ipv4] is the MAC address corresponding to the multicast address [ipv4]. Described by {{:http://tools.ietf.org/html/rfc1112#section-6.2} RFC 1112}. *) (** {3 Host conversion} *) val to_domain_name : t -> [ `host ] Domain_name.t (** [to_domain_name ipv4] is the domain name label list for reverse lookups of [ipv4]. This includes the [.in-addr.arpa] suffix. *) val of_domain_name : 'a Domain_name.t -> t option (** [of_domain_name name] is [Some t] if the [name] has an [.in-addr.arpa] suffix, and an IPv4 address prefixed. *) (** {3 Utility functions} *) val succ : t -> (t, [> `Msg of string ]) result (** [succ ipv4] is ip address next to [ipv4]. Returns a human-readable error string if it's already the highest address. *) val pred : t -> (t, [> `Msg of string ]) result (** [pred ipv4] is ip address before [ipv4]. Returns a human-readable error string if it's already the lowest address. *) (** {3 Common addresses} *) val any : t (** [any] is 0.0.0.0. *) val unspecified : t (** [unspecified] is 0.0.0.0. *) val broadcast : t (** [broadcast] is 255.255.255.255. *) val nodes : t (** [nodes] is 224.0.0.1. *) val routers : t (** [routers] is 224.0.0.2. *) val localhost : t (** [localhost] is 127.0.0.1. *) (** A module for manipulating IPv4 network prefixes (CIDR). *) module Prefix : sig type addr = t type t (** Type of a internet protocol subnet: an address and prefix length. *) val mask : int -> addr (** [mask n] is the pseudo-address of an [n] bit subnet mask. *) val make : int -> addr -> t (** [make n addr] is the cidr of [addr] with [n] bits prefix. *) val prefix : t -> t (** [prefix cidr] is the subnet prefix of [cidr] where all non-prefix bits set to 0. *) val network_address : t -> addr -> addr (** [network_address cidr addr] is the address with prefix [cidr] and suffix from [addr]. See . *) val of_string : string -> (t, [> `Msg of string ]) result (** [of_string cidr] is the subnet prefix represented by the CIDR string, [cidr]. Returns a human-readable parsing error message if [cidr] is not a valid representation of a CIDR notation routing prefix. *) val of_string_exn : string -> t (** [of_string_exn cidr] is the subnet prefix represented by the CIDR string, [cidr]. Raises [Parse_error] if [cidr] is not a valid representation of a CIDR notation routing prefix. *) val of_string_raw : string -> int ref -> t (** Same as {!of_string_exn} but takes as an extra argument the offset into the string for reading. *) val to_string : t -> string (** [to_string cidr] is the CIDR notation string representation of [cidr], i.e. [XXX.XX.X.XXX/XX]. *) val pp : Format.formatter -> t -> unit [@@ocaml.toplevel_printer] (** [pp f cidr] outputs a human-readable representation of [cidr] to the formatter [f]. *) val to_buffer : Buffer.t -> t -> unit (** [to_buffer buf cidr] writes the string representation of [cidr] into the buffer [buf]. *) val of_netmask_exn : netmask:addr -> address:addr -> t (** [of_netmask_exn ~netmask ~address] is the subnet prefix of [address] with netmask [netmask]. *) val of_netmask : netmask:addr -> address:addr -> (t, [> `Msg of string ]) result (** [of_netmask ~netmask ~address] is the cidr of [address] with netmask [netmask]. *) val mem : addr -> t -> bool (** [mem ip subnet] checks whether [ip] is found within [subnet]. *) val subset : subnet:t -> network:t -> bool (** [subset ~subnet ~network] checks whether [subnet] is contained within [network]. *) val of_addr : addr -> t (** [of_addr ip] create a subnet composed of only one address, [ip]. It is the same as [make 32 ip]. *) val global : t (** The default route, all addresses in IPv4-space, 0.0.0.0/0. *) val loopback : t (** The host loopback network, 127.0.0.0/8. *) val link : t (** The local-link network, 169.254.0.0/16. *) val relative : t (** The relative addressing network, 0.0.0.0/8. *) val multicast : t (** The multicast network, 224.0.0.0/4. *) val private_10 : t (** The private subnet with 10 as first octet, 10.0.0.0/8. *) val private_172 : t (** The private subnet with 172 as first octet, 172.16.0.0/12. *) val private_192 : t (** The private subnet with 192 as first octet, 192.168.0.0/16. *) val private_blocks : t list (** The privately addressable networks: [loopback], [link], [private_10], [private_172], [private_192]. *) val broadcast : t -> addr (** [broadcast subnet] is the broadcast address for [subnet]. *) val network : t -> addr (** [network subnet] is the address for [subnet]. *) val netmask : t -> addr (** [netmask subnet] is the netmask for [subnet]. *) val address : t -> addr (** [address cidr] is the address for [cidr]. *) val bits : t -> int (** [bits cidr] is the bit size of the [cidr] prefix. *) val first : t -> addr (** [first cidr] is first valid unicast address in this [cidr]. *) val last : t -> addr (** [last cidr] is last valid unicast address in this [cidr]. *) include Map.OrderedType with type t := t end val scope : t -> scope (** [scope ipv4] is the classification of [ipv4] by the {!scope} hierarchy. *) val is_global : t -> bool (** [is_global ipv4] is a predicate indicating whether [ipv4] globally addresses a node. *) val is_multicast : t -> bool (** [is_multicast ipv4] is a predicate indicating whether [ipv4] is a multicast address. *) val is_private : t -> bool (** [is_private ipv4] is a predicate indicating whether [ipv4] privately addresses a node. *) include Map.OrderedType with type t := t module Set : Set.S with type elt := t module Map : Map.S with type key := t end (** A collection of functions for IPv6 addresses. *) module V6 : sig type t (** Type of the internet protocol v6 address of a host *) val make : int -> int -> int -> int -> int -> int -> int -> int -> t (** Converts the low bytes of eight int values into an abstract {!V6.t}. *) (** {3 Text string conversion} *) val of_string_exn : string -> t (** [of_string_exn ipv6_string] is the address represented by [ipv6_string]. Raises {!Parse_error} if [ipv6_string] is not a valid representation of an IPv6 address. *) val of_string : string -> (t, [> `Msg of string ]) result (** Same as [of_string_exn] but returns an option type instead of raising an exception. *) val with_port_of_string : default:int -> string -> (t * int, [> `Msg of string ]) result (** [with_port_of_string ~default ipv6_string] is the address represented by [ipv6_string] with a possibly [:] (otherwise, we take the [default] value). Due to the [':'] separator, the user should expand [ipv6_string] to let us to consider the last [:] as a port. In other words: - [::1:8080] returns the IPv6 [::1:8080] with the [default] port - [0:0:0:0:0:0:0:1:8080] returns [::1] with the port [8080]. *) val of_string_raw : string -> int ref -> t (** Same as [of_string_exn] but takes as an extra argument the offset into the string for reading. *) val to_string : t -> string (** [to_string ipv6] is the string representation of [ipv6], i.e. [XXX:XX:X::XXX:XX]. *) val to_buffer : Buffer.t -> t -> unit (** [to_buffer buf ipv6] writes the string representation of [ipv6] into the buffer [buf]. *) val pp : Format.formatter -> t -> unit [@@ocaml.toplevel_printer] (** [pp f ipv6] outputs a human-readable representation of [ipv6] to the formatter [f]. *) (** {3 Octets conversion} *) val of_octets_exn : ?off:int -> string -> t (** [of_octets_exn ?off ipv6_octets] is the address represented by [ipv6_octets], starting from offset [off]. Raises {!Parse_error} if [ipv6_octets] is not a valid representation of an IPv6 address. *) val of_octets : ?off:int -> string -> (t, [> `Msg of string ]) result (** Same as {!of_octets_exn} but returns an result type instead of raising an exception. *) val write_octets_exn : ?off:int -> t -> bytes -> unit (** [write_octets_exn ?off ipv6 b] writes 16 bytes that encode [ipv6] into [b] starting from offset [off] within [b]. [b] must be at least [off+16] bytes long or a {!Parse_error} exception will be raised. *) val write_octets : ?off:int -> t -> bytes -> (unit, [> `Msg of string ]) result (** [write_octets ?off ipv6 b] writes 16 bytes that encode [ipv6] into [b] starting from offset [off] within [b]. [b] must be at least [off+16] bytes long or an error is returned. *) val to_octets : t -> string (** [to_octets ipv6] returns the 16 bytes representing the [ipv6] octets. *) (** {3 Int conversion} *) val of_int64 : int64 * int64 -> t (** [of_int64 (ho, lo)] is the IPv6 address represented by two int64. *) val to_int64 : t -> int64 * int64 (** [to_int64 ipv6] is the 128-bit packed encoding of [ipv6]. *) val of_int32 : int32 * int32 * int32 * int32 -> t (** [of_int32 (a, b, c, d)] is the IPv6 address represented by four int32. *) val to_int32 : t -> int32 * int32 * int32 * int32 (** [to_int32 ipv6] is the 128-bit packed encoding of [ipv6]. *) val of_int16 : int * int * int * int * int * int * int * int -> t (** [of_int16 (a, b, c, d, e, f, g, h)] is the IPv6 address represented by eight 16-bit int. *) val to_int16 : t -> int * int * int * int * int * int * int * int (** [to_int16 ipv6] is the 128-bit packed encoding of [ipv6]. *) (** {3 MAC conversion} *) val multicast_to_mac : t -> Macaddr.t (** [multicast_to_mac ipv6] is the MAC address corresponding to the multicast address [ipv6]. Described by {{:https://tools.ietf.org/html/rfc2464#section-7} RFC 2464}. *) (** {3 Host conversion} *) val to_domain_name : t -> [ `host ] Domain_name.t (** [to_domain_name ipv6] is the domain name label list for reverse lookups of [ipv6]. This includes the [.ip6.arpa] suffix. *) val of_domain_name : 'a Domain_name.t -> t option (** [of_domain_name name] is [Some t] if the [name] has an [.ip6.arpa] suffix, and an IPv6 address prefixed. *) (** {3 Utility functions} *) val succ : t -> (t, [> `Msg of string ]) result (** [succ ipv6] is ip address next to [ipv6]. Returns a human-readable error string if it's already the highest address. *) val pred : t -> (t, [> `Msg of string ]) result (** [pred ipv6] is ip address before [ipv6]. Returns a human-readable error string if it's already the lowest address. *) (** {3 Common addresses} *) val unspecified : t (** [unspecified] is ::. *) val localhost : t (** [localhost] is ::1. *) val interface_nodes : t (** [interface_nodes] is ff01::01. *) val link_nodes : t (** [link_nodes] is ff02::01. *) val interface_routers : t (** [interface_routers] is ff01::02. *) val link_routers : t (** [link_routers] is ff02::02. *) val site_routers : t (** [site_routers] is ff05::02. *) (** A module for manipulating IPv6 network prefixes (CIDR). *) module Prefix : sig type addr = t type t (** Type of a internet protocol subnet: an address and a prefix length. *) val mask : int -> addr (** [mask n] is the pseudo-address of an [n] bit subnet mask. *) val make : int -> addr -> t (** [make n addr] is the cidr of [addr] with [n] bit prefix. *) val prefix : t -> t (** [prefix cidr] is the subnet prefix of [cidr] where all non-prefix bits set to 0. *) val network_address : t -> addr -> addr (** [network_address cidr addr] is the address with prefix [cidr] and suffix from [addr]. See . *) val of_string_exn : string -> t (** [of_string_exn cidr] is the subnet prefix represented by the CIDR string, [cidr]. Raises {!Parse_error} if [cidr] is not a valid representation of a CIDR notation routing prefix. *) val of_string : string -> (t, [> `Msg of string ]) result (** Same as {!of_string_exn} but returns a result type instead of raising an exception. *) val of_string_raw : string -> int ref -> t (** Same as {!of_string_exn} but takes as an extra argument the offset into the string for reading. *) val to_string : t -> string (** [to_string cidr] is the CIDR notation string representation of [cidr], i.e. XXX:XX:X::XXX/XX. *) val pp : Format.formatter -> t -> unit [@@ocaml.toplevel_printer] (** [pp f cidr] outputs a human-readable representation of [cidr] to the formatter [f]. *) val to_buffer : Buffer.t -> t -> unit (** [to_buffer buf cidr] writes the string representation of [cidr] to the buffer [buf]. *) val of_netmask_exn : netmask:addr -> address:addr -> t (** [of_netmask_exn ~netmask ~address] is the subnet prefix of [address] with netmask [netmask]. *) val of_netmask : netmask:addr -> address:addr -> (t, [> `Msg of string ]) result (** [of_netmask ~netmask ~address] is the cidr of [address] with netmask [netmask]. *) val mem : addr -> t -> bool (** [mem ip subnet] checks whether [ip] is found within [subnet]. *) val subset : subnet:t -> network:t -> bool (** [subset ~subnet ~network] checks whether [subnet] is contained within [network]. *) val of_addr : addr -> t (** [of_addr ip] create a subnet composed of only one address, [ip]. It is the same as [make 128 ip]. *) val global_unicast_001 : t (** Global Unicast 001, 2000::/3. *) val unique_local : t (** The Unique Local Unicast (ULA), fc00::/7. *) val link : t (** Link-Local Unicast, fe80::/64. *) val multicast : t (** The multicast network, ff00::/8. *) val ipv4_mapped : t (** IPv4-mapped addresses, ::ffff:0:0/96. *) val noneui64_interface : t (** Global Unicast addresses that don't use Modified EUI64 interface identifiers, ::/3. *) val solicited_node : t (** Solicited-Node multicast addresses *) val network : t -> addr (** [network subnet] is the address for [subnet]. *) val netmask : t -> addr (** [netmask subnet] is the netmask for [subnet]. *) val address : t -> addr (** [address cidr] is the address for [cidr]. *) val bits : t -> int (** [bits subnet] is the bit size of the [subnet] prefix. *) val first : t -> addr (** [first subnet] is first valid unicast address in this [subnet]. *) val last : t -> addr (** [last subnet] is last valid unicast address in this [subnet]. *) include Map.OrderedType with type t := t end val scope : t -> scope (** [scope ipv6] is the classification of [ipv6] by the {!scope} hierarchy. *) val link_address_of_mac : Macaddr.t -> t (** [link_address_of_mac mac] is the link-local address for an Ethernet interface derived by the IEEE MAC -> EUI-64 map with the Universal/Local bit complemented for IPv6. @see RFC 2464 *) val is_global : t -> bool (** [is_global ipv6] is a predicate indicating whether [ipv6] globally addresses a node. *) val is_multicast : t -> bool (** [is_multicast ipv6] is a predicate indicating whether [ipv6] is a multicast address. *) val is_private : t -> bool (** [is_private ipv6] is a predicate indicating whether [ipv6] privately addresses a node. *) include Map.OrderedType with type t := t module Set : Set.S with type elt := t module Map : Map.S with type key := t end (** Type of either an IPv4 value or an IPv6 value *) type ('v4, 'v6) v4v6 = V4 of 'v4 | V6 of 'v6 type t = (V4.t, V6.t) v4v6 (** Type of any IP address *) val to_string : t -> string (** [to_string addr] is the text string representation of [addr]. *) val to_buffer : Buffer.t -> t -> unit (** [to_buffer buf addr] writes the text string representation of [addr] into [buf]. *) val pp : Format.formatter -> t -> unit [@@ocaml.toplevel_printer] (** [pp f ip] outputs a human-readable representation of [ip] to the formatter [f]. *) val of_string_exn : string -> t (** [of_string_exn s] parses [s] as an IPv4 or IPv6 address. Raises {!Parse_error} if [s] is not a valid string representation of an IP address. *) val of_string : string -> (t, [> `Msg of string ]) result (** Same as {!of_string_exn} but returns a result type instead of raising an exception. *) val of_string_raw : string -> int ref -> t (** Same as [of_string_exn] but takes as an extra argument the offset into the string for reading. *) val with_port_of_string : default:int -> string -> (t * int, [> `Msg of string ]) result (** [with_port_of_string ~default s] parses [s] as an IPv4 or IPv6 address with a possible port seperated by a [':'] (if not, we use [default]). For IPv6, due to the [':'] separator, only a full expansion of the IPv6 plus the port lets us to interpret the last [:] as the port. In other words: - [::1:8080] returns the IPv6 [::1:8080] with the [default] port - [0:0:0:0:0:0:0:1:8080] returns [::1] with the port [8080]. *) val of_octets_exn : string -> t (** [of_octets_exn octets] is the address {!t} represented by [octets]. The [octets] must be 4 bytes long for a {!V4} or 16 if a {!V6}. Raises {!Parse_error} if [octets] is not a valid representation of an address. *) val of_octets : string -> (t, [> `Msg of string ]) result (** Same as {!of_octets_exn} but returns a result type instead of raising an exception. *) val to_octets : t -> string (** [to_octets addr] returns the bytes representing the [addr] octets, which will be 4 bytes long if addr is a {!V4} or 16 if a {!V6}. *) val v4_of_v6 : V6.t -> V4.t option (** [v4_of_v6 ipv6] is the IPv4 representation of the IPv6 address [ipv6]. If [ipv6] is not an IPv4-mapped address, None is returned. *) val to_v4 : t -> V4.t option (** [to_v4 addr] is the IPv4 representation of [addr]. *) val v6_of_v4 : V4.t -> V6.t (** [v6_of_v4 ipv4] is the IPv6 representation of the IPv4 address [ipv4]. *) val to_v6 : t -> V6.t (** [to_v6 addr] is the IPv6 representation of [addr]. *) val scope : t -> scope (** [scope addr] is the classification of [addr] by the {!scope} hierarchy. *) val is_global : t -> bool (** [is_global addr] is a predicate indicating whether [addr] globally addresses a node. *) val is_multicast : t -> bool (** [is_multicast addr] is a predicate indicating whether [addr] is a multicast address. *) val is_private : t -> bool (** [is_private addr] is a predicate indicating whether [addr] privately addresses a node. *) val multicast_to_mac : t -> Macaddr.t (** [multicast_to_mac addr] is the MAC address corresponding to the multicast address [addr]. See {!V4.multicast_to_mac} and {!V6.multicast_to_mac}.*) val to_domain_name : t -> [ `host ] Domain_name.t (** [to_domain_name addr] is the domain name label list for reverse lookups of [addr]. This includes the [.in-addr.arpa] or [.ip6.arpa] suffix. *) val of_domain_name : 'a Domain_name.t -> t option (** [of_domain_name name] is [Some t] if the [name] has an [.in-addr.arpa] or [ip6.arpa] suffix, and an IP address prefixed. *) val succ : t -> (t, [> `Msg of string ]) result (** [succ addr] is ip address next to [addr]. Returns a human-readable error string if it's already the highest address. *) val pred : t -> (t, [> `Msg of string ]) result (** [pred addr] is ip address before [addr]. Returns a human-readable error string if it's already the lowest address. *) module Prefix : sig type addr = t type t = (V4.Prefix.t, V6.Prefix.t) v4v6 (** Type of a internet protocol subnet *) val to_string : t -> string (** [to_string subnet] is the text string representation of [subnet]. *) val to_buffer : Buffer.t -> t -> unit (** [to_buffer buf subnet] writes the text string representation of [subnet] into [buf]. *) val pp : Format.formatter -> t -> unit [@@ocaml.toplevel_printer] (** [pp f subnet] outputs a human-readable representation of [subnet] to the formatter [f]. *) val of_string_exn : string -> t (** [of_string_exn cidr] is the subnet prefix represented by the CIDR string, [cidr]. Raises {!Parse_error} if [cidr] is not a valid representation of a CIDR notation routing prefix. *) val of_string : string -> (t, [> `Msg of string ]) result (** Same as {!of_string_exn} but returns a result type instead of raising an exception. *) val of_string_raw : string -> int ref -> t (** Same as {!of_string_exn} but takes as an extra argument the offset into the string for reading. *) val v4_of_v6 : V6.Prefix.t -> V4.Prefix.t option (** [v4_of_v6 ipv6] is the IPv4 representation of the IPv6 subnet [ipv6]. If [ipv6] is not an IPv4-mapped subnet, None is returned. *) val to_v4 : t -> V4.Prefix.t option (** [to_v4 subnet] is the IPv4 representation of [subnet]. *) val v6_of_v4 : V4.Prefix.t -> V6.Prefix.t (** [v6_of_v4 ipv4] is the IPv6 representation of the IPv4 subnet [ipv4]. *) val to_v6 : t -> V6.Prefix.t (** [to_v6 subnet] is the IPv6 representation of [subnet]. *) val mem : addr -> t -> bool (** [mem ip subnet] checks whether [ip] is found within [subnet]. *) val subset : subnet:t -> network:t -> bool (** [subset ~subnet ~network] checks whether [subnet] is contained within [network]. *) val of_addr : addr -> t (** [of_addr ip] create a subnet composed of only one address, [ip].*) val network : t -> addr (** [network subnet] is the address for [subnet]. *) val netmask : t -> addr (** [netmask subnet] is the netmask for [subnet]. *) val first : t -> addr (** [first subnet] is first valid unicast address in this [subnet]. *) val last : t -> addr (** [last subnet] is last valid unicast address in this [subnet]. *) include Map.OrderedType with type t := t end include Map.OrderedType with type t := t module Set : Set.S with type elt := t module Map : Map.S with type key := t ocaml-ipaddr-5.5.0/lib/ipaddr_cstruct.ml000066400000000000000000000045511441155524600202030ustar00rootroot00000000000000(* * Copyright (c) 2019 Anil Madhavapeddy * Copyright (c) 2014 Nicolás Ojeda Bär * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. * *) let need_more x = Ipaddr.Parse_error ("not enough data", x) let try_with_result fn a = try Ok (fn a) with Ipaddr.Parse_error (msg, _) -> Error (`Msg ("Ipaddr: " ^ msg)) module V4 = struct let of_cstruct_exn cs = let len = Cstruct.length cs in if len < 4 then raise (need_more (Cstruct.to_string cs)); Ipaddr.V4.of_int32 (Cstruct.BE.get_uint32 cs 0) let of_cstruct cs = try_with_result of_cstruct_exn cs let write_cstruct_exn i cs = let len = Cstruct.length cs in if len < 4 then raise (need_more (Cstruct.to_string cs)); Cstruct.BE.set_uint32 cs 0 (Ipaddr.V4.to_int32 i) let to_cstruct ?(allocator = Cstruct.create) i = let cs = allocator 4 in write_cstruct_exn i cs; cs end module V6 = struct open Ipaddr.V6 let of_cstruct_exn cs = let len = Cstruct.length cs in if len < 16 then raise (need_more (Cstruct.to_string cs)); let hihi = Cstruct.BE.get_uint32 cs 0 in let hilo = Cstruct.BE.get_uint32 cs 4 in let lohi = Cstruct.BE.get_uint32 cs 8 in let lolo = Cstruct.BE.get_uint32 cs 12 in of_int32 (hihi, hilo, lohi, lolo) let of_cstruct cs = try_with_result of_cstruct_exn cs let write_cstruct_exn i cs = let len = Cstruct.length cs in if len < 16 then raise (need_more (Cstruct.to_string cs)); let a, b, c, d = to_int32 i in Cstruct.BE.set_uint32 cs 0 a; Cstruct.BE.set_uint32 cs 4 b; Cstruct.BE.set_uint32 cs 8 c; Cstruct.BE.set_uint32 cs 12 d let to_cstruct ?(allocator = Cstruct.create) i = let cs = allocator 16 in write_cstruct_exn i cs; cs end ocaml-ipaddr-5.5.0/lib/ipaddr_cstruct.mli000066400000000000000000000051321441155524600203500ustar00rootroot00000000000000(* * Copyright (c) 2019 Anil Madhavapeddy * Copyright (c) 2014 Nicolás Ojeda Bär * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. * *) (** Convert to and from Cstructs and IP addresses *) (** Ipv4 address conversions *) module V4 : sig val of_cstruct : Cstruct.t -> (Ipaddr.V4.t, [> `Msg of string ]) result (** [of_cstruct c] parses the first 4 octets of [c] into an IPv4 address. *) val of_cstruct_exn : Cstruct.t -> Ipaddr.V4.t (** [of_cstruct_exn] parses the first 4 octets of [c] into an IPv4 address. Raises {!Ipaddr.Parse_failure} on error. *) val to_cstruct : ?allocator:(int -> Cstruct.t) -> Ipaddr.V4.t -> Cstruct.t (** [to_cstruct ipv4] is a cstruct of length 4 encoding [ipv4]. The cstruct is allocated using [allocator]. If [allocator] is not provided, [Cstruct.create] is used. *) val write_cstruct_exn : Ipaddr.V4.t -> Cstruct.t -> unit (** [write_cstruct_exn ipv4 cs] writes 4 bytes into [cs] representing the [ipv4] address octets. Raises {!Ipaddr.Parse_error} if [cs] is not at least 4 bytes long. *) end (** Ipv6 address conversions *) module V6 : sig val of_cstruct : Cstruct.t -> (Ipaddr.V6.t, [> `Msg of string ]) result (** [of_cstruct c] parses the first 16 octets of [c] into an IPv6 address. *) val of_cstruct_exn : Cstruct.t -> Ipaddr.V6.t (** [of_cstruct_exn] parses the first 16 octets of [c] into an IPv6 address. Raises {!Ipaddr.Parse_failure} on error. *) val to_cstruct : ?allocator:(int -> Cstruct.t) -> Ipaddr.V6.t -> Cstruct.t (** [to_cstruct ipv6] is a cstruct of length 16 encoding [ipv6]. The cstruct is allocated using [allocator]. If [allocator] is not provided, [Cstruct.create] is used. *) val write_cstruct_exn : Ipaddr.V6.t -> Cstruct.t -> unit (** [write_cstruct_exn ipv6 cs] writes 16 bytes into [cs] representing the [ipv6] address octets. Raises {!Ipaddr.Parse_error} if [cs] is not at least 16 bytes long. *) end ocaml-ipaddr-5.5.0/lib/ipaddr_sexp.ml000066400000000000000000000042471441155524600174750ustar00rootroot00000000000000(* * Copyright (c) 2018 Anil Madhavapeddy * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. * *) open Sexplib0 let of_sexp fn = function | Sexp.List _ -> failwith "expecting sexp atom" | Sexp.Atom s -> ( match fn s with Ok r -> r | Error (`Msg msg) -> failwith msg) let to_sexp fn t = Sexp.Atom (fn t) module V4 = struct module I = Ipaddr.V4 type t = I.t let sexp_of_t = to_sexp I.to_string let t_of_sexp = of_sexp I.of_string let compare = I.compare module Prefix = struct module I = Ipaddr.V4.Prefix type addr = I.addr type t = I.t let sexp_of_t = to_sexp I.to_string let t_of_sexp = of_sexp I.of_string let compare = I.compare end end module V6 = struct module I = Ipaddr.V6 type t = I.t let sexp_of_t = to_sexp I.to_string let t_of_sexp = of_sexp I.of_string let compare = I.compare module Prefix = struct module I = Ipaddr.V6.Prefix type addr = I.addr type t = I.t let sexp_of_t = to_sexp I.to_string let t_of_sexp = of_sexp I.of_string let compare = I.compare end end module I = Ipaddr type t = I.t let sexp_of_t = to_sexp I.to_string let t_of_sexp = of_sexp I.of_string let compare = I.compare type scope = I.scope let sexp_of_scope = to_sexp I.string_of_scope let scope_of_sexp = of_sexp I.scope_of_string module Prefix = struct module I = Ipaddr.Prefix type addr = I.addr type t = I.t let sexp_of_t = to_sexp I.to_string let t_of_sexp = of_sexp I.of_string let compare = I.compare end ocaml-ipaddr-5.5.0/lib/ipaddr_sexp.mli000066400000000000000000000057611441155524600176500ustar00rootroot00000000000000(* * Copyright (c) 2018 Anil Madhavapeddy * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. * *) (** serialisers to and from {!Ipaddr} and s-expression {!Sexplib0} format To use these with ppx-based derivers, simply replace the reference to the {!Ipaddr} type definition with {!Ipaddr_sexp} instead. That will import the sexp-conversion functions, and the actual type definitions are simply aliases to the corresponding type within {!Ipaddr}. For example, you might do: {[ type t = { ip : Ipaddr_sexp.t; mac : Macaddr_sexp.t } [@@deriving sexp] ]} The actual types of the records will be aliases to the main library types, and there will be two new functions available as converters. {[ type t = { ip : Ipaddr.t; mac : Macaddr.t } val sexp_of_t : t -> Sexplib0.t val t_of_sexp : Sexplib0.t -> t ]} *) type t = Ipaddr.t val sexp_of_t : Ipaddr.t -> Sexplib0.Sexp.t val t_of_sexp : Sexplib0.Sexp.t -> Ipaddr.t val compare : Ipaddr.t -> Ipaddr.t -> int type scope = Ipaddr.scope val sexp_of_scope : Ipaddr.scope -> Sexplib0.Sexp.t val scope_of_sexp : Sexplib0.Sexp.t -> Ipaddr.scope module V4 : sig type t = Ipaddr.V4.t val sexp_of_t : Ipaddr.V4.t -> Sexplib0.Sexp.t val t_of_sexp : Sexplib0.Sexp.t -> Ipaddr.V4.t val compare : Ipaddr.V4.t -> Ipaddr.V4.t -> int module Prefix : sig type addr = Ipaddr.V4.Prefix.addr type t = Ipaddr.V4.Prefix.t val sexp_of_t : Ipaddr.V4.Prefix.t -> Sexplib0.Sexp.t val t_of_sexp : Sexplib0.Sexp.t -> Ipaddr.V4.Prefix.t val compare : Ipaddr.V4.Prefix.t -> Ipaddr.V4.Prefix.t -> int end end module V6 : sig type t = Ipaddr.V6.t val sexp_of_t : Ipaddr.V6.t -> Sexplib0.Sexp.t val t_of_sexp : Sexplib0.Sexp.t -> Ipaddr.V6.t val compare : Ipaddr.V6.t -> Ipaddr.V6.t -> int module Prefix : sig type addr = Ipaddr.V6.Prefix.addr type t = Ipaddr.V6.Prefix.t val sexp_of_t : Ipaddr.V6.Prefix.t -> Sexplib0.Sexp.t val t_of_sexp : Sexplib0.Sexp.t -> Ipaddr.V6.Prefix.t val compare : Ipaddr.V6.Prefix.t -> Ipaddr.V6.Prefix.t -> int end end module Prefix : sig type addr = Ipaddr.Prefix.addr type t = Ipaddr.Prefix.t val sexp_of_t : Ipaddr.Prefix.t -> Sexplib0.Sexp.t val t_of_sexp : Sexplib0.Sexp.t -> Ipaddr.Prefix.t val compare : Ipaddr.Prefix.t -> Ipaddr.Prefix.t -> int end ocaml-ipaddr-5.5.0/lib/ipaddr_top.ml000066400000000000000000000013331441155524600173110ustar00rootroot00000000000000let printers = [ "Ipaddr.pp"; "Ipaddr.Prefix.pp"; "Ipaddr.V4.pp"; "Ipaddr.V4.Prefix.pp"; "Ipaddr.V6.pp"; "Ipaddr.V6.Prefix.pp"; "Macaddr.pp"; ] let eval_string ?(print_outcome = false) ?(err_formatter = Format.err_formatter) str = let lexbuf = Lexing.from_string str in let phrase = !Toploop.parse_toplevel_phrase lexbuf in Toploop.execute_phrase print_outcome err_formatter phrase let rec install_printers = function | [] -> true | printer :: printers -> let cmd = Printf.sprintf "#install_printer %s;;" printer in eval_string cmd && install_printers printers let () = if not (install_printers printers) then Format.eprintf "Problem installing Ipaddr-printers@." ocaml-ipaddr-5.5.0/lib/ipaddr_top.mli000066400000000000000000000002451441155524600174630ustar00rootroot00000000000000val printers : string list val eval_string : ?print_outcome:bool -> ?err_formatter:Format.formatter -> string -> bool val install_printers : string list -> bool ocaml-ipaddr-5.5.0/lib/ipaddr_unix.ml000066400000000000000000000026201441155524600174720ustar00rootroot00000000000000(* * Copyright (c) 2014 Anil Madhavapeddy * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. * *) let to_inet_addr t = Unix.inet_addr_of_string (Ipaddr.to_string t) let of_inet_addr t = Ipaddr.of_string_exn (Unix.string_of_inet_addr t) module V4 = struct let to_inet_addr t = Unix.inet_addr_of_string (Ipaddr.V4.to_string t) let of_inet_addr_exn t = Ipaddr.V4.of_string_exn (Unix.string_of_inet_addr t) let of_inet_addr t = try Some (of_inet_addr_exn t) with _ -> None end module V6 = struct let to_inet_addr t = Unix.inet_addr_of_string (Ipaddr.V6.to_string t) let of_inet_addr_exn t = Ipaddr.V6.of_string_exn (Unix.string_of_inet_addr t) let of_inet_addr t = try Some (of_inet_addr_exn t) with _ -> None end ocaml-ipaddr-5.5.0/lib/ipaddr_unix.mli000066400000000000000000000045051441155524600176470ustar00rootroot00000000000000(* * Copyright (c) 2014 Anil Madhavapeddy * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. * *) (** Convert to and from [Unix] to [Ipaddr] representations {e %%VERSION%% - {{:%%PKG_HOMEPAGE%%} homepage}} *) val to_inet_addr : Ipaddr.t -> Unix.inet_addr (** [to_inet_addr ip] is the {!Unix.inet_addr} equivalent of the IPv4 or IPv6 address [ip]. *) val of_inet_addr : Unix.inet_addr -> Ipaddr.t (** [of_inet_addr ip] is the {!Ipaddr.t} equivalent of the {!Unix.inet_addr} [ip]. *) module V4 : sig val to_inet_addr : Ipaddr.V4.t -> Unix.inet_addr (** [to_inet_addr ip] is the {!Unix.inet_addr} equivalent of the IPv4 address [ip]. *) val of_inet_addr_exn : Unix.inet_addr -> Ipaddr.V4.t (** [of_inet_addr_exn ip] is the {!Ipaddr.t} equivalent of the {!Unix.inet_addr} [ip] IPv4 address. Raises {!Ipaddr.Parse_error} if [ip] is not a valid representation of an IPv4 address. *) val of_inet_addr : Unix.inet_addr -> Ipaddr.V4.t option (** Same as [of_inet_addr_exn] but returns an option type instead of raising an exception. *) end module V6 : sig val to_inet_addr : Ipaddr.V6.t -> Unix.inet_addr (** [to_inet_addr ip] is the {!Unix.inet_addr} equivalent of the IPv6 address [ip]. *) val of_inet_addr_exn : Unix.inet_addr -> Ipaddr.V6.t (** [of_inet_addr_exn ip] is the {!Ipaddr.t} equivalent of the {!Unix.inet_addr} [ip] IPv6 address. Raises {!Ipaddr.Parse_error} if [ip] is not a valid representation of an IPv6 address. *) val of_inet_addr : Unix.inet_addr -> Ipaddr.V6.t option (** Same as [of_inet_addr_exn] but returns an option type instead of raising an exception. *) end ocaml-ipaddr-5.5.0/lib/macaddr.ml000066400000000000000000000073341441155524600165660ustar00rootroot00000000000000(* * Copyright (c) 2010 Anil Madhavapeddy * Copyright (c) 2014 David Sheets * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *) exception Parse_error of string * string let need_more x = Parse_error ("not enough data", x) let try_with_result fn a = try Ok (fn a) with Parse_error (msg, _) -> Error (`Msg ("Macaddr: " ^ msg)) type t = Bytes.t (* length 6 only *) let compare = Bytes.compare (* Raw MAC address off the wire (network endian) *) let of_octets_exn x = if String.length x <> 6 then raise (Parse_error ("MAC is exactly 6 bytes", x)) else Bytes.of_string x let of_octets x = try_with_result of_octets_exn x let int_of_hex_char c = let c = int_of_char (Char.uppercase_ascii c) - 48 in if c > 9 then if c > 16 then c - 7 (* upper hex offset *) else -1 (* :;<=>?@ *) else c let is_hex i = i >= 0 && i < 16 let bad_char i s = let msg = Printf.sprintf "invalid character '%c' at %d" s.[i] i in Parse_error (msg, s) let parse_hex_int term s i = let len = String.length s in let rec hex prev = let j = !i in if j >= len then prev else let c = s.[j] in let k = int_of_hex_char c in if is_hex k then ( incr i; hex ((prev lsl 4) + k)) else if List.mem c term then prev else raise (bad_char j s) in let i = !i in if i < len then if is_hex (int_of_hex_char s.[i]) then hex 0 else raise (bad_char i s) else raise (need_more s) let parse_sextuple s i = let m = Bytes.create 6 in try let p = !i in Bytes.set m 0 (Char.chr (parse_hex_int [ ':'; '-' ] s i)); if !i >= String.length s then raise (need_more s) else let sep = [ s.[!i] ] in if !i - p <> 2 then raise (Parse_error ("hex pairs required", s)); incr i; for k = 1 to 4 do let p = !i in Bytes.set m k (Char.chr (parse_hex_int sep s i)); if !i - p <> 2 then raise (Parse_error ("hex pairs required", s)); incr i done; let p = !i in Bytes.set m 5 (Char.chr (parse_hex_int [] s i)); if !i - p <> 2 then raise (Parse_error ("hex pairs required", s)); m with Invalid_argument _ -> raise (Parse_error ("address segment too large", s)) (* Read a MAC address colon-separated string *) let of_string_exn x = parse_sextuple x (ref 0) let of_string x = try_with_result of_string_exn x let chri x i = Char.code (Bytes.get x i) let to_string ?(sep = ':') x = Printf.sprintf "%02x%c%02x%c%02x%c%02x%c%02x%c%02x" (chri x 0) sep (chri x 1) sep (chri x 2) sep (chri x 3) sep (chri x 4) sep (chri x 5) let to_octets x = Bytes.to_string x let pp ppf i = Format.fprintf ppf "%s" (to_string i) let broadcast = Bytes.make 6 '\255' let make_local bytegenf = let x = Bytes.create 6 in (* set locally administered and unicast bits *) Bytes.set x 0 (Char.chr (((bytegenf 0 lor 2) lsr 1) lsl 1)); for i = 1 to 5 do Bytes.set x i (Char.chr (bytegenf i)) done; x let get_oui x = (chri x 0 lsl 16) lor (chri x 1 lsl 8) lor chri x 2 let is_local x = (chri x 0 lsr 1) land 1 = 1 let is_unicast x = chri x 0 land 1 = 0 ocaml-ipaddr-5.5.0/lib/macaddr.mli000066400000000000000000000060101441155524600167250ustar00rootroot00000000000000(* * Copyright (c) 2010-2011 Anil Madhavapeddy * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *) (** A library for manipulation of MAC address representations. {e %%VERSION%% - {{:%%PKG_HOMEPAGE%%} homepage}} *) exception Parse_error of string * string (** [Parse_error (err,packet)] is raised when parsing of the MAC address syntax fails. [err] contains a human-readable error and [packet] is the original octet list that failed to parse. *) type t (** Type of the hardware address (MAC) of an ethernet interface. *) (** {2 Functions converting MAC addresses to/from octets/string} *) val of_octets_exn : string -> t (** [of_octets_exn buf] is the hardware address extracted from [buf]. Raises [Parse_error] if [buf] has not length 6. *) val of_octets : string -> (t, [> `Msg of string ]) result (** Same as {!of_octets_exn} but returns a result type instead of raising an exception. *) val of_string_exn : string -> t (** [of_string_exn mac_string] is the human-readable hardware address represented by [mac_string]. Raises {!Parse_error} if [mac_string] is not a valid representation of a MAC address. *) val of_string : string -> (t, [> `Msg of string ]) result (** Same as {!of_string_exn} but returns a result type instead of raising an exception. *) val to_octets : t -> string (** [to_octets mac_addr] is a string of size 6 encoding [mac_addr] as a sequence of bytes. *) val to_string : ?sep:char -> t -> string (** [to_string ?(sep=':') mac_addr] is the [sep]-separated string representation of [mac_addr], i.e. [xx:xx:xx:xx:xx:xx]. *) val pp : Format.formatter -> t -> unit [@@ocaml.toplevel_printer] (** [pp f mac_addr] outputs a human-readable representation of [mac_addr] to the formatter [f]. *) val broadcast : t (** [broadcast] is [ff:ff:ff:ff:ff:ff]. *) val make_local : (int -> int) -> t (** [make_local bytegen] creates a unicast, locally administered MAC address given a function mapping octet offset to octet value. *) val get_oui : t -> int (** [get_oui macaddr] is the integer organization identifier for [macaddr]. *) val is_local : t -> bool (** [is_local macaddr] is the predicate on the locally administered bit of [macaddr]. *) val is_unicast : t -> bool (** [is_unicast macaddr] the is the predicate on the unicast bit of [macaddr]. *) include Map.OrderedType with type t := t ocaml-ipaddr-5.5.0/lib/macaddr_cstruct.ml000066400000000000000000000027731441155524600203370ustar00rootroot00000000000000(* * Copyright (c) 2019 Anil Madhavapeddy * Copyright (c) 2014 Nicolás Ojeda Bär * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. * *) let try_with_result fn a = try Ok (fn a) with Macaddr.Parse_error (msg, _) -> Error (`Msg ("Macaddr: " ^ msg)) let of_cstruct_exn cs = if Cstruct.length cs <> 6 then raise (Macaddr.Parse_error ("MAC is exactly 6 bytes", Cstruct.to_string cs)) else Cstruct.to_string cs |> Macaddr.of_octets_exn let of_cstruct cs = try_with_result of_cstruct_exn cs let write_cstruct_exn (mac : Macaddr.t) cs = let len = Cstruct.length cs in let mac = Macaddr.to_octets mac in if len <> 6 then raise (Macaddr.Parse_error ("MAC is exactly 6 bytes", mac)); Cstruct.blit_from_string mac 0 cs 0 6 let to_cstruct ?(allocator = Cstruct.create) mac = let cs = allocator 6 in write_cstruct_exn mac cs; cs ocaml-ipaddr-5.5.0/lib/macaddr_cstruct.mli000066400000000000000000000031541441155524600205020ustar00rootroot00000000000000(* * Copyright (c) 2019 Anil Madhavapeddy * Copyright (c) 2014 Nicolás Ojeda Bär * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. * *) (** Convert to and from Cstructs and MAC address. *) val of_cstruct : Cstruct.t -> (Macaddr.t, [> `Msg of string ]) result (** [of_cstruct c] parses the 6 octets of [c] into a MAC address. *) val of_cstruct_exn : Cstruct.t -> Macaddr.t (** [of_cstruct_exn] parses the 6 octets of [c] into a MAC address. Raises {!Macaddr.Parse_failure} on error. *) val to_cstruct : ?allocator:(int -> Cstruct.t) -> Macaddr.t -> Cstruct.t (** [to_cstruct mac] is a cstruct of length 4 encoding [ipv4]. The cstruct is allocated using [allocator]. If [allocator] is not provided, [Cstruct.create] is used. *) val write_cstruct_exn : Macaddr.t -> Cstruct.t -> unit (** [write_cstruct_exn mac cs] writes 6 bytes into [cs] representing the [mac] address octets. Raises {!Macaddr.Parse_error} if [cs] is not 6 bytes long. *) ocaml-ipaddr-5.5.0/lib/macaddr_sexp.ml000066400000000000000000000021761441155524600176240ustar00rootroot00000000000000(* * Copyright (c) 2018 Anil Madhavapeddy * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. * *) open Sexplib0 let of_sexp fn = function | Sexp.List _ -> failwith "expecting sexp atom" | Sexp.Atom s -> ( match fn s with Ok r -> r | Error (`Msg msg) -> failwith msg) let to_sexp fn t = Sexp.Atom (fn t) type t = Macaddr.t let sexp_of_t = to_sexp Macaddr.to_string let t_of_sexp = of_sexp Macaddr.of_string let compare = Macaddr.compare ocaml-ipaddr-5.5.0/lib/macaddr_sexp.mli000066400000000000000000000033051441155524600177700ustar00rootroot00000000000000(* * Copyright (c) 2018 Anil Madhavapeddy * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. * *) (** serialisers to and from {!Macaddr} and s-expression {!Sexplib0} format To use these with ppx-based derivers, simply replace the reference to the {!Macaddr} type definition with {!Macaddr_sexp} instead. That will import the sexp-conversion functions, and the actual type definitions are simply aliases to the corresponding type within {!Ipaddr}. For example, you might do: {[ type t = { ip : Ipaddr_sexp.t; mac : Macaddr_sexp.t } [@@deriving sexp] ]} The actual types of the records will be aliases to the main library types, and there will be two new functions available as converters. {[ type t = { ip : Ipaddr.t; mac : Macaddr.t } val sexp_of_t : t -> Sexplib0.t val t_of_sexp : Sexplib0.t -> t ]} *) type t = Macaddr.t val sexp_of_t : Macaddr.t -> Sexplib0.Sexp.t val t_of_sexp : Sexplib0.Sexp.t -> Macaddr.t val compare : Macaddr.t -> Macaddr.t -> int ocaml-ipaddr-5.5.0/lib/macaddr_top.ml000066400000000000000000000011141441155524600174360ustar00rootroot00000000000000let printers = [ "Macaddr.pp" ] let eval_string ?(print_outcome = false) ?(err_formatter = Format.err_formatter) str = let lexbuf = Lexing.from_string str in let phrase = !Toploop.parse_toplevel_phrase lexbuf in Toploop.execute_phrase print_outcome err_formatter phrase let rec install_printers = function | [] -> true | printer :: printers -> let cmd = Printf.sprintf "#install_printer %s;;" printer in eval_string cmd && install_printers printers let () = if not (install_printers printers) then Format.eprintf "Problem installing Macaddr-printers@." ocaml-ipaddr-5.5.0/lib_test/000077500000000000000000000000001441155524600156715ustar00rootroot00000000000000ocaml-ipaddr-5.5.0/lib_test/dune000066400000000000000000000017701441155524600165540ustar00rootroot00000000000000(rule (copy# ../lib/ipaddr_sexp.ml ipaddr_sexp.ml)) (rule (copy# ../lib/macaddr_sexp.ml macaddr_sexp.ml)) (rule (copy# ../lib/ipaddr.ml ipaddr_internal.ml)) (library (name test_macaddr_sexp) (wrapped false) (modules macaddr_sexp) (preprocess (pps ppx_sexp_conv)) (libraries macaddr sexplib0)) (library (name test_ipaddr_sexp) (wrapped false) (modules ipaddr_sexp) (preprocess (pps ppx_sexp_conv)) (libraries ipaddr sexplib0)) (test (name test_ipaddr) (package ipaddr-sexp) (modules test_ipaddr) (libraries ipaddr ipaddr-cstruct test_ipaddr_sexp ounit2)) (test (name test_ipaddr_b128) (package ipaddr-sexp) (modules test_ipaddr_b128 ipaddr_internal) (libraries ipaddr ipaddr-cstruct test_ipaddr_sexp ounit2)) (test (name test_macaddr) (package macaddr-sexp) (modules test_macaddr) (libraries macaddr macaddr-cstruct test_macaddr_sexp ounit2)) (test (name test_ppx) (modules test_ppx) (package ipaddr-sexp) (libraries ipaddr macaddr test_ipaddr_sexp test_macaddr_sexp ounit2)) ocaml-ipaddr-5.5.0/lib_test/test_ipaddr.ml000066400000000000000000001175051441155524600205360ustar00rootroot00000000000000(* * Copyright (c) 2013-2014 David Sheets * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. * *) open OUnit open Ipaddr let error s msg = (s, Parse_error (msg, s)) let need_more s = error s "not enough data" let bad_char i s = error s (Printf.sprintf "invalid character '%c' at %d" s.[i] i) let ( >>= ) v f = match v with Ok v -> f v | Error _ as e -> e let assert_raises ~msg exn test_fn = assert_raises ~msg exn (fun () -> try test_fn () with rtexn -> if exn <> rtexn then ( Printf.eprintf "Stacktrace for '%s':\n%!" msg; Printexc.print_backtrace stderr); raise rtexn) module Test_v4 = struct let test_string_rt () = let addrs = [ ("192.168.0.1", "192.168.0.1") ] in List.iter (fun (addr, rt) -> let os = V4.of_string_exn addr in let ts = V4.to_string os in assert_equal ~msg:addr ts rt; let os = Ipaddr_sexp.(V4.t_of_sexp (V4.sexp_of_t os)) in let ts = V4.to_string os in assert_equal ~msg:addr ts rt) addrs let test_string_rt_bad () = let addrs = [ need_more "192.168.0"; bad_char 11 "192.168.0.1.1"; error "192.268.2.1" "second octet out of bounds"; bad_char 4 "192. 168.1.1"; bad_char 4 "192..0.1"; bad_char 3 "192,168.0.1"; ] in List.iter (fun (addr, exn) -> assert_raises ~msg:addr exn (fun () -> V4.of_string_exn addr)) addrs let test_string_raw_rt () = let addrs = [ (("IP: 192.168.0.1!!!", 4), ("192.168.0.1", 15)); (("IP: 192.168.0.1.1!!!", 4), ("192.168.0.1", 15)); ] in List.iter (fun ((addr, off), result) -> let c = ref off in let os = V4.of_string_raw addr c in let ts = V4.to_string os in assert_equal ~msg:addr (ts, !c) result) addrs let test_string_raw_rt_bad () = let addrs = [ (let s = "IP: 192.168.0!!!" in ((s, 4), (Parse_error ("invalid character '!' at 13", s), 13))); ] in List.iter (fun ((addr, off), (exn, cursor)) -> let c = ref off in assert_raises ~msg:addr exn (fun () -> V4.of_string_raw addr c); assert_equal ~msg:(Printf.sprintf "%s cursor <> %d (%d)" addr cursor !c) !c cursor) addrs let test_bytes_rt () = let addr = "\254\099\003\128" in assert_equal ~msg:(String.escaped addr) V4.(to_octets (of_octets_exn addr)) addr let test_bytes_rt_bad () = let addrs = [ need_more "\254\099\003" ] in List.iter (fun (addr, exn) -> assert_raises ~msg:(String.escaped addr) exn (fun () -> V4.of_octets_exn addr)) addrs let test_int32_rt () = let addr = 0x0_F0_AB_00_01_l in assert_equal ~msg:(Printf.sprintf "%08lX" addr) V4.(to_int32 (of_int32 addr)) addr let test_prefix_string_rt () = let subnets = [ ("192.168.0.0/24", "192.168.0.0/24"); ("0.0.0.0/0", "0.0.0.0/0"); ("192.168.0.1/24", "192.168.0.0/24"); ("192.168.0.0/0", "0.0.0.0/0"); ] in List.iter (fun (subnet, rt) -> let os = V4.Prefix.of_string_exn subnet |> V4.Prefix.prefix in let ts = V4.Prefix.to_string os in assert_equal ~msg:subnet ts rt; let os = Ipaddr_sexp.(V4.Prefix.(t_of_sexp (sexp_of_t os))) in let ts = V4.Prefix.to_string os in assert_equal ~msg:subnet ts rt) subnets let test_prefix_string_rt_bad () = let subnets = [ bad_char 9 "192.168.0/24"; bad_char 10 "192.168.0./24"; error "192.168.0.0/33" "invalid prefix size"; bad_char 14 "192.168.0.0/30/1"; bad_char 12 "192.168.0.0/-1"; ] in List.iter (fun (subnet, exn) -> assert_raises ~msg:subnet exn (fun () -> V4.Prefix.of_string_exn subnet)) subnets let test_network_address_rt () = let netaddrs = [ ("192.168.0.1/24", "192.168.0.0/24", "192.168.0.1") ] in List.iter (fun (netaddr, net, addr) -> let netv4 = V4.Prefix.of_string_exn net in let addrv4 = V4.of_string_exn addr in let cidr = V4.Prefix.of_string_exn netaddr in let prefix = V4.Prefix.prefix cidr and v4 = V4.Prefix.address cidr in assert_equal ~msg:(net ^ " <> " ^ V4.Prefix.to_string prefix) netv4 prefix; assert_equal ~msg:(addr ^ " <> " ^ V4.to_string v4) addrv4 v4; let addrstr = V4.Prefix.to_string cidr in assert_equal ~msg:(netaddr ^ " <> " ^ addrstr) netaddr addrstr) netaddrs let test_prefix_broadcast () = let pairs = [ ("192.168.0.0/16", "192.168.255.255"); ("192.168.0.0/24", "192.168.0.255"); ("192.168.1.1/24", "192.168.1.255"); ("192.168.0.128/29", "192.168.0.135"); ("192.168.0.0/31", "192.168.0.1"); ("192.168.0.0/32", "192.168.0.0"); ("0.0.0.0/0", "255.255.255.255"); ] in List.iter (fun (subnet, bcast) -> let r = V4.(to_string Prefix.(broadcast (of_string_exn subnet))) in assert_equal ~msg:(subnet ^ " <> " ^ r) r bcast) pairs let test_prefix_bits () = let pairs = V4.Prefix. [ (global, 0); (loopback, 8); (link, 16); (relative, 8); (multicast, 4); (private_10, 8); (private_172, 12); (private_192, 16); ] in List.iter (fun (subnet, bits) -> let msg = V4.Prefix.to_string subnet ^ " <> " ^ string_of_int bits in assert_equal ~msg (V4.Prefix.bits subnet) bits) pairs let test_prefix_netmask () = let nets = [ ("192.168.0.1/32", "255.255.255.255"); ("192.168.0.1/31", "255.255.255.254"); ("192.168.0.1/1", "128.0.0.0"); ("192.168.0.1/0", "0.0.0.0"); ] in List.iter (fun (net_str, nm_str) -> let cidr = V4.Prefix.of_string_exn net_str in let prefix = V4.Prefix.prefix cidr and address = V4.Prefix.address cidr in let netmask = V4.Prefix.netmask prefix in let nnm_str = V4.to_string netmask in let msg = Printf.sprintf "netmask %s <> %s" nnm_str nm_str in assert_equal ~msg nnm_str nm_str; let prefix = V4.Prefix.of_netmask_exn ~netmask ~address in let nns = V4.Prefix.to_string prefix in let msg = Printf.sprintf "%s is %s under netmask iso" net_str nns in assert_equal ~msg net_str nns) nets let test_prefix_netmask_bad () = let bad_masks = [ error "127.255.255.255" "invalid netmask"; error "255.255.254.128" "invalid netmask"; ] in List.iter (fun (nm_str, exn) -> let netmask = V4.of_string_exn nm_str in let address = V4.of_string_exn "192.168.0.1" in assert_raises ~msg:nm_str exn (fun () -> V4.Prefix.of_netmask_exn ~netmask ~address)) bad_masks let test_scope () = let ip = V4.of_string_exn in (*let is subnet addr = V4.Prefix.(mem addr subnet) in*) let is_scope scop addr = scop = V4.scope addr in let ships = V4. [ (unspecified, "global", is_global, false); (unspecified, "multicast", is_multicast, false); (unspecified, "point", is_scope Point, true); (localhost, "global", is_global, false); (localhost, "multicast", is_multicast, false); (localhost, "interface", is_scope Interface, true); (broadcast, "global", is_global, false); (broadcast, "multicast", is_multicast, false); (broadcast, "admin", is_scope Admin, true); (nodes, "global", is_global, false); (nodes, "multicast", is_multicast, true); (nodes, "interface", is_scope Link, true); (routers, "global", is_global, false); (routers, "multicast", is_multicast, true); (routers, "link", is_scope Link, true); (ip "192.168.0.1", "private", is_private, true); (ip "10.3.21.155", "private", is_private, true); (ip "172.16.0.0", "private", is_private, true); (ip "172.31.255.255", "private", is_private, true); (ip "172.15.255.255", "private", is_private, false); (ip "172.32.0.0", "private", is_private, false); ] in List.iter (fun (addr, lbl, pred, is_mem) -> let mems = if is_mem then "" else " not" in let msg = V4.to_string addr ^ " is" ^ mems ^ " in " ^ lbl in assert_equal ~msg (pred addr) is_mem) ships let test_map () = let m = V4.Map.add (V4.of_string_exn "1.0.0.1") "min" V4.Map.empty in let m = V4.Map.add (V4.of_string_exn "254.254.254.254") "the greatest host" m in let m = V4.Map.add (V4.of_string_exn "1.0.0.1") "the least host" m in assert_equal ~msg:"size" (V4.Map.cardinal m) 2; let min_key, min_val = V4.Map.min_binding m in assert_equal ~msg:("min is '" ^ min_val ^ "'") (min_key, min_val) (V4.of_string_exn "1.0.0.1", "the least host"); assert_equal ~msg:"max" (V4.Map.max_binding m) (V4.of_string_exn "254.254.254.254", "the greatest host") let test_prefix_map () = let module M = Stdlib.Map.Make (V4.Prefix) in let of_string s = s |> V4.Prefix.of_string_exn |> V4.Prefix.prefix in let m = M.add (of_string "0.0.0.0/0") "everyone" M.empty in let m = M.add (of_string "192.0.0.0/1") "weirdos" m in let m = M.add (of_string "128.0.0.0/1") "high-bitters" m in let m = M.add (of_string "254.0.0.0/8") "top-end" m in let m = M.add (of_string "0.0.0.0/0") "iana" m in assert_equal ~msg:"size" (M.cardinal m) 3; assert_equal ~msg:"min" (M.min_binding m) (V4.Prefix.of_string_exn "0.0.0.0/0", "iana"); assert_equal ~msg:"max" (M.max_binding m) (V4.Prefix.of_string_exn "254.0.0.0/8", "top-end"); assert_equal ~msg:"third" (M.find (V4.Prefix.of_string_exn "128.0.0.0/1") m) "high-bitters" let test_special_addr () = assert_equal ~msg:"broadcast" V4.broadcast V4.Prefix.(broadcast global); assert_equal ~msg:"any" V4.any V4.Prefix.(network global); assert_equal ~msg:"localhost" true V4.(Prefix.(mem localhost loopback)) let test_multicast_mac () = let ip = V4.of_octets_exn "\xff\xbf\x9f\x8f" in let multicast = V4.Prefix.(network_address multicast ip) in let unicast_mac_str = Macaddr.to_string (V4.multicast_to_mac ip) in let multicast_mac_str = Macaddr.to_string (V4.multicast_to_mac multicast) in let mac_str = "01:00:5e:3f:9f:8f" in assert_equal ~msg:("unicast_mac " ^ unicast_mac_str ^ " <> " ^ mac_str) unicast_mac_str mac_str; assert_equal ~msg:("multicast_mac " ^ multicast_mac_str ^ " <> " ^ mac_str) multicast_mac_str mac_str let test_domain_name () = let ip = V4.of_string_exn "128.64.32.16" in let name = Domain_name.(host_exn (of_string_exn "16.32.64.128.in-addr.arpa")) in assert_equal ~cmp:Domain_name.equal ~msg:"to_domain_name" (V4.to_domain_name ip) name; assert_equal ~msg:"of_domain_name" (V4.of_domain_name name) (Some ip) let test_cstruct_rt () = let addr = "\254\099\003\128" in assert_equal ~msg:(String.escaped addr) (Cstruct.to_string Ipaddr_cstruct.V4.( to_cstruct (of_cstruct_exn (Cstruct.of_string addr)))) addr let test_cstruct_rt_bad () = let addrs = [ need_more "\254\099\003" ] in List.iter (fun (addr, exn) -> assert_raises ~msg:(String.escaped addr) exn (fun () -> Ipaddr_cstruct.V4.of_cstruct_exn (Cstruct.of_string addr))) addrs let test_prefix_mem () = let ip = V4.of_string_exn in let prefix = V4.Prefix.of_string_exn in let ships = [ (ip "10.0.0.7", prefix "10.0.0.0/29", true); (ip "172.16.255.254", prefix "172.16.255.254/31", true); (ip "192.168.0.1", prefix "0.0.0.0/0", true); (ip "192.168.0.1", V4.Prefix.private_192, true); (ip "255.255.255.255", prefix "255.255.255.255/32", true); (ip "192.0.2.1", prefix "192.0.2.0/32", false); (ip "192.0.2.1", prefix "192.0.0.0/23", false); (ip "255.255.255.255", prefix "0.0.0.0/1", false); ] in List.iter (fun (addr, subnet, is_mem) -> let msg = Printf.sprintf "%s is%s in %s" (V4.to_string addr) (if is_mem then "" else " not") (V4.Prefix.to_string subnet) in assert_equal ~msg (V4.Prefix.mem addr subnet) is_mem) ships let test_succ_pred () = let open V4 in let printer = function | Ok v -> Printf.sprintf "Ok %s" (to_string v) | Error (`Msg e) -> Printf.sprintf "Error `Msg \"%s\"" e in let assert_equal = assert_equal ~printer in let ip1 = of_string_exn "0.0.0.0" in let ip2 = of_string_exn "255.255.255.255" in assert_equal ~msg:"succ 0.0.0.0" (of_string "0.0.0.1") (succ ip1); assert_equal ~msg:"succ 255.255.255.255" (Error (`Msg "Ipaddr: highest address has been reached")) (succ ip2); assert_equal ~msg:"succ (succ 255.255.255.255)" (Error (`Msg "Ipaddr: highest address has been reached")) (succ ip2 >>= succ); assert_equal ~msg:"pred 0.0.0.0" (Error (`Msg "Ipaddr: lowest address has been reached")) (pred ip1); () let test_prefix_first_last () = let open V4.Prefix in let assert_equal = assert_equal ~printer:V4.to_string in assert_equal ~msg:"first 192.168.1.0/24" (V4.of_string_exn "192.168.1.1") (first (of_string_exn "192.168.1.0/24")); assert_equal ~msg:"first 169.254.169.254/31" (Ipaddr.V4.of_string_exn "169.254.169.254") (first (of_string_exn "169.254.169.254/31")); assert_equal ~msg:"first 169.254.169.254/32" (Ipaddr.V4.of_string_exn "169.254.169.254") (first (of_string_exn "169.254.169.254/32")); assert_equal ~msg:"last 192.168.1.0/24" (Ipaddr.V4.of_string_exn "192.168.1.254") (last (of_string_exn "192.168.1.0/24")); assert_equal ~msg:"last 169.254.169.254/31" (Ipaddr.V4.of_string_exn "169.254.169.255") (last (of_string_exn "169.254.169.254/31")); assert_equal ~msg:"last 169.254.169.254/32" (Ipaddr.V4.of_string_exn "169.254.169.254") (last (of_string_exn "169.254.169.254/32")) let test_reject_octal () = let bad_addrs = [ error "010.8.8.8" "octal notation disallowed"; error "8.010.8.8" "octal notation disallowed"; error "8.8.010.8" "octal notation disallowed"; error "8.8.8.010" "octal notation disallowed"; ] in List.iter (fun (addr, exn) -> assert_raises ~msg:addr exn (fun () -> V4.of_string_exn addr)) bad_addrs let test_reject_prefix_octal () = let bad_addrs = [ error "010.8.8.8/32" "octal notation disallowed"; error "8.010.8.8/32" "octal notation disallowed"; error "8.8.010.8/32" "octal notation disallowed"; error "8.8.8.010/32" "octal notation disallowed"; ] in List.iter (fun (addr, exn) -> assert_raises ~msg:addr exn (fun () -> V4.Prefix.of_string_exn addr)) bad_addrs let suite = "Test V4" >::: [ "string_rt" >:: test_string_rt; "string_rt_bad" >:: test_string_rt_bad; "string_raw_rt" >:: test_string_raw_rt; "string_raw_rt_bad" >:: test_string_raw_rt_bad; "bytes_rt" >:: test_bytes_rt; "bytes_rt_bad" >:: test_bytes_rt_bad; "cstruct_rt" >:: test_cstruct_rt; "cstruct_rt_bad" >:: test_cstruct_rt_bad; "int32_rt" >:: test_int32_rt; "prefix_string_rt" >:: test_prefix_string_rt; "prefix_string_rt_bad" >:: test_prefix_string_rt_bad; "network_address_rt" >:: test_network_address_rt; "prefix_broadcast" >:: test_prefix_broadcast; "prefix_bits" >:: test_prefix_bits; "prefix_netmask" >:: test_prefix_netmask; "prefix_netmask_bad" >:: test_prefix_netmask_bad; "scope" >:: test_scope; "map" >:: test_map; "prefix_map" >:: test_prefix_map; "special_addr" >:: test_special_addr; "multicast_mac" >:: test_multicast_mac; "domain_name" >:: test_domain_name; "prefix_mem" >:: test_prefix_mem; "succ_pred" >:: test_succ_pred; "prefix_first_last" >:: test_prefix_first_last; "reject_octal" >:: test_reject_octal; "reject_prefix_octal" >:: test_reject_prefix_octal; ] end module Test_v6 = struct let test_string_rt () = let addrs = [ ("2001:db8::ff00:42:8329", "2001:db8::ff00:42:8329"); ("::ffff:192.168.1.1", "::ffff:192.168.1.1"); ("::", "::"); ("[::]", "::"); ("1:1:1:1::1:1:1", "1:1:1:1:0:1:1:1"); ("0:0:0:1:1:0:0:0", "::1:1:0:0:0"); ("0:0:0:1:1::", "::1:1:0:0:0"); ("::1:0:0:0:0", "0:0:0:1::"); ("FE80::", "fe80::"); ("::192.168.0.1", "::c0a8:1"); ] in List.iter (fun (addr, rt) -> let os = V6.of_string_exn addr in let ts = V6.to_string os in assert_equal ~msg:(addr ^ " <> " ^ rt ^ " (" ^ ts ^ ")") ts rt; let os = Ipaddr_sexp.(V6.t_of_sexp (V6.sexp_of_t os)) in let ts = V6.to_string os in assert_equal ~msg:(addr ^ " <> " ^ rt ^ " (" ^ ts ^ ")") ts rt) addrs let test_string_rt_bad () = let addrs = [ need_more "["; need_more "[:"; need_more "[]"; (* ? *) need_more ":"; need_more "[::"; bad_char 4 "::1:g:f"; bad_char 3 "::1::"; bad_char 4 "1::2::3"; need_more "1:2:3:4:5:6:7"; bad_char 15 "1:2:3:4:5:6:7:8:9"; bad_char 15 "1:2:3:4:5:6:7:8::"; error "12345::12:2" "component 0 out of bounds"; bad_char 1 ":1"; ] in List.iter (fun (addr, exn) -> assert_raises ~msg:addr exn (fun () -> V6.of_string_exn addr)) addrs let test_string_raw_rt () = let addrs = [ (("IP: 2001:db8::ff00:42:8329!", 4), ("2001:db8::ff00:42:8329", 26)); (("IP: ::ffff:192.168.1.1 ", 4), ("::ffff:192.168.1.1", 22)); (("IP: :::", 4), ("::", 6)); (("IP: [::]:", 4), ("::", 8)); (("IP: 1:1:1:1::1:1:1:1", 4), ("1:1:1:1:0:1:1:1", 18)); (("IP: ::1:1:0:0:0::g", 4), ("::1:1:0:0:0", 15)); ] in List.iter (fun ((addr, off), (result, cursor)) -> let c = ref off in let os = V6.of_string_raw addr c in let ts = V6.to_string os in let msg = Printf.sprintf "%s at %d: %s at %d <> %s at %d" addr off result cursor ts !c in assert_equal ~msg (ts, !c) (result, cursor)) addrs let test_string_raw_rt_bad () = let error (s, c) msg c' = ((s, c), (Parse_error (msg, s), c')) in let need_more loc = error loc "not enough data" in let bad_char i (s, c) = error (s, c) (Printf.sprintf "invalid character '%c' at %d" s.[i] i) i in let addrs = [ need_more ("IP: [] ", 4) 5; bad_char 5 ("IP: : ", 4); bad_char 7 ("IP: [:: ", 4); bad_char 17 ("IP: 1:2:3:4:5:6:7 ", 4); error ("IP: 12345::12:2 ", 4) "component 0 out of bounds" 15; bad_char 5 ("IP: :1 ", 4); need_more ("IP: ::1:1:0:0:0:", 4) 16; bad_char 8 ("IP: ::1:g:f ", 4); ] in List.iter (fun ((addr, off), (exn, cursor)) -> let c = ref off in assert_raises ~msg:addr exn (fun () -> V6.of_string_raw addr c); assert_equal ~msg:(Printf.sprintf "%s cursor <> %d (%d)" addr cursor !c) !c cursor) addrs let test_bytes_rt () = let addr = "\000\000\000\000\000\000\000\000\000\000\255\255\192\168\000\001" in let v6 = V6.of_octets_exn addr in assert_equal ~msg:(String.escaped addr) V6.(to_octets v6) addr let test_bytes_rt_bad () = let addrs = [ need_more "\000\000\000\000\000\000\000\000\000\000\255\255\192\168\001"; ] in List.iter (fun (addr, exn) -> assert_raises ~msg:(String.escaped addr) exn (fun () -> V6.of_octets_exn addr)) addrs let test_cstruct_rt () = let addr = "\000\000\000\000\000\000\000\000\000\000\255\255\192\168\000\001" in let v6 = Ipaddr_cstruct.V6.of_cstruct_exn (Cstruct.of_string addr) in assert_equal ~msg:(String.escaped addr) (Cstruct.to_string Ipaddr_cstruct.V6.(to_cstruct v6)) addr let test_cstruct_rt_bad () = let addrs = [ need_more "\000\000\000\000\000\000\000\000\000\000\255\255\192\168\001"; ] in List.iter (fun (addr, exn) -> assert_raises ~msg:(String.escaped addr) exn (fun () -> Ipaddr_cstruct.V6.of_cstruct_exn (Cstruct.of_string addr))) addrs let test_int32_rt () = let ((a, b, c, d) as addr) = (0x2001_0665_l, 0x0000_0000_l, 0xff00_00ff_l, 0xfe00_0001_l) in assert_equal ~msg:(Printf.sprintf "%08lx %08lx %08lx %08lx" a b c d) V6.(to_int32 (of_int32 addr)) addr let test_int64_rt () = let tests = [ (0x2a01_04f9_c011_87adL, 0x0_0_0_0L); (0x0000_0000_8000_0000L, 0x0_0_0_0L); ] in List.iter (fun ((a, b) as addr) -> assert_equal ~msg:(Printf.sprintf "%016Lx %016Lx" a b) V6.(to_int64 (of_int64 addr)) addr) tests let test_prefix_string_rt () = let subnets = [ ("2000::/3", "2000::/3"); ("c012::/2", "c000::/2"); ("ffff:ffff:ffff::ffff/0", "::/0"); ("::/0", "::/0"); ("::/128", "::/128"); ("::1/128", "::1/128"); ("::/64", "::/64"); ("[::]/64", "::/64"); ] in List.iter (fun (subnet, rt) -> let os = V6.Prefix.of_string_exn subnet |> V6.Prefix.prefix in let ts = V6.Prefix.to_string os in assert_equal ~msg:subnet ts rt; let os = Ipaddr_sexp.(V6.Prefix.(t_of_sexp (sexp_of_t os))) in let ts = V6.Prefix.to_string os in assert_equal ~msg:subnet ts rt) subnets let test_prefix_string_rt_bad () = let subnets = [ need_more "/24"; need_more "::"; error "::/130" "invalid prefix size"; bad_char 5 "::/30/1"; bad_char 7 "2000::/-1"; bad_char 5 "1::3:/4"; ] in List.iter (fun (subnet, exn) -> assert_raises ~msg:subnet exn (fun () -> V6.Prefix.of_string_exn subnet)) subnets let test_network_address_rt () = let netaddrs = [ ("::1/24", "::/24", "::1") ] in List.iter (fun (netaddr, net, addr) -> let netv4 = V6.Prefix.of_string_exn net in let addrv4 = V6.of_string_exn addr in let cidr = V6.Prefix.of_string_exn netaddr in let prefix = V6.Prefix.prefix cidr and v4 = V6.Prefix.address cidr in let prefix = V6.Prefix.prefix prefix in assert_equal ~msg:(net ^ " <> " ^ V6.Prefix.to_string prefix) netv4 prefix; assert_equal ~msg:(addr ^ " <> " ^ V6.to_string v4) addrv4 v4; let addrstr = V6.Prefix.to_string cidr in assert_equal ~msg:(netaddr ^ " <> " ^ addrstr) netaddr addrstr) netaddrs let test_prefix_bits () = let pairs = V6.Prefix. [ (global_unicast_001, 3); (link, 64); (unique_local, 7); (multicast, 8); (ipv4_mapped, 96); (noneui64_interface, 3); ] in List.iter (fun (subnet, bits) -> let msg = V6.Prefix.to_string subnet ^ " <> bits " ^ string_of_int bits in assert_equal ~msg (V6.Prefix.bits subnet) bits) pairs let test_prefix_netmask () = let nets = [ ("8::1/128", "ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff"); ("8::1/127", "ffff:ffff:ffff:ffff:ffff:ffff:ffff:fffe"); ("8::1/96", "ffff:ffff:ffff:ffff:ffff:ffff::"); ("8::1/64", "ffff:ffff:ffff:ffff::"); ("8::1/32", "ffff:ffff::"); ("8::1/1", "8000::"); ("8::1/0", "::"); ] in List.iter (fun (net_str, nm_str) -> let cidr = V6.Prefix.of_string_exn net_str in let prefix = V6.Prefix.prefix cidr and address = V6.Prefix.address cidr in let netmask = V6.Prefix.netmask prefix in let nnm_str = V6.to_string netmask in let msg = Printf.sprintf "netmask %s <> %s" nnm_str nm_str in assert_equal ~msg nnm_str nm_str; let prefix = V6.Prefix.of_netmask_exn ~netmask ~address in let nns = V6.Prefix.to_string prefix in let msg = Printf.sprintf "%s is %s under netmask iso" net_str nns in assert_equal ~msg net_str nns) nets let test_prefix_netmask_bad () = let bad_masks = [ error "7fff:ffff:ffff:ffff:ffff:ffff:ffff:ffff" "invalid netmask"; error "ffff:ffff:ffff:ffff:ffff:fffe:8000:0" "invalid netmask"; error "ffff:ffff:ffff:fffe:8000::" "invalid netmask"; error "ffff:fffe:8000::" "invalid netmask"; ] in List.iter (fun (nm_str, exn) -> let netmask = V6.of_string_exn nm_str in let address = V6.of_string_exn "::" in assert_raises ~msg:nm_str exn (fun () -> V6.Prefix.of_netmask_exn ~netmask ~address)) bad_masks let test_scope () = let localhost_v4 = V6.of_string_exn "::ffff:127.0.0.1" in let is subnet addr = V6.Prefix.(mem addr subnet) in let is_scope scop addr = scop = V6.scope addr in let ships = V6. [ (unspecified, "global", is_global, false); (unspecified, "multicast", is_multicast, false); (unspecified, "point", is_scope Point, true); (localhost, "global", is_global, false); (localhost, "multicast", is_multicast, false); (localhost, "interface", is_scope Interface, true); (interface_nodes, "global", is_global, false); (interface_nodes, "multicast", is_multicast, true); (interface_nodes, "interface", is_scope Interface, true); (link_nodes, "global", is_global, false); (link_nodes, "multicast", is_multicast, true); (link_nodes, "link", is_scope Link, true); (link_routers, "global", is_global, false); (link_routers, "multicast", is_multicast, true); (link_routers, "link", is_scope Link, true); (localhost_v4, "global", is_global, false); (localhost_v4, "multicast", is_multicast, false); (localhost_v4, "ipv4", is Prefix.ipv4_mapped, true); (localhost_v4, "noneui64", is Prefix.noneui64_interface, true); (localhost_v4, "global_001", is Prefix.global_unicast_001, false); (localhost_v4, "interface", is_scope Interface, true); ] in List.iter (fun (addr, lbl, pred, is_mem) -> let mems = if is_mem then "" else " not" in let msg = V6.to_string addr ^ " is" ^ mems ^ " in " ^ lbl in assert_equal ~msg (pred addr) is_mem) ships let test_map () = let maxs = "ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff" in let m = V6.Map.add (V6.of_string_exn "::0:0") "min" V6.Map.empty in let m = V6.Map.add (V6.of_string_exn maxs) "the greatest host" m in let m = V6.Map.add (V6.of_string_exn "::") "the least host" m in assert_equal ~msg:"size" (V6.Map.cardinal m) 2; let min_key, min_val = V6.Map.min_binding m in assert_equal ~msg:("min is '" ^ min_val ^ "'") (min_key, min_val) (V6.of_string_exn "::0:0:0", "the least host"); assert_equal ~msg:"max" (V6.Map.max_binding m) (V6.of_string_exn maxs, "the greatest host") let test_prefix_map () = let module M = Stdlib.Map.Make (V6.Prefix) in let of_string s = s |> V6.Prefix.of_string_exn |> V6.Prefix.prefix in let m = M.add (of_string "::ffff:0.0.0.0/0") "everyone" M.empty in let m = M.add (of_string "::ffff:192.0.0.0/1") "weirdos" m in let m = M.add (of_string "::ffff:128.0.0.0/1") "high-bitters" m in let m = M.add (of_string "::ffff:254.0.0.0/8") "top-end" m in let m = M.add (of_string "::ffff:0.0.0.0/0") "iana" m in assert_equal ~msg:"size" (M.cardinal m) 3; assert_equal ~msg:"min" (M.min_binding m) (of_string "::ffff:0.0.0.0/0", "iana"); assert_equal ~msg:"max" (M.max_binding m) (of_string "::ffff:254.0.0.0/8", "top-end"); assert_equal ~msg:"third" (M.find (of_string "::ffff:128.0.0.0/1") m) "high-bitters" let test_multicast_mac () = let on = 0xFFFF in let ip = V6.make on on on on on 0xFFFF 0xFEFE 0xFDFD in let unicast = V6.Prefix.(network_address global_unicast_001 ip) in let multicast = V6.Prefix.(network_address multicast ip) in let unicast_mac_str = Macaddr.to_string (V6.multicast_to_mac unicast) in let multicast_mac_str = Macaddr.to_string (V6.multicast_to_mac multicast) in let mac_str = "33:33:fe:fe:fd:fd" in assert_equal ~msg:("unicast_mac " ^ unicast_mac_str ^ " <> " ^ mac_str) unicast_mac_str mac_str; assert_equal ~msg:("multicast_mac " ^ multicast_mac_str ^ " <> " ^ mac_str) multicast_mac_str mac_str let test_domain_name () = let ip = V6.of_string_exn "2a00:1450:4009:800::200e" in let name = "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" in let name = Domain_name.(host_exn (of_string_exn name)) in assert_equal ~cmp:Domain_name.equal ~msg:"to_domain_name" (V6.to_domain_name ip) name; assert_equal ~msg:"of_domain_name" (V6.of_domain_name name) (Some ip) let test_link_address_of_mac () = let mac = Macaddr.of_string_exn "34-56-78-9A-BC-DE" in let ip_str = V6.(to_string (link_address_of_mac mac)) in let expected = "fe80::3656:78ff:fe9a:bcde" in assert_equal ~msg:("link_address_of_mac " ^ ip_str ^ " <> " ^ expected) ip_str expected let test_succ_pred () = let open V6 in let printer = function | Ok v -> Printf.sprintf "Ok %s" (V6.to_string v) | Error (`Msg e) -> Printf.sprintf "Error `Msg \"%s\"" e in let assert_equal = assert_equal ~printer in let ip1 = of_string_exn "::" in let ip2 = of_string_exn "ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff" in let ip3 = of_string_exn "::2" in assert_equal ~msg:"succ ::" (of_string "::1") (succ ip1); assert_equal ~msg:"succ (succ ::)" (of_string "::2") (succ ip1 >>= succ); assert_equal ~msg:"succ ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff" (Error (`Msg "Ipaddr: highest address has been reached")) (succ ip2); assert_equal ~msg:"pred ::2" (of_string "::1") (pred ip3); assert_equal ~msg:"pred ::ffff:ffff" (of_string "::ffff:fffd") (of_string "::ffff:ffff" >>= pred >>= pred); assert_equal ~msg:"pred ::" (Error (`Msg "Ipaddr: lowest address has been reached")) (pred ip1); assert_equal ~msg:"pred (succ ::2)" (Ok ip3) (succ ip3 >>= pred) let test_first_last () = let open V6 in let open Prefix in let ip_of_string = V6.of_string_exn in let assert_equal = assert_equal ~printer:V6.to_string in assert_equal ~msg:"first ::/64" (ip_of_string "::1") (first @@ of_string_exn "::/64"); assert_equal ~msg:"first ::ff00/120" (ip_of_string "::ff01") (first @@ of_string_exn "::ff00/120"); assert_equal ~msg:"first ::aaa0/127" (ip_of_string "::aaa0") (first @@ of_string_exn "::aaa0/127"); assert_equal ~msg:"first ::aaa0/128" (ip_of_string "::aaa0") (first @@ of_string_exn "::aaa0/128"); assert_equal ~msg:"last ::/64" (ip_of_string "::ffff:ffff:ffff:ffff") (last @@ of_string_exn "::/64"); assert_equal ~msg:"last ::/120" (ip_of_string "::ff") (last @@ of_string_exn "::/120"); assert_equal ~msg:"last ::/112" (ip_of_string "::ffff") (last @@ of_string_exn "::/112"); assert_equal ~msg:"last ::bbbb:eeee:0000:0000/64" (ip_of_string "::ffff:ffff:ffff:ffff") (last @@ of_string_exn "::bbbb:eeee:0000:0000/64"); assert_equal ~msg:"last ::aaa0/127" (ip_of_string "::aaa1") (last @@ of_string_exn "::aaa0/127"); assert_equal ~msg:"last ::aaa0/128" (ip_of_string "::aaa0") (last @@ of_string_exn "::aaa0/128") let suite = "Test V6" >::: [ "string_rt" >:: test_string_rt; "string_rt_bad" >:: test_string_rt_bad; "string_raw_rt" >:: test_string_raw_rt; "string_raw_rt_bad" >:: test_string_raw_rt_bad; "bytes_rt" >:: test_bytes_rt; "bytes_rt_bad" >:: test_bytes_rt_bad; "cstruct_rt" >:: test_cstruct_rt; "cstruct_rt_bad" >:: test_cstruct_rt_bad; "int32_rt" >:: test_int32_rt; "int64_rt" >:: test_int64_rt; "prefix_string_rt" >:: test_prefix_string_rt; "prefix_string_rt_bad" >:: test_prefix_string_rt_bad; "network_address_rt" >:: test_network_address_rt; "prefix_bits" >:: test_prefix_bits; "prefix_netmask" >:: test_prefix_netmask; "prefix_netmask_bad" >:: test_prefix_netmask_bad; "scope" >:: test_scope; "map" >:: test_map; "prefix_map" >:: test_prefix_map; "multicast_mac" >:: test_multicast_mac; "domain_name" >:: test_domain_name; "link_address_of_mac" >:: test_link_address_of_mac; "succ_pred" >:: test_succ_pred; "first_last" >:: test_first_last; ] end let test_string_raw_rt () = let addrs = [ (("IP: 192.168.0.0!!", 4), ("192.168.0.0", 15)); (("IP: 192:168:0::!!", 4), ("192:168::", 15)); (("IP: [192:168::]!!", 4), ("192:168::", 15)); ] in List.iter (fun ((addr, off), (result, cursor)) -> let c = ref off in let os = of_string_raw addr c in let ts = to_string os in let msg = Printf.sprintf "%s at %d: %s at %d <> %s at %d" addr off result cursor ts !c in assert_equal ~msg (ts, !c) (result, cursor)) addrs let test_with_port_of_string () = let default = 8080 in let addrs = [ ("127.0.0.1", (Ipaddr.(V4 V4.localhost), default)); ("127.0.0.1:8080", (Ipaddr.(V4 V4.localhost), 8080)); ("127.0.0.1:4343", (Ipaddr.(V4 V4.localhost), 4343)); ("::1", (Ipaddr.(V6 V6.localhost), default)); ("0:0:0:0:0:0:0:1:8080", (Ipaddr.(V6 V6.localhost), 8080)); ("0:0:0:0:0:0:0:1:4343", (Ipaddr.(V6 V6.localhost), 4343)); ] in List.iter (fun (inet_addr, result) -> match Ipaddr.with_port_of_string ~default inet_addr with | Ok ((V4 ipv4, port) as result') -> let result'' = V4.with_port_of_string ~default inet_addr in let msg = Format.asprintf "%s <> %a:%d" inet_addr Ipaddr.V4.pp ipv4 port in assert_equal ~msg result result'; assert_equal ~msg (Ok (ipv4, port)) result'' | Ok ((V6 ipv6, port) as result') -> let result'' = V6.with_port_of_string ~default inet_addr in let msg = Format.asprintf "%s <> %a:%d" inet_addr Ipaddr.V6.pp ipv6 port in assert_equal ~msg result result'; assert_equal ~msg (Ok (ipv6, port)) result'' | Error (`Msg err) -> assert_failure (Format.asprintf "%s: %s" inet_addr err)) addrs let test_invalid_with_port_of_string () = let default = 8080 in let addrs = [ "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:"; ] in List.iter (fun inet_addr -> match ( Ipaddr.with_port_of_string ~default inet_addr, Ipaddr.V4.with_port_of_string ~default inet_addr, Ipaddr.V4.with_port_of_string ~default inet_addr ) with | Error _, Error _, Error _ -> () | _ -> assert_failure (Format.asprintf "Unexpected valid inet_addr: %S" inet_addr)) addrs let test_string_raw_rt_bad () = let error (s, c) msg c' = ((s, c), (Parse_error (msg, s), c')) in let addrs = [ error ("IP: ::192.168 ", 4) "not an IPv4 address: invalid character ':' at 4\n\ not an IPv6 address: invalid character ' ' at 13" 13; error ("IP: [::192.168] ", 4) "not an IPv4 address: invalid character '[' at 4\n\ not an IPv6 address: invalid character ']' at 14" 14; (* ? *) error ("IP: 192:168::3.5 ", 4) "not an IPv4 address: invalid character ':' at 7\n\ not an IPv6 address: invalid character ' ' at 16" 16; ] in List.iter (fun ((addr, off), (exn, cursor)) -> let c = ref off in assert_raises ~msg:addr exn (fun () -> of_string_raw addr c); assert_equal ~msg:(Printf.sprintf "%s cursor <> %d (%d)" addr cursor !c) !c cursor) addrs let test_map () = let maxv6 = "ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff" in let maxv4 = "254.254.254.254" in let m = Map.add (of_string_exn maxv4) "the greatest host v4" Map.empty in let m = Map.add (of_string_exn "::0:0") "minv6" m in let m = Map.add (of_string_exn maxv6) "the greatest host v6" m in let m = Map.add (of_string_exn "::") "the least host v6" m in let m = Map.add (of_string_exn "1.0.0.1") "minv4" m in let m = Map.add (of_string_exn "1.0.0.1") "the least host v4" m in assert_equal ~msg:"size" (Map.cardinal m) 4; let min_key, min_val = Map.min_binding m in assert_equal ~msg:("min is '" ^ min_val ^ "'") (min_key, min_val) (of_string_exn "1.0.0.1", "the least host v4"); assert_equal ~msg:"max" (Map.max_binding m) (of_string_exn maxv6, "the greatest host v6") let test_prefix_mem () = let ip = of_string_exn in let ships = [ (ip "192.168.0.1", V4 V4.Prefix.private_192, true); (ip "192.168.0.1", Prefix.of_string_exn "::ffff:0:0/96", true); (ip "192.168.0.1", Prefix.of_string_exn "::ffff:0:0/95", true); (ip "192.168.0.1", Prefix.of_string_exn "::ffff:0:0/97", false); (ip "192.168.0.1", Prefix.of_string_exn "::ffff:128.0.0.0/97", true); (ip "::ffff:10.0.0.1", V4 V4.Prefix.private_10, true); (ip "::fffe:10.0.0.1", V4 V4.Prefix.private_10, false); ] in List.iter (fun (addr, subnet, is_mem) -> let msg = Printf.sprintf "%s is%s in %s" (to_string addr) (if is_mem then "" else " not") (Prefix.to_string subnet) in assert_equal ~msg (Prefix.mem addr subnet) is_mem) ships let test_prefix_subset () = let pre = Prefix.of_string_exn in let ships = [ (pre "10.0.0.1/32", pre "10.0.0.1/32", true); (pre "10.0.0.1/32", pre "10.0.0.2/32", false); (pre "10.0.0.3/32", pre "10.0.0.2/31", true); (pre "10.0.0.2/31", pre "10.0.0.3/32", false); (pre "10.0.10.0/24", V4 V4.Prefix.private_10, true); (V4 V4.Prefix.private_10, pre "10.0.10.0/24", false); ] in List.iter (fun (subnet1, subnet2, is_subset) -> let msg = Printf.sprintf "%s is%s subset of %s" (Prefix.to_string subnet1) (if is_subset then "" else " not") (Prefix.to_string subnet2) in assert_equal ~msg (Prefix.subset ~subnet:subnet1 ~network:subnet2) is_subset) ships let suite = "Test Generic Addresses" >::: [ "string_raw_rt" >:: test_string_raw_rt; "string_raw_rt_bad" >:: test_string_raw_rt_bad; "map" >:: test_map; "prefix_mem" >:: test_prefix_mem; "prefix_subset" >:: test_prefix_subset; "with_port" >:: test_with_port_of_string; "invalid_with_port" >:: test_invalid_with_port_of_string; ] ;; let _results = run_test_tt_main Test_v4.suite in let _results = run_test_tt_main Test_v6.suite in let _results = run_test_tt_main suite in () ocaml-ipaddr-5.5.0/lib_test/test_ipaddr_b128.ml000066400000000000000000000164221441155524600212660ustar00rootroot00000000000000(* * Copyright (c) 2013-2014 David Sheets * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. * *) open OUnit module B128 = Ipaddr_internal.B128 (* copied from test_ipaddr.ml *) let assert_raises ~msg exn test_fn = assert_raises ~msg exn (fun () -> try test_fn () with rtexn -> if exn <> rtexn then ( Printf.eprintf "Stacktrace for '%s':\n%!" msg; Printexc.print_backtrace stderr); raise rtexn) let assert_equal = assert_equal ~printer:Ipaddr_internal.B128.to_string let test_addition () = (* simple addition *) let d1 = B128.zero () in let d2 = B128.of_string_exn "00000000000000000000000000000001" in assert_equal ~msg:"adding one to zero is one" d2 (B128.add_exn d1 d2); (* addition carry *) let d1 = B128.of_string_exn "000000000000000000ff000000000000" in let d2 = B128.of_string_exn "00000000000000000001000000000000" in let d3 = B128.of_string_exn "00000000000000000100000000000000" in assert_equal ~msg:"test addition carry over" d3 (B128.add_exn d1 d2); (* adding one to max_int overflows *) let d1 = B128.max_int () in let d2 = B128.of_string_exn "00000000000000000000000000000001" in assert_raises ~msg:"adding one to max_int overflows" B128.Overflow (fun () -> B128.add_exn d1 d2) let test_subtraction () = (* simple subtraction *) let d1 = B128.of_string_exn "00000000000000000000000000000001" in let d2 = B128.of_string_exn "00000000000000000000000000000001" in let d3 = B128.zero () in assert_equal ~msg:"subtracting one from one is zero" d3 (B128.sub_exn d1 d2); (* subtract carry *) let d1 = B128.of_string_exn "00000000000000000000000000000300" in let d2 = B128.of_string_exn "0000000000000000000000000000002a" in let d3 = B128.of_string_exn "000000000000000000000000000002d6" in assert_equal ~msg:"test subtraction carry over" d3 (B128.sub_exn d1 d2); (* subtracting one from zero overflows *) let d1 = B128.zero () in let d2 = B128.of_string_exn "00000000000000000000000000000001" in assert_raises ~msg:"subtracting one from min_int overflows" B128.Overflow (fun () -> B128.sub_exn d1 d2) let test_of_to_string () = let s = "ff000000000000004200000000000001" in OUnit.assert_equal ~msg:"input of of_string is equal to output of to_string" s (B128.of_string_exn s |> B128.to_string) let test_lognot () = let d1 = B128.of_string_exn "00000000000000000000000000000001" in let d2 = B128.of_string_exn "fffffffffffffffffffffffffffffffe" in assert_equal ~msg:"lognot inverts bits" d2 (B128.lognot d1) let test_shift_left () = (* bit shift count, input, expected output *) let test_shifts = [ (1, "f0000000000000000000000000000000", "e0000000000000000000000000000000"); (1, "0000000000000000000000000000000f", "0000000000000000000000000000001e"); (1, "00000000000000000000000000000001", "00000000000000000000000000000002"); (2, "f0000000000000000000000000000000", "c0000000000000000000000000000000"); (2, "0000000000000000000000000000ffff", "0000000000000000000000000003fffc"); (8, "00000000000000000000000000000100", "00000000000000000000000000010000"); (9, "f0000000000000000000000000000000", "00000000000000000000000000000000"); ( 64, "00000000000000000000000000000001", "00000000000000010000000000000000" ); ( 127, "00000000000000000000000000000001", "80000000000000000000000000000000" ); ( 128, "00000000000000000000000000000001", "00000000000000000000000000000000" ); ] in List.iter (fun (bits, input_value, expected_output) -> assert_equal ~msg:(Printf.sprintf "shift left by %i" bits) (B128.of_string_exn expected_output) (B128.shift_left (B128.of_string_exn input_value) bits)) test_shifts let test_shift_right () = (* (bit shift count, input, expected output) *) let test_shifts = [ (1, "f0000000000000000000000000000000", "78000000000000000000000000000000"); (2, "f0000000000000000000000000000000", "3c000000000000000000000000000000"); (2, "0000000000000000000000000000ffff", "00000000000000000000000000003fff"); (2, "000000000000000000000000000ffff0", "0000000000000000000000000003fffc"); (8, "00000000000000000000000000000100", "00000000000000000000000000000001"); (9, "f0000000000000000000000000000000", "00780000000000000000000000000000"); ( 32, "000000000000000000000000ffffffff", "00000000000000000000000000000000" ); ( 32, "0000000000000000aaaabbbbffffffff", "000000000000000000000000aaaabbbb" ); ( 40, "0000000000000000aaaabbbbffffffff", "00000000000000000000000000aaaabb" ); ( 64, "01000000000000000000000000000000", "00000000000000000100000000000000" ); ( 120, "aaaabbbbccccdddd0000000000000000", "000000000000000000000000000000aa" ); ( 127, "80000000000000000000000000000000", "00000000000000000000000000000001" ); ( 128, "ffff0000000000000000000000000000", "00000000000000000000000000000000" ); ] in List.iter (fun (bits, input_value, expected_output) -> assert_equal ~msg:(Printf.sprintf "shift right by %i" bits) (B128.of_string_exn expected_output) (B128.shift_right (B128.of_string_exn input_value) bits)) test_shifts let test_byte_module () = let assert_equal = OUnit2.assert_equal ~printer:(Printf.sprintf "0x%x") in assert_equal ~msg:"get 3 lsb" 0x00 (B128.Byte.get_lsbits 3 0x00); assert_equal ~msg:"get 4 lsb" 0x0f (B128.Byte.get_lsbits 4 0xff); assert_equal ~msg:"get 5 lsb" 0x10 (B128.Byte.get_lsbits 5 0x10); assert_equal ~msg:"get 8 lsb" 0xff (B128.Byte.get_lsbits 8 0xff); assert_equal ~msg:"get 3 msb" 0x0 (B128.Byte.get_msbits 3 0x00); assert_equal ~msg:"get 4 msb" 0xf (B128.Byte.get_msbits 4 0xff); assert_equal ~msg:"get 5 msb" 0x2 (B128.Byte.get_msbits 5 0x10); assert_equal ~msg:"get 8 msb" 0xff (B128.Byte.get_msbits 8 0xff); assert_equal ~msg:"set 3 msb" 0x20 (B128.Byte.set_msbits 3 0x1 0x00); assert_equal ~msg:"set 4 msb" 0xa0 (B128.Byte.set_msbits 4 0xa 0x00); assert_equal ~msg:"set 5 msb" 0x98 (B128.Byte.set_msbits 5 0x13 0x00); assert_equal ~msg:"set 8 msb" 0xff (B128.Byte.set_msbits 8 0xff 0x00) let suite = "Test B128 module" >::: [ "addition" >:: test_addition; "subtraction" >:: test_subtraction; "of_to_string" >:: test_of_to_string; "lognot" >:: test_lognot; "shift_left" >:: test_shift_left; "shift_right" >:: test_shift_right; "byte_module" >:: test_byte_module; ] ;; let _results = run_test_tt_main suite in () ocaml-ipaddr-5.5.0/lib_test/test_macaddr.ml000066400000000000000000000070101441155524600206530ustar00rootroot00000000000000(* * Copyright (c) 2013-2014 David Sheets * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. * *) open OUnit open Macaddr let test_string_rt () = let addrs = [ ("ca:fe:ba:be:ee:ee", ':'); ("ca-fe-ba-be-ee-ee", '-') ] in List.iter (fun (addr, sep) -> let os = of_string_exn addr in let ts = to_string ~sep os in assert_equal ~msg:(addr ^ " <> " ^ ts) ts addr; let os = Macaddr_sexp.(t_of_sexp (sexp_of_t os)) in let ts = to_string ~sep os in assert_equal ~msg:(addr ^ " <> " ^ ts) ts addr) addrs let assert_result_failure ~msg a = match a with Ok _ -> assert_failure msg | Error (`Msg _) -> () let test_string_rt_bad () = let addrs = [ "ca:fe:ba:be:ee:e"; "ca:fe:ba:be:ee:eee"; "ca:fe:ba:be:eeee"; "ca:fe:ba:be:ee::ee"; "ca:fe:ba:be:e:eee"; "ca:fe:ba:be:ee-ee"; ] in List.iter (fun addr -> assert_result_failure ~msg:addr (of_string addr)) addrs let test_bytes_rt () = let addr = "\254\099\003\128\000\000" in assert_equal ~msg:(String.escaped addr) (to_octets (of_octets_exn addr)) addr let test_bytes_rt_bad () = let addrs = [ "\254\099\003\128\000"; "\254\099\003\128\000\000\233" ] in List.iter (fun addr -> assert_result_failure ~msg:(String.escaped addr) (of_octets addr)) addrs let test_cstruct_rt () = let open Macaddr_cstruct in let addr = "\254\099\003\128\000\000" in assert_equal ~msg:(String.escaped addr) (Cstruct.to_string (to_cstruct (of_cstruct_exn (Cstruct.of_string addr)))) addr let error s = (s, Parse_error ("MAC is exactly 6 bytes", s)) let test_cstruct_rt_bad () = let open Macaddr_cstruct in let addrs = [ error "\254\099\003\128\000"; error "\254\099\003\128\000\000\233" ] in List.iter (fun (addr, exn) -> assert_raises ~msg:(String.escaped addr) exn (fun () -> of_cstruct_exn (Cstruct.of_string addr))) addrs let test_make_local () = let () = Random.self_init () in let bytegen i = if i = 0 then 253 else 255 - i in let local_addr = make_local bytegen in assert_equal ~msg:"is_local" (is_local local_addr) true; assert_equal ~msg:"is_unicast" (is_unicast local_addr) true; assert_equal ~msg:"localize" (to_octets local_addr).[0] (Char.chr 254); for i = 1 to 5 do assert_equal ~msg:("addr.[" ^ string_of_int i ^ "]") (to_octets local_addr).[i] (Char.chr (bytegen i)) done; assert_equal ~msg:"get_oui" (get_oui local_addr) ((254 lsl 16) + (254 lsl 8) + 253) let suite = "Test" >::: [ "string_rt" >:: test_string_rt; "string_rt_bad" >:: test_string_rt_bad; "bytes_rt" >:: test_bytes_rt; "bytes_rt_bad" >:: test_bytes_rt_bad; "cstruct_rt" >:: test_cstruct_rt; "cstruct_rt_bad" >:: test_cstruct_rt_bad; "make_local" >:: test_make_local; ] ;; run_test_tt_main suite ocaml-ipaddr-5.5.0/lib_test/test_ppx.ml000066400000000000000000000020421441155524600200670ustar00rootroot00000000000000(* * Copyright (c) 2018 Anil Madhavapeddy * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. * *) type t = { ip : Ipaddr_sexp.t; ipv6 : Ipaddr_sexp.V6.t; ipv6p : Ipaddr_sexp.V6.Prefix.t; ipv4 : Ipaddr_sexp.V4.t; ipv4p : Ipaddr_sexp.V4.Prefix.t; scope : Ipaddr_sexp.scope; mac : Macaddr_sexp.t; ipp : Ipaddr_sexp.Prefix.t; } [@@deriving sexp] ocaml-ipaddr-5.5.0/macaddr-cstruct.opam000066400000000000000000000013651441155524600200270ustar00rootroot00000000000000opam-version: "2.0" maintainer: "anil@recoil.org" authors: ["David Sheets" "Anil Madhavapeddy" "Hugo Heuzard"] synopsis: "A library for manipulation of MAC address representations using Cstructs" license: "ISC" tags: ["org:mirage" "org:xapi-project"] homepage: "https://github.com/mirage/ocaml-ipaddr" doc: "https://mirage.github.io/ocaml-ipaddr/" bug-reports: "https://github.com/mirage/ocaml-ipaddr/issues" depends: [ "ocaml" {>= "4.08.0"} "dune" {>= "1.9.0"} "macaddr" {= version} "cstruct" {>= "6.0.0"} ] build: [ ["dune" "subst"] {dev} ["dune" "build" "-p" name "-j" jobs] ["dune" "runtest" "-p" name "-j" jobs] {with-test} ] dev-repo: "git+https://github.com/mirage/ocaml-ipaddr.git" description: """ Cstruct convertions for macaddr """ ocaml-ipaddr-5.5.0/macaddr-sexp.opam000066400000000000000000000015511441155524600173140ustar00rootroot00000000000000opam-version: "2.0" maintainer: "anil@recoil.org" authors: ["David Sheets" "Anil Madhavapeddy" "Hugo Heuzard"] synopsis: "A library for manipulation of MAC address representations using sexp" license: "ISC" tags: ["org:mirage" "org:xapi-project"] homepage: "https://github.com/mirage/ocaml-ipaddr" doc: "https://mirage.github.io/ocaml-ipaddr/" bug-reports: "https://github.com/mirage/ocaml-ipaddr/issues" depends: [ "ocaml" {>= "4.08.0"} "dune" {>= "1.9.0"} "macaddr" {= version} "macaddr-cstruct" {with-test & = version} "ounit2" {with-test} "ppx_sexp_conv" {>= "v0.9.0"} "sexplib0" ] conflicts: [ "ipaddr" {< "3.0.0"} ] build: [ ["dune" "subst"] {dev} ["dune" "build" "-p" name "-j" jobs] ["dune" "runtest" "-p" name "-j" jobs] {with-test} ] dev-repo: "git+https://github.com/mirage/ocaml-ipaddr.git" description: """ Sexp convertions for macaddr """ ocaml-ipaddr-5.5.0/macaddr.opam000066400000000000000000000020021441155524600163270ustar00rootroot00000000000000opam-version: "2.0" maintainer: "anil@recoil.org" authors: ["David Sheets" "Anil Madhavapeddy" "Hugo Heuzard"] synopsis: "A library for manipulation of MAC address representations" license: "ISC" tags: ["org:mirage" "org:xapi-project"] homepage: "https://github.com/mirage/ocaml-ipaddr" doc: "https://mirage.github.io/ocaml-ipaddr/" bug-reports: "https://github.com/mirage/ocaml-ipaddr/issues" depends: [ "ocaml" {>= "4.08.0"} "dune" {>= "1.9.0"} "ounit2" {with-test} "ppx_sexp_conv" {with-test & >= "v0.9.0"} ] conflicts: [ "ipaddr" {< "3.0.0"} ] build: [ ["dune" "subst"] {dev} ["dune" "build" "-p" name "-j" jobs] ["dune" "runtest" "-p" name "-j" jobs] {with-test} ] dev-repo: "git+https://github.com/mirage/ocaml-ipaddr.git" description: """ A library for manipulation of MAC address representations. Features: * ounit2-based tests * MAC-48 (Ethernet) address support * `Macaddr` is a `Map.OrderedType` * All types have sexplib serializers/deserializers optionally via the `Macaddr_sexp` library. """