Skip to content

Commit

Permalink
Merge branch 'wip_netrequest'
Browse files Browse the repository at this point in the history
  • Loading branch information
@Fr0sT-Brutal
Fr0sT-Brutal committed Nov 1, 2022
2 parents 198aaca + 59eb2bc commit 416dcdd
Show file tree
Hide file tree
Showing 4 changed files with 298 additions and 163 deletions.
105 changes: 56 additions & 49 deletions Source/OSM.NetworkRequest.RTL.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -37,10 +37,10 @@ interface
htcProxyAuth, htcAuth, htcAuthURL, htcHeaders, htcTimeout, htcTLS];
{$ENDIF}

// Function executing a network request. See description of
// OSM.NetworkRequest.TBlockingNetworkRequestFunc type.@br
function NetworkRequest(RequestProps: THttpRequestProps;
ResponseStm: TStream; out ErrMsg: string): Boolean;
// Procedure executing a network request. See description of
// OSM.NetworkRequest.TBlockingNetworkRequestProc type.
procedure NetworkRequest(RequestProps: THttpRequestProps;
ResponseStm: TStream; var Client: TNetworkClient);

implementation

Expand All @@ -52,8 +52,10 @@ implementation
{$ENDIF}
{$ENDIF}

function NetworkRequest(RequestProps: THttpRequestProps;
ResponseStm: TStream; out ErrMsg: string): Boolean;
// Procedure executing a network request. See description of
// OSM.NetworkRequest.TBlockingNetworkRequestProc type.
procedure NetworkRequest(RequestProps: THttpRequestProps;
ResponseStm: TStream; var Client: TNetworkClient);
var
uri: TURI;
{$IFDEF FPC}
Expand All @@ -66,13 +68,17 @@ function NetworkRequest(RequestProps: THttpRequestProps;
Resp: IHttpResponse;
{$ENDIF}
begin
ErrMsg := ''; Result := False;

try try
{$IFDEF FPC}
httpCli := TFPHTTPClient.Create(nil);
httpCli.ConnectTimeout := ReqTimeout;
httpCli.IOTimeout := ReqTimeout;
{$IFDEF FPC}
if Client = nil then
begin
CheckEngineCaps(RequestProps, EngineCapabilities);
Client := TFPHTTPClient.Create(nil);
httpCli := TFPHTTPClient(Client);
if htcTimeout in EngineCapabilities then
begin
httpCli.ConnectTimeout := ReqTimeout;
httpCli.IOTimeout := ReqTimeout;
end;

// Ensure URL requisites have priority over field requisites
uri := ParseURI(RequestProps.URL);
Expand All @@ -87,9 +93,6 @@ function NetworkRequest(RequestProps: THttpRequestProps;
httpCli.Password := RequestProps.HttpPassword;
end;

if RequestProps.HeaderLines <> nil then
httpCli.RequestHeaders.Assign(RequestProps.HeaderLines);

if RequestProps.Proxy <> '' then
begin
uri := ParseURI(RequestProps.Proxy);
Expand All @@ -99,19 +102,29 @@ function NetworkRequest(RequestProps: THttpRequestProps;
httpCli.Proxy.Password := uri.Password;
end;

httpCli.Get(RequestProps.URL, ResponseStm);
if RequestProps.HeaderLines <> nil then
httpCli.RequestHeaders.Assign(RequestProps.HeaderLines);
end
else
httpCli := TFPHTTPClient(Client);

httpCli.Get(RequestProps.URL, ResponseStm);

// check HTTP error
CheckHTTPError(httpCli.ResponseStatusCode, httpCli.ResponseStatusText);
{$ENDIF}

// check HTTP error
if httpCli.ResponseStatusCode >= 400 then
{$IFDEF DCC}
if Client = nil then
begin
CheckEngineCaps(RequestProps, EngineCapabilities);
Client := TNetHTTPClient.Create(nil);
httpCli := TNetHTTPClient(Client);
if htcTimeout in EngineCapabilities then
begin
ErrMsg := Format(SEMsg_HTTPErr, [httpCli.ResponseStatusCode, httpCli.ResponseStatusText]);
Exit(False);
httpCli.ConnectionTimeout := ReqTimeout;
httpCli.ResponseTimeout := ReqTimeout;
end;
{$ENDIF}
{$IFDEF DCC}
httpCli := TNetHTTPClient.Create(nil);
httpCli.ConnectionTimeout := ReqTimeout;
httpCli.ResponseTimeout := ReqTimeout;

// Ensure URL requisites have priority over field requisites
uri := TURI.Create(RequestProps.URL);
Expand All @@ -121,45 +134,39 @@ function NetworkRequest(RequestProps: THttpRequestProps;
httpCli.CredentialsStorage.AddCredential(TCredentialsStorage.TCredential.Create(
TAuthTargetType.Server, '', '', User, Pass));

if RequestProps.HeaderLines <> nil then
begin
for s in RequestProps.HeaderLines do
begin
HdrArr := SplitString(s, ':');
httpCli.CustomHeaders[HdrArr[0]] := HdrArr[1];
end;
end;

// http://docwiki.embarcadero.com/RADStudio/Sydney/en/Using_an_HTTP_Client#Sending_a_Request_Behind_a_Proxy
// '' means system, bypassing only allowed for Windows: to bypass the system proxy settings, create proxy settings
// for the HTTP Client and specify http://direct as the URL
// So:
// - '' => Direct (Windows only)
// - SYSTEM => ''
if RequestProps.Proxy = '' then
begin
{$IFDEF MSWINDOWS}
CheckEngineCap(htcDirect, EngineCapabilities);
httpCli.ProxySettings := TProxySettings.Create(DirectConnection)
{$ENDIF}
end
else if RequestProps.Proxy <> SystemProxy then
httpCli.ProxySettings := TProxySettings.Create(RequestProps.Proxy);

Resp := httpCli.Get(RequestProps.URL, ResponseStm);

// check HTTP error
if Resp.StatusCode >= 400 then
if RequestProps.HeaderLines <> nil then
begin
ErrMsg := Format(SEMsg_HTTPErr, [Resp.StatusCode, Resp.StatusText]);
Exit(False);
for s in RequestProps.HeaderLines do
begin
HdrArr := SplitString(s, ':');
httpCli.CustomHeaders[HdrArr[0]] := HdrArr[1];
end;
end;
{$ENDIF}
end
else
httpCli := TNetHTTPClient(Client);

Result := ResponseStm.Size > 0;
except on E: Exception do
ErrMsg := E.Message;
end;
finally
FreeAndNil(httpCli);
end;
Resp := httpCli.Get(RequestProps.URL, ResponseStm);

// check HTTP error
CheckHTTPError(Resp.StatusCode, Resp.StatusText);
{$ENDIF}
end;

end.
119 changes: 70 additions & 49 deletions Source/OSM.NetworkRequest.Synapse.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,9 +4,8 @@
based on code by Simon Kroik, 06.2018, kroiksm@@gmx.de
For HTTPS-Support:
1) USES ssl_openssl;
2) copy libeay32.dll
3) copy ssleay32.dll
1) DEFINE SynapseSSL
2) copy libeay32.dll and ssleay32.dll near the binary
(c) Fr0sT-Brutal https://github.com/Fr0sT-Brutal/Delphi_OSMMap
Expand All @@ -19,80 +18,102 @@ interface

uses
SysUtils, Classes,
HTTPSend, SynaUtil,
HTTPSend, SynaUtil, SynaMisc, {$IFDEF SynapseSSL} ssl_openssl, {$ENDIF}
OSM.NetworkRequest;

const
// Capabilities of Synapse engine
EngineCapabilities = [htcProxy, htcDirect, htcProxyAuth, htcAuth, htcAuthURL,
htcHeaders, htcTimeout
{$IF DECLARED(TSSLOpenSSL)} , htcTLS {$ENDIF} ];
{$IFDEF MSWINDOWS} , htcSystemProxy {$ENDIF}
{$IF DECLARED(TSSLOpenSSL)} , htcTLS {$IFEND} ];

// Function executing a network request. See description of
// OSM.NetworkRequest.TBlockingNetworkRequestFunc type.@br
function NetworkRequest(RequestProps: THttpRequestProps;
ResponseStm: TStream; out ErrMsg: string): Boolean;
// Procedure executing a network request. See description of
// OSM.NetworkRequest.TBlockingNetworkRequestProc type.
procedure NetworkRequest(RequestProps: THttpRequestProps;
ResponseStm: TStream; var Client: TNetworkClient);

implementation

const
SEMsg_HTTPErr = 'HTTP error: %d %s';
SUserAgentHdrName = 'User-Agent: ';

function NetworkRequest(RequestProps: THttpRequestProps;
ResponseStm: TStream; out ErrMsg: string): Boolean;
// Procedure executing a network request. See description of
// OSM.NetworkRequest.TBlockingNetworkRequestProc type.
procedure NetworkRequest(RequestProps: THttpRequestProps;
ResponseStm: TStream; var Client: TNetworkClient);
var
HTTP: THTTPSend;
User, Pass, ProxyUser, ProxyPass, ProxyHost, ProxyPort, Dummy: string;
httpCli: THTTPSend;
Prot, User, Pass, ProxyUser, ProxyPass, ProxyHost, ProxyPort, Dummy: string;
{$IFDEF MSWINDOWS}
ProxyProps: TProxySetting;
{$ENDIF}
begin
ErrMsg := '';

HTTP := THTTPSend.Create;
try
HTTP.Timeout := ReqTimeout;
if Client = nil then
begin
CheckEngineCaps(RequestProps, EngineCapabilities);
Client := THTTPSend.Create;
httpCli := THTTPSend(Client);
httpCli.Protocol := '1.1'; // 1.0 by default thus killing keep-alive feature
if htcTimeout in EngineCapabilities then
httpCli.Timeout := ReqTimeout;
// Ensure URL requisites have priority over field requisites
ParseURL(RequestProps.URL, Dummy, User, Pass, Dummy, Dummy, Dummy, Dummy);
ParseURL(RequestProps.URL, Prot, User, Pass, Dummy, Dummy, Dummy, Dummy);
if (User <> '') and (Pass <> '') then
begin
HTTP.UserName := User;
HTTP.Password := Pass;
httpCli.UserName := User;
httpCli.Password := Pass;
end
else
begin
HTTP.UserName := RequestProps.HttpUserName;
HTTP.Password := RequestProps.HttpPassword;
httpCli.UserName := RequestProps.HttpUserName;
httpCli.Password := RequestProps.HttpPassword;
end;

if RequestProps.Proxy <> '' then
begin
{$IFDEF MSWINDOWS}
if RequestProps.Proxy = SystemProxy then
begin
ProxyProps := GetIEProxy(Prot);
// Bypass list is ignored
ProxyHost := ProxyProps.Host;
ProxyPort := ProxyProps.Port;
end
else
{$ENDIF}
ParseURL(RequestProps.Proxy, Dummy, ProxyUser, ProxyPass, ProxyHost, ProxyPort, Dummy, Dummy);
HTTP.ProxyHost := ProxyHost;
HTTP.ProxyPort := ProxyPort;
HTTP.ProxyUser := ProxyUser;
HTTP.ProxyPass := ProxyPass;
httpCli.ProxyHost := ProxyHost;
httpCli.ProxyPort := ProxyPort;
httpCli.ProxyUser := ProxyUser;
httpCli.ProxyPass := ProxyPass;
end;
end
else
begin
httpCli := THTTPSend(Client);
// Synapse fills Headers with response headers so we need to clear them and
// fill again before the new request
httpCli.Clear;
end;

if RequestProps.HeaderLines <> nil then
HTTP.Headers.AddStrings(RequestProps.HeaderLines);

Result := HTTP.HTTPMethod('GET', RequestProps.URL);

// check network error
if not Result then
begin
ErrMsg := HTTP.Sock.LastErrorDesc;
Exit;
end;
// check HTTP error
if HTTP.ResultCode >= 400 then
begin
ErrMsg := Format(SEMsg_HTTPErr, [HTTP.ResultCode, HTTP.ResultString]);
Exit(False);
end;
// OK
ResponseStm.CopyFrom(HTTP.Document, 0);
finally
FreeAndNil(HTTP);
if RequestProps.HeaderLines <> nil then
begin
httpCli.Headers.AddStrings(RequestProps.HeaderLines);
// Synapse doesn't take User agent from headers but from .UserAgent property.
// So check if we have it defined and set explicitly
for Dummy in RequestProps.HeaderLines do
if Pos(SUserAgentHdrName, Dummy) = 1 then
httpCli.UserAgent := Copy(Dummy, Length(SUserAgentHdrName) + 1, MaxInt);
end;

// try to get, check network error
if not httpCli.HTTPMethod('GET', RequestProps.URL) then
raise Exception.Create(httpCli.Sock.LastErrorDesc);
// check httpCli error
CheckHTTPError(httpCli.ResultCode, httpCli.ResultString);
// OK
ResponseStm.CopyFrom(httpCli.Document, 0);
end;

end.
Loading

0 comments on commit 416dcdd

Please sign in to comment.