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       pragma Unreferenced (H_Errnop);
  81       --  VxWorks does not provide h_errno
  82
  83    begin
  84       pragma Assert (Addr_Type = SOSC.AF_INET);
  85       pragma Assert (Addr_Len = In_Addr'Size / 8);
  86
  87       --  Check that provided buffer is sufficiently large to hold the
  88       --  data we want to return.
  89
  90       if Netdb_Data'Size / 8 > Buflen then
  91          return -1;
  92       end if;
  93
  94       if VxWorks_hostGetByAddr (To_Pointer (Addr).all,
  95                                 Netdb_Data.Name'Address)
  96            /= SOSC.OK
  97       then
  98          return -1;
  99       end if;
 100
 101       Netdb_Data.Address   := To_In_Addr (To_Pointer (Addr).all);
 102       Netdb_Data.Addr_List :=
 103         (0 => Netdb_Data.Address'Unchecked_Access,
 104          1 => null);
 105
 106       Ret.H_Name      := C.Strings.To_Chars_Ptr
 107                            (Netdb_Data.Name'Unrestricted_Access);
 108       Ret.H_Aliases   := Alias_Access;
 109       Ret.H_Addrtype  := SOSC.AF_INET;
 110       Ret.H_Length    := 4;
 111       Ret.H_Addr_List :=
 112         Netdb_Data.Addr_List (Netdb_Data.Addr_List'First)'Unchecked_Access;
 113       return 0;
 114    end Safe_Gethostbyaddr;
 115
 116    ------------------------
 117    -- Safe_Gethostbyname --
 118    ------------------------
 119
 120    function Safe_Gethostbyname
 121      (Name     : C.char_array;
 122       Ret      : not null access Hostent;
 123       Buf      : System.Address;
 124       Buflen   : C.int;
 125       H_Errnop : not null access C.int) return C.int
 126    is
 127       function VxWorks_hostGetByName
 128         (Name : C.char_array) return C.int;
 129       pragma Import (C, VxWorks_hostGetByName, "hostGetByName");
 130
 131       Addr : C.int;
 132
 133       pragma Unreferenced (H_Errnop);
 134       --  VxWorks does not provide h_errno
 135
 136    begin
 137       Addr := VxWorks_hostGetByName (Name);
 138       if Addr = SOSC.ERROR then
 139          return -1;
 140       end if;
 141
 142       declare
 143          Netdb_Data : Netdb_Host_Data (Name_Length => Name'Length);
 144          pragma Import (Ada, Netdb_Data);
 145          for Netdb_Data'Address use Buf;
 146
 147       begin
 148          --  Check that provided buffer is sufficiently large to hold the
 149          --  data we want to return.
 150
 151          if Netdb_Data'Size / 8 > Buflen then
 152             return -1;
 153          end if;
 154
 155          Netdb_Data.Address   := To_In_Addr (Addr);
 156          Netdb_Data.Addr_List :=
 157            (0 => Netdb_Data.Address'Unchecked_Access,
 158             1 => null);
 159          Netdb_Data.Name (Netdb_Data.Name'First .. Name'Length - 1) := Name;
 160
 161          Ret.H_Name      := C.Strings.To_Chars_Ptr
 162                               (Netdb_Data.Name'Unrestricted_Access);
 163          Ret.H_Aliases   := Alias_Access;
 164          Ret.H_Addrtype  := SOSC.AF_INET;
 165          Ret.H_Length    := 4;
 166          Ret.H_Addr_List :=
 167            Netdb_Data.Addr_List (Netdb_Data.Addr_List'First)'Unchecked_Access;
 168       end;
 169       return 0;
 170    end Safe_Gethostbyname;
 171
 172    ------------------------
 173    -- Safe_Getservbyname --
 174    ------------------------
 175
 176    function Safe_Getservbyname
 177      (Name     : C.char_array;
 178       Proto    : C.char_array;
 179       Ret      : not null access Servent;
 180       Buf      : System.Address;
 181       Buflen   : C.int) return C.int
 182    is
 183       pragma Unreferenced (Name, Proto, Ret, Buf, Buflen);
 184    begin
 185       --  Not available under VxWorks
 186       return -1;
 187    end Safe_Getservbyname;
 188
 189    ------------------------
 190    -- Safe_Getservbyport --
 191    ------------------------
 192
 193    function Safe_Getservbyport
 194      (Port     : C.int;
 195       Proto    : C.char_array;
 196       Ret      : not null access Servent;
 197       Buf      : System.Address;
 198       Buflen   : C.int) return C.int
 199    is
 200       pragma Unreferenced (Port, Proto, Ret, Buf, Buflen);
 201    begin
 202       --  Not available under VxWorks
 203       return -1;
 204    end Safe_Getservbyport;
 205
 206 end GNAT.Sockets.Thin.Task_Safe_NetDB;