diff options
Diffstat (limited to 'c/src/lib/libbsp/i386/ts_386ex/tools/network_ada/adasockets/sockets-naming.adb')
| -rw-r--r-- | c/src/lib/libbsp/i386/ts_386ex/tools/network_ada/adasockets/sockets-naming.adb | 411 |
1 files changed, 0 insertions, 411 deletions
diff --git a/c/src/lib/libbsp/i386/ts_386ex/tools/network_ada/adasockets/sockets-naming.adb b/c/src/lib/libbsp/i386/ts_386ex/tools/network_ada/adasockets/sockets-naming.adb deleted file mode 100644 index 4faa989138..0000000000 --- a/c/src/lib/libbsp/i386/ts_386ex/tools/network_ada/adasockets/sockets-naming.adb +++ /dev/null @@ -1,411 +0,0 @@ ------------------------------------------------------------------------------ --- -- --- ADASOCKETS COMPONENTS -- --- -- --- S O C K E T S . N A M I N G -- --- -- --- B o d y -- --- -- --- $ReleaseVersion: 0.1.3 $ -- --- -- --- Copyright (C) 1996-1998 Free Software Foundation -- --- -- --- AdaSockets is free software; you can redistribute it and/or modify -- --- it under terms of the GNU General Public License as published by -- --- the Free Software Foundation; either version 2, or (at your option) -- --- any later version. AdaSockets is distributed in the hope that it -- --- will be useful, but WITHOUT 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 AdaSockets; see file COPYING. If not, write to the Free -- --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- --- 02111-1307, 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. -- --- -- --- The main repository for this software is located at: -- --- http://www-inf.enst.fr/ANC/ -- --- -- ------------------------------------------------------------------------------ - -with Ada.Exceptions; -with Interfaces.C; use Interfaces.C; -with Interfaces.C.Strings; use Interfaces.C.Strings; -with Sockets.Constants; use Sockets.Constants; -with Ada.Unchecked_Conversion; -with Ada.Unchecked_Deallocation; - -package body Sockets.Naming is - - use Sockets.Constants, Sockets.Thin; - - Default_Buffer_Size : constant := 16384; - - procedure Free is - new Ada.Unchecked_Deallocation (String, String_Access); - - procedure Free is - new Ada.Unchecked_Deallocation (char_array, char_array_access); - - function Allocate (Size : Positive := Default_Buffer_Size) - return char_array_access; - -- Allocate a buffer - - function Parse_Entry (Host : Hostent) - return Host_Entry; - -- Parse an entry - - procedure Raise_Naming_Error - (Errno : in C.int; - Message : in String); - -- Raise the exception Naming_Error with an appropriate error message - - C_Errno : C.int; - pragma Import (C, C_Errno, "h_errno"); - - ---------------- - -- Address_Of -- - ---------------- - - function Address_Of (Something : String) - return Address - is - begin - if Is_IP_Address (Something) then - return Value (Something); - else - return Info_Of (Something) .Addresses (1); - end if; - end Address_Of; - - ------------ - -- Adjust -- - ------------ - - procedure Adjust (Object : in out Host_Entry) - is - Aliases : String_Array renames Object.Aliases; - begin - Object.Name := new String'(Object.Name.all); - for I in Aliases'Range loop - Aliases (I) := new String'(Aliases (I) .all); - end loop; - end Adjust; - - -------------- - -- Allocate -- - -------------- - - function Allocate - (Size : Positive := Default_Buffer_Size) - return char_array_access - is - begin - return new char_array (1 .. size_t (Size)); - end Allocate; - - ----------------- - -- Any_Address -- - ----------------- - - function Any_Address return Address - is - begin - return To_Address (Inaddr_Any); - end Any_Address; - - -------------- - -- Finalize -- - -------------- - - procedure Finalize (Object : in out Host_Entry) - is - Aliases : String_Array renames Object.Aliases; - begin - Free (Object.Name); - for I in Aliases'Range loop - Free (Aliases (I)); - end loop; - end Finalize; - - --------------- - -- Host_Name -- - --------------- - - function Host_Name return String - is - Buff : char_array_access := Allocate; - Buffer : constant chars_ptr := To_Chars_Ptr (Buff); - Res : constant int := C_Gethostname (Buffer, Buff'Length); - begin - if Res = Failure then - Free (Buff); - Raise_Naming_Error (C_Errno, ""); - end if; - declare - Result : constant String := Value (Buffer); - begin - Free (Buff); - return Result; - end; - end Host_Name; - - ----------- - -- Image -- - ----------- - - function Image (Add : Address) return String - is - - function Image (A : Address_Component) return String; - -- Return the string corresponding to its argument without - -- the leading space. - - ----------- - -- Image -- - ----------- - - function Image (A : Address_Component) - return String - is - Im : constant String := Address_Component'Image (A); - begin - return Im (Im'First + 1 .. Im'Last); - end Image; - - begin - return Image (Add.H1) & "." & Image (Add.H2) & "." & - Image (Add.H3) & "." & Image (Add.H4); - end Image; - - ----------- - -- Image -- - ----------- - - function Image (Add : Thin.In_Addr) return String is - begin - return Image (To_Address (Add)); - end Image; - - ------------- - -- Info_Of -- - ------------- - - function Info_Of (Name : String) - return Host_Entry - is - Res : Hostent_Access; - C_Name : chars_ptr := New_String (Name); - begin - Res := C_Gethostbyname (C_Name); - Free (C_Name); - if Res = null then - Raise_Naming_Error (C_Errno, Name); - end if; - declare - Result : constant Host_Entry := Parse_Entry (Res.all); - begin - return Result; - end; - end Info_Of; - - ------------- - -- Info_Of -- - ------------- - - function Info_Of (Addr : Address) - return Host_Entry - is - function Convert is - new Ada.Unchecked_Conversion (Source => In_Addr_Access, - Target => chars_ptr); - Temp : aliased In_Addr := To_In_Addr (Addr); - C_Addr : constant chars_ptr := Convert (Temp'Unchecked_Access); - Res : Hostent_Access; - begin - Res := C_Gethostbyaddr (C_Addr, - C.int (Temp'Size / CHAR_BIT), - Constants.Af_Inet); - if Res = null then - Raise_Naming_Error (C_Errno, Image (Addr)); - end if; - declare - Result : constant Host_Entry := Parse_Entry (Res.all); - begin - return Result; - end; - end Info_Of; - - ------------------------ - -- Info_Of_Name_Or_IP -- - ------------------------ - - function Info_Of_Name_Or_IP (Something : String) - return Host_Entry - is - begin - if Is_IP_Address (Something) then - return Info_Of (Value (Something)); - else - return Info_Of (Something); - end if; - end Info_Of_Name_Or_IP; - - ------------------- - -- Is_Ip_Address -- - ------------------- - - function Is_IP_Address (Something : String) - return Boolean - is - begin - for Index in Something'Range loop - declare - Current : Character renames Something (Index); - begin - if (Current < '0' - or else Current > '9') - and then Current /= '.' then - return False; - end if; - end; - end loop; - return True; - end Is_IP_Address; - - ------------- - -- Name_Of -- - ------------- - - function Name_Of (Something : String) - return String - is - Hostent : constant Host_Entry := Info_Of_Name_Or_IP (Something); - begin - if Hostent.Name = null then - Ada.Exceptions.Raise_Exception (Naming_Error'Identity, - "No name for " & Something); - end if; - return Hostent.Name.all; - end Name_Of; - - ----------------- - -- Parse_Entry -- - ----------------- - - function Parse_Entry (Host : Hostent) - return Host_Entry - is - C_Aliases : constant Thin.Chars_Ptr_Array := - Chars_Ptr_Pointers.Value (Host.H_Aliases); - C_Addr : constant In_Addr_Access_Array := - In_Addr_Access_Pointers.Value - (Host.H_Addr_List); - Result : Host_Entry (N_Aliases => C_Aliases'Length - 1, - N_Addresses => C_Addr'Length - 1); - begin - Result.Name := new String'(Value (Host.H_Name)); - for I in 1 .. Result.Aliases'Last loop - declare - Index : Natural := I - 1 + Natural (C_Aliases'First); - Current : chars_ptr renames C_Aliases (size_t (Index)); - begin - Result.Aliases (I) := new String'(Value (Current)); - end; - end loop; - for I in Result.Addresses'Range loop - declare - Index : Natural := I - 1 + Natural (C_Addr'First); - Current : In_Addr_Access renames C_Addr (Index); - begin - Result.Addresses (I) := To_Address (Current.all); - end; - end loop; - return Result; - end Parse_Entry; - - ------------------------ - -- Raise_Naming_Error -- - ------------------------ - - procedure Raise_Naming_Error - (Errno : in C.int; - Message : in String) - is - - function Error_Message return String; - -- Return the message according to Errno. - - ------------------- - -- Error_Message -- - ------------------- - - function Error_Message return String is - begin - case Errno is - when Host_Not_Found => return "Host not found"; - when Try_Again => return "Try again"; - when No_Recovery => return "No recovery"; - when No_Address => return "No address"; - when others => return "Unknown error" & - C.int'Image (Errno); - end case; - end Error_Message; - - begin - Ada.Exceptions.Raise_Exception (Naming_Error'Identity, - Error_Message & ": " & Message); - end Raise_Naming_Error; - - ---------------- - -- To_Address -- - ---------------- - - function To_Address (Addr : In_Addr) return Address - is - begin - return (H1 => Address_Component (Addr.S_B1), - H2 => Address_Component (Addr.S_B2), - H3 => Address_Component (Addr.S_B3), - H4 => Address_Component (Addr.S_B4)); - end To_Address; - - ---------------- - -- To_In_Addr -- - ---------------- - - function To_In_Addr (Addr : Address) return In_Addr - is - begin - return (S_B1 => unsigned_char (Addr.H1), - S_B2 => unsigned_char (Addr.H2), - S_B3 => unsigned_char (Addr.H3), - S_B4 => unsigned_char (Addr.H4)); - end To_In_Addr; - - ----------- - -- Value -- - ----------- - - function Value (Add : String) return Address - is - function Convert is - new Ada.Unchecked_Conversion (Source => Interfaces.Unsigned_32, - Target => In_Addr); - C_Add : chars_ptr := New_String (Add); - Converted : constant In_Addr := Convert (C_Inet_Addr (C_Add)); - begin - Free (C_Add); - return (H1 => Address_Component (Converted.S_B1), - H2 => Address_Component (Converted.S_B2), - H3 => Address_Component (Converted.S_B3), - H4 => Address_Component (Converted.S_B4)); - end Value; - -end Sockets.Naming; |