File : posix-xti-internet.adb
------------------------------------------------------------------------------
-- --
-- POSIX Ada95 Bindings for Protocol Independent Interfaces (P1003.5c) --
-- --
-- P O S I X . X T I . Internet --
-- --
-- S p e c --
-- --
-- --
------------------------------------------------------------------------------
with Ada.Streams,
POSIX.C,
POSIX.Implementation,
System,
Text_IO,
Unchecked_Conversion,
System.Address_Image;
package body POSIX.XTI.Internet is
use Ada.Streams,
POSIX.C,
POSIX.Implementation,
POSIX.C.Sockets,
POSIX.C.NetDB;
type char_array is array (size_t range <>) of aliased char;
function c_inet_addr (str : char_ptr) return POSIX.C.Sockets.in_addr_t;
pragma Import (C, c_inet_addr, POSIX.C.Netinet.inet_addr_LINKNAME);
function c_inet_ntoa (addr : System.Address)
return char_ptr;
pragma Import (C, c_inet_ntoa, "c_inet_ntoa");
-- pragma Import (C, c_inet_ntoa, POSIX.C.Netinet.inet_ntoa_LINKNAME);
function To_char_ptr is new Unchecked_Conversion (System.Address, char_ptr);
function To_Address is new Unchecked_Conversion (char_ptr, System.Address);
function To_sockaddr_in is new Unchecked_Conversion
(char_ptr, POSIX.C.Sockets.sockaddr_in_ptr);
function To_ptr is new Unchecked_Conversion
(System.Address, POSIX.C.XTI.t_bind_ptr);
function To_in_addr_ptr is new Unchecked_Conversion
(System.Address, POSIX.C.Sockets.in_addr_ptr);
function c_t_getprotaddr (fd : int;
boundaddr : POSIX.C.XTI.t_bind_ptr;
peeraddr : POSIX.C.XTI.t_bind_ptr) return int;
pragma Import (C, c_t_getprotaddr, POSIX.C.XTI.t_getprotaddr_LINKNAME);
-- Internet support from <netdb.h>
-- Note : using the thread safe versions of the following rather
-- than the MT unsafe versions spec'd in dot1g
function c_getnetbyname_r
(name : char_ptr; result : netent_ptr; buffer : char_ptr;
buflen : int)
return netent_ptr;
pragma Import (C, c_getnetbyname_r, POSIX.C.NetDB.getnetbyname_r_LINKNAME);
function c_getnetbyaddr_r
(net : unsigned; typ : int; result : netent_ptr;
buffer : char_ptr; buflen : int)
return netent_ptr;
pragma Import (C, c_getnetbyaddr_r, POSIX.C.NetDB.getnetbyaddr_r_LINKNAME);
function c_setnetent (stayopen : int) return int;
pragma Import (C, c_setnetent, POSIX.C.NetDB.setnetent_LINKNAME);
function c_endnetent return int;
pragma Import (C, c_endnetent, POSIX.C.NetDB.endnetent_LINKNAME);
function c_getprotobyname_r
(name : char_ptr; result : protoent_ptr; buffer : char_ptr;
buflen : int)
return protoent_ptr;
pragma Import (C, c_getprotobyname_r,
POSIX.C.NetDB.getprotobyname_r_LINKNAME);
function c_getprotobynumber_r
(proto : int; result : protoent_ptr; buffer : char_ptr; buflen : int)
return protoent_ptr;
pragma Import (C, c_getprotobynumber_r,
POSIX.C.NetDB.getprotobynumber_r_LINKNAME);
function c_setprotoent (stayopen : int) return int;
pragma Import (C, c_setprotoent, POSIX.C.NetDB.setprotoent_LINKNAME);
function c_endprotoent return int;
pragma Import (C, c_endprotoent, POSIX.C.NetDB.endprotoent_LINKNAME);
package Integer_IO is new Text_IO.Integer_IO (integer);
use Integer_IO;
function Get_Value (Option_Item : Protocol_Option)
return XTI_Option is
type opthdr_and_data is record
header : POSIX.C.XTI.struct_t_opthdr;
data : integer;
end record;
pragma Pack (opthdr_and_data);
type opthdr_and_data_ptr is access opthdr_and_data;
function To_opthdr_and_data_ptr is new Unchecked_Conversion
(System.Address, opthdr_and_data_ptr);
begin
if (To_opthdr_and_data_ptr (Option_Item.C'Address).data
= integer (POSIX.C.XTI.T_YES)) then
return Enabled;
elsif (To_opthdr_and_data_ptr (Option_Item.C'Address).data
= integer (POSIX.C.XTI.T_NO)) then
return Disabled;
else
return Disabled;
end if;
end Get_Value;
procedure Set_Option
(Option_Item : in out Protocol_Option;
Level : in Option_Level;
Name : in Option_Name;
To : in XTI_Option) is
type opthdr_and_data is record
header : POSIX.C.XTI.struct_t_opthdr;
data : POSIX.XTI.Option_Value;
end record;
pragma Pack (opthdr_and_data);
type opthdr_and_data_ptr is access opthdr_and_data;
function To_opthdr_and_data_ptr is new Unchecked_Conversion
(System.Address, opthdr_and_data_ptr);
begin
if (To = Enabled) then
To_opthdr_and_data_ptr (Option_Item.C'Address).data
:= POSIX.XTI.Option_Value (POSIX.C.XTI.T_YES);
else
To_opthdr_and_data_ptr (Option_Item.C'Address).data
:= POSIX.XTI.Option_Value (POSIX.C.XTI.T_NO);
end if;
Option_Item.C.len := (POSIX.C.XTI.struct_t_opthdr'Size / char'Size) +
(POSIX.XTI.Option_Value'Size / char'Size);
Option_Item.C.level := unsigned_long (Level);
Option_Item.C.name := unsigned_long (Name);
end Set_Option;
function Get_Internet_Port (Name : Internet_XTI_Address)
return Internet_Port is
begin
return Internet_Port (Name.sockaddr_in.sin_port);
end Get_Internet_Port;
procedure Set_Internet_Port
(Name : in out Internet_XTI_Address;
Port_Value : in Internet_Port) is
begin
Name.sockaddr_in.sin_port := POSIX.C.Sockets.in_port_t (Port_Value);
Name.netbuf.maxlen := Name.sockaddr_in'Size / char'Size;
Name.netbuf.len := Name.sockaddr_in'Size / char'Size;
Name.netbuf.buf := To_char_ptr (Name.sockaddr_in'Address);
end Set_Internet_Port;
function Get_Internet_Address (Name : Internet_XTI_Address)
return Internet_Address is
begin
return (C => (s_addr => Name.sockaddr_in.sin_addr.s_addr));
end Get_Internet_Address;
procedure Set_Internet_Address
(Name : in out Internet_XTI_Address;
Address_Value : in Internet_Address) is
begin
Name.sockaddr_in.sin_addr.s_addr := Address_Value.C.s_addr;
Name.netbuf.maxlen := Name.sockaddr_in'Size / char'Size;
Name.netbuf.len := Name.sockaddr_in'Size / char'Size;
Name.netbuf.buf := To_char_ptr (Name.sockaddr_in'Address);
end Set_Internet_Address;
--------------------------------------
-- Internetwork Support Functions --
--------------------------------------
-- Internet Address Manipulation
function c_htons (x : Internet_Port) return Internet_Port;
pragma Import (C, c_htons, "c_htons");
-- function Host_To_Network_Byte_Order (Port : Internet_Port)
-- return Internet_Port is
-- begin
-- return c_htons (Port);
-- end Host_To_Network_Byte_Order;
function c_ntohs (x : Internet_Port) return Internet_Port;
pragma Import (C, c_ntohs, "c_ntohs");
-- function Network_To_Host_Byte_Order (Port : Internet_Port)
-- return Internet_Port is
-- begin
-- return c_ntohs (Port);
-- end Network_To_Host_Byte_Order;
function c_htonl (x : POSIX.C.Sockets.in_addr_t)
return POSIX.C.Sockets.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 (x : POSIX.C.Sockets.in_addr_t)
return POSIX.C.Sockets.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 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) =
POSIX.C.Netinet.INADDR_NONE then
return False;
else
return True;
end if;
end Is_Internet_Address;
function Internet_Address_To_String (Address : Internet_Address)
return POSIX.POSIX_String is
temp_var : POSIX.C.Sockets.struct_in_addr;
begin
temp_var.s_addr := Address.C.s_addr;
return POSIX.C.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_Address_Family (Info_Item : Network_Info)
-- return Address_Family is
-- begin
-- return Address_Family (Info_Item.C.n_addrtype);
-- end Get_Address_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 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 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;
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;
procedure Close_Network_Database_Connection is
begin
Check (c_endnetent);
end Close_Network_Database_Connection;
-- Network 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_Family (Info_Item : Network_Info)
return Protocol_Family is
begin
return Protocol_Family (Info_Item.C.n_addrtype);
end Get_Family;
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 Get_Protocol_Info_By_Number (Number : Protocol_Number)
return Protocol_Info is
protoent : aliased POSIX.C.NetDB.struct_protoent;
buffer : char_array (0 .. 1023);
Result : POSIX.C.NetDB.protoent_ptr;
begin
Result := c_getprotobynumber_r
(int (Number), protoent'Unchecked_Access,
buffer (buffer'First)'Unchecked_Access, buffer'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 Get_Protocol_Info_By_Name (Name : POSIX.POSIX_String)
return Protocol_Info is
protoent : aliased POSIX.C.NetDB.struct_protoent;
buffer : char_array (0 .. 1023);
Result : POSIX.C.NetDB.protoent_ptr;
begin
Result := c_getprotobyname_r
(Name (Name'First)'Unchecked_Access, protoent'Unchecked_Access,
buffer (buffer'First)'Unchecked_Access, buffer'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;
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;
procedure Close_Protocol_Database_Connection is
begin
Check (c_endprotoent);
end Close_Protocol_Database_Connection;
function Get_Status (Info_Item : Keep_Alive_Info)
return Keep_Alive_Status is
begin
if Info_Item.C.kp_onoff = POSIX.C.XTI.T_YES then
return Keep_Alive_On;
elsif Info_Item.C.kp_onoff = POSIX.C.XTI.T_NO then
return Keep_Alive_Off;
elsif Info_Item.C.kp_onoff = POSIX.C.XTI.T_GARBAGE then
return Send_Garbage;
else
raise Constraint_Error;
end if;
end Get_Status;
procedure Set_Status
(Info_Item : in out Keep_Alive_Info;
To : in Keep_Alive_Status) is
begin
if To = Keep_Alive_On then
Info_Item.C.kp_onoff := POSIX.C.XTI.T_YES;
elsif To = Keep_Alive_Off then
Info_Item.C.kp_onoff := POSIX.C.XTI.T_NO;
else
Info_Item.C.kp_onoff := POSIX.C.XTI.T_GARBAGE;
end if;
end Set_Status;
procedure Set_Keep_Alive_Interval_Default
(Info_Item : in out Keep_Alive_Info) is
begin
Info_Item.C.kp_timeout := long (POSIX.C.XTI.T_UNSPEC);
end Set_Keep_Alive_Interval_Default;
procedure Set_Keep_Alive_Timeout
(Info_Item : in out Keep_Alive_Info;
Minutes : in Positive) is
begin
Info_Item.C.kp_timeout := long (Minutes);
end Set_Keep_Alive_Timeout;
function Get_Keep_Alive_Timeout
(Info_Item : Keep_Alive_Info)
return Positive is
begin
return Positive (Info_Item.C.kp_timeout);
end Get_Keep_Alive_Timeout;
function Get_Value (Option_Item : Protocol_Option)
return Keep_Alive_Info is
type opthdr_and_kpalive is record
header : POSIX.C.XTI.struct_t_opthdr;
data : POSIX.C.XTI.struct_t_kpalive;
end record;
pragma Pack (opthdr_and_kpalive);
type opthdr_and_kpalive_ptr is access opthdr_and_kpalive;
function To_opthdr_and_kpalive_ptr is new Unchecked_Conversion
(System.Address, opthdr_and_kpalive_ptr);
function To_Option_Name is new Unchecked_Conversion
(unsigned_long, Option_Name);
begin
if (To_Option_Name (Option_Item.C.name) =
POSIX.XTI.Internet.TCP_Keep_Alive_Interval) then
return (C => (To_opthdr_and_kpalive_ptr
(Option_Item.C'Address).data));
else
-- Not a linger Option, raise Operation_Not_Permitted
Raise_POSIX_Error (Operation_Not_Permitted);
-- Fake return so we don't get compiler warning
return (C => (To_opthdr_and_kpalive_ptr
(Option_Item.C'Address).data));
end if;
end Get_Value;
procedure Set_Option
(Option_Item : in out Protocol_Option;
Level : in Option_Level;
Name : in Option_Name;
Value : in Keep_Alive_Info) is
type opthdr_and_kpalive is record
header : POSIX.C.XTI.struct_t_opthdr;
data : POSIX.C.XTI.struct_t_kpalive;
end record;
pragma Pack (opthdr_and_kpalive);
type opthdr_and_kpalive_ptr is access opthdr_and_kpalive;
function To_opthdr_and_kpalive_ptr is new Unchecked_Conversion
(System.Address, opthdr_and_kpalive_ptr);
begin
To_opthdr_and_kpalive_ptr (Option_Item.C'Address).data
:= Value.C;
Option_Item.C.len := (POSIX.C.XTI.struct_t_opthdr'Size / char'Size) +
(POSIX.C.XTI.struct_t_kpalive'Size / char'Size);
Option_Item.C.level := unsigned_long (Level);
Option_Item.C.name := unsigned_long (Name);
end Set_Option;
procedure Get_Value (Option_Item : in Protocol_Option;
IP_Option : out IP_Option_List;
Count : out Natural) is
list_size : Natural :=
Natural (Option_Item.C.len -
(POSIX.C.XTI.struct_t_opthdr'Size / char'Size));
type opthdr_and_data is record
header : POSIX.C.XTI.struct_t_opthdr;
data : IP_Option_List (0 .. list_size);
end record;
pragma Pack (opthdr_and_data);
type opthdr_and_data_ptr is access opthdr_and_data;
function To_opthdr_and_data_ptr is new Unchecked_Conversion
(System.Address, opthdr_and_data_ptr);
begin
list_size :=
Natural (Option_Item.C.len -
(POSIX.C.XTI.struct_t_opthdr'Size / char'Size));
if list_size > 0 then
IP_Option (IP_Option'First .. (IP_Option'First + (list_size - 1)))
:= To_opthdr_and_data_ptr (Option_Item.C'Address).data;
end if;
Count := list_size;
end Get_Value;
procedure Set_Option
(Option_Item : in out Protocol_Option;
Level : in Option_Level;
Name : in Option_Name;
To : in IP_Option_List) is
type opthdr_and_data is record
header : POSIX.C.XTI.struct_t_opthdr;
data : IP_Option_List (To'First .. To'Last);
end record;
pragma Pack (opthdr_and_data);
type opthdr_and_data_ptr is access opthdr_and_data;
function To_opthdr_and_data_ptr is new Unchecked_Conversion
(System.Address, opthdr_and_data_ptr);
begin
To_opthdr_and_data_ptr (Option_Item.C'Address).data := To;
Option_Item.C.len := (POSIX.C.XTI.struct_t_opthdr'Size / char'Size) +
(To'Size / char'Size);
Option_Item.C.level := unsigned_long (Level);
Option_Item.C.name := unsigned_long (Name);
end Set_Option;
function Get_Value (Option_Item : Protocol_Option)
return IP_Service_Type is
begin
Raise_POSIX_Error (Operation_Not_Implemented);
return Normal;
end Get_Value;
function Get_Value (Option_Item : Protocol_Option)
return IP_Precedence_Level is
begin
Raise_POSIX_Error (Operation_Not_Implemented);
return Routine;
end Get_Value;
procedure Set_Option
(Option_Item : in out Protocol_Option;
Level : in Option_Level;
Name : in Option_Name;
Service : in IP_Service_Type;
Precedence : in IP_Precedence_Level) is
type opthdr_and_data is record
header : POSIX.C.XTI.struct_t_opthdr;
data : integer;
end record;
pragma Pack (opthdr_and_data);
type opthdr_and_data_ptr is access opthdr_and_data;
function To_opthdr_and_data_ptr is new Unchecked_Conversion
(System.Address, opthdr_and_data_ptr);
begin
Raise_POSIX_Error (Operation_Not_Implemented);
Option_Item.C.level := unsigned_long (Level);
Option_Item.C.name := unsigned_long (Name);
end Set_Option;
--
-- POSIX.XTI protocol specific functions
--
-- This will not work because the dummy.netbuf.buf will overwrite
-- the application's ????.netbuf.buf which, when the next call to
-- the POSIX.XTI interface, will cause a Memory Error. This would
-- only work if the XTI_Address were an object of some sort with
-- a life and the Internet_XTI_Address was mearly a pointer to that
-- object. Suggested change or delete:
-- procedure Get_Address (Info_Item : Binding_Info;
-- Address : in out Internet_XTI_Address) is
-- function Get_Address (Info_Item : Binding_Info)
-- return Internet_XTI_Address is
-- dummy : Internet_XTI_Address;
-- addr_ptr : POSIX.C.Sockets.sockaddr_in_ptr;
-- begin
-- addr_ptr := To_sockaddr_in (Info_Item.C.addr.buf);
-- dummy.sockaddr_in.sin_port := addr_ptr.sin_port;
-- dummy.sockaddr_in.sin_addr := addr_ptr.sin_addr;
-- dummy.sockaddr_in.sin_family := addr_ptr.sin_family;
-- dummy.sockaddr_in.sin_zero := addr_ptr.sin_zero;
--
-- dummy.netbuf.len := Info_Item.C.addr.len;
-- dummy.netbuf.maxlen := Info_Item.C.addr.maxlen;
-- .buf is set in the routines that use the XTI_Address
-- return dummy;
-- end Get_Address;
-- Bussiere Suggested changes
-- procedure Get_Address (Info_Item : Unit_Data;
-- Address : in out Internet_XTI_Address) is
-- addr_ptr : POSIX.C.Sockets.sockaddr_in_ptr;
-- begin
-- addr_ptr := To_sockaddr_in (Info_Item.C.addr.buf);
-- Address.sockaddr_in.sin_port := addr_ptr.sin_port;
-- Address.sockaddr_in.sin_addr := addr_ptr.sin_addr;
-- Address.sockaddr_in.sin_family := addr_ptr.sin_family;
-- Address.sockaddr_in.sin_zero := addr_ptr.sin_zero;
-- Address.netbuf.len := Info_Item.C.addr.len;
-- Address.netbuf.maxlen := Info_Item.C.addr.maxlen;
-- .buf is set in the routines that use the XTI_Address
-- end Get_Address;
-- procedure Get_Address (Info_Item : Unit_Data_Error;
-- Address : in out Internet_XTI_Address) is
-- addr_ptr : POSIX.C.Sockets.sockaddr_in_ptr;
-- begin
-- addr_ptr := To_sockaddr_in (Info_Item.C.addr.buf);
-- Address.sockaddr_in.sin_port := addr_ptr.sin_port;
-- Address.sockaddr_in.sin_addr := addr_ptr.sin_addr;
-- Address.sockaddr_in.sin_family := addr_ptr.sin_family;
-- Address.sockaddr_in.sin_zero := addr_ptr.sin_zero;
-- Address.netbuf.len := Info_Item.C.addr.len;
-- Address.netbuf.maxlen := Info_Item.C.addr.maxlen;
-- .buf is set in the routines that use the XTI_Address
-- end Get_Address;
procedure Get_Address (Info_Item : Connection_Info;
Address : in out Internet_XTI_Address) is
addr_ptr : POSIX.C.Sockets.sockaddr_in_ptr;
begin
addr_ptr := To_sockaddr_in (Info_Item.C.addr.buf);
Address.sockaddr_in.sin_port := addr_ptr.sin_port;
Address.sockaddr_in.sin_addr := addr_ptr.sin_addr;
Address.sockaddr_in.sin_family := addr_ptr.sin_family;
Address.sockaddr_in.sin_zero := addr_ptr.sin_zero;
Address.netbuf.len := Info_Item.C.addr.len;
Address.netbuf.maxlen := Info_Item.C.addr.maxlen;
-- .buf is set in the routines that use the XTI_Address
end Get_Address;
function To_XTI_Address is new Unchecked_Conversion
(Internet_XTI_Address_Pointer, XTI_Address_Pointer);
function "+" (Ptr : Internet_XTI_Address_Pointer)
return XTI_Address_Pointer is
begin
Ptr.netbuf.maxlen := Ptr.sockaddr_in'Size / char'Size;
Ptr.netbuf.len := Ptr.sockaddr_in'Size / char'Size;
Ptr.netbuf.buf := To_char_ptr (Ptr.sockaddr_in'Address);
return To_XTI_Address (Ptr);
end "+";
function To_Internet_XTI_Address is new Unchecked_Conversion
(XTI_Address_Pointer, Internet_XTI_Address_Pointer);
function "+" (Ptr : XTI_Address_Pointer)
return Internet_XTI_Address_Pointer is
in_XTI_Addr_ptr : Internet_XTI_Address_Pointer;
begin
in_XTI_Addr_ptr := To_Internet_XTI_Address (Ptr);
if in_XTI_Addr_ptr.sockaddr_in.sin_family = POSIX.C.Sockets.AF_INET then
return in_XTI_Addr_ptr;
else
-- Need to find out exact error ??
return null;
-- raise POSIX.Operation_Not_Implemented;
end if;
end "+";
function Is_Internet_XTI_Address (Ptr : XTI_Address_Pointer)
return Boolean is
in_XTI_Addr_ptr : Internet_XTI_Address_Pointer;
begin
if in_XTI_Addr_ptr.sockaddr_in.sin_family = POSIX.C.Sockets.AF_INET then
return true;
else
return false;
end if;
end Is_Internet_XTI_Address;
end POSIX.XTI.Internet;