pax_global_header00006660000000000000000000000064135121212310014501gustar00rootroot0000000000000052 comment=fda97e5355239c68b70a838012a037d7f0df4aba ocaml-ipaddr-4.0.0/000077500000000000000000000000001351212123100140365ustar00rootroot00000000000000ocaml-ipaddr-4.0.0/.gitignore000066400000000000000000000000441351212123100160240ustar00rootroot00000000000000_build *.install **/*.merlin .*.swp ocaml-ipaddr-4.0.0/.travis.yml000066400000000000000000000007401351212123100161500ustar00rootroot00000000000000language: c sudo: false services: - docker install: wget https://raw.githubusercontent.com/ocaml/ocaml-travisci-skeleton/master/.travis-docker.sh script: bash ./.travis-docker.sh env: global: - PACKAGE="ipaddr" - PINS="ipaddr:. macaddr:. ipaddr-sexp:. macaddr-sexp:. ipaddr-cstruct:. macaddr-cstruct:." matrix: - DISTRO=debian-stable OCAML_VERSION=4.04 - DISTRO=ubuntu OCAML_VERSION=4.05 - DISTRO=alpine OCAML_VERSION=4.06 - DISTRO=fedora OCAML_VERSION=4.07 ocaml-ipaddr-4.0.0/CHANGES.md000066400000000000000000000222021351212123100154260ustar00rootroot00000000000000## 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-4.0.0/LICENSE.md000066400000000000000000000015011351212123100154370ustar00rootroot00000000000000ISC 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-4.0.0/Makefile000066400000000000000000000001441351212123100154750ustar00rootroot00000000000000.PHONY: all clean all: dune build test: dune runtest doc: dune build @doc clean: dune clean ocaml-ipaddr-4.0.0/README.md000066400000000000000000000037441351212123100153250ustar00rootroot00000000000000# ipaddr: IP and MAC address manipulation A library for manipulation of IP and MAC address representations. Features: * oUnit-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. ## Contact - Issues: - E-mail: - API Documentation: - Discussion: with the `mirageos` tag. ocaml-ipaddr-4.0.0/dune-project000066400000000000000000000000711351212123100163560ustar00rootroot00000000000000(lang dune 1.9) (name ipaddr) (allow_approximate_merlin) ocaml-ipaddr-4.0.0/ipaddr-cstruct.opam000066400000000000000000000013431351212123100176450ustar00rootroot00000000000000opam-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.04.0"} "dune" {build} "ipaddr" {=version} "cstruct" ] build: [ ["dune" "subst"] {pinned} ["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-4.0.0/ipaddr-sexp.opam000066400000000000000000000014321351212123100171340ustar00rootroot00000000000000opam-version: "2.0" maintainer: "anil@recoil.org" authors: ["David Sheets" "Anil Madhavapeddy" "Hugo Heuzard"] synopsis: "A library for manipulation of IP address representations usnig 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.04.0"} "dune" {build} "ipaddr" "ipaddr-cstruct" {with-test} "ounit" {with-test} "ppx_sexp_conv" {>= "v0.9.0"} ] build: [ ["dune" "subst"] {pinned} ["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-4.0.0/ipaddr.opam000066400000000000000000000033131351212123100161570ustar00rootroot00000000000000opam-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) * oUnit-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.04.0"} "dune" {build} "macaddr" {=version} "sexplib0" "domain-name" {>= "0.3.0"} "ounit" {with-test} "ppx_sexp_conv" {with-test & >= "v0.9.0"} ] build: [ ["dune" "subst"] {pinned} ["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-4.0.0/lib/000077500000000000000000000000001351212123100146045ustar00rootroot00000000000000ocaml-ipaddr-4.0.0/lib/dune000066400000000000000000000021241351212123100154610ustar00rootroot00000000000000(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-4.0.0/lib/ipaddr.ml000066400000000000000000000737101351212123100164110ustar00rootroot00000000000000(* * 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 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 ( Pervasives.int_of_char c - char_0 | 'a'..'f' -> 10 + Pervasives.int_of_char c - char_a | 'A'..'F' -> 10 + Pervasives.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 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 hex_char_of_int = function | 0 -> '0' | 1 -> '1' | 2 -> '2' | 3 -> '3' | 4 -> '4' | 5 -> '5' | 6 -> '6' | 7 -> '7' | 8 -> '8' | 9 -> '9' | 10 -> 'a' | 11 -> 'b' | 12 -> 'c' | 13 -> 'd' | 14 -> 'e' | 15 -> 'f' | _ -> raise (Invalid_argument "not a hex int") let hex_string_of_int32 i = String.make 1 (hex_char_of_int (Int32.to_int i)) 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 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") -> begin 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 end | _ -> None (* 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 Pervasives.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 make sz pre = (pre &&& (mask sz),sz) let network_address (pre,sz) addr = pre ||| (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_address_string_exn s = let (p,quad) = _of_string_exn s in (make p quad, quad) let of_address_string s = try_with_result of_address_string_exn s let of_netmask nm addr = 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 = nm &&& (Int32.neg nm) in let sz = 32 - (find_greatest_one one (if one = 0_l then 33 else 0)) in if nm <> (mask sz) then raise (Parse_error ("invalid netmask",to_string nm)) else make sz addr 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 to_address_buffer buf ((_,sz) as subnet) addr = to_buffer buf (network_address subnet addr,sz) let to_address_string subnet addr = let b = Buffer.create 18 in to_address_buffer b subnet addr; Buffer.contents b let mem ip (pre,sz) = let host = 32 - sz in (ip >|> host) = (pre >|> host) 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) = pre ||| (0x0_FF_FF_FF_FF_l >|> sz) let network (pre,_) = pre let bits (_,sz) = sz let netmask subnet = mask (bits subnet) 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 end module B128 = struct type t = int32 * int32 * int32 * int32 let of_int64 (a, b) = Int64.( to_int32 (shift_right_logical a 32), to_int32 a, to_int32 (shift_right_logical b 32), to_int32 b) let to_int64 (a,b,c,d) = Int64.( logor (shift_left (of_int32 a) 32) (of_int32 b), logor (shift_left (of_int32 c) 32) (of_int32 d)) let of_int32 x = x let to_int32 x = x let of_int16 (a, b, c, d, e, f, g, h) = V4.of_int16 (a,b), V4.of_int16 (c,d), V4.of_int16 (e,f), V4.of_int16 (g,h) let to_int16 (x,y,z,t) = let a,b = V4.to_int16 x and c,d = V4.to_int16 y and e,f = V4.to_int16 z and g,h = V4.to_int16 t in (a,b,c,d,e,f,g,h) let write_octets_exn ?(off=0) (a,b,c,d) byte = V4.write_octets_exn ~off a byte; V4.write_octets_exn ~off:(off+4) b byte; V4.write_octets_exn ~off:(off+8) c byte; V4.write_octets_exn ~off:(off+12) d byte let compare (a1,b1,c1,d1) (a2,b2,c2,d2) = match V4.compare a1 a2 with | 0 -> begin match V4.compare b1 b2 with | 0 -> begin match V4.compare c1 c2 with | 0 -> V4.compare d1 d2 | n -> n end | n -> n end | n -> n let logand (a1,b1,c1,d1) (a2,b2,c2,d2) = (a1 &&& a2, b1 &&& b2, c1 &&& c2, d1 &&& d2) let logor (a1,b1,c1,d1) (a2,b2,c2,d2) = (a1 ||| a2, b1 ||| b2, c1 ||| c2, d1 ||| d2) let lognot (a,b,c,d) = Int32.(lognot a, lognot b, lognot c, lognot d) end module V6 = struct include B128 (* TODO: Perhaps represent with bytestring? *) 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 begin incr i; if s.[!i] = ':' then begin compressed := true; incr i; [-1] end else raise (bad_char !i s); end 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 begin incr i; if !i < len then if s.[!i] = ':' then if !compressed then (decr i; x::acc) (* trailing :: *) else begin compressed:=true; incr i; loop (nb + 2) (-1::x::acc) end else begin if is_number 16 (int_of_char s.[!i]) then loop (nb+1) (x::acc) else raise (bad_char !i s) end else raise (need_more s) end else if !i < len && s.[!i] = '.' then begin i:= pos; let v4 = V4.of_string_raw s i in let (hi,lo) = V4.to_int16 v4 in lo :: hi :: acc end 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 begin if x land 0xffff <> x then raise (Parse_error (Printf.sprintf "component %d out of bounds" i, s)); a.(i) <- x; i - 1 end ) 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 (* 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 = (* TODO : from cstruct *) let hihi = V4.of_octets_exn ~off bs in let hilo = V4.of_octets_exn ~off:(off+4) bs in let lohi = V4.of_octets_exn ~off:(off+8) bs in let lolo = V4.of_octets_exn ~off:(off+12) bs in of_int32 (hihi, hilo, lohi, lolo) 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 i = let b = Bytes.create 16 in write_octets_exn i b; Bytes.to_string b (* MAC *) (* {{:https://tools.ietf.org/html/rfc2464#section-7}RFC 2464}. *) let multicast_to_mac i = let (_,_,_,i) = to_int32 i in let macb = Bytes.create 6 in Bytes.set macb 0 (Char.chr 0x33); Bytes.set macb 1 (Char.chr 0x33); Bytes.set macb 2 (Char.chr ((|~) (i >! 24))); Bytes.set macb 3 (Char.chr ((|~) (i >! 16))); 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 (a,b,c,d) = let name = [ hex_string_of_int32 ((d >|> 0) &&& 0xF_l); hex_string_of_int32 ((d >|> 4) &&& 0xF_l); hex_string_of_int32 ((d >|> 8) &&& 0xF_l); hex_string_of_int32 ((d >|> 12) &&& 0xF_l); hex_string_of_int32 ((d >|> 16) &&& 0xF_l); hex_string_of_int32 ((d >|> 20) &&& 0xF_l); hex_string_of_int32 ((d >|> 24) &&& 0xF_l); hex_string_of_int32 ((d >|> 28) &&& 0xF_l); hex_string_of_int32 ((c >|> 0) &&& 0xF_l); hex_string_of_int32 ((c >|> 4) &&& 0xF_l); hex_string_of_int32 ((c >|> 8) &&& 0xF_l); hex_string_of_int32 ((c >|> 12) &&& 0xF_l); hex_string_of_int32 ((c >|> 16) &&& 0xF_l); hex_string_of_int32 ((c >|> 20) &&& 0xF_l); hex_string_of_int32 ((c >|> 24) &&& 0xF_l); hex_string_of_int32 ((c >|> 28) &&& 0xF_l); hex_string_of_int32 ((b >|> 0) &&& 0xF_l); hex_string_of_int32 ((b >|> 4) &&& 0xF_l); hex_string_of_int32 ((b >|> 8) &&& 0xF_l); hex_string_of_int32 ((b >|> 12) &&& 0xF_l); hex_string_of_int32 ((b >|> 16) &&& 0xF_l); hex_string_of_int32 ((b >|> 20) &&& 0xF_l); hex_string_of_int32 ((b >|> 24) &&& 0xF_l); hex_string_of_int32 ((b >|> 28) &&& 0xF_l); hex_string_of_int32 ((a >|> 0) &&& 0xF_l); hex_string_of_int32 ((a >|> 4) &&& 0xF_l); hex_string_of_int32 ((a >|> 8) &&& 0xF_l); hex_string_of_int32 ((a >|> 12) &&& 0xF_l); hex_string_of_int32 ((a >|> 16) &&& 0xF_l); hex_string_of_int32 ((a >|> 20) &&& 0xF_l); hex_string_of_int32 ((a >|> 24) &&& 0xF_l); hex_string_of_int32 ((a >|> 28) &&& 0xF_l); "ip6"; "arpa" ] in Domain_name.(host_exn (of_strings_exn name)) let of_domain_name n = let open Domain_name in if count_labels n = 34 then let ip6 = get_label_exn n 32 and arpa = get_label_exn n 33 in if equal_label ip6 "ip6" && equal_label arpa "arpa" then let rev = true in let n' = drop_label_exn ~rev ~amount:2 n in let d = drop_label_exn ~rev ~amount:24 n' and c = drop_label_exn ~amount:8 (drop_label_exn ~rev ~amount:16 n') and b = drop_label_exn ~amount:16 (drop_label_exn ~rev ~amount:8 n') and a = drop_label_exn ~amount:24 n' in let t b d = let v = Int32.of_int (parse_hex_int d (ref 0)) in if v > 0xFl then raise (Parse_error ("number in label too big", d)) else v <|< b in let f d = List.fold_left (fun (acc, b) d -> Int32.add acc (t b d), b + 4) (0l, 0) (to_strings d) in try let a', _ = f a and b', _ = f b and c', _ = f c and d', _ = f d in Some (a', b', c', d') with | Parse_error _ -> None else 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 Pervasives.compare sz sz' else c let ip = make let _full = let f = 0x0_FFFF_FFFF_l in f,f,f,f let mask sz = V4.Prefix.( mask (sz - 0), mask (sz - 32), mask (sz - 64), mask (sz - 96)) let make sz pre = (logand pre (mask sz),sz) let network_address (pre,sz) addr = logor pre (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_address_string_exn s = let (p,v6) = _of_string_exn s in (make p v6, v6) let of_address_string s = try_with_result of_address_string_exn s let of_netmask nm addr = make (match nm with | (0_l,0_l,0_l,0_l) -> 0 | (lsw ,0_l ,0_l ,0_l) -> V4.Prefix.(bits (of_netmask lsw V4.any)) | (-1_l,lsw ,0_l ,0_l) -> V4.Prefix.(bits (of_netmask lsw V4.any)) + 32 | (-1_l,-1_l,lsw ,0_l) -> V4.Prefix.(bits (of_netmask lsw V4.any)) + 64 | (-1_l,-1_l,-1_l,lsw) -> V4.Prefix.(bits (of_netmask lsw V4.any)) + 96 | _ -> raise (Parse_error ("invalid netmask", to_string nm)) ) addr 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 to_address_buffer buf ((_,sz) as subnet) addr = to_buffer buf (network_address subnet addr,sz) let to_address_string subnet addr = let b = Buffer.create 43 in to_address_buffer b subnet addr; Buffer.contents b 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,_) = pre let bits (_,sz) = sz let netmask subnet = mask (bits subnet) 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 (String.get 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 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 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 = of_string_raw s (ref 0) let of_string s = try_with_result of_string_exn s 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 -> begin match V4.of_domain_name n with | None -> None | Some x -> Some (V4 x) end | 34 -> begin match V6.of_domain_name n with | None -> None | Some x -> Some (V6 x) end | _ -> None 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 = of_string_raw s (ref 0) 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) end ocaml-ipaddr-4.0.0/lib/ipaddr.mli000066400000000000000000000612251351212123100165600ustar00rootroot00000000000000(* * 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}} *) (** [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. *) exception Parse_error of string * string (** Type of ordered address scope classifications *) type scope = | Point | Interface | Link | Admin | Site | Organization | Global (** [string_of_scope scope] returns a human-readable representation of {!scope}. *) val string_of_scope : scope -> string (** [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 scope_of_string : string -> (scope, [> `Msg of string]) result (** [pp_scope fmt scope] outputs a human-readable representation of {!scope} to the [fmt] formatter. *) val pp_scope : Format.formatter -> scope -> unit [@@ocaml.toplevel_printer] (** A collection of functions for IPv4 addresses. *) module V4 : sig (** Type of the internet protocol v4 address of a host *) type t (** Converts the low bytes of four int values into an abstract {! V4.t }. *) val make : int -> int -> int -> int -> t (** {3 Text string conversion} These manipulate human-readable IPv4 addresses (for example [192.168.1.2]). *) (** [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 : string -> (t, [> `Msg of string ]) result (** [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_exn : string -> 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 of_string_raw : string -> int ref -> t (** [to_string ipv4] is the dotted decimal string representation of [ipv4], i.e. [XXX.XX.X.XXX]. *) val to_string : t -> string (** [to_buffer buf ipv4] writes the string representation of [ipv4] into the buffer [buf]. *) val to_buffer : Buffer.t -> t -> unit (** [pp f ipv4] outputs a human-readable representation of [ipv4] to the formatter [f]. *) val pp : Format.formatter -> t -> unit [@@ocaml.toplevel_printer] (** {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. *) (** [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 : ?off:int -> string -> (t, [> `Msg of string ]) result (** [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 of_octets_exn : ?off:int -> string -> t (** [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 : ?off:int -> t -> bytes -> (unit, [> `Msg of string ]) result (** [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 write_octets_exn : ?off:int -> t -> bytes -> unit (** [to_octets ipv4] returns the 4 bytes representing the [ipv4] octets. *) val to_octets : t -> string (** {3 Int conversion} *) (** [of_int32 ipv4_packed] is the address represented by [ipv4_packed]. *) val of_int32 : int32 -> t (** [to_int32 ipv4] is the 32-bit packed encoding of [ipv4]. *) val to_int32 : t -> int32 (** [of_int16 ipv4_packed] is the address represented by [ipv4_packed]. *) val of_int16 : (int * int) -> t (** [to_int16 ipv4] is the 16-bit packed encoding of [ipv4]. *) val to_int16 : t -> int * int (** {3 MAC conversion} *) (** [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}. *) val multicast_to_mac : t -> Macaddr.t (** {3 Host conversion} *) (** [to_domain_name ipv4] is the domain name label list for reverse lookups of [ipv4]. This includes the [.in-addr.arpa] suffix. *) val to_domain_name : t -> [ `host ] Domain_name.t (** [of_domain_name name] is [Some t] if the [name] has an [.in-addr.arpa] suffix, and an IPv4 address prefixed. *) val of_domain_name : 'a Domain_name.t -> t option (** {3 Common addresses} *) (** [any] is 0.0.0.0. *) val any : t (** [unspecified] is 0.0.0.0. *) val unspecified : t (** [broadcast] is 255.255.255.255. *) val broadcast : t (** [nodes] is 224.0.0.1. *) val nodes : t (** [routers] is 224.0.0.2. *) val routers : t (** [localhost] is 127.0.0.1. *) val localhost : t (** A module for manipulating IPv4 network prefixes. *) module Prefix : sig type addr = t (** Type of a internet protocol subnet *) type t (** [mask n] is the pseudo-address of an [n] bit subnet mask. *) val mask : int -> addr (** [make n addr] is the [n] bit subnet prefix to which [addr] belongs. *) val make : int -> addr -> t (** [network_address prefix addr] is the address with prefix [prefix] and suffix from [addr]. See . *) val network_address : t -> addr -> addr (** [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 : string -> (t, [> `Msg of string ]) result (** [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_exn : string -> t (** Same as {!of_string_exn} but takes as an extra argument the offset into the string for reading. *) val of_string_raw : string -> int ref -> t (** [to_string prefix] is the CIDR notation string representation of [prefix], i.e. [XXX.XX.X.XXX/XX]. *) val to_string : t -> string (** [pp f prefix] outputs a human-readable representation of [prefix] to the formatter [f]. *) val pp : Format.formatter -> t -> unit [@@ocaml.toplevel_printer] (** [of_address_string_exn cidr_addr] is the address and prefix represented by [cidr_addr]. Raises {!Parse_error} if [cidr_addr] is not a valid representation of a CIDR-scoped address. *) val of_address_string_exn : string -> t * addr (** Same as {!of_address_string_exn} but returns a result type instead of raising an exception. *) val of_address_string : string -> (t * addr, [> `Msg of string ]) result (** [to_address_string prefix addr] is the network address constructed from [prefix] and [addr]. *) val to_address_string : t -> addr -> string (** [to_buffer buf prefix] writes the string representation of [prefix] into the buffer [buf]. *) val to_buffer : Buffer.t -> t -> unit (** [to_address_buffer buf prefix addr] writes string representation of the network address representing [addr] in [prefix] to the buffer [buf]. *) val to_address_buffer : Buffer.t -> t -> addr -> unit (** [of_netmask netmask addr] is the subnet prefix of [addr] with netmask [netmask]. *) val of_netmask : addr -> addr -> t (** [mem ip subnet] checks whether [ip] is found within [subnet]. *) val mem : addr -> t -> bool (** [subset ~subnet ~network] checks whether [subnet] is contained within [network]. *) val subset : subnet:t -> network:t -> bool (** [of_addr ip] create a subnet composed of only one address, [ip]. It is the same as [make 32 ip]. *) val of_addr : addr -> t (** The default route, all addresses in IPv4-space, 0.0.0.0/0. *) val global : t (** The host loopback network, 127.0.0.0/8. *) val loopback : t (** The local-link network, 169.254.0.0/16. *) val link : t (** The relative addressing network, 0.0.0.0/8. *) val relative : t (** The multicast network, 224.0.0.0/4. *) val multicast : t (** The private subnet with 10 as first octet, 10.0.0.0/8. *) val private_10 : t (** The private subnet with 172 as first octet, 172.16.0.0/12. *) val private_172 : t (** The private subnet with 192 as first octet, 192.168.0.0/16. *) val private_192 : t (** The privately addressable networks: [loopback], [link], [private_10], [private_172], [private_192]. *) val private_blocks : t list (** [broadcast subnet] is the broadcast address for [subnet]. *) val broadcast : t -> addr (** [network subnet] is the address for [subnet]. *) val network : t -> addr (** [netmask subnet] is the netmask for [subnet]. *) val netmask : t -> addr (** [bits subnet] is the bit size of the [subnet] prefix. *) val bits : t -> int include Map.OrderedType with type t := t end (** [scope ipv4] is the classification of [ipv4] by the {! scope } hierarchy. *) val scope : t -> scope (** [is_global ipv4] is a predicate indicating whether [ipv4] globally addresses a node. *) val is_global : t -> bool (** [is_multicast ipv4] is a predicate indicating whether [ipv4] is a multicast address. *) val is_multicast : t -> bool (** [is_private ipv4] is a predicate indicating whether [ipv4] privately addresses a node. *) val is_private : t -> bool include Map.OrderedType with type t := t end (** A collection of functions for IPv6 addresses. *) module V6 : sig (** Type of the internet protocol v6 address of a host *) type t (** Converts the low bytes of eight int values into an abstract {! V6.t }. *) val make : int -> int -> int -> int -> int -> int -> int -> int -> t (** {3 Text string conversion} *) (** [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_exn : string -> t (** Same as [of_string_exn] but returns an option type instead of raising an exception. *) val of_string : string -> (t, [> `Msg of string ]) result (** Same as [of_string_exn] but takes as an extra argument the offset into the string for reading. *) val of_string_raw : string -> int ref -> t (** [to_string ipv6] is the string representation of [ipv6], i.e. [XXX:XX:X::XXX:XX]. *) val to_string : t -> string (** [to_buffer buf ipv6] writes the string representation of [ipv6] into the buffer [buf]. *) val to_buffer : Buffer.t -> t -> unit (** [pp f ipv6] outputs a human-readable representation of [ipv6] to the formatter [f]. *) val pp : Format.formatter -> t -> unit [@@ocaml.toplevel_printer] (** {3 Octets conversion} *) (** [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_exn : ?off:int -> string -> t (** Same as {!of_octets_exn} but returns an result type instead of raising an exception. *) val of_octets : ?off:int -> string -> (t, [> `Msg of string ]) result (** [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_exn : ?off:int -> t -> bytes -> unit (** [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 write_octets : ?off:int -> t -> bytes -> (unit, [> `Msg of string ]) result (** [to_octets ipv6] returns the 16 bytes representing the [ipv6] octets. *) val to_octets : t -> string (** {3 Int conversion} *) (** [of_int64 (ho, lo)] is the IPv6 address represented by two int64. *) val of_int64 : int64 * int64 -> t (** [to_int64 ipv6] is the 128-bit packed encoding of [ipv6]. *) val to_int64 : t -> int64 * int64 (** [of_int32 (a, b, c, d)] is the IPv6 address represented by four int32. *) val of_int32 : int32 * int32 * int32 * int32 -> t (** [to_int32 ipv6] is the 128-bit packed encoding of [ipv6]. *) val to_int32 : t -> int32 * int32 * int32 * int32 (** [of_int16 (a, b, c, d, e, f, g, h)] is the IPv6 address represented by eight 16-bit int. *) val of_int16 : int * int * int * int * int * int * int * int -> t (** [to_int16 ipv6] is the 128-bit packed encoding of [ipv6]. *) val to_int16 : t -> int * int * int * int * int * int * int * int (** {3 MAC conversion} *) (** [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}. *) val multicast_to_mac : t -> Macaddr.t (** {3 Host conversion} *) (** [to_domain_name ipv6] is the domain name label list for reverse lookups of [ipv6]. This includes the [.ip6.arpa] suffix. *) val to_domain_name : t -> [ `host ] Domain_name.t (** [of_domain_name name] is [Some t] if the [name] has an [.ip6.arpa] suffix, and an IPv6 address prefixed. *) val of_domain_name : 'a Domain_name.t -> t option (** {3 Common addresses} *) (** [unspecified] is ::. *) val unspecified : t (** [localhost] is ::1. *) val localhost : t (** [interface_nodes] is ff01::01. *) val interface_nodes : t (** [link_nodes] is ff02::01. *) val link_nodes : t (** [interface_routers] is ff01::02. *) val interface_routers : t (** [link_routers] is ff02::02. *) val link_routers : t (** [site_routers] is ff05::02. *) val site_routers : t (** A module for manipulating IPv6 network prefixes. *) module Prefix : sig type addr = t (** Type of a internet protocol subnet *) type t (** [mask n] is the pseudo-address of an [n] bit subnet mask. *) val mask : int -> addr (** [make n addr] is the [n] bit subnet prefix to which [addr] belongs. *) val make : int -> addr -> t (** [network_address prefix addr] is the address with prefix [prefix] and suffix from [addr]. See . *) val network_address : t -> addr -> addr (** [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_exn : string -> t (** Same as {!of_string_exn} but returns a result type instead of raising an exception. *) val of_string : string -> (t, [> `Msg of string ]) result (** Same as {!of_string_exn} but takes as an extra argument the offset into the string for reading. *) val of_string_raw : string -> int ref -> t (** [to_string prefix] is the CIDR notation string representation of [prefix], i.e. XXX:XX:X::XXX/XX. *) val to_string : t -> string (** [pp f prefix] outputs a human-readable representation of [prefix] to the formatter [f]. *) val pp : Format.formatter -> t -> unit [@@ocaml.toplevel_printer] (** [of_address_string_exn cidr_addr] is the address and prefix represented by [cidr_addr]. Raises {!Parse_error} if [cidr_addr] is not a valid representation of a CIDR-scoped address. *) val of_address_string_exn : string -> t * addr (** Same as {!of_address_string_exn} but returns an option type instead of raising an exception. *) val of_address_string : string -> ((t * addr), [> `Msg of string]) result (** [to_address_string prefix addr] is the network address constructed from [prefix] and [addr]. *) val to_address_string : t -> addr -> string (** [to_buffer buf prefix] writes the string representation of [prefix] to the buffer [buf]. *) val to_buffer : Buffer.t -> t -> unit (** [to_address_buffer buf prefix addr] writes string representation of the network address representing [addr] in [prefix] to the buffer [buf]. *) val to_address_buffer : Buffer.t -> t -> addr -> unit (** [of_netmask netmask addr] is the subnet prefix of [addr] with netmask [netmask]. *) val of_netmask : addr -> addr -> t (** [mem ip subnet] checks whether [ip] is found within [subnet]. *) val mem : addr -> t -> bool (** [subset ~subnet ~network] checks whether [subnet] is contained within [network]. *) val subset : subnet:t -> network:t -> bool (** [of_addr ip] create a subnet composed of only one address, [ip]. It is the same as [make 128 ip]. *) val of_addr : addr -> t (** Global Unicast 001, 2000::/3. *) val global_unicast_001 : t (** The Unique Local Unicast (ULA), fc00::/7. *) val unique_local : t (** Link-Local Unicast, fe80::/64. *) val link : t (** The multicast network, ff00::/8. *) val multicast : t (** IPv4-mapped addresses, ::ffff:0:0/96. *) val ipv4_mapped : t (** Global Unicast addresses that don't use Modified EUI64 interface identifiers, ::/3. *) val noneui64_interface : t (** Solicited-Node multicast addresses *) val solicited_node : t (** [network subnet] is the address for [subnet]. *) val network : t -> addr (** [netmask subnet] is the netmask for [subnet]. *) val netmask : t -> addr (** [bits subnet] is the bit size of the [subnet] prefix. *) val bits : t -> int include Map.OrderedType with type t := t end (** [scope ipv6] is the classification of [ipv6] by the {! scope } hierarchy. *) val scope : t -> scope (** [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 link_address_of_mac : Macaddr.t -> t (** [is_global ipv6] is a predicate indicating whether [ipv6] globally addresses a node. *) val is_global : t -> bool (** [is_multicast ipv6] is a predicate indicating whether [ipv6] is a multicast address. *) val is_multicast : t -> bool (** [is_private ipv6] is a predicate indicating whether [ipv6] privately addresses a node. *) val is_private : t -> bool include Map.OrderedType with type t := t end (** Type of either an IPv4 value or an IPv6 value *) type ('v4,'v6) v4v6 = V4 of 'v4 | V6 of 'v6 (** Type of any IP address *) type t = (V4.t,V6.t) v4v6 (** [to_string addr] is the text string representation of [addr]. *) val to_string : t -> string (** [to_buffer buf addr] writes the text string representation of [addr] into [buf]. *) val to_buffer : Buffer.t -> t -> unit (** [pp f ip] outputs a human-readable representation of [ip] to the formatter [f]. *) val pp : Format.formatter -> t -> unit [@@ocaml.toplevel_printer] (** [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_exn : string -> t (** Same as {!of_string_exn} but returns a result type instead of raising an exception. *) val of_string : string -> (t, [> `Msg of string ]) result (** Same as [of_string_exn] but takes as an extra argument the offset into the string for reading. *) val of_string_raw : string -> int ref -> t (** [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 v4_of_v6 : V6.t -> V4.t option (** [to_v4 addr] is the IPv4 representation of [addr]. *) val to_v4 : t -> V4.t option (** [v6_of_v4 ipv4] is the IPv6 representation of the IPv4 address [ipv4]. *) val v6_of_v4 : V4.t -> V6.t (** [to_v6 addr] is the IPv6 representation of [addr]. *) val to_v6 : t -> V6.t (** [scope addr] is the classification of [addr] by the {! scope } hierarchy. *) val scope : t -> scope (** [is_global addr] is a predicate indicating whether [addr] globally addresses a node. *) val is_global : t -> bool (** [is_multicast addr] is a predicate indicating whether [addr] is a multicast address. *) val is_multicast : t -> bool (** [is_private addr] is a predicate indicating whether [addr] privately addresses a node. *) val is_private : t -> bool (** [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 multicast_to_mac : t -> Macaddr.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 to_domain_name : t -> [ `host ] Domain_name.t (** [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 of_domain_name : 'a Domain_name.t -> t option module Prefix : sig type addr = t (** Type of a internet protocol subnet *) type t = (V4.Prefix.t, V6.Prefix.t) v4v6 (** [to_string subnet] is the text string representation of [subnet]. *) val to_string : t -> string (** [to_buffer buf subnet] writes the text string representation of [subnet] into [buf]. *) val to_buffer : Buffer.t -> t -> unit (** [pp f subnet] outputs a human-readable representation of [subnet] to the formatter [f]. *) val pp : Format.formatter -> t -> unit [@@ocaml.toplevel_printer] (** [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_exn : string -> t (** Same as {!of_string_exn} but returns a result type instead of raising an exception. *) val of_string : string -> (t, [> `Msg of string]) result (** Same as {!of_string_exn} but takes as an extra argument the offset into the string for reading. *) val of_string_raw : string -> int ref -> t (** [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 v4_of_v6 : V6.Prefix.t -> V4.Prefix.t option (** [to_v4 subnet] is the IPv4 representation of [subnet]. *) val to_v4 : t -> V4.Prefix.t option (** [v6_of_v4 ipv4] is the IPv6 representation of the IPv4 subnet [ipv4]. *) val v6_of_v4 : V4.Prefix.t -> V6.Prefix.t (** [to_v6 subnet] is the IPv6 representation of [subnet]. *) val to_v6 : t -> V6.Prefix.t (** [mem ip subnet] checks whether [ip] is found within [subnet]. *) val mem : addr -> t -> bool (** [subset ~subnet ~network] checks whether [subnet] is contained within [network]. *) val subset : subnet:t -> network:t -> bool (** [of_addr ip] create a subnet composed of only one address, [ip].*) val of_addr : addr -> t (** [network subnet] is the address for [subnet]. *) val network : t -> addr (** [netmask subnet] is the netmask for [subnet]. *) val netmask : t -> addr include Map.OrderedType with type t := t end include Map.OrderedType with type t := t ocaml-ipaddr-4.0.0/lib/ipaddr_cstruct.ml000066400000000000000000000045501351212123100201540ustar00rootroot00000000000000(* * 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.len 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.len 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.len 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.len 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-4.0.0/lib/ipaddr_cstruct.mli000066400000000000000000000051321351212123100203220ustar00rootroot00000000000000(* * 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 (** [of_cstruct c] parses the first 4 octets of [c] into an IPv4 address. *) val of_cstruct : Cstruct.t -> (Ipaddr.V4.t, [> `Msg of string ]) result (** [of_cstruct_exn] parses the first 4 octets of [c] into an IPv4 address. Raises {!Ipaddr.Parse_failure} on error. *) val of_cstruct_exn : Cstruct.t -> Ipaddr.V4.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 to_cstruct: ?allocator:(int -> Cstruct.t) -> Ipaddr.V4.t -> Cstruct.t (** [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. *) val write_cstruct_exn : Ipaddr.V4.t -> Cstruct.t -> unit end (** Ipv6 address conversions *) module V6 : sig (** [of_cstruct c] parses the first 16 octets of [c] into an IPv6 address. *) val of_cstruct : Cstruct.t -> (Ipaddr.V6.t, [> `Msg of string ]) result (** [of_cstruct_exn] parses the first 16 octets of [c] into an IPv6 address. Raises {!Ipaddr.Parse_failure} on error. *) val of_cstruct_exn : Cstruct.t -> Ipaddr.V6.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 to_cstruct: ?allocator:(int -> Cstruct.t) -> Ipaddr.V6.t -> Cstruct.t (** [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. *) val write_cstruct_exn : Ipaddr.V6.t -> Cstruct.t -> unit end ocaml-ipaddr-4.0.0/lib/ipaddr_sexp.ml000066400000000000000000000037601351212123100174460ustar00rootroot00000000000000(* * 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 ocaml-ipaddr-4.0.0/lib/ipaddr_sexp.mli000066400000000000000000000054131351212123100176140ustar00rootroot00000000000000(* * 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 ocaml-ipaddr-4.0.0/lib/ipaddr_top.ml000066400000000000000000000013131351212123100172610ustar00rootroot00000000000000let 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-4.0.0/lib/ipaddr_top.mli000066400000000000000000000002431351212123100174330ustar00rootroot00000000000000val printers : string list val eval_string : ?print_outcome:bool -> ?err_formatter:Format.formatter -> string -> bool val install_printers : string list -> bool ocaml-ipaddr-4.0.0/lib/ipaddr_unix.ml000066400000000000000000000026731351212123100174540ustar00rootroot00000000000000(* * 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-4.0.0/lib/ipaddr_unix.mli000066400000000000000000000045211351212123100176170ustar00rootroot00000000000000(* * 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}} *) (** [to_inet_addr ip] is the {! Unix.inet_addr} equivalent of the IPv4 or IPv6 address [ip]. *) val to_inet_addr : Ipaddr.t -> Unix.inet_addr (** [of_inet_addr ip] is the {! Ipaddr.t} equivalent of the {! Unix.inet_addr} [ip]. *) val of_inet_addr : Unix.inet_addr -> Ipaddr.t module V4 : sig (** [to_inet_addr ip] is the {! Unix.inet_addr} equivalent of the IPv4 address [ip]. *) val to_inet_addr : Ipaddr.V4.t -> Unix.inet_addr (** [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_exn : Unix.inet_addr -> Ipaddr.V4.t (** Same as [of_inet_addr_exn] but returns an option type instead of raising an exception. *) val of_inet_addr : Unix.inet_addr -> Ipaddr.V4.t option end module V6 : sig (** [to_inet_addr ip] is the {! Unix.inet_addr} equivalent of the IPv6 address [ip]. *) val to_inet_addr : Ipaddr.V6.t -> Unix.inet_addr (** [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_exn : Unix.inet_addr -> Ipaddr.V6.t (** Same as [of_inet_addr_exn] but returns an option type instead of raising an exception. *) val of_inet_addr : Unix.inet_addr -> Ipaddr.V6.t option end ocaml-ipaddr-4.0.0/lib/macaddr.ml000066400000000000000000000074301351212123100165350ustar00rootroot00000000000000(* * 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-4.0.0/lib/macaddr.mli000066400000000000000000000060111351212123100167000ustar00rootroot00000000000000(* * 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}} *) (** [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. *) exception Parse_error of string * string (** Type of the hardware address (MAC) of an ethernet interface. *) type t (** {2 Functions converting MAC addresses to/from octets/string} *) (** [of_octets_exn buf] is the hardware address extracted from [buf]. Raises [Parse_error] if [buf] has not length 6. *) val of_octets_exn : string -> t (** Same as {!of_octets_exn} but returns a result type instead of raising an exception. *) val of_octets : string -> (t, [> `Msg of string]) result (** [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_exn : string -> t (** Same as {!of_string_exn} but returns a result type instead of raising an exception. *) val of_string : string -> (t, [> `Msg of string]) result (** [to_octets mac_addr] is a string of size 6 encoding [mac_addr] as a sequence of bytes. *) val to_octets : 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 to_string : ?sep:char -> t -> string (** [pp f mac_addr] outputs a human-readable representation of [mac_addr] to the formatter [f]. *) val pp : Format.formatter -> t -> unit [@@ocaml.toplevel_printer] (** [broadcast] is [ff:ff:ff:ff:ff:ff]. *) val broadcast : t (** [make_local bytegen] creates a unicast, locally administered MAC address given a function mapping octet offset to octet value. *) val make_local : (int -> int) -> t (** [get_oui macaddr] is the integer organization identifier for [macaddr]. *) val get_oui : t -> int (** [is_local macaddr] is the predicate on the locally administered bit of [macaddr]. *) val is_local : t -> bool (** [is_unicast macaddr] the is the predicate on the unicast bit of [macaddr]. *) val is_unicast : t -> bool include Map.OrderedType with type t := t ocaml-ipaddr-4.0.0/lib/macaddr_cstruct.ml000066400000000000000000000027631351212123100203100ustar00rootroot00000000000000(* * 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.len 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.len 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-4.0.0/lib/macaddr_cstruct.mli000066400000000000000000000031571351212123100204570ustar00rootroot00000000000000(* * 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. *) (** [of_cstruct c] parses the 6 octets of [c] into a MAC address. *) val of_cstruct : Cstruct.t -> (Macaddr.t, [> `Msg of string ]) result (** [of_cstruct_exn] parses the 6 octets of [c] into a MAC address. Raises {!Macaddr.Parse_failure} on error. *) val of_cstruct_exn : Cstruct.t -> Macaddr.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 to_cstruct: ?allocator:(int -> Cstruct.t) -> Macaddr.t -> Cstruct.t (** [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. *) val write_cstruct_exn : Macaddr.t -> Cstruct.t -> unit ocaml-ipaddr-4.0.0/lib/macaddr_sexp.ml000066400000000000000000000021771351212123100175770ustar00rootroot00000000000000(* * 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-4.0.0/lib/macaddr_sexp.mli000066400000000000000000000033141351212123100177420ustar00rootroot00000000000000(* * 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-4.0.0/lib/macaddr_top.ml000066400000000000000000000011211351212123100174060ustar00rootroot00000000000000let 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-4.0.0/lib_test/000077500000000000000000000000001351212123100156435ustar00rootroot00000000000000ocaml-ipaddr-4.0.0/lib_test/dune000066400000000000000000000014321351212123100165210ustar00rootroot00000000000000(rule (copy# ../lib/ipaddr_sexp.ml ipaddr_sexp.ml)) (rule (copy# ../lib/macaddr_sexp.ml macaddr_sexp.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 oUnit)) (test (name test_macaddr) (package macaddr-sexp) (modules test_macaddr) (libraries macaddr macaddr-cstruct test_macaddr_sexp oUnit)) (test (name test_ppx) (modules test_ppx) (package ipaddr-sexp) (libraries ipaddr macaddr test_ipaddr_sexp test_macaddr_sexp oUnit)) ocaml-ipaddr-4.0.0/lib_test/test_ipaddr.ml000066400000000000000000000742721351212123100205130ustar00rootroot00000000000000(* * 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 assert_raises ~msg exn test_fn = assert_raises ~msg exn (fun () -> try test_fn () with rtexn -> begin (if exn <> rtexn then ( Printf.eprintf "Stacktrace for '%s':\n%!" msg; Printexc.print_backtrace stderr; )); raise rtexn end) 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 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 prefix,v4 = V4.Prefix.of_address_string_exn netaddr 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_address_string prefix v4 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"; "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 prefix, v4 = V4.Prefix.of_address_string_exn net_str in let nm = V4.Prefix.netmask prefix in let nnm_str = V4.to_string nm 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 nm v4 in let nns = V4.Prefix.to_address_string prefix v4 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 nm = V4.of_string_exn nm_str in let addr = V4.of_string_exn "192.168.0.1" in assert_raises ~msg:nm_str exn (fun () -> V4.Prefix.of_netmask nm addr) ) 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 module M = Map.Make(V4) in let m = M.add (V4.of_string_exn "1.0.0.1") "min" M.empty in let m = M.add (V4.of_string_exn "254.254.254.254") "the greatest host" m in let m = M.add (V4.of_string_exn "1.0.0.1") "the least host" m in assert_equal ~msg:"size" (M.cardinal m) 2; let (min_key, min_val) = M.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" (M.max_binding m) (V4.of_string_exn "254.254.254.254", "the greatest host") let test_prefix_map () = let module M = Map.Make(V4.Prefix) in let m = M.add (V4.Prefix.of_string_exn "0.0.0.0/0") "everyone" M.empty in let m = M.add (V4.Prefix.of_string_exn "192.0.0.0/1") "weirdos" m in let m = M.add (V4.Prefix.of_string_exn "128.0.0.0/1") "high-bitters" m in let m = M.add (V4.Prefix.of_string_exn "254.0.0.0/8") "top-end" m in let m = M.add (V4.Prefix.of_string_exn "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 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; ] 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_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 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 prefix,v4 = V6.Prefix.of_address_string_exn netaddr 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_address_string prefix v4 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 prefix, v6 = V6.Prefix.of_address_string_exn net_str in let nm = V6.Prefix.netmask prefix in let nnm_str = V6.to_string nm 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 nm v6 in let nns = V6.Prefix.to_address_string prefix v6 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 nm = V6.of_string_exn nm_str in let addr = V6.of_string_exn "::" in assert_raises ~msg:nm_str exn (fun () -> V6.Prefix.of_netmask nm addr) ) 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 module M = Map.Make(V6) in let maxs = "ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff" in let m = M.add (V6.of_string_exn "::0:0") "min" M.empty in let m = M.add (V6.of_string_exn maxs) "the greatest host" m in let m = M.add (V6.of_string_exn "::") "the least host" m in assert_equal ~msg:"size" (M.cardinal m) 2; let (min_key, min_val) = M.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" (M.max_binding m) (V6.of_string_exn maxs, "the greatest host") let test_prefix_map () = let module M = Map.Make(V6.Prefix) in let m = M.add (V6.Prefix.of_string_exn "::ffff:0.0.0.0/0") "everyone" M.empty in let m = M.add (V6.Prefix.of_string_exn "::ffff:192.0.0.0/1") "weirdos" m in let m = M.add (V6.Prefix.of_string_exn "::ffff:128.0.0.0/1") "high-bitters" m in let m = M.add (V6.Prefix.of_string_exn "::ffff:254.0.0.0/8") "top-end" m in let m = M.add (V6.Prefix.of_string_exn "::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) (V6.Prefix.of_string_exn "::ffff:0.0.0.0/0", "iana"); assert_equal ~msg:"max" (M.max_binding m) (V6.Prefix.of_string_exn "::ffff:254.0.0.0/8", "top-end"); assert_equal ~msg:"third" (M.find (V6.Prefix.of_string_exn "::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 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; "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; ] 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_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\nnot an IPv6 address: invalid character ' ' at 13" 13; error ("IP: [::192.168] ",4) "not an IPv4 address: invalid character '[' at 4\nnot an IPv6 address: invalid character ']' at 14" 14; (* ? *) error ("IP: 192:168::3.5 ",4) "not an IPv4 address: invalid character ':' at 7\nnot 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 module M = Map.Make(Ipaddr) in let maxv6 = "ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff" in let maxv4 = "254.254.254.254" in let m = M.add (of_string_exn maxv4) "the greatest host v4" M.empty in let m = M.add (of_string_exn "::0:0") "minv6" m in let m = M.add (of_string_exn maxv6) "the greatest host v6" m in let m = M.add (of_string_exn "::") "the least host v6" m in let m = M.add (of_string_exn "1.0.0.1") "minv4" m in let m = M.add (of_string_exn "1.0.0.1") "the least host v4" m in assert_equal ~msg:"size" (M.cardinal m) 4; let (min_key, min_val) = M.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" (M.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; ] ;; 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-4.0.0/lib_test/test_macaddr.ml000066400000000000000000000067151351212123100206400ustar00rootroot00000000000000(* * 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-4.0.0/lib_test/test_ppx.ml000066400000000000000000000017751351212123100200550ustar00rootroot00000000000000(* * 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; } [@@deriving sexp] ocaml-ipaddr-4.0.0/macaddr-cstruct.opam000066400000000000000000000013451351212123100177770ustar00rootroot00000000000000opam-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.04.0"} "dune" {build} "macaddr" {=version} "cstruct" ] build: [ ["dune" "subst"] {pinned} ["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-4.0.0/macaddr-sexp.opam000066400000000000000000000015011351212123100172610ustar00rootroot00000000000000opam-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.04.0"} "dune" {build} "macaddr" "macaddr-cstruct" {with-test} "ounit" {with-test} "ppx_sexp_conv" {>= "v0.9.0"} ] conflicts: [ "ipaddr" {< "3.0.0"} ] build: [ ["dune" "subst"] {pinned} ["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-4.0.0/macaddr.opam000066400000000000000000000017761351212123100163220ustar00rootroot00000000000000opam-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.04.0"} "dune" {build} "ounit" {with-test} "ppx_sexp_conv" {with-test & >= "v0.9.0"} ] conflicts: [ "ipaddr" {< "3.0.0"} ] build: [ ["dune" "subst"] {pinned} ["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: * oUnit-based tests * MAC-48 (Ethernet) address support * `Macaddr` is a `Map.OrderedType` * All types have sexplib serializers/deserializers optionally via the `Macaddr_sexp` library. """