Subversion Repositories openrisc_me

------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--    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     --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                   Copyright (C) 2007-2009, AdaCore                       --
--                                                                          --
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
-- for  more details.  You should have  received  a copy of the GNU General --
-- Public License  distributed with GNAT;  see file COPYING.  If not, write --
-- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
-- Boston, MA 02110-1301, USA.                                              --
--                                                                          --
-- As a special exception,  if other files  instantiate  generics from this --
-- unit, or you link  this unit with other files  to produce an executable, --
-- this  unit  does not  by itself cause  the resulting  executable  to  be --
-- covered  by the  GNU  General  Public  License.  This exception does not --
-- however invalidate  any other reasons why  the executable file  might be --
-- covered by the  GNU Public License.                                      --
--                                                                          --
-- GNAT was originally developed  by the GNAT team at  New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
--                                                                          --
------------------------------------------------------------------------------
 
--  This version is used on VMS and LynxOS
 
with GNAT.Task_Lock;
 
with Interfaces.C; use Interfaces.C;
 
package body GNAT.Sockets.Thin.Task_Safe_NetDB is
 
   --  The Safe_GetXXXbyYYY routines wrap the Nonreentrant_ versions using the
   --  task lock, and copy the relevant data structures (under the lock) into
   --  the result. The Nonreentrant_ versions are expected to be in the parent
   --  package GNAT.Sockets.Thin (on platforms that use this version of
   --  Task_Safe_NetDB).
 
   procedure Copy_Host_Entry
     (Source_Hostent       : Hostent;
      Target_Hostent       : out Hostent;
      Target_Buffer        : System.Address;
      Target_Buffer_Length : C.int;
      Result               : out C.int);
   --  Copy all the information from Source_Hostent into Target_Hostent,
   --  using Target_Buffer to store associated data.
   --  0 is returned on success, -1 on failure (in case the provided buffer
   --  is too small for the associated data).
 
   procedure Copy_Service_Entry
     (Source_Servent       : Servent_Access;
      Target_Servent       : Servent_Access;
      Target_Buffer        : System.Address;
      Target_Buffer_Length : C.int;
      Result               : out C.int);
   --  Copy all the information from Source_Servent into Target_Servent,
   --  using Target_Buffer to store associated data.
   --  0 is returned on success, -1 on failure (in case the provided buffer
   --  is too small for the associated data).
 
   procedure Store_Name
     (Name          : char_array;
      Storage       : in out char_array;
      Storage_Index : in out size_t;
      Stored_Name   : out C.Strings.chars_ptr);
   --  Store the given Name at the first available location in Storage
   --  (indicated by Storage_Index, which is updated afterwards), and return
   --  the address of that location in Stored_Name.
   --  (Supporting routine for the two below).
 
   ---------------------
   -- Copy_Host_Entry --
   ---------------------
 
   procedure Copy_Host_Entry
     (Source_Hostent       : Hostent;
      Target_Hostent       : out Hostent;
      Target_Buffer        : System.Address;
      Target_Buffer_Length : C.int;
      Result               : out C.int)
   is
      use type C.Strings.chars_ptr;
 
      Names_Length : size_t;
 
      Source_Aliases : Chars_Ptr_Array
        renames Chars_Ptr_Pointers.Value
          (Source_Hostent.H_Aliases, Terminator => C.Strings.Null_Ptr);
      --  Null-terminated list of aliases (last element of this array is
      --  Null_Ptr).
 
      Source_Addresses : In_Addr_Access_Array
        renames In_Addr_Access_Pointers.Value
          (Source_Hostent.H_Addr_List, Terminator => null);
 
   begin
      Result := -1;
      Names_Length := C.Strings.Strlen (Source_Hostent.H_Name) + 1;
 
      for J in Source_Aliases'Range loop
         if Source_Aliases (J) /= C.Strings.Null_Ptr then
            Names_Length :=
              Names_Length + C.Strings.Strlen (Source_Aliases (J)) + 1;
         end if;
      end loop;
 
      declare
         type In_Addr_Array is array (Source_Addresses'Range)
                                 of aliased In_Addr;
 
         type Netdb_Host_Data is record
            Aliases_List   : aliased Chars_Ptr_Array (Source_Aliases'Range);
            Names          : aliased char_array (1 .. Names_Length);
 
            Addresses_List : aliased In_Addr_Access_Array
                                       (In_Addr_Array'Range);
            Addresses : In_Addr_Array;
            --  ??? This assumes support only for Inet family
 
         end record;
 
         Netdb_Data : Netdb_Host_Data;
         pragma Import (Ada, Netdb_Data);
         for Netdb_Data'Address use Target_Buffer;
 
         Names_Index : size_t := Netdb_Data.Names'First;
         --  Index of first available location in Netdb_Data.Names
 
      begin
         if Netdb_Data'Size / 8 > Target_Buffer_Length then
            return;
         end if;
 
         --  Copy host name
 
         Store_Name
           (C.Strings.Value (Source_Hostent.H_Name),
            Netdb_Data.Names, Names_Index,
            Target_Hostent.H_Name);
 
         --  Copy aliases (null-terminated string pointer array)
 
         Target_Hostent.H_Aliases :=
           Netdb_Data.Aliases_List
             (Netdb_Data.Aliases_List'First)'Unchecked_Access;
         for J in Netdb_Data.Aliases_List'Range loop
            if J = Netdb_Data.Aliases_List'Last then
               Netdb_Data.Aliases_List (J) := C.Strings.Null_Ptr;
            else
               Store_Name
                 (C.Strings.Value (Source_Aliases (J)),
                  Netdb_Data.Names, Names_Index,
                  Netdb_Data.Aliases_List (J));
            end if;
         end loop;
 
         --  Copy address type and length
 
         Target_Hostent.H_Addrtype := Source_Hostent.H_Addrtype;
         Target_Hostent.H_Length   := Source_Hostent.H_Length;
 
         --  Copy addresses
 
         Target_Hostent.H_Addr_List :=
           Netdb_Data.Addresses_List
             (Netdb_Data.Addresses_List'First)'Unchecked_Access;
 
         for J in Netdb_Data.Addresses'Range loop
            if J = Netdb_Data.Addresses'Last then
               Netdb_Data.Addresses_List (J) := null;
            else
               Netdb_Data.Addresses_List (J) :=
                 Netdb_Data.Addresses (J)'Unchecked_Access;
 
               Netdb_Data.Addresses (J) := Source_Addresses (J).all;
            end if;
         end loop;
      end;
 
      Result := 0;
   end Copy_Host_Entry;
 
   ------------------------
   -- Copy_Service_Entry --
   ------------------------
 
   procedure Copy_Service_Entry
     (Source_Servent       : Servent_Access;
      Target_Servent       : Servent_Access;
      Target_Buffer        : System.Address;
      Target_Buffer_Length : C.int;
      Result               : out C.int)
   is
      use type C.Strings.chars_ptr;
 
      Names_Length : size_t;
 
      Source_Aliases : Chars_Ptr_Array
        renames Chars_Ptr_Pointers.Value
          (Servent_S_Aliases (Source_Servent),
           Terminator => C.Strings.Null_Ptr);
      --  Null-terminated list of aliases (last element of this array is
      --  Null_Ptr).
 
   begin
      Result := -1;
      Names_Length := C.Strings.Strlen (Servent_S_Name (Source_Servent)) + 1 +
                      C.Strings.Strlen (Servent_S_Proto (Source_Servent)) + 1;
 
      for J in Source_Aliases'Range loop
         if Source_Aliases (J) /= C.Strings.Null_Ptr then
            Names_Length :=
              Names_Length + C.Strings.Strlen (Source_Aliases (J)) + 1;
         end if;
      end loop;
 
      declare
         type Netdb_Service_Data is record
            Aliases_List : aliased Chars_Ptr_Array (Source_Aliases'Range);
            Names        : aliased char_array (1 .. Names_Length);
         end record;
 
         Netdb_Data : Netdb_Service_Data;
         pragma Import (Ada, Netdb_Data);
         for Netdb_Data'Address use Target_Buffer;
 
         Names_Index : size_t := Netdb_Data.Names'First;
         --  Index of first available location in Netdb_Data.Names
 
         Stored_Name : C.Strings.chars_ptr;
 
      begin
         if Netdb_Data'Size / 8 > Target_Buffer_Length then
            return;
         end if;
 
         --  Copy service name
 
         Store_Name
           (C.Strings.Value (Servent_S_Name (Source_Servent)),
            Netdb_Data.Names, Names_Index,
            Stored_Name);
         Servent_Set_S_Name (Target_Servent, Stored_Name);
 
         --  Copy aliases (null-terminated string pointer array)
 
         Servent_Set_S_Aliases
           (Target_Servent,
            Netdb_Data.Aliases_List
              (Netdb_Data.Aliases_List'First)'Unchecked_Access);
 
         --  Copy port number
 
         Servent_Set_S_Port (Target_Servent, Servent_S_Port (Source_Servent));
 
         --  Copy protocol name
 
         Store_Name
           (C.Strings.Value (Servent_S_Proto (Source_Servent)),
            Netdb_Data.Names, Names_Index,
            Stored_Name);
         Servent_Set_S_Proto (Target_Servent, Stored_Name);
 
         for J in Netdb_Data.Aliases_List'Range loop
            if J = Netdb_Data.Aliases_List'Last then
               Netdb_Data.Aliases_List (J) := C.Strings.Null_Ptr;
            else
               Store_Name
                 (C.Strings.Value (Source_Aliases (J)),
                  Netdb_Data.Names, Names_Index,
                  Netdb_Data.Aliases_List (J));
            end if;
         end loop;
      end;
 
      Result := 0;
   end Copy_Service_Entry;
 
   ------------------------
   -- Safe_Gethostbyaddr --
   ------------------------
 
   function Safe_Gethostbyaddr
     (Addr      : System.Address;
      Addr_Len  : C.int;
      Addr_Type : C.int;
      Ret      : not null access Hostent;
      Buf      : System.Address;
      Buflen   : C.int;
      H_Errnop : not null access C.int) return C.int
   is
      HE     : Hostent_Access;
      Result : C.int;
   begin
      Result := -1;
      GNAT.Task_Lock.Lock;
      HE := Nonreentrant_Gethostbyaddr (Addr, Addr_Len, Addr_Type);
 
      if HE = null then
         H_Errnop.all := C.int (Host_Errno);
         goto Unlock_Return;
      end if;
 
      --  Now copy the data to the user-provided buffer
 
      Copy_Host_Entry
        (Source_Hostent       => HE.all,
         Target_Hostent       => Ret.all,
         Target_Buffer        => Buf,
         Target_Buffer_Length => Buflen,
         Result               => Result);
 
      <<Unlock_Return>>
      GNAT.Task_Lock.Unlock;
      return Result;
   end Safe_Gethostbyaddr;
 
   ------------------------
   -- Safe_Gethostbyname --
   ------------------------
 
   function Safe_Gethostbyname
     (Name     : C.char_array;
      Ret      : not null access Hostent;
      Buf      : System.Address;
      Buflen   : C.int;
      H_Errnop : not null access C.int) return C.int
   is
      HE     : Hostent_Access;
      Result : C.int;
   begin
      Result := -1;
      GNAT.Task_Lock.Lock;
      HE := Nonreentrant_Gethostbyname (Name);
 
      if HE = null then
         H_Errnop.all := C.int (Host_Errno);
         goto Unlock_Return;
      end if;
 
      --  Now copy the data to the user-provided buffer
 
      Copy_Host_Entry
        (Source_Hostent       => HE.all,
         Target_Hostent       => Ret.all,
         Target_Buffer        => Buf,
         Target_Buffer_Length => Buflen,
         Result               => Result);
 
      <<Unlock_Return>>
      GNAT.Task_Lock.Unlock;
      return Result;
   end Safe_Gethostbyname;
 
   ------------------------
   -- Safe_Getservbyname --
   ------------------------
 
   function Safe_Getservbyname
     (Name     : C.char_array;
      Proto    : C.char_array;
      Ret      : not null access Servent;
      Buf      : System.Address;
      Buflen   : C.int) return C.int
   is
      SE     : Servent_Access;
      Result : C.int;
   begin
      Result := -1;
      GNAT.Task_Lock.Lock;
      SE := Nonreentrant_Getservbyname (Name, Proto);
 
      if SE = null then
         goto Unlock_Return;
      end if;
 
      --  Now copy the data to the user-provided buffer. We convert Ret to
      --  type Servent_Access using the .all'Unchecked_Access trick to avoid
      --  an accessibility check. Ret could be pointing to a nested variable,
      --  and we don't want to raise an exception in that case.
 
      Copy_Service_Entry
        (Source_Servent       => SE,
         Target_Servent       => Ret.all'Unchecked_Access,
         Target_Buffer        => Buf,
         Target_Buffer_Length => Buflen,
         Result               => Result);
 
      <<Unlock_Return>>
      GNAT.Task_Lock.Unlock;
      return Result;
   end Safe_Getservbyname;
 
   ------------------------
   -- Safe_Getservbyport --
   ------------------------
 
   function Safe_Getservbyport
     (Port     : C.int;
      Proto    : C.char_array;
      Ret      : not null access Servent;
      Buf      : System.Address;
      Buflen   : C.int) return C.int
   is
      SE     : Servent_Access;
      Result : C.int;
 
   begin
      Result := -1;
      GNAT.Task_Lock.Lock;
      SE := Nonreentrant_Getservbyport (Port, Proto);
 
      if SE = null then
         goto Unlock_Return;
      end if;
 
      --  Now copy the data to the user-provided buffer. See Safe_Getservbyname
      --  for comment regarding .all'Unchecked_Access.
 
      Copy_Service_Entry
        (Source_Servent       => SE,
         Target_Servent       => Ret.all'Unchecked_Access,
         Target_Buffer        => Buf,
         Target_Buffer_Length => Buflen,
         Result               => Result);
 
      <<Unlock_Return>>
      GNAT.Task_Lock.Unlock;
      return Result;
   end Safe_Getservbyport;
 
   ----------------
   -- Store_Name --
   ----------------
 
   procedure Store_Name
     (Name          : char_array;
      Storage       : in out char_array;
      Storage_Index : in out size_t;
      Stored_Name   : out C.Strings.chars_ptr)
   is
      First : constant C.size_t := Storage_Index;
      Last  : constant C.size_t := Storage_Index + Name'Length - 1;
   begin
      Storage (First .. Last) := Name;
      Stored_Name := C.Strings.To_Chars_Ptr
                       (Storage (First .. Last)'Unrestricted_Access);
      Storage_Index := Last + 1;
   end Store_Name;
 
end GNAT.Sockets.Thin.Task_Safe_NetDB;