File : posix-sockets-internet.adb


pragma Source_Reference (1, "posix-sockets-internet.gpb");
------------------------------------------------------------------------------
--                                                                          --
--   POSIX Ada95 Bindings for Protocol Independent Interfaces (P1003.5c)    --
--                                                                          --
--                P O S I X . S o c k e t s . I n t e r n e t               --
--                                                                          --
--                                  B o d y                                 --
--                                                                          --
--                                                                          --
--  Copyright (c) 1997 Lockheed Martin Corporation, All Rights Reserved.    --
--                                                                          --
--  This file is part of an implementation of an Ada95 API for the sockets  --
--  and network support services found in P1003.1g -- Protocol Independent  --
--  Interfaces.  It is integrated with the  FSU Implementation of POSIX.5b  --
--  (FLORIST), an Ada API for  POSIX OS services for use with the GNAT Ada  --
--  compiler and the FSU Gnu Ada Runtime Library (GNARL). The interface is  --
--  intended to be close to those specified in IEEE STD 1003.5: 1990, IEEE  --
--  STD 1003.5b: 1996, and IEEE Draft STD 1003.5c: 1997.                    --
--                                                                          --
--  This is free software;  you can redistribute it and/or modify it under  --
--  terms of the  GNU  General  Public  License as  published by the  Free  --
--  Software Foundation;  either version  2, or (at your option) any later  --
--  version.  This software is distributed  in  the hope  that  it will be  --
--  useful, but WITHOUT ANY WARRANTY;  without  even the implied  warranty  --
--  of MERCHANTABILITY or FITNESS FOR A PARTICULAR  PURPOSE.  See  the GNU  --
--  General Public License for more details.  You  should have  received a  --
--  copy of the GNU General Public License  distributed  with  GNARL;  see  --
--  file  COPYING.  If not,  write to  the  Free  Software  Foundation, 59  --
--  Temple Place - Suite 330, Boston, MA 02111-1307, USA.                   --
--                                                                          --
--  As a special exception, if other files instantiate generics from  this  --
--  unit, or you link this unit with other files to produce an  executable, --
--  this  unit does not by itself cause the  resulting  executable  to  be  --
--  covered  by the  GNU  General  Public License. This exception does not  --
--  however invalidate any other  reasons why the executable file might be  --
--  covered by the GNU Public License.                                      --
--                                                                          --
------------------------------------------------------------------------------

with POSIX.C; use POSIX.C;
with GNAT.IO; use GNAT.IO;
with POSIX.Implementation; use POSIX.Implementation;
with Unchecked_Conversion;
with System;
with Text_IO;
package body POSIX.Sockets.Internet is

   use POSIX.C.Sockets;
   use POSIX.C.NetDB;

   --  unchecked conversions

   function To_char_ptr is new Unchecked_Conversion
      (System.Address, char_ptr);

   function To_char_var_ptr is new Unchecked_Conversion
      (System.Address, char_var_ptr);

   type IP_Ancillary_Data_Access is access all IP_Ancillary_Data;

   function To_ADA is new Unchecked_Conversion
      (char_ptr, IP_Ancillary_Data_Access);

   function To_sockaddr_var_ptr is new Unchecked_Conversion
      (System.Address, sockaddr_var_ptr);

   function To_sockaddr_in_var_ptr is new Unchecked_Conversion
      (System.Address, sockaddr_in_var_ptr);

   function To_sockaddr_in_var_ptr is new Unchecked_Conversion
      (char_ptr, sockaddr_in_var_ptr);

   function To_sockaddr_in_ptr is new Unchecked_Conversion
      (char_ptr, sockaddr_in_ptr);

   function To_sockaddr_in_ptr is new Unchecked_Conversion
      (sockaddr_ptr, sockaddr_in_ptr);

   -----------------------------------------
   --  C interface routines
   -----------------------------------------

   function c_setsockopt
      (s : int;
       level : int;
       optname : int;
       optval : char_ptr;
       optlen : size_t)
     return int;
   pragma Import (C, c_setsockopt, setsockopt_LINKNAME);

   function c_getsockopt
      (s : int;
       level : int;
       optname : int;
       optval : char_var_ptr;
       optlen : size_t_var_ptr)
     return int;
   pragma Import (C, c_getsockopt, getsockopt_LINKNAME);

--     function c_htons (in_port : in_port_t) return in_port_t;
--     pragma Import (C, c_htons, "c_htons");

