{
- Copyright (C) 2010 MegaBrutal
+ Copyright (C) 2010-2018 MegaBrutal
This unit is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
unit DNSResolve;
interface
-uses WinSock, Sockets;
+uses WinSock, Sockets, ctypes;
+type
- function ResolveHost(HostName: ansistring): in_addr;
- function ResolveIP(IP: in_addr): ansistring;
+ PAddrInfo = ^TAddrInfo;
+ TAddrInfo = record
+ ai_flags: cint;
+ ai_family: cint;
+ ai_socktype: cint;
+ ai_protocol: cint;
+ ai_addrlen: size_t;
+ ai_canonname: PChar;
+ ai_addr: PSockAddr;
+ ai_next: PAddrInfo;
+ end;
+
+ TGAIResult = record
+ GAIError: integer;
+ AddrInfo: PAddrInfo;
+ end;
+
+
+ function getaddrinfo(NodeName, ServiceName: PChar; Hints: PAddrInfo; var AddrInfo: PAddrInfo): cint; stdcall;
+ external 'ws2_32.dll' name 'getaddrinfo';
+
+ procedure freeaddrinfo(AddrInfo: PAddrInfo); stdcall;
+ external 'ws2_32.dll' name 'freeaddrinfo';
+
+ function getnameinfo(SockAddr: PSockAddr; SockAddrLength: cuint32; NodeBuffer: PChar; NodeBufferSize: cuint32;
+ ServiceBuffer: PChar; ServiceBufferSize: cuint32; Flags: cint): cint; stdcall;
+ external 'ws2_32.dll' name 'getnameinfo';
+
+ function ResolveHost(HostName: ansistring): TGAIResult;
+ procedure FreeHost(var GAIResult: TGAIResult);
+ function ResolveIP(SockAddr: PSockAddr): ansistring;
implementation
-function ResolveHost(HostName: ansistring): in_addr;
-var
- HostEnt: PHostEnt;
+function ResolveHost(HostName: ansistring): TGAIResult;
+var hint: TAddrInfo;
+begin
+ FillByte(hint, SizeOf(hint), 0);
+ with hint do begin
+ ai_family:= AF_INET;
+ ai_socktype:= SOCK_STREAM;
+ ai_protocol:= IPPROTO_TCP;
+ end;
+ ResolveHost.GAIError:= getaddrinfo(PChar(HostName), nil, @hint, ResolveHost.AddrInfo);
+end;
+
+procedure FreeHost(var GAIResult: TGAIResult);
begin
- HostEnt:= gethostbyname(PChar(HostName));
- if HostEnt <> nil then
- ResolveHost.s_addr:= PLongWord(HostEnt^.h_addr_list[0])^
- else
- ResolveHost.s_addr:= 0;
+ if GAIResult.AddrInfo <> nil then begin
+ freeaddrinfo(GAIResult.AddrInfo);
+ GAIResult.AddrInfo:= nil;
+ end;
end;
-function ResolveIP(IP: in_addr): ansistring;
+function ResolveIP(SockAddr: PSockAddr): ansistring;
var
- HostEnt: PHostEnt;
+ r: integer;
+ NodeBuffer: array[0..255] of char;
begin
- HostEnt:= gethostbyaddr(@IP, 4, AF_INET);
- if HostEnt <> nil then
- ResolveIP:= HostEnt^.h_name
- else
- ResolveIP:= NetAddrToStr(IP);
+ NodeBuffer[0]:= #0;
+ r:= getnameinfo(SockAddr, SizeOf(TSockAddr), @NodeBuffer, SizeOf(NodeBuffer), nil, 0, 0);
+ if r = 0 then ResolveIP:= PChar(@NodeBuffer)
+ else ResolveIP:= NetAddrToStr(SockAddr^.sin_addr);
end;
FSocket: socket;
FHostIP: TIPNamePair;
FSockTimeOut: DWord;
- sAddr: TSockAddr;
+ SockAddr: TSockAddr;
public
function Connect(const HostName: string; Port: word): boolean;
procedure Disconnect;
FListenAddress: string;
FListenPort: word;
FListenSocket: socket;
- sAddr: TSockAddr;
+ SockAddr: TSockAddr;
protected
procedure HandleClient(Connection: TTCPConnection); virtual; abstract;
procedure Execute; override;
constructor TTCPConnection.Create(const HostName: string; Port: word);
{ Connect to the given port on the given hostname. }
begin
- inherited Create;
+ Create;
Connect(HostName, Port);
end;
begin
inherited Create;
FSocket:= Socket;
- sAddr:= Addr;
+ SockAddr:= Addr;
FHostIP:= TIPNamePair.Create('', NetAddrToStr(Addr.sin_addr));
FConnected:= true;
end;
FListenPort:= Port;
FFeatureRequest:= FeatureRequest;
FreeOnTerminate:= false;
+ FillChar(SockAddr, SizeOf(SockAddr), 0);
inherited Create(true);
end;
function TTCPConnection.Connect(const HostName: string; Port: word): boolean;
{ Resolves the given hostname, and tries to connect it on the given port. }
+var GAIResult: TGAIResult;
begin
FSocket:= fpSocket(af_inet, sock_stream, 0);
if (FSocket <> -1) then begin
- with sAddr do begin
- sin_family:= af_inet;
- sin_port:= htons(Port);
- { Resolve hostname to IP address. }
- sin_addr:= ResolveHost(HostName);
+ GAIResult:= ResolveHost(HostName);
+ if GAIResult.GAIError = 0 then begin
+ SockAddr:= GAIResult.AddrInfo^.ai_addr^;
+ SockAddr.sin_port:= htons(Port);
+
+ if SockAddr.sin_addr.s_addr <> 0 then
+ { Try to initiate connection. }
+ FConnected:= fpConnect(FSocket, @SockAddr, SizeOf(SockAddr)) <> -1;
+
+ if FConnected then begin
+ FHostIP:= TIPNamePair.Create(HostName, NetAddrToStr(SockAddr.sin_addr));
+ SetSockTimeOut(FSockTimeOut);
+ end
+ else
+ CloseSocket(FSocket);
+
+ FreeHost(GAIResult);
end;
-
- if sAddr.sin_addr.s_addr <> 0 then
- { Try to initiate connection. }
- FConnected:= fpConnect(FSocket, @sAddr, SizeOf(sAddr)) <> -1;
-
- if FConnected then begin
- FHostIP:= TIPNamePair.Create(HostName, NetAddrToStr(sAddr.sin_addr));
- SetSockTimeOut(FSockTimeOut);
- end
- else
- CloseSocket(FSocket);
end;
Result:= FConnected;
end;
var NHostIP: TIPNamePair;
begin
if FConnected then begin
- NHostIP:= TIPNamePair.Create(ResolveIP(sAddr.sin_addr), FHostIP.IP);
+ NHostIP:= TIPNamePair.Create(ResolveIP(@SockAddr), FHostIP.IP);
FHostIP.Free;
FHostIP:= NHostIP;
end;
end;
function TTCPConnection.VerifyFCrDNS: boolean;
+var GAIResult: TGAIResult; ai: PAddrInfo;
begin
- Result:= NetAddrToStr(ResolveHost(HostIP.Name)) = HostIP.IP;
+ Result:= false;
+ GAIResult:= ResolveHost(HostIP.Name);
+ if GAIResult.GAIError = 0 then begin
+ ai:= GAIResult.AddrInfo;
+ { One of the addresses must match. }
+ while (ai <> nil) and not Result do begin
+ Result:= NetAddrToStr(ai^.ai_addr^.sin_addr) = HostIP.IP;
+ ai:= ai^.ai_next;
+ end;
+ end;
end;
procedure TTCPConnection.SetSockTimeOut(TimeOut: DWord);
function TTCPListener.StartListen: boolean;
+var GAIResult: TGAIResult;
begin
FListenSocket:= fpSocket(af_inet, sock_stream, 0);
if FListenSocket <> -1 then begin
- with sAddr do begin
- sin_family:= af_inet;
- sin_port:= htons(FListenPort);
- sin_addr:= ResolveHost(FListenAddress);
- end;
- if fpBind(FListenSocket, @sAddr, sizeof(sAddr)) <> -1 then begin
- { It seems the maximum connection value isn't enforced by the
- Free Pascal library, so this 512 is a constant, dummy value. }
- if fpListen(FListenSocket, 512) <> -1 then begin
- Result:= true;
- Start;
+ GAIResult:= ResolveHost(FListenAddress);
+ if GAIResult.GAIError = 0 then begin
+ SockAddr:= GAIResult.AddrInfo^.ai_addr^;
+ SockAddr.sin_port:= htons(FListenPort);
+
+ if fpBind(FListenSocket, @SockAddr, SizeOf(SockAddr)) <> -1 then begin
+ { It seems the maximum connection value isn't enforced by the
+ Free Pascal library, so this 512 is a constant, dummy value. }
+ if fpListen(FListenSocket, 512) <> -1 then begin
+ Result:= true;
+ Start;
+ end
+ else Result:= false;
end
else Result:= false;
+
+ FreeHost(GAIResult);
end
- else Result:= false;
+ else Result:= false;
end
else Result:= false;
end;
{ Now, accept connections. }
AcceptFailCount:= 0;
while not Terminated do begin
- Len:= SizeOf(sAddr);
- ClientSocket:= fpAccept(FListenSocket, @sAddr, @Len);
+ Len:= SizeOf(SockAddr);
+ ClientSocket:= fpAccept(FListenSocket, @SockAddr, @Len);
if ClientSocket <> -1 then begin
AcceptFailCount:= 0;
connection. }
case FFeatureRequest of
NET_TCP_BASIC:
- TCPConnection:= TTCPConnection.Create(ClientSocket, sAddr);
+ TCPConnection:= TTCPConnection.Create(ClientSocket, SockAddr);
NET_TCP_RFCSUPPORT:
- TCPConnection:= TTCPRFCConnection.Create(ClientSocket, sAddr);
+ TCPConnection:= TTCPRFCConnection.Create(ClientSocket, SockAddr);
end;
{ Then start a new thread with the connection handler. }