Network.pas

   1 {
   2    Basic object-oriented network functions
   3    Copyright (C) 2010-2018 MegaBrutal
   4
   5    This unit is free software: you can redistribute it and/or modify
   6    it under the terms of the GNU Lesser General Public License as published by
   7    the Free Software Foundation, either version 3 of the License, or
   8    (at your option) any later version.
   9
  10    This unit is distributed in the hope that it will be useful,
  11    but WITHOUT ANY WARRANTY; without even the implied warranty of
  12    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13    GNU Lesser General Public License for more details.
  14
  15    You should have received a copy of the GNU Lesser General Public License
  16    along with this program.  If not, see <http://www.gnu.org/licenses/>.
  17 }
  18
  19 {
  20    Unit: Network
  21    This unit provides an object-oriented interface to manage TCP/IPv4
  22    connections.
  23
  24    TTCPConnection - provides methods for sending/receiving buffers through
  25       the connection, and some support for text-based communication.
  26
  27    TTCPRFCConnection - in addition to TTCPConnection, it provides methods
  28       to send/receive RFC-style commands and responses.
  29
  30    TTCPListener - opens a port to listen on, and accepts incoming connections
  31       through it. Override its "HandleClient" method to serve connected
  32       clients.
  33 }
  34
  35
  36 {$MODE DELPHI}
  37 unit Network;
  38
  39 interface
  40 uses Classes, Sockets, SocketUtils, DNSResolve, NetRFC, Common;
  41
  42 const
  43
  44    { Connection feature requests: }
  45    NET_TCP_BASIC        =  0;
  46    NET_TCP_RFCSUPPORT   =  1;
  47
  48    { Default socket timeout: }
  49    DEF_SOCK_TIMEOUT     =  5 * 60000;     { 5 minutes. }
  50
  51
  52 type
  53
  54    TTCPConnection = class
  55       constructor Create; overload;
  56       constructor Create(const HostName: string; Port: word); overload;
  57       constructor Create(Socket: socket; const Addr: TSockAddr); overload;
  58       destructor Destroy; override;
  59    private
  60       FConnected: boolean;
  61       FSocket: socket;
  62       FHostIP: TIPNamePair;
  63       FSockTimeOut: DWord;
  64       SockAddr: TSockAddr;
  65    public
  66       function Connect(const HostName: string; Port: word): boolean;
  67       procedure Disconnect;
  68       procedure ReverseDNSLookup;
  69       function VerifyFCrDNS: boolean;
  70       procedure SetSockTimeOut(TimeOut: DWord);
  71       function ReadBuffer(PtrBuffer: pointer; Len: size_t): ssize_t;
  72       function WriteBuffer(PtrBuffer: pointer; Len: size_t): ssize_t;
  73       function ReadLn(var Line: string): boolean;
  74       function WriteLn(const Line: string): boolean;
  75       property Connected: boolean read FConnected;
  76       property Socket: socket read FSocket;
  77       property HostIP: TIPNamePair read FHostIP;
  78       property SockTimeOut: DWord read FSockTimeOut write SetSockTimeOut;
  79    end;
  80
  81    TTCPRFCConnection = class(TTCPConnection)
  82    public
  83       function ReadCommand(var Command: shortstring; var Prms: string): boolean;
  84       function ReadResponse(Response: TRFCReply): boolean;
  85       function SendCommand(Command: shortstring): boolean; overload;
  86       function SendCommand(Command: shortstring; Prms: string): boolean; overload;
  87       function SendResponse(Response: TRFCReply): boolean;
  88    end;
  89
  90
  91    TTCPAcceptHandler = procedure(Connection: TTCPConnection) of object;
  92
  93    TTCPAcceptor = class(TThread)
  94       constructor Create(Handler: TTCPAcceptHandler; TCPConnection: TTCPConnection);
  95    protected
  96       FHandler: TTCPAcceptHandler;
  97       FTCPConnection: TTCPConnection;
  98       procedure Execute; override;
  99    end;
 100
 101    TTCPListener = class(TThread)
 102       constructor Create(const Address: string; Port: word; FeatureRequest: word);
 103       {destructor Destroy; override;}
 104    private
 105       FFeatureRequest: word;
 106       FListenAddress: string;
 107       FListenPort: word;
 108       FListenSocket: socket;
 109       SockAddr: TSockAddr;
 110    protected
 111       procedure HandleClient(Connection: TTCPConnection); virtual; abstract;
 112       procedure Execute; override;
 113    public
 114       property ListenPort: word read FListenPort;
 115       function StartListen: boolean;
 116       procedure StopListen;
 117    end;
 118
 119
 120
 121 implementation
 122
 123
 124 constructor TTCPConnection.Create;
 125 { Create an instance, but don't connect to anywhere yet. }
 126 begin
 127    inherited Create;
 128    FConnected:= false;
 129    FSocket:= -1;
 130    FSockTimeOut:= DEF_SOCK_TIMEOUT;
 131 end;
 132
 133 constructor TTCPConnection.Create(const HostName: string; Port: word);
 134 { Connect to the given port on the given hostname. }
 135 begin
 136    Create;
 137    Connect(HostName, Port);
 138 end;
 139
 140 constructor TTCPConnection.Create(Socket: socket; const Addr: TSockAddr);
 141 { Use an already connected socket. }
 142 begin
 143    inherited Create;
 144    FSocket:= Socket;
 145    SockAddr:= Addr;
 146    FHostIP:= TIPNamePair.Create('', NetAddrToStr(Addr.sin_addr));
 147    FConnected:= true;
 148 end;
 149
 150 destructor TTCPConnection.Destroy;
 151 begin
 152    if FConnected then Disconnect;
 153    inherited Destroy;
 154 end;
 155
 156
 157 constructor TTCPAcceptor.Create(Handler: TTCPAcceptHandler; TCPConnection: TTCPConnection);
 158 { Start a connection handler on a distinct thread. }
 159 begin
 160    FHandler:= Handler;
 161    FTCPConnection:= TCPConnection;
 162    FreeOnTerminate:= true;
 163    inherited Create(false);
 164 end;
 165
 166
 167 constructor TTCPListener.Create(const Address: string; Port: word; FeatureRequest: word);
 168 begin
 169    FListenAddress:= Address;
 170    FListenPort:= Port;
 171    FFeatureRequest:= FeatureRequest;
 172    FreeOnTerminate:= false;
 173    FillChar(SockAddr, SizeOf(SockAddr), 0);
 174    inherited Create(true);
 175 end;
 176
 177
 178 function TTCPConnection.Connect(const HostName: string; Port: word): boolean;
 179 { Resolves the given hostname, and tries to connect it on the given port. }
 180 var GAIResult: TGAIResult;
 181 begin
 182    FSocket:= fpSocket(af_inet, sock_stream, 0);
 183    if (FSocket <> -1) then begin
 184       GAIResult:= ResolveHost(HostName);
 185           if GAIResult.GAIError = 0 then begin
 186              SockAddr:= GAIResult.AddrInfo^.ai_addr^;
 187                  SockAddr.sin_port:= htons(Port);
 188
 189                  if SockAddr.sin_addr.s_addr <> 0 then
 190                     { Try to initiate connection. }
 191                     FConnected:= fpConnect(FSocket, @SockAddr, SizeOf(SockAddr)) <> -1;
 192
 193                  if FConnected then begin
 194                     FHostIP:= TIPNamePair.Create(HostName, NetAddrToStr(SockAddr.sin_addr));
 195                     SetSockTimeOut(FSockTimeOut);
 196                  end
 197                  else
 198                     CloseSocket(FSocket);
 199
 200          FreeHost(GAIResult);
 201       end;
 202    end;
 203    Result:= FConnected;
 204 end;
 205
 206 procedure TTCPConnection.Disconnect;
 207 begin
 208    fpShutdown(FSocket, 2);
 209    CloseSocket(FSocket);
 210    FSocket:= -1;
 211    FHostIP.Free;
 212    FConnected:= false;
 213 end;
 214
 215 procedure TTCPConnection.ReverseDNSLookup;
 216 { Performs a reverse DNS lookup, and updates the HostIP structure. }
 217 var NHostIP: TIPNamePair;
 218 begin
 219    if FConnected then begin
 220       NHostIP:= TIPNamePair.Create(ResolveIP(@SockAddr), FHostIP.IP);
 221       FHostIP.Free;
 222       FHostIP:= NHostIP;
 223    end;
 224 end;
 225
 226 function TTCPConnection.VerifyFCrDNS: boolean;
 227 var GAIResult: TGAIResult; ai: PAddrInfo;
 228 begin
 229    Result:= false;
 230    GAIResult:= ResolveHost(HostIP.Name);
 231    if GAIResult.GAIError = 0 then begin
 232       ai:= GAIResult.AddrInfo;
 233           { One of the addresses must match. }
 234           while (ai <> nil) and not Result do begin
 235              Result:= NetAddrToStr(ai^.ai_addr^.sin_addr) = HostIP.IP;
 236                  ai:= ai^.ai_next;
 237       end;
 238    end;
 239 end;
 240
 241 procedure TTCPConnection.SetSockTimeOut(TimeOut: DWord);
 242 begin
 243    FSockTimeOut:= TimeOut;
 244    if Connected then begin
 245       fpSetSockOpt(FSocket, SOL_SOCKET, SO_RCVTIMEO, @FSockTimeOut, SizeOf(FSockTimeOut));
 246       fpSetSockOpt(FSocket, SOL_SOCKET, SO_SNDTIMEO, @FSockTimeOut, SizeOf(FSockTimeOut));
 247    end;
 248 end;
 249
 250 function TTCPConnection.ReadBuffer(PtrBuffer: pointer; Len: size_t): ssize_t;
 251 begin
 252    Result:= fpRecv(FSocket, PtrBuffer, Len, 0);
 253 end;
 254
 255 function TTCPConnection.WriteBuffer(PtrBuffer: pointer; Len: size_t): ssize_t;
 256 begin
 257    Result:= fpSend(FSocket, PtrBuffer, Len, 0);
 258 end;
 259
 260 function TTCPConnection.ReadLn(var Line: string): boolean;
 261 begin
 262    Result:= SockReadLn(FSocket, Line);
 263 end;
 264
 265 function TTCPConnection.WriteLn(const Line: string): boolean;
 266 begin
 267    Result:= SockWriteLn(FSocket, Line);
 268 end;
 269
 270
 271 function TTCPRFCConnection.ReadCommand(var Command: shortstring; var Prms: string): boolean;
 272 begin
 273    Result:= NetRFC.ReadCommand(FSocket, Command, Prms);
 274 end;
 275
 276 function TTCPRFCConnection.ReadResponse(Response: TRFCReply): boolean;
 277 begin
 278    Result:= NetRFC.ReadResponse(FSocket, Response);
 279 end;
 280
 281 function TTCPRFCConnection.SendCommand(Command: shortstring): boolean;
 282 begin
 283    Result:= NetRFC.SendCommand(FSocket, Command);
 284 end;
 285
 286 function TTCPRFCConnection.SendCommand(Command: shortstring; Prms: string): boolean;
 287 begin
 288    Result:= NetRFC.SendCommand(FSocket, Command, Prms);
 289 end;
 290
 291 function TTCPRFCConnection.SendResponse(Response: TRFCReply): boolean;
 292 begin
 293    Result:= NetRFC.SendResponse(FSocket, Response);
 294 end;
 295
 296
 297 procedure TTCPAcceptor.Execute;
 298 begin
 299    FHandler(FTCPConnection);
 300 end;
 301
 302
 303 function TTCPListener.StartListen: boolean;
 304 var GAIResult: TGAIResult;
 305 begin
 306    FListenSocket:= fpSocket(af_inet, sock_stream, 0);
 307    if FListenSocket <> -1 then begin
 308       GAIResult:= ResolveHost(FListenAddress);
 309           if GAIResult.GAIError = 0 then begin
 310              SockAddr:= GAIResult.AddrInfo^.ai_addr^;
 311                  SockAddr.sin_port:= htons(FListenPort);
 312
 313          if fpBind(FListenSocket, @SockAddr, SizeOf(SockAddr)) <> -1 then begin
 314             { It seems the maximum connection value isn't enforced by the
 315               Free Pascal library, so this 512 is a constant, dummy value. }
 316             if fpListen(FListenSocket, 512) <> -1 then begin
 317                Result:= true;
 318                Start;
 319             end
 320             else Result:= false;
 321          end
 322          else Result:= false;
 323
 324          FreeHost(GAIResult);
 325       end
 326           else Result:= false;
 327    end
 328    else Result:= false;
 329 end;
 330
 331 procedure TTCPListener.StopListen;
 332 begin
 333    Terminate;
 334    KillThread(Handle);
 335 end;
 336
 337 procedure TTCPListener.Execute;
 338 var ClientSocket: socket; AcceptFailCount: word; Len: longint;
 339     TCPConnection: TTCPConnection;
 340 begin
 341    { Now, accept connections. }
 342    AcceptFailCount:= 0;
 343    while not Terminated do begin
 344       Len:= SizeOf(SockAddr);
 345       ClientSocket:= fpAccept(FListenSocket, @SockAddr, @Len);
 346       if ClientSocket <> -1 then begin
 347          AcceptFailCount:= 0;
 348
 349          { Creates the requested TTCPConnection object for the accepted
 350            connection. }
 351          case FFeatureRequest of
 352          NET_TCP_BASIC:
 353             TCPConnection:= TTCPConnection.Create(ClientSocket, SockAddr);
 354          NET_TCP_RFCSUPPORT:
 355             TCPConnection:= TTCPRFCConnection.Create(ClientSocket, SockAddr);
 356          end;
 357
 358          { Then start a new thread with the connection handler. }
 359          TTCPAcceptor.Create(HandleClient, TCPConnection);
 360       end
 361       else begin
 362          Inc(AcceptFailCount);
 363          if AcceptFailCount >= 512 then Terminate;
 364       end;
 365    end;
 366 end;
 367
 368
 369 end.