unit SynBidirSock;

{$I Synopse.inc} // define HASINLINE CPU32 CPU64 OWNNORMTOUPPER

{$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

/// 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;

function PurgeHeaders(P: PUTF8Char): RawUTF8;

/// 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;

/// 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;