/*---------------------------------------------------------------------------*
  C MODULE  cf_ip4_addr_p.c

  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. 
 *---------------------------------------------------------------------------*/

#include "cf_ip4_addr_p.h"

#include <sys/socket.h>
#include <arpa/inet.h>

#include <string.h>


#define FAILWITH(S)	(failwith("Cf_ip4_addr." S))

/*---------------------------------------------------------------------------*
  IPv4 addresses
 *---------------------------------------------------------------------------*/

enum cf_ip4_addr_unicast_realm {
    Cf_ip4_addr_U_loopback,
    Cf_ip4_addr_U_link,
    Cf_ip4_addr_U_private,
    Cf_ip4_addr_U_global
};

enum cf_ip4_addr_multicast_realm {
    Cf_ip4_addr_M_link,
    Cf_ip4_addr_M_global
};

static int cf_ip4_addr_compare(value v1, value v2)
{
    CAMLparam2(v1, v2);
    const u_int8_t* addr1Ptr;
    const u_int8_t* addr2Ptr;
    int i, result;
    
    addr1Ptr = (u_int8_t*)(&Cf_ip4_addr_val(v1)->s_addr) + 3;
    addr2Ptr = (u_int8_t*)(&Cf_ip4_addr_val(v2)->s_addr) + 3;
    
    for (i = 4; i >= 0; --i, --addr1Ptr, --addr2Ptr) {
        result = *addr1Ptr - *addr2Ptr;
        if (result) break;
    }
    
    CAMLreturn(result);
}

static long cf_ip4_addr_hash(value v)
{
    CAMLparam1(v);
    long result;
    
    result = (long) ntohl(Cf_ip4_addr_val(v)->s_addr);
    
    CAMLreturn(result);
}

static void cf_ip4_addr_serialize
   (value v, unsigned long* size32Ptr, unsigned long* size64Ptr)
{
    CAMLparam1(v);
    
    serialize_block_1(&Cf_ip4_addr_val(v)->s_addr, 4);
    *size32Ptr = 4;
    *size64Ptr = 4;
    
    CAMLreturn0;
}

static unsigned long cf_ip4_addr_deserialize(void* bufferPtr)
{
    deserialize_block_1(bufferPtr, 4);
    return 4;
}

static struct custom_operations cf_ip4_addr_op = {
    "org.conjury.ocnae.cf.in_addr",
    custom_finalize_default,
    cf_ip4_addr_compare,
    cf_ip4_addr_hash,
    cf_ip4_addr_serialize,
    cf_ip4_addr_deserialize
};

value cf_ip4_addr_alloc(const struct in_addr* addrPtr)
{
    value result;
    
    result = alloc_custom(&cf_ip4_addr_op, 4, 0, 1);
    *Cf_ip4_addr_val(result) = *addrPtr;
    return result;
}

int cf_ip4_addr_category_code(const struct in_addr* addrPtr)
{
    u_int32_t addrN = ntohl(addrPtr->s_addr);
    
    if (!addrN) return Cf_ip4_addr_unspecified;
    else if (!~addrN) return Cf_ip4_addr_broadcast;
    else if (IN_CLASSD(addrN)) return Cf_ip4_addr_multicast;
    else if (IN_EXPERIMENTAL(addrN)) return Cf_ip4_addr_experimental;
    return Cf_ip4_addr_unicast;
}

/*---
    external category: opaque t -> category = "cf_ip4_addr_category"
  ---*/
CAMLprim value cf_ip4_addr_category(value addr)
{
    CAMLparam1(addr);
    u_int32_t n = cf_ip4_addr_category_code(Cf_ip4_addr_val(addr));
    CAMLreturn(Val_int(n));
}

/*---
    external is_unicast:
        [> opaque ] t -> unicast t = "cf_ip4_addr_is_unicast"
  ---*/
CAMLprim value cf_ip4_addr_is_unicast(value addr)
{
    CAMLparam1(addr);
    
    u_int32_t addrN;
    
    addrN = Cf_ip4_addr_val(addr)->s_addr;
    addrN = ntohl(addrN);
    if (!(addrN && (IN_CLASSA(addrN) || IN_CLASSB(addrN) || IN_CLASSC(addrN))))
        FAILWITH("is_unicast");
    
    CAMLreturn(addr);
}

/*---
    external is_multicast:
        [> opaque ] t -> multicast t = "cf_ip4_addr_is_multicast"
  ---*/
CAMLprim value cf_ip4_addr_is_multicast(value addr)
{
    CAMLparam1(addr);
    
    u_int32_t addrN;
    
    addrN = Cf_ip4_addr_val(addr)->s_addr;
    addrN = ntohl(addrN);
    if (!IN_CLASSD(addrN)) FAILWITH("is_multicast");
    
    CAMLreturn(addr);
}

