/*---------------------------------------------------------------------------*
  C MODULE  cf_ip6_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_ip6_addr_p.h"

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

#include <string.h>


#define FAILWITH(S)		(failwith("Cf_ip6_addr." S))
#define INVALID_ARGUMENT(S)	(invalid_argument("Cf_ip6_addr." S))

enum cf_ip6_addr_format {
    Cf_ip6_addr_unspecified,
    Cf_ip6_addr_unicast,
    Cf_ip6_addr_multicast
};

enum cf_ip6_addr_unicast_format {
    Cf_ip6_addr_U_unassigned,
    Cf_ip6_addr_U_reserved,
    Cf_ip6_addr_U_loopback,
    Cf_ip6_addr_U_v4compat,
    Cf_ip6_addr_U_v4mapped,
    Cf_ip6_addr_U_link,
    Cf_ip6_addr_U_site,
    Cf_ip6_addr_U_uniqlocal,
    Cf_ip6_addr_U_global
};

enum cf_ip6_addr_multicast_flag {
    /* constant constructors */
    Cf_ip6_addr_M_F_transient = 0,
    
    /* non-constant constructors */
    Cf_ip6_addr_M_F_unassigned = 0
};

enum cf_ip6_addr_multicast_scope {
    /* constant constructors */
    Cf_ip6_addr_M_S_node = 0,
    Cf_ip6_addr_M_S_link,
    Cf_ip6_addr_M_S_site,
    Cf_ip6_addr_M_S_org,
    Cf_ip6_addr_M_S_global,
    
    /* non-constant constructors */
    Cf_ip6_addr_M_S_unassigned = 0
};

static const int cf_ip6_addr_multicast_scope_array[] = {
    /* Cf_ip6_addr_M_S_node    */	1,
    /* Cf_ip6_addr_M_S_link    */	2,
    /* Cf_ip6_addr_M_S_site    */	5,
    /* Cf_ip6_addr_M_S_org     */	8,
    /* Cf_ip6_addr_M_S_global  */	14,
};

static value cf_ip6_addr_alloc_constructor_0(int n)
{
    value v = alloc_small(1, 0);
    Store_field(v, 0, Int_val(n));
    return v;
}

static const Cf_constant_table_t cf_ip6_addr_multicast_scope_table = {
    cf_ip6_addr_multicast_scope_array,
    sizeof cf_ip6_addr_multicast_scope_array / sizeof (int),
    cf_ip6_addr_alloc_constructor_0
};

static int cf_ip6_addr_compare(value v1, value v2)
{
    CAMLparam2(v1, v2);
    const u_int8_t* addr1Ptr;
    const u_int8_t* addr2Ptr;
    int i, result;
    
    addr1Ptr = &Cf_ip6_addr_val(v1)->s6_addr[15];
    addr2Ptr = &Cf_ip6_addr_val(v2)->s6_addr[15];
    for (i = 15; i >= 0; --i, --addr1Ptr, --addr2Ptr) {
        result = *addr1Ptr - *addr2Ptr;
        if (result) break;
    }
    
    CAMLreturn(result);
}

static long cf_ip6_addr_hash(value v)
{
    CAMLparam1(v);
    long result;
    const u_int32_t* u32Ptr;
    u_int32_t hash, x;
    
    u32Ptr = (const u_int32_t*) Cf_ip6_addr_val(v)->s6_addr;
    hash = 0;
    hash ^= (x = *u32Ptr++, ntohl(x));
    hash ^= (x = *u32Ptr++, ntohl(x));
    hash ^= (x = *u32Ptr++, ntohl(x));
    hash ^= (x = *u32Ptr, ntohl(x));
    result = (long) hash;
    
    CAMLreturn(result);
}

static void cf_ip6_addr_serialize
   (value v, unsigned long* size32Ptr, unsigned long* size64Ptr)
{
    CAMLparam1(v);
    
    serialize_block_1(Cf_ip6_addr_val(v)->s6_addr, 16);
    *size32Ptr = 16;
    *size64Ptr = 16;
    
    CAMLreturn0;
}

