inet.ml

   1
   2 open Devkit
   3 open ExtLib
   4 open Printf
   5
   6 let uint_of_ipv4 = sprintf "%lu" $ Network.int32_of_ipv4
   7 let raw_of_ipv4 = Int32.to_string $ Network.int32_of_ipv4
   8 let ipv4_of_raw = Network.ipv4_of_int32 $ Int32.of_string
   9
  10 type domain = string list
  11
  12 let string_of_domain = String.concat "."
  13 let domain_of_string s = Stre.nsplitc s '.'
  14
  15 let domain_equal d1 d2 =
  16   try
  17     List.for_all2 (fun n1 n2 -> String.uppercase n1 = String.uppercase n2) d1 d2
  18   with
  19   | Invalid_argument _ -> false
  20
  21 (* www.site.com site.com -> www *)
  22 let subdomain_prefix d1 d2 =
  23   if String.ends_with d1 d2 then
  24     match String.length d1 - String.length d2 with
  25     | 0 -> ""
  26     | n -> if d1.[n - 1] = '.' then String.slice ~last:(n-1) d1 else ""
  27   else
  28     ""
  29
  30 (* d1 subdomain of d2 *)
  31 let is_subdomain d1 d2 =
  32   if String.ends_with d1 d2 then
  33     match String.length d1 - String.length d2 with
  34     | 0 -> true
  35     | n -> d1.[n - 1] = '.'
  36   else
  37     false
  38
  39 (* empty labels are prevented by Html_lexer *)
  40 let check_dns_labels =
  41   let rec loop s i =
  42     match String.index_from s i '.' with
  43     | exception Not_found -> String.length s - i <= 63
  44     | j -> j - i <= 63 && loop s (j+1)
  45   in
  46   fun s -> loop s 0
  47
  48 let check_valid_dns s = String.length s <= 255 && check_dns_labels s
  49
  50 (*
  51 (** keep old version for Domain *)
  52 let is_dns_domain_old host = Html_lexer.is_dns_domain (Lexing.from_string host)
  53
  54 (* should be used on punycode *)
  55 (* TODO unify in one ragel machine *)
  56 let is_dns_domain host = is_dns_domain_old host && check_valid_dns host
  57 let is_internet_hostname host = Html_lexer.is_internet_hostname (Lexing.from_string host) && check_valid_dns host && Root_domain.has_valid_tld host
  58 *)
  59
  60 let cidr_compare cidr ip =
  61   if Network.ipv4_matches ip cidr then 0 else compare (Network.prefix_of_cidr cidr) ip
  62
  63 let cidr_equal cidr1 cidr2 = Network.(ipv4_matches (prefix_of_cidr cidr1) cidr2)