------------------------------------------------------------------------------ -- -- -- POSIX Ada95 Bindings for Protocol Independent Interfaces (P1003.5c) -- -- -- -- P O S I X . X T I -- -- -- -- B o d y -- -- -- -- -- -- 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). -- -- -- -- This package specification contains some text extracted from IEEE STD -- -- 1003.5: 1990, Information Technology -- POSIX Ada Language Interfaces -- -- Part 1: Binding for System Application Program Interface, as amended -- -- by IEEE STD 1003.5b: 1996, Amendment 1: Realtime Extensions, and as -- -- further amended by IEEE Draft STD 1003.5c: 1997, Amendment 2: Protocol -- -- Independent Interfaces, copyright 1997 by the Institute of Electrical -- -- and Electronics Engineers, Inc. -- -- -- -- The package specifications in the IEEE standards cited above represent -- -- only a portion of the documents and are not to be interpreted -- -- outside the context of the documents. The standards must be used in -- -- conjunction with the package specifications in order to claim -- -- conformance. The IEEE takes no responsibility for and will assume no -- -- liability for damages resulting from the reader's misinterpretation of -- -- said information resulting from its out-of-context nature. To order -- -- copies of the IEEE standards, please contact the IEEE Service Center -- -- at 445 Hoes Lane, PO Box 1331, Piscataway, NJ 08855-1331; via phone at -- -- 1-800-678-IEEE, 908-981-1393; or via fax at 908-981-9667. -- -- -- -- These package specifications are distributed in the hope that they -- -- will be useful, but WITHOUT ANY WARRANTY; without even the implied -- -- warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- -- -- ------------------------------------------------------------------------------ with Ada.Streams, Ada.IO_Exceptions, POSIX, POSIX.C, POSIX.Implementation, POSIX.IO, Text_IO, System, System.Address_Image, System.Storage_Elements, Unchecked_Conversion; package body POSIX.XTI is use Ada.Streams; use POSIX.C; use POSIX.C.XTI; use POSIX.Implementation; use System.Storage_Elements; package Integer_IO is new Text_IO.Integer_IO (integer); use Integer_IO; -- unchecked conversions function To_ptr is new Unchecked_Conversion (System.Address, POSIX.C.XTI.t_call_ptr); function To_ptr is new Unchecked_Conversion (System.Address, POSIX.C.XTI.t_discon_ptr); function To_ptr is new Unchecked_Conversion (System.Address, POSIX.C.XTI.t_bind_ptr); function To_ptr is new Unchecked_Conversion (System.Address, POSIX.C.XTI.t_unitdata_ptr); function To_iovec_ptr is new Unchecked_Conversion (System.Address, POSIX.C.XTI.t_iovec_ptr); function To_ptr is new Unchecked_Conversion (System.Address, POSIX.C.XTI.t_info_ptr); function To_ptr is new Unchecked_Conversion (System.Address, POSIX.C.XTI.t_optmgmt_ptr); function To_ptr is new Unchecked_Conversion (System.Address, POSIX.C.XTI.t_uderr_ptr); function To_int_ptr is new Unchecked_Conversion (System.Address, int_ptr); function To_int is new Unchecked_Conversion (XTI_Flags, int); function To_int is new Unchecked_Conversion (POSIX.IO.Open_Option_Set, int); function To_long is new Unchecked_Conversion (XTI_Flags, long); function To_XTI_Flags is new Unchecked_Conversion (long, XTI_Flags); function To_XTI_Events is new Unchecked_Conversion (int, XTI_Events); function To_CP_Flags is new Unchecked_Conversion (long, CP_Flags); function To_Option_Name is new Unchecked_Conversion (unsigned_long, Option_Name); function To_Address is new Unchecked_Conversion (char_ptr, System.Address); function To_Address is new Unchecked_Conversion (POSIX.C.XTI.t_opthdr_ptr, System.Address); function To_char_ptr is new Unchecked_Conversion (System.Address, char_ptr); function To_opthdr_ptr is new Unchecked_Conversion (char_ptr, POSIX.C.XTI.t_opthdr_ptr); -------------------------------- -- The C Interface routines -- -------------------------------- function Fetch_T_Errno return Error_Code; pragma Import (C, Fetch_T_Errno, "fetch_t_errno"); function c_t_accept (fd : int; resfd : int; t_call : POSIX.C.XTI.t_call_ptr) return int; pragma Import (C, c_t_accept, POSIX.C.XTI.t_accept_LINKNAME); function c_t_alloc (fd : int; struct_type : int; fields : int) return int; pragma Import (C, c_t_alloc, POSIX.C.XTI.t_alloc_LINKNAME); function c_t_bind (fd : int; req : POSIX.C.XTI.t_bind_ptr; ret : POSIX.C.XTI.t_bind_ptr) return int; pragma Import (C, c_t_bind, POSIX.C.XTI.t_bind_LINKNAME); function c_t_close (fd : int) return int; pragma Import (C, c_t_close, POSIX.C.XTI.t_close_LINKNAME); function c_t_connect (fd : int; sndcall : POSIX.C.XTI.t_call_ptr; rcvcall : POSIX.C.XTI.t_call_ptr) return int; pragma Import (C, c_t_connect, POSIX.C.XTI.t_connect_LINKNAME); function c_t_error (errmsg : char_ptr) return int; pragma Import (C, c_t_error, POSIX.C.XTI.t_error_LINKNAME); function c_t_free (ptr : char_ptr; struct_type : int) return int; pragma Import (C, c_t_free, POSIX.C.XTI.t_free_LINKNAME); function c_t_getinfo (fd : int; info : POSIX.C.XTI.t_info_ptr) return int; pragma Import (C, c_t_getinfo, POSIX.C.XTI.t_getinfo_LINKNAME); 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); function c_t_getstate (fd : int) return int; pragma Import (C, c_t_getstate, POSIX.C.XTI.t_getstate_LINKNAME); function c_t_listen (fd : int; call : POSIX.C.XTI.t_call_ptr) return int; pragma Import (C, c_t_listen, POSIX.C.XTI.t_listen_LINKNAME); function c_t_look (fd : int) return int; pragma Import (C, c_t_look, POSIX.C.XTI.t_look_LINKNAME); function c_t_open (name : char_ptr; oflag : int; info : POSIX.C.XTI.t_info_ptr) return int; pragma Import (C, c_t_open, POSIX.C.XTI.t_open_LINKNAME); function c_t_optmgmt (fd : int; req : POSIX.C.XTI.t_optmgmt_ptr; ret : POSIX.C.XTI.t_optmgmt_ptr) return int; pragma Import (C, c_t_optmgmt, POSIX.C.XTI.t_optmgmt_LINKNAME); function c_t_rcv (fd : int; buf : char_ptr; nbytes : unsigned; flags : int_ptr) return int; pragma Import (C, c_t_rcv, POSIX.C.XTI.t_rcv_LINKNAME); function c_t_rcvconnect (fd : int; call : POSIX.C.XTI.t_call_ptr) return int; pragma Import (C, c_t_rcvconnect, POSIX.C.XTI.t_rcvconnect_LINKNAME); function c_t_rcvdis (fd : int; discon : POSIX.C.XTI.t_discon_ptr) return int; pragma Import (C, c_t_rcvdis, POSIX.C.XTI.t_rcvdis_LINKNAME); function c_t_rcvrel (fd : int) return int; pragma Import (C, c_t_rcvrel, POSIX.C.XTI.t_rcvrel_LINKNAME); function c_t_rcvreldata (fd : int; discon : POSIX.C.XTI.t_discon_ptr) return int; pragma Import (C, c_t_rcvreldata, POSIX.C.XTI.t_rcvreldata_LINKNAME); function c_t_rcvudata (fd : int; unitdata : POSIX.C.XTI.t_unitdata_ptr; flags : int_ptr) return int; pragma Import (C, c_t_rcvudata, POSIX.C.XTI.t_rcvudata_LINKNAME); function c_t_rcvuderr (fd : int; uderr : POSIX.C.XTI.t_uderr_ptr) return int; pragma Import (C, c_t_rcvuderr, POSIX.C.XTI.t_rcvuderr_LINKNAME); function c_t_rcvv (fd : int; iov : POSIX.C.XTI.t_iovec_ptr; iovcount : unsigned; flags : int_ptr) return int; pragma Import (C, c_t_rcvv, POSIX.C.XTI.t_rcvv_LINKNAME); function c_t_rcvvudata (fd : int; unitdata : POSIX.C.XTI.t_unitdata_ptr; iov : POSIX.C.XTI.t_iovec_ptr; iovcount : unsigned; flags : int_ptr) return int; pragma Import (C, c_t_rcvvudata, POSIX.C.XTI.t_rcvvudata_LINKNAME); function c_t_snd (fd : int; buf : char_ptr; nbytes : unsigned; flags : int) return int; pragma Import (C, c_t_snd, POSIX.C.XTI.t_snd_LINKNAME); function c_t_snddis (fd : int; call : POSIX.C.XTI.t_call_ptr) return int; pragma Import (C, c_t_snddis, POSIX.C.XTI.t_snddis_LINKNAME); function c_t_sndrel (fd : int) return int; pragma Import (C, c_t_sndrel, POSIX.C.XTI.t_sndrel_LINKNAME); function c_t_sndreldata (fd : int; discon : POSIX.C.XTI.t_discon_ptr) return int; pragma Import (C, c_t_sndreldata, POSIX.C.XTI.t_sndreldata_LINKNAME); function c_t_sndudata (fd : int; unitdata : POSIX.C.XTI.t_unitdata_ptr) return int; pragma Import (C, c_t_sndudata, POSIX.C.XTI.t_sndudata_LINKNAME); function c_t_sndv (fd : int; iov : POSIX.C.XTI.t_iovec_ptr; iovcount : unsigned; flags : int) return int; pragma Import (C, c_t_sndv, POSIX.C.XTI.t_sndv_LINKNAME); function c_t_sndvudata (fd : int; unitdata : POSIX.C.XTI.t_unitdata_ptr; iov : POSIX.C.XTI.t_iovec_ptr; iovcount : int) return int; pragma Import (C, c_t_sndvudata, POSIX.C.XTI.t_sndvudata_LINKNAME); function c_t_strerror (errnum : int) return char_ptr; pragma Import (C, c_t_strerror, POSIX.C.XTI.t_strerror_LINKNAME); function c_t_sync (fd : int) return int; pragma Import (C, c_t_sync, POSIX.C.XTI.t_sync_LINKNAME); function c_t_unbind (fd : int) return int; pragma Import (C, c_t_unbind, POSIX.C.XTI.t_unbind_LINKNAME); function c_OPT_NEXTHDR (pbuf : char_ptr; buflen : unsigned_int; poption : POSIX.C.XTI.t_opthdr_ptr) return POSIX.C.XTI.t_opthdr_ptr; pragma Import (C, c_OPT_NEXTHDR, "c_OPT_NEXTHDR"); ------------------------ -- XTI Ada routines -- ------------------------ function Protocol_Addresses_Are_Valid (Info_Item : Communications_Provider_Info) return Boolean is begin if (Info_Item.C.addr > 0) then return True; else return False; end if; end Protocol_Addresses_Are_Valid; function Get_Max_Size_Protocol_Address (Info_Item : Communications_Provider_Info) return Positive is begin return Positive (Info_Item.C.addr); end Get_Max_Size_Protocol_Address; function Protocol_Options_Are_Valid (Info_Item : Communications_Provider_Info) return Boolean is begin if (Info_Item.C.options > 0) then return True; else return False; end if; end Protocol_Options_Are_Valid; function Get_Max_Size_Protocol_Options (Info_Item : Communications_Provider_Info) return Positive is begin return Positive (Info_Item.C.options); end Get_Max_Size_Protocol_Options; function SDU_Is_Supported (Info_Item : Communications_Provider_Info) return Boolean is begin if (Info_Item.C.tsdu = POSIX.C.XTI.T_INVALID) then return False; elsif (Info_Item.C.tsdu = POSIX.C.XTI.T_NULL) then return False; elsif (Info_Item.C.tsdu > 0) then return True; else return False; end if; end SDU_Is_Supported; function SDU_Is_Infinite (Info_Item : Communications_Provider_Info) return Boolean is begin if (Info_Item.C.tsdu = POSIX.C.XTI.T_INFINITE) then return True; else return False; end if; end SDU_Is_Infinite; function SDU_Is_Valid (Info_Item : Communications_Provider_Info) return Boolean is begin if (Info_Item.C.tsdu = POSIX.C.XTI.T_INVALID) then return False; else return True; end if; end SDU_Is_Valid; function Get_Max_Size_SDU (Info_Item : Communications_Provider_Info) return Positive is begin return Positive (Info_Item.C.tsdu); end Get_Max_Size_SDU; function SEDU_Is_Supported (Info_Item : Communications_Provider_Info) return Boolean is begin if (Info_Item.C.etsdu = POSIX.C.XTI.T_INVALID) then return False; elsif (Info_Item.C.etsdu = POSIX.C.XTI.T_NULL) then return False; elsif (Info_Item.C.etsdu > 0) then return True; else return False; end if; end SEDU_Is_Supported; function SEDU_Is_Infinite (Info_Item : Communications_Provider_Info) return Boolean is begin if (Info_Item.C.etsdu = POSIX.C.XTI.T_INFINITE) then return True; else return False; end if; end SEDU_Is_Infinite; function SEDU_Is_Valid (Info_Item : Communications_Provider_Info) return Boolean is begin if (Info_Item.C.etsdu = POSIX.C.XTI.T_INVALID) then return False; else return True; end if; end SEDU_Is_Valid; function Get_Max_Size_SEDU (Info_Item : Communications_Provider_Info) return Positive is begin return Positive (Info_Item.C.etsdu); end Get_Max_Size_SEDU; function Connect_Data_Is_Valid (Info_Item : Communications_Provider_Info) return Boolean is begin if (Info_Item.C.connect < 0) then return False; else return True; end if; end Connect_Data_Is_Valid; function Get_Max_Size_Connect_Data (Info_Item : Communications_Provider_Info) return Positive is begin return Positive (Info_Item.C.connect); end Get_Max_Size_Connect_Data; function Disconnect_Data_Is_Valid (Info_Item : Communications_Provider_Info) return Boolean is begin if (Info_Item.C.discon < 0) then return False; else return True; end if; end Disconnect_Data_Is_Valid; function Get_Max_Size_Disconnect_Data (Info_Item : Communications_Provider_Info) return Positive is begin return Positive (Info_Item.C.discon); end Get_Max_Size_Disconnect_Data; function Get_CP_Flags (Info_Item : Communications_Provider_Info) return CP_Flags is begin -- ??? Used to be the other way around, but this didn't compile on Solaris -- (flags not defined). # if TLI then return To_CP_Flags (Info_Item.C.flags); # else return CP_Flags (POSIX.Empty_Set); # end if; end Get_CP_Flags; function Get_Service_Type (Info_Item : Communications_Provider_Info) return Service_Type is begin return Service_Type (Info_Item.C.servtype); end Get_Service_Type; function Get_Status (Item : Linger_Info) return Linger_Option is begin if (Item.C.l_onoff = POSIX.C.XTI.T_NO) then return Linger_Off; else return Linger_On; end if; end Get_Status; procedure Set_Status (Item : in out Linger_Info; Linger : in Linger_Option) is begin if (Linger = Linger_Off) then Item.C.l_onoff := POSIX.C.XTI.T_NO; else Item.C.l_onoff := POSIX.C.XTI.T_YES; end if; end Set_Status; function Period_Is_Infinite (Item : Linger_Info) return Boolean is begin if (Item.C.l_linger = POSIX.C.XTI.T_INFINITE) then return True; else return False; end if; end Period_Is_Infinite; function Period_Is_Unspecified (Item : Linger_Info) return Boolean is begin if (Item.C.l_linger = POSIX.C.XTI.T_UNSPEC) then return True; else return False; end if; end Period_Is_Unspecified; function Get_Period (Item : Linger_Info) return Linger_Time is begin return Linger_Time (Item.C.l_linger); end Get_Period; procedure Set_Period_Infinite (Item : in out Linger_Info) is begin Item.C.l_linger := POSIX.C.XTI.T_INFINITE; end Set_Period_Infinite; procedure Set_Period_Unspecified (Item : in out Linger_Info) is begin Item.C.l_linger := POSIX.C.XTI.T_UNSPEC; end Set_Period_Unspecified; procedure Set_Period (Item : in out Linger_Info; Time : in Linger_Time) is begin Item.C.l_linger := long (Time); end Set_Period; function Get_Level (Option_Item : Protocol_Option) return Option_Level is begin return Option_Level (Option_Item.C.level); end Get_Level; -- procedure Set_Level -- (Option_Item : in out Protocol_Option; -- Level : in Option_Level) is -- begin -- Option_Item.C.level := unsigned_long (Level); -- end Set_Level; function Get_Name (Option_Item : Protocol_Option) return Option_Name is begin return Option_Name (Option_Item.C.name); end Get_Name; -- procedure Set_Name -- (Option_Item : in out Protocol_Option; -- Name : in Option_Name) is -- begin -- Option_Item.C.name := unsigned_long (Name); -- end Set_Name; procedure Set_Option (Option_Item : in out Protocol_Option; Level : in Option_Level; Name : in Option_Name) is begin Option_Item.C.level := unsigned_long (Level); Option_Item.C.name := unsigned_long (Name); end Set_Option; function Get_Status (Option_Item : Protocol_Option) return Option_Status is begin if ((Option_Item.C.status and unsigned_long (POSIX.C.XTI.T_SUCCESS)) = unsigned_long (POSIX.C.XTI.T_SUCCESS)) then return Success; elsif ((Option_Item.C.status and unsigned_long (POSIX.C.XTI.T_PARTSUCCESS)) = unsigned_long (POSIX.C.XTI.T_PARTSUCCESS)) then return Partial_Success; elsif ((Option_Item.C.status and unsigned_long (POSIX.C.XTI.T_FAILURE)) = unsigned_long (POSIX.C.XTI.T_FAILURE)) then return Failure; elsif ((Option_Item.C.status and unsigned_long (POSIX.C.XTI.T_READONLY)) = unsigned_long (POSIX.C.XTI.T_READONLY)) then return Read_Only; elsif ((Option_Item.C.status and unsigned_long (POSIX.C.XTI.T_NOTSUPPORT)) = unsigned_long (POSIX.C.XTI.T_NOTSUPPORT)) then return Not_Supported; else raise Program_Error; -- fake return to avoid compiler warning message return Failure; end if; end Get_Status; function Get_Value (Option_Item : Protocol_Option) return Option_Value 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 return To_opthdr_and_data_ptr (Option_Item.C'Address).data; end Get_Value; procedure Set_Option (Option_Item : in out Protocol_Option; Level : in Option_Level; Name : in Option_Name; Value : in Option_Value) 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 To_opthdr_and_data_ptr (Option_Item.C'Address).data := Value; Option_Item.C.len := (POSIX.C.XTI.struct_t_opthdr'Size / char'Size) + (Value'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 Option_Value_Array is type opthdr_and_data is record header : POSIX.C.XTI.struct_t_opthdr; data : POSIX.XTI.Option_Value_Array (1 .. ((positive (Option_Item.C.len) - positive ((POSIX.C.XTI.struct_t_opthdr'Size / char'Size))) / positive ((POSIX.XTI.Option_Value'Size / char'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 return To_opthdr_and_data_ptr (Option_Item.C'Address).data; end Get_Value; procedure Set_Option (Option_Item : in out Protocol_Option; Level : in Option_Level; Name : in Option_Name; Value : in Option_Value_Array) is type opthdr_and_data is record header : POSIX.C.XTI.struct_t_opthdr; data : POSIX.XTI.Option_Value_Array (Value'First .. Value'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 (Value'First .. Value'Last) := Value (Value'First .. Value'Last); Option_Item.C.len := (POSIX.C.XTI.struct_t_opthdr'Size / char'Size) + (Value'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 Linger_Info is type opthdr_and_data is record header : POSIX.C.XTI.struct_t_opthdr; data : POSIX.C.XTI.struct_t_linger; 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_Option_Name (Option_Item.C.name) = POSIX.XTI.Linger_On_Close_If_Data_Present) then return (C => (To_opthdr_and_data_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_data_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 Linger_Info) is type opthdr_and_data is record header : POSIX.C.XTI.struct_t_opthdr; data : POSIX.C.XTI.struct_t_linger; 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 := Value.C; Option_Item.C.len := (POSIX.C.XTI.struct_t_opthdr'Size / char'Size) + (POSIX.C.XTI.struct_t_linger'Size / char'Size); Option_Item.C.level := unsigned_long (Level); Option_Item.C.name := unsigned_long (Name); end Set_Option; -- function Get_Address (Info_Item : Binding_Info) -- return XTI_Address_Pointer is -- this functon is protocol specific. Look in the xti child packages. -- procedure Set_Address -- (Info_Item : in out Binding_Info; -- Address : in XTI_Address_Pointer) is -- begin -- Info_Item.C.addr.maxlen := Address.netbuf.maxlen; -- Info_Item.C.addr.len := Address.netbuf.len; -- Info_Item.C.addr.buf := Address.netbuf.buf; -- end Set_Address; -- function Get_Endpoint_Queue_Length (Info_Item : Binding_Info) -- return Integer is -- begin -- return Integer (Info_Item.C.qlen); -- end Get_Endpoint_Queue_Length; -- procedure Set_Endpoint_Queue_Length -- (Info_Item : in out Binding_Info; -- Max_Conn : in Integer) is -- begin -- Info_Item.C.qlen := unsigned (Max_Conn); -- end Set_Endpoint_Queue_Length; --------------------------- -- Option Buffer stuff -- --------------------------- procedure Set_Buffer (Info_Item : in out Protocol_Option_List; Options_Buffer : in Octet_Buffer_Pointer) is begin Info_Item.C.buf := To_char_ptr (Options_Buffer (Options_Buffer'First)'Address); Info_Item.C.maxlen := unsigned_int ((Options_Buffer'Last - Options_Buffer'First) + 1); Info_Item.buf_ptr := Options_Buffer; end Set_Buffer; procedure Make_Empty (Info_Item : in out Protocol_Option_List) is begin -- Set the length back to zero Info_Item.C.len := 0; -- Clear the Buffer if (Info_Item.C.maxlen > 0) then Info_Item.buf_ptr (1 .. integer (Info_Item.C.maxlen)) := (others => 0); end if; end Make_Empty; procedure Append (Info_Item : in out Protocol_Option_List; Option : in Protocol_Option) is type local_t_opthdr_ptr is access POSIX.C.XTI.struct_t_opthdr; function To_local_t_opthdr_ptr is new Unchecked_Conversion (POSIX.C.XTI.t_opthdr_ptr, local_t_opthdr_ptr); current_option_ptr : POSIX.C.XTI.t_opthdr_ptr := To_opthdr_ptr (Info_Item.C.buf); option_ptr : POSIX.C.XTI.t_opthdr_ptr := current_option_ptr; option_data_size : Integer; option_offset : Storage_Offset; begin while (current_option_ptr /= null) loop current_option_ptr := c_OPT_NEXTHDR (Info_Item.C.buf, Info_Item.C.maxlen, current_option_ptr); if (option_ptr = current_option_ptr) then -- Not getting anywhere, exit. exit; elsif (current_option_ptr = null) then exit; end if; option_ptr := current_option_ptr; end loop; To_local_t_opthdr_ptr (option_ptr).len := Option.C.len; To_local_t_opthdr_ptr (option_ptr).level := Option.C.level; To_local_t_opthdr_ptr (option_ptr).name := Option.C.name; To_local_t_opthdr_ptr (option_ptr).status := Option.C.status; option_offset := (To_Address (option_ptr) - To_Address (Info_Item.C.buf)) + Storage_Offset (POSIX.C.XTI.struct_t_opthdr'Size / char'Size); option_data_size := (Integer (Option.C.len) - (POSIX.C.XTI.struct_t_opthdr'Size / char'Size)); if option_data_size > 0 then -- Add data after header Info_Item.buf_ptr ((Integer (option_offset) + 1) .. (Integer (option_offset) + option_data_size)) := Option.Data (1 .. option_data_size); end if; Info_Item.C.len := Info_Item.C.len + (POSIX.C.XTI.struct_t_opthdr'Size / char'Size) + unsigned_int (option_data_size); end Append; procedure For_Every_Item (Info_Item : Protocol_Option_List) is Quit : boolean := False; current_option_ptr : POSIX.C.XTI.t_opthdr_ptr := To_opthdr_ptr (Info_Item.C.buf); option_ptr : POSIX.C.XTI.t_opthdr_ptr := current_option_ptr; option : POSIX.XTI.Protocol_Option; option_data_size : Integer; option_offset : Storage_Offset; begin while (current_option_ptr /= null) loop option_ptr := current_option_ptr; -- Exit if there is no option if current_option_ptr.len = 0 then exit; end if; option.C.len := current_option_ptr.len; option.C.level := current_option_ptr.level; option.C.name := current_option_ptr.name; option.C.status := current_option_ptr.status; option_data_size := Integer (option.C.len) - (POSIX.C.XTI.struct_t_opthdr'Size / char'Size); option_offset := (To_Address (current_option_ptr) - To_Address (Info_Item.C.buf)) + Storage_Offset (POSIX.C.XTI.struct_t_opthdr'Size / char'Size); option.Data (1 .. option_data_size) := Info_Item.buf_ptr ((Integer (option_offset) + 1) .. (Integer (option_offset) + option_data_size)); Action (option, Quit); exit when Quit; current_option_ptr := c_OPT_NEXTHDR (Info_Item.C.buf, Info_Item.C.maxlen, current_option_ptr); if option_ptr = current_option_ptr then -- Not getting anywhere, exit. exit; elsif current_option_ptr = null then exit; end if; end loop; end For_Every_Item; function Number_Of_Options (Info_Item : Protocol_Option_List) return Natural is current_option_ptr : POSIX.C.XTI.t_opthdr_ptr := To_opthdr_ptr (Info_Item.C.buf); option_ptr : POSIX.C.XTI.t_opthdr_ptr := current_option_ptr; count : Integer := 0; begin while current_option_ptr /= null loop option_ptr := current_option_ptr; -- Exit if there is no option if current_option_ptr.len = 0 then exit; end if; current_option_ptr := c_OPT_NEXTHDR (Info_Item.C.buf, Info_Item.C.maxlen, current_option_ptr); if option_ptr = current_option_ptr then -- Not getting anywhere, exit. exit; elsif current_option_ptr = null then exit; end if; count := count + 1; end loop; return count; end Number_Of_Options; procedure Get_Option (Info_Item : in Protocol_Option_List; Option_Number : in Positive; Option : out Protocol_Option) is current_option_ptr : POSIX.C.XTI.t_opthdr_ptr := To_opthdr_ptr (Info_Item.C.buf); option_ptr : POSIX.C.XTI.t_opthdr_ptr := current_option_ptr; option_data_size : Integer; option_offset : Storage_Offset; count : integer := 1; begin while current_option_ptr /= null loop option_ptr := current_option_ptr; -- Exit if there is no option if current_option_ptr.len = 0 then exit; end if; -- We are at the option to pass back if count = Option_Number then Option.C.len := current_option_ptr.len; Option.C.level := current_option_ptr.level; Option.C.name := current_option_ptr.name; Option.C.status := current_option_ptr.status; option_data_size := Integer (Option.C.len) - (POSIX.C.XTI.struct_t_opthdr'Size / char'Size); option_offset := (To_Address (current_option_ptr) - To_Address (Info_Item.C.buf)) + Storage_Offset (POSIX.C.XTI.struct_t_opthdr'Size / char'Size); Option.Data (1 .. option_data_size) := Info_Item.buf_ptr ((Integer (option_offset) + 1) .. (Integer (option_offset) + option_data_size)); return; end if; current_option_ptr := c_OPT_NEXTHDR (Info_Item.C.buf, Info_Item.C.maxlen, current_option_ptr); if option_ptr = current_option_ptr then -- Not getting anywhere, exit. exit; elsif current_option_ptr = null then exit; end if; count := count + 1; end loop; -- Need to Raise Some Exception Raise_POSIX_Error (Invalid_Argument); end Get_Option; procedure Set_Address (Info_Item : in out Connection_Info; Address : in XTI_Address_Pointer) is begin Info_Item.C.addr.maxlen := Address.netbuf.maxlen; Info_Item.C.addr.len := Address.netbuf.len; Info_Item.C.addr.buf := Address.netbuf.buf; end Set_Address; function Get_Options (Info_Item : Connection_Info) return Protocol_Option_List is begin return (C => (maxlen => Info_Item.C.opt.maxlen, len => Info_Item.C.opt.len, buf => Info_Item.C.opt.buf), buf_ptr => Info_Item.opt_buf_ptr); end Get_Options; procedure Set_Options (Info_Item : in out Connection_Info; Options : in Protocol_Option_List_Pointer) is begin Info_Item.C.opt.maxlen := Options.C.maxlen; Info_Item.C.opt.len := Options.C.len; Info_Item.C.opt.buf := Options.C.buf; end Set_Options; procedure Set_User_Data (Info_Item : in out Connection_Info; User_Data : in System.Address; Max_Length : in POSIX.IO_Count) is begin Info_Item.C.udata.buf := To_char_ptr (User_Data); Info_Item.C.udata.maxlen := unsigned_int (Max_Length); Info_Item.C.udata.len := 0; end Set_User_Data; procedure Set_User_Data_Length (Info_Item : in out Connection_Info; Length : in POSIX.IO_Count) is begin Info_Item.C.udata.len := unsigned_int (Length); end Set_User_Data_Length; function Get_User_Data_Length (Info_Item : Connection_Info) return POSIX.IO_Count is begin return POSIX.IO_Count (Info_Item.C.udata.len); end Get_User_Data_Length; function Get_Sequence_Number (Info_Item : Connection_Info) return Natural is begin return Natural (Info_Item.C.sequence); end Get_Sequence_Number; procedure Set_Sequence_Number (Info_Item : in out Connection_Info; Number : in Natural) is begin Info_Item.C.sequence := int (Number); end Set_Sequence_Number; procedure Accept_Connection (Listening_Endpoint : in POSIX.IO.File_Descriptor; Responding_Endpoint : in POSIX.IO.File_Descriptor; Call : in Connection_Info) is begin if c_t_accept (int (Listening_Endpoint), int (Responding_Endpoint), To_ptr (Call'Address)) < 0 then -- Error Raise_XTI_Error; end if; end Accept_Connection; procedure Accept_Connection (Listening_Endpoint : in POSIX.IO.File_Descriptor; Responding_Endpoint : in POSIX.IO.File_Descriptor) is Call : POSIX.C.XTI.struct_t_call; begin Call.addr.len := 0; Call.opt.len := 0; Call.udata.len := 0; if c_t_accept (int (Listening_Endpoint), int (Responding_Endpoint), To_ptr (Call'Address)) < 0 then -- Error Raise_XTI_Error; end if; end Accept_Connection; procedure Acknowledge_Orderly_Release (Endpoint : in POSIX.IO.File_Descriptor) is begin if c_t_rcvrel (int (Endpoint)) < 0 then -- Error Raise_XTI_Error; end if; end Acknowledge_Orderly_Release; -- procedure Acknowledge_Orderly_Release_With_Data -- (Endpoint : in POSIX.IO.File_Descriptor; -- Info : in out Disconnect_Info) is -- begin -- if (c_t_rcvreldata (int (Endpoint), -- To_ptr (Info'Address)) < 0) then -- Error -- Raise_XTI_Error; -- end if; -- end Acknowledge_Orderly_Release_With_Data; procedure Acknowledge_Orderly_Release (Endpoint : in POSIX.IO.File_Descriptor; Reason : out Reason_Code) is Info : POSIX.C.XTI.struct_t_discon; begin Info.udata.len := 0; Info.udata.maxlen := 0; Info.udata.buf := null; if c_t_rcvreldata (int (Endpoint), To_ptr (Info'Address)) < 0 then -- Error Raise_XTI_Error; end if; Reason := Reason_Code (Info.reason); end Acknowledge_Orderly_Release; procedure Acknowledge_Orderly_Release_With_Data (Endpoint : in POSIX.IO.File_Descriptor; Reason : out Reason_Code; User_Data : in System.Address; Octets_Requested : in POSIX.IO_Count; Octets_Received : out POSIX.IO_Count) is Info : POSIX.C.XTI.struct_t_discon; begin Info.udata.len := unsigned_int (Octets_Requested); Info.udata.maxlen := unsigned_int (Octets_Requested); Info.udata.buf := To_char_ptr (User_Data); if c_t_rcvreldata (int (Endpoint), To_ptr (Info'Address)) < 0 then -- Error Raise_XTI_Error; end if; Reason := Reason_Code (Info.reason); Octets_Received := POSIX.IO_Count (Info.udata.len); end Acknowledge_Orderly_Release_With_Data; -- procedure Bind -- (Endpoint : in POSIX.IO.File_Descriptor; -- Request : in Binding_Info; -- Response : in out Binding_Info) is -- begin -- if (c_t_bind (int (Endpoint), -- To_ptr (Request'Address), -- To_ptr (Response'Address)) < 0) then -- Error -- Raise_XTI_Error; -- end if; -- end Bind; procedure Close (Endpoint : in POSIX.IO.File_Descriptor) is begin if (c_t_close (int (Endpoint)) < 0) then -- Error Raise_XTI_Error; end if; end Close; procedure Confirm_Connection (Endpoint : in POSIX.IO.File_Descriptor; Call : in Connection_Info_Pointer) is begin if c_t_rcvconnect (int (Endpoint), To_ptr (Call.C'Address)) < 0 then -- Error Raise_XTI_Error; end if; end Confirm_Connection; procedure Confirm_Connection (Endpoint : in POSIX.IO.File_Descriptor) is Call : POSIX.C.XTI.struct_t_call; begin Call.addr.len := 0; Call.opt.len := 0; Call.udata.len := 0; if c_t_rcvconnect (int (Endpoint), To_ptr (Call'Address)) < 0 then -- Error Raise_XTI_Error; end if; end Confirm_Connection; procedure Connect (Endpoint : in POSIX.IO.File_Descriptor; Send : in Connection_Info; Receive : in Connection_Info_Pointer) is begin if c_t_connect (int (Endpoint), To_ptr (Send.C'Address), To_ptr (Receive.C'Address)) < 0 then -- Error Raise_XTI_Error; end if; end Connect; procedure Connect (Endpoint : in POSIX.IO.File_Descriptor; Send : in Connection_Info) is begin if c_t_connect (int (Endpoint), To_ptr (Send'Address), null) < 0 then -- Error Raise_XTI_Error; end if; end Connect; procedure Gather_And_Send_Data (Endpoint : in POSIX.IO.File_Descriptor; Vector : in IO_Vector_Array; Flags : in XTI_Flags; Octets_Sent : out POSIX.IO_Count) is c_bytes : int; begin c_bytes := c_t_sndv (int (Endpoint), To_iovec_ptr (Vector (Vector'First)'Address), unsigned (Vector'Length), To_int (Flags)); if c_bytes < 0 then -- Error Raise_XTI_Error; else Octets_Sent := POSIX.IO_Count (c_bytes); end if; end Gather_And_Send_Data; procedure Gather_And_Send_Data_Unit (Endpoint : in POSIX.IO.File_Descriptor; Address : in XTI_Address_Pointer; Vector : in IO_Vector_Array; Options : in Protocol_Option_List) is c_bytes : int; data : POSIX.C.XTI.struct_t_unitdata; begin data.addr.len := Address.netbuf.len; data.addr.maxlen := Address.netbuf.maxlen; data.addr.buf := Address.netbuf.buf; data.opt.len := Options.C.len; data.opt.maxlen := Options.C.maxlen; data.opt.buf := Options.C.buf; data.udata.len := 0; c_bytes := c_t_sndvudata (int (Endpoint), To_ptr (data'Address), To_iovec_ptr (Vector (Vector'First)'Address), int (Vector'Length)); if c_bytes < 0 then -- Error Raise_XTI_Error; end if; end Gather_And_Send_Data_Unit; procedure Gather_And_Send_Data_Unit (Endpoint : in POSIX.IO.File_Descriptor; Address : in XTI_Address_Pointer; Vector : in IO_Vector_Array) is c_bytes : int; data : POSIX.C.XTI.struct_t_unitdata; begin data.addr.len := Address.netbuf.len; data.addr.maxlen := Address.netbuf.maxlen; data.addr.buf := Address.netbuf.buf; data.opt.len := 0; data.udata.len := 0; c_bytes := c_t_sndvudata (int (Endpoint), To_ptr (data'Address), To_iovec_ptr (Vector (Vector'First)'Address), int (Vector'Length)); if c_bytes < 0 then -- Error Raise_XTI_Error; end if; end Gather_And_Send_Data_Unit; function Get_Current_State (Endpoint : POSIX.IO.File_Descriptor) return Interface_State is S : constant int := c_t_getstate (int (Endpoint)); begin -- Use if-statement instead of case-statement or table, -- to allow for sparse or (if not supported) zero values -- of C-language constants. -- ????? change .5c? -- Make Interface_State into a private type with deferred -- constants. if S = POSIX.C.XTI.T_UNINIT then return Uninitialized; end if; if S = POSIX.C.XTI.T_UNBND then return Unbound; end if; if S = POSIX.C.XTI.T_IDLE then return Idle; end if; if S = POSIX.C.XTI.T_OUTCON then return Outgoing_Connect; end if; if S = POSIX.C.XTI.T_INCON then return Incoming_Connect; end if; if S = POSIX.C.XTI.T_DATAXFER then return Data_Transfer; end if; if S = POSIX.C.XTI.T_OUTREL then return Outgoing_Release; end if; if S = POSIX.C.XTI.T_INREL then return Incoming_Release; end if; if S = -1 then Raise_XTI_Error; end if; raise Program_Error; return Uninitialized; end Get_Current_State; procedure Get_Info (Endpoint : in POSIX.IO.File_Descriptor; Info : in Communications_Provider_Info_Pointer) is begin if c_t_getinfo (int (Endpoint), To_ptr (Info.C'Address)) < 0 then -- Error Raise_XTI_Error; end if; end Get_Info; procedure Get_Protocol_Address (Endpoint : in POSIX.IO.File_Descriptor; Bound_Address : in XTI_Address_Pointer; Peer_Address : in XTI_Address_Pointer) is bound_addr : POSIX.C.XTI.struct_t_bind; peer_addr : POSIX.C.XTI.struct_t_bind; begin bound_addr.addr.len := Bound_Address.netbuf.len; bound_addr.addr.maxlen := Bound_Address.netbuf.maxlen; bound_addr.addr.buf := Bound_Address.netbuf.buf; peer_addr.addr.len := Peer_Address.netbuf.len; peer_addr.addr.maxlen := Peer_Address.netbuf.maxlen; peer_addr.addr.buf := Peer_Address.netbuf.buf; if c_t_getprotaddr (int (Endpoint), To_ptr (bound_addr'Address), To_ptr (peer_addr'Address)) < 0 then -- Error Raise_XTI_Error; end if; end Get_Protocol_Address; procedure Initiate_Orderly_Release (Endpoint : in POSIX.IO.File_Descriptor) is begin if c_t_sndrel (int (Endpoint)) < 0 then -- Error Raise_XTI_Error; end if; end Initiate_Orderly_Release; -- procedure Initiate_Orderly_Release_With_Data -- (Endpoint : in POSIX.IO.File_Descriptor; -- Info : in Disconnect_Info) is -- begin -- if (c_t_sndreldata (int (Endpoint), -- To_ptr (Info'Address)) < 0) then -- Error -- Raise_XTI_Error; -- end if; -- end Initiate_Orderly_Release_With_Data; procedure Initiate_Orderly_Release (Endpoint : in POSIX.IO.File_Descriptor; Reason : in Reason_Code) is Info : POSIX.C.XTI.struct_t_discon; begin Info.udata.len := 0; Info.udata.maxlen := 0; Info.udata.buf := null; Info.reason := int (Reason); if c_t_sndreldata (int (Endpoint), To_ptr (Info'Address)) < 0 then -- Error Raise_XTI_Error; end if; end Initiate_Orderly_Release; procedure Initiate_Orderly_Release_With_Data (Endpoint : in POSIX.IO.File_Descriptor; Reason : in Reason_Code; User_Data : in System.Address; Octets_To_Send : in POSIX.IO_Count) is Info : POSIX.C.XTI.struct_t_discon; begin Info.udata.len := unsigned_int (Octets_To_Send); Info.udata.maxlen := unsigned_int (Octets_To_Send); Info.udata.buf := To_char_ptr (User_Data); Info.reason := int (Reason); if c_t_sndreldata (int (Endpoint), To_ptr (Info'Address)) < 0 then -- Error Raise_XTI_Error; end if; end Initiate_Orderly_Release_With_Data; procedure Listen (Endpoint : in POSIX.IO.File_Descriptor; Call : in Connection_Info_Pointer) is begin if c_t_listen (int (Endpoint), To_ptr (Call.C'Address)) < 0 then Raise_XTI_Error; end if; end Listen; function Look (Endpoint : POSIX.IO.File_Descriptor) return XTI_Events is c_events : int; begin c_events := c_t_look (int (Endpoint)); if c_events < 0 then -- Error Raise_XTI_Error; return XTI_Events (POSIX.Empty_Set); else return To_XTI_Events (c_events); end if; end Look; procedure Manage_Options (Endpoint : in POSIX.IO.File_Descriptor; Request : in Protocol_Option_List; Request_Flag : in Options_Flags; Response : in Protocol_Option_List_Pointer; Response_Flags : out Option_Status) is c_req : POSIX.C.XTI.struct_t_optmgmt; c_ret : POSIX.C.XTI.struct_t_optmgmt; begin c_req.opt.maxlen := Request.C.maxlen; c_req.opt.len := Request.C.len; c_req.opt.buf := Request.C.buf; c_req.flags := long (Request_Flag); c_ret.opt.maxlen := Response.C.maxlen; c_ret.opt.len := Response.C.len; c_ret.opt.buf := Response.C.buf; if c_t_optmgmt (int (Endpoint), To_ptr (c_req'Address), To_ptr (c_ret'Address)) < 0 then -- Error Raise_XTI_Error; end if; -- Set the Response_Flags if (unsigned (c_ret.flags) and unsigned (POSIX.C.XTI.T_SUCCESS)) = unsigned (POSIX.C.XTI.T_SUCCESS) then Response_Flags := Success; elsif (unsigned (c_ret.flags) and unsigned (POSIX.C.XTI.T_PARTSUCCESS)) = unsigned (POSIX.C.XTI.T_PARTSUCCESS) then Response_Flags := Partial_Success; elsif (unsigned (c_ret.flags) and unsigned (POSIX.C.XTI.T_FAILURE)) = unsigned (POSIX.C.XTI.T_FAILURE) then Response_Flags := Failure; elsif (unsigned (c_ret.flags) and unsigned (POSIX.C.XTI.T_READONLY)) = unsigned (POSIX.C.XTI.T_READONLY) then Response_Flags := Read_Only; elsif (unsigned (c_ret.flags) and unsigned (POSIX.C.XTI.T_NOTSUPPORT)) = unsigned (POSIX.C.XTI.T_NOTSUPPORT) then Response_Flags := Not_Supported; end if; end Manage_Options; procedure Open (Endpoint : out POSIX.IO.File_Descriptor; Name : in POSIX.POSIX_String; Mode : in POSIX.IO.File_Mode; Options : in POSIX.IO.Open_Option_Set; Info : in Communications_Provider_Info_Pointer) is c_endpoint : int; c_oflags : int; begin c_oflags := To_int (Options); case Mode is when POSIX.IO.Read_Only => c_oflags := c_oflags + POSIX.C.O_RDONLY; when POSIX.IO.Write_Only => c_oflags := c_oflags + POSIX.C.O_WRONLY; when POSIX.IO.Read_Write => c_oflags := c_oflags + POSIX.C.O_RDWR; end case; c_endpoint := c_t_open (To_char_ptr (Name'Address), c_oflags, To_ptr (Info.C'Address)); if c_endpoint < 0 then -- Error Raise_XTI_Error; else Endpoint := POSIX.IO.File_Descriptor (c_endpoint); end if; end Open; procedure Open (Endpoint : out POSIX.IO.File_Descriptor; Name : in POSIX.POSIX_String; Mode : in POSIX.IO.File_Mode; Options : in POSIX.IO.Open_Option_Set) is c_endpoint : int; c_oflags : int; begin c_oflags := To_int (Options); case Mode is when POSIX.IO.Read_Only => c_oflags := c_oflags + POSIX.C.O_RDONLY; when POSIX.IO.Write_Only => c_oflags := c_oflags + POSIX.C.O_WRONLY; when POSIX.IO.Read_Write => c_oflags := c_oflags + POSIX.C.O_RDWR; end case; c_endpoint := c_t_open (To_char_ptr (Name'Address), c_oflags, null); if c_endpoint < 0 then -- Error Raise_XTI_Error; else Endpoint := POSIX.IO.File_Descriptor (c_endpoint); end if; end Open; procedure Receive (Endpoint : in POSIX.IO.File_Descriptor; Buffer : in System.Address; Octets_Requested : in POSIX.IO_Count; Octets_Received : out POSIX.IO_Count; Flags : out XTI_Flags) is c_bytes : int; begin c_bytes := c_t_rcv (int (Endpoint), To_char_ptr (Buffer), unsigned (Octets_Requested), To_int_ptr (Flags'Address)); if c_bytes < 0 then -- Error Raise_XTI_Error; else Octets_Received := POSIX.IO_Count (c_bytes); end if; end Receive; procedure Receive_And_Scatter_Data (Endpoint : in POSIX.IO.File_Descriptor; Vector : in IO_Vector_Array; Octets_Received : out POSIX.IO_Count; Flags : out XTI_Flags) is c_bytes : int; begin c_bytes := c_t_rcvv (int (Endpoint), To_iovec_ptr (Vector (Vector'First)'Address), unsigned (Vector'Length), To_int_ptr (Flags'Address)); if c_bytes < 0 then -- Error Raise_XTI_Error; else Octets_Received := POSIX.IO_Count (c_bytes); end if; end Receive_And_Scatter_Data; procedure Receive_And_Scatter_Data_Unit (Endpoint : in POSIX.IO.File_Descriptor; Address : in XTI_Address_Pointer; Options : in Protocol_Option_List_Pointer; Vector : in IO_Vector_Array; Octets_Received : out POSIX.IO_Count; Flags : out XTI_Flags) is c_bytes : int; Data : POSIX.C.XTI.struct_t_unitdata; begin Data.udata.len := 0; Data.addr.len := Address.netbuf.len; Data.addr.maxlen := Address.netbuf.maxlen; Data.addr.buf := Address.netbuf.buf; Data.opt.len := Options.C.len; Data.opt.maxlen := Options.C.maxlen; Data.opt.buf := Options.C.buf; c_bytes := c_t_rcvvudata (int (Endpoint), To_ptr (Data'Address), To_iovec_ptr (Vector (Vector'First)'Address), unsigned (Vector'Length), To_int_ptr (Flags'Address)); if c_bytes < 0 then -- Error Raise_XTI_Error; else Octets_Received := POSIX.IO_Count (c_bytes); end if; end Receive_And_Scatter_Data_Unit; procedure Receive_Data_Unit (Endpoint : in POSIX.IO.File_Descriptor; User_Data : in System.Address; Octets_Requested : in POSIX.IO_Count; Address : in XTI_Address_Pointer; Options : in Protocol_Option_List_Pointer; Flags : out XTI_Flags) is Data : POSIX.C.XTI.struct_t_unitdata; begin Data.udata.len := unsigned_int (Octets_Requested); Data.udata.maxlen := unsigned_int (Octets_Requested); Data.udata.buf := To_char_ptr (User_Data); Data.addr.len := Address.netbuf.len; Data.addr.maxlen := Address.netbuf.maxlen; Data.addr.buf := Address.netbuf.buf; Data.opt.len := Options.C.len; Data.opt.maxlen := Options.C.maxlen; Data.opt.buf := Options.C.buf; if c_t_rcvudata (int (Endpoint), To_ptr (Data'Address), To_int_ptr (Flags'Address)) < 0 then -- Error Raise_XTI_Error; end if; end Receive_Data_Unit; procedure Receive_Data_Unit (Endpoint : in POSIX.IO.File_Descriptor; User_Data : in System.Address; Octets_Requested : in POSIX.IO_Count; Address : in XTI_Address_Pointer; Flags : out XTI_Flags) is Data : POSIX.C.XTI.struct_t_unitdata; begin Data.udata.len := unsigned_int (Octets_Requested); Data.udata.maxlen := unsigned_int (Octets_Requested); Data.udata.buf := To_char_ptr (User_Data); Data.addr.len := Address.netbuf.len; Data.addr.maxlen := Address.netbuf.maxlen; Data.addr.buf := Address.netbuf.buf; Data.opt.len := 0; Data.opt.maxlen := 0; Data.opt.buf := null; if c_t_rcvudata (int (Endpoint), To_ptr (Data'Address), To_int_ptr (Flags'Address)) < 0 then -- Error Raise_XTI_Error; end if; end Receive_Data_Unit; -- function Get_Address (Error_Item : Unit_Data_Error) -- return XTI_Address_Pointer is -- this function is protocol specific. Look in the xti child packages. -- function Get_Options (Error_Item : Unit_Data_Error) -- return Protocol_Option_List is -- begin -- return (C => (maxlen => Error_Item.C.opt.maxlen, -- len => Error_Item.C.opt.len, -- buf => Error_Item.C.opt.buf), -- buf_ptr => Error_Item.opt_buf_ptr); -- end Get_Options; -- function Get_Error_Code (Error_Item : Unit_Data_Error) -- return Integer is -- begin -- return Integer (Error_Item.C.error); -- end Get_Error_Code; -- procedure Receive_Data_Unit_Error -- (Endpoint : in POSIX.IO.File_Descriptor; -- Error : in out Unit_Data_Error) is -- begin -- if (c_t_rcvuderr (int (Endpoint), -- To_ptr (Error'Address)) < 0) then -- Error -- Raise_XTI_Error; -- end if; -- end Receive_Data_Unit_Error; procedure Retrieve_Data_Unit_Error (Endpoint : in POSIX.IO.File_Descriptor; Address : in XTI_Address_Pointer; Options : in Protocol_Option_List_Pointer; Error : out Unit_Data_Error_Code) is Error_Data : POSIX.C.XTI.struct_t_uderr; begin Error_Data.addr.len := Address.netbuf.len; Error_Data.addr.maxlen := Address.netbuf.maxlen; Error_Data.addr.buf := Address.netbuf.buf; Error_Data.opt.len := Options.C.len; Error_Data.opt.maxlen := Options.C.maxlen; Error_Data.opt.buf := Options.C.buf; if c_t_rcvuderr (int (Endpoint), To_ptr (Error_Data'Address)) < 0 then -- Error Raise_XTI_Error; end if; Error := Unit_Data_Error_Code (Error_Data.error); end Retrieve_Data_Unit_Error; procedure Retrieve_Data_Unit_Error (Endpoint : in POSIX.IO.File_Descriptor; Address : in XTI_Address_Pointer; Error : out Unit_Data_Error_Code) is Error_Data : POSIX.C.XTI.struct_t_uderr; begin Error_Data.addr.len := Address.netbuf.len; Error_Data.addr.maxlen := Address.netbuf.maxlen; Error_Data.addr.buf := Address.netbuf.buf; Error_Data.opt.len := 0; Error_Data.opt.maxlen := 0; Error_Data.opt.buf := null; if c_t_rcvuderr (int (Endpoint), To_ptr (Error_Data'Address)) < 0 then -- Error Raise_XTI_Error; end if; Error := Unit_Data_Error_Code (Error_Data.error); end Retrieve_Data_Unit_Error; procedure Retrieve_Data_Unit_Error (Endpoint : in POSIX.IO.File_Descriptor; Options : in Protocol_Option_List_Pointer; Error : out Unit_Data_Error_Code) is Error_Data : POSIX.C.XTI.struct_t_uderr; begin Error_Data.addr.len := 0; Error_Data.addr.maxlen := 0; Error_Data.addr.buf := null; Error_Data.opt.len := Options.C.len; Error_Data.opt.maxlen := Options.C.maxlen; Error_Data.opt.buf := Options.C.buf; if c_t_rcvuderr (int (Endpoint), To_ptr (Error_Data'Address)) < 0 then -- Error Raise_XTI_Error; end if; Error := Unit_Data_Error_Code (Error_Data.error); end Retrieve_Data_Unit_Error; procedure Retrieve_Data_Unit_Error (Endpoint : in POSIX.IO.File_Descriptor; Error : out Unit_Data_Error_Code) is Error_Data : POSIX.C.XTI.struct_t_uderr; begin Error_Data.addr.len := 0; Error_Data.addr.maxlen := 0; Error_Data.addr.buf := null; Error_Data.opt.len := 0; Error_Data.opt.maxlen := 0; Error_Data.opt.buf := null; if c_t_rcvuderr (int (Endpoint), To_ptr (Error_Data'Address)) < 0 then -- Error Raise_XTI_Error; end if; Error := Unit_Data_Error_Code (Error_Data.error); end Retrieve_Data_Unit_Error; -- procedure Retrieve_Disconnect_Info -- (Endpoint : in POSIX.IO.File_Descriptor; -- Info : in out Disconnect_Info) is -- begin -- if (c_t_rcvdis (int (Endpoint), -- To_ptr (Info'Address)) < 0) then -- Error -- Raise_XTI_Error; -- end if; -- end Retrieve_Disconnect_Info; procedure Retrieve_Disconnect_Info (Endpoint : in POSIX.IO.File_Descriptor; User_Data : in System.Address; Octets_Requested : in POSIX.IO_Count; Reason : out Reason_Code; Sequence_Number : out Natural) is Info : POSIX.C.XTI.struct_t_discon; begin Info.udata.len := 0; Info.udata.maxlen := unsigned_int (Octets_Requested); Info.udata.buf := To_char_ptr (User_Data); if c_t_rcvdis (int (Endpoint), To_ptr (Info'Address)) < 0 then -- Error Raise_XTI_Error; end if; Reason := Reason_Code (Info.reason); Sequence_Number := Integer (Info.sequence); end Retrieve_Disconnect_Info; procedure Clear_Disconnect_Info (Endpoint : in POSIX.IO.File_Descriptor) is begin if c_t_rcvdis (int (Endpoint), null) < 0 then -- Error Raise_XTI_Error; end if; end Clear_Disconnect_Info; procedure Send (Endpoint : in POSIX.IO.File_Descriptor; Buffer : in System.Address; Octets_To_Send : in POSIX.IO_Count; Flags : in XTI_Flags; Octets_Sent : out POSIX.IO_Count) is c_count : int; begin c_count := c_t_snd (int (Endpoint), To_char_ptr (Buffer), unsigned (Octets_To_Send), To_int (Flags)); if c_count < 0 then -- Error Raise_XTI_Error; else Octets_Sent := POSIX.IO_Count (c_count); end if; end Send; procedure Send_Data_Unit (Endpoint : in POSIX.IO.File_Descriptor; User_Data : in System.Address; Octets_To_Send : in POSIX.IO_Count; Address : in XTI_Address_Pointer; Options : in Protocol_Option_List) is c_count : int; Data : POSIX.C.XTI.struct_t_unitdata; begin Data.udata.len := unsigned_int (Octets_To_Send); Data.udata.maxlen := unsigned_int (Octets_To_Send); Data.udata.buf := To_char_ptr (User_Data); Data.addr.len := Address.netbuf.len; Data.addr.maxlen := Address.netbuf.maxlen; Data.addr.buf := Address.netbuf.buf; Data.opt.len := Options.C.len; Data.opt.maxlen := Options.C.maxlen; Data.opt.buf := Options.C.buf; c_count := c_t_sndudata (int (Endpoint), To_ptr (Data'Address)); if c_count < 0 then -- Error Raise_XTI_Error; end if; end Send_Data_Unit; procedure Send_Data_Unit (Endpoint : in POSIX.IO.File_Descriptor; User_Data : in System.Address; Octets_To_Send : in POSIX.IO_Count; Address : in XTI_Address_Pointer) is c_count : int; Data : POSIX.C.XTI.struct_t_unitdata; begin Data.udata.len := unsigned_int (Octets_To_Send); Data.udata.maxlen := unsigned_int (Octets_To_Send); Data.udata.buf := To_char_ptr (User_Data); Data.addr.len := Address.netbuf.len; Data.addr.maxlen := Address.netbuf.maxlen; Data.addr.buf := Address.netbuf.buf; Data.opt.len := 0; Data.opt.maxlen := 0; Data.opt.buf := null; c_count := c_t_sndudata (int (Endpoint), To_ptr (User_Data)); if c_count < 0 then -- Error Raise_XTI_Error; end if; end Send_Data_Unit; procedure Send_Disconnect_Request (Endpoint : in POSIX.IO.File_Descriptor; Call : in Connection_Info) is begin if c_t_snddis (int (Endpoint), To_ptr (Call.C'Address)) < 0 then -- Error Raise_XTI_Error; end if; end Send_Disconnect_Request; procedure Send_Disconnect_Request (Endpoint : in POSIX.IO.File_Descriptor) is begin if c_t_snddis (int (Endpoint), null) < 0 then -- Error Raise_XTI_Error; end if; end Send_Disconnect_Request; function Synchronize_Endpoint (Endpoint : in POSIX.IO.File_Descriptor) return Interface_State is S : constant int := c_t_sync (int (Endpoint)); begin return Interface_State (S); end Synchronize_Endpoint; procedure Unbind (Endpoint : in POSIX.IO.File_Descriptor) is begin if (c_t_unbind (int (Endpoint)) < 0) then -- Error Raise_XTI_Error; end if; end Unbind; procedure Raise_XTI_Error is c_t_errno : Error_Code; begin c_t_errno := Fetch_T_Errno; Raise_POSIX_Error (c_t_errno + POSIX.XTI_Error_Code'First); end Raise_XTI_Error; procedure Bind (Endpoint : in POSIX.IO.File_Descriptor; Request_Address : in XTI_Address_Pointer; Request_Queue_Length : in Natural; Response_Address : in XTI_Address_Pointer; Response_Queue_Length : out Natural) is request : POSIX.C.XTI.struct_t_bind; response : POSIX.C.XTI.struct_t_bind; begin request.qlen := unsigned (Request_Queue_Length); request.addr.len := Request_Address.netbuf.len; request.addr.maxlen := Request_Address.netbuf.maxlen; request.addr.buf := Request_Address.netbuf.buf; response.addr.len := Response_Address.netbuf.len; response.addr.maxlen := Response_Address.netbuf.maxlen; response.addr.buf := Response_Address.netbuf.buf; if c_t_bind (int (Endpoint), To_ptr (request'Address), To_ptr (response'Address)) < 0 then -- Error Raise_XTI_Error; end if; Response_Queue_Length := Integer (response.qlen); end Bind; procedure Bind (Endpoint : in POSIX.IO.File_Descriptor; Request_Queue_Length : in Natural; Response_Address : in XTI_Address_Pointer; Response_Queue_Length : out Natural) is request : POSIX.C.XTI.struct_t_bind; response : POSIX.C.XTI.struct_t_bind; begin request.qlen := unsigned (Request_Queue_Length); request.addr.len := 0; request.addr.maxlen := 0; request.addr.buf := null; response.addr.len := Response_Address.netbuf.len; response.addr.maxlen := Response_Address.netbuf.maxlen; response.addr.buf := Response_Address.netbuf.buf; if c_t_bind (int (Endpoint), To_ptr (request'Address), To_ptr (response'Address)) < 0 then -- Error Raise_XTI_Error; end if; Response_Queue_Length := Integer (response.qlen); end Bind; procedure Bind (Endpoint : in POSIX.IO.File_Descriptor; Request_Address : in XTI_Address_Pointer; Request_Queue_Length : in Natural) is request : POSIX.C.XTI.struct_t_bind; begin request.qlen := unsigned (Request_Queue_Length); request.addr.len := Request_Address.netbuf.len; request.addr.maxlen := Request_Address.netbuf.maxlen; request.addr.buf := Request_Address.netbuf.buf; if c_t_bind (int (Endpoint), To_ptr (request'Address), null) < 0 then -- Error Raise_XTI_Error; end if; end Bind; procedure Bind (Endpoint : in POSIX.IO.File_Descriptor; Response_Address : in XTI_Address_Pointer) is response : POSIX.C.XTI.struct_t_bind; begin response.addr.len := Response_Address.netbuf.len; response.addr.maxlen := Response_Address.netbuf.maxlen; response.addr.buf := Response_Address.netbuf.buf; if c_t_bind (int (Endpoint), null, To_ptr (response'Address)) < 0 then -- Error Raise_XTI_Error; end if; end Bind; procedure Bind (Endpoint : in POSIX.IO.File_Descriptor) is begin if c_t_bind (int (Endpoint), null, null) < 0 then -- Error Raise_XTI_Error; end if; end Bind; procedure Send_Disconnect_Request (Endpoint : in POSIX.IO.File_Descriptor; Sequence_Number : in Natural) is call : POSIX.C.XTI.struct_t_call; begin call.sequence := int (Sequence_Number); call.udata.len := 0; call.addr.len := 0; call.opt.len := 0; if c_t_snddis (int (Endpoint), To_ptr (call'Address)) < 0 then -- Error Raise_XTI_Error; end if; end Send_Disconnect_Request; procedure Send_Disconnect_Request (Endpoint : in POSIX.IO.File_Descriptor; User_Data : in System.Address; Octets_To_Send : in POSIX.IO_Count) is call : POSIX.C.XTI.struct_t_call; begin -- sequence, addr, and opt are not used call.sequence := 0; call.addr.len := 0; call.addr.maxlen := 0; call.addr.buf := null; call.opt.len := 0; call.opt.maxlen := 0; call.opt.buf := null; call.udata.len := unsigned_int (Octets_To_Send); call.udata.maxlen := unsigned_int (Octets_To_Send); call.udata.buf := To_char_ptr (User_Data); if c_t_snddis (int (Endpoint), To_ptr (call'Address)) < 0 then -- Error Raise_XTI_Error; end if; end Send_Disconnect_Request; end POSIX.XTI;