Permalink
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
12217 lines (11394 sloc) 459 KB
/// classes implementing HTTP/1.1 client and server protocol
// - this unit is a part of the freeware Synopse mORMot framework,
// licensed under a MPL/GPL/LGPL tri-license; version 1.18
unit SynCrtSock;
{
This file is part of Synopse framework.
Synopse framework. Copyright (C) 2018 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) 2018
the Initial Developer. All Rights Reserved.
Contributor(s):
- Alfred Glaenzer (alf)
- Cybexr
- EMartin
- Eric Grange
- EvaF
- f-vicente
- Maciej Izak (hnb)
- Marius Maximus
- Pavel (mpv)
- Willo vd Merwe
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 *****
TCP/IP and HTTP/1.1 Client and Server
***************************************
Initial version: 2009 May, by Arnaud Bouchez
Version 1.4 - February 8, 2010
- whole Synopse SQLite3 database framework released under the GNU Lesser
General Public License version 3, instead of generic "Public Domain"
- fix a bug happening when multiple HTTP connections were opened and
closed in the same program
Version 1.5 - March 1, 2010
- new generic unix implementation, using libc sockets, in SynLibcSock.pas
Version 1.9
- avoid some GPF during client deconnection when the server shut down
- rewrite HTTP Server handle request loop keep alive timing
- HTTP Server now use a Thread Pool to speed up multi-connections: this
speed up a lot HTTP/1.0 requests, by creating a Thread only if
necessary
Version 1.9.2
- deleted deprecated DOS related code (formerly used with DWPL Dos Extender)
- a dedicated thread is now used if the incoming HTTP request has
POSTed a body content of more than 16 KB (to avoid Deny Of Service, and
preserve the Thread Pool to only real small processes)
- new CROnly parameter for TCrtSocket.SockRecvLn, to handle #13 as
line delimiter: by default, #10 or #13#10 are line delimiters
(as for normal Window/Linux text files)
Version 1.12
- added connection check and exception handling in
THttpServerSocket.GetRequest, which now is a function returning a boolean
- added DOS / TCP SYN Flood detection if THttpServerSocket.GetRequest
spent more than 2 seconds to get header from HTTP Client
Version 1.13
- code modifications to compile with Delphi 5 compiler
- new THttpApiServer class, using fast http.sys kernel-mode server
for better performance and less resource usage
- DOS / TCP SYN Flood detection time enhanced to 5 seconds
- fixed HTTP client stream layout (to be more RFC compliant)
- new generic compression handling mechanism: can handle gzip, deflate
or custom synlz / synlzo algorithms via THttpSocketCompress functions
- new THttpServerGeneric.Request virtual abstract method prototype
- new TWinINet class, using WinINet API (very slow, do not use)
- new TWinHTTP class, using WinHTTP API (faster than THttpClientSocket):
this is the class to be used
Version 1.15
- unit now tested with Delphi XE2 (32 Bit)
- fixed issue in HTTP_RESPONSE.SetHeaders()
Version 1.16
- fixed issue in case of wrong void parameter e.g. in THttpApiServer.AddUrl
- circumvent some bugs of Delphi XE2 background compiler (main compiler is OK)
- added 'RemoteIP: 127.0.0.1' to the retrieved HTTP headers
- major speed up of THttpApiServer for Windows Vista and up, by processing
huge content in chunks: upload of 100Mb file take 25 sec before and 6 sec
after changes, according to feedback by MPV - ticket 711247b998
- new THttpServerGeneric.OnHttpThreadTerminate event, available to clean-up
any process in the thread context, when it is terminated (to call e.g.
TSQLDBConnectionPropertiesThreadSafe.EndCurrentThread in order to call
CoUnInitialize from thread in which CoInitialize was initialy made) - see
https://synopse.info/fossil/tktview?name=213544b2f5
Version 1.17
- replaced TSockData string type to the generic RawByteString type (and
the default AnsiString for non-Unicode version of Delphi)
- added optional aProxyName, aProxyByPass parameters to TWinHttpAPI /
TWinInet and TWinHTTP constructors
- added THttpServerGeneric.OnHttpThreadStart property, and associated
TNotifyThreadEvent event prototype
- handle 'Range: bytes=***-***' request in THttpApiServer
Version 1.18
- replaced RawByteString type (defined locally for non-Unicode version of
Delphi) by a dedicated SockString type, used for data storage and for
simple ASCII content (like URIs or port number)
- added and tested Linux support (FPC/CrossKylix), via sockets or libcurl API
- introducing THttpServerRequest class for HTTP server context and THttpRequest
(replacing TWinHttpAPI) as abstract parent for HTTP client classes
- http.sys kernel-mode server now handles HTTP API 2.0 (available since
Windows Vista / Server 2008), or fall back to HTTP API 1.0 (for Windows XP
or Server 2003) - thanks pavel for the feedback and initial patch!
- deep code refactoring of thread process, especially for TSynThreadPool as
used by THttpServer: introducing TSynThread and TSynThreadPoolSubThread;
as a result, it fixes OnHttpThreadStart and OnHttpThreadTerminate to be
triggered from every thread, and propagated from THttpApiServer's clones
- added TCrtSocket.TCPNoDelay/SendTimeout/ReceiveTimeout/KeepAlive properties
- added optional parameter to set buffer size for TCrtSocket.CreateSockIn
and TCrtSocket.CreateSockOut methods
- renamed misleading TCrtSocket.Snd method as overloaded SockSend, and
refactored public fields as read/only properties
- fixed long-standing random bug occuring when a TCrtSocket connection is
closed then reopened (e.g. when THttpClientSocket.Request does its retrial);
thanks hnb for the patch!
- added THttpServerRequest.UseSSL property to check if connection is secured
- added optional queue name for THttpApiServer.Create constructor [149cf42383]
- added THttpApiServer.RemoveUrl() method
- introduced THttpApiServer.ReceiveBufferSize property
- added THttpApiServer.HTTPQueueLength property (for HTTP API 2.0 only)
- added THttpApiServer.MaxBandwidth and THttpApiServer.MaxConnections
properties (for HTTP API 2.0 only) - thanks mpv for the proposal!
- added THttpApiServer.LogStart/LogStop for HTTP API 2.0 integrated logging
- introducing new THttpApiServer.SetAuthenticationSchemes() method for HTTP
API 2.0, and the corresponding THttpServerRequest.AuthenticationStatus and
AuthenticatedUser properties
- added THttpApiServer.SetTimeOutLimits() method for HTTP API 2.0
- added THttpApiServer.ServerSessionID and UrlGroupID read-only properties
- let HTTP_RESPONSE.AddCustomHeader() recognize all known headers
- THttpApiServer won't try to send an error message when connection is broken
- added error check for HttpSendHttpResponse() API call
- added EWinHTTP exception, raised when TWinHttp client fails to connect
- added aTimeOut optional parameter to TCrtSocket.Open() constructor
- added function HtmlEncode()
- some code cleaning about 64-bit compilation (including [540628f498])
- refactored HTTP_DATA_CHUNK record definition into HTTP_DATA_CHUNK_* records
to circumvent XE3 alignemnt issue
- WinSock-based THttpServer will avoid creating a thread per connection,
when the maximum of 256 threads is reached in the pool, with an exception
of kept-alife or huge body requets (avoiding DoS attacks by limiting the
total number of created threads)
- allow WinSock-based THttpServer to set a server address ('1.2.3.4:1234')
- let WinSock-based THttpServer.Process() handle HTTP_RESP_STATICFILE
- force disable range checking and other compiler options for this unit
- included more detailed information to HTTP client User-Agent header
- added ConnectionTimeOut, SendTimeout and ReceiveTimeout optional parameters
to THttpRequest constructors - feature request [bfe485b678]
- added optional aCompressMinSize parameter to RegisterCompress() methods
- added THttpRequest.Get/Post/Put/Delete() class functions for easy remote
resource retrieval using either WinHTTP or WinINet APIs
- added TURI structure, ready to parse a supplied HTTP URI
- added ConnectionID the HTTP server context - see request [0636eeec54]
- added THttpRequest.IgnoreSSLCertificateErrors property (proposal by EMartin)
- added THttpRequest AuthScheme and AuthUserName/AuthPassword properties, for
authentication - only implemented at TWinHttp level (thanks Eric Grange)
- fixed TCrtSocket.BytesIn and TCrtSocket.BytesOut properties
- fixed ticket [82df275784] THttpRequest with responses without Content-Length
- fixed ticket [f0749956af] TWinINet does not work with HTTPS servers
- fixed ticket [842a5ae15a] THttpApiServer.Execute/SendError message
- fixed ticket [f2ae4022a4] EWinINet error handling
- fixed ticket [73da2c17b1] about Accept-Encoding header in THttpApiServer
- fixed ticket [cbcbb3b2fc] about PtrInt definition
- fixed ticket [91f8f3ec6f] about error retrieving unknown headers
- fixed ticket [f79ff5714b] about potential finalization issues as .bpl in IDE
- fixed ticket [2d53fc43e3] about unneeded port 80
- fixed ticket [11b327bd77] about TCrtSocket not working with Delphi 2009+
- fixed ticket [0f6ecdaf55] for better compatibility with HTTP/1.1 cache
- fixed ticket [814f6bd65a] about missing OnHttpThreadStart in CreateClone
- fixed ticket [51a9c086f3] about THttpApiServer.SetHTTPQueueLength()
- fixed potential Access Violation error at THttpServerResp shutdown
- removed several compilation hints when assertions are set to off
- added aRegisterURI optional parameter to THttpApiServer.AddUrl() method
- made exception error messages more explicit (tuned per module)
- fixed several issues when releasing THttpApiServer and THttpServer instances
- allow to use any Unicode content for SendEmail() - also includes
SendEmailSubject() function, for feature request [0a5fdf9129]
- added support for TLS1.1 & TLS1.2 for TWinHTTP
- added advanced exception text if case of HTTPS connection problems
- added HTTP.SYS 2.0 web socket API TWebSocketAPI
- added HTTP.SYS 2.0 based WebSocket server THttpApiWebSocketServer
- added direct SChannel API TLS support on Windows
}
{$I Synopse.inc} // define HASINLINE USETYPEINFO CPU32 CPU64 OWNNORMTOUPPER
interface
uses
{$ifdef MSWINDOWS}
Windows,
SynWinSock,
{$ifdef USEWININET}
WinInet,
{$endif}
{$ifndef DELPHI5OROLDER}
Types,
{$endif}
{$else MSWINDOWS}
{$undef USEWININET}
{$ifdef FPC}
Sockets,
SynFPCSock,
SynFPCLinux,
BaseUnix, // for fpgetrlimit/fpsetrlimit
{$else}
{$ifndef DELPHI5OROLDER}
Types,
{$endif}
{$endif}
{$ifdef KYLIX3}
KernelIoctl, // for IoctlSocket/ioctl FION* constants
LibC,
SynFPCSock, // shared with Kylix
SynKylix,
{$endif}
{$endif MSWINDOWS}
{$ifndef LVCL}
Contnrs,
SyncObjs, // for TEvent (in Classes.pas for LVCL)
{$endif}
SysUtils,
Classes;
const
/// the full text of the current Synopse mORMot framework version
// - match the value defined in SynCommons.pas and SynopseCommit.inc
// - we don't supply full version number with build revision, to reduce
// potential attack surface
XPOWEREDPROGRAM = 'mORMot 1.18';
/// the running Operating System
XPOWEREDOS = {$ifdef MSWINDOWS} 'Windows' {$else}
{$ifdef LINUXNOTBSD} 'Linux' {$else} 'Posix' {$endif LINUXNOTBSD}
{$endif MSWINDOWS};
/// used by THttpApiServer.Request for http.sys to send a static file
// - the OutCustomHeader should contain the proper 'Content-type: ....'
// corresponding to the file (e.g. by calling GetMimeContentType() function
// from SynCommons supplyings the file name)
// - should match HTML_CONTENT_STATICFILE constant defined in mORMot.pas unit
HTTP_RESP_STATICFILE = '!STATICFILE';
/// used to notify e.g. the THttpServerRequest not to wait for any response
// from the client
// - is not to be used in normal HTTP process, but may be used e.g. by
// TWebSocketProtocolRest.ProcessFrame() to avoid to wait for an incoming
// response from the other endpoint
// - should match NORESPONSE_CONTENT_TYPE constant defined in mORMot.pas unit
HTTP_RESP_NORESPONSE = '!NORESPONSE';
var
/// THttpRequest timeout default value for DNS resolution
// - leaving to 0 will let system default value be used
HTTP_DEFAULT_RESOLVETIMEOUT: integer = 0;
/// THttpRequest timeout default value for remote connection
// - default is 60 seconds
// - used e.g. by THttpRequest, TSQLHttpClientRequest and TSQLHttpClientGeneric
HTTP_DEFAULT_CONNECTTIMEOUT: integer = 60000;
/// THttpRequest timeout default value for data sending
// - default is 30 seconds
// - used e.g. by THttpRequest, TSQLHttpClientRequest and TSQLHttpClientGeneric
// - you can override this value by setting the corresponding parameter in
// THttpRequest.Create() constructor
HTTP_DEFAULT_SENDTIMEOUT: integer = 30000;
/// THttpRequest timeout default value for data receiving
// - default is 30 seconds
// - used e.g. by THttpRequest, TSQLHttpClientRequest and TSQLHttpClientGeneric
// - you can override this value by setting the corresponding parameter in
// THttpRequest.Create() constructor
HTTP_DEFAULT_RECEIVETIMEOUT: integer = 30000;
type
{$ifdef UNICODE}
/// define the fastest Unicode string type of the compiler
SynUnicode = UnicodeString;
/// define a raw 8-bit storage string type, used for data buffer management
SockString = type RawByteString;
{$else}
/// define the fastest 16-bit Unicode string type of the compiler
SynUnicode = WideString;
{$ifdef HASCODEPAGE} // FPC may expect a CP, e.g. to compare two string constants
SockString = type RawByteString;
{$else}
/// define a 8-bit raw storage string type, used for data buffer management
SockString = type AnsiString;
{$endif}
{$endif}
/// points to a 8-bit raw storage variable, used for data buffer management
PSockString = ^SockString;
/// defines a dynamic array of SockString
TSockStringDynArray = array of SockString;
{$ifdef DELPHI5OROLDER}
// not defined in Delphi 5 or older
PPointer = ^Pointer;
TTextLineBreakStyle = (tlbsLF, tlbsCRLF);
UTF8String = AnsiString;
UTF8Encode = AnsiString;
{$endif}
{$ifndef FPC}
/// FPC 64-bit compatibility integer type
{$ifdef CPU64}
PtrInt = NativeInt;
PtrUInt = NativeUInt;
{$else}
PtrInt = integer;
PtrUInt = cardinal;
{$endif}
PPtrInt = ^PtrInt;
PPtrUInt = ^PtrUInt;
{$endif FPC}
{$M+}
/// exception thrown by the classes of this unit
ECrtSocket = class(Exception)
protected
fLastError: integer;
public
/// will concat the message with the WSAGetLastError information
constructor Create(const Msg: string); overload;
/// will concat the message with the supplied WSAGetLastError information
constructor Create(const Msg: string; Error: integer); overload;
/// will concat the message with the supplied WSAGetLastError information
constructor CreateFmt(const Msg: string; const Args: array of const; Error: integer); overload;
published
/// the associated WSAGetLastError value
property LastError: integer read fLastError;
end;
{$M-}
TCrtSocketClass = class of TCrtSocket;
/// the available available network transport layer
// - either TCP/IP, UDP/IP or Unix sockets
TCrtSocketLayer = (cslTCP, cslUDP, cslUNIX);
/// identify the incoming data availability in TCrtSocket.SockReceivePending
TCrtSocketPending = (cspSocketError, cspNoData, cspDataAvailable);
PTextFile = ^TextFile;
{$M+}
/// Fast low-level Socket implementation
// - direct access to the OS (Windows, Linux) network layer API
// - use Open constructor to create a client to be connected to a server
// - use Bind constructor to initialize a server
// - use SockIn and SockOut (after CreateSock*) to read/readln or write/writeln
// as with standard Delphi text files (see SendEmail implementation)
// - even if you do not use read(SockIn^), you may call CreateSockIn then
// read the (binary) content via SockInRead/SockInPending methods, which would
// benefit of the SockIn^ input buffer to maximize reading speed
// - to write data, CreateSockOut and write(SockOut^) is not mandatory: you
// rather may use SockSend() overloaded methods, followed by a SockFlush call
// - in fact, you can decide whatever to use none, one or both SockIn/SockOut
// - since this class rely on its internal optimized buffering system,
// TCP_NODELAY is set to disable the Nagle algorithm
// - our classes are (much) faster than the Indy or Synapse implementation
TCrtSocket = class
protected
fSock: TSocket;
fServer: SockString;
fPort: SockString;
fSockIn: PTextFile;
fSockOut: PTextFile;
fTimeOut: cardinal;
fBytesIn: Int64;
fBytesOut: Int64;
fSocketLayer: TCrtSocketLayer;
fSockInEof, fTLS: boolean;
// updated by every SockSend() call
fSndBuf: SockString;
fSndBufLen: integer;
// updated during UDP connection, accessed via PeerAddress/PeerPort
fPeerAddr: TSockAddr;
{$ifdef MSWINDOWS}
fSecure: TSChannelClient;
{$endif MSWINDOWS}
procedure SetInt32OptionByIndex(OptName, OptVal: integer); virtual;
procedure AcceptRequest(aClientSock: TSocket; aRemoteIP: PSockString);
public
/// common initialization of all constructors
// - do not call directly, but use Open / Bind constructors instead
constructor Create(aTimeOut: cardinal=10000); reintroduce; virtual;
/// connect to aServer:aPort
// - you may ask for a TLS secured client connection (only available under
// Windows by now, using the SChanell API - and not fully tested)
constructor Open(const aServer, aPort: SockString; aLayer: TCrtSocketLayer=cslTCP;
aTimeOut: cardinal=10000; aTLS: boolean=false);
/// bind to a Port
// - expects the port to be specified as Ansi string, e.g. '1234'
// - you can optionally specify a server address to bind to, e.g.
// '1.2.3.4:1234'
constructor Bind(const aPort: SockString; aLayer: TCrtSocketLayer=cslTCP);
/// low-level internal method called by Open() and Bind() constructors
// - raise an ECrtSocket exception on error
// - you may ask for a TLS secured client connection (only available under
// Windows by now, using the SChanell API - and not fully tested)
procedure OpenBind(const aServer, aPort: SockString; doBind: boolean;
aSock: integer=-1; aLayer: TCrtSocketLayer=cslTCP; aTLS: boolean=false);
/// initialize SockIn for receiving with read[ln](SockIn^,...)
// - data is buffered, filled as the data is available
// - read(char) or readln() is indeed very fast
// - multithread applications would also use this SockIn pseudo-text file
// - by default, expect CR+LF as line feed (i.e. the HTTP way)
procedure CreateSockIn(LineBreak: TTextLineBreakStyle=tlbsCRLF;
InputBufferSize: Integer=1024);
/// initialize SockOut for sending with write[ln](SockOut^,....)
// - data is sent (flushed) after each writeln() - it's a compiler feature
// - use rather SockSend() + SockSendFlush to send headers at once e.g.
// since writeln(SockOut^,..) flush buffer each time
procedure CreateSockOut(OutputBufferSize: Integer=1024);
/// finalize SockIn receiving buffer
// - you may call this method when you are sure that you don't need the
// input buffering feature on this connection any more (e.g. after having
// parsed the HTTP header, then rely on direct socket comunication)
procedure CloseSockIn;
/// finalize SockOut receiving buffer
// - you may call this method when you are sure that you don't need the
// output buffering feature on this connection any more (e.g. after having
// parsed the HTTP header, then rely on direct socket comunication)
procedure CloseSockOut;
/// close and shutdown the connection (called from Destroy)
procedure Close;
/// close the opened socket, and corresponding SockIn/SockOut
destructor Destroy; override;
/// read Length bytes from SockIn buffer + Sock if necessary
// - if SockIn is available, it first gets data from SockIn^.Buffer,
// then directly receive data from socket if UseOnlySockIn=false
// - if UseOnlySockIn=true, it will return the data available in SockIn^,
// and returns the number of bytes
// - can be used also without SockIn: it will call directly SockRecv()
// in such case (assuming UseOnlySockin=false)
function SockInRead(Content: PAnsiChar; Length: integer;
UseOnlySockIn: boolean=false): integer;
/// returns the number of bytes in SockIn buffer or pending in Sock
// - if SockIn is available, it first check from any data in SockIn^.Buffer,
// then call InputSock to try to receive any pending data if the buffer is
// void - unless aSocketForceCheck is TRUE, and both the buffer and the
// socket are asked for pending bytes (slower, but sometimes needed, e.g.
// if you are currently waiting for a whole header block to be available)
// - will wait up to the specified aTimeOutMS value (in milliseconds) for
// incoming data
// - returns -1 in case of a socket error (e.g. broken connection); you
// can raise a ECrtSocket exception to propagate the error
function SockInPending(aTimeOutMS: integer; aSocketForceCheck: boolean=false): integer;
/// check the connection status of the socket
function SockConnected: boolean;
/// simulate writeln() with direct use of Send(Sock, ..)
// - useful on multi-treaded environnement (as in THttpServer.Process)
// - no temp buffer is used
// - handle SockString, ShortString, Char, Integer parameters
// - raise ECrtSocket exception on socket error
procedure SockSend(const Values: array of const); overload;
/// simulate writeln() with a single line
procedure SockSend(const Line: SockString=''); overload;
/// append P^ data into SndBuf (used by SockSend(), e.g.)
// - call SockSendFlush to send it through the network via SndLow()
procedure SockSend(P: pointer; Len: integer); overload;
/// flush all pending data to be sent, optionally with some body content
// - raise ECrtSocket on error
procedure SockSendFlush(const aBody: SockString='');
/// flush all pending data to be sent
// - returning true on success
function TrySockSendFlush: boolean;
/// how many bytes could be added by SockSend() in the internal buffer
function SockSendRemainingSize: integer;
/// fill the Buffer with Length bytes
// - use TimeOut milliseconds wait for incoming data
// - bypass the SockIn^ buffers
// - raise ECrtSocket exception on socket error
procedure SockRecv(Buffer: pointer; Length: integer);
/// check if there are some pending bytes in the input sockets API buffer
function SockReceivePending(TimeOutMS: cardinal): TCrtSocketPending;
/// returns the socket input stream as a string
function SockReceiveString: SockString;
/// fill the Buffer with Length bytes
// - use TimeOut milliseconds wait for incoming data
// - bypass the SockIn^ buffers
// - return false on any fatal socket error, true on success
// - call Close if the socket is identified as shutdown from the other side
// - you may optionally set StopBeforeLength=true, then the read bytes count
// are set in Length, even if not all expected data has been received - in
// this case, Close method won't be called
function TrySockRecv(Buffer: pointer; var Length: integer; StopBeforeLength: boolean=false): boolean;
/// call readln(SockIn^,Line) or simulate it with direct use of Recv(Sock, ..)
// - char are read one by one
// - use TimeOut milliseconds wait for incoming data
// - raise ECrtSocket exception on socket error
// - by default, will handle #10 or #13#10 as line delimiter (as normal text
// files), but you can delimit lines using #13 if CROnly is TRUE
procedure SockRecvLn(out Line: SockString; CROnly: boolean=false); overload;
/// call readln(SockIn^) or simulate it with direct use of Recv(Sock, ..)
// - char are read one by one
// - use TimeOut milliseconds wait for incoming data
// - raise ECrtSocket exception on socket error
// - line content is ignored
procedure SockRecvLn; overload;
/// direct send data through network
// - raise a ECrtSocket exception on any error
// - bypass the SockSend() or SockOut^ buffers
procedure SndLow(P: pointer; Len: integer);
/// direct send data through network
// - return false on any error, true on success
// - bypass the SndBuf or SockOut^ buffers
function TrySndLow(P: pointer; Len: integer): boolean;
/// returns the low-level error number
// - i.e. returns WSAGetLastError
function LastLowSocketError: Integer;
/// direct send data through network
// - raise a ECrtSocket exception on any error
// - bypass the SndBuf or SockOut^ buffers
// - raw Data is sent directly to OS: no CR/CRLF is appened to the block
procedure Write(const Data: SockString);
/// direct accept an new incoming connection on a bound socket
// - instance should have been setup as a server via a previous Bind() call
// - returns nil on error or a ResultClass instance on success
// - if ResultClass is nil, will return a plain TCrtSocket, but you may
// specify e.g. THttpServerSocket if you expect incoming HTTP requests
function AcceptIncoming(RemoteIP: PSockString=nil;
ResultClass: TCrtSocketClass=nil): TCrtSocket;
/// remote IP address of the last packet received (SocketLayer=slUDP only)
function PeerAddress: SockString;
/// remote IP port of the last packet received (SocketLayer=slUDP only)
function PeerPort: integer;
/// set the TCP_NODELAY option for the connection
// - default 1 (true) will disable the Nagle buffering algorithm; it should
// only be set for applications that send frequent small bursts of information
// without getting an immediate response, where timely delivery of data
// is required - so it expects buffering before calling Write() or SndLow()
// - you can set 0 (false) here to enable the Nagle algorithm, if needed
// - see http://www.unixguide.net/network/socketfaq/2.16.shtml
property TCPNoDelay: Integer index TCP_NODELAY write SetInt32OptionByIndex;
/// set the SO_SNDTIMEO option for the connection
// - i.e. the timeout, in milliseconds, for blocking send calls
// - see http://msdn.microsoft.com/en-us/library/windows/desktop/ms740476
property SendTimeout: Integer index SO_SNDTIMEO write SetInt32OptionByIndex;
/// set the SO_RCVTIMEO option for the connection
// - i.e. the timeout, in milliseconds, for blocking receive calls
// - see http://msdn.microsoft.com/en-us/library/windows/desktop/ms740476
property ReceiveTimeout: Integer index SO_RCVTIMEO write SetInt32OptionByIndex;
/// set the SO_KEEPALIVE option for the connection
// - 1 (true) will enable keep-alive packets for the connection
// - see http://msdn.microsoft.com/en-us/library/windows/desktop/ee470551
property KeepAlive: Integer index SO_KEEPALIVE write SetInt32OptionByIndex;
/// set the SO_LINGER option for the connection, to control its shutdown
// - by default (or Linger<0), Close will return immediately to the caller,
// and any pending data will be delivered if possible
// - Linger > 0 represents the time in seconds for the timeout period
// to be applied at Close; under Linux, will also set SO_REUSEADDR; under
// Darwin, set SO_NOSIGPIPE
// - Linger = 0 causes the connection to be aborted and any pending data
// is immediately discarded at Close
property Linger: Integer index SO_LINGER write SetInt32OptionByIndex;
/// after CreateSockIn, use Readln(SockIn^,s) to read a line from the opened socket
property SockIn: PTextFile read fSockIn;
/// after CreateSockOut, use Writeln(SockOut^,s) to send a line to the opened socket
property SockOut: PTextFile read fSockOut;
published
/// low-level socket handle, initialized after Open() with socket
property Sock: TSocket read fSock write fSock;
/// low-level socket type, initialized after Open() with socket
property SocketLayer: TCrtSocketLayer read fSocketLayer;
/// IP address, initialized after Open() with Server name
property Server: SockString read fServer;
/// IP port, initialized after Open() with port number
property Port: SockString read fPort;
/// if higher than 0, read loop will wait for incoming data till
// TimeOut milliseconds (default value is 10000) - used also in SockSend()
property TimeOut: cardinal read fTimeOut;
/// total bytes received
property BytesIn: Int64 read fBytesIn;
/// total bytes sent
property BytesOut: Int64 read fBytesOut;
end;
{$M-}
/// event used to compress or uncompress some data during HTTP protocol
// - should always return the protocol name for ACCEPT-ENCODING: header
// e.g. 'gzip' or 'deflate' for standard HTTP format, but you can add
// your own (like 'synlzo' or 'synlz')
// - the data is compressed (if Compress=TRUE) or uncompressed (if
// Compress=FALSE) in the Data variable (i.e. it is modified in-place)
// - to be used with THttpSocket.RegisterCompress method
// - DataRawByteStringtype should be a generic AnsiString/RawByteString, which
// should be in practice a SockString or a RawByteString
THttpSocketCompress = function(var DataRawByteString; Compress: boolean): AnsiString;
/// used to maintain a list of known compression algorithms
THttpSocketCompressRec = record
/// the compression name, as in ACCEPT-ENCODING: header (gzip,deflate,synlz)
Name: SockString;
/// the function handling compression and decompression
Func: THttpSocketCompress;
/// the size in bytes after which compress will take place
// - will be 1024 e.g. for 'zip' or 'deflate'
// - could be 0 e.g. when encrypting the content, meaning "always compress"
CompressMinSize: integer;
end;
/// list of known compression algorithms
THttpSocketCompressRecDynArray = array of THttpSocketCompressRec;
/// identify some items in a list of known compression algorithms
THttpSocketCompressSet = set of 0..31;
/// parent of THttpClientSocket and THttpServerSocket classes
// - contain properties for implementing HTTP/1.1 using the Socket API
// - handle chunking of body content
// - can optionaly compress and uncompress on the fly the data, with
// standard gzip/deflate or custom (synlzo/synlz) protocols
THttpSocket = class(TCrtSocket)
protected
/// true if the TRANSFER-ENCODING: CHUNKED was set in headers
Chunked: boolean;
/// to call GetBody only once
fBodyRetrieved: boolean;
/// used by RegisterCompress method
fCompress: THttpSocketCompressRecDynArray;
/// set by RegisterCompress method
fCompressAcceptEncoding: SockString;
/// GetHeader set index of protocol in fCompress[], from ACCEPT-ENCODING:
fCompressHeader: THttpSocketCompressSet;
/// same as HeaderValue('Content-Encoding'), but retrieved during Request
// and mapped into the fCompress[] array
fContentCompress: integer;
/// cache for HeaderGetText
fHeaderText: SockString;
/// compress the data, adding corresponding headers via SockSend()
// - always add a 'Content-Length: ' header entry (even if length=0)
// - e.g. 'Content-Encoding: synlz' header if compressed using synlz
// - and if Data is not '', will add 'Content-Type: ' header
procedure CompressDataAndWriteHeaders(const OutContentType: SockString;
var OutContent: SockString);
public
/// TCP/IP prefix to mask HTTP protocol
// - if not set, will create full HTTP/1.0 or HTTP/1.1 compliant content
// - in order to make the TCP/IP stream not HTTP compliant, you can specify
// a prefix which will be put before the first header line: in this case,
// the TCP/IP stream won't be recognized as HTTP, and will be ignored by
// most AntiVirus programs, and increase security - but you won't be able
// to use an Internet Browser nor AJAX application for remote access any more
TCPPrefix: SockString;
/// will contain the first header line:
// - 'GET /path HTTP/1.1' for a GET request with THttpServer, e.g.
// - 'HTTP/1.0 200 OK' for a GET response after Get() e.g.
Command: SockString;
/// will contain the header lines after a Request - use HeaderValue() to get one
Headers: array of SockString;
/// will contain the data retrieved from the server, after the Request
Content: SockString;
/// same as HeaderValue('Content-Length'), but retrieved during Request
// - is overridden with real Content length during HTTP body retrieval
ContentLength: integer;
/// same as HeaderValue('Content-Type'), but retrieved during Request
ContentType: SockString;
/// same as HeaderValue('Connection')='Close', but retrieved during Request
ConnectionClose: boolean;
/// same as HeaderValue('Connection')='Upgrade', but retrieved during Request
ConnectionUpgrade: boolean;
/// retrieve the HTTP headers into Headers[] and fill most properties below
procedure GetHeader;
/// retrieve the HTTP body (after uncompression if necessary) into Content
procedure GetBody;
/// add an header entry, returning the just entered entry index in Headers[]
function HeaderAdd(const aValue: SockString): integer;
/// set all Header values at once, from CRLF delimited text
procedure HeaderSetText(const aText: SockString;
const aForcedContentType: SockString='');
/// get all Header values at once, as CRLF delimited text
// - you can optionally specify a value to be added as 'RemoteIP: ' header
function HeaderGetText(const aRemoteIP: SockString=''): SockString;
/// HeaderValue('Content-Type')='text/html', e.g.
function HeaderValue(aName: SockString): SockString;
/// will register a compression algorithm
// - used e.g. to compress on the fly the data, with standard gzip/deflate
// or custom (synlzo/synlz) protocols
// - returns true on success, false if this function or this
// ACCEPT-ENCODING: header was already registered
// - you can specify a minimal size (in bytes) before which the content won't
// be compressed (1024 by default, corresponding to a MTU of 1500 bytes)
// - the first registered algorithm will be the prefered one for compression
function RegisterCompress(aFunction: THttpSocketCompress;
aCompressMinSize: integer=1024): boolean;
end;
THttpServer = class;
/// Socket API based HTTP/1.1 server class used by THttpServer Threads
THttpServerSocket = class(THttpSocket)
protected
fMethod: SockString;
fURL: SockString;
fKeepAliveClient: boolean;
fRemoteIP: SockString;
fServer: THttpServer;
public
/// create the socket according to a server
// - will register the THttpSocketCompress functions from the server
constructor Create(aServer: THttpServer); reintroduce;
/// main object function called after aClientSock := Accept + Create:
// - get initialize the socket with the supplied accepted socket
// - caller will then use the GetRequest method below to
// get the request
procedure InitRequest(aClientSock: TSocket);
/// main object function called after aClientSock := Accept + Create:
// - get Command, Method, URL, Headers and Body (if withBody is TRUE)
// - get sent data in Content (if ContentLength<>0)
// - return false if the socket was not connected any more, or if
// any exception occured during the process
function GetRequest(withBody: boolean=true): boolean;
/// contains the method ('GET','POST'.. e.g.) after GetRequest()
property Method: SockString read fMethod;
/// contains the URL ('/' e.g.) after GetRequest()
property URL: SockString read fURL;
/// true if the client is HTTP/1.1 and 'Connection: Close' is not set
// - default HTTP/1.1 behavior is "keep alive", unless 'Connection: Close'
// is specified, cf. RFC 2068 page 108: "HTTP/1.1 applications that do not
// support persistent connections MUST include the "close" connection option
// in every message"
property KeepAliveClient: boolean read fKeepAliveClient write fKeepAliveClient;
/// the recognized client IP, after a call to InitRequest()
property RemoteIP: SockString read fRemoteIP;
end;
/// Socket API based REST and HTTP/1.1 compatible client class
// - this component is HTTP/1.1 compatible, according to RFC 2068 document
// - the REST commands (GET/POST/PUT/DELETE) are directly available
// - open connection with the server with inherited Open(server,port) function
// - if KeepAlive>0, the connection is not broken: a further request (within
// KeepAlive milliseconds) will use the existing connection if available,
// or recreate a new one if the former is outdated or reset by server
// (will retry only once); this is faster, uses less resources (especialy
// under Windows), and is the recommended way to implement a HTTP/1.1 server
// - on any error (timeout, connection closed) will retry once to get the value
// - don't forget to use Free procedure when you are finished
THttpClientSocket = class(THttpSocket)
protected
fUserAgent: SockString;
fProcessName: SockString;
procedure RequestSendHeader(const url, method: SockString); virtual;
public
/// common initialization of all constructors
// - this overridden method will set the UserAgent with some default value
// - you can customize the default client timeouts by setting appropriate
// aTimeout parameters (in ms) if you left the 0 default parameters,
// it would use global HTTP_DEFAULT_RECEIVETIMEOUT variable values
constructor Create(aTimeOut: cardinal=0); override;
/// low-level HTTP/1.1 request
// - called by all Get/Head/Post/Put/Delete REST methods
// - after an Open(server,port), return 200,202,204 if OK, http status error otherwise
// - retry is false by caller, and will be recursively called with true to retry once
function Request(const url, method: SockString; KeepAlive: cardinal;
const header, Data, DataType: SockString; retry: boolean): integer; virtual;
/// after an Open(server,port), return 200 if OK, http status error otherwise
// - get the page data in Content
function Get(const url: SockString; KeepAlive: cardinal=0; const header: SockString=''): integer;
/// after an Open(server,port), return 200 if OK, http status error otherwise
// - get the page data in Content
// - if AuthToken<>'', will add an header with 'Authorization: Bearer '+AuthToken
function GetAuth(const url, AuthToken: SockString; KeepAlive: cardinal=0): integer;
/// after an Open(server,port), return 200 if OK, http status error otherwise - only
// header is read from server: Content is always '', but Headers are set
function Head(const url: SockString; KeepAlive: cardinal=0; const header: SockString=''): integer;
/// after an Open(server,port), return 200,201,204 if OK, http status error otherwise
function Post(const url, Data, DataType: SockString; KeepAlive: cardinal=0;
const header: SockString=''): integer;
/// after an Open(server,port), return 200,201,204 if OK, http status error otherwise
function Put(const url, Data, DataType: SockString; KeepAlive: cardinal=0;
const header: SockString=''): integer;
/// after an Open(server,port), return 200,202,204 if OK, http status error otherwise
function Delete(const url: SockString; KeepAlive: cardinal=0; const header: SockString=''): integer;
/// by default, the client is identified as IE 5.5, which is very
// friendly welcome by most servers :(
// - you can specify a custom value here
property UserAgent: SockString read fUserAgent write fUserAgent;
/// the associated process name
property ProcessName: SockString read fProcessName write fProcessName;
end;
/// class-reference type (metaclass) of a HTTP client socket access
// - may be either THttpClientSocket or THttpClientWebSockets (from
// SynBidirSock unit)
THttpClientSocketClass = class of THttpClientSocket;
{$ifndef LVCL}
/// event prototype used e.g. by THttpServerGeneric.OnHttpThreadStart
TNotifyThreadEvent = procedure(Sender: TThread) of object;
{$endif}
{$M+}
TSynThreadPool = class;
/// a simple TThread with a "Terminate" event run in the thread context
// - the TThread.OnTerminate event is run within Synchronize() so did not
// match our expectations to be able to release the resources in the thread
// context which created them (e.g. for COM objects, or some DB drivers)
// - used internally by THttpServerGeneric.NotifyThreadStart() - you should
// not have to use the protected fOnTerminate event handler
// - also define a Start method for compatibility with older versions of Delphi
TSynThread = class(TThread)
protected
// ensure fOnTerminate is called only if NotifyThreadStart has been done
fStartNotified: TObject;
{$ifndef LVCL} // already available in LVCL
// we re-defined an fOnTerminate event which would be run in the terminated
// thread context (whereas TThread.OnTerminate is called in the main thread)
// -> see THttpServerGeneric.OnHttpThreadTerminate event property
fOnTerminate: TNotifyThreadEvent;
procedure DoTerminate; override;
{$endif}
public
/// initialize the server instance, in non suspended state
constructor Create(CreateSuspended: boolean); reintroduce; virtual;
{$ifndef HASTTHREADSTART}
/// method to be called when the thread was created as suspended
// - Resume is deprecated in the newest RTL, since some OS - e.g. Linux -
// do not implement this pause/resume feature
// - we define here this method for older versions of Delphi
procedure Start;
{$endif}
/// safe version of Sleep() which won't break the thread process
// - returns TRUE if the thread was Terminated
// - returns FALSE if successfully waited up to MS milliseconds
function SleepOrTerminated(MS: cardinal): boolean;
/// defined as public since may be used to terminate the processing methods
property Terminated;
end;
{$M-}
/// HTTP response Thread as used by THttpServer Socket API based class
// - Execute procedure get the request and calculate the answer
// - you don't have to overload the protected THttpServerResp Execute method:
// override THttpServer.Request() function or, if you need a lower-level access
// (change the protocol, e.g.) THttpServer.Process() method itself
THttpServerResp = class(TSynThread)
protected
fServer: THttpServer;
fServerSock: THttpServerSocket;
fClientSock: TSocket;
fConnectionID: integer;
/// main thread loop: read request from socket, send back answer
procedure Execute; override;
public
/// initialize the response thread for the corresponding incoming socket
// - this version will get the request directly from an incoming socket
constructor Create(aSock: TSocket; aServer: THttpServer); reintroduce; overload;
/// initialize the response thread for the corresponding incoming socket
// - this version will handle KeepAlive, for such an incoming request
constructor Create(aServerSock: THttpServerSocket; aServer: THttpServer);
reintroduce; overload; virtual;
/// the associated socket to communicate with the client
property ServerSock: THttpServerSocket read fServerSock;
/// the associated main HTTP server instance
property Server: THttpServer read fServer;
/// the unique identifier of this connection
property ConnectionID: integer read fConnectionID;
end;
/// metaclass of HTTP response Thread
THttpServerRespClass = class of THttpServerResp;
{$ifdef MSWINDOWS}
// I/O completion ports API is the best option under Windows
// under Linux/POSIX, we fallback to a classical event-driven pool
{$define USE_WINIOCP}
{$endif}
/// defines the sub-threads used by TSynThreadPool
TSynThreadPoolSubThread = class(TSynThread)
protected
fOwner: TSynThreadPool;
fNotifyThreadStartName: AnsiString;
fProcessingContext: pointer;
fProcessingContextCS: TRTLCriticalSection;
{$ifndef USE_WINIOCP}
fEvent: TEvent;
function AssignProcess(aContext: pointer): boolean;
{$endif}
procedure NotifyThreadStart(Sender: TSynThread);
public
/// initialize the thread
constructor Create(Owner: TSynThreadPool); reintroduce;
/// finalize the thread
destructor Destroy; override;
/// will loop for any pending IOCP commands, and execute fOwner.Task()
procedure Execute; override;
end;
/// a simple Thread Pool, used e.g. for fast handling HTTP requests
// - implemented over I/O Completion Ports under Windows, or a classical
// Event-driven approach under Linux/POSIX
TSynThreadPool = class
protected
{$ifdef USE_WINIOCP}
fRequestQueue: THandle;
{$endif}
fSubThread: TObjectList; // holds TSynThreadPoolSubThread
fRunningThreads: integer;
fExceptionsCount: integer;
fOnTerminate: TNotifyThreadEvent;
fTerminated: boolean;
fOnThreadStart: TNotifyThreadEvent;
/// end thread on IO error
function NeedStopOnIOError: boolean; virtual;
/// process to be executed after notification
procedure Task(aCaller: TSynThread; aContext: Pointer); virtual; abstract;
public
/// initialize a thread pool with the supplied number of threads
// - abstract Task() virtual method will be called by one of the threads
// - up to 256 threads can be associated to a Thread Pool
// - can optionaly accept aOverlapHandle - a handle previously
// opened for overlapped I/O (IOCP)
constructor Create(NumberOfThreads: Integer=32
{$ifdef USE_WINIOCP}; aOverlapHandle: THandle=INVALID_HANDLE_VALUE{$endif});
/// shut down the Thread pool, releasing all associated threads
destructor Destroy; override;
/// let a task be processed by the Thread Pool
// - returns false if there is no idle thread available in the pool (caller
// should retry later)
// - matches TOnThreadPoolSocketPush event handler signature
function Push(aContext: pointer): boolean;
published
/// how many threads are currently running in this thread pool
property RunningThreads: integer read fRunningThreads;
end;
/// a simple Thread Pool, used for fast handling HTTP requests of a THttpServer
// - will handle multi-connection with less overhead than creating a thread
// for each incoming request
// - will create a THttpServerResp response thread, if the incoming request is
// identified as HTTP/1.1 keep alive, or HTTP body length is bigger than 1 MB
TSynThreadPoolTHttpServer = class(TSynThreadPool)
protected
fServer: THttpServer;
fHeaderErrors: integer;
fHeaderProcessed: integer;
fBodyProcessed: integer;
fBodyOwnThreads: integer;
// here aContext is a pointer(TSocket=THandle) value
procedure Task(aCaller: TSynThread; aContext: Pointer); override;
public
/// initialize a thread pool with the supplied number of threads
// - Task() overridden method processs the HTTP request set by Push()
// - up to 256 threads can be associated to a Thread Pool
constructor Create(Server: THttpServer; NumberOfThreads: Integer=32); reintroduce;
published
/// how many invalid HTTP headers have been rejected by this thread pool
property HeaderErrors: integer read fHeaderErrors write fHeaderErrors;
/// how many HTTP headers have been processed by this thread pool
property HeaderProcessed: integer read fHeaderProcessed write fHeaderProcessed;
/// how many HTTP bodies have been processed by this thread pool
property BodyProcessed: integer read fBodyProcessed write fBodyProcessed;
/// how many HTTP bodies have been processed by a dedicated THttpServerResp thread
property BodyOwnThreads: integer read fBodyOwnThreads write fBodyOwnThreads;
end;
{$M+} // to have existing RTTI for published properties
THttpServerGeneric = class;
{$M-}
/// the server-side available authentication schemes
// - as used by THttpServerRequest.AuthenticationStatus
// - hraNone..hraKerberos will match low-level HTTP_REQUEST_AUTH_TYPE enum as
// defined in HTTP 2.0 API and
THttpServerRequestAuthentication = (
hraNone, hraFailed, hraBasic, hraDigest, hraNtlm, hraNegotiate, hraKerberos);
/// a generic input/output structure used for HTTP server requests
// - URL/Method/InHeaders/InContent properties are input parameters
// - OutContent/OutContentType/OutCustomHeader are output parameters
THttpServerRequest = class
protected
fURL, fMethod, fInHeaders, fInContent, fInContentType: SockString;
fOutContent, fOutContentType, fOutCustomHeaders: SockString;
fServer: THttpServerGeneric;
fConnectionID: Int64;
fConnectionThread: TSynThread;
fUseSSL: boolean;
fAuthenticationStatus: THttpServerRequestAuthentication;
fAuthenticatedUser: SockString;
{$ifdef MSWINDOWS}
fHttpApiRequest: Pointer;
{$endif}
public
/// initialize the context, associated to a HTTP server instance
constructor Create(aServer: THttpServerGeneric; aConnectionID: Int64;
aConnectionThread: TSynThread); virtual;
/// prepare an incoming request
// - will set input parameters URL/Method/InHeaders/InContent/InContentType
// - will reset output parameters
procedure Prepare(const aURL,aMethod,aInHeaders,aInContent,aInContentType,
aRemoteIP: SockString);
/// append some lines to the InHeaders input parameter
procedure AddInHeader(additionalHeader: SockString);
/// input parameter containing the caller URI
property URL: SockString read fURL;
/// input parameter containing the caller method (GET/POST...)
property Method: SockString read fMethod;
/// input parameter containing the caller message headers
property InHeaders: SockString read fInHeaders;
/// input parameter containing the caller message body
// - e.g. some GET/POST/PUT JSON data can be specified here
property InContent: SockString read fInContent;
// input parameter defining the caller message body content type
property InContentType: SockString read fInContentType;
/// output parameter to be set to the response message body
property OutContent: SockString read fOutContent write fOutContent ;
/// output parameter to define the reponse message body content type
// - if OutContentType is HTTP_RESP_STATICFILE (i.e. '!STATICFILE', defined
// as STATICFILE_CONTENT_TYPE in mORMot.pas), then OutContent is the UTF-8
// file name of a file which must be sent to the client via http.sys (much
// faster than manual buffering/sending)
// - if OutContentType is HTTP_RESP_NORESPONSE (i.e. '!NORESPONSE', defined
// as NORESPONSE_CONTENT_TYPE in mORMot.pas), then the actual transmission
// protocol may not wait for any answer - used e.g. for WebSockets
property OutContentType: SockString read fOutContentType write fOutContentType;
/// output parameter to be sent back as the response message header
// - e.g. to set Content-Type/Location
property OutCustomHeaders: SockString read fOutCustomHeaders write fOutCustomHeaders;
/// the associated server instance
// - may be a THttpServer or a THttpApiServer class
property Server: THttpServerGeneric read fServer;
/// the ID of the connection which called this execution context
// - e.g. SynCrtSock's TWebSocketProcess.NotifyCallback method would use
// this property to specify the client connection to be notified
// - is set as an Int64 to match http.sys ID type, but will be an
// increasing integer sequence for (web)socket-based servers
property ConnectionID: Int64 read fConnectionID;
/// the thread which owns the connection of this execution context
// - depending on the HTTP server used, may not follow ConnectionID
property ConnectionThread: TSynThread read fConnectionThread;
/// is TRUE if the caller is connected via HTTPS
// - only set for THttpApiServer class yet
property UseSSL: boolean read fUseSSL;
/// contains the THttpServer-side authentication status
// - e.g. when using http.sys authentication with HTTP API 2.0
property AuthenticationStatus: THttpServerRequestAuthentication
read fAuthenticationStatus;
/// contains the THttpServer-side authenticated user name, UTF-8 encoded
// - e.g. when using http.sys authentication with HTTP API 2.0, the
// domain user name is retrieved from the supplied AccessToken
// - could also be set by the THttpServerGeneric.Request() method, after
// proper authentication, so that it would be logged as expected
property AuthenticatedUser: SockString read fAuthenticatedUser;
{$ifdef MSWINDOWS}
/// for THttpApiServer, points to a PHTTP_REQUEST structure
// - not used by now for other servers
property HttpApiRequest: Pointer read fHttpApiRequest;
{$endif}
end;
/// event handler used by THttpServerGeneric.OnRequest property
// - Ctxt defines both input and output parameters
// - result of the function is the HTTP error code (200 if OK, e.g.)
// - OutCustomHeader will handle Content-Type/Location
// - if OutContentType is HTTP_RESP_STATICFILE (i.e. '!STATICFILE' aka
// STATICFILE_CONTENT_TYPE in mORMot.pas), then OutContent is the UTF-8 file
// name of a file which must be sent to the client via http.sys (much faster
// than manual buffering/sending) and the OutCustomHeader should
// contain the proper 'Content-type: ....'
TOnHttpServerRequest = function(Ctxt: THttpServerRequest): cardinal of object;
/// event handler used by THttpServerGeneric.OnBeforeBody property
// - if defined, is called just before the body is retrieved from the client
// - supplied parameters reflect the current input state
// - should return STATUS_SUCCESS=200 to continue the process, or an HTTP
// error code (e.g. STATUS_FORBIDDEN or STATUS_PAYLOADTOOLARGE) to reject
// the request
TOnHttpServerBeforeBody = function(const aURL,aMethod,aInHeaders,
aInContentType,aRemoteIP: SockString; aContentLength: integer;
aUseSSL: boolean): cardinal of object;
{$M+}
/// abstract class to implement a server thread
// - do not use this class, but rather the THttpServer, THttpApiServer
// or TAsynchFrameServer (as defined in SynBidirSock)
TServerGeneric = class(TSynThread)
protected
fProcessName: SockString;
fOnHttpThreadStart: TNotifyThreadEvent;
procedure SetOnTerminate(const Event: TNotifyThreadEvent); virtual;
procedure NotifyThreadStart(Sender: TSynThread);
public
/// initialize the server instance, in non suspended state
constructor Create(CreateSuspended: boolean; OnStart,OnStop: TNotifyThreadEvent;
const ProcessName: SockString); reintroduce; virtual;
end;
/// abstract class to implement a HTTP server
// - do not use this class, but rather the THttpServer or THttpApiServer
THttpServerGeneric = class(TServerGeneric)
protected
fShutdownInProgress: boolean;
/// optional event handlers for process interception
fOnRequest: TOnHttpServerRequest;
fOnBeforeBody: TOnHttpServerBeforeBody;
fOnBeforeRequest: TOnHttpServerRequest;
fOnAfterRequest: TOnHttpServerRequest;
fOnAfterResponse: TOnHttpServerRequest;
fMaximumAllowedContentLength: cardinal;
/// list of all registered compression algorithms
fCompress: THttpSocketCompressRecDynArray;
/// set by RegisterCompress method
fCompressAcceptEncoding: SockString;
fServerName: SockString;
fCurrentConnectionID: integer;
fCanNotifyCallback: boolean;
fRemoteIPHeader, fRemoteIPHeaderUpper: SockString;
function GetAPIVersion: string; virtual; abstract;
procedure SetServerName(const aName: SockString); virtual;
procedure SetOnBeforeBody(const aEvent: TOnHttpServerBeforeBody); virtual;
procedure SetOnBeforeRequest(const aEvent: TOnHttpServerRequest); virtual;
procedure SetOnAfterRequest(const aEvent: TOnHttpServerRequest); virtual;
procedure SetOnAfterResponse(const aEvent: TOnHttpServerRequest); virtual;
procedure SetMaximumAllowedContentLength(aMax: cardinal); virtual;
procedure SetRemoteIPHeader(const aHeader: SockString);
function DoBeforeRequest(Ctxt: THttpServerRequest): cardinal;
function DoAfterRequest(Ctxt: THttpServerRequest): cardinal;
procedure DoAfterResponse(Ctxt: THttpServerRequest); virtual;
function NextConnectionID: integer;
public
/// initialize the server instance, in non suspended state
constructor Create(CreateSuspended: boolean; OnStart,OnStop: TNotifyThreadEvent;
const ProcessName: SockString); override;
/// override this function to customize your http server
// - InURL/InMethod/InContent properties are input parameters
// - OutContent/OutContentType/OutCustomHeader are output parameters
// - result of the function is the HTTP error code (200 if OK, e.g.),
// - OutCustomHeader is available to handle Content-Type/Location
// - if OutContentType is HTTP_RESP_STATICFILE (i.e. '!STATICFILE' or
// STATICFILE_CONTENT_TYPE defined in mORMot.pas), then OutContent is the
// UTF-8 file name of a file which must be sent to the client via http.sys
// (much faster than manual buffering/sending) and the OutCustomHeader should
// contain the proper 'Content-type: ....'
// - default implementation is to call the OnRequest event (if existing),
// and will return STATUS_NOTFOUND if OnRequest was not set
// - warning: this process must be thread-safe (can be called by several
// threads simultaneously, but with a given Ctxt instance for each)
function Request(Ctxt: THttpServerRequest): cardinal; virtual;
/// server can send a request back to the client, when the connection has
// been upgraded e.g. to WebSockets
// - 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.)
// - warning: this void implementation will raise an ECrtSocket exception -
// inherited classes should override it, e.g. as in TWebSocketServerRest
function Callback(Ctxt: THttpServerRequest; aNonBlocking: boolean): cardinal; virtual;
/// will register a compression algorithm
// - used e.g. to compress on the fly the data, with standard gzip/deflate
// or custom (synlzo/synlz) protocols
// - you can specify a minimal size (in bytes) before which the content won't
// be compressed (1024 by default, corresponding to a MTU of 1500 bytes)
// - the first registered algorithm will be the prefered one for compression
procedure RegisterCompress(aFunction: THttpSocketCompress;
aCompressMinSize: integer=1024); virtual;
/// you can call this method to prepare the HTTP server for shutting down
procedure Shutdown;
/// event handler called by the default implementation of the
// virtual Request method
// - warning: this process must be thread-safe (can be called by several
// threads simultaneously)
property OnRequest: TOnHttpServerRequest read fOnRequest write fOnRequest;
/// event handler called just before the body is retrieved from the client
// - should return STATUS_SUCCESS=200 to continue the process, or an HTTP
// error code to reject the request immediatly, and close the connection
property OnBeforeBody: TOnHttpServerBeforeBody read fOnBeforeBody write SetOnBeforeBody;
/// event handler called after HTTP body has been retrieved, before OnProcess
// - may be used e.g. to return a STATUS_ACCEPTED (202) status to client and
// continue a long-term job inside the OnProcess handler in the same thread;
// or to modify incoming information before passing it to main businnes logic,
// (header preprocessor, body encoding etc...)
// - if the handler returns > 0 server will send a response immediately,
// unless return code is STATUS_ACCEPTED (202), then OnRequest will be called
// - warning: this handler must be thread-safe (can be called by several
// threads simultaneously)
property OnBeforeRequest: TOnHttpServerRequest read fOnBeforeRequest write fOnBeforeRequest;
/// event handler called after request is processed but before response
// is sent back to client
// - main purpose is to apply post-processor, not part of request logic
// - if handler returns value > 0 it will override the OnProcess response code
// - warning: this handler must be thread-safe (can be called by several
// threads simultaneously)
property OnAfterRequest: TOnHttpServerRequest read fOnAfterRequest write fOnAfterRequest;
/// event handler called after each working Thread is just initiated
// - called in the thread context at first place in THttpServerGeneric.Execute
property OnHttpThreadStart: TNotifyThreadEvent
read fOnHttpThreadStart write fOnHttpThreadStart;
/// event handler called when a working Thread is terminating
// - called in the corresponding thread context
// - the TThread.OnTerminate event will be called within a Synchronize()
// wrapper, so it won't fit our purpose
// - to be used e.g. to call CoUnInitialize from thread in which CoInitialize
// was made, for instance via a method defined as such:
// ! procedure TMyServer.OnHttpThreadTerminate(Sender: TObject);
// ! begin // TSQLDBConnectionPropertiesThreadSafe
// ! fMyConnectionProps.EndCurrentThread;
// ! end;
// - is used e.g. by TSQLRest.EndCurrentThread for proper multi-threading
property OnHttpThreadTerminate: TNotifyThreadEvent read fOnTerminate write SetOnTerminate;
/// reject any incoming request with a body size bigger than this value
// - default to 0, meaning any input size is allowed
// - returns STATUS_PAYLOADTOOLARGE = 413 error if "Content-Length" incoming
// header overflow the supplied number of bytes
property MaximumAllowedContentLength: cardinal read fMaximumAllowedContentLength
write SetMaximumAllowedContentLength;
/// TRUE if the inherited class is able to handle callbacks
// - only TWebSocketServer has this ability by now
property CanNotifyCallback: boolean read fCanNotifyCallback;
/// the value of a custom HTTP header containing the real client IP
// - by default, the RemoteIP information will be retrieved from the socket
// layer - but if the server runs behind some proxy service, you should
// define here the HTTP header name which indicates the true remote client
// IP value, mostly as 'X-Real-IP' or 'X-Forwarded-For'
property RemoteIPHeader: SockString read fRemoteIPHeader write SetRemoteIPHeader;
published
/// returns the API version used by the inherited implementation
property APIVersion: string read GetAPIVersion;
/// the Server name, UTF-8 encoded, e.g. 'mORMot/1.18 (Linux)'
// - will be served as "Server: ..." HTTP header
// - for THttpApiServer, when called from the main instance, will propagate
// the change to all cloned instances, and included in any HTTP API 2.0 log
property ServerName: SockString read fServerName write SetServerName;
/// the associated process name
property ProcessName: SockString read fProcessName write fProcessName;
end;
{$ifndef UNICODE}
ULONGLONG = Int64;
{$endif}
{$ifdef MSWINDOWS}
HTTP_OPAQUE_ID = ULONGLONG;
HTTP_REQUEST_ID = HTTP_OPAQUE_ID;
HTTP_URL_GROUP_ID = HTTP_OPAQUE_ID;
HTTP_SERVER_SESSION_ID = HTTP_OPAQUE_ID;
/// http.sys API 2.0 logging file supported layouts
// - match low-level HTTP_LOGGING_TYPE as defined in HTTP 2.0 API
THttpApiLoggingType = (
hltW3C, hltIIS, hltNCSA, hltRaw);
/// http.sys API 2.0 logging file rollover types
// - match low-level HTTP_LOGGING_ROLLOVER_TYPE as defined in HTTP 2.0 API
THttpApiLoggingRollOver = (
hlrSize, hlrDaily, hlrWeekly, hlrMonthly, hlrHourly);
/// http.sys API 2.0 logging option flags
// - used to alter the default logging behavior
// - hlfLocalTimeRollover would force the log file rollovers by local time,
// instead of the default GMT time
// - hlfUseUTF8Conversion will use UTF-8 instead of default local code page
// - only one of hlfLogErrorsOnly and hlfLogSuccessOnly flag could be set
// at a time: if neither of them are present, both errors and success will
// be logged, otherwise mutually exclusive flags could be set to force only
// errors or success logging
// - match low-level HTTP_LOGGING_FLAG_* constants as defined in HTTP 2.0 API
THttpApiLoggingFlags = set of (
hlfLocalTimeRollover, hlfUseUTF8Conversion,
hlfLogErrorsOnly, hlfLogSuccessOnly);
/// http.sys API 2.0 fields used for W3C logging
// - match low-level HTTP_LOG_FIELD_* constants as defined in HTTP 2.0 API
THttpApiLogFields = set of (
hlfDate, hlfTime, hlfClientIP, hlfUserName, hlfSiteName, hlfComputerName,
hlfServerIP, hlfMethod, hlfURIStem, hlfURIQuery, hlfStatus, hlfWIN32Status,
hlfBytesSent, hlfBytesRecv, hlfTimeTaken, hlfServerPort, hlfUserAgent,
hlfCookie, hlfReferer, hlfVersion, hlfHost, hlfSubStatus);
/// http.sys API 2.0 fields used for server-side authentication
// - as used by THttpApiServer.SetAuthenticationSchemes/AuthenticationSchemes
// - match low-level HTTP_AUTH_ENABLE_* constants as defined in HTTP 2.0 API
THttpApiRequestAuthentications = set of (
haBasic, haDigest, haNtlm, haNegotiate, haKerberos);
/// HTTP server using fast http.sys kernel-mode server
// - The HTTP Server API enables applications to communicate over HTTP without
// using Microsoft Internet Information Server (IIS). Applications can register
// to receive HTTP requests for particular URLs, receive HTTP requests, and send
// HTTP responses. The HTTP Server API includes SSL support so that applications
// can exchange data over secure HTTP connections without IIS. It is also
// designed to work with I/O completion ports.
// - The HTTP Server API is supported on Windows Server 2003 operating systems
// and on Windows XP with Service Pack 2 (SP2). Be aware that Microsoft IIS 5
// running on Windows XP with SP2 is not able to share port 80 with other HTTP
// applications running simultaneously.
THttpApiServer = class(THttpServerGeneric)
protected
/// the internal request queue
fReqQueue: THandle;
/// contain list of THttpApiServer cloned instances
fClones: TObjectList;
// if fClones=nil, fOwner contains the main THttpApiServer instance
fOwner: THttpApiServer;
/// list of all registered URL
fRegisteredUnicodeUrl: array of SynUnicode;
fServerSessionID: HTTP_SERVER_SESSION_ID;
fUrlGroupID: HTTP_URL_GROUP_ID;
fExecuteFinished: boolean;
fLogData: pointer;
fLogDataStorage: array of byte;
fLoggingServiceName: SockString;
fAuthenticationSchemes: THttpApiRequestAuthentications;
fReceiveBufferSize: cardinal;
procedure SetReceiveBufferSize(Value: cardinal);
function GetRegisteredUrl: SynUnicode;
function GetCloned: boolean;
function GetHTTPQueueLength: Cardinal;
procedure SetHTTPQueueLength(aValue: Cardinal);
function GetMaxBandwidth: Cardinal;
procedure SetMaxBandwidth(aValue: Cardinal);
function GetMaxConnections: Cardinal;
procedure SetMaxConnections(aValue: Cardinal);
procedure SetOnTerminate(const Event: TNotifyThreadEvent); override;
function GetAPIVersion: string; override;
function GetLogging: boolean;
procedure SetServerName(const aName: SockString); override;
procedure SetOnBeforeBody(const aEvent: TOnHttpServerBeforeBody); override;
procedure SetOnBeforeRequest(const aEvent: TOnHttpServerRequest); override;
procedure SetOnAfterRequest(const aEvent: TOnHttpServerRequest); override;
procedure SetOnAfterResponse(const aEvent: TOnHttpServerRequest); override;
procedure SetMaximumAllowedContentLength(aMax: cardinal); override;
procedure SetLoggingServiceName(const aName: SockString);
/// server main loop - don't change directly
// - will call the Request public virtual method with the appropriate
// parameters to retrive the content
procedure Execute; override;
/// retrieve flags for SendHttpResponse
// - if response content type is not HTTP_RESP_STATICFILE
function GetSendResponseFlags(Ctxt: THttpServerRequest): integer; virtual;
/// create a clone
constructor CreateClone(From: THttpApiServer); virtual;
/// free resources (for not cloned server)
procedure DestroyMainThread; virtual;
public
/// initialize the HTTP Service
// - will raise an exception if http.sys is not available (e.g. before
// Windows XP SP2) or if the request queue creation failed
// - if you override this contructor, put the AddUrl() methods within,
// and you can set CreateSuspended to FALSE
// - if you will call AddUrl() methods later, set CreateSuspended to TRUE,
// then call explicitely the Resume method, after all AddUrl() calls, in
// order to start the server
constructor Create(CreateSuspended: boolean; QueueName: SynUnicode='';
OnStart: TNotifyThreadEvent=nil; OnStop: TNotifyThreadEvent=nil;
const ProcessName: SockString=''); reintroduce;
/// release all associated memory and handles
destructor Destroy; override;
/// will clone this thread into multiple other threads
// - could speed up the process on multi-core CPU
// - will work only if the OnProcess property was set (this is the case
// e.g. in TSQLHttpServer.Create() constructor)
// - maximum value is 256 - higher should not be worth it
procedure Clone(ChildThreadCount: integer);
/// register the URLs to Listen On
// - e.g. AddUrl('root','888')
// - aDomainName could be either a fully qualified case-insensitive domain
// name, an IPv4 or IPv6 literal string, or a wildcard ('+' will bound
// to all domain names for the specified port, '*' will accept the request
// when no other listening hostnames match the request for that port)
// - return 0 (NO_ERROR) on success, an error code if failed: under Vista
// and Seven, you could have ERROR_ACCESS_DENIED if the process is not
// running with enough rights (by default, UAC requires administrator rights
// for adding an URL to http.sys registration list) - solution is to call
// the THttpApiServer.AddUrlAuthorize class method during program setup
// - if this method is not used within an overridden constructor, default
// Create must have be called with CreateSuspended = TRUE and then call the
// Resume method after all Url have been added
// - if aRegisterURI is TRUE, the URI will be registered (need adminitrator
// rights) - default is FALSE, as defined by Windows security policy
function AddUrl(const aRoot, aPort: SockString; Https: boolean=false;
const aDomainName: SockString='*'; aRegisterURI: boolean=false;
aContext: Int64=0): integer;
/// un-register the URLs to Listen On
// - this method expect the same parameters as specified to AddUrl()
// - return 0 (NO_ERROR) on success, an error code if failed (e.g.
// -1 if the corresponding parameters do not match any previous AddUrl)
function RemoveUrl(const aRoot, aPort: SockString; Https: boolean=false;
const aDomainName: SockString='*'): integer;
/// will authorize a specified URL prefix
// - will allow to call AddUrl() later for any user on the computer
// - if aRoot is left '', it will authorize any root for this port
// - must be called with Administrator rights: this class function is to be
// used in a Setup program for instance, especially under Vista or Seven,
// to reserve the Url for the server
// - add a new record to the http.sys URL reservation store
// - return '' on success, an error message otherwise
// - will first delete any matching rule for this URL prefix
// - if OnlyDelete is true, will delete but won't add the new authorization;
// in this case, any error message at deletion will be returned
class function AddUrlAuthorize(const aRoot, aPort: SockString; Https: boolean=false;
const aDomainName: SockString='*'; OnlyDelete: boolean=false): string;
/// will register a compression algorithm
// - overridden method which will handle any cloned instances
procedure RegisterCompress(aFunction: THttpSocketCompress;
aCompressMinSize: integer=1024); override;
/// access to the internal THttpApiServer list cloned by this main instance
// - as created by Clone() method
property Clones: TObjectList read fClones;
public { HTTP API 2.0 methods and properties }
/// can be used to check if the HTTP API 2.0 is available
function HasAPI2: boolean;
/// enable HTTP API 2.0 advanced timeout settings
// - all those settings are set for the current URL group
// - will raise an EHttpApiServer exception if the old HTTP API 1.x is used
// so you should better test the availability of the method first:
// ! if aServer.HasAPI2 then
// ! SetTimeOutLimits(....);
// - aEntityBody is the time, in seconds, allowed for the request entity
// body to arrive - default value is 2 minutes
// - aDrainEntityBody is the time, in seconds, allowed for the HTTP Server
// API to drain the entity body on a Keep-Alive connection - default value
// is 2 minutes
// - aRequestQueue is the time, in seconds, allowed for the request to
// remain in the request queue before the application picks it up - default
// value is 2 minutes
// - aIdleConnection is the time, in seconds, allowed for an idle connection;
// is similar to THttpServer.ServerKeepAliveTimeOut - default value is
// 2 minutes
// - aHeaderWait is the time, in seconds, allowed for the HTTP Server API
// to parse the request header - default value is 2 minutes
// - aMinSendRate is the minimum send rate, in bytes-per-second, for the
// response - default value is 150 bytes-per-second
// - any value set to 0 will set the HTTP Server API default value
procedure SetTimeOutLimits(aEntityBody, aDrainEntityBody,
aRequestQueue, aIdleConnection, aHeaderWait, aMinSendRate: cardinal);
/// enable HTTP API 2.0 logging
// - will raise an EHttpApiServer exception if the old HTTP API 1.x is used
// so you should better test the availability of the method first:
// ! if aServer.HasAPI2 then
// ! LogStart(....);
// - this method won't do anything on the cloned instances, but the main
// instance logging state will be replicated to all cloned instances
// - you can select the output folder and the expected logging layout
// - aSoftwareName will set the optional W3C-only software name string
// - aRolloverSize will be used only when aRolloverType is hlrSize
procedure LogStart(const aLogFolder: TFileName;
aType: THttpApiLoggingType=hltW3C;
const aSoftwareName: TFileName='';
aRolloverType: THttpApiLoggingRollOver=hlrDaily;
aRolloverSize: cardinal=0;
aLogFields: THttpApiLogFields=[hlfDate..hlfSubStatus];
aFlags: THttpApiLoggingFlags=[hlfUseUTF8Conversion]);
/// disable HTTP API 2.0 logging
// - this method won't do anything on the cloned instances, but the main
// instance logging state will be replicated to all cloned instances
procedure LogStop;
/// enable HTTP API 2.0 server-side authentication
// - once enabled, the client sends an unauthenticated request: it is up to
// the server application to generate the initial 401 challenge with proper
// WWW-Authenticate headers; any further authentication steps will be
// perform in kernel mode, until the authentication handshake is finalized;
// later on, the application can check the AuthenticationStatus property
// of THttpServerRequest and its associated AuthenticatedUser value
// see https://msdn.microsoft.com/en-us/library/windows/desktop/aa364452
// - will raise an EHttpApiServer exception if the old HTTP API 1.x is used
// so you should better test the availability of the method first:
// ! if aServer.HasAPI2 then
// ! SetAuthenticationSchemes(....);
// - this method will work on the current group, for all instances
// - see HTTPAPI_AUTH_ENABLE_ALL constant to set all available schemes
// - optional Realm parameters can be used when haBasic scheme is defined
// - optional DomainName and Realm parameters can be used for haDigest
procedure SetAuthenticationSchemes(schemes: THttpApiRequestAuthentications;
const DomainName: SynUnicode=''; const Realm: SynUnicode='');
/// read-only access to HTTP API 2.0 server-side enabled authentication schemes
property AuthenticationSchemes: THttpApiRequestAuthentications
read fAuthenticationSchemes;
/// read-only access to check if the HTTP API 2.0 logging is enabled
// - use LogStart/LogStop methods to change this property value
property Logging: boolean read GetLogging;
/// the current HTTP API 2.0 logging Service name
// - should be UTF-8 encoded, if LogStart(aFlags=[hlfUseUTF8Conversion])
// - this value is dedicated to one instance, so the main instance won't
// propagate the change to all cloned instances
property LoggingServiceName: SockString
read fLoggingServiceName write SetLoggingServiceName;
/// read-only access to the low-level HTTP API 2.0 Session ID
property ServerSessionID: HTTP_SERVER_SESSION_ID read fServerSessionID;
/// read-only access to the low-level HTTP API 2.0 URI Group ID
property UrlGroupID: HTTP_URL_GROUP_ID read fUrlGroupID;
/// how many bytes are retrieved in a single call to ReceiveRequestEntityBody
// - set by default to 1048576, i.e. 1 MB - practical limit is around 20 MB
// - you may customize this value if you encounter HTTP error STATUS_NOTACCEPTABLE
// (406) from client, corresponding to an ERROR_NO_SYSTEM_RESOURCES (1450)
// exception on server side, when uploading huge data content
property ReceiveBufferSize: cardinal read fReceiveBufferSize write SetReceiveBufferSize;
published
/// TRUE if this instance is in fact a cloned instance for the thread pool
property Cloned: boolean read GetCloned;
/// return the list of registered URL on this server instance
property RegisteredUrl: SynUnicode read GetRegisteredUrl;
/// HTTP.sys request/response queue length (via HTTP API 2.0)
// - default value if 1000, which sounds fine for most use cases
// - increase this value in case of many 503 HTTP answers or if many
// "QueueFull" messages appear in HTTP.sys log files (normaly in
// C:\Windows\System32\LogFiles\HTTPERR\httperr*.log) - may appear with
// thousands of concurrent clients accessing at once the same server
// - see @http://msdn.microsoft.com/en-us/library/windows/desktop/aa364501
// - will return 0 if the system does not support HTTP API 2.0 (i.e.
// under Windows XP or Server 2003)
// - this method will also handle any cloned instances, so you can write e.g.
// ! if aSQLHttpServer.HttpServer.InheritsFrom(THttpApiServer) then
// ! THttpApiServer(aSQLHttpServer.HttpServer).HTTPQueueLength := 5000;
property HTTPQueueLength: Cardinal read GetHTTPQueueLength write SetHTTPQueueLength;
/// the maximum allowed bandwidth rate in bytes per second (via HTTP API 2.0)
// - Setting this value to 0 allows an unlimited bandwidth
// - by default Windows not limit bandwidth (actually limited to 4 Gbit/sec).
// - will return 0 if the system does not support HTTP API 2.0 (i.e.
// under Windows XP or Server 2003)
property MaxBandwidth: Cardinal read GetMaxBandwidth write SetMaxBandwidth;
/// the maximum number of HTTP connections allowed (via HTTP API 2.0)
// - Setting this value to 0 allows an unlimited number of connections
// - by default Windows does not limit number of allowed connections
// - will return 0 if the system does not support HTTP API 2.0 (i.e.
// under Windows XP or Server 2003)
property MaxConnections: Cardinal read GetMaxConnections write SetMaxConnections;
end;
/// low-level API reference to a WebSocket session
WEB_SOCKET_HANDLE = Pointer;
/// WebSocket close status as defined by http://tools.ietf.org/html/rfc6455#section-7.4
WEB_SOCKET_CLOSE_STATUS = Word;
/// the bit values used to construct the WebSocket frame header for httpapi.dll
// - not equals to WINHTTP_WEB_SOCKET_BUFFER_TYPE from winhttp.dll
WEB_SOCKET_BUFFER_TYPE = ULONG;
TSynThreadPoolHttpApiWebSocketServer = class;
TSynWebSocketGuard = class;
THttpApiWebSocketServer = class;
THttpApiWebSocketServerProtocol = class;
/// current state of a THttpApiWebSocketConnection
TWebSocketState = (wsConnecting, wsOpen,
wsClosing, wsClosedByClient, wsClosedByServer, wsClosedByGuard, wsClosedByShutdown);
/// structure representing a single WebSocket connection
{$ifdef UNICODE}
THttpApiWebSocketConnection = record
{$else}
THttpApiWebSocketConnection = object
{$endif}
private
fOverlapped: TOverlapped;
fState: TWebSocketState;
fProtocol: THttpApiWebSocketServerProtocol;
fOpaqueHTTPRequestId: HTTP_REQUEST_ID;
fWSHandle: WEB_SOCKET_HANDLE;
fLastActionContext: Pointer;
fLastReceiveTickCount: Cardinal;
fPrivateData: pointer;
fBuffer: SockString;
fCloseStatus: WEB_SOCKET_CLOSE_STATUS;
fIndex: integer;
function ProcessActions(ActionQueue: Cardinal): boolean;
function ReadData(const WebsocketBufferData): integer;
procedure WriteData(const WebsocketBufferData);
procedure BeforeRead;
procedure DoOnMessage(aBufferType: WEB_SOCKET_BUFFER_TYPE;
aBuffer: Pointer; aBufferSize: ULONG);
procedure DoOnConnect;
procedure DoOnDisconnect();
procedure InternalSend(aBufferType: WEB_SOCKET_BUFFER_TYPE; WebsocketBufferData: pointer);
procedure Ping;
procedure Disconnect;
procedure CheckIsActive;
// call onAccept Method of protocol, and if protocol not accept connection or
// can not be accepted from other reasons return false else return true
function TryAcceptConnection(aProtocol: THttpApiWebSocketServerProtocol; Ctxt: THttpServerRequest; aNeedHeader: boolean): boolean;
public
/// Index of connection in protocol's connection list
property Index: integer read fIndex;
/// Protocol of connection
property Protocol: THttpApiWebSocketServerProtocol read fProtocol;
/// Custom user data
property PrivateData: pointer read fPrivateData write fPrivateData;
/// Access to the current state of this connection
property State: TWebSocketState read fState;
/// Send data to client
procedure Send(aBufferType: WEB_SOCKET_BUFFER_TYPE; aBuffer: Pointer; aBufferSize: ULONG);
/// Close connection
procedure Close(aStatus: WEB_SOCKET_CLOSE_STATUS; aBuffer: Pointer; aBufferSize: ULONG);
end;
PHttpApiWebSocketConnection = ^THttpApiWebSocketConnection;
THttpApiWebSocketConnectionVector = array[0..MaxInt div SizeOf(PHttpApiWebSocketConnection) - 1] of PHttpApiWebSocketConnection;
PHttpApiWebSocketConnectionVector = ^THttpApiWebSocketConnectionVector;
/// Event handlers for WebSocket
THttpApiWebSocketServerOnAcceptEvent = function(Ctxt: THttpServerRequest;
var Conn: THttpApiWebSocketConnection): Boolean of object;
THttpApiWebSocketServerOnMessageEvent = procedure(const Conn: THttpApiWebSocketConnection;
aBufferType: WEB_SOCKET_BUFFER_TYPE; aBuffer: Pointer; aBufferSize: ULONG) of object;
THttpApiWebSocketServerOnConnectEvent = procedure(const Conn: THttpApiWebSocketConnection) of object;
THttpApiWebSocketServerOnDisconnectEvent = procedure(const Conn: THttpApiWebSocketConnection;
aStatus: WEB_SOCKET_CLOSE_STATUS; aBuffer: Pointer; aBufferSize: ULONG) of object;
/// Protocol Handler of websocket endpoints events
// - maintains a list of all WebSockets clients for a given protocol
THttpApiWebSocketServerProtocol = class
private
fName: SockString;
fManualFragmentManagement: Boolean;
fOnAccept: THttpApiWebSocketServerOnAcceptEvent;
fOnMessage: THttpApiWebSocketServerOnMessageEvent;
fOnFragment: THttpApiWebSocketServerOnMessageEvent;
fOnConnect: THttpApiWebSocketServerOnConnectEvent;
fOnDisconnect: THttpApiWebSocketServerOnDisconnectEvent;
fConnections: PHttpApiWebSocketConnectionVector;
fConnectionsCapacity: Integer;
//Count of used connections. Some of them can be nil(if not used more)
fConnectionsCount: Integer;
fFirstEmptyConnectionIndex: Integer;
fServer: THttpApiWebSocketServer;
fSafe: TRTLCriticalSection;
fPendingForClose: TList;
fIndex: integer;
function AddConnection(aConn: PHttpApiWebSocketConnection): Integer;
procedure RemoveConnection(index: integer);
procedure doShutdown;
public
/// initialize the WebSockets process
// - if aManualFragmentManagement is true, onMessage will appear only for whole
// received messages, otherwise OnFragment handler must be passed (for video
// broadcast, for example)
constructor Create(const aName: SockString; aManualFragmentManagement: Boolean;
aServer: THttpApiWebSocketServer;
aOnAccept: THttpApiWebSocketServerOnAcceptEvent;
aOnMessage: THttpApiWebSocketServerOnMessageEvent;
aOnConnect: THttpApiWebSocketServerOnConnectEvent;
aOnDisconnect: THttpApiWebSocketServerOnDisconnectEvent;
aOnFragment: THttpApiWebSocketServerOnMessageEvent=nil);
/// finalize the process
destructor Destroy; override;
/// text identifier
property Name: SockString read fName;
/// identify the endpoint instance
property Index: integer read fIndex;
/// OnFragment event will be called for each fragment
property ManualFragmentManagement: Boolean read fManualFragmentManagement;
/// event triggerred when a WebSockets client is initiated
property OnAccept: THttpApiWebSocketServerOnAcceptEvent read fOnAccept;
/// event triggerred when a WebSockets message is received
property OnMessage: THttpApiWebSocketServerOnMessageEvent read fOnMessage;
/// event triggerred when a WebSockets client is connected
property OnConnect: THttpApiWebSocketServerOnConnectEvent read fOnConnect;
/// event triggerred when a WebSockets client is gracefully disconnected
property OnDisconnect: THttpApiWebSocketServerOnDisconnectEvent read fOnDisconnect;
/// event triggerred when a non complete frame is received
// - required if ManualFragmentManagement is true
property OnFragment: THttpApiWebSocketServerOnMessageEvent read fOnFragment;
/// Send message to the WebSocket connection identified by its index
function Send(index: Integer; aBufferType: ULONG; aBuffer: Pointer; aBufferSize: ULONG): boolean;
/// Send message to all connections of this protocol
function Broadcast(aBufferType: ULONG; aBuffer: Pointer; aBufferSize: ULONG): boolean;
/// Close WebSocket connection identified by its index
function Close(index: Integer; aStatus: WEB_SOCKET_CLOSE_STATUS; aBuffer: Pointer; aBufferSize: ULONG): boolean;
end;
THttpApiWebSocketServerProtocolDynArray = array of THttpApiWebSocketServerProtocol;
PHttpApiWebSocketServerProtocolDynArray = ^THttpApiWebSocketServerProtocolDynArray;
/// HTTP & WebSocket server using fast http.sys kernel-mode server
// - can be used like simple THttpApiServer
// - when AddUrlWebSocket is called WebSocket support are added
// in this case WebSocket will receiving the frames in asynchronous
THttpApiWebSocketServer = class(THttpApiServer)
private
fThreadPoolServer: TSynThreadPoolHttpApiWebSocketServer;
fGuard: TSynWebSocketGuard;
fLastConnection: PHttpApiWebSocketConnection;
fPingTimeout: integer;
fRegisteredProtocols: PHttpApiWebSocketServerProtocolDynArray;
fOnWSThreadStart: TNotifyThreadEvent;
fOnWSThreadTerminate: TNotifyThreadEvent;
fSendOverlaped: TOverlapped;
fServiceOverlaped: TOverlapped;
fOnServiceMessage: TThreadMethod;
procedure SetOnWSThreadTerminate(const Value: TNotifyThreadEvent);
function GetProtocol(index: integer): THttpApiWebSocketServerProtocol;
function getProtocolsCount: Integer;
procedure SetOnWSThreadStart(const Value: TNotifyThreadEvent);
protected
function UpgradeToWebSocket(Ctxt: THttpServerRequest): cardinal;
procedure DoAfterResponse(Ctxt: THttpServerRequest); override;
function GetSendResponseFlags(Ctxt: THttpServerRequest): Integer; override;
constructor CreateClone(From: THttpApiServer); override;
procedure DestroyMainThread; override;
public
/// initialize the HTTPAPI based Server with WebSocket support
// - will raise an exception if http.sys or websocket.dll is not available
// (e.g. before Windows 8) or if the request queue creation failed
// - for aPingTimeout explanation see PingTimeout property documentation
constructor Create(CreateSuspended: Boolean; aSocketThreadsCount: integer=1;
aPingTimeout: integer=0; QueueName: SynUnicode='';
aOnWSThreadStart: TNotifyThreadEvent=nil;
aOnWSThreadTerminate: TNotifyThreadEvent=nil); reintroduce;
/// prepare the process for a given THttpApiWebSocketServerProtocol
procedure RegisterProtocol(const aName: SockString; aManualFragmentManagement: Boolean;
aOnAccept: THttpApiWebSocketServerOnAcceptEvent;
aOnMessage: THttpApiWebSocketServerOnMessageEvent;
aOnConnect: THttpApiWebSocketServerOnConnectEvent;
aOnDisconnect: THttpApiWebSocketServerOnDisconnectEvent;
aOnFragment: THttpApiWebSocketServerOnMessageEvent=nil);
/// register the URLs to Listen on using WebSocket
// - aProtocols is an array of a recond with callbacks, server call during
// WebSocket activity
function AddUrlWebSocket(const aRoot, aPort: SockString; Https: boolean=false;
const aDomainName: SockString='*'; aRegisterURI: boolean=false): integer;
function Request(Ctxt: THttpServerRequest): cardinal; override;
/// Ping timeout in seconds. 0 mean no ping.
// - if connection not receive messages longer than this timeout
// TSynWebSocketGuard will send ping frame
// - if connection not receive any messages longer than double of
// this timeout it will be closed
property PingTimeout: integer read fPingTimeout;
/// access to the associated endpoints
property Protocols[index: integer]: THttpApiWebSocketServerProtocol read GetProtocol;
/// access to the associated endpoints count
property ProtocolsCount: Integer read getProtocolsCount;
/// event called when the processing thread starts
property OnWSThreadStart: TNotifyThreadEvent read FOnWSThreadStart
write SetOnWSThreadStart;
/// event called when the processing thread termintes
property OnWSThreadTerminate: TNotifyThreadEvent read FOnWSThreadTerminate
write SetOnWSThreadTerminate;
/// can be called from any thread
// - will send a "service" message to a WebSocketServer to wake up a WebSocket thread
// - When a webSocket thread receives such a message it will call onServiceMessage in the thread context
procedure SendServiceMessage;
/// event called when a service message is raised
property OnServiceMessage: TThreadMethod read fOnServiceMessage write fOnServiceMessage;
end;
/// a Thread Pool, used for fast handling WebSocket requests
TSynThreadPoolHttpApiWebSocketServer = class(TSynThreadPool)
protected
fServer: THttpApiWebSocketServer;
procedure onThreadStart(Sender: TThread);
procedure onThreadTerminate(Sender: TThread);
function NeedStopOnIOError: Boolean; override;
procedure Task(aCaller: TSynThread; aContext: Pointer); override;
public
/// initialize the thread pool
constructor Create(Server: THttpApiWebSocketServer; NumberOfThreads: Integer=1); reintroduce;
end;
/// Thread for closing WebSocket connections which not response more than PingTimeout interval
TSynWebSocketGuard = class(TThread)
protected
fServer: THttpApiWebSocketServer;
fSmallWait, fWaitCount: integer;
procedure Execute; override;
public
/// initialize the thread
constructor Create(Server: THttpApiWebSocketServer); reintroduce;
end;
{$endif MSWINDOWS}
/// an event handler for implementing a socked-based Thread Pool
// - matches TSynThreadPool.Push method signature
// - uses pointer instead of TSocket=THandle to be implementation neutral
// - should return false if there is no thread available in the pool
TOnThreadPoolSocketPush = function(aClientSock: pointer): boolean of object;
/// event handler used by THttpServer.Process to send a local file
// when HTTP_RESP_STATICFILE content-type is returned by the service
// - can be defined e.g. to use NGINX X-Accel-Redirect header
// - should return true if the Context has been modified to serve the file, or
// false so that the file will be manually read and sent from memory
// - any exception during process will be returned as a STATUS_NOTFOUND page
TOnHttpServerSendFile = function(Context: THttpServerRequest;
const LocalFileName: TFileName): boolean of object;
/// main HTTP server Thread using the standard Sockets API (e.g. WinSock)
// - bind to a port and listen to incoming requests
// - assign this requests to THttpServerResp threads
// - it implements a HTTP/1.1 compatible server, according to RFC 2068 specifications
// - if the client is also HTTP/1.1 compatible, KeepAlive connection is handled:
// multiple requests will use the existing connection and thread;
// this is faster and uses less resources, especialy under Windows
// - a Thread Pool is used internaly to speed up HTTP/1.0 connections - a
// typical use, under Linux, is to run this class behind a NGINX frontend,
// configured as https reverse proxy, leaving default "proxy_http_version 1.0"
// and "proxy_request_buffering on" options for best performance, and
// setting KeepAliveTimeOut=0 in the THttpServer.Create constructor
// - under windows, will trigger the firewall UAC popup at first run
// - don't forget to use Free method when you are finished
THttpServer = class(THttpServerGeneric)
protected
/// used to protect Process() call
fProcessCS: TRTLCriticalSection;
fThreadPoolPush: TOnThreadPoolSocketPush;
fThreadPoolContentionTime: cardinal;
fThreadPoolContentionCount: cardinal;
fThreadPoolContentionAbortCount: cardinal;
fThreadPoolContentionAbortDelay: cardinal;
fThreadPool: TSynThreadPoolTHttpServer;
fInternalHttpServerRespList: TList;
fServerConnectionCount: cardinal;
fServerKeepAliveTimeOut: cardinal;
fTCPPrefix: SockString;
fSock: TCrtSocket;
fThreadRespClass: THttpServerRespClass;
fOnSendFile: TOnHttpServerSendFile;
fNginxSendFileFrom: array of TFileName;
fExecuteFinished: boolean;
function OnNginxAllowSend(Context: THttpServerRequest; const LocalFileName: TFileName): boolean;
// this overridden version will return e.g. 'Winsock 2.514'
function GetAPIVersion: string; override;
/// server main loop - don't change directly
procedure Execute; override;
/// this method is called on every new client connection, i.e. every time
// a THttpServerResp thread is created with a new incoming socket
procedure OnConnect; virtual;
/// this method is called on every client disconnection to update stats
procedure OnDisconnect; virtual;
/// override this function in order to low-level process the request;
// default process is to get headers, and call public function Request
procedure Process(ClientSock: THttpServerSocket;
ConnectionID: integer; ConnectionThread: TSynThread); virtual;
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'
// - you can specify a number of threads to be initialized to handle
// incoming connections (default is 32, which may be sufficient for most
// cases, maximum is 256) - if you set 0, the thread pool will be disabled
// and one thread will be created for any incoming connection
// - you can also tune (or disable with 0) HTTP/1.1 keep alive delay
constructor Create(const aPort: SockString; OnStart,OnStop: TNotifyThreadEvent;
const ProcessName: SockString; ServerThreadPoolCount: integer=32;
KeepAliveTimeOut: integer=3000); reintroduce; virtual;
/// enable NGINX X-Accel internal redirection for HTTP_RESP_STATICFILE
// - will define internally a matching OnSendFile event handler
// - generating "X-Accel-Redirect: " header, trimming any supplied left
// case-sensitive file name prefix, e.g. with NginxSendFileFrom('/var/www'):
// $ # Will serve /var/www/protected_files/myfile.tar.gz
// $ # When passed URI /protected_files/myfile.tar.gz
// $ location /protected_files {
// $ internal;
// $ root /var/www;
// $ }
// - call this method several times to register several folders
procedure NginxSendFileFrom(const FileNameLeftTrim: TFileName);
/// release all memory and handlers
destructor Destroy; override;
/// access to the main server low-level Socket
// - it's a raw TCrtSocket, which only need a socket to be bound, listening
// and accept incoming request
// - THttpServerSocket are created on the fly for every request, then
// a THttpServerResp thread is created for handling this THttpServerSocket
property Sock: TCrtSocket read fSock;
published
/// will contain the total number of connections to the server
// - it's the global count since the server started
property ServerConnectionCount: cardinal
read fServerConnectionCount write fServerConnectionCount;
/// time, in milliseconds, for the HTTP/1.1 connections to be kept alive
// - default is 3000 ms
// - setting 0 here (or in KeepAliveTimeOut constructor parameter) will
// disable keep-alive, and fallback to HTTP.1/0 for all incoming requests
// (may be a good idea e.g. behind a NGINX reverse proxy)
// - see THttpApiServer.SetTimeOutLimits(aIdleConnection) parameter
property ServerKeepAliveTimeOut: cardinal
read fServerKeepAliveTimeOut write fServerKeepAliveTimeOut;
/// TCP/IP prefix to mask HTTP protocol
// - if not set, will create full HTTP/1.0 or HTTP/1.1 compliant content
// - in order to make the TCP/IP stream not HTTP compliant, you can specify
// a prefix which will be put before the first header line: in this case,
// the TCP/IP stream won't be recognized as HTTP, and will be ignored by
// most AntiVirus programs, and increase security - but you won't be able
// to use an Internet Browser nor AJAX application for remote access any more
property TCPPrefix: SockString read fTCPPrefix write fTCPPrefix;
/// the associated thread pool
// - may be nil if ServerThreadPoolCount was 0 on constructor
property ThreadPool: TSynThreadPoolTHttpServer read fThreadPool;
/// milliseconds spent waiting for an available thread in the pool
// - no available thread won't make any error at first, but try again until
// ThreadPoolContentionAbortDelay is reached and the incoming socket aborded
// - if this number is high, consider setting a higher number of threads,
// or profile and tune the Request method processing
property ThreadPoolContentionTime: cardinal read fThreadPoolContentionTime;
/// how many time the process was waiting for an available thread in the pool
// - no available thread won't make any error at first, but try again until
// ThreadPoolContentionAbortDelay is reached and the incoming socket aborded
// - if this number is high, consider setting a higher number of threads,
// or profile and tune the Request method processing
// - use this property and ThreadPoolContentionTime to compute the
// average contention time
property ThreadPoolContentionCount: cardinal read fThreadPoolContentionCount;
/// how many connections were rejected due to thread pool contention
// - disconnect the client socket after ThreadPoolContentionAbortDelay
// - any high number here requires code refactoring of Request method! :)
property ThreadPoolContentionAbortCount: cardinal read fThreadPoolContentionAbortCount;
/// milliseconds delay to reject a connection due to thread pool contention
// - default is 5000, i.e. 5 seconds
property ThreadPoolContentionAbortDelay: cardinal read fThreadPoolContentionAbortDelay
write fThreadPoolContentionAbortDelay;
/// custom event handler used to send a local file for HTTP_RESP_STATICFILE
// - see also NginxSendFileFrom() method
property OnSendFile: TOnHttpServerSendFile read fOnSendFile write fOnSendFile;
end;
{$M-}
/// structure used to parse an URI into its components
// - ready to be supplied e.g. to a THttpRequest sub-class
// - used e.g. by class function THttpRequest.Get()
TURI = {$ifdef UNICODE}record{$else}object{$endif}
public
/// if the server is accessible via https:// and not plain http://
Https: boolean;
/// if the server is accessible via something else than http:// or https://
// - e.g. 'ws' or 'wss' for ws:// or wss://
Scheme: SockString;
/// the server name
// - e.g. 'www.somewebsite.com'
Server: SockString;
/// the server port
// - e.g. '80'
Port: SockString;
/// the resource address
// - e.g. '/category/name/10?param=1'
Address: SockString;
/// fill the members from a supplied URI
function From(aURI: SockString; const DefaultPort: SockString=''): boolean;
/// compute the whole normalized URI
function URI: SockString;
/// the server port, as integer value
function PortInt: integer;
/// compute the root resource Address, without any URI-encoded parameter
// - e.g. '/category/name/10'
function Root: SockString;
/// reset all stored information
procedure Clear;
end;
/// the supported authentication schemes which may be used by HTTP clients
// - supported only by TWinHTTP class yet
THttpRequestAuthentication = (wraNone,wraBasic,wraDigest,wraNegotiate);
/// a record to set some extended options for HTTP clients
// - allow easy propagation e.g. from a TSQLHttpClient* wrapper class to
// the actual SynCrtSock's THttpRequest implementation class
THttpRequestExtendedOptions = record
/// let HTTPS be less paranoid about SSL certificates
// - IgnoreSSLCertificateErrors is handled by TWinHttp and TCurlHTTP
IgnoreSSLCertificateErrors: boolean;
/// allow HTTP authentication to take place at connection
// - Auth.Scheme and UserName/Password properties are handled
// by the TWinHttp class only by now
Auth: record
UserName: SynUnicode;
Password: SynUnicode;
Scheme: THttpRequestAuthentication;
end;
end;
{$M+} // to have existing RTTI for published properties
/// abstract class to handle HTTP/1.1 request
// - never instantiate this class, but inherited TWinHTTP, TWinINet or TCurlHTTP
THttpRequest = class
protected
fServer: SockString;
fProxyName: SockString;
fProxyByPass: SockString;
fPort: cardinal;
fHttps: boolean;
fKeepAlive: cardinal;
fUserAgent: SockString;
fExtendedOptions: THttpRequestExtendedOptions;
/// used by RegisterCompress method
fCompress: THttpSocketCompressRecDynArray;
/// set by RegisterCompress method
fCompressAcceptEncoding: SockString;
/// set index of protocol in fCompress[], from ACCEPT-ENCODING: header
fCompressHeader: THttpSocketCompressSet;
fTag: PtrInt;
class function InternalREST(const url,method,data,header: SockString;
aIgnoreSSLCertificateErrors: boolean; outHeaders: PSockString=nil): SockString;
// inherited class should override those abstract methods
procedure InternalConnect(ConnectionTimeOut,SendTimeout,ReceiveTimeout: DWORD); virtual; abstract;
procedure InternalCreateRequest(const method, aURL: SockString); virtual; abstract;
procedure InternalSendRequest(const aData: SockString); virtual; abstract;
function InternalRetrieveAnswer(var Header, Encoding, AcceptEncoding,
Data: SockString): integer; virtual; abstract;
procedure InternalCloseRequest; virtual; abstract;
procedure InternalAddHeader(const hdr: SockString); virtual; abstract;
public
/// returns TRUE if the class is actually supported on this system
class function IsAvailable: boolean; virtual; abstract;
/// connect to http://aServer:aPort or https://aServer:aPort
// - optional aProxyName may contain the name of the proxy server to use,
// and aProxyByPass an optional semicolon delimited list of host names or
// IP addresses, or both, that should not be routed through the proxy:
// aProxyName/aProxyByPass will be recognized by TWinHTTP and TWinINet,
// and aProxyName will set the CURLOPT_PROXY option to TCurlHttp
// (see https://curl.haxx.se/libcurl/c/CURLOPT_PROXY.html as reference)
// - you can customize the default client timeouts by setting appropriate
// SendTimeout and ReceiveTimeout parameters (in ms) - note that after
// creation of this instance, the connection is tied to the initial
// parameters, so we won't publish any properties to change those
// initial values once created - if you left the 0 default parameters, it
// would use global HTTP_DEFAULT_CONNECTTIMEOUT, HTTP_DEFAULT_SENDTIMEOUT
// and HTTP_DEFAULT_RECEIVETIMEOUT variable values
// - *TimeOut parameters are currently ignored by TCurlHttp
constructor Create(const aServer, aPort: SockString; aHttps: boolean;
const aProxyName: SockString=''; const aProxyByPass: SockString='';
ConnectionTimeOut: DWORD=0; SendTimeout: DWORD=0; ReceiveTimeout: DWORD=0); overload; virtual;
/// connect to the supplied URI
// - is just a wrapper around TURI and the overloaded Create() constructor
constructor Create(const aURI: SockString;
const aProxyName: SockString=''; const aProxyByPass: SockString='';
ConnectionTimeOut: DWORD=0; SendTimeout: DWORD=0; ReceiveTimeout: DWORD=0;
aIgnoreSSLCertificateErrors: boolean=false); overload;
/// low-level HTTP/1.1 request
// - after an Create(server,port), return 200,202,204 if OK,
// http status error otherwise
// - KeepAlive is in milliseconds, 0 for "Connection: Close" HTTP/1.0 requests
function Request(const url, method: SockString; KeepAlive: cardinal;
const InHeader, InData, InDataType: SockString;
out OutHeader, OutData: SockString): integer; virtual;
/// wrapper method to retrieve a resource via an HTTP GET
// - will parse the supplied URI to check for the http protocol (HTTP/HTTPS),
// server name and port, and resource name
// - aIgnoreSSLCerticateErrors will ignore the error when using untrusted certificates
// - it will internally create a THttpRequest inherited instance: do not use
// THttpRequest.Get() but either TWinHTTP.Get(), TWinINet.Get() or
// TCurlHTTP.Get() methods
class function Get(const aURI: SockString; const aHeader: SockString='';
aIgnoreSSLCertificateErrors: boolean=true; outHeaders: PSockString=nil): SockString;
/// wrapper method to create a resource via an HTTP POST
// - will parse the supplied URI to check for the http protocol (HTTP/HTTPS),
// server name and port, and resource name
// - aIgnoreSSLCerticateErrors will ignore the error when using untrusted certificates
// - the supplied aData content is POSTed to the server, with an optional
// aHeader content
// - it will internally create a THttpRequest inherited instance: do not use
// THttpRequest.Post() but either TWinHTTP.Post(), TWinINet.Post() or
// TCurlHTTP.Post() methods
class function Post(const aURI, aData: SockString; const aHeader: SockString='';
aIgnoreSSLCertificateErrors: boolean=true; outHeaders: PSockString=nil): SockString;
/// wrapper method to update a resource via an HTTP PUT
// - will parse the supplied URI to check for the http protocol (HTTP/HTTPS),
// server name and port, and resource name
// - aIgnoreSSLCerticateErrors will ignore the error when using untrusted certificates
// - the supplied aData content is PUT to the server, with an optional
// aHeader content
// - it will internally create a THttpRequest inherited instance: do not use
// THttpRequest.Put() but either TWinHTTP.Put(), TWinINet.Put() or
// TCurlHTTP.Put() methods
class function Put(const aURI, aData: SockString; const aHeader: SockString='';
aIgnoreSSLCertificateErrors: boolean=true; outHeaders: PSockString=nil): SockString;
/// wrapper method to delete a resource via an HTTP DELETE
// - will parse the supplied URI to check for the http protocol (HTTP/HTTPS),
// server name and port, and resource name
// - aIgnoreSSLCerticateErrors will ignore the error when using untrusted certificates
// - it will internally create a THttpRequest inherited instance: do not use
// THttpRequest.Delete() but either TWinHTTP.Delete(), TWinINet.Delete() or
// TCurlHTTP.Delete() methods
class function Delete(const aURI: SockString; const aHeader: SockString='';
aIgnoreSSLCertificateErrors: boolean=true; outHeaders: PSockString=nil): SockString;
/// will register a compression algorithm
// - used e.g. to compress on the fly the data, with standard gzip/deflate
// or custom (synlzo/synlz) protocols
// - returns true on success, false if this function or this
// ACCEPT-ENCODING: header was already registered
// - you can specify a minimal size (in bytes) before which the content won't
// be compressed (1024 by default, corresponding to a MTU of 1500 bytes)
// - the first registered algorithm will be the prefered one for compression
function RegisterCompress(aFunction: THttpSocketCompress;
aCompressMinSize: integer=1024): boolean;
/// allows to ignore untrusted SSL certificates
// - similar to adding a security exception for a domain in the browser
property IgnoreSSLCertificateErrors: boolean
read fExtendedOptions.IgnoreSSLCertificateErrors
write fExtendedOptions.IgnoreSSLCertificateErrors;
/// optional Authentication Scheme
property AuthScheme: THttpRequestAuthentication
read fExtendedOptions.Auth.Scheme write fExtendedOptions.Auth.Scheme;
/// optional User Name for Authentication
property AuthUserName: SynUnicode
read fExtendedOptions.Auth.UserName write fExtendedOptions.Auth.UserName;
/// optional Password for Authentication
property AuthPassword: SynUnicode
read fExtendedOptions.Auth.Password write fExtendedOptions.Auth.Password;
/// internal structure used to store extended options
// - will be replicated by IgnoreSSLCertificateErrors and Auth* properties
property ExtendedOptions: THttpRequestExtendedOptions
read fExtendedOptions write fExtendedOptions;
/// some internal field, which may be used by end-user code
property Tag: PtrInt read fTag write fTag;
published
/// the remote server host name, as stated specified to the class constructor
property Server: SockString read fServer;
/// the remote server port number, as specified to the class constructor
property Port: cardinal read fPort;
/// if the remote server uses HTTPS, as specified to the class constructor
property Https: boolean read fHttps;
/// the remote server optional proxy, as specified to the class constructor
property ProxyName: SockString read fProxyName;
/// the remote server optional proxy by-pass list, as specified to the class
// constructor
property ProxyByPass: SockString read fProxyByPass;
/// the HTTP "User Agent:" header value
// - you can customize this value from its default content
// (only for TCurlHTTP class)
property UserAgent: SockString read fUserAgent write fUserAgent;
end;
{$M-}
/// store the actual class of a HTTP/1.1 client instance
// - may be used to define at runtime which API to be used (e.g. WinHTTP,
// WinINet or LibCurl), following the Liskov substitution principle
THttpRequestClass = class of THttpRequest;
{$ifdef USEWININET}
TWinHttpAPI = class;
/// event callback to track download progress, e.g. in the UI
// - used in TWinHttpAPI.OnProgress property
// - CurrentSize is the current total number of downloaded bytes
// - ContentLength is retrieved from HTTP headers, but may be 0 if not set
TWinHttpProgress = procedure(Sender: TWinHttpAPI;
CurrentSize, ContentLength: DWORD) of object;
/// event callback to process the download by chunks, not in memory
// - used in TWinHttpAPI.OnDownload property
// - CurrentSize is the current total number of downloaded bytes
// - ContentLength is retrieved from HTTP headers, but may be 0 if not set
// - ChunkSize is the size of the latest downloaded chunk, available in
// the untyped ChunkData memory buffer
// - implementation should return TRUE to continue the download, or FALSE
// to abort the download process
TWinHttpDownload = function(Sender: TWinHttpAPI;
CurrentSize, ContentLength, ChunkSize: DWORD; const ChunkData): boolean of object;
/// a class to handle HTTP/1.1 request using either WinINet or WinHTTP API
// - both APIs have a common logic, which is encapsulated by this parent class
// - this abstract class defined some abstract methods which will be
// implemented by TWinINet or TWinHttp with the proper API calls
TWinHttpAPI = class(THttpRequest)
protected
fOnProgress: TWinHttpProgress;
fOnDownload: TWinHttpDownload;
fOnDownloadChunkSize: cardinal;
/// used for internal connection
fSession, fConnection, fRequest: HINTERNET;
function InternalGetInfo(Info: DWORD): SockString; virtual; abstract;
function InternalGetInfo32(Info: DWORD): DWORD; virtual; abstract;
function InternalReadData(var Data: SockString; Read: integer): cardinal; virtual; abstract;
function InternalRetrieveAnswer(
var Header, Encoding, AcceptEncoding, Data: SockString): integer; override;
public
/// returns TRUE if the class is actually supported on this system
class function IsAvailable: boolean; override;
/// download would call this method to notify progress
property OnProgress: TWinHttpProgress read fOnProgress write fOnProgress;
/// download would call this method instead of filling Data: SockString value
// - may be used e.g. when downloading huge content, and saving directly
// the incoming data on disk or database
// - if this property is set, raw TCP/IP incoming data would be supplied:
// compression and encoding won't be handled by the class
property OnDownload: TWinHttpDownload read fOnDownload write fOnDownload;
/// how many bytes should be retrieved for each OnDownload event chunk
// - if default 0 value is left, would use 65536, i.e. 64KB
property OnDownloadChunkSize: cardinal
read fOnDownloadChunkSize write fOnDownloadChunkSize;
end;
/// a class to handle HTTP/1.1 request using the WinINet API
// - The Microsoft Windows Internet (WinINet) application programming interface
// (API) enables applications to access standard Internet protocols, such as
// FTP and HTTP/HTTPS, similar to what IE offers
// - by design, the WinINet API should not be used from a service, since this
// API may require end-user GUI interaction
// - note: WinINet is MUCH slower than THttpClientSocket or TWinHttp: do not
// use this, only if you find some configuration benefit on some old networks
// (e.g. to diaplay the dialup popup window for a GUI client application)
TWinINet = class(TWinHttpAPI)
protected
// those internal methods will raise an EWinINet exception on error
procedure InternalConnect(ConnectionTimeOut,SendTimeout,ReceiveTimeout: DWORD); override;
procedure InternalCreateRequest(const method, aURL: SockString); override;
procedure InternalCloseRequest; override;
procedure InternalAddHeader(const hdr: SockString); override;
procedure InternalSendRequest(const aData: SockString); override;
function InternalGetInfo(Info: DWORD): SockString; override;
function InternalGetInfo32(Info: DWORD): DWORD; override;
function InternalReadData(var Data: SockString; Read: integer): cardinal; override;
public
/// relase the connection
destructor Destroy; override;
end;
/// WinINet exception type
EWinINet = class(ECrtSocket)
public
/// create a WinINet exception, with the error message as text
constructor Create;
end;
/// a class to handle HTTP/1.1 request using the WinHTTP API
// - has a common behavior as THttpClientSocket() but seems to be faster
// over a network and is able to retrieve the current proxy settings
// (if available) and handle secure https connection - so it seems to be the
// class to use in your client programs
// - WinHTTP does not share any proxy settings with Internet Explorer.
// The WinHTTP proxy configuration is set by either
// $ proxycfg.exe
// on Windows XP and Windows Server 2003 or earlier, either
// $ netsh.exe
// on Windows Vista and Windows Server 2008 or later; for instance,
// you can run either:
// $ proxycfg -u
// $ netsh winhttp import proxy source=ie
// to use the current user's proxy settings for Internet Explorer (under 64-bit
// Vista/Seven, to configure applications using the 32 bit WinHttp settings,
// call netsh or proxycfg bits from %SystemRoot%\SysWOW64 folder explicitely)
// - Microsoft Windows HTTP Services (WinHTTP) is targeted at middle-tier and
// back-end server applications that require access to an HTTP client stack
TWinHTTP = class(TWinHttpAPI)
protected
// those internal methods will raise an EOSError exception on error
procedure InternalConnect(ConnectionTimeOut,SendTimeout,ReceiveTimeout: DWORD); override;
procedure InternalCreateRequest(const method, aURL: SockString); override;
procedure InternalCloseRequest; override;
procedure InternalAddHeader(const hdr: SockString); override;
procedure InternalSendRequest(const aData: SockString); override;
function InternalGetInfo(Info: DWORD): SockString; override;
function InternalGetInfo32(Info: DWORD): DWORD; override;
function InternalReadData(var Data: SockString; Read: integer): cardinal; override;
public
/// relase the connection
destructor Destroy; override;
end;
/// WinHTTP exception type
EWinHTTP = class(Exception);
/// types of WebSocket buffers for winhttp.dll
// it is the different thing than WEB_SOCKET_BUFFER_TYPE for httpapi.dll
WINHTTP_WEB_SOCKET_BUFFER_TYPE = ULONG;
/// A class to establish a client connection to a WebSocket server using Windows API
// - used by TWinWebSocketClient class
TWinHTTPUpgradeable = class(TWinHTTP)
private
fSocket: HINTERNET;
protected
function InternalRetrieveAnswer(var Header, Encoding, AcceptEncoding,
Data: SockString): integer; override;
procedure InternalSendRequest(const aData: SockString); override;
public
/// initialize the instance
constructor Create(const aServer, aPort: SockString; aHttps: boolean;
const aProxyName: SockString=''; const aProxyByPass: SockString='';
ConnectionTimeOut: DWORD=0; SendTimeout: DWORD=0;
ReceiveTimeout: DWORD=0); override;
end;
/// WebSocket client implementation
TWinHTTPWebSocketClient = class
protected
fSocket: HINTERNET;
function CheckSocket: Boolean;
public
/// initialize the instance
// - all parameters do match TWinHTTP.Create except url: address of WebSocketServer
// for sending upgrade request
constructor Create(const aServer, aPort: SockString; aHttps: boolean;
const url: SockString; const aSubProtocol: SockString = '';
const aProxyName: SockString=''; const aProxyByPass: SockString='';
ConnectionTimeOut: DWORD=0; SendTimeout: DWORD=0; ReceiveTimeout: DWORD=0);
/// Send buffer
function Send(aBufferType: WINHTTP_WEB_SOCKET_BUFFER_TYPE; aBuffer: pointer;
aBufferLength: DWORD): DWORD;
/// Receive buffer
function Receive(aBuffer: pointer; aBufferLength: DWORD;
out aBytesRead: DWORD; out aBufferType: WINHTTP_WEB_SOCKET_BUFFER_TYPE): DWORD;
/// Close current connection
function CloseConnection(const aCloseReason: SockString): DWORD;
destructor Destroy; override;
end;
{$endif USEWININET}
{$ifdef USELIBCURL}
type
/// a class to handle HTTP/1.1 request using the libcurl library
// - libcurl is a free and easy-to-use cross-platform URL transfer library,
// able to directly connect via HTTP or HTTPS on most Linux systems
// - under a 32 bit Linux system, the libcurl library (and its dependencies,
// like OpenSSL) may not be installed - you can add it via your package
// manager, e.g. on Ubuntu:
// $ sudo apt-get install libcurl3
// - under a 64-bit Linux system, you should install the 32-bit flavor of
// libcurl, e.g. on Ubuntu:
// $ sudo apt-get install libcurl3:i386
// - will use in fact libcurl.so, so either libcurl.so.3 or libcurl.so.4,
// depending on the default version installation on the system
TCurlHTTP = class(THttpRequest)
protected
fHandle: pointer;
fRootURL: SockString;
fIn: record
Headers: pointer;
Method: SockString;
Data: SockString;
DataOffset: integer;
end;
fOut: record
Header, Encoding, AcceptEncoding, Data: SockString;
end;
fSSL: record
CertFile: SockString;
CACertFile: SockString;
KeyName: SockString;
PassPhrase: SockString;
end;
procedure InternalConnect(ConnectionTimeOut,SendTimeout,ReceiveTimeout: DWORD); override;
procedure InternalCreateRequest(const method, aURL: SockString); override;
procedure InternalSendRequest(const aData: SockString); override;
function InternalRetrieveAnswer(var Header, Encoding, AcceptEncoding,
Data: SockString): integer; override;
procedure InternalCloseRequest; override;
procedure InternalAddHeader(const hdr: SockString); override;
public
/// returns TRUE if the class is actually supported on this system
class function IsAvailable: boolean; override;
/// release the connection
destructor Destroy; override;
/// set the client SSL certification details
// - used e.g. as
// ! UseClientCertificate('testcert.pem','cacert.pem','testkey.pem','pass');
procedure UseClientCertificate(
const aCertFile, aCACertFile, aKeyName, aPassPhrase: SockString);
end;
{$endif USELIBCURL}
/// simple wrapper around THttpClientSocket/THttpRequest instances
// - this class will reuse the previous connection if possible, and select the
// best connection class available on this platform
TSimpleHttpClient = class
protected
fHttp: THttpClientSocket;
fHttps: THttpRequest;
fBody, fHeaders: SockString;
fOnlyUseClientSocket: boolean;
public
/// initialize the instance
constructor Create(aOnlyUseClientSocket: boolean=false); reintroduce;
/// finalize the connection
destructor Destroy; override;
/// low-level entry point of this instance
function RawRequest(const uri: TURI; const method, Header, Data, DataType: SockString;
KeepAlive: cardinal): integer; overload;
/// simple-to-use entry point of this instance
// - use Body and Headers properties to retrieve the HTTP body and headers
function Request(const uri: SockString; const method: SockString='GET';
const header: SockString = ''; const data: SockString = '';
const datatype: SockString = ''; keepalive: cardinal=10000): integer; overload;
/// returns the HTTP body as returnsd by a previous call to Request()
property Body: SockString read fBody;
/// returns the HTTP headers as returnsd by a previous call to Request()
property Headers: SockString read fHeaders;
end;
/// returns the best THttpRequest class, depending on the system it runs on
// - e.g. TWinHTTP or TCurlHTTP
// - consider using TSimpleHttpClient if you just need a simple connection
function MainHttpClass: THttpRequestClass;
/// low-level forcing of another THttpRequest class
// - could be used if we found out that the current MainHttpClass failed (which
// could easily happen with TCurlHTTP if the library is missing or deprecated)
procedure ReplaceMainHttpClass(aClass: THttpRequestClass);
/// create a TCrtSocket, returning nil on error
// (useful to easily catch socket error exception ECrtSocket)
function Open(const aServer, aPort: SockString; aTLS: boolean=false): TCrtSocket;
/// create a THttpClientSocket, returning nil on error
// - useful to easily catch socket error exception ECrtSocket
function OpenHttp(const aServer, aPort: SockString; aTLS: boolean=false): THttpClientSocket; overload;
/// create a THttpClientSocket, returning nil on error
// - useful to easily catch socket error exception ECrtSocket
function OpenHttp(const aURI: SockString; aAddress: PSockString=nil): THttpClientSocket; overload;
/// retrieve the content of a web page, using the HTTP/1.1 protocol and GET method
// - this method will use a low-level THttpClientSock socket: if you want
// something able to use your computer proxy, take a look at TWinINet.Get()
function HttpGet(const server, port: SockString; const url: SockString;
const inHeaders: SockString; outHeaders: PSockString=nil): SockString; overload;
/// retrieve the content of a web page, using the HTTP/1.1 protocol and GET method
// - this method will use a low-level THttpClientSock socket for plain http URI,
// or TWinHTTP/TCurlHTTP for any https URI
function HttpGet(const aURI: SockString; outHeaders: PSockString=nil): SockString; overload;
/// retrieve the content of a web page, using the HTTP/1.1 protocol and GET method
// - this method will use a low-level THttpClientSock socket for plain http URI,
// or TWinHTTP/TCurlHTTP for any https URI
function HttpGet(const aURI: SockString; const inHeaders: SockString;
outHeaders: PSockString=nil): SockString; overload;
/// retrieve the content of a web page, using HTTP/1.1 GET method and a token
// - this method will use a low-level THttpClientSock socket and its GetAuth method
// - if AuthToken<>'', will add an header with 'Authorization: Bearer '+AuthToken
function HttpGetAuth(const aURI, aAuthToken: SockString; outHeaders: PSockString=nil): SockString;
/// send some data to a remote web server, using the HTTP/1.1 protocol and POST method
function HttpPost(const server, port: SockString; const url, Data, DataType: SockString;
outData: PSockString=nil): boolean;
/// compute the 'Authorization: Bearer ####' HTTP header of a given token value
function AuthorizationBearer(const AuthToken: SockString): SockString;
/// compute the '1.2.3.4' text representation of a raw IP4 binary
procedure IP4Text(const ip4addr; var result: SockString);
const
/// the layout of TSMTPConnection.FromText method
SMTP_DEFAULT = 'user:password@smtpserver:port';
type
/// may be used to store a connection to a SMTP server
// - see SendEmail() overloaded function
TSMTPConnection = {$ifdef UNICODE}record{$else}object{$endif}
public
/// the SMTP server IP or host name
Host: SockString;
/// the SMTP server port (25 by default)
Port: SockString;
/// the SMTP user login (if any)
User: SockString;
/// the SMTP user password (if any)
Pass: SockString;
/// fill the STMP server information from a single text field
// - expects 'user:password@smtpserver:port' format
// - if aText equals SMTP_DEFAULT ('user:password@smtpserver:port'),
// does nothing
function FromText(const aText: SockString): boolean;
end;
/// send an email using the SMTP protocol
// - retry true on success
// - the Subject is expected to be in plain 7 bit ASCII, so you could use
// SendEmailSubject() to encode it as Unicode, if needed
// - you can optionally set the encoding charset to be used for the Text body
function SendEmail(const Server, From, CSVDest, Subject, Text: SockString;
const Headers: SockString=''; const User: SockString=''; const Pass: SockString='';
const Port: SockString='25'; const TextCharSet: SockString = 'ISO-8859-1';
aTLS: boolean=false): boolean; overload;
/// send an email using the SMTP protocol
// - retry true on success
// - the Subject is expected to be in plain 7 bit ASCII, so you could use
// SendEmailSubject() to encode it as Unicode, if needed
// - you can optionally set the encoding charset to be used for the Text body
function SendEmail(const Server: TSMTPConnection;
const From, CSVDest, Subject, Text: SockString; const Headers: SockString='';
const TextCharSet: SockString = 'ISO-8859-1'; aTLS: boolean=false): boolean; overload;
/// convert a supplied subject text into an Unicode encoding
// - will convert the text into UTF-8 and append '=?UTF-8?B?'
// - for pre-Unicode versions of Delphi, Text is expected to be already UTF-8
// encoded - since Delphi 2010, it will be converted from UnicodeString
function SendEmailSubject(const Text: string): SockString;
const
/// HTTP Status Code for "Success"
STATUS_SUCCESS = 200;
/// HTTP Status Code for "Created"
STATUS_CREATED = 201;
/// HTTP Status Code for "Accepted"
STATUS_ACCEPTED = 202;
/// HTTP Status Code for "No Content"
STATUS_NOCONTENT = 204;
/// HTTP Status Code for "Partial Content"
STATUS_PARTIALCONTENT = 206;
/// HTTP Status Code for "Not Modified"
STATUS_NOTMODIFIED = 304;
/// HTTP Status Code for "Bad Request"
STATUS_BADREQUEST = 400;
/// HTTP Status Code for "Unauthorized"
STATUS_UNAUTHORIZED = 401;
/// HTTP Status Code for "Forbidden"
STATUS_FORBIDDEN = 403;
/// HTTP Status Code for "Not Found"
STATUS_NOTFOUND = 404;
/// HTTP Status Code for "Not Acceptable"
STATUS_NOTACCEPTABLE = 406;
/// HTTP Status Code for "Payload Too Large"
STATUS_PAYLOADTOOLARGE = 413;
/// HTTP Status Code for "Internal Server Error"
STATUS_SERVERERROR = 500;
/// HTTP Status Code for "Not Implemented"
STATUS_NOTIMPLEMENTED = 501;
{$ifdef MSWINDOWS}
/// can be used with THttpApiServer.AuthenticationSchemes to enable all schemes
HTTPAPI_AUTH_ENABLE_ALL = [hraBasic..hraKerberos];
/// the buffer contains the last, and possibly only, part of a UTF8 message
WEB_SOCKET_UTF8_MESSAGE_BUFFER_TYPE: WEB_SOCKET_BUFFER_TYPE = $80000000;
/// the buffer contains part of a UTF8 message
WEB_SOCKET_UTF8_FRAGMENT_BUFFER_TYPE: WEB_SOCKET_BUFFER_TYPE = $80000001;
/// the buffer contains the last, and possibly only, part of a binary message
WEB_SOCKET_BINARY_MESSAGE_BUFFER_TYPE: WEB_SOCKET_BUFFER_TYPE = $80000002;
/// the buffer contains part of a binary message
WEB_SOCKET_BINARY_FRAGMENT_BUFFER_TYPE: WEB_SOCKET_BUFFER_TYPE = $80000003;
/// the buffer contains a close message
WEB_SOCKET_CLOSE_BUFFER_TYPE: WEB_SOCKET_BUFFER_TYPE = $80000004;
/// the buffer contains a ping or pong message
// - when sending, this value means 'ping'
// - when processing received data, this value means 'pong'
WEB_SOCKET_PING_PONG_BUFFER_TYPE: WEB_SOCKET_BUFFER_TYPE = $80000005;
/// the buffer contains an unsolicited pong message
WEB_SOCKET_UNSOLICITED_PONG_BUFFER_TYPE: WEB_SOCKET_BUFFER_TYPE = $80000006;
// https://msdn.microsoft.com/en-us/library/windows/desktop/hh449347
WEB_SOCKET_MAX_CLOSE_REASON_LENGTH = 123;
/// Close completed successfully
WEB_SOCKET_SUCCESS_CLOSE_STATUS : WEB_SOCKET_CLOSE_STATUS = 1000;
/// The endpoint is going away and thus closing the connection
WEB_SOCKET_ENDPOINT_UNAVAILABLE_CLOSE_STATUS : WEB_SOCKET_CLOSE_STATUS = 1001;
/// Peer detected protocol error and it is closing the connection
WEB_SOCKET_PROTOCOL_ERROR_CLOSE_STATUS : WEB_SOCKET_CLOSE_STATUS = 1002;
/// The endpoint cannot receive this type of data
WEB_SOCKET_INVALID_DATA_TYPE_CLOSE_STATUS : WEB_SOCKET_CLOSE_STATUS = 1003;
/// No close status code was provided
WEB_SOCKET_EMPTY_CLOSE_STATUS : WEB_SOCKET_CLOSE_STATUS = 1005;
/// The connection was closed without sending or receiving a close frame
WEB_SOCKET_ABORTED_CLOSE_STATUS : WEB_SOCKET_CLOSE_STATUS = 1006;
/// Data within a message is not consistent with the type of the message
WEB_SOCKET_INVALID_PAYLOAD_CLOSE_STATUS : WEB_SOCKET_CLOSE_STATUS = 1007;
/// The message violates an endpoint's policy
WEB_SOCKET_POLICY_VIOLATION_CLOSE_STATUS : WEB_SOCKET_CLOSE_STATUS = 1008;
/// The message sent was too large to process
WEB_SOCKET_MESSAGE_TOO_BIG_CLOSE_STATUS : WEB_SOCKET_CLOSE_STATUS = 1009;
/// A client endpoint expected the server to negotiate one or more extensions,
// but the server didn't return them in the response message of the WebSocket handshake
WEB_SOCKET_UNSUPPORTED_EXTENSIONS_CLOSE_STATUS : WEB_SOCKET_CLOSE_STATUS = 1010;
/// An unexpected condition prevented the server from fulfilling the request
WEB_SOCKET_SERVER_ERROR_CLOSE_STATUS : WEB_SOCKET_CLOSE_STATUS = 1011;
/// The TLS handshake could not be completed
WEB_SOCKET_SECURE_HANDSHAKE_ERROR_CLOSE_STATUS : WEB_SOCKET_CLOSE_STATUS = 1015;
{$endif}
/// retrieve the HTTP reason text from a code
// - e.g. StatusCodeToReason(200)='OK'
// - see http://www.w3.org/Protocols/rfc2616/rfc2616-sec10.html
// - mORMot.StatusCodeToErrorMsg() will call this function
function StatusCodeToReason(Code: cardinal): SockString;
/// retrieve the IP address from a computer name
function ResolveName(const Name: SockString;
Family: Integer=AF_INET; SockProtocol: Integer=IPPROTO_TCP;
SockType: integer=SOCK_STREAM): SockString;
/// Base64 encoding of a string
// - used internally for STMP email sending
// - consider using more efficient BinToBase64() from SynCommons.pas instead
function SockBase64Encode(const s: SockString): SockString;
/// Base64 decoding of a string
// - consider using more efficient Base64ToBin() from SynCommons.pas instead
function SockBase64Decode(const s: SockString): SockString;
/// escaping of HTML codes like < > & "
function HtmlEncode(const s: SockString): SockString;
/// decode a HTTP chunk length
function HttpChunkToHex32(p: PAnsiChar): integer;
{$ifdef MSWINDOWS}
/// remotly get the MAC address of a computer, from its IP Address
// - only works under Win2K and later
// - return the MAC address as a 12 hexa chars ('0050C204C80A' e.g.)
function GetRemoteMacAddress(const IP: SockString): SockString;
{$else}
/// returns how many files could be opened at once on this POSIX system
// - hard=true is for the maximum allowed limit, false for the current process
// - returns -1 if the getrlimit() API call failed
function GetFileOpenLimit(hard: boolean=false): integer;
/// changes how many files could be opened at once on this POSIX system
// - hard=true is for the maximum allowed limit (requires root priviledges),
// false for the current process
// - returns the new value set (may not match the expected max value on error)
// - returns -1 if the getrlimit().setrlimit() API calls failed
// - for instance, to set the limit of the current process to its highest value:
// ! SetFileOpenLimit(GetFileOpenLimit(true));
function SetFileOpenLimit(max: integer; hard: boolean=false): integer;
{$endif MSWINDOWS}
type
TIPAddress = (tiaAny, tiaPublic, tiaPrivate);
/// enumerate all IP addresses of the current computer
// - may be used to enumerate all adapters
function GetIPAddresses(Kind: TIPAddress = tiaAny): TSockStringDynArray;
/// returns all IP addresses of the current computer as a single CSV text
// - may be used to enumerate all adapters
function GetIPAddressesText(const Sep: SockString = ' ';
PublicOnly: boolean = false): SockString;
/// low-level text description of Socket error code
// - if Error is -1, will call WSAGetLastError to retrieve the last error code
function SocketErrorMessage(Error: integer=-1): string;
/// low-level direct creation of a TSocket handle for TCP, UDP or UNIX layers
// - doBind=true will call Bind() to create a server socket instance
// - doBind=false will call Connect() to create a client socket instance
function CallServer(const Server, Port: SockString; doBind: boolean;
aLayer: TCrtSocketLayer; ConnectTimeout: DWORD): TSocket;
/// retrieve the text-converted remote IP address of a client socket
function GetRemoteIP(aClientSock: TSocket): SockString;
/// low-level direct shutdown of a given socket
procedure DirectShutdown(sock: TSocket);
/// low-level change of a socket to be in non-blocking mode
// - used e.g. by TPollAsynchSockets.Start
function AsynchSocket(sock: TSocket): boolean;
/// low-level direct call of the socket recv() function
// - by-pass overriden blocking recv() e.g. in SynFPCSock, so will work if
// the socket is in non-blocking mode, as with AsynchSocket/TPollAsynchSockets
function AsynchRecv(sock: TSocket; buf: pointer; buflen: integer): integer;
/// low-level direct call of the socket send() function
// - by-pass overriden blocking send() e.g. in SynFPCSock, so will work if
// the socket is in non-blocking mode, as with AsynchSocket/TPollAsynchSockets
function AsynchSend(sock: TSocket; buf: pointer; buflen: integer): integer;
{ ************ socket polling optimized for multiple connections }
type
/// the events monitored by TPollSocketAbstract classes
// - we don't make any difference between urgent or normal read/write events
TPollSocketEvent = (pseRead, pseWrite, pseError, pseClosed);
/// set of events monitored by TPollSocketAbstract classes
TPollSocketEvents = set of TPollSocketEvent;
/// some opaque value (which may be a pointer) associated with a polling event
TPollSocketTag = type PtrInt;
/// modifications notified by TPollSocketAbstract.WaitForModified
TPollSocketResult = record
/// the events which are notified
events: TPollSocketEvents;
/// opaque value as defined by TPollSocketAbstract.Subscribe
tag: TPollSocketTag;
end;
/// all modifications returned by TPollSocketAbstract.WaitForModified
TPollSocketResults = array of TPollSocketResult;
{$M+}
/// abstract parent class for efficient socket polling
// - works like Linux epoll API in level-triggered (LT) mode
// - implements libevent-like cross-platform features
// - use PollSockClass global function to retrieve the best class depending
// on the running Operating System
TPollSocketAbstract = class
protected
fCount: integer;
fMaxSockets: integer;
public
/// class function factory, returning a socket polling instance matching
// at best the current operating system
// - returns a TPollSocketSelect/TPollSocketPoll instance under Windows,
// a TPollSocketEpoll instance under Linux, or a TPollSocketPoll on BSD
// - just a wrapper around PollSockClass.Create
class function New: TPollSocketAbstract;
/// initialize the polling
constructor Create; virtual;
/// track status modifications on one specified TSocket
// - you can specify which events are monitored - pseError and pseClosed
// will always be notified
// - tag parameter will be returned as TPollSocketResult - you may set
// here the socket file descriptor value, or a transtyped class instance
// - similar to epoll's EPOLL_CTL_ADD control interface
function Subscribe(socket: TSocket; events: TPollSocketEvents;
tag: TPollSocketTag): boolean; virtual; abstract;
/// stop status modifications tracking on one specified TSocket
// - the socket should have been monitored by a previous call to Subscribe()
// - on success, returns true and fill tag with the associated opaque value
// - similar to epoll's EPOLL_CTL_DEL control interface
function Unsubscribe(socket: TSocket): boolean; virtual; abstract;
/// waits for status modifications of all tracked TSocket
// - will wait up to timeoutMS milliseconds, 0 meaning immediate return
// and -1 for infinite blocking
// - returns -1 on error (e.g. no TSocket currently registered), or
// the number of modifications stored in results[] (may be 0 if none)
function WaitForModified(out results: TPollSocketResults;
timeoutMS: integer): integer; virtual; abstract;
published
/// how many TSocket instances could be tracked, at most
// - depends on the API used
property MaxSockets: integer read fMaxSockets;
/// how many TSocket instances are currently tracked
property Count: integer read fCount;
end;
{$M-}
/// meta-class of TPollSocketAbstract socket polling classes
// - since TPollSocketAbstract.Create is declared as virtual, could be used
// to specify the proper polling class to add
// - see PollSockClass function and TPollSocketAbstract.New method
TPollSocketClass = class of TPollSocketAbstract;
/// returns the TPollSocketAbstract class best fitting with the current
// Operating System
// - as used by TPollSocketAbstract.New method
function PollSocketClass: TPollSocketClass;
type
{$ifdef MSWINDOWS}
/// socket polling via Windows' Select() API
// - under Windows, Select() handles up to 64 TSocket, and is available
// in Windows XP, whereas WSAPoll() is available only since Vista
// - under Linux, select() is very limited, so poll/epoll APIs are to be used
// - in practice, TPollSocketSelect is slighlty FASTER than TPollSocketPoll
// when tracking a lot of connections (at least under Windows): WSAPoll()
// seems to be just an emulation API - very disapointing :(
TPollSocketSelect = class(TPollSocketAbstract)
protected
fHighestSocket: integer;
fRead: TFDSet;
fWrite: TFDSet;
fTag: array[0..FD_SETSIZE-1] of record
socket: TSocket;
tag: TPollSocketTag;
end;
public
/// initialize the polling via creating an epoll file descriptor
constructor Create; override;
/// track status modifications on one specified TSocket
// - you can specify which events are monitored - pseError and pseClosed
// will always be notified
function Subscribe(socket: TSocket; events: TPollSocketEvents;
tag: TPollSocketTag): boolean; override;
/// stop status modifications tracking on one specified TSocket
// - the socket should have been monitored by a previous call to Subscribe()
function Unsubscribe(socket: TSocket): boolean; override;
/// waits for status modifications of all tracked TSocket
// - will wait up to timeoutMS milliseconds, 0 meaning immediate return
// and -1 for infinite blocking
// - returns -1 on error (e.g. no TSocket currently registered), or
// the number of modifications stored in results[] (may be 0 if none)
function WaitForModified(out results: TPollSocketResults;
timeoutMS: integer): integer; override;
end;
{$endif MSWINDOWS}
/// socket polling via poll/WSAPoll API
// - direct call of the Linux/POSIX poll() API, or Windows WSAPoll() API
TPollSocketPoll = class(TPollSocketAbstract)
protected
fFD: TPollFDDynArray; // fd=-1 for ignored fields
fTags: array of TPollSocketTag;
fFDCount: integer;
procedure FDVacuum;
public
/// initialize the polling using poll/WSAPoll API
constructor Create; override;
/// track status modifications on one specified TSocket
// - you can specify which events are monitored - pseError and pseClosed
// will always be notified
function Subscribe(socket: TSocket; events: TPollSocketEvents;
tag: TPollSocketTag): boolean; override;
/// stop status modifications tracking on one specified TSocket
// - the socket should have been monitored by a previous call to Subscribe()
function Unsubscribe(socket: TSocket): boolean; override;
/// waits for status modifications of all tracked TSocket
// - will wait up to timeoutMS milliseconds, 0 meaning immediate return
// and -1 for infinite blocking
// - returns -1 on error (e.g. no TSocket currently registered), or
// the number of modifications stored in results[] (may be 0 if none)
function WaitForModified(out results: TPollSocketResults;
timeoutMS: integer): integer; override;
end;
{$ifdef LINUXNOTBSD}
/// socket polling via Linux epoll optimized API
// - not available under Windows or BSD/Darwin
// - direct call of the epoll API in level-triggered (LT) mode
// - only available on Linux - use TPollSocketPoll for using cross-plaform
// poll/WSAPoll API
TPollSocketEpoll = class(TPollSocketAbstract)
protected
fEPFD: integer;
fResults: TEPollEventDynArray;
public
/// initialize the polling via creating an epoll file descriptor
constructor Create; override;
/// finalize the polling by closing the epoll file descriptor
destructor Destroy; override;
/// track status modifications on one specified TSocket
// - you can specify which events are monitored - pseError and pseClosed
// will always be notified
// - directly calls epoll's EPOLL_CTL_ADD control interface
function Subscribe(socket: TSocket; events: TPollSocketEvents;
tag: TPollSocketTag): boolean; override;
/// stop status modifications tracking on one specified TSocket
// - the socket should have been monitored by a previous call to Subscribe()
// - directly calls epoll's EPOLL_CTL_DEL control interface
function Unsubscribe(socket: TSocket): boolean; override;
/// waits for status modifications of all tracked TSocket
// - will wait up to timeoutMS milliseconds, 0 meaning immediate return
// and -1 for infinite blocking
// - returns -1 on error (e.g. no TSocket currently registered), or
// the number of modifications stored in results[] (may be 0 if none)
// - directly calls epool_wait() function
function WaitForModified(out results: TPollSocketResults;
timeoutMS: integer): integer; override;
/// read-only access to the low-level epoll_create file descriptor
property EPFD: integer read fEPFD;
end;
{$endif LINUXNOTBSD}
type
{$M+}
/// implements efficient polling of multiple sockets
// - will maintain a pool of TPollSocketAbstract instances, to monitor
// incoming data or outgoing availability for a set of active connections
// - call Subscribe/Unsubscribe to setup the monitored sockets
// - call GetOne from any consumming threads to process new events
TPollSockets = class
protected
fPollClass: TPollSocketClass;
fPoll: array of TPollSocketAbstract;
fPollIndex: integer;
fPending: TPollSocketResults;
fPendingIndex: integer;
fTerminated: boolean;
fCount: integer;
fPollLock: TRTLCriticalSection;
fPendingLock: TRTLCriticalSection;
public
/// initialize the sockets polling
// - you can specify the TPollSocketAbsract class to be used, if the
// default is not the one expected
// - under Linux/POSIX, will set the open files maximum number for the
// current process to match the system hard limit: if your system has a
// low "ulimit -H -n" value, you may add the following line in your
// /etc/limits.conf or /etc/security/limits.conf file:
// $ * hard nofile 65535
constructor Create(aPollClass: TPollSocketClass=nil);
/// finalize the sockets polling, and release all used memory
destructor Destroy; override;
/// track modifications on one specified TSocket and tag
// - the supplied tag value - maybe a PtrInt(aObject) - will be part of
// GetOne method results
// - will create as many TPollSocketAbstract instances as needed, depending
// on the MaxSockets capability of the actual implementation class
// - this method is thread-safe
function Subscribe(socket: TSocket; tag: TPollSocketTag;
events: TPollSocketEvents): boolean; virtual;
/// stop status modifications tracking on one specified TSocket and tag
// - the socket should have been monitored by a previous call to Subscribe()
// - this method is thread-safe
function Unsubscribe(socket: TSocket; tag: TPollSocketTag): boolean; virtual;
/// retrieve the next pending notification, or let the poll wait for new
// - if there is no pending notification, will poll and wait up to
// timeoutMS milliseconds for pending data
// - returns true and set notif.events/tag with the corresponding notification
// - returns false if no pending event was handled within the timeoutMS period
// - this method is thread-safe, and could be called from several threads
function GetOne(timeoutMS: integer; out notif: TPollSocketResult): boolean; virtual;
/// retrieve the next pending notification
// - returns true and set notif.events/tag with the corresponding notification
// - returns false if no pending event is available
// - this method is thread-safe, and could be called from several threads
function GetOneWithinPending(out notif: TPollSocketResult): boolean;
/// notify any GetOne waiting method to stop its polling loop
procedure Terminate;
/// the actual polling class used to track socket state changes
property PollClass: TPollSocketClass read fPollClass;
/// set to true by the Terminate method
property Terminated: boolean read fTerminated;
published
/// how many sockets are currently tracked
property Count: integer read fCount;
end;
{$M-}
/// store thread-safe information of one TPollAsynchSockets connection
TPollSocketsSlot = {$ifdef UNICODE}record{$else}object{$endif}
/// the associated TCP connection
socket: TSocket;
/// Lock/Unlock thread acquisition (lighter than a TRTLCriticalSection)
lockcounter: integer;
/// the current read data buffer of this slot
readbuf: SockString;
/// the current write data buffer of this slot
writebuf: SockString;
/// the last error reported by WSAGetLastError before the connection ends
lastWSAError: Integer;
/// acquire an exclusive access to this connection
// - returns true if slot has been acquired
// - returns false if it is used by another thread
// - warning: this method is not re-entrant
function Lock: boolean;
/// try to acquire an exclusive access to this connection
// - returns true if slot has been acquired
// - returns false if it is used by another thread, after the timeoutMS period
// - warning: this method is not re-entrant
function TryLock(timeoutMS: cardinal): boolean;
/// release exclusive access to this connection
procedure UnLock;
end;
/// points to thread-safe information of one TPollAsynchSockets connection
PPollSocketsSlot = ^TPollSocketsSlot;
/// possible options for TPollAsynchSockets process
// - by default, TPollAsynchSockets.Write will first try to send the data
// using Send() in non-blocking mode, unless paoWritePollOnly is defined,
// and fWrite will be used to poll output state and send it asynchronously
TPollAsynchSocketsOptions = set of (paoWritePollOnly);
/// let TPollAsynchSockets.OnRead shutdown the socket if needed
TPollAsynchSocketOnRead = (sorContinue, sorClose);
{$M+}
/// read/write buffer-oriented process of multiple non-blocking connections
// - to be used e.g. for stream protocols (e.g. WebSockets or IoT communication)
// - assigned sockets will be set in non-blocking mode, so that polling will
// work as expected: you should then never use direclty the socket (e.g. via
// blocking TCrtSocket), but rely on this class for asynchronous process:
// OnRead() overriden method will receive all incoming data from input buffer,
// and Write() should be called to add some data to asynchronous output buffer
// - connections are identified as TObject instances, which should hold a
// TPollSocketsSlot record as private values for the polling process
// - ProcessRead/ProcessWrite methods are to be run for actual communication:
// either you call those methods from multiple threads, or you run them in
// loop from a single thread, then define a TSynThreadPool for running any
// blocking process (e.g. computing requests answers) from OnRead callbacks
// - inherited classes should override abstract OnRead, OnClose, OnError and
// SlotFromConnection methods according to the actual connection class
TPollAsynchSockets = class
protected
fRead: TPollSockets;
fWrite: TPollSockets;
fReadCount: integer;
fWriteCount: integer;
fReadBytes: Int64;
fWriteBytes: Int64;
fProcessing: integer;
fOptions: TPollAsynchSocketsOptions;
function GetCount: integer;
// return low-level socket information from connection instance
function SlotFromConnection(connection: TObject): PPollSocketsSlot; virtual; abstract;
// extract frames from slot.readbuf, and handle them
function OnRead(connection: TObject): TPollAsynchSocketOnRead; virtual; abstract;
// called when slot.writebuf has been sent through the socket
procedure AfterWrite(connection: TObject); virtual; abstract;
// pseClosed: should do connection.free - Stop() has been called (socket=0)
procedure OnClose(connection: TObject); virtual; abstract;
// pseError: return false to close socket and connection (calling OnClose)
function OnError(connection: TObject; events: TPollSocketEvents): boolean; virtual; abstract;
public
/// initialize the read/write sockets polling
// - fRead and fWrite TPollSocketsBuffer instances will track pseRead or
// pseWrite events, and maintain input and output data buffers
constructor Create; virtual;
/// finalize buffer-oriented sockets polling, and release all used memory
destructor Destroy; override;
/// assign a new connection to the internal poll
// - the TSocket handle will be retrieved via SlotFromConnection, and
// set in non-blocking mode from now on - it is not recommended to access
// it directly any more, but use Write() and handle OnRead() callback
// - fRead will poll incoming packets, then call OnRead to handle them,
// or Unsubscribe and delete the socket when pseClosed is notified
// - fWrite will poll for outgoing packets as specified by Write(), then
// send any pending data once the socket is ready
function Start(connection: TObject): boolean; virtual;
/// remove a connection from the internal poll, and shutdown its socket
// - most of the time, the connection is released by OnClose when the other
// end shutdown the socket; but you can explicitely call this method when
// the connection (and its socket) is to be shutdown
// - this method won't call OnClose, since it is initiated by the class
function Stop(connection: TObject): boolean; virtual;
/// add some data to the asynchronous output buffer of a given connection
function Write(connection: TObject; const data; datalen: integer): boolean; virtual;
/// add some data to the asynchronous output buffer of a given connection
function WriteString(connection: TObject; const data: SockString): boolean;
/// one or several threads should execute this method
// - thread-safe handle of any incoming packets
// - if this method is called from a single thread, you should use
// a TSynThreadPool for any blocking process of OnRead events
// - otherwise, this method is thread-safe, and incoming packets may be
// consummed from a set of threads, and call OnRead with newly received data
procedure ProcessRead(timeoutMS: integer);
/// one or several threads should execute this method
// - thread-safe handle of any outgoing packets
procedure ProcessWrite(timeoutMS: integer);
/// notify internal socket polls to stop their polling loop ASAP
procedure Terminate(waitforMS: integer);
/// low-level access to the polling class used for incoming data
property PollRead: TPollSockets read fRead;
/// low-level access to the polling class used for outgoind data
property PollWrite: TPollSockets write fWrite;
/// some processing options
property Options: TPollAsynchSocketsOptions read fOptions write fOptions;
published
/// how many connections are currently managed by this instance
property Count: integer read GetCount;
/// how many times data has been received by this instance
property ReadCount: integer read fReadCount;
/// how many times data has been sent by this instance
property WriteCount: integer read fWriteCount;
/// how many data bytes have been received by this instance
property ReadBytes: Int64 read fReadBytes;
/// how many data bytes have been sent by this instance
property WriteBytes: Int64 read fWriteBytes;
end;
{$M-}
function SysErrorMessagePerModule(Code: DWORD; ModuleName: PChar): string;
{$ifdef MSWINDOWS}
/// is HTTP.SYS web socket API available on the target system Windows 8 and UP
function WinHTTP_WebSocketEnabled: boolean;
{$endif}
implementation
{$ifdef FPC}
uses
dynlibs;
{$endif}
{ ************ some shared helper functions and classes }
var
ReasonCache: array[1..5,0..8] of SockString; // avoid memory allocation
function StatusCodeToReasonInternal(Code: cardinal): SockString;
begin
case Code of
100: result := 'Continue';
101: result := 'Switching Protocols';
200: result := 'OK';
201: result := 'Created';
202: result := 'Accepted';
203: result := 'Non-Authoritative Information';
204: result := 'No Content';
205: result := 'Reset Content';
206: result := 'Partial Content';
207: result := 'Multi-Status';
300: result := 'Multiple Choices';
301: result := 'Moved Permanently';
302: result := 'Found';
303: result := 'See Other';
304: result := 'Not Modified';
305: result := 'Use Proxy';
307: result := 'Temporary Redirect';
308: result := 'Permanent Redirect';
400: result := 'Bad Request';
401: result := 'Unauthorized';
403: result := 'Forbidden';
404: result := 'Not Found';
405: result := 'Method Not Allowed';
406: result := 'Not Acceptable';
407: result := 'Proxy Authentication Required';
408: result := 'Request Timeout';
409: result := 'Conflict';
410: result := 'Gone';
411: result := 'Length Required';
412: result := 'Precondition Failed';
413: result := 'Payload Too Large';
414: result := 'URI Too Long';
415: result := 'Unsupported Media Type';
416: result := 'Requested Range Not Satisfiable';
426: result := 'Upgrade Required';
500: result := 'Internal Server Error';
501: result := 'Not Implemented';
502: result := 'Bad Gateway';
503: result := 'Service Unavailable';
504: result := 'Gateway Timeout';
505: result := 'HTTP Version Not Supported';
511: result := 'Network Authentication Required';
else result := 'Invalid Request';
end;
end;
function StatusCodeToReason(Code: cardinal): SockString;
var Hi,Lo: cardinal;
begin
if Code=200 then begin // optimistic approach :)
Hi := 2;
Lo := 0;
end else begin
Hi := Code div 100;
Lo := Code-Hi*100;
if not ((Hi in [1..5]) and (Lo in [0..8])) then begin
result := StatusCodeToReasonInternal(Code);
exit;
end;
end;
result := ReasonCache[Hi,Lo];
if result<>'' then
exit;
result := StatusCodeToReasonInternal(Code);
ReasonCache[Hi,Lo] := result;
end;
function Hex2Dec(c: AnsiChar): integer; {$ifdef HASINLINE}inline;{$endif}
begin
case c of
'A'..'Z': result := Ord(c) - (Ord('A') - 10);
'a'..'z': result := Ord(c) - (Ord('a') - 10);
'0'..'9': result := Ord(c) - Ord('0');
else result := -1;
end;
end;
function SockBase64Encode(const s: SockString): SockString;
procedure Encode(rp, sp: PAnsiChar; len: integer);
const
b64: array[0..63] of AnsiChar =
'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
var i: integer;
c: cardinal;
begin
for i := 1 to len div 3 do begin
c := ord(sp[0]) shl 16 + ord(sp[1]) shl 8 + ord(sp[2]);
rp[0] := b64[(c shr 18) and $3f];
rp[1] := b64[(c shr 12) and $3f];
rp[2] := b64[(c shr 6) and $3f];
rp[3] := b64[c and $3f];
inc(rp,4);
inc(sp,3);
end;
case len mod 3 of
1: begin
c := ord(sp[0]) shl 16;
rp[0] := b64[(c shr 18) and $3f];
rp[1] := b64[(c shr 12) and $3f];
rp[2] := '=';
rp[3] := '=';
end;
2: begin
c := ord(sp[0]) shl 16 + ord(sp[1]) shl 8;
rp[0] := b64[(c shr 18) and $3f];
rp[1] := b64[(c shr 12) and $3f];
rp[2] := b64[(c shr 6) and $3f];
rp[3] := '=';
end;
end;
end;
var len: integer;
begin
result:='';
len := length(s);
if len = 0 then exit;
SetLength(result, ((len + 2) div 3) * 4);
Encode(pointer(result),pointer(s),len);
end;
function SockBase64Decode(const s: SockString): SockString;
var i, j, len: integer;
sp, rp: PAnsiChar;
c, ch: integer;
begin
result:= '';
len := length(s);
if (len = 0) or (len mod 4 <> 0) then
exit;
len := len shr 2;
SetLength(result, len * 3);
sp := pointer(s);
rp := pointer(result);
for i := 1 to len do begin
c := 0;
j := 0;
while true do begin
ch := ord(sp[j]);
case chr(ch) of
'A'..'Z': c := c or (ch - ord('A'));
'a'..'z': c := c or (ch - (ord('a')-26));
'0'..'9': c := c or (ch - (ord('0')-52));
'+': c := c or 62;
'/': c := c or 63;
else
if j=3 then begin
rp[0] := AnsiChar(c shr 16);
rp[1] := AnsiChar(c shr 8);
SetLength(result, len*3-1);
exit;
end else begin
rp[0] := AnsiChar(c shr 10);
SetLength(result, len*3-2);
exit;
end;
end;
if j=3 then break;
inc(j);
c := c shl 6;
end;
rp[2] := AnsiChar(c);
c := c shr 8;
rp[1] := AnsiChar(c);
c := c shr 8;
rp[0] := AnsiChar(c);
inc(rp,3);
inc(sp,4);
end;
end;
function HtmlEncode(const s: SockString): SockString;
var i: integer;
begin // not very fast, but working
result := '';
for i := 1 to length(s) do
case s[i] of
'<': result := result+'&lt;';
'>': result := result+'&gt;';
'&': result := result+'&amp;';
'"': result := result+'&quot;';
else result := result+s[i];
end;
end;
function HtmlEncodeString(const s: string): string;
var i: integer;
begin // not very fast, but working
result := '';
for i := 1 to length(s) do
case s[i] of
'<': result := result+'&lt;';
'>': result := result+'&gt;';
'&': result := result+'&amp;';
'"': result := result+'&quot;';
else result := result+s[i];
end;
end;
const
CRLF: array[0..1] of AnsiChar = (#13,#10);
function StrLen(S: PAnsiChar): integer;
begin
result := 0;
if S<>nil then
while true do
if S[0]<>#0 then
if S[1]<>#0 then
if S[2]<>#0 then
if S[3]<>#0 then begin
inc(S,4);
inc(result,4);
end else begin
inc(result,3);
exit;
end else begin
inc(result,2);
exit;
end else begin
inc(result);
exit;
end else
exit;
end;
function IdemPChar(p, up: pAnsiChar): boolean;
// if the beginning of p^ is same as up^ (ignore case - up^ must be already Upper)
var c: AnsiChar;
begin
result := false;
if p=nil then
exit;
if (up<>nil) and (up^<>#0) then
repeat
c := p^;
if up^<>c then
if c in ['a'..'z'] then begin
dec(c,32);
if up^<>c then
exit;
end else exit;
inc(up);
inc(p);
until up^=#0;
result := true;
end;
function IdemPCharArray(p: PAnsiChar; const upArray: array of PAnsiChar): integer;
var w: word;
begin
if p<>nil then begin
w := ord(p[0])+ord(p[1])shl 8;
if p[0] in ['a'..'z'] then
dec(w,32);
if p[1] in ['a'..'z'] then
dec(w,32 shl 8);
for result := 0 to high(upArray) do
if (PWord(upArray[result])^=w) and IdemPChar(p+2,upArray[result]+2) then
exit;
end;
result := -1;
end;
procedure GetNextItem(var P: PAnsiChar; Sep: AnsiChar; var result: SockString);
// return next CSV string in P, nil if no more
var S: PAnsiChar;
begin
if P=nil then
result := '' else begin
S := P;
while (S^<>#0) and (S^<>Sep) do
inc(S);
SetString(result,P,S-P);
if S^<>#0 then
P := S+1 else
P := nil;
end;
end;
function SameText(const a,b: SockString): boolean;
var n,i: integer;
c,d: AnsiChar;
begin
result := false;
n := length(a);
if length(b)<>n then
exit;
for i := 1 to n do begin
c := a[i];
if c in ['a'..'z'] then
dec(c,32);
d := b[i];
if d in ['a'..'z'] then
dec(d,32);
if c<>d then
exit;
end;
result := true;
end;
function GetNextItemUInt64(var P: PAnsiChar): ULONGLONG;
var c: PtrUInt;
begin
result := 0;
if P<>nil then
repeat
c := byte(P^)-48;
if c>9 then
break else
result := result*10+ULONGLONG(c);
inc(P);
until false;
end; // P^ will point to the first non digit char
function GetNextLine(var P: PAnsiChar): SockString;
var S: PAnsiChar;
begin
if P=nil then
result := '' else begin
S := P;
while S^>=' ' do
inc(S);
SetString(result,P,S-P);
while (S^<>#0) and (S^<' ') do inc(S); // ignore e.g. #13 or #10
if S^<>#0 then
P := S else
P := nil;
end;
end;
function GetHeaderValue(var headers: SockString; const upname: SockString;
deleteInHeaders: boolean): SockString;
var i,j,k: integer;
begin
result := '';
if (headers='') or (upname='') then
exit;
i := 1;
repeat
k := length(headers)+1;
for j := i to k-1 do
if headers[j]<' ' then begin
k := j;
break;
end;
if IdemPChar(@headers[i],pointer(upname)) then begin
j := i;
inc(i,length(upname));
while headers[i]=' ' do inc(i);
result := copy(headers,i,k-i);
if deleteInHeaders then begin
while true do
if (headers[k]=#0) or (headers[k]>=' ') then
break else
inc(k);
delete(headers,j,k-j);
end;
exit;
end;
i := k;
while headers[i]<' ' do
if headers[i]=#0 then
exit else
inc(i);
until false;
end;
function PosChar(Str: PAnsiChar; Chr: AnsiChar): PAnsiChar;
begin
result := Str;
while result^<>Chr do begin
if result^=#0 then begin
result := nil;
exit;
end;
Inc(result);
end;
end;
{$ifdef HASCODEPAGE}
// rewrite some functions to avoid unattempted ansi<->unicode conversion
function Trim(const S: SockString): SockString;
{$ifdef FPC_OR_PUREPASCAL}
var I, L: Integer;
begin
L := Length(S);
I := 1;
while (I<=L) and (S[i]<=' ') do Inc(I);
if I>L then
Result := '' else
if (I=1) and (S[L]>' ') then
Result := S else begin
while S[L]<=' ' do Dec(L);
Result := Copy(S, I, L-I+1);
end;
end;
{$else}
asm // fast implementation by John O'Harrow
test eax,eax {S = nil?}
xchg eax,edx
jz System.@LStrClr {Yes, Return Empty String}
mov ecx,[edx-4] {Length(S)}
cmp byte ptr [edx],' ' {S[1] <= ' '?}
jbe @@TrimLeft {Yes, Trim Leading Spaces}
cmp byte ptr [edx+ecx-1],' ' {S[Length(S)] <= ' '?}
jbe @@TrimRight {Yes, Trim Trailing Spaces}
jmp System.@LStrLAsg {No, Result := S (which occurs most time)}
@@TrimLeft: {Strip Leading Whitespace}
dec ecx
jle System.@LStrClr {All Whitespace}
inc edx
cmp byte ptr [edx],' '
jbe @@TrimLeft
@@CheckDone:
cmp byte ptr [edx+ecx-1],' '
{$ifdef UNICODE}
jbe @@TrimRight
push 65535 // SockString code page for Delphi 2009 and up
call System.@LStrFromPCharLen // we need a call, not a direct jmp
ret
{$else}
ja System.@LStrFromPCharLen
{$endif}
@@TrimRight: {Strip Trailing Whitespace}
dec ecx
jmp @@CheckDone
end;
{$endif}
function UpperCase(const S: SockString): SockString;
procedure Upper(Source, Dest: PAnsiChar; L: cardinal);
var Ch: AnsiChar; // this sub-call is shorter and faster than 1 plain proc
begin
repeat
Ch := Source^;
if (Ch>='a') and (Ch<='z') then
dec(Ch,32);
Dest^ := Ch;
dec(L);
inc(Source);
inc(Dest);
until L=0;
end;
var L: cardinal;
begin
result := '';
L := Length(S);
if L=0 then
exit;
SetLength(result, L);
Upper(pointer(S),pointer(result),L);
end;
{$endif HASCODEPAGE}
function GetCardinal(P: PAnsiChar): cardinal; overload;
var c: cardinal;
begin
if P=nil then begin
result := 0;
exit;
end;
if P^=' ' then repeat inc(P) until P^<>' ';
c := byte(P^)-48;
if c>9 then
result := 0 else begin
result := c;
inc(P);
repeat
c := byte(P^)-48;
if c>9 then
break else
result := result*10+c;
inc(P);
until false;
end;
end;
function GetCardinal(P,PEnd: PAnsiChar): cardinal; overload;
var c: cardinal;
begin
result := 0;
if (P=nil) or (P>=PEnd) then
exit;
if P^=' ' then repeat
inc(P);
if P=PEnd then exit;
until P^<>' ';
c := byte(P^)-48;
if c>9 then
exit;
result := c;
inc(P);
while P<PEnd do begin
c := byte(P^)-48;
if c>9 then
break else
result := result*10+c;
inc(P);
end;
end;
function HttpChunkToHex32(p: PAnsiChar): integer;
var v0,v1: integer;
begin
result := 0;
if p<>nil then begin
while p^=' ' do inc(p);
repeat
v0 := Hex2Dec(p[0]);
if v0<0 then break; // not in '0'..'9','a'..'f'
v1 := Hex2Dec(p[1]);
inc(p);
if v1<0 then begin
result := (result shl 4) or v0; // only one char left
break;
end;
result := (result shl 8) or (v0 shl 4) or v1;
inc(p);
until false;
end;
end;
{$ifdef DELPHI5OROLDER}
function Utf8ToAnsi(const UTF8: SockString): SockString;
begin
result := UTF8; // no conversion
end;
{$endif}
const
ENGLISH_LANGID = $0409;
// see http://msdn.microsoft.com/en-us/library/windows/desktop/aa383770
ERROR_WINHTTP_CANNOT_CONNECT = 12029;
ERROR_WINHTTP_TIMEOUT = 12002;
ERROR_WINHTTP_INVALID_SERVER_RESPONSE = 12152;
function SysErrorMessagePerModule(Code: DWORD; ModuleName: PChar): string;
{$ifdef MSWINDOWS}
var tmpLen: DWORD;
err: PChar;
{$endif}
begin
if Code=NO_ERROR then begin
result := '';
exit;
end;
{$ifdef MSWINDOWS}
tmpLen := FormatMessage(
FORMAT_MESSAGE_FROM_HMODULE or FORMAT_MESSAGE_ALLOCATE_BUFFER,
pointer(GetModuleHandle(ModuleName)),Code,ENGLISH_LANGID,@err,0,nil);
try
while (tmpLen>0) and (ord(err[tmpLen-1]) in [0..32,ord('.')]) do
dec(tmpLen);
SetString(result,err,tmpLen);
finally
LocalFree(HLOCAL(err));
end;
{$endif}
if result='' then begin
result := SysErrorMessage(Code);
if result='' then
if Code=ERROR_WINHTTP_CANNOT_CONNECT then
result := 'cannot connect' else
if Code=ERROR_WINHTTP_TIMEOUT then