File : g-socthi-mingw.adb


   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                    G N A T . S O C K E T S . T H I N                     --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --                     Copyright (C) 2001-2014, 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 --                                                                          --
  19 --                                                                          --
  20 --                                                                          --
  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 package provides a target dependent thin interface to the sockets
  33 --  layer for use by the GNAT.Sockets package (g-socket.ads). This package
  34 --  should not be directly with'ed by an applications program.
  35 
  36 --  This version is for NT
  37 
  38 with Ada.Unchecked_Conversion;
  39 with Interfaces.C.Strings;    use Interfaces.C.Strings;
  40 with System;                  use System;
  41 with System.Storage_Elements; use System.Storage_Elements;
  42 
  43 package body GNAT.Sockets.Thin is
  44 
  45    use type C.unsigned;
  46    use type C.int;
  47 
  48    WSAData_Dummy : array (1 .. 512) of C.int;
  49 
  50    WS_Version : constant := 16#0202#;
  51    --  Winsock 2.2
  52 
  53    Initialized : Boolean := False;
  54 
  55    function Standard_Connect
  56      (S       : C.int;
  57       Name    : System.Address;
  58       Namelen : C.int) return C.int;
  59    pragma Import (Stdcall, Standard_Connect, "connect");
  60 
  61    function Standard_Select
  62      (Nfds      : C.int;
  63       Readfds   : access Fd_Set;
  64       Writefds  : access Fd_Set;
  65       Exceptfds : access Fd_Set;
  66       Timeout   : Timeval_Access) return C.int;
  67    pragma Import (Stdcall, Standard_Select, "select");
  68 
  69    type Error_Type is
  70      (N_EINTR,
  71       N_EBADF,
  72       N_EACCES,
  73       N_EFAULT,
  74       N_EINVAL,
  75       N_EMFILE,
  76       N_EWOULDBLOCK,
  77       N_EINPROGRESS,
  78       N_EALREADY,
  79       N_ENOTSOCK,
  80       N_EDESTADDRREQ,
  81       N_EMSGSIZE,
  82       N_EPROTOTYPE,
  83       N_ENOPROTOOPT,
  84       N_EPROTONOSUPPORT,
  85       N_ESOCKTNOSUPPORT,
  86       N_EOPNOTSUPP,
  87       N_EPFNOSUPPORT,
  88       N_EAFNOSUPPORT,
  89       N_EADDRINUSE,
  90       N_EADDRNOTAVAIL,
  91       N_ENETDOWN,
  92       N_ENETUNREACH,
  93       N_ENETRESET,
  94       N_ECONNABORTED,
  95       N_ECONNRESET,
  96       N_ENOBUFS,
  97       N_EISCONN,
  98       N_ENOTCONN,
  99       N_ESHUTDOWN,
 100       N_ETOOMANYREFS,
 101       N_ETIMEDOUT,
 102       N_ECONNREFUSED,
 103       N_ELOOP,
 104       N_ENAMETOOLONG,
 105       N_EHOSTDOWN,
 106       N_EHOSTUNREACH,
 107       N_WSASYSNOTREADY,
 108       N_WSAVERNOTSUPPORTED,
 109       N_WSANOTINITIALISED,
 110       N_WSAEDISCON,
 111       N_HOST_NOT_FOUND,
 112       N_TRY_AGAIN,
 113       N_NO_RECOVERY,
 114       N_NO_DATA,
 115       N_OTHERS);
 116 
 117    Error_Messages : constant array (Error_Type) of chars_ptr :=
 118      (N_EINTR =>
 119         New_String ("Interrupted system call"),
 120       N_EBADF =>
 121         New_String ("Bad file number"),
 122       N_EACCES =>
 123         New_String ("Permission denied"),
 124       N_EFAULT =>
 125         New_String ("Bad address"),
 126       N_EINVAL =>
 127         New_String ("Invalid argument"),
 128       N_EMFILE =>
 129         New_String ("Too many open files"),
 130       N_EWOULDBLOCK =>
 131         New_String ("Operation would block"),
 132       N_EINPROGRESS =>
 133         New_String ("Operation now in progress. This error is "
 134                     & "returned if any Windows Sockets API "
 135                     & "function is called while a blocking "
 136                     & "function is in progress"),
 137       N_EALREADY =>
 138         New_String ("Operation already in progress"),
 139       N_ENOTSOCK =>
 140         New_String ("Socket operation on nonsocket"),
 141       N_EDESTADDRREQ =>
 142         New_String ("Destination address required"),
 143       N_EMSGSIZE =>
 144         New_String ("Message too long"),
 145       N_EPROTOTYPE =>
 146         New_String ("Protocol wrong type for socket"),
 147       N_ENOPROTOOPT =>
 148         New_String ("Protocol not available"),
 149       N_EPROTONOSUPPORT =>
 150         New_String ("Protocol not supported"),
 151       N_ESOCKTNOSUPPORT =>
 152         New_String ("Socket type not supported"),
 153       N_EOPNOTSUPP =>
 154         New_String ("Operation not supported on socket"),
 155       N_EPFNOSUPPORT =>
 156         New_String ("Protocol family not supported"),
 157       N_EAFNOSUPPORT =>
 158         New_String ("Address family not supported by protocol family"),
 159       N_EADDRINUSE =>
 160         New_String ("Address already in use"),
 161       N_EADDRNOTAVAIL =>
 162         New_String ("Cannot assign requested address"),
 163       N_ENETDOWN =>
 164         New_String ("Network is down. This error may be "
 165                     & "reported at any time if the Windows "
 166                     & "Sockets implementation detects an "
 167                     & "underlying failure"),
 168       N_ENETUNREACH =>
 169         New_String ("Network is unreachable"),
 170       N_ENETRESET =>
 171         New_String ("Network dropped connection on reset"),
 172       N_ECONNABORTED =>
 173         New_String ("Software caused connection abort"),
 174       N_ECONNRESET =>
 175         New_String ("Connection reset by peer"),
 176       N_ENOBUFS =>
 177         New_String ("No buffer space available"),
 178       N_EISCONN  =>
 179         New_String ("Socket is already connected"),
 180       N_ENOTCONN =>
 181         New_String ("Socket is not connected"),
 182       N_ESHUTDOWN =>
 183         New_String ("Cannot send after socket shutdown"),
 184       N_ETOOMANYREFS =>
 185         New_String ("Too many references: cannot splice"),
 186       N_ETIMEDOUT =>
 187         New_String ("Connection timed out"),
 188       N_ECONNREFUSED =>
 189         New_String ("Connection refused"),
 190       N_ELOOP =>
 191         New_String ("Too many levels of symbolic links"),
 192       N_ENAMETOOLONG =>
 193         New_String ("File name too long"),
 194       N_EHOSTDOWN =>
 195         New_String ("Host is down"),
 196       N_EHOSTUNREACH =>
 197         New_String ("No route to host"),
 198       N_WSASYSNOTREADY =>
 199         New_String ("Returned by WSAStartup(), indicating that "
 200                     & "the network subsystem is unusable"),
 201       N_WSAVERNOTSUPPORTED =>
 202         New_String ("Returned by WSAStartup(), indicating that "
 203                     & "the Windows Sockets DLL cannot support "
 204                     & "this application"),
 205       N_WSANOTINITIALISED =>
 206         New_String ("Winsock not initialized. This message is "
 207                     & "returned by any function except WSAStartup(), "
 208                     & "indicating that a successful WSAStartup() has "
 209                     & "not yet been performed"),
 210       N_WSAEDISCON =>
 211         New_String ("Disconnected"),
 212       N_HOST_NOT_FOUND =>
 213         New_String ("Host not found. This message indicates "
 214                     & "that the key (name, address, and so on) was not found"),
 215       N_TRY_AGAIN =>
 216         New_String ("Nonauthoritative host not found. This error may "
 217                     & "suggest that the name service itself is not "
 218                     & "functioning"),
 219       N_NO_RECOVERY =>
 220         New_String ("Nonrecoverable error. This error may suggest that the "
 221                     & "name service itself is not functioning"),
 222       N_NO_DATA =>
 223         New_String ("Valid name, no data record of requested type. "
 224                     & "This error indicates that the key (name, address, "
 225                     & "and so on) was not found."),
 226       N_OTHERS =>
 227         New_String ("Unknown system error"));
 228 
 229    ---------------
 230    -- C_Connect --
 231    ---------------
 232 
 233    function C_Connect
 234      (S       : C.int;
 235       Name    : System.Address;
 236       Namelen : C.int) return C.int
 237    is
 238       Res : C.int;
 239 
 240    begin
 241       Res := Standard_Connect (S, Name, Namelen);
 242 
 243       if Res = -1 then
 244          if Socket_Errno = SOSC.EWOULDBLOCK then
 245             Set_Socket_Errno (SOSC.EINPROGRESS);
 246          end if;
 247       end if;
 248 
 249       return Res;
 250    end C_Connect;
 251 
 252    ------------------
 253    -- Socket_Ioctl --
 254    ------------------
 255 
 256    function Socket_Ioctl
 257      (S   : C.int;
 258       Req : SOSC.IOCTL_Req_T;
 259       Arg : access C.int) return C.int
 260    is
 261    begin
 262       return C_Ioctl (S, Req, Arg);
 263    end Socket_Ioctl;
 264 
 265    ---------------
 266    -- C_Recvmsg --
 267    ---------------
 268 
 269    function C_Recvmsg
 270      (S     : C.int;
 271       Msg   : System.Address;
 272       Flags : C.int) return System.CRTL.ssize_t
 273    is
 274       use type C.size_t;
 275 
 276       Fill  : constant Boolean :=
 277                 SOSC.MSG_WAITALL /= -1
 278                   and then (C.unsigned (Flags) and SOSC.MSG_WAITALL) /= 0;
 279       --  Is the MSG_WAITALL flag set? If so we need to fully fill all vectors
 280 
 281       Res   : C.int;
 282       Count : C.int := 0;
 283 
 284       MH : Msghdr;
 285       for MH'Address use Msg;
 286 
 287       Iovec : array (0 .. MH.Msg_Iovlen - 1) of Vector_Element;
 288       for Iovec'Address use MH.Msg_Iov;
 289       pragma Import (Ada, Iovec);
 290 
 291       Iov_Index     : Integer;
 292       Current_Iovec : Vector_Element;
 293 
 294       function To_Access is new Ada.Unchecked_Conversion
 295                                   (System.Address, Stream_Element_Reference);
 296       pragma Warnings (Off, Stream_Element_Reference);
 297 
 298       Req : Request_Type (Name => N_Bytes_To_Read);
 299 
 300    begin
 301       --  Windows does not provide an implementation of recvmsg(). The spec for
 302       --  WSARecvMsg() is incompatible with the data types we define, and is
 303       --  available starting with Windows Vista and Server 2008 only. So,
 304       --  we use C_Recv instead.
 305 
 306       --  Check how much data are available
 307 
 308       Control_Socket (Socket_Type (S), Req);
 309 
 310       --  Fill the vectors
 311 
 312       Iov_Index := -1;
 313       Current_Iovec := (Base => null, Length => 0);
 314 
 315       loop
 316          if Current_Iovec.Length = 0 then
 317             Iov_Index := Iov_Index + 1;
 318             exit when Iov_Index > Integer (Iovec'Last);
 319             Current_Iovec := Iovec (SOSC.Msg_Iovlen_T (Iov_Index));
 320          end if;
 321 
 322          Res :=
 323            C_Recv
 324             (S,
 325              Current_Iovec.Base.all'Address,
 326              C.int (Current_Iovec.Length),
 327              Flags);
 328 
 329          if Res < 0 then
 330             return System.CRTL.ssize_t (Res);
 331 
 332          elsif Res = 0 and then not Fill then
 333             exit;
 334 
 335          else
 336             pragma Assert (Interfaces.C.size_t (Res) <= Current_Iovec.Length);
 337 
 338             Count := Count + Res;
 339             Current_Iovec.Length :=
 340               Current_Iovec.Length - Interfaces.C.size_t (Res);
 341             Current_Iovec.Base :=
 342               To_Access (Current_Iovec.Base.all'Address
 343                 + Storage_Offset (Res));
 344 
 345             --  If all the data that was initially available read, do not
 346             --  attempt to receive more, since this might block, or merge data
 347             --  from successive datagrams for a datagram-oriented socket. We
 348             --  still try to receive more if we need to fill all vectors
 349             --  (MSG_WAITALL flag is set).
 350 
 351             exit when Natural (Count) >= Req.Size
 352               and then
 353 
 354                 --  Either we are not in fill mode
 355 
 356                 (not Fill
 357 
 358                   --  Or else last vector filled
 359 
 360                   or else (Interfaces.C.size_t (Iov_Index) = Iovec'Last
 361                             and then Current_Iovec.Length = 0));
 362          end if;
 363       end loop;
 364 
 365       return System.CRTL.ssize_t (Count);
 366    end C_Recvmsg;
 367 
 368    --------------
 369    -- C_Select --
 370    --------------
 371 
 372    function C_Select
 373      (Nfds      : C.int;
 374       Readfds   : access Fd_Set;
 375       Writefds  : access Fd_Set;
 376       Exceptfds : access Fd_Set;
 377       Timeout   : Timeval_Access) return C.int
 378    is
 379       pragma Warnings (Off, Exceptfds);
 380 
 381       Original_WFS : aliased constant Fd_Set := Writefds.all;
 382 
 383       Res  : C.int;
 384       S    : aliased C.int;
 385       Last : aliased C.int;
 386 
 387    begin
 388       --  Asynchronous connection failures are notified in the exception fd
 389       --  set instead of the write fd set. To ensure POSIX compatibility, copy
 390       --  write fd set into exception fd set. Once select() returns, check any
 391       --  socket present in the exception fd set and peek at incoming
 392       --  out-of-band data. If the test is not successful, and the socket is
 393       --  present in the initial write fd set, then move the socket from the
 394       --  exception fd set to the write fd set.
 395 
 396       if Writefds /= No_Fd_Set_Access then
 397 
 398          --  Add any socket present in write fd set into exception fd set
 399 
 400          declare
 401             WFS : aliased Fd_Set := Writefds.all;
 402          begin
 403             Last := Nfds - 1;
 404             loop
 405                Get_Socket_From_Set
 406                  (WFS'Access, S'Unchecked_Access, Last'Unchecked_Access);
 407                exit when S = -1;
 408                Insert_Socket_In_Set (Exceptfds, S);
 409             end loop;
 410          end;
 411       end if;
 412 
 413       Res := Standard_Select (Nfds, Readfds, Writefds, Exceptfds, Timeout);
 414 
 415       if Exceptfds /= No_Fd_Set_Access then
 416          declare
 417             EFSC    : aliased Fd_Set := Exceptfds.all;
 418             Flag    : constant C.int := SOSC.MSG_PEEK + SOSC.MSG_OOB;
 419             Buffer  : Character;
 420             Length  : C.int;
 421             Fromlen : aliased C.int;
 422 
 423          begin
 424             Last := Nfds - 1;
 425             loop
 426                Get_Socket_From_Set
 427                  (EFSC'Access, S'Unchecked_Access, Last'Unchecked_Access);
 428 
 429                --  No more sockets in EFSC
 430 
 431                exit when S = -1;
 432 
 433                --  Check out-of-band data
 434 
 435                Length :=
 436                  C_Recvfrom
 437                   (S, Buffer'Address, 1, Flag,
 438                    From    => System.Null_Address,
 439                    Fromlen => Fromlen'Unchecked_Access);
 440                --  Is Fromlen necessary if From is Null_Address???
 441 
 442                --  If the signal is not an out-of-band data, then it
 443                --  is a connection failure notification.
 444 
 445                if Length = -1 then
 446                   Remove_Socket_From_Set (Exceptfds, S);
 447 
 448                   --  If S is present in the initial write fd set, move it from
 449                   --  exception fd set back to write fd set. Otherwise, ignore
 450                   --  this event since the user is not watching for it.
 451 
 452                   if Writefds /= No_Fd_Set_Access
 453                     and then (Is_Socket_In_Set (Original_WFS'Access, S) /= 0)
 454                   then
 455                      Insert_Socket_In_Set (Writefds, S);
 456                   end if;
 457                end if;
 458             end loop;
 459          end;
 460       end if;
 461       return Res;
 462    end C_Select;
 463 
 464    ---------------
 465    -- C_Sendmsg --
 466    ---------------
 467 
 468    function C_Sendmsg
 469      (S     : C.int;
 470       Msg   : System.Address;
 471       Flags : C.int) return System.CRTL.ssize_t
 472    is
 473       use type C.size_t;
 474 
 475       Res   : C.int;
 476       Count : C.int := 0;
 477 
 478       MH : Msghdr;
 479       for MH'Address use Msg;
 480 
 481       Iovec : array (0 .. MH.Msg_Iovlen - 1) of Vector_Element;
 482       for Iovec'Address use MH.Msg_Iov;
 483       pragma Import (Ada, Iovec);
 484 
 485    begin
 486       --  Windows does not provide an implementation of sendmsg(). The spec for
 487       --  WSASendMsg() is incompatible with the data types we define, and is
 488       --  available starting with Windows Vista and Server 2008 only. So
 489       --  use C_Sendto instead.
 490 
 491       for J in Iovec'Range loop
 492          Res :=
 493            C_Sendto
 494             (S,
 495              Iovec (J).Base.all'Address,
 496              C.int (Iovec (J).Length),
 497              Flags => Flags,
 498              To    => MH.Msg_Name,
 499              Tolen => C.int (MH.Msg_Namelen));
 500 
 501          if Res < 0 then
 502             return System.CRTL.ssize_t (Res);
 503          else
 504             Count := Count + Res;
 505          end if;
 506 
 507          --  Exit now if the buffer is not fully transmitted
 508 
 509          exit when Interfaces.C.size_t (Res) < Iovec (J).Length;
 510       end loop;
 511 
 512       return System.CRTL.ssize_t (Count);
 513    end C_Sendmsg;
 514 
 515    --------------
 516    -- Finalize --
 517    --------------
 518 
 519    procedure Finalize is
 520    begin
 521       if Initialized then
 522          WSACleanup;
 523          Initialized := False;
 524       end if;
 525    end Finalize;
 526 
 527    -------------------------
 528    -- Host_Error_Messages --
 529    -------------------------
 530 
 531    package body Host_Error_Messages is
 532 
 533       --  On Windows, socket and host errors share the same code space, and
 534       --  error messages are provided by Socket_Error_Message, so the default
 535       --  separate body for Host_Error_Messages is not used in this case.
 536 
 537       function Host_Error_Message (H_Errno : Integer) return String
 538          renames Socket_Error_Message;
 539 
 540    end Host_Error_Messages;
 541 
 542    ----------------
 543    -- Initialize --
 544    ----------------
 545 
 546    procedure Initialize is
 547       Return_Value : Interfaces.C.int;
 548    begin
 549       if not Initialized then
 550          Return_Value := WSAStartup (WS_Version, WSAData_Dummy'Address);
 551          pragma Assert (Return_Value = 0);
 552          Initialized := True;
 553       end if;
 554    end Initialize;
 555 
 556    --------------------
 557    -- Signalling_Fds --
 558    --------------------
 559 
 560    package body Signalling_Fds is separate;
 561 
 562    --------------------------
 563    -- Socket_Error_Message --
 564    --------------------------
 565 
 566    function Socket_Error_Message (Errno : Integer) return String is
 567       use GNAT.Sockets.SOSC;
 568 
 569       Errm : C.Strings.chars_ptr;
 570 
 571    begin
 572       case Errno is
 573          when EINTR =>           Errm := Error_Messages (N_EINTR);
 574          when EBADF =>           Errm := Error_Messages (N_EBADF);
 575          when EACCES =>          Errm := Error_Messages (N_EACCES);
 576          when EFAULT =>          Errm := Error_Messages (N_EFAULT);
 577          when EINVAL =>          Errm := Error_Messages (N_EINVAL);
 578          when EMFILE =>          Errm := Error_Messages (N_EMFILE);
 579          when EWOULDBLOCK =>     Errm := Error_Messages (N_EWOULDBLOCK);
 580          when EINPROGRESS =>     Errm := Error_Messages (N_EINPROGRESS);
 581          when EALREADY =>        Errm := Error_Messages (N_EALREADY);
 582          when ENOTSOCK =>        Errm := Error_Messages (N_ENOTSOCK);
 583          when EDESTADDRREQ =>    Errm := Error_Messages (N_EDESTADDRREQ);
 584          when EMSGSIZE =>        Errm := Error_Messages (N_EMSGSIZE);
 585          when EPROTOTYPE =>      Errm := Error_Messages (N_EPROTOTYPE);
 586          when ENOPROTOOPT =>     Errm := Error_Messages (N_ENOPROTOOPT);
 587          when EPROTONOSUPPORT => Errm := Error_Messages (N_EPROTONOSUPPORT);
 588          when ESOCKTNOSUPPORT => Errm := Error_Messages (N_ESOCKTNOSUPPORT);
 589          when EOPNOTSUPP =>      Errm := Error_Messages (N_EOPNOTSUPP);
 590          when EPFNOSUPPORT =>    Errm := Error_Messages (N_EPFNOSUPPORT);
 591          when EAFNOSUPPORT =>    Errm := Error_Messages (N_EAFNOSUPPORT);
 592          when EADDRINUSE =>      Errm := Error_Messages (N_EADDRINUSE);
 593          when EADDRNOTAVAIL =>   Errm := Error_Messages (N_EADDRNOTAVAIL);
 594          when ENETDOWN =>        Errm := Error_Messages (N_ENETDOWN);
 595          when ENETUNREACH =>     Errm := Error_Messages (N_ENETUNREACH);
 596          when ENETRESET =>       Errm := Error_Messages (N_ENETRESET);
 597          when ECONNABORTED =>    Errm := Error_Messages (N_ECONNABORTED);
 598          when ECONNRESET =>      Errm := Error_Messages (N_ECONNRESET);
 599          when ENOBUFS =>         Errm := Error_Messages (N_ENOBUFS);
 600          when EISCONN =>         Errm := Error_Messages (N_EISCONN);
 601          when ENOTCONN =>        Errm := Error_Messages (N_ENOTCONN);
 602          when ESHUTDOWN =>       Errm := Error_Messages (N_ESHUTDOWN);
 603          when ETOOMANYREFS =>    Errm := Error_Messages (N_ETOOMANYREFS);
 604          when ETIMEDOUT =>       Errm := Error_Messages (N_ETIMEDOUT);
 605          when ECONNREFUSED =>    Errm := Error_Messages (N_ECONNREFUSED);
 606          when ELOOP =>           Errm := Error_Messages (N_ELOOP);
 607          when ENAMETOOLONG =>    Errm := Error_Messages (N_ENAMETOOLONG);
 608          when EHOSTDOWN =>       Errm := Error_Messages (N_EHOSTDOWN);
 609          when EHOSTUNREACH =>    Errm := Error_Messages (N_EHOSTUNREACH);
 610 
 611          --  Windows-specific error codes
 612 
 613          when WSASYSNOTREADY =>  Errm := Error_Messages (N_WSASYSNOTREADY);
 614          when WSAVERNOTSUPPORTED =>
 615             Errm := Error_Messages (N_WSAVERNOTSUPPORTED);
 616          when WSANOTINITIALISED =>
 617             Errm := Error_Messages (N_WSANOTINITIALISED);
 618          when WSAEDISCON =>
 619             Errm := Error_Messages (N_WSAEDISCON);
 620 
 621          --  h_errno values
 622 
 623          when HOST_NOT_FOUND =>  Errm := Error_Messages (N_HOST_NOT_FOUND);
 624          when TRY_AGAIN =>       Errm := Error_Messages (N_TRY_AGAIN);
 625          when NO_RECOVERY =>     Errm := Error_Messages (N_NO_RECOVERY);
 626          when NO_DATA =>         Errm := Error_Messages (N_NO_DATA);
 627 
 628          when others =>          Errm := Error_Messages (N_OTHERS);
 629       end case;
 630 
 631       return Value (Errm);
 632    end Socket_Error_Message;
 633 
 634 end GNAT.Sockets.Thin;