1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- G N A T . S O C K E T S . T H I N _ C O M M O N -- 6-- -- 7-- S p e c -- 8-- -- 9-- Copyright (C) 2008-2021, AdaCore -- 10-- -- 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. -- 17-- -- 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. -- 21-- -- 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/>. -- 26-- -- 27-- GNAT was originally developed by the GNAT team at New York University. -- 28-- Extensive contributions were provided by Ada Core Technologies Inc. -- 29-- -- 30------------------------------------------------------------------------------ 31 32-- This is the target-independent part of the thin sockets mapping. 33-- This package should not be directly with'ed by an applications program. 34 35with Ada.Unchecked_Conversion; 36with Interfaces.C.Strings; 37with System.Parameters; 38 39package GNAT.Sockets.Thin_Common is 40 41 package C renames Interfaces.C; 42 package CS renames C.Strings; 43 44 Success : constant C.int := 0; 45 Failure : constant C.int := -1; 46 47 type time_t is 48 range -2 ** (System.Parameters.time_t_bits - 1) 49 .. 2 ** (System.Parameters.time_t_bits - 1) - 1; 50 for time_t'Size use System.Parameters.time_t_bits; 51 pragma Convention (C, time_t); 52 53 type suseconds_t is 54 range -2 ** (8 * SOSC.SIZEOF_tv_usec - 1) 55 .. 2 ** (8 * SOSC.SIZEOF_tv_usec - 1) - 1; 56 for suseconds_t'Size use 8 * SOSC.SIZEOF_tv_usec; 57 pragma Convention (C, suseconds_t); 58 59 type Timeval is record 60 Tv_Sec : time_t; 61 Tv_Usec : suseconds_t; 62 end record; 63 pragma Convention (C, Timeval); 64 65 type Timeval_Access is access all Timeval; 66 pragma Convention (C, Timeval_Access); 67 68 type socklen_t is mod 2 ** (8 * SOSC.SIZEOF_socklen_t); 69 for socklen_t'Size use (8 * SOSC.SIZEOF_socklen_t); 70 71 Immediat : constant Timeval := (0, 0); 72 73 ------------------------------------------- 74 -- Mapping tables to low level constants -- 75 ------------------------------------------- 76 77 Families : constant array (Family_Type) of C.int := 78 [Family_Unspec => SOSC.AF_UNSPEC, 79 Family_Unix => SOSC.AF_UNIX, 80 Family_Inet => SOSC.AF_INET, 81 Family_Inet6 => SOSC.AF_INET6]; 82 83 Lengths : constant array (Family_Type) of C.unsigned_char := 84 [Family_Unspec => 0, 85 Family_Unix => SOSC.SIZEOF_sockaddr_un, 86 Family_Inet => SOSC.SIZEOF_sockaddr_in, 87 Family_Inet6 => SOSC.SIZEOF_sockaddr_in6]; 88 89 ---------------------------- 90 -- Generic socket address -- 91 ---------------------------- 92 93 -- Common header 94 95 -- All socket address types (struct sockaddr, struct sockaddr_storage, 96 -- and protocol specific address types) start with the same 2-byte header, 97 -- which is either a length and a family (one byte each) or just a two-byte 98 -- family. The following unchecked union describes the two possible layouts 99 -- and is meant to be constrained with SOSC.Have_Sockaddr_Len. 100 101 type Sockaddr_Length_And_Family 102 (Has_Sockaddr_Len : Boolean := False) 103 is record 104 case Has_Sockaddr_Len is 105 when True => 106 Length : C.unsigned_char; 107 Char_Family : C.unsigned_char; 108 109 when False => 110 Short_Family : C.unsigned_short; 111 end case; 112 end record with Unchecked_Union, Convention => C; 113 114 procedure Set_Family 115 (Length_And_Family : out Sockaddr_Length_And_Family; 116 Family : Family_Type); 117 -- Set the family component to the appropriate value for Family, and also 118 -- set Length accordingly if applicable on this platform. 119 120 ---------------------------- 121 -- AF_INET socket address -- 122 ---------------------------- 123 124 type In_Addr is record 125 S_B1, S_B2, S_B3, S_B4 : C.unsigned_char; 126 end record with Convention => C, Alignment => C.int'Alignment; 127 -- IPv4 address, represented as a network-order C.int. Note that the 128 -- underlying operating system may assume that values of this type have 129 -- C.int alignment, so we need to provide a suitable alignment clause here. 130 131 function To_In_Addr is new Ada.Unchecked_Conversion (C.int, In_Addr); 132 function To_Int is new Ada.Unchecked_Conversion (In_Addr, C.int); 133 134 function To_In_Addr (Addr : Inet_Addr_Type) return In_Addr; 135 procedure To_Inet_Addr 136 (Addr : In_Addr; 137 Result : out Inet_Addr_Type); 138 -- Conversion functions 139 140 type In6_Addr is array (1 .. 16) of C.unsigned_char with Convention => C; 141 142 Unix_Name_Length : constant := 108; 143 -- Maximum length for local unix socket name 144 145 function To_In6_Addr (Addr : Inet_Addr_Type) return In6_Addr; 146 procedure To_Inet_Addr 147 (Addr : In6_Addr; 148 Result : out Inet_Addr_Type); 149 -- Conversion functions 150 151 type Sockaddr (Family : Family_Type := Family_Inet) is record 152 case Family is 153 when Family_Inet => 154 Sin_Family : Sockaddr_Length_And_Family; 155 -- Address family (and address length on some platforms) 156 157 Sin_Port : C.unsigned_short; 158 -- Port in network byte order 159 160 Sin_Addr : In_Addr := (others => 0); 161 -- IPv4 address 162 163 Sin_Zero : C.char_array (1 .. 8) := [others => C.nul]; 164 -- Padding 165 -- 166 -- Note that some platforms require that all unused (reserved) bytes 167 -- in addresses be initialized to 0 (e.g. VxWorks). 168 169 when Family_Inet6 => 170 Sin6_Family : Sockaddr_Length_And_Family; 171 -- Address family (and address length on some platforms) 172 173 Sin6_Port : C.unsigned_short; 174 -- Port in network byte order 175 176 Sin6_FlowInfo : Interfaces.Unsigned_32 := 0; 177 Sin6_Addr : In6_Addr := [others => 0]; 178 Sin6_Scope_Id : Interfaces.Unsigned_32 := 0; 179 180 when Family_Unix => 181 Sun_Family : Sockaddr_Length_And_Family; 182 -- Address family (and address length on some platforms) 183 184 Sun_Path : C.char_array (1 .. Unix_Name_Length); 185 186 when Family_Unspec => 187 null; 188 end case; 189 end record with Convention => C, Unchecked_Union; 190 -- Internet socket address 191 192 type Sockaddr_Access is access all Sockaddr; 193 pragma Convention (C, Sockaddr_Access); 194 -- Access to internet socket address 195 196 procedure Set_Address 197 (Sin : Sockaddr_Access; 198 Address : Sock_Addr_Type; 199 Length : out C.int); 200 -- Initialise all necessary fields in Sin from Address. 201 -- Set appropriate Family, Port, and either Sin.Sin_Addr or Sin.Sin6_Addr 202 -- depend on family. 203 -- Set the Length out parameter to the valuable Sockaddr data length. 204 205 function Get_Address (Sin : Sockaddr; Length : C.int) return Sock_Addr_Type; 206 -- Get Sock_Addr_Type from Sockaddr and its valuable data Length 207 208 ------------------ 209 -- Host entries -- 210 ------------------ 211 212 type Hostent is new 213 System.Storage_Elements.Storage_Array (1 .. SOSC.SIZEOF_struct_hostent); 214 for Hostent'Alignment use 8; 215 -- Host entry. This is an opaque type used only via the following 216 -- accessor functions, because 'struct hostent' has different layouts on 217 -- different platforms. 218 219 type Hostent_Access is access all Hostent; 220 pragma Convention (C, Hostent_Access); 221 -- Access to host entry 222 223 function Hostent_H_Name 224 (E : Hostent_Access) return System.Address; 225 226 function Hostent_H_Alias 227 (E : Hostent_Access; I : C.int) return System.Address; 228 229 function Hostent_H_Addrtype 230 (E : Hostent_Access) return C.int; 231 232 function Hostent_H_Length 233 (E : Hostent_Access) return C.int; 234 235 function Hostent_H_Addr 236 (E : Hostent_Access; Index : C.int) return System.Address; 237 238 --------------------- 239 -- Service entries -- 240 --------------------- 241 242 type Servent is new 243 System.Storage_Elements.Storage_Array (1 .. SOSC.SIZEOF_struct_servent); 244 for Servent'Alignment use 8; 245 -- Service entry. This is an opaque type used only via the following 246 -- accessor functions, because 'struct servent' has different layouts on 247 -- different platforms. 248 249 type Servent_Access is access all Servent; 250 pragma Convention (C, Servent_Access); 251 -- Access to service entry 252 253 function Servent_S_Name 254 (E : Servent_Access) return System.Address; 255 256 function Servent_S_Alias 257 (E : Servent_Access; Index : C.int) return System.Address; 258 259 function Servent_S_Port 260 (E : Servent_Access) return C.unsigned_short; 261 262 function Servent_S_Proto 263 (E : Servent_Access) return System.Address; 264 265 ------------------ 266 -- NetDB access -- 267 ------------------ 268 269 -- There are three possible situations for the following NetDB access 270 -- functions: 271 -- - inherently thread safe (case of data returned in a thread specific 272 -- buffer); 273 -- - thread safe using user-provided buffer; 274 -- - thread unsafe. 275 -- 276 -- In the first and third cases, the Buf and Buflen are ignored. In the 277 -- second case, the caller must provide a buffer large enough to 278 -- accommodate the returned data. In the third case, the caller must ensure 279 -- that these functions are called within a critical section. 280 281 function C_Gethostbyname 282 (Name : C.char_array; 283 Ret : not null access Hostent; 284 Buf : System.Address; 285 Buflen : C.size_t; 286 H_Errnop : not null access C.int) return C.int; 287 288 function C_Gethostbyaddr 289 (Addr : System.Address; 290 Addr_Len : C.int; 291 Addr_Type : C.int; 292 Ret : not null access Hostent; 293 Buf : System.Address; 294 Buflen : C.size_t; 295 H_Errnop : not null access C.int) return C.int; 296 297 function C_Getservbyname 298 (Name : C.char_array; 299 Proto : C.char_array; 300 Ret : not null access Servent; 301 Buf : System.Address; 302 Buflen : C.size_t) return C.int; 303 304 function C_Getservbyport 305 (Port : C.int; 306 Proto : C.char_array; 307 Ret : not null access Servent; 308 Buf : System.Address; 309 Buflen : C.size_t) return C.int; 310 311 Address_Size : constant := Standard'Address_Size; 312 313 type Addrinfo; 314 type Addrinfo_Access is access all Addrinfo; 315 316 type Addrinfo is record 317 ai_flags : C.int; 318 ai_family : C.int; 319 ai_socktype : C.int; 320 ai_protocol : C.int; 321 ai_addrlen : socklen_t; 322 ai_addr : Sockaddr_Access; 323 ai_canonname : CS.char_array_access; 324 ai_next : Addrinfo_Access; 325 end record with Convention => C; 326 for Addrinfo use record 327 ai_flags at SOSC.AI_FLAGS_OFFSET range 0 .. C.int'Size - 1; 328 ai_family at SOSC.AI_FAMILY_OFFSET range 0 .. C.int'Size - 1; 329 ai_socktype at SOSC.AI_SOCKTYPE_OFFSET range 0 .. C.int'Size - 1; 330 ai_protocol at SOSC.AI_PROTOCOL_OFFSET range 0 .. C.int'Size - 1; 331 ai_addrlen at SOSC.AI_ADDRLEN_OFFSET range 0 .. socklen_t'Size - 1; 332 ai_canonname at SOSC.AI_CANONNAME_OFFSET range 0 .. Address_Size - 1; 333 ai_addr at SOSC.AI_ADDR_OFFSET range 0 .. Address_Size - 1; 334 ai_next at SOSC.AI_NEXT_OFFSET range 0 .. Address_Size - 1; 335 end record; 336 337 function C_Getaddrinfo 338 (Node : CS.char_array_access; 339 Service : CS.char_array_access; 340 Hints : access constant Addrinfo; 341 Res : not null access Addrinfo_Access) return C.int; 342 343 procedure C_Freeaddrinfo (res : Addrinfo_Access); 344 345 function C_Getnameinfo 346 (sa : Sockaddr_Access; 347 salen : socklen_t; 348 host : CS.char_array_access; 349 hostlen : C.size_t; 350 serv : CS.char_array_access; 351 servlen : C.size_t; 352 flags : C.int) return C.int; 353 354 function C_GAI_Strerror (ecode : C.int) return CS.chars_ptr; 355 356 ------------------------------------ 357 -- Scatter/gather vector handling -- 358 ------------------------------------ 359 360 type Msghdr is record 361 Msg_Name : System.Address; 362 Msg_Namelen : C.unsigned; 363 Msg_Iov : System.Address; 364 Msg_Iovlen : SOSC.Msg_Iovlen_T; 365 Msg_Control : System.Address; 366 Msg_Controllen : C.size_t; 367 Msg_Flags : C.int; 368 end record; 369 pragma Convention (C, Msghdr); 370 371 ---------------------------- 372 -- Socket sets management -- 373 ---------------------------- 374 375 procedure Get_Socket_From_Set 376 (Set : access Fd_Set; 377 Last : access C.int; 378 Socket : access C.int); 379 -- Get last socket in Socket and remove it from the socket set. The 380 -- parameter Last is a maximum value of the largest socket. This hint is 381 -- used to avoid scanning very large socket sets. After a call to 382 -- Get_Socket_From_Set, Last is set back to the real largest socket in the 383 -- socket set. 384 385 procedure Insert_Socket_In_Set 386 (Set : access Fd_Set; 387 Socket : C.int); 388 -- Insert socket in the socket set 389 390 function Is_Socket_In_Set 391 (Set : access constant Fd_Set; 392 Socket : C.int) return C.int; 393 -- Check whether Socket is in the socket set, return a non-zero 394 -- value if it is, zero if it is not. 395 396 procedure Last_Socket_In_Set 397 (Set : access Fd_Set; 398 Last : access C.int); 399 -- Find the largest socket in the socket set. This is needed for select(). 400 -- When Last_Socket_In_Set is called, parameter Last is a maximum value of 401 -- the largest socket. This hint is used to avoid scanning very large 402 -- socket sets. After the call, Last is set back to the real largest socket 403 -- in the socket set. 404 405 procedure Remove_Socket_From_Set (Set : access Fd_Set; Socket : C.int); 406 -- Remove socket from the socket set 407 408 procedure Reset_Socket_Set (Set : access Fd_Set); 409 -- Make Set empty 410 411 ------------------------------------------ 412 -- Pairs of signalling file descriptors -- 413 ------------------------------------------ 414 415 type Two_Ints is array (0 .. 1) of C.int; 416 pragma Convention (C, Two_Ints); 417 -- Container for two int values 418 419 subtype Fd_Pair is Two_Ints; 420 -- Two_Ints as used for Create_Signalling_Fds: a pair of connected file 421 -- descriptors, one of which (the "read end" of the connection) being used 422 -- for reading, the other one (the "write end") being used for writing. 423 424 Read_End : constant := 0; 425 Write_End : constant := 1; 426 -- Indexes into an Fd_Pair value providing access to each of the connected 427 -- file descriptors. 428 429 function Inet_Pton 430 (Af : C.int; 431 Cp : System.Address; 432 Inp : System.Address) return C.int; 433 434 function Inet_Ntop 435 (Af : C.int; 436 Src : System.Address; 437 Dst : CS.char_array_access; 438 Size : socklen_t) return CS.char_array_access; 439 440 function C_Ioctl 441 (Fd : C.int; 442 Req : SOSC.IOCTL_Req_T; 443 Arg : access C.int) return C.int; 444 445 function Short_To_Network 446 (S : C.unsigned_short) return C.unsigned_short; 447 pragma Inline (Short_To_Network); 448 -- Convert a port number into a network port number 449 450 function Network_To_Short 451 (S : C.unsigned_short) return C.unsigned_short 452 renames Short_To_Network; 453 -- Symmetric operation 454 455 Minus_500ms_Windows_Timeout : constant Boolean; 456 -- Microsoft Windows desktop older then 8.0 and Microsoft Windows Server 457 -- older than 2019 need timeout correction for 500 milliseconds. This 458 -- constant is True for such versions. 459 460private 461 462 function Get_Minus_500ms_Timeout return C.int 463 with Import, Convention => C, External_Name => "__gnat_minus_500ms"; 464 465 Minus_500ms_Windows_Timeout : constant Boolean := 466 Get_Minus_500ms_Timeout /= 0; 467 468 pragma Import (C, Get_Socket_From_Set, "__gnat_get_socket_from_set"); 469 pragma Import (C, Is_Socket_In_Set, "__gnat_is_socket_in_set"); 470 pragma Import (C, Last_Socket_In_Set, "__gnat_last_socket_in_set"); 471 pragma Import (C, Insert_Socket_In_Set, "__gnat_insert_socket_in_set"); 472 pragma Import (C, Remove_Socket_From_Set, "__gnat_remove_socket_from_set"); 473 pragma Import (C, Reset_Socket_Set, "__gnat_reset_socket_set"); 474 pragma Import (C, C_Ioctl, "__gnat_socket_ioctl"); 475 pragma Import (C, Inet_Pton, SOSC.Inet_Pton_Linkname); 476 pragma Import (C, Inet_Ntop, SOSC.Inet_Ntop_Linkname); 477 478 pragma Import (C, C_Gethostbyname, "__gnat_gethostbyname"); 479 pragma Import (C, C_Gethostbyaddr, "__gnat_gethostbyaddr"); 480 pragma Import (C, C_Getservbyname, "__gnat_getservbyname"); 481 pragma Import (C, C_Getservbyport, "__gnat_getservbyport"); 482 483 pragma Import (C, C_Getaddrinfo, "__gnat_getaddrinfo"); 484 pragma Import (C, C_Freeaddrinfo, "__gnat_freeaddrinfo"); 485 pragma Import (C, C_Getnameinfo, "__gnat_getnameinfo"); 486 pragma Import (C, C_GAI_Strerror, "__gnat_gai_strerror"); 487 488 pragma Import (C, Servent_S_Name, "__gnat_servent_s_name"); 489 pragma Import (C, Servent_S_Alias, "__gnat_servent_s_alias"); 490 pragma Import (C, Servent_S_Port, "__gnat_servent_s_port"); 491 pragma Import (C, Servent_S_Proto, "__gnat_servent_s_proto"); 492 493 pragma Import (C, Hostent_H_Name, "__gnat_hostent_h_name"); 494 pragma Import (C, Hostent_H_Alias, "__gnat_hostent_h_alias"); 495 pragma Import (C, Hostent_H_Addrtype, "__gnat_hostent_h_addrtype"); 496 pragma Import (C, Hostent_H_Length, "__gnat_hostent_h_length"); 497 pragma Import (C, Hostent_H_Addr, "__gnat_hostent_h_addr"); 498 499end GNAT.Sockets.Thin_Common; 500