static unsigned long cf_ip6_addr_deserialize(void* bufferPtr)
{
    deserialize_block_1(bufferPtr, 16);
    return 16;
}

static struct custom_operations cf_ip6_addr_op = {
    "org.conjury.ocnae.cf.in6_addr",
    custom_finalize_default,
    cf_ip6_addr_compare,
    cf_ip6_addr_hash,
    cf_ip6_addr_serialize,
    cf_ip6_addr_deserialize
};

value cf_ip6_addr_alloc(const struct in6_addr* addrPtr)
{
    value result;
    
    result = alloc_custom(&cf_ip6_addr_op, 16, 0, 1);
    *Cf_ip6_addr_val(result) = *addrPtr;
    return result;
}

static int cf_ip6_addr_format_code(const struct in6_addr* addrPtr)
{
    int i;
    for (i = 0; i < 4; ++i) {
        u_int32_t word;
        const u_int32_t fp = htonl(0xFF000000);
        
        word = *(const u_int32_t*) &addrPtr->s6_addr[i * 4];
        if (!i && (word & fp) == fp) return Cf_ip6_addr_multicast;
        if (i < 3 && !!word) break;
        if (i == 3 && !word) return Cf_ip6_addr_unspecified;
    }
    
    return Cf_ip6_addr_unicast;
}

/*---
    external format: opaque t -> format = "cf_ip6_addr_format"
  ---*/
CAMLprim value cf_ip6_addr_format(value addr)
{
    CAMLparam1(addr);
    CAMLreturn(Val_int(cf_ip6_addr_format_code(Cf_ip6_addr_val(addr))));
}

/*---
    external is_unicast:
        [> opaque ] t -> unicast t = "cf_ip6_addr_is_unicast"
  ---*/
CAMLprim value cf_ip6_addr_is_unicast(value addr)
{
    CAMLparam1(addr);
    
    const struct in6_addr* addr6Ptr = Cf_ip6_addr_val(addr);

    if (cf_ip6_addr_format_code(addr6Ptr) != Cf_ip6_addr_unicast)
        FAILWITH("is_unicast");
    CAMLreturn(addr);
}

/*---
    external is_multicast:
        [> opaque ] t -> multicast t = "cf_ip6_addr_is_multicast"
  ---*/
CAMLprim value cf_ip6_addr_is_multicast(value addr)
{
    CAMLparam1(addr);

    const struct in6_addr* addr6Ptr = Cf_ip6_addr_val(addr);

    if (cf_ip6_addr_format_code(addr6Ptr) != Cf_ip6_addr_multicast)
        FAILWITH("is_multicast");
    CAMLreturn(addr);
}

/*---
    external unicast_format:
        [> unicast] t -> unicast_format = "cf_ip6_addr_unicast_format"
  ---*/
CAMLprim value cf_ip6_addr_unicast_format(value addr)
{
    CAMLparam1(addr);

    const struct in6_addr* addr6Ptr = Cf_ip6_addr_val(addr);
    value result = Val_int(Cf_ip6_addr_U_unassigned);
    u_int32_t word;
    
    word = *(const u_int32_t*) &addr6Ptr->s6_addr[0];
    word = ntohl(word);
    
    if (word > 0) {
        u_int32_t fp3 = word >> 29;
        if (fp3 == 0) {
            unsigned int fp7 = word >> 25;
            if (fp7 == 1 || fp7 == 2)
                result = Val_int(Cf_ip6_addr_U_reserved);
        }
        else if (fp3 == 1)
            result = Val_int(Cf_ip6_addr_U_global);
        else if (fp3 == 7) {
            unsigned int fp8 = word >> 24;
            if (fp8 == 0)
                result = Val_int(Cf_ip6_addr_U_reserved);
            else if (fp8 == 0xFE) {
                unsigned int fp10 = (word >> 22) & 3;
                if (fp10 == 2)
                    result = Val_int(Cf_ip6_addr_U_link);
                else if (fp10 == 3)
                    result = Val_int(Cf_ip6_addr_U_site);
            }
            else if (fp8 == 0xFC || fp8 == 0xFD)
                result = Val_int(Cf_ip6_addr_U_uniqlocal);
        }
    }
    else /* word == 0 */ {
        int i;

        result = Val_int(Cf_ip6_addr_U_reserved);
        
        for (i = 1; i < 3; ++i) {
            word = *(const u_int32_t*) &addr6Ptr->s6_addr[i * 4];
            
            if (i == 1 && !!word) break;
            
            if (i == 2) {
                const struct in_addr* addr4Ptr;
                
                if (word && word != ntohl(0xFFFF)) break;
                
                addr4Ptr = (const struct in_addr*) &addr6Ptr->s6_addr[12];
                
                if (!word && addr4Ptr->s_addr == ntohl(1)) {
                    result = Val_int(Cf_ip6_addr_U_loopback);
                    break;
                }
                                
                if (
                    cf_ip4_addr_category_code(addr4Ptr) == Cf_ip4_addr_unicast
                   )
                {
                    result = word
                        ? Val_int(Cf_ip6_addr_U_v4mapped)
                        : Val_int(Cf_ip6_addr_U_v4compat);
                    break;
                }
            }
        }
    }
    
    CAMLreturn(result);
}

