/packages/fcl-net/src/ssockets.pp
Puppet | 737 lines | 612 code | 125 blank | 0 comment | 15 complexity | 0024a81d6fb9045a3affd86daf8d3da4 MD5 | raw file
Possible License(s): LGPL-2.0, LGPL-2.1, LGPL-3.0
1{ 2 This file is part of the Free Component Library (FCL) 3 Copyright (c) 1999-2000 by the Free Pascal development team 4 5 See the file COPYING.FPC, included in this distribution, 6 for details about the copyright. 7 8 This program is distributed in the hope that it will be useful, 9 but WITHOUT ANY WARRANTY; without even the implied warranty of 10 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 11 12 **********************************************************************} 13{$MODE objfpc}{$H+} 14 15unit ssockets; 16 17 18interface 19 20uses 21 SysUtils, Classes, ctypes, sockets; 22 23type 24 25 TSocketErrorType = ( 26 seHostNotFound, 27 seCreationFailed, 28 seBindFailed, 29 seListenFailed, 30 seConnectFailed, 31 seAcceptFailed, 32 seAcceptWouldBlock); 33 34 TSocketOption = (soDebug,soReuseAddr,soKeepAlive,soDontRoute,soBroadcast, 35 soOOBinline); 36 TSocketOptions = Set of TSocketOption; 37 38 ESocketError = class(Exception) 39 Code: TSocketErrorType; 40 constructor Create(ACode: TSocketErrorType; const MsgArgs: array of const); 41 end; 42 43 { TSocketStream } 44 45 TSocketStream = class(THandleStream) 46 Private 47 FReadFlags: Integer; 48 FSocketInitialized : Boolean; 49 FSocketOptions : TSocketOptions; 50 FLastError : integer; 51 FWriteFlags: Integer; 52 Procedure GetSockOptions; 53 Procedure SetSocketOptions(Value : TSocketOptions); 54 function GetLocalAddress: TSockAddr; 55 function GetRemoteAddress: TSockAddr; 56 Public 57 Constructor Create (AHandle : Longint);virtual; 58 destructor Destroy; override; 59 function Seek(Offset: Longint; Origin: Word): Longint; override; 60 Function Read (Var Buffer; Count : Longint) : longint; Override; 61 Function Write (Const Buffer; Count : Longint) :Longint; Override; 62 Property SocketOptions : TSocketOptions Read FSocketOptions 63 Write SetSocketOptions; 64 property LocalAddress: TSockAddr read GetLocalAddress; 65 property RemoteAddress: TSockAddr read GetRemoteAddress; 66 Property LastError : Integer Read FLastError; 67 Property ReadFlags : Integer Read FReadFlags Write FReadFlags; 68 Property WriteFlags : Integer Read FWriteFlags Write FWriteFlags; 69 end; 70 71 TConnectEvent = Procedure (Sender : TObject; Data : TSocketStream) Of Object; 72 TConnectQuery = Procedure (Sender : TObject; ASocket : Longint; Var Allow : Boolean) of Object; 73 74 { TSocketServer } 75 76 TSocketServer = Class(TObject) 77 Private 78 FOnIdle : TNotifyEvent; 79 FNonBlocking : Boolean; 80 FSocket : longint; 81 FListened : Boolean; 82 FAccepting : Boolean; 83 FMaxConnections : Longint; 84 FQueueSize : Longint; 85 FOnConnect : TConnectEvent; 86 FOnConnectQuery : TConnectQuery; 87 Procedure DoOnIdle; 88 Function GetReuseAddress: Boolean; 89 Function GetKeepAlive : Boolean; 90 Function GetLinger : Integer; 91 Procedure SetReuseAddress (AValue : Boolean); 92 Procedure SetKeepAlive (AValue : Boolean); 93 Procedure SetLinger(ALinger : Integer); 94 Protected 95 FSockType : Longint; 96 FBound : Boolean; 97 Procedure DoConnect(ASocket : TSocketStream); Virtual; 98 Function DoConnectQuery(ASocket : longint): Boolean ;Virtual; 99 Procedure Bind; Virtual; Abstract; 100 Function Accept: Longint;Virtual;Abstract; 101 Function SockToStream (ASocket : Longint) : TSocketStream;Virtual;Abstract; 102 Procedure Close; Virtual; 103 function GetConnection: TSocketStream; 104 Public 105 Constructor Create(ASocket : Longint); 106 Destructor Destroy; Override; 107 Procedure Listen; 108 function GetSockopt(ALevel,AOptName : cint; var optval; Var optlen : tsocklen): Boolean; 109 function SetSockopt(ALevel,AOptName : cint; var optval; optlen : tsocklen): Boolean; 110 Procedure StartAccepting; 111 Procedure StopAccepting; 112 Procedure SetNonBlocking; 113 Property Bound : Boolean Read FBound; 114 Property MaxConnections : longint Read FMaxConnections Write FMaxConnections; 115 Property QueueSize : Longint Read FQueueSize Write FQueueSize default 5; 116 Property OnConnect : TConnectEvent Read FOnConnect Write FOnConnect; 117 Property OnConnectQuery : TConnectQuery Read FOnConnectQuery Write FOnConnectQuery; 118 Property OnIdle : TNotifyEvent Read FOnIdle Write FOnIdle; 119 Property NonBlocking : Boolean Read FNonBlocking; 120 Property Socket : Longint Read FSocket; 121 Property SockType : Longint Read FSockType; 122 Property KeepAlive : Boolean Read GetKeepAlive Write SetKeepAlive; 123 Property ReuseAddress : Boolean Read GetReuseAddress Write SetReuseAddress; 124 // -1 means no linger. Any value >=0 sets linger on. 125 Property Linger: Integer Read GetLinger Write Setlinger; 126 end; 127 128 { TInetServer } 129 130 TInetServer = Class(TSocketServer) 131 Protected 132 FAddr : TINetSockAddr; 133 FPort : Word; 134 FHost: string; 135 Function SockToStream (ASocket : Longint) : TSocketStream;Override; 136 Function Accept : Longint;override; 137 Public 138 Procedure Bind; Override; 139 Constructor Create(APort: Word); 140 Constructor Create(const aHost: string; const APort: Word); 141 Property Port : Word Read FPort; 142 Property Host : string Read FHost; 143 end; 144 145{$ifdef Unix} 146 147 { TUnixServer } 148 149 TUnixServer = Class(TSocketServer) 150 Private 151 FUnixAddr : TUnixSockAddr; 152 FFileName : String; 153 Protected 154 Procedure Bind; Override; 155 Function Accept : Longint;override; 156 Function SockToStream (ASocket : Longint) : TSocketStream;Override; 157 Procedure Close; override; 158 Public 159 Constructor Create(AFileName : String); 160 Property FileName : String Read FFileName; 161 end; 162{$endif} 163 164 { TInetSocket } 165 166 TInetSocket = Class(TSocketStream) 167 Private 168 FHost : String; 169 FPort : Word; 170 Protected 171 Procedure DoConnect(ASocket : longint); Virtual; 172 Public 173 Constructor Create(ASocket : longint); Override; Overload; 174 Constructor Create(const AHost: String; APort: Word); Overload; 175 Property Host : String Read FHost; 176 Property Port : Word Read FPort; 177 end; 178 179{$ifdef Unix} 180 181 TUnixSocket = Class(TSocketStream) 182 Private 183 FFileName : String; 184 Protected 185 Procedure DoConnect(ASocket : longint); Virtual; 186 Public 187 Constructor Create(ASocket : Longint); Overload; 188 Constructor Create(AFileName : String); Overload; 189 Property FileName : String Read FFileName; 190 end; 191{$endif} 192 193Implementation 194 195uses 196{$ifdef unix} 197 BaseUnix, Unix, 198{$endif} 199 resolve; 200 201Const 202 SocketWouldBlock = -2; 203 204{ --------------------------------------------------------------------- 205 ESocketError 206 ---------------------------------------------------------------------} 207 208resourcestring 209 strHostNotFound = 'Host name resolution for "%s" failed.'; 210 strSocketCreationFailed = 'Creation of socket failed: %s'; 211 strSocketBindFailed = 'Binding of socket failed: %s'; 212 strSocketListenFailed = 'Listening on port #%d failed, error: %d'; 213 strSocketConnectFailed = 'Connect to %s failed.'; 214 strSocketAcceptFailed = 'Could not accept a client connection on socket: %d, error %d'; 215 strSocketAcceptWouldBlock = 'Accept would block on socket: %d'; 216 217constructor ESocketError.Create(ACode: TSocketErrorType; const MsgArgs: array of const); 218var 219 s: String; 220begin 221 Code := ACode; 222 case ACode of 223 seHostNotFound : s := strHostNotFound; 224 seCreationFailed: s := strSocketCreationFailed; 225 seBindFailed : s := strSocketBindFailed; 226 seListenFailed : s := strSocketListenFailed; 227 seConnectFailed : s := strSocketConnectFailed; 228 seAcceptFailed : s := strSocketAcceptFailed; 229 seAcceptWouldBLock : S:= strSocketAcceptWouldBlock; 230 end; 231 s := Format(s, MsgArgs); 232 inherited Create(s); 233end; 234 235{ --------------------------------------------------------------------- 236 TSocketStream 237 ---------------------------------------------------------------------} 238Constructor TSocketStream.Create (AHandle : Longint); 239 240begin 241 Inherited Create(AHandle); 242 FSocketInitialized := true; 243 GetSockOptions; 244end; 245 246destructor TSocketStream.Destroy; 247begin 248 if FSocketInitialized then 249 {$ifdef netware} 250 CloseSocket(Handle); 251 {$else} 252 FileClose(Handle); 253 {$endif} 254 inherited Destroy; 255end; 256 257Procedure TSocketStream.GetSockOptions; 258 259begin 260end; 261 262Procedure TSocketStream.SetSocketOptions(Value : TSocketOptions); 263 264begin 265end; 266 267Function TSocketStream.Seek(Offset: Longint; Origin: Word): Longint; 268 269begin 270 Result:=0; 271end; 272 273Function TSocketStream.Read (Var Buffer; Count : Longint) : longint; 274 275Var 276 Flags : longint; 277 278begin 279 Flags:=FReadFlags; 280 Result:=fprecv(handle,@Buffer,count,flags); 281 If Result<0 then 282 FLastError:=SocketError 283 else 284 FLastError:=0; 285end; 286 287Function TSocketStream.Write (Const Buffer; Count : Longint) :Longint; 288 289Var 290 Flags : longint; 291 292begin 293 Flags:=FWriteFlags; 294 Result:=fpsend(handle,@Buffer,count,flags); 295 If Result<0 then 296 FLastError:=SocketError 297 else 298 FlastError:=0; 299end; 300 301function TSocketStream.GetLocalAddress: TSockAddr; 302var 303 len: LongInt; 304begin 305 len := SizeOf(TSockAddr); 306 if fpGetSockName(Handle, @Result, @len) <> 0 then 307 FillChar(Result, SizeOf(Result), 0); 308end; 309 310function TSocketStream.GetRemoteAddress: TSockAddr; 311var 312 len: LongInt; 313begin 314 len := SizeOf(TSockAddr); 315 if fpGetPeerName(Handle, @Result, @len) <> 0 then 316 FillChar(Result, SizeOf(Result), 0); 317end; 318 319 320{ --------------------------------------------------------------------- 321 TSocketServer 322 ---------------------------------------------------------------------} 323 324Constructor TSocketServer.Create(ASocket : Longint); 325 326begin 327 FSocket:=ASocket; 328 FQueueSize :=5; 329 FMaxConnections:=-1; 330end; 331 332Destructor TSocketServer.Destroy; 333 334begin 335 Close; 336 Inherited; 337end; 338 339Procedure TSocketServer.Close; 340 341begin 342 If FSocket<>-1 Then 343 {$ifdef netware} 344 CloseSocket(FSocket); 345 {$else} 346 FileClose(FSocket); 347 {$endif} 348 FSocket:=-1; 349end; 350 351Procedure TSocketServer.Listen; 352 353begin 354 If Not FBound then 355 Bind; 356 If Sockets.FpListen(FSocket,FQueueSize)<>0 then 357 Raise ESocketError.Create(seListenFailed,[FSocket,SocketError]); 358end; 359 360function TSocketServer.GetSockopt(ALevel, AOptName: cint; Var optval; 361 var optlen: tsocklen): Boolean; 362begin 363 Result:=fpGetSockOpt(FSocket,ALevel,AOptName,@optval,@optlen)<>-1; 364end; 365 366function TSocketServer.SetSockopt(ALevel, AOptName: cint; var optval; 367 optlen: tsocklen): Boolean; 368begin 369 Result:=fpSetSockOpt(FSocket,ALevel,AOptName,@optval,optlen)<>-1; 370end; 371 372Function TSocketServer.GetConnection : TSocketStream; 373 374var 375 NewSocket : longint; 376 377begin 378 Result:=Nil; 379 NewSocket:=Accept; 380 If NewSocket>=0 then 381 begin 382 If FAccepting and DoConnectQuery(NewSocket) Then 383 Result:=SockToStream(NewSocket) 384 else 385 CloseSocket(NewSocket); 386 end 387end; 388 389Procedure TSocketServer.StartAccepting; 390 391Var 392 NoConnections : Integer; 393 Stream : TSocketStream; 394 395begin 396 FAccepting := True; 397 NoConnections := 0; 398 Listen; 399 Repeat 400 Repeat 401 Try 402 Stream:=GetConnection; 403 if Assigned(Stream) then 404 begin 405 Inc (NoConnections); 406 DoConnect(Stream); 407 end; 408 except 409 On E : ESocketError do 410 begin 411 If E.Code=seAcceptWouldBlock then 412 DoOnIdle 413 else 414 Raise; 415 end; 416 end; 417 Until (Stream<>Nil) or (Not NonBlocking); 418 Until Not (FAccepting) or ((FMaxConnections<>-1) and (NoConnections>=FMaxConnections)); 419end; 420 421Procedure TSocketServer.StopAccepting; 422 423begin 424 FAccepting:=False; 425end; 426 427Procedure TSocketServer.DoOnIdle; 428 429begin 430 If Assigned(FOnIdle) then 431 FOnIdle(Self); 432end; 433 434function TSocketServer.GetReuseAddress: Boolean; 435Var 436 L : cint; 437 ls : Tsocklen; 438begin 439 L:=0; 440 ls:=0; 441{$IFDEF UNIX} 442 if not GetSockOpt(SOL_SOCKET, SO_REUSEADDR, L, LS) then 443 Raise ESocketError.CreateFmt('Failed to get SO_REUSEADDR to %d: %d',[l,socketerror]); 444 Result:=(L<>0); 445{$ELSE} 446 Result:=True; 447{$ENDIF} 448 449end; 450 451function TSocketServer.GetKeepAlive: Boolean; 452Var 453 L : cint; 454 ls : Tsocklen; 455begin 456 L:=0; 457 ls:=0; 458{$IFDEF UNIX} 459 if Not GetSockOpt(SOL_SOCKET, SO_KEEPALIVE, L, LS) then 460 Raise ESocketError.CreateFmt('Failed to get SO_KEEPALIVE: %d',[socketerror]); 461 Result:=(L<>0); 462{$ELSE} 463 Result:=True; 464{$ENDIF} 465end; 466 467function TSocketServer.GetLinger: Integer; 468Var 469 L : linger; 470 ls : tsocklen; 471 472begin 473 L.l_onoff:=0; 474 l.l_linger:=0; 475 if Not GetSockOpt(SOL_SOCKET, SO_LINGER, l, ls) then 476 Raise ESocketError.CreateFmt('Failed to set linger: %d',[socketerror]); 477 if l.l_onoff=0 then 478 Result:=-1 479 else 480 Result:=l.l_linger; 481end; 482 483Procedure TSocketServer.DoConnect(ASocket : TSocketStream); 484 485begin 486 If Assigned(FOnConnect) Then 487 FOnConnect(Self,ASocket); 488end; 489 490Function TSocketServer.DoConnectQuery(ASocket : Longint) : Boolean; 491 492begin 493 Result:=True; 494 If Assigned(FOnConnectQuery) then 495 FOnConnectQuery(Self,ASocket,Result); 496end; 497 498Procedure TSocketServer.SetNonBlocking; 499 500begin 501{$ifdef Unix} 502 fpfcntl(FSocket,F_SETFL,O_NONBLOCK); 503{$endif} 504 FNonBlocking:=True; 505end; 506 507procedure TSocketServer.SetLinger(ALinger: Integer); 508Var 509 L : linger; 510begin 511 L.l_onoff:=Ord(ALinger>0); 512 if ALinger<0 then 513 l.l_linger:=ALinger 514 else 515 l.l_linger:=0; 516 if Not SetSockOpt(SOL_SOCKET, SO_LINGER, l, SizeOf(L)) then 517 Raise ESocketError.CreateFmt('Failed to set linger: %d',[socketerror]); 518end; 519 520procedure TSocketServer.SetReuseAddress(AValue: Boolean); 521Var 522 L : cint; 523begin 524 L:=Ord(AValue); 525{$IFDEF UNIX} 526 if not SetSockOpt(SOL_SOCKET, SO_REUSEADDR , L, SizeOf(L)) then 527 Raise ESocketError.CreateFmt('Failed to set SO_REUSEADDR to %d: %d',[l,socketerror]); 528{$ENDIF} 529end; 530 531procedure TSocketServer.SetKeepAlive(AValue: Boolean); 532Var 533 L : cint; 534begin 535 L:=Ord(AValue); 536{$IFDEF UNIX} 537 if Not SetSockOpt(SOL_SOCKET, SO_KEEPALIVE, L, SizeOf(L)) then 538 Raise ESocketError.CreateFmt('Failed to set SO_REUSEADDR to %d: %d',[l,socketerror]); 539{$ENDIF} 540end; 541 542{ --------------------------------------------------------------------- 543 TInetServer 544 ---------------------------------------------------------------------} 545 546Constructor TInetServer.Create(APort: Word); 547 548begin 549 Create('0.0.0.0', aPort); 550end; 551 552Constructor TInetServer.Create(const aHost: string; const APort: Word); 553 554Var S : longint; 555 556begin 557 FHost:=aHost; 558 FPort:=APort; 559 S:=Sockets.FpSocket(AF_INET,SOCK_STREAM,0); 560 If S=-1 Then 561 Raise ESocketError.Create(seCreationFailed,[Format('%d',[APort])]); 562 Inherited Create(S); 563end; 564 565Procedure TInetServer.Bind; 566 567begin 568 Faddr.sin_family := AF_INET; 569 Faddr.sin_port := ShortHostToNet(FPort); 570 Faddr.sin_addr.s_addr := LongWord(StrToNetAddr(FHost)); 571 if Sockets.fpBind(FSocket, @FAddr, Sizeof(FAddr))<>0 then 572 raise ESocketError.Create(seBindFailed, [IntToStr(FPort)]); 573 FBound:=True; 574end; 575 576Function TInetServer.SockToStream (ASocket : Longint) : TSocketStream; 577 578begin 579 Result:=TInetSocket.Create(ASocket); 580 (Result as TInetSocket).FHost:=''; 581 (Result as TInetSocket).FPort:=FPort; 582end; 583 584Function TInetServer.Accept : Longint; 585 586Var l : longint; 587 588begin 589 L:=SizeOf(FAddr); 590 Result:=Sockets.fpAccept(Socket,@Faddr,@L); 591 If Result<0 then 592{$ifdef Unix} 593 If SocketError=ESysEWOULDBLOCK then 594 Raise ESocketError.Create(seAcceptWouldBlock,[socket]) 595 else 596{$endif} 597 Raise ESocketError.Create(seAcceptFailed,[Socket,SocketError]); 598end; 599 600{ --------------------------------------------------------------------- 601 TUnixServer 602 ---------------------------------------------------------------------} 603{$ifdef Unix} 604Constructor TUnixServer.Create(AFileName : String); 605 606Var S : Longint; 607 608begin 609 FFileName:=AFileName; 610 S:=Sockets.fpSocket(AF_UNIX,SOCK_STREAM,0); 611 If S=-1 then 612 Raise ESocketError.Create(seCreationFailed,[AFileName]) 613 else 614 Inherited Create(S); 615end; 616 617Procedure TUnixServer.Close; 618begin 619 Inherited Close; 620 DeleteFile(FFileName); 621 FFileName:=''; 622end; 623 624Procedure TUnixServer.Bind; 625 626var 627 AddrLen : longint; 628begin 629 Str2UnixSockAddr(FFilename,FUnixAddr,AddrLen); 630 If Sockets.FpBind(Socket,@FUnixAddr,AddrLen)<>0 then 631 Raise ESocketError.Create(seBindFailed,[FFileName]); 632 FBound:=True; 633end; 634 635Function TUnixServer.Accept : Longint; 636 637Var L : longint; 638 639begin 640 L:=Length(FFileName); 641 Result:=Sockets.fpAccept(Socket,@FUnixAddr,@L); 642 If Result<0 then 643 If SocketError=ESysEWOULDBLOCK then 644 Raise ESocketError.Create(seAcceptWouldBlock,[socket]) 645 else 646 Raise ESocketError.Create(seAcceptFailed,[socket,SocketError]); 647end; 648 649Function TUnixServer.SockToStream (ASocket : Longint) : TSocketStream; 650 651begin 652 Result:=TUnixSocket.Create(ASocket); 653 (Result as TUnixSocket).FFileName:=FFileName; 654end; 655 656{$endif} 657 658{ --------------------------------------------------------------------- 659 TInetSocket 660 ---------------------------------------------------------------------} 661Constructor TInetSocket.Create(ASocket : Longint); 662 663begin 664 Inherited Create(ASocket); 665end; 666 667Constructor TInetSocket.Create(const AHost: String; APort: Word); 668 669Var 670 S : Longint; 671 672begin 673 FHost:=AHost; 674 FPort:=APort; 675 S:=fpSocket(AF_INET,SOCK_STREAM,0); 676 DoConnect(S); 677 Inherited Create(S); 678end; 679 680Procedure TInetSocket.DoConnect(ASocket : Longint); 681 682Var 683 A : THostAddr; 684 addr: TInetSockAddr; 685 686begin 687 A := StrToHostAddr(FHost); 688 if A.s_bytes[1] = 0 then 689 With THostResolver.Create(Nil) do 690 try 691 If Not NameLookup(FHost) then 692 raise ESocketError.Create(seHostNotFound, [FHost]); 693 A:=HostAddress; 694 finally 695 free; 696 end; 697 addr.sin_family := AF_INET; 698 addr.sin_port := ShortHostToNet(FPort); 699 addr.sin_addr.s_addr := HostToNet(a.s_addr); 700 701 If Sockets.fpConnect(ASocket, @addr, sizeof(addr))<>0 then 702 raise ESocketError.Create(seConnectFailed, [Format('%s:%d',[FHost, FPort])]); 703end; 704 705{ --------------------------------------------------------------------- 706 TUnixSocket 707 ---------------------------------------------------------------------} 708{$ifdef Unix} 709Constructor TUnixSocket.Create(ASocket : Longint); 710 711begin 712 Inherited Create(ASocket); 713end; 714 715Constructor TUnixSocket.Create(AFileName : String); 716 717Var S : Longint; 718 719begin 720 FFileName:=AFileName; 721 S:=FpSocket(AF_UNIX,SOCK_STREAM,0); 722 DoConnect(S); 723 Inherited Create(S); 724end; 725 726Procedure TUnixSocket.DoConnect(ASocket : longint); 727 728Var 729 UnixAddr : TUnixSockAddr; 730 AddrLen : longint; 731begin 732 Str2UnixSockAddr(FFilename,UnixAddr,AddrLen); 733 If FpConnect(ASocket,@UnixAddr,AddrLen)<>0 then 734 Raise ESocketError.Create(seConnectFailed,[FFilename]); 735end; 736{$endif} 737end.