* Added Proxy support: bug ID #26270

git-svn-id: trunk@33742 -

packages/fcl-web/examples/httpclient/httpget.pas

@@ -92,6 +92,10 @@ begin
       OnPassword:=@DoPassword;
       OnDataReceived:=@DoProgress;
       OnHeaders:=@DoHeaders;
+      { Set this if you want to try a proxy.
+      Proxy.Host:='195.207.46.20';
+      Proxy.Port:=8080;
+      }
       Get(ParamStr(1),ParamStr(2));
     finally
       Free;

packages/fcl-web/src/base/fphttpclient.pp

@@ -42,6 +42,28 @@ Type
   // Use this to set up a socket handler. UseSSL is true if protocol was https
   TGetSocketHandlerEvent = Procedure (Sender : TObject; Const UseSSL : Boolean; Out AHandler : TSocketHandler) of object;
 
+  TFPCustomHTTPClient = Class;
+
+  { TProxyData }
+
+  TProxyData = Class (TPersistent)
+  private
+    FHost: string;
+    FPassword: String;
+    FPort: Word;
+    FUserName: String;
+    FHTTPClient : TFPCustomHTTPClient;
+  Protected
+    Function GetProxyHeaders : String; virtual;
+    Property HTTPClient : TFPCustomHTTPClient Read FHTTPClient;
+  Public
+    Procedure Assign(Source: TPersistent); override;
+    Property Host: string Read FHost Write FHost;
+    Property Port: Word Read FPort Write FPort;
+    Property UserName : String Read FUserName Write FUserName;
+    Property Password : String Read FPassword Write FPassword;
+  end;
+
   { TFPCustomHTTPClient }
   TFPCustomHTTPClient = Class(TComponent)
   private
@@ -68,14 +90,21 @@ Type
     FBuffer : Ansistring;
     FUserName: String;
     FOnGetSocketHandler : TGetSocketHandlerEvent;
+    FProxy : TProxyData;
     function CheckContentLength: Int64;
     function CheckTransferEncoding: string;
     function GetCookies: TStrings;
+    function GetProxy: TProxyData;
     Procedure ResetResponse;
     Procedure SetCookies(const AValue: TStrings);
+    procedure SetProxy(AValue: TProxyData);
     Procedure SetRequestHeaders(const AValue: TStrings);
     procedure SetIOTimeout(AValue: Integer);
   protected
+    // True if we need to use a proxy: ProxyData Assigned and Hostname Set
+    Function ProxyActive : Boolean;
+    // Override this if you want to create a custom instance of proxy.
+    Function CreateProxyData : TProxyData;
     // Called whenever data is read.
     Procedure DoDataRead; virtual;
     // Parse response status line. Saves status text and protocol, returns numerical code. Exception if invalid line.
@@ -241,6 +270,8 @@ Type
     // Called On redirect. Dest URL can be edited.
     // If The DEST url is empty on return, the method is aborted (with redirect status).
     Property OnRedirect : TRedirectEvent Read FOnRedirect Write FOnRedirect;
+    // Proxy support
+    Property Proxy : TProxyData Read GetProxy Write SetProxy;
     // Authentication.
     // When set, they override the credentials found in the URI.
     // They also override any Authenticate: header in Requestheaders.
@@ -255,11 +286,12 @@ Type
     Property OnHeaders : TNotifyEvent Read FOnHeaders Write FOnHeaders;
     // Called to create socket handler. If not set, or Nil is returned, a standard socket handler is created.
     Property OnGetSocketHandler : TGetSocketHandlerEvent Read FOnGetSocketHandler Write FOnGetSocketHandler;
+
   end;
 
 
   TFPHTTPClient = Class(TFPCustomHTTPClient)
-  Public
+  Published
     Property IOTimeout;
     Property RequestHeaders;
     Property RequestBody;
@@ -278,6 +310,7 @@ Type
     Property OnDataReceived;
     Property OnHeaders;
     Property OnGetSocketHandler;
+    Property Proxy;
   end;
 
   EHTTPClient = Class(EHTTP);
@@ -381,6 +414,33 @@ begin
   SetLength(Result, P-Pchar(Result));
 end;
 
+{ TProxyData }
+
+function TProxyData.GetProxyHeaders: String;
+begin
+  Result:='';
+  if (UserName<>'') then
+   Result:='Proxy-Authorization: Basic ' + EncodeStringBase64(UserName+':'+UserName);
+end;
+
+procedure TProxyData.Assign(Source: TPersistent);
+
+Var
+  D : TProxyData;
+
+begin
+  if Source is TProxyData then
+    begin
+    D:=Source as TProxyData;
+    Host:=D.Host;
+    Port:=D.Port;
+    UserName:=D.UserName;
+    Password:=D.Password;
+    end
+  else
+    inherited Assign(Source);
+end;
+
 { TFPCustomHTTPClient }
 
 procedure TFPCustomHTTPClient.SetRequestHeaders(const AValue: TStrings);