--     function c_ntohs (in_port : in_port_t) return in_port_t;
--     pragma Import (C, c_ntohs, "c_ntohs");

   ---------------------------------
   --  Internet Socket Addresses  --
   ---------------------------------

   function Get_Internet_Port (Name : Internet_Socket_Address)
      return Internet_Port is
   begin
      return Internet_Port (Name.C.sin_port);
   end Get_Internet_Port;

   procedure Set_Internet_Port
      (Name  : in out Internet_Socket_Address;
       Value : in     Internet_Port) is
   begin
      Name.C.sin_port := in_port_t (Value);
   end Set_Internet_Port;

   function Get_Internet_Address (Name : Internet_Socket_Address)
      return Internet_Address is
   begin
      return (C => (s_addr => Name.C.sin_addr.s_addr));
   end Get_Internet_Address;

   procedure Set_Internet_Address
      (Name    : in out Internet_Socket_Address;
       Address : in     Internet_Address) is
   begin
      Name.C.sin_addr.s_addr := Address.C.s_addr;
   end Set_Internet_Address;

   --------------------------------------
   --  Internetwork Support Functions  --
   --------------------------------------

   --  Internet Address Manipulation
--     function c_htonl (in_addr : in_addr_t) return in_addr_t;
--     pragma Import (C, c_htonl, "c_htonl");

--   function Host_To_Network_Byte_Order
--      (Address : Internet_Address)
--     return Internet_Address is
--   begin
--      return (C => (s_addr => c_htonl (Address.C.s_addr)));
--   end Host_To_Network_Byte_Order;

--     function c_ntohl (in_addr : in_addr_t) return in_addr_t;
--     pragma Import (C, c_ntohl, "c_ntohl");

