paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-10-01 07:59:22 +02:00
Code Issues Packages Projects Releases Wiki Activity

--- Merging r32726 into '.':

Browse Source 
U    packages/fcl-net/src/cnetdb.pp
U    packages/fcl-net/fpmake.pp
--- Recording mergeinfo for merge of r32726 into '.':
 U   .
--- Merging r33094 into '.':
U    packages/fcl-net/src/ssockets.pp
--- Recording mergeinfo for merge of r33094 into '.':
 G   .
--- Merging r33166 into '.':
G    packages/fcl-net/src/ssockets.pp
--- Recording mergeinfo for merge of r33166 into '.':
 G   .
--- Merging r33332 into '.':
G    packages/fcl-net/src/cnetdb.pp
--- Recording mergeinfo for merge of r33332 into '.':
 G   .

# revisions: 32726,33094,33166,33332

git-svn-id: branches/fixes_3_0@33395 -
This commit is contained in:
marco 2016-03-31 09:32:54 +00:00
parent 929573ae72
commit ae2cab9b58
3 changed files with 187 additions and 76 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
packages/fcl-net/fpmake.pp
View File

@ -70,7 +70,7 @@ begin
end;
T.ResourceStrings := True;
T:=P.Targets.AddUnit('cnetdb.pp',[linux,freebsd]);
T:=P.Targets.AddUnit('cnetdb.pp',[linux,freebsd,solaris]);
P.ExamplePath.Add('examples');
P.Targets.AddExampleProgram('examples/ip6test.pp');

165
packages/fcl-net/src/cnetdb.pp
View File