/*---
    external is_experimental:
        [> opaque ] t -> experimental t = "cf_ip4_addr_is_experimental"
  ---*/
CAMLprim value cf_ip4_addr_is_experimental(value addr)
{
    CAMLparam1(addr);
    
    u_int32_t addrN;
    
    addrN = Cf_ip4_addr_val(addr)->s_addr;
    addrN = ntohl(addrN);
    if (!IN_EXPERIMENTAL(addrN)) FAILWITH("is_experimental");
    
    CAMLreturn(addr);
}

#ifndef IN_LINKLOCAL
#define IN_LINKLOCALNETNUM    (u_int32_t)0xA9FE0000 /* 169.254.0.0 */
#define IN_LINKLOCAL(i) \
    (((u_int32_t)(i) & IN_CLASSB_NET) == IN_LINKLOCALNETNUM)
#endif

/*---
    external unicast_realm:
        [> unicast ] t -> unicast_realm = "cf_ip4_addr_unicast_realm"
  ---*/
CAMLprim value cf_ip4_addr_unicast_realm(value addr)
{
    CAMLparam1(addr);
    
    static const u_int32_t rfc1918_net[][2] = {
        { 0x0A000000, 0xFF000000 },  /* 10/8        */
        { 0xAC100000, 0xFFF00000 },  /* 172.16/12   */
        { 0xC0A80000, 0xFFFF0000 }   /* 192.168/16  */
    };
        
    u_int32_t addrN;
    value result;
    
    addrN = Cf_ip4_addr_val(addr)->s_addr;
    addrN = ntohl(addrN);
    
    if ((addrN & IN_CLASSA_NET) == (IN_LOOPBACKNET << IN_CLASSA_NSHIFT))
        result = Val_int(Cf_ip4_addr_U_loopback);
    else if (IN_LINKLOCAL(addrN))
        result = Val_int(Cf_ip4_addr_U_link);
    else {
        int i;
        
        result = Val_int(Cf_ip4_addr_U_global);
        for (i = 0; i < 3; ++i)
            if ((addrN & rfc1918_net[i][1]) == rfc1918_net[i][0]) {
                result = Val_int(Cf_ip4_addr_U_private);
                break;
            }
    }
    
    CAMLreturn(result);
}

/*---
    external multicast_realm:
        [> multicast ] t -> multicast_realm = "cf_ip4_addr_multicast_realm"
  ---*/
CAMLprim value cf_ip4_addr_multicast_realm(value addr)
{
    CAMLparam1(addr);
    
    u_int32_t addrN;
    
    addrN = Cf_ip4_addr_val(addr)->s_addr;
    addrN = ntohl(addrN);
    CAMLreturn(Val_int((addrN <= INADDR_MAX_LOCAL_GROUP)
        ? Cf_ip4_addr_M_link : Cf_ip4_addr_M_global));
}

static value cf_ip4_addr_any_val = Val_unit;
static value cf_ip4_addr_loopback_val = Val_unit;
static value cf_ip4_addr_broadcast_val = Val_unit;
static value cf_ip4_addr_empty_group_val = Val_unit;
static value cf_ip4_addr_all_hosts_group_val = Val_unit;
static value cf_ip4_addr_all_routers_group_val = Val_unit;

/*---
    external any_: unit -> unspecified t = "cf_ip4_addr_any"
  ---*/
CAMLprim value cf_ip4_addr_any(value unit)
{
    CAMLparam0();
    CAMLreturn(cf_ip4_addr_any_val);
}

/*---
    external broadcast_: unit -> broadcast t = "cf_ip4_addr_broadcast"
  ---*/
CAMLprim value cf_ip4_addr_loopback(value unit)
{
    CAMLparam0();
    CAMLreturn(cf_ip4_addr_loopback_val);
}

/*---
    external loopback_: unit -> unicast t = "cf_ip4_addr_loopback"
  ---*/
CAMLprim value cf_ip4_addr_broadcast(value unit)
{
    CAMLparam0();
    CAMLreturn(cf_ip4_addr_broadcast_val);
}

/*---
    external empty_group_: unit -> multicast t = "cf_ip4_addr_empty_group"
  ---*/
CAMLprim value cf_ip4_addr_empty_group(value unit)
{
    CAMLparam0();
    CAMLreturn(cf_ip4_addr_empty_group_val);
}

/*---
    external all_hosts_group_:
        unit -> multicast t = "cf_ip4_addr_all_hosts_group"
  ---*/
CAMLprim value cf_ip4_addr_all_hosts_group(value unit)
{
    CAMLparam0();
    CAMLreturn(cf_ip4_addr_all_hosts_group_val);
}

/*---
    external all_routers_group_:
        unit -> multicast t = "cf_ip4_addr_all_routers_group"
  ---*/