/*---
    external is_v4compat:
        [> opaque ] t -> Cf_ip4_addr.opaque t = "cf_ip6_addr_is_v4compat"
  ---*/
CAMLprim value cf_ip6_addr_is_v4compat(value addr)
{
    CAMLparam1(addr);
    
    const struct in6_addr* addr6Ptr = Cf_ip6_addr_val(addr);
    struct in_addr addr4;
    
    if (!IN6_IS_ADDR_V4COMPAT(addr6Ptr)) FAILWITH("is_v4compat");
    addr4.s_addr = *(const u_int32_t*)(&addr6Ptr->s6_addr[12]);
    CAMLreturn(cf_ip4_addr_alloc(&addr4));
}

/*---
    external to_v4compat:
        [> Cf_ip4_addr.unicast ] -> v4compat t = "cf_ip6_addr_to_v4compat"
  ---*/
CAMLprim value cf_ip6_addr_is_v4mapped(value addr)
{
    CAMLparam1(addr);
    
    const struct in6_addr* addr6Ptr = Cf_ip6_addr_val(addr);
    struct in_addr addr4;

    if (!IN6_IS_ADDR_V4MAPPED(addr6Ptr)) FAILWITH("is_v4mapped");    
    addr4.s_addr = *(const u_int32_t*)(&addr6Ptr->s6_addr[12]);
    CAMLreturn(cf_ip4_addr_alloc(&addr4));
}

/*---
    external is_v4mapped:
        [> opaque ] t -> Cf_ip4_addr.opaque t = "cf_ip6_addr_is_v4mapped"
  ---*/
CAMLprim value cf_ip6_addr_to_v4compat(value addr4)
{
    CAMLparam1(addr4);
    
    const struct in_addr* addrPtr = Cf_ip4_addr_val(addr4);
    struct in6_addr addr6;
    
    addr6 = in6addr_any;
    *((u_int32_t*) &addr6.s6_addr[0]) = 0;
    *((u_int32_t*) &addr6.s6_addr[4]) = 0;
    *((u_int32_t*) &addr6.s6_addr[8]) = 0;
    *((u_int32_t*) &addr6.s6_addr[12]) = addrPtr->s_addr;
    
    CAMLreturn(cf_ip6_addr_alloc(&addr6));
}

/*---
    external to_v4mapped:
        [> Cf_ip4_addr.unicast ] -> v4mapped t = "cf_ip6_addr_to_v4mapped"
  ---*/
CAMLprim value cf_ip6_addr_to_v4mapped(value addr4)
{
    CAMLparam1(addr4);
    
    const struct in_addr* addrPtr = Cf_ip4_addr_val(addr4);
    struct in6_addr addr6;
    
    addr6 = in6addr_any;
    *((u_int32_t*) &addr6.s6_addr[0]) = 0;
    *((u_int32_t*) &addr6.s6_addr[4]) = 0;
    *((u_int32_t*) &addr6.s6_addr[8]) = htonl(0xFFFF);
    *((u_int32_t*) &addr6.s6_addr[12]) = addrPtr->s_addr;
    
    CAMLreturn(cf_ip6_addr_alloc(&addr6));
}

