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