CAMLprim value cf_ip4_addr_all_routers_group(value unit)
{
    CAMLparam0();
    CAMLreturn(cf_ip4_addr_all_routers_group_val);
}

/*---
    external equal:
        ([> opaque ] t as 'a) -> 'a -> bool = "cf_ip4_addr_equal"
  ---*/
CAMLprim value cf_ip4_addr_equal(value addr1, value addr2)
{
    CAMLparam2(addr1, addr2);

    value result;
    
    if (Cf_ip4_addr_val(addr1)->s_addr == Cf_ip4_addr_val(addr2)->s_addr)
        result = Val_true;
    else
        result = Val_false;
    
    CAMLreturn(result);
}

/*---
    external compare:
        [> opaque ] t -> [> opaque ] t -> int = "cf_ip4_addr_compare_aux"
  ---*/
CAMLprim value cf_ip4_addr_compare_aux(value v1, value v2)
{
    int d = cf_ip4_addr_compare(v1, v2);
    return Val_int(d);
}

/*---
    external pton: string -> opaque t = "cf_inet_pton4"
  ---*/
CAMLprim value cf_inet_pton4(value str)
{
    CAMLparam1(str);
    CAMLlocal1(resultVal);

    struct in_addr addr;
    int result;
    
    result = inet_pton(AF_INET, String_val(str), &addr);
    if (result < 0) failwith("inet_pton(AF_INET, ...)");
    
    resultVal = Val_int(0);
    if (result > 0) {
        resultVal = alloc_small(1, 0);
        Store_field(resultVal, 0, cf_ip4_addr_alloc(&addr));
    }
    
    CAMLreturn(resultVal);
}

/*---
    external ntop: [> opaque ] t -> string = "cf_inet_ntop4"
  ---*/
CAMLprim value cf_inet_ntop4(value addrVal)
{
    CAMLparam1(addrVal);
    CAMLlocal1(result);
    
    struct in_addr* addrPtr;
    char buffer[INET_ADDRSTRLEN];
    
    if (!inet_ntop(AF_INET, Cf_ip4_addr_val(addrVal), buffer, sizeof buffer))
        failwith("inet_ntop(AF_INET, ....)");
    
    CAMLreturn(copy_string(buffer));
}

static int cf_ip4_addr_network_min_prefix_compute
   (const struct in_addr* addrPtr)
{
    u_int32_t network;
    int prefixLen;
    
    network = addrPtr->s_addr;
    network = ntohl(network);
    
    if (IN_CLASSA(network)) prefixLen = 8;
    else if (IN_CLASSB(network)) prefixLen = 16;
    else if (IN_CLASSC(network)) prefixLen = 24;
    else prefixLen = 4;
    
    return prefixLen;
}

static u_int32_t cf_ip4_addr_compute_hostmask(unsigned int prefixLen)
{
    u_int32_t hostMask;
    
    hostMask = ((1 << (32 - prefixLen)) - 1);
    return htonl(hostMask);
}

static void cf_ip4_addr_compute_limits
   (const struct in_addr* addrPtr, unsigned int prefixLen,
    struct in_addr* minPtr, struct in_addr* maxPtr)
{
    u_int32_t hostMask;
    
    hostMask = cf_ip4_addr_compute_hostmask(prefixLen);
    
    if (minPtr) minPtr->s_addr = addrPtr->s_addr & ~hostMask;
    if (maxPtr) maxPtr->s_addr = addrPtr->s_addr | ~hostMask;
}

/*---
    external network_min_prefix_:
        ([> opaque ] as 'a) t -> int = "cf_ip4_addr_network_min_prefix"
---*/
CAMLprim value cf_ip4_addr_network_min_prefix(value addr)
{
    CAMLparam1(addr);
    int result;
    
    result = cf_ip4_addr_network_min_prefix_compute(Cf_ip4_addr_val(addr));
    CAMLreturn(Val_int(result));
}

/*---
    external network_member_:
        n:([> opaque ] as 'a) t -> p:int -> 'a t -> bool =
        "cf_ip4_addr_network_member"
---*/
CAMLprim value cf_ip4_addr_network_member
   (value networkVal, value prefixLenVal, value addrVal)
{
    CAMLparam3(networkVal, prefixLenVal, addrVal);
    
    int prefixLen, result;
    struct in_addr* networkPtr;
    struct in_addr* addrPtr;
    struct in_addr min, max;
    u_int32_t mask;
    
    prefixLen = Int_val(prefixLenVal);
    if (prefixLen < 1 || prefixLen > 31) FAILWITH("network: prefix length");
    
    networkPtr = Cf_ip4_addr_val(networkVal);
    addrPtr = Cf_ip4_addr_val(addrVal);
    cf_ip4_addr_compute_limits
       (networkPtr, (unsigned int) prefixLen, &min, &max);
    mask = ~(min.s_addr ^ max.s_addr);
    result = !!((networkPtr->s_addr & mask) == (addrPtr->s_addr & mask));

    CAMLreturn(result ? Val_true : Val_false);
}
    
