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 with GNAT.Sockets.Constants;
  40
  41 package body GNAT.Sockets.Thin.Task_Safe_NetDB is
  42
  43    --  The following additional data is returned by Safe_Gethostbyname
  44    --  and Safe_Getostbyaddr in the user provided buffer.
  45
  46    type Netdb_Host_Data (Name_Length : C.size_t) is record
  47       Address   : aliased In_Addr;
  48       Addr_List : aliased In_Addr_Access_Array (0 .. 1);
  49       Name      : aliased C.char_array (0 .. Name_Length);
  50    end record;
  51
  52    Alias_Access : constant Chars_Ptr_Pointers.Pointer :=
  53                     new C.Strings.chars_ptr'(C.Strings.Null_Ptr);
  54    --  Constant used to create a Hostent record manually
  55
  56    ------------------------
  57    -- Safe_Gethostbyaddr --
  58    ------------------------
  59
  60    function Safe_Gethostbyaddr
  61      (Addr      : System.Address;
  62       Addr_Len  : C.int;
  63       Addr_Type : C.int;
  64       Ret       : not null access Hostent;
  65       Buf       : System.Address;
  66       Buflen    : C.int;
  67       H_Errnop  : not null access C.int) return C.int
  68    is
  69       type int_Access is access int;
  70       function To_Pointer is
  71         new Ada.Unchecked_Conversion (System.Address, int_Access);
  72
  73       function VxWorks_hostGetByAddr
  74         (Addr : C.int; Buf : System.Address) return C.int;
  75       pragma Import (C, VxWorks_hostGetByAddr, "hostGetByAddr");
  76
  77       Netdb_Data : Netdb_Host_Data (Name_Length => Max_Name_Length);
  78       pragma Import (Ada, Netdb_Data);
  79       for Netdb_Data'Address use Buf;
  80
  81       pragma Unreferenced (H_Errnop);
  82       --  VxWorks does not provide h_errno
  83
  84    begin
  85       pragma Assert (Addr_Type = Constants.AF_INET);
  86       pragma Assert (Addr_Len = In_Addr'Size / 8);
  87
  88       --  Check that provided buffer is sufficiently large to hold the
  89       --  data we want to return.
  90
  91       if Netdb_Data'Size / 8 > Buflen then
  92          return -1;
  93       end if;
  94
  95       if VxWorks_hostGetByAddr (To_Pointer (Addr).all,
  96                                 Netdb_Data.Name'Address)
  97            /= Constants.OK
  98       then
  99          return -1;
 100       end if;
 101
 102       Netdb_Data.Address   := To_In_Addr (To_Pointer (Addr).all);
 103       Netdb_Data.Addr_List :=
 104         (0 => Netdb_Data.Address'Unchecked_Access,
 105          1 => null);
 106
 107       Ret.H_Name      := C.Strings.To_Chars_Ptr
 108                            (Netdb_Data.Name'Unrestricted_Access);
 109       Ret.H_Aliases   := Alias_Access;
 110       Ret.H_Addrtype  := Constants.AF_INET;
 111       Ret.H_Length    := 4;
 112       Ret.H_Addr_List :=
 113         Netdb_Data.Addr_List (Netdb_Data.Addr_List'First)'Unchecked_Access;
 114       return 0;
 115    end Safe_Gethostbyaddr;
 116
 117    ------------------------
 118    -- Safe_Gethostbyname --
 119    ------------------------
 120
 121    function Safe_Gethostbyname
 122      (Name     : C.char_array;
 123       Ret      : not null access Hostent;
 124       Buf      : System.Address;
 125       Buflen   : C.int;
 126       H_Errnop : not null access C.int) return C.int
 127    is
 128       function VxWorks_hostGetByName
 129         (Name : C.char_array) return C.int;
 130       pragma Import (C, VxWorks_hostGetByName, "hostGetByName");
 131
 132       Addr : C.int;
 133
 134       pragma Unreferenced (H_Errnop);
 135       --  VxWorks does not provide h_errno
 136
 137    begin
 138       Addr := VxWorks_hostGetByName (Name);
 139       if Addr = Constants.ERROR then
 140          return -1;
 141       end if;
 142
 143       declare
 144          Netdb_Data : Netdb_Host_Data (Name_Length => Name'Length);
 145          pragma Import (Ada, Netdb_Data);
 146          for Netdb_Data'Address use Buf;
 147
 148       begin
 149          --  Check that provided buffer is sufficiently large to hold the
 150          --  data we want to return.
 151
 152          if Netdb_Data'Size / 8 > Buflen then
 153             return -1;
 154          end if;
 155
 156          Netdb_Data.Address   := To_In_Addr (Addr);
 157          Netdb_Data.Addr_List :=
 158            (0 => Netdb_Data.Address'Unchecked_Access,
 159             1 => null);
 160          Netdb_Data.Name (Netdb_Data.Name'First .. Name'Length - 1) := Name;
 161
 162          Ret.H_Name      := C.Strings.To_Chars_Ptr
 163                               (Netdb_Data.Name'Unrestricted_Access);
 164          Ret.H_Aliases   := Alias_Access;
 165          Ret.H_Addrtype  := Constants.AF_INET;
 166          Ret.H_Length    := 4;
 167          Ret.H_Addr_List :=
 168            Netdb_Data.Addr_List (Netdb_Data.Addr_List'First)'Unchecked_Access;
 169       end;
 170       return 0;
 171    end Safe_Gethostbyname;
 172
 173    ------------------------
 174    -- Safe_Getservbyname --
 175    ------------------------
 176
 177    function Safe_Getservbyname
 178      (Name     : C.char_array;
 179       Proto    : C.char_array;
 180       Ret      : not null access Servent;
 181       Buf      : System.Address;
 182       Buflen   : C.int) return C.int
 183    is
 184       pragma Unreferenced (Name, Proto, Ret, Buf, Buflen);
 185    begin
 186       --  Not available under VxWorks
 187       return -1;
 188    end Safe_Getservbyname;
 189
 190    ------------------------
 191    -- Safe_Getservbyport --
 192    ------------------------
 193
 194    function Safe_Getservbyport
 195      (Port     : C.int;
 196       Proto    : C.char_array;
 197       Ret      : not null access Servent;
 198       Buf      : System.Address;
 199       Buflen   : C.int) return C.int
 200    is
 201       pragma Unreferenced (Port, Proto, Ret, Buf, Buflen);
 202    begin
 203       --  Not available under VxWorks
 204       return -1;
 205    end Safe_Getservbyport;
 206
 207 end GNAT.Sockets.Thin.Task_Safe_NetDB;