@ -75,66 +75,105 @@ const
// (left in h_errno).
const
NETDB_INTERNAL = -(1); { see errno }
NETDB_SUCCESS = 0; { no problem }
HOST_NOT_FOUND = 1; { Authoritative Answer Host not found }
TRY_AGAIN = 2; { Non-Authoritative Host not found, or SERVERFAIL }
NO_RECOVERY = 3; { Non recoverable errors, FORMERR, REFUSED, NOTIMP }
NO_DATA = 4; { Valid name, no data record of requested type }
NO_ADDRESS = NO_DATA; { no address, look for MX record }
{
return codes from getaddrinfo()
}
EAI_AGAIN = 2; { address family for hostname not supported }
EAI_BADFLAGS = 3; { invalid value for ai_flags }
EAI_FAIL = 4; { non-recoverable failure in name resolution }
EAI_FAMILY = 5; { ai_family not supported }
EAI_MEMORY = 6; { memory allocation failure }
EAI_NONAME = 8; { hostname nor servname provided, or not known }
EAI_SERVICE = 9; { servname not supported for ai_socktype }
EAI_SOCKTYPE = 10; { ai_socktype not supported }
EAI_SYSTEM = 11; { system error returned in errno }
EAI_BADHINTS = 12;
EAI_PROTOCOL = 13;
EAI_MAX = 14;
{
* Flag values for getaddrinfo()
}
{ get address to use bind() }
AI_PASSIVE = $00000001;
{ fill ai_canonname }
AI_CANONNAME = $00000002;
{ prevent host name resolution }
AI_NUMERICHOST = $00000004;
{ prevent service name resolution }
AI_NUMERICSERV = $00000008;
{ IPv6 and IPv4-mapped (with AI_V4MAPPED) }
AI_ALL = $00000100;
{ accept IPv4-mapped if kernel supports }
AI_V4MAPPED_CFG = $00000200;
{ only if any address is assigned }
AI_ADDRCONFIG = $00000400;
{ accept IPv4-mapped IPv6 address }
AI_V4MAPPED = $00000800;
{ special recommended flags for getipnodebyname }
AI_DEFAULT = AI_V4MAPPED_CFG or AI_ADDRCONFIG;
{ valid flags for addrinfo (not a standard def, apps should not use it) }
AI_MASK = AI_PASSIVE or AI_CANONNAME or AI_NUMERICHOST or AI_NUMERICSERV or AI_ADDRCONFIG;
NETDB_INTERNAL = -(1); { see errno }
NETDB_SUCCESS = 0; { no problem }
HOST_NOT_FOUND = 1; { Authoritative Answer Host not found }
TRY_AGAIN = 2; { Non-Authoritative Host not found, or SERVERFAIL }
NO_RECOVERY = 3; { Non recoverable errors, FORMERR, REFUSED, NOTIMP }
NO_DATA = 4; { Valid name, no data record of requested type }
NO_ADDRESS = NO_DATA; { no address, look for MX record }
{$IF DEFINED(FREEBSD)}
AI_PASSIVE = $00000001;
AI_CANONNAME = $00000002;
AI_NUMERICHOST = $00000004;
AI_V4MAPPED = $00000008;
AI_ALL = $00000010;
AI_ADDRCONFIG = $00000020;
AI_DEFAULT = (AI_V4MAPPED OR AI_ADDRCONFIG);
EAI_ADDRFAMILY = 1; (* address family for hostname not supported *)
EAI_AGAIN = 2; (* temporary failure in name resolution *)
EAI_BADFLAGS = 3; (* invalid value for ai_flags *)
EAI_FAIL = 4; (* non-recoverable failure in name resolution *)
EAI_FAMILY = 5; (* ai_family not supported *)
EAI_MEMORY = 6; (* memory allocation failure *)
EAI_NODATA = 7; (* no address associated with hostname *)
EAI_NONAME = 8; (* hostname nor servname provided, or not known *)
EAI_SERVICE = 9; (* servname not supported for ai_socktype *)
EAI_SOCKTYPE = 10; (* ai_socktype not supported *)
EAI_SYSTEM = 11; (* system error returned in errno *)
EAI_BADHINTS = 12;
EAI_PROTOCOL = 13;
EAI_MAX = 14;
{$ELSE}
(* Possible values for `ai_flags' field in `addrinfo' structure. *)
AI_PASSIVE = $0001; (* Socket address is intended for `bind'. *)
AI_CANONNAME = $0002; (* Request for canonical name. *)
AI_NUMERICHOST = $0004; (* Don't use name resolution. *)
AI_V4MAPPED = $0008; (* IPv4 mapped addresses are acceptable. *)
AI_ALL = $0010; (* Return IPv4 mapped and IPv6 addresses. *)
AI_ADDRCONFIG = $0020; (* Use configuration of this host to choose returned address type.. *)
AI_IDN = $0040; (* IDN encode input (assuming it is encoded in the current locale's character set) before looking it up. *)
AI_CANONIDN = $0080; (* Translate canonical name from IDN format. *)
AI_IDN_ALLOW_UNASSIGNED = $0100; (* Don't reject unassigned Unicode code points. *)
AI_IDN_USE_STD3_ASCII_RULES = $0200; (* Validate strings according to STD3 rules. *)
AI_NUMERICSERV = $0400; (* Don't use name resolution. *)
(* Error values for `getaddrinfo' function. *)
EAI_BADFLAGS = -1; (* Invalid value for `ai_flags' field. *)
EAI_NONAME = -2; (* NAME or SERVICE is unknown. *)
EAI_AGAIN = -3; (* Temporary failure in name resolution. *)
EAI_FAIL = -4; (* Non-recoverable failure in name res. *)
EAI_NODATA = -5; (* No address associated with NAME. *)
EAI_FAMILY = -6; (* `ai_family' not supported. *)
EAI_SOCKTYPE = -7; (* `ai_socktype' not supported. *)
EAI_SERVICE = -8; (* SERVICE not supported for `ai_socktype'. *)
EAI_ADDRFAMILY = -9; (* Address family for NAME not supported. *)
EAI_MEMORY = -10; (* Memory allocation failure. *)
EAI_SYSTEM = -11; (* System error returned in `errno'. *)
EAI_OVERFLOW = -12; (* Argument buffer overflow. *)
EAI_INPROGRESS = -100; (* Processing request in progress. *)
EAI_CANCELED = -101; (* Request canceled. *)
EAI_NOTCANCELED = -102; (* Request not canceled. *)
EAI_ALLDONE = -103; (* All requests done. *)
EAI_INTR = -104; (* Interrupted by a signal. *)
EAI_IDN_ENCODE = -105; (* IDN encoding failed. *)
{$ENDIF}
(* Constants for getnameinfo() *)
NI_MAXHOST = 1025;
NI_MAXSERV = 32;
(* Flag values for getnameinfo() *)
{$IF DEFINED(FREEBSD)}
NI_NOFQDN = $00000001;
NI_NUMERICHOST = $00000002;
NI_NAMEREQD = $00000004;
NI_NUMERICSERV = $00000008;
NI_DGRAM = $00000010;
NI_NUMERICSCOPE = $00000020;
{$ELSE}
NI_NUMERICHOST = 1;
NI_NUMERICSERV = 2;
NI_NOFQDN = 4;
NI_NAMEREQD = 8;
NI_DGRAM = 16;
{$ENDIF}
{
* Constants for getnameinfo()
}
NI_MAXHOST = 1025;
NI_MAXSERV = 32;
{
* Flag values for getnameinfo()
}
NI_NOFQDN = $00000001;
NI_NUMERICHOST = $00000002;
NI_NAMEREQD = $00000004;
NI_NUMERICSERV = $00000008;
NI_DGRAM = $00000010;
{
* Scope delimit character
}
@ -194,11 +233,11 @@ type
{$if defined(LINUX) or defined(OPENBSD)}
{$define FIRST_ADDR_THEN_CANONNAME}
{$endif}
{$if defined(FREEBSD) or defined(NETBSD) or defined(DRAGONFLY)}
{$if defined(FREEBSD) or defined(NETBSD) or defined(DRAGONFLY) or defined(SOLARIS)}
{$define FIRST_CANONNAME_THEN_ADDR}
{$endif}
{$if not defined(FIRST_CANONNAME_THEN_ADDR) and not defined(FIRST_ADDR_THEN_CANONNAME)}
{$error fatal 'Please consult the netdh.h file for your system to determine the order of ai_addr and ai_canonname'}
{$error fatal 'Please consult the netdb.h file for your system to determine the order of ai_addr and ai_canonname'}
{$endif}
PAddrInfo = ^addrinfo;
@ -268,10 +307,10 @@ procedure sethostent(i: cInt); cdecl; external LIB_C name 'sethostent';
procedure setnetent(stayopen: cInt); cdecl; external LIB_C name 'setnetent';
procedure setprotoent(stayopen: cInt); cdecl; external LIB_C name 'setprotoent';
function getaddrinfo(hostname, servname: PChar;
hints: PAddrInfo; res: PPAddrInfo): cInt; cdecl; external LIB_C name 'getaddrinfo';
function getaddrinfo(name, service: PChar; hints: PAddrInfo;
res: PPAddrInfo): cInt; cdecl; external LIB_C name 'getaddrinfo';
function getnameinfo(sa: PSockAddr; salen: TSockLen; host: PChar; hostlen: TSize;
serv: PChar; servlen: TSize; flags: cInt): cInt; cdecl; external LIB_C name 'getnameinfo';
serv: PChar; servlen: TSize; flags: cInt): cInt; cdecl; external LIB_C name 'getnameinfo';
procedure freeaddrinfo(ai: PAddrInfo); cdecl; external LIB_C name 'freeaddrinfo';
function gai_strerror(ecode: cInt): PChar; cdecl; external LIB_C name 'gai_strerror';
procedure setnetgrent(netgroup: PChar); cdecl; external LIB_C name 'setnetgrent';

96
packages/fcl-net/src/ssockets.pp
View File

@ -29,7 +29,8 @@ type
seListenFailed,
seConnectFailed,
seAcceptFailed,
seAcceptWouldBlock);
seAcceptWouldBlock,
seIOTimeOut);
TSocketOption = (soDebug,soReuseAddr,soKeepAlive,soDontRoute,soBroadcast,
soOOBinline);
@ -79,11 +80,13 @@ type
FSocketOptions : TSocketOptions;
FWriteFlags: Integer;
FHandler : TSocketHandler;
FIOTimeout : Integer;
function GetLastError: Integer;
Procedure GetSockOptions;
Procedure SetSocketOptions(Value : TSocketOptions);
function GetLocalAddress: TSockAddr;
function GetRemoteAddress: TSockAddr;
procedure SetIOTimeout(AValue: Integer);
Public
Constructor Create (AHandle : Longint; AHandler : TSocketHandler = Nil);virtual;
destructor Destroy; override;
@ -97,6 +100,7 @@ type
Property LastError : Integer Read GetLastError;
Property ReadFlags : Integer Read FReadFlags Write FReadFlags;
Property WriteFlags : Integer Read FWriteFlags Write FWriteFlags;
Property IOTimeout : Integer read FIOTimeout Write SetIOTimeout;
end;
TConnectEvent = Procedure (Sender : TObject; Data : TSocketStream) Of Object;
@ -194,6 +198,7 @@ type
Protected
Procedure Bind; Override;
Function Accept : Longint;override;
function GetConnection: TSocketStream; override;
Function SockToStream (ASocket : Longint) : TSocketStream;Override;
Procedure Close; override;
Public
@ -253,7 +258,9 @@ resourcestring
strSocketConnectFailed = 'Connect to %s failed.';
strSocketAcceptFailed = 'Could not accept a client connection on socket: %d, error %d';
strSocketAcceptWouldBlock = 'Accept would block on socket: %d';
strSocketIOTimeOut = 'Failed to set IO Timeout to %d';
strErrNoStream = 'Socket stream not assigned';
{ TSocketHandler }
Procedure TSocketHandler.SetSocket(const AStream: TSocketStream);
@ -349,13 +356,14 @@ var
begin
Code := ACode;
case ACode of
seHostNotFound : s := strHostNotFound;
seCreationFailed: s := strSocketCreationFailed;
seBindFailed : s := strSocketBindFailed;
seListenFailed : s := strSocketListenFailed;
seConnectFailed : s := strSocketConnectFailed;
seAcceptFailed : s := strSocketAcceptFailed;
seAcceptWouldBLock : S:= strSocketAcceptWouldBlock;
seHostNotFound : s := strHostNotFound;
seCreationFailed : s := strSocketCreationFailed;
seBindFailed : s := strSocketBindFailed;
seListenFailed : s := strSocketListenFailed;
seConnectFailed : s := strSocketConnectFailed;
seAcceptFailed : s := strSocketAcceptFailed;
seAcceptWouldBLock : S := strSocketAcceptWouldBlock;
seIOTimeout : S := strSocketIOTimeOut;
end;
s := Format(s, MsgArgs);
inherited Create(s);
@ -385,9 +393,28 @@ begin
inherited Destroy;
end;
Procedure TSocketStream.GetSockOptions;
procedure TSocketStream.GetSockOptions;
{$ifdef windows}
var
opt: DWord;
olen: tsocklen;
{$endif windows}
{$ifdef unix}
var
time: ttimeval;
olen: tsocklen;
{$endif unix}
begin
{$ifdef windows}
olen:=4;
if fpgetsockopt(Handle, SOL_SOCKET, SO_RCVTIMEO, @opt, @olen) = 0 then
FIOTimeout:=opt;
{$endif windows}
{$ifdef unix}
olen:=sizeof(time);
if fpgetsockopt(Handle, SOL_SOCKET, SO_RCVTIMEO, @time, @olen) = 0 then
FIOTimeout:=(time.tv_sec*1000)+(time.tv_usec div 1000);
{$endif}
end;
function TSocketStream.GetLastError: Integer;
@ -436,6 +463,37 @@ begin
FillChar(Result, SizeOf(Result), 0);
end;
procedure TSocketStream.SetIOTimeout(AValue: Integer);
Var
E : Boolean;
{$ifdef windows}
opt: DWord;
{$endif windows}
{$ifdef unix}
time: ttimeval;
{$endif unix}
begin
if FIOTimeout=AValue then Exit;
FIOTimeout:=AValue;
{$ifdef windows}
opt := AValue;
E:=fpsetsockopt(Handle, SOL_SOCKET, SO_RCVTIMEO, @opt, 4)<>0;
if not E then
E:=fpsetsockopt(Handle, SOL_SOCKET, SO_SNDTIMEO, @opt, 4)<>0;
{$endif windows}
{$ifdef unix}
time.tv_sec:=avalue div 1000;
time.tv_usec:=(avalue mod 1000) * 1000;
E:=fpsetsockopt(Handle, SOL_SOCKET, SO_RCVTIMEO, @time, sizeof(time))<>0;
if not E then
E:=fpsetsockopt(Handle, SOL_SOCKET, SO_SNDTIMEO, @time, sizeof(time))<>0;
{$endif}
if E then
Raise ESocketError.Create(seIOTimeout,[AValue]);
end;
{ ---------------------------------------------------------------------
TSocketServer
@ -509,11 +567,9 @@ Function TInetServer.GetConnection : TSocketStream;
var
NewSocket : longint;
l : integer;
begin
Result:=Nil;
L:=SizeOf(FAddr);
NewSocket:=Accept;
if (NewSocket<0) then
Raise ESocketError.Create(seAcceptFailed,[Socket,SocketError]);
@ -817,6 +873,22 @@ begin
(Result as TUnixSocket).FFileName:=FFileName;
end;
Function TUnixServer.GetConnection : TSocketStream;
var
NewSocket : longint;
begin
Result:=Nil;
NewSocket:=Accept;
if (NewSocket<0) then
Raise ESocketError.Create(seAcceptFailed,[Socket,SocketError]);
If FAccepting and DoConnectQuery(NewSocket) Then
Result:=SockToStream(NewSocket)
else
CloseSocket(NewSocket);
end;
{$endif}
{ ---------------------------------------------------------------------