X-Git-Url: http://git.megabrutal.com/?p=mgsmtp.git;a=blobdiff_plain;f=Network.pas;h=d19aeeacbda844998fea48c0701f40c7cf56afeb;hp=5ef26164939b85795cf4abc85ef5cf93d20ba9f4;hb=HEAD;hpb=4806fe76baf12d97f1afe2f9b29ea384d37aa839 diff --git a/Network.pas b/Network.pas index 5ef2616..d19aeea 100644 --- a/Network.pas +++ b/Network.pas @@ -1,6 +1,6 @@ { Basic object-oriented network functions - Copyright (C) 2010-2014 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 @@ -37,7 +37,7 @@ unit Network; interface -uses Classes, Sockets, SocketUtils, DNSResolve, NetRFC, Common; +uses Classes, Sockets, SocketUtils, SysUtils, DNSResolve, NetRFC, Common; const @@ -54,15 +54,16 @@ type TTCPConnection = class constructor Create; overload; constructor Create(const HostName: string; Port: word); overload; - constructor Create(Socket: socket; const Addr: TSockAddr); overload; + constructor Create(Socket: socket); overload; destructor Destroy; override; private FConnected: boolean; FSocket: socket; FHostIP: TIPNamePair; FSockTimeOut: DWord; - sAddr: TSockAddr; + SrcSockAddr, DstSockAddr: TSockAddr; public + function SetBindAddress(const HostName: string): boolean; function Connect(const HostName: string; Port: word): boolean; procedure Disconnect; procedure ReverseDNSLookup; @@ -99,18 +100,20 @@ type end; TTCPListener = class(TThread) - constructor Create(Port: word; FeatureRequest: word); + constructor Create(const Address: string; Port: word; FeatureRequest: word); {destructor Destroy; override;} - private + protected FFeatureRequest: word; + FListenAddress: string; FListenPort: word; FListenSocket: socket; - sAddr: TSockAddr; - protected + SockAddr: TSockAddr; procedure HandleClient(Connection: TTCPConnection); virtual; abstract; procedure Execute; override; public + property ListenAddress: string read FListenAddress; property ListenPort: word read FListenPort; + function GetSockAddrStr: string; function StartListen: boolean; procedure StopListen; end; @@ -127,22 +130,28 @@ begin FConnected:= false; FSocket:= -1; FSockTimeOut:= DEF_SOCK_TIMEOUT; + FillChar(SrcSockAddr, SizeOf(SrcSockAddr), 0); + FillChar(DstSockAddr, SizeOf(DstSockAddr), 0); end; 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; -constructor TTCPConnection.Create(Socket: socket; const Addr: TSockAddr); +constructor TTCPConnection.Create(Socket: socket); { Use an already connected socket. } +var ssocklen, dsocklen: TSockLen; begin inherited Create; FSocket:= Socket; - sAddr:= Addr; - FHostIP:= TIPNamePair.Create('', NetAddrToStr(Addr.sin_addr)); + ssocklen:= SizeOf(SrcSockAddr); + dsocklen:= SizeOf(DstSockAddr); + fpgetsockname(FSocket, @SrcSockAddr, @ssocklen); + fpgetpeername(FSocket, @DstSockAddr, @dsocklen); + FHostIP:= TIPNamePair.Create('', NetAddrToStr(DstSockAddr.sin_addr)); FConnected:= true; end; @@ -163,37 +172,56 @@ begin end; -constructor TTCPListener.Create(Port: word; FeatureRequest: word); +constructor TTCPListener.Create(const Address: string; Port: word; FeatureRequest: word); begin + FListenAddress:= Address; FListenPort:= Port; FFeatureRequest:= FeatureRequest; FreeOnTerminate:= false; + FillChar(SockAddr, SizeOf(SockAddr), 0); inherited Create(true); end; +function TTCPConnection.SetBindAddress(const HostName: string): boolean; +var GAIResult: TGAIResult; +begin + GAIResult:= ResolveHost(HostName); + if GAIResult.GAIError = 0 then begin + SrcSockAddr:= GAIResult.AddrInfo^.ai_addr^; + FreeHost(GAIResult); + Result:= true; + end + else + Result:= false; +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); + if (SrcSockAddr.sin_addr.s_addr = 0) or (fpBind(FSocket, @SrcSockAddr, SizeOf(SrcSockAddr)) = 0) then begin + GAIResult:= ResolveHost(HostName); + if GAIResult.GAIError = 0 then begin + DstSockAddr:= GAIResult.AddrInfo^.ai_addr^; + DstSockAddr.sin_port:= htons(Port); + + if DstSockAddr.sin_addr.s_addr <> 0 then + { Try to initiate connection. } + FConnected:= fpConnect(FSocket, @DstSockAddr, SizeOf(DstSockAddr)) <> -1; + + if FConnected then begin + FHostIP:= TIPNamePair.Create(HostName, NetAddrToStr(DstSockAddr.sin_addr)); + SetSockTimeOut(FSockTimeOut); + end + else + CloseSocket(FSocket); + + FreeHost(GAIResult); + end; 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; @@ -212,15 +240,25 @@ procedure TTCPConnection.ReverseDNSLookup; var NHostIP: TIPNamePair; begin if FConnected then begin - NHostIP:= TIPNamePair.Create(ResolveIP(sAddr.sin_addr), FHostIP.IP); + NHostIP:= TIPNamePair.Create(ResolveIP(@DstSockAddr), 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); @@ -285,26 +323,35 @@ begin end; +function TTCPListener.GetSockAddrStr: string; +begin + Result:= NetAddrToStr(SockAddr.sin_addr) + ':' + IntToStr(ntohs(SockAddr.sin_port)); +end; + 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.s_addr:= 0; - 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. } - { TEMPORARY SETTING OF 1 FROM 512! } - 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; @@ -322,8 +369,8 @@ begin { 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; @@ -331,9 +378,9 @@ begin connection. } case FFeatureRequest of NET_TCP_BASIC: - TCPConnection:= TTCPConnection.Create(ClientSocket, sAddr); + TCPConnection:= TTCPConnection.Create(ClientSocket); NET_TCP_RFCSUPPORT: - TCPConnection:= TTCPRFCConnection.Create(ClientSocket, sAddr); + TCPConnection:= TTCPRFCConnection.Create(ClientSocket); end; { Then start a new thread with the connection handler. }