(*---------------------------------------------------------------------------*
  IMPLEMENTATION  cf_ip4_addr.ml

  Copyright (c) 2003-2006, James H. Woodyatt
  All rights reserved.

  Redistribution and use in source and binary forms, with or without
  modification, are permitted provided that the following conditions
  are met:

    Redistributions of source code must retain the above copyright
    notice, this list of conditions and the following disclaimer.

    Redistributions in binary form must reproduce the above copyright
    notice, this list of conditions and the following disclaimer in
    the documentation and/or other materials provided with the
    distribution

  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
  ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
  FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
  COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
  INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
  (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
  SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
  HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
  STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
  ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
  OF THE POSSIBILITY OF SUCH DAMAGE. 
 *---------------------------------------------------------------------------*)

external init_: unit -> unit = "cf_ip4_addr_init";;
init_ ();;

type -'a t

type opaque = [ `AF_INET ]

type category = Unspecified | Unicast | Multicast | Experimental | Broadcast

type unspecified = [ opaque | `X ]
type unicast = [ opaque | `U ]
type multicast = [ opaque | `M ]
type experimental = [ opaque | `E ]
type broadcast = [ opaque | `B ]

external category: opaque t -> category = "cf_ip4_addr_category"
external is_unicast: [> opaque ] t -> unicast t = "cf_ip4_addr_is_unicast"
external is_multicast:
    [> opaque ] t -> multicast t = "cf_ip4_addr_is_multicast"
external is_experimental:
    [> opaque ] t -> experimental t = "cf_ip4_addr_is_experimental"

type unicast_realm = U_loopback | U_link | U_private | U_global
external unicast_realm:
    [> unicast ] t -> unicast_realm = "cf_ip4_addr_unicast_realm"

type multicast_realm = M_link | M_global
external multicast_realm:
    [> multicast ] t -> multicast_realm = "cf_ip4_addr_multicast_realm"

external any_: unit -> unspecified t = "cf_ip4_addr_any"
external broadcast_: unit -> broadcast t = "cf_ip4_addr_broadcast"
external loopback_: unit -> unicast t = "cf_ip4_addr_loopback"
external empty_group_: unit -> multicast t = "cf_ip4_addr_empty_group"
external all_hosts_group_: unit -> multicast t = "cf_ip4_addr_all_hosts_group"
external all_routers_group_:
    unit -> multicast t = "cf_ip4_addr_all_routers_group"

let any = any_ ()
let broadcast = broadcast_ ()
let loopback = loopback_ ()
let empty_group = empty_group_ ()
let all_hosts_group = all_hosts_group_ ()
let all_routers_group = all_routers_group_ ()

external equal: ([> opaque ] t as 'a) -> 'a -> bool = "cf_ip4_addr_equal"
external compare: ([> opaque ] t as 'a) -> 'a -> int =
    "cf_ip4_addr_compare_aux"

external pton: string -> opaque t option = "cf_inet_pton4"
external ntop: [> opaque ] t -> string = "cf_inet_ntop4"

external network_min_prefix_:
    ([> opaque ] as 'a) t -> int = "cf_ip4_addr_network_min_prefix"

external network_member_:
    ([> opaque ] as 'a) t -> int -> 'a t -> bool =
    "cf_ip4_addr_network_member"

external network_limit_:
    ([> opaque ] as 'a) t -> int -> int -> 'a t =
    "cf_ip4_addr_network_limit"

external network_next_: 'a t -> int -> 'a t = "cf_ip4_addr_network_next"

external network_netmask_: int -> string = "cf_ip4_addr_network_netmask"
    
let rec iterator_ ~dir ~lim addr =
    lazy begin
        if equal addr lim then
            Cf_seq.Z
        else
            Cf_seq.P (addr, iterator_ ~dir ~lim (network_next_ addr dir))
    end

type 'a network = {
    net_prefix_: int;
    net_minimum_: 'a t;
    net_maximum_: 'a t;
    net_member_: 'a t -> bool;
} constraint 'a = [> opaque ]

let net_create ?subnet:s n =
    let p = match s with Some p -> p | None -> network_min_prefix_ n in {
        net_prefix_ = p;
        net_minimum_ = network_limit_ n p (-1);
        net_maximum_ = network_limit_ n p 1;
        net_member_ = fun x -> network_member_ n p x;
    }

let net_number net = net.net_minimum_
let net_broadcast net = net.net_maximum_
let net_prefix net = net.net_prefix_
let net_member net = net.net_member_
let net_mask net = network_netmask_ net.net_prefix_

let net_increasing net =
    iterator_ ~dir:1 ~lim:net.net_maximum_ net.net_minimum_

let net_decreasing net =
    iterator_ ~dir:(-1) ~lim:net.net_minimum_ net.net_maximum_

(*--- End of File [ cf_ip4_addr.ml ] ---*)
