Mercurial > hg > CbC > CbC_gcc

comparison gcc/ada/libgnat/g-socket.adb @ 145:1830386684a0

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
gcc-9.2.0
author anatofuz
date Thu, 13 Feb 2020 11:34:05 +0900
parents 84e7813d76e9
children
comparison
equal deleted inserted replaced
131:84e7813d76e9 145:1830386684a0
4 -- -- 4 -- --
5 -- G N A T . S O C K E T S -- 5 -- G N A T . S O C K E T S --
6 -- -- 6 -- --
7 -- B o d y -- 7 -- B o d y --
8 -- -- 8 -- --
9 -- Copyright (C) 2001-2018, AdaCore -- 9 -- Copyright (C) 2001-2019, AdaCore --
10 -- -- 10 -- --
11 -- GNAT is free software; you can redistribute it and/or modify it under -- 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- -- 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- -- 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- -- 14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
29 -- -- 29 -- --
30 ------------------------------------------------------------------------------ 30 ------------------------------------------------------------------------------
31 31
32 with Ada.Streams; use Ada.Streams; 32 with Ada.Streams; use Ada.Streams;
33 with Ada.Exceptions; use Ada.Exceptions; 33 with Ada.Exceptions; use Ada.Exceptions;
34 with Ada.Containers.Generic_Array_Sort;
34 with Ada.Finalization; 35 with Ada.Finalization;
35 with Ada.Unchecked_Conversion; 36 with Ada.Unchecked_Conversion;
36 37
37 with GNAT.Sockets.Thin_Common; use GNAT.Sockets.Thin_Common; 38 with GNAT.Sockets.Thin_Common; use GNAT.Sockets.Thin_Common;
38 with GNAT.Sockets.Thin; use GNAT.Sockets.Thin; 39 with GNAT.Sockets.Thin; use GNAT.Sockets.Thin;
47 with System.Task_Lock; 48 with System.Task_Lock;
48 49
49 package body GNAT.Sockets is 50 package body GNAT.Sockets is
50 51
51 package C renames Interfaces.C; 52 package C renames Interfaces.C;
53
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
52 59
53 ENOERROR : constant := 0; 60 ENOERROR : constant := 0;
54 61
55 Netdb_Buffer_Size : constant := SOSC.Need_Netdb_Buffer * 1024; 62 Netdb_Buffer_Size : constant := SOSC.Need_Netdb_Buffer * 1024;
56 Need_Netdb_Lock : constant Boolean := SOSC.Need_Netdb_Lock /= 0; 63 Need_Netdb_Lock : constant Boolean := SOSC.Need_Netdb_Lock /= 0;
60 -- to ensure concurrent uses do not interfere. 67 -- to ensure concurrent uses do not interfere.
61 68
62 -- Correspondence tables 69 -- Correspondence tables
63 70
64 Levels : constant array (Level_Type) of C.int := 71 Levels : constant array (Level_Type) of C.int :=
65 (Socket_Level => SOSC.SOL_SOCKET, 72 (Socket_Level => SOSC.SOL_SOCKET,
66 IP_Protocol_For_IP_Level => SOSC.IPPROTO_IP, 73 IP_Protocol_For_IP_Level => SOSC.IPPROTO_IP,
67 IP_Protocol_For_UDP_Level => SOSC.IPPROTO_UDP, 74 IP_Protocol_For_IPv6_Level => SOSC.IPPROTO_IPV6,
68 IP_Protocol_For_TCP_Level => SOSC.IPPROTO_TCP); 75 IP_Protocol_For_UDP_Level => SOSC.IPPROTO_UDP,
76 IP_Protocol_For_TCP_Level => SOSC.IPPROTO_TCP,
77 IP_Protocol_For_ICMP_Level => SOSC.IPPROTO_ICMP,
78 IP_Protocol_For_IGMP_Level => SOSC.IPPROTO_IGMP,
79 IP_Protocol_For_RAW_Level => SOSC.IPPROTO_RAW);
69 80
70 Modes : constant array (Mode_Type) of C.int := 81 Modes : constant array (Mode_Type) of C.int :=
71 (Socket_Stream => SOSC.SOCK_STREAM, 82 (Socket_Stream => SOSC.SOCK_STREAM,
72 Socket_Datagram => SOSC.SOCK_DGRAM); 83 Socket_Datagram => SOSC.SOCK_DGRAM,
84 Socket_Raw => SOSC.SOCK_RAW);
73 85
74 Shutmodes : constant array (Shutmode_Type) of C.int := 86 Shutmodes : constant array (Shutmode_Type) of C.int :=
75 (Shut_Read => SOSC.SHUT_RD, 87 (Shut_Read => SOSC.SHUT_RD,
76 Shut_Write => SOSC.SHUT_WR, 88 Shut_Write => SOSC.SHUT_WR,
77 Shut_Read_Write => SOSC.SHUT_RDWR); 89 Shut_Read_Write => SOSC.SHUT_RDWR);
87 Send_Buffer => SOSC.SO_SNDBUF, 99 Send_Buffer => SOSC.SO_SNDBUF,
88 Receive_Buffer => SOSC.SO_RCVBUF, 100 Receive_Buffer => SOSC.SO_RCVBUF,
89 Linger => SOSC.SO_LINGER, 101 Linger => SOSC.SO_LINGER,
90 Error => SOSC.SO_ERROR, 102 Error => SOSC.SO_ERROR,
91 No_Delay => SOSC.TCP_NODELAY, 103 No_Delay => SOSC.TCP_NODELAY,
92 Add_Membership => SOSC.IP_ADD_MEMBERSHIP, 104 Add_Membership_V4 => SOSC.IP_ADD_MEMBERSHIP,
93 Drop_Membership => SOSC.IP_DROP_MEMBERSHIP, 105 Drop_Membership_V4 => SOSC.IP_DROP_MEMBERSHIP,
94 Multicast_If => SOSC.IP_MULTICAST_IF, 106 Multicast_If_V4 => SOSC.IP_MULTICAST_IF,
107 Multicast_Loop_V4 => SOSC.IP_MULTICAST_LOOP,
108 Receive_Packet_Info => SOSC.IP_PKTINFO,
95 Multicast_TTL => SOSC.IP_MULTICAST_TTL, 109 Multicast_TTL => SOSC.IP_MULTICAST_TTL,
96 Multicast_Loop => SOSC.IP_MULTICAST_LOOP, 110 Add_Membership_V6 => SOSC.IPV6_ADD_MEMBERSHIP,
97 Receive_Packet_Info => SOSC.IP_PKTINFO, 111 Drop_Membership_V6 => SOSC.IPV6_DROP_MEMBERSHIP,
112 Multicast_If_V6 => SOSC.IPV6_MULTICAST_IF,
113 Multicast_Loop_V6 => SOSC.IPV6_MULTICAST_LOOP,
114 Multicast_Hops => SOSC.IPV6_MULTICAST_HOPS,
115 IPv6_Only => SOSC.IPV6_V6ONLY,
98 Send_Timeout => SOSC.SO_SNDTIMEO, 116 Send_Timeout => SOSC.SO_SNDTIMEO,
99 Receive_Timeout => SOSC.SO_RCVTIMEO, 117 Receive_Timeout => SOSC.SO_RCVTIMEO,
100 Busy_Polling => SOSC.SO_BUSY_POLL); 118 Busy_Polling => SOSC.SO_BUSY_POLL);
101 -- ??? Note: for OpenSolaris, Receive_Packet_Info should be IP_RECVPKTINFO, 119 -- ??? Note: for OpenSolaris, Receive_Packet_Info should be IP_RECVPKTINFO,
102 -- but for Linux compatibility this constant is the same as IP_PKTINFO. 120 -- but for Linux compatibility this constant is the same as IP_PKTINFO.
108 3 => SOSC.MSG_EOR); -- Send_End_Of_Record 126 3 => SOSC.MSG_EOR); -- Send_End_Of_Record
109 127
110 Socket_Error_Id : constant Exception_Id := Socket_Error'Identity; 128 Socket_Error_Id : constant Exception_Id := Socket_Error'Identity;
111 Host_Error_Id : constant Exception_Id := Host_Error'Identity; 129 Host_Error_Id : constant Exception_Id := Host_Error'Identity;
112 130
113 Hex_To_Char : constant String (1 .. 16) := "0123456789ABCDEF"; 131 type In_Addr_Union (Family : Family_Inet_4_6) is record
114 -- Use to print in hexadecimal format 132 case Family is
133 when Family_Inet =>
134 In4 : In_Addr;
135 when Family_Inet6 =>
136 In6 : In6_Addr;
137 end case;
138 end record with Unchecked_Union;
115 139
116 ----------------------- 140 -----------------------
117 -- Local subprograms -- 141 -- Local subprograms --
118 ----------------------- 142 -----------------------
119 143
130 function To_Int (F : Request_Flag_Type) return C.int; 154 function To_Int (F : Request_Flag_Type) return C.int;
131 -- Return the int value corresponding to the specified flags combination 155 -- Return the int value corresponding to the specified flags combination
132 156
133 function Set_Forced_Flags (F : C.int) return C.int; 157 function Set_Forced_Flags (F : C.int) return C.int;
134 -- Return F with the bits from SOSC.MSG_Forced_Flags forced set 158 -- Return F with the bits from SOSC.MSG_Forced_Flags forced set
135
136 function Short_To_Network
137 (S : C.unsigned_short) return C.unsigned_short;
138 pragma Inline (Short_To_Network);
139 -- Convert a port number into a network port number
140
141 function Network_To_Short
142 (S : C.unsigned_short) return C.unsigned_short
143 renames Short_To_Network;
144 -- Symmetric operation
145
146 function Image
147 (Val : Inet_Addr_Bytes;
148 Hex : Boolean := False) return String;
149 -- Output an array of inet address components in hex or decimal mode
150
151 function Is_IP_Address (Name : String) return Boolean;
152 -- Return true when Name is an IPv4 address in dotted quad notation
153 159
154 procedure Netdb_Lock; 160 procedure Netdb_Lock;
155 pragma Inline (Netdb_Lock); 161 pragma Inline (Netdb_Lock);
156 procedure Netdb_Unlock; 162 procedure Netdb_Unlock;
157 pragma Inline (Netdb_Unlock); 163 pragma Inline (Netdb_Unlock);
158 -- Lock/unlock operation used to protect netdb access for platforms that 164 -- Lock/unlock operation used to protect netdb access for platforms that
159 -- require such protection. 165 -- require such protection.
160 166
161 function To_In_Addr (Addr : Inet_Addr_Type) return In_Addr;
162 procedure To_Inet_Addr
163 (Addr : In_Addr;
164 Result : out Inet_Addr_Type);
165 -- Conversion functions
166
167 function To_Host_Entry (E : Hostent_Access) return Host_Entry_Type; 167 function To_Host_Entry (E : Hostent_Access) return Host_Entry_Type;
168 -- Conversion function 168 -- Conversion function
169 169
170 function To_Service_Entry (E : Servent_Access) return Service_Entry_Type; 170 function To_Service_Entry (E : Servent_Access) return Service_Entry_Type;
171 -- Conversion function 171 -- Conversion function
177 -- Separate Val in seconds and microseconds 177 -- Separate Val in seconds and microseconds
178 178
179 function To_Duration (Val : Timeval) return Timeval_Duration; 179 function To_Duration (Val : Timeval) return Timeval_Duration;
180 -- Reconstruct a Duration value from a Timeval record (seconds and 180 -- Reconstruct a Duration value from a Timeval record (seconds and
181 -- microseconds). 181 -- microseconds).
182
183 function Dedot (Value : String) return String
184 is (if Value /= "" and then Value (Value'Last) = '.'
185 then Value (Value'First .. Value'Last - 1)
186 else Value);
187 -- Removes dot at the end of error message
182 188
183 procedure Raise_Socket_Error (Error : Integer); 189 procedure Raise_Socket_Error (Error : Integer);
184 -- Raise Socket_Error with an exception message describing the error code 190 -- Raise Socket_Error with an exception message describing the error code
185 -- from errno. 191 -- from errno.
186 192
187 procedure Raise_Host_Error (H_Error : Integer; Name : String); 193 procedure Raise_Host_Error (H_Error : Integer; Name : String);
188 -- Raise Host_Error exception with message describing error code (note 194 -- Raise Host_Error exception with message describing error code (note
189 -- hstrerror seems to be obsolete) from h_errno. Name is the name 195 -- hstrerror seems to be obsolete) from h_errno. Name is the name
190 -- or address that was being looked up. 196 -- or address that was being looked up.
197
198 procedure Raise_GAI_Error (RC : C.int; Name : String);
199 -- Raise Host_Error with exception message in case of errors in
200 -- getaddrinfo and getnameinfo.
201
202 function Is_Windows return Boolean with Inline;
203 -- Returns True on Windows platform
191 204
192 procedure Narrow (Item : in out Socket_Set_Type); 205 procedure Narrow (Item : in out Socket_Set_Type);
193 -- Update Last as it may be greater than the real last socket 206 -- Update Last as it may be greater than the real last socket
194 207
195 procedure Check_For_Fd_Set (Fd : Socket_Type); 208 procedure Check_For_Fd_Set (Fd : Socket_Type);
274 -- Return True for an "open" Selector_Type object, i.e. one for which 287 -- Return True for an "open" Selector_Type object, i.e. one for which
275 -- Create_Selector has been called and Close_Selector has not been called, 288 -- Create_Selector has been called and Close_Selector has not been called,
276 -- or the null selector. 289 -- or the null selector.
277 290
278 function Create_Address 291 function Create_Address
279 (Family : Family_Type; Bytes : Inet_Addr_Bytes) return Inet_Addr_Type 292 (Family : Family_Inet_4_6; Bytes : Inet_Addr_Bytes) return Inet_Addr_Type
280 with Inline; 293 with Inline;
281 -- Creates address from family and Inet_Addr_Bytes array. 294 -- Creates address from family and Inet_Addr_Bytes array.
282 295
283 function Get_Bytes (Addr : Inet_Addr_Type) return Inet_Addr_Bytes 296 function Get_Bytes (Addr : Inet_Addr_Type) return Inet_Addr_Bytes
284 with Inline; 297 with Inline;
326 (Server : Socket_Type; 339 (Server : Socket_Type;
327 Socket : out Socket_Type; 340 Socket : out Socket_Type;
328 Address : out Sock_Addr_Type) 341 Address : out Sock_Addr_Type)
329 is 342 is
330 Res : C.int; 343 Res : C.int;
331 Sin : aliased Sockaddr_In; 344 Sin : aliased Sockaddr;
332 Len : aliased C.int := Sin'Size / 8; 345 Len : aliased C.int := Sin'Size / 8;
333 346
334 begin 347 begin
335 Res := C_Accept (C.int (Server), Sin'Address, Len'Access); 348 Res := C_Accept (C.int (Server), Sin'Address, Len'Access);
336 349
337 if Res = Failure then 350 if Res = Failure then
338 Raise_Socket_Error (Socket_Errno); 351 Raise_Socket_Error (Socket_Errno);
339 end if; 352 end if;
340 353
341 Socket := Socket_Type (Res); 354 Socket := Socket_Type (Res);
342 355 Address := Get_Address (Sin, Len);
343 To_Inet_Addr (Sin.Sin_Addr, Address.Addr);
344 Address.Port := Port_Type (Network_To_Short (Sin.Sin_Port));
345 end Accept_Socket; 356 end Accept_Socket;
346 357
347 ------------------- 358 -------------------
348 -- Accept_Socket -- 359 -- Accept_Socket --
349 ------------------- 360 -------------------
449 procedure Bind_Socket 460 procedure Bind_Socket
450 (Socket : Socket_Type; 461 (Socket : Socket_Type;
451 Address : Sock_Addr_Type) 462 Address : Sock_Addr_Type)
452 is 463 is
453 Res : C.int; 464 Res : C.int;
454 Sin : aliased Sockaddr_In; 465 Sin : aliased Sockaddr;
455 Len : constant C.int := Sin'Size / 8; 466 Len : C.int;
456 -- This assumes that Address.Family = Family_Inet??? 467
457 468 begin
458 begin 469 Set_Address (Sin'Unchecked_Access, Address, Len);
459 if Address.Family = Family_Inet6 then
460 raise Socket_Error with "IPv6 not supported";
461 end if;
462
463 Set_Family (Sin.Sin_Family, Address.Family);
464 Set_Address (Sin'Unchecked_Access, To_In_Addr (Address.Addr));
465 Set_Port
466 (Sin'Unchecked_Access,
467 Short_To_Network (C.unsigned_short (Address.Port)));
468 470
469 Res := C_Bind (C.int (Socket), Sin'Address, Len); 471 Res := C_Bind (C.int (Socket), Sin'Address, Len);
470 472
471 if Res = Failure then 473 if Res = Failure then
472 Raise_Socket_Error (Socket_Errno); 474 Raise_Socket_Error (Socket_Errno);
476 ---------------------- 478 ----------------------
477 -- Check_For_Fd_Set -- 479 -- Check_For_Fd_Set --
478 ---------------------- 480 ----------------------
479 481
480 procedure Check_For_Fd_Set (Fd : Socket_Type) is 482 procedure Check_For_Fd_Set (Fd : Socket_Type) is
481 use SOSC;
482
483 begin 483 begin
484 -- On Windows, fd_set is a FD_SETSIZE array of socket ids: 484 -- On Windows, fd_set is a FD_SETSIZE array of socket ids:
485 -- no check required. Warnings suppressed because condition 485 -- no check required. Warnings suppressed because condition
486 -- is known at compile time. 486 -- is known at compile time.
487 487
488 if Target_OS = Windows then 488 if Is_Windows then
489 489
490 return; 490 return;
491 491
492 -- On other platforms, fd_set is an FD_SETSIZE bitmap: check 492 -- On other platforms, fd_set is an FD_SETSIZE bitmap: check
493 -- that Fd is within range (otherwise behavior is undefined). 493 -- that Fd is within range (otherwise behavior is undefined).
665 665
666 function Connect_Socket 666 function Connect_Socket
667 (Socket : Socket_Type; 667 (Socket : Socket_Type;
668 Server : Sock_Addr_Type) return C.int 668 Server : Sock_Addr_Type) return C.int
669 is 669 is
670 Sin : aliased Sockaddr_In; 670 Sin : aliased Sockaddr;
671 Len : constant C.int := Sin'Size / 8; 671 Len : C.int;
672 672 begin
673 begin 673 Set_Address (Sin'Unchecked_Access, Server, Len);
674 if Server.Family = Family_Inet6 then
675 raise Socket_Error with "IPv6 not supported";
676 end if;
677
678 Set_Family (Sin.Sin_Family, Server.Family);
679 Set_Address (Sin'Unchecked_Access, To_In_Addr (Server.Addr));
680 Set_Port
681 (Sin'Unchecked_Access,
682 Short_To_Network (C.unsigned_short (Server.Port)));
683 674
684 return C_Connect (C.int (Socket), Sin'Address, Len); 675 return C_Connect (C.int (Socket), Sin'Address, Len);
685 end Connect_Socket; 676 end Connect_Socket;
686 677
687 procedure Connect_Socket 678 procedure Connect_Socket
859 ------------------- 850 -------------------
860 851
861 procedure Create_Socket 852 procedure Create_Socket
862 (Socket : out Socket_Type; 853 (Socket : out Socket_Type;
863 Family : Family_Type := Family_Inet; 854 Family : Family_Type := Family_Inet;
864 Mode : Mode_Type := Socket_Stream) 855 Mode : Mode_Type := Socket_Stream;
856 Level : Level_Type := IP_Protocol_For_IP_Level)
865 is 857 is
866 Res : C.int; 858 Res : C.int;
867 859
868 begin 860 begin
869 Res := C_Socket (Families (Family), Modes (Mode), 0); 861 Res := C_Socket (Families (Family), Modes (Mode), Levels (Level));
870 862
871 if Res = Failure then 863 if Res = Failure then
872 Raise_Socket_Error (Socket_Errno); 864 Raise_Socket_Error (Socket_Errno);
873 end if; 865 end if;
874 866
875 Socket := Socket_Type (Res); 867 Socket := Socket_Type (Res);
876 end Create_Socket; 868 end Create_Socket;
869
870 ------------------------
871 -- Create_Socket_Pair --
872 ------------------------
873
874 procedure Create_Socket_Pair
875 (Left : out Socket_Type;
876 Right : out Socket_Type;
877 Family : Family_Type := Family_Unspec;
878 Mode : Mode_Type := Socket_Stream;
879 Level : Level_Type := IP_Protocol_For_IP_Level)
880 is
881 Res : C.int;
882 Pair : aliased Thin_Common.Fd_Pair;
883
884 begin
885 Res := C_Socketpair
886 ((if Family = Family_Unspec then Default_Socket_Pair_Family
887 else Families (Family)),
888 Modes (Mode), Levels (Level), Pair'Access);
889
890 if Res = Failure then
891 Raise_Socket_Error (Socket_Errno);
892 end if;
893
894 Left := Socket_Type (Pair (Pair'First));
895 Right := Socket_Type (Pair (Pair'Last));
896 end Create_Socket_Pair;
877 897
878 ----------- 898 -----------
879 -- Empty -- 899 -- Empty --
880 ----------- 900 -----------
881 901
957 else 977 else
958 return Get_Peer_Name (Stream_Socket_Stream_Type (Stream.all).Socket); 978 return Get_Peer_Name (Stream_Socket_Stream_Type (Stream.all).Socket);
959 end if; 979 end if;
960 end Get_Address; 980 end Get_Address;
961 981
982 ---------------------
983 -- Raise_GAI_Error --
984 ---------------------
985
986 procedure Raise_GAI_Error (RC : C.int; Name : String) is
987 begin
988 if RC = SOSC.EAI_SYSTEM then
989 declare
990 Errcode : constant Integer := Socket_Errno;
991 begin
992 raise Host_Error with Err_Code_Image (Errcode)
993 & Dedot (Socket_Error_Message (Errcode)) & ": " & Name;
994 end;
995 else
996 raise Host_Error with Err_Code_Image (Integer (RC))
997 & Dedot (CS.Value (C_GAI_Strerror (RC))) & ": " & Name;
998 end if;
999 end Raise_GAI_Error;
1000
1001 ----------------------
1002 -- Get_Address_Info --
1003 ----------------------
1004
1005 function Get_Address_Info
1006 (Host : String;
1007 Service : String;
1008 Family : Family_Type := Family_Unspec;
1009 Mode : Mode_Type := Socket_Stream;
1010 Level : Level_Type := IP_Protocol_For_IP_Level;
1011 Numeric_Host : Boolean := False;
1012 Passive : Boolean := False;
1013 Unknown : access procedure
1014 (Family, Mode, Level, Length : Integer) := null)
1015 return Address_Info_Array
1016 is
1017 A : aliased Addrinfo_Access;
1018 N : aliased C.char_array := C.To_C (Host);
1019 S : aliased C.char_array := C.To_C (if Service = "" then "0"
1020 else Service);
1021 Hints : aliased constant Addrinfo :=
1022 (ai_family => Families (Family),
1023 ai_socktype => Modes (Mode),
1024 ai_protocol => Levels (Level),
1025 ai_flags => (if Numeric_Host then SOSC.AI_NUMERICHOST else 0) +
1026 (if Passive then SOSC.AI_PASSIVE else 0),
1027 ai_addrlen => 0,
1028 others => <>);
1029
1030 R : C.int;
1031 Iter : Addrinfo_Access;
1032 Found : Boolean;
1033
1034 function To_Array return Address_Info_Array;
1035 -- Convert taken from OS addrinfo list A into Address_Info_Array
1036
1037 --------------
1038 -- To_Array --
1039 --------------
1040
1041 function To_Array return Address_Info_Array is
1042 Result : Address_Info_Array (1 .. 8);
1043
1044 procedure Unsupported;
1045 -- Calls Unknown callback if defiend
1046
1047 -----------------
1048 -- Unsupported --
1049 -----------------
1050
1051 procedure Unsupported is
1052 begin
1053 if Unknown /= null then
1054 Unknown
1055 (Integer (Iter.ai_family),
1056 Integer (Iter.ai_socktype),
1057 Integer (Iter.ai_protocol),
1058 Integer (Iter.ai_addrlen));
1059 end if;
1060 end Unsupported;
1061
1062 -- Start of processing for To_Array
1063
1064 begin
1065 for J in Result'Range loop
1066 Look_For_Supported : loop
1067 if Iter = null then
1068 pragma Warnings
1069 (Off, "may be referenced before it has a value");
1070
1071 return Result (1 .. J - 1);
1072
1073 pragma Warnings
1074 (On, "may be referenced before it has a value");
1075 end if;
1076
1077 Result (J).Addr :=
1078 Get_Address (Iter.ai_addr.all, C.int (Iter.ai_addrlen));
1079
1080 if Result (J).Addr.Family = Family_Unspec then
1081 Unsupported;
1082 else
1083 for M in Modes'Range loop
1084 Found := False;
1085 if Modes (M) = Iter.ai_socktype then
1086 Result (J).Mode := M;
1087 Found := True;
1088 exit;
1089 end if;
1090 end loop;
1091
1092 if Found then
1093 for L in Levels'Range loop
1094 if Levels (L) = Iter.ai_protocol then
1095 Result (J).Level := L;
1096 exit;
1097 end if;
1098 end loop;
1099
1100 exit Look_For_Supported;
1101 else
1102 Unsupported;
1103 end if;
1104 end if;
1105
1106 Iter := Iter.ai_next;
1107 end loop Look_For_Supported;
1108
1109 Iter := Iter.ai_next;
1110 end loop;
1111
1112 return Result & To_Array;
1113 end To_Array;
1114
1115 -- Start of processing for Get_Address_Info
1116
1117 begin
1118 R := C_Getaddrinfo
1119 (Node => (if Host = "" then null else N'Unchecked_Access),
1120 Service => S'Unchecked_Access,
1121 Hints => Hints'Unchecked_Access,
1122 Res => A'Access);
1123
1124 if R /= 0 then
1125 Raise_GAI_Error
1126 (R, Host & (if Service = "" then "" else ':' & Service));
1127 end if;
1128
1129 Iter := A;
1130
1131 return Result : constant Address_Info_Array := To_Array do
1132 C_Freeaddrinfo (A);
1133 end return;
1134 end Get_Address_Info;
1135
1136 ----------
1137 -- Sort --
1138 ----------
1139
1140 procedure Sort
1141 (Addr_Info : in out Address_Info_Array;
1142 Compare : access function (Left, Right : Address_Info) return Boolean)
1143 is
1144 function Comp (Left, Right : Address_Info) return Boolean is
1145 (Compare (Left, Right));
1146 procedure Sorter is new Ada.Containers.Generic_Array_Sort
1147 (Positive, Address_Info, Address_Info_Array, Comp);
1148 begin
1149 Sorter (Addr_Info);
1150 end Sort;
1151
1152 ------------------------
1153 -- IPv6_TCP_Preferred --
1154 ------------------------
1155
1156 function IPv6_TCP_Preferred (Left, Right : Address_Info) return Boolean is
1157 begin
1158 pragma Assert (Family_Inet < Family_Inet6);
1159 -- To be sure that Family_Type enumeration has appropriate elements
1160 -- order
1161
1162 if Left.Addr.Family /= Right.Addr.Family then
1163 return Left.Addr.Family > Right.Addr.Family;
1164 end if;
1165
1166 pragma Assert (Socket_Stream < Socket_Datagram);
1167 -- To be sure that Mode_Type enumeration has appropriate elements order
1168
1169 return Left.Mode < Right.Mode;
1170 end IPv6_TCP_Preferred;
1171
1172 -------------------
1173 -- Get_Name_Info --
1174 -------------------
1175
1176 function Get_Name_Info
1177 (Addr : Sock_Addr_Type;
1178 Numeric_Host : Boolean := False;
1179 Numeric_Serv : Boolean := False) return Host_Service
1180 is
1181 SA : aliased Sockaddr;
1182 H : aliased C.char_array := (1 .. SOSC.NI_MAXHOST => C.nul);
1183 S : aliased C.char_array := (1 .. SOSC.NI_MAXSERV => C.nul);
1184 RC : C.int;
1185 Len : C.int;
1186 begin
1187 Set_Address (SA'Unchecked_Access, Addr, Len);
1188
1189 RC := C_Getnameinfo
1190 (SA'Unchecked_Access, socklen_t (Len),
1191 H'Unchecked_Access, H'Length,
1192 S'Unchecked_Access, S'Length,
1193 (if Numeric_Host then SOSC.NI_NUMERICHOST else 0) +
1194 (if Numeric_Serv then SOSC.NI_NUMERICSERV else 0));
1195
1196 if RC /= 0 then
1197 Raise_GAI_Error (RC, Image (Addr));
1198 end if;
1199
1200 declare
1201 HR : constant String := C.To_Ada (H);
1202 SR : constant String := C.To_Ada (S);
1203 begin
1204 return (HR'Length, SR'Length, HR, SR);
1205 end;
1206 end Get_Name_Info;
1207
962 ------------------------- 1208 -------------------------
963 -- Get_Host_By_Address -- 1209 -- Get_Host_By_Address --
964 ------------------------- 1210 -------------------------
965 1211
966 function Get_Host_By_Address 1212 function Get_Host_By_Address
967 (Address : Inet_Addr_Type; 1213 (Address : Inet_Addr_Type;
968 Family : Family_Type := Family_Inet) return Host_Entry_Type 1214 Family : Family_Type := Family_Inet) return Host_Entry_Type
969 is 1215 is
970 pragma Unreferenced (Family); 1216 pragma Unreferenced (Family);
971 1217
972 HA : aliased In_Addr := To_In_Addr (Address); 1218 HA : aliased In_Addr_Union (Address.Family);
973 Buflen : constant C.int := Netdb_Buffer_Size; 1219 Buflen : constant C.int := Netdb_Buffer_Size;
974 Buf : aliased C.char_array (1 .. Netdb_Buffer_Size); 1220 Buf : aliased C.char_array (1 .. Netdb_Buffer_Size);
975 Res : aliased Hostent; 1221 Res : aliased Hostent;
976 Err : aliased C.int; 1222 Err : aliased C.int;
977 1223
978 begin 1224 begin
1225 case Address.Family is
1226 when Family_Inet =>
1227 HA.In4 := To_In_Addr (Address);
1228 when Family_Inet6 =>
1229 HA.In6 := To_In6_Addr (Address);
1230 end case;
1231
979 Netdb_Lock; 1232 Netdb_Lock;
980 1233
981 if C_Gethostbyaddr (HA'Address, HA'Size / 8, SOSC.AF_INET, 1234 if C_Gethostbyaddr
982 Res'Access, Buf'Address, Buflen, Err'Access) /= 0 1235 (HA'Address,
1236 (case Address.Family is
1237 when Family_Inet => HA.In4'Size,
1238 when Family_Inet6 => HA.In6'Size) / 8,
1239 Families (Address.Family),
1240 Res'Access, Buf'Address, Buflen, Err'Access) /= 0
983 then 1241 then
984 Netdb_Unlock; 1242 Netdb_Unlock;
985 Raise_Host_Error (Integer (Err), Image (Address)); 1243 Raise_Host_Error (Integer (Err), Image (Address));
986 end if; 1244 end if;
987 1245
1005 function Get_Host_By_Name (Name : String) return Host_Entry_Type is 1263 function Get_Host_By_Name (Name : String) return Host_Entry_Type is
1006 begin 1264 begin
1007 -- If the given name actually is the string representation of 1265 -- If the given name actually is the string representation of
1008 -- an IP address, use Get_Host_By_Address instead. 1266 -- an IP address, use Get_Host_By_Address instead.
1009 1267
1010 if Is_IP_Address (Name) then 1268 if Is_IPv4_Address (Name) or else Is_IPv6_Address (Name) then
1011 return Get_Host_By_Address (Inet_Addr (Name)); 1269 return Get_Host_By_Address (Inet_Addr (Name));
1012 end if; 1270 end if;
1013 1271
1014 declare 1272 declare
1015 HN : constant C.char_array := C.To_C (Name); 1273 HN : constant C.char_array := C.To_C (Name);
1039 ------------------- 1297 -------------------
1040 -- Get_Peer_Name -- 1298 -- Get_Peer_Name --
1041 ------------------- 1299 -------------------
1042 1300
1043 function Get_Peer_Name (Socket : Socket_Type) return Sock_Addr_Type is 1301 function Get_Peer_Name (Socket : Socket_Type) return Sock_Addr_Type is
1044 Sin : aliased Sockaddr_In; 1302 Sin : aliased Sockaddr;
1045 Len : aliased C.int := Sin'Size / 8; 1303 Len : aliased C.int := Sin'Size / 8;
1046 Res : Sock_Addr_Type (Family_Inet);
1047
1048 begin 1304 begin
1049 if C_Getpeername (C.int (Socket), Sin'Address, Len'Access) = Failure then 1305 if C_Getpeername (C.int (Socket), Sin'Address, Len'Access) = Failure then
1050 Raise_Socket_Error (Socket_Errno); 1306 Raise_Socket_Error (Socket_Errno);
1051 end if; 1307 end if;
1052 1308
1053 To_Inet_Addr (Sin.Sin_Addr, Res.Addr); 1309 return Get_Address (Sin, Len);
1054 Res.Port := Port_Type (Network_To_Short (Sin.Sin_Port));
1055
1056 return Res;
1057 end Get_Peer_Name; 1310 end Get_Peer_Name;
1058 1311
1059 ------------------------- 1312 -------------------------
1060 -- Get_Service_By_Name -- 1313 -- Get_Service_By_Name --
1061 ------------------------- 1314 -------------------------
1125 --------------------- 1378 ---------------------
1126 1379
1127 function Get_Socket_Name 1380 function Get_Socket_Name
1128 (Socket : Socket_Type) return Sock_Addr_Type 1381 (Socket : Socket_Type) return Sock_Addr_Type
1129 is 1382 is
1130 Sin : aliased Sockaddr_In; 1383 Sin : aliased Sockaddr;
1131 Len : aliased C.int := Sin'Size / 8; 1384 Len : aliased C.int := Sin'Size / 8;
1132 Res : C.int; 1385 Res : C.int;
1133 Addr : Sock_Addr_Type := No_Sock_Addr;
1134
1135 begin 1386 begin
1136 Res := C_Getsockname (C.int (Socket), Sin'Address, Len'Access); 1387 Res := C_Getsockname (C.int (Socket), Sin'Address, Len'Access);
1137 1388
1138 if Res /= Failure then 1389 if Res = Failure then
1139 To_Inet_Addr (Sin.Sin_Addr, Addr.Addr); 1390 return No_Sock_Addr;
1140 Addr.Port := Port_Type (Network_To_Short (Sin.Sin_Port)); 1391 end if;
1141 end if; 1392
1142 1393 return Get_Address (Sin, Len);
1143 return Addr;
1144 end Get_Socket_Name; 1394 end Get_Socket_Name;
1145 1395
1146 ----------------------- 1396 -----------------------
1147 -- Get_Socket_Option -- 1397 -- Get_Socket_Option --
1148 ----------------------- 1398 -----------------------
1149 1399
1150 function Get_Socket_Option 1400 function Get_Socket_Option
1151 (Socket : Socket_Type; 1401 (Socket : Socket_Type;
1152 Level : Level_Type := Socket_Level; 1402 Level : Level_Type;
1153 Name : Option_Name; 1403 Name : Option_Name;
1154 Optname : Interfaces.C.int := -1) return Option_Type 1404 Optname : Interfaces.C.int := -1) return Option_Type
1155 is 1405 is
1156 use SOSC; 1406 use type C.unsigned;
1157 use type C.unsigned_char; 1407 use type C.unsigned_char;
1158 1408
1159 V8 : aliased Two_Ints; 1409 V8 : aliased Two_Ints;
1160 V4 : aliased C.int; 1410 V4 : aliased C.int;
1411 U4 : aliased C.unsigned;
1161 V1 : aliased C.unsigned_char; 1412 V1 : aliased C.unsigned_char;
1162 VT : aliased Timeval; 1413 VT : aliased Timeval;
1163 Len : aliased C.int; 1414 Len : aliased C.int;
1164 Add : System.Address; 1415 Add : System.Address;
1165 Res : C.int; 1416 Res : C.int;
1176 else 1427 else
1177 Onm := Optname; 1428 Onm := Optname;
1178 end if; 1429 end if;
1179 1430
1180 case Name is 1431 case Name is
1181 when Multicast_Loop 1432 when Multicast_TTL
1182 | Multicast_TTL
1183 | Receive_Packet_Info 1433 | Receive_Packet_Info
1184 => 1434 =>
1185 Len := V1'Size / 8; 1435 Len := V1'Size / 8;
1186 Add := V1'Address; 1436 Add := V1'Address;
1187 1437
1188 when Broadcast 1438 when Broadcast
1189 | Busy_Polling 1439 | Busy_Polling
1190 | Error 1440 | Error
1191 | Generic_Option 1441 | Generic_Option
1192 | Keep_Alive 1442 | Keep_Alive
1193 | Multicast_If 1443 | Multicast_If_V4
1444 | Multicast_If_V6
1445 | Multicast_Loop_V4
1446 | Multicast_Loop_V6
1447 | Multicast_Hops
1194 | No_Delay 1448 | No_Delay
1195 | Receive_Buffer 1449 | Receive_Buffer
1196 | Reuse_Address 1450 | Reuse_Address
1197 | Send_Buffer 1451 | Send_Buffer
1452 | IPv6_Only
1198 => 1453 =>
1199 Len := V4'Size / 8; 1454 Len := V4'Size / 8;
1200 Add := V4'Address; 1455 Add := V4'Address;
1201 1456
1202 when Receive_Timeout 1457 when Receive_Timeout
1204 => 1459 =>
1205 -- The standard argument for SO_RCVTIMEO and SO_SNDTIMEO is a 1460 -- The standard argument for SO_RCVTIMEO and SO_SNDTIMEO is a
1206 -- struct timeval, but on Windows it is a milliseconds count in 1461 -- struct timeval, but on Windows it is a milliseconds count in
1207 -- a DWORD. 1462 -- a DWORD.
1208 1463
1209 if Target_OS = Windows then 1464 if Is_Windows then
1210 Len := V4'Size / 8; 1465 Len := U4'Size / 8;
1211 Add := V4'Address; 1466 Add := U4'Address;
1212
1213 else 1467 else
1214 Len := VT'Size / 8; 1468 Len := VT'Size / 8;
1215 Add := VT'Address; 1469 Add := VT'Address;
1216 end if; 1470 end if;
1217 1471
1218 when Add_Membership 1472 when Add_Membership_V4
1219 | Drop_Membership 1473 | Add_Membership_V6
1220 | Linger 1474 | Drop_Membership_V4
1475 | Drop_Membership_V6
1476 =>
1477 raise Socket_Error with
1478 "Add/Drop membership valid only for Set_Socket_Option";
1479
1480 when Linger
1221 => 1481 =>
1222 Len := V8'Size / 8; 1482 Len := V8'Size / 8;
1223 Add := V8'Address; 1483 Add := V8'Address;
1224 end case; 1484 end case;
1225 1485
1241 1501
1242 when Broadcast 1502 when Broadcast
1243 | Keep_Alive 1503 | Keep_Alive
1244 | No_Delay 1504 | No_Delay
1245 | Reuse_Address 1505 | Reuse_Address
1506 | Multicast_Loop_V4
1507 | Multicast_Loop_V6
1508 | IPv6_Only
1246 => 1509 =>
1247 Opt.Enabled := (V4 /= 0); 1510 Opt.Enabled := (V4 /= 0);
1248 1511
1249 when Busy_Polling => 1512 when Busy_Polling =>
1250 Opt.Microseconds := Natural (V4); 1513 Opt.Microseconds := Natural (V4);
1259 Opt.Size := Natural (V4); 1522 Opt.Size := Natural (V4);
1260 1523
1261 when Error => 1524 when Error =>
1262 Opt.Error := Resolve_Error (Integer (V4)); 1525 Opt.Error := Resolve_Error (Integer (V4));
1263 1526
1264 when Add_Membership 1527 when Add_Membership_V4
1265 | Drop_Membership 1528 | Add_Membership_V6
1529 | Drop_Membership_V4
1530 | Drop_Membership_V6
1266 => 1531 =>
1267 To_Inet_Addr (To_In_Addr (V8 (V8'First)), Opt.Multicast_Address); 1532 -- No way to be here. Exception raised in the first case Name
1268 To_Inet_Addr (To_In_Addr (V8 (V8'Last)), Opt.Local_Interface); 1533 -- expression.
1269 1534 null;
1270 when Multicast_If => 1535
1536 when Multicast_If_V4 =>
1271 To_Inet_Addr (To_In_Addr (V4), Opt.Outgoing_If); 1537 To_Inet_Addr (To_In_Addr (V4), Opt.Outgoing_If);
1538
1539 when Multicast_If_V6 =>
1540 Opt.Outgoing_If_Index := Natural (V4);
1272 1541
1273 when Multicast_TTL => 1542 when Multicast_TTL =>
1274 Opt.Time_To_Live := Integer (V1); 1543 Opt.Time_To_Live := Integer (V1);
1275 1544
1276 when Multicast_Loop 1545 when Multicast_Hops =>
1277 | Receive_Packet_Info 1546 Opt.Hop_Limit := Integer (V4);
1547
1548 when Receive_Packet_Info
1278 => 1549 =>
1279 Opt.Enabled := (V1 /= 0); 1550 Opt.Enabled := (V1 /= 0);
1280 1551
1281 when Receive_Timeout 1552 when Receive_Timeout
1282 | Send_Timeout 1553 | Send_Timeout
1283 => 1554 =>
1284 if Target_OS = Windows then 1555 if Is_Windows then
1285 1556
1286 -- Timeout is in milliseconds, actual value is 500 ms + 1557 -- Timeout is in milliseconds, actual value is 500 ms +
1287 -- returned value (unless it is 0). 1558 -- returned value (unless it is 0).
1288 1559
1289 if V4 = 0 then 1560 if U4 = 0 then
1290 Opt.Timeout := 0.0; 1561 Opt.Timeout := 0.0;
1291 else 1562 else
1292 Opt.Timeout := Natural (V4) * 0.001 + 0.500; 1563 Opt.Timeout := Duration (U4) / 1000 + 0.500;
1293 end if; 1564 end if;
1294 1565
1295 else 1566 else
1296 Opt.Timeout := To_Duration (VT); 1567 Opt.Timeout := To_Duration (VT);
1297 end if; 1568 end if;
1320 1591
1321 ----------- 1592 -----------
1322 -- Image -- 1593 -- Image --
1323 ----------- 1594 -----------
1324 1595
1325 function Image 1596 function Image (Value : Inet_Addr_Type) return String is
1326 (Val : Inet_Addr_Bytes; 1597 use type CS.char_array_access;
1327 Hex : Boolean := False) return String 1598 Size : constant socklen_t :=
1328 is 1599 (case Value.Family is
1329 -- The largest Inet_Addr_Comp_Type image occurs with IPv4. It 1600 when Family_Inet => 4 * Value.Sin_V4'Length,
1330 -- has at most a length of 3 plus one '.' character. 1601 when Family_Inet6 => 6 * 5 + 4 * 4);
1331 1602 -- 1234:1234:1234:1234:1234:1234:123.123.123.123
1332 Buffer : String (1 .. 4 * Val'Length); 1603 Dst : aliased C.char_array := (1 .. C.size_t (Size) => C.nul);
1333 Length : Natural := 1; 1604 Ia : aliased In_Addr_Union (Value.Family);
1334 Separator : Character; 1605 begin
1335 1606 case Value.Family is
1336 procedure Img10 (V : Inet_Addr_Comp_Type); 1607 when Family_Inet6 =>
1337 -- Append to Buffer image of V in decimal format 1608 Ia.In6 := To_In6_Addr (Value);
1338 1609 when Family_Inet =>
1339 procedure Img16 (V : Inet_Addr_Comp_Type); 1610 Ia.In4 := To_In_Addr (Value);
1340 -- Append to Buffer image of V in hexadecimal format 1611 end case;
1341 1612
1342 ----------- 1613 if Inet_Ntop
1343 -- Img10 -- 1614 (Families (Value.Family), Ia'Address,
1344 ----------- 1615 Dst'Unchecked_Access, Size) = null
1345 1616 then
1346 procedure Img10 (V : Inet_Addr_Comp_Type) is 1617 Raise_Socket_Error (Socket_Errno);
1347 Img : constant String := V'Img; 1618 end if;
1348 Len : constant Natural := Img'Length - 1; 1619
1349 begin 1620 return C.To_Ada (Dst);
1350 Buffer (Length .. Length + Len - 1) := Img (2 .. Img'Last);
1351 Length := Length + Len;
1352 end Img10;
1353
1354 -----------
1355 -- Img16 --
1356 -----------
1357
1358 procedure Img16 (V : Inet_Addr_Comp_Type) is
1359 begin
1360 Buffer (Length) := Hex_To_Char (Natural (V / 16) + 1);
1361 Buffer (Length + 1) := Hex_To_Char (Natural (V mod 16) + 1);
1362 Length := Length + 2;
1363 end Img16;
1364
1365 -- Start of processing for Image
1366
1367 begin
1368 Separator := (if Hex then ':' else '.');
1369
1370 for J in Val'Range loop
1371 if Hex then
1372 Img16 (Val (J));
1373 else
1374 Img10 (Val (J));
1375 end if;
1376
1377 if J /= Val'Last then
1378 Buffer (Length) := Separator;
1379 Length := Length + 1;
1380 end if;
1381 end loop;
1382
1383 return Buffer (1 .. Length - 1);
1384 end Image; 1621 end Image;
1385 1622
1386 ----------- 1623 -----------
1387 -- Image -- 1624 -- Image --
1388 ----------- 1625 -----------
1389 1626
1390 function Image (Value : Inet_Addr_Type) return String is
1391 begin
1392 if Value.Family = Family_Inet then
1393 return Image (Inet_Addr_Bytes (Value.Sin_V4), Hex => False);
1394 else
1395 return Image (Inet_Addr_Bytes (Value.Sin_V6), Hex => True);
1396 end if;
1397 end Image;
1398
1399 -----------
1400 -- Image --
1401 -----------
1402
1403 function Image (Value : Sock_Addr_Type) return String is 1627 function Image (Value : Sock_Addr_Type) return String is
1404 Port : constant String := Value.Port'Img; 1628 function Ipv6_Brackets (S : String) return String is
1405 begin 1629 (if Value.Family = Family_Inet6 then "[" & S & "]" else S);
1406 return Image (Value.Addr) & ':' & Port (2 .. Port'Last); 1630 begin
1631 case Value.Family is
1632 when Family_Unix =>
1633 if ASU.Length (Value.Name) > 0
1634 and then ASU.Element (Value.Name, 1) = ASCII.NUL
1635 then
1636 return '@' & ASU.Slice (Value.Name, 2, ASU.Length (Value.Name));
1637 else
1638 return ASU.To_String (Value.Name);
1639 end if;
1640
1641 when Family_Inet_4_6 =>
1642 declare
1643 Port : constant String := Value.Port'Img;
1644 begin
1645 return Ipv6_Brackets (Image (Value.Addr)) & ':'
1646 & Port (2 .. Port'Last);
1647 end;
1648
1649 when Family_Unspec =>
1650 return "";
1651 end case;
1407 end Image; 1652 end Image;
1408 1653
1409 ----------- 1654 -----------
1410 -- Image -- 1655 -- Image --
1411 ----------- 1656 -----------
1452 1697
1453 function Inet_Addr (Image : String) return Inet_Addr_Type is 1698 function Inet_Addr (Image : String) return Inet_Addr_Type is
1454 use Interfaces.C; 1699 use Interfaces.C;
1455 1700
1456 Img : aliased char_array := To_C (Image); 1701 Img : aliased char_array := To_C (Image);
1457 Addr : aliased C.int;
1458 Res : C.int; 1702 Res : C.int;
1459 Result : Inet_Addr_Type; 1703 Result : Inet_Addr_Type;
1460 1704 IPv6 : constant Boolean := Is_IPv6_Address (Image);
1705 Ia : aliased In_Addr_Union
1706 (if IPv6 then Family_Inet6 else Family_Inet);
1461 begin 1707 begin
1462 -- Special case for an empty Image as on some platforms (e.g. Windows) 1708 -- Special case for an empty Image as on some platforms (e.g. Windows)
1463 -- calling Inet_Addr("") will not return an error. 1709 -- calling Inet_Addr("") will not return an error.
1464 1710
1465 if Image = "" then 1711 if Image = "" then
1466 Raise_Socket_Error (SOSC.EINVAL); 1712 Raise_Socket_Error (SOSC.EINVAL);
1467 end if; 1713 end if;
1468 1714
1469 Res := Inet_Pton (SOSC.AF_INET, Img'Address, Addr'Address); 1715 Res := Inet_Pton
1716 ((if IPv6 then SOSC.AF_INET6 else SOSC.AF_INET), Img'Address,
1717 Ia'Address);
1470 1718
1471 if Res < 0 then 1719 if Res < 0 then
1472 Raise_Socket_Error (Socket_Errno); 1720 Raise_Socket_Error (Socket_Errno);
1473 1721
1474 elsif Res = 0 then 1722 elsif Res = 0 then
1475 Raise_Socket_Error (SOSC.EINVAL); 1723 Raise_Socket_Error (SOSC.EINVAL);
1476 end if; 1724 end if;
1477 1725
1478 To_Inet_Addr (To_In_Addr (Addr), Result); 1726 if IPv6 then
1727 To_Inet_Addr (Ia.In6, Result);
1728 else
1729 To_Inet_Addr (Ia.In4, Result);
1730 end if;
1731
1479 return Result; 1732 return Result;
1480 end Inet_Addr; 1733 end Inet_Addr;
1481 1734
1482 ---------------- 1735 ----------------
1483 -- Initialize -- 1736 -- Initialize --
1523 -- of Sockets_Library_Controller. 1776 -- of Sockets_Library_Controller.
1524 1777
1525 null; 1778 null;
1526 end Initialize; 1779 end Initialize;
1527 1780
1781 ----------------
1782 -- Is_Windows --
1783 ----------------
1784
1785 function Is_Windows return Boolean is
1786 use SOSC;
1787 begin
1788 return Target_OS = Windows;
1789 end Is_Windows;
1790
1528 -------------- 1791 --------------
1529 -- Is_Empty -- 1792 -- Is_Empty --
1530 -------------- 1793 --------------
1531 1794
1532 function Is_Empty (Item : Socket_Set_Type) return Boolean is 1795 function Is_Empty (Item : Socket_Set_Type) return Boolean is
1533 begin 1796 begin
1534 return Item.Last = No_Socket; 1797 return Item.Last = No_Socket;
1535 end Is_Empty; 1798 end Is_Empty;
1536 1799
1537 ------------------- 1800 ---------------------
1538 -- Is_IP_Address -- 1801 -- Is_IPv6_Address --
1539 ------------------- 1802 ---------------------
1540 1803
1541 function Is_IP_Address (Name : String) return Boolean is 1804 function Is_IPv6_Address (Name : String) return Boolean is
1805 Prev_Colon : Natural := 0;
1806 Double_Colon : Boolean := False;
1807 Colons : Natural := 0;
1808 begin
1809 for J in Name'Range loop
1810 if Name (J) = ':' then
1811 Colons := Colons + 1;
1812
1813 if Prev_Colon > 0 and then J = Prev_Colon + 1 then
1814 if Double_Colon then
1815 -- Only one double colon allowed
1816 return False;
1817 end if;
1818
1819 Double_Colon := True;
1820
1821 elsif J = Name'Last then
1822 -- Single colon at the end is not allowed
1823 return False;
1824 end if;
1825
1826 Prev_Colon := J;
1827
1828 elsif Prev_Colon = Name'First then
1829 -- Single colon at start is not allowed
1830 return False;
1831
1832 elsif Name (J) = '.' then
1833 return Prev_Colon > 0
1834 and then Is_IPv4_Address (Name (Prev_Colon + 1 .. Name'Last));
1835
1836 elsif Name (J) not in '0' .. '9' | 'A' .. 'F' | 'a' .. 'f' then
1837 return False;
1838
1839 end if;
1840 end loop;
1841
1842 return Colons in 2 .. 8;
1843 end Is_IPv6_Address;
1844
1845 ---------------------
1846 -- Is_IPv4_Address --
1847 ---------------------
1848
1849 function Is_IPv4_Address (Name : String) return Boolean is
1542 Dots : Natural := 0; 1850 Dots : Natural := 0;
1543 1851
1544 begin 1852 begin
1545 -- Perform a cursory check for a dotted quad: we must have 1 to 3 dots, 1853 -- Perform a cursory check for a dotted quad: we must have 1 to 3 dots,
1546 -- and there must be at least one digit around each. 1854 -- and there must be at least one digit around each.
1567 return False; 1875 return False;
1568 end if; 1876 end if;
1569 end loop; 1877 end loop;
1570 1878
1571 return Dots in 1 .. 3; 1879 return Dots in 1 .. 3;
1572 end Is_IP_Address; 1880 end Is_IPv4_Address;
1573 1881
1574 ------------- 1882 -------------
1575 -- Is_Open -- 1883 -- Is_Open --
1576 ------------- 1884 -------------
1577 1885
1655 begin 1963 begin
1656 if Need_Netdb_Lock then 1964 if Need_Netdb_Lock then
1657 System.Task_Lock.Unlock; 1965 System.Task_Lock.Unlock;
1658 end if; 1966 end if;
1659 end Netdb_Unlock; 1967 end Netdb_Unlock;
1968
1969 ----------------------------
1970 -- Network_Socket_Address --
1971 ----------------------------
1972
1973 function Network_Socket_Address
1974 (Addr : Inet_Addr_Type; Port : Port_Type) return Sock_Addr_Type is
1975 begin
1976 return Result : Sock_Addr_Type (Addr.Family) do
1977 Result.Addr := Addr;
1978 Result.Port := Port;
1979 end return;
1980 end Network_Socket_Address;
1660 1981
1661 -------------------------------- 1982 --------------------------------
1662 -- Normalize_Empty_Socket_Set -- 1983 -- Normalize_Empty_Socket_Set --
1663 -------------------------------- 1984 --------------------------------
1664 1985
1756 ---------------------- 2077 ----------------------
1757 -- Raise_Host_Error -- 2078 -- Raise_Host_Error --
1758 ---------------------- 2079 ----------------------
1759 2080
1760 procedure Raise_Host_Error (H_Error : Integer; Name : String) is 2081 procedure Raise_Host_Error (H_Error : Integer; Name : String) is
1761 function Dedot (Value : String) return String is
1762 (if Value /= "" and then Value (Value'Last) = '.' then
1763 Value (Value'First .. Value'Last - 1)
1764 else
1765 Value);
1766 -- Removes dot at the end of error message
1767
1768 begin 2082 begin
1769 raise Host_Error with 2083 raise Host_Error with
1770 Err_Code_Image (H_Error) 2084 Err_Code_Image (H_Error)
1771 & Dedot (Host_Error_Messages.Host_Error_Message (H_Error)) 2085 & Dedot (Host_Error_Messages.Host_Error_Message (H_Error))
1772 & ": " & Name; 2086 & ": " & Name;
1859 Last : out Ada.Streams.Stream_Element_Offset; 2173 Last : out Ada.Streams.Stream_Element_Offset;
1860 From : out Sock_Addr_Type; 2174 From : out Sock_Addr_Type;
1861 Flags : Request_Flag_Type := No_Request_Flag) 2175 Flags : Request_Flag_Type := No_Request_Flag)
1862 is 2176 is
1863 Res : C.int; 2177 Res : C.int;
1864 Sin : aliased Sockaddr_In; 2178 Sin : aliased Sockaddr;
1865 Len : aliased C.int := Sin'Size / 8; 2179 Len : aliased C.int := Sin'Size / 8;
1866 2180
1867 begin 2181 begin
1868 Res := 2182 Res :=
1869 C_Recvfrom 2183 C_Recvfrom
1878 Raise_Socket_Error (Socket_Errno); 2192 Raise_Socket_Error (Socket_Errno);
1879 end if; 2193 end if;
1880 2194
1881 Last := Last_Index (First => Item'First, Count => size_t (Res)); 2195 Last := Last_Index (First => Item'First, Count => size_t (Res));
1882 2196
1883 To_Inet_Addr (Sin.Sin_Addr, From.Addr); 2197 From := Get_Address (Sin, Len);
1884 From.Port := Port_Type (Network_To_Short (Sin.Sin_Port));
1885 end Receive_Socket; 2198 end Receive_Socket;
1886 2199
1887 -------------------- 2200 --------------------
1888 -- Receive_Vector -- 2201 -- Receive_Vector --
1889 -------------------- 2202 --------------------
2138 To : access Sock_Addr_Type; 2451 To : access Sock_Addr_Type;
2139 Flags : Request_Flag_Type := No_Request_Flag) 2452 Flags : Request_Flag_Type := No_Request_Flag)
2140 is 2453 is
2141 Res : C.int; 2454 Res : C.int;
2142 2455
2143 Sin : aliased Sockaddr_In; 2456 Sin : aliased Sockaddr;
2144 C_To : System.Address; 2457 C_To : System.Address;
2145 Len : C.int; 2458 Len : C.int;
2146 2459
2147 begin 2460 begin
2148 if To /= null then 2461 if To /= null then
2149 Set_Family (Sin.Sin_Family, To.Family); 2462 Set_Address (Sin'Unchecked_Access, To.all, Len);
2150 Set_Address (Sin'Unchecked_Access, To_In_Addr (To.Addr));
2151 Set_Port
2152 (Sin'Unchecked_Access,
2153 Short_To_Network (C.unsigned_short (To.Port)));
2154 C_To := Sin'Address; 2463 C_To := Sin'Address;
2155 Len := Sin'Size / 8;
2156 2464
2157 else 2465 else
2158 C_To := System.Null_Address; 2466 C_To := System.Null_Address;
2159 Len := 0; 2467 Len := 0;
2160 end if; 2468 end if;
2287 -- Set_Socket_Option -- 2595 -- Set_Socket_Option --
2288 ----------------------- 2596 -----------------------
2289 2597
2290 procedure Set_Socket_Option 2598 procedure Set_Socket_Option
2291 (Socket : Socket_Type; 2599 (Socket : Socket_Type;
2292 Level : Level_Type := Socket_Level; 2600 Level : Level_Type;
2293 Option : Option_Type) 2601 Option : Option_Type)
2294 is 2602 is
2295 use SOSC; 2603 use type C.unsigned;
2296 2604
2605 MR : aliased IPV6_Mreq;
2297 V8 : aliased Two_Ints; 2606 V8 : aliased Two_Ints;
2298 V4 : aliased C.int; 2607 V4 : aliased C.int;
2608 U4 : aliased C.unsigned;
2299 V1 : aliased C.unsigned_char; 2609 V1 : aliased C.unsigned_char;
2300 VT : aliased Timeval; 2610 VT : aliased Timeval;
2301 Len : C.int; 2611 Len : C.int;
2302 Add : System.Address := Null_Address; 2612 Add : System.Address := Null_Address;
2303 Res : C.int; 2613 Res : C.int;
2312 2622
2313 when Broadcast 2623 when Broadcast
2314 | Keep_Alive 2624 | Keep_Alive
2315 | No_Delay 2625 | No_Delay
2316 | Reuse_Address 2626 | Reuse_Address
2627 | Multicast_Loop_V4
2628 | Multicast_Loop_V6
2629 | IPv6_Only
2317 => 2630 =>
2318 V4 := C.int (Boolean'Pos (Option.Enabled)); 2631 V4 := C.int (Boolean'Pos (Option.Enabled));
2319 Len := V4'Size / 8; 2632 Len := V4'Size / 8;
2320 Add := V4'Address; 2633 Add := V4'Address;
2321 2634
2340 when Error => 2653 when Error =>
2341 V4 := C.int (Boolean'Pos (True)); 2654 V4 := C.int (Boolean'Pos (True));
2342 Len := V4'Size / 8; 2655 Len := V4'Size / 8;
2343 Add := V4'Address; 2656 Add := V4'Address;
2344 2657
2345 when Add_Membership 2658 when Add_Membership_V4
2346 | Drop_Membership 2659 | Drop_Membership_V4
2347 => 2660 =>
2348 V8 (V8'First) := To_Int (To_In_Addr (Option.Multicast_Address)); 2661 V8 (V8'First) := To_Int (To_In_Addr (Option.Multicast_Address));
2349 V8 (V8'Last) := To_Int (To_In_Addr (Option.Local_Interface)); 2662 V8 (V8'Last) := To_Int (To_In_Addr (Option.Local_Interface));
2350 Len := V8'Size / 8; 2663 Len := V8'Size / 8;
2351 Add := V8'Address; 2664 Add := V8'Address;
2352 2665
2353 when Multicast_If => 2666 when Add_Membership_V6
2667 | Drop_Membership_V6 =>
2668 MR.ipv6mr_multiaddr := To_In6_Addr (Option.Multicast_Address);
2669 MR.ipv6mr_interface := C.unsigned (Option.Interface_Index);
2670 Len := MR'Size / 8;
2671 Add := MR'Address;
2672
2673 when Multicast_If_V4 =>
2354 V4 := To_Int (To_In_Addr (Option.Outgoing_If)); 2674 V4 := To_Int (To_In_Addr (Option.Outgoing_If));
2675 Len := V4'Size / 8;
2676 Add := V4'Address;
2677
2678 when Multicast_If_V6 =>
2679 V4 := C.int (Option.Outgoing_If_Index);
2355 Len := V4'Size / 8; 2680 Len := V4'Size / 8;
2356 Add := V4'Address; 2681 Add := V4'Address;
2357 2682
2358 when Multicast_TTL => 2683 when Multicast_TTL =>
2359 V1 := C.unsigned_char (Option.Time_To_Live); 2684 V1 := C.unsigned_char (Option.Time_To_Live);
2360 Len := V1'Size / 8; 2685 Len := V1'Size / 8;
2361 Add := V1'Address; 2686 Add := V1'Address;
2362 2687
2363 when Multicast_Loop 2688 when Multicast_Hops =>
2364 | Receive_Packet_Info 2689 V4 := C.int (Option.Hop_Limit);
2690 Len := V4'Size / 8;
2691 Add := V4'Address;
2692
2693 when Receive_Packet_Info
2365 => 2694 =>
2366 V1 := C.unsigned_char (Boolean'Pos (Option.Enabled)); 2695 V1 := C.unsigned_char (Boolean'Pos (Option.Enabled));
2367 Len := V1'Size / 8; 2696 Len := V1'Size / 8;
2368 Add := V1'Address; 2697 Add := V1'Address;
2369 2698
2370 when Receive_Timeout 2699 when Receive_Timeout
2371 | Send_Timeout 2700 | Send_Timeout
2372 => 2701 =>
2373 if Target_OS = Windows then 2702 if Is_Windows then
2374 2703
2375 -- On Windows, the timeout is a DWORD in milliseconds, and 2704 -- On Windows, the timeout is a DWORD in milliseconds
2376 -- the actual timeout is 500 ms + the given value (unless it 2705
2377 -- is 0). 2706 Len := U4'Size / 8;
2378 2707 Add := U4'Address;
2379 V4 := C.int (Option.Timeout / 0.001); 2708
2380 2709 U4 := C.unsigned (Option.Timeout / 0.001);
2381 if V4 > 500 then 2710
2382 V4 := V4 - 500; 2711 if Option.Timeout > 0.0 and then U4 = 0 then
2383 2712 -- Avoid round to zero. Zero timeout mean unlimited.
2384 elsif V4 > 0 then 2713 U4 := 1;
2385 V4 := 1;
2386 end if; 2714 end if;
2387 2715
2388 Len := V4'Size / 8; 2716 -- Old windows versions actual timeout is 500 ms + the given
2389 Add := V4'Address; 2717 -- value (unless it is 0).
2718
2719 if Minus_500ms_Windows_Timeout /= 0 then
2720 if U4 > 500 then
2721 U4 := U4 - 500;
2722
2723 elsif U4 > 0 then
2724 U4 := 1;
2725 end if;
2726 end if;
2390 2727
2391 else 2728 else
2392 VT := To_Timeval (Option.Timeout); 2729 VT := To_Timeval (Option.Timeout);
2393 Len := VT'Size / 8; 2730 Len := VT'Size / 8;
2394 Add := VT'Address; 2731 Add := VT'Address;
2414 if Res = Failure then 2751 if Res = Failure then
2415 Raise_Socket_Error (Socket_Errno); 2752 Raise_Socket_Error (Socket_Errno);
2416 end if; 2753 end if;
2417 end Set_Socket_Option; 2754 end Set_Socket_Option;
2418 2755
2419 ----------------------
2420 -- Short_To_Network --
2421 ----------------------
2422
2423 function Short_To_Network (S : C.unsigned_short) return C.unsigned_short is
2424 use type C.unsigned_short;
2425
2426 begin
2427 -- Big-endian case. No conversion needed. On these platforms, htons()
2428 -- defaults to a null procedure.
2429
2430 if Default_Bit_Order = High_Order_First then
2431 return S;
2432
2433 -- Little-endian case. We must swap the high and low bytes of this
2434 -- short to make the port number network compliant.
2435
2436 else
2437 return (S / 256) + (S mod 256) * 256;
2438 end if;
2439 end Short_To_Network;
2440
2441 --------------------- 2756 ---------------------
2442 -- Shutdown_Socket -- 2757 -- Shutdown_Socket --
2443 --------------------- 2758 ---------------------
2444 2759
2445 procedure Shutdown_Socket 2760 procedure Shutdown_Socket
2507 ----------------- 2822 -----------------
2508 -- To_Duration -- 2823 -- To_Duration --
2509 ----------------- 2824 -----------------
2510 2825
2511 function To_Duration (Val : Timeval) return Timeval_Duration is 2826 function To_Duration (Val : Timeval) return Timeval_Duration is
2512 begin 2827 Max_D : constant Long_Long_Integer := Long_Long_Integer (Forever - 0.5);
2513 return Natural (Val.Tv_Sec) * 1.0 + Natural (Val.Tv_Usec) * 1.0E-6; 2828 Tv_sec_64 : constant Boolean := SOSC.SIZEOF_tv_sec = 8;
2829 -- Need to separate this condition into the constant declaration to
2830 -- avoid GNAT warning about "always true" or "always false".
2831 begin
2832 if Tv_sec_64 then
2833 -- Check for possible Duration overflow when Tv_Sec field is 64 bit
2834 -- integer.
2835
2836 if Val.Tv_Sec > time_t (Max_D) or else
2837 (Val.Tv_Sec = time_t (Max_D) and then
2838 Val.Tv_Usec > suseconds_t ((Forever - Duration (Max_D)) * 1E6))
2839 then
2840 return Forever;
2841 end if;
2842 end if;
2843
2844 return Duration (Val.Tv_Sec) + Duration (Val.Tv_Usec) * 1.0E-6;
2514 end To_Duration; 2845 end To_Duration;
2515 2846
2516 ------------------- 2847 -------------------
2517 -- To_Host_Entry -- 2848 -- To_Host_Entry --
2518 ------------------- 2849 -------------------
2519 2850
2520 function To_Host_Entry (E : Hostent_Access) return Host_Entry_Type is 2851 function To_Host_Entry (E : Hostent_Access) return Host_Entry_Type is
2521 use type C.size_t;
2522
2523 Aliases_Count, Addresses_Count : Natural; 2852 Aliases_Count, Addresses_Count : Natural;
2524 2853
2525 -- H_Length is not used because it is currently only ever set to 4, as 2854 Family : constant Family_Type :=
2526 -- we only handle the case of H_Addrtype being AF_INET. 2855 (case Hostent_H_Addrtype (E) is
2527 2856 when SOSC.AF_INET => Family_Inet,
2528 begin 2857 when SOSC.AF_INET6 => Family_Inet6,
2529 if Hostent_H_Addrtype (E) /= SOSC.AF_INET then 2858 when others => Family_Unspec);
2859
2860 Addr_Len : constant C.size_t := C.size_t (Hostent_H_Length (E));
2861
2862 begin
2863 if Family = Family_Unspec then
2530 Raise_Socket_Error (SOSC.EPFNOSUPPORT); 2864 Raise_Socket_Error (SOSC.EPFNOSUPPORT);
2531 end if; 2865 end if;
2532 2866
2533 Aliases_Count := 0; 2867 Aliases_Count := 0;
2534 while Hostent_H_Alias (E, C.int (Aliases_Count)) /= Null_Address loop 2868 while Hostent_H_Alias (E, C.int (Aliases_Count)) /= Null_Address loop
2552 (E, C.int (J - Result.Aliases'First)))); 2886 (E, C.int (J - Result.Aliases'First))));
2553 end loop; 2887 end loop;
2554 2888
2555 for J in Result.Addresses'Range loop 2889 for J in Result.Addresses'Range loop
2556 declare 2890 declare
2557 Addr : In_Addr; 2891 Ia : In_Addr_Union (Family);
2558 2892
2559 -- Hostent_H_Addr (E, <index>) may return an address that is 2893 -- Hostent_H_Addr (E, <index>) may return an address that is
2560 -- not correctly aligned for In_Addr, so we need to use 2894 -- not correctly aligned for In_Addr, so we need to use
2561 -- an intermediate copy operation on a type with an alignment 2895 -- an intermediate copy operation on a type with an alignment
2562 -- of 1 to recover the value. 2896 -- of 1 to recover the value.
2563 2897
2564 subtype Addr_Buf_T is C.char_array (1 .. Addr'Size / 8); 2898 subtype Addr_Buf_T is C.char_array (1 .. Addr_Len);
2565 Unaligned_Addr : Addr_Buf_T; 2899 Unaligned_Addr : Addr_Buf_T;
2566 for Unaligned_Addr'Address 2900 for Unaligned_Addr'Address
2567 use Hostent_H_Addr (E, C.int (J - Result.Addresses'First)); 2901 use Hostent_H_Addr (E, C.int (J - Result.Addresses'First));
2568 pragma Import (Ada, Unaligned_Addr); 2902 pragma Import (Ada, Unaligned_Addr);
2569 2903
2570 Aligned_Addr : Addr_Buf_T; 2904 Aligned_Addr : Addr_Buf_T;
2571 for Aligned_Addr'Address use Addr'Address; 2905 for Aligned_Addr'Address use Ia'Address;
2572 pragma Import (Ada, Aligned_Addr); 2906 pragma Import (Ada, Aligned_Addr);
2573 2907
2574 begin 2908 begin
2575 Aligned_Addr := Unaligned_Addr; 2909 Aligned_Addr := Unaligned_Addr;
2576 To_Inet_Addr (Addr, Result.Addresses (J)); 2910 if Family = Family_Inet6 then
2911 To_Inet_Addr (Ia.In6, Result.Addresses (J));
2912 else
2913 To_Inet_Addr (Ia.In4, Result.Addresses (J));
2914 end if;
2577 end; 2915 end;
2578 end loop; 2916 end loop;
2579 end return; 2917 end return;
2580 end To_Host_Entry; 2918 end To_Host_Entry;
2581
2582 ----------------
2583 -- To_In_Addr --
2584 ----------------
2585
2586 function To_In_Addr (Addr : Inet_Addr_Type) return In_Addr is
2587 begin
2588 if Addr.Family = Family_Inet then
2589 return (S_B1 => C.unsigned_char (Addr.Sin_V4 (1)),
2590 S_B2 => C.unsigned_char (Addr.Sin_V4 (2)),
2591 S_B3 => C.unsigned_char (Addr.Sin_V4 (3)),
2592 S_B4 => C.unsigned_char (Addr.Sin_V4 (4)));
2593 end if;
2594
2595 raise Socket_Error with "IPv6 not supported";
2596 end To_In_Addr;
2597
2598 ------------------
2599 -- To_Inet_Addr --
2600 ------------------
2601
2602 procedure To_Inet_Addr
2603 (Addr : In_Addr;
2604 Result : out Inet_Addr_Type) is
2605 begin
2606 Result.Sin_V4 (1) := Inet_Addr_Comp_Type (Addr.S_B1);
2607 Result.Sin_V4 (2) := Inet_Addr_Comp_Type (Addr.S_B2);
2608 Result.Sin_V4 (3) := Inet_Addr_Comp_Type (Addr.S_B3);
2609 Result.Sin_V4 (4) := Inet_Addr_Comp_Type (Addr.S_B4);
2610 end To_Inet_Addr;
2611 2919
2612 ------------ 2920 ------------
2613 -- To_Int -- 2921 -- To_Int --
2614 ------------ 2922 ------------
2615 2923
2699 3007
2700 -- Normal case where we do round down 3008 -- Normal case where we do round down
2701 3009
2702 else 3010 else
2703 S := time_t (Val - 0.5); 3011 S := time_t (Val - 0.5);
2704 uS := suseconds_t (1_000_000 * (Val - Selector_Duration (S))); 3012 uS := suseconds_t (1_000_000 * (Val - Selector_Duration (S)) - 0.5);
3013
3014 if uS = -1 then
3015 -- It happen on integer duration
3016 uS := 0;
3017 end if;
2705 end if; 3018 end if;
2706 3019
2707 return (S, uS); 3020 return (S, uS);
2708 end To_Timeval; 3021 end To_Timeval;
2709 3022
2794 -------------------- 3107 --------------------
2795 -- Create_Address -- 3108 -- Create_Address --
2796 -------------------- 3109 --------------------
2797 3110
2798 function Create_Address 3111 function Create_Address
2799 (Family : Family_Type; Bytes : Inet_Addr_Bytes) return Inet_Addr_Type 3112 (Family : Family_Inet_4_6; Bytes : Inet_Addr_Bytes) return Inet_Addr_Type
2800 is 3113 is
2801 (case Family is 3114 (case Family is
2802 when Family_Inet => (Family_Inet, Bytes), 3115 when Family_Inet => (Family_Inet, Bytes),
2803 when Family_Inet6 => (Family_Inet6, Bytes)); 3116 when Family_Inet6 => (Family_Inet6, Bytes));
2804 3117
2814 ---------- 3127 ----------
2815 -- Mask -- 3128 -- Mask --
2816 ---------- 3129 ----------
2817 3130
2818 function Mask 3131 function Mask
2819 (Family : Family_Type; 3132 (Family : Family_Inet_4_6;
2820 Length : Natural; 3133 Length : Natural;
2821 Host : Boolean := False) return Inet_Addr_Type 3134 Host : Boolean := False) return Inet_Addr_Type
2822 is 3135 is
2823 Addr_Len : constant Natural := Inet_Addr_Bytes_Length (Family); 3136 Addr_Len : constant Natural := Inet_Addr_Bytes_Length (Family);
2824 begin 3137 begin
2846 3159
2847 return Create_Address (Family, B); 3160 return Create_Address (Family, B);
2848 end; 3161 end;
2849 end Mask; 3162 end Mask;
2850 3163
3164 -------------------------
3165 -- Unix_Socket_Address --
3166 -------------------------
3167
3168 function Unix_Socket_Address (Addr : String) return Sock_Addr_Type is
3169 begin
3170 return Sock_Addr_Type'(Family_Unix, ASU.To_Unbounded_String (Addr));
3171 end Unix_Socket_Address;
3172
2851 ----------- 3173 -----------
2852 -- "and" -- 3174 -- "and" --
2853 ----------- 3175 -----------
2854 3176
2855 function "and" (Addr, Mask : Inet_Addr_Type) return Inet_Addr_Type is 3177 function "and" (Addr, Mask : Inet_Addr_Type) return Inet_Addr_Type is