1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
5 -- G N A T . S O C K E T S --
9 -- Copyright (C) 2001-2004 Ada Core Technologies, Inc. --
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, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, 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;
40 with GNAT.OS_Lib; use GNAT.OS_Lib;
41 with GNAT.Sockets.Constants;
42 with GNAT.Sockets.Thin; use GNAT.Sockets.Thin;
45 with GNAT.Sockets.Linker_Options;
46 pragma Warnings (Off, GNAT.Sockets.Linker_Options);
47 -- Need to include pragma Linker_Options which is platform dependent
49 with System; use System;
51 package body GNAT.Sockets is
53 use type C.int, System.Address;
55 Finalized : Boolean := False;
56 Initialized : Boolean := False;
58 ENOERROR : constant := 0;
60 -- Correspondance tables
62 Families : constant array (Family_Type) of C.int :=
63 (Family_Inet => Constants.AF_INET,
64 Family_Inet6 => Constants.AF_INET6);
66 Levels : constant array (Level_Type) of C.int :=
67 (Socket_Level => Constants.SOL_SOCKET,
68 IP_Protocol_For_IP_Level => Constants.IPPROTO_IP,
69 IP_Protocol_For_UDP_Level => Constants.IPPROTO_UDP,
70 IP_Protocol_For_TCP_Level => Constants.IPPROTO_TCP);
72 Modes : constant array (Mode_Type) of C.int :=
73 (Socket_Stream => Constants.SOCK_STREAM,
74 Socket_Datagram => Constants.SOCK_DGRAM);
76 Shutmodes : constant array (Shutmode_Type) of C.int :=
77 (Shut_Read => Constants.SHUT_RD,
78 Shut_Write => Constants.SHUT_WR,
79 Shut_Read_Write => Constants.SHUT_RDWR);
81 Requests : constant array (Request_Name) of C.int :=
82 (Non_Blocking_IO => Constants.FIONBIO,
83 N_Bytes_To_Read => Constants.FIONREAD);
85 Options : constant array (Option_Name) of C.int :=
86 (Keep_Alive => Constants.SO_KEEPALIVE,
87 Reuse_Address => Constants.SO_REUSEADDR,
88 Broadcast => Constants.SO_BROADCAST,
89 Send_Buffer => Constants.SO_SNDBUF,
90 Receive_Buffer => Constants.SO_RCVBUF,
91 Linger => Constants.SO_LINGER,
92 Error => Constants.SO_ERROR,
93 No_Delay => Constants.TCP_NODELAY,
94 Add_Membership => Constants.IP_ADD_MEMBERSHIP,
95 Drop_Membership => Constants.IP_DROP_MEMBERSHIP,
96 Multicast_TTL => Constants.IP_MULTICAST_TTL,
97 Multicast_Loop => Constants.IP_MULTICAST_LOOP);
99 Flags : constant array (0 .. 3) of C.int :=
100 (0 => Constants.MSG_OOB, -- Process_Out_Of_Band_Data
101 1 => Constants.MSG_PEEK, -- Peek_At_Incoming_Data
102 2 => Constants.MSG_WAITALL, -- Wait_For_A_Full_Reception
103 3 => Constants.MSG_EOR); -- Send_End_Of_Record
105 Socket_Error_Id : constant Exception_Id := Socket_Error'Identity;
106 Host_Error_Id : constant Exception_Id := Host_Error'Identity;
108 Hex_To_Char : constant String (1 .. 16) := "0123456789ABCDEF";
109 -- Use to print in hexadecimal format
111 function To_In_Addr is new Ada.Unchecked_Conversion (C.int, In_Addr);
112 function To_Int is new Ada.Unchecked_Conversion (In_Addr, C.int);
114 -----------------------
115 -- Local subprograms --
116 -----------------------
118 function Resolve_Error
119 (Error_Value : Integer;
120 From_Errno : Boolean := True) return Error_Type;
121 -- Associate an enumeration value (error_type) to en error value
122 -- (errno). From_Errno prevents from mixing h_errno with errno.
124 function To_Name (N : String) return Name_Type;
125 function To_String (HN : Name_Type) return String;
126 -- Conversion functions
128 function To_Int (F : Request_Flag_Type) return C.int;
129 -- Return the int value corresponding to the specified flags combination
131 function Set_Forced_Flags (F : C.int) return C.int;
132 -- Return F with the bits from Constants.MSG_Forced_Flags forced set
134 function Short_To_Network
135 (S : C.unsigned_short) return C.unsigned_short;
136 pragma Inline (Short_To_Network);
137 -- Convert a port number into a network port number
139 function Network_To_Short
140 (S : C.unsigned_short) return C.unsigned_short
141 renames Short_To_Network;
142 -- Symetric operation
145 (Val : Inet_Addr_VN_Type;
146 Hex : Boolean := False) return String;
147 -- Output an array of inet address components either in
148 -- hexadecimal or in decimal mode.
150 function Is_IP_Address (Name : String) return Boolean;
151 -- Return true when Name is an IP address in standard dot notation.
153 function To_In_Addr (Addr : Inet_Addr_Type) return Thin.In_Addr;
154 function To_Inet_Addr (Addr : In_Addr) return Inet_Addr_Type;
155 -- Conversion functions
157 function To_Host_Entry (E : Hostent) return Host_Entry_Type;
158 -- Conversion function
160 function To_Service_Entry (E : Servent) return Service_Entry_Type;
161 -- Conversion function
163 function To_Timeval (Val : Selector_Duration) return Timeval;
164 -- Separate Val in seconds and microseconds
166 procedure Raise_Socket_Error (Error : Integer);
167 -- Raise Socket_Error with an exception message describing
170 procedure Raise_Host_Error (Error : Integer);
171 -- Raise Host_Error exception with message describing error code
172 -- (note hstrerror seems to be obsolete).
174 procedure Narrow (Item : in out Socket_Set_Type);
175 -- Update Last as it may be greater than the real last socket
177 -- Types needed for Datagram_Socket_Stream_Type
179 type Datagram_Socket_Stream_Type is new Root_Stream_Type with record
180 Socket : Socket_Type;
182 From : Sock_Addr_Type;
185 type Datagram_Socket_Stream_Access is
186 access all Datagram_Socket_Stream_Type;
189 (Stream : in out Datagram_Socket_Stream_Type;
190 Item : out Ada.Streams.Stream_Element_Array;
191 Last : out Ada.Streams.Stream_Element_Offset);
194 (Stream : in out Datagram_Socket_Stream_Type;
195 Item : Ada.Streams.Stream_Element_Array);
197 -- Types needed for Stream_Socket_Stream_Type
199 type Stream_Socket_Stream_Type is new Root_Stream_Type with record
200 Socket : Socket_Type;
203 type Stream_Socket_Stream_Access is
204 access all Stream_Socket_Stream_Type;
207 (Stream : in out Stream_Socket_Stream_Type;
208 Item : out Ada.Streams.Stream_Element_Array;
209 Last : out Ada.Streams.Stream_Element_Offset);
212 (Stream : in out Stream_Socket_Stream_Type;
213 Item : Ada.Streams.Stream_Element_Array);
219 function "+" (L, R : Request_Flag_Type) return Request_Flag_Type is
228 procedure Abort_Selector (Selector : Selector_Type) is
229 Buf : aliased Character := ASCII.NUL;
233 -- Send an empty array to unblock C select system call
235 Res := C_Send (C.int (Selector.W_Sig_Socket), Buf'Address, 1,
236 Constants.MSG_Forced_Flags);
237 if Res = Failure then
238 Raise_Socket_Error (Socket_Errno);
246 procedure Accept_Socket
247 (Server : Socket_Type;
248 Socket : out Socket_Type;
249 Address : out Sock_Addr_Type)
252 Sin : aliased Sockaddr_In;
253 Len : aliased C.int := Sin'Size / 8;
256 Res := C_Accept (C.int (Server), Sin'Address, Len'Access);
258 if Res = Failure then
259 Raise_Socket_Error (Socket_Errno);
262 Socket := Socket_Type (Res);
264 Address.Addr := To_Inet_Addr (Sin.Sin_Addr);
265 Address.Port := Port_Type (Network_To_Short (Sin.Sin_Port));
273 (E : Host_Entry_Type;
274 N : Positive := 1) return Inet_Addr_Type
277 return E.Addresses (N);
280 ----------------------
281 -- Addresses_Length --
282 ----------------------
284 function Addresses_Length (E : Host_Entry_Type) return Natural is
286 return E.Addresses_Length;
287 end Addresses_Length;
294 (E : Host_Entry_Type;
295 N : Positive := 1) return String
298 return To_String (E.Aliases (N));
306 (S : Service_Entry_Type;
307 N : Positive := 1) return String
310 return To_String (S.Aliases (N));
317 function Aliases_Length (E : Host_Entry_Type) return Natural is
319 return E.Aliases_Length;
326 function Aliases_Length (S : Service_Entry_Type) return Natural is
328 return S.Aliases_Length;
335 procedure Bind_Socket
336 (Socket : Socket_Type;
337 Address : Sock_Addr_Type)
340 Sin : aliased Sockaddr_In;
341 Len : constant C.int := Sin'Size / 8;
344 if Address.Family = Family_Inet6 then
348 Set_Length (Sin'Unchecked_Access, Len);
349 Set_Family (Sin'Unchecked_Access, Families (Address.Family));
351 (Sin'Unchecked_Access,
352 Short_To_Network (C.unsigned_short (Address.Port)));
354 Res := C_Bind (C.int (Socket), Sin'Address, Len);
356 if Res = Failure then
357 Raise_Socket_Error (Socket_Errno);
365 procedure Check_Selector
366 (Selector : in out Selector_Type;
367 R_Socket_Set : in out Socket_Set_Type;
368 W_Socket_Set : in out Socket_Set_Type;
369 Status : out Selector_Status;
370 Timeout : Selector_Duration := Forever)
372 E_Socket_Set : Socket_Set_Type; -- (No_Socket, No_Socket_Set)
375 (Selector, R_Socket_Set, W_Socket_Set, E_Socket_Set, Status, Timeout);
378 procedure Check_Selector
379 (Selector : in out Selector_Type;
380 R_Socket_Set : in out Socket_Set_Type;
381 W_Socket_Set : in out Socket_Set_Type;
382 E_Socket_Set : in out Socket_Set_Type;
383 Status : out Selector_Status;
384 Timeout : Selector_Duration := Forever)
388 RSet : Socket_Set_Type;
389 WSet : Socket_Set_Type;
390 ESet : Socket_Set_Type;
391 TVal : aliased Timeval;
392 TPtr : Timeval_Access;
397 -- No timeout or Forever is indicated by a null timeval pointer
399 if Timeout = Forever then
402 TVal := To_Timeval (Timeout);
403 TPtr := TVal'Unchecked_Access;
406 -- Copy R_Socket_Set in RSet and add read signalling socket
408 RSet := (Set => New_Socket_Set (R_Socket_Set.Set),
409 Last => R_Socket_Set.Last);
410 Set (RSet, Selector.R_Sig_Socket);
412 -- Copy W_Socket_Set in WSet
414 WSet := (Set => New_Socket_Set (W_Socket_Set.Set),
415 Last => W_Socket_Set.Last);
417 -- Copy E_Socket_Set in ESet
419 ESet := (Set => New_Socket_Set (E_Socket_Set.Set),
420 Last => E_Socket_Set.Last);
422 Last := C.int'Max (C.int'Max (C.int (RSet.Last),
434 if Res = Failure then
435 Raise_Socket_Error (Socket_Errno);
438 -- If Select was resumed because of read signalling socket,
439 -- read this data and remove socket from set.
441 if Is_Set (RSet, Selector.R_Sig_Socket) then
442 Clear (RSet, Selector.R_Sig_Socket);
448 Res := C_Recv (C.int (Selector.R_Sig_Socket), Buf'Address, 1, 0);
450 if Res = Failure then
451 Raise_Socket_Error (Socket_Errno);
461 -- Update RSet, WSet and ESet in regard to their new socket
468 -- Reset RSet as it should be if R_Sig_Socket was not added
470 if Is_Empty (RSet) then
474 if Is_Empty (WSet) then
478 if Is_Empty (ESet) then
482 -- Deliver RSet, WSet and ESet
484 Empty (R_Socket_Set);
485 R_Socket_Set := RSet;
487 Empty (W_Socket_Set);
488 W_Socket_Set := WSet;
490 Empty (E_Socket_Set);
491 E_Socket_Set := ESet;
499 (Item : in out Socket_Set_Type;
500 Socket : Socket_Type)
502 Last : aliased C.int := C.int (Item.Last);
505 if Item.Last /= No_Socket then
506 Remove_Socket_From_Set (Item.Set, C.int (Socket));
507 Last_Socket_In_Set (Item.Set, Last'Unchecked_Access);
508 Item.Last := Socket_Type (Last);
516 -- Comments needed below ???
517 -- Why are exceptions ignored ???
519 procedure Close_Selector (Selector : in out Selector_Type) is
522 Close_Socket (Selector.R_Sig_Socket);
530 Close_Socket (Selector.W_Sig_Socket);
542 procedure Close_Socket (Socket : Socket_Type) is
546 Res := C_Close (C.int (Socket));
548 if Res = Failure then
549 Raise_Socket_Error (Socket_Errno);
557 procedure Connect_Socket
558 (Socket : Socket_Type;
559 Server : in out Sock_Addr_Type)
562 Sin : aliased Sockaddr_In;
563 Len : constant C.int := Sin'Size / 8;
566 if Server.Family = Family_Inet6 then
570 Set_Length (Sin'Unchecked_Access, Len);
571 Set_Family (Sin'Unchecked_Access, Families (Server.Family));
572 Set_Address (Sin'Unchecked_Access, To_In_Addr (Server.Addr));
574 (Sin'Unchecked_Access,
575 Short_To_Network (C.unsigned_short (Server.Port)));
577 Res := C_Connect (C.int (Socket), Sin'Address, Len);
579 if Res = Failure then
580 Raise_Socket_Error (Socket_Errno);
588 procedure Control_Socket
589 (Socket : Socket_Type;
590 Request : in out Request_Type)
597 when Non_Blocking_IO =>
598 Arg := C.int (Boolean'Pos (Request.Enabled));
600 when N_Bytes_To_Read =>
607 Requests (Request.Name),
608 Arg'Unchecked_Access);
610 if Res = Failure then
611 Raise_Socket_Error (Socket_Errno);
615 when Non_Blocking_IO =>
618 when N_Bytes_To_Read =>
619 Request.Size := Natural (Arg);
629 (Source : Socket_Set_Type;
630 Target : in out Socket_Set_Type)
634 if Source.Last /= No_Socket then
635 Target.Set := New_Socket_Set (Source.Set);
636 Target.Last := Source.Last;
640 ---------------------
641 -- Create_Selector --
642 ---------------------
644 procedure Create_Selector (Selector : out Selector_Type) is
649 Sin : aliased Sockaddr_In;
650 Len : aliased C.int := Sin'Size / 8;
654 -- We open two signalling sockets. One of them is used to
655 -- send data to the other, which is included in a C_Select
656 -- socket set. The communication is used to force the call
657 -- to C_Select to complete, and the waiting task to resume
660 -- Create a listening socket
662 S0 := C_Socket (Constants.AF_INET, Constants.SOCK_STREAM, 0);
664 Raise_Socket_Error (Socket_Errno);
667 -- Sin is already correctly initialized. Bind the socket to any
670 Res := C_Bind (S0, Sin'Address, Len);
671 if Res = Failure then
674 Raise_Socket_Error (Err);
677 -- Get the port used by the socket
679 Res := C_Getsockname (S0, Sin'Address, Len'Access);
681 if Res = Failure then
684 Raise_Socket_Error (Err);
687 Res := C_Listen (S0, 2);
689 if Res = Failure then
692 Raise_Socket_Error (Err);
695 S1 := C_Socket (Constants.AF_INET, Constants.SOCK_STREAM, 0);
700 Raise_Socket_Error (Err);
703 -- Use INADDR_LOOPBACK
705 Sin.Sin_Addr.S_B1 := 127;
706 Sin.Sin_Addr.S_B2 := 0;
707 Sin.Sin_Addr.S_B3 := 0;
708 Sin.Sin_Addr.S_B4 := 1;
710 -- Do a connect and accept the connection
712 Res := C_Connect (S1, Sin'Address, Len);
714 if Res = Failure then
718 Raise_Socket_Error (Err);
721 S2 := C_Accept (S0, Sin'Address, Len'Access);
727 Raise_Socket_Error (Err);
732 if Res = Failure then
733 Raise_Socket_Error (Socket_Errno);
736 Selector.R_Sig_Socket := Socket_Type (S1);
737 Selector.W_Sig_Socket := Socket_Type (S2);
744 procedure Create_Socket
745 (Socket : out Socket_Type;
746 Family : Family_Type := Family_Inet;
747 Mode : Mode_Type := Socket_Stream)
752 Res := C_Socket (Families (Family), Modes (Mode), 0);
754 if Res = Failure then
755 Raise_Socket_Error (Socket_Errno);
758 Socket := Socket_Type (Res);
765 procedure Empty (Item : in out Socket_Set_Type) is
767 if Item.Set /= No_Socket_Set then
768 Free_Socket_Set (Item.Set);
769 Item.Set := No_Socket_Set;
772 Item.Last := No_Socket;
779 procedure Finalize is
794 (Item : in out Socket_Set_Type;
795 Socket : out Socket_Type)
798 L : aliased C.int := C.int (Item.Last);
801 if Item.Last /= No_Socket then
803 (Item.Set, L'Unchecked_Access, S'Unchecked_Access);
804 Item.Last := Socket_Type (L);
805 Socket := Socket_Type (S);
815 function Get_Address (Stream : Stream_Access) return Sock_Addr_Type is
817 if Stream = null then
820 elsif Stream.all in Datagram_Socket_Stream_Type then
821 return Datagram_Socket_Stream_Type (Stream.all).From;
824 return Get_Peer_Name (Stream_Socket_Stream_Type (Stream.all).Socket);
828 -------------------------
829 -- Get_Host_By_Address --
830 -------------------------
832 function Get_Host_By_Address
833 (Address : Inet_Addr_Type;
834 Family : Family_Type := Family_Inet) return Host_Entry_Type
836 pragma Unreferenced (Family);
838 HA : aliased In_Addr := To_In_Addr (Address);
839 Res : Hostent_Access;
843 -- This C function is not always thread-safe. Protect against
844 -- concurrent access.
847 Res := C_Gethostbyaddr (HA'Address, HA'Size / 8, Constants.AF_INET);
852 Raise_Host_Error (Err);
855 -- Translate from the C format to the API format
858 HE : constant Host_Entry_Type := To_Host_Entry (Res.all);
864 end Get_Host_By_Address;
866 ----------------------
867 -- Get_Host_By_Name --
868 ----------------------
870 function Get_Host_By_Name (Name : String) return Host_Entry_Type is
871 HN : constant C.char_array := C.To_C (Name);
872 Res : Hostent_Access;
876 -- Detect IP address name and redirect to Inet_Addr
878 if Is_IP_Address (Name) then
879 return Get_Host_By_Address (Inet_Addr (Name));
882 -- This C function is not always thread-safe. Protect against
883 -- concurrent access.
886 Res := C_Gethostbyname (HN);
891 Raise_Host_Error (Err);
894 -- Translate from the C format to the API format
897 HE : constant Host_Entry_Type := To_Host_Entry (Res.all);
903 end Get_Host_By_Name;
909 function Get_Peer_Name (Socket : Socket_Type) return Sock_Addr_Type is
910 Sin : aliased Sockaddr_In;
911 Len : aliased C.int := Sin'Size / 8;
912 Res : Sock_Addr_Type (Family_Inet);
915 if C_Getpeername (C.int (Socket), Sin'Address, Len'Access) = Failure then
916 Raise_Socket_Error (Socket_Errno);
919 Res.Addr := To_Inet_Addr (Sin.Sin_Addr);
920 Res.Port := Port_Type (Network_To_Short (Sin.Sin_Port));
925 -------------------------
926 -- Get_Service_By_Name --
927 -------------------------
929 function Get_Service_By_Name
931 Protocol : String) return Service_Entry_Type
933 SN : constant C.char_array := C.To_C (Name);
934 SP : constant C.char_array := C.To_C (Protocol);
935 Res : Servent_Access;
938 -- This C function is not always thread-safe. Protect against
939 -- concurrent access.
942 Res := C_Getservbyname (SN, SP);
946 Ada.Exceptions.Raise_Exception
947 (Service_Error'Identity, "Service not found");
950 -- Translate from the C format to the API format
953 SE : constant Service_Entry_Type := To_Service_Entry (Res.all);
959 end Get_Service_By_Name;
961 -------------------------
962 -- Get_Service_By_Port --
963 -------------------------
965 function Get_Service_By_Port
967 Protocol : String) return Service_Entry_Type
969 SP : constant C.char_array := C.To_C (Protocol);
970 Res : Servent_Access;
973 -- This C function is not always thread-safe. Protect against
974 -- concurrent access.
977 Res := C_Getservbyport
978 (C.int (Short_To_Network (C.unsigned_short (Port))), SP);
982 Ada.Exceptions.Raise_Exception
983 (Service_Error'Identity, "Service not found");
986 -- Translate from the C format to the API format
989 SE : constant Service_Entry_Type := To_Service_Entry (Res.all);
995 end Get_Service_By_Port;
997 ---------------------
998 -- Get_Socket_Name --
999 ---------------------
1001 function Get_Socket_Name
1002 (Socket : Socket_Type) return Sock_Addr_Type
1004 Sin : aliased Sockaddr_In;
1005 Len : aliased C.int := Sin'Size / 8;
1007 Addr : Sock_Addr_Type := No_Sock_Addr;
1010 Res := C_Getsockname (C.int (Socket), Sin'Address, Len'Access);
1011 if Res /= Failure then
1012 Addr.Addr := To_Inet_Addr (Sin.Sin_Addr);
1013 Addr.Port := Port_Type (Network_To_Short (Sin.Sin_Port));
1017 end Get_Socket_Name;
1019 -----------------------
1020 -- Get_Socket_Option --
1021 -----------------------
1023 function Get_Socket_Option
1024 (Socket : Socket_Type;
1025 Level : Level_Type := Socket_Level;
1026 Name : Option_Name) return Option_Type
1028 use type C.unsigned_char;
1030 V8 : aliased Two_Int;
1032 V1 : aliased C.unsigned_char;
1033 Len : aliased C.int;
1034 Add : System.Address;
1036 Opt : Option_Type (Name);
1040 when Multicast_Loop |
1068 Add, Len'Unchecked_Access);
1070 if Res = Failure then
1071 Raise_Socket_Error (Socket_Errno);
1079 Opt.Enabled := (V4 /= 0);
1082 Opt.Enabled := (V8 (V8'First) /= 0);
1083 Opt.Seconds := Natural (V8 (V8'Last));
1087 Opt.Size := Natural (V4);
1090 Opt.Error := Resolve_Error (Integer (V4));
1092 when Add_Membership |
1094 Opt.Multicast_Address := To_Inet_Addr (To_In_Addr (V8 (V8'First)));
1095 Opt.Local_Interface := To_Inet_Addr (To_In_Addr (V8 (V8'Last)));
1097 when Multicast_TTL =>
1098 Opt.Time_To_Live := Integer (V1);
1100 when Multicast_Loop =>
1101 Opt.Enabled := (V1 /= 0);
1106 end Get_Socket_Option;
1112 function Host_Name return String is
1113 Name : aliased C.char_array (1 .. 64);
1117 Res := C_Gethostname (Name'Address, Name'Length);
1119 if Res = Failure then
1120 Raise_Socket_Error (Socket_Errno);
1123 return C.To_Ada (Name);
1131 (Val : Inet_Addr_VN_Type;
1132 Hex : Boolean := False) return String
1134 -- The largest Inet_Addr_Comp_Type image occurs with IPv4. It
1135 -- has at most a length of 3 plus one '.' character.
1137 Buffer : String (1 .. 4 * Val'Length);
1138 Length : Natural := 1;
1139 Separator : Character;
1141 procedure Img10 (V : Inet_Addr_Comp_Type);
1142 -- Append to Buffer image of V in decimal format
1144 procedure Img16 (V : Inet_Addr_Comp_Type);
1145 -- Append to Buffer image of V in hexadecimal format
1151 procedure Img10 (V : Inet_Addr_Comp_Type) is
1152 Img : constant String := V'Img;
1153 Len : constant Natural := Img'Length - 1;
1156 Buffer (Length .. Length + Len - 1) := Img (2 .. Img'Last);
1157 Length := Length + Len;
1164 procedure Img16 (V : Inet_Addr_Comp_Type) is
1166 Buffer (Length) := Hex_To_Char (Natural (V / 16) + 1);
1167 Buffer (Length + 1) := Hex_To_Char (Natural (V mod 16) + 1);
1168 Length := Length + 2;
1171 -- Start of processing for Image
1180 for J in Val'Range loop
1187 if J /= Val'Last then
1188 Buffer (Length) := Separator;
1189 Length := Length + 1;
1193 return Buffer (1 .. Length - 1);
1200 function Image (Value : Inet_Addr_Type) return String is
1202 if Value.Family = Family_Inet then
1203 return Image (Inet_Addr_VN_Type (Value.Sin_V4), Hex => False);
1205 return Image (Inet_Addr_VN_Type (Value.Sin_V6), Hex => True);
1213 function Image (Value : Sock_Addr_Type) return String is
1214 Port : constant String := Value.Port'Img;
1216 return Image (Value.Addr) & ':' & Port (2 .. Port'Last);
1223 function Image (Socket : Socket_Type) return String is
1232 function Inet_Addr (Image : String) return Inet_Addr_Type is
1233 use Interfaces.C.Strings;
1235 Img : chars_ptr := New_String (Image);
1240 Res := C_Inet_Addr (Img);
1244 if Res = Failure then
1245 Raise_Socket_Error (Err);
1248 return To_Inet_Addr (To_In_Addr (Res));
1255 procedure Initialize (Process_Blocking_IO : Boolean := False) is
1257 if not Initialized then
1258 Initialized := True;
1259 Thin.Initialize (Process_Blocking_IO);
1267 function Is_Empty (Item : Socket_Set_Type) return Boolean is
1269 return Item.Last = No_Socket;
1276 function Is_IP_Address (Name : String) return Boolean is
1278 for J in Name'Range loop
1280 and then Name (J) not in '0' .. '9'
1294 (Item : Socket_Set_Type;
1295 Socket : Socket_Type) return Boolean
1298 return Item.Last /= No_Socket
1299 and then Socket <= Item.Last
1300 and then Is_Socket_In_Set (Item.Set, C.int (Socket)) /= 0;
1307 procedure Listen_Socket
1308 (Socket : Socket_Type;
1309 Length : Positive := 15)
1311 Res : constant C.int := C_Listen (C.int (Socket), C.int (Length));
1313 if Res = Failure then
1314 Raise_Socket_Error (Socket_Errno);
1322 procedure Narrow (Item : in out Socket_Set_Type) is
1323 Last : aliased C.int := C.int (Item.Last);
1325 if Item.Set /= No_Socket_Set then
1326 Last_Socket_In_Set (Item.Set, Last'Unchecked_Access);
1327 Item.Last := Socket_Type (Last);
1335 function Official_Name (E : Host_Entry_Type) return String is
1337 return To_String (E.Official);
1344 function Official_Name (S : Service_Entry_Type) return String is
1346 return To_String (S.Official);
1353 function Port_Number (S : Service_Entry_Type) return Port_Type is
1362 function Protocol_Name (S : Service_Entry_Type) return String is
1364 return To_String (S.Protocol);
1367 ----------------------
1368 -- Raise_Host_Error --
1369 ----------------------
1371 procedure Raise_Host_Error (Error : Integer) is
1373 function Host_Error_Message return String;
1374 -- We do not use a C function like strerror because hstrerror
1375 -- that would correspond seems to be obsolete. Return
1376 -- appropriate string for error value.
1378 ------------------------
1379 -- Host_Error_Message --
1380 ------------------------
1382 function Host_Error_Message return String is
1385 when Constants.HOST_NOT_FOUND => return "Host not found";
1386 when Constants.TRY_AGAIN => return "Try again";
1387 when Constants.NO_RECOVERY => return "No recovery";
1388 when Constants.NO_DATA => return "No address";
1389 when others => return "Unknown error";
1391 end Host_Error_Message;
1393 -- Start of processing for Raise_Host_Error
1396 Ada.Exceptions.Raise_Exception (Host_Error'Identity, Host_Error_Message);
1397 end Raise_Host_Error;
1399 ------------------------
1400 -- Raise_Socket_Error --
1401 ------------------------
1403 procedure Raise_Socket_Error (Error : Integer) is
1404 use type C.Strings.chars_ptr;
1406 function Image (E : Integer) return String;
1412 function Image (E : Integer) return String is
1413 Msg : String := E'Img & "] ";
1415 Msg (Msg'First) := '[';
1419 -- Start of processing for Raise_Socket_Error
1422 Ada.Exceptions.Raise_Exception
1423 (Socket_Error'Identity,
1424 Image (Error) & C.Strings.Value (Socket_Error_Message (Error)));
1425 end Raise_Socket_Error;
1432 (Stream : in out Datagram_Socket_Stream_Type;
1433 Item : out Ada.Streams.Stream_Element_Array;
1434 Last : out Ada.Streams.Stream_Element_Offset)
1436 First : Ada.Streams.Stream_Element_Offset := Item'First;
1437 Index : Ada.Streams.Stream_Element_Offset := First - 1;
1438 Max : constant Ada.Streams.Stream_Element_Offset := Item'Last;
1444 Item (First .. Max),
1450 -- Exit when all or zero data received. Zero means that
1451 -- the socket peer is closed.
1453 exit when Index < First or else Index = Max;
1464 (Stream : in out Stream_Socket_Stream_Type;
1465 Item : out Ada.Streams.Stream_Element_Array;
1466 Last : out Ada.Streams.Stream_Element_Offset)
1468 First : Ada.Streams.Stream_Element_Offset := Item'First;
1469 Index : Ada.Streams.Stream_Element_Offset := First - 1;
1470 Max : constant Ada.Streams.Stream_Element_Offset := Item'Last;
1474 Receive_Socket (Stream.Socket, Item (First .. Max), Index);
1477 -- Exit when all or zero data received. Zero means that
1478 -- the socket peer is closed.
1480 exit when Index < First or else Index = Max;
1486 --------------------
1487 -- Receive_Socket --
1488 --------------------
1490 procedure Receive_Socket
1491 (Socket : Socket_Type;
1492 Item : out Ada.Streams.Stream_Element_Array;
1493 Last : out Ada.Streams.Stream_Element_Offset;
1494 Flags : Request_Flag_Type := No_Request_Flag)
1496 use type Ada.Streams.Stream_Element_Offset;
1503 Item (Item'First)'Address,
1507 if Res = Failure then
1508 Raise_Socket_Error (Socket_Errno);
1511 Last := Item'First + Ada.Streams.Stream_Element_Offset (Res - 1);
1514 --------------------
1515 -- Receive_Socket --
1516 --------------------
1518 procedure Receive_Socket
1519 (Socket : Socket_Type;
1520 Item : out Ada.Streams.Stream_Element_Array;
1521 Last : out Ada.Streams.Stream_Element_Offset;
1522 From : out Sock_Addr_Type;
1523 Flags : Request_Flag_Type := No_Request_Flag)
1525 use type Ada.Streams.Stream_Element_Offset;
1528 Sin : aliased Sockaddr_In;
1529 Len : aliased C.int := Sin'Size / 8;
1535 Item (Item'First)'Address,
1538 Sin'Unchecked_Access,
1539 Len'Unchecked_Access);
1541 if Res = Failure then
1542 Raise_Socket_Error (Socket_Errno);
1545 Last := Item'First + Ada.Streams.Stream_Element_Offset (Res - 1);
1547 From.Addr := To_Inet_Addr (Sin.Sin_Addr);
1548 From.Port := Port_Type (Network_To_Short (Sin.Sin_Port));
1555 function Resolve_Error
1556 (Error_Value : Integer;
1557 From_Errno : Boolean := True) return Error_Type
1559 use GNAT.Sockets.Constants;
1562 if not From_Errno then
1564 when Constants.HOST_NOT_FOUND => return Unknown_Host;
1565 when Constants.TRY_AGAIN => return Host_Name_Lookup_Failure;
1566 when Constants.NO_RECOVERY =>
1567 return Non_Recoverable_Error;
1568 when Constants.NO_DATA => return Unknown_Server_Error;
1569 when others => return Cannot_Resolve_Error;
1574 when ENOERROR => return Success;
1575 when EACCES => return Permission_Denied;
1576 when EADDRINUSE => return Address_Already_In_Use;
1577 when EADDRNOTAVAIL => return Cannot_Assign_Requested_Address;
1578 when EAFNOSUPPORT =>
1579 return Address_Family_Not_Supported_By_Protocol;
1580 when EALREADY => return Operation_Already_In_Progress;
1581 when EBADF => return Bad_File_Descriptor;
1582 when ECONNABORTED => return Software_Caused_Connection_Abort;
1583 when ECONNREFUSED => return Connection_Refused;
1584 when ECONNRESET => return Connection_Reset_By_Peer;
1585 when EDESTADDRREQ => return Destination_Address_Required;
1586 when EFAULT => return Bad_Address;
1587 when EHOSTDOWN => return Host_Is_Down;
1588 when EHOSTUNREACH => return No_Route_To_Host;
1589 when EINPROGRESS => return Operation_Now_In_Progress;
1590 when EINTR => return Interrupted_System_Call;
1591 when EINVAL => return Invalid_Argument;
1592 when EIO => return Input_Output_Error;
1593 when EISCONN => return Transport_Endpoint_Already_Connected;
1594 when ELOOP => return Too_Many_Symbolic_Links;
1595 when EMFILE => return Too_Many_Open_Files;
1596 when EMSGSIZE => return Message_Too_Long;
1597 when ENAMETOOLONG => return File_Name_Too_Long;
1598 when ENETDOWN => return Network_Is_Down;
1600 return Network_Dropped_Connection_Because_Of_Reset;
1601 when ENETUNREACH => return Network_Is_Unreachable;
1602 when ENOBUFS => return No_Buffer_Space_Available;
1603 when ENOPROTOOPT => return Protocol_Not_Available;
1604 when ENOTCONN => return Transport_Endpoint_Not_Connected;
1605 when ENOTSOCK => return Socket_Operation_On_Non_Socket;
1606 when EOPNOTSUPP => return Operation_Not_Supported;
1607 when EPFNOSUPPORT => return Protocol_Family_Not_Supported;
1608 when EPROTONOSUPPORT => return Protocol_Not_Supported;
1609 when EPROTOTYPE => return Protocol_Wrong_Type_For_Socket;
1611 return Cannot_Send_After_Transport_Endpoint_Shutdown;
1612 when ESOCKTNOSUPPORT => return Socket_Type_Not_Supported;
1613 when ETIMEDOUT => return Connection_Timed_Out;
1614 when ETOOMANYREFS => return Too_Many_References;
1615 when EWOULDBLOCK => return Resource_Temporarily_Unavailable;
1616 when others => null;
1619 return Cannot_Resolve_Error;
1622 -----------------------
1623 -- Resolve_Exception --
1624 -----------------------
1626 function Resolve_Exception
1627 (Occurrence : Exception_Occurrence) return Error_Type
1629 Id : constant Exception_Id := Exception_Identity (Occurrence);
1630 Msg : constant String := Exception_Message (Occurrence);
1631 First : Natural := Msg'First;
1636 while First <= Msg'Last
1637 and then Msg (First) not in '0' .. '9'
1642 if First > Msg'Last then
1643 return Cannot_Resolve_Error;
1648 while Last < Msg'Last
1649 and then Msg (Last + 1) in '0' .. '9'
1654 Val := Integer'Value (Msg (First .. Last));
1656 if Id = Socket_Error_Id then
1657 return Resolve_Error (Val);
1658 elsif Id = Host_Error_Id then
1659 return Resolve_Error (Val, False);
1661 return Cannot_Resolve_Error;
1663 end Resolve_Exception;
1665 --------------------
1666 -- Receive_Vector --
1667 --------------------
1669 procedure Receive_Vector
1670 (Socket : Socket_Type;
1671 Vector : Vector_Type;
1672 Count : out Ada.Streams.Stream_Element_Count)
1680 Vector (Vector'First)'Address,
1683 if Res = Failure then
1684 Raise_Socket_Error (Socket_Errno);
1687 Count := Ada.Streams.Stream_Element_Count (Res);
1694 procedure Send_Socket
1695 (Socket : Socket_Type;
1696 Item : Ada.Streams.Stream_Element_Array;
1697 Last : out Ada.Streams.Stream_Element_Offset;
1698 Flags : Request_Flag_Type := No_Request_Flag)
1700 use type Ada.Streams.Stream_Element_Offset;
1708 Item (Item'First)'Address,
1710 Set_Forced_Flags (To_Int (Flags)));
1712 if Res = Failure then
1713 Raise_Socket_Error (Socket_Errno);
1716 Last := Item'First + Ada.Streams.Stream_Element_Offset (Res - 1);
1723 procedure Send_Socket
1724 (Socket : Socket_Type;
1725 Item : Ada.Streams.Stream_Element_Array;
1726 Last : out Ada.Streams.Stream_Element_Offset;
1727 To : Sock_Addr_Type;
1728 Flags : Request_Flag_Type := No_Request_Flag)
1730 use type Ada.Streams.Stream_Element_Offset;
1733 Sin : aliased Sockaddr_In;
1734 Len : constant C.int := Sin'Size / 8;
1737 Set_Length (Sin'Unchecked_Access, Len);
1738 Set_Family (Sin'Unchecked_Access, Families (To.Family));
1739 Set_Address (Sin'Unchecked_Access, To_In_Addr (To.Addr));
1741 (Sin'Unchecked_Access,
1742 Short_To_Network (C.unsigned_short (To.Port)));
1746 Item (Item'First)'Address,
1748 Set_Forced_Flags (To_Int (Flags)),
1749 Sin'Unchecked_Access,
1752 if Res = Failure then
1753 Raise_Socket_Error (Socket_Errno);
1756 Last := Item'First + Ada.Streams.Stream_Element_Offset (Res - 1);
1763 procedure Send_Vector
1764 (Socket : Socket_Type;
1765 Vector : Vector_Type;
1766 Count : out Ada.Streams.Stream_Element_Count)
1774 Vector (Vector'First)'Address,
1777 if Res = Failure then
1778 Raise_Socket_Error (Socket_Errno);
1781 Count := Ada.Streams.Stream_Element_Count (Res);
1788 procedure Set (Item : in out Socket_Set_Type; Socket : Socket_Type) is
1790 if Item.Set = No_Socket_Set then
1791 Item.Set := New_Socket_Set (No_Socket_Set);
1792 Item.Last := Socket;
1794 elsif Item.Last < Socket then
1795 Item.Last := Socket;
1798 Insert_Socket_In_Set (Item.Set, C.int (Socket));
1801 ----------------------
1802 -- Set_Forced_Flags --
1803 ----------------------
1805 function Set_Forced_Flags (F : C.int) return C.int is
1806 use type C.unsigned;
1807 function To_unsigned is
1808 new Ada.Unchecked_Conversion (C.int, C.unsigned);
1810 new Ada.Unchecked_Conversion (C.unsigned, C.int);
1812 return To_int (To_unsigned (F) or Constants.MSG_Forced_Flags);
1813 end Set_Forced_Flags;
1815 -----------------------
1816 -- Set_Socket_Option --
1817 -----------------------
1819 procedure Set_Socket_Option
1820 (Socket : Socket_Type;
1821 Level : Level_Type := Socket_Level;
1822 Option : Option_Type)
1824 V8 : aliased Two_Int;
1826 V1 : aliased C.unsigned_char;
1827 Len : aliased C.int;
1828 Add : System.Address := Null_Address;
1837 V4 := C.int (Boolean'Pos (Option.Enabled));
1842 V8 (V8'First) := C.int (Boolean'Pos (Option.Enabled));
1843 V8 (V8'Last) := C.int (Option.Seconds);
1849 V4 := C.int (Option.Size);
1854 V4 := C.int (Boolean'Pos (True));
1858 when Add_Membership |
1860 V8 (V8'First) := To_Int (To_In_Addr (Option.Multicast_Address));
1861 V8 (V8'Last) := To_Int (To_In_Addr (Option.Local_Interface));
1865 when Multicast_TTL =>
1866 V1 := C.unsigned_char (Option.Time_To_Live);
1870 when Multicast_Loop =>
1871 V1 := C.unsigned_char (Boolean'Pos (Option.Enabled));
1880 Options (Option.Name),
1883 if Res = Failure then
1884 Raise_Socket_Error (Socket_Errno);
1886 end Set_Socket_Option;
1888 ----------------------
1889 -- Short_To_Network --
1890 ----------------------
1892 function Short_To_Network (S : C.unsigned_short) return C.unsigned_short is
1893 use type C.unsigned_short;
1896 -- Big-endian case. No conversion needed. On these platforms,
1897 -- htons() defaults to a null procedure.
1899 pragma Warnings (Off);
1900 -- Since the test can generate "always True/False" warning
1902 if Default_Bit_Order = High_Order_First then
1905 pragma Warnings (On);
1907 -- Little-endian case. We must swap the high and low bytes of this
1908 -- short to make the port number network compliant.
1911 return (S / 256) + (S mod 256) * 256;
1913 end Short_To_Network;
1915 ---------------------
1916 -- Shutdown_Socket --
1917 ---------------------
1919 procedure Shutdown_Socket
1920 (Socket : Socket_Type;
1921 How : Shutmode_Type := Shut_Read_Write)
1926 Res := C_Shutdown (C.int (Socket), Shutmodes (How));
1928 if Res = Failure then
1929 Raise_Socket_Error (Socket_Errno);
1931 end Shutdown_Socket;
1938 (Socket : Socket_Type;
1939 Send_To : Sock_Addr_Type) return Stream_Access
1941 S : Datagram_Socket_Stream_Access;
1944 S := new Datagram_Socket_Stream_Type;
1947 S.From := Get_Socket_Name (Socket);
1948 return Stream_Access (S);
1955 function Stream (Socket : Socket_Type) return Stream_Access is
1956 S : Stream_Socket_Stream_Access;
1959 S := new Stream_Socket_Stream_Type;
1961 return Stream_Access (S);
1968 function To_C (Socket : Socket_Type) return Integer is
1970 return Integer (Socket);
1977 function To_Host_Entry (E : Hostent) return Host_Entry_Type is
1980 Official : constant String :=
1981 C.Strings.Value (E.H_Name);
1983 Aliases : constant Chars_Ptr_Array :=
1984 Chars_Ptr_Pointers.Value (E.H_Aliases);
1985 -- H_Aliases points to a list of name aliases. The list is
1986 -- terminated by a NULL pointer.
1988 Addresses : constant In_Addr_Access_Array :=
1989 In_Addr_Access_Pointers.Value (E.H_Addr_List);
1990 -- H_Addr_List points to a list of binary addresses (in network
1991 -- byte order). The list is terminated by a NULL pointer.
1993 -- H_Length is not used because it is currently only set to 4.
1994 -- H_Addrtype is always AF_INET
1996 Result : Host_Entry_Type
1997 (Aliases_Length => Aliases'Length - 1,
1998 Addresses_Length => Addresses'Length - 1);
1999 -- The last element is a null pointer
2005 Result.Official := To_Name (Official);
2007 Source := Aliases'First;
2008 Target := Result.Aliases'First;
2009 while Target <= Result.Aliases_Length loop
2010 Result.Aliases (Target) :=
2011 To_Name (C.Strings.Value (Aliases (Source)));
2012 Source := Source + 1;
2013 Target := Target + 1;
2016 Source := Addresses'First;
2017 Target := Result.Addresses'First;
2018 while Target <= Result.Addresses_Length loop
2019 Result.Addresses (Target) :=
2020 To_Inet_Addr (Addresses (Source).all);
2021 Source := Source + 1;
2022 Target := Target + 1;
2032 function To_In_Addr (Addr : Inet_Addr_Type) return Thin.In_Addr is
2034 if Addr.Family = Family_Inet then
2035 return (S_B1 => C.unsigned_char (Addr.Sin_V4 (1)),
2036 S_B2 => C.unsigned_char (Addr.Sin_V4 (2)),
2037 S_B3 => C.unsigned_char (Addr.Sin_V4 (3)),
2038 S_B4 => C.unsigned_char (Addr.Sin_V4 (4)));
2048 function To_Inet_Addr
2049 (Addr : In_Addr) return Inet_Addr_Type
2051 Result : Inet_Addr_Type;
2053 Result.Sin_V4 (1) := Inet_Addr_Comp_Type (Addr.S_B1);
2054 Result.Sin_V4 (2) := Inet_Addr_Comp_Type (Addr.S_B2);
2055 Result.Sin_V4 (3) := Inet_Addr_Comp_Type (Addr.S_B3);
2056 Result.Sin_V4 (4) := Inet_Addr_Comp_Type (Addr.S_B4);
2064 function To_Int (F : Request_Flag_Type) return C.int
2066 Current : Request_Flag_Type := F;
2067 Result : C.int := 0;
2070 for J in Flags'Range loop
2071 exit when Current = 0;
2073 if Current mod 2 /= 0 then
2074 if Flags (J) = -1 then
2075 Raise_Socket_Error (Constants.EOPNOTSUPP);
2077 Result := Result + Flags (J);
2080 Current := Current / 2;
2090 function To_Name (N : String) return Name_Type is
2092 return Name_Type'(N'Length, N);
2095 ----------------------
2096 -- To_Service_Entry --
2097 ----------------------
2099 function To_Service_Entry (E : Servent) return Service_Entry_Type is
2102 Official : constant String :=
2103 C.Strings.Value (E.S_Name);
2105 Aliases : constant Chars_Ptr_Array :=
2106 Chars_Ptr_Pointers.Value (E.S_Aliases);
2107 -- S_Aliases points to a list of name aliases. The list is
2108 -- terminated by a NULL pointer.
2110 Protocol : constant String :=
2111 C.Strings.Value (E.S_Proto);
2113 Result : Service_Entry_Type
2114 (Aliases_Length => Aliases'Length - 1);
2115 -- The last element is a null pointer
2121 Result.Official := To_Name (Official);
2123 Source := Aliases'First;
2124 Target := Result.Aliases'First;
2125 while Target <= Result.Aliases_Length loop
2126 Result.Aliases (Target) :=
2127 To_Name (C.Strings.Value (Aliases (Source)));
2128 Source := Source + 1;
2129 Target := Target + 1;
2133 Port_Type (Network_To_Short (C.unsigned_short (E.S_Port)));
2135 Result.Protocol := To_Name (Protocol);
2138 end To_Service_Entry;
2144 function To_String (HN : Name_Type) return String is
2146 return HN.Name (1 .. HN.Length);
2153 function To_Timeval (Val : Selector_Duration) return Timeval is
2158 -- If zero, set result as zero (otherwise it gets rounded down to -1)
2164 -- Normal case where we do round down
2167 S := Timeval_Unit (Val - 0.5);
2168 MS := Timeval_Unit (1_000_000 * (Val - Selector_Duration (S)));
2179 (Stream : in out Datagram_Socket_Stream_Type;
2180 Item : Ada.Streams.Stream_Element_Array)
2182 First : Ada.Streams.Stream_Element_Offset := Item'First;
2183 Index : Ada.Streams.Stream_Element_Offset := First - 1;
2184 Max : constant Ada.Streams.Stream_Element_Offset := Item'Last;
2190 Item (First .. Max),
2194 -- Exit when all or zero data sent. Zero means that the
2195 -- socket has been closed by peer.
2197 exit when Index < First or else Index = Max;
2202 if Index /= Max then
2212 (Stream : in out Stream_Socket_Stream_Type;
2213 Item : Ada.Streams.Stream_Element_Array)
2215 First : Ada.Streams.Stream_Element_Offset := Item'First;
2216 Index : Ada.Streams.Stream_Element_Offset := First - 1;
2217 Max : constant Ada.Streams.Stream_Element_Offset := Item'Last;
2221 Send_Socket (Stream.Socket, Item (First .. Max), Index);
2223 -- Exit when all or zero data sent. Zero means that the
2224 -- socket has been closed by peer.
2226 exit when Index < First or else Index = Max;
2231 if Index /= Max then