forked from IndySockets/Indy
/
IdOpenSSLIOHandlerClient.pas
209 lines (182 loc) · 6.42 KB
/
IdOpenSSLIOHandlerClient.pas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
{******************************************************************************}
{ }
{ Indy (Internet Direct) - Internet Protocols Simplified }
{ }
{ https://www.indyproject.org/ }
{ https://gitter.im/IndySockets/Indy }
{ }
{******************************************************************************}
{ }
{ This file is part of the Indy (Internet Direct) project, and is offered }
{ under the dual-licensing agreement described on the Indy website. }
{ (https://www.indyproject.org/license/) }
{ }
{ Copyright: }
{ (c) 1993-2020, Chad Z. Hower and the Indy Pit Crew. All rights reserved. }
{ }
{******************************************************************************}
{ }
{ Originally written by: Fabian S. Biehn }
{ fbiehn@aagon.com (German & English) }
{ }
{ Contributers: }
{ Here could be your name }
{ }
{******************************************************************************}
unit IdOpenSSLIOHandlerClient;
interface
{$i IdCompilerDefines.inc}
uses
IdGlobal,
IdOpenSSLContext,
IdOpenSSLIOHandlerClientBase,
IdOpenSSLOptions,
IdOpenSSLOptionsClient,
IdOpenSSLSocketClient,
IdSSL;
type
TIdOpenSSLIOHandlerClient = class(TIdOpenSSLIOHandlerClientBase)
private
FOpenSSLLoaded: Boolean;
function GetTargetHost: string;
function GetClientSocket: TIdOpenSSLSocketClient; {$IFDEF USE_INLINE}inline;{$ENDIF}
procedure EnsureOpenSSLLoaded;
function GetOptions: TIdOpenSSLOptionsClient;
protected
function GetOptionClass: TIdOpenSSLOptionsClass; override;
procedure EnsureContext; override;
procedure BeforeInitContext(const AContext: TIdOpenSSLContext); virtual;
procedure AfterInitContext(const AContext: TIdOpenSSLContext); virtual;
public
destructor Destroy; override;
procedure StartSSL; override;
function Clone: TIdSSLIOHandlerSocketBase; override;
published
property Options: TIdOpenSSLOptionsClient read GetOptions;
end;
implementation
uses
Classes,
IdCustomTransparentProxy,
IdOpenSSLContextClient,
IdOpenSSLExceptions,
IdOpenSSLHeaders_ssl,
IdOpenSSLLoader,
IdURI,
SysUtils;
type
TIdOpenSSLContextClientAccessor = class(TIdOpenSSLContextClient);
{ TIdOpenSSLIOHandlerClient }
procedure TIdOpenSSLIOHandlerClient.EnsureContext;
begin
if not Assigned(FContext) then
FContext := TIdOpenSSLContextClient.Create();
EnsureOpenSSLLoaded();
try
BeforeInitContext(FContext);
TIdOpenSSLContextClient(FContext).Init(Options);
AfterInitContext(FContext);
except
on E: EExternalException do
begin
try
FreeAndNil(FContext);
except
on E: EExternalException do ; // Nothing
end;
raise EIdOpenSSLLoadError.Create('Failed to load OpenSSL');
end;
end;
end;
procedure TIdOpenSSLIOHandlerClient.EnsureOpenSSLLoaded;
var
LLoader: IOpenSSLLoader;
begin
if not FOpenSSLLoaded then
begin
LLoader := GetOpenSSLLoader();
if Assigned(LLoader) and not LLoader.Load() then
raise EIdOpenSSLLoadError.Create('Failed to load OpenSSL');
FOpenSSLLoaded := True;
end;
end;
procedure TIdOpenSSLIOHandlerClient.AfterInitContext(
const AContext: TIdOpenSSLContext);
begin
end;
procedure TIdOpenSSLIOHandlerClient.BeforeInitContext(
const AContext: TIdOpenSSLContext);
begin
end;
function TIdOpenSSLIOHandlerClient.Clone: TIdSSLIOHandlerSocketBase;
var
LSessionCopies: TList;
i: Integer;
begin
Result := inherited Clone();
TIdOpenSSLIOHandlerClient(Result).EnsureContext();
LSessionCopies := TIdOpenSSLContextClientAccessor(TIdOpenSSLIOHandlerClient(Result).FContext).FSessionList;
LSessionCopies.Assign(TIdOpenSSLContextClientAccessor(TIdOpenSSLIOHandlerClient(Self).FContext).FSessionList);
for i := 0 to LSessionCopies.Count-1 do
SSL_SESSION_up_ref(LSessionCopies[i]);
end;
destructor TIdOpenSSLIOHandlerClient.Destroy;
begin
inherited;
// Destroy tls socket before context
FContext.Free();
end;
function TIdOpenSSLIOHandlerClient.GetClientSocket: TIdOpenSSLSocketClient;
begin
Result := FTLSSocket as TIdOpenSSLSocketClient;
end;
function TIdOpenSSLIOHandlerClient.GetOptionClass: TIdOpenSSLOptionsClass;
begin
Result := TIdOpenSSLOptionsClient;
end;
function TIdOpenSSLIOHandlerClient.GetOptions: TIdOpenSSLOptionsClient;
begin
Result := TIdOpenSSLOptionsClient(FOptions);
end;
function TIdOpenSSLIOHandlerClient.GetTargetHost: string;
function GetHostToCheck(const AUriToCheck: string): string;
var
LURI: TIdURI;
begin
Result := '';
if AUriToCheck = '' then
Exit;
LURI := TIdURI.Create(AURIToCheck);
try
Result := LURI.Host;
finally
LURI.Free();
end;
end;
function GetProxyTargetHost(const ATransparentProxy: TIdCustomTransparentProxy): string;
var
LProxy: TIdCustomTransparentProxy;
begin
Result := '';
LProxy := ATransparentProxy;
while Assigned(LProxy) and LProxy.Enabled do
begin
Result := LProxy.Host;
LProxy := LProxy.ChainedProxy;
end;
end;
begin
Result := GetHostToCheck(URIToCheck);
if Result = '' then
// RLebeau: not reading from the property as it will create a
// default Proxy object if one is not already assigned...
Result := GetProxyTargetHost(FTransparentProxy);
end;
procedure TIdOpenSSLIOHandlerClient.StartSSL;
begin
inherited;
if PassThrough then
Exit;
GetClientSocket().Connect(Binding.Handle, GetTargetHost(), Options.VerifyHostName);
end;
end.