-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2009, AdaCore --
+-- Copyright (C) 2001-2010, 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- --
function To_Service_Entry (E : Servent_Access) return Service_Entry_Type;
-- Conversion function
+ function Value (S : System.Address) return String;
+ -- Same as Interfaces.C.Strings.Value but taking a System.Address (on VMS,
+ -- chars_ptr is a 32-bit pointer, and here we need a 64-bit version).
+
function To_Timeval (Val : Timeval_Duration) return Timeval;
-- Separate Val in seconds and microseconds
function Is_Open (S : Selector_Type) return Boolean;
-- Return True for an "open" Selector_Type object, i.e. one for which
- -- Create_Selector has been called and Close_Selector has not been called.
+ -- Create_Selector has been called and Close_Selector has not been called,
+ -- or the null selector.
---------
-- "+" --
begin
if not Is_Open (Selector) then
raise Program_Error with "closed selector";
+
+ elsif Selector.Is_Null then
+ raise Program_Error with "null selector";
+
end if;
-- Send one byte to unblock select system call
--------------------
procedure Check_Selector
- (Selector : in out Selector_Type;
+ (Selector : Selector_Type;
R_Socket_Set : in out Socket_Set_Type;
W_Socket_Set : in out Socket_Set_Type;
Status : out Selector_Status;
--------------------
procedure Check_Selector
- (Selector : in out Selector_Type;
+ (Selector : Selector_Type;
R_Socket_Set : in out Socket_Set_Type;
W_Socket_Set : in out Socket_Set_Type;
E_Socket_Set : in out Socket_Set_Type;
is
Res : C.int;
Last : C.int;
- RSig : constant Socket_Type := Selector.R_Sig_Socket;
+ RSig : Socket_Type := No_Socket;
TVal : aliased Timeval;
TPtr : Timeval_Access;
TPtr := TVal'Unchecked_Access;
end if;
- -- Add read signalling socket
+ -- Add read signalling socket, if present
- Set (R_Socket_Set, RSig);
+ if not Selector.Is_Null then
+ RSig := Selector.R_Sig_Socket;
+ Set (R_Socket_Set, RSig);
+ end if;
Last := C.int'Max (C.int'Max (C.int (R_Socket_Set.Last),
C.int (W_Socket_Set.Last)),
-- If Select was resumed because of read signalling socket, read this
-- data and remove socket from set.
- if Is_Set (R_Socket_Set, RSig) then
+ if RSig /= No_Socket and then Is_Set (R_Socket_Set, RSig) then
Clear (R_Socket_Set, RSig);
Res := Signalling_Fds.Read (C.int (RSig));
procedure Close_Selector (Selector : in out Selector_Type) is
begin
- if not Is_Open (Selector) then
-
- -- Selector already in closed state: nothing to do
+ -- Nothing to do if selector already in closed state
+ if Selector.Is_Null or else not Is_Open (Selector) then
return;
end if;
begin
Netdb_Lock;
+
if C_Gethostbyaddr (HA'Address, HA'Size / 8, SOSC.AF_INET,
Res'Access, Buf'Address, Buflen, Err'Access) /= 0
then
begin
Netdb_Lock;
+
if C_Gethostbyname
(HN, Res'Access, Buf'Address, Buflen, Err'Access) /= 0
then
begin
Netdb_Lock;
+
if C_Getservbyname (SN, SP, Res'Access, Buf'Address, Buflen) /= 0 then
Netdb_Unlock;
raise Service_Error with "Service not found";
begin
Netdb_Lock;
+
if C_Getservbyport
(C.int (Short_To_Network (C.unsigned_short (Port))), SP,
Res'Access, Buf'Address, Buflen) /= 0
use Interfaces.C.Strings;
Img : aliased char_array := To_C (Image);
- Cp : constant chars_ptr := To_Chars_Ptr (Img'Unchecked_Access);
Addr : aliased C.int;
Res : C.int;
Result : Inet_Addr_Type;
Raise_Socket_Error (SOSC.EINVAL);
end if;
- Res := Inet_Pton (SOSC.AF_INET, Cp, Addr'Address);
+ Res := Inet_Pton (SOSC.AF_INET, Img'Address, Addr'Address);
if Res < 0 then
Raise_Socket_Error (Socket_Errno);
function Is_Open (S : Selector_Type) return Boolean is
begin
- -- Either both controlling socket descriptors are valid (case of an
- -- open selector) or neither (case of a closed selector).
+ if S.Is_Null then
+ return True;
- pragma Assert ((S.R_Sig_Socket /= No_Socket)
- =
- (S.W_Sig_Socket /= No_Socket));
+ else
+ -- Either both controlling socket descriptors are valid (case of an
+ -- open selector) or neither (case of a closed selector).
+
+ pragma Assert ((S.R_Sig_Socket /= No_Socket)
+ =
+ (S.W_Sig_Socket /= No_Socket));
- return S.R_Sig_Socket /= No_Socket;
+ return S.R_Sig_Socket /= No_Socket;
+ end if;
end Is_Open;
------------
return Resource_Temporarily_Unavailable;
end if;
- pragma Warnings (On);
-
-- This is not a case statement because if a particular error
-- number constant is not defined, s-oscons-tmplt.c defines
-- it to -1. If multiple constants are not defined, they
-- would each be -1 and result in a "duplicate value in case" error.
+ --
+ -- But we have to leave warnings off because the compiler is also
+ -- smart enough to note that when two errnos have the same value,
+ -- the second if condition is useless.
if Error_Value = ENOERROR then
return Success;
elsif Error_Value = EACCES then
else
return Cannot_Resolve_Error;
end if;
+ pragma Warnings (On);
+
end Resolve_Error;
-----------------------
begin
Aliases_Count := 0;
- while Hostent_H_Alias (E, C.int (Aliases_Count)) /= Null_Ptr loop
+ while Hostent_H_Alias (E, C.int (Aliases_Count)) /= Null_Address loop
Aliases_Count := Aliases_Count + 1;
end loop;
Addresses_Count := 0;
- while Hostent_H_Addr (E, C.int (Addresses_Count)) /= Null_Ptr loop
+ while Hostent_H_Addr (E, C.int (Addresses_Count)) /= Null_Address loop
Addresses_Count := Addresses_Count + 1;
end loop;
for J in Result.Addresses'Range loop
declare
Addr : In_Addr;
- function To_Address is
- new Ada.Unchecked_Conversion (chars_ptr, System.Address);
for Addr'Address use
- To_Address (Hostent_H_Addr
- (E, C.int (J - Result.Addresses'First)));
+ Hostent_H_Addr (E, C.int (J - Result.Addresses'First));
pragma Import (Ada, Addr);
begin
To_Inet_Addr (Addr, Result.Addresses (J));
begin
Aliases_Count := 0;
- while Servent_S_Alias (E, C.int (Aliases_Count)) /= Null_Ptr loop
+ while Servent_S_Alias (E, C.int (Aliases_Count)) /= Null_Address loop
Aliases_Count := Aliases_Count + 1;
end loop;
end To_Timeval;
-----------
+ -- Value --
+ -----------
+
+ function Value (S : System.Address) return String is
+ Str : String (1 .. Positive'Last);
+ for Str'Address use S;
+ pragma Import (Ada, Str);
+
+ Terminator : Positive := Str'First;
+
+ begin
+ while Str (Terminator) /= ASCII.NUL loop
+ Terminator := Terminator + 1;
+ end loop;
+
+ return Str (1 .. Terminator - 1);
+ end Value;
+
+ -----------
-- Write --
-----------
OSDN Git Service
