1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
5 -- G N A T . S O C K E T S --
9 -- Copyright (C) 2001-2019, 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 3, 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. --
18 -- As a special exception under Section 7 of GPL version 3, you are granted --
19 -- additional permissions described in the GCC Runtime Library Exception, --
20 -- version 3.1, as published by the Free Software Foundation. --
22 -- You should have received a copy of the GNU General Public License and --
23 -- a copy of the GCC Runtime Library Exception along with this program; --
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
25 -- <http://www.gnu.org/licenses/>. --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
30 ------------------------------------------------------------------------------
32 with Ada.Streams; use Ada.Streams;
33 with Ada.Exceptions; use Ada.Exceptions;
34 with Ada.Containers.Generic_Array_Sort;
35 with Ada.Finalization;
36 with Ada.Unchecked_Conversion;
38 with GNAT.Sockets.Thin_Common; use GNAT.Sockets.Thin_Common;
39 with GNAT.Sockets.Thin; use GNAT.Sockets.Thin;
41 with GNAT.Sockets.Linker_Options;
42 pragma Warnings (Off, GNAT.Sockets.Linker_Options);
43 -- Need to include pragma Linker_Options which is platform dependent
45 with System; use System;
46 with System.Communication; use System.Communication;
47 with System.CRTL; use System.CRTL;
48 with System.Task_Lock;
50 package body GNAT.Sockets is
52 package C renames Interfaces.C;
54 type IPV6_Mreq is record
55 ipv6mr_multiaddr : In6_Addr;
56 ipv6mr_interface : C.unsigned;
57 end record with Convention => C;
58 -- Record to Add/Drop_Membership for multicast in IPv6
60 ENOERROR : constant := 0;
62 Netdb_Buffer_Size : constant := SOSC.Need_Netdb_Buffer * 1024;
63 Need_Netdb_Lock : constant Boolean := SOSC.Need_Netdb_Lock /= 0;
64 -- The network database functions gethostbyname, gethostbyaddr,
65 -- getservbyname and getservbyport can either be guaranteed task safe by
66 -- the operating system, or else return data through a user-provided buffer
67 -- to ensure concurrent uses do not interfere.
69 -- Correspondence tables
71 Levels : constant array (Level_Type) of C.int :=
72 (Socket_Level => SOSC.SOL_SOCKET,
73 IP_Protocol_For_IP_Level => SOSC.IPPROTO_IP,
74 IP_Protocol_For_IPv6_Level => SOSC.IPPROTO_IPV6,
75 IP_Protocol_For_UDP_Level => SOSC.IPPROTO_UDP,
76 IP_Protocol_For_TCP_Level => SOSC.IPPROTO_TCP);
78 Modes : constant array (Mode_Type) of C.int :=
79 (Socket_Stream => SOSC.SOCK_STREAM,
80 Socket_Datagram => SOSC.SOCK_DGRAM);
82 Shutmodes : constant array (Shutmode_Type) of C.int :=
83 (Shut_Read => SOSC.SHUT_RD,
84 Shut_Write => SOSC.SHUT_WR,
85 Shut_Read_Write => SOSC.SHUT_RDWR);
87 Requests : constant array (Request_Name) of SOSC.IOCTL_Req_T :=
88 (Non_Blocking_IO => SOSC.FIONBIO,
89 N_Bytes_To_Read => SOSC.FIONREAD);
91 Options : constant array (Specific_Option_Name) of C.int :=
92 (Keep_Alive => SOSC.SO_KEEPALIVE,
93 Reuse_Address => SOSC.SO_REUSEADDR,
94 Broadcast => SOSC.SO_BROADCAST,
95 Send_Buffer => SOSC.SO_SNDBUF,
96 Receive_Buffer => SOSC.SO_RCVBUF,
97 Linger => SOSC.SO_LINGER,
98 Error => SOSC.SO_ERROR,
99 No_Delay => SOSC.TCP_NODELAY,
100 Add_Membership_V4 => SOSC.IP_ADD_MEMBERSHIP,
101 Drop_Membership_V4 => SOSC.IP_DROP_MEMBERSHIP,
102 Multicast_If_V4 => SOSC.IP_MULTICAST_IF,
103 Multicast_Loop_V4 => SOSC.IP_MULTICAST_LOOP,
104 Receive_Packet_Info => SOSC.IP_PKTINFO,
105 Multicast_TTL => SOSC.IP_MULTICAST_TTL,
106 Add_Membership_V6 => SOSC.IPV6_ADD_MEMBERSHIP,
107 Drop_Membership_V6 => SOSC.IPV6_DROP_MEMBERSHIP,
108 Multicast_If_V6 => SOSC.IPV6_MULTICAST_IF,
109 Multicast_Loop_V6 => SOSC.IPV6_MULTICAST_LOOP,
110 Multicast_Hops => SOSC.IPV6_MULTICAST_HOPS,
111 IPv6_Only => SOSC.IPV6_V6ONLY,
112 Send_Timeout => SOSC.SO_SNDTIMEO,
113 Receive_Timeout => SOSC.SO_RCVTIMEO,
114 Busy_Polling => SOSC.SO_BUSY_POLL);
115 -- ??? Note: for OpenSolaris, Receive_Packet_Info should be IP_RECVPKTINFO,
116 -- but for Linux compatibility this constant is the same as IP_PKTINFO.
118 Flags : constant array (0 .. 3) of C.int :=
119 (0 => SOSC.MSG_OOB, -- Process_Out_Of_Band_Data
120 1 => SOSC.MSG_PEEK, -- Peek_At_Incoming_Data
121 2 => SOSC.MSG_WAITALL, -- Wait_For_A_Full_Reception
122 3 => SOSC.MSG_EOR); -- Send_End_Of_Record
124 Socket_Error_Id : constant Exception_Id := Socket_Error'Identity;
125 Host_Error_Id : constant Exception_Id := Host_Error'Identity;
127 type In_Addr_Union (Family : Family_Type) is record
133 when Family_Unspec =>
136 end record with Unchecked_Union;
138 -----------------------
139 -- Local subprograms --
140 -----------------------
142 function Resolve_Error
143 (Error_Value : Integer;
144 From_Errno : Boolean := True) return Error_Type;
145 -- Associate an enumeration value (error_type) to an error value (errno).
146 -- From_Errno prevents from mixing h_errno with errno.
148 function To_Name (N : String) return Name_Type;
149 function To_String (HN : Name_Type) return String;
150 -- Conversion functions
152 function To_Int (F : Request_Flag_Type) return C.int;
153 -- Return the int value corresponding to the specified flags combination
155 function Set_Forced_Flags (F : C.int) return C.int;
156 -- Return F with the bits from SOSC.MSG_Forced_Flags forced set
158 procedure Netdb_Lock;
159 pragma Inline (Netdb_Lock);
160 procedure Netdb_Unlock;
161 pragma Inline (Netdb_Unlock);
162 -- Lock/unlock operation used to protect netdb access for platforms that
163 -- require such protection.
165 function To_Host_Entry (E : Hostent_Access) return Host_Entry_Type;
166 -- Conversion function
168 function To_Service_Entry (E : Servent_Access) return Service_Entry_Type;
169 -- Conversion function
171 function Value (S : System.Address) return String;
172 -- Same as Interfaces.C.Strings.Value but taking a System.Address
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 function Dedot (Value : String) return String
182 is (if Value /= "" and then Value (Value'Last) = '.'
183 then Value (Value'First .. Value'Last - 1)
185 -- Removes dot at the end of error message
187 procedure Raise_Socket_Error (Error : Integer);
188 -- Raise Socket_Error with an exception message describing the error code
191 procedure Raise_Host_Error (H_Error : Integer; Name : String);
192 -- Raise Host_Error exception with message describing error code (note
193 -- hstrerror seems to be obsolete) from h_errno. Name is the name
194 -- or address that was being looked up.
196 procedure Raise_GAI_Error (RC : C.int; Name : String);
197 -- Raise Host_Error with exception message in case of errors in
198 -- getaddrinfo and getnameinfo.
200 function Is_Windows return Boolean with Inline;
201 -- Returns True on Windows platform
203 procedure Narrow (Item : in out Socket_Set_Type);
204 -- Update Last as it may be greater than the real last socket
206 procedure Check_For_Fd_Set (Fd : Socket_Type);
207 pragma Inline (Check_For_Fd_Set);
208 -- Raise Constraint_Error if Fd is less than 0 or greater than or equal to
209 -- FD_SETSIZE, on platforms where fd_set is a bitmap.
211 function Connect_Socket
212 (Socket : Socket_Type;
213 Server : Sock_Addr_Type) return C.int;
214 pragma Inline (Connect_Socket);
215 -- Underlying implementation for the Connect_Socket procedures
217 -- Types needed for Datagram_Socket_Stream_Type
219 type Datagram_Socket_Stream_Type is new Root_Stream_Type with record
220 Socket : Socket_Type;
222 From : Sock_Addr_Type;
225 type Datagram_Socket_Stream_Access is
226 access all Datagram_Socket_Stream_Type;
229 (Stream : in out Datagram_Socket_Stream_Type;
230 Item : out Ada.Streams.Stream_Element_Array;
231 Last : out Ada.Streams.Stream_Element_Offset);
234 (Stream : in out Datagram_Socket_Stream_Type;
235 Item : Ada.Streams.Stream_Element_Array);
237 -- Types needed for Stream_Socket_Stream_Type
239 type Stream_Socket_Stream_Type is new Root_Stream_Type with record
240 Socket : Socket_Type;
243 type Stream_Socket_Stream_Access is
244 access all Stream_Socket_Stream_Type;
247 (Stream : in out Stream_Socket_Stream_Type;
248 Item : out Ada.Streams.Stream_Element_Array;
249 Last : out Ada.Streams.Stream_Element_Offset);
252 (Stream : in out Stream_Socket_Stream_Type;
253 Item : Ada.Streams.Stream_Element_Array);
255 procedure Wait_On_Socket
256 (Socket : Socket_Type;
258 Timeout : Selector_Duration;
259 Selector : access Selector_Type := null;
260 Status : out Selector_Status);
261 -- Common code for variants of socket operations supporting a timeout:
262 -- block in Check_Selector on Socket for at most the indicated timeout.
263 -- If For_Read is True, Socket is added to the read set for this call, else
264 -- it is added to the write set. If no selector is provided, a local one is
265 -- created for this call and destroyed prior to returning.
267 type Sockets_Library_Controller is new Ada.Finalization.Limited_Controlled
269 -- This type is used to generate automatic calls to Initialize and Finalize
270 -- during the elaboration and finalization of this package. A single object
271 -- of this type must exist at library level.
273 function Err_Code_Image (E : Integer) return String;
274 -- Return the value of E surrounded with brackets
276 procedure Initialize (X : in out Sockets_Library_Controller);
277 procedure Finalize (X : in out Sockets_Library_Controller);
279 procedure Normalize_Empty_Socket_Set (S : in out Socket_Set_Type);
280 -- If S is the empty set (detected by Last = No_Socket), make sure its
281 -- fd_set component is actually cleared. Note that the case where it is
282 -- not can occur for an uninitialized Socket_Set_Type object.
284 function Is_Open (S : Selector_Type) return Boolean;
285 -- Return True for an "open" Selector_Type object, i.e. one for which
286 -- Create_Selector has been called and Close_Selector has not been called,
287 -- or the null selector.
289 function Create_Address
290 (Family : Family_Type; Bytes : Inet_Addr_Bytes) return Inet_Addr_Type
292 -- Creates address from family and Inet_Addr_Bytes array.
294 function Get_Bytes (Addr : Inet_Addr_Type) return Inet_Addr_Bytes
296 -- Extract bytes from address
302 function "+" (L, R : Request_Flag_Type) return Request_Flag_Type is
311 procedure Abort_Selector (Selector : Selector_Type) is
315 if not Is_Open (Selector) then
316 raise Program_Error with "closed selector";
318 elsif Selector.Is_Null then
319 raise Program_Error with "null selector";
323 -- Send one byte to unblock select system call
325 Res := Signalling_Fds.Write (C.int (Selector.W_Sig_Socket));
327 if Res = Failure then
328 Raise_Socket_Error (Socket_Errno);
336 procedure Accept_Socket
337 (Server : Socket_Type;
338 Socket : out Socket_Type;
339 Address : out Sock_Addr_Type)
342 Sin : aliased Sockaddr;
343 Len : aliased C.int := Sin'Size / 8;
346 Res := C_Accept (C.int (Server), Sin'Address, Len'Access);
348 if Res = Failure then
349 Raise_Socket_Error (Socket_Errno);
352 Socket := Socket_Type (Res);
353 Address := Get_Address (Sin);
360 procedure Accept_Socket
361 (Server : Socket_Type;
362 Socket : out Socket_Type;
363 Address : out Sock_Addr_Type;
364 Timeout : Selector_Duration;
365 Selector : access Selector_Type := null;
366 Status : out Selector_Status)
369 if Selector /= null and then not Is_Open (Selector.all) then
370 raise Program_Error with "closed selector";
373 -- Wait for socket to become available for reading
379 Selector => Selector,
382 -- Accept connection if available
384 if Status = Completed then
385 Accept_Socket (Server, Socket, Address);
396 (E : Host_Entry_Type;
397 N : Positive := 1) return Inet_Addr_Type
400 return E.Addresses (N);
403 ----------------------
404 -- Addresses_Length --
405 ----------------------
407 function Addresses_Length (E : Host_Entry_Type) return Natural is
409 return E.Addresses_Length;
410 end Addresses_Length;
417 (E : Host_Entry_Type;
418 N : Positive := 1) return String
421 return To_String (E.Aliases (N));
429 (S : Service_Entry_Type;
430 N : Positive := 1) return String
433 return To_String (S.Aliases (N));
440 function Aliases_Length (E : Host_Entry_Type) return Natural is
442 return E.Aliases_Length;
449 function Aliases_Length (S : Service_Entry_Type) return Natural is
451 return S.Aliases_Length;
458 procedure Bind_Socket
459 (Socket : Socket_Type;
460 Address : Sock_Addr_Type)
463 Sin : aliased Sockaddr;
466 Set_Address (Sin'Unchecked_Access, Address);
469 (C.int (Socket), Sin'Address, C.int (Lengths (Address.Family)));
471 if Res = Failure then
472 Raise_Socket_Error (Socket_Errno);
476 ----------------------
477 -- Check_For_Fd_Set --
478 ----------------------
480 procedure Check_For_Fd_Set (Fd : Socket_Type) is
482 -- On Windows, fd_set is a FD_SETSIZE array of socket ids:
483 -- no check required. Warnings suppressed because condition
484 -- is known at compile time.
490 -- On other platforms, fd_set is an FD_SETSIZE bitmap: check
491 -- that Fd is within range (otherwise behavior is undefined).
493 elsif Fd < 0 or else Fd >= SOSC.FD_SETSIZE then
494 raise Constraint_Error
495 with "invalid value for socket set: " & Image (Fd);
497 end Check_For_Fd_Set;
503 procedure Check_Selector
504 (Selector : Selector_Type;
505 R_Socket_Set : in out Socket_Set_Type;
506 W_Socket_Set : in out Socket_Set_Type;
507 Status : out Selector_Status;
508 Timeout : Selector_Duration := Forever)
510 E_Socket_Set : Socket_Set_Type;
513 (Selector, R_Socket_Set, W_Socket_Set, E_Socket_Set, Status, Timeout);
516 procedure Check_Selector
517 (Selector : Selector_Type;
518 R_Socket_Set : in out Socket_Set_Type;
519 W_Socket_Set : in out Socket_Set_Type;
520 E_Socket_Set : in out Socket_Set_Type;
521 Status : out Selector_Status;
522 Timeout : Selector_Duration := Forever)
526 RSig : Socket_Type := No_Socket;
527 TVal : aliased Timeval;
528 TPtr : Timeval_Access;
531 if not Is_Open (Selector) then
532 raise Program_Error with "closed selector";
537 -- No timeout or Forever is indicated by a null timeval pointer
539 if Timeout = Forever then
542 TVal := To_Timeval (Timeout);
543 TPtr := TVal'Unchecked_Access;
546 -- Add read signalling socket, if present
548 if not Selector.Is_Null then
549 RSig := Selector.R_Sig_Socket;
550 Set (R_Socket_Set, RSig);
553 Last := C.int'Max (C.int'Max (C.int (R_Socket_Set.Last),
554 C.int (W_Socket_Set.Last)),
555 C.int (E_Socket_Set.Last));
557 -- Zero out fd_set for empty Socket_Set_Type objects
559 Normalize_Empty_Socket_Set (R_Socket_Set);
560 Normalize_Empty_Socket_Set (W_Socket_Set);
561 Normalize_Empty_Socket_Set (E_Socket_Set);
566 R_Socket_Set.Set'Access,
567 W_Socket_Set.Set'Access,
568 E_Socket_Set.Set'Access,
571 if Res = Failure then
572 Raise_Socket_Error (Socket_Errno);
575 -- If Select was resumed because of read signalling socket, read this
576 -- data and remove socket from set.
578 if RSig /= No_Socket and then Is_Set (R_Socket_Set, RSig) then
579 Clear (R_Socket_Set, RSig);
581 Res := Signalling_Fds.Read (C.int (RSig));
583 if Res = Failure then
584 Raise_Socket_Error (Socket_Errno);
593 -- Update socket sets in regard to their new contents
595 Narrow (R_Socket_Set);
596 Narrow (W_Socket_Set);
597 Narrow (E_Socket_Set);
605 (Item : in out Socket_Set_Type;
606 Socket : Socket_Type)
608 Last : aliased C.int := C.int (Item.Last);
611 Check_For_Fd_Set (Socket);
613 if Item.Last /= No_Socket then
614 Remove_Socket_From_Set (Item.Set'Access, C.int (Socket));
615 Last_Socket_In_Set (Item.Set'Access, Last'Unchecked_Access);
616 Item.Last := Socket_Type (Last);
624 procedure Close_Selector (Selector : in out Selector_Type) is
626 -- Nothing to do if selector already in closed state
628 if Selector.Is_Null or else not Is_Open (Selector) then
632 -- Close the signalling file descriptors used internally for the
633 -- implementation of Abort_Selector.
635 Signalling_Fds.Close (C.int (Selector.R_Sig_Socket));
636 Signalling_Fds.Close (C.int (Selector.W_Sig_Socket));
638 -- Reset R_Sig_Socket and W_Sig_Socket to No_Socket to ensure that any
639 -- (erroneous) subsequent attempt to use this selector properly fails.
641 Selector.R_Sig_Socket := No_Socket;
642 Selector.W_Sig_Socket := No_Socket;
649 procedure Close_Socket (Socket : Socket_Type) is
653 Res := C_Close (C.int (Socket));
655 if Res = Failure then
656 Raise_Socket_Error (Socket_Errno);
664 function Connect_Socket
665 (Socket : Socket_Type;
666 Server : Sock_Addr_Type) return C.int
668 Sin : aliased Sockaddr;
670 Set_Address (Sin'Unchecked_Access, Server);
673 (C.int (Socket), Sin'Address, C.int (Lengths (Server.Family)));
676 procedure Connect_Socket
677 (Socket : Socket_Type;
678 Server : Sock_Addr_Type)
681 if Connect_Socket (Socket, Server) = Failure then
682 Raise_Socket_Error (Socket_Errno);
686 procedure Connect_Socket
687 (Socket : Socket_Type;
688 Server : Sock_Addr_Type;
689 Timeout : Selector_Duration;
690 Selector : access Selector_Type := null;
691 Status : out Selector_Status)
694 -- Used to set Socket to non-blocking I/O
696 Conn_Err : aliased Integer;
697 -- Error status of the socket after completion of select(2)
700 Conn_Err_Size : aliased C.int := Conn_Err'Size / 8;
701 -- For getsockopt(2) call
704 if Selector /= null and then not Is_Open (Selector.all) then
705 raise Program_Error with "closed selector";
708 -- Set the socket to non-blocking I/O
710 Req := (Name => Non_Blocking_IO, Enabled => True);
711 Control_Socket (Socket, Request => Req);
713 -- Start operation (non-blocking), will return Failure with errno set
716 Res := Connect_Socket (Socket, Server);
717 if Res = Failure then
718 Conn_Err := Socket_Errno;
719 if Conn_Err /= SOSC.EINPROGRESS then
720 Raise_Socket_Error (Conn_Err);
724 -- Wait for socket to become available for writing (unless the Timeout
725 -- is zero, in which case we consider that it has already expired, and
726 -- we do not need to wait at all).
728 if Timeout = 0.0 then
736 Selector => Selector,
740 -- Check error condition (the asynchronous connect may have terminated
741 -- with an error, e.g. ECONNREFUSED) if select(2) completed.
743 if Status = Completed then
745 (C.int (Socket), SOSC.SOL_SOCKET, SOSC.SO_ERROR,
746 Conn_Err'Address, Conn_Err_Size'Access);
749 Conn_Err := Socket_Errno;
756 -- Reset the socket to blocking I/O
758 Req := (Name => Non_Blocking_IO, Enabled => False);
759 Control_Socket (Socket, Request => Req);
761 -- Report error condition if any
763 if Conn_Err /= 0 then
764 Raise_Socket_Error (Conn_Err);
772 procedure Control_Socket
773 (Socket : Socket_Type;
774 Request : in out Request_Type)
781 when Non_Blocking_IO =>
782 Arg := C.int (Boolean'Pos (Request.Enabled));
784 when N_Bytes_To_Read =>
789 (C.int (Socket), Requests (Request.Name), Arg'Unchecked_Access);
791 if Res = Failure then
792 Raise_Socket_Error (Socket_Errno);
796 when Non_Blocking_IO =>
799 when N_Bytes_To_Read =>
800 Request.Size := Natural (Arg);
809 (Source : Socket_Set_Type;
810 Target : out Socket_Set_Type)
816 ---------------------
817 -- Create_Selector --
818 ---------------------
820 procedure Create_Selector (Selector : out Selector_Type) is
821 Two_Fds : aliased Fd_Pair;
825 if Is_Open (Selector) then
826 -- Raise exception to prevent socket descriptor leak
828 raise Program_Error with "selector already open";
831 -- We open two signalling file descriptors. One of them is used to send
832 -- data to the other, which is included in a C_Select socket set. The
833 -- communication is used to force a call to C_Select to complete, and
834 -- the waiting task to resume its execution.
836 Res := Signalling_Fds.Create (Two_Fds'Access);
838 if Res = Failure then
839 Raise_Socket_Error (Socket_Errno);
842 Selector.R_Sig_Socket := Socket_Type (Two_Fds (Read_End));
843 Selector.W_Sig_Socket := Socket_Type (Two_Fds (Write_End));
850 procedure Create_Socket
851 (Socket : out Socket_Type;
852 Family : Family_Type := Family_Inet;
853 Mode : Mode_Type := Socket_Stream;
854 Level : Level_Type := IP_Protocol_For_IP_Level)
859 Res := C_Socket (Families (Family), Modes (Mode), Levels (Level));
861 if Res = Failure then
862 Raise_Socket_Error (Socket_Errno);
865 Socket := Socket_Type (Res);
872 procedure Empty (Item : out Socket_Set_Type) is
874 Reset_Socket_Set (Item.Set'Access);
875 Item.Last := No_Socket;
882 function Err_Code_Image (E : Integer) return String is
883 Msg : String := E'Img & "] ";
885 Msg (Msg'First) := '[';
893 procedure Finalize (X : in out Sockets_Library_Controller) is
894 pragma Unreferenced (X);
897 -- Finalization operation for the GNAT.Sockets package
906 procedure Finalize is
908 -- This is a dummy placeholder for an obsolete API.
909 -- The real finalization actions are in Initialize primitive operation
910 -- of Sockets_Library_Controller.
920 (Item : in out Socket_Set_Type;
921 Socket : out Socket_Type)
924 L : aliased C.int := C.int (Item.Last);
927 if Item.Last /= No_Socket then
929 (Item.Set'Access, Last => L'Access, Socket => S'Access);
930 Item.Last := Socket_Type (L);
931 Socket := Socket_Type (S);
942 (Stream : not null Stream_Access) return Sock_Addr_Type
945 if Stream.all in Datagram_Socket_Stream_Type then
946 return Datagram_Socket_Stream_Type (Stream.all).From;
948 return Get_Peer_Name (Stream_Socket_Stream_Type (Stream.all).Socket);
952 ---------------------
953 -- Raise_GAI_Error --
954 ---------------------
956 procedure Raise_GAI_Error (RC : C.int; Name : String) is
958 if RC = SOSC.EAI_SYSTEM then
960 Errcode : constant Integer := Socket_Errno;
962 raise Host_Error with Err_Code_Image (Errcode)
963 & Dedot (Socket_Error_Message (Errcode)) & ": " & Name;
966 raise Host_Error with Err_Code_Image (Integer (RC))
967 & Dedot (CS.Value (C_GAI_Strerror (RC))) & ": " & Name;
971 ----------------------
972 -- Get_Address_Info --
973 ----------------------
975 function Get_Address_Info
978 Family : Family_Type := Family_Unspec;
979 Mode : Mode_Type := Socket_Stream;
980 Level : Level_Type := IP_Protocol_For_IP_Level;
981 Numeric_Host : Boolean := False;
982 Passive : Boolean := False;
983 Unknown : access procedure
984 (Family, Mode, Level, Length : Integer) := null)
985 return Address_Info_Array
987 A : aliased Addrinfo_Access;
988 N : aliased C.char_array := C.To_C (Host);
989 S : aliased C.char_array := C.To_C (if Service = "" then "0"
991 Hints : aliased constant Addrinfo :=
992 (ai_family => Families (Family),
993 ai_socktype => Modes (Mode),
994 ai_protocol => Levels (Level),
995 ai_flags => (if Numeric_Host then SOSC.AI_NUMERICHOST else 0) +
996 (if Passive then SOSC.AI_PASSIVE else 0),
1001 Iter : Addrinfo_Access;
1004 function To_Array return Address_Info_Array;
1005 -- Convert taken from OS addrinfo list A into Address_Info_Array
1011 function To_Array return Address_Info_Array is
1012 Result : Address_Info_Array (1 .. 8);
1014 procedure Unsupported;
1015 -- Calls Unknown callback if defiend
1021 procedure Unsupported is
1023 if Unknown /= null then
1025 (Integer (Iter.ai_family),
1026 Integer (Iter.ai_socktype),
1027 Integer (Iter.ai_protocol),
1028 Integer (Iter.ai_addrlen));
1032 -- Start of processing for To_Array
1035 for J in Result'Range loop
1036 Look_For_Supported : loop
1038 return Result (1 .. J - 1);
1041 Result (J).Addr := Get_Address (Iter.ai_addr.all);
1043 if Result (J).Addr.Family = Family_Unspec then
1046 for M in Modes'Range loop
1048 if Modes (M) = Iter.ai_socktype then
1049 Result (J).Mode := M;
1056 for L in Levels'Range loop
1057 if Levels (L) = Iter.ai_protocol then
1058 Result (J).Level := L;
1063 exit Look_For_Supported;
1069 Iter := Iter.ai_next;
1072 return Result (1 .. J - 1);
1074 end loop Look_For_Supported;
1076 Iter := Iter.ai_next;
1079 return Result & To_Array;
1082 -- Start of processing for Get_Address_Info
1086 (Node => (if Host = "" then null else N'Unchecked_Access),
1087 Service => S'Unchecked_Access,
1088 Hints => Hints'Unchecked_Access,
1093 (R, Host & (if Service = "" then "" else ':' & Service));
1098 return Result : constant Address_Info_Array := To_Array do
1101 end Get_Address_Info;
1108 (Addr_Info : in out Address_Info_Array;
1109 Compare : access function (Left, Right : Address_Info) return Boolean)
1111 function Comp (Left, Right : Address_Info) return Boolean is
1112 (Compare (Left, Right));
1113 procedure Sorter is new Ada.Containers.Generic_Array_Sort
1114 (Positive, Address_Info, Address_Info_Array, Comp);
1119 ------------------------
1120 -- IPv6_TCP_Preferred --
1121 ------------------------
1123 function IPv6_TCP_Preferred (Left, Right : Address_Info) return Boolean is
1125 pragma Assert (Family_Inet < Family_Inet6);
1126 -- To be sure that Family_Type enumeration has appropriate elements
1129 if Left.Addr.Family /= Right.Addr.Family then
1130 return Left.Addr.Family > Right.Addr.Family;
1133 pragma Assert (Socket_Stream < Socket_Datagram);
1134 -- To be sure that Mode_Type enumeration has appropriate elements order
1136 return Left.Mode < Right.Mode;
1137 end IPv6_TCP_Preferred;
1143 function Get_Name_Info
1144 (Addr : Sock_Addr_Type;
1145 Numeric_Host : Boolean := False;
1146 Numeric_Serv : Boolean := False) return Host_Service
1148 SA : aliased Sockaddr;
1149 H : aliased C.char_array := (1 .. SOSC.NI_MAXHOST => C.nul);
1150 S : aliased C.char_array := (1 .. SOSC.NI_MAXSERV => C.nul);
1153 Set_Address (SA'Unchecked_Access, Addr);
1156 (SA'Unchecked_Access, socklen_t (Lengths (Addr.Family)),
1157 H'Unchecked_Access, H'Length,
1158 S'Unchecked_Access, S'Length,
1159 (if Numeric_Host then SOSC.NI_NUMERICHOST else 0) +
1160 (if Numeric_Serv then SOSC.NI_NUMERICSERV else 0));
1163 Raise_GAI_Error (RC, Image (Addr));
1167 HR : constant String := C.To_Ada (H);
1168 SR : constant String := C.To_Ada (S);
1170 return (HR'Length, SR'Length, HR, SR);
1174 -------------------------
1175 -- Get_Host_By_Address --
1176 -------------------------
1178 function Get_Host_By_Address
1179 (Address : Inet_Addr_Type;
1180 Family : Family_Type := Family_Inet) return Host_Entry_Type
1182 pragma Unreferenced (Family);
1184 HA : aliased In_Addr_Union (Address.Family);
1185 Buflen : constant C.int := Netdb_Buffer_Size;
1186 Buf : aliased C.char_array (1 .. Netdb_Buffer_Size);
1187 Res : aliased Hostent;
1188 Err : aliased C.int;
1191 case Address.Family is
1193 HA.In4 := To_In_Addr (Address);
1194 when Family_Inet6 =>
1195 HA.In6 := To_In6_Addr (Address);
1196 when Family_Unspec =>
1197 return (0, 0, (1, " "), (1 .. 0 => (1, " ")),
1198 (1 .. 0 => No_Inet_Addr));
1205 (case Address.Family is
1206 when Family_Inet => HA.In4'Size,
1207 when Family_Inet6 => HA.In6'Size,
1208 when Family_Unspec => 0) / 8,
1209 Families (Address.Family),
1210 Res'Access, Buf'Address, Buflen, Err'Access) /= 0
1213 Raise_Host_Error (Integer (Err), Image (Address));
1217 return H : constant Host_Entry_Type :=
1218 To_Host_Entry (Res'Unchecked_Access)
1227 end Get_Host_By_Address;
1229 ----------------------
1230 -- Get_Host_By_Name --
1231 ----------------------
1233 function Get_Host_By_Name (Name : String) return Host_Entry_Type is
1235 -- If the given name actually is the string representation of
1236 -- an IP address, use Get_Host_By_Address instead.
1238 if Is_IPv4_Address (Name) or else Is_IPv6_Address (Name) then
1239 return Get_Host_By_Address (Inet_Addr (Name));
1243 HN : constant C.char_array := C.To_C (Name);
1244 Buflen : constant C.int := Netdb_Buffer_Size;
1245 Buf : aliased C.char_array (1 .. Netdb_Buffer_Size);
1246 Res : aliased Hostent;
1247 Err : aliased C.int;
1253 (HN, Res'Access, Buf'Address, Buflen, Err'Access) /= 0
1256 Raise_Host_Error (Integer (Err), Name);
1259 return H : constant Host_Entry_Type :=
1260 To_Host_Entry (Res'Unchecked_Access)
1265 end Get_Host_By_Name;
1271 function Get_Peer_Name (Socket : Socket_Type) return Sock_Addr_Type is
1272 Sin : aliased Sockaddr;
1273 Len : aliased C.int := Sin'Size / 8;
1275 if C_Getpeername (C.int (Socket), Sin'Address, Len'Access) = Failure then
1276 Raise_Socket_Error (Socket_Errno);
1279 return Get_Address (Sin);
1282 -------------------------
1283 -- Get_Service_By_Name --
1284 -------------------------
1286 function Get_Service_By_Name
1288 Protocol : String) return Service_Entry_Type
1290 SN : constant C.char_array := C.To_C (Name);
1291 SP : constant C.char_array := C.To_C (Protocol);
1292 Buflen : constant C.int := Netdb_Buffer_Size;
1293 Buf : aliased C.char_array (1 .. Netdb_Buffer_Size);
1294 Res : aliased Servent;
1299 if C_Getservbyname (SN, SP, Res'Access, Buf'Address, Buflen) /= 0 then
1301 raise Service_Error with "Service not found";
1304 -- Translate from the C format to the API format
1306 return S : constant Service_Entry_Type :=
1307 To_Service_Entry (Res'Unchecked_Access)
1311 end Get_Service_By_Name;
1313 -------------------------
1314 -- Get_Service_By_Port --
1315 -------------------------
1317 function Get_Service_By_Port
1319 Protocol : String) return Service_Entry_Type
1321 SP : constant C.char_array := C.To_C (Protocol);
1322 Buflen : constant C.int := Netdb_Buffer_Size;
1323 Buf : aliased C.char_array (1 .. Netdb_Buffer_Size);
1324 Res : aliased Servent;
1330 (C.int (Short_To_Network (C.unsigned_short (Port))), SP,
1331 Res'Access, Buf'Address, Buflen) /= 0
1334 raise Service_Error with "Service not found";
1337 -- Translate from the C format to the API format
1339 return S : constant Service_Entry_Type :=
1340 To_Service_Entry (Res'Unchecked_Access)
1344 end Get_Service_By_Port;
1346 ---------------------
1347 -- Get_Socket_Name --
1348 ---------------------
1350 function Get_Socket_Name
1351 (Socket : Socket_Type) return Sock_Addr_Type
1353 Sin : aliased Sockaddr;
1354 Len : aliased C.int := Sin'Size / 8;
1357 Res := C_Getsockname (C.int (Socket), Sin'Address, Len'Access);
1359 if Res = Failure then
1360 return No_Sock_Addr;
1363 return Get_Address (Sin);
1364 end Get_Socket_Name;
1366 -----------------------
1367 -- Get_Socket_Option --
1368 -----------------------
1370 function Get_Socket_Option
1371 (Socket : Socket_Type;
1372 Level : Level_Type := Socket_Level;
1374 Optname : Interfaces.C.int := -1) return Option_Type
1376 use type C.unsigned;
1377 use type C.unsigned_char;
1379 V8 : aliased Two_Ints;
1381 U4 : aliased C.unsigned;
1382 V1 : aliased C.unsigned_char;
1383 VT : aliased Timeval;
1384 Len : aliased C.int;
1385 Add : System.Address;
1387 Opt : Option_Type (Name);
1388 Onm : Interfaces.C.int;
1391 if Name in Specific_Option_Name then
1392 Onm := Options (Name);
1394 elsif Optname = -1 then
1395 raise Socket_Error with "optname must be specified";
1403 | Receive_Packet_Info
1427 when Receive_Timeout
1430 -- The standard argument for SO_RCVTIMEO and SO_SNDTIMEO is a
1431 -- struct timeval, but on Windows it is a milliseconds count in
1442 when Add_Membership_V4
1444 | Drop_Membership_V4
1445 | Drop_Membership_V6
1447 raise Socket_Error with
1448 "Add/Drop membership valid only for Set_Socket_Option";
1463 if Res = Failure then
1464 Raise_Socket_Error (Socket_Errno);
1468 when Generic_Option =>
1480 Opt.Enabled := (V4 /= 0);
1482 when Busy_Polling =>
1483 Opt.Microseconds := Natural (V4);
1486 Opt.Enabled := (V8 (V8'First) /= 0);
1487 Opt.Seconds := Natural (V8 (V8'Last));
1492 Opt.Size := Natural (V4);
1495 Opt.Error := Resolve_Error (Integer (V4));
1497 when Add_Membership_V4
1499 | Drop_Membership_V4
1500 | Drop_Membership_V6
1502 -- No way to be here. Exception raised in the first case Name
1506 when Multicast_If_V4 =>
1507 To_Inet_Addr (To_In_Addr (V4), Opt.Outgoing_If);
1509 when Multicast_If_V6 =>
1510 Opt.Outgoing_If_Index := Natural (V4);
1512 when Multicast_TTL =>
1513 Opt.Time_To_Live := Integer (V1);
1515 when Multicast_Hops =>
1516 Opt.Hop_Limit := Integer (V4);
1518 when Receive_Packet_Info
1520 Opt.Enabled := (V1 /= 0);
1522 when Receive_Timeout
1527 -- Timeout is in milliseconds, actual value is 500 ms +
1528 -- returned value (unless it is 0).
1533 Opt.Timeout := Duration (U4) / 1000 + 0.500;
1537 Opt.Timeout := To_Duration (VT);
1542 end Get_Socket_Option;
1548 function Host_Name return String is
1549 Name : aliased C.char_array (1 .. 64);
1553 Res := C_Gethostname (Name'Address, Name'Length);
1555 if Res = Failure then
1556 Raise_Socket_Error (Socket_Errno);
1559 return C.To_Ada (Name);
1566 function Image (Value : Inet_Addr_Type) return String is
1567 use type CS.char_array_access;
1568 Size : constant socklen_t :=
1569 (case Value.Family is
1570 when Family_Inet => 4 * Value.Sin_V4'Length,
1571 when Family_Inet6 => 6 * 5 + 4 * 4,
1572 -- 1234:1234:1234:1234:1234:1234:123.123.123.123
1573 when Family_Unspec => 0);
1574 Dst : aliased C.char_array := (1 .. C.size_t (Size) => C.nul);
1575 Ia : aliased In_Addr_Union (Value.Family);
1577 case Value.Family is
1578 when Family_Inet6 =>
1579 Ia.In6 := To_In6_Addr (Value);
1581 Ia.In4 := To_In_Addr (Value);
1582 when Family_Unspec =>
1587 (Families (Value.Family), Ia'Address,
1588 Dst'Unchecked_Access, Size) = null
1590 Raise_Socket_Error (Socket_Errno);
1593 return C.To_Ada (Dst);
1600 function Image (Value : Sock_Addr_Type) return String is
1601 Port : constant String := Value.Port'Img;
1602 function Ipv6_Brackets (S : String) return String is
1603 (if Value.Family = Family_Inet6 then "[" & S & "]" else S);
1605 return Ipv6_Brackets (Image (Value.Addr)) & ':' & Port (2 .. Port'Last);
1612 function Image (Socket : Socket_Type) return String is
1621 function Image (Item : Socket_Set_Type) return String is
1622 Socket_Set : Socket_Set_Type := Item;
1626 Last_Img : constant String := Socket_Set.Last'Img;
1628 (1 .. (Integer (Socket_Set.Last) + 1) * Last_Img'Length);
1629 Index : Positive := 1;
1630 Socket : Socket_Type;
1633 while not Is_Empty (Socket_Set) loop
1634 Get (Socket_Set, Socket);
1637 Socket_Img : constant String := Socket'Img;
1639 Buffer (Index .. Index + Socket_Img'Length - 1) := Socket_Img;
1640 Index := Index + Socket_Img'Length;
1644 return "[" & Last_Img & "]" & Buffer (1 .. Index - 1);
1652 function Inet_Addr (Image : String) return Inet_Addr_Type is
1655 Img : aliased char_array := To_C (Image);
1657 Result : Inet_Addr_Type;
1658 IPv6 : constant Boolean := Is_IPv6_Address (Image);
1659 Ia : aliased In_Addr_Union
1660 (if IPv6 then Family_Inet6 else Family_Inet);
1662 -- Special case for an empty Image as on some platforms (e.g. Windows)
1663 -- calling Inet_Addr("") will not return an error.
1666 Raise_Socket_Error (SOSC.EINVAL);
1670 ((if IPv6 then SOSC.AF_INET6 else SOSC.AF_INET), Img'Address,
1674 Raise_Socket_Error (Socket_Errno);
1677 Raise_Socket_Error (SOSC.EINVAL);
1681 To_Inet_Addr (Ia.In6, Result);
1683 To_Inet_Addr (Ia.In4, Result);
1693 procedure Initialize (X : in out Sockets_Library_Controller) is
1694 pragma Unreferenced (X);
1704 procedure Initialize (Process_Blocking_IO : Boolean) is
1705 Expected : constant Boolean := not SOSC.Thread_Blocking_IO;
1708 if Process_Blocking_IO /= Expected then
1709 raise Socket_Error with
1710 "incorrect Process_Blocking_IO setting, expected " & Expected'Img;
1713 -- This is a dummy placeholder for an obsolete API
1715 -- Real initialization actions are in Initialize primitive operation
1716 -- of Sockets_Library_Controller.
1725 procedure Initialize is
1727 -- This is a dummy placeholder for an obsolete API
1729 -- Real initialization actions are in Initialize primitive operation
1730 -- of Sockets_Library_Controller.
1739 function Is_Windows return Boolean is
1742 return Target_OS = Windows;
1749 function Is_Empty (Item : Socket_Set_Type) return Boolean is
1751 return Item.Last = No_Socket;
1754 ---------------------
1755 -- Is_IPv6_Address --
1756 ---------------------
1758 function Is_IPv6_Address (Name : String) return Boolean is
1759 Prev_Colon : Natural := 0;
1760 Double_Colon : Boolean := False;
1761 Colons : Natural := 0;
1763 for J in Name'Range loop
1764 if Name (J) = ':' then
1765 Colons := Colons + 1;
1767 if Prev_Colon > 0 and then J = Prev_Colon + 1 then
1768 if Double_Colon then
1769 -- Only one double colon allowed
1773 Double_Colon := True;
1775 elsif J = Name'Last then
1776 -- Single colon at the end is not allowed
1782 elsif Prev_Colon = Name'First then
1783 -- Single colon at start is not allowed
1786 elsif Name (J) = '.' then
1787 return Prev_Colon > 0
1788 and then Is_IPv4_Address (Name (Prev_Colon + 1 .. Name'Last));
1790 elsif Name (J) not in '0' .. '9' | 'A' .. 'F' | 'a' .. 'f' then
1797 end Is_IPv6_Address;
1799 ---------------------
1800 -- Is_IPv4_Address --
1801 ---------------------
1803 function Is_IPv4_Address (Name : String) return Boolean is
1804 Dots : Natural := 0;
1807 -- Perform a cursory check for a dotted quad: we must have 1 to 3 dots,
1808 -- and there must be at least one digit around each.
1810 for J in Name'Range loop
1811 if Name (J) = '.' then
1813 -- Check that the dot is not in first or last position, and that
1814 -- it is followed by a digit. Note that we already know that it is
1815 -- preceded by a digit, or we would have returned earlier on.
1817 if J in Name'First + 1 .. Name'Last - 1
1818 and then Name (J + 1) in '0' .. '9'
1822 -- Definitely not a proper dotted quad
1828 elsif Name (J) not in '0' .. '9' then
1833 return Dots in 1 .. 3;
1834 end Is_IPv4_Address;
1840 function Is_Open (S : Selector_Type) return Boolean is
1846 -- Either both controlling socket descriptors are valid (case of an
1847 -- open selector) or neither (case of a closed selector).
1849 pragma Assert ((S.R_Sig_Socket /= No_Socket)
1851 (S.W_Sig_Socket /= No_Socket));
1853 return S.R_Sig_Socket /= No_Socket;
1862 (Item : Socket_Set_Type;
1863 Socket : Socket_Type) return Boolean
1866 Check_For_Fd_Set (Socket);
1868 return Item.Last /= No_Socket
1869 and then Socket <= Item.Last
1870 and then Is_Socket_In_Set (Item.Set'Access, C.int (Socket)) /= 0;
1877 procedure Listen_Socket
1878 (Socket : Socket_Type;
1879 Length : Natural := 15)
1881 Res : constant C.int := C_Listen (C.int (Socket), C.int (Length));
1883 if Res = Failure then
1884 Raise_Socket_Error (Socket_Errno);
1892 procedure Narrow (Item : in out Socket_Set_Type) is
1893 Last : aliased C.int := C.int (Item.Last);
1895 if Item.Last /= No_Socket then
1896 Last_Socket_In_Set (Item.Set'Access, Last'Unchecked_Access);
1897 Item.Last := Socket_Type (Last);
1905 procedure Netdb_Lock is
1907 if Need_Netdb_Lock then
1908 System.Task_Lock.Lock;
1916 procedure Netdb_Unlock is
1918 if Need_Netdb_Lock then
1919 System.Task_Lock.Unlock;
1923 --------------------------------
1924 -- Normalize_Empty_Socket_Set --
1925 --------------------------------
1927 procedure Normalize_Empty_Socket_Set (S : in out Socket_Set_Type) is
1929 if S.Last = No_Socket then
1930 Reset_Socket_Set (S.Set'Access);
1932 end Normalize_Empty_Socket_Set;
1938 function Official_Name (E : Host_Entry_Type) return String is
1940 return To_String (E.Official);
1947 function Official_Name (S : Service_Entry_Type) return String is
1949 return To_String (S.Official);
1952 --------------------
1953 -- Wait_On_Socket --
1954 --------------------
1956 procedure Wait_On_Socket
1957 (Socket : Socket_Type;
1959 Timeout : Selector_Duration;
1960 Selector : access Selector_Type := null;
1961 Status : out Selector_Status)
1963 type Local_Selector_Access is access Selector_Type;
1964 for Local_Selector_Access'Storage_Size use Selector_Type'Size;
1966 S : Selector_Access;
1967 -- Selector to use for waiting
1969 R_Fd_Set : Socket_Set_Type;
1970 W_Fd_Set : Socket_Set_Type;
1973 -- Create selector if not provided by the user
1975 if Selector = null then
1977 Local_S : constant Local_Selector_Access := new Selector_Type;
1979 S := Local_S.all'Unchecked_Access;
1980 Create_Selector (S.all);
1984 S := Selector.all'Access;
1988 Set (R_Fd_Set, Socket);
1990 Set (W_Fd_Set, Socket);
1993 Check_Selector (S.all, R_Fd_Set, W_Fd_Set, Status, Timeout);
1995 if Selector = null then
1996 Close_Selector (S.all);
2004 function Port_Number (S : Service_Entry_Type) return Port_Type is
2013 function Protocol_Name (S : Service_Entry_Type) return String is
2015 return To_String (S.Protocol);
2018 ----------------------
2019 -- Raise_Host_Error --
2020 ----------------------
2022 procedure Raise_Host_Error (H_Error : Integer; Name : String) is
2024 raise Host_Error with
2025 Err_Code_Image (H_Error)
2026 & Dedot (Host_Error_Messages.Host_Error_Message (H_Error))
2028 end Raise_Host_Error;
2030 ------------------------
2031 -- Raise_Socket_Error --
2032 ------------------------
2034 procedure Raise_Socket_Error (Error : Integer) is
2036 raise Socket_Error with
2037 Err_Code_Image (Error) & Socket_Error_Message (Error);
2038 end Raise_Socket_Error;
2045 (Stream : in out Datagram_Socket_Stream_Type;
2046 Item : out Ada.Streams.Stream_Element_Array;
2047 Last : out Ada.Streams.Stream_Element_Offset)
2062 (Stream : in out Stream_Socket_Stream_Type;
2063 Item : out Ada.Streams.Stream_Element_Array;
2064 Last : out Ada.Streams.Stream_Element_Offset)
2066 First : Ada.Streams.Stream_Element_Offset := Item'First;
2067 Index : Ada.Streams.Stream_Element_Offset := First - 1;
2068 Max : constant Ada.Streams.Stream_Element_Offset := Item'Last;
2072 Receive_Socket (Stream.Socket, Item (First .. Max), Index);
2075 -- Exit when all or zero data received. Zero means that the socket
2078 exit when Index < First or else Index = Max;
2084 --------------------
2085 -- Receive_Socket --
2086 --------------------
2088 procedure Receive_Socket
2089 (Socket : Socket_Type;
2090 Item : out Ada.Streams.Stream_Element_Array;
2091 Last : out Ada.Streams.Stream_Element_Offset;
2092 Flags : Request_Flag_Type := No_Request_Flag)
2098 C_Recv (C.int (Socket), Item'Address, Item'Length, To_Int (Flags));
2100 if Res = Failure then
2101 Raise_Socket_Error (Socket_Errno);
2104 Last := Last_Index (First => Item'First, Count => size_t (Res));
2107 --------------------
2108 -- Receive_Socket --
2109 --------------------
2111 procedure Receive_Socket
2112 (Socket : Socket_Type;
2113 Item : out Ada.Streams.Stream_Element_Array;
2114 Last : out Ada.Streams.Stream_Element_Offset;
2115 From : out Sock_Addr_Type;
2116 Flags : Request_Flag_Type := No_Request_Flag)
2119 Sin : aliased Sockaddr;
2120 Len : aliased C.int := Sin'Size / 8;
2132 if Res = Failure then
2133 Raise_Socket_Error (Socket_Errno);
2136 Last := Last_Index (First => Item'First, Count => size_t (Res));
2138 From := Get_Address (Sin);
2141 --------------------
2142 -- Receive_Vector --
2143 --------------------
2145 procedure Receive_Vector
2146 (Socket : Socket_Type;
2147 Vector : Vector_Type;
2148 Count : out Ada.Streams.Stream_Element_Count;
2149 Flags : Request_Flag_Type := No_Request_Flag)
2154 (Msg_Name => System.Null_Address,
2156 Msg_Iov => Vector'Address,
2158 -- recvmsg(2) returns EMSGSIZE on Linux (and probably on other
2159 -- platforms) when the supplied vector is longer than IOV_MAX,
2160 -- so use minimum of the two lengths.
2162 Msg_Iovlen => SOSC.Msg_Iovlen_T'Min
2163 (Vector'Length, SOSC.IOV_MAX),
2165 Msg_Control => System.Null_Address,
2166 Msg_Controllen => 0,
2176 if Res = ssize_t (Failure) then
2177 Raise_Socket_Error (Socket_Errno);
2180 Count := Ada.Streams.Stream_Element_Count (Res);
2187 function Resolve_Error
2188 (Error_Value : Integer;
2189 From_Errno : Boolean := True) return Error_Type
2191 use GNAT.Sockets.SOSC;
2194 if not From_Errno then
2196 when SOSC.HOST_NOT_FOUND => return Unknown_Host;
2197 when SOSC.TRY_AGAIN => return Host_Name_Lookup_Failure;
2198 when SOSC.NO_RECOVERY => return Non_Recoverable_Error;
2199 when SOSC.NO_DATA => return Unknown_Server_Error;
2200 when others => return Cannot_Resolve_Error;
2204 -- Special case: EAGAIN may be the same value as EWOULDBLOCK, so we
2205 -- can't include it in the case statement below.
2207 pragma Warnings (Off);
2208 -- Condition "EAGAIN /= EWOULDBLOCK" is known at compile time
2210 if EAGAIN /= EWOULDBLOCK and then Error_Value = EAGAIN then
2211 return Resource_Temporarily_Unavailable;
2214 -- This is not a case statement because if a particular error
2215 -- number constant is not defined, s-oscons-tmplt.c defines
2216 -- it to -1. If multiple constants are not defined, they
2217 -- would each be -1 and result in a "duplicate value in case" error.
2219 -- But we have to leave warnings off because the compiler is also
2220 -- smart enough to note that when two errnos have the same value,
2221 -- the second if condition is useless.
2222 if Error_Value = ENOERROR then
2224 elsif Error_Value = EACCES then
2225 return Permission_Denied;
2226 elsif Error_Value = EADDRINUSE then
2227 return Address_Already_In_Use;
2228 elsif Error_Value = EADDRNOTAVAIL then
2229 return Cannot_Assign_Requested_Address;
2230 elsif Error_Value = EAFNOSUPPORT then
2231 return Address_Family_Not_Supported_By_Protocol;
2232 elsif Error_Value = EALREADY then
2233 return Operation_Already_In_Progress;
2234 elsif Error_Value = EBADF then
2235 return Bad_File_Descriptor;
2236 elsif Error_Value = ECONNABORTED then
2237 return Software_Caused_Connection_Abort;
2238 elsif Error_Value = ECONNREFUSED then
2239 return Connection_Refused;
2240 elsif Error_Value = ECONNRESET then
2241 return Connection_Reset_By_Peer;
2242 elsif Error_Value = EDESTADDRREQ then
2243 return Destination_Address_Required;
2244 elsif Error_Value = EFAULT then
2246 elsif Error_Value = EHOSTDOWN then
2247 return Host_Is_Down;
2248 elsif Error_Value = EHOSTUNREACH then
2249 return No_Route_To_Host;
2250 elsif Error_Value = EINPROGRESS then
2251 return Operation_Now_In_Progress;
2252 elsif Error_Value = EINTR then
2253 return Interrupted_System_Call;
2254 elsif Error_Value = EINVAL then
2255 return Invalid_Argument;
2256 elsif Error_Value = EIO then
2257 return Input_Output_Error;
2258 elsif Error_Value = EISCONN then
2259 return Transport_Endpoint_Already_Connected;
2260 elsif Error_Value = ELOOP then
2261 return Too_Many_Symbolic_Links;
2262 elsif Error_Value = EMFILE then
2263 return Too_Many_Open_Files;
2264 elsif Error_Value = EMSGSIZE then
2265 return Message_Too_Long;
2266 elsif Error_Value = ENAMETOOLONG then
2267 return File_Name_Too_Long;
2268 elsif Error_Value = ENETDOWN then
2269 return Network_Is_Down;
2270 elsif Error_Value = ENETRESET then
2271 return Network_Dropped_Connection_Because_Of_Reset;
2272 elsif Error_Value = ENETUNREACH then
2273 return Network_Is_Unreachable;
2274 elsif Error_Value = ENOBUFS then
2275 return No_Buffer_Space_Available;
2276 elsif Error_Value = ENOPROTOOPT then
2277 return Protocol_Not_Available;
2278 elsif Error_Value = ENOTCONN then
2279 return Transport_Endpoint_Not_Connected;
2280 elsif Error_Value = ENOTSOCK then
2281 return Socket_Operation_On_Non_Socket;
2282 elsif Error_Value = EOPNOTSUPP then
2283 return Operation_Not_Supported;
2284 elsif Error_Value = EPFNOSUPPORT then
2285 return Protocol_Family_Not_Supported;
2286 elsif Error_Value = EPIPE then
2288 elsif Error_Value = EPROTONOSUPPORT then
2289 return Protocol_Not_Supported;
2290 elsif Error_Value = EPROTOTYPE then
2291 return Protocol_Wrong_Type_For_Socket;
2292 elsif Error_Value = ESHUTDOWN then
2293 return Cannot_Send_After_Transport_Endpoint_Shutdown;
2294 elsif Error_Value = ESOCKTNOSUPPORT then
2295 return Socket_Type_Not_Supported;
2296 elsif Error_Value = ETIMEDOUT then
2297 return Connection_Timed_Out;
2298 elsif Error_Value = ETOOMANYREFS then
2299 return Too_Many_References;
2300 elsif Error_Value = EWOULDBLOCK then
2301 return Resource_Temporarily_Unavailable;
2303 return Cannot_Resolve_Error;
2305 pragma Warnings (On);
2309 -----------------------
2310 -- Resolve_Exception --
2311 -----------------------
2313 function Resolve_Exception
2314 (Occurrence : Exception_Occurrence) return Error_Type
2316 Id : constant Exception_Id := Exception_Identity (Occurrence);
2317 Msg : constant String := Exception_Message (Occurrence);
2324 while First <= Msg'Last
2325 and then Msg (First) not in '0' .. '9'
2330 if First > Msg'Last then
2331 return Cannot_Resolve_Error;
2335 while Last < Msg'Last
2336 and then Msg (Last + 1) in '0' .. '9'
2341 Val := Integer'Value (Msg (First .. Last));
2343 if Id = Socket_Error_Id then
2344 return Resolve_Error (Val);
2346 elsif Id = Host_Error_Id then
2347 return Resolve_Error (Val, False);
2350 return Cannot_Resolve_Error;
2352 end Resolve_Exception;
2358 procedure Send_Socket
2359 (Socket : Socket_Type;
2360 Item : Ada.Streams.Stream_Element_Array;
2361 Last : out Ada.Streams.Stream_Element_Offset;
2362 Flags : Request_Flag_Type := No_Request_Flag)
2365 Send_Socket (Socket, Item, Last, To => null, Flags => Flags);
2372 procedure Send_Socket
2373 (Socket : Socket_Type;
2374 Item : Ada.Streams.Stream_Element_Array;
2375 Last : out Ada.Streams.Stream_Element_Offset;
2376 To : Sock_Addr_Type;
2377 Flags : Request_Flag_Type := No_Request_Flag)
2381 (Socket, Item, Last, To => To'Unrestricted_Access, Flags => Flags);
2388 procedure Send_Socket
2389 (Socket : Socket_Type;
2390 Item : Ada.Streams.Stream_Element_Array;
2391 Last : out Ada.Streams.Stream_Element_Offset;
2392 To : access Sock_Addr_Type;
2393 Flags : Request_Flag_Type := No_Request_Flag)
2397 Sin : aliased Sockaddr;
2398 C_To : System.Address;
2403 Set_Address (Sin'Unchecked_Access, To.all);
2404 C_To := Sin'Address;
2405 Len := C.int (Thin_Common.Lengths (To.Family));
2408 C_To := System.Null_Address;
2416 Set_Forced_Flags (To_Int (Flags)),
2420 if Res = Failure then
2421 Raise_Socket_Error (Socket_Errno);
2424 Last := Last_Index (First => Item'First, Count => size_t (Res));
2431 procedure Send_Vector
2432 (Socket : Socket_Type;
2433 Vector : Vector_Type;
2434 Count : out Ada.Streams.Stream_Element_Count;
2435 Flags : Request_Flag_Type := No_Request_Flag)
2440 Iov_Count : SOSC.Msg_Iovlen_T;
2441 This_Iov_Count : SOSC.Msg_Iovlen_T;
2447 while Iov_Count < Vector'Length loop
2449 pragma Warnings (Off);
2450 -- Following test may be compile time known on some targets
2453 (if Vector'Length - Iov_Count > SOSC.IOV_MAX
2455 else Vector'Length - Iov_Count);
2457 pragma Warnings (On);
2460 (Msg_Name => System.Null_Address,
2463 (Vector'First + Integer (Iov_Count))'Address,
2464 Msg_Iovlen => This_Iov_Count,
2465 Msg_Control => System.Null_Address,
2466 Msg_Controllen => 0,
2473 Set_Forced_Flags (To_Int (Flags)));
2475 if Res = ssize_t (Failure) then
2476 Raise_Socket_Error (Socket_Errno);
2479 Count := Count + Ada.Streams.Stream_Element_Count (Res);
2480 Iov_Count := Iov_Count + This_Iov_Count;
2488 procedure Set (Item : in out Socket_Set_Type; Socket : Socket_Type) is
2490 Check_For_Fd_Set (Socket);
2492 if Item.Last = No_Socket then
2494 -- Uninitialized socket set, make sure it is properly zeroed out
2496 Reset_Socket_Set (Item.Set'Access);
2497 Item.Last := Socket;
2499 elsif Item.Last < Socket then
2500 Item.Last := Socket;
2503 Insert_Socket_In_Set (Item.Set'Access, C.int (Socket));
2506 -----------------------
2507 -- Set_Close_On_Exec --
2508 -----------------------
2510 procedure Set_Close_On_Exec
2511 (Socket : Socket_Type;
2512 Close_On_Exec : Boolean;
2513 Status : out Boolean)
2515 function C_Set_Close_On_Exec
2516 (Socket : Socket_Type; Close_On_Exec : C.int) return C.int;
2517 pragma Import (C, C_Set_Close_On_Exec, "__gnat_set_close_on_exec");
2519 Status := C_Set_Close_On_Exec (Socket, Boolean'Pos (Close_On_Exec)) = 0;
2520 end Set_Close_On_Exec;
2522 ----------------------
2523 -- Set_Forced_Flags --
2524 ----------------------
2526 function Set_Forced_Flags (F : C.int) return C.int is
2527 use type C.unsigned;
2528 function To_unsigned is
2529 new Ada.Unchecked_Conversion (C.int, C.unsigned);
2531 new Ada.Unchecked_Conversion (C.unsigned, C.int);
2533 return To_int (To_unsigned (F) or SOSC.MSG_Forced_Flags);
2534 end Set_Forced_Flags;
2536 -----------------------
2537 -- Set_Socket_Option --
2538 -----------------------
2540 procedure Set_Socket_Option
2541 (Socket : Socket_Type;
2542 Level : Level_Type := Socket_Level;
2543 Option : Option_Type)
2545 use type C.unsigned;
2547 MR : aliased IPV6_Mreq;
2548 V8 : aliased Two_Ints;
2550 U4 : aliased C.unsigned;
2551 V1 : aliased C.unsigned_char;
2552 VT : aliased Timeval;
2554 Add : System.Address := Null_Address;
2560 when Generic_Option =>
2561 V4 := Option.Optval;
2573 V4 := C.int (Boolean'Pos (Option.Enabled));
2577 when Busy_Polling =>
2578 V4 := C.int (Option.Microseconds);
2583 V8 (V8'First) := C.int (Boolean'Pos (Option.Enabled));
2584 V8 (V8'Last) := C.int (Option.Seconds);
2591 V4 := C.int (Option.Size);
2596 V4 := C.int (Boolean'Pos (True));
2600 when Add_Membership_V4
2601 | Drop_Membership_V4
2603 V8 (V8'First) := To_Int (To_In_Addr (Option.Multicast_Address));
2604 V8 (V8'Last) := To_Int (To_In_Addr (Option.Local_Interface));
2608 when Add_Membership_V6
2609 | Drop_Membership_V6 =>
2610 MR.ipv6mr_multiaddr := To_In6_Addr (Option.Multicast_Address);
2611 MR.ipv6mr_interface := C.unsigned (Option.Interface_Index);
2615 when Multicast_If_V4 =>
2616 V4 := To_Int (To_In_Addr (Option.Outgoing_If));
2620 when Multicast_If_V6 =>
2621 V4 := C.int (Option.Outgoing_If_Index);
2625 when Multicast_TTL =>
2626 V1 := C.unsigned_char (Option.Time_To_Live);
2630 when Multicast_Hops =>
2631 V4 := C.int (Option.Hop_Limit);
2635 when Receive_Packet_Info
2637 V1 := C.unsigned_char (Boolean'Pos (Option.Enabled));
2641 when Receive_Timeout
2646 -- On Windows, the timeout is a DWORD in milliseconds, and
2647 -- the actual timeout is 500 ms + the given value (unless it
2650 U4 := C.unsigned (Option.Timeout / 0.001);
2663 VT := To_Timeval (Option.Timeout);
2669 if Option.Name in Specific_Option_Name then
2670 Onm := Options (Option.Name);
2672 elsif Option.Optname = -1 then
2673 raise Socket_Error with "optname must be specified";
2676 Onm := Option.Optname;
2685 if Res = Failure then
2686 Raise_Socket_Error (Socket_Errno);
2688 end Set_Socket_Option;
2690 ---------------------
2691 -- Shutdown_Socket --
2692 ---------------------
2694 procedure Shutdown_Socket
2695 (Socket : Socket_Type;
2696 How : Shutmode_Type := Shut_Read_Write)
2701 Res := C_Shutdown (C.int (Socket), Shutmodes (How));
2703 if Res = Failure then
2704 Raise_Socket_Error (Socket_Errno);
2706 end Shutdown_Socket;
2713 (Socket : Socket_Type;
2714 Send_To : Sock_Addr_Type) return Stream_Access
2716 S : Datagram_Socket_Stream_Access;
2719 S := new Datagram_Socket_Stream_Type;
2722 S.From := Get_Socket_Name (Socket);
2723 return Stream_Access (S);
2730 function Stream (Socket : Socket_Type) return Stream_Access is
2731 S : Stream_Socket_Stream_Access;
2733 S := new Stream_Socket_Stream_Type;
2735 return Stream_Access (S);
2742 function To_Ada (Fd : Integer) return Socket_Type is
2744 return Socket_Type (Fd);
2751 function To_C (Socket : Socket_Type) return Integer is
2753 return Integer (Socket);
2760 function To_Duration (Val : Timeval) return Timeval_Duration is
2761 Max_D : constant Long_Long_Integer := Long_Long_Integer (Forever - 0.5);
2762 Tv_sec_64 : constant Boolean := SOSC.SIZEOF_tv_sec = 8;
2763 -- Need to separate this condition into the constant declaration to
2764 -- avoid GNAT warning about "always true" or "always false".
2767 -- Check for possible Duration overflow when Tv_Sec field is 64 bit
2770 if Val.Tv_Sec > time_t (Max_D) or else
2771 (Val.Tv_Sec = time_t (Max_D) and then
2772 Val.Tv_Usec > suseconds_t ((Forever - Duration (Max_D)) * 1E6))
2778 return Duration (Val.Tv_Sec) + Duration (Val.Tv_Usec) * 1.0E-6;
2785 function To_Host_Entry (E : Hostent_Access) return Host_Entry_Type is
2786 Aliases_Count, Addresses_Count : Natural;
2788 Family : constant Family_Type :=
2789 (case Hostent_H_Addrtype (E) is
2790 when SOSC.AF_INET => Family_Inet,
2791 when SOSC.AF_INET6 => Family_Inet6,
2792 when others => Family_Unspec);
2794 Addr_Len : constant C.size_t := C.size_t (Hostent_H_Length (E));
2797 if Family = Family_Unspec then
2798 Raise_Socket_Error (SOSC.EPFNOSUPPORT);
2802 while Hostent_H_Alias (E, C.int (Aliases_Count)) /= Null_Address loop
2803 Aliases_Count := Aliases_Count + 1;
2806 Addresses_Count := 0;
2807 while Hostent_H_Addr (E, C.int (Addresses_Count)) /= Null_Address loop
2808 Addresses_Count := Addresses_Count + 1;
2811 return Result : Host_Entry_Type
2812 (Aliases_Length => Aliases_Count,
2813 Addresses_Length => Addresses_Count)
2815 Result.Official := To_Name (Value (Hostent_H_Name (E)));
2817 for J in Result.Aliases'Range loop
2818 Result.Aliases (J) :=
2819 To_Name (Value (Hostent_H_Alias
2820 (E, C.int (J - Result.Aliases'First))));
2823 for J in Result.Addresses'Range loop
2825 Ia : In_Addr_Union (Family);
2827 -- Hostent_H_Addr (E, <index>) may return an address that is
2828 -- not correctly aligned for In_Addr, so we need to use
2829 -- an intermediate copy operation on a type with an alignment
2830 -- of 1 to recover the value.
2832 subtype Addr_Buf_T is C.char_array (1 .. Addr_Len);
2833 Unaligned_Addr : Addr_Buf_T;
2834 for Unaligned_Addr'Address
2835 use Hostent_H_Addr (E, C.int (J - Result.Addresses'First));
2836 pragma Import (Ada, Unaligned_Addr);
2838 Aligned_Addr : Addr_Buf_T;
2839 for Aligned_Addr'Address use Ia'Address;
2840 pragma Import (Ada, Aligned_Addr);
2843 Aligned_Addr := Unaligned_Addr;
2844 if Family = Family_Inet6 then
2845 To_Inet_Addr (Ia.In6, Result.Addresses (J));
2847 To_Inet_Addr (Ia.In4, Result.Addresses (J));
2858 function To_Int (F : Request_Flag_Type) return C.int
2860 Current : Request_Flag_Type := F;
2861 Result : C.int := 0;
2864 for J in Flags'Range loop
2865 exit when Current = 0;
2867 if Current mod 2 /= 0 then
2868 if Flags (J) = -1 then
2869 Raise_Socket_Error (SOSC.EOPNOTSUPP);
2872 Result := Result + Flags (J);
2875 Current := Current / 2;
2885 function To_Name (N : String) return Name_Type is
2887 return Name_Type'(N'Length, N);
2890 ----------------------
2891 -- To_Service_Entry --
2892 ----------------------
2894 function To_Service_Entry (E : Servent_Access) return Service_Entry_Type is
2895 Aliases_Count : Natural;
2899 while Servent_S_Alias (E, C.int (Aliases_Count)) /= Null_Address loop
2900 Aliases_Count := Aliases_Count + 1;
2903 return Result : Service_Entry_Type (Aliases_Length => Aliases_Count) do
2904 Result.Official := To_Name (Value (Servent_S_Name (E)));
2906 for J in Result.Aliases'Range loop
2907 Result.Aliases (J) :=
2908 To_Name (Value (Servent_S_Alias
2909 (E, C.int (J - Result.Aliases'First))));
2912 Result.Protocol := To_Name (Value (Servent_S_Proto (E)));
2914 Port_Type (Network_To_Short (Servent_S_Port (E)));
2916 end To_Service_Entry;
2922 function To_String (HN : Name_Type) return String is
2924 return HN.Name (1 .. HN.Length);
2931 function To_Timeval (Val : Timeval_Duration) return Timeval is
2936 -- If zero, set result as zero (otherwise it gets rounded down to -1)
2942 -- Normal case where we do round down
2945 S := time_t (Val - 0.5);
2946 uS := suseconds_t (1_000_000 * (Val - Selector_Duration (S)) - 0.5);
2949 -- It happen on integer duration
2961 function Value (S : System.Address) return String is
2962 Str : String (1 .. Positive'Last);
2963 for Str'Address use S;
2964 pragma Import (Ada, Str);
2966 Terminator : Positive := Str'First;
2969 while Str (Terminator) /= ASCII.NUL loop
2970 Terminator := Terminator + 1;
2973 return Str (1 .. Terminator - 1);
2981 (Stream : in out Datagram_Socket_Stream_Type;
2982 Item : Ada.Streams.Stream_Element_Array)
2984 Last : Stream_Element_Offset;
2993 -- It is an error if not all of the data has been sent
2995 if Last /= Item'Last then
2996 Raise_Socket_Error (Socket_Errno);
3005 (Stream : in out Stream_Socket_Stream_Type;
3006 Item : Ada.Streams.Stream_Element_Array)
3008 First : Ada.Streams.Stream_Element_Offset;
3009 Index : Ada.Streams.Stream_Element_Offset;
3010 Max : constant Ada.Streams.Stream_Element_Offset := Item'Last;
3013 First := Item'First;
3015 while First <= Max loop
3016 Send_Socket (Stream.Socket, Item (First .. Max), Index, null);
3018 -- Exit when all or zero data sent. Zero means that the socket has
3019 -- been closed by peer.
3021 exit when Index < First or else Index = Max;
3026 -- For an empty array, we have First > Max, and hence Index >= Max (no
3027 -- error, the loop above is never executed). After a successful send,
3028 -- Index = Max. The only remaining case, Index < Max, is therefore
3029 -- always an actual send failure.
3032 Raise_Socket_Error (Socket_Errno);
3036 Sockets_Library_Controller_Object : Sockets_Library_Controller;
3037 pragma Unreferenced (Sockets_Library_Controller_Object);
3038 -- The elaboration and finalization of this object perform the required
3039 -- initialization and cleanup actions for the sockets library.
3041 --------------------
3042 -- Create_Address --
3043 --------------------
3045 function Create_Address
3046 (Family : Family_Type; Bytes : Inet_Addr_Bytes) return Inet_Addr_Type
3049 when Family_Inet => (Family_Inet, Bytes),
3050 when Family_Inet6 => (Family_Inet6, Bytes),
3051 when Family_Unspec => (Family => Family_Unspec));
3057 function Get_Bytes (Addr : Inet_Addr_Type) return Inet_Addr_Bytes is
3058 (case Addr.Family is
3059 when Family_Inet => Addr.Sin_V4,
3060 when Family_Inet6 => Addr.Sin_V6,
3061 when Family_Unspec => (1 .. 0 => 0));
3068 (Family : Family_Type;
3070 Host : Boolean := False) return Inet_Addr_Type
3072 Addr_Len : constant Natural := Inet_Addr_Bytes_Length (Family);
3074 if Length > 8 * Addr_Len then
3075 raise Constraint_Error with
3076 "invalid mask length for address family " & Family'Img;
3080 B : Inet_Addr_Bytes (1 .. Addr_Len);
3081 Part : Inet_Addr_Comp_Type;
3083 for J in 1 .. Length / 8 loop
3084 B (J) := (if Host then 0 else 255);
3087 if Length < 8 * Addr_Len then
3088 Part := 2 ** (8 - Length mod 8) - 1;
3089 B (Length / 8 + 1) := (if Host then Part else not Part);
3091 for J in Length / 8 + 2 .. B'Last loop
3092 B (J) := (if Host then 255 else 0);
3096 return Create_Address (Family, B);
3104 function "and" (Addr, Mask : Inet_Addr_Type) return Inet_Addr_Type is
3106 if Addr.Family /= Mask.Family then
3107 raise Constraint_Error with "incompatible address families";
3111 A : constant Inet_Addr_Bytes := Get_Bytes (Addr);
3112 M : constant Inet_Addr_Bytes := Get_Bytes (Mask);
3113 R : Inet_Addr_Bytes (A'Range);
3116 for J in A'Range loop
3117 R (J) := A (J) and M (J);
3119 return Create_Address (Addr.Family, R);
3127 function "or" (Net, Host : Inet_Addr_Type) return Inet_Addr_Type is
3129 if Net.Family /= Host.Family then
3130 raise Constraint_Error with "incompatible address families";
3134 N : constant Inet_Addr_Bytes := Get_Bytes (Net);
3135 H : constant Inet_Addr_Bytes := Get_Bytes (Host);
3136 R : Inet_Addr_Bytes (N'Range);
3139 for J in N'Range loop
3140 R (J) := N (J) or H (J);
3142 return Create_Address (Net.Family, R);
3150 function "not" (Mask : Inet_Addr_Type) return Inet_Addr_Type is
3151 M : constant Inet_Addr_Bytes := Get_Bytes (Mask);
3152 R : Inet_Addr_Bytes (M'Range);
3154 for J in R'Range loop
3157 return Create_Address (Mask.Family, R);