Browse Source

fphttpclient allow to override supported protocols from url

Andrew Haines 2 years ago
parent
commit
bc17da25e1
1 changed files with 8 additions and 2 deletions
  1. 8 2
      packages/fcl-web/src/base/fphttpclient.pp

+ 8 - 2
packages/fcl-web/src/base/fphttpclient.pp

@@ -141,6 +141,8 @@ Type
     Function ParseStatusLine(AStatusLine : String) : Integer;
     Function ParseStatusLine(AStatusLine : String) : Integer;
     // Construct server URL for use in request line.
     // Construct server URL for use in request line.
     function GetServerURL(URI: TURI): String;
     function GetServerURL(URI: TURI): String;
+    // Verify protocol is supported
+    function ProtocolSupported(Protocol: String; out IsSSL: Boolean): Boolean; virtual;
     // Read raw data from socket
     // Read raw data from socket
     Function ReadFromSocket(var Buffer; Count: Longint): Longint; virtual;
     Function ReadFromSocket(var Buffer; Count: Longint): Longint; virtual;
     // Write raw data to socket
     // Write raw data to socket
@@ -719,6 +721,11 @@ procedure TFPCustomHTTPClient.DisconnectFromServer;
 begin
 begin
   FreeAndNil(FSocket);
   FreeAndNil(FSocket);
 end;
 end;
+function TFPCustomHTTPClient.ProtocolSupported(Protocol: String; out IsSSL: Boolean): Boolean;
+begin
+  Result := (Protocol='http') or (Protocol='https');
+  IsSSL := (Protocol = 'https');
+end;
 
 
 function TFPCustomHTTPClient.ReadFromSocket(var Buffer; Count: Longint): Longint;
 function TFPCustomHTTPClient.ReadFromSocket(var Buffer; Count: Longint): Longint;
 begin
 begin
@@ -1461,9 +1468,8 @@ begin
   ResetResponse;
   ResetResponse;
   URI:=ParseURI(AURL,False);
   URI:=ParseURI(AURL,False);
   p:=LowerCase(URI.Protocol);
   p:=LowerCase(URI.Protocol);
-  If Not ((P='http') or (P='https')) then
+  If Not ProtocolSupported(p, IsHttps) then
    Raise EHTTPClient.CreateFmt(SErrInvalidProtocol,[URI.Protocol]);
    Raise EHTTPClient.CreateFmt(SErrInvalidProtocol,[URI.Protocol]);
-  IsHttps:=P='https';
   HeadersOnly:=CompareText(AMethod,'HEAD')=0;
   HeadersOnly:=CompareText(AMethod,'HEAD')=0;
   if FKeepConnection then
   if FKeepConnection then
     DoKeepConnectionRequest(URI,AMethod,Stream,AllowedResponseCodes,HeadersOnly,IsHttps)
     DoKeepConnectionRequest(URI,AMethod,Stream,AllowedResponseCodes,HeadersOnly,IsHttps)