@@ -397,6 +457,16 @@ begin
     FSocket.IOTimeout:=AValue;
 end;
 
+function TFPCustomHTTPClient.ProxyActive: Boolean;
+begin
+  Result:=Assigned(FProxy) and (FProxy.Host<>'') and (FProxy.Port>0);
+end;
+
+function TFPCustomHTTPClient.CreateProxyData: TProxyData;
+begin
+  Result:=TProxyData.Create;
+end;
+
 procedure TFPCustomHTTPClient.DoDataRead;
 begin
   If Assigned(FOnDataReceived) Then
@@ -437,6 +507,13 @@ begin
   Result:=D+URI.Document;
   if (URI.Params<>'') then
     Result:=Result+'?'+URI.Params;
+  if ProxyActive then
+    begin
+    if URI.Port>0 then
+      Result:=':'+IntToStr(URI.Port)+Result;
+    Result:=URI.Protocol+'://'+URI.Host+Result;
+    end;
+  Writeln('Doing URL : ',Result);
 end;
 
 function TFPCustomHTTPClient.GetSocketHandler(const UseSSL: Boolean): TSocketHandler;
@@ -494,7 +571,7 @@ end;
 procedure TFPCustomHTTPClient.SendRequest(const AMethod: String; URI: TURI);
 
 Var
-  UN,PW,S,L : String;
+  PH,UN,PW,S,L : String;
   I : Integer;
 
 begin
@@ -513,6 +590,12 @@ begin
     If I<>-1 then
       RequestHeaders.Delete(i);
     end;
+  if Assigned(FProxy) and (FProxy.Host<>'') then
+    begin
+    PH:=FProxy.GetProxyHeaders;
+    if (PH<>'') then
+      S:=S+PH+CRLF;
+    end;
   S:=S+'Host: '+URI.Host;
   If (URI.Port<>0) then
     S:=S+':'+IntToStr(URI.Port);
@@ -773,12 +856,28 @@ begin
   Result:=FCookies;
 end;
 
+function TFPCustomHTTPClient.GetProxy: TProxyData;
+begin
+  If not Assigned(FProxy) then
+    begin
+    FProxy:=CreateProxyData;
+    FProxy.FHTTPClient:=Self;
+    end;
+  Result:=FProxy;
+end;
+
 procedure TFPCustomHTTPClient.SetCookies(const AValue: TStrings);
 begin
   if GetCookies=AValue then exit;
   GetCookies.Assign(AValue);
 end;
 
+procedure TFPCustomHTTPClient.SetProxy(AValue: TProxyData);
+begin
+  if (AValue=FProxy) then exit;
+  Proxy.Assign(AValue);
+end;
+
 procedure TFPCustomHTTPClient.ReadResponse(Stream: TStream;
   const AllowedResponseCodes: array of Integer; HeadersOnly: Boolean);
 
@@ -951,7 +1050,8 @@ procedure TFPCustomHTTPClient.DoMethod(const AMethod, AURL: String;
 
 Var
   URI : TURI;
-  P : String;
+  P,CHost : String;
+  CPort : Word;
 
 begin
   ResetResponse;
@@ -959,7 +1059,17 @@ begin
   p:=LowerCase(URI.Protocol);
   If Not ((P='http') or (P='https')) then
    Raise EHTTPClient.CreateFmt(SErrInvalidProtocol,[URI.Protocol]);
-  ConnectToServer(URI.Host,URI.Port,P='https');
+  if ProxyActive then
+    begin
+    CHost:=Proxy.Host;
+    CPort:=Proxy.Port;
+    end
+  else
+    begin
+    CHost:=URI.Host;
+    CPort:=URI.Port;
+    end;
+  ConnectToServer(CHost,CPort,P='https');
   try
     SendRequest(AMethod,URI);
     ReadResponse(Stream,AllowedResponseCodes,CompareText(AMethod,'HEAD')=0);
@@ -981,6 +1091,7 @@ end;
 
 destructor TFPCustomHTTPClient.Destroy;
 begin
+  FreeAndNil(FProxy);
   FreeAndNil(FCookies);
   FreeAndNil(FSentCookies);
   FreeAndNil(FRequestHeaders);