Version 1.13
        - now can compress its content using deflate or faster SynLZ algorithm:
          by default, the SynLZ algorithm will be used between a Delphi Client
          and Server over HTTP/1.1 - there will be no speed penalty on the
          server side, whereas deflate would use much more CPU 
        - by default, will handle SynLZ compression for TSQLite3HttpServer


}

interface

{$define COMPRESSSYNLZ}
{ if defined, will use SynLZ for content compression
................................................................................
  - is defined by default for a Delphi client }

{.$define COMPRESSDEFLATE}
{ if defined, will use deflate/zip for content compression
  - can be set globally for Client and Server applications
  - not defined by default for a Delphi client (SynLZ is more convenient) }








uses
  Windows,
  SysUtils,
{$ifdef COMPRESSDEFLATE}
  SynZip,
{$endif}
{$ifdef COMPRESSSYNLZ}
................................................................................
{ TSQLite3HttpClient }

constructor TSQLite3HttpClient.Create(const aServer, aPort: AnsiString;
  aModel: TSQLModel);
begin
  inherited Create(aModel);
  fSocket := THttpClientSocket.Open(aServer,aPort);



  KeepAliveMS := 20000; // 20 seconds connection keep alive by default
{$ifdef COMPRESSSYNLZ}
   // SynLZ is very fast and efficient, perfect for a Delphi Client
   fSocket.RegisterCompress(CompressSynLZ);
{$endif}
{$ifdef COMPRESSDEFLATE}
   fSocket.RegisterCompress(CompressDeflate);

      Version 1.13
        - now can compress its content using deflate or faster SynLZ algorithm:
          by default, the SynLZ algorithm will be used between a Delphi Client
          and Server over HTTP/1.1 - there will be no speed penalty on the
          server side, whereas deflate would use much more CPU 
        - by default, will handle SynLZ compression for TSQLite3HttpServer
        - can make TCP/IP stream not HTTP compliant (against antivirus slowdown)

}

interface

{$define COMPRESSSYNLZ}
{ if defined, will use SynLZ for content compression
................................................................................
  - is defined by default for a Delphi client }

{.$define COMPRESSDEFLATE}
{ if defined, will use deflate/zip for content compression
  - can be set globally for Client and Server applications
  - not defined by default for a Delphi client (SynLZ is more convenient) }

{.$define USETCPPREFIX}
{ if defined, a prefix will be added to the TCP/IP stream so that it won't be
  valid HTTP content any more: it could increase the client/server speed with
  some anti-virus software, but the remote access won't work any more with
  Internet Browsers nor AJAX applications
  - not defined by default - should be set globally to the project conditionals } 

uses
  Windows,
  SysUtils,
{$ifdef COMPRESSDEFLATE}
  SynZip,
{$endif}
{$ifdef COMPRESSSYNLZ}
................................................................................
{ TSQLite3HttpClient }

constructor TSQLite3HttpClient.Create(const aServer, aPort: AnsiString;
  aModel: TSQLModel);
begin
  inherited Create(aModel);
  fSocket := THttpClientSocket.Open(aServer,aPort);
{$ifdef USETCPPREFIX}
  fSocket.TCPPrefix := 'magic';
{$endif}
  KeepAliveMS := 20000; // 20 seconds connection keep alive by default
{$ifdef COMPRESSSYNLZ}
   // SynLZ is very fast and efficient, perfect for a Delphi Client
   fSocket.RegisterCompress(CompressSynLZ);
{$endif}
{$ifdef COMPRESSDEFLATE}
   fSocket.RegisterCompress(CompressDeflate);

          per one server (dispatching requests via the Root URI used)
        - new AddServer method, to register a TSQLRestServer after launch
        - new TSQLRestServer.OnlyJSONRequests property

      Version 1.13
        - now can compress its content using deflate or faster SynLZ algorithm
        - by default, will handle SynLZ compression for TSQLite3HttpClient

}

interface

