From c13c4e0f3859752bec5a4e9a029bf33862a10118 Mon Sep 17 00:00:00 2001 From: butlerdj Date: Wed, 3 Jun 2020 06:21:10 +0200 Subject: [PATCH] HTTP/HTTPS update --- Source/HTTP/flcHTTP.inc | 7 +- Source/HTTP/flcHTTPClient.pas | 21 +- Source/HTTP/flcHTTPServer.pas | 445 +++++++++++++++++++++------------- Source/HTTP/flcHTTPTests.pas | 23 +- Source/HTTP/flcHTTPUtils.pas | 12 +- 5 files changed, 318 insertions(+), 190 deletions(-) diff --git a/Source/HTTP/flcHTTP.inc b/Source/HTTP/flcHTTP.inc index 59cc9ee..248c320 100644 --- a/Source/HTTP/flcHTTP.inc +++ b/Source/HTTP/flcHTTP.inc @@ -10,10 +10,9 @@ {$ENDIF} {$ENDIF} -{.DEFINE HTTP_TLS} - -{.DEFINE HTTPCLIENT_CUSTOM} -{.DEFINE HTTPSERVER_CUSTOM} +{$IFDEF TLS} + {$DEFINE HTTP_TLS} +{$ENDIF} {$IFNDEF TCPCLIENT_TLS} {$UNDEF HTTP_TLS} diff --git a/Source/HTTP/flcHTTPClient.pas b/Source/HTTP/flcHTTPClient.pas index 5ef72ce..132cd2d 100644 --- a/Source/HTTP/flcHTTPClient.pas +++ b/Source/HTTP/flcHTTPClient.pas @@ -574,10 +574,11 @@ implementation flcBase64, flcStringBuilder, flcDateTime, - flcSocketLib - {$IFDEF HTTP_TLS}, - flcTLSClient - {$ENDIF}; + flcSocketLib, + {$IFDEF HTTP_TLS} + flcTLSTransportClient, + {$ENDIF} + flcTCPUtils; @@ -1353,7 +1354,7 @@ procedure TF5HTTPClient.ProcessResponseHeader; {$IFDEF StringIsUnicode} FResponseCookies.Add(B.AsString); {$ELSE} - FResponseCookies.Add(B.AsRawByteString); + FResponseCookies.Add(String(B.AsRawByteString)); {$ENDIF} end; FResponseRequireClose := @@ -1439,6 +1440,8 @@ procedure TF5HTTPClient.InitTCPClient; {$IFDEF HTTP_TLS} FTCPClient.TLSEnabled := FUseHTTPS; TLSOpt := []; + ///// + (* if csoDontUseSSL3 in FHTTPSOptions then Include(TLSOpt, ctoDisableSSL3); if csoDontUseTLS10 in FHTTPSOptions then @@ -1447,6 +1450,7 @@ procedure TF5HTTPClient.InitTCPClient; Include(TLSOpt, ctoDisableTLS11); if csoDontUseTLS12 in FHTTPSOptions then Include(TLSOpt, ctoDisableTLS12); + *) FTCPClient.TLSOptions := TLSOpt; {$ENDIF} InitTCPClientHost; @@ -1713,11 +1717,14 @@ procedure TF5HTTPClient.ReadResponseContent; procedure TF5HTTPClient.ReadResponse; begin + if FState = hcsStarting then + exit; Assert(FTCPClient.State in [csReady, csClosed]); Assert(FState in [ hcsAwaitingResponse, hcsReceivedResponse, hcsReceivingContent, hcsResponseComplete, hcsResponseCompleteAndClosing, hcsResponseCompleteAndClosed, hcsRequestInterruptedAndClosed]); + try if FState = hcsAwaitingResponse then ReadResponseHeader; @@ -1860,7 +1867,7 @@ procedure TF5HTTPClient.PrepareHTTPRequest; else FRequest.Header.CommonHeaders.Connection.Value := C; - FRequest.Header.FixedHeaders[hntHost] := FHost; + FRequest.Header.FixedHeaders[hntHost] := UTF8Encode(FHost); FRequest.Header.FixedHeaders[hntUserAgent] := FUserAgent; FRequest.Header.FixedHeaders[hntReferer] := FReferer; FRequest.Header.FixedHeaders[hntAuthorization] := FAuthorization; @@ -1900,7 +1907,7 @@ procedure TF5HTTPClient.SendStr(const S: RawByteString); Assert(Assigned(FTCPClient)); Assert(FState in [hcsSendingRequest, hcsSendingContent]); // - FTCPClient.Connection.WriteStrB(S); + FTCPClient.Connection.WriteByteString(S); end; procedure TF5HTTPClient.SendRequest; diff --git a/Source/HTTP/flcHTTPServer.pas b/Source/HTTP/flcHTTPServer.pas index e0af73f..1354ba9 100644 --- a/Source/HTTP/flcHTTPServer.pas +++ b/Source/HTTP/flcHTTPServer.pas @@ -5,7 +5,7 @@ { File version: 5.06 } { Description: HTTP server. } { } -{ Copyright: Copyright (c) 2011-2018, David J Butler } +{ Copyright: Copyright (c) 2011-2020, David J Butler } { All rights reserved. } { This file is licensed under the BSD License. } { See http://www.opensource.org/licenses/bsd-license.php } @@ -53,44 +53,61 @@ interface uses { System } + SysUtils, Classes, SyncObjs, + { Fundamentals } + flcStdTypes, flcStrings, flcSocketLib, + { TCP } + flcTCPConnection, flcTCPServer, + { HTTP } + flcHTTPUtils; { } -{ THTTP4Server } +{ TF5HTTPServer } { } const - HTTP_SERVER_DEFAULT_MaxBacklog = 8; - HTTP_SERVER_DEFAULT_MaxClients = -1; + HTTPSERVER_DefaultPort = 80; + HTTPSERVER_DefaultPortStr = '80'; + HTTPSERVER_DefaultMaxBacklog = 8; + HTTPSERVER_DefaultMaxClients = -1; type THTTPServerLogType = ( + // sltTrace sltDebug, + // sltParameter sltInfo, - sltError); + // sltWarning, + sltError + // sltAlert + // sltCritical + ); THTTPServerAddressFamily = ( safIP4, - safIP6); + safIP6 + ); {$IFDEF HTTP_TLS} THTTPSServerOption = ( ssoDontUseSSL3, ssoDontUseTLS10, ssoDontUseTLS11, - ssoDontUseTLS12); + ssoDontUseTLS12 + ); THTTPSServerOptions = set of THTTPSServerOption; {$ENDIF} @@ -110,21 +127,20 @@ TF5HTTPServer = class; hscsResponseComplete, hscsResponseCompleteAndClosing, hscsResponseCompleteAndClosed, - hscsRequestInterruptedAndClosed); + hscsRequestInterruptedAndClosed + ); THTTPServerClient = class private - // parameters - FHTTPServer : TF5HTTPServer; - FTCPClient : TTCPServerClient; + FHTTPServer : TF5HTTPServer; + FTCPClient : TTCPServerClient; - // state - FLock : TCriticalSection; - FState : THTTPServerClientState; - FHTTPParser : THTTPParser; + FLock : TCriticalSection; + FState : THTTPServerClientState; + FHTTPParser : THTTPParser; - FRequest : THTTPRequest; - FRequestContentReader : THTTPContentReader; + FRequest : THTTPRequest; + FRequestContentReader : THTTPContentReader; FResponse : THTTPResponse; FResponseContentWriter : THTTPContentWriter; @@ -139,11 +155,12 @@ THTTPServerClient = class procedure Unlock; function GetState: THTTPServerClientState; - function GetStateStr: RawByteString; + function GetStateStr: String; + procedure SetState(const State: THTTPServerClientState); function GetRemoteAddr: TSocketAddr; - function GetRemoteAddrStr: RawByteString; + function GetRemoteAddrStr: String; procedure TriggerStateChanged; procedure TriggerRequestHeader; @@ -198,43 +215,43 @@ THTTPServerClient = class function GetRequestRecordPtr: PHTTPRequest; function GetResponseCode: Integer; - procedure SetResponseCode(const ResponseCode: Integer); + procedure SetResponseCode(const AResponseCode: Integer); function GetResponseMsg: RawByteString; - procedure SetResponseMsg(const ResponseMsg: RawByteString); + procedure SetResponseMsg(const AResponseMsg: RawByteString); function GetResponseContentType: RawByteString; - procedure SetResponseContentType(const ResponseContentType: RawByteString); + procedure SetResponseContentType(const AResponseContentType: RawByteString); function GetResponseRecordPtr: PHTTPResponse; function GetRequestContentStream: TStream; - procedure SetRequestContentStream(const RequestContentStream: TStream); + procedure SetRequestContentStream(const ARequestContentStream: TStream); function GetRequestContentFileName: String; - procedure SetRequestContentFileName(const RequestContentFileName: String); + procedure SetRequestContentFileName(const ARequestContentFileName: String); function GetRequestContentStr: RawByteString; function GetRequestContentReceivedSize: Int64; function GetResponseContentMechanism: THTTPContentWriterMechanism; - procedure SetResponseContentMechanism(const ResponseContentMechanism: THTTPContentWriterMechanism); + procedure SetResponseContentMechanism(const AResponseContentMechanism: THTTPContentWriterMechanism); function GetResponseContentStr: RawByteString; - procedure SetResponseContentStr(const ResponseContentStr: RawByteString); + procedure SetResponseContentStr(const AResponseContentStr: RawByteString); function GetResponseContentStream: TStream; - procedure SetResponseContentStream(const ResponseContentStream: TStream); + procedure SetResponseContentStream(const AResponseContentStream: TStream); function GetResponseContentFileName: String; - procedure SetResponseContentFileName(const ResponseContentFileName: String); - procedure SetResponseReady(const ResponseReady: Boolean); + procedure SetResponseContentFileName(const AResponseContentFileName: String); + procedure SetResponseReady(const AResponseReady: Boolean); public constructor Create( - const HTTPServer: TF5HTTPServer; - const TCPClient: TTCPServerClient); + const AHTTPServer: TF5HTTPServer; + const ATCPClient: TTCPServerClient); destructor Destroy; override; procedure Finalise; property State: THTTPServerClientState read GetState; - property StateStr: RawByteString read GetStateStr; + property StateStr: String read GetStateStr; property RemoteAddr: TSocketAddr read GetRemoteAddr; - property RemoteAddrStr: RawByteString read GetRemoteAddrStr; + property RemoteAddrStr: String read GetRemoteAddrStr; property RequestRecord: THTTPRequest read FRequest; property RequestRecordPtr: PHTTPRequest read GetRequestRecordPtr; @@ -263,23 +280,37 @@ THTTPServerClient = class property ResponseContentFileName: String read GetResponseContentFileName write SetResponseContentFileName; property ResponseReady: Boolean read FResponseReady write SetResponseReady; - procedure SetResponseOKHtmlStr(const HtmlStr: RawByteString); - procedure SetResponseOKFile(const ContentType: THTTPContentTypeEnum; - const FileName: String); + procedure SetResponseOKHtmlStr(const AHtmlStr: RawByteString); + procedure SetResponseOKFile( + const AContentType: THTTPContentTypeEnum; + const AFileName: String); procedure SetResponseNotFound; - procedure SetResponseRedirect(const Location: RawByteString); + procedure SetResponseRedirect(const ALocation: RawByteString); procedure Disconnect; end; - THTTPServerEvent = procedure (Server: TF5HTTPServer) of object; - THTTPServerLogEvent = procedure (Server: TF5HTTPServer; LogType: THTTPServerLogType; Msg: String; LogLevel: Integer) of object; - THTTPServerClientEvent = procedure (Server: TF5HTTPServer; Client: THTTPServerClient) of object; - THTTPServerClientContentEvent = procedure (Server: TF5HTTPServer; Client: THTTPServerClient; const Buf; const Size: Integer) of object; + + + THTTPServerEvent = procedure (const AServer: TF5HTTPServer) of object; + + THTTPServerLogEvent = procedure ( + const AServer: TF5HTTPServer; + const ALogType: THTTPServerLogType; + const AMsg: String; + const ALogLevel: Integer) of object; + + THTTPServerClientEvent = procedure ( + const AServer: TF5HTTPServer; + const AClient: THTTPServerClient) of object; + + THTTPServerClientContentEvent = procedure ( + const AServer: TF5HTTPServer; + const AClient: THTTPServerClient; + const Buf; const Size: Integer) of object; TF5HTTPServer = class(TComponent) protected - // events FOnLog : THTTPServerLogEvent; FOnStart : THTTPServerEvent; FOnStop : THTTPServerEvent; @@ -291,7 +322,6 @@ TF5HTTPServer = class(TComponent) FOnPrepareResponse : THTTPServerClientEvent; FOnResponseComplete : THTTPServerClientEvent; - // parameters FAddressFamily : THTTPServerAddressFamily; FBindAddressStr : String; FServerPort : Integer; @@ -311,9 +341,9 @@ TF5HTTPServer = class(TComponent) FUserData : Pointer; FUserTag : NativeInt; - // state FLock : TCriticalSection; FActive : Boolean; + FStopping : Boolean; FActivateOnLoaded : Boolean; FTCPServer : TF5TCPServer; @@ -380,13 +410,15 @@ TF5HTTPServer = class(TComponent) procedure DoStart; procedure DoStop; - procedure SetActive(const Active: Boolean); + + procedure SetActive(const AActive: Boolean); function GetClientCount: Integer; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; + procedure Finalise; property OnLog: THTTPServerLogEvent read FOnLog write FOnLog; @@ -404,8 +436,8 @@ TF5HTTPServer = class(TComponent) property AddressFamily: THTTPServerAddressFamily read FAddressFamily write SetAddressFamily default safIP4; property BindAddress: String read FBindAddressStr write SetBindAddress; property ServerPort: Integer read FServerPort write SetServerPort; - property MaxBacklog: Integer read FMaxBacklog write SetMaxBacklog default HTTP_SERVER_DEFAULT_MaxBacklog; - property MaxClients: Integer read FMaxClients write SetMaxClients default HTTP_SERVER_DEFAULT_MaxClients; + property MaxBacklog: Integer read FMaxBacklog write SetMaxBacklog default HTTPSERVER_DefaultMaxBacklog; + property MaxClients: Integer read FMaxClients write SetMaxClients default HTTPSERVER_DefaultMaxClients; property ServerName: RawByteString read FServerName write SetServerName; @@ -419,11 +451,10 @@ TF5HTTPServer = class(TComponent) property Active: Boolean read FActive write SetActive default False; property TCPServer: TF5TCPServer read FTCPServer; - + property ClientCount: Integer read GetClientCount; property UserObject: TObject read FUserObject write FUserObject; - property UserData: Pointer read FUserData write FUserData; property UserTag: NativeInt read FUserTag write FUserTag; end; @@ -468,20 +499,13 @@ TfclHTTPServer = class(TF5HTTPServer) property Active; end; -{$IFDEF HTTPSERVER_CUSTOM} - {$INCLUDE cHTTPServerIntf.inc} -{$ENDIF} - implementation {$IFDEF HTTP_TLS} uses - {$IFDEF HTTPSERVER_CUSTOM} - {$INCLUDE cHTTPServerUses.inc} - {$ENDIF} - flcTLSServer; + flcTLSTransportServer; {$ENDIF} @@ -490,9 +514,6 @@ implementation { HTTP Server constants } { } const - HTTPSERVER_PORT = 80; - HTTPSERVER_PORT_STR = '80'; - HTTPSERVER_RequestHeader_MaxSize = 16384; HTTPSERVER_RequestHeader_Delim = #13#10#13#10; HTTPSERVER_RequestHeader_DelimLen = Length(HTTPSERVER_RequestHeader_Delim); @@ -506,7 +527,7 @@ implementation SError_NotAllowedWhileActive = 'Operation not allowed while active'; const - SClientState : array[THTTPServerClientState] of RawByteString = ( + SClientState : array[THTTPServerClientState] of String = ( 'Initialise', 'AwaitingRequest', 'ReceivedRequestHeader', @@ -519,25 +540,26 @@ implementation 'ResponseComplete', 'ResponseCompleteAndClosing', 'ResponseCompleteAndClosed', - 'RequestInterruptedAndClosed'); + 'RequestInterruptedAndClosed' + ); { } { THTTPServerClient } { } -constructor THTTPServerClient.Create(const HTTPServer: TF5HTTPServer; const TCPClient: TTCPServerClient); +constructor THTTPServerClient.Create( + const AHTTPServer: TF5HTTPServer; + const ATCPClient: TTCPServerClient); begin - Assert(Assigned(HTTPServer)); - Assert(Assigned(TCPClient)); - // + Assert(Assigned(AHTTPServer)); + Assert(Assigned(ATCPClient)); + inherited Create; - FHTTPServer := HTTPServer; - FTCPClient := TCPClient; + + FHTTPServer := AHTTPServer; + FTCPClient := ATCPClient; Init; - {$IFDEF HTTP_DEBUG} - Log(sltDebug, 'Initialised'); - {$ENDIF} end; procedure THTTPServerClient.Init; @@ -564,7 +586,10 @@ procedure THTTPServerClient.Init; destructor THTTPServerClient.Destroy; begin - Finalise; + FreeAndNil(FResponseContentWriter); + FreeAndNil(FRequestContentReader); + FreeAndNil(FHTTPParser); + FreeAndNil(FLock); inherited Destroy; end; @@ -572,10 +597,6 @@ procedure THTTPServerClient.Finalise; begin FHTTPServer := nil; FTCPClient := nil; - FreeAndNil(FResponseContentWriter); - FreeAndNil(FRequestContentReader); - FreeAndNil(FHTTPParser); - FreeAndNil(FLock); end; procedure THTTPServerClient.Log(const LogType: THTTPServerLogType; const Msg: String; const LogLevel: Integer); @@ -591,14 +612,12 @@ procedure THTTPServerClient.Log(const LogType: THTTPServerLogType; const Msg: St procedure THTTPServerClient.Lock; begin - if Assigned(FLock) then - FLock.Acquire; + FLock.Acquire; end; procedure THTTPServerClient.Unlock; begin - if Assigned(FLock) then - FLock.Release; + FLock.Release; end; function THTTPServerClient.GetState: THTTPServerClientState; @@ -611,7 +630,7 @@ function THTTPServerClient.GetState: THTTPServerClientState; end; end; -function THTTPServerClient.GetStateStr: RawByteString; +function THTTPServerClient.GetStateStr: String; begin Result := SClientState[GetState]; end; @@ -633,7 +652,7 @@ function THTTPServerClient.GetRemoteAddr: TSocketAddr; Result := FTCPClient.RemoteAddr; end; -function THTTPServerClient.GetRemoteAddrStr: RawByteString; +function THTTPServerClient.GetRemoteAddrStr: String; begin Result := FTCPClient.RemoteAddrStr; end; @@ -643,6 +662,7 @@ procedure THTTPServerClient.TriggerStateChanged; {$IFDEF HTTP_DEBUG} Log(sltDebug, 'State:%s', [GetStateStr]); {$ENDIF} + Assert(Assigned(FHTTPServer)); FHTTPServer.ClientStateChanged(self); end; @@ -653,6 +673,7 @@ procedure THTTPServerClient.TriggerRequestHeader; Log(sltDebug, 'RequestHeader:'); Log(sltDebug, String(HTTPRequestToStr(FRequest))); {$ENDIF} + Assert(Assigned(FHTTPServer)); FHTTPServer.ClientRequestHeader(self); end; @@ -662,6 +683,7 @@ procedure THTTPServerClient.TriggerRequestContentBuffer(const Buf; const Size: I {$IFDEF HTTP_DEBUG} Log(sltDebug, 'RequestContentBuffer'); {$ENDIF} + Assert(Assigned(FHTTPServer)); FHTTPServer.ClientRequestContentBuffer(self, Buf, Size); end; @@ -671,6 +693,7 @@ procedure THTTPServerClient.TriggerRequestContentComplete; {$IFDEF HTTP_DEBUG} Log(sltDebug, 'RequestContentComplete'); {$ENDIF} + Assert(Assigned(FHTTPServer)); FHTTPServer.ClientRequestContentComplete(self); end; @@ -680,6 +703,7 @@ procedure THTTPServerClient.TriggerPrepareResponse; {$IFDEF HTTP_DEBUG} Log(sltDebug, 'PrepareResponse'); {$ENDIF} + Assert(Assigned(FHTTPServer)); FHTTPServer.ClientPrepareResponse(self); end; @@ -689,6 +713,7 @@ procedure THTTPServerClient.TriggerResponseComplete; {$IFDEF HTTP_DEBUG} Log(sltDebug, 'ResponseComplete'); {$ENDIF} + Assert(Assigned(FHTTPServer)); FHTTPServer.ClientResponseComplete(self); end; @@ -699,13 +724,13 @@ procedure THTTPServerClient.TCPClientStateChange; procedure THTTPServerClient.TCPClientRead; begin - Assert(FState in [ - hscsInit, // ?? +{ Assert(FState in [ + hscsInit, hscsAwaitingRequest, hscsReceivingContent, hscsResponseComplete, - hscsResponseCompleteAndClosing, // ?? - hscsResponseCompleteAndClosed]); // ?? + hscsResponseCompleteAndClosing, + hscsResponseCompleteAndClosed]); } //// 2020/05/01 OnRead can be called when closed in TCP connection if FState = hscsResponseComplete then SetState(hscsAwaitingRequest); if FState = hscsAwaitingRequest then @@ -731,6 +756,7 @@ procedure THTTPServerClient.TCPClientClose; {$IFDEF HTTP_DEBUG} Log(sltDebug, 'TCPClient_Close'); {$ENDIF} + if FState in [hscsInit, hscsResponseCompleteAndClosed, hscsRequestInterruptedAndClosed] then @@ -760,10 +786,11 @@ function THTTPServerClient.ContentReaderReadProc(const Sender: THTTPContentReade begin Assert(Assigned(FTCPClient)); Assert(FState in [hscsReceivingContent]); - // + {$IFDEF HTTP_DEBUG} Log(sltDebug, 'ContentReader_Read'); {$ENDIF} + Result := FTCPClient.Connection.Read(Buf, Size); end; @@ -773,6 +800,7 @@ procedure THTTPServerClient.ContentReaderContentProc(const Sender: THTTPContentR {$IFDEF HTTP_DEBUG} Log(sltDebug, 'ContentReader_Content'); {$ENDIF} + TriggerRequestContentBuffer(Buf, Size); end; @@ -781,6 +809,7 @@ procedure THTTPServerClient.ContentReaderContentCompleteProc(const Sender: THTTP {$IFDEF HTTP_DEBUG} Log(sltDebug, 'ContentReader_ContentComplete'); {$ENDIF} + FinaliseRequestContent; SetRequestComplete; end; @@ -799,13 +828,14 @@ function THTTPServerClient.ContentWriterWriteProc(const Sender: THTTPContentWrit {$IFDEF HTTP_DEBUG} Log(sltDebug, 'ContentWriter_Write'); {$ENDIF} + Result := FTCPClient.Connection.Write(Buf, Size); end; procedure THTTPServerClient.SendStr(const S: RawByteString); begin Assert(Assigned(FTCPClient)); - FTCPClient.Connection.WriteStrB(S); + FTCPClient.Connection.WriteByteString(S); end; procedure THTTPServerClient.Start; @@ -831,16 +861,18 @@ procedure THTTPServerClient.ReadRequestHeader; begin Assert(Assigned(FTCPClient)); Assert(FState in [hscsAwaitingRequest]); - // + HdrLen := FTCPClient.Connection.PeekDelimited( HdrBuf[0], HdrBufSize, HTTPSERVER_RequestHeader_Delim, HTTPSERVER_RequestHeader_MaxSize); if HdrLen < 0 then exit; + {$IFDEF HTTP_DEBUG} Log(sltDebug, 'RequestHeader:%db', [HdrLen]); {$ENDIF} + ClearHTTPRequest(FRequest); FHTTPParser.SetTextBuf(HdrBuf[0], HdrLen); FHTTPParser.ParseRequest(FRequest); @@ -849,10 +881,12 @@ procedure THTTPServerClient.ReadRequestHeader; {$IFDEF HTTP_DEBUG} Log(sltDebug, 'RequestHeader:BadFormat:ClosingConnection'); {$ENDIF} + FTCPClient.Close; exit; end; FTCPClient.Connection.Discard(HdrLen); + ClearResponse; ProcessRequestHeader; SetState(hscsReceivedRequestHeader); @@ -903,14 +937,17 @@ procedure THTTPServerClient.InitResponse; {$IFDEF HTTP_DEBUG} Log(sltDebug, 'InitResponse'); {$ENDIF} + FResponse.StartLine.Version := FRequest.StartLine.Version; if FRequest.StartLine.Version.Version = hvHTTP11 then case FRequest.Header.CommonHeaders.Connection.Value of hcfClose : FResponse.Header.CommonHeaders.Connection.Value := hcfClose; hcfKeepAlive : FResponse.Header.CommonHeaders.Connection.Value := hcfKeepAlive; end; + FResponse.Header.CommonHeaders.Date.Value := hdDateTime; FResponse.Header.CommonHeaders.Date.DateTime := Now; + if FHTTPServer.FServerName <> '' then FResponse.Header.FixedHeaders[hntServer] := FHTTPServer.FServerName; end; @@ -920,6 +957,7 @@ procedure THTTPServerClient.PrepareResponse; {$IFDEF HTTP_DEBUG} Log(sltDebug, 'PrepareResponse'); {$ENDIF} + TriggerPrepareResponse; if FResponse.StartLine.Msg = hslmNone then FResponse.StartLine.Msg := HTTPResponseCodeToStartLineMessage(FResponse.StartLine.Code); @@ -937,6 +975,7 @@ procedure THTTPServerClient.InitResponseContent; B := ContentLen; FResponse.Header.CommonHeaders.ContentLength.Value := hcltByteCount; FResponse.Header.CommonHeaders.ContentLength.ByteCount := B; + {$IFDEF HTTP_DEBUG} Log(sltDebug, Format('InitResponseContent:%d:%db:%db', [Ord(HasContent), ContentLen, B])); {$ENDIF} @@ -947,6 +986,7 @@ procedure THTTPServerClient.SendResponseContent; {$IFDEF HTTP_DEBUG} Log(sltDebug, 'SendResponseContent'); {$ENDIF} + FResponseContentWriter.SendContent; end; @@ -955,6 +995,7 @@ procedure THTTPServerClient.ResponsePrepared; {$IFDEF HTTP_DEBUG} Log(sltDebug, 'ResponsePrepared'); {$ENDIF} + SendResponse; end; @@ -962,17 +1003,21 @@ procedure THTTPServerClient.SendResponse; var ResponseHdr : RawByteString; begin InitResponseContent; + SetState(hscsSendingResponseHeader); ResponseHdr := HTTPResponseToStr(FResponse); + {$IFDEF HTTP_DEBUG} Log(sltDebug, 'ResponseHeader:'); Log(sltDebug, String(ResponseHdr)); {$ENDIF} + SendStr(HTTPResponseToStr(FResponse)); SetState(hscsSendingContent); SendResponseContent; if not FResponseContentWriter.ContentComplete then exit; + SetResponseComplete; end; @@ -980,7 +1025,9 @@ procedure THTTPServerClient.SetResponseComplete; begin Assert(FState = hscsSendingContent); SetState(hscsResponseComplete); + TriggerResponseComplete; + if (FRequest.StartLine.Version.Version = hvHTTP10) or (FRequest.Header.CommonHeaders.Connection.Value = hcfClose) or (FResponse.Header.CommonHeaders.Connection.Value = hcfClose) then @@ -988,6 +1035,7 @@ procedure THTTPServerClient.SetResponseComplete; {$IFDEF HTTP_DEBUG} Log(sltDebug, 'SetResponseComplete:ConnectionClose'); {$ENDIF} + FTCPClient.Connection.Shutdown; SetState(hscsResponseCompleteAndClosing); end; @@ -1033,9 +1081,9 @@ function THTTPServerClient.GetResponseCode: Integer; Result := FResponse.StartLine.Code; end; -procedure THTTPServerClient.SetResponseCode(const ResponseCode: Integer); +procedure THTTPServerClient.SetResponseCode(const AResponseCode: Integer); begin - FResponse.StartLine.Code := ResponseCode; + FResponse.StartLine.Code := AResponseCode; end; function THTTPServerClient.GetResponseMsg: RawByteString; @@ -1043,10 +1091,10 @@ function THTTPServerClient.GetResponseMsg: RawByteString; Result := FResponse.StartLine.CustomMsg; end; -procedure THTTPServerClient.SetResponseMsg(const ResponseMsg: RawByteString); +procedure THTTPServerClient.SetResponseMsg(const AResponseMsg: RawByteString); begin FResponse.StartLine.Msg := hslmCustom; - FResponse.StartLine.CustomMsg := ResponseMsg; + FResponse.StartLine.CustomMsg := AResponseMsg; end; function THTTPServerClient.GetResponseContentType: RawByteString; @@ -1054,10 +1102,11 @@ function THTTPServerClient.GetResponseContentType: RawByteString; Result := HTTPContentTypeValueToStr(FResponse.Header.CommonHeaders.ContentType); end; -procedure THTTPServerClient.SetResponseContentType(const ResponseContentType: RawByteString); +procedure THTTPServerClient.SetResponseContentType( + const AResponseContentType: RawByteString); begin FResponse.Header.CommonHeaders.ContentType.Value := hctCustomString; - FResponse.Header.CommonHeaders.ContentType.CustomStr := ResponseContentType; + FResponse.Header.CommonHeaders.ContentType.CustomStr := AResponseContentType; end; function THTTPServerClient.GetResponseRecordPtr: PHTTPResponse; @@ -1070,9 +1119,9 @@ function THTTPServerClient.GetRequestContentStream: TStream; Result := FRequestContentReader.ContentStream; end; -procedure THTTPServerClient.SetRequestContentStream(const RequestContentStream: TStream); +procedure THTTPServerClient.SetRequestContentStream(const ARequestContentStream: TStream); begin - FRequestContentReader.ContentStream := RequestContentStream; + FRequestContentReader.ContentStream := ARequestContentStream; end; function THTTPServerClient.GetRequestContentFileName: String; @@ -1080,9 +1129,9 @@ function THTTPServerClient.GetRequestContentFileName: String; Result := FRequestContentReader.ContentFileName; end; -procedure THTTPServerClient.SetRequestContentFileName(const RequestContentFileName: String); +procedure THTTPServerClient.SetRequestContentFileName(const ARequestContentFileName: String); begin - FRequestContentReader.ContentFileName := RequestContentFileName; + FRequestContentReader.ContentFileName := ARequestContentFileName; end; function THTTPServerClient.GetRequestContentStr: RawByteString; @@ -1100,9 +1149,10 @@ function THTTPServerClient.GetResponseContentMechanism: THTTPContentWriterMechan Result := FResponseContentWriter.Mechanism; end; -procedure THTTPServerClient.SetResponseContentMechanism(const ResponseContentMechanism: THTTPContentWriterMechanism); +procedure THTTPServerClient.SetResponseContentMechanism( + const AResponseContentMechanism: THTTPContentWriterMechanism); begin - FResponseContentWriter.Mechanism := ResponseContentMechanism; + FResponseContentWriter.Mechanism := AResponseContentMechanism; end; function THTTPServerClient.GetResponseContentStr: RawByteString; @@ -1110,10 +1160,10 @@ function THTTPServerClient.GetResponseContentStr: RawByteString; Result := FResponseContentWriter.ContentString; end; -procedure THTTPServerClient.SetResponseContentStr(const ResponseContentStr: RawByteString); +procedure THTTPServerClient.SetResponseContentStr(const AResponseContentStr: RawByteString); begin FResponseContentWriter.Mechanism := hctmString; - FResponseContentWriter.ContentString := ResponseContentStr; + FResponseContentWriter.ContentString := AResponseContentStr; end; function THTTPServerClient.GetResponseContentStream: TStream; @@ -1121,10 +1171,10 @@ function THTTPServerClient.GetResponseContentStream: TStream; Result := FResponseContentWriter.ContentStream; end; -procedure THTTPServerClient.SetResponseContentStream(const ResponseContentStream: TStream); +procedure THTTPServerClient.SetResponseContentStream(const AResponseContentStream: TStream); begin FResponseContentWriter.Mechanism := hctmStream; - FResponseContentWriter.ContentStream := ResponseContentStream; + FResponseContentWriter.ContentStream := AResponseContentStream; end; function THTTPServerClient.GetResponseContentFileName: String; @@ -1132,45 +1182,48 @@ function THTTPServerClient.GetResponseContentFileName: String; Result := FResponseContentWriter.ContentFileName; end; -procedure THTTPServerClient.SetResponseContentFileName(const ResponseContentFileName: String); +procedure THTTPServerClient.SetResponseContentFileName(const AResponseContentFileName: String); begin FResponseContentWriter.Mechanism := hctmFile; - FResponseContentWriter.ContentFileName := ResponseContentFileName; + FResponseContentWriter.ContentFileName := AResponseContentFileName; end; -procedure THTTPServerClient.SetResponseReady(const ResponseReady: Boolean); +procedure THTTPServerClient.SetResponseReady(const AResponseReady: Boolean); begin - if not ResponseReady then + if not AResponseReady then exit; Assert(FState in [hscsInit, hscsAwaitingRequest, hscsReceivedRequestHeader, hscsReceivingContent, hscsRequestComplete, hscsPreparingResponse, hscsAwaitingPreparedResponse]); - FResponseReady := ResponseReady; + + FResponseReady := AResponseReady; if FState = hscsAwaitingPreparedResponse then ResponsePrepared; end; -procedure THTTPServerClient.SetResponseOKHtmlStr(const HtmlStr: RawByteString); +procedure THTTPServerClient.SetResponseOKHtmlStr(const AHtmlStr: RawByteString); var ContentType : THTTPContentTypeEnum; begin ResponseCode := HTTP_ResponseCode_OK; - if Length(HtmlStr) > 0 then + if Length(AHtmlStr) > 0 then ContentType := hctTextHtml else ContentType := hctNone; ResponseRecordPtr^.Header.CommonHeaders.ContentType.Value := ContentType; + ResponseContentMechanism := hctmString; - ResponseContentStr := HtmlStr; + ResponseContentStr := AHtmlStr; ResponseReady := True; end; -procedure THTTPServerClient.SetResponseOKFile(const ContentType: THTTPContentTypeEnum; - const FileName: String); +procedure THTTPServerClient.SetResponseOKFile( + const AContentType: THTTPContentTypeEnum; + const AFileName: String); begin ResponseCode := HTTP_ResponseCode_OK; - ResponseRecordPtr^.Header.CommonHeaders.ContentType.Value := ContentType; + ResponseRecordPtr^.Header.CommonHeaders.ContentType.Value := AContentType; ResponseContentMechanism := hctmFile; - ResponseContentFileName := FileName; + ResponseContentFileName := AFileName; ResponseReady := True; end; @@ -1181,10 +1234,10 @@ procedure THTTPServerClient.SetResponseNotFound; ResponseReady := True; end; -procedure THTTPServerClient.SetResponseRedirect(const Location: RawByteString); +procedure THTTPServerClient.SetResponseRedirect(const ALocation: RawByteString); begin ResponseCode := HTTP_ResponseCode_SeeOther; - ResponseRecordPtr^.Header.FixedHeaders[hntLocation] := Location; + ResponseRecordPtr^.Header.FixedHeaders[hntLocation] := ALocation; ResponseReady := True; end; @@ -1214,9 +1267,7 @@ procedure TF5HTTPServer.Init; procedure TF5HTTPServer.InitTCPServer; begin - Assert(not Assigned(FTCPServer)); FTCPServer := TF5TCPServer.Create(nil); - FTCPServer.OnLog := TCPServerLog; FTCPServer.OnStateChanged := TCPServerStateChanged; FTCPServer.OnClientAccept := TCPServerClientAccept; @@ -1233,9 +1284,9 @@ procedure TF5HTTPServer.InitDefaults; begin FAddressFamily := safIP4; FBindAddressStr := '0.0.0.0'; - FServerPort := HTTPSERVER_PORT; - FMaxBacklog := HTTP_SERVER_DEFAULT_MaxBacklog; - FMaxClients := HTTP_SERVER_DEFAULT_MaxClients; + FServerPort := HTTPSERVER_DefaultPort; + FMaxBacklog := HTTPSERVER_DefaultMaxBacklog; + FMaxClients := HTTPSERVER_DefaultMaxClients; {$IFDEF HTTP_TLS} FHTTPSEnabled := False; {$ENDIF} @@ -1245,15 +1296,18 @@ procedure TF5HTTPServer.InitDefaults; destructor TF5HTTPServer.Destroy; begin - if Assigned(FTCPServer) then - begin - FTCPServer.Finalise; - FreeAndNil(FTCPServer); - end; + FreeAndNil(FTCPServer); FreeAndNil(FLock); inherited Destroy; end; +procedure TF5HTTPServer.Finalise; +begin + FUserObject := nil; + if Assigned(FTCPServer) then + FTCPServer.Finalise; +end; + procedure TF5HTTPServer.Loaded; begin inherited Loaded; @@ -1261,27 +1315,32 @@ procedure TF5HTTPServer.Loaded; DoStart; end; -procedure TF5HTTPServer.Log(const LogType: THTTPServerLogType; const Msg: String; const LogLevel: Integer); +procedure TF5HTTPServer.Log( + const LogType: THTTPServerLogType; + const Msg: String; + const LogLevel: Integer); begin if Assigned(FOnLog) then FOnLog(self, LogType, Msg, LogLevel); end; -procedure TF5HTTPServer.Log(const LogType: THTTPServerLogType; const Msg: String; const Args: array of const; const LogLevel: Integer); +procedure TF5HTTPServer.Log( + const LogType: THTTPServerLogType; + const Msg: String; + const Args: array of const; + const LogLevel: Integer); begin Log(LogType, Format(Msg, Args), LogLevel); end; procedure TF5HTTPServer.Lock; begin - if Assigned(FLock) then - FLock.Acquire; + FLock.Acquire; end; procedure TF5HTTPServer.Unlock; begin - if Assigned(FLock) then - FLock.Release; + FLock.Release; end; procedure TF5HTTPServer.CheckNotActive; @@ -1311,8 +1370,10 @@ procedure TF5HTTPServer.SetServerPort(const ServerPort: Integer); begin if ServerPort = FServerPort then exit; + CheckNotActive; FServerPort := ServerPort; + {$IFDEF HTTP_DEBUG} Log(sltDebug, 'ServerPort:%d', [ServerPort]); {$ENDIF} @@ -1332,8 +1393,10 @@ procedure TF5HTTPServer.SetServerName(const ServerName: RawByteString); begin if ServerName = FServerName then exit; + CheckNotActive; FServerName := ServerName; + {$IFDEF HTTP_DEBUG} Log(sltDebug, 'ServerName:%s', [ServerName]); {$ENDIF} @@ -1344,8 +1407,10 @@ procedure TF5HTTPServer.SetHTTPSEnabled(const HTTPSEnabled: Boolean); begin if HTTPSEnabled = FHTTPSEnabled then exit; + CheckNotActive; FHTTPSEnabled := HTTPSEnabled; + {$IFDEF HTTP_DEBUG} Log(sltDebug, 'HTTPSEnabled:%d', [Ord(HTTPSEnabled)]); {$ENDIF} @@ -1355,15 +1420,18 @@ procedure TF5HTTPServer.SetHTTPSOptions(const HTTPSOptions: THTTPSServerOptions) begin if HTTPSOptions = FHTTPSOptions then exit; + CheckNotActive; FHTTPSOptions := HTTPSOptions; end; {$ENDIF} -procedure TF5HTTPServer.SetRequestContentMechanism(const RequestContentMechanism: THTTPContentReaderMechanism); +procedure TF5HTTPServer.SetRequestContentMechanism( + const RequestContentMechanism: THTTPContentReaderMechanism); begin if RequestContentMechanism = FRequestContentMechanism then exit; + CheckNotActive; FRequestContentMechanism := RequestContentMechanism; end; @@ -1398,7 +1466,9 @@ procedure TF5HTTPServer.TriggerRequestHeader(const Client: THTTPServerClient); FOnRequestHeader(self, Client); end; -procedure TF5HTTPServer.TriggerRequestContent(const Client: THTTPServerClient; const Buf; const Size: Integer); +procedure TF5HTTPServer.TriggerRequestContent( + const Client: THTTPServerClient; + const Buf; const Size: Integer); begin if Assigned(FOnRequestContent) then FOnRequestContent(self, Client, Buf, Size); @@ -1422,7 +1492,11 @@ procedure TF5HTTPServer.TriggerResponseComplete(const Client: THTTPServerClient) FOnResponseComplete(self, Client); end; -procedure TF5HTTPServer.TCPServerLog(Sender: TF5TCPServer; LogType: TTCPLogType; Msg: String; LogLevel: Integer); +procedure TF5HTTPServer.TCPServerLog( + Sender: TF5TCPServer; + LogType: TTCPLogType; + Msg: String; + LogLevel: Integer); begin {$IFDEF HTTP_DEBUG} Log(sltDebug, 'TCPServer:%s', [Msg], LogLevel + 1); @@ -1450,6 +1524,7 @@ procedure TF5HTTPServer.TCPServerClientCreate(Sender: TTCPServerClient); {$IFDEF HTTP_DEBUG} Log(sltDebug, 'TCPServer_ClientCreate'); {$ENDIF} + C := THTTPServerClient.Create(self, Sender); Sender.UserObject := C; end; @@ -1460,6 +1535,7 @@ procedure TF5HTTPServer.TCPServerClientAdd(Sender: TTCPServerClient); {$IFDEF HTTP_DEBUG} Log(sltDebug, 'TCPServer_ClientAdd'); {$ENDIF} + Assert(Sender.UserObject is THTTPServerClient); C := THTTPServerClient(Sender.UserObject); C.Start; @@ -1470,6 +1546,7 @@ procedure TF5HTTPServer.TCPServerClientRemove(Sender: TTCPServerClient); {$IFDEF HTTP_DEBUG} Log(sltDebug, 'TCPServer_ClientRemove'); {$ENDIF} + Assert(not Assigned(Sender.UserObject) or (Sender.UserObject is THTTPServerClient)); if Assigned(Sender.UserObject) then begin @@ -1487,6 +1564,7 @@ procedure TF5HTTPServer.TCPServerClientStateChange(Sender: TTCPServerClient); {$IFDEF HTTP_DEBUG} Log(sltDebug, 'TCPServer_ClientStateChange:%s', [Sender.StateStr]); {$ENDIF} + C := Sender.UserObject as THTTPServerClient; C.TCPClientStateChange; end; @@ -1497,6 +1575,8 @@ procedure TF5HTTPServer.TCPServerClientRead(Sender: TTCPServerClient); {$IFDEF HTTP_DEBUG} Log(sltDebug, 'TCPServer_ClientRead'); {$ENDIF} + + Assert(Sender.UserObject is THTTPServerClient); C := Sender.UserObject as THTTPServerClient; C.TCPClientRead; end; @@ -1507,6 +1587,7 @@ procedure TF5HTTPServer.TCPServerClientWrite(Sender: TTCPServerClient); {$IFDEF HTTP_DEBUG} Log(sltDebug, 'TCPServer_ClientWrite'); {$ENDIF} + Assert(Sender.UserObject is THTTPServerClient); C := THTTPServerClient(Sender.UserObject); C.TCPClientWrite; @@ -1518,12 +1599,17 @@ procedure TF5HTTPServer.TCPServerClientClose(Sender: TTCPServerClient); {$IFDEF HTTP_DEBUG} Log(sltDebug, 'TCPServer_ClientClose'); {$ENDIF} + Assert(Sender.UserObject is THTTPServerClient); C := THTTPServerClient(Sender.UserObject); C.TCPClientClose; end; -procedure TF5HTTPServer.ClientLog(const Client: THTTPServerClient; const LogType: THTTPServerLogType; const Msg: String; const LogLevel: Integer); +procedure TF5HTTPServer.ClientLog( + const Client: THTTPServerClient; + const LogType: THTTPServerLogType; + const Msg: String; + const LogLevel: Integer); begin {$IFDEF HTTP_DEBUG} Log(LogType, 'Client:%s', [Msg], LogLevel + 1); @@ -1542,14 +1628,18 @@ procedure TF5HTTPServer.ClientRequestHeader(const Client: THTTPServerClient); {$IFDEF HTTP_DEBUG} Log(sltDebug, 'Client_RequestHeader'); {$ENDIF} + TriggerRequestHeader(Client); end; -procedure TF5HTTPServer.ClientRequestContentBuffer(const Client: THTTPServerClient; const Buf; const Size: Integer); +procedure TF5HTTPServer.ClientRequestContentBuffer( + const Client: THTTPServerClient; + const Buf; const Size: Integer); begin {$IFDEF HTTP_DEBUG} Log(sltDebug, 'Client_RequestContentBuffer'); {$ENDIF} + TriggerRequestContent(Client, Buf, Size); end; @@ -1558,6 +1648,7 @@ procedure TF5HTTPServer.ClientRequestContentComplete(const Client: THTTPServerCl {$IFDEF HTTP_DEBUG} Log(sltDebug, 'Client_RequestContentComplete'); {$ENDIF} + TriggerRequestComplete(Client); end; @@ -1566,6 +1657,7 @@ procedure TF5HTTPServer.ClientPrepareResponse(const Client: THTTPServerClient); {$IFDEF HTTP_DEBUG} Log(sltDebug, 'Client_PrepareResponse'); {$ENDIF} + TriggerPrepareResponse(Client); end; @@ -1574,14 +1666,16 @@ procedure TF5HTTPServer.ClientResponseComplete(const Client: THTTPServerClient); {$IFDEF HTTP_DEBUG} Log(sltDebug, 'Client_ResponseComplete'); {$ENDIF} + TriggerResponseComplete(Client); end; procedure TF5HTTPServer.SetupTCPServer; -var AF : TIPAddressFamily; - {$IFDEF HTTP_TLS} - TLSOpt : TTLSServerOptions; - {$ENDIF} +var + AF : TIPAddressFamily; + {$IFDEF HTTP_TLS} + //TLSOpt : TTLSServerOptions; + {$ENDIF} begin {$IFDEF HTTP_DEBUG} Log(sltDebug, 'SetupTCPServer'); @@ -1598,8 +1692,10 @@ procedure TF5HTTPServer.SetupTCPServer; FTCPServer.AddressFamily := AF; FTCPServer.BindAddress := FBindAddressStr; FTCPServer.ServerPort := FServerPort; + {$IFDEF HTTP_TLS} FTCPServer.TLSEnabled := FHTTPSEnabled; + { TLSOpt := []; if ssoDontUseSSL3 in FHTTPSOptions then Include(TLSOpt, tlssoDontUseSSL3); @@ -1610,42 +1706,66 @@ procedure TF5HTTPServer.SetupTCPServer; if ssoDontUseTLS12 in FHTTPSOptions then Include(TLSOpt, tlssoDontUseTLS12); FTCPServer.TLSServer.Options := TLSOpt; + } + //// {$ENDIF} end; procedure TF5HTTPServer.DoStart; begin - Assert(not FActive); + Lock; + try + if FActive then + exit; + FActive := True; + finally + Unlock; + end; + + Log(sltInfo, 'Active'); + TriggerActive; Log(sltInfo, 'Start'); TriggerStart; + SetupTCPServer; FTCPServer.Start; - - FActive := True; - Log(sltInfo, 'Active'); - TriggerActive; end; procedure TF5HTTPServer.DoStop; begin - Assert(FActive); - Assert(Assigned(FTCPServer)); + Lock; + try + if not FActive or FStopping then + exit; + FStopping := True; + finally + Unlock; + end; + + try + Log(sltInfo, 'Stop'); + TriggerStop; - Log(sltInfo, 'Stop'); - TriggerStop; - FTCPServer.Stop; + Assert(Assigned(FTCPServer)); + FTCPServer.Stop; + finally + Lock; + try + FActive := False; + FStopping := False; + finally + Unlock; + end; + end; - FActive := False; Log(sltInfo, 'Inactive'); TriggerInactive; end; -procedure TF5HTTPServer.SetActive(const Active: Boolean); +procedure TF5HTTPServer.SetActive(const AActive: Boolean); begin - if Active = FActive then - exit; - if Active then + if AActive then DoStart else DoStop; @@ -1658,12 +1778,5 @@ function TF5HTTPServer.GetClientCount: Integer; -{$IFDEF HTTPSERVER_CUSTOM} - {$INCLUDE cHTTPServerImpl.inc} -{$ENDIF} - - - end. - diff --git a/Source/HTTP/flcHTTPTests.pas b/Source/HTTP/flcHTTPTests.pas index 7d64946..54b742c 100644 --- a/Source/HTTP/flcHTTPTests.pas +++ b/Source/HTTP/flcHTTPTests.pas @@ -6,7 +6,7 @@ { } { Supported compilers: } { } -{ Delphi 7 Win32 5.03 2016/01/09 } +{ Delphi 7 Win32 5.03 2019/02/24 } { Delphi XE7 Win32 5.03 2016/01/09 } { Delphi XE7 Win64 5.03 2016/01/09 } { } @@ -52,8 +52,10 @@ implementation SysUtils, SyncObjs, flcUtils, + flcBase64, flcSocketLib {$IFDEF HTTP_TLS}, + flcTLSCertificate, flcTLSHandshake {$ENDIF}; @@ -71,7 +73,7 @@ THTTPServerTestObj = class Lock : TCriticalSection; constructor Create; destructor Destroy; override; - procedure HTTPServerLog(Server: TF5HTTPServer; LogType: THTTPServerLogType; Msg: String; LogLevel: Integer); + procedure HTTPServerLog(const Server: TF5HTTPServer; const LogType: THTTPServerLogType; const Msg: String; const LogLevel: Integer); end; constructor THTTPServerTestObj.Create; @@ -86,7 +88,7 @@ destructor THTTPServerTestObj.Destroy; inherited Destroy; end; -procedure THTTPServerTestObj.HTTPServerLog(Server: TF5HTTPServer; LogType: THTTPServerLogType; Msg: String; LogLevel: Integer); +procedure THTTPServerTestObj.HTTPServerLog(const Server: TF5HTTPServer; const LogType: THTTPServerLogType; const Msg: String; const LogLevel: Integer); begin {$IFDEF HTTP_TEST_LOG_TO_CONSOLE} Lock.Acquire; @@ -252,9 +254,9 @@ THTTPClientServerTestObj = class procedure HTTPClientLog(Client: TF5HTTPClient; LogType: THTTPClientLogType; Msg: String; Level: Integer); procedure HTTPClientResponseHeader(Client: TF5HTTPClient); procedure HTTPClientResponseComplete(Client: TF5HTTPClient); - procedure HTTPServerLog(Server: TF5HTTPServer; LogType: THTTPServerLogType; Msg: String; LogLevel: Integer); - procedure HTTPServerPrepareResponse(Server: TF5HTTPServer; Client: THTTPServerClient); - procedure HTTPServerRequestComplete(Server: TF5HTTPServer; Client: THTTPServerClient); + procedure HTTPServerLog(const Server: TF5HTTPServer; const LogType: THTTPServerLogType; const Msg: String; const LogLevel: Integer); + procedure HTTPServerPrepareResponse(const Server: TF5HTTPServer; const Client: THTTPServerClient); + procedure HTTPServerRequestComplete(const Server: TF5HTTPServer; const Client: THTTPServerClient); end; constructor THTTPClientServerTestObj.Create; @@ -297,12 +299,12 @@ procedure THTTPClientServerTestObj.HTTPClientResponseComplete(Client: TF5HTTPCli Assert(Client.ResponseContentStr = 'Test'); end; -procedure THTTPClientServerTestObj.HTTPServerLog(Server: TF5HTTPServer; LogType: THTTPServerLogType; Msg: String; LogLevel: Integer); +procedure THTTPClientServerTestObj.HTTPServerLog(const Server: TF5HTTPServer; const LogType: THTTPServerLogType; const Msg: String; const LogLevel: Integer); begin Log('S:' + IntToStr(LogLevel) + ':' + Msg); end; -procedure THTTPClientServerTestObj.HTTPServerPrepareResponse(Server: TF5HTTPServer; Client: THTTPServerClient); +procedure THTTPClientServerTestObj.HTTPServerPrepareResponse(const Server: TF5HTTPServer; const Client: THTTPServerClient); begin Client.ResponseCode := 200; Client.ResponseMsg := 'OK'; @@ -312,7 +314,7 @@ procedure THTTPClientServerTestObj.HTTPServerPrepareResponse(Server: TF5HTTPServ Client.ResponseReady := True; end; -procedure THTTPClientServerTestObj.HTTPServerRequestComplete(Server: TF5HTTPServer; Client: THTTPServerClient); +procedure THTTPClientServerTestObj.HTTPServerRequestComplete(const Server: TF5HTTPServer; const Client: THTTPServerClient); begin end; @@ -392,12 +394,14 @@ procedure Test_ClientServer_Simple(const HTTPS: Boolean); T := 0; repeat Sleep(1); + Inc(T); until (T > 2000) or (Srv.ClientCount = 1); Assert(Srv.ClientCount = 1); T := 0; repeat Sleep(1); + Inc(T); until (T > 2000) or (Cln.State in [hcsResponseComplete, hcsResponseCompleteAndClosed]); Assert(Cln.State in [hcsResponseComplete, hcsResponseCompleteAndClosed]); @@ -407,6 +411,7 @@ procedure Test_ClientServer_Simple(const HTTPS: Boolean); T := 0; repeat Sleep(1); + Inc(T); until (T > 2000) or (Srv.ClientCount = 0); Assert(Srv.ClientCount = 0); diff --git a/Source/HTTP/flcHTTPUtils.pas b/Source/HTTP/flcHTTPUtils.pas index 4a1b4fa..ba3970c 100644 --- a/Source/HTTP/flcHTTPUtils.pas +++ b/Source/HTTP/flcHTTPUtils.pas @@ -5,7 +5,7 @@ { File version: 5.12 } { Description: HTTP utilities. } { } -{ Copyright: Copyright (c) 2011-2019, David J Butler } +{ Copyright: Copyright (c) 2011-2020, David J Butler } { All rights reserved. } { This file is licensed under the BSD License. } { See http://www.opensource.org/licenses/bsd-license.php } @@ -50,6 +50,7 @@ { 2019/07/29 5.12 SendContent fix. } { } { References: } +{ } { * HTTP/1.1 : http://www.w3.org/Protocols/rfc2616/rfc2616.html } { * Chunked encoding : http://tools.ietf.org/html/rfc2616#section-3.6.1 } { * Origin header : https://wiki.mozilla.org/Security/Origin } @@ -66,10 +67,12 @@ interface uses { System } + SysUtils, Classes, { Fundamentals } + flcStdTypes, flcUtils, flcStrings, @@ -1042,7 +1045,8 @@ THTTPContentReader = class hctmEvent, hctmString, hctmStream, - hctmFile); + hctmFile + ); THTTPContentWriter = class; @@ -1098,7 +1102,7 @@ THTTPContentWriter = class { } -{ Test cases } +{ Tests } { } {$IFDEF HTTP_TEST} procedure Test; @@ -4073,7 +4077,7 @@ procedure THTTPContentWriter.Clear; { } -{ Test cases } +{ Tests } { } {$IFDEF HTTP_TEST} {$ASSERTIONS ON}