4188 lines
155 KiB
ObjectPascal
4188 lines
155 KiB
ObjectPascal
/// implements bidirectional client and server protocol, e.g. WebSockets
|
|
// - this unit is a part of the freeware Synopse mORMot framework,
|
|
// licensed under a MPL/GPL/LGPL tri-license; version 1.18
|
|
unit SynBidirSock;
|
|
|
|
{
|
|
This file is part of the Synopse framework.
|
|
|
|
Synopse framework. Copyright (C) 2022 Arnaud Bouchez
|
|
Synopse Informatique - https://synopse.info
|
|
|
|
*** BEGIN LICENSE BLOCK *****
|
|
Version: MPL 1.1/GPL 2.0/LGPL 2.1
|
|
|
|
The contents of this file are subject to the Mozilla Public License Version
|
|
1.1 (the "License"); you may not use this file except in compliance with
|
|
the License. You may obtain a copy of the License at
|
|
http://www.mozilla.org/MPL
|
|
|
|
Software distributed under the License is distributed on an "AS IS" basis,
|
|
WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
|
|
for the specific language governing rights and limitations under the License.
|
|
|
|
The Original Code is Synopse mORMot framework.
|
|
|
|
The Initial Developer of the Original Code is Arnaud Bouchez.
|
|
|
|
Portions created by the Initial Developer are Copyright (C) 2022
|
|
the Initial Developer. All Rights Reserved.
|
|
|
|
Contributor(s):
|
|
- Alfred (alf)
|
|
- AntoineGS
|
|
- f-vicente
|
|
- nortg
|
|
|
|
|
|
Alternatively, the contents of this file may be used under the terms of
|
|
either the GNU General Public License Version 2 or later (the "GPL"), or
|
|
the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
|
|
in which case the provisions of the GPL or the LGPL are applicable instead
|
|
of those above. If you wish to allow use of your version of this file only
|
|
under the terms of either the GPL or the LGPL, and not to allow others to
|
|
use your version of this file under the terms of the MPL, indicate your
|
|
decision by deleting the provisions above and replace them with the notice
|
|
and other provisions required by the GPL or the LGPL. If you do not delete
|
|
the provisions above, a recipient may use your version of this file under
|
|
the terms of any one of the MPL, the GPL or the LGPL.
|
|
|
|
***** END LICENSE BLOCK *****
|
|
|
|
TODO: broadcast a message to several aCallingThread: THttpServerResp values
|
|
(add TWebSocketClientRequest? or asynch notifications may be enough, and
|
|
the "broadcast" feature should be implementation at application level,
|
|
using a list of callbacks)
|
|
|
|
TODO: enhance TWebSocketServer process to use events, and not threads
|
|
- current implementation has its threads spending most time waiting in loops
|
|
- eventually also at SynCrtSock's THttpServer class level also
|
|
|
|
}
|
|
|
|
{$I Synopse.inc} // define HASINLINE CPU32 CPU64 OWNNORMTOUPPER
|
|
|
|
interface
|
|
|
|
uses
|
|
{$ifdef MSWINDOWS}
|
|
Windows,
|
|
SynWinSock,
|
|
{$else}
|
|
SynFPCSock, // shared with Kylix
|
|
{$ifdef KYLIX3}
|
|
LibC,
|
|
Types,
|
|
SynKylix,
|
|
{$endif}
|
|
{$ifdef FPC}
|
|
SynFPCLinux,
|
|
{$endif}
|
|
{$endif}
|
|
SysUtils,
|
|
Classes,
|
|
Contnrs,
|
|
SyncObjs,
|
|
SynLZ,
|
|
SynCommons,
|
|
SynTable,
|
|
SynLog,
|
|
SynCrtSock,
|
|
SynCrypto, // for SHA and AES
|
|
SynEcc; // for TECDHEProtocol
|
|
|
|
|
|
{ -------------- high-level SynCrtSock classes depending on SynCommons }
|
|
|
|
type
|
|
/// in-memory storage of one THttpRequestCached entry
|
|
THttpRequestCache = record
|
|
Tag: RawUTF8;
|
|
Content: RawByteString;
|
|
end;
|
|
/// in-memory storage of all THttpRequestCached entries
|
|
THttpRequestCacheDynArray = array of THttpRequestCache;
|
|
|
|
/// handles cached HTTP connection to a remote server
|
|
// - use in-memory cached content when HTTP_NOTMODIFIED (304) is returned
|
|
// for an already known ETAG header value
|
|
THttpRequestCached = class(TSynPersistent)
|
|
protected
|
|
fURI: TURI;
|
|
fHttp: THttpRequest; // either fHttp or fSocket is used
|
|
fSocket: THttpClientSocket;
|
|
fKeepAlive: integer;
|
|
fTokenHeader: RawUTF8;
|
|
fCache: TSynDictionary;
|
|
public
|
|
/// initialize the cache for a given server
|
|
// - once set, you can change the request URI using the Address property
|
|
// - aKeepAliveSeconds = 0 will force "Connection: Close" HTTP/1.0 requests
|
|
// - an internal cache will be maintained, and entries will be flushed after
|
|
// aTimeoutSeconds - i.e. 15 minutes per default - setting 0 will disable
|
|
// the client-side cache content
|
|
// - aToken is an optional token which will be transmitted as HTTP header:
|
|
// $ Authorization: Bearer <aToken>
|
|
// - TWinHttp will be used by default under Windows, unless you specify
|
|
// another class
|
|
constructor Create(const aURI: RawUTF8; aKeepAliveSeconds: integer=30;
|
|
aTimeoutSeconds: integer=15*60; const aToken: RawUTF8='';
|
|
aHttpClass: THttpRequestClass=nil); reintroduce;
|
|
/// finalize the current connnection and flush its in-memory cache
|
|
// - you may use LoadFromURI() to connect to a new server
|
|
procedure Clear;
|
|
/// connect to a new server
|
|
// - aToken is an optional token which will be transmitted as HTTP header:
|
|
// $ Authorization: Bearer <aToken>
|
|
// - TWinHttp will be used by default under Windows, unless you specify
|
|
// another class
|
|
function LoadFromURI(const aURI: RawUTF8; const aToken: RawUTF8='';
|
|
aHttpClass: THttpRequestClass=nil): boolean;
|
|
/// finalize the cache
|
|
destructor Destroy; override;
|
|
/// retrieve a resource from the server, or internal cache
|
|
// - aModified^ = true if server returned a HTTP_SUCCESS (200) with some new
|
|
// content, or aModified^ = false if HTTP_NOTMODIFIED (304) was returned
|
|
function Get(const aAddress: SockString; aModified: PBoolean=nil;
|
|
aStatus: PInteger=nil): SockString;
|
|
/// erase one resource from internal cache
|
|
function Flush(const aAddress: SockString): boolean;
|
|
/// read-only access to the connected server
|
|
property URI: TURI read fURI;
|
|
end;
|
|
|
|
|
|
/// will remove most usual HTTP headers which are to be recomputed on sending
|
|
function PurgeHeaders(P: PUTF8Char): RawUTF8;
|
|
|
|
|
|
{ ------------ client or server asynchronous process of multiple connections }
|
|
|
|
type
|
|
/// exception associated with TAsynchConnection / TAsynchConnections process
|
|
EAsynchConnections = class(ESynException);
|
|
|
|
/// 32-bit integer value used to identify an asynchronous connection
|
|
// - will start from 1, and increase during the TAsynchConnections live-time
|
|
TAsynchConnectionHandle = type integer;
|
|
|
|
TAsynchConnections = class;
|
|
|
|
/// abstract class to store one TAsynchConnections connection
|
|
// - may implement e.g. WebSockets frames, or IoT binary protocol
|
|
// - each connection will be identified by a TAsynchConnectionHandle integer
|
|
// - idea is to minimize the resources used per connection, and allow full
|
|
// customization of the process by overriding the OnRead virtual method (and,
|
|
// if needed, AfterCreate/AfterWrite/BeforeDestroy/OnLastOperationIdle)
|
|
TAsynchConnection = class(TSynPersistent)
|
|
protected
|
|
fSlot: TPollSocketsSlot;
|
|
fHandle: TAsynchConnectionHandle;
|
|
fLastOperation: cardinal;
|
|
fRemoteIP: RawUTF8;
|
|
/// this method is called when the instance is connected to a poll
|
|
// - default implementation will set fLastOperation content
|
|
procedure AfterCreate(Sender: TAsynchConnections); virtual;
|
|
/// this method is called when the some input data is pending on the socket
|
|
// - should extract frames or requests from fSlot.readbuf, and handle them
|
|
// - this is where the input should be parsed and extracted according to
|
|
// the implemented procotol; fSlot.readbuf could be kept as temporary
|
|
// buffer during the parsing, and voided by the caller once processed
|
|
// - Sender.Write() could be used for asynchronous answer sending
|
|
// - Sender.LogVerbose() allows logging of escaped data
|
|
// - could return sorClose to shutdown the socket, e.g. on parsing error
|
|
function OnRead(Sender: TAsynchConnections): TPollAsynchSocketOnRead; virtual; abstract;
|
|
/// this method is called when some data has been written to the socket
|
|
// - default implementation will do nothing
|
|
procedure AfterWrite(Sender: TAsynchConnections); virtual;
|
|
/// this method is called when the instance is about to be deleted from a poll
|
|
// - default implementation will reset fHandle to 0
|
|
procedure BeforeDestroy(Sender: TAsynchConnections); virtual;
|
|
// called after TAsynchConnections.LastOperationIdleSeconds of no activity
|
|
// - reset fLastOperation by default - overriden code should be fast
|
|
// - Sender.Write() could be used to send e.g. a hearbeat frame
|
|
procedure OnLastOperationIdle(Sender: TAsynchConnections); virtual;
|
|
public
|
|
/// initialize this instance
|
|
constructor Create(const aRemoteIP: RawUTF8); reintroduce; virtual;
|
|
published
|
|
/// the associated remote IP4/IP6, as text
|
|
property RemoteIP: RawUTF8 read fRemoteIP;
|
|
/// read-only access to the handle number associated with this connection
|
|
property Handle: TAsynchConnectionHandle read fHandle;
|
|
/// read-only access to the socket number associated with this connection
|
|
property Socket: TSocket read fSlot.socket;
|
|
end;
|
|
|
|
/// meta-class of one TAsynchConnections connection
|
|
TAsynchConnectionClass = class of TAsynchConnection;
|
|
/// used to store a dynamic array of TAsynchConnection
|
|
TAsynchConnectionObjArray = array of TAsynchConnection;
|
|
|
|
/// handle multiple non-blocking connections using TAsynchConnection instances
|
|
// - OnRead will redirect to TAsynchConnection.OnRead virtual method
|
|
// - OnClose will remove the instance from TAsynchConnections.fConnections[]
|
|
// - OnError will return false to shutdown the connection (unless
|
|
// acoOnErrorContinue is defined in TAsynchConnections.Options)
|
|
TAsynchConnectionsSockets = class(TPollAsynchSockets)
|
|
protected
|
|
fOwner: TAsynchConnections;
|
|
function SlotFromConnection(connection: TObject): PPollSocketsSlot; override;
|
|
function OnRead(connection: TObject): TPollAsynchSocketOnRead; override;
|
|
procedure AfterWrite(connection: TObject); override;
|
|
procedure OnClose(connection: TObject); override;
|
|
function OnError(connection: TObject; events: TPollSocketEvents): boolean; override;
|
|
function GetTotal: integer;
|
|
public
|
|
/// add some data to the asynchronous output buffer of a given connection
|
|
// - this overriden method will refresh TAsynchConnection.LastOperation
|
|
// - can be executed from an TAsynchConnection.OnRead method
|
|
function Write(connection: TObject; const data; datalen: integer;
|
|
timeout: integer=5000): boolean; override;
|
|
published
|
|
/// how many clients have been handled by the poll, from the beginning
|
|
property Total: integer read GetTotal;
|
|
end;
|
|
|
|
/// used to implement a thread poll to process TAsynchConnection instances
|
|
TAsynchConnectionsThread = class(TSynThread)
|
|
protected
|
|
fOwner: TAsynchConnections;
|
|
fProcess: TPollSocketEvent; // pseRead or pseWrite
|
|
procedure Execute; override;
|
|
public
|
|
/// initialize the thread
|
|
constructor Create(aOwner: TAsynchConnections; aProcess: TPollSocketEvent); reintroduce;
|
|
end;
|
|
|
|
/// low-level options for TAsynchConnections processing
|
|
// - TAsynchConnectionsSockets.OnError will shutdown the connection on any error,
|
|
// unless acoOnErrorContinue is defined
|
|
// - acoOnAcceptFailureStop will let failed Accept() finalize the process
|
|
// - acoNoLogRead and acoNoLogWrite could reduce the log verbosity
|
|
// - acoVerboseLog will log transmitted frames content, for debugging purposes
|
|
// - acoLastOperationNoRead and acoLastOperationNoWrite could be used to
|
|
// avoid TAsynchConnection.fLastOperation reset at read or write
|
|
TAsynchConnectionsOptions = set of (acoOnErrorContinue,
|
|
acoOnAcceptFailureStop, acoNoLogRead, acoNoLogWrite, acoVerboseLog,
|
|
acoLastOperationNoRead, acoLastOperationNoWrite);
|
|
|
|
/// implements an abstract thread-pooled high-performance TCP clients or server
|
|
// - internal TAsynchConnectionsSockets will handle high-performance process
|
|
// of a high number of long-living simultaneous connections
|
|
// - will use a TAsynchConnection inherited class to maintain connection state
|
|
// - don't use this abstract class but either TAsynchServer or TAsynchClients
|
|
// - under Linux/POSIX, check your "ulimit -H -n" value: one socket consumes
|
|
// two file descriptors: you may better add the following line to your
|
|
// /etc/limits.conf or /etc/security/limits.conf system file:
|
|
// $ * hard nofile 65535
|
|
TAsynchConnections = class(TServerGeneric)
|
|
protected
|
|
fStreamClass: TAsynchConnectionClass;
|
|
fConnection: TAsynchConnectionObjArray;
|
|
fConnectionCount: integer;
|
|
fConnections: TDynArray; // fConnection[] sorted by TAsynchConnection.Handle
|
|
fClients: TAsynchConnectionsSockets;
|
|
fThreads: array of TAsynchConnectionsThread;
|
|
fLastHandle: integer;
|
|
fLog: TSynLogClass;
|
|
fTempConnectionForSearchPerHandle: TAsynchConnection;
|
|
fOptions: TAsynchConnectionsOptions;
|
|
fLastOperationIdleSeconds: cardinal;
|
|
fThreadClients: record // used by TAsynchClient
|
|
Count, Timeout: integer;
|
|
Address, Port: SockString;
|
|
end;
|
|
fConnectionLock: TSynLocker;
|
|
procedure IdleEverySecond;
|
|
function ConnectionCreate(aSocket: TSocket; const aRemoteIp: RawUTF8;
|
|
out aConnection: TAsynchConnection): boolean; virtual;
|
|
function ConnectionAdd(aSocket: TSocket; aConnection: TAsynchConnection): boolean; virtual;
|
|
function ConnectionDelete(aHandle: TAsynchConnectionHandle): boolean; overload; virtual;
|
|
function ConnectionDelete(aConnection: TAsynchConnection; aIndex: integer): boolean; overload;
|
|
procedure ThreadClientsConnect; // from fThreadClients
|
|
public
|
|
/// initialize the multiple connections
|
|
// - warning: currently reliable only with aThreadPoolCount=1
|
|
constructor Create(OnStart,OnStop: TNotifyThreadEvent;
|
|
aStreamClass: TAsynchConnectionClass; const ProcessName: SockString;
|
|
aLog: TSynLogClass; aOptions: TAsynchConnectionsOptions; aThreadPoolCount: integer); reintroduce; virtual;
|
|
/// shut down the instance, releasing all associated threads and sockets
|
|
destructor Destroy; override;
|
|
/// high-level access to a connection instance, from its handle
|
|
// - could be executed e.g. from a TAsynchConnection.OnRead method
|
|
// - returns nil if the handle was not found
|
|
// - returns the maching instance, and caller should release the lock as:
|
|
// ! try ... finally UnLock; end;
|
|
function ConnectionFindLocked(aHandle: TAsynchConnectionHandle;
|
|
aIndex: PInteger=nil): TAsynchConnection;
|
|
/// just a wrapper around fConnectionLock.Lock
|
|
procedure Lock;
|
|
/// just a wrapper around fConnectionLock.UnLock
|
|
procedure Unlock;
|
|
/// remove an handle from the internal list, and close its connection
|
|
// - could be executed e.g. from a TAsynchConnection.OnRead method
|
|
function ConnectionRemove(aHandle: TAsynchConnectionHandle): boolean;
|
|
/// add some data to the asynchronous output buffer of a given connection
|
|
// - could be executed e.g. from a TAsynchConnection.OnRead method
|
|
function Write(connection: TAsynchConnection; const data; datalen: integer): boolean; overload;
|
|
/// add some data to the asynchronous output buffer of a given connection
|
|
// - could be executed e.g. from a TAsynchConnection.OnRead method
|
|
function Write(connection: TAsynchConnection; const data: SockString): boolean; overload;
|
|
/// log some binary data with proper escape
|
|
// - can be executed from an TAsynchConnection.OnRead method to track content:
|
|
// $ if acoVerboseLog in Sender.Options then Sender.LogVerbose(self,...);
|
|
procedure LogVerbose(connection: TAsynchConnection; const ident: RawUTF8;
|
|
frame: pointer; framelen: integer); overload;
|
|
/// log some binary data with proper escape
|
|
// - can be executed from an TAsynchConnection.OnRead method to track content:
|
|
// $ if acoVerboseLog in Sender.Options then Sender.LogVerbose(...);
|
|
procedure LogVerbose(connection: TAsynchConnection; const ident: RawUTF8;
|
|
const frame: RawByteString); overload;
|
|
/// will execute TAsynchConnection.OnLastOperationIdle after an idle period
|
|
// - could be used to send heartbeats after read/write inactivity
|
|
// - equals 0 (i.e. disabled) by default
|
|
property LastOperationIdleSeconds: cardinal read fLastOperationIdleSeconds
|
|
write fLastOperationIdleSeconds;
|
|
/// allow to customize low-level options for processing
|
|
property Options: TAsynchConnectionsOptions read fOptions write fOptions;
|
|
/// access to the associated log class
|
|
property Log: TSynLogClass read fLog;
|
|
/// low-level unsafe direct access to the connection instances
|
|
// - ensure this property is used in a thread-safe manner, i.e. via
|
|
// ! Lock; try ... finally UnLock; end;
|
|
property Connection: TAsynchConnectionObjArray read fConnection;
|
|
/// low-level unsafe direct access to the connection count
|
|
// - ensure this property is used in a thread-safe manner, i.e. via
|
|
// ! Lock; try ... finally UnLock; end;
|
|
property ConnectionCount: integer read fConnectionCount;
|
|
published
|
|
/// access to the TCP client sockets poll
|
|
// - TAsynchConnection.OnRead should rather use Write() and LogVerbose()
|
|
// methods of this TAsynchConnections class instead of using Clients
|
|
property Clients: TAsynchConnectionsSockets read fClients;
|
|
end;
|
|
|
|
/// implements a thread-pooled high-performance TCP server
|
|
// - will use a TAsynchConnection inherited class to maintain connection state
|
|
// for server process
|
|
TAsynchServer = class(TAsynchConnections)
|
|
protected
|
|
fServer: TCrtSocket;
|
|
fExecuteFinished: boolean;
|
|
procedure Execute; override;
|
|
public
|
|
/// run the TCP server, listening on a supplied IP port
|
|
constructor Create(const aPort: SockString; OnStart,OnStop: TNotifyThreadEvent;
|
|
aStreamClass: TAsynchConnectionClass; const ProcessName: SockString;
|
|
aLog: TSynLogClass; aOptions: TAsynchConnectionsOptions; aThreadPoolCount: integer=1); reintroduce; virtual;
|
|
/// shut down the server, releasing all associated threads and sockets
|
|
destructor Destroy; override;
|
|
published
|
|
/// access to the TCP server socket
|
|
property Server: TCrtSocket read fServer;
|
|
end;
|
|
|
|
/// implements thread-pooled high-performance TCP multiple clients
|
|
// - e.g. to run some load stress tests with optimized resource use
|
|
// - will use a TAsynchConnection inherited class to maintain connection state
|
|
// of each connected client
|
|
TAsynchClient = class(TAsynchConnections)
|
|
protected
|
|
procedure Execute; override;
|
|
public
|
|
/// start the TCP client connections, connecting to the supplied IP server
|
|
constructor Create(const aServer,aPort: SockString;
|
|
aClientsCount,aClientsTimeoutSecs: integer; OnStart,OnStop: TNotifyThreadEvent;
|
|
aStreamClass: TAsynchConnectionClass; const ProcessName: SockString;
|
|
aLog: TSynLogClass; aOptions: TAsynchConnectionsOptions; aThreadPoolCount: integer=1); reintroduce; virtual;
|
|
published
|
|
/// server IP address
|
|
property Server: SockString read fThreadClients.Address;
|
|
/// server IP port
|
|
property Port: SockString read fThreadClients.Port;
|
|
end;
|
|
|
|
|
|
{ -------------- WebSockets shared classes for bidirectional remote access }
|
|
|
|
type
|
|
/// Exception raised when processing WebSockets
|
|
EWebSockets = class(ESynException);
|
|
|
|
/// defines the interpretation of the WebSockets frame data
|
|
// - match order expected by the WebSockets RFC
|
|
TWebSocketFrameOpCode = (
|
|
focContinuation, focText, focBinary,
|
|
focReserved3, focReserved4, focReserved5, focReserved6, focReserved7,
|
|
focConnectionClose, focPing, focPong,
|
|
focReservedB, focReservedC, focReservedD, focReservedE, focReservedF);
|
|
|
|
/// set of WebSockets frame interpretation
|
|
TWebSocketFrameOpCodes = set of TWebSocketFrameOpCode;
|
|
|
|
/// define one attribute of a WebSockets frame data
|
|
TWebSocketFramePayload = (
|
|
fopAlreadyCompressed);
|
|
/// define the attributes of a WebSockets frame data
|
|
TWebSocketFramePayloads = set of TWebSocketFramePayload;
|
|
|
|
/// stores a WebSockets frame
|
|
// - see @http://tools.ietf.org/html/rfc6455 for reference
|
|
TWebSocketFrame = record
|
|
/// the interpretation of the frame data
|
|
opcode: TWebSocketFrameOpCode;
|
|
/// what is stored in the frame data, i.e. in payload field
|
|
content: TWebSocketFramePayloads;
|
|
/// equals GetTickCount64 shr 10, as used for TWebSocketFrameList timeout
|
|
tix: cardinal;
|
|
/// the frame data itself
|
|
// - is plain UTF-8 for focText kind of frame
|
|
// - is raw binary for focBinary or any other frames
|
|
payload: RawByteString;
|
|
end;
|
|
|
|
/// points to a WebSockets frame
|
|
PWebSocketFrame = ^TWebSocketFrame;
|
|
|
|
/// a dynamic list of WebSockets frames
|
|
TWebSocketFrameDynArray = array of TWebSocketFrame;
|
|
|
|
{$M+}
|
|
TWebSocketProcess = class;
|
|
{$M-}
|
|
|
|
/// callback event triggered by TWebSocketProtocol for any incoming message
|
|
// - called before TWebSocketProtocol.ProcessIncomingFrame for incoming
|
|
// focText/focBinary frames
|
|
// - should return true if the frame has been handled, or false if the
|
|
// regular processing should take place
|
|
TOnWebSocketProtocolIncomingFrame =
|
|
function(Sender: TWebSocketProcess; var Frame: TWebSocketFrame): boolean of object;
|
|
|
|
/// one instance implementing application-level WebSockets protocol
|
|
// - shared by TWebSocketServer and TWebSocketClient classes
|
|
// - once upgraded to WebSockets, a HTTP link could be used e.g. to transmit our
|
|
// proprietary 'synopsejson' or 'synopsebin' application content, as stated
|
|
// by this typical handshake:
|
|
// $ GET /myservice HTTP/1.1
|
|
// $ Host: server.example.com
|
|
// $ Upgrade: websocket
|
|
// $ Connection: Upgrade
|
|
// $ Sec-WebSocket-Key: x3JJHMbDL1EzLkh9GBhXDw==
|
|
// $ Sec-WebSocket-Protocol: synopsejson
|
|
// $ Sec-WebSocket-Version: 13
|
|
// $ Origin: http://example.com
|
|
// $
|
|
// $ HTTP/1.1 101 Switching Protocols
|
|
// $ Upgrade: websocket
|
|
// $ Connection: Upgrade
|
|
// $ Sec-WebSocket-Accept: HSmrc0sMlYUkAGmm5OPpG2HaGWk=
|
|
// $ Sec-WebSocket-Protocol: synopsejson
|
|
// - the TWebSocketProtocolJSON inherited class will implement
|
|
// $ Sec-WebSocket-Protocol: synopsejson
|
|
// - the TWebSocketProtocolBinary inherited class will implement
|
|
// $ Sec-WebSocket-Protocol: synopsebin
|
|
TWebSocketProtocol = class(TSynPersistent)
|
|
protected
|
|
fName: RawUTF8;
|
|
fURI: RawUTF8;
|
|
fFramesInCount: integer;
|
|
fFramesOutCount: integer;
|
|
fFramesInBytes: QWord;
|
|
fFramesOutBytes: QWord;
|
|
fOnBeforeIncomingFrame: TOnWebSocketProtocolIncomingFrame;
|
|
fRemoteLocalhost: boolean;
|
|
fRemoteIP: SockString;
|
|
fUpgradeURI: RawUTF8;
|
|
fLastError: string;
|
|
fEncryption: IProtocol;
|
|
// calls fEncryption.ProcessHandshake, if defined
|
|
function ProcessHandshake(const ExtIn: TRawUTF8DynArray; out ExtOut: RawUTF8;
|
|
ErrorMsg: PRawUTF8): boolean; virtual;
|
|
function ProcessURI(const aClientURI: RawUTF8): boolean; virtual; // e.g. for authentication
|
|
// focText/focBinary or focContinuation/focConnectionClose from ProcessStart/ProcessStop
|
|
procedure ProcessIncomingFrame(Sender: TWebSocketProcess;
|
|
var request: TWebSocketFrame; const info: RawUTF8); virtual; abstract;
|
|
function SendFrames(Owner: TWebSocketProcess;
|
|
var Frames: TWebSocketFrameDynArray; var FramesCount: integer): boolean; virtual;
|
|
procedure AfterGetFrame(var frame: TWebSocketFrame); virtual;
|
|
procedure BeforeSendFrame(var frame: TWebSocketFrame); virtual;
|
|
function FrameData(const frame: TWebSocketFrame; const Head: RawUTF8;
|
|
HeadFound: PRawUTF8=nil): pointer; virtual;
|
|
function FrameType(const frame: TWebSocketFrame): RawUTF8; virtual;
|
|
function GetRemoteIP: SockString;
|
|
function GetEncrypted: boolean;
|
|
// fName by default, but e.g. 'synopsebin, synopsebinary'
|
|
function GetSubprotocols: RawUTF8; virtual;
|
|
function SetSubprotocol(const aProtocolName: RawUTF8): boolean; virtual;
|
|
public
|
|
/// abstract constructor to initialize the protocol
|
|
// - the protocol should be named, so that the client may be able to request
|
|
// for a given protocol
|
|
// - if aURI is '', any URI would potentially upgrade to this protocol; you can
|
|
// specify an URI to limit the protocol upgrade to a single resource
|
|
constructor Create(const aName,aURI: RawUTF8); reintroduce;
|
|
/// compute a new instance of the WebSockets protocol, with same parameters
|
|
function Clone(const aClientURI: RawUTF8): TWebSocketProtocol; virtual; abstract;
|
|
/// set the fEncryption: IProtocol according to the supplied key
|
|
// - any asymetric algorithm need to know which side (client/server) to work on
|
|
// - try TECDHEProtocol.FromKey(aKey) and fallback to TProtocolAES.Create(TAESCFB)
|
|
// using SHA256Weak(aKey)
|
|
procedure SetEncryptKey(aServer: boolean; const aKey: RawUTF8);
|
|
/// set the fEncryption: IProtocol as TProtocolAES.Create(TAESCFB)
|
|
procedure SetEncryptKeyAES(const aKey; aKeySize: cardinal);
|
|
/// allow low-level interception before ProcessIncomingFrame is done
|
|
property OnBeforeIncomingFrame: TOnWebSocketProtocolIncomingFrame
|
|
read fOnBeforeIncomingFrame write fOnBeforeIncomingFrame;
|
|
/// access low-level frame encryption
|
|
property Encryption: IProtocol read fEncryption;
|
|
published
|
|
/// the Sec-WebSocket-Protocol application name currently involved
|
|
// - e.g. 'synopsejson', 'synopsebin' or 'synopsebinary'
|
|
property Name: RawUTF8 read fName;
|
|
/// the optional URI on which this protocol would be enabled
|
|
// - leave to '' if any URI should match
|
|
property URI: RawUTF8 read fURI;
|
|
/// the associated 'Remote-IP' HTTP header value
|
|
// - returns '' if self=nil or RemoteLocalhost=true
|
|
property RemoteIP: SockString read GetRemoteIP;
|
|
/// the URI on which this protocol has been upgraded
|
|
property UpgradeURI: RawUTF8 read fUpgradeURI;
|
|
/// the last error message, during frame processing
|
|
property LastError: string read fLastError;
|
|
/// returns TRUE if encryption is enabled during the transmission
|
|
// - is currently only available for TWebSocketProtocolBinary
|
|
property Encrypted: boolean read GetEncrypted;
|
|
/// how many frames have been received by this instance
|
|
property FramesInCount: integer read fFramesInCount;
|
|
/// how many frames have been sent by this instance
|
|
property FramesOutCount: integer read fFramesOutCount;
|
|
/// how many (uncompressed) bytes have been received by this instance
|
|
property FramesInBytes: QWord read fFramesInBytes;
|
|
/// how many (uncompressed) bytes have been sent by this instance
|
|
property FramesOutBytes: QWord read fFramesOutBytes;
|
|
end;
|
|
|
|
/// callback event triggered by TWebSocketProtocolChat for any incoming message
|
|
// - a first call with frame.opcode=focContinuation will take place when
|
|
// the connection will be upgraded to WebSockets
|
|
// - then any incoming focText/focBinary events will trigger this callback
|
|
// - eventually, a focConnectionClose will notify the connection ending
|
|
TOnWebSocketProtocolChatIncomingFrame =
|
|
procedure(Sender: THttpServerResp; const Frame: TWebSocketFrame) of object;
|
|
|
|
/// simple chatting protocol, allowing to receive and send WebSocket frames
|
|
// - you can use this protocol to implement simple asynchronous communication
|
|
// with events expecting no answers, e.g. with AJAX applications
|
|
// - see TWebSocketProtocolRest for bi-directional events expecting answers
|
|
TWebSocketProtocolChat = class(TWebSocketProtocol)
|
|
protected
|
|
fOnIncomingFrame: TOnWebSocketProtocolChatIncomingFrame;
|
|
procedure ProcessIncomingFrame(Sender: TWebSocketProcess;
|
|
var request: TWebSocketFrame; const info: RawUTF8); override;
|
|
public
|
|
/// initialize the chat protocol with an incoming frame callback
|
|
constructor Create(const aName,aURI: RawUTF8;
|
|
const aOnIncomingFrame: TOnWebSocketProtocolChatIncomingFrame); overload;
|
|
/// compute a new instance of the WebSockets protocol, with same parameters
|
|
function Clone(const aClientURI: RawUTF8): TWebSocketProtocol; override;
|
|
/// on the server side, allows to send a message over the wire to a
|
|
// specified client connection
|
|
// - a temporary copy of the Frame content will be made for safety
|
|
function SendFrame(Sender: THttpServerResp; const Frame: TWebSocketFrame): boolean;
|
|
/// on the server side, allows to send a JSON message over the wire to a
|
|
// specified client connection
|
|
// - the supplied JSON content is supplied as "var", since it may be
|
|
// modified during execution, e.g. XORed for frame masking
|
|
function SendFrameJson(Sender: THttpServerResp; var JSON: RawUTF8): boolean;
|
|
/// you can assign an event to this property to be notified of incoming messages
|
|
property OnIncomingFrame: TOnWebSocketProtocolChatIncomingFrame
|
|
read fOnIncomingFrame write fOnIncomingFrame;
|
|
end;
|
|
|
|
|
|
/// handle a REST application-level bi-directional WebSockets protocol
|
|
// - will emulate a bi-directional REST process, using THttpServerRequest to
|
|
// store and handle the request parameters: clients would be able to send
|
|
// regular REST requests to the server, but the server could use the same
|
|
// communication channel to push REST requests to the client
|
|
// - a local THttpServerRequest will be used on both client and server sides,
|
|
// to store REST parameters and compute the corresponding WebSockets frames
|
|
TWebSocketProtocolRest = class(TWebSocketProtocol)
|
|
protected
|
|
fSequencing: boolean;
|
|
fSequence: integer;
|
|
procedure ProcessIncomingFrame(Sender: TWebSocketProcess;
|
|
var request: TWebSocketFrame; const info: RawUTF8); override;
|
|
procedure FrameCompress(const Head: RawUTF8; const Values: array of const;
|
|
const Content,ContentType: RawByteString; var frame: TWebSocketFrame); virtual; abstract;
|
|
function FrameDecompress(const frame: TWebSocketFrame; const Head: RawUTF8;
|
|
const values: array of PRawByteString; var contentType,content: RawByteString): Boolean; virtual; abstract;
|
|
/// convert the input information of REST request to a WebSocket frame
|
|
procedure InputToFrame(Ctxt: THttpServerRequest; aNoAnswer: boolean;
|
|
out request: TWebSocketFrame; out head: RawUTF8); virtual;
|
|
/// convert a WebSocket frame to the input information of a REST request
|
|
function FrameToInput(var request: TWebSocketFrame; out aNoAnswer: boolean;
|
|
Ctxt: THttpServerRequest): boolean; virtual;
|
|
/// convert a WebSocket frame to the output information of a REST request
|
|
function FrameToOutput(var answer: TWebSocketFrame; Ctxt: THttpServerRequest): cardinal; virtual;
|
|
/// convert the output information of REST request to a WebSocket frame
|
|
procedure OutputToFrame(Ctxt: THttpServerRequest; Status: Cardinal;
|
|
var outhead: RawUTF8; out answer: TWebSocketFrame); virtual;
|
|
end;
|
|
|
|
/// used to store the class of a TWebSocketProtocol type
|
|
TWebSocketProtocolClass = class of TWebSocketProtocol;
|
|
|
|
/// handle a REST application-level WebSockets protocol using JSON for transmission
|
|
// - could be used e.g. for AJAX or non Delphi remote access
|
|
// - this class will implement then following application-level protocol:
|
|
// $ Sec-WebSocket-Protocol: synopsejson
|
|
TWebSocketProtocolJSON = class(TWebSocketProtocolRest)
|
|
protected
|
|
procedure FrameCompress(const Head: RawUTF8; const Values: array of const;
|
|
const Content,ContentType: RawByteString; var frame: TWebSocketFrame); override;
|
|
function FrameDecompress(const frame: TWebSocketFrame; const Head: RawUTF8;
|
|
const values: array of PRawByteString; var contentType,content: RawByteString): Boolean; override;
|
|
function FrameData(const frame: TWebSocketFrame; const Head: RawUTF8;
|
|
HeadFound: PRawUTF8=nil): pointer; override;
|
|
function FrameType(const frame: TWebSocketFrame): RawUTF8; override;
|
|
public
|
|
/// initialize the WebSockets JSON protocol
|
|
// - if aURI is '', any URI would potentially upgrade to this protocol; you can
|
|
// specify an URI to limit the protocol upgrade to a single resource
|
|
constructor Create(const aURI: RawUTF8); reintroduce;
|
|
/// compute a new instance of the WebSockets protocol, with same parameters
|
|
function Clone(const aClientURI: RawUTF8): TWebSocketProtocol; override;
|
|
end;
|
|
|
|
/// handle a REST application-level WebSockets protocol using compressed and
|
|
// optionally AES-CFB encrypted binary
|
|
// - this class will implement then following application-level protocol:
|
|
// $ Sec-WebSocket-Protocol: synopsebin
|
|
// or fallback to the previous subprotocol
|
|
// $ Sec-WebSocket-Protocol: synopsebinary
|
|
// - 'synopsebin' will expect requests sequenced as 'r000001','r000002',...
|
|
// headers matching 'a000001','a000002',... instead of 'request'/'answer'
|
|
TWebSocketProtocolBinary = class(TWebSocketProtocolRest)
|
|
protected
|
|
fCompressed: boolean;
|
|
fFramesInBytesSocket: QWord;
|
|
fFramesOutBytesSocket: QWord;
|
|
procedure FrameCompress(const Head: RawUTF8; const Values: array of const;
|
|
const Content,ContentType: RawByteString; var frame: TWebSocketFrame); override;
|
|
function FrameDecompress(const frame: TWebSocketFrame; const Head: RawUTF8;
|
|
const values: array of PRawByteString; var contentType,content: RawByteString): Boolean; override;
|
|
procedure AfterGetFrame(var frame: TWebSocketFrame); override;
|
|
procedure BeforeSendFrame(var frame: TWebSocketFrame); override;
|
|
function FrameData(const frame: TWebSocketFrame; const Head: RawUTF8;
|
|
HeadFound: PRawUTF8=nil): pointer; override;
|
|
function FrameType(const frame: TWebSocketFrame): RawUTF8; override;
|
|
function SendFrames(Owner: TWebSocketProcess;
|
|
var Frames: TWebSocketFrameDynArray; var FramesCount: integer): boolean; override;
|
|
procedure ProcessIncomingFrame(Sender: TWebSocketProcess;
|
|
var request: TWebSocketFrame; const info: RawUTF8); override;
|
|
function GetFramesInCompression: integer;
|
|
function GetFramesOutCompression: integer;
|
|
function GetSubprotocols: RawUTF8; override;
|
|
function SetSubprotocol(const aProtocolName: RawUTF8): boolean; override;
|
|
public
|
|
/// initialize the WebSockets binary protocol with no encryption
|
|
// - if aURI is '', any URI would potentially upgrade to this protocol; you
|
|
// can specify an URI to limit the protocol upgrade to a single resource
|
|
// - SynLZ compression is enabled by default, unless aCompressed is false
|
|
constructor Create(const aURI: RawUTF8; aCompressed: boolean=true); reintroduce; overload; virtual;
|
|
/// initialize the WebSockets binary protocol with a symmetric AES key
|
|
// - if aURI is '', any URI would potentially upgrade to this protocol; you
|
|
// can specify an URI to limit the protocol upgrade to a single resource
|
|
// - if aKeySize if 128, 192 or 256, TProtocolAES (i.e. AES-CFB encryption)
|
|
// will be used to secure the transmission
|
|
// - SynLZ compression is enabled by default, unless aCompressed is false
|
|
constructor Create(const aURI: RawUTF8; const aKey; aKeySize: cardinal;
|
|
aCompressed: boolean=true); reintroduce; overload;
|
|
/// initialize the WebSockets binary protocol from a textual key
|
|
// - if aURI is '', any URI would potentially upgrade to this protocol; you
|
|
// can specify an URI to limit the protocol upgrade to a single resource
|
|
// - will create a TProtocolAES or TECDHEProtocol instance, corresponding to
|
|
// the supplied aKey and aServer values, to secure the transmission using
|
|
// a symmetric or assymetric algorithm
|
|
// - SynLZ compression is enabled by default, unless aCompressed is false
|
|
constructor Create(const aURI: RawUTF8; aServer: boolean; const aKey: RawUTF8;
|
|
aCompressed: boolean=true); reintroduce; overload;
|
|
/// compute a new instance of the WebSockets protocol, with same parameters
|
|
function Clone(const aClientURI: RawUTF8): TWebSocketProtocol; override;
|
|
published
|
|
/// defines if SynLZ compression is enabled during the transmission
|
|
// - is set to TRUE by default
|
|
property Compressed: boolean read fCompressed write fCompressed;
|
|
/// how many bytes have been received by this instance from the wire
|
|
property FramesInBytesSocket: QWord read fFramesInBytesSocket;
|
|
/// how many bytes have been sent by this instance to the wire
|
|
property FramesOutBytesSocket: QWord read fFramesOutBytesSocket;
|
|
/// compression ratio of frames received by this instance
|
|
property FramesInCompression: integer read GetFramesInCompression;
|
|
/// compression ratio of frames Sent by this instance
|
|
property FramesOutCompression: integer read GetFramesOutCompression;
|
|
end;
|
|
|
|
/// used to maintain a list of websocket protocols (for the server side)
|
|
TWebSocketProtocolList = class(TSynPersistentLock)
|
|
protected
|
|
fProtocols: array of TWebSocketProtocol;
|
|
// caller should make fSafe.Lock/UnLock
|
|
function FindIndex(const aName,aURI: RawUTF8): integer;
|
|
public
|
|
/// add a protocol to the internal list
|
|
// - returns TRUE on success
|
|
// - if this protocol is already existing for this given name and URI,
|
|
// returns FALSE: it is up to the caller to release aProtocol if needed
|
|
function Add(aProtocol: TWebSocketProtocol): boolean;
|
|
/// add once a protocol to the internal list
|
|
// - if this protocol is already existing for this given name and URI, any
|
|
// previous one will be released - so it may be confusing on a running server
|
|
// - returns TRUE if the protocol was added for the first time, or FALSE
|
|
// if the protocol has been replaced or is invalid (e.g. aProtocol=nil)
|
|
function AddOnce(aProtocol: TWebSocketProtocol): boolean;
|
|
/// erase a protocol from the internal list, specified by its name
|
|
function Remove(const aProtocolName,aURI: RawUTF8): boolean;
|
|
/// finalize the list storage
|
|
destructor Destroy; override;
|
|
/// create a new protocol instance, from the internal list
|
|
function CloneByName(const aProtocolName, aClientURI: RawUTF8): TWebSocketProtocol;
|
|
/// create a new protocol instance, from the internal list
|
|
function CloneByURI(const aClientURI: RawUTF8): TWebSocketProtocol;
|
|
/// how many protocols are stored
|
|
function Count: integer;
|
|
end;
|
|
|
|
/// indicates which kind of process did occur in the main WebSockets loop
|
|
TWebSocketProcessOne = (
|
|
wspNone, wspPing, wspDone, wspAnswer, wspError, wspClosed);
|
|
|
|
/// indicates how TWebSocketProcess.NotifyCallback() will work
|
|
TWebSocketProcessNotifyCallback = (
|
|
wscBlockWithAnswer, wscBlockWithoutAnswer, wscNonBlockWithoutAnswer);
|
|
|
|
/// used to manage a thread-safe list of WebSockets frames
|
|
TWebSocketFrameList = class(TSynPersistentLock)
|
|
protected
|
|
fTimeoutSec: PtrInt;
|
|
procedure Delete(i: integer);
|
|
public
|
|
/// low-level access to the WebSocket frames list
|
|
List: TWebSocketFrameDynArray;
|
|
/// current number of WebSocket frames in the list
|
|
Count: integer;
|
|
/// initialize the list
|
|
constructor Create(timeoutsec: integer); reintroduce;
|
|
/// add a WebSocket frame in the list
|
|
// - this method is thread-safe
|
|
procedure Push(const frame: TWebSocketFrame);
|
|
/// add a void WebSocket frame in the list
|
|
// - this method is thread-safe
|
|
procedure PushVoidFrame(opcode: TWebSocketFrameOpCode);
|
|
/// retrieve a WebSocket frame from the list, oldest first
|
|
// - you should specify a frame type to search for, according to the
|
|
// specified WebSockets protocl
|
|
// - this method is thread-safe
|
|
function Pop(protocol: TWebSocketProtocol;
|
|
const head: RawUTF8; out frame: TWebSocketFrame): boolean;
|
|
/// how many 'answer' frames are to be ignored
|
|
// - this method is thread-safe
|
|
function AnswerToIgnore(incr: integer=0): integer;
|
|
end;
|
|
|
|
/// parameters to be used for WebSockets process
|
|
{$ifdef USERECORDWITHMETHODS}TWebSocketProcessSettings = record
|
|
{$else}TWebSocketProcessSettings = object{$endif}
|
|
public
|
|
/// time in milli seconds between each focPing commands sent to the other end
|
|
// - default is 0, i.e. no automatic ping sending on client side, and
|
|
// 20000, i.e. 20 seconds, on server side
|
|
HeartbeatDelay: cardinal;
|
|
/// maximum period time in milli seconds when ProcessLoop thread will stay
|
|
// idle before checking for the next pending requests
|
|
// - default is 500 ms, but you may put a lower value, if you expects e.g.
|
|
// REST commands or NotifyCallback(wscNonBlockWithoutAnswer) to be processed
|
|
// with a lower delay
|
|
LoopDelay: cardinal;
|
|
/// ms between sending - allow to gather output frames
|
|
// - GetTickCount resolution is around 16ms under Windows, so default 10ms
|
|
// seems fine for a cross-platform similar behavior
|
|
SendDelay: cardinal;
|
|
/// will close the connection after a given number of invalid Heartbeat sent
|
|
// - when a Hearbeat is failed to be transmitted, the class will start
|
|
// counting how many ping/pong did fail: when this property value is
|
|
// reached, it will release and close the connection
|
|
// - default value is 5
|
|
DisconnectAfterInvalidHeartbeatCount: cardinal;
|
|
/// how many milliseconds the callback notification should wait acquiring
|
|
// the connection before failing
|
|
// - defaut is 5000, i.e. 5 seconds
|
|
CallbackAcquireTimeOutMS: cardinal;
|
|
/// how many milliseconds the callback notification should wait for the
|
|
// client to return its answer
|
|
// - defaut is 30000, i.e. 30 seconds
|
|
CallbackAnswerTimeOutMS: cardinal;
|
|
/// callback run when a WebSockets client is just connected
|
|
// - triggerred by TWebSocketProcess.ProcessStart
|
|
OnClientConnected: TNotifyEvent;
|
|
/// callback run when a WebSockets client is just disconnected
|
|
// - triggerred by TWebSocketProcess.ProcessStop
|
|
OnClientDisconnected: TNotifyEvent;
|
|
/// by default, contains [] to minimize the logged information
|
|
// - set logHeartbeat if you want the ping/pong frames to be logged
|
|
// - set logTextFrameContent if you want the text frame content to be logged
|
|
// - set logBinaryFrameContent if you want the binary frame content to be logged
|
|
// - used only if WebSocketLog global variable is set to a TSynLog class
|
|
LogDetails: set of (logHeartbeat,logTextFrameContent,logBinaryFrameContent);
|
|
/// will set the default values
|
|
procedure SetDefaults;
|
|
/// will set LogDetails to its highest level of verbosity
|
|
// - used only if WebSocketLog global variable is set
|
|
procedure SetFullLog;
|
|
end;
|
|
|
|
/// points to parameters to be used for WebSockets process
|
|
// - using a pointer/reference type will allow in-place modification of
|
|
// any TWebSocketProcess.Settings, TWebSocketServer.Settings or
|
|
// THttpClientWebSockets.Settings property
|
|
PWebSocketProcessSettings = ^TWebSocketProcessSettings;
|
|
|
|
/// the current state of the WebSockets process
|
|
TWebSocketProcessState = (wpsCreate,wpsRun,wpsClose,wpsDestroy);
|
|
|
|
/// abstract WebSockets process, used on both client or server sides
|
|
// - CanGetFrame/ReceiveBytes/SendBytes abstract methods should be overriden with
|
|
// actual communication, and fState and ProcessStart/ProcessStop should be
|
|
// updated from the actual processing thread (e.g. as in TWebCrtSocketProcess)
|
|
TWebSocketProcess = class(TSynPersistent)
|
|
protected
|
|
fProcessName: RawUTF8;
|
|
fIncoming: TWebSocketFrameList;
|
|
fOutgoing: TWebSocketFrameList;
|
|
fOwnerThread: TSynThread;
|
|
fOwnerConnection: THttpServerConnectionID;
|
|
fState: TWebSocketProcessState;
|
|
fProtocol: TWebSocketProtocol;
|
|
fMaskSentFrames: byte;
|
|
fProcessEnded: boolean;
|
|
fNoConnectionCloseAtDestroy: boolean;
|
|
fProcessCount: integer;
|
|
fSettings: TWebSocketProcessSettings;
|
|
fSafeIn, fSafeOut: PSynLocker;
|
|
fInvalidPingSendCount: cardinal;
|
|
fSafePing: PSynLocker;
|
|
fLastSocketTicks: Int64;
|
|
function LastPingDelay: Int64;
|
|
procedure SetLastPingTicks(invalidPing: boolean=false);
|
|
/// callback methods run by ProcessLoop
|
|
procedure ProcessStart; virtual;
|
|
procedure ProcessStop; virtual;
|
|
// called by ProcessLoop - TRUE=continue, FALSE=ended
|
|
// - caller may have checked that some data is pending to read
|
|
function ProcessLoopStepReceive: boolean;
|
|
// called by ProcessLoop - TRUE=continue, FALSE=ended
|
|
// - caller may check that LastPingDelay>fSettings.SendDelay and Socket is writable
|
|
function ProcessLoopStepSend: boolean;
|
|
// blocking process, for one thread handling all WebSocket connection process
|
|
procedure ProcessLoop;
|
|
function ComputeContext(out RequestProcess: TOnHttpServerRequest): THttpServerRequest; virtual; abstract;
|
|
procedure HiResDelay(const start: Int64);
|
|
procedure Log(const frame: TWebSocketFrame; const aMethodName: RawUTF8;
|
|
aEvent: TSynLogInfo=sllTrace; DisableRemoteLog: Boolean=false); virtual;
|
|
function SendPendingOutgoingFrames: boolean;
|
|
public
|
|
/// initialize the WebSockets process on a given connection
|
|
// - the supplied TWebSocketProtocol will be owned by this instance
|
|
// - other parameters should reflect the client or server expectations
|
|
constructor Create(aProtocol: TWebSocketProtocol; aOwnerConnection: THttpServerConnectionID;
|
|
aOwnerThread: TSynThread; const aSettings: TWebSocketProcessSettings;
|
|
const aProcessName: RawUTF8); reintroduce;
|
|
/// finalize the context
|
|
// - if needed, will notify the other end with a focConnectionClose frame
|
|
// - will release the TWebSocketProtocol associated instance
|
|
destructor Destroy; override;
|
|
/// abstract low-level method to retrieve pending input data
|
|
// - should return the number of bytes (<=count) received and written to P
|
|
// - is defined separated to allow multi-thread pooling
|
|
function ReceiveBytes(P: PAnsiChar; count: integer): integer;
|
|
virtual; abstract;
|
|
/// abstract low-level method to send pending output data
|
|
// - returns false on any error, try on success
|
|
// - is defined separated to allow multi-thread pooling
|
|
function SendBytes(P: pointer; Len: integer): boolean;
|
|
virtual; abstract;
|
|
/// abstract low-level method to check if there is some pending input data
|
|
// in the input Socket ready for GetFrame/ReceiveBytes
|
|
// - is defined separated to allow multi-thread pooling
|
|
function CanGetFrame(TimeOut: cardinal; ErrorWithoutException: PInteger): boolean;
|
|
virtual; abstract;
|
|
/// blocking process incoming WebSockets framing protocol
|
|
// - CanGetFrame should have been called and returned true before
|
|
// - will call overriden ReceiveBytes() for the actual communication
|
|
function GetFrame(out Frame: TWebSocketFrame; ErrorWithoutException: PInteger): boolean;
|
|
/// process outgoing WebSockets framing protocol -> to be overriden
|
|
// - will call overriden SendBytes() for the actual communication
|
|
// - use Outgoing.Push() to send frames asynchronously
|
|
function SendFrame(var Frame: TWebSocketFrame): boolean;
|
|
/// will push a request or notification to the other end of the connection
|
|
// - caller should set the aRequest with the outgoing parameters, and
|
|
// optionally receive a response from the other end
|
|
// - the request may be sent in blocking or non blocking mode
|
|
// - returns the HTTP Status code (e.g. HTTP_SUCCESS=200 for success)
|
|
function NotifyCallback(aRequest: THttpServerRequest;
|
|
aMode: TWebSocketProcessNotifyCallback): cardinal; virtual;
|
|
/// the settings currently used during the WebSockets process
|
|
// - defined as a pointer so that you may be able to change the values
|
|
function Settings: PWebSocketProcessSettings; {$ifdef HASINLINE}inline;{$endif}
|
|
/// returns the current state of the underlying connection
|
|
function State: TWebSocketProcessState;
|
|
/// the associated 'Remote-IP' HTTP header value
|
|
// - returns '' if Protocol=nil or Protocol.RemoteLocalhost=true
|
|
function RemoteIP: SockString;
|
|
/// direct access to the low-level incoming frame stack
|
|
property Incoming: TWebSocketFrameList read fIncoming;
|
|
/// direct access to the low-level outgoing frame stack
|
|
// - call Outgoing.Push() to send frames asynchronously, with optional
|
|
// jumboframe gathering (if supported by the protocol)
|
|
property Outgoing: TWebSocketFrameList read fOutgoing;
|
|
/// the associated low-level processing thread
|
|
property OwnerThread: TSynThread read fOwnerThread;
|
|
/// the associated low-level WebSocket connection opaque identifier
|
|
property OwnerConnection: THttpServerConnectionID read fOwnerConnection;
|
|
/// how many frames are currently processed by this connection
|
|
property ProcessCount: integer read fProcessCount;
|
|
/// may be set to TRUE before Destroy to force raw socket disconnection
|
|
property NoConnectionCloseAtDestroy: boolean
|
|
read fNoConnectionCloseAtDestroy write fNoConnectionCloseAtDestroy;
|
|
published
|
|
/// the Sec-WebSocket-Protocol application protocol currently involved
|
|
// - TWebSocketProtocolJSON or TWebSocketProtocolBinary in the mORMot context
|
|
// - could be nil if the connection is in standard HTTP/1.1 mode
|
|
property Protocol: TWebSocketProtocol read fProtocol;
|
|
/// the associated process name
|
|
property ProcessName: RawUTF8 read fProcessName write fProcessName;
|
|
/// how many invalid heartbeat frames have been sent
|
|
// - a non 0 value indicates a connection problem
|
|
property InvalidPingSendCount: cardinal read fInvalidPingSendCount;
|
|
end;
|
|
|
|
/// TCrtSocket-based WebSockets process, used on both client or server sides
|
|
// - will use the socket in blocking mode, so expects its own processing thread
|
|
TWebCrtSocketProcess = class(TWebSocketProcess)
|
|
protected
|
|
fSocket: TCrtSocket;
|
|
public
|
|
/// initialize the WebSockets process on a given TCrtSocket connection
|
|
// - the supplied TWebSocketProtocol will be owned by this instance
|
|
// - other parameters should reflect the client or server expectations
|
|
constructor Create(aSocket: TCrtSocket; aProtocol: TWebSocketProtocol;
|
|
aOwnerConnection: THttpServerConnectionID; aOwnerThread: TSynThread;
|
|
const aSettings: TWebSocketProcessSettings;
|
|
const aProcessName: RawUTF8); reintroduce; virtual;
|
|
/// first step of the low level incoming WebSockets framing protocol over TCrtSocket
|
|
// - in practice, just call fSocket.SockInPending to check for pending data
|
|
function CanGetFrame(TimeOut: cardinal; ErrorWithoutException: PInteger): boolean; override;
|
|
/// low level receive incoming WebSockets frame data over TCrtSocket
|
|
// - in practice, just call fSocket.SockInRead to check for pending data
|
|
function ReceiveBytes(P: PAnsiChar; count: integer): integer; override;
|
|
/// low level receive incoming WebSockets frame data over TCrtSocket
|
|
// - in practice, just call fSocket.TrySndLow to send pending data
|
|
function SendBytes(P: pointer; Len: integer): boolean; override;
|
|
/// the associated communication socket
|
|
// - on the server side, is a THttpServerSocket
|
|
// - access to this instance is protected by Safe.Lock/Unlock
|
|
property Socket: TCrtSocket read fSocket;
|
|
end;
|
|
|
|
|
|
{ -------------- WebSockets Server classes for bidirectional remote access }
|
|
|
|
type
|
|
TWebSocketServerSocket = class(THttpServerSocket)
|
|
public
|
|
/// overriden to detect upgrade: websocket header and return grOwned
|
|
function GetRequest(withBody: boolean;
|
|
headerMaxTix: Int64): THttpServerSocketGetRequestResult; override;
|
|
end;
|
|
|
|
type
|
|
{$M+}
|
|
TWebSocketServerResp = class;
|
|
{$M-}
|
|
|
|
/// implements WebSockets process as used on server side
|
|
TWebSocketProcessServer = class(TWebCrtSocketProcess)
|
|
protected
|
|
fServerResp: TWebSocketServerResp;
|
|
function ComputeContext(out RequestProcess: TOnHttpServerRequest): THttpServerRequest; override;
|
|
end;
|
|
|
|
/// an enhanced input/output structure used for HTTP and WebSockets requests
|
|
// - this class will contain additional parameters used to maintain the
|
|
// WebSockets execution context in overriden TWebSocketServer.Process method
|
|
TWebSocketServerResp = class(THttpServerResp)
|
|
protected
|
|
fProcess: TWebSocketProcessServer;
|
|
public
|
|
/// initialize the context, associated to a HTTP/WebSockets server instance
|
|
constructor Create(aServerSock: THttpServerSocket; aServer: THttpServer); override;
|
|
/// push a notification to the client
|
|
function NotifyCallback(Ctxt: THttpServerRequest; aMode: TWebSocketProcessNotifyCallback): cardinal; virtual;
|
|
/// the Sec-WebSocket-Protocol application protocol currently involved
|
|
// - TWebSocketProtocolJSON or TWebSocketProtocolBinary in the mORMot context
|
|
// - could be nil if the connection is in standard HTTP/1.1 mode
|
|
function WebSocketProtocol: TWebSocketProtocol;
|
|
/// low-level WebSocket protocol processing instance
|
|
property WebSocketProcess: TWebSocketProcessServer read fProcess;
|
|
end;
|
|
|
|
/// main HTTP/WebSockets server Thread using the standard Sockets API (e.g. WinSock)
|
|
// - once upgraded to WebSockets from the client, this class is able to serve
|
|
// any Sec-WebSocket-Protocol application content
|
|
TWebSocketServer = class(THttpServer)
|
|
protected
|
|
fWebSocketConnections: TSynObjectListLocked;
|
|
fProtocols: TWebSocketProtocolList;
|
|
fSettings: TWebSocketProcessSettings;
|
|
/// validate the WebSockets handshake, then call Context.fProcess.ProcessLoop()
|
|
function WebSocketProcessUpgrade(ClientSock: THttpServerSocket;
|
|
Context: TWebSocketServerResp): integer; virtual;
|
|
/// overriden method which will recognize the WebSocket protocol handshake,
|
|
// then run the whole bidirectional communication in its calling thread
|
|
// - here ConnectionThread is a THttpServerResp, and ClientSock.Headers
|
|
// and ConnectionUpgrade properties should be checked for the handshake
|
|
procedure Process(ClientSock: THttpServerSocket;
|
|
ConnectionID: THttpServerConnectionID; ConnectionThread: TSynThread); override;
|
|
public
|
|
/// create a Server Thread, binded and listening on a port
|
|
// - this constructor will raise a EHttpServer exception if binding failed
|
|
// - expects the port to be specified as string, e.g. '1234'; you can
|
|
// optionally specify a server address to bind to, e.g. '1.2.3.4:1234'
|
|
// - due to the way how WebSockets works, one thread will be created
|
|
// for any incoming connection
|
|
// - note that this constructor will not register any protocol, so is
|
|
// useless until you execute Protocols.Add()
|
|
// - in the current implementation, the ServerThreadPoolCount parameter will
|
|
// use two threads by default to handle shortliving HTTP/1.0 "connection: close"
|
|
// requests, and one thread will be maintained per keep-alive/websockets client
|
|
// - by design, the KeepAliveTimeOut value is ignored with this server
|
|
// once it has been upgraded to WebSockets
|
|
constructor Create(const aPort: SockString; OnStart,OnStop: TNotifyThreadEvent;
|
|
const ProcessName: SockString; ServerThreadPoolCount: integer=2;
|
|
KeepAliveTimeOut: integer=30000; HeadersNotFiltered: boolean=false;
|
|
CreateSuspended: boolean = false); override;
|
|
/// close the server
|
|
destructor Destroy; override;
|
|
/// will send a given frame to all connected clients
|
|
// - expect aFrame.opcode to be either focText or focBinary
|
|
// - will call TWebSocketProcess.Outgoing.Push for asynchronous sending
|
|
procedure WebSocketBroadcast(const aFrame: TWebSocketFrame); overload;
|
|
/// will send a given frame to clients matching the supplied connection IDs
|
|
// - expect aFrame.opcode to be either focText or focBinary
|
|
// - will call TWebSocketProcess.Outgoing.Push for asynchronous sending
|
|
procedure WebSocketBroadcast(const aFrame: TWebSocketFrame;
|
|
const aClientsConnectionID: THttpServerConnectionIDDynArray); overload;
|
|
/// give access to the underlying connection from its ID
|
|
// - also identifies an incoming THttpServerResp as a valid TWebSocketServerResp
|
|
function IsActiveWebSocket(ConnectionID: THttpServerConnectionID): TWebSocketServerResp;
|
|
/// give access to the underlying connection from its connection thread
|
|
// - also identifies an incoming THttpServerResp as a valid TWebSocketServerResp
|
|
function IsActiveWebSocketThread(ConnectionThread: TSynThread): TWebSocketServerResp;
|
|
/// the settings to be used for WebSockets process
|
|
// - note that those parameters won't be propagated to existing connections
|
|
// - defined as a pointer so that you may be able to change the values
|
|
function Settings: PWebSocketProcessSettings; {$ifdef HASINLINE}inline;{$endif}
|
|
/// how many WebSockets connections are currently maintained
|
|
function WebSocketConnections: integer;
|
|
/// access to the protocol list handled by this server
|
|
property WebSocketProtocols: TWebSocketProtocolList read fProtocols;
|
|
end;
|
|
|
|
/// main HTTP/WebSockets server Thread using the standard Sockets API (e.g. WinSock)
|
|
// - once upgraded to WebSockets from the client, this class is able to serve
|
|
// our proprietary Sec-WebSocket-Protocol: 'synopsejson' or 'synopsebin'
|
|
// application content, managing regular REST client-side requests and
|
|
// also server-side push notifications
|
|
// - once in 'synopse*' mode, the Request() method will be trigerred from
|
|
// any incoming REST request from the client, and the OnCallback event
|
|
// will be available to push a request from the server to the client
|
|
TWebSocketServerRest = class(TWebSocketServer)
|
|
public
|
|
/// create a Server Thread, binded and listening on a port, with our
|
|
// 'synopsebin' and optionally 'synopsejson' modes
|
|
// - if aWebSocketsURI is '', any URI would potentially upgrade; you can
|
|
// specify an URI to limit the protocol upgrade to a single resource
|
|
// - TWebSocketProtocolBinary will always be registered by this constructor
|
|
// - if the encryption key text is not '', TWebSocketProtocolBinary will
|
|
// use AES-CFB 256 bits encryption
|
|
// - if aWebSocketsAJAX is TRUE, it will also register TWebSocketProtocolJSON
|
|
// so that AJAX applications would be able to connect to this server
|
|
// - warning: WaitStarted should be called after Create() to check for
|
|
// for actual port binding in the background thread
|
|
constructor Create(const aPort: SockString; OnStart,OnStop: TNotifyThreadEvent;
|
|
const aProcessName, aWebSocketsURI, aWebSocketsEncryptionKey: RawUTF8;
|
|
aWebSocketsAJAX: boolean=false); reintroduce; overload;
|
|
/// defines the WebSockets protocols to be used for this Server
|
|
// - i.e. 'synopsebin' and optionally 'synopsejson' modes
|
|
// - if aWebSocketsURI is '', any URI would potentially upgrade; you can
|
|
// specify an URI to limit the protocol upgrade to a single resource
|
|
// - TWebSocketProtocolBinary will always be registered by this constructor
|
|
// - if the encryption key text is not '', TWebSocketProtocolBinary will
|
|
// use AES-CFB 256 bits encryption
|
|
// - if aWebSocketsAJAX is TRUE, it will also register TWebSocketProtocolJSON
|
|
// so that AJAX applications would be able to connect to this server
|
|
procedure WebSocketsEnable(const aWebSocketsURI, aWebSocketsEncryptionKey: RawUTF8;
|
|
aWebSocketsAJAX: boolean=false; aWebSocketsCompressed: boolean=true);
|
|
/// server can send a request back to the client, when the connection has
|
|
// been upgraded to WebSocket
|
|
// - InURL/InMethod/InContent properties are input parameters (InContentType
|
|
// is ignored)
|
|
// - OutContent/OutContentType/OutCustomHeader are output parameters
|
|
// - CallingThread should be set to the client's Ctxt.CallingThread
|
|
// value, so that the method could know which connnection is to be used -
|
|
// it will return STATUS_NOTFOUND (404) if the connection is unknown
|
|
// - result of the function is the HTTP error code (200 if OK, e.g.)
|
|
function Callback(Ctxt: THttpServerRequest; aNonBlocking: boolean): cardinal; override;
|
|
end;
|
|
|
|
|
|
/// used to return the text corresponding to a specified WebSockets frame data
|
|
function ToText(opcode: TWebSocketFrameOpCode): PShortString; overload;
|
|
|
|
/// used to return the text corresponding to a specified WebSockets sending mode
|
|
function ToText(mode: TWebSocketProcessNotifyCallback): PShortString; overload;
|
|
|
|
/// low-level intitialization of a TWebSocketFrame for proper REST content
|
|
procedure FrameInit(opcode: TWebSocketFrameOpCode; const Content, ContentType: RawByteString;
|
|
out frame: TWebSocketFrame);
|
|
|
|
|
|
{ -------------- WebSockets Client classes for bidirectional remote access }
|
|
|
|
type
|
|
{$M+}
|
|
THttpClientWebSockets = class;
|
|
TWebSocketProcessClientThread = class;
|
|
{$M-}
|
|
|
|
/// implements WebSockets process as used on client side
|
|
TWebSocketProcessClient = class(TWebCrtSocketProcess)
|
|
protected
|
|
fClientThread: TWebSocketProcessClientThread;
|
|
function ComputeContext(out RequestProcess: TOnHttpServerRequest): THttpServerRequest; override;
|
|
public
|
|
/// initialize the client process for a given THttpClientWebSockets
|
|
constructor Create(aSender: THttpClientWebSockets; aProtocol: TWebSocketProtocol;
|
|
const aProcessName: RawUTF8); reintroduce; virtual;
|
|
/// finalize the process
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
/// the current state of the client side processing thread
|
|
TWebSocketProcessClientThreadState = (sCreate, sRun, sFinished, sClosed);
|
|
|
|
/// WebSockets processing thread used on client side
|
|
// - will handle any incoming callback
|
|
TWebSocketProcessClientThread = class(TSynThread)
|
|
protected
|
|
fThreadState: TWebSocketProcessClientThreadState;
|
|
fProcess: TWebSocketProcessClient;
|
|
procedure Execute; override;
|
|
public
|
|
constructor Create(aProcess: TWebSocketProcessClient); reintroduce;
|
|
end;
|
|
|
|
/// Socket API based REST and HTTP/1.1 client, able to upgrade to WebSockets
|
|
// - will implement regular HTTP/1.1 until WebSocketsUpgrade() is called
|
|
THttpClientWebSockets = class(THttpClientSocket)
|
|
protected
|
|
fProcess: TWebSocketProcessClient;
|
|
fSettings: TWebSocketProcessSettings;
|
|
fOnCallbackRequestProcess: TOnHttpServerRequest;
|
|
fOnBeforeIncomingFrame: TOnWebSocketProtocolIncomingFrame;
|
|
fOnWebSocketsClosed: TNotifyEvent;
|
|
procedure SetInt32OptionByIndex(OptName, OptVal: integer); override;
|
|
public
|
|
/// low-level initialization of a client WebSockets connection
|
|
// - calls Open() then WebSocketsUpgrade() for a given protocol
|
|
// - with proper error interception and optional logging, returning nil
|
|
class function WebSocketsConnect(const aHost, aPort: SockString;
|
|
aProtocol: TWebSocketProtocol; aLog: TSynLogClass=nil;
|
|
const aLogContext: RawUTF8=''; const aURI: RawUTF8='';
|
|
const aCustomHeaders: RawUTF8=''): THttpClientWebSockets;
|
|
/// common initialization of all constructors
|
|
// - this overridden method will set the UserAgent with some default value
|
|
constructor Create(aTimeOut: PtrInt=10000); override;
|
|
/// finalize the connection
|
|
destructor Destroy; override;
|
|
/// process low-level REST request, either on HTTP/1.1 or via WebSockets
|
|
// - after WebSocketsUpgrade() call, will use WebSockets for the communication
|
|
function Request(const url, method: SockString; KeepAlive: cardinal;
|
|
const header, Data, DataType: SockString; retry: boolean): integer; override;
|
|
/// upgrade the HTTP client connection to a specified WebSockets protocol
|
|
// - i.e. 'synopsebin' and optionally 'synopsejson' modes
|
|
// - you may specify an URI to as expected by the server for upgrade
|
|
// - if aWebSocketsAJAX equals default FALSE, it will register the
|
|
// TWebSocketProtocolBinaryprotocol, with AES-CFB 256 bits encryption
|
|
// if the encryption key text is not '' and optional SynLZ compression
|
|
// - if aWebSocketsAJAX is TRUE, it will register the slower and less secure
|
|
// TWebSocketProtocolJSON (to be used for AJAX debugging/test purposes only)
|
|
// and aWebSocketsEncryptionKey/aWebSocketsCompression parameters won't be used
|
|
// - alternatively, you can specify your own custom TWebSocketProtocol instance
|
|
// (owned by this method and immediately released on error)
|
|
// - will return '' on success, or an error message on failure
|
|
function WebSocketsUpgrade(const aWebSocketsURI, aWebSocketsEncryptionKey: RawUTF8;
|
|
aWebSocketsAJAX: boolean=false; aWebSocketsCompression: boolean=true;
|
|
aProtocol: TWebSocketProtocol=nil; const aCustomHeaders: RawUTF8=''): RawUTF8;
|
|
/// the settings to be used for WebSockets process
|
|
// - note that those parameters won't be propagated to existing connections
|
|
// - defined as a pointer so that you may be able to change the values
|
|
function Settings: PWebSocketProcessSettings; {$ifdef HASINLINE}inline;{$endif}
|
|
/// this event handler will be executed for any incoming push notification
|
|
property OnCallbackRequestProcess: TOnHttpServerRequest
|
|
read fOnCallbackRequestProcess write fOnCallbackRequestProcess;
|
|
/// event handler trigerred when the WebSocket link is destroyed
|
|
// - may happen e.g. after graceful close from the server side, or
|
|
// after DisconnectAfterInvalidHeartbeatCount is reached
|
|
property OnWebSocketsClosed: TNotifyEvent
|
|
read fOnWebSocketsClosed write fOnWebSocketsClosed;
|
|
/// allow low-level interception before
|
|
// TWebSocketProcessClient.ProcessIncomingFrame is executed
|
|
property OnBeforeIncomingFrame: TOnWebSocketProtocolIncomingFrame
|
|
read fOnBeforeIncomingFrame write fOnBeforeIncomingFrame;
|
|
published
|
|
/// the current WebSockets processing class
|
|
// - equals nil for plain HTTP/1.1 mode
|
|
// - points to the current WebSockets process instance, after a successful
|
|
// WebSocketsUpgrade() call, so that you could use e.g. WebSockets.Protocol
|
|
// to retrieve the protocol currently used
|
|
property WebSockets: TWebSocketProcessClient read fProcess;
|
|
end;
|
|
|
|
|
|
var
|
|
/// if set, will log all WebSockets raw information
|
|
// - see also TWebSocketProcessSettings.LogDetails and
|
|
// TWebSocketProcessSettings.SetFullLog to setup even more verbose information,
|
|
// e.g. by setting HttpServerFullWebSocketsLog and HttpClientFullWebSocketsLog
|
|
// global variables to true (as defined in mORMotHttpServer/mORMotHttpClient)
|
|
WebSocketLog: TSynLogClass;
|
|
|
|
/// number of bytes above which SynLZ compression may be done
|
|
// - when working with TWebSocketProtocolBinary
|
|
// - it is useless to compress smaller frames, which fits in network MTU
|
|
WebSocketsBinarySynLzThreshold: integer = 450;
|
|
|
|
/// how replay attacks will be handled in TWebSocketProtocolBinary encryption
|
|
// - you may set this global value to repCheckedIfAvailable if you are
|
|
// really paranoid (but resulting security may be lower, since the IV is
|
|
// somewhat more predictable than plain random)
|
|
WebSocketsIVReplayAttackCheck: TAESIVReplayAttackCheck = repNoCheck;
|
|
|
|
/// the allowed maximum size, in MB, of a WebSockets frame
|
|
WebSocketsMaxFrameMB: cardinal = 256;
|
|
|
|
|
|
|
|
implementation
|
|
|
|
{ -------------- high-level SynCrtSock classes depending on SynCommons }
|
|
|
|
{ THttpRequestCached }
|
|
|
|
constructor THttpRequestCached.Create(const aURI: RawUTF8;
|
|
aKeepAliveSeconds, aTimeoutSeconds: integer; const aToken: RawUTF8;
|
|
aHttpClass: THttpRequestClass);
|
|
begin
|
|
inherited Create;
|
|
fKeepAlive := aKeepAliveSeconds*1000;
|
|
if aTimeoutSeconds > 0 then // 0 means no cache
|
|
fCache := TSynDictionary.Create(TypeInfo(TRawUTF8DynArray),
|
|
TypeInfo(THttpRequestCacheDynArray),true,aTimeoutSeconds);
|
|
if not LoadFromURI(aURI,aToken,aHttpClass) then
|
|
raise ESynException.CreateUTF8('%.Create: invalid aURI=%',[self,aURI]);
|
|
end;
|
|
|
|
procedure THttpRequestCached.Clear;
|
|
begin
|
|
FreeAndNil(fHttp); // either fHttp or fSocket is used
|
|
FreeAndNil(fSocket);
|
|
if fCache <> nil then
|
|
fCache.DeleteAll;
|
|
fURI.Clear;
|
|
fTokenHeader := '';
|
|
end;
|
|
|
|
destructor THttpRequestCached.Destroy;
|
|
begin
|
|
fCache.Free;
|
|
fHttp.Free;
|
|
fSocket.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function THttpRequestCached.Get(const aAddress: SockString;
|
|
aModified: PBoolean; aStatus: PInteger): SockString;
|
|
var cache: THttpRequestCache;
|
|
headin, headout: SockString;
|
|
status: integer;
|
|
modified: boolean;
|
|
begin
|
|
result := '';
|
|
if (fHttp=nil) and (fSocket=nil) then // either fHttp or fSocket is used
|
|
exit;
|
|
if (fCache <> nil) and fCache.FindAndCopy(aAddress,cache) then
|
|
FormatUTF8('If-None-Match: %',[cache.Tag],RawUTF8(headin));
|
|
if fTokenHeader<>'' then begin
|
|
if headin<>'' then
|
|
headin := headin+#13#10;
|
|
headin := headin+fTokenHeader;
|
|
end;
|
|
if fSocket<>nil then begin
|
|
if connectionClose in fSocket.HeaderFlags then begin
|
|
// server may close after a few requests (e.g. nginx keepalive_requests)
|
|
FreeAndNil(fSocket);
|
|
fSocket := THttpClientSocket.Open(fURI.Server,fURI.Port)
|
|
end;
|
|
status := fSocket.Get(aAddress,fKeepAlive,headin);
|
|
result := fSocket.Content;
|
|
end else
|
|
status := fHttp.Request(aAddress,'GET',fKeepAlive,headin,'','',headout,result);
|
|
modified := true;
|
|
case status of
|
|
STATUS_SUCCESS:
|
|
if fCache <> nil then begin
|
|
if fHttp <> nil then
|
|
FindNameValue(headout,'ETAG:',cache.Tag) else
|
|
cache.Tag := fSocket.HeaderGetValue('ETAG');
|
|
if cache.Tag <> '' then begin
|
|
cache.Content := result;
|
|
fCache.AddOrUpdate(aAddress,cache);
|
|
end;
|
|
end;
|
|
STATUS_NOTMODIFIED: begin
|
|
result := cache.Content;
|
|
modified := false;
|
|
end;
|
|
end;
|
|
if aModified<>nil then
|
|
aModified^ := modified;
|
|
if aStatus<>nil then
|
|
aStatus^ := status;
|
|
end;
|
|
|
|
function THttpRequestCached.LoadFromURI(const aURI, aToken: RawUTF8;
|
|
aHttpClass: THttpRequestClass): boolean;
|
|
begin
|
|
result := false;
|
|
if (self=nil) or (fHttp<>nil) or (fSocket<>nil) or not fURI.From(aURI) then
|
|
exit;
|
|
fTokenHeader := AuthorizationBearer(aToken);
|
|
if aHttpClass=nil then begin
|
|
{$ifdef USEWININET}
|
|
aHttpClass := TWinHTTP;
|
|
{$else}
|
|
{$ifdef USELIBCURL}
|
|
if fURI.Https then
|
|
aHttpClass := TCurlHTTP;
|
|
{$endif}
|
|
{$endif}
|
|
end;
|
|
if aHttpClass=nil then
|
|
fSocket := THttpClientSocket.Open(fURI.Server,fURI.Port) else
|
|
fHttp := aHttpClass.Create(fURI.Server,fURI.Port,fURI.Https);
|
|
result := true;
|
|
end;
|
|
|
|
function THttpRequestCached.Flush(const aAddress: SockString): boolean;
|
|
begin
|
|
if fCache <> nil then
|
|
result := fCache.Delete(aAddress)>=0 else
|
|
result := true;
|
|
end;
|
|
|
|
|
|
function PurgeHeaders(P: PUTF8Char): RawUTF8;
|
|
var
|
|
tmp: TTextWriterStackBuffer;
|
|
next: PUTF8Char;
|
|
W: TTextWriter;
|
|
begin
|
|
result := '';
|
|
W := nil;
|
|
try
|
|
while P <> nil do begin
|
|
next := GotoNextLine(P);
|
|
if IdemPCharArray(P, ['CONTENT-', 'CONNECTION:', 'KEEP-ALIVE:', 'TRANSFER-',
|
|
'X-POWERED', 'USER-AGENT', 'REMOTEIP:', 'HOST:', 'ACCEPT:']) < 0 then begin
|
|
if W = nil then
|
|
W := TTextWriter.CreateOwnedStream(tmp);
|
|
if next=nil then
|
|
W.AddNoJSONEscape(P) else
|
|
W.AddNoJSONEscape(P, next - P);
|
|
end;
|
|
P := next;
|
|
end;
|
|
if W <> nil then
|
|
W.SetText(result);
|
|
finally
|
|
W.Free;
|
|
end;
|
|
end;
|
|
|
|
|
|
{ -------------- WebSockets shared classes for bidirectional remote access }
|
|
|
|
var
|
|
_TWebSocketFrameOpCode: array[TWebSocketFrameOpCode] of PShortString;
|
|
_TWebSocketProcessNotifyCallback: array[TWebSocketProcessNotifyCallback] of PShortString;
|
|
|
|
function ToText(opcode: TWebSocketFrameOpCode): PShortString;
|
|
begin
|
|
result := _TWebSocketFrameOpCode[opcode];
|
|
end;
|
|
|
|
function ToText(mode: TWebSocketProcessNotifyCallback): PShortString;
|
|
begin
|
|
result := _TWebSocketProcessNotifyCallback[mode];
|
|
end;
|
|
|
|
function ToText(st: TWebSocketProcessClientThreadState): PShortString; overload;
|
|
begin
|
|
result := GetEnumName(TypeInfo(TWebSocketProcessClientThreadState),ord(st));
|
|
end;
|
|
|
|
function ToText(ev: TPollSocketEvent): PShortString; overload;
|
|
begin
|
|
result := GetEnumName(TypeInfo(TPollSocketEvent),ord(ev));
|
|
end;
|
|
|
|
function ToText(st: TWebSocketProcessState): PShortString; overload;
|
|
begin
|
|
result := GetEnumName(TypeInfo(TWebSocketProcessState),ord(st));
|
|
end;
|
|
|
|
|
|
const
|
|
STATUS_WEBSOCKETCLOSED = 0;
|
|
|
|
procedure ComputeChallenge(const Base64: RawByteString; out Digest: TSHA1Digest);
|
|
const SALT: string[36] = '258EAFA5-E914-47DA-95CA-C5AB0DC85B11';
|
|
var SHA: TSHA1;
|
|
begin
|
|
SHA.Init;
|
|
SHA.Update(pointer(Base64),length(Base64));
|
|
SHA.Update(@SALT[1],36);
|
|
SHA.Final(Digest);
|
|
end;
|
|
|
|
|
|
{ TWebSocketProcessSettings }
|
|
|
|
procedure TWebSocketProcessSettings.SetDefaults;
|
|
begin
|
|
HeartbeatDelay := 0;
|
|
LoopDelay := 500;
|
|
SendDelay := 10;
|
|
DisconnectAfterInvalidHeartbeatCount := 5;
|
|
CallbackAcquireTimeOutMS := 5000;
|
|
CallbackAnswerTimeOutMS := 5000;
|
|
LogDetails := [];
|
|
OnClientConnected := nil;
|
|
OnClientDisconnected := nil;
|
|
end;
|
|
|
|
procedure TWebSocketProcessSettings.SetFullLog;
|
|
begin
|
|
LogDetails := [logHeartbeat,logTextFrameContent,logBinaryFrameContent];
|
|
end;
|
|
|
|
|
|
{ TWebSocketProtocol }
|
|
|
|
constructor TWebSocketProtocol.Create(const aName,aURI: RawUTF8);
|
|
begin
|
|
fName := aName;
|
|
fURI := aURI;
|
|
end;
|
|
|
|
procedure TWebSocketProtocol.SetEncryptKey(aServer: boolean; const aKey: RawUTF8);
|
|
var key: TSHA256Digest;
|
|
begin
|
|
if aKey='' then
|
|
fEncryption := nil else begin
|
|
fEncryption := TECDHEProtocol.FromKey(aKey,aServer);
|
|
if fEncryption=nil then begin
|
|
SHA256Weak(aKey,key); // fallback to TProtocolAES/TAESCFB
|
|
SetEncryptKeyAES(key,256);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TWebSocketProtocol.SetEncryptKeyAES(const aKey; aKeySize: cardinal);
|
|
begin
|
|
if aKeySize>=128 then
|
|
fEncryption := TProtocolAES.Create(
|
|
TAESCFB,aKey,aKeySize,WebSocketsIVReplayAttackCheck);
|
|
end;
|
|
|
|
procedure TWebSocketProtocol.AfterGetFrame(var frame: TWebSocketFrame);
|
|
begin
|
|
inc(fFramesInCount);
|
|
inc(fFramesInBytes,length(frame.payload)+2);
|
|
end;
|
|
|
|
procedure TWebSocketProtocol.BeforeSendFrame(var frame: TWebSocketFrame);
|
|
begin
|
|
inc(fFramesOutCount);
|
|
inc(fFramesOutBytes,length(frame.payload)+2);
|
|
end;
|
|
|
|
function TWebSocketProtocol.FrameData(const frame: TWebSocketFrame;
|
|
const Head: RawUTF8; HeadFound: PRawUTF8): pointer;
|
|
begin
|
|
result := nil; // no frame type by default
|
|
end;
|
|
|
|
function TWebSocketProtocol.FrameType(
|
|
const frame: TWebSocketFrame): RawUTF8;
|
|
begin
|
|
result := '*'; // no frame URI by default
|
|
end;
|
|
|
|
function TWebSocketProtocol.ProcessHandshake(const ExtIn: TRawUTF8DynArray;
|
|
out ExtOut: RawUTF8; ErrorMsg: PRawUTF8): boolean;
|
|
var res: TProtocolResult;
|
|
msgin,msgout: RawUTF8;
|
|
synhk: boolean;
|
|
i: integer;
|
|
begin
|
|
result := fEncryption=nil;
|
|
if result then
|
|
exit; // nothing to handshake for -> try to continue
|
|
synhk := false;
|
|
if ExtIn<>nil then begin
|
|
for i := 0 to length(ExtIn)-1 do
|
|
if IdemPropNameU(ExtIn[i],'synhk') then
|
|
synhk := true else
|
|
if synhk and IdemPChar(pointer(ExtIn[i]),'HK=') then begin
|
|
msgin := copy(ExtIn[i],4,maxInt);
|
|
break;
|
|
end;
|
|
if (msgin='') or not synhk then
|
|
exit;
|
|
end;
|
|
res := fEncryption.ProcessHandshake(msgin,msgout);
|
|
case res of
|
|
sprSuccess: begin
|
|
AddToCSV('synhk; hk='+msgout,ExtOut,'; ');
|
|
result := true;
|
|
exit;
|
|
end;
|
|
sprUnsupported:
|
|
if not synhk then begin
|
|
result := true; // try to continue execution
|
|
exit;
|
|
end;
|
|
end;
|
|
WebSocketLog.Add.Log(sllWarning,'ProcessHandshake=% In=[%]',[ToText(res)^,msgin],self);
|
|
if ErrorMsg<>nil then
|
|
ErrorMsg^ := FormatUTF8('%: %',[ErrorMsg^,
|
|
GetCaptionFromEnum(TypeInfo(TProtocolResult),ord(res))]);
|
|
end;
|
|
|
|
function TWebSocketProtocol.ProcessURI(const aClientURI: RawUTF8): boolean;
|
|
begin
|
|
result := true; // override and return false to return STATUS_UNAUTHORIZED
|
|
end;
|
|
|
|
function TWebSocketProtocol.SendFrames(Owner: TWebSocketProcess;
|
|
var Frames: TWebSocketFrameDynArray; var FramesCount: integer): boolean;
|
|
var i,n: integer;
|
|
begin // this default implementation will send all frames one by one
|
|
n := FramesCount;
|
|
if (n>0) and (Owner<>nil) then begin
|
|
result := false;
|
|
FramesCount := 0;
|
|
for i := 0 to n-1 do
|
|
if Owner.SendFrame(Frames[i]) then
|
|
Frames[i].payload := '' else
|
|
exit;
|
|
end;
|
|
result := true;
|
|
end;
|
|
|
|
function TWebSocketProtocol.GetEncrypted: boolean;
|
|
begin
|
|
result := (self<>nil) and (fEncryption<>nil);
|
|
end;
|
|
|
|
function TWebSocketProtocol.GetSubprotocols: RawUTF8;
|
|
begin
|
|
result := fName;
|
|
end;
|
|
|
|
function TWebSocketProtocol.SetSubprotocol(const aProtocolName: RawUTF8): boolean;
|
|
begin
|
|
result := IdemPropNameU(aProtocolName,fName);
|
|
end;
|
|
|
|
function TWebSocketProtocol.GetRemoteIP: SockString;
|
|
begin
|
|
if (self = nil) or fRemoteLocalhost then
|
|
result := '' else
|
|
result := fRemoteIP;
|
|
end;
|
|
|
|
|
|
{ TWebSocketFrameList }
|
|
|
|
constructor TWebSocketFrameList.Create(timeoutsec: integer);
|
|
begin
|
|
inherited Create;
|
|
fTimeoutSec := timeoutsec;
|
|
end;
|
|
|
|
function TWebSocketFrameList.AnswerToIgnore(incr: integer): integer;
|
|
begin
|
|
Safe^.Lock;
|
|
if incr<>0 then
|
|
inc(Safe^.Padding[0].VInteger,incr);
|
|
result := Safe^.Padding[0].VInteger;
|
|
Safe^.UnLock;
|
|
end;
|
|
|
|
function TWebSocketFrameList.Pop(protocol: TWebSocketProtocol; const head: RawUTF8;
|
|
out frame: TWebSocketFrame): boolean;
|
|
var i: integer;
|
|
tix: cardinal;
|
|
item: PWebSocketFrame;
|
|
begin
|
|
result := false;
|
|
if (self=nil) or (Count=0) or (head='') or (protocol=nil) then
|
|
exit;
|
|
if fTimeoutSec=0 then
|
|
tix := 0 else
|
|
tix := {$ifdef FPCLINUX}SynFPCLinux.{$endif}GetTickCount64 shr 10;
|
|
Safe.Lock;
|
|
try
|
|
for i := Count-1 downto 0 do begin
|
|
item := @List[i];
|
|
if protocol.FrameData(item^,head)<>nil then begin
|
|
result := true;
|
|
frame := item^;
|
|
Delete(i);
|
|
exit;
|
|
end else
|
|
if (tix>0) and (tix>item^.tix) then
|
|
Delete(i);
|
|
end;
|
|
finally
|
|
Safe.UnLock;
|
|
end;
|
|
end;
|
|
|
|
procedure TWebSocketFrameList.Push(const frame: TWebSocketFrame);
|
|
begin
|
|
if self=nil then
|
|
exit;
|
|
Safe.Lock;
|
|
try
|
|
if Count>=length(List) then
|
|
SetLength(List,Count+Count shr 3+8);
|
|
List[Count] := frame;
|
|
if fTimeoutSec>0 then
|
|
List[Count].tix := fTimeoutSec+
|
|
({$ifdef FPCLINUX}SynFPCLinux.{$endif}GetTickCount64 shr 10);
|
|
inc(Count);
|
|
finally
|
|
Safe.UnLock;
|
|
end;
|
|
end;
|
|
|
|
procedure TWebSocketFrameList.PushVoidFrame(opcode: TWebSocketFrameOpCode);
|
|
var frame: TWebSocketFrame;
|
|
begin
|
|
frame.opcode := opcode;
|
|
frame.content := [];
|
|
Push(frame);
|
|
end;
|
|
|
|
procedure TWebSocketFrameList.Delete(i: integer);
|
|
begin // faster than a TDynArray which will release the memory
|
|
List[i].payload := '';
|
|
dec(Count);
|
|
if i<Count then begin
|
|
MoveFast(List[i+1],List[i],(Count-i)*sizeof(List[i]));
|
|
pointer(List[Count].payload) := nil;
|
|
end;
|
|
end;
|
|
|
|
|
|
{ TWebSocketProtocolChat }
|
|
|
|
constructor TWebSocketProtocolChat.Create(const aName, aURI: RawUTF8;
|
|
const aOnIncomingFrame: TOnWebSocketProtocolChatIncomingFrame);
|
|
begin
|
|
inherited Create(aName,aURI);
|
|
fOnIncomingFrame := aOnIncomingFrame;
|
|
end;
|
|
|
|
function TWebSocketProtocolChat.Clone(const aClientURI: RawUTF8): TWebSocketProtocol;
|
|
begin
|
|
result := TWebSocketProtocolChat.Create(fName,fURI);
|
|
if fEncryption<>nil then
|
|
result.fEncryption := fEncryption.Clone;
|
|
TWebSocketProtocolChat(result).OnIncomingFrame := OnIncomingFrame;
|
|
end;
|
|
|
|
procedure TWebSocketProtocolChat.ProcessIncomingFrame(Sender: TWebSocketProcess;
|
|
var request: TWebSocketFrame; const info: RawUTF8);
|
|
begin
|
|
if Assigned(OnInComingFrame) then
|
|
try
|
|
if Sender.InheritsFrom(TWebSocketProcessServer) then
|
|
OnIncomingFrame(TWebSocketProcessServer(Sender).fServerResp,request) else
|
|
OnIncomingFrame(nil,request);
|
|
except
|
|
// ignore any exception in the callback
|
|
end;
|
|
end;
|
|
|
|
function TWebSocketProtocolChat.SendFrame(Sender: THttpServerResp;
|
|
const frame: TWebSocketFrame): boolean;
|
|
var tmp: TWebSocketFrame; // SendFrame() may change frame content (e.g. mask)
|
|
begin
|
|
result := false;
|
|
if (self=nil) or (Sender=nil) or Sender.Terminated or
|
|
not (Frame.opcode in [focText,focBinary]) or
|
|
((Sender.Server as TWebSocketServer).IsActiveWebSocketThread(Sender)<>Sender) then
|
|
exit;
|
|
tmp.opcode := frame.opcode;
|
|
tmp.content := frame.content;
|
|
SetString(tmp.payload,PAnsiChar(Pointer(frame.payload)),length(frame.payload));
|
|
result := (Sender as TWebSocketServerResp).fProcess.SendFrame(tmp)
|
|
end;
|
|
|
|
function TWebSocketProtocolChat.SendFrameJson(Sender: THttpServerResp;
|
|
var JSON: RawUTF8): boolean;
|
|
var frame: TWebSocketFrame;
|
|
begin
|
|
result := false;
|
|
if (self=nil) or (Sender=nil) or Sender.Terminated or
|
|
((Sender.Server as TWebSocketServer).IsActiveWebSocketThread(Sender)<>Sender) then
|
|
exit;
|
|
frame.opcode := focText;
|
|
frame.content := [];
|
|
frame.payload := JSON;
|
|
result := (Sender as TWebSocketServerResp).fProcess.SendFrame(frame)
|
|
end;
|
|
|
|
|
|
{ TWebSocketProtocolRest }
|
|
|
|
procedure TWebSocketProtocolRest.ProcessIncomingFrame(Sender: TWebSocketProcess;
|
|
var request: TWebSocketFrame; const info: RawUTF8);
|
|
var Ctxt: THttpServerRequest;
|
|
onRequest: TOnHttpServerRequest;
|
|
status: cardinal;
|
|
noAnswer: boolean;
|
|
answer: TWebSocketFrame;
|
|
head: RawUTF8;
|
|
begin
|
|
if not (request.opcode in [focText,focBinary]) then
|
|
exit; // ignore e.g. from TWebSocketServerResp.ProcessStart/ProcessStop
|
|
if FrameData(request,'r',@head)<>nil then
|
|
try
|
|
Ctxt := Sender.ComputeContext(onRequest);
|
|
try
|
|
if (Ctxt=nil) or not Assigned(onRequest) then
|
|
raise EWebSockets.CreateUTF8('%.ProcessOne: onRequest=nil',[self]);
|
|
if (head='') or not FrameToInput(request,noAnswer,Ctxt) then
|
|
raise EWebSockets.CreateUTF8('%.ProcessOne: invalid frame',[self]);
|
|
request.payload := ''; // release memory ASAP
|
|
if info<>'' then
|
|
Ctxt.AddInHeader(info);
|
|
status := onRequest(Ctxt); // blocking call to compute the answer
|
|
if (Ctxt.OutContentType=HTTP_RESP_NORESPONSE) or noAnswer then
|
|
exit;
|
|
OutputToFrame(Ctxt,status,head,answer);
|
|
if not Sender.SendFrame(answer) then
|
|
fLastError := UTF8ToString(FormatUTF8('SendFrame error %',[Sender]));
|
|
finally
|
|
Ctxt.Free;
|
|
end;
|
|
except
|
|
on E: Exception do
|
|
FormatString('% [%]',[E.ClassName,E.Message],fLastError);
|
|
end else
|
|
if (Sender.fIncoming.AnswerToIgnore>0) and (FrameData(request,'answer')<>nil) then begin
|
|
Sender.fIncoming.AnswerToIgnore(-1);
|
|
Sender.Log(request,'Ignored answer after NotifyCallback TIMEOUT',sllWarning);
|
|
end else
|
|
Sender.fIncoming.Push(request); // e.g. asynch 'answer'
|
|
end;
|
|
|
|
// by convention, defaults are POST and JSON, to reduce frame size for SOA calls
|
|
|
|
procedure TWebSocketProtocolRest.InputToFrame(Ctxt: THttpServerRequest;
|
|
aNoAnswer: boolean; out request: TWebSocketFrame; out head: RawUTF8);
|
|
var Method,InContentType: RawByteString;
|
|
seq: integer;
|
|
begin
|
|
if not IdemPropNameU(Ctxt.Method,'POST') then
|
|
Method := Ctxt.Method;
|
|
if (Ctxt.InContent<>'') and (Ctxt.InContentType<>'') and
|
|
not IdemPropNameU(Ctxt.InContentType,JSON_CONTENT_TYPE) then
|
|
InContentType := Ctxt.InContentType;
|
|
if fSequencing then begin
|
|
seq := InterlockedIncrement(fSequence);
|
|
SetLength(head,7); // safe overlap after 16,777,216 frames
|
|
PAnsiChar(pointer(head))^ := 'r';
|
|
BinToHexDisplay(@seq,PAnsiChar(pointer(head))+1,3);
|
|
end else
|
|
head := 'request';
|
|
FrameCompress(head,[Method,Ctxt.URL,Ctxt.InHeaders,ord(aNoAnswer)],
|
|
Ctxt.InContent,InContentType,request);
|
|
if fSequencing then
|
|
head[1] := 'a' else
|
|
head := 'answer';
|
|
end;
|
|
|
|
function TWebSocketProtocolRest.FrameToInput(var request: TWebSocketFrame;
|
|
out aNoAnswer: boolean; Ctxt: THttpServerRequest): boolean;
|
|
var URL,Method,InHeaders,NoAnswer,InContentType,InContent: RawByteString;
|
|
begin
|
|
result := FrameDecompress(request,'r',[@Method,@URL,@InHeaders,@NoAnswer],
|
|
InContentType,InContent);
|
|
if result then begin
|
|
if (InContentType='') and (InContent<>'') then
|
|
InContentType := JSON_CONTENT_TYPE_VAR;
|
|
if Method='' then
|
|
Method := 'POST';
|
|
Ctxt.Prepare(URL,Method,InHeaders,InContent,InContentType,fRemoteIP,Ctxt.UseSSL);
|
|
aNoAnswer := NoAnswer='1';
|
|
end;
|
|
end;
|
|
|
|
procedure TWebSocketProtocolRest.OutputToFrame(Ctxt: THttpServerRequest;
|
|
Status: Cardinal; var outhead: RawUTF8; out answer: TWebSocketFrame);
|
|
var OutContentType: RawByteString;
|
|
begin
|
|
if (Ctxt.OutContent<>'') and
|
|
not IdemPropNameU(Ctxt.OutContentType,JSON_CONTENT_TYPE) then
|
|
OutContentType := Ctxt.OutContentType;
|
|
if NormToUpperAnsi7[outhead[3]]='Q' then
|
|
outhead := 'answer' else // 'request' -> 'answer'
|
|
outhead[1] := 'a'; // 'r000001' -> 'a000001'
|
|
FrameCompress(outhead,[Status,Ctxt.OutCustomHeaders],
|
|
Ctxt.OutContent,OutContentType,answer);
|
|
end;
|
|
|
|
function TWebSocketProtocolRest.FrameToOutput(
|
|
var answer: TWebSocketFrame; Ctxt: THttpServerRequest): cardinal;
|
|
var status,outHeaders,outContentType,outContent: RawByteString;
|
|
begin
|
|
result := STATUS_NOTFOUND;
|
|
if not FrameDecompress(answer,'a',[@status,@outHeaders],outContentType,outContent) then
|
|
exit;
|
|
result := GetInteger(pointer(status));
|
|
Ctxt.OutCustomHeaders := outHeaders;
|
|
if (outContentType='') and (outContent<>'') then
|
|
Ctxt.OutContentType := JSON_CONTENT_TYPE_VAR else
|
|
Ctxt.OutContentType := outContentType;
|
|
Ctxt.OutContent := outContent;
|
|
end;
|
|
|
|
|
|
{ TWebSocketProtocolJSON }
|
|
|
|
constructor TWebSocketProtocolJSON.Create(const aURI: RawUTF8);
|
|
begin
|
|
inherited Create('synopsejson',aURI);
|
|
end;
|
|
|
|
function TWebSocketProtocolJSON.Clone(const aClientURI: RawUTF8): TWebSocketProtocol;
|
|
begin
|
|
result := TWebSocketProtocolJSON.Create(fURI);
|
|
end;
|
|
|
|
procedure TWebSocketProtocolJSON.FrameCompress(const Head: RawUTF8;
|
|
const Values: array of const; const Content, ContentType: RawByteString;
|
|
var frame: TWebSocketFrame);
|
|
var WR: TTextWriter;
|
|
tmp: TTextWriterStackBuffer;
|
|
i: integer;
|
|
begin
|
|
frame.opcode := focText;
|
|
frame.content := [];
|
|
WR := TTextWriter.CreateOwnedStream(tmp);
|
|
try
|
|
WR.Add('{');
|
|
WR.AddFieldName(Head);
|
|
WR.Add('[');
|
|
for i := 0 to High(Values) do begin
|
|
WR.AddJSONEscape(Values[i]);
|
|
WR.Add(',');
|
|
end;
|
|
WR.Add('"');
|
|
WR.AddString(ContentType);
|
|
WR.Add('"',',');
|
|
if Content='' then
|
|
WR.Add('"','"') else
|
|
if (ContentType='') or
|
|
IdemPropNameU(ContentType,JSON_CONTENT_TYPE) then
|
|
WR.AddNoJSONEscape(pointer(Content),length(Content)) else
|
|
if IdemPChar(pointer(ContentType),'TEXT/') then
|
|
WR.AddCSVUTF8([Content]) else
|
|
WR.WrBase64(pointer(Content),length(Content),true);
|
|
WR.Add(']','}');
|
|
WR.SetText(RawUTF8(frame.payload));
|
|
finally
|
|
WR.Free;
|
|
end;
|
|
end;
|
|
|
|
function TWebSocketProtocolJSON.FrameData(const frame: TWebSocketFrame;
|
|
const Head: RawUTF8; HeadFound: PRawUTF8): pointer;
|
|
var P,txt: PUTF8Char;
|
|
len: integer;
|
|
begin
|
|
result := nil;
|
|
if (length(frame.payload)<10) or (frame.opcode<>focText) then
|
|
exit;
|
|
P := pointer(frame.payload);
|
|
if not NextNotSpaceCharIs(P,'{') then
|
|
exit;
|
|
while P^<>'"' do begin
|
|
inc(P);
|
|
if P^=#0 then exit;
|
|
end;
|
|
txt := P+1;
|
|
P := GotoEndOfJSONString(P); // here P^ should be '"'
|
|
len := length(Head);
|
|
if (P^<>#0) and (P-txt>=len) and CompareMem(pointer(Head),txt,len) then begin
|
|
result := P+1;
|
|
if HeadFound<>nil then
|
|
SetString(HeadFound^,txt,P-txt);
|
|
end;
|
|
end;
|
|
|
|
function TWebSocketProtocolJSON.FrameDecompress(
|
|
const frame: TWebSocketFrame; const Head: RawUTF8;
|
|
const values: array of PRawByteString;
|
|
var contentType,content: RawByteString): Boolean;
|
|
var i: Integer;
|
|
P: PUTF8Char;
|
|
b64: PUTF8Char;
|
|
b64len: integer;
|
|
procedure GetNext(var content: RawByteString);
|
|
var txt: PUTF8Char;
|
|
txtlen: integer;
|
|
begin
|
|
txt := GetJSONField(P,P,nil,nil,@txtlen);
|
|
SetString(content,txt,txtlen);
|
|
end;
|
|
begin
|
|
result := false;
|
|
P := FrameData(frame,Head);
|
|
if P=nil then
|
|
exit;
|
|
if not NextNotSpaceCharIs(P,':') or
|
|
not NextNotSpaceCharIs(P,'[') then
|
|
exit;
|
|
for i := 0 to high(values) do
|
|
GetNext(values[i]^);
|
|
GetNext(contentType);
|
|
if P=nil then
|
|
exit;
|
|
if (contentType='') or IdemPropNameU(contentType,JSON_CONTENT_TYPE) then
|
|
GetJSONItemAsRawJSON(P,RawJSON(content)) else
|
|
if IdemPChar(pointer(contentType),'TEXT/') then
|
|
GetNext(content) else begin
|
|
b64 := GetJSONField(P,P,nil,nil,@b64len);
|
|
if not Base64MagicCheckAndDecode(b64,b64len,content) then
|
|
exit;
|
|
end;
|
|
result := true;
|
|
end;
|
|
|
|
function TWebSocketProtocolJSON.FrameType(
|
|
const frame: TWebSocketFrame): RawUTF8;
|
|
var P,txt: PUTF8Char;
|
|
begin
|
|
result := '*';
|
|
if (length(frame.payload)<10) or (frame.opcode<>focText) then
|
|
exit;
|
|
P := pointer(frame.payload);
|
|
if not NextNotSpaceCharIs(P,'{') or
|
|
not NextNotSpaceCharIs(P,'"') then
|
|
exit;
|
|
txt := P;
|
|
P := GotoEndOfJSONString(P);
|
|
SetString(result,txt,P-Txt);
|
|
end;
|
|
|
|
|
|
{ TWebSocketProtocolBinary }
|
|
|
|
constructor TWebSocketProtocolBinary.Create(const aURI: RawUTF8;
|
|
aCompressed: boolean);
|
|
begin
|
|
inherited Create('synopsebin',aURI);
|
|
fCompressed := aCompressed;
|
|
end;
|
|
|
|
constructor TWebSocketProtocolBinary.Create(const aURI: RawUTF8;
|
|
const aKey; aKeySize: cardinal; aCompressed: boolean);
|
|
begin
|
|
Create(aURI,aCompressed);
|
|
SetEncryptKeyAES(aKey, aKeySize);
|
|
end;
|
|
|
|
constructor TWebSocketProtocolBinary.Create(const aURI: RawUTF8;
|
|
aServer: boolean; const aKey: RawUTF8; aCompressed: boolean);
|
|
begin
|
|
Create(aURI,aCompressed);
|
|
SetEncryptKey(aServer,aKey);
|
|
end;
|
|
|
|
function TWebSocketProtocolBinary.Clone(const aClientURI: RawUTF8): TWebSocketProtocol;
|
|
begin
|
|
result := TWebSocketProtocolBinary.Create(fURI,{dummykey=}self,0,fCompressed);
|
|
TWebSocketProtocolBinary(result).fSequencing := fSequencing;
|
|
if fEncryption<>nil then
|
|
result.fEncryption := fEncryption.Clone;
|
|
end;
|
|
|
|
const
|
|
FRAME_HEAD_SEP = #1;
|
|
|
|
procedure FrameInit(opcode: TWebSocketFrameOpCode; const Content, ContentType: RawByteString;
|
|
out frame: TWebSocketFrame);
|
|
begin
|
|
frame.opcode := opcode;
|
|
if (ContentType<>'') and (Content<>'') and
|
|
not IdemPChar(pointer(ContentType),'TEXT/') and
|
|
IsContentCompressed(pointer(Content),length(Content)) then
|
|
frame.content := [fopAlreadyCompressed] else
|
|
frame.content := [];
|
|
end;
|
|
|
|
procedure TWebSocketProtocolBinary.FrameCompress(const Head: RawUTF8;
|
|
const Values: array of const; const Content, ContentType: RawByteString;
|
|
var frame: TWebSocketFrame);
|
|
var item: RawUTF8;
|
|
i: integer;
|
|
W: TFileBufferWriter;
|
|
begin
|
|
FrameInit(focBinary,Content,ContentType,frame);
|
|
W := TFileBufferWriter.Create(TRawByteStringStream);
|
|
try
|
|
W.WriteBinary(Head);
|
|
W.Write1(byte(FRAME_HEAD_SEP));
|
|
for i := 0 to high(Values) do
|
|
with Values[i] do begin
|
|
VarRecToUTF8(Values[i],item);
|
|
W.Write(item);
|
|
end;
|
|
W.Write(ContentType);
|
|
W.WriteBinary(Content);
|
|
W.Flush;
|
|
frame.payload := TRawByteStringStream(W.Stream).DataString;
|
|
finally
|
|
W.Free;
|
|
end;
|
|
end;
|
|
|
|
function TWebSocketProtocolBinary.FrameData(const frame: TWebSocketFrame;
|
|
const Head: RawUTF8; HeadFound: PRawUTF8): pointer;
|
|
var len: integer;
|
|
P: PAnsiChar;
|
|
begin
|
|
P := pointer(frame.payload);
|
|
len := length(Head);
|
|
if (frame.opcode=focBinary) and (length(frame.payload)>=len+6) and
|
|
CompareMemSmall(pointer(Head),P,len) then begin
|
|
result := PosChar(PUTF8Char(P)+len,FRAME_HEAD_SEP);
|
|
if result<>nil then begin
|
|
if HeadFound<>nil then
|
|
SetString(HeadFound^,P,PAnsiChar(result)-P);
|
|
inc(PByte(result));
|
|
end;
|
|
end else
|
|
result := nil;
|
|
end;
|
|
|
|
function TWebSocketProtocolBinary.FrameType(
|
|
const frame: TWebSocketFrame): RawUTF8;
|
|
var i: integer;
|
|
begin
|
|
if (length(frame.payload)<10) or (frame.opcode<>focBinary) then
|
|
i := 0 else
|
|
i := PosExChar(FRAME_HEAD_SEP,frame.payload);
|
|
if i=0 then
|
|
result := '*' else
|
|
result := copy(frame.payload,1,i-1);
|
|
end;
|
|
|
|
procedure TWebSocketProtocolBinary.BeforeSendFrame(var frame: TWebSocketFrame);
|
|
var value: RawByteString;
|
|
threshold: integer;
|
|
begin
|
|
inherited BeforeSendFrame(frame);
|
|
if frame.opcode=focBinary then begin
|
|
if fCompressed then begin
|
|
if fRemoteLocalhost or (fopAlreadyCompressed in frame.content) then
|
|
threshold := maxInt else // localhost or compressed -> no SynLZ
|
|
threshold := WebSocketsBinarySynLzThreshold;
|
|
SynLZCompress(pointer(frame.payload),length(frame.payload),value,threshold);
|
|
end else
|
|
value := frame.payload;
|
|
if fEncryption<>nil then
|
|
fEncryption.Encrypt(value,frame.payload) else
|
|
frame.payload := value;
|
|
end;
|
|
inc(fFramesOutBytesSocket,length(frame.payload)+2);
|
|
end;
|
|
|
|
procedure TWebSocketProtocolBinary.AfterGetFrame(var frame: TWebSocketFrame);
|
|
var value: RawByteString;
|
|
res: TProtocolResult;
|
|
begin
|
|
inc(fFramesInBytesSocket,length(frame.payload)+2);
|
|
if frame.opcode=focBinary then begin
|
|
if fEncryption<>nil then begin
|
|
res := fEncryption.Decrypt(frame.payload,value);
|
|
if res<>sprSuccess then
|
|
raise EWebSockets.CreateUTF8('%.AfterGetFrame: encryption error %',
|
|
[self,ToText(res)^]);
|
|
end else
|
|
value := frame.payload;
|
|
if fCompressed then
|
|
SynLZDecompress(pointer(value),length(value),frame.payload) else
|
|
frame.payload := value;
|
|
end;
|
|
inherited AfterGetFrame(frame);
|
|
end;
|
|
|
|
function TWebSocketProtocolBinary.FrameDecompress(const frame: TWebSocketFrame;
|
|
const Head: RawUTF8; const values: array of PRawByteString;
|
|
var contentType,content: RawByteString): Boolean;
|
|
var i: integer;
|
|
P: PByte;
|
|
begin
|
|
result := false;
|
|
P := FrameData(frame,Head);
|
|
if P=nil then
|
|
exit;
|
|
for i := 0 to high(values) do
|
|
values[i]^ := FromVarString(P);
|
|
contentType := FromVarString(P);
|
|
i := length(frame.payload)-(PAnsiChar(P)-pointer(frame.payload));
|
|
if i<0 then
|
|
exit;
|
|
SetString(content,PAnsiChar(P),i);
|
|
result := true;
|
|
end;
|
|
|
|
function TWebSocketProtocolBinary.SendFrames(Owner: TWebSocketProcess;
|
|
var Frames: TWebSocketFrameDynArray; var FramesCount: integer): boolean;
|
|
const JUMBO_HEADER: array[0..6] of AnsiChar = 'frames'+FRAME_HEAD_SEP;
|
|
var jumboFrame: TWebSocketFrame;
|
|
i, len: integer;
|
|
P: PByte;
|
|
begin
|
|
if (FramesCount=0) or (Owner=nil) then begin
|
|
result := true;
|
|
exit;
|
|
end;
|
|
dec(FramesCount);
|
|
if FramesCount=0 then begin
|
|
result := Owner.SendFrame(Frames[0]);
|
|
exit;
|
|
end;
|
|
jumboFrame.opcode := focBinary;
|
|
jumboFrame.content := [];
|
|
len := sizeof(JUMBO_HEADER)+ToVarUInt32Length(FramesCount);
|
|
for i := 0 to FramesCount do
|
|
if Frames[i].opcode=focBinary then
|
|
inc(len,ToVarUInt32LengthWithData(length(Frames[i].payload))) else
|
|
raise EWebSockets.CreateUTF8('%.SendFrames[%]: Unexpected opcode=%',
|
|
[self,i,ord(Frames[i].opcode)]);
|
|
SetString(jumboframe.payload,nil,len);
|
|
P := pointer(jumboframe.payload);
|
|
MoveFast(JUMBO_HEADER,P^,SizeOf(JUMBO_HEADER));
|
|
inc(P,SizeOf(JUMBO_HEADER));
|
|
P := ToVarUInt32(FramesCount,P);
|
|
for i := 0 to FramesCount do begin
|
|
len := length(Frames[i].payload);
|
|
P := ToVarUInt32(len,P);
|
|
MoveFast(pointer(Frames[i].payload)^,P^,len);
|
|
inc(P,len);
|
|
end;
|
|
FramesCount := 0;
|
|
Frames := nil;
|
|
result := Owner.SendFrame(jumboFrame); // send all frames at once
|
|
end;
|
|
|
|
procedure TWebSocketProtocolBinary.ProcessIncomingFrame(Sender: TWebSocketProcess;
|
|
var request: TWebSocketFrame; const info: RawUTF8);
|
|
var jumboInfo: RawByteString;
|
|
n,i: integer;
|
|
frame: TWebSocketFrame;
|
|
P: PByte;
|
|
begin
|
|
P := FrameData(request,'frames');
|
|
if P<>nil then begin
|
|
n := FromVarUInt32(P);
|
|
for i := 0 to n do begin
|
|
if i=0 then
|
|
jumboInfo:= 'Sec-WebSocket-Frame: [0]' else
|
|
if i=n then
|
|
jumboInfo := 'Sec-WebSocket-Frame: [1]' else
|
|
jumboInfo := '';
|
|
frame.opcode := focBinary;
|
|
frame.content := [];
|
|
frame.payload := FromVarString(P);
|
|
Sender.Log(frame,FormatUTF8('GetSubFrame(%/%)',[i+1,n+1]));
|
|
inherited ProcessIncomingFrame(Sender,frame,jumboInfo);
|
|
end;
|
|
end else
|
|
inherited ProcessIncomingFrame(Sender,request,info);
|
|
end;
|
|
|
|
function TWebSocketProtocolBinary.GetFramesInCompression: integer;
|
|
begin
|
|
if (self=nil) or (fFramesInBytes=0) then
|
|
result := 100 else
|
|
if not fCompressed or (fFramesInBytesSocket<fFramesInBytes) then
|
|
result := 0 else
|
|
result := 100-(fFramesInBytesSocket*100) div fFramesInBytes;
|
|
end;
|
|
|
|
function TWebSocketProtocolBinary.GetFramesOutCompression: integer;
|
|
begin
|
|
if (self=nil) or (fFramesOutBytes=0) then
|
|
result := 100 else
|
|
if not fCompressed or (fFramesOutBytesSocket<=fFramesOutBytes) then
|
|
result := 0 else
|
|
result := 100-(fFramesOutBytesSocket*100) div fFramesOutBytes;
|
|
end;
|
|
|
|
function TWebSocketProtocolBinary.GetSubprotocols: RawUTF8;
|
|
begin
|
|
result := 'synopsebin, synopsebinary';
|
|
end;
|
|
|
|
function TWebSocketProtocolBinary.SetSubprotocol(
|
|
const aProtocolName: RawUTF8): boolean;
|
|
begin
|
|
case FindPropName(['synopsebin', 'synopsebinary'], aProtocolName) of
|
|
0: fSequencing := true;
|
|
1: fSequencing := false;
|
|
else begin
|
|
result := false;
|
|
exit;
|
|
end;
|
|
end;
|
|
result := true;
|
|
end;
|
|
|
|
|
|
{ TWebSocketProtocolList }
|
|
|
|
function TWebSocketProtocolList.CloneByName(
|
|
const aProtocolName, aClientURI: RawUTF8): TWebSocketProtocol;
|
|
var i: Integer;
|
|
begin
|
|
result := nil;
|
|
if self=nil then
|
|
exit;
|
|
fSafe.Lock;
|
|
try
|
|
for i := 0 to length(fProtocols)-1 do
|
|
with fProtocols[i] do
|
|
if ((fURI='') or IdemPropNameU(fURI,aClientURI)) and
|
|
SetSubprotocol(aProtocolName) then begin
|
|
result := fProtocols[i].Clone(aClientURI);
|
|
result.fName := aProtocolName;
|
|
exit;
|
|
end;
|
|
finally
|
|
fSafe.UnLock;
|
|
end;
|
|
end;
|
|
|
|
function TWebSocketProtocolList.CloneByURI(const aClientURI: RawUTF8): TWebSocketProtocol;
|
|
var i: integer;
|
|
begin
|
|
result := nil;
|
|
if (self=nil) or (aClientURI='') then
|
|
exit;
|
|
fSafe.Lock;
|
|
try
|
|
for i := 0 to length(fProtocols)-1 do
|
|
if IdemPropNameU(fProtocols[i].fURI,aClientURI) then begin
|
|
result := fProtocols[i].Clone(aClientURI);
|
|
exit;
|
|
end;
|
|
finally
|
|
fSafe.UnLock;
|
|
end;
|
|
end;
|
|
|
|
function TWebSocketProtocolList.Count: integer;
|
|
begin
|
|
if self=nil then
|
|
result := 0 else
|
|
result := length(fProtocols);
|
|
end;
|
|
|
|
destructor TWebSocketProtocolList.Destroy;
|
|
begin
|
|
ObjArrayClear(fProtocols);
|
|
inherited;
|
|
end;
|
|
|
|
function TWebSocketProtocolList.FindIndex(const aName,aURI: RawUTF8): integer;
|
|
begin
|
|
if aName<>'' then
|
|
for result := 0 to high(fProtocols) do
|
|
with fProtocols[result] do
|
|
if IdemPropNameU(fName,aName) and
|
|
((fURI='') or IdemPropNameU(fURI,aURI)) then
|
|
exit;
|
|
result := -1;
|
|
end;
|
|
|
|
function TWebSocketProtocolList.Add(aProtocol: TWebSocketProtocol): boolean;
|
|
var i: Integer;
|
|
begin
|
|
result := false;
|
|
if aProtocol=nil then
|
|
exit;
|
|
fSafe.Lock;
|
|
try
|
|
i := FindIndex(aProtocol.Name,aProtocol.URI);
|
|
if i<0 then begin
|
|
ObjArrayAdd(fProtocols,aProtocol);
|
|
result := true;
|
|
end;
|
|
finally
|
|
fSafe.UnLock;
|
|
end;
|
|
end;
|
|
|
|
function TWebSocketProtocolList.AddOnce(aProtocol: TWebSocketProtocol): boolean;
|
|
var i: Integer;
|
|
begin
|
|
result := false;
|
|
if aProtocol=nil then
|
|
exit;
|
|
fSafe.Lock;
|
|
try
|
|
i := FindIndex(aProtocol.Name,aProtocol.URI);
|
|
if i<0 then begin
|
|
ObjArrayAdd(fProtocols,aProtocol);
|
|
result := true;
|
|
end else begin
|
|
fProtocols[i].Free;
|
|
fProtocols[i] := aProtocol;
|
|
end;
|
|
finally
|
|
fSafe.UnLock;
|
|
end;
|
|
end;
|
|
|
|
function TWebSocketProtocolList.Remove(const aProtocolName,aURI: RawUTF8): Boolean;
|
|
var i: Integer;
|
|
begin
|
|
fSafe.Lock;
|
|
try
|
|
i := FindIndex(aProtocolName,aURI);
|
|
if i>=0 then begin
|
|
ObjArrayDelete(fProtocols,i);
|
|
result := true;
|
|
end else
|
|
result := false;
|
|
finally
|
|
fSafe.UnLock;
|
|
end;
|
|
end;
|
|
|
|
|
|
{ TWebSocketProcess }
|
|
|
|
constructor TWebSocketProcess.Create(aProtocol: TWebSocketProtocol;
|
|
aOwnerConnection: THttpServerConnectionID; aOwnerThread: TSynThread;
|
|
const aSettings: TWebSocketProcessSettings; const aProcessName: RawUTF8);
|
|
begin
|
|
inherited Create;
|
|
fProcessName := aProcessName;
|
|
fProtocol := aProtocol;
|
|
fOwnerConnection := aOwnerConnection;
|
|
fOwnerThread := aOwnerThread;
|
|
fSettings := aSettings;
|
|
fIncoming := TWebSocketFrameList.Create(30*60);
|
|
fOutgoing := TWebSocketFrameList.Create(0);
|
|
fSafeIn := NewSynLocker;
|
|
fSafeOut := NewSynLocker;
|
|
fSafePing := NewSynLocker;
|
|
end;
|
|
|
|
destructor TWebSocketProcess.Destroy;
|
|
var frame: TWebSocketFrame;
|
|
timeout: Int64;
|
|
log: ISynLog;
|
|
dummyerror: integer;
|
|
begin
|
|
log := WebSocketLog.Enter('Destroy %',[ToText(fState)^],self);
|
|
if fState = wpsCreate then
|
|
fProcessEnded := true else
|
|
if not fNoConnectionCloseAtDestroy then begin
|
|
if log<>nil then
|
|
log.Log(sllTrace,'Destroy: notify focConnectionClose',self);
|
|
InterlockedIncrement(fProcessCount);
|
|
try
|
|
fState := wpsDestroy;
|
|
if fOutgoing.Count>0 then
|
|
SendPendingOutgoingFrames;
|
|
frame.opcode := focConnectionClose;
|
|
dummyerror := 0;
|
|
if not SendFrame(frame) or not CanGetFrame(1000,@dummyerror) or
|
|
not GetFrame(frame,@dummyerror) then
|
|
if log<>nil then // expects an answer from peer
|
|
log.Log(sllWarning,'Destroy: no focConnectionClose ACK %',[dummyerror],self);
|
|
finally
|
|
InterlockedDecrement(fProcessCount);
|
|
end;
|
|
end;
|
|
fState := wpsDestroy;
|
|
if (fProcessCount>0) or not fProcessEnded then begin
|
|
if log<>nil then
|
|
log.Log(sllDebug,'Destroy: wait for fProcessCount=%',[fProcessCount],self);
|
|
timeOut := GetTickCount64+5000;
|
|
repeat
|
|
SleepHiRes(2);
|
|
until ((fProcessCount=0) and fProcessEnded) or (GetTickCount64>timeOut);
|
|
if log<>nil then
|
|
log.Log(sllDebug,'Destroy: waited fProcessCount=%',[fProcessCount],self);
|
|
end;
|
|
fProtocol.Free;
|
|
fOutgoing.Free;
|
|
fIncoming.Free;
|
|
fSafeIn.DoneAndFreeMem;
|
|
fSafeOut.DoneAndFreeMem;
|
|
fSafePing.DoneAndFreeMem; // to be done lately to avoid GPF in above Destroy
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TWebSocketProcess.ProcessStart;
|
|
var frame: TWebSocketFrame; // notify e.g. TOnWebSocketProtocolChatIncomingFrame
|
|
begin
|
|
if Assigned(fSettings.OnClientConnected) then
|
|
try
|
|
WebSocketLog.Add.Log(sllTrace,'ProcessStart: OnClientConnected',self);
|
|
fSettings.OnClientConnected(Self);
|
|
except
|
|
end;
|
|
WebSocketLog.Add.Log(sllTrace,'ProcessStart: callbacks',self);
|
|
frame.opcode := focContinuation;
|
|
if not Assigned(fProtocol.fOnBeforeIncomingFrame) or
|
|
not fProtocol.fOnBeforeIncomingFrame(self,frame) then
|
|
fProtocol.ProcessIncomingFrame(self,frame,''); // any exception would abort
|
|
WebSocketLog.Add.Log(sllDebug,'ProcessStart %', [fProtocol],self);
|
|
end;
|
|
|
|
procedure TWebSocketProcess.ProcessStop;
|
|
var frame: TWebSocketFrame; // notify e.g. TOnWebSocketProtocolChatIncomingFrame
|
|
begin
|
|
try
|
|
WebSocketLog.Add.Log(sllTrace,'ProcessStop: callbacks',self);
|
|
frame.opcode := focConnectionClose;
|
|
if not Assigned(fProtocol.fOnBeforeIncomingFrame) or
|
|
not fProtocol.fOnBeforeIncomingFrame(self,frame) then
|
|
fProtocol.ProcessIncomingFrame(self,frame,'');
|
|
if Assigned(fSettings.OnClientDisconnected) then begin
|
|
WebSocketLog.Add.Log(sllTrace,'ProcessStop: OnClientDisconnected',self);
|
|
fSettings.OnClientDisconnected(Self);
|
|
end;
|
|
except // exceptions are just ignored at shutdown
|
|
end;
|
|
fProcessEnded := true;
|
|
WebSocketLog.Add.Log(sllDebug,'ProcessStop %', [fProtocol], self);
|
|
end;
|
|
|
|
procedure TWebSocketProcess.SetLastPingTicks(invalidPing: boolean);
|
|
var tix: Int64;
|
|
begin
|
|
tix := {$ifdef FPCLINUX}SynFPCLinux.{$endif}GetTickCount64;
|
|
fSafePing.Lock;
|
|
try
|
|
fLastSocketTicks := tix;
|
|
if invalidPing then begin
|
|
inc(fInvalidPingSendCount);
|
|
fNoConnectionCloseAtDestroy := true;
|
|
end else
|
|
fInvalidPingSendCount := 0;
|
|
finally
|
|
fSafePing.UnLock;
|
|
end;
|
|
end;
|
|
|
|
function TWebSocketProcess.LastPingDelay: Int64;
|
|
begin
|
|
result := {$ifdef FPCLINUX}SynFPCLinux.{$endif}GetTickCount64;
|
|
fSafePing.Lock;
|
|
try
|
|
dec(result,fLastSocketTicks);
|
|
finally
|
|
fSafePing.UnLock;
|
|
end;
|
|
end;
|
|
|
|
function TWebSocketProcess.ProcessLoopStepReceive: boolean;
|
|
var request: TWebSocketFrame;
|
|
sockerror: integer;
|
|
begin
|
|
if fState=wpsRun then begin
|
|
InterlockedIncrement(fProcessCount); // flag currently processing
|
|
try
|
|
if CanGetFrame({timeout=}1,@sockerror) and GetFrame(request,@sockerror) then begin
|
|
case request.opcode of
|
|
focPing: begin
|
|
request.opcode := focPong;
|
|
SendFrame(request);
|
|
end;
|
|
focPong:
|
|
; // nothing to do
|
|
focText,focBinary:
|
|
if not Assigned(fProtocol.fOnBeforeIncomingFrame) or
|
|
not fProtocol.fOnBeforeIncomingFrame(self,request) then
|
|
fProtocol.ProcessIncomingFrame(self,request,'');
|
|
focConnectionClose: begin
|
|
if fState=wpsRun then begin
|
|
fState := wpsClose; // will close the connection
|
|
SendFrame(request); // send back the frame as ACK
|
|
end;
|
|
end;
|
|
end;
|
|
end else
|
|
if (fOwnerThread<>nil) and fOwnerThread.Terminated then
|
|
fState := wpsClose else
|
|
if sockerror<>0 then begin
|
|
WebSocketLog.Add.Log(sllInfo,'GetFrame SockInPending error % on %',
|
|
[sockerror,fProtocol],self);
|
|
fState := wpsClose;
|
|
end;
|
|
finally
|
|
InterlockedDecrement(fProcessCount); // release flag
|
|
end;
|
|
end;
|
|
result := (fState=wpsRun);
|
|
end;
|
|
|
|
function TWebSocketProcess.ProcessLoopStepSend: boolean;
|
|
var request: TWebSocketFrame;
|
|
elapsed: cardinal;
|
|
begin
|
|
if fState=wpsRun then begin
|
|
InterlockedIncrement(fProcessCount); // flag currently processing
|
|
try
|
|
elapsed := LastPingDelay;
|
|
if elapsed>fSettings.SendDelay then
|
|
if (fOutgoing.Count>0) and not SendPendingOutgoingFrames then
|
|
fState := wpsClose
|
|
else
|
|
if (fSettings.HeartbeatDelay<>0) and
|
|
(elapsed>fSettings.HeartbeatDelay) then begin
|
|
request.opcode := focPing;
|
|
if not SendFrame(request) then
|
|
if (fSettings.DisconnectAfterInvalidHeartbeatCount<>0) and
|
|
(fInvalidPingSendCount>=fSettings.DisconnectAfterInvalidHeartbeatCount) then
|
|
fState := wpsClose
|
|
else
|
|
SetLastPingTicks(true); // mark invalid, and avoid immediate retry
|
|
end;
|
|
finally
|
|
InterlockedDecrement(fProcessCount); // release flag
|
|
end;
|
|
end;
|
|
result := (fState=wpsRun);
|
|
end;
|
|
|
|
procedure TWebSocketProcess.ProcessLoop;
|
|
begin
|
|
if fProtocol=nil then
|
|
exit;
|
|
try
|
|
ProcessStart; // any exception will close the socket
|
|
try
|
|
SetLastPingTicks;
|
|
fState := wpsRun;
|
|
while (fOwnerThread=nil) or not fOwnerThread.Terminated do
|
|
if ProcessLoopStepReceive and ProcessLoopStepSend then
|
|
HiResDelay(fLastSocketTicks)
|
|
else
|
|
break; // connection ended
|
|
finally
|
|
ProcessStop;
|
|
end;
|
|
except // don't be optimistic: abort and close connection
|
|
fState := wpsClose;
|
|
end;
|
|
end;
|
|
|
|
procedure TWebSocketProcess.HiResDelay(const start: Int64);
|
|
var delay: cardinal;
|
|
begin
|
|
case {$ifdef FPCLINUX}SynFPCLinux.{$endif}GetTickCount64-start of
|
|
0..50: delay := 0; // 10 microsecs on POSIX
|
|
51..200: delay := 1;
|
|
201..500: delay := 5;
|
|
501..2000: delay := 50;
|
|
2001..5000: delay := 100;
|
|
else delay := 500;
|
|
end;
|
|
if (fSettings.LoopDelay<>0) and (delay>fSettings.LoopDelay) then
|
|
delay := fSettings.LoopDelay;
|
|
SleepHiRes(delay);
|
|
end;
|
|
|
|
function TWebSocketProcess.Settings: PWebSocketProcessSettings;
|
|
begin
|
|
result := @fSettings;
|
|
end;
|
|
|
|
function TWebSocketProcess.State: TWebSocketProcessState;
|
|
begin
|
|
if self=nil then
|
|
result := wpsCreate else
|
|
result := fState;
|
|
end;
|
|
|
|
function TWebSocketProcess.RemoteIP: SockString;
|
|
begin
|
|
if (self=nil) or (fProtocol=nil) or fProtocol.fRemoteLocalhost then
|
|
result := '' else
|
|
result := fProtocol.fRemoteIP;
|
|
end;
|
|
|
|
function TWebSocketProcess.NotifyCallback(aRequest: THttpServerRequest;
|
|
aMode: TWebSocketProcessNotifyCallback): cardinal;
|
|
var request,answer: TWebSocketFrame;
|
|
i: integer;
|
|
start,max: Int64;
|
|
head: RawUTF8;
|
|
begin
|
|
result := STATUS_NOTFOUND;
|
|
if (fProtocol=nil) or (aRequest=nil) or
|
|
not fProtocol.InheritsFrom(TWebSocketProtocolRest) then
|
|
exit;
|
|
if WebSocketLog<>nil then
|
|
WebSocketLog.Add.Log(sllTrace,'NotifyCallback(%,%)',
|
|
[aRequest.URL,_TWebSocketProcessNotifyCallback[aMode]^],self);
|
|
TWebSocketProtocolRest(fProtocol).InputToFrame(
|
|
aRequest,aMode in [wscBlockWithoutAnswer,wscNonBlockWithoutAnswer],request,head);
|
|
case aMode of
|
|
wscNonBlockWithoutAnswer: begin
|
|
// add to the internal sending list for asynchronous sending
|
|
fOutgoing.Push(request);
|
|
result := STATUS_SUCCESS;
|
|
exit;
|
|
end;
|
|
wscBlockWithAnswer:
|
|
if fIncoming.AnswerToIgnore>0 then begin
|
|
WebSocketLog.Add.Log(sllDebug,'NotifyCallback: Waiting for AnswerToIgnore=%',
|
|
[fIncoming.AnswerToIgnore],self);
|
|
start := GetTickCount64;
|
|
max := start+30000;
|
|
repeat
|
|
HiResDelay(start);
|
|
if fState in [wpsDestroy,wpsClose] then begin
|
|
result := STATUS_WEBSOCKETCLOSED;
|
|
exit;
|
|
end;
|
|
if fIncoming.AnswerToIgnore=0 then
|
|
break; // it is now safe to send a new 'request'
|
|
if GetTickCount64<max then
|
|
continue;
|
|
self.Log(request,'NotifyCallback AnswerToIgnore TIMEOUT -> abort connection',sllInfo);
|
|
result := STATUS_NOTIMPLEMENTED; // 501 will force recreate connection
|
|
exit;
|
|
until false;
|
|
end;
|
|
end;
|
|
i := InterlockedIncrement(fProcessCount);
|
|
try
|
|
if (i>2) and (WebSocketLog<>nil) then
|
|
WebSocketLog.Add.Log(sllWarning,'NotifyCallback with fProcessCount=%',[i],self);
|
|
if not SendFrame(request) then
|
|
exit;
|
|
if aMode=wscBlockWithoutAnswer then begin
|
|
result := STATUS_SUCCESS;
|
|
exit;
|
|
end;
|
|
start := {$ifdef FPCLINUX}SynFPCLinux.{$endif}GetTickCount64;
|
|
if fSettings.CallbackAnswerTimeOutMS=0 then
|
|
max := start+30000 else // never wait for ever
|
|
if fSettings.CallbackAnswerTimeOutMS<2000 then
|
|
max := start+2000 else // 2 seconds minimal wait
|
|
max := start+fSettings.CallbackAnswerTimeOutMS;
|
|
while not fIncoming.Pop(fProtocol,head,answer) do
|
|
if fState in [wpsDestroy,wpsClose] then begin
|
|
result := STATUS_WEBSOCKETCLOSED;
|
|
exit;
|
|
end else
|
|
if {$ifdef FPCLINUX}SynFPCLinux.{$endif}GetTickCount64>max then begin
|
|
WebSocketLog.Add.Log(sllWarning,'NotifyCallback TIMEOUT %',[head],self);
|
|
if head='answer' then
|
|
fIncoming.AnswerToIgnore(1); // ignore next 'answer'
|
|
exit; // returns STATUS_NOTFOUND
|
|
end else
|
|
HiResDelay(start);
|
|
finally
|
|
InterlockedDecrement(fProcessCount);
|
|
end;
|
|
result := TWebSocketProtocolRest(fProtocol).FrameToOutput(answer,aRequest);
|
|
end;
|
|
|
|
function TWebSocketProcess.SendPendingOutgoingFrames: boolean;
|
|
begin
|
|
result := false;
|
|
fOutgoing.Safe.Lock;
|
|
try
|
|
if fProtocol.SendFrames(self,fOutgoing.List,fOutgoing.Count) then
|
|
result := true else
|
|
WebSocketLog.Add.Log(sllInfo,'SendPendingOutgoingFrames: SendFrames failed',self);
|
|
finally
|
|
fOutgoing.Safe.UnLock;
|
|
end;
|
|
end;
|
|
|
|
procedure TWebSocketProcess.Log(const frame: TWebSocketFrame;
|
|
const aMethodName: RawUTF8; aEvent: TSynLogInfo; DisableRemoteLog: Boolean);
|
|
var tmp: TLogEscape;
|
|
log: TSynLog;
|
|
len: integer;
|
|
begin
|
|
if WebSocketLog<>nil then
|
|
with WebSocketLog.Family do
|
|
if aEvent in Level then
|
|
if (logHeartbeat in fSettings.LogDetails) or
|
|
not (frame.opcode in [focPing,focPong]) then begin
|
|
log := SynLog;
|
|
log.DisableRemoteLog(DisableRemoteLog);
|
|
try
|
|
if (frame.opcode=focText) and
|
|
(logTextFrameContent in fSettings.LogDetails) then
|
|
log.Log(aEvent,'% % % focText %',[aMethodName,fProtocol.GetRemoteIP,
|
|
Protocol.FrameType(frame),frame.PayLoad],self) else begin
|
|
len := length(frame.PayLoad);
|
|
log.Log(aEvent,'% % % % len=%%',[aMethodName,fProtocol.GetRemoteIP,
|
|
Protocol.FrameType(frame),_TWebSocketFrameOpCode[frame.opcode]^,len,
|
|
LogEscape(pointer(frame.PayLoad),len,tmp,
|
|
logBinaryFrameContent in fSettings.LogDetails)],self);
|
|
end;
|
|
finally
|
|
log.DisableRemoteLog(false);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
const
|
|
FRAME_OPCODE_FIN=128;
|
|
FRAME_LEN_MASK=128;
|
|
FRAME_LEN_2BYTES=126;
|
|
FRAME_LEN_8BYTES=127;
|
|
|
|
type
|
|
TFrameHeader = packed record
|
|
first: byte;
|
|
len8: byte;
|
|
len32: cardinal;
|
|
len64: cardinal;
|
|
mask: cardinal; // 0 indicates no payload masking
|
|
end;
|
|
|
|
procedure ProcessMask(data: pointer; mask: cardinal; len: PtrInt);
|
|
var i,maskCount: PtrInt;
|
|
begin
|
|
maskCount := len shr 2;
|
|
for i := 0 to maskCount-1 do
|
|
PCardinalArray(data)^[i] := PCardinalArray(data)^[i] xor mask;
|
|
maskCount := maskCount shl 2;
|
|
for i := maskCount to maskCount+(len and 3)-1 do begin
|
|
PByteArray(data)^[i] := PByteArray(data)^[i] xor mask;
|
|
mask := mask shr 8;
|
|
end;
|
|
end;
|
|
|
|
type
|
|
// asynchronous state machine to process incoming frames
|
|
TWebProcessInFrameState = (
|
|
pfsHeader1, pfsData1, pfsHeaderN, pfsDataN, pfsDone, pfsError);
|
|
TWebProcessInFrame = object
|
|
hdr: TFrameHeader;
|
|
opcode: TWebSocketFrameOpCode;
|
|
masked: boolean;
|
|
st: TWebProcessInFrameState;
|
|
process: TWebSocketProcess;
|
|
outputframe: PWebSocketFrame;
|
|
len: integer;
|
|
data: RawByteString;
|
|
procedure Init(owner: TWebSocketProcess; output: PWebSocketFrame);
|
|
function GetBytes(P: PAnsiChar; count: integer): boolean;
|
|
function GetHeader: boolean;
|
|
function GetData: boolean;
|
|
function Step(ErrorWithoutException: PInteger): TWebProcessInFrameState;
|
|
end;
|
|
|
|
function TWebProcessInFrame.GetBytes(P: PAnsiChar; count: integer): boolean;
|
|
begin // SockInRead() below raise a ECrtSocket error on failure
|
|
inc(len,process.ReceiveBytes(P+len,count-len));
|
|
result := len=count;
|
|
end;
|
|
|
|
function TWebProcessInFrame.GetHeader: boolean;
|
|
begin
|
|
result := false;
|
|
if len<2 then begin
|
|
data := '';
|
|
FillCharFast(hdr,sizeof(hdr),0);
|
|
if not GetBytes(@hdr,2) then // first+len8
|
|
exit;
|
|
end;
|
|
opcode := TWebSocketFrameOpCode(hdr.first and 15);
|
|
masked := hdr.len8 and FRAME_LEN_MASK<>0;
|
|
if masked then
|
|
hdr.len8 := hdr.len8 and 127;
|
|
if hdr.len8<FRAME_LEN_2BYTES then
|
|
hdr.len32 := hdr.len8 else
|
|
if hdr.len8=FRAME_LEN_2BYTES then begin
|
|
if not GetBytes(@hdr,4) then // first+len8+len32.low
|
|
exit;
|
|
hdr.len32 := swap(word(hdr.len32)); // FPC expects explicit word() cast
|
|
end else
|
|
if hdr.len8=FRAME_LEN_8BYTES then begin
|
|
if not GetBytes(@hdr,10) then // first+len8+len32+len64.low
|
|
exit;
|
|
if hdr.len32<>0 then // size is more than 32 bits -> reject
|
|
hdr.len32 := maxInt else
|
|
hdr.len32 := bswap32(hdr.len64);
|
|
if hdr.len32>WebSocketsMaxFrameMB shl 20 then
|
|
raise EWebSockets.CreateUTF8('%.GetFrame: length should be < % MB',
|
|
[process,WebSocketsMaxFrameMB]);
|
|
end;
|
|
if masked then begin
|
|
len := 0; // not appended to hdr
|
|
if not GetBytes(@hdr.mask,4) then
|
|
raise EWebSockets.CreateUTF8('%.GetFrame: truncated mask',[process]);
|
|
end;
|
|
len := 0; // prepare upcoming GetData
|
|
result := true;
|
|
end;
|
|
|
|
function TWebProcessInFrame.GetData: boolean;
|
|
begin
|
|
if length(data)<>integer(hdr.len32) then
|
|
SetString(data,nil,hdr.len32);
|
|
result := GetBytes(pointer(data),hdr.len32);
|
|
if result then begin
|
|
if hdr.mask<>0 then
|
|
ProcessMask(pointer(data),hdr.mask,hdr.len32);
|
|
len := 0; // prepare upcoming GetHeader
|
|
end;
|
|
end;
|
|
|
|
function TWebProcessInFrame.Step(ErrorWithoutException: PInteger): TWebProcessInFrameState;
|
|
begin
|
|
while true do // process incoming data as much as possible
|
|
case st of
|
|
pfsHeader1:
|
|
if GetHeader then begin
|
|
outputframe.opcode := opcode;
|
|
outputframe.content := [];
|
|
st := pfsData1;
|
|
end else
|
|
break; // quit when not enough data is available from input
|
|
pfsData1:
|
|
if GetData then begin
|
|
outputframe.payload := data;
|
|
if hdr.first and FRAME_OPCODE_FIN=0 then
|
|
st := pfsHeaderN else
|
|
st := pfsDone;
|
|
end else
|
|
break;
|
|
pfsHeaderN:
|
|
if GetHeader then
|
|
if (opcode<>focContinuation) and (opcode<>outputframe.opcode) then begin
|
|
st := pfsError;
|
|
if ErrorWithoutException<>nil then begin
|
|
WebSocketLog.Add.Log(sllDebug, 'GetFrame: received %, expected %',
|
|
[_TWebSocketFrameOpCode[opcode]^,_TWebSocketFrameOpCode[outputframe.opcode]^],process);
|
|
ErrorWithoutException^ := maxInt;
|
|
end else
|
|
raise EWebSockets.CreateUTF8('%.GetFrame: received %, expected %',
|
|
[process,_TWebSocketFrameOpCode[opcode]^,_TWebSocketFrameOpCode[outputframe.opcode]^]);
|
|
end else
|
|
st := pfsDataN else
|
|
break;
|
|
pfsDataN:
|
|
if GetData then begin
|
|
outputframe.payload := outputframe.payload+data;
|
|
if hdr.first and FRAME_OPCODE_FIN=0 then
|
|
st := pfsHeaderN else
|
|
st := pfsDone;
|
|
end else
|
|
break;
|
|
pfsDone: begin
|
|
data := '';
|
|
{$ifdef HASCODEPAGE}
|
|
if opcode=focText then
|
|
SetCodePage(outputframe.payload,CP_UTF8,false); // identify text value as UTF-8
|
|
{$endif}
|
|
if (process.fProtocol<>nil) and (outputframe.payload<>'') then
|
|
process.fProtocol.AfterGetFrame(outputframe^);
|
|
process.Log(outputframe^,'GetFrame');
|
|
process.SetLastPingTicks;
|
|
break;
|
|
end;
|
|
else // e.g. pfsError
|
|
break;
|
|
end;
|
|
result := st;
|
|
end;
|
|
|
|
procedure TWebProcessInFrame.Init(owner: TWebSocketProcess; output: PWebSocketFrame);
|
|
begin
|
|
process := owner;
|
|
outputframe := output;
|
|
st := pfsHeader1;
|
|
len := 0;
|
|
end;
|
|
|
|
|
|
function TWebSocketProcess.GetFrame(out Frame: TWebSocketFrame;
|
|
ErrorWithoutException: PInteger): boolean;
|
|
var f: TWebProcessInFrame;
|
|
begin
|
|
f.Init(self,@Frame);
|
|
fSafeIn.Lock;
|
|
try
|
|
repeat until f.Step(ErrorWithoutException) in [pfsDone,pfsError];
|
|
result := f.st=pfsDone;
|
|
finally
|
|
fSafeIn.UnLock;
|
|
end;
|
|
end;
|
|
|
|
function TWebSocketProcess.SendFrame(var Frame: TWebSocketFrame): boolean;
|
|
var hdr: TFrameHeader;
|
|
hdrlen, len: cardinal;
|
|
tmp: TSynTempBuffer;
|
|
begin
|
|
fSafeOut.Lock;
|
|
try
|
|
Log(frame,'SendFrame',sllTrace,true);
|
|
try
|
|
result := true;
|
|
if Frame.opcode=focConnectionClose then
|
|
fNoConnectionCloseAtDestroy := true; // to be done once on each end
|
|
if (fProtocol<>nil) and (Frame.payload<>'') then
|
|
fProtocol.BeforeSendFrame(Frame);
|
|
len := Length(Frame.payload);
|
|
hdr.first := byte(Frame.opcode) or FRAME_OPCODE_FIN; // single frame
|
|
if len<FRAME_LEN_2BYTES then begin
|
|
hdr.len8 := len or fMaskSentFrames;
|
|
hdrlen := 2; // opcode+len8
|
|
end else
|
|
if len<65536 then begin
|
|
hdr.len8 := FRAME_LEN_2BYTES or fMaskSentFrames;
|
|
hdr.len32 := swap(word(len)); // FPC expects explicit word() cast
|
|
hdrlen := 4; // opcode+len8+len32.low
|
|
end else begin
|
|
hdr.len8 := FRAME_LEN_8BYTES or fMaskSentFrames;
|
|
hdr.len64 := bswap32(len);
|
|
hdr.len32 := 0;
|
|
hdrlen := 10; // opcode+len8+len32+len64.low
|
|
end;
|
|
if fMaskSentFrames<>0 then begin
|
|
hdr.mask := Random32gsl; // https://tools.ietf.org/html/rfc6455#section-10.3
|
|
ProcessMask(pointer(Frame.payload),hdr.mask,len);
|
|
inc(hdrlen,4);
|
|
end;
|
|
tmp.Init(hdrlen+len); // avoid most memory allocations
|
|
try
|
|
MoveSmall(@hdr,tmp.buf,hdrlen);
|
|
if fMaskSentFrames<>0 then
|
|
PInteger(PAnsiChar(tmp.buf)+hdrlen-4)^ := hdr.mask;
|
|
MoveFast(pointer(Frame.payload)^,PAnsiChar(tmp.buf)[hdrlen],len);
|
|
if not SendBytes(tmp.buf,hdrlen+len) then
|
|
result := false;
|
|
finally
|
|
tmp.Done;
|
|
end;
|
|
SetLastPingTicks(not result);
|
|
except
|
|
result := false;
|
|
end;
|
|
finally
|
|
fSafeOut.UnLock;
|
|
end;
|
|
end;
|
|
|
|
|
|
{ TWebCrtSocketProcess }
|
|
|
|
constructor TWebCrtSocketProcess.Create(aSocket: TCrtSocket; aProtocol: TWebSocketProtocol;
|
|
aOwnerConnection: THttpServerConnectionID; aOwnerThread: TSynThread;
|
|
const aSettings: TWebSocketProcessSettings; const aProcessName: RawUTF8);
|
|
begin
|
|
inherited Create(aProtocol,aOwnerConnection,aOwnerThread,aSettings,aProcessName);
|
|
fSocket := aSocket;
|
|
end;
|
|
|
|
function TWebCrtSocketProcess.CanGetFrame(TimeOut: cardinal; ErrorWithoutException: PInteger): boolean;
|
|
var pending: integer;
|
|
begin
|
|
if ErrorWithoutException<>nil then
|
|
ErrorWithoutException^ := 0;
|
|
pending := fSocket.SockInPending(TimeOut,{PendingAlsoInSocket=}true);
|
|
if pending<0 then // socket error
|
|
if ErrorWithoutException<>nil then begin
|
|
ErrorWithoutException^ := fSocket.LastLowSocketError;
|
|
result := false;
|
|
exit;
|
|
end else
|
|
raise EWebSockets.CreateUTF8('SockInPending() Error % on %:% - from %',
|
|
[fSocket.LastLowSocketError,fSocket.Server,fSocket.Port,fProtocol.fRemoteIP]);
|
|
result := (pending>=2);
|
|
end;
|
|
|
|
function TWebCrtSocketProcess.ReceiveBytes(P: PAnsiChar; count: integer): integer;
|
|
begin
|
|
result := fSocket.SockInRead(P,count,{useonlysockin=}false);
|
|
end;
|
|
|
|
function TWebCrtSocketProcess.SendBytes(P: pointer; Len: integer): boolean;
|
|
begin
|
|
result := fSocket.TrySndLow(P,Len);
|
|
end;
|
|
|
|
|
|
{ -------------- WebSockets Server classes for bidirectional remote access }
|
|
|
|
function HttpServerWebSocketUpgrade(ClientSock: THttpServerSocket;
|
|
Protocols: TWebSocketProtocolList; out Protocol: TWebSocketProtocol): integer;
|
|
var uri,version,prot,subprot,key,extin,extout,header: RawUTF8;
|
|
extins: TRawUTF8DynArray;
|
|
P: PUTF8Char;
|
|
Digest: TSHA1Digest;
|
|
begin
|
|
result := STATUS_BADREQUEST;
|
|
try
|
|
if not IdemPropNameU(ClientSock.Upgrade,'websocket') then
|
|
exit;
|
|
version := ClientSock.HeaderGetValue('SEC-WEBSOCKET-VERSION');
|
|
if GetInteger(pointer(version))<13 then
|
|
exit; // we expect WebSockets protocol version 13 at least
|
|
uri := Trim(RawUTF8(ClientSock.URL));
|
|
if (uri<>'') and (uri[1]='/') then
|
|
Delete(uri,1,1);
|
|
prot := ClientSock.HeaderGetValue('SEC-WEBSOCKET-PROTOCOL');
|
|
P := pointer(prot);
|
|
if P<>nil then begin
|
|
repeat
|
|
GetNextItemTrimed(P,',',subprot);
|
|
Protocol := Protocols.CloneByName(subprot,uri);
|
|
until (P=nil) or (Protocol<>nil);
|
|
if (Protocol<>nil) and (Protocol.URI='') and not Protocol.ProcessURI(uri) then begin
|
|
Protocol.Free;
|
|
result := STATUS_UNAUTHORIZED;
|
|
exit;
|
|
end;
|
|
end else
|
|
// if no protocol is specified, try to match by URI
|
|
Protocol := Protocols.CloneByURI(uri);
|
|
if Protocol=nil then
|
|
exit;
|
|
Protocol.fUpgradeURI := uri;
|
|
Protocol.fRemoteIP := ClientSock.HeaderGetValue('SEC-WEBSOCKET-REMOTEIP');
|
|
if Protocol.fRemoteIP='' then
|
|
Protocol.fRemoteIP := ClientSock.RemoteIP;
|
|
Protocol.fRemoteLocalhost := Protocol.fRemoteIP='127.0.0.1';
|
|
extin := ClientSock.HeaderGetValue('SEC-WEBSOCKET-EXTENSIONS');
|
|
if extin<>'' then begin
|
|
CSVToRawUTF8DynArray(pointer(extin),extins,';',true);
|
|
if not Protocol.ProcessHandshake(extins,extout,nil) then begin
|
|
Protocol.Free;
|
|
result := STATUS_UNAUTHORIZED;
|
|
exit;
|
|
end;
|
|
end;
|
|
key := ClientSock.HeaderGetValue('SEC-WEBSOCKET-KEY');
|
|
if Base64ToBinLengthSafe(pointer(key),length(key))<>16 then begin
|
|
Protocol.Free;
|
|
exit; // this nonce must be a Base64-encoded value of 16 bytes
|
|
end;
|
|
ComputeChallenge(key,Digest);
|
|
if extout<>'' then
|
|
extout := 'Sec-WebSocket-Extensions: '+extout+#13#10;
|
|
FormatUTF8('HTTP/1.1 101 Switching Protocols'#13#10+
|
|
'Upgrade: websocket'#13#10'Connection: Upgrade'#13#10+
|
|
'Sec-WebSocket-Protocol: %'#13#10'%Sec-WebSocket-Accept: %'#13#10#13#10,
|
|
[Protocol.Name,extout,BinToBase64Short(@Digest,sizeof(Digest))],header);
|
|
if not ClientSock.TrySndLow(pointer(header),length(header)) then begin
|
|
Protocol.Free;
|
|
result := STATUS_WEBSOCKETCLOSED;
|
|
exit;
|
|
end;
|
|
result := STATUS_SUCCESS; // connection upgraded: never back to HTTP/1.1
|
|
finally
|
|
if result<>STATUS_SUCCESS then begin // notify upgrade failure to client
|
|
FormatUTF8('HTTP/1.0 % WebSocket Upgrade Error'#13#10+
|
|
'Connection: Close'#13#10#13#10,[result],header);
|
|
ClientSock.TrySndLow(pointer(header),length(header));
|
|
ClientSock.KeepAliveClient := false;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
{ TWebSocketServer }
|
|
|
|
constructor TWebSocketServer.Create(const aPort: SockString; OnStart,OnStop: TNotifyThreadEvent;
|
|
const ProcessName: SockString; ServerThreadPoolCount, KeepAliveTimeOut: integer;
|
|
HeadersNotFiltered: boolean; CreateSuspended: boolean);
|
|
begin
|
|
// override with custom processing classes
|
|
fSocketClass := TWebSocketServerSocket;
|
|
fThreadRespClass := TWebSocketServerResp;
|
|
// initialize protocols and connections
|
|
fWebSocketConnections := TSynObjectListLocked.Create({owned=}false);
|
|
fProtocols := TWebSocketProtocolList.Create;
|
|
fSettings.SetDefaults;
|
|
fSettings.HeartbeatDelay := 20000;
|
|
fCanNotifyCallback := true;
|
|
// start the server
|
|
inherited Create(aPort,OnStart,OnStop,ProcessName,ServerThreadPoolCount,
|
|
KeepAliveTimeOut,HeadersNotFiltered,CreateSuspended);
|
|
end;
|
|
|
|
function TWebSocketServer.WebSocketProcessUpgrade(ClientSock: THttpServerSocket;
|
|
Context: TWebSocketServerResp): integer;
|
|
var protocol: TWebSocketProtocol;
|
|
begin
|
|
result := HttpServerWebSocketUpgrade(ClientSock,fProtocols,protocol);
|
|
if result<>STATUS_SUCCESS then
|
|
exit;
|
|
ClientSock.KeepAliveClient := false; // close connection with WebSockets
|
|
Context.fProcess := TWebSocketProcessServer.Create(
|
|
ClientSock,protocol,Context.ConnectionID,Context,fSettings,fProcessName);
|
|
Context.fProcess.fServerResp := Context;
|
|
fWebSocketConnections.Add(Context);
|
|
try
|
|
Context.fProcess.ProcessLoop; // run main blocking loop
|
|
finally
|
|
FreeAndNil(Context.fProcess); // notify end of WebSockets
|
|
fWebSocketConnections.Remove(Context);
|
|
end;
|
|
end;
|
|
|
|
procedure TWebSocketServer.Process(ClientSock: THttpServerSocket;
|
|
ConnectionID: THttpServerConnectionID; ConnectionThread: TSynThread);
|
|
var err: integer;
|
|
begin
|
|
if (connectionUpgrade in ClientSock.HeaderFlags) and ClientSock.KeepAliveClient and
|
|
IdemPropNameU('GET',ClientSock.Method) and
|
|
IdemPropNameU(ClientSock.Upgrade,'websocket') and
|
|
ConnectionThread.InheritsFrom(TWebSocketServerResp) then begin
|
|
err := WebSocketProcessUpgrade(ClientSock,TWebSocketServerResp(ConnectionThread));
|
|
if err<>STATUS_SUCCESS then
|
|
WebSocketLog.Add.Log(sllTrace,'Process: WebSocketProcessUpgrade failed as %',[err],self);
|
|
end else
|
|
inherited Process(ClientSock,ConnectionID,ConnectionThread);
|
|
end;
|
|
|
|
destructor TWebSocketServer.Destroy;
|
|
begin
|
|
inherited Destroy; // close any pending connection
|
|
fWebSocketConnections.Free;
|
|
fProtocols.Free;
|
|
end;
|
|
|
|
function TWebSocketServer.Settings: PWebSocketProcessSettings;
|
|
begin
|
|
result := @fSettings;
|
|
end;
|
|
|
|
function TWebSocketServer.WebSocketConnections: integer;
|
|
begin
|
|
result := fWebSocketConnections.Count;
|
|
end;
|
|
|
|
type
|
|
PWebSocketServerResp = ^TWebSocketServerResp;
|
|
|
|
function TWebSocketServer.IsActiveWebSocketThread(ConnectionThread: TSynThread): TWebSocketServerResp;
|
|
var i: Integer;
|
|
c: PWebSocketServerResp;
|
|
begin // no need to optimize (not called often)
|
|
result := nil;
|
|
if Terminated or (ConnectionThread=nil) or
|
|
not ConnectionThread.InheritsFrom(TWebSocketServerResp) then
|
|
exit;
|
|
fWebSocketConnections.Safe.Lock;
|
|
try
|
|
c := pointer(fWebSocketConnections.List);
|
|
for i := 1 to fWebSocketConnections.Count do
|
|
if c^=ConnectionThread then begin
|
|
if c^.fProcess.State=wpsRun then
|
|
result := c^;
|
|
exit;
|
|
end else
|
|
inc(c);
|
|
finally
|
|
fWebSocketConnections.Safe.UnLock;
|
|
end;
|
|
end;
|
|
|
|
function FastFindConnection(c: PWebSocketServerResp; n: integer; id: THttpServerConnectionID): TWebSocketServerResp;
|
|
begin // speedup brute force check in case of high number of connections
|
|
if n>0 then
|
|
repeat
|
|
result := c^;
|
|
if result.ConnectionID=id then
|
|
exit;
|
|
inc(c);
|
|
dec(n);
|
|
if n=0 then
|
|
break;
|
|
result := c^;
|
|
if result.ConnectionID=id then
|
|
exit;
|
|
inc(c);
|
|
dec(n);
|
|
until n=0;
|
|
result := nil;
|
|
end;
|
|
|
|
function TWebSocketServer.IsActiveWebSocket(ConnectionID: THttpServerConnectionID): TWebSocketServerResp;
|
|
begin
|
|
result := nil;
|
|
if Terminated or (ConnectionID=0) then
|
|
exit;
|
|
fWebSocketConnections.Safe.Lock;
|
|
try
|
|
result := FastFindConnection(pointer(fWebSocketConnections.List),
|
|
fWebSocketConnections.Count, ConnectionID);
|
|
finally
|
|
fWebSocketConnections.Safe.UnLock;
|
|
end;
|
|
end;
|
|
|
|
procedure TWebSocketServer.WebSocketBroadcast(const aFrame: TWebSocketFrame);
|
|
begin
|
|
WebSocketBroadcast(aFrame,nil);
|
|
end;
|
|
|
|
procedure TWebSocketServer.WebSocketBroadcast(const aFrame: TWebSocketFrame;
|
|
const aClientsConnectionID: THttpServerConnectionIDDynArray);
|
|
var i, len, ids: Integer;
|
|
c: ^TWebSocketServerResp;
|
|
temp: TWebSocketFrame; // local copy since SendFrame() modifies the payload
|
|
sorted: TSynTempBuffer;
|
|
begin
|
|
if Terminated or not(aFrame.opcode in [focText, focBinary]) then
|
|
exit;
|
|
ids := length(aClientsConnectionID);
|
|
if ids>0 then begin
|
|
sorted.Init(pointer(aClientsConnectionID),ids*8);
|
|
QuickSortInt64(sorted.buf,0,ids-1); // faster O(log(n)) binary search
|
|
end;
|
|
dec(ids); // WebSocketBroadcast(nil) -> ids<0
|
|
temp.opcode := aFrame.opcode;
|
|
temp.content := aFrame.content;
|
|
len := length(aFrame.payload);
|
|
fWebSocketConnections.Safe.Lock;
|
|
try
|
|
c := pointer(fWebSocketConnections.List);
|
|
for i := 1 to fWebSocketConnections.Count do begin
|
|
if (c^.fProcess.State=wpsRun) and
|
|
((ids<0) or (FastFindInt64Sorted(sorted.buf,ids,c^.ConnectionID)>=0)) then begin
|
|
SetString(temp.payload,PAnsiChar(pointer(aFrame.payload)),len);
|
|
c^.fProcess.Outgoing.Push(temp); // non blocking asynchronous sending
|
|
end;
|
|
inc(c);
|
|
end;
|
|
finally
|
|
fWebSocketConnections.Safe.UnLock;
|
|
if ids>=0 then
|
|
sorted.Done;
|
|
end;
|
|
end;
|
|
|
|
{ TWebSocketServerRest }
|
|
|
|
constructor TWebSocketServerRest.Create(const aPort: SockString;
|
|
OnStart,OnStop: TNotifyThreadEvent; const aProcessName,
|
|
aWebSocketsURI, aWebSocketsEncryptionKey: RawUTF8; aWebSocketsAJAX: boolean);
|
|
begin
|
|
Create(aPort,OnStart,OnStop,aProcessName);
|
|
WebSocketsEnable(aWebSocketsURI,aWebSocketsEncryptionKey,aWebSocketsAJAX);
|
|
end;
|
|
|
|
procedure TWebSocketServerRest.WebSocketsEnable(const aWebSocketsURI,
|
|
aWebSocketsEncryptionKey: RawUTF8; aWebSocketsAJAX,aWebSocketsCompressed: boolean);
|
|
begin
|
|
if self=nil then
|
|
exit;
|
|
fProtocols.AddOnce(TWebSocketProtocolBinary.Create(
|
|
aWebSocketsURI,true,aWebSocketsEncryptionKey,aWebSocketsCompressed));
|
|
if aWebSocketsAJAX then
|
|
fProtocols.AddOnce(TWebSocketProtocolJSON.Create(aWebSocketsURI));
|
|
end;
|
|
|
|
function TWebSocketServerRest.Callback(
|
|
Ctxt: THttpServerRequest; aNonBlocking: boolean): cardinal;
|
|
var connection: TWebSocketServerResp;
|
|
mode: TWebSocketProcessNotifyCallback;
|
|
begin
|
|
if Ctxt=nil then
|
|
connection := nil else begin
|
|
WebSocketLog.Add.Log(sllTrace,'Callback(%) on socket=%',
|
|
[Ctxt.URL,Ctxt.ConnectionID],self);
|
|
connection := IsActiveWebSocket(Ctxt.ConnectionID);
|
|
end;
|
|
if connection<>nil then begin
|
|
// this request is a websocket, on a non broken connection
|
|
if aNonBlocking then // see TInterfacedObjectFakeServer.CallbackInvoke
|
|
mode := wscNonBlockWithoutAnswer else
|
|
mode := wscBlockWithAnswer;
|
|
result := connection.NotifyCallback(Ctxt,mode);
|
|
end else begin
|
|
WebSocketLog.Add.Log(sllError,'Callback() on inactive socket',self);
|
|
result := STATUS_NOTFOUND;
|
|
end;
|
|
end;
|
|
|
|
|
|
{ TWebSocketServerResp }
|
|
|
|
constructor TWebSocketServerResp.Create(aServerSock: THttpServerSocket;
|
|
aServer: THttpServer);
|
|
begin
|
|
if not aServer.InheritsFrom(TWebSocketServer) then
|
|
raise EWebSockets.CreateUTF8('%.Create(%: TWebSocketServer?)',[self,aServer]);
|
|
inherited Create(aServerSock,aServer);
|
|
end;
|
|
|
|
function TWebSocketServerResp.NotifyCallback(Ctxt: THttpServerRequest;
|
|
aMode: TWebSocketProcessNotifyCallback): cardinal;
|
|
begin
|
|
if fProcess=nil then
|
|
result := STATUS_NOTFOUND else begin
|
|
result := fProcess.NotifyCallback(Ctxt,aMode);
|
|
if result=STATUS_WEBSOCKETCLOSED then begin
|
|
WebSocketLog.Add.Log(sllError,'NotifyCallback on closed connection',self);
|
|
ServerSock.KeepAliveClient := false; // force close the connection
|
|
result := STATUS_NOTFOUND;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TWebSocketServerResp.WebSocketProtocol: TWebSocketProtocol;
|
|
begin
|
|
if (Self=nil) or (fProcess=nil) then
|
|
result := nil else
|
|
result := fProcess.Protocol;
|
|
end;
|
|
|
|
|
|
{ TWebSocketProcessServer }
|
|
|
|
function TWebSocketProcessServer.ComputeContext(
|
|
out RequestProcess: TOnHttpServerRequest): THttpServerRequest;
|
|
begin
|
|
result := THttpServerRequest.Create(
|
|
(fOwnerThread as TWebSocketServerResp).fServer,fOwnerConnection,fOwnerThread);
|
|
RequestProcess := TWebSocketServerResp(fOwnerThread).fServer.Request;
|
|
end;
|
|
|
|
|
|
{ TWebSocketServerSocket }
|
|
|
|
function TWebSocketServerSocket.GetRequest(withBody: boolean;
|
|
headerMaxTix: Int64): THttpServerSocketGetRequestResult;
|
|
begin
|
|
result := inherited GetRequest(withBody, headerMaxTix);
|
|
if (result=grHeaderReceived) and (connectionUpgrade in HeaderFlags) and
|
|
KeepAliveClient and IdemPropNameU('GET',Method) and IdemPropNameU(Upgrade,'websocket') then
|
|
//writeln('!!');
|
|
end;
|
|
|
|
|
|
{ -------------- WebSockets Client classes for bidirectional remote access }
|
|
|
|
{ THttpClientWebSockets }
|
|
|
|
constructor THttpClientWebSockets.Create(aTimeOut: PtrInt);
|
|
begin
|
|
inherited;
|
|
fSettings.SetDefaults;
|
|
fSettings.CallbackAnswerTimeOutMS := aTimeOut;
|
|
end;
|
|
|
|
class function THttpClientWebSockets.WebSocketsConnect(const aHost,
|
|
aPort: SockString; aProtocol: TWebSocketProtocol; aLog: TSynLogClass;
|
|
const aLogContext, aURI, aCustomHeaders: RawUTF8): THttpClientWebSockets;
|
|
var error: RawUTF8;
|
|
begin
|
|
result := nil;
|
|
if (aProtocol = nil) or (aHost = '') then
|
|
raise EWebSockets.CreateUTF8('%.WebSocketsConnect(nil)', [self]);
|
|
try
|
|
result := Open(aHost, aPort); // constructor
|
|
error := result.WebSocketsUpgrade(aURI, '', false, false, aProtocol, aCustomHeaders);
|
|
if error <> '' then
|
|
FreeAndNil(result);
|
|
except
|
|
on E: Exception do begin
|
|
aProtocol.Free; // as done in WebSocketsUpgrade()
|
|
FreeAndNil(result);
|
|
FormatUTF8('% %', [E, E.Message], error);
|
|
end;
|
|
end;
|
|
if aLog <> nil then
|
|
if result <> nil then
|
|
aLog.Add.Log(sllDebug, '%: WebSocketsConnect %', [aLogContext, result])
|
|
else
|
|
aLog.Add.Log(sllWarning, '%: WebSocketsConnect %:% failed - %',
|
|
[aLogContext, aHost, aPort, error]);
|
|
end;
|
|
|
|
destructor THttpClientWebSockets.Destroy;
|
|
begin
|
|
FreeAndNil(fProcess);
|
|
inherited;
|
|
end;
|
|
|
|
function THttpClientWebSockets.Request(const url, method: SockString;
|
|
KeepAlive: cardinal; const header, Data, DataType: SockString;
|
|
retry: boolean): integer;
|
|
var Ctxt: THttpServerRequest;
|
|
block: TWebSocketProcessNotifyCallback;
|
|
resthead: RawUTF8;
|
|
begin
|
|
if fProcess<>nil then begin
|
|
if fProcess.fClientThread.fThreadState=sCreate then
|
|
sleep(10); // paranoid warmup of TWebSocketProcessClientThread.Execute
|
|
if fProcess.fClientThread.fThreadState<>sRun then
|
|
// WebSockets closed by server side
|
|
result := STATUS_NOTIMPLEMENTED else begin
|
|
// send the REST request over WebSockets
|
|
Ctxt := THttpServerRequest.Create(
|
|
nil,fProcess.fOwnerConnection,fProcess.fOwnerThread);
|
|
try
|
|
Ctxt.Prepare(url,method,header,data,dataType,'',fTLS);
|
|
FindNameValue(header,'SEC-WEBSOCKET-REST:',resthead);
|
|
if resthead='NonBlocking' then
|
|
block := wscNonBlockWithoutAnswer else
|
|
block := wscBlockWithAnswer;
|
|
result := fProcess.NotifyCallback(Ctxt,block);
|
|
if IdemPChar(pointer(Ctxt.OutContentType),JSON_CONTENT_TYPE_UPPER) then
|
|
HeaderSetText(Ctxt.OutCustomHeaders) else
|
|
HeaderSetText(Ctxt.OutCustomHeaders,Ctxt.OutContentType);
|
|
Content := Ctxt.OutContent;
|
|
ContentType := Ctxt.OutContentType;
|
|
ContentLength := length(Ctxt.OutContent);
|
|
finally
|
|
Ctxt.Free;
|
|
end;
|
|
end;
|
|
end else
|
|
// standard HTTP/1.1 REST request (before WebSocketsUpgrade call)
|
|
result := inherited Request(url,method,KeepAlive,header,Data,DataType,retry);
|
|
end;
|
|
|
|
procedure THttpClientWebSockets.SetInt32OptionByIndex(OptName, OptVal: integer);
|
|
begin
|
|
inherited SetInt32OptionByIndex(OptName,OptVal);
|
|
if OptName=SO_RCVTIMEO then
|
|
fSettings.CallbackAnswerTimeOutMS := OptVal;
|
|
end;
|
|
|
|
function THttpClientWebSockets.Settings: PWebSocketProcessSettings;
|
|
begin
|
|
result := @fSettings;
|
|
end;
|
|
|
|
function THttpClientWebSockets.WebSocketsUpgrade(const aWebSocketsURI,
|
|
aWebSocketsEncryptionKey: RawUTF8; aWebSocketsAJAX: boolean;
|
|
aWebSocketsCompression: boolean; aProtocol: TWebSocketProtocol;
|
|
const aCustomHeaders: RawUTF8): RawUTF8;
|
|
var key: TAESBlock;
|
|
bin1,bin2: RawByteString;
|
|
extin,extout,prot: RawUTF8;
|
|
extins: TRawUTF8DynArray;
|
|
cmd: SockString;
|
|
digest1,digest2: TSHA1Digest;
|
|
begin
|
|
try
|
|
try
|
|
if fProcess<>nil then begin
|
|
result := 'Already upgraded to WebSockets';
|
|
if IdemPropNameU(fProcess.Protocol.URI,aWebSocketsURI) then
|
|
result := result+' on this URI' else
|
|
result := FormatUTF8('% with URI=[%] but requested [%]',
|
|
[result,fProcess.Protocol.URI,aWebSocketsURI]);
|
|
exit;
|
|
end;
|
|
if aProtocol = nil then
|
|
if aWebSocketsAJAX then
|
|
aProtocol := TWebSocketProtocolJSON.Create(aWebSocketsURI) else
|
|
aProtocol := TWebSocketProtocolBinary.Create(
|
|
aWebSocketsURI,false,aWebSocketsEncryptionKey,aWebSocketsCompression);
|
|
aProtocol.fOnBeforeIncomingFrame := fOnBeforeIncomingFrame;
|
|
RequestSendHeader(aWebSocketsURI,'GET');
|
|
TAESPRNG.Main.FillRandom(key);
|
|
bin1 := BinToBase64(@key,sizeof(key));
|
|
SockSend(['Content-Length: 0'#13#10'Connection: Upgrade'#13#10+
|
|
'Upgrade: websocket'#13#10'Sec-WebSocket-Key: ',bin1,#13#10+
|
|
'Sec-WebSocket-Protocol: ',aProtocol.GetSubprotocols,#13#10+
|
|
'Sec-WebSocket-Version: 13']);
|
|
if aProtocol.ProcessHandshake(nil,extout,nil) and (extout<>'') then
|
|
SockSend(['Sec-WebSocket-Extensions: ',extout]);
|
|
if aCustomHeaders<>'' then
|
|
SockSend(aCustomHeaders);
|
|
SockSend; // CRLF
|
|
SockSendFlush('');
|
|
SockRecvLn(cmd);
|
|
GetHeader(false);
|
|
prot := HeaderGetValue('SEC-WEBSOCKET-PROTOCOL');
|
|
result := 'Invalid HTTP Upgrade Header';
|
|
if not IdemPChar(pointer(cmd),'HTTP/1.1 101') or
|
|
not (connectionUpgrade in HeaderFlags) or (ContentLength>0) or
|
|
not IdemPropNameU(Upgrade,'websocket') or
|
|
not aProtocol.SetSubprotocol(prot) then
|
|
exit;
|
|
aProtocol.fName := prot;
|
|
result := 'Invalid HTTP Upgrade Accept Challenge';
|
|
ComputeChallenge(bin1,digest1);
|
|
bin2 := HeaderGetValue('SEC-WEBSOCKET-ACCEPT');
|
|
if not Base64ToBin(pointer(bin2),@digest2,length(bin2),sizeof(digest2),false) or
|
|
not IsEqual(digest1,digest2) then
|
|
exit;
|
|
if extout<>'' then begin
|
|
result := 'Invalid HTTP Upgrade ProcessHandshake';
|
|
extin := HeaderGetValue('SEC-WEBSOCKET-EXTENSIONS');
|
|
CSVToRawUTF8DynArray(pointer(extin),extins,';',true);
|
|
if (extins=nil) or not aProtocol.ProcessHandshake(extins,extout,@result) then
|
|
exit;
|
|
end;
|
|
// if we reached here, connection is successfully upgraded to WebSockets
|
|
if (Server='localhost') or (Server='127.0.0.1') then begin
|
|
aProtocol.fRemoteIP := '127.0.0.1';
|
|
aProtocol.fRemoteLocalhost := true;
|
|
end else
|
|
aProtocol.fRemoteIP := Server;
|
|
result := ''; // no error message = success
|
|
fProcess := TWebSocketProcessClient.Create(self,aProtocol,fProcessName);
|
|
aProtocol := nil; // protocol instance is owned by fProcess now
|
|
finally
|
|
aProtocol.Free;
|
|
end;
|
|
except
|
|
on E: Exception do begin
|
|
FreeAndNil(fProcess);
|
|
FormatUTF8('%: %',[E,E.Message],result);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
{ TWebSocketProcessClient }
|
|
|
|
constructor TWebSocketProcessClient.Create(aSender: THttpClientWebSockets;
|
|
aProtocol: TWebSocketProtocol; const aProcessName: RawUTF8);
|
|
var endtix: Int64;
|
|
begin
|
|
fMaskSentFrames := FRAME_LEN_MASK; // https://tools.ietf.org/html/rfc6455#section-10.3
|
|
inherited Create(aSender,aProtocol,0,nil,aSender.fSettings,aProcessName);
|
|
// initialize the thread after everything is set (Execute may be instant)
|
|
fClientThread := TWebSocketProcessClientThread.Create(self);
|
|
endtix := GetTickCount64+5000;
|
|
repeat // wait for TWebSocketProcess.ProcessLoop to initiate
|
|
SleepHiRes(0);
|
|
until fProcessEnded or (fState<>wpsCreate) or (GetTickCount64>endtix);
|
|
end;
|
|
|
|
destructor TWebSocketProcessClient.Destroy;
|
|
var tix: Int64;
|
|
begin
|
|
with WebSocketLog.Enter('Destroy: ThreadState=%', [ToText(fClientThread.fThreadState)^], self) do
|
|
try
|
|
// focConnectionClose would be handled in this thread -> close client thread
|
|
fClientThread.Terminate;
|
|
tix := GetTickCount64+7000; // never wait forever
|
|
while (fClientThread.fThreadState=sRun) and (GetTickCount64<tix) do
|
|
SleepHiRes(1);
|
|
fClientThread.fProcess := nil;
|
|
finally
|
|
// SendPendingOutgoingFrames + SendFrame/GetFrame(focConnectionClose)
|
|
inherited Destroy;
|
|
fClientThread.Free;
|
|
end;
|
|
end;
|
|
|
|
function TWebSocketProcessClient.ComputeContext(
|
|
out RequestProcess: TOnHttpServerRequest): THttpServerRequest;
|
|
begin
|
|
RequestProcess := (fSocket as THttpClientWebSockets).fOnCallbackRequestProcess;
|
|
if Assigned(RequestProcess) then
|
|
result := THttpServerRequest.Create(nil,0,fOwnerThread) else
|
|
result := nil;
|
|
end;
|
|
|
|
|
|
{ TWebSocketProcessClientThread }
|
|
|
|
constructor TWebSocketProcessClientThread.Create(aProcess: TWebSocketProcessClient);
|
|
begin
|
|
fProcess := aProcess;
|
|
fProcess.fOwnerThread := self;
|
|
inherited Create({suspended=}false);
|
|
end;
|
|
|
|
procedure TWebSocketProcessClientThread.Execute;
|
|
begin
|
|
try
|
|
fThreadState := sRun;
|
|
if fProcess<>nil then // may happen when debugging under FPC (alf)
|
|
SetCurrentThreadName('% % %',[fProcess.fProcessName,self,fProcess.Protocol.Name]);
|
|
WebSocketLog.Add.Log(sllDebug,'Execute: before ProcessLoop %', [fProcess], self);
|
|
if not Terminated and (fProcess<>nil) then
|
|
fProcess.ProcessLoop;
|
|
WebSocketLog.Add.Log(sllDebug,'Execute: after ProcessLoop %',[fProcess],self);
|
|
if (fProcess<>nil) and (fProcess.Socket<>nil) and
|
|
fProcess.Socket.InheritsFrom(THttpClientWebSockets) then
|
|
with THttpClientWebSockets(fProcess.Socket) do
|
|
if Assigned(OnWebSocketsClosed) then
|
|
OnWebSocketsClosed(self);
|
|
except // ignore any exception in the thread
|
|
end;
|
|
fThreadState := sFinished; // safely set final state
|
|
if (fProcess<>nil) and (fProcess.fState=wpsClose) then
|
|
fThreadState := sClosed;
|
|
WebSocketLog.Add.Log(sllDebug,'Execute: done (%)',[ToText(fThreadState)^],self);
|
|
end;
|
|
|
|
|
|
{ ------------ client or server asynchronous process of multiple connections }
|
|
|
|
{ TAsynchConnection }
|
|
|
|
constructor TAsynchConnection.Create(const aRemoteIP: RawUTF8);
|
|
begin
|
|
inherited Create;
|
|
fRemoteIP := aRemoteIP;
|
|
end;
|
|
|
|
procedure TAsynchConnection.AfterCreate(Sender: TAsynchConnections);
|
|
begin
|
|
fLastOperation := UnixTimeUTC;
|
|
end;
|
|
|
|
procedure TAsynchConnection.OnLastOperationIdle(Sender: TAsynchConnections);
|
|
begin
|
|
fLastOperation := UnixTimeUTC;
|
|
end;
|
|
|
|
procedure TAsynchConnection.AfterWrite(Sender: TAsynchConnections);
|
|
begin // do nothing
|
|
end;
|
|
|
|
procedure TAsynchConnection.BeforeDestroy(Sender: TAsynchConnections);
|
|
begin
|
|
fHandle := 0; // to detect any dangling pointer
|
|
end;
|
|
|
|
|
|
{ TAsynchConnectionsSockets }
|
|
|
|
procedure TAsynchConnectionsSockets.OnClose(connection: TObject);
|
|
begin
|
|
// caller did call Stop() before calling OnClose (socket=0)
|
|
fOwner.fLog.Add.Log(sllTrace,'OnClose%',[connection],self);
|
|
fOwner.ConnectionDelete((connection as TAsynchConnection).Handle); // do connection.Free
|
|
end;
|
|
|
|
function TAsynchConnectionsSockets.OnError(connection: TObject;
|
|
events: TPollSocketEvents): boolean;
|
|
begin
|
|
fOwner.fLog.Add.Log(sllDebug,'OnError% events=[%] -> free socket and instance',
|
|
[connection,GetSetName(TypeInfo(TPollSocketEvents),events)],self);
|
|
result := acoOnErrorContinue in fOwner.Options; // false=close by default
|
|
end;
|
|
|
|
function TAsynchConnectionsSockets.OnRead(connection: TObject): TPollAsynchSocketOnRead;
|
|
var ac: TAsynchConnection;
|
|
begin
|
|
ac := connection as TAsynchConnection;
|
|
if not(acoNoLogRead in fOwner.Options) then
|
|
fOwner.fLog.Add.Log(sllTrace,'OnRead% len=%',[ac,length(ac.fSlot.readbuf)],self);
|
|
result := ac.OnRead(fOwner);
|
|
if not (acoLastOperationNoRead in fOwner.Options) then
|
|
ac.fLastOperation := UnixTimeUTC;
|
|
end;
|
|
|
|
function TAsynchConnectionsSockets.SlotFromConnection(connection: TObject): PPollSocketsSlot;
|
|
begin
|
|
try
|
|
if (connection=nil) or not connection.InheritsFrom(TAsynchConnection) or
|
|
(TAsynchConnection(connection).Handle=0) then begin
|
|
fOwner.fLog.Add.Log(sllStackTrace,'SlotFromConnection() with dangling pointer %',
|
|
[connection],self);
|
|
result := nil;
|
|
end else
|
|
result := @TAsynchConnection(connection).fSlot;
|
|
except
|
|
fOwner.fLog.Add.Log(sllError,'SlotFromConnection() with dangling pointer %',
|
|
[pointer(connection)],self);
|
|
result := nil;
|
|
end;
|
|
end;
|
|
|
|
function TAsynchConnectionsSockets.Write(connection: TObject;
|
|
const data; datalen, timeout: integer): boolean;
|
|
var tmp: TLogEscape;
|
|
begin
|
|
result := inherited Write(connection,data,datalen,timeout);
|
|
if result and not (acoLastOperationNoWrite in fOwner.Options) then
|
|
(connection as TAsynchConnection).fLastOperation := UnixTimeUTC;
|
|
if (fOwner.fLog<>nil) and not(acoNoLogWrite in fOwner.Options) then
|
|
fOwner.fLog.Add.Log(sllTrace,'Write%=% len=%%',
|
|
[connection,BOOL_STR[result],datalen,LogEscape(@data,datalen,tmp,
|
|
acoVerboseLog in fOwner.Options)],self);
|
|
end;
|
|
|
|
procedure TAsynchConnectionsSockets.AfterWrite(connection: TObject);
|
|
begin
|
|
(connection as TAsynchConnection).AfterWrite(fOwner);
|
|
end;
|
|
|
|
function TAsynchConnectionsSockets.GetTotal: integer;
|
|
begin
|
|
result := fOwner.fLastHandle; // by definition
|
|
end;
|
|
|
|
|
|
{ TAsynchConnectionsThread }
|
|
|
|
constructor TAsynchConnectionsThread.Create(aOwner: TAsynchConnections;
|
|
aProcess: TPollSocketEvent);
|
|
begin
|
|
fOwner := aOwner;
|
|
fProcess := aProcess;
|
|
fOnThreadTerminate := fOwner.fOnThreadTerminate;
|
|
inherited Create(false);
|
|
end;
|
|
|
|
procedure TAsynchConnectionsThread.Execute;
|
|
var idletix: Int64;
|
|
begin
|
|
SetCurrentThreadName('% % %',[fOwner.fProcessName,self,ToText(fProcess)^]);
|
|
fOwner.NotifyThreadStart(self);
|
|
try
|
|
idletix := {$ifdef FPCLINUX}SynFPCLinux.{$endif}GetTickCount64+1000;
|
|
while not Terminated and (fOwner.fClients<>nil) do begin
|
|
// implement parallel client connections for TAsynchClient
|
|
if (fOwner.fThreadClients.Count>0) and
|
|
(InterlockedDecrement(fOwner.fThreadClients.Count)>=0) then
|
|
fOwner.ThreadClientsConnect else
|
|
// generic TAsynchConnections read/write process
|
|
case fProcess of
|
|
pseRead:
|
|
fOwner.fClients.ProcessRead(30000);
|
|
pseWrite: begin
|
|
fOwner.fClients.ProcessWrite(30000);
|
|
if {$ifdef FPCLINUX}SynFPCLinux.{$endif}GetTickCount64>=idletix then begin
|
|
fOwner.IdleEverySecond; // may take some time -> retrieve ticks again
|
|
idletix := {$ifdef FPCLINUX}SynFPCLinux.{$endif}GetTickCount64+1000;
|
|
end;
|
|
end;
|
|
else
|
|
raise EAsynchConnections.CreateUTF8('%.Execute: unexpected fProcess=%',
|
|
[self,ToText(fProcess)^]);
|
|
end;
|
|
end;
|
|
except
|
|
on E: Exception do
|
|
fOwner.fLog.Add.Log(sllWarning,'Execute raised a % -> terminate % thread',
|
|
[E.ClassType,fOwner.fStreamClass],self);
|
|
end;
|
|
fOwner.fLog.Add.Log(sllDebug,'Execute: done', self);
|
|
end;
|
|
|
|
|
|
{ TAsynchConnections }
|
|
|
|
function TAsynchConnectionCompareByHandle(const A,B): integer;
|
|
begin // for fast binary search from the connection handle
|
|
result := TAsynchConnection(A).Handle-TAsynchConnection(B).Handle;
|
|
end;
|
|
|
|
constructor TAsynchConnections.Create(OnStart, OnStop: TNotifyThreadEvent;
|
|
aStreamClass: TAsynchConnectionClass; const ProcessName: SockString;
|
|
aLog: TSynLogClass; aOptions: TAsynchConnectionsOptions; aThreadPoolCount: integer);
|
|
var i: integer;
|
|
log: ISynLog;
|
|
begin
|
|
log := aLog.Enter('Create(%,%,%)',[aStreamClass,ProcessName,aThreadPoolCount],self);
|
|
if (aStreamClass=TAsynchConnection) or (aStreamClass=nil) then
|
|
raise EAsynchConnections.CreateUTF8('%.Create(%)',[self,aStreamClass]);
|
|
if aThreadPoolCount<=0 then
|
|
aThreadPoolCount := 1;
|
|
fLog := aLog;
|
|
fStreamClass := aStreamClass;
|
|
fConnectionLock.Init;
|
|
fConnections.Init(TypeInfo(TAsynchConnectionObjArray),fConnection,@fConnectionCount);
|
|
fConnections.Compare := TAsynchConnectionCompareByHandle;
|
|
fConnections.IsObjArray := false; // to call TAsynchConnection.BeforeDestroy
|
|
fClients := TAsynchConnectionsSockets.Create;
|
|
fClients.fOwner := self;
|
|
fTempConnectionForSearchPerHandle := fStreamClass.Create('');
|
|
fOptions := aOptions;
|
|
inherited Create(false,OnStart,OnStop,ProcessName);
|
|
SetLength(fThreads,aThreadPoolCount+1);
|
|
fThreads[0] := TAsynchConnectionsThread.Create(self,pseWrite);
|
|
for i := 1 to aThreadPoolCount do
|
|
fThreads[i] := TAsynchConnectionsThread.Create(self,pseRead);
|
|
end;
|
|
|
|
destructor TAsynchConnections.Destroy;
|
|
var i: integer;
|
|
begin
|
|
with fClients do
|
|
fLog.Add.Log(sllDebug,'Destroy total=% reads=%/% writes=%/%',[Total,
|
|
ReadCount,KB(ReadBytes),WriteCount,KB(WriteBytes)],self);
|
|
Terminate;
|
|
for i := 0 to high(fThreads) do
|
|
fThreads[i].Terminate; // stop ProcessRead/ProcessWrite when polling stops
|
|
FreeAndNil(fClients); // stop polling and refuse further Write/ConnectionRemove
|
|
ObjArrayClear(fThreads);
|
|
inherited Destroy;
|
|
for i := 0 to fConnectionCount-1 do
|
|
try
|
|
fConnection[i].BeforeDestroy(self);
|
|
fConnection[i].Free;
|
|
except
|
|
end;
|
|
fConnectionLock.Done;
|
|
fTempConnectionForSearchPerHandle.Free;
|
|
end;
|
|
|
|
procedure TAsynchConnections.ThreadClientsConnect;
|
|
var client: TSocket;
|
|
connection: TAsynchConnection;
|
|
begin
|
|
with fThreadClients do
|
|
client := CallServer(Address,Port,false,cslTCP,Timeout);
|
|
if client<0 then
|
|
raise ECrtSocket.CreateFmt('%s: %s:%s connection failure', // ECrtSocket for error
|
|
[ClassName,fThreadClients.Address,fThreadClients.Port],-1);
|
|
connection := nil;
|
|
if not ConnectionCreate(client,{ip=}'',connection) then
|
|
DirectShutdown(client);
|
|
end;
|
|
|
|
function TAsynchConnections.ConnectionCreate(aSocket: TSocket; const aRemoteIp: RawUTF8;
|
|
out aConnection: TAsynchConnection): boolean;
|
|
begin // you can override this class then call ConnectionAdd
|
|
if Terminated then
|
|
result := false else begin
|
|
aConnection := fStreamClass.Create(aRemoteIP);
|
|
result := ConnectionAdd(aSocket,aConnection);
|
|
end;
|
|
end;
|
|
|
|
function TAsynchConnections.ConnectionAdd(aSocket: TSocket;
|
|
aConnection: TAsynchConnection): boolean;
|
|
begin
|
|
result := false; // caller should release aSocket
|
|
if Terminated then
|
|
exit;
|
|
aConnection.fSlot.socket := aSocket;
|
|
fConnectionLock.Lock;
|
|
try
|
|
inc(fLastHandle);
|
|
aConnection.fHandle := fLastHandle;
|
|
fConnections.Add(aConnection);
|
|
fLog.Add.Log(sllTrace,'ConnectionAdd% count=%',[aConnection,fConnectionCount],self);
|
|
fConnections.Sorted := true; // handles are increasing
|
|
finally
|
|
fConnectionLock.UnLock;
|
|
end;
|
|
aConnection.AfterCreate(self);
|
|
result := true; // indicates aSocket owned by the pool
|
|
end;
|
|
|
|
function TAsynchConnections.ConnectionDelete(
|
|
aConnection: TAsynchConnection; aIndex: integer): boolean;
|
|
var t: TClass;
|
|
h: TAsynchConnectionHandle;
|
|
begin // caller should have done fConnectionLock.Lock
|
|
try
|
|
h := aConnection.Handle;
|
|
t := aConnection.ClassType;
|
|
aConnection.BeforeDestroy(self);
|
|
aConnection.Free;
|
|
finally
|
|
fConnections.FastDeleteSorted(aIndex);
|
|
end;
|
|
fLog.Add.Log(sllTrace,'ConnectionDelete %.Handle=% count=%',[t,h,fConnectionCount],self);
|
|
result := true;
|
|
end;
|
|
|
|
function TAsynchConnections.ConnectionDelete(aHandle: TAsynchConnectionHandle): boolean;
|
|
var i: integer;
|
|
conn: TAsynchConnection;
|
|
begin // don't call fClients.Stop() here - see ConnectionRemove()
|
|
result := false;
|
|
if Terminated or (aHandle<=0) then
|
|
exit;
|
|
conn := ConnectionFindLocked(aHandle,@i);
|
|
if conn<>nil then
|
|
try
|
|
result := ConnectionDelete(conn,i);
|
|
finally
|
|
fConnectionLock.UnLock;
|
|
end;
|
|
if not result then
|
|
fLog.Add.Log(sllTrace,'ConnectionDelete(%)=false count=%',
|
|
[aHandle,fConnectionCount],self);
|
|
end;
|
|
|
|
function TAsynchConnections.ConnectionFindLocked(aHandle: TAsynchConnectionHandle;
|
|
aIndex: PInteger): TAsynchConnection;
|
|
var i: integer;
|
|
begin
|
|
result := nil;
|
|
if (self=nil) or Terminated or (aHandle<=0) then
|
|
exit;
|
|
fConnectionLock.Lock;
|
|
try
|
|
fTempConnectionForSearchPerHandle.fHandle := aHandle;
|
|
i := fConnections.Find(fTempConnectionForSearchPerHandle); // fast O(log(n)) binary search
|
|
if i>=0 then begin
|
|
result := fConnection[i];
|
|
if aIndex<>nil then
|
|
aIndex^ := i;
|
|
end;
|
|
fLog.Add.Log(sllTrace,'ConnectionFindLocked(%)=%',[aHandle,result],self);
|
|
finally
|
|
if result=nil then
|
|
fConnectionLock.UnLock;
|
|
end;
|
|
end;
|
|
|
|
function TAsynchConnections.ConnectionRemove(aHandle: TAsynchConnectionHandle): boolean;
|
|
var i: integer;
|
|
conn: TAsynchConnection;
|
|
begin
|
|
result := false;
|
|
if (self=nil) or Terminated or (aHandle<=0) then
|
|
exit;
|
|
conn := ConnectionFindLocked(aHandle,@i);
|
|
if conn<>nil then
|
|
try
|
|
if not fClients.Stop(conn) then
|
|
fLog.Add.Log(sllDebug,'ConnectionRemove: Stop=false for %',[conn],self);
|
|
result := ConnectionDelete(conn,i);
|
|
finally
|
|
fConnectionLock.UnLock;
|
|
end;
|
|
if not result then
|
|
fLog.Add.Log(sllTrace,'ConnectionRemove(%)=false',[aHandle],self);
|
|
end;
|
|
|
|
procedure TAsynchConnections.Lock;
|
|
begin
|
|
fConnectionLock.Lock;
|
|
end;
|
|
|
|
procedure TAsynchConnections.Unlock;
|
|
begin
|
|
fConnectionLock.UnLock;
|
|
end;
|
|
|
|
function TAsynchConnections.Write(connection: TAsynchConnection;
|
|
const data; datalen: integer): boolean;
|
|
begin
|
|
if Terminated then
|
|
result := false else
|
|
result := fClients.Write(connection,data,datalen);
|
|
end;
|
|
|
|
function TAsynchConnections.Write(connection: TAsynchConnection;
|
|
const data: SockString): boolean;
|
|
begin
|
|
if Terminated then
|
|
result := false else
|
|
result := fClients.WriteString(connection,data);
|
|
end;
|
|
|
|
procedure TAsynchConnections.LogVerbose(connection: TAsynchConnection;
|
|
const ident: RawUTF8; frame: pointer; framelen: integer);
|
|
var tmp: TLogEscape;
|
|
begin
|
|
if not(acoNoLogRead in Options) and (acoVerboseLog in Options) and (fLog<>nil) then
|
|
fLog.Add.Log(sllTrace,'% len=%%',[ident,framelen,
|
|
LogEscape(frame,framelen,tmp)],connection);
|
|
end;
|
|
|
|
procedure TAsynchConnections.LogVerbose(connection: TAsynchConnection;
|
|
const ident: RawUTF8; const frame: RawByteString);
|
|
begin
|
|
LogVerbose(connection,ident,pointer(frame),length(frame));
|
|
end;
|
|
|
|
procedure TAsynchConnections.IdleEverySecond;
|
|
var i,n: integer;
|
|
allowed: cardinal;
|
|
log: ISynLog;
|
|
begin
|
|
if Terminated or (LastOperationIdleSeconds<=0) then
|
|
exit;
|
|
fConnectionLock.Lock;
|
|
try
|
|
n := 0;
|
|
allowed := UnixTimeUTC-LastOperationIdleSeconds;
|
|
for i := 0 to fConnectionCount-1 do
|
|
if fConnection[i].fLastOperation<allowed then
|
|
try
|
|
if log=nil then
|
|
log := fLog.Enter(self{$ifndef DELPHI5OROLDER},'IdleEverySecond'{$endif});
|
|
fConnection[i].OnLastOperationIdle(self);
|
|
inc(n);
|
|
except
|
|
end;
|
|
if log<>nil then
|
|
log.Log(sllTrace,'IdleEverySecond notified % %',[n,fStreamClass],self);
|
|
finally
|
|
fConnectionLock.UnLock;
|
|
end;
|
|
end;
|
|
|
|
|
|
{ TAsynchServer }
|
|
|
|
constructor TAsynchServer.Create(const aPort: SockString; OnStart,
|
|
OnStop: TNotifyThreadEvent; aStreamClass: TAsynchConnectionClass;
|
|
const ProcessName: SockString; aLog: TSynLogClass;
|
|
aOptions: TAsynchConnectionsOptions; aThreadPoolCount: integer);
|
|
begin
|
|
fServer := TCrtSocket.Bind(aPort);
|
|
inherited Create(OnStart,OnStop,aStreamClass,ProcessName,aLog,aOptions,aThreadPoolCount);
|
|
end;
|
|
|
|
destructor TAsynchServer.Destroy;
|
|
var endtix: Int64;
|
|
begin
|
|
Terminate;
|
|
fServer.Close; // shutdown the socket to unlock Accept() in Execute
|
|
DirectShutdown(CallServer('127.0.0.1',fServer.Port,false,cslTCP,1)); // paranoid
|
|
endtix := GetTickCount64+10000;
|
|
inherited Destroy;
|
|
while not fExecuteFinished and (GetTickCount64<endtix) do
|
|
SleepHiRes(1); // wait for Execute to be finalized (unlikely)
|
|
fServer.Free;
|
|
end;
|
|
|
|
procedure TAsynchServer.Execute;
|
|
var client: TSocket;
|
|
connection: TAsynchConnection;
|
|
sin: TVarSin;
|
|
ip: SockString;
|
|
err: string;
|
|
begin
|
|
SetCurrentThreadName('% % Accept',[fProcessName,self]);
|
|
NotifyThreadStart(self);
|
|
if fServer.Sock<>0 then
|
|
try
|
|
while not Terminated do begin
|
|
client := Accept(fServer.Sock,sin);
|
|
if client<0 then
|
|
if Terminated then
|
|
break else begin
|
|
err := SocketErrorMessage;
|
|
fLog.Add.Log(sllWarning,'Execute: Accept()=%',[err],self);
|
|
if acoOnAcceptFailureStop in fOptions then
|
|
if WSAGetLastError=WSAEMFILE then
|
|
raise EAsynchConnections.CreateUTF8('%.Execute: too many connections', [self]) else
|
|
raise EAsynchConnections.CreateUTF8('%.Execute: Accept failed as %',[self,err]);
|
|
SleepHiRes(1);
|
|
continue;
|
|
end;
|
|
if Terminated then begin
|
|
DirectShutdown(client);
|
|
break;
|
|
end;
|
|
IPText(sin,ip);
|
|
if ConnectionCreate(client,ip,connection) then
|
|
if fClients.Start(connection) then
|
|
fLog.Add.Log(sllTrace,'Execute: Accept()=%',[connection], self) else
|
|
connection.Free else
|
|
DirectShutdown(client);
|
|
end;
|
|
except
|
|
on E: Exception do
|
|
fLog.Add.Log(sllWarning,'Execute raised % -> terminate %',
|
|
[E.ClassType,fProcessName],self);
|
|
end;
|
|
fLog.Add.Log(sllDebug, 'Execute: % done', [fProcessName], self);
|
|
fExecuteFinished := true;
|
|
end;
|
|
|
|
|
|
|
|
{ TAsynchClient }
|
|
|
|
constructor TAsynchClient.Create(const aServer, aPort: SockString;
|
|
aClientsCount,aClientsTimeoutSecs: integer; OnStart, OnStop: TNotifyThreadEvent;
|
|
aStreamClass: TAsynchConnectionClass; const ProcessName: SockString;
|
|
aLog: TSynLogClass; aOptions: TAsynchConnectionsOptions; aThreadPoolCount: integer);
|
|
begin
|
|
fThreadClients.Count := aClientsCount;
|
|
fThreadClients.Timeout := aClientsTimeoutSecs*1000;
|
|
fThreadClients.Address := aServer;
|
|
fThreadClients.Port := aPort;
|
|
inherited Create(OnStart,OnStop,aStreamClass,ProcessName,aLog,aOptions,aThreadPoolCount);
|
|
end;
|
|
|
|
procedure TAsynchClient.Execute;
|
|
begin
|
|
SetCurrentThreadName('% %',[fProcessName,self]);
|
|
NotifyThreadStart(self);
|
|
try
|
|
while InterlockedDecrement(fThreadClients.Count)>=0 do
|
|
ThreadClientsConnect; // will connect some clients in this main thread
|
|
except
|
|
on E: Exception do
|
|
fLog.Add.Log(sllWarning,'Execute raised % -> terminate %',
|
|
[E.ClassType,fProcessName],self);
|
|
end;
|
|
fLog.Add.Log(sllDebug, 'Execute: % done', [fProcessName], self);
|
|
end;
|
|
|
|
|
|
initialization
|
|
GetEnumNames(TypeInfo(TWebSocketFrameOpCode),@_TWebSocketFrameOpCode);
|
|
GetEnumNames(TypeInfo(TWebSocketProcessNotifyCallback),@_TWebSocketProcessNotifyCallback);
|
|
end.
|