{$define COMPRESSSYNLZ}
{ if defined, will use SynLZ for content compression
  - SynLZ is much faster than deflate/zip, so is preferred
................................................................................
{ if defined, will use deflate/zip for content compression
  - can be set global for Client and Server applications
  - SynLZ is faster but only known by Delphi clients: you can enable deflate
    when the server is connected an AJAX application (not defined by default)
  - if you define both COMPRESSSYNLZ and COMPRESSDEFLATE, the server will use
    SynLZ if available, and deflate if not called from a Delphi client }








{.$define HTTPEMBEDSQLITE3}
{ if defined, some additional methods will be included, in order to initialize
  directly a SQLite3 database engine
  -> it's cleaner to instantiate the TSQLRestServerDB instance first, then
    assign it to the TSQLite3HttpServer
  -> don't define it, even for TTestSQLite3Remote or TestSQL3.dpr }

................................................................................
      if aServers[j].Model.Root=Root then
        ErrMsg:= 'Duplicated Root URI';
  if ErrMsg<>'' then
     raise Exception.Create('TSQLite3HttpServer.Create: '+ErrMsg);
  SetLength(fDBServers,length(aServers));
  for i := 0 to high(aServers) do
    fDBServers[i] := aServers[i];



{$ifdef COMPRESSSYNLZ}
   RegisterCompress(CompressSynLZ);
{$endif}
{$ifdef COMPRESSDEFLATE}
   RegisterCompress(CompressDeflate);
{$endif}
end;

          per one server (dispatching requests via the Root URI used)
        - new AddServer method, to register a TSQLRestServer after launch
        - new TSQLRestServer.OnlyJSONRequests property

      Version 1.13
        - now can compress its content using deflate or faster SynLZ algorithm
        - by default, will handle SynLZ compression for TSQLite3HttpClient
        - can make TCP/IP stream not HTTP compliant (against antivirus slowdown)
}

interface

{$define COMPRESSSYNLZ}
{ if defined, will use SynLZ for content compression
  - SynLZ is much faster than deflate/zip, so is preferred
................................................................................
{ if defined, will use deflate/zip for content compression
  - can be set global for Client and Server applications
  - SynLZ is faster but only known by Delphi clients: you can enable deflate
    when the server is connected an AJAX application (not defined by default)
  - if you define both COMPRESSSYNLZ and COMPRESSDEFLATE, the server will use
    SynLZ if available, and deflate if not called from a Delphi client }

{.$define USETCPPREFIX}
{ if defined, a prefix will be added to the TCP/IP stream so that it won't be
  valid HTTP content any more: it could increase the client/server speed with
  some anti-virus software, but the remote access won't work any more with
  Internet Browsers nor AJAX applications
  - not defined by default - should be set globally to the project conditionals } 

{.$define HTTPEMBEDSQLITE3}
{ if defined, some additional methods will be included, in order to initialize
  directly a SQLite3 database engine
  -> it's cleaner to instantiate the TSQLRestServerDB instance first, then
    assign it to the TSQLite3HttpServer
  -> don't define it, even for TTestSQLite3Remote or TestSQL3.dpr }

................................................................................
      if aServers[j].Model.Root=Root then
        ErrMsg:= 'Duplicated Root URI';
  if ErrMsg<>'' then
     raise Exception.Create('TSQLite3HttpServer.Create: '+ErrMsg);
  SetLength(fDBServers,length(aServers));
  for i := 0 to high(aServers) do
    fDBServers[i] := aServers[i];
{$ifdef USETCPPREFIX}
  TCPPrefix := 'magic';
{$endif}
{$ifdef COMPRESSSYNLZ}
   RegisterCompress(CompressSynLZ);
{$endif}
{$ifdef COMPRESSDEFLATE}
   RegisterCompress(CompressDeflate);
{$endif}
end;

    /// decode 'CONTENT-ENCODING: ' parameter
    procedure SetfCompressHeader(P: PAnsiChar);
    /// 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;
  public








    /// 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: TSockData;
    /// will contain the header lines after a Request - use HeaderValue() to get one
    Headers: array of TSockData;
    /// will contain the data retrieved from the server, after the Request
................................................................................
    Sock: TCrtSocket;
    /// will contain the total number of connection to the server
    // - it's the global count since the server started
    ServerConnectionCount: cardinal;
    /// time, in milliseconds, for the HTTP.1/1 connections to be kept alive;
    // default is 3000 ms
    ServerKeepAliveTimeOut: cardinal;









    /// create a Server Thread, binded and listening on a port
    // - this constructor will raise a EHttpServer exception if binding failed
    // - 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 64)
    constructor Create(const aPort: AnsiString
................................................................................
    DoRetry(404) else // socket closed (e.g. KeepAlive=0) -> reconnect
  try
  try
{$ifdef DEBUG23}system.write(' Send');{$endif}
    // send request - we use SockSend because writeln() is calling flush()
    // -> all header will be sent at once
    DataLen := length(Data);


    SockSend([method, ' ', url, ' HTTP/1.1'#13#10+
      'Accept: */*'#13#10'Host: ', Server]);
    if UserAgent='' then
      SockSend('User-Agent: Mozilla/4.0 (compatible; MSIE 5.5; Windows; FREE)') else
      SockSend(['User-Agent: ',UserAgent]);
    // for POST/PUT: always put content byte count to be sent (even 0)
    SockSend(['Content-Length: ', DataLen]);
................................................................................
    {$ifdef DEBUG23} SndBuf[SndBufLen+1] := #0; system.Writeln(#13#10'HeaderOut ',PAnsiChar(SndBuf));{$endif}
    SockSendFlush; // flush all pending data (i.e. headers) to network
    if DataLen<>0 then // for POST and PUT methods: content to be sent
      SndLow(pointer(Data),DataLen); // no CRLF at the end of data
{$ifdef DEBUG23}system.write('OK ');{$endif}
    // get headers
    SockRecvLn(Command); // will raise ECrtSocket on any error






{$ifdef DEBUG23}system.write(Command);{$endif}
    P := pointer(Command);
    if IdemPChar(P,'HTTP/1.') then begin
      if P[7]='0' then
        KeepAlive := 0; // HTTP/1.0 -> force connection close
      inc(P,9);
      result := GetCardinal(P); // get http numeric status code
................................................................................
  if not(Code in [200,201]) and (Data='') then begin
    Setlength(ClientSock.Headers,0);
    ClientSock.ContentType := 'text/html'; // create message to display
    Data := TSockData(ClassName+' Server Error '+IntToStr(Code)
      +'<hr>'+StringReplace(string(s),#13#10,'<br>',[rfReplaceAll]));
  end;
  // 1. send HTTP status command


  if ClientSock.KeepAliveClient then
    ClientSock.SockSend(['HTTP/1.1 ',Code,' OK']) else
    ClientSock.SockSend(['HTTP/1.0 ',Code,' OK']);
  // 2. send headers
  // 2.1. custom headers from Request() method
  for i := 0 to high(ClientSock.Headers) do begin
    s := ClientSock.Headers[i];
................................................................................
var P: PAnsiChar;
    StartTix, EndTix: cardinal;
begin
  try
    StartTix := GetTickCount;
    // 1st line is command: 'GET /path HTTP/1.1' e.g.
    SockRecvLn(Command);






    P := pointer(Command);
    Method := GetNextItem(P,' '); // 'GET'
    URL := GetNextItem(P,' ');    // '/path'
    KeepAliveClient := IdemPChar(P,'HTTP/1.1');
    Content := '';
    // get headers and content
    GetHeader;
................................................................................
end;


constructor THttpServerSocket.Create(aServer: THttpServer);
var i: integer;
begin
  inherited Create;
  if aServer<>nil then
    for i := 0 to aServer.fCompress.Count-1 do
      RegisterCompress(aServer.fCompress[i]);


end;

{ ECrtSocket }

constructor ECrtSocket.Create(const Msg: string);
begin
  inherited CreateFmt('%s %d',[Msg,WSAGetLastError]);

    /// decode 'CONTENT-ENCODING: ' parameter
    procedure SetfCompressHeader(P: PAnsiChar);
    /// 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;
  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: TSockData;
    /// 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: TSockData;
    /// will contain the header lines after a Request - use HeaderValue() to get one
    Headers: array of TSockData;
    /// will contain the data retrieved from the server, after the Request
................................................................................
    Sock: TCrtSocket;
    /// will contain the total number of connection to the server
    // - it's the global count since the server started
    ServerConnectionCount: cardinal;
    /// time, in milliseconds, for the HTTP.1/1 connections to be kept alive;
    // default is 3000 ms
    ServerKeepAliveTimeOut: cardinal;
    /// 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: TSockData;

    /// create a Server Thread, binded and listening on a port
    // - this constructor will raise a EHttpServer exception if binding failed
    // - 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 64)
    constructor Create(const aPort: AnsiString
................................................................................
    DoRetry(404) else // socket closed (e.g. KeepAlive=0) -> reconnect
  try
  try
{$ifdef DEBUG23}system.write(' Send');{$endif}
    // send request - we use SockSend because writeln() is calling flush()
    // -> all header will be sent at once
    DataLen := length(Data);
    if TCPPrefix<>'' then
      SockSend(TCPPrefix);
    SockSend([method, ' ', url, ' HTTP/1.1'#13#10+
      'Accept: */*'#13#10'Host: ', Server]);
    if UserAgent='' then
      SockSend('User-Agent: Mozilla/4.0 (compatible; MSIE 5.5; Windows; FREE)') else
      SockSend(['User-Agent: ',UserAgent]);
    // for POST/PUT: always put content byte count to be sent (even 0)
    SockSend(['Content-Length: ', DataLen]);
................................................................................
    {$ifdef DEBUG23} SndBuf[SndBufLen+1] := #0; system.Writeln(#13#10'HeaderOut ',PAnsiChar(SndBuf));{$endif}
    SockSendFlush; // flush all pending data (i.e. headers) to network
    if DataLen<>0 then // for POST and PUT methods: content to be sent
      SndLow(pointer(Data),DataLen); // no CRLF at the end of data
{$ifdef DEBUG23}system.write('OK ');{$endif}
    // get headers
    SockRecvLn(Command); // will raise ECrtSocket on any error
    if TCPPrefix<>'' then
      if Command<>TCPPrefix then begin
        result :=  505;
        exit;
      end else
      SockRecvLn(Command);
{$ifdef DEBUG23}system.write(Command);{$endif}
    P := pointer(Command);
    if IdemPChar(P,'HTTP/1.') then begin
      if P[7]='0' then
        KeepAlive := 0; // HTTP/1.0 -> force connection close
      inc(P,9);
      result := GetCardinal(P); // get http numeric status code
................................................................................
  if not(Code in [200,201]) and (Data='') then begin
    Setlength(ClientSock.Headers,0);
    ClientSock.ContentType := 'text/html'; // create message to display
    Data := TSockData(ClassName+' Server Error '+IntToStr(Code)
      +'<hr>'+StringReplace(string(s),#13#10,'<br>',[rfReplaceAll]));
  end;
  // 1. send HTTP status command
  if ClientSock.TCPPrefix<>'' then
    ClientSock.SockSend(ClientSock.TCPPrefix);
  if ClientSock.KeepAliveClient then
    ClientSock.SockSend(['HTTP/1.1 ',Code,' OK']) else
    ClientSock.SockSend(['HTTP/1.0 ',Code,' OK']);
  // 2. send headers
  // 2.1. custom headers from Request() method
  for i := 0 to high(ClientSock.Headers) do begin
    s := ClientSock.Headers[i];
................................................................................
var P: PAnsiChar;
    StartTix, EndTix: cardinal;
begin
  try
    StartTix := GetTickCount;
    // 1st line is command: 'GET /path HTTP/1.1' e.g.
    SockRecvLn(Command);
    if TCPPrefix<>'' then
      if TCPPrefix<>Command then begin
        result := false;
        exit
      end else
      SockRecvLn(Command);
    P := pointer(Command);
    Method := GetNextItem(P,' '); // 'GET'
    URL := GetNextItem(P,' ');    // '/path'
    KeepAliveClient := IdemPChar(P,'HTTP/1.1');
    Content := '';
    // get headers and content
    GetHeader;
................................................................................
end;


constructor THttpServerSocket.Create(aServer: THttpServer);
var i: integer;
begin
  inherited Create;
  if aServer<>nil then begin
    for i := 0 to aServer.fCompress.Count-1 do
      RegisterCompress(aServer.fCompress[i]);
    TCPPrefix := aServer.TCPPrefix;  
  end;
end;

{ ECrtSocket }

constructor ECrtSocket.Create(const Msg: string);
begin
  inherited CreateFmt('%s %d',[Msg,WSAGetLastError]);

/// 2nd compression method optimizes pattern copy -> a bit smaller, but slower
function SynLZdecompress2(src: PAnsiChar; size: integer; dst: PAnsiChar): Integer;


/// compress a data content using the SynLZ algorithm
// - as expected by THttpSocket.RegisterCompress
// - will return 'synlz' as ACCEPT-ENCODING: header parameter
// - will use internaly a level compression of 1, i.e. fastest available

function CompressSynLZ(var Data: AnsiString; Compress: boolean): AnsiString;



implementation

{$ifndef FPC}

/// 2nd compression method optimizes pattern copy -> a bit smaller, but slower
function SynLZdecompress2(src: PAnsiChar; size: integer; dst: PAnsiChar): Integer;


/// compress a data content using the SynLZ algorithm
// - as expected by THttpSocket.RegisterCompress
// - will return 'synlz' as ACCEPT-ENCODING: header parameter
// - will store a hash of both compressed and uncompressed stream: if the
// data is corrupted during transmission, will instantly return ''
function CompressSynLZ(var Data: AnsiString; Compress: boolean): AnsiString;



implementation

{$ifndef FPC}

/// uncompress in_p(in_len) into out_p (must be allocated before call), returns out_len
// - may write up to out_len+3 bytes in out_p
// - the decompression mode is "fast-unsafe" -> CRC/Adler32 in_p data before call
function lzopas_decompress(in_p: PAnsiChar; in_len: integer; out_p: PAnsiChar): Integer;

/// (de)compress a data content using the SynLZO algorithm
// - as expected by THttpSocket.RegisterCompress
// - will use internaly a level compression of 1, i.e. fastest available
// - will return 'synlzo' as ACCEPT-ENCODING: header parameter


function CompressSynLZO(var Data: AnsiString; Compress: boolean): AnsiString;



{$ifdef LZOFILE}

{$ifdef WIN32}

/// uncompress in_p(in_len) into out_p (must be allocated before call), returns out_len
// - may write up to out_len+3 bytes in out_p
// - the decompression mode is "fast-unsafe" -> CRC/Adler32 in_p data before call
function lzopas_decompress(in_p: PAnsiChar; in_len: integer; out_p: PAnsiChar): Integer;

/// (de)compress a data content using the SynLZO algorithm
// - as expected by THttpSocket.RegisterCompress

// - will return 'synlzo' as ACCEPT-ENCODING: header parameter
// - will store a hash of both compressed and uncompressed stream: if the
// data is corrupted during transmission, will instantly return ''
function CompressSynLZO(var Data: AnsiString; Compress: boolean): AnsiString;



{$ifdef LZOFILE}

{$ifdef WIN32}