/*---
    external network_limit_:
        n:([> opaque ] as 'a) t -> p:int -> int -> 'a t =
        "cf_ip4_addr_network_limit"
---*/
CAMLprim value cf_ip4_addr_network_limit
   (value networkVal, value prefixLenVal, value dirVal, value addrVal)
{
    CAMLparam4(networkVal, prefixLenVal, dirVal, addrVal);

    int prefixLen, dir;
    struct in_addr* networkPtr;
    struct in_addr* addrPtr;
    struct in_addr* minPtr;
    struct in_addr* maxPtr;
    struct in_addr limit;
    
    networkPtr = Cf_ip4_addr_val(networkVal);
    prefixLen = Int_val(prefixLenVal);
    if (prefixLen >= 4 && prefixLen < 32) {
        u_int32_t network;
        
        network = networkPtr->s_addr;
        network = ntohl(network);
    
        if (
            (prefixLen < 24 && IN_CLASSC(network)) ||
            (prefixLen < 16 && IN_CLASSB(network)) ||
            (prefixLen < 8 && IN_CLASSA(network)) ||
            (prefixLen < 4 /* allowed for both class D and class E */)
        )
            FAILWITH("network: invalid prefix length for address class");
    }
    else
        FAILWITH("network: invalid prefix length");
    
    addrPtr = Cf_ip4_addr_val(addrVal);
    dir = Int_val(dirVal);
    minPtr = (dir < 0) ? &limit : 0;
    maxPtr = (dir > 0) ? &limit : 0;
    limit.s_addr = 0;
    
    cf_ip4_addr_compute_limits
        (networkPtr, (unsigned int) prefixLen, minPtr, maxPtr);
    
    CAMLreturn (cf_ip4_addr_alloc(&limit));
}

/*---
    external network_next_: 'a t -> int -> 'a t = "cf_ip4_addr_network_next"
---*/
CAMLprim value cf_ip4_addr_network_next(value addrVal, value stepVal)
{
    CAMLparam2(addrVal, stepVal);
    
    struct in_addr result;
    u_int32_t x;
    
    x = Cf_ip4_addr_val(addrVal)->s_addr;
    x = ntohl(x);
    x += Val_int(stepVal);
    result.s_addr = htonl(x);
    CAMLreturn (cf_ip4_addr_alloc(&result));
}

/*---
    external network_netmask_: int -> string = "cf_ip4_addr_network_netmask"
---*/
CAMLprim value cf_ip4_addr_network_netmask(value prefixLen)
{
    CAMLparam1(prefixLen);
    
    struct in_addr addr;
    char buffer[INET_ADDRSTRLEN];
    
    addr.s_addr = ~cf_ip4_addr_compute_hostmask(Int_val(prefixLen));
    if (inet_ntop(AF_INET, &addr, buffer, sizeof buffer) == 0)
        failwith("inet_ntop(AF_INET, ....)");
    
    CAMLreturn(copy_string(buffer));
}


/*---
  Initialization primitive
  ---*/
CAMLprim value cf_ip4_addr_init(value unit)
{
    struct in_addr addr;

    register_custom_operations(&cf_ip4_addr_op);
        
    addr.s_addr = htonl(INADDR_ANY);
    register_global_root(&cf_ip4_addr_any_val);
    cf_ip4_addr_any_val = cf_ip4_addr_alloc(&addr);

    addr.s_addr = htonl(INADDR_LOOPBACK);
    register_global_root(&cf_ip4_addr_loopback_val);
    cf_ip4_addr_loopback_val = cf_ip4_addr_alloc(&addr);

    addr.s_addr = htonl(INADDR_BROADCAST);
    register_global_root(&cf_ip4_addr_broadcast_val);
    cf_ip4_addr_broadcast_val = cf_ip4_addr_alloc(&addr);

    addr.s_addr = htonl(INADDR_UNSPEC_GROUP);
    register_global_root(&cf_ip4_addr_empty_group_val);
    cf_ip4_addr_empty_group_val = cf_ip4_addr_alloc(&addr);

    addr.s_addr = htonl(INADDR_ALLHOSTS_GROUP);
    register_global_root(&cf_ip4_addr_all_hosts_group_val);
    cf_ip4_addr_all_hosts_group_val = cf_ip4_addr_alloc(&addr);

    addr.s_addr = htonl(INADDR_ALLRTRS_GROUP);
    register_global_root(&cf_ip4_addr_all_routers_group_val);
    cf_ip4_addr_all_routers_group_val = cf_ip4_addr_alloc(&addr);

    return Val_unit;
}

/*--- End of File [ cf_ip4_addr_p.c ] ---*/
