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