1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
5 -- G N A T . S O C K E T S --
9 -- Copyright (C) 2001-2007, AdaCore --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 2, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, USA. --
22 -- As a special exception, if other files instantiate generics from this --
23 -- unit, or you link this unit with other files to produce an executable, --
24 -- this unit does not by itself cause the resulting executable to be --
25 -- covered by the GNU General Public License. This exception does not --
26 -- however invalidate any other reasons why the executable file might be --
27 -- covered by the GNU Public License. --
29 -- GNAT was originally developed by the GNAT team at New York University. --
30 -- Extensive contributions were provided by Ada Core Technologies Inc. --
32 ------------------------------------------------------------------------------
34 with Ada.Streams; use Ada.Streams;
35 with Ada.Exceptions; use Ada.Exceptions;
36 with Ada.Unchecked_Conversion;
38 with Interfaces.C.Strings;
39 with GNAT.Sockets.Constants;
40 with GNAT.Sockets.Thin; use GNAT.Sockets.Thin;
41 with GNAT.Sockets.Thin.Task_Safe_NetDB; use GNAT.Sockets.Thin.Task_Safe_NetDB;
43 with GNAT.Sockets.Linker_Options;
44 pragma Warnings (Off, GNAT.Sockets.Linker_Options);
45 -- Need to include pragma Linker_Options which is platform dependent
47 with System; use System;
49 package body GNAT.Sockets is
51 use type C.int, System.Address;
53 Finalized : Boolean := False;
54 Initialized : Boolean := False;
56 ENOERROR : constant := 0;
58 Netdb_Buffer_Size : constant := Constants.Need_Netdb_Buffer * 1024;
59 -- The network database functions gethostbyname, gethostbyaddr,
60 -- getservbyname and getservbyport can either be guaranteed task safe by
61 -- the operating system, or else return data through a user-provided buffer
62 -- to ensure concurrent uses do not interfere.
64 -- Correspondance tables
66 Families : constant array (Family_Type) of C.int :=
67 (Family_Inet => Constants.AF_INET,
68 Family_Inet6 => Constants.AF_INET6);
70 Levels : constant array (Level_Type) of C.int :=
71 (Socket_Level => Constants.SOL_SOCKET,
72 IP_Protocol_For_IP_Level => Constants.IPPROTO_IP,
73 IP_Protocol_For_UDP_Level => Constants.IPPROTO_UDP,
74 IP_Protocol_For_TCP_Level => Constants.IPPROTO_TCP);
76 Modes : constant array (Mode_Type) of C.int :=
77 (Socket_Stream => Constants.SOCK_STREAM,
78 Socket_Datagram => Constants.SOCK_DGRAM);
80 Shutmodes : constant array (Shutmode_Type) of C.int :=
81 (Shut_Read => Constants.SHUT_RD,
82 Shut_Write => Constants.SHUT_WR,
83 Shut_Read_Write => Constants.SHUT_RDWR);
85 Requests : constant array (Request_Name) of C.int :=
86 (Non_Blocking_IO => Constants.FIONBIO,
87 N_Bytes_To_Read => Constants.FIONREAD);
89 Options : constant array (Option_Name) of C.int :=
90 (Keep_Alive => Constants.SO_KEEPALIVE,
91 Reuse_Address => Constants.SO_REUSEADDR,
92 Broadcast => Constants.SO_BROADCAST,
93 Send_Buffer => Constants.SO_SNDBUF,
94 Receive_Buffer => Constants.SO_RCVBUF,
95 Linger => Constants.SO_LINGER,
96 Error => Constants.SO_ERROR,
97 No_Delay => Constants.TCP_NODELAY,
98 Add_Membership => Constants.IP_ADD_MEMBERSHIP,
99 Drop_Membership => Constants.IP_DROP_MEMBERSHIP,
100 Multicast_If => Constants.IP_MULTICAST_IF,
101 Multicast_TTL => Constants.IP_MULTICAST_TTL,
102 Multicast_Loop => Constants.IP_MULTICAST_LOOP,
103 Send_Timeout => Constants.SO_SNDTIMEO,
104 Receive_Timeout => Constants.SO_RCVTIMEO);
106 Flags : constant array (0 .. 3) of C.int :=
107 (0 => Constants.MSG_OOB, -- Process_Out_Of_Band_Data
108 1 => Constants.MSG_PEEK, -- Peek_At_Incoming_Data
109 2 => Constants.MSG_WAITALL, -- Wait_For_A_Full_Reception
110 3 => Constants.MSG_EOR); -- Send_End_Of_Record
112 Socket_Error_Id : constant Exception_Id := Socket_Error'Identity;
113 Host_Error_Id : constant Exception_Id := Host_Error'Identity;
115 Hex_To_Char : constant String (1 .. 16) := "0123456789ABCDEF";
116 -- Use to print in hexadecimal format
118 function To_In_Addr is new Ada.Unchecked_Conversion (C.int, In_Addr);
119 function To_Int is new Ada.Unchecked_Conversion (In_Addr, C.int);
121 function Err_Code_Image (E : Integer) return String;
122 -- Return the value of E surrounded with brackets
124 -----------------------
125 -- Local subprograms --
126 -----------------------
128 function Resolve_Error
129 (Error_Value : Integer;
130 From_Errno : Boolean := True) return Error_Type;
131 -- Associate an enumeration value (error_type) to en error value (errno).
132 -- From_Errno prevents from mixing h_errno with errno.
134 function To_Name (N : String) return Name_Type;
135 function To_String (HN : Name_Type) return String;
136 -- Conversion functions
138 function To_Int (F : Request_Flag_Type) return C.int;
139 -- Return the int value corresponding to the specified flags combination
141 function Set_Forced_Flags (F : C.int) return C.int;
142 -- Return F with the bits from Constants.MSG_Forced_Flags forced set
144 function Short_To_Network
145 (S : C.unsigned_short) return C.unsigned_short;
146 pragma Inline (Short_To_Network);
147 -- Convert a port number into a network port number
149 function Network_To_Short
150 (S : C.unsigned_short) return C.unsigned_short
151 renames Short_To_Network;
152 -- Symetric operation
155 (Val : Inet_Addr_VN_Type;
156 Hex : Boolean := False) return String;
157 -- Output an array of inet address components in hex or decimal mode
159 function Is_IP_Address (Name : String) return Boolean;
160 -- Return true when Name is an IP address in standard dot notation
162 function To_In_Addr (Addr : Inet_Addr_Type) return Thin.In_Addr;
163 procedure To_Inet_Addr
165 Result : out Inet_Addr_Type);
166 -- Conversion functions
168 function To_Host_Entry (E : Hostent) return Host_Entry_Type;
169 -- Conversion function
171 function To_Service_Entry (E : Servent) return Service_Entry_Type;
172 -- Conversion function
174 function To_Timeval (Val : Timeval_Duration) return Timeval;
175 -- Separate Val in seconds and microseconds
177 function To_Duration (Val : Timeval) return Timeval_Duration;
178 -- Reconstruct a Duration value from a Timeval record (seconds and
181 procedure Raise_Socket_Error (Error : Integer);
182 -- Raise Socket_Error with an exception message describing the error code
185 procedure Raise_Host_Error (H_Error : Integer);
186 -- Raise Host_Error exception with message describing error code (note
187 -- hstrerror seems to be obsolete) from h_errno.
189 procedure Narrow (Item : in out Socket_Set_Type);
190 -- Update Last as it may be greater than the real last socket
192 -- Types needed for Datagram_Socket_Stream_Type
194 type Datagram_Socket_Stream_Type is new Root_Stream_Type with record
195 Socket : Socket_Type;
197 From : Sock_Addr_Type;
200 type Datagram_Socket_Stream_Access is
201 access all Datagram_Socket_Stream_Type;
204 (Stream : in out Datagram_Socket_Stream_Type;
205 Item : out Ada.Streams.Stream_Element_Array;
206 Last : out Ada.Streams.Stream_Element_Offset);
209 (Stream : in out Datagram_Socket_Stream_Type;
210 Item : Ada.Streams.Stream_Element_Array);
212 -- Types needed for Stream_Socket_Stream_Type
214 type Stream_Socket_Stream_Type is new Root_Stream_Type with record
215 Socket : Socket_Type;
218 type Stream_Socket_Stream_Access is
219 access all Stream_Socket_Stream_Type;
222 (Stream : in out Stream_Socket_Stream_Type;
223 Item : out Ada.Streams.Stream_Element_Array;
224 Last : out Ada.Streams.Stream_Element_Offset);
227 (Stream : in out Stream_Socket_Stream_Type;
228 Item : Ada.Streams.Stream_Element_Array);
234 function "+" (L, R : Request_Flag_Type) return Request_Flag_Type is
243 procedure Abort_Selector (Selector : Selector_Type) is
247 -- Send one byte to unblock select system call
249 Res := Signalling_Fds.Write (C.int (Selector.W_Sig_Socket));
251 if Res = Failure then
252 Raise_Socket_Error (Socket_Errno);
260 procedure Accept_Socket
261 (Server : Socket_Type;
262 Socket : out Socket_Type;
263 Address : out Sock_Addr_Type)
266 Sin : aliased Sockaddr_In;
267 Len : aliased C.int := Sin'Size / 8;
270 Res := C_Accept (C.int (Server), Sin'Address, Len'Access);
272 if Res = Failure then
273 Raise_Socket_Error (Socket_Errno);
276 Socket := Socket_Type (Res);
278 To_Inet_Addr (Sin.Sin_Addr, Address.Addr);
279 Address.Port := Port_Type (Network_To_Short (Sin.Sin_Port));
287 (E : Host_Entry_Type;
288 N : Positive := 1) return Inet_Addr_Type
291 return E.Addresses (N);
294 ----------------------
295 -- Addresses_Length --
296 ----------------------
298 function Addresses_Length (E : Host_Entry_Type) return Natural is
300 return E.Addresses_Length;
301 end Addresses_Length;
308 (E : Host_Entry_Type;
309 N : Positive := 1) return String
312 return To_String (E.Aliases (N));
320 (S : Service_Entry_Type;
321 N : Positive := 1) return String
324 return To_String (S.Aliases (N));
331 function Aliases_Length (E : Host_Entry_Type) return Natural is
333 return E.Aliases_Length;
340 function Aliases_Length (S : Service_Entry_Type) return Natural is
342 return S.Aliases_Length;
349 procedure Bind_Socket
350 (Socket : Socket_Type;
351 Address : Sock_Addr_Type)
354 Sin : aliased Sockaddr_In;
355 Len : constant C.int := Sin'Size / 8;
358 if Address.Family = Family_Inet6 then
362 Set_Length (Sin'Unchecked_Access, Len);
363 Set_Family (Sin'Unchecked_Access, Families (Address.Family));
364 Set_Address (Sin'Unchecked_Access, To_In_Addr (Address.Addr));
366 (Sin'Unchecked_Access,
367 Short_To_Network (C.unsigned_short (Address.Port)));
369 Res := C_Bind (C.int (Socket), Sin'Address, Len);
371 if Res = Failure then
372 Raise_Socket_Error (Socket_Errno);
380 procedure Check_Selector
381 (Selector : in out Selector_Type;
382 R_Socket_Set : in out Socket_Set_Type;
383 W_Socket_Set : in out Socket_Set_Type;
384 Status : out Selector_Status;
385 Timeout : Selector_Duration := Forever)
387 E_Socket_Set : Socket_Set_Type; -- (No_Socket, No_Socket_Set)
390 (Selector, R_Socket_Set, W_Socket_Set, E_Socket_Set, Status, Timeout);
393 procedure Check_Selector
394 (Selector : in out Selector_Type;
395 R_Socket_Set : in out Socket_Set_Type;
396 W_Socket_Set : in out Socket_Set_Type;
397 E_Socket_Set : in out Socket_Set_Type;
398 Status : out Selector_Status;
399 Timeout : Selector_Duration := Forever)
403 RSig : Socket_Type renames Selector.R_Sig_Socket;
404 RSet : Socket_Set_Type;
405 WSet : Socket_Set_Type;
406 ESet : Socket_Set_Type;
407 TVal : aliased Timeval;
408 TPtr : Timeval_Access;
414 -- No timeout or Forever is indicated by a null timeval pointer
416 if Timeout = Forever then
419 TVal := To_Timeval (Timeout);
420 TPtr := TVal'Unchecked_Access;
423 -- Copy R_Socket_Set in RSet and add read signalling socket
425 RSet := (Set => New_Socket_Set (R_Socket_Set.Set),
426 Last => R_Socket_Set.Last);
429 -- Copy W_Socket_Set in WSet
431 WSet := (Set => New_Socket_Set (W_Socket_Set.Set),
432 Last => W_Socket_Set.Last);
434 -- Copy E_Socket_Set in ESet
436 ESet := (Set => New_Socket_Set (E_Socket_Set.Set),
437 Last => E_Socket_Set.Last);
439 Last := C.int'Max (C.int'Max (C.int (RSet.Last),
451 if Res = Failure then
452 Raise_Socket_Error (Socket_Errno);
455 -- If Select was resumed because of read signalling socket, read this
456 -- data and remove socket from set.
458 if Is_Set (RSet, RSig) then
461 Res := Signalling_Fds.Read (C.int (RSig));
463 if Res = Failure then
464 Raise_Socket_Error (Socket_Errno);
473 -- Update RSet, WSet and ESet in regard to their new socket sets
479 -- Reset RSet as it should be if R_Sig_Socket was not added
481 if Is_Empty (RSet) then
485 if Is_Empty (WSet) then
489 if Is_Empty (ESet) then
493 -- Deliver RSet, WSet and ESet
495 Empty (R_Socket_Set);
496 R_Socket_Set := RSet;
498 Empty (W_Socket_Set);
499 W_Socket_Set := WSet;
501 Empty (E_Socket_Set);
502 E_Socket_Set := ESet;
507 -- The local socket sets must be emptied before propagating
508 -- Socket_Error so the associated storage is freed.
522 (Item : in out Socket_Set_Type;
523 Socket : Socket_Type)
525 Last : aliased C.int := C.int (Item.Last);
527 if Item.Last /= No_Socket then
528 Remove_Socket_From_Set (Item.Set, C.int (Socket));
529 Last_Socket_In_Set (Item.Set, Last'Unchecked_Access);
530 Item.Last := Socket_Type (Last);
538 procedure Close_Selector (Selector : in out Selector_Type) is
540 -- Close the signalling file descriptors used internally for the
541 -- implementation of Abort_Selector.
543 Signalling_Fds.Close (C.int (Selector.R_Sig_Socket));
544 Signalling_Fds.Close (C.int (Selector.W_Sig_Socket));
546 -- Reset R_Sig_Socket and W_Sig_Socket to No_Socket to ensure that any
547 -- (errneous) subsequent attempt to use this selector properly fails.
549 Selector.R_Sig_Socket := No_Socket;
550 Selector.W_Sig_Socket := No_Socket;
557 procedure Close_Socket (Socket : Socket_Type) is
561 Res := C_Close (C.int (Socket));
563 if Res = Failure then
564 Raise_Socket_Error (Socket_Errno);
572 procedure Connect_Socket
573 (Socket : Socket_Type;
574 Server : in out Sock_Addr_Type)
577 Sin : aliased Sockaddr_In;
578 Len : constant C.int := Sin'Size / 8;
581 if Server.Family = Family_Inet6 then
585 Set_Length (Sin'Unchecked_Access, Len);
586 Set_Family (Sin'Unchecked_Access, Families (Server.Family));
587 Set_Address (Sin'Unchecked_Access, To_In_Addr (Server.Addr));
589 (Sin'Unchecked_Access,
590 Short_To_Network (C.unsigned_short (Server.Port)));
592 Res := C_Connect (C.int (Socket), Sin'Address, Len);
594 if Res = Failure then
595 Raise_Socket_Error (Socket_Errno);
603 procedure Control_Socket
604 (Socket : Socket_Type;
605 Request : in out Request_Type)
612 when Non_Blocking_IO =>
613 Arg := C.int (Boolean'Pos (Request.Enabled));
615 when N_Bytes_To_Read =>
621 Requests (Request.Name),
622 Arg'Unchecked_Access);
624 if Res = Failure then
625 Raise_Socket_Error (Socket_Errno);
629 when Non_Blocking_IO =>
632 when N_Bytes_To_Read =>
633 Request.Size := Natural (Arg);
642 (Source : Socket_Set_Type;
643 Target : in out Socket_Set_Type)
647 if Source.Last /= No_Socket then
648 Target.Set := New_Socket_Set (Source.Set);
649 Target.Last := Source.Last;
653 ---------------------
654 -- Create_Selector --
655 ---------------------
657 procedure Create_Selector (Selector : out Selector_Type) is
658 Two_Fds : aliased Fd_Pair;
662 -- We open two signalling file descriptors. One of them is used to send
663 -- data to the other, which is included in a C_Select socket set. The
664 -- communication is used to force a call to C_Select to complete, and
665 -- the waiting task to resume its execution.
667 Res := Signalling_Fds.Create (Two_Fds'Access);
669 if Res = Failure then
670 Raise_Socket_Error (Socket_Errno);
673 Selector.R_Sig_Socket := Socket_Type (Two_Fds (Read_End));
674 Selector.W_Sig_Socket := Socket_Type (Two_Fds (Write_End));
681 procedure Create_Socket
682 (Socket : out Socket_Type;
683 Family : Family_Type := Family_Inet;
684 Mode : Mode_Type := Socket_Stream)
689 Res := C_Socket (Families (Family), Modes (Mode), 0);
691 if Res = Failure then
692 Raise_Socket_Error (Socket_Errno);
695 Socket := Socket_Type (Res);
702 procedure Empty (Item : in out Socket_Set_Type) is
704 if Item.Set /= No_Socket_Set then
705 Free_Socket_Set (Item.Set);
706 Item.Set := No_Socket_Set;
709 Item.Last := No_Socket;
716 function Err_Code_Image (E : Integer) return String is
717 Msg : String := E'Img & "] ";
719 Msg (Msg'First) := '[';
727 procedure Finalize is
742 (Item : in out Socket_Set_Type;
743 Socket : out Socket_Type)
746 L : aliased C.int := C.int (Item.Last);
749 if Item.Last /= No_Socket then
751 (Item.Set, L'Unchecked_Access, S'Unchecked_Access);
752 Item.Last := Socket_Type (L);
753 Socket := Socket_Type (S);
763 function Get_Address (Stream : Stream_Access) return Sock_Addr_Type is
765 if Stream = null then
767 elsif Stream.all in Datagram_Socket_Stream_Type then
768 return Datagram_Socket_Stream_Type (Stream.all).From;
770 return Get_Peer_Name (Stream_Socket_Stream_Type (Stream.all).Socket);
774 -------------------------
775 -- Get_Host_By_Address --
776 -------------------------
778 function Get_Host_By_Address
779 (Address : Inet_Addr_Type;
780 Family : Family_Type := Family_Inet) return Host_Entry_Type
782 pragma Unreferenced (Family);
784 HA : aliased In_Addr := To_In_Addr (Address);
785 Buflen : constant C.int := Netdb_Buffer_Size;
786 Buf : aliased C.char_array (1 .. Netdb_Buffer_Size);
787 Res : aliased Hostent;
791 if Safe_Gethostbyaddr (HA'Address, HA'Size / 8, Constants.AF_INET,
792 Res'Access, Buf'Address, Buflen, Err'Access) /= 0
794 Raise_Host_Error (Integer (Err));
797 return To_Host_Entry (Res);
798 end Get_Host_By_Address;
800 ----------------------
801 -- Get_Host_By_Name --
802 ----------------------
804 function Get_Host_By_Name (Name : String) return Host_Entry_Type is
806 -- Detect IP address name and redirect to Inet_Addr
808 if Is_IP_Address (Name) then
809 return Get_Host_By_Address (Inet_Addr (Name));
813 HN : constant C.char_array := C.To_C (Name);
814 Buflen : constant C.int := Netdb_Buffer_Size;
815 Buf : aliased C.char_array (1 .. Netdb_Buffer_Size);
816 Res : aliased Hostent;
820 if Safe_Gethostbyname
821 (HN, Res'Access, Buf'Address, Buflen, Err'Access) /= 0
823 Raise_Host_Error (Integer (Err));
826 return To_Host_Entry (Res);
828 end Get_Host_By_Name;
834 function Get_Peer_Name (Socket : Socket_Type) return Sock_Addr_Type is
835 Sin : aliased Sockaddr_In;
836 Len : aliased C.int := Sin'Size / 8;
837 Res : Sock_Addr_Type (Family_Inet);
840 if C_Getpeername (C.int (Socket), Sin'Address, Len'Access) = Failure then
841 Raise_Socket_Error (Socket_Errno);
844 To_Inet_Addr (Sin.Sin_Addr, Res.Addr);
845 Res.Port := Port_Type (Network_To_Short (Sin.Sin_Port));
850 -------------------------
851 -- Get_Service_By_Name --
852 -------------------------
854 function Get_Service_By_Name
856 Protocol : String) return Service_Entry_Type
858 SN : constant C.char_array := C.To_C (Name);
859 SP : constant C.char_array := C.To_C (Protocol);
860 Buflen : constant C.int := Netdb_Buffer_Size;
861 Buf : aliased C.char_array (1 .. Netdb_Buffer_Size);
862 Res : aliased Servent;
865 if Safe_Getservbyname (SN, SP, Res'Access, Buf'Address, Buflen) /= 0 then
866 Ada.Exceptions.Raise_Exception
867 (Service_Error'Identity, "Service not found");
870 -- Translate from the C format to the API format
872 return To_Service_Entry (Res);
873 end Get_Service_By_Name;
875 -------------------------
876 -- Get_Service_By_Port --
877 -------------------------
879 function Get_Service_By_Port
881 Protocol : String) return Service_Entry_Type
883 SP : constant C.char_array := C.To_C (Protocol);
884 Buflen : constant C.int := Netdb_Buffer_Size;
885 Buf : aliased C.char_array (1 .. Netdb_Buffer_Size);
886 Res : aliased Servent;
889 if Safe_Getservbyport
890 (C.int (Short_To_Network (C.unsigned_short (Port))), SP,
891 Res'Access, Buf'Address, Buflen) /= 0
893 Ada.Exceptions.Raise_Exception
894 (Service_Error'Identity, "Service not found");
897 -- Translate from the C format to the API format
899 return To_Service_Entry (Res);
900 end Get_Service_By_Port;
902 ---------------------
903 -- Get_Socket_Name --
904 ---------------------
906 function Get_Socket_Name
907 (Socket : Socket_Type) return Sock_Addr_Type
909 Sin : aliased Sockaddr_In;
910 Len : aliased C.int := Sin'Size / 8;
912 Addr : Sock_Addr_Type := No_Sock_Addr;
915 Res := C_Getsockname (C.int (Socket), Sin'Address, Len'Access);
917 if Res /= Failure then
918 To_Inet_Addr (Sin.Sin_Addr, Addr.Addr);
919 Addr.Port := Port_Type (Network_To_Short (Sin.Sin_Port));
925 -----------------------
926 -- Get_Socket_Option --
927 -----------------------
929 function Get_Socket_Option
930 (Socket : Socket_Type;
931 Level : Level_Type := Socket_Level;
932 Name : Option_Name) return Option_Type
934 use type C.unsigned_char;
936 V8 : aliased Two_Ints;
938 V1 : aliased C.unsigned_char;
939 VT : aliased Timeval;
941 Add : System.Address;
943 Opt : Option_Type (Name);
947 when Multicast_Loop |
981 Add, Len'Unchecked_Access);
983 if Res = Failure then
984 Raise_Socket_Error (Socket_Errno);
992 Opt.Enabled := (V4 /= 0);
995 Opt.Enabled := (V8 (V8'First) /= 0);
996 Opt.Seconds := Natural (V8 (V8'Last));
1000 Opt.Size := Natural (V4);
1003 Opt.Error := Resolve_Error (Integer (V4));
1005 when Add_Membership |
1007 To_Inet_Addr (To_In_Addr (V8 (V8'First)), Opt.Multicast_Address);
1008 To_Inet_Addr (To_In_Addr (V8 (V8'Last)), Opt.Local_Interface);
1010 when Multicast_If =>
1011 To_Inet_Addr (To_In_Addr (V4), Opt.Outgoing_If);
1013 when Multicast_TTL =>
1014 Opt.Time_To_Live := Integer (V1);
1016 when Multicast_Loop =>
1017 Opt.Enabled := (V1 /= 0);
1021 Opt.Timeout := To_Duration (VT);
1025 end Get_Socket_Option;
1031 function Host_Name return String is
1032 Name : aliased C.char_array (1 .. 64);
1036 Res := C_Gethostname (Name'Address, Name'Length);
1038 if Res = Failure then
1039 Raise_Socket_Error (Socket_Errno);
1042 return C.To_Ada (Name);
1050 (Val : Inet_Addr_VN_Type;
1051 Hex : Boolean := False) return String
1053 -- The largest Inet_Addr_Comp_Type image occurs with IPv4. It
1054 -- has at most a length of 3 plus one '.' character.
1056 Buffer : String (1 .. 4 * Val'Length);
1057 Length : Natural := 1;
1058 Separator : Character;
1060 procedure Img10 (V : Inet_Addr_Comp_Type);
1061 -- Append to Buffer image of V in decimal format
1063 procedure Img16 (V : Inet_Addr_Comp_Type);
1064 -- Append to Buffer image of V in hexadecimal format
1070 procedure Img10 (V : Inet_Addr_Comp_Type) is
1071 Img : constant String := V'Img;
1072 Len : constant Natural := Img'Length - 1;
1074 Buffer (Length .. Length + Len - 1) := Img (2 .. Img'Last);
1075 Length := Length + Len;
1082 procedure Img16 (V : Inet_Addr_Comp_Type) is
1084 Buffer (Length) := Hex_To_Char (Natural (V / 16) + 1);
1085 Buffer (Length + 1) := Hex_To_Char (Natural (V mod 16) + 1);
1086 Length := Length + 2;
1089 -- Start of processing for Image
1098 for J in Val'Range loop
1105 if J /= Val'Last then
1106 Buffer (Length) := Separator;
1107 Length := Length + 1;
1111 return Buffer (1 .. Length - 1);
1118 function Image (Value : Inet_Addr_Type) return String is
1120 if Value.Family = Family_Inet then
1121 return Image (Inet_Addr_VN_Type (Value.Sin_V4), Hex => False);
1123 return Image (Inet_Addr_VN_Type (Value.Sin_V6), Hex => True);
1131 function Image (Value : Sock_Addr_Type) return String is
1132 Port : constant String := Value.Port'Img;
1134 return Image (Value.Addr) & ':' & Port (2 .. Port'Last);
1141 function Image (Socket : Socket_Type) return String is
1150 function Inet_Addr (Image : String) return Inet_Addr_Type is
1151 use Interfaces.C.Strings;
1155 Result : Inet_Addr_Type;
1158 -- Special case for the all-ones broadcast address: this address has the
1159 -- same in_addr_t value as Failure, and thus cannot be properly returned
1162 if Image = "255.255.255.255" then
1163 return Broadcast_Inet_Addr;
1165 -- Special case for an empty Image as on some platforms (e.g. Windows)
1166 -- calling Inet_Addr("") will not return an error.
1168 elsif Image = "" then
1169 Raise_Socket_Error (Constants.EINVAL);
1172 Img := New_String (Image);
1173 Res := C_Inet_Addr (Img);
1176 if Res = Failure then
1177 Raise_Socket_Error (Constants.EINVAL);
1180 To_Inet_Addr (To_In_Addr (Res), Result);
1188 procedure Initialize (Process_Blocking_IO : Boolean) is
1189 Expected : constant Boolean := not Constants.Thread_Blocking_IO;
1191 if Process_Blocking_IO /= Expected then
1192 raise Socket_Error with
1193 "incorrect Process_Blocking_IO setting, expected " & Expected'Img;
1203 procedure Initialize is
1205 if not Initialized then
1206 Initialized := True;
1215 function Is_Empty (Item : Socket_Set_Type) return Boolean is
1217 return Item.Last = No_Socket;
1224 function Is_IP_Address (Name : String) return Boolean is
1226 for J in Name'Range loop
1228 and then Name (J) not in '0' .. '9'
1242 (Item : Socket_Set_Type;
1243 Socket : Socket_Type) return Boolean
1246 return Item.Last /= No_Socket
1247 and then Socket <= Item.Last
1248 and then Is_Socket_In_Set (Item.Set, C.int (Socket)) /= 0;
1255 procedure Listen_Socket
1256 (Socket : Socket_Type;
1257 Length : Positive := 15)
1259 Res : constant C.int := C_Listen (C.int (Socket), C.int (Length));
1261 if Res = Failure then
1262 Raise_Socket_Error (Socket_Errno);
1270 procedure Narrow (Item : in out Socket_Set_Type) is
1271 Last : aliased C.int := C.int (Item.Last);
1273 if Item.Set /= No_Socket_Set then
1274 Last_Socket_In_Set (Item.Set, Last'Unchecked_Access);
1275 Item.Last := Socket_Type (Last);
1283 function Official_Name (E : Host_Entry_Type) return String is
1285 return To_String (E.Official);
1292 function Official_Name (S : Service_Entry_Type) return String is
1294 return To_String (S.Official);
1301 function Port_Number (S : Service_Entry_Type) return Port_Type is
1310 function Protocol_Name (S : Service_Entry_Type) return String is
1312 return To_String (S.Protocol);
1315 ----------------------
1316 -- Raise_Host_Error --
1317 ----------------------
1319 procedure Raise_Host_Error (H_Error : Integer) is
1321 Ada.Exceptions.Raise_Exception (Host_Error'Identity,
1322 Err_Code_Image (H_Error)
1323 & C.Strings.Value (Host_Error_Messages.Host_Error_Message (H_Error)));
1324 end Raise_Host_Error;
1326 ------------------------
1327 -- Raise_Socket_Error --
1328 ------------------------
1330 procedure Raise_Socket_Error (Error : Integer) is
1331 use type C.Strings.chars_ptr;
1333 Ada.Exceptions.Raise_Exception (Socket_Error'Identity,
1334 Err_Code_Image (Error)
1335 & C.Strings.Value (Socket_Error_Message (Error)));
1336 end Raise_Socket_Error;
1343 (Stream : in out Datagram_Socket_Stream_Type;
1344 Item : out Ada.Streams.Stream_Element_Array;
1345 Last : out Ada.Streams.Stream_Element_Offset)
1347 First : Ada.Streams.Stream_Element_Offset := Item'First;
1348 Index : Ada.Streams.Stream_Element_Offset := First - 1;
1349 Max : constant Ada.Streams.Stream_Element_Offset := Item'Last;
1355 Item (First .. Max),
1361 -- Exit when all or zero data received. Zero means that the socket
1364 exit when Index < First or else Index = Max;
1375 (Stream : in out Stream_Socket_Stream_Type;
1376 Item : out Ada.Streams.Stream_Element_Array;
1377 Last : out Ada.Streams.Stream_Element_Offset)
1379 First : Ada.Streams.Stream_Element_Offset := Item'First;
1380 Index : Ada.Streams.Stream_Element_Offset := First - 1;
1381 Max : constant Ada.Streams.Stream_Element_Offset := Item'Last;
1385 Receive_Socket (Stream.Socket, Item (First .. Max), Index);
1388 -- Exit when all or zero data received. Zero means that the socket
1391 exit when Index < First or else Index = Max;
1397 --------------------
1398 -- Receive_Socket --
1399 --------------------
1401 procedure Receive_Socket
1402 (Socket : Socket_Type;
1403 Item : out Ada.Streams.Stream_Element_Array;
1404 Last : out Ada.Streams.Stream_Element_Offset;
1405 Flags : Request_Flag_Type := No_Request_Flag)
1407 use type Ada.Streams.Stream_Element_Offset;
1413 C_Recv (C.int (Socket), Item'Address, Item'Length, To_Int (Flags));
1415 if Res = Failure then
1416 Raise_Socket_Error (Socket_Errno);
1419 Last := Item'First + Ada.Streams.Stream_Element_Offset (Res - 1);
1422 --------------------
1423 -- Receive_Socket --
1424 --------------------
1426 procedure Receive_Socket
1427 (Socket : Socket_Type;
1428 Item : out Ada.Streams.Stream_Element_Array;
1429 Last : out Ada.Streams.Stream_Element_Offset;
1430 From : out Sock_Addr_Type;
1431 Flags : Request_Flag_Type := No_Request_Flag)
1433 use type Ada.Streams.Stream_Element_Offset;
1436 Sin : aliased Sockaddr_In;
1437 Len : aliased C.int := Sin'Size / 8;
1446 Sin'Unchecked_Access,
1447 Len'Unchecked_Access);
1449 if Res = Failure then
1450 Raise_Socket_Error (Socket_Errno);
1453 Last := Item'First + Ada.Streams.Stream_Element_Offset (Res - 1);
1455 To_Inet_Addr (Sin.Sin_Addr, From.Addr);
1456 From.Port := Port_Type (Network_To_Short (Sin.Sin_Port));
1463 function Resolve_Error
1464 (Error_Value : Integer;
1465 From_Errno : Boolean := True) return Error_Type
1467 use GNAT.Sockets.Constants;
1470 if not From_Errno then
1472 when Constants.HOST_NOT_FOUND => return Unknown_Host;
1473 when Constants.TRY_AGAIN => return Host_Name_Lookup_Failure;
1474 when Constants.NO_RECOVERY => return Non_Recoverable_Error;
1475 when Constants.NO_DATA => return Unknown_Server_Error;
1476 when others => return Cannot_Resolve_Error;
1481 when ENOERROR => return Success;
1482 when EACCES => return Permission_Denied;
1483 when EADDRINUSE => return Address_Already_In_Use;
1484 when EADDRNOTAVAIL => return Cannot_Assign_Requested_Address;
1485 when EAFNOSUPPORT => return
1486 Address_Family_Not_Supported_By_Protocol;
1487 when EALREADY => return Operation_Already_In_Progress;
1488 when EBADF => return Bad_File_Descriptor;
1489 when ECONNABORTED => return Software_Caused_Connection_Abort;
1490 when ECONNREFUSED => return Connection_Refused;
1491 when ECONNRESET => return Connection_Reset_By_Peer;
1492 when EDESTADDRREQ => return Destination_Address_Required;
1493 when EFAULT => return Bad_Address;
1494 when EHOSTDOWN => return Host_Is_Down;
1495 when EHOSTUNREACH => return No_Route_To_Host;
1496 when EINPROGRESS => return Operation_Now_In_Progress;
1497 when EINTR => return Interrupted_System_Call;
1498 when EINVAL => return Invalid_Argument;
1499 when EIO => return Input_Output_Error;
1500 when EISCONN => return Transport_Endpoint_Already_Connected;
1501 when ELOOP => return Too_Many_Symbolic_Links;
1502 when EMFILE => return Too_Many_Open_Files;
1503 when EMSGSIZE => return Message_Too_Long;
1504 when ENAMETOOLONG => return File_Name_Too_Long;
1505 when ENETDOWN => return Network_Is_Down;
1506 when ENETRESET => return
1507 Network_Dropped_Connection_Because_Of_Reset;
1508 when ENETUNREACH => return Network_Is_Unreachable;
1509 when ENOBUFS => return No_Buffer_Space_Available;
1510 when ENOPROTOOPT => return Protocol_Not_Available;
1511 when ENOTCONN => return Transport_Endpoint_Not_Connected;
1512 when ENOTSOCK => return Socket_Operation_On_Non_Socket;
1513 when EOPNOTSUPP => return Operation_Not_Supported;
1514 when EPFNOSUPPORT => return Protocol_Family_Not_Supported;
1515 when EPROTONOSUPPORT => return Protocol_Not_Supported;
1516 when EPROTOTYPE => return Protocol_Wrong_Type_For_Socket;
1517 when ESHUTDOWN => return
1518 Cannot_Send_After_Transport_Endpoint_Shutdown;
1519 when ESOCKTNOSUPPORT => return Socket_Type_Not_Supported;
1520 when ETIMEDOUT => return Connection_Timed_Out;
1521 when ETOOMANYREFS => return Too_Many_References;
1522 when EWOULDBLOCK => return Resource_Temporarily_Unavailable;
1523 when others => null;
1526 return Cannot_Resolve_Error;
1529 -----------------------
1530 -- Resolve_Exception --
1531 -----------------------
1533 function Resolve_Exception
1534 (Occurrence : Exception_Occurrence) return Error_Type
1536 Id : constant Exception_Id := Exception_Identity (Occurrence);
1537 Msg : constant String := Exception_Message (Occurrence);
1544 while First <= Msg'Last
1545 and then Msg (First) not in '0' .. '9'
1550 if First > Msg'Last then
1551 return Cannot_Resolve_Error;
1555 while Last < Msg'Last
1556 and then Msg (Last + 1) in '0' .. '9'
1561 Val := Integer'Value (Msg (First .. Last));
1563 if Id = Socket_Error_Id then
1564 return Resolve_Error (Val);
1565 elsif Id = Host_Error_Id then
1566 return Resolve_Error (Val, False);
1568 return Cannot_Resolve_Error;
1570 end Resolve_Exception;
1572 --------------------
1573 -- Receive_Vector --
1574 --------------------
1576 procedure Receive_Vector
1577 (Socket : Socket_Type;
1578 Vector : Vector_Type;
1579 Count : out Ada.Streams.Stream_Element_Count)
1590 if Res = Failure then
1591 Raise_Socket_Error (Socket_Errno);
1594 Count := Ada.Streams.Stream_Element_Count (Res);
1601 procedure Send_Socket
1602 (Socket : Socket_Type;
1603 Item : Ada.Streams.Stream_Element_Array;
1604 Last : out Ada.Streams.Stream_Element_Offset;
1605 Flags : Request_Flag_Type := No_Request_Flag)
1607 use type Ada.Streams.Stream_Element_Offset;
1617 Set_Forced_Flags (To_Int (Flags)));
1619 if Res = Failure then
1620 Raise_Socket_Error (Socket_Errno);
1623 Last := Item'First + Ada.Streams.Stream_Element_Offset (Res - 1);
1630 procedure Send_Socket
1631 (Socket : Socket_Type;
1632 Item : Ada.Streams.Stream_Element_Array;
1633 Last : out Ada.Streams.Stream_Element_Offset;
1634 To : Sock_Addr_Type;
1635 Flags : Request_Flag_Type := No_Request_Flag)
1637 use type Ada.Streams.Stream_Element_Offset;
1640 Sin : aliased Sockaddr_In;
1641 Len : constant C.int := Sin'Size / 8;
1644 Set_Length (Sin'Unchecked_Access, Len);
1645 Set_Family (Sin'Unchecked_Access, Families (To.Family));
1646 Set_Address (Sin'Unchecked_Access, To_In_Addr (To.Addr));
1648 (Sin'Unchecked_Access,
1649 Short_To_Network (C.unsigned_short (To.Port)));
1655 Set_Forced_Flags (To_Int (Flags)),
1656 Sin'Unchecked_Access,
1659 if Res = Failure then
1660 Raise_Socket_Error (Socket_Errno);
1663 Last := Item'First + Ada.Streams.Stream_Element_Offset (Res - 1);
1670 procedure Send_Vector
1671 (Socket : Socket_Type;
1672 Vector : Vector_Type;
1673 Count : out Ada.Streams.Stream_Element_Count)
1677 This_Iov_Count : C.int;
1682 while Iov_Count < Vector'Length loop
1684 pragma Warnings (Off);
1685 -- Following test may be compile time known on some targets
1687 if Vector'Length - Iov_Count > Constants.IOV_MAX then
1688 This_Iov_Count := Constants.IOV_MAX;
1690 This_Iov_Count := Vector'Length - Iov_Count;
1693 pragma Warnings (On);
1698 Vector (Vector'First + Integer (Iov_Count))'Address,
1701 if Res = Failure then
1702 Raise_Socket_Error (Socket_Errno);
1705 Count := Count + Ada.Streams.Stream_Element_Count (Res);
1706 Iov_Count := Iov_Count + This_Iov_Count;
1714 procedure Set (Item : in out Socket_Set_Type; Socket : Socket_Type) is
1716 if Item.Set = No_Socket_Set then
1717 Item.Set := New_Socket_Set (No_Socket_Set);
1718 Item.Last := Socket;
1720 elsif Item.Last < Socket then
1721 Item.Last := Socket;
1724 Insert_Socket_In_Set (Item.Set, C.int (Socket));
1727 ----------------------
1728 -- Set_Forced_Flags --
1729 ----------------------
1731 function Set_Forced_Flags (F : C.int) return C.int is
1732 use type C.unsigned;
1733 function To_unsigned is
1734 new Ada.Unchecked_Conversion (C.int, C.unsigned);
1736 new Ada.Unchecked_Conversion (C.unsigned, C.int);
1738 return To_int (To_unsigned (F) or Constants.MSG_Forced_Flags);
1739 end Set_Forced_Flags;
1741 -----------------------
1742 -- Set_Socket_Option --
1743 -----------------------
1745 procedure Set_Socket_Option
1746 (Socket : Socket_Type;
1747 Level : Level_Type := Socket_Level;
1748 Option : Option_Type)
1750 V8 : aliased Two_Ints;
1752 V1 : aliased C.unsigned_char;
1753 VT : aliased Timeval;
1755 Add : System.Address := Null_Address;
1764 V4 := C.int (Boolean'Pos (Option.Enabled));
1769 V8 (V8'First) := C.int (Boolean'Pos (Option.Enabled));
1770 V8 (V8'Last) := C.int (Option.Seconds);
1776 V4 := C.int (Option.Size);
1781 V4 := C.int (Boolean'Pos (True));
1785 when Add_Membership |
1787 V8 (V8'First) := To_Int (To_In_Addr (Option.Multicast_Address));
1788 V8 (V8'Last) := To_Int (To_In_Addr (Option.Local_Interface));
1792 when Multicast_If =>
1793 V4 := To_Int (To_In_Addr (Option.Outgoing_If));
1797 when Multicast_TTL =>
1798 V1 := C.unsigned_char (Option.Time_To_Live);
1802 when Multicast_Loop =>
1803 V1 := C.unsigned_char (Boolean'Pos (Option.Enabled));
1809 VT := To_Timeval (Option.Timeout);
1818 Options (Option.Name),
1821 if Res = Failure then
1822 Raise_Socket_Error (Socket_Errno);
1824 end Set_Socket_Option;
1826 ----------------------
1827 -- Short_To_Network --
1828 ----------------------
1830 function Short_To_Network (S : C.unsigned_short) return C.unsigned_short is
1831 use type C.unsigned_short;
1834 -- Big-endian case. No conversion needed. On these platforms,
1835 -- htons() defaults to a null procedure.
1837 pragma Warnings (Off);
1838 -- Since the test can generate "always True/False" warning
1840 if Default_Bit_Order = High_Order_First then
1843 pragma Warnings (On);
1845 -- Little-endian case. We must swap the high and low bytes of this
1846 -- short to make the port number network compliant.
1849 return (S / 256) + (S mod 256) * 256;
1851 end Short_To_Network;
1853 ---------------------
1854 -- Shutdown_Socket --
1855 ---------------------
1857 procedure Shutdown_Socket
1858 (Socket : Socket_Type;
1859 How : Shutmode_Type := Shut_Read_Write)
1864 Res := C_Shutdown (C.int (Socket), Shutmodes (How));
1866 if Res = Failure then
1867 Raise_Socket_Error (Socket_Errno);
1869 end Shutdown_Socket;
1876 (Socket : Socket_Type;
1877 Send_To : Sock_Addr_Type) return Stream_Access
1879 S : Datagram_Socket_Stream_Access;
1882 S := new Datagram_Socket_Stream_Type;
1885 S.From := Get_Socket_Name (Socket);
1886 return Stream_Access (S);
1893 function Stream (Socket : Socket_Type) return Stream_Access is
1894 S : Stream_Socket_Stream_Access;
1896 S := new Stream_Socket_Stream_Type;
1898 return Stream_Access (S);
1905 function To_C (Socket : Socket_Type) return Integer is
1907 return Integer (Socket);
1914 function To_Duration (Val : Timeval) return Timeval_Duration is
1916 return Natural (Val.Tv_Sec) * 1.0 + Natural (Val.Tv_Usec) * 1.0E-6;
1923 function To_Host_Entry (E : Hostent) return Host_Entry_Type is
1926 Official : constant String :=
1927 C.Strings.Value (E.H_Name);
1929 Aliases : constant Chars_Ptr_Array :=
1930 Chars_Ptr_Pointers.Value (E.H_Aliases);
1931 -- H_Aliases points to a list of name aliases. The list is terminated by
1934 Addresses : constant In_Addr_Access_Array :=
1935 In_Addr_Access_Pointers.Value (E.H_Addr_List);
1936 -- H_Addr_List points to a list of binary addresses (in network byte
1937 -- order). The list is terminated by a NULL pointer.
1939 -- H_Length is not used because it is currently only set to 4.
1940 -- H_Addrtype is always AF_INET
1942 Result : Host_Entry_Type
1943 (Aliases_Length => Aliases'Length - 1,
1944 Addresses_Length => Addresses'Length - 1);
1945 -- The last element is a null pointer
1951 Result.Official := To_Name (Official);
1953 Source := Aliases'First;
1954 Target := Result.Aliases'First;
1955 while Target <= Result.Aliases_Length loop
1956 Result.Aliases (Target) :=
1957 To_Name (C.Strings.Value (Aliases (Source)));
1958 Source := Source + 1;
1959 Target := Target + 1;
1962 Source := Addresses'First;
1963 Target := Result.Addresses'First;
1964 while Target <= Result.Addresses_Length loop
1965 To_Inet_Addr (Addresses (Source).all, Result.Addresses (Target));
1966 Source := Source + 1;
1967 Target := Target + 1;
1977 function To_In_Addr (Addr : Inet_Addr_Type) return Thin.In_Addr is
1979 if Addr.Family = Family_Inet then
1980 return (S_B1 => C.unsigned_char (Addr.Sin_V4 (1)),
1981 S_B2 => C.unsigned_char (Addr.Sin_V4 (2)),
1982 S_B3 => C.unsigned_char (Addr.Sin_V4 (3)),
1983 S_B4 => C.unsigned_char (Addr.Sin_V4 (4)));
1993 procedure To_Inet_Addr
1995 Result : out Inet_Addr_Type) is
1997 Result.Sin_V4 (1) := Inet_Addr_Comp_Type (Addr.S_B1);
1998 Result.Sin_V4 (2) := Inet_Addr_Comp_Type (Addr.S_B2);
1999 Result.Sin_V4 (3) := Inet_Addr_Comp_Type (Addr.S_B3);
2000 Result.Sin_V4 (4) := Inet_Addr_Comp_Type (Addr.S_B4);
2007 function To_Int (F : Request_Flag_Type) return C.int
2009 Current : Request_Flag_Type := F;
2010 Result : C.int := 0;
2013 for J in Flags'Range loop
2014 exit when Current = 0;
2016 if Current mod 2 /= 0 then
2017 if Flags (J) = -1 then
2018 Raise_Socket_Error (Constants.EOPNOTSUPP);
2021 Result := Result + Flags (J);
2024 Current := Current / 2;
2034 function To_Name (N : String) return Name_Type is
2036 return Name_Type'(N'Length, N);
2039 ----------------------
2040 -- To_Service_Entry --
2041 ----------------------
2043 function To_Service_Entry (E : Servent) return Service_Entry_Type is
2046 Official : constant String := C.Strings.Value (E.S_Name);
2048 Aliases : constant Chars_Ptr_Array :=
2049 Chars_Ptr_Pointers.Value (E.S_Aliases);
2050 -- S_Aliases points to a list of name aliases. The list is
2051 -- terminated by a NULL pointer.
2053 Protocol : constant String := C.Strings.Value (E.S_Proto);
2055 Result : Service_Entry_Type (Aliases_Length => Aliases'Length - 1);
2056 -- The last element is a null pointer
2062 Result.Official := To_Name (Official);
2064 Source := Aliases'First;
2065 Target := Result.Aliases'First;
2066 while Target <= Result.Aliases_Length loop
2067 Result.Aliases (Target) :=
2068 To_Name (C.Strings.Value (Aliases (Source)));
2069 Source := Source + 1;
2070 Target := Target + 1;
2074 Port_Type (Network_To_Short (C.unsigned_short (E.S_Port)));
2076 Result.Protocol := To_Name (Protocol);
2078 end To_Service_Entry;
2084 function To_String (HN : Name_Type) return String is
2086 return HN.Name (1 .. HN.Length);
2093 function To_Timeval (Val : Timeval_Duration) return Timeval is
2098 -- If zero, set result as zero (otherwise it gets rounded down to -1)
2104 -- Normal case where we do round down
2107 S := time_t (Val - 0.5);
2108 uS := suseconds_t (1_000_000 * (Val - Selector_Duration (S)));
2119 (Stream : in out Datagram_Socket_Stream_Type;
2120 Item : Ada.Streams.Stream_Element_Array)
2122 First : Ada.Streams.Stream_Element_Offset := Item'First;
2123 Index : Ada.Streams.Stream_Element_Offset := First - 1;
2124 Max : constant Ada.Streams.Stream_Element_Offset := Item'Last;
2130 Item (First .. Max),
2134 -- Exit when all or zero data sent. Zero means that the socket has
2135 -- been closed by peer.
2137 exit when Index < First or else Index = Max;
2142 if Index /= Max then
2152 (Stream : in out Stream_Socket_Stream_Type;
2153 Item : Ada.Streams.Stream_Element_Array)
2155 First : Ada.Streams.Stream_Element_Offset := Item'First;
2156 Index : Ada.Streams.Stream_Element_Offset := First - 1;
2157 Max : constant Ada.Streams.Stream_Element_Offset := Item'Last;
2161 Send_Socket (Stream.Socket, Item (First .. Max), Index);
2163 -- Exit when all or zero data sent. Zero means that the socket has
2164 -- been closed by peer.
2166 exit when Index < First or else Index = Max;
2171 if Index /= Max then