#ifndef IN6ADDR_NODELOCAL_ALLNODES_INIT
#define IN6ADDR_NODELOCAL_ALLNODES_INIT \
        {{{ 0xff, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, \
            0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x01 }}}
#endif

#ifndef IN6ADDR_LINKLOCAL_ALLNODES_INIT
#define IN6ADDR_LINKLOCAL_ALLNODES_INIT \
        {{{ 0xff, 0x02, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, \
            0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x01 }}}
#endif

#ifndef IN6ADDR_LINKLOCAL_ALLROUTERS_INIT
#define IN6ADDR_LINKLOCAL_ALLROUTERS_INIT \
        {{{ 0xff, 0x02, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, \
            0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x02 }}}
#endif

static const struct in6_addr cf_in6addr_nodelocal_allnodes =
    IN6ADDR_NODELOCAL_ALLNODES_INIT;

static const struct in6_addr cf_in6addr_linklocal_allnodes =
    IN6ADDR_LINKLOCAL_ALLNODES_INIT;

static const struct in6_addr cf_in6addr_linklocal_allrouters =
IN6ADDR_LINKLOCAL_ALLROUTERS_INIT;

static value cf_ip6_addr_unspecified_val = Val_unit;
static value cf_ip6_addr_loopback_val = Val_unit;
static value cf_ip6_addr_node_local_all_nodes_val = Val_unit;
static value cf_ip6_addr_link_local_all_nodes_val = Val_unit;
static value cf_ip6_addr_link_local_all_routers_val = Val_unit;

/*---
    external to_multicast_components:
        [> multicast ] t ->
        multicast_scope * multicast_flag list * multicast_group_id t =
        "cf_ip6_addr_to_multicast_components"
  ---*/
CAMLprim value cf_ip6_addr_to_multicast_components(value addrVal)
{
    CAMLparam1(addrVal);
    CAMLlocal5(resultVal, scopeVal, flagListVal, groupIdVal, hdVal);
    CAMLlocal1(consVal);
    
    const struct in6_addr* addrPtr = Cf_ip6_addr_val(addrVal);
    struct in6_addr groupId;
    u_int32_t word;
    int i;
    
    word = *(const u_int32_t*) addrPtr->s6_addr;
    word = ntohl(word);
    
    scopeVal = cf_get_constant
       (&cf_ip6_addr_multicast_scope_table, (word >> 16) & 0xF);
    flagListVal = Val_int(0);
    for (i = 0; i < 4; ++i) {
        if (word & (0x100000 << i)) {
            hdVal = alloc_small(2, 0);
            if (i == 0)
                Store_field(hdVal, 0, Val_int(0));
            else {
                consVal = alloc_small(1, 0);
                Store_field(consVal, 0, Val_int(i));
                Store_field(hdVal, 0, consVal);
            }
            Store_field(hdVal, 1, flagListVal);
            flagListVal = hdVal;
        }
    }
    
    groupId.s6_addr[0] = 0;
    groupId.s6_addr[1] = 0;
    memcpy(&groupId.s6_addr[2], &addrPtr->s6_addr[2], 14);
    groupIdVal = cf_ip6_addr_alloc(&groupId);
    
    resultVal = alloc_small(3, 0);
    Store_field(resultVal, 0, scopeVal);
    Store_field(resultVal, 1, flagListVal);
    Store_field(resultVal, 2, groupIdVal);
        
    CAMLreturn(resultVal);
}

/*---
    external of_multicast_components:
        multicast_scope -> multicast_flag list -> multicast_group_id t ->
        multicast t = "cf_ip6_addr_of_multicast_components"
  ---*/
