gcc/ada/g-sttsne-vxworks.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --    G N A T . S O C K E T S . T H I N . T A S K _ S A F E _ N E T D B     --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --                  Copyright (C) 2007-2008, 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 2,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  19 -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
  20 -- Boston, MA 02110-1301, USA.                                              --
  21 --                                                                          --
  22 -- As a special exception,  if other files  instantiate  generics from this --
  23 -- unit, or you link  this unit with other files  to produce an executable, --
  24 -- this  unit  does not  by itself cause  the resulting  executable  to  be --
  25 -- covered  by the  GNU  General  Public  License.  This exception does not --
  26 -- however invalidate  any other reasons why  the executable file  might be --
  27 -- covered by the  GNU Public License.                                      --
  28 --                                                                          --
  29 -- GNAT was originally developed  by the GNAT team at  New York University. --
  30 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  31 --                                                                          --
  32 ------------------------------------------------------------------------------
  33
  34 --  This version is used on VxWorks. Note that the corresponding spec is in
  35 --  g-sttsne-locking.ads.
  36
  37 with Ada.Unchecked_Conversion;
  38 with Interfaces.C; use Interfaces.C;
  39
  40 package body GNAT.Sockets.Thin.Task_Safe_NetDB is
  41
  42    --  The following additional data is returned by Safe_Gethostbyname
  43    --  and Safe_Getostbyaddr in the user provided buffer.
  44
  45    type Netdb_Host_Data (Name_Length : C.size_t) is record
  46       Address   : aliased In_Addr;
  47       Addr_List : aliased In_Addr_Access_Array (0 .. 1);
  48       Name      : aliased C.char_array (0 .. Name_Length);
  49    end record;
  50
  51    Alias_Access : constant Chars_Ptr_Pointers.Pointer :=
  52                     new C.Strings.chars_ptr'(C.Strings.Null_Ptr);
  53    --  Constant used to create a Hostent record manually
  54
  55    ------------------------
  56    -- Safe_Gethostbyaddr --
  57    ------------------------
  58
  59    function Safe_Gethostbyaddr
  60      (Addr      : System.Address;
  61       Addr_Len  : C.int;
  62       Addr_Type : C.int;
  63       Ret       : not null access Hostent;
  64       Buf       : System.Address;
  65       Buflen    : C.int;
  66       H_Errnop  : not null access C.int) return C.int
  67    is
  68       type int_Access is access int;
  69       function To_Pointer is
  70         new Ada.Unchecked_Conversion (System.Address, int_Access);
  71
  72       function VxWorks_hostGetByAddr
  73         (Addr : C.int; Buf : System.Address) return C.int;
  74       pragma Import (C, VxWorks_hostGetByAddr, "hostGetByAddr");
  75
  76       Netdb_Data : Netdb_Host_Data (Name_Length => Max_Name_Length);
  77       pragma Import (Ada, Netdb_Data);
  78       for Netdb_Data'Address use Buf;
  79
  80    begin
  81       pragma Assert (Addr_Type = SOSC.AF_INET);
  82       pragma Assert (Addr_Len = In_Addr'Size / 8);
  83
  84       --  Check that provided buffer is sufficiently large to hold the
  85       --  data we want to return.
  86
  87       if Netdb_Data'Size / 8 > Buflen then
  88          H_Errnop.all := SOSC.ERANGE;
  89          return -1;
  90       end if;
  91
  92       if VxWorks_hostGetByAddr (To_Pointer (Addr).all,
  93                                 Netdb_Data.Name'Address)
  94            /= SOSC.OK
  95       then
  96          H_Errnop.all := C.int (Host_Errno);
  97          return -1;
  98       end if;
  99
 100       Netdb_Data.Address   := To_In_Addr (To_Pointer (Addr).all);
 101       Netdb_Data.Addr_List :=
 102         (0 => Netdb_Data.Address'Unchecked_Access,
 103          1 => null);
 104
 105       Ret.H_Name      := C.Strings.To_Chars_Ptr
 106                            (Netdb_Data.Name'Unrestricted_Access);
 107       Ret.H_Aliases   := Alias_Access;
 108       Ret.H_Addrtype  := SOSC.AF_INET;
 109       Ret.H_Length    := 4;
 110       Ret.H_Addr_List :=
 111         Netdb_Data.Addr_List (Netdb_Data.Addr_List'First)'Unchecked_Access;
 112       return 0;
 113    end Safe_Gethostbyaddr;
 114
 115    ------------------------
 116    -- Safe_Gethostbyname --
 117    ------------------------
 118
 119    function Safe_Gethostbyname
 120      (Name     : C.char_array;
 121       Ret      : not null access Hostent;
 122       Buf      : System.Address;
 123       Buflen   : C.int;
 124       H_Errnop : not null access C.int) return C.int
 125    is
 126       function VxWorks_hostGetByName
 127         (Name : C.char_array) return C.int;
 128       pragma Import (C, VxWorks_hostGetByName, "hostGetByName");
 129
 130       Addr : C.int;
 131
 132    begin
 133       Addr := VxWorks_hostGetByName (Name);
 134       if Addr = SOSC.ERROR then
 135          H_Errnop.all := C.int (Host_Errno);
 136          return -1;
 137       end if;
 138
 139       declare
 140          Netdb_Data : Netdb_Host_Data (Name_Length => Name'Length);
 141          pragma Import (Ada, Netdb_Data);
 142          for Netdb_Data'Address use Buf;
 143
 144       begin
 145          --  Check that provided buffer is sufficiently large to hold the
 146          --  data we want to return.
 147
 148          if Netdb_Data'Size / 8 > Buflen then
 149             H_Errnop.all := SOSC.ERANGE;
 150             return -1;
 151          end if;
 152
 153          Netdb_Data.Address   := To_In_Addr (Addr);
 154          Netdb_Data.Addr_List :=
 155            (0 => Netdb_Data.Address'Unchecked_Access,
 156             1 => null);
 157          Netdb_Data.Name (Netdb_Data.Name'First .. Name'Length - 1) := Name;
 158
 159          Ret.H_Name      := C.Strings.To_Chars_Ptr
 160                               (Netdb_Data.Name'Unrestricted_Access);
 161          Ret.H_Aliases   := Alias_Access;
 162          Ret.H_Addrtype  := SOSC.AF_INET;
 163          Ret.H_Length    := 4;
 164          Ret.H_Addr_List :=
 165            Netdb_Data.Addr_List (Netdb_Data.Addr_List'First)'Unchecked_Access;
 166       end;
 167       return 0;
 168    end Safe_Gethostbyname;
 169
 170    ------------------------
 171    -- Safe_Getservbyname --
 172    ------------------------
 173
 174    function Safe_Getservbyname
 175      (Name     : C.char_array;
 176       Proto    : C.char_array;
 177       Ret      : not null access Servent;
 178       Buf      : System.Address;
 179       Buflen   : C.int) return C.int
 180    is
 181       pragma Unreferenced (Name, Proto, Ret, Buf, Buflen);
 182    begin
 183       --  Not available under VxWorks
 184       return -1;
 185    end Safe_Getservbyname;
 186
 187    ------------------------
 188    -- Safe_Getservbyport --
 189    ------------------------
 190
 191    function Safe_Getservbyport
 192      (Port     : C.int;
 193       Proto    : C.char_array;
 194       Ret      : not null access Servent;
 195       Buf      : System.Address;
 196       Buflen   : C.int) return C.int
 197    is
 198       pragma Unreferenced (Port, Proto, Ret, Buf, Buflen);
 199    begin
 200       --  Not available under VxWorks
 201       return -1;
 202    end Safe_Getservbyport;
 203
 204 end GNAT.Sockets.Thin.Task_Safe_NetDB;