Proxy support

IndySockets/Indy#49 (comment)
tothpaul · Nov 1, 2018 · d110e80 · d110e80
1 parent 2065b2b
commit d110e80
Show file tree

Hide file tree

Showing 3 changed files with 334 additions and 20 deletions.
diff --git a/Indy.SChannel/lib/Execute.IdSSLSChannel.pas b/Indy.SChannel/lib/Execute.IdSSLSChannel.pas
@@ -2,6 +2,7 @@
 {
   TLS SChannel for Indy (c)2018 Execute SARL
 
+	2018.11.01 - added Proxy support
 }
 interface
 {-$DEFINE LOG}
@@ -12,14 +13,28 @@ interface
   System.SysUtils,
   IdGlobal,
   IdSSL,
+  IdURI,
+  IdCustomTransparentProxy,
   Execute.SChannel;
 
 type
+  SChannelError = class(Exception)
+    CertStatus: Cardinal;
+    constructor Create(AMsg: string; AStatus: Cardinal);
+  end;
+
+  TCredentialsEvent = procedure(Sender: TObject) of object;
+
   TIdSSLIOHandlerSocketSChannel = class(TIdSSLIOHandlerSocketBase)
   private
     FSSL: THandle;
+    FOnCredentials: TCredentialsEvent;
+    procedure SetCredentials(Value: TCredentialsEvent);
+    procedure ConnectSSL;
     procedure CloseSSL;
+    function GetTargetHost: string;
   protected
+    procedure SetPassThrough(const Value: Boolean); override;
     function RecvEnc(var ABuffer: TIdBytes): Integer; override;
     function SendEnc(const ABuffer: TIdBytes; const AOffset, ALength: Integer): Integer; override;
     procedure ConnectClient; override;
@@ -29,6 +44,7 @@   TIdSSLIOHandlerSocketSChannel = class(TIdSSLIOHandlerSocketBase)
     procedure Close; override;
     function Connected: Boolean; override;
     function Readable(AMSec: Integer = IdTimeoutDefault): Boolean; override;
+    property OnCredentials: TCredentialsEvent read FOnCredentials write SetCredentials;
   end;
 
 implementation
@@ -72,6 +88,9 @@ function TIdSSLIOHandlerSocketSChannel.Connected: Boolean;
 {
   I'm not sure is this is correct, but when Indy check for KeepAlive connexion, it tries to read data and this can lead to a session timeout
 }
+  if Passthrough then
+    Result := inherited Connected
+  else
   Result := FSSL <> 0;
  {$IFDEF LOG}System.WriteLn('TIdSSLIOHandlerSocketSChannel.Connected = ', Result);{$ENDIF}
 end;
@@ -82,7 +101,7 @@ function TIdSSLIOHandlerSocketSChannel.Readable(AMSec: Integer): Boolean;
   Not sure of this code either
 }
  {$IFDEF LOG}System.WriteLn('TIdSSLIOHandlerSocketSChannel.Readable(', AMSec, ')');{$ENDIF}
-  if FSSL <> 0 then
+  if (FSSL <> 0) and (PassThrough = False) then
     Result := True
   else
     Result := inherited Readable(AMSec);
@@ -121,14 +140,107 @@ function TIdSSLIOHandlerSocketSChannel.SendEnc(const ABuffer: TIdBytes;
 {$IFDEF LOG}System.WriteLn('TIdSSLIOHandlerSocketSChannel.SendEnc(', Length(ABuffer) ,') = ', Result);{$ENDIF}
 end;
 
+procedure DoCredentials(SSL: Integer; UserData: Pointer);
+begin
+  with TIdSSLIOHandlerSocketSChannel(UserData) do
+  begin
+    if Assigned(FOnCredentials) then
+      FOnCredentials(TIdSSLIOHandlerSocketSChannel(UserData));
+  end;
+end;
+
+procedure TIdSSLIOHandlerSocketSChannel.SetCredentials(
+  Value: TCredentialsEvent);
+begin
+  FOnCredentials := Value;
+  if FSSL <> 0 then
+  begin
+    if Assigned(FOnCredentials) then
+      SSLCredentialsCallBack(FSSL, DoCredentials, Self)
+    else
+      SSLCredentialsCallBack(FSSL, nil, nil);
+  end;
+end;
+
+procedure TIdSSLIOHandlerSocketSChannel.SetPassThrough(const Value: Boolean);
+begin
+{$IFDEF LOG}System.WriteLn('TIdSSLIOHandlerSocketSChannel.SetPassThrough (', Value,')');{$ENDIF}
+  if fPassThrough <> Value then begin
+    if not Value then begin
+      if BindingAllocated then begin
+        ConnectSSL;
+      end;
+    end;
+    fPassThrough := Value;
+  end;
+end;
+
 procedure TIdSSLIOHandlerSocketSChannel.StartSSL;
 begin
-{$IFDEF LOG}System.WriteLn('TIdSSLIOHandlerSocketSChannel.StartSSL');{$ENDIF}
-  FSSL := SSLStart(Binding.Handle, AnsiString(Host));
+  if not PassThrough then
+    ConnectSSL;
+end;
+
+procedure TIdSSLIOHandlerSocketSChannel.ConnectSSL;
+var
+  aHost: AnsiString;
+begin
+  aHost := AnsiString(GetTargetHost);
+{$IFDEF LOG}System.WriteLn('TIdSSLIOHandlerSocketSChannel.ConnectSSL (', aHost,')');{$ENDIF}
+  FSSL := SSLStart(Binding.Handle, aHost);
   if FSSL = 0 then
-    raise Exception.Create('SChannel initialization fails'#13 + SSLError);
+    raise SChannelError.Create('SChannel initialization fails'#13 + SSLError, CertStatus);
+  if Assigned(FOnCredentials) then
+    SSLCredentialsCallBack(FSSL, DoCredentials, Self);
+end;
+
+function TIdSSLIOHandlerSocketSChannel.GetTargetHost: string;
+var
+  LURI: TIdURI;
+  LTransparentProxy, LNextTransparentProxy: TIdCustomTransparentProxy;
+begin
+  Result := '';
+
+  if URIToCheck <> '' then
+  begin
+    LURI := TIdURI.Create(URIToCheck);
+    try
+      Result := LURI.Host;
+    finally
+      LURI.Free;
+    end;
+    if Result <> '' then
+      Exit;
+  end;
+
+  LTransparentProxy := FTransparentProxy;
+  if Assigned(LTransparentProxy) then
+  begin
+    if LTransparentProxy.Enabled then
+    begin
+      repeat
+        LNextTransparentProxy := LTransparentProxy.ChainedProxy;
+        if not Assigned(LNextTransparentProxy) then Break;
+        if not LNextTransparentProxy.Enabled then Break;
+        LTransparentProxy := LNextTransparentProxy;
+      until False;
+      Result := LTransparentProxy.Host;
+      if Result <> '' then
+        Exit;
+    end;
+  end;
+
+  Result := Host;
+end;
+
+{ SChannelError }
+
+constructor SChannelError.Create(AMsg: string; AStatus: Cardinal);
+begin
+  CertStatus := AStatus;
+  inherited create(AMsg);
 end;
 
 initialization
 {$IFDEF LOG}AllocConsole;{$ENDIF}
-end.
+end.