--   function Network_To_Host_Byte_Order (Address : Internet_Address)
--     return Internet_Address is
--   begin
--      return (C => (s_addr => c_ntohl (Address.C.s_addr)));
--   end Network_To_Host_Byte_Order;

   function c_inet_addr (str : char_ptr) return in_addr_t;
   pragma Import (C, c_inet_addr, POSIX.C.Netinet.inet_addr_LINKNAME);

   function String_To_Internet_Address (Address : POSIX.POSIX_String)
     return Internet_Address is
   begin
      return (C => (s_addr =>
         c_inet_addr (To_char_ptr (Address (Address'First)'Address))));
   end String_To_Internet_Address;

   function Is_Internet_Address (Address : POSIX.POSIX_String)
     return Boolean is
   begin
      if c_inet_addr
         (Address (Address'First)'Unchecked_Access) = INADDR_NONE then
         return False;
      else
         return True;
      end if;
   end Is_Internet_Address;

   function c_inet_ntoa (addr : System.Address) return char_ptr;
   pragma Import (C, c_inet_ntoa, "c_inet_ntoa");

   function Internet_Address_To_String (Address : Internet_Address)
     return POSIX.POSIX_String is
   begin
      return Form_POSIX_String
           (c_inet_ntoa (Address.C.s_addr'Address));
   end Internet_Address_To_String;

   --  Network Database Functions
   function Get_Name (Info_Item : Network_Info)
     return POSIX.POSIX_String is
   begin
      return Form_POSIX_String (Info_Item.C.n_name);
   end Get_Name;

   procedure For_Every_Network_Alias (Info_Item : Network_Info) is
      next_alias : char_ptr_ptr;
      Quit : Boolean := False;
   begin
      next_alias := Info_Item.C.n_aliases;
      if next_alias /= null then
         while next_alias.all /= null loop
            Action (Form_POSIX_String (next_alias.all), Quit);
            exit when Quit;
            Advance (next_alias);
         end loop;
      end if;
   end For_Every_Network_Alias;

   function Get_Family (Info_Item : Network_Info)
      return Protocol_Family is
   begin
      return Protocol_Family (Info_Item.C.n_addrtype);
   end Get_Family;

   function Get_Network_Number (Info_Item : Network_Info)
     return Network_Number is
   begin
      return Network_Number (Info_Item.C.n_net);
   end Get_Network_Number;

   function c_getnetbyaddr_r
      (net : unsigned;
       typ : int;
       result : netent_var_ptr;
       buffer : char_ptr;
       buflen : int)
     return netent_ptr;
   pragma Import (C, c_getnetbyaddr_r, getnetbyaddr_r_LINKNAME);

   function Get_Network_Info_By_Address
      (Number : Network_Number;
       Family  : Protocol_Family;
       Storage : Database_Array_Pointer)
     return Network_Info is
      netent : aliased POSIX.C.NetDB.struct_netent;
      Result : POSIX.C.NetDB.netent_ptr;
   begin
      Result := c_getnetbyaddr_r
      (unsigned (Number), int (Family), netent'Unchecked_Access,
       To_char_ptr (Storage (Storage'First)'Address), Storage'Length);
      if Result /= null then
         return (C => netent);
      else
         return (C => (n_name     => null,
                       n_aliases  => null,
                       n_addrtype => 0,
                       n_net      => 0));
      end if;
   end Get_Network_Info_By_Address;

   function c_getnetbyname_r
      (name : char_ptr;
       result : netent_var_ptr;
       buffer : char_ptr;
       buflen : int)
     return netent_ptr;
   pragma Import (C, c_getnetbyname_r, getnetbyname_r_LINKNAME);

   function Get_Network_Info_By_Name
      (Name    : POSIX.POSIX_String;
       Storage : Database_Array_Pointer)
     return Network_Info is
      netent : aliased POSIX.C.NetDB.struct_netent;
      Result : POSIX.C.NetDB.netent_ptr;
   begin
      Result := c_getnetbyname_r
      (Name (Name'First)'Unchecked_Access, netent'Unchecked_Access,
       To_char_ptr (Storage (Storage'First)'Address), Storage'Length);
      if Result /= null then
         return (C => netent);
      else
         return (C => (n_name => null,
                       n_aliases => null,
                       n_addrtype => 0,
                       n_net => 0));
      end if;
   end Get_Network_Info_By_Name;

   function c_setnetent (stayopen : int) return int;
   pragma Import (C, c_setnetent, setnetent_LINKNAME);

   procedure Open_Network_Database_Connection
      (Stay_Open : in Boolean) is
   begin
      if Stay_Open then
         Check (c_setnetent (1));
      else
         Check (c_setnetent (0));
      end if;
   end Open_Network_Database_Connection;

   function c_endnetent return int;
   pragma Import (C, c_endnetent, endnetent_LINKNAME);

   procedure Close_Network_Database_Connection is
   begin
      Check (c_endnetent);
   end Close_Network_Database_Connection;

   --  Protocol Database Functions
   function Get_Name (Info_Item : Protocol_Info)
     return POSIX.POSIX_String is
   begin
      return Form_POSIX_String (Info_Item.C.p_name);
   end Get_Name;

   procedure For_Every_Protocol_Alias (Info_Item : Protocol_Info) is
      next_alias : char_ptr_ptr;
      Quit : Boolean := False;
   begin
      next_alias := Info_Item.C.p_aliases;
      if next_alias /= null then
         while next_alias.all /= null loop
            Action (Form_POSIX_String (next_alias.all), Quit);
            exit when Quit;
            Advance (next_alias);
         end loop;
      end if;
   end For_Every_Protocol_Alias;

   function Get_Protocol_Number (Info_Item : Protocol_Info)
     return Protocol_Number is
   begin
      return Protocol_Number (Info_Item.C.p_proto);
   end Get_Protocol_Number;

   function c_getprotobynumber_r
      (proto : int;
       result : protoent_var_ptr;
       buffer : char_ptr;
       buflen : int)
     return protoent_ptr;
   pragma Import (C, c_getprotobynumber_r, getprotobynumber_r_LINKNAME);

   function Get_Protocol_Info_By_Number
      (Number : Protocol_Number;
       Storage : Database_Array_Pointer)
     return Protocol_Info is
      protoent : aliased struct_protoent;
      Result : protoent_ptr;
   begin
      Result := c_getprotobynumber_r
      (int (Number), protoent'Unchecked_Access,
       To_char_ptr (Storage (Storage'First)'Address), Storage'Length);
      if Result /= null then
         return (C => protoent);
      else
         return (C => (p_name => null,
                       p_aliases => null,
                       p_proto => 0));
      end if;
   end Get_Protocol_Info_By_Number;

   function c_getprotobyname_r
      (name : char_ptr;
       result : protoent_var_ptr;
       buffer : char_ptr;
       buflen : int)
     return protoent_ptr;
   pragma Import (C, c_getprotobyname_r, getprotobyname_r_LINKNAME);

   function Get_Protocol_Info_By_Name
      (Name : POSIX.POSIX_String;
       Storage : Database_Array_Pointer)
     return Protocol_Info is
      protoent : aliased struct_protoent;
      Result : protoent_ptr;
   begin
      Result := c_getprotobyname_r
      (Name (Name'First)'Unchecked_Access, protoent'Unchecked_Access,
       To_char_ptr (Storage (Storage'First)'Address), Storage'Length);
      if Result /= null then
         return (C => protoent);
      else
         return (C => (p_name => null,
                       p_aliases => null,
                       p_proto => 0));
      end if;
   end Get_Protocol_Info_By_Name;

   function c_setprotoent (stayopen : int) return int;
   pragma Import (C, c_setprotoent, setprotoent_LINKNAME);

   procedure Open_Protocol_Database_Connection
      (Stay_Open : in Boolean) is
   begin
      if Stay_Open then
         Check (c_setprotoent (1));
      else
         Check (c_setprotoent (0));
      end if;
   end Open_Protocol_Database_Connection;

   function c_endprotoent return int;
   pragma Import (C, c_endprotoent, endprotoent_LINKNAME);

   procedure Close_Protocol_Database_Connection is
   begin
      Check (c_endprotoent);
   end Close_Protocol_Database_Connection;

   -------------------------------
   --  Internet Socket Options  --
   -------------------------------

   --  TCP Keepalive Interval  --

   function Get_Keep_Alive_Interval
      (Socket : POSIX.IO.File_Descriptor)
      return Keep_Alive_Time is
      optval : aliased int;
      optlen : aliased size_t := optval'Size / char'Size;
   begin
      Check (c_getsockopt (int (Socket), int (IPPROTO_TCP),
        int (TCP_KEEPALIVE), To_char_var_ptr (optval'Address),
        optlen'Unchecked_Access));
      return Keep_Alive_Time (optval);
   end Get_Keep_Alive_Interval;

   procedure Set_Keep_Alive_Interval
      (Socket : in POSIX.IO.File_Descriptor;
       To     : in Keep_Alive_Time) is
      optval : aliased int;
      optlen : aliased size_t := optval'Size / char'Size;
   begin
      optval := int (To);
      Check (c_setsockopt (int (Socket), int (IPPROTO_TCP),
             int (TCP_KEEPALIVE), To_char_ptr (optval'Address), optlen));
   end Set_Keep_Alive_Interval;

   --  TCP No Delay  --

   function Get_No_Delay
      (Socket : POSIX.IO.File_Descriptor)
      return Socket_Option_Value is
      optval : aliased int;
      optlen : aliased size_t := optval'Size / char'Size;
   begin
      Check (c_getsockopt (int (Socket), int (IPPROTO_TCP), int (TCP_NODELAY),
             To_char_var_ptr (optval'Address), optlen'Unchecked_Access));
      if optval = 0 then
         return Disabled;
      else
         return Enabled;
      end if;
   end Get_No_Delay;

   procedure Set_No_Delay
      (Socket : in POSIX.IO.File_Descriptor;
       To     : in Socket_Option_Value) is
      optval : aliased int := 0;
      optlen : size_t := optval'Size / char'Size;
   begin
      if To = Enabled then optval := 1; end if;
      Check (c_setsockopt (int (Socket), int (IPPROTO_TCP), int (TCP_NODELAY),
             To_char_ptr (optval'Address), optlen));
   end Set_No_Delay;

   --  TCP Max Retransmit Time  --

   function Get_Retransmit_Time_Maximum
      (Socket : POSIX.IO.File_Descriptor)
      return Socket_Retransmit_Time is
      optval : aliased int;
      optlen : aliased size_t := optval'Size / char'Size;
   begin
      Check (c_getsockopt (int (Socket), int (IPPROTO_TCP), int (TCP_MAXRXT),
             To_char_var_ptr (optval'Address), optlen'Unchecked_Access));
      return Socket_Retransmit_Time (optval);
   end Get_Retransmit_Time_Maximum;

   procedure Set_Retransmit_Time_Maximum
      (Socket : in POSIX.IO.File_Descriptor;
       To     : in Socket_Retransmit_Time) is
      optval : aliased int;
      optlen : aliased size_t := optval'Size / char'Size;
   begin
      optval := int (To);
      Check (c_setsockopt (int (Socket), int (IPPROTO_TCP), int (TCP_MAXRXT),
             To_char_ptr (optval'Address), optlen));
   end Set_Retransmit_Time_Maximum;

   --  TCP Segment Size  --

   function Get_Segment_Size_Maximum
      (Socket : POSIX.IO.File_Descriptor)
      return Positive is
      optval : aliased int;
      optlen : aliased size_t := optval'Size / char'Size;
   begin
      Check (c_getsockopt (int (Socket), int (IPPROTO_TCP), int (TCP_MAXSEG),
             To_char_var_ptr (optval'Address), optlen'Unchecked_Access));
      return Positive (optval);
   end Get_Segment_Size_Maximum;

   --  TCP Standardized Handling of Urgent Data  --

   function Get_Standardized_Urgent_Data
      (Socket : POSIX.IO.File_Descriptor)
      return Socket_Option_Value is
      optval : aliased int;
      optlen : aliased size_t := optval'Size / char'Size;
   begin
      Check (c_getsockopt (int (Socket), int (IPPROTO_TCP), int (TCP_STDURG),
             To_char_var_ptr (optval'Address), optlen'Unchecked_Access));
      if optval = 0 then
         return Disabled;
      else
         return Enabled;
      end if;
   end Get_Standardized_Urgent_Data;

   procedure Set_Standardized_Urgent_Data
      (Socket : in POSIX.IO.File_Descriptor;
       To     : in Socket_Option_Value) is
      optval : aliased int := 0;
      optlen : size_t := optval'Size / char'Size;
   begin
      if To = Enabled then optval := 1; end if;
      Check (c_setsockopt (int (Socket), int (IPPROTO_TCP), int (TCP_STDURG),
             To_char_ptr (optval'Address), optlen));
   end Set_Standardized_Urgent_Data;

   --  IP Protocol Options in IP Header  --

   function IP_Header_Options_In_Use
      (Socket : POSIX.IO.File_Descriptor)
      return Boolean is
      optval : aliased struct_ip_opts;
      optlen : aliased size_t := optval'Size / char'Size;
   begin
      Check (c_getsockopt (int (Socket), int (IPPROTO_IP), int (IP_OPTIONS),
             To_char_var_ptr (optval'Address), optlen'Unchecked_Access));
      if optlen = 0 then
         return False;
      else
         return True;
      end if;
   end IP_Header_Options_In_Use;

   procedure Reset_IP_Header_Options              --  send null to reset
      (Socket : in POSIX.IO.File_Descriptor) is
   begin
      Check (c_setsockopt (int (Socket), int (IPPROTO_IP), int (IP_OPTIONS),
             To_char_ptr (System.Null_Address), 0));
   end Reset_IP_Header_Options;

   function Get_IP_Header_Options
      (Socket : POSIX.IO.File_Descriptor)
      return IP_Options_Buffer is
      optval : aliased struct_ip_opts;
      optlen : aliased size_t := optval'Size / char'Size;
   begin
      Check (c_getsockopt (int (Socket), int (IPPROTO_IP), int (IP_OPTIONS),
             To_char_var_ptr (optval'Address), optlen'Unchecked_Access));
      return IP_Options_Buffer'(C => optval);
   end Get_IP_Header_Options;

   procedure Set_IP_Header_Options
      (Socket  : in POSIX.IO.File_Descriptor;
       To      : in IP_Options_Buffer) is
      optlen : size_t := To'Size / char'Size;
   begin
      Check (c_setsockopt (int (Socket), int (IPPROTO_IP), int (IP_OPTIONS),
             To_char_ptr (To.C'Address), optlen));
   end Set_IP_Header_Options;

   function Get_First_Hop
      (Options : IP_Options_Buffer)
      return Internet_Address is
   begin
      return (C => Options.C.ip_dst);
   end Get_First_Hop;

   procedure Set_First_Hop
      (Options : in out IP_Options_Buffer;
       Address : in     Internet_Address) is
   begin
      Options.C.ip_dst := Address.C;
   end Set_First_Hop;

   function Get_IP_Options
      (Options : IP_Options_Buffer)
      return POSIX.Octet_Array is
   begin
      return Options.C.ip_opts;
   end Get_IP_Options;

   procedure Set_IP_Options
      (Options : in out IP_Options_Buffer;
       Buffer  : in     POSIX.Octet_Array) is
   begin
      Options.C.ip_opts := Buffer;
   end Set_IP_Options;

   --  IP Type of Service Value  --

   function Get_Type_Of_Service
      (Socket : POSIX.IO.File_Descriptor)
      return IP_Type_Of_Service is
      optval : aliased int;
      optlen : aliased size_t := optval'Size / char'Size;
   begin
      Check (c_getsockopt (int (Socket), int (IPPROTO_IP), int (IP_TOS),
        To_char_var_ptr (optval'Address), optlen'Unchecked_Access));
      case optval is
         when IPTOS_LOWDELAY =>    return Low_Delay;
         when IPTOS_THROUGHPUT =>  return High_Throughput;
         when IPTOS_RELIABILITY => return High_Reliability;
         when others =>            return Unspecified;
      end case;
   end Get_Type_Of_Service;

   procedure Set_Type_Of_Service
      (Socket : in POSIX.IO.File_Descriptor;
       To     : in IP_Type_Of_Service) is
      optval : aliased int := 0;
      optlen : size_t := optval'Size / char'Size;
   begin
      case To is
         when Low_Delay        => optval := IPTOS_LOWDELAY;
         when High_Throughput  => optval := IPTOS_THROUGHPUT;
         when High_Reliability => optval := IPTOS_RELIABILITY;
         when others           => optval := 0;
      end case;
      Check (c_setsockopt (int (Socket), int (IPPROTO_IP), int (IP_TOS),
             To_char_ptr (optval'Address), optlen));
   end Set_Type_Of_Service;

   --  IP Initial Time to Live Value  --

   function Get_Initial_Time_To_Live
      (Socket : POSIX.IO.File_Descriptor)
      return Time_To_Live is
      optval : aliased int;
      optlen : aliased size_t := optval'Size / char'Size;
   begin
      Check (c_getsockopt (int (Socket), int (IPPROTO_IP), int (IP_TTL),
        To_char_var_ptr (optval'Address), optlen'Unchecked_Access));
      return Time_To_Live (optval);
   end Get_Initial_Time_To_Live;

   procedure Set_Initial_Time_To_Live
      (Socket : in POSIX.IO.File_Descriptor;
       To     : in Time_To_Live) is
      optval : aliased int;
      optlen : aliased size_t := optval'Size / char'Size;
   begin
      optval := int (To);
      Check (c_setsockopt (int (Socket), int (IPPROTO_IP), int (IP_TTL),
             To_char_ptr (optval'Address), optlen));
   end Set_Initial_Time_To_Live;

   --  IP Request Destination Address of Incoming Packets  --

   function Get_Receive_Destination_Address
      (Socket : POSIX.IO.File_Descriptor)
      return Socket_Option_Value is
      optval : aliased int;
      optlen : aliased size_t := optval'Size / char'Size;
   begin
      Check (c_getsockopt (int (Socket), int (IPPROTO_UDP),
        int (IP_RECVDSTADDR), To_char_var_ptr (optval'Address),
        optlen'Unchecked_Access));
      if optval = 0 then
         return Disabled;
      else
         return Enabled;
      end if;
   end Get_Receive_Destination_Address;

   procedure Set_Receive_Destination_Address
      (Socket : in POSIX.IO.File_Descriptor;
       To     : in Socket_Option_Value) is
      optval : aliased int := 0;
      optlen : size_t := optval'Size / char'Size;
   begin
      if To = Enabled then optval := 1; end if;
      Check (c_setsockopt (int (Socket), int (IPPROTO_UDP),
        int (IP_RECVDSTADDR), To_char_ptr (optval'Address), optlen));
   end Set_Receive_Destination_Address;

   procedure Set_Ancillary_Data
      (Message : in out Socket_Message;
       Data    : in     IP_Ancillary_Data) is
   begin



         Message.C.msg_control := To_char_ptr (Data.C1'Address);
         Message.C.msg_controllen := size_t (Data'Size / char'Size);

   end Set_Ancillary_Data;

   function Get_Ancillary_Data
      (Message : Socket_Message)
      return Internet_Address is




      Data : IP_Ancillary_Data_Access := To_ADA (Message.C.msg_control);
   begin
      return (C => Data.all.C2);

   end Get_Ancillary_Data;

   --  IP Header Included with Outgoing Datagram  --

   function Get_Header_Included
      (Socket : POSIX.IO.File_Descriptor)
      return Socket_Option_Value is
      optval : aliased int;
      optlen : aliased size_t := optval'Size / char'Size;
   begin
      Check (c_getsockopt (int (Socket), int (IPPROTO_UDP), int (IP_HDRINCL),
        To_char_var_ptr (optval'Address), optlen'Unchecked_Access));
      if optval = 0 then
         return Disabled;
      else
         return Enabled;
      end if;
   end Get_Header_Included;

   procedure Set_Header_Included
      (Socket : in POSIX.IO.File_Descriptor;
       To     : in Socket_Option_Value) is
      optval : aliased int := 0;
      optlen : size_t := optval'Size / char'Size;
   begin
      if To = Enabled then optval := 1; end if;
      Check (c_setsockopt (int (Socket), int (IPPROTO_UDP), int (IP_HDRINCL),
             To_char_ptr (optval'Address), optlen));
   end Set_Header_Included;

   ---------------------
   --  Get_Peer_Name  --
   ---------------------

   function c_getpeername
      (s : int;
       socketaddress : sockaddr_var_ptr;
       addresslen : access size_t) return int;
   pragma Import (C, c_getpeername, getpeername_LINKNAME);

   function Get_Peer_Name (Socket : POSIX.IO.File_Descriptor)
     return Internet_Socket_Address is
      c_address : aliased struct_sockaddr_in;
      c_address_len : aliased size_t := c_address'Size / char'Size;
   begin
      Check (c_getpeername (int (Socket),
        To_sockaddr_var_ptr (c_address'Address),
        c_address_len'Access));
      if c_address_len /= struct_sockaddr_in'Size / char'Size then
         raise Constraint_Error;
      end if;
      return (C => c_address);
   end Get_Peer_Name;

   -----------------------
   --  Get_Socket_Name  --
   -----------------------

   function c_getsockname
      (s : int;
       socketaddress : sockaddr_in_var_ptr;
       addresslen : size_t_var_ptr) return int;
   pragma Import (C, c_getsockname, getsockname_LINKNAME);

   function Get_Socket_Name (Socket : POSIX.IO.File_Descriptor)
     return Internet_Socket_Address is
      c_address : aliased struct_sockaddr_in;
      c_address_len : aliased size_t := c_address'Size / char'Size;
   begin
      Check (c_getsockname (int (Socket),
        To_sockaddr_in_var_ptr (c_address'Address),
        c_address_len'Unchecked_Access));
      if c_address_len /= struct_sockaddr_in'Size / char'Size then
         raise Constraint_Error;
      end if;
      return (C => c_address);
   end Get_Socket_Name;

   -----------------------
   --  Get_Socket_Name  --
   -----------------------

   function Get_Socket_Name (Handle : Socket_Message)
     return Internet_Socket_Address is
   begin
      --  cast the generic address pointer to an internet socket
      --  address pointer and dereference it. Note that dot1g uses
      --  void* for these. Solaris uses typedef caddr_t which is char*.
      return (C => To_sockaddr_in_ptr (Handle.C.msg_name).all);
   end Get_Socket_Name;

   -------------------
   --  Get_Address  --
   -------------------

   function Get_Address (Info_Item : Socket_Address_Info)
     return Internet_Socket_Address is
   begin
      --  cast the generic socket address pointer to an internet socket
      --  address pointer and dereference it
      return (C => To_sockaddr_in_ptr (Info_Item.C.ai_addr).all);
   end Get_Address;

   function To_Socket_Address is new Unchecked_Conversion
      (Internet_Socket_Address_Pointer, Socket_Address_Pointer);
   function "+" (Ptr : Internet_Socket_Address_Pointer)
     return Socket_Address_Pointer is
   begin
      return To_Socket_Address (Ptr);
   end "+";

   function To_Internet_Socket_Address is new Unchecked_Conversion
      (Socket_Address_Pointer, Internet_Socket_Address_Pointer);
   function "+" (Ptr : Socket_Address_Pointer)
     return Internet_Socket_Address_Pointer is
   begin
      if (Ptr.C.sa_family = POSIX.C.Sockets.AF_INET) then
         return To_Internet_Socket_Address (Ptr);
      else
         --  Need to find out exact error ??
         return null;
         --  raise POSIX.Operation_Not_Implemented;
      end if;
   end "+";

   function Is_Internet_Socket_Address (Ptr : Socket_Address_Pointer)
     return Boolean is
   begin
      if (Ptr.C.sa_family = POSIX.C.Sockets.AF_INET) then
         return true;
      else
         return false;
      end if;
   end Is_Internet_Socket_Address;

end POSIX.Sockets.Internet;