CAMLprim value cf_ip6_addr_of_multicast_components
   (value scopeVal, value flagListVal, value groupIdVal)
{
    CAMLparam3(scopeVal, flagListVal, groupIdVal);
    CAMLlocal2(flagVal, consVal);
    
    struct in6_addr addr;
    u_int8_t byte;
    
    addr.s6_addr[0] = 0xFF;

    byte = 0;
    while (Is_block(flagListVal)) {        
        flagVal = Field(flagListVal, 0);
        if (Is_block(flagVal)) {
            int unassigned;
            
            consVal = Field(0, flagVal);
            unassigned = Int_val(consVal);
            if (unassigned < 0 || unassigned > 3)
                INVALID_ARGUMENT("of_multicast_components");
            byte |= 0x10 << unassigned;
        }
        else
            byte |= 0x10 << Int_val(flagVal);
        
        flagListVal = Field(flagListVal, 1);
    }

    byte |= cf_ip6_addr_multicast_scope_table.array[Int_val(scopeVal)];
    addr.s6_addr[1] = byte;

    memcpy(&addr.s6_addr[2], &Cf_ip6_addr_val(groupIdVal)->s6_addr[2], 14);
    
    CAMLreturn(cf_ip6_addr_alloc(&addr));
}

/*---
    external unspecified_: unit -> unspecified t = "cf_ip6_addr_unspecified"
  ---*/
CAMLprim value cf_ip6_addr_unspecified(value unit)
{
    CAMLparam0();
    CAMLreturn(cf_ip6_addr_unspecified_val);
}

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

/*---
    external node_local_all_nodes_:
        unit -> multicast t = "cf_ip6_addr_node_local_all_nodes"
  ---*/
CAMLprim value cf_ip6_addr_node_local_all_nodes(value unit)
{
    CAMLparam0();
    CAMLreturn(cf_ip6_addr_node_local_all_nodes_val);
}

/*---
    external link_local_all_nodes_:
        unit -> multicast t = "cf_ip6_addr_link_local_all_nodes"
  ---*/
CAMLprim value cf_ip6_addr_link_local_all_nodes(value unit)
{
    CAMLparam0();
    CAMLreturn(cf_ip6_addr_link_local_all_nodes_val);
}

/*---
    external link_local_all_routers_:
        unit -> multicast t = "cf_ip6_addr_link_local_all_routers"
  ---*/
CAMLprim value cf_ip6_addr_link_local_all_routers(value unit)
{
    CAMLparam0();
    CAMLreturn(cf_ip6_addr_link_local_all_routers_val);
}

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

    value result;
    
    if (IN6_ARE_ADDR_EQUAL(Cf_ip6_addr_val(addr1), Cf_ip6_addr_val(addr2)))
        result = Val_true;
    else
        result = Val_false;
    
    CAMLreturn(result);
}

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

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

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

/*---
    external ntop: [> opaque ] t -> string = "cf_inet_ntop6"
  ---*/
CAMLprim value cf_inet_ntop6(value str)
{
    CAMLparam1(str);
    
    char buffer[INET6_ADDRSTRLEN];
    
    if (inet_ntop(AF_INET6, Cf_ip6_addr_val(str), buffer, sizeof buffer) == 0)
        failwith("inet_ntop(AF_INET6, ....)");
    
    CAMLreturn(copy_string(buffer));
}


/*---
  Initialization primitive
  ---*/
CAMLprim value cf_ip6_addr_init(value unit)
{
    register_custom_operations(&cf_ip6_addr_op);
        
    register_global_root(&cf_ip6_addr_unspecified_val);
    cf_ip6_addr_unspecified_val = cf_ip6_addr_alloc(&in6addr_any);
    
    register_global_root(&cf_ip6_addr_loopback_val);
    cf_ip6_addr_loopback_val = cf_ip6_addr_alloc(&in6addr_loopback);
    
    register_global_root(&cf_ip6_addr_node_local_all_nodes_val);
    cf_ip6_addr_node_local_all_nodes_val =
        cf_ip6_addr_alloc(&cf_in6addr_nodelocal_allnodes);
    
    register_global_root(&cf_ip6_addr_link_local_all_nodes_val);
    cf_ip6_addr_link_local_all_nodes_val =
        cf_ip6_addr_alloc(&cf_in6addr_linklocal_allnodes);
    
    register_global_root(&cf_ip6_addr_link_local_all_routers_val);
    cf_ip6_addr_link_local_all_routers_val =
        cf_ip6_addr_alloc(&cf_in6addr_linklocal_allrouters);

    return Val_unit;
}

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