aksdb
/
restemplate
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity
restemplate/indy/Protocols/IdHTTPProxyServer.pas

500 lines
16 KiB
Plaintext
Raw Permalink Blame History

{
$Project$
$Workfile$
$Revision$
$DateUTC$
$Id$
This file is part of the Indy (Internet Direct) project, and is offered
under the dual-licensing agreement described on the Indy website.
(http://www.indyproject.org/)
Copyright:
(c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved.
}
{
$Log$
}
{
Rev 1.24 10/14/2004 1:45:32 PM BGooijen
Beauty fixes ;)
Rev 1.23 10/14/2004 1:05:48 PM BGooijen
set PerformReply to false, else "200 OK" was added behind the document body
Rev 1.22 09.08.2004 09:30:00 OMonien
changed disconnect handling. Previous implementation failed when exceptions
ocured in command handler.
Rev 1.21 08.08.2004 10:35:56 OMonien
Greeting removed
Rev 1.20 6/11/2004 9:36:28 AM DSiders
Added "Do not Localize" comments.
Rev 1.19 2004.05.20 1:39:24 PM czhower
Last of the IdStream updates
Rev 1.18 2004.05.20 11:37:20 AM czhower
IdStreamVCL
Rev 1.17 4/19/2004 7:07:38 PM BGooijen
the remote headers are now passed to the OnHTTPDocument event
Rev 1.16 4/18/2004 11:31:26 PM BGooijen
Fixed POST
Build CONNECT
fixed some bugs where chars were replaced when that was not needed ( thus
causing corrupt data )
Rev 1.15 2004.04.13 10:24:24 PM czhower
Bug fix for when user changes stream.
Rev 1.14 2004.02.03 5:45:12 PM czhower
Name changes
Rev 1.13 1/21/2004 2:42:52 PM JPMugaas
InitComponent
Rev 1.12 10/25/2003 06:52:12 AM JPMugaas
Updated for new API changes and tried to restore some functionality.
Rev 1.11 2003.10.24 10:43:10 AM czhower
TIdSTream to dos
Rev 1.10 10/17/2003 12:10:08 AM DSiders
Added localization comments.
Rev 1.9 2003.10.12 3:50:44 PM czhower
Compile todos
Rev 1.8 7/13/2003 7:57:38 PM SPerry
fixed problem with commandhandlers
Rev 1.6 5/25/2003 03:54:42 AM JPMugaas
Rev 1.5 2/24/2003 08:56:50 PM JPMugaas
Rev 1.4 1/20/2003 1:15:44 PM BGooijen
Changed to TIdTCPServer / TIdCmdTCPServer classes
Rev 1.3 1-14-2003 19:19:22 BGooijen
The first line of the header was sent to the server twice, fixed that.
Rev 1.2 1-1-2003 21:52:06 BGooijen
Changed for TIdContext
Rev 1.1 12-29-2002 13:00:02 BGooijen
- Works on Indy 10 now
- Cleaned up some code
Rev 1.0 2002.11.22 8:37:50 PM czhower
Rev 1.0 2002.11.22 8:37:16 PM czhower
10-May-2002: Created Unit.
}
unit IdHTTPProxyServer;
interface
{$i IdCompilerDefines.inc}
{
Indy HTTP proxy Server
Original Programmer: Bas Gooijen (bas_gooijen@yahoo.com)
Current Maintainer: Bas Gooijen
Code is given to the Indy Pit Crew.
Modifications by Chad Z. Hower (Kudzu)
}
uses
Classes,
IdAssignedNumbers,
IdGlobal,
IdHeaderList,
IdTCPConnection,
IdCustomTCPServer, //for TIdServerContext
IdCmdTCPServer,
IdCommandHandlers,
IdContext,
IdYarn;
const
IdPORT_HTTPProxy = 8080;
type
TIdHTTPProxyTransferMode = ( tmFullDocument, tmStreaming );
TIdHTTPProxyTransferSource = ( tsClient, tsServer );
TIdHTTPProxyServerContext = class(TIdServerContext)
protected
FHeaders: TIdHeaderList;
FCommand: String;
FDocument: String;
FOutboundClient: TIdTCPConnection;
FTarget: String;
FTransferMode: TIdHTTPProxyTransferMode;
FTransferSource: TIdHTTPProxyTransferSource;
public
constructor Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil); override;
destructor Destroy; override;
property Headers: TIdHeaderList read FHeaders;
property Command: String read FCommand;
property Document: String read FDocument;
property OutboundClient: TIdTCPConnection read FOutboundClient;
property Target: String read FTarget;
property TransferMode: TIdHTTPProxyTransferMode read FTransferMode write FTransferMode;
property TransferSource: TIdHTTPProxyTransferSource read FTransferSource;
end;
TIdHTTPProxyServer = class;
TOnHTTPContextEvent = procedure(AContext: TIdHTTPProxyServerContext) of object;
TOnHTTPDocument = procedure(AContext: TIdHTTPProxyServerContext; var VStream: TStream) of object;
TIdHTTPProxyServer = class(TIdCmdTCPServer)
protected
FDefTransferMode: TIdHTTPProxyTransferMode;
FOnHTTPBeforeCommand: TOnHTTPContextEvent;
FOnHTTPResponse: TOnHTTPContextEvent;
FOnHTTPDocument: TOnHTTPDocument;
// CommandHandlers
procedure CommandPassThrough(ASender: TIdCommand);
procedure CommandCONNECT(ASender: TIdCommand); // for ssl
procedure DoHTTPBeforeCommand(AContext: TIdHTTPProxyServerContext);
procedure DoHTTPDocument(AContext: TIdHTTPProxyServerContext; var VStream: TStream);
procedure DoHTTPResponse(AContext: TIdHTTPProxyServerContext);
procedure InitializeCommandHandlers; override;
procedure TransferData(AContext: TIdHTTPProxyServerContext; ASrc, ADest: TIdTCPConnection);
procedure InitComponent; override;
published
property DefaultPort default IdPORT_HTTPProxy;
property DefaultTransferMode: TIdHTTPProxyTransferMode read FDefTransferMode write FDefTransferMode default tmFullDocument;
property OnHTTPBeforeCommand: TOnHTTPContextEvent read FOnHTTPBeforeCommand write FOnHTTPBeforeCommand;
property OnHTTPResponse: TOnHTTPContextEvent read FOnHTTPResponse write FOnHTTPResponse;
property OnHTTPDocument: TOnHTTPDocument read FOnHTTPDocument write FOnHTTPDocument;
end;
implementation
uses
IdResourceStrings, IdResourceStringsProtocols, IdReplyRFC, IdTCPClient, IdURI,
IdGlobalProtocols, IdStack, IdTCPStream, IdException, SysUtils;
constructor TIdHTTPProxyServerContext.Create(AConnection: TIdTCPConnection;
AYarn: TIdYarn; AList: TIdContextThreadList = nil);
begin
inherited Create(AConnection, AYarn, AList);
FHeaders := TIdHeaderList.Create(QuoteHTTP);
end;
destructor TIdHTTPProxyServerContext.Destroy;
begin
FreeAndNil(FHeaders);
inherited Destroy;
end;
{ TIdHTTPProxyServer }
procedure TIdHTTPProxyServer.InitializeCommandHandlers;
var
LCommandHandler: TIdCommandHandler;
begin
inherited;
LCommandHandler := CommandHandlers.Add;
LCommandHandler.Command := 'GET'; {do not localize}
LCommandHandler.OnCommand := CommandPassThrough;
LCommandHandler.ParseParams := True;
LCommandHandler.Disconnect := True;
LCommandHandler := CommandHandlers.Add;
LCommandHandler.Command := 'POST'; {do not localize}
LCommandHandler.OnCommand := CommandPassThrough;
LCommandHandler.ParseParams := True;
LCommandHandler.Disconnect := True;
LCommandHandler := CommandHandlers.Add;
LCommandHandler.Command := 'HEAD'; {do not localize}
LCommandHandler.OnCommand := CommandPassThrough;
LCommandHandler.ParseParams := True;
LCommandHandler.Disconnect := True;
LCommandHandler := CommandHandlers.Add;
LCommandHandler.Command := 'CONNECT'; {do not localize}
LCommandHandler.OnCommand := CommandCONNECT;
LCommandHandler.ParseParams := True;
LCommandHandler.Disconnect := True;
//HTTP Servers/Proxies do not send a greeting
Greeting.Clear;
end;
procedure TIdHTTPProxyServer.TransferData(AContext: TIdHTTPProxyServerContext;
ASrc, ADest: TIdTCPConnection);
var
LStream: TStream;
LSize: TIdStreamSize;
S: String;
begin
// RLebeau: TODO - support chunked, gzip, and deflate transfers.
// RLebeau: determine how many bytes to read
S := AContext.Headers.Values['Content-Length']; {Do not Localize}
if S <> '' then
begin
LSize := IndyStrToStreamSize(S, -1) ; {Do not Localize}
if LSize < 0 then begin
// Write HTTP error status response
if AContext.TransferSource = tsClient then begin
ASrc.IOHandler.WriteLn('HTTP/1.0 400 Bad Request'); {Do not Localize}
end else begin
ASrc.IOHandler.WriteLn('HTTP/1.0 502 Bad Gateway'); {Do not Localize}
end;
ASrc.IOHandler.WriteLn;
Exit;
end;
end else begin
LSize := -1;
end;
if AContext.TransferSource = tsClient then begin
ADest.IOHandler.WriteLn(AContext.Command + ' ' + AContext.Document + ' HTTP/1.0'); {Do not Localize}
end;
if (AContext.TransferSource = tsServer) or (LSize > 0) then
begin
LStream := nil;
try
if AContext.TransferMode = tmFullDocument then
begin
//TODO: Have an event to let the user perform stream creation
LStream := TMemoryStream.Create;
// RLebeau: do not write the source headers until the OnHTTPDocument
// event has had a chance to update them if it alters the document data...
ASrc.IOHandler.ReadStream(LStream, LSize, LSize < 0);
LStream.Position := 0;
DoHTTPDocument(AContext, LStream);
ADest.IOHandler.Write(AContext.Headers);
ADest.IOHandler.WriteLn;
ADest.IOHandler.Write(LStream);
end else
begin
// RLebeau: direct pass-through, send everything as-is...
LStream := TIdTCPStream.Create(ADest);
ADest.IOHandler.Write(AContext.Headers);
ADest.IOHandler.WriteLn;
ASrc.IOHandler.ReadStream(LStream, LSize, LSize < 0);
end;
finally
FreeAndNil(LStream);
end;
end else
begin
// RLebeau: the client sent a document with no data in it, so just pass
// along the headers by themselves ...
ADest.IOHandler.Write(AContext.Headers);
ADest.IOHandler.WriteLn;
end;
end;
procedure TIdHTTPProxyServer.CommandPassThrough(ASender: TIdCommand);
var
LURI: TIdURI;
LContext: TIdHTTPProxyServerContext;
begin
ASender.PerformReply := False;
LContext := TIdHTTPProxyServerContext(ASender.Context);
LContext.FCommand := ASender.CommandHandler.Command;
LContext.FTarget := ASender.Params.Strings[0];
LContext.FOutboundClient := TIdTCPClient.Create(nil);
try
LURI := TIdURI.Create(LContext.Target);
try
TIdTCPClient(LContext.FOutboundClient).Host := LURI.Host;
if LURI.Port <> '' then begin
TIdTCPClient(LContext.FOutboundClient).Port := IndyStrToInt(LURI.Port, 80);
end
else if TextIsSame(LURI.Protocol, 'http') then begin {do not localize}
TIdTCPClient(LContext.FOutboundClient).Port := IdPORT_HTTP;
end
else if TextIsSame(LURI.Protocol, 'https') then begin {do not localize}
TIdTCPClient(LContext.FOutboundClient).Port := IdPORT_https;
end else begin
raise EIdException.Create(RSHTTPUnknownProtocol);
end;
//We have to remove the host and port from the request
LContext.FDocument := LURI.GetPathAndParams;
finally
FreeAndNil(LURI);
end;
LContext.Headers.Clear;
LContext.Connection.IOHandler.Capture(LContext.Headers, '', False);
LContext.FTransferMode := FDefTransferMode;
LContext.FTransferSource := tsClient;
DoHTTPBeforeCommand(LContext);
TIdTCPClient(LContext.FOutboundClient).Connect;
try
TransferData(LContext, LContext.Connection, LContext.FOutboundClient);
LContext.Headers.Clear;
LContext.FOutboundClient.IOHandler.Capture(LContext.Headers, '', False);
LContext.FTransferMode := FDefTransferMode;
LContext.FTransferSource := tsServer;
DoHTTPResponse(LContext);
TransferData(LContext, LContext.FOutboundClient, LContext.Connection);
finally
LContext.FOutboundClient.Disconnect;
end;
finally
FreeAndNil(LContext.FOutboundClient);
end;
end;
procedure TIdHTTPProxyServer.CommandCONNECT(ASender: TIdCommand);
var
LRemoteHost: string;
LContext: TIdHTTPProxyServerContext;
LReadList, LDataAvailList: TIdSocketList;
LClientToServerStream, LServerToClientStream: TStream;
begin
// RLebeau 7/31/09: we can't make any assumptions about the contents of
// the data being exchanged after the connection has been established.
// It may not (and likely will not) be HTTP data at all. We must pass
// it along as-is in both directions, in as near-realtime as we can...
ASender.PerformReply := False;
LContext := TIdHTTPProxyServerContext(ASender.Context);
LContext.FCommand := ASender.CommandHandler.Command;
LContext.FTarget := ASender.Params.Strings[0];
LContext.FOutboundClient := TIdTCPClient.Create(nil);
try
LClientToServerStream := nil;
LServerToClientStream := nil;
try
LClientToServerStream := TIdTCPStream.Create(LContext.FOutboundClient);
LServerToClientStream := TIdTCPStream.Create(LContext.Connection);
LRemoteHost := LContext.Target;
TIdTCPClient(LContext.FOutboundClient).Host := Fetch(LRemoteHost, ':', True);
TIdTCPClient(LContext.FOutboundClient).Port := IndyStrToInt(LRemoteHost, 443);
LContext.Headers.Clear;
LContext.Connection.IOHandler.Capture(LContext.Headers, '', False);
LContext.FTransferMode := FDefTransferMode;
LContext.FTransferSource := tsClient;
DoHTTPBeforeCommand(LContext);
LReadList := nil;
LDataAvailList := nil;
try
LReadList := TIdSocketList.CreateSocketList;
LDataAvailList := TIdSocketList.CreateSocketList;
TIdTCPClient(LContext.FOutboundClient).Connect;
try
LReadList.Add(LContext.Connection.Socket.Binding.Handle);
LReadList.Add(LContext.FOutboundClient.Socket.Binding.Handle);
LContext.Connection.IOHandler.WriteLn('HTTP/1.0 200 Connection established'); {do not localize}
LContext.Connection.IOHandler.WriteLn('Proxy-agent: Indy-Proxy/1.1'); {do not localize}
LContext.Connection.IOHandler.WriteLn;
LContext.Connection.IOHandler.ReadTimeout := 100;
LContext.FOutboundClient.IOHandler.ReadTimeout := 100;
while LContext.Connection.Connected and LContext.FOutboundClient.Connected do
begin
if LReadList.SelectReadList(LDataAvailList, IdTimeoutInfinite) then
begin
if LDataAvailList.ContainsSocket(LContext.Connection.Socket.Binding.Handle) then
begin
LContext.Connection.IOHandler.CheckForDataOnSource(0);
end;
if LDataAvailList.ContainsSocket(LContext.FOutboundClient.Socket.Binding.Handle) then
begin
LContext.FOutboundClient.IOHandler.CheckForDataOnSource(0);
end;
if not LContext.Connection.IOHandler.InputBufferIsEmpty then
begin
LContext.Connection.IOHandler.InputBuffer.ExtractToStream(LClientToServerStream);
end;
if not LContext.FOutboundClient.IOHandler.InputBufferIsEmpty then
begin
LContext.FOutboundClient.IOHandler.InputBuffer.ExtractToStream(LServerToClientStream);
end;
end;
end;
if LContext.FOutboundClient.Connected and (not LContext.Connection.IOHandler.InputBufferIsEmpty) then
begin
LContext.Connection.IOHandler.InputBuffer.ExtractToStream(LClientToServerStream);
end;
if LContext.Connection.Connected and (not LContext.FOutboundClient.IOHandler.InputBufferIsEmpty) then
begin
LContext.FOutboundClient.IOHandler.InputBuffer.ExtractToStream(LServerToClientStream);
end;
finally
LContext.FOutboundClient.Disconnect;
end;
finally
FreeAndNil(LDataAvailList);
FreeAndNil(LReadList);
end;
finally
FreeAndNil(LClientToServerStream);
FreeAndNil(LServerToClientStream);
end;
finally
FreeAndNil(LContext.FOutboundClient);
end;
end;
procedure TIdHTTPProxyServer.InitComponent;
begin
inherited InitComponent;
ContextClass := TIdHTTPProxyServerContext;
DefaultPort := IdPORT_HTTPProxy;
FDefTransferMode := tmFullDocument;
Greeting.Text.Text := ''; // RS
ReplyUnknownCommand.Text.Text := ''; // RS
end;
procedure TIdHTTPProxyServer.DoHTTPBeforeCommand(AContext: TIdHTTPProxyServerContext);
begin
if Assigned(OnHTTPBeforeCommand) then begin
OnHTTPBeforeCommand(AContext);
end;
end;
procedure TIdHTTPProxyServer.DoHTTPDocument(AContext: TIdHTTPProxyServerContext;
var VStream: TStream);
begin
if Assigned(OnHTTPDocument) then begin
OnHTTPDocument(AContext, VStream);
end;
end;
procedure TIdHTTPProxyServer.DoHTTPResponse(AContext: TIdHTTPProxyServerContext);
begin
if Assigned(OnHTTPResponse) then begin
OnHTTPResponse(AContext);
end;
end;
end.
Reference in New Issue View Git Blame Copy Permalink