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

916 lines
32 KiB
Plaintext
Raw 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.7 6/26/2004 12:11:16 AM BGooijen
updates for D8
Rev 1.6 4/8/2004 4:00:40 PM BGooijen
Fix for D8
Rev 1.5 07/04/2004 20:44:06 HHariri
Updates
Rev 1.4 07/04/2004 20:07:50 HHariri
Updates for .NET
Rev 1.3 10/19/2003 4:50:10 PM DSiders
Added localization comments.
Rev 1.2 10/12/2003 1:49:48 PM BGooijen
Changed comment of last checkin
Rev 1.1 10/12/2003 1:43:32 PM BGooijen
Changed IdCompilerDefines.inc to Core\IdCompilerDefines.inc
Rev 1.0 11/13/2002 07:54:34 AM JPMugaas
}
unit IdHTTPWebBrokerBridge;
{
Original Author: Dave Nottage.
Modified by: Grahame Grieve
Modified by: Chad Z. Hower (Kudzu)
}
interface
{$i IdCompilerDefines.inc}
uses
Classes,
HTTPApp,
IdContext, IdCustomHTTPServer, IdException, IdTCPServer, IdIOHandlerSocket,
{$IFDEF CLR}System.Text,{$ENDIF}
WebBroker, WebReq;
type
EWBBException = class(EIdException);
EWBBInvalidIdxGetDateVariable = class(EWBBException);
EWBBInvalidIdxSetDateVariable = class(EWBBException );
EWBBInvalidIdxGetIntVariable = class(EWBBException );
EWBBInvalidIdxSetIntVariable = class(EWBBException );
EWBBInvalidIdxGetStrVariable = class(EWBBException);
EWBBInvalidIdxSetStringVar = class(EWBBException);
EWBBInvalidStringVar = class(EWBBException);
TIdHTTPAppRequest = class(TWebRequest)
protected
FRequestInfo : TIdHTTPRequestInfo;
FResponseInfo : TIdHTTPResponseInfo;
FThread : TIdContext;
FContentStream : TStream;
FFreeContentStream : Boolean;
//
function GetDateVariable(Index: Integer): TDateTime; override;
function GetIntegerVariable(Index: Integer): Integer; override;
function GetStringVariable(Index: Integer): AnsiString; override;
{$IFDEF VCL_XE_OR_ABOVE}
function GetRemoteIP: string; override;
function GetRawPathInfo: AnsiString; override;
{$ENDIF}
public
constructor Create(AThread: TIdContext; ARequestInfo: TIdHTTPRequestInfo;
AResponseInfo: TIdHTTPResponseInfo);
destructor Destroy; override;
function GetFieldByName(const Name: AnsiString): AnsiString; override;
function ReadClient(var Buffer{$IFDEF CLR}: TBytes{$ENDIF}; Count: Integer): Integer; override;
function ReadString(Count: Integer): AnsiString; override;
{function ReadUnicodeString(Count: Integer): string;}
function TranslateURI(const URI: string): string; override;
function WriteClient(var ABuffer; ACount: Integer): Integer; override;
{$IFDEF VCL_6_OR_ABOVE}
{$DEFINE VCL_6_OR_ABOVE_OR_CLR}
{$ENDIF}
{$IFDEF CLR}
{$DEFINE VCL_6_OR_ABOVE_OR_CLR}
{$ENDIF}
{$IFDEF VCL_6_OR_ABOVE_OR_CLR}
function WriteHeaders(StatusCode: Integer; const ReasonString, Headers: AnsiString): Boolean; override;
{$ENDIF}
function WriteString(const AString: AnsiString): Boolean; override;
end;
TIdHTTPAppResponse = class(TWebResponse)
protected
FContent: string;
FRequestInfo: TIdHTTPRequestInfo;
FResponseInfo: TIdHTTPResponseInfo;
FSent: Boolean;
FThread: TIdContext;
FContentType: AnsiString; // Workaround to preserve value of ContentType property
//
function GetContent: AnsiString; override;
function GetDateVariable(Index: Integer): TDateTime; override;
function GetStatusCode: Integer; override;
function GetIntegerVariable(Index: Integer): Integer; override;
function GetLogMessage: string; override;
function GetStringVariable(Index: Integer): AnsiString; override;
procedure SetContent(const AValue: AnsiString); override;
procedure SetContentStream(AValue: TStream); override;
procedure SetStatusCode(AValue: Integer); override;
procedure SetStringVariable(Index: Integer; const Value: AnsiString); override;
procedure SetDateVariable(Index: Integer; const Value: TDateTime); override;
procedure SetIntegerVariable(Index: Integer; Value: Integer); override;
procedure SetLogMessage(const Value: string); override;
procedure MoveCookiesAndCustomHeaders;
public
constructor Create(AHTTPRequest: TWebRequest; AThread: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
procedure SendRedirect(const URI: AnsiString); override;
procedure SendResponse; override;
procedure SendStream(AStream: TStream); override;
function Sent: Boolean; override;
end;
TIdHTTPWebBrokerBridge = class(TIdCustomHTTPServer)
private
procedure RunWebModuleClass(AThread: TIdContext; ARequestInfo: TIdHTTPRequestInfo;
AResponseInfo: TIdHTTPResponseInfo);
protected
FWebModuleClass: TComponentClass;
//
procedure DoCommandGet(AThread: TIdContext; ARequestInfo: TIdHTTPRequestInfo;
AResponseInfo: TIdHTTPResponseInfo); override;
procedure DoCommandOther(AThread: TIdContext; ARequestInfo: TIdHTTPRequestInfo;
AResponseInfo: TIdHTTPResponseInfo); override;
procedure InitComponent; override;
public
procedure RegisterWebModuleClass(AClass: TComponentClass);
end;
implementation
uses
IdResourceStringsProtocols,
IdBuffer, IdHTTPHeaderInfo, IdGlobal, IdGlobalProtocols, IdCookie, IdStream,
{$IFDEF STRING_IS_UNICODE}IdCharsets,{$ENDIF}
SysUtils, Math
{$IFDEF HAS_TNetEncoding}
, System.NetEncoding
{$ENDIF}
;
type
// Make HandleRequest accessible
TWebDispatcherAccess = class(TCustomWebDispatcher);
const
INDEX_RESP_Version = 0;
INDEX_RESP_ReasonString = 1;
INDEX_RESP_Server = 2;
INDEX_RESP_WWWAuthenticate = 3;
INDEX_RESP_Realm = 4;
INDEX_RESP_Allow = 5;
INDEX_RESP_Location = 6;
INDEX_RESP_ContentEncoding = 7;
INDEX_RESP_ContentType = 8;
INDEX_RESP_ContentVersion = 9;
INDEX_RESP_DerivedFrom = 10;
INDEX_RESP_Title = 11;
//
INDEX_RESP_ContentLength = 0;
//
INDEX_RESP_Date = 0;
INDEX_RESP_Expires = 1;
INDEX_RESP_LastModified = 2;
//
//Borland coder didn't define constants in HTTPApp
INDEX_Method = 0;
INDEX_ProtocolVersion = 1;
INDEX_URL = 2;
INDEX_Query = 3;
INDEX_PathInfo = 4;
INDEX_PathTranslated = 5;
INDEX_CacheControl = 6;
INDEX_Date = 7;
INDEX_Accept = 8;
INDEX_From = 9;
INDEX_Host = 10;
INDEX_IfModifiedSince = 11;
INDEX_Referer = 12;
INDEX_UserAgent = 13;
INDEX_ContentEncoding = 14;
INDEX_ContentType = 15;
INDEX_ContentLength = 16;
INDEX_ContentVersion = 17;
INDEX_DerivedFrom = 18;
INDEX_Expires = 19;
INDEX_Title = 20;
INDEX_RemoteAddr = 21;
INDEX_RemoteHost = 22;
INDEX_ScriptName = 23;
INDEX_ServerPort = 24;
INDEX_Content = 25;
INDEX_Connection = 26;
INDEX_Cookie = 27;
INDEX_Authorization = 28;
{ TIdHTTPAppRequest }
constructor TIdHTTPAppRequest.Create(AThread: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
i: Integer;
begin
FThread := AThread;
FRequestInfo := ARequestInfo;
FResponseInfo := AResponseInfo;
inherited Create;
for i := 0 to ARequestInfo.Cookies.Count - 1 do begin
CookieFields.Add(ARequestInfo.Cookies[i].ClientCookie);
end;
if Assigned(FRequestInfo.PostStream) then
begin
FContentStream := FRequestInfo.PostStream;
FFreeContentStream := False;
end else
begin
if FRequestInfo.FormParams <> '' then begin {do not localize}
// an input form that was submitted as "application/www-url-encoded"...
FContentStream := TStringStream.Create(FRequestInfo.FormParams);
end else
begin
// anything else for now...
FContentStream := TStringStream.Create(FRequestInfo.UnparsedParams);
end;
FFreeContentStream := True;
end;
end;
destructor TIdHTTPAppRequest.Destroy;
begin
if FFreeContentStream then begin
FreeAndNil(FContentStream);
end;
inherited;
end;
function TIdHTTPAppRequest.GetDateVariable(Index: Integer): TDateTime;
var
LValue: string;
begin
LValue := string(GetStringVariable(Index));
if Length(LValue) > 0 then begin
Result := ParseDate(LValue);
end else begin
Result := -1;
end;
end;
function TIdHTTPAppRequest.GetIntegerVariable(Index: Integer): Integer;
begin
Result := StrToIntDef(string(GetStringVariable(Index)), -1)
end;
{$IFDEF VCL_XE_OR_ABOVE}
function TIdHTTPAppRequest.GetRawPathInfo: AnsiString;
begin
Result := AnsiString(FRequestInfo.URI);
end;
function TIdHTTPAppRequest.GetRemoteIP: string;
begin
Result := String(FRequestInfo.RemoteIP);
end;
{$ENDIF}
function TIdHTTPAppRequest.GetStringVariable(Index: Integer): AnsiString;
var
s: string;
LPos: TIdStreamSize;
LBytes: TIdBytes;
begin
LBytes := nil;
case Index of
INDEX_Method : Result := AnsiString(FRequestInfo.Command);
INDEX_ProtocolVersion : Result := AnsiString(FRequestInfo.Version);
//INDEX_URL : Result := AnsiString(FRequestInfo.Document);
INDEX_URL : Result := AnsiString(''); // Root - consistent with ISAPI which return path to root
INDEX_Query : Result := AnsiString(FRequestInfo.QueryParams);
INDEX_PathInfo : Result := AnsiString(FRequestInfo.Document);
INDEX_PathTranslated : Result := AnsiString(FRequestInfo.Document); // it's not clear quite what should be done here - we can't translate to a path
INDEX_CacheControl : Result := GetFieldByName('Cache-Control'); {do not localize}
INDEX_Date : Result := GetFieldByName('Date'); {do not localize}
INDEX_Accept : Result := AnsiString(FRequestInfo.Accept);
INDEX_From : Result := AnsiString(FRequestInfo.From);
INDEX_Host: begin
s := FRequestInfo.Host;
Result := AnsiString(Fetch(s, ':'));
end;
INDEX_IfModifiedSince : Result := GetFieldByName('If-Modified-Since'); {do not localize}
INDEX_Referer : Result := AnsiString(FRequestInfo.Referer);
INDEX_UserAgent : Result := AnsiString(FRequestInfo.UserAgent);
INDEX_ContentEncoding : Result := AnsiString(FRequestInfo.ContentEncoding);
INDEX_ContentType : Result := AnsiString(FRequestInfo.ContentType);
INDEX_ContentLength : Result := AnsiString(IntToStr(FContentStream.Size));
INDEX_ContentVersion : Result := GetFieldByName('CONTENT_VERSION'); {do not localize}
INDEX_DerivedFrom : Result := GetFieldByName('Derived-From'); {do not localize}
INDEX_Expires : Result := GetFieldByName('Expires'); {do not localize}
INDEX_Title : Result := GetFieldByName('Title'); {do not localize}
INDEX_RemoteAddr : Result := AnsiString(FRequestInfo.RemoteIP);
INDEX_RemoteHost : Result := GetFieldByName('REMOTE_HOST'); {do not localize}
INDEX_ScriptName : Result := '';
INDEX_ServerPort: begin
s := FRequestInfo.Host;
Fetch(s, ':');
if Length(s) = 0 then begin
s := IntToStr(FThread.Connection.Socket.Binding.Port);
// Result := '80';
end;
Result := AnsiString(s);
end;
INDEX_Content: begin
if FFreeContentStream then
begin
Result := AnsiString(TStringStream(FContentStream).DataString);
end else
begin
LPos := FContentStream.Position;
FContentStream.Position := 0;
try
// RLebeau 2/21/2009: not using ReadStringAsCharSet() anymore. Since
// this method returns an AnsiString, the stream data should not be
// decoded to Unicode and then converted to Ansi. That can lose
// characters. Also, for D2009+, the AnsiString payload should have
// the proper codepage assigned to it as well so it can be converted
// correctly if assigned to other string variables later on...
// Result := ReadStringAsCharSet(FContentStream, FRequestInfo.CharSet);
TIdStreamHelper.ReadBytes(FContentStream, LBytes);
{$IFDEF DOTNET}
// RLebeau: how to handle this correctly in .NET?
Result := AnsiString(BytesToStringRaw(LBytes));
{$ELSE}
SetString(Result, PAnsiChar(LBytes), Length(LBytes));
{$IFDEF VCL_2009_OR_ABOVE}
SetCodePage(PRawByteString(@Result)^, CharsetToCodePage(FRequestInfo.CharSet), False);
{$ENDIF}
{$ENDIF}
finally
FContentStream.Position := LPos;
end;
end;
end;
INDEX_Connection : Result := GetFieldByName('Connection'); {do not localize}
INDEX_Cookie : Result := ''; // not available at present. FRequestInfo.Cookies....;
INDEX_Authorization : Result := GetFieldByName('Authorization'); {do not localize}
else
Result := '';
end;
end;
function TIdHTTPAppRequest.GetFieldByName(const Name: AnsiString): AnsiString;
begin
Result := AnsiString(FRequestInfo.RawHeaders.Values[string(Name)]);
end;
function TIdHTTPAppRequest.ReadClient(var Buffer{$IFDEF CLR}: TBytes{$ENDIF};
Count: Integer): Integer;
begin
{$IFDEF CLR}
Result := TIdStreamHelper.ReadBytes(FContentStream, Buffer, Count);
{$ELSE}
Result := FContentStream.Read(Buffer, Count);
{$ENDIF}
// well, it shouldn't be less than 0. but let's not take chances
if Result < 0 then begin
Result := 0;
end;
end;
function TIdHTTPAppRequest.ReadString(Count: Integer): AnsiString;
var
LBytes: TIdBytes;
begin
// RLebeau 2/21/2009: not using ReadStringAsCharSet() anymore. Since
// this method returns an AnsiString, the stream data should not be
// decoded to Unicode and then converted to Ansi. That can lose
// characters.
// Result := AnsiString(ReadStringFromStream(FContentStream, Count));
LBytes := nil;
TIdStreamHelper.ReadBytes(FContentStream, LBytes, Count);
{$IFDEF DOTNET}
// RLebeau: how to handle this correctly in .NET?
Result := AnsiString(BytesToStringRaw(LBytes));
{$ELSE}
SetString(Result, PAnsiChar(LBytes), Length(LBytes));
{$IFDEF VCL_2009_OR_ABOVE}
SetCodePage(PRawByteString(@Result)^, CharsetToCodePage(FRequestInfo.CharSet), False);
{$ENDIF}
{$ENDIF}
end;
function TIdHTTPAppRequest.TranslateURI(const URI: string): string;
begin
// we don't have the concept of a path translation. It's not quite clear
// what to do about this. Comments welcome (grahame@kestral.com.au)
Result := URI;
end;
{$IFDEF VCL_6_OR_ABOVE_OR_CLR}
function TIdHTTPAppRequest.WriteHeaders(StatusCode: Integer; const ReasonString, Headers: AnsiString): Boolean;
begin
FResponseInfo.ResponseNo := StatusCode;
FResponseInfo.ResponseText := string(ReasonString);
FResponseInfo.CustomHeaders.Add(string(Headers));
FResponseInfo.WriteHeader;
Result := True;
end;
{$ENDIF}
function TIdHTTPAppRequest.WriteString(const AString: AnsiString): Boolean;
begin
FThread.Connection.IOHandler.Write(string(AString));
Result := True;
end;
function TIdHTTPAppRequest.WriteClient(var ABuffer; ACount: Integer): Integer;
var
LBuffer: TIdBytes;
begin
SetLength(LBuffer, ACount);
{$IFNDEF CLR}
Move(ABuffer, LBuffer[0], ACount);
{$ELSE}
// RLebeau: this can't be right? It is interpretting the source as a
// null-terminated character string, which is likely not the case...
CopyTIdBytes(ToBytes(string(ABuffer)), 0, LBuffer, 0, ACount);
{$ENDIF}
FThread.Connection.IOHandler.Write(LBuffer);
Result := ACount;
end;
{ TIdHTTPAppResponse }
constructor TIdHTTPAppResponse.Create(AHTTPRequest: TWebRequest; AThread: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
begin
FThread := AThread;
FRequestInfo := ARequestInfo;
FResponseInfo := AResponseInfo;
inherited Create(AHTTPRequest);
if Length(FHTTPRequest.ProtocolVersion) = 0 then begin
Version := '1.0'; {do not localize}
end;
StatusCode := 200;
LastModified := -1;
Expires := -1;
Date := -1;
// RLebeau 8/13/2015: no longer setting a default ContentType here. Doing so
// sets a default CharSet, which would get carried over if the user assigns a
// new *non-text* ContentType without an explicit charset. TAppResponse does
// not expose access to the FResponseInfo.CharSet property. For example, if
// the user sets TAppResponse.ContentType to 'image/jpeg', the resulting
// Content-Type header woud be 'image/jpeg; charset=ISO-8859-1', which can
// cause problems for some clients. Besides, TIdHTTPResponseInfo.WriteHeader()
// sets the ContentType to 'text/html; charset=ISO-8859-1' if no ContentType
// has been provided but there is ContentText/ContentStream data, so this is
// redundant here anyway...
//
// ContentType := 'text/html'; {do not localize}
end;
function TIdHTTPAppResponse.GetContent: AnsiString;
{$IFDEF STRING_IS_UNICODE}
var
LEncoding: IIdTextEncoding;
LBytes: TIdBytes;
{$ENDIF}
begin
{$IFDEF STRING_IS_UNICODE}
// RLebeau 2/21/2009: encode the content using the specified charset.
// Also, the AnsiString payload should have the proper codepage assigned
// to it as well so it can be converted correctly if assigned to other
// string variables later on...
Result := '';
LEncoding := CharsetToEncoding(FResponseInfo.CharSet);
LBytes := LEncoding.GetBytes(FResponseInfo.ContentText);
{$IFDEF DOTNET}
// RLebeau: how to handle this correctly in .NET?
Result := AnsiString(BytesToStringRaw(LBytes));
{$ELSE}
SetString(Result, PAnsiChar(LBytes), Length(LBytes));
{$IFDEF VCL_2009_OR_ABOVE}
SetCodePage(PRawByteString(@Result)^, CharsetToCodePage(FResponseInfo.CharSet), False);
{$ENDIF}
{$ENDIF}
{$ELSE}
Result := FResponseInfo.ContentText;
{$ENDIF}
end;
function TIdHTTPAppResponse.GetLogMessage: string;
begin
Result := '';
end;
function TIdHTTPAppResponse.GetStatusCode: Integer;
begin
Result := FResponseInfo.ResponseNo;
end;
function TIdHTTPAppResponse.GetDateVariable(Index: Integer): TDateTime;
// WebBroker apps are responsible for conversion to GMT, Indy HTTP server expects apps to pas local time
function ToGMT(ADateTime: TDateTime): TDateTime;
begin
Result := ADateTime;
if Result <> -1 then
Result := Result - OffsetFromUTC;
end;
begin
//TODO: resource string these
case Index of
INDEX_RESP_Date : Result := ToGMT(FResponseInfo.Date);
INDEX_RESP_Expires : Result := ToGMT(FResponseInfo.Expires);
INDEX_RESP_LastModified : Result := ToGMT(FResponseInfo.LastModified);
else
raise EWBBInvalidIdxGetDateVariable.Create( Format( RSWBBInvalidIdxGetDateVariable,[inttostr(Index)]));
end;
end;
procedure TIdHTTPAppResponse.SetDateVariable(Index: Integer; const Value: TDateTime);
// WebBroker apps are responsible for conversion to GMT, Indy HTTP server expects apps to pas local time
function ToLocal(ADateTime: TDateTime): TDateTime;
begin
Result := ADateTime;
if Result <> -1 then
Result := Result + OffsetFromUTC;
end;
begin
//TODO: resource string these
case Index of
INDEX_RESP_Date : FResponseInfo.Date := ToLocal(Value);
INDEX_RESP_Expires : FResponseInfo.Expires := ToLocal(Value);
INDEX_RESP_LastModified : FResponseInfo.LastModified := ToLocal(Value);
else
raise EWBBInvalidIdxSetDateVariable.Create(Format(RSWBBInvalidIdxSetDateVariable,[inttostr(Index) ]));
end;
end;
function TIdHTTPAppResponse.GetIntegerVariable(Index: Integer): Integer;
begin
//TODO: resource string these
case Index of
INDEX_RESP_ContentLength: Result := FResponseInfo.ContentLength;
else
raise EWBBInvalidIdxGetIntVariable.Create( Format( RSWBBInvalidIdxGetIntVariable,[inttostr(Index)]));
end;
end;
procedure TIdHTTPAppResponse.SetIntegerVariable(Index, Value: Integer);
begin
//TODO: resource string these
case Index of
INDEX_RESP_ContentLength: FResponseInfo.ContentLength := Value;
else
raise EWBBInvalidIdxSetIntVariable.Create( Format(RSWBBInvalidIdxSetIntVariable,[inttostr(Index)])); {do not localize}
end;
end;
function TIdHTTPAppResponse.GetStringVariable(Index: Integer): AnsiString;
begin
//TODO: resource string these
case Index of
INDEX_RESP_Version :Result := AnsiString(FRequestInfo.Version);
INDEX_RESP_ReasonString :Result := AnsiString(FResponseInfo.ResponseText);
INDEX_RESP_Server :Result := AnsiString(FResponseInfo.Server);
INDEX_RESP_WWWAuthenticate :Result := AnsiString(FResponseInfo.WWWAuthenticate.Text);
INDEX_RESP_Realm :Result := AnsiString(FResponseInfo.AuthRealm);
INDEX_RESP_Allow :Result := AnsiString(FResponseInfo.CustomHeaders.Values['Allow']); {do not localize}
INDEX_RESP_Location :Result := AnsiString(FResponseInfo.Location);
INDEX_RESP_ContentEncoding :Result := AnsiString(FResponseInfo.ContentEncoding);
INDEX_RESP_ContentType :
begin
if FContentType <> '' then begin
Result := FContentType;
end else begin
Result := AnsiString(FResponseInfo.ContentType);
end;
end;
INDEX_RESP_ContentVersion :Result := AnsiString(FResponseInfo.ContentVersion);
INDEX_RESP_DerivedFrom :Result := AnsiString(FResponseInfo.CustomHeaders.Values['Derived-From']); {do not localize}
INDEX_RESP_Title :Result := AnsiString(FResponseInfo.CustomHeaders.Values['Title']); {do not localize}
else
raise EWBBInvalidIdxGetStrVariable.Create(Format(RSWBBInvalidIdxGetStrVariable,[ IntToStr(Index)]));
end;
end;
procedure TIdHTTPAppResponse.SetStringVariable(Index: Integer; const Value: AnsiString);
begin
//TODO: resource string these
case Index of
INDEX_RESP_Version :EWBBInvalidStringVar.Create(RSWBBInvalidStringVar);
INDEX_RESP_ReasonString :FResponseInfo.ResponseText := string(Value);
INDEX_RESP_Server :FResponseInfo.Server := string(Value);
INDEX_RESP_WWWAuthenticate :FResponseInfo.WWWAuthenticate.Text := string(Value);
INDEX_RESP_Realm :FResponseInfo.AuthRealm := string(Value);
INDEX_RESP_Allow :FResponseInfo.CustomHeaders.Values['Allow'] := string(Value); {do not localize}
INDEX_RESP_Location :FResponseInfo.Location := string(Value);
INDEX_RESP_ContentEncoding :FResponseInfo.ContentEncoding := string(Value);
INDEX_RESP_ContentType :
begin
FResponseInfo.ContentType := string(Value);
FContentType := Value;
end;
INDEX_RESP_ContentVersion :FResponseInfo.ContentVersion := string(Value);
INDEX_RESP_DerivedFrom :FResponseInfo.CustomHeaders.Values['Derived-From'] := string(Value); {do not localize}
INDEX_RESP_Title :FResponseInfo.CustomHeaders.Values['Title'] := string(Value); {do not localize}
else
raise EWBBInvalidIdxSetStringVar.Create( Format(RSWBBInvalidIdxSetStringVar,[IntToStr(Index)])); {do not localize}
end;
end;
procedure TIdHTTPAppResponse.SendRedirect(const URI: AnsiString);
begin
FSent := True;
MoveCookiesAndCustomHeaders;
FResponseInfo.Redirect(string(URI));
end;
procedure TIdHTTPAppResponse.SendResponse;
begin
FSent := True;
// Reset to -1 so Indy will auto set it
FResponseInfo.ContentLength := -1;
MoveCookiesAndCustomHeaders;
FResponseInfo.WriteContent;
end;
procedure TIdHTTPAppResponse.SendStream(AStream: TStream);
begin
FThread.Connection.IOHandler.Write(AStream);
end;
function TIdHTTPAppResponse.Sent: Boolean;
begin
Result := FSent;
end;
procedure TIdHTTPAppResponse.SetContent(const AValue: AnsiString);
var
LValue : string;
begin
{$IFDEF STRING_IS_UNICODE}
// RLebeau 3/28/2013: decode the content using the specified charset.
if FResponseInfo.CharSet <> '' then begin
// AValue contains Encoded bytes
if AValue <> '' then begin
LValue := CharsetToEncoding(FResponseInfo.CharSet).GetString(RawToBytes(PAnsiChar(AValue)^, Length(AValue)));
end;
end else begin
LValue := string(AValue);
end;
{$ELSE}
LValue := string(AValue);
{$ENDIF}
FResponseInfo.ContentText := LValue;
FResponseInfo.ContentLength := Length(LValue);
end;
procedure TIdHTTPAppResponse.SetLogMessage(const Value: string);
begin
// logging not supported
end;
procedure TIdHTTPAppResponse.SetStatusCode(AValue: Integer);
begin
FResponseInfo.ResponseNo := AValue;
end;
procedure TIdHTTPAppResponse.SetContentStream(AValue: TStream);
begin
inherited;
FResponseInfo.ContentStream := AValue;
end;
function DoHTTPEncode(const AStr: AnsiString): String;
begin
{$IFDEF HAS_TNetEncoding}
Result := TNetEncoding.URL.Encode(string(AStr));
{$ELSE}
Result := String(HTTPEncode(AStr));
{$ENDIF}
end;
procedure TIdHTTPAppResponse.MoveCookiesAndCustomHeaders;
var
i: Integer;
LSrcCookie: TCookie;
LDestCookie: TIdCookie;
begin
for i := 0 to Cookies.Count - 1 do begin
LSrcCookie := Cookies[i];
LDestCookie := FResponseInfo.Cookies.Add;
LDestCookie.CookieName := DoHTTPEncode(LSrcCookie.Name);
LDestCookie.Value := DoHTTPEncode(LSrcCookie.Value);
LDestCookie.Domain := String(LSrcCookie.Domain);
LDestCookie.Path := String(LSrcCookie.Path);
LDestCookie.Expires := LSrcCookie.Expires;
LDestCookie.Secure := LSrcCookie.Secure;
// TODO: LDestCookie.HttpOnly := LSrcCookie.HttpOnly;
end;
FResponseInfo.CustomHeaders.Clear;
FResponseInfo.CustomHeaders.AddStdValues(CustomHeaders);
end;
{ TIdHTTPWebBrokerBridge }
procedure TIdHTTPWebBrokerBridge.DoCommandOther(AThread: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
begin
DoCommandGet(AThread, ARequestInfo, AResponseInfo);
end;
procedure TIdHTTPWebBrokerBridge.InitComponent;
begin
inherited InitComponent;
// FOkToProcessCommand := True;
end;
type
TIdHTTPWebBrokerBridgeRequestHandler = class(TWebRequestHandler)
{$IFDEF HAS_CLASSVARS}
private
class var FWebRequestHandler: TIdHTTPWebBrokerBridgeRequestHandler;
{$ENDIF}
public
constructor Create(AOwner: TComponent); override;
{$IFDEF HAS_CLASSVARS}
{$IFDEF HAS_CLASSDESTRUCTOR}
class destructor Destroy;
{$ENDIF}
{$ENDIF}
destructor Destroy; override;
procedure Run(AThread: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
end;
{$IFNDEF HAS_CLASSVARS}
var
IndyWebRequestHandler: TIdHTTPWebBrokerBridgeRequestHandler = nil;
{$ENDIF}
{ TIdHTTPWebBrokerBridgeRequestHandler }
procedure TIdHTTPWebBrokerBridgeRequestHandler.Run(AThread: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
LRequest: TIdHTTPAppRequest;
LResponse: TIdHTTPAppResponse;
begin
try
LRequest := TIdHTTPAppRequest.Create(AThread, ARequestInfo, AResponseInfo);
try
LResponse := TIdHTTPAppResponse.Create(LRequest, AThread, ARequestInfo, AResponseInfo);
try
// WebBroker will free it and we cannot change this behaviour
AResponseInfo.FreeContentStream := False;
HandleRequest(LRequest, LResponse);
finally
FreeAndNil(LResponse);
end;
finally
FreeAndNil(LRequest);
end;
except
// Let Indy handle this exception
raise;
end;
end;
constructor TIdHTTPWebBrokerBridgeRequestHandler.Create(AOwner: TComponent);
begin
inherited;
Classes.ApplicationHandleException := HandleException;
end;
destructor TIdHTTPWebBrokerBridgeRequestHandler.Destroy;
begin
Classes.ApplicationHandleException := nil;
inherited;
end;
{$IFDEF HAS_CLASSVARS}
{$IFDEF HAS_CLASSDESTRUCTOR}
class destructor TIdHTTPWebBrokerBridgeRequestHandler.Destroy;
begin
FreeAndNil(FWebRequestHandler);
end;
{$ENDIF}
{$ENDIF}
function IdHTTPWebBrokerBridgeRequestHandler: TWebRequestHandler;
begin
{$IFDEF HAS_CLASSVARS}
if not Assigned(TIdHTTPWebBrokerBridgeRequestHandler.FWebRequestHandler) then
TIdHTTPWebBrokerBridgeRequestHandler.FWebRequestHandler := TIdHTTPWebBrokerBridgeRequestHandler.Create(nil);
Result := TIdHTTPWebBrokerBridgeRequestHandler.FWebRequestHandler;
{$ELSE}
if not Assigned(IndyWebRequestHandler) then
IndyWebRequestHandler := TIdHTTPWebBrokerBridgeRequestHandler.Create(nil);
Result := IndyWebRequestHandler;
{$ENDIF}
end;
procedure TIdHTTPWebBrokerBridge.DoCommandGet(AThread: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
begin
if FWebModuleClass <> nil then begin
// FWebModuleClass, RegisterWebModuleClass supported for backward compatability
RunWebModuleClass(AThread, ARequestInfo, AResponseInfo)
end else
begin
{$IFDEF HAS_CLASSVARS}
TIdHTTPWebBrokerBridgeRequestHandler.FWebRequestHandler.Run(AThread, ARequestInfo, AResponseInfo);
{$ELSE}
IndyWebRequestHandler.Run(AThread, ARequestInfo, AResponseInfo);
{$ENDIF}
end;
end;
procedure TIdHTTPWebBrokerBridge.RunWebModuleClass(AThread: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
LRequest: TIdHTTPAppRequest;
LResponse: TIdHTTPAppResponse;
LWebModule: TCustomWebDispatcher;
{$IFDEF VCL_6_OR_ABOVE}
WebRequestHandler: IWebRequestHandler;
{$ENDIF}
Handled: Boolean;
begin
LRequest := TIdHTTPAppRequest.Create(AThread, ARequestInfo, AResponseInfo);
try
LResponse := TIdHTTPAppResponse.Create(LRequest, AThread, ARequestInfo, AResponseInfo);
try
// WebBroker will free it and we cannot change this behaviour
AResponseInfo.FreeContentStream := False;
// There are better ways in D6, but this works in D5
LWebModule := FWebModuleClass.Create(nil) as TCustomWebDispatcher;
try
{$IFDEF VCL_6_OR_ABOVE}
if Supports(LWebModule, IWebRequestHandler, WebRequestHandler) then begin
try
Handled := WebRequestHandler.HandleRequest(LRequest, LResponse);
finally
WebRequestHandler := nil;
end;
end else begin
Handled := TWebDispatcherAccess(LWebModule).DispatchAction(LRequest, LResponse);
end;
{$ELSE}
Handled := TWebDispatcherAccess(LWebModule).DispatchAction(LRequest, LResponse);
{$ENDIF}
if Handled and (not LResponse.Sent) then begin
LResponse.SendResponse;
end;
finally
FreeAndNil(LWebModule);
end;
finally
FreeAndNil(LResponse);
end;
finally
FreeAndNil(LRequest);
end;
end;
// FWebModuleClass, RegisterWebModuleClass supported for backward compatability
// Instead set WebModuleClass using: WebReq.WebRequestHandler.WebModuleClass := TWebModule1;
procedure TIdHTTPWebBrokerBridge.RegisterWebModuleClass(AClass: TComponentClass);
begin
FWebModuleClass := AClass;
end;
initialization
WebReq.WebRequestHandlerProc := IdHTTPWebBrokerBridgeRequestHandler;
{$IFDEF HAS_CLASSVARS}
{$IFNDEF HAS_CLASSDESTRUCTOR}
finalization
FreeAndNil(TIdHTTPWebBrokerBridgeRequestHandler.FWebRequestHandler);
{$ENDIF}
{$ELSE}
finalization
FreeAndNil(IndyWebRequestHandler);
{$ENDIF}
end.
Reference in New Issue View Git Blame Copy Permalink