mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-11-13 15:39:33 +01:00
* Rework header treatment, deprecated some calls/properties
git-svn-id: trunk@30550 -
This commit is contained in:
michael
parent
9559dabe51
commit
4769a5407c
2
.gitattributes
vendored
2
.gitattributes
vendored
@ -3149,6 +3149,7 @@ packages/fcl-web/src/base/Makefile svneol=native#text/plain
|
||||
packages/fcl-web/src/base/Makefile.fpc svneol=native#text/plain
|
||||
packages/fcl-web/src/base/README.txt svneol=native#text/plain
|
||||
packages/fcl-web/src/base/cgiapp.pp svneol=native#text/plain
|
||||
packages/fcl-web/src/base/cgiprotocol.pp svneol=native#text/plain
|
||||
packages/fcl-web/src/base/custcgi.pp svneol=native#text/plain
|
||||
packages/fcl-web/src/base/custfcgi.pp svneol=native#text/plain
|
||||
packages/fcl-web/src/base/custhttpapp.pp svneol=native#text/plain
|
||||
@ -3169,6 +3170,7 @@ packages/fcl-web/src/base/fphttpstatus.pas svneol=native#text/plain
|
||||
packages/fcl-web/src/base/fpweb.pp svneol=native#text/plain
|
||||
packages/fcl-web/src/base/fpwebfile.pp svneol=native#text/plain
|
||||
packages/fcl-web/src/base/httpdefs.pp svneol=native#text/plain
|
||||
packages/fcl-web/src/base/httpprotocol.pp svneol=native#text/plain
|
||||
packages/fcl-web/src/base/iniwebsession.pp svneol=native#text/plain
|
||||
packages/fcl-web/src/base/webpage.pp svneol=native#text/plain
|
||||
packages/fcl-web/src/base/websession.pp svneol=native#text/plain
|
||||
|
||||
@ -48,6 +48,8 @@ begin
|
||||
T.ResourceStrings:=true;
|
||||
with T.Dependencies do
|
||||
begin
|
||||
AddUnit('httpprotocol');
|
||||
AddUnit('cgiprotocol');
|
||||
AddUnit('httpdefs');
|
||||
end;
|
||||
T:=P.Targets.AddUnit('ezcgi.pp');
|
||||
@ -83,7 +85,12 @@ begin
|
||||
AddUnit('fphttp');
|
||||
AddUnit('websession');
|
||||
end;
|
||||
T:=P.Targets.AddUnit('httpprotocol.pp');
|
||||
T:=P.Targets.AddUnit('cgiprotocol.pp');
|
||||
|
||||
T:=P.Targets.AddUnit('httpdefs.pp');
|
||||
T.Dependencies.AddUnit('httpprotocol');
|
||||
|
||||
T.ResourceStrings:=true;
|
||||
T:=P.Targets.AddUnit('iniwebsession.pp');
|
||||
T.ResourceStrings:=true;
|
||||
@ -122,6 +129,9 @@ begin
|
||||
with P.Targets.AddUnit('custfcgi.pp') do
|
||||
begin
|
||||
OSes:=AllOses-[wince,darwin,iphonesim,aix,amiga,aros];
|
||||
Dependencies.AddUnit('httpprotocol');
|
||||
Dependencies.AddUnit('cgiprotocol');
|
||||
Dependencies.AddUnit('custcgi');
|
||||
Dependencies.AddUnit('httpdefs');
|
||||
Dependencies.AddUnit('custweb');
|
||||
ResourceStrings:=true;
|
||||
@ -129,6 +139,7 @@ begin
|
||||
with P.Targets.AddUnit('fpapache.pp') do
|
||||
begin
|
||||
OSes:=AllOses-[amiga,aros];
|
||||
Dependencies.AddUnit('httpprotocol');
|
||||
Dependencies.AddUnit('fphttp');
|
||||
Dependencies.AddUnit('custweb');
|
||||
ResourceStrings:=true;
|
||||
|
||||
80
packages/fcl-web/src/base/cgiprotocol.pp
Normal file
80
packages/fcl-web/src/base/cgiprotocol.pp
Normal file
@ -0,0 +1,80 @@
|
||||
unit cgiprotocol;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
Const
|
||||
CGIVarCount = 44 ;
|
||||
|
||||
Type
|
||||
TCGIVarArray = Array[1..CGIVarCount] of String;
|
||||
|
||||
Const
|
||||
CgiVarNames : TCGIVarArray =
|
||||
({ 1 } 'AUTH_TYPE',
|
||||
{ 2 } 'CONTENT_LENGTH',
|
||||
{ 3 } 'CONTENT_TYPE',
|
||||
{ 4 } 'GATEWAY_INTERFACE',
|
||||
{ 5 } 'PATH_INFO',
|
||||
{ 6 } 'PATH_TRANSLATED',
|
||||
{ 7 } 'QUERY_STRING',
|
||||
{ 8 } 'REMOTE_ADDR',
|
||||
{ 9 } 'REMOTE_HOST',
|
||||
{ 10 } 'REMOTE_IDENT',
|
||||
{ 11 } 'REMOTE_USER',
|
||||
{ 12 } 'REQUEST_METHOD',
|
||||
{ 13 } 'SCRIPT_NAME',
|
||||
{ 14 } 'SERVER_NAME',
|
||||
{ 15 } 'SERVER_PORT',
|
||||
{ 16 } 'SERVER_PROTOCOL',
|
||||
{ 17 } 'SERVER_SOFTWARE',
|
||||
{ 18 } 'HTTP_ACCEPT',
|
||||
{ 19 } 'HTTP_ACCEPT_CHARSET',
|
||||
{ 20 } 'HTTP_ACCEPT_ENCODING',
|
||||
{ 21 } 'HTTP_IF_MODIFIED_SINCE',
|
||||
{ 22 } 'HTTP_REFERER',
|
||||
{ 23 } 'HTTP_USER_AGENT',
|
||||
{ 24 } 'HTTP_COOKIE',
|
||||
|
||||
// Additional Apache vars
|
||||
{ 25 } 'HTTP_CONNECTION',
|
||||
{ 26 } 'HTTP_ACCEPT_LANGUAGE',
|
||||
{ 27 } 'HTTP_HOST',
|
||||
{ 28 } 'SERVER_SIGNATURE',
|
||||
{ 29 } 'SERVER_ADDR',
|
||||
{ 30 } 'DOCUMENT_ROOT',
|
||||
{ 31 } 'SERVER_ADMIN',
|
||||
{ 32 } 'SCRIPT_FILENAME',
|
||||
{ 33 } 'REMOTE_PORT',
|
||||
{ 34 } 'REQUEST_URI',
|
||||
{ 35 } 'CONTENT',
|
||||
{ 36 } 'HTTP_X_REQUESTED_WITH',
|
||||
{ 37 } 'HTTP_AUTHORIZATION',
|
||||
{ 38 } 'SCRIPT_URI',
|
||||
{ 39 } 'SCRIPT_URL',
|
||||
{ 40 } 'CONTEXT_DOCUMENT_ROOT',
|
||||
{ 41 } 'CONTEXT_PREFIX',
|
||||
{ 42 } 'HTTP_CACHE_CONTROL',
|
||||
{ 43 } 'HTTP_PRAGMA',
|
||||
{ 44 } 'REQUEST_SCHEME'
|
||||
);
|
||||
|
||||
Function IndexOfCGIVar(AVarName: String): Integer;
|
||||
|
||||
implementation
|
||||
|
||||
uses sysutils;
|
||||
|
||||
Function IndexOfCGIVar(AVarName: String): Integer;
|
||||
|
||||
begin
|
||||
Result:=CGIVarCount;
|
||||
While (Result>0) and (CompareText(AVarName,CgiVarNames[Result])<>0) do
|
||||
Dec(Result);
|
||||
If Result<1 then
|
||||
Result:=-1;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@ -21,7 +21,7 @@ unit custcgi;
|
||||
Interface
|
||||
|
||||
uses
|
||||
CustWeb,Classes,SysUtils, httpdefs;
|
||||
CustWeb, Classes,SysUtils, httpdefs, cgiprotocol, httpprotocol;
|
||||
|
||||
Type
|
||||
{ TCGIRequest }
|
||||
@ -36,7 +36,8 @@ Type
|
||||
FOnContentRead: TCGIContentReadEvent;
|
||||
function GetCGIVar(Index: integer): String;
|
||||
Protected
|
||||
Function GetFieldValue(Index : Integer) : String; override;
|
||||
Function DoMapCgiToHTTP(Const AVariableName : String; Out AHeaderType : THeader; Out AVariableType : THTTPVariableType) : Boolean;
|
||||
function DoGetCGIVar(AVarName: String): String; virtual;
|
||||
Procedure InitFromEnvironment; virtual;
|
||||
// Read content from stdin. Calls DoContentRead to see if reading must be aborted.
|
||||
procedure ReadContent; override;
|
||||
@ -45,16 +46,30 @@ Type
|
||||
Function DoContentRead(B : PByte; Len : Integer) : Boolean; virtual;
|
||||
Public
|
||||
Constructor CreateCGI(ACGI : TCGIHandler);
|
||||
Function GetCustomHeader(const Name: String) : String; override;
|
||||
Property OnContentRead : TCGIContentReadEvent Read FOnContentRead Write FOnContentRead;
|
||||
Property GatewayInterface : String Index 1 Read GetCGIVar;
|
||||
Property RemoteIdent : String Index 2 read GetCGIVar;
|
||||
Property RemoteUser : String Index 3 read GetCGIVar;
|
||||
Property RequestMethod : String Index 4 read GetCGIVar;
|
||||
Property ServerName : String Index 5 read GetCGIVar;
|
||||
Property ServerProtocol : String Index 6 read GetCGIVar;
|
||||
Property ServerSoftware : String Index 7 read GetCGIVar;
|
||||
// Index is index in CGIVarnames array.
|
||||
Property GatewayInterface : String Index 4 Read GetCGIVar;
|
||||
Property RemoteIdent : String Index 10 read GetCGIVar;
|
||||
Property RemoteUser : String Index 11 read GetCGIVar;
|
||||
Property RequestMethod : String Index 12 read GetCGIVar;
|
||||
Property ServerName : String Index 14 read GetCGIVar;
|
||||
Property ServerProtocol : String Index 16 read GetCGIVar;
|
||||
Property ServerSoftware : String Index 17 read GetCGIVar;
|
||||
Property ServerSignature : String Index 28 Read GetCGIVar;
|
||||
Property ServerAddr : String Index 29 Read GetCGIVar;
|
||||
Property DocumentRoot : String Index 30 Read GetCGIVar;
|
||||
Property ServerAdmin : String Index 31 Read GetCGIVar;
|
||||
Property ScriptFileName : String Index 32 Read GetCGIVar;
|
||||
Property RemotePort : String Index 33 Read GetCGIVar;
|
||||
Property RequestURI : String Index 34 Read GetCGIVar;
|
||||
Property ScriptURI : String Index 38 Read GetCGIVar;
|
||||
Property ContextDocumentRoot : String Index 40 Read GetCGIVar;
|
||||
Property ContextPrefix : String Index 41 Read GetCGIVar;
|
||||
Property RequestScheme : String Index 44 Read GetCGIVar;
|
||||
end;
|
||||
TCGIRequestClass = Class of TCGIRequest;
|
||||
|
||||
{ TCGIResponse }
|
||||
|
||||
TCGIResponse = Class(TResponse)
|
||||
@ -139,53 +154,61 @@ uses
|
||||
{$endif}
|
||||
iostream;
|
||||
|
||||
Type
|
||||
TMap = record
|
||||
h : THeader;
|
||||
v : THTTPVariableType;
|
||||
end;
|
||||
TCGIHeaderMap = Array[1..CGIVarCount] of TMap;
|
||||
|
||||
Const
|
||||
MapCgiToHTTP : TCGIVarArray =
|
||||
({ 1: 'AUTH_TYPE' } fieldWWWAuthenticate, // ?
|
||||
{ 2: 'CONTENT_LENGTH' } FieldContentLength,
|
||||
{ 3: 'CONTENT_TYPE' } FieldContentType,
|
||||
{ 4: 'GATEWAY_INTERFACE' } '',
|
||||
{ 5: 'PATH_INFO' } '',
|
||||
{ 6: 'PATH_TRANSLATED' } '',
|
||||
{ 7: 'QUERY_STRING' } '',
|
||||
{ 8: 'REMOTE_ADDR' } '',
|
||||
{ 9: 'REMOTE_HOST' } '',
|
||||
{ 10: 'REMOTE_IDENT' } '',
|
||||
{ 11: 'REMOTE_USER' } '',
|
||||
{ 12: 'REQUEST_METHOD' } '',
|
||||
{ 13: 'SCRIPT_NAME' } '',
|
||||
{ 14: 'SERVER_NAME' } '',
|
||||
{ 15: 'SERVER_PORT' } '',
|
||||
{ 16: 'SERVER_PROTOCOL' } '',
|
||||
{ 17: 'SERVER_SOFTWARE' } '',
|
||||
{ 18: 'HTTP_ACCEPT' } FieldAccept,
|
||||
{ 19: 'HTTP_ACCEPT_CHARSET' } FieldAcceptCharset,
|
||||
{ 20: 'HTTP_ACCEPT_ENCODING' } FieldAcceptEncoding,
|
||||
{ 21: 'HTTP_IF_MODIFIED_SINCE' } FieldIfModifiedSince,
|
||||
{ 22: 'HTTP_REFERER' } FieldReferer,
|
||||
{ 23: 'HTTP_USER_AGENT' } FieldUserAgent,
|
||||
{ 24: 'HTTP_COOKIE' } FieldCookie,
|
||||
|
||||
MapCgiToHTTP : TCGIHeaderMap =
|
||||
({ 1: 'AUTH_TYPE' } (h : hhWWWAuthenticate; v : hvUnknown), // ?
|
||||
{ 2: 'CONTENT_LENGTH' } (h : hhContentLength; v : hvUnknown),
|
||||
{ 3: 'CONTENT_TYPE' } (h : hhContentType; v : hvUnknown),
|
||||
{ 4: 'GATEWAY_INTERFACE' } (h:hhUnknown; v : hvUnknown),
|
||||
{ 5: 'PATH_INFO' } (h:hhUnknown; v : hvPathInfo),
|
||||
{ 6: 'PATH_TRANSLATED' } (h:hhUnknown; v : hvPathTranslated),
|
||||
{ 7: 'QUERY_STRING' } (h:hhUnknown; v : hvQuery),
|
||||
{ 8: 'REMOTE_ADDR' } (h:hhUnknown; v : hvRemoteAddress),
|
||||
{ 9: 'REMOTE_HOST' } (h:hhUnknown; v : hvRemoteHost),
|
||||
{ 10: 'REMOTE_IDENT' } (h:hhUnknown; v : hvUnknown),
|
||||
{ 11: 'REMOTE_USER' } (h:hhUnknown; v : hvUnknown),
|
||||
{ 12: 'REQUEST_METHOD' } (h:hhUnknown; v : hvMethod),
|
||||
{ 13: 'SCRIPT_NAME' } (h:hhUnknown; v : hvScriptName),
|
||||
{ 14: 'SERVER_NAME' } (h:hhServer; v : hvUnknown),
|
||||
{ 15: 'SERVER_PORT' } (h:hhUnknown; v : hvServerPort),
|
||||
{ 16: 'SERVER_PROTOCOL' } (h:hhUnknown; v : hvUnknown),
|
||||
{ 17: 'SERVER_SOFTWARE' } (h:hhUnknown; v : hvUnknown),
|
||||
{ 18: 'HTTP_ACCEPT' } (h:hhAccept; v : hvUnknown),
|
||||
{ 19: 'HTTP_ACCEPT_CHARSET' } (h:hhAcceptCharset; v : hvUnknown),
|
||||
{ 20: 'HTTP_ACCEPT_ENCODING' } (h:hhAcceptEncoding; v : hvUnknown),
|
||||
{ 21: 'HTTP_IF_MODIFIED_SINCE' } (h:hhIfModifiedSince; v : hvUnknown),
|
||||
{ 22: 'HTTP_REFERER' } (h:hhReferer; v : hvUnknown),
|
||||
{ 23: 'HTTP_USER_AGENT' } (h:hhUserAgent; v : hvUnknown),
|
||||
{ 24: 'HTTP_COOKIE' } (h:hhUnknown; v : hvCookie),
|
||||
// Additional Apache vars
|
||||
{ 25: 'HTTP_CONNECTION' } FieldConnection,
|
||||
{ 26: 'HTTP_ACCEPT_LANGUAGE' } FieldAcceptLanguage,
|
||||
{ 27: 'HTTP_HOST' } '',
|
||||
{ 28: 'SERVER_SIGNATURE' } '',
|
||||
{ 29: 'SERVER_ADDR' } '',
|
||||
{ 30: 'DOCUMENT_ROOT' } '',
|
||||
{ 31: 'SERVER_ADMIN' } '',
|
||||
{ 32: 'SCRIPT_FILENAME' } '',
|
||||
{ 33: 'REMOTE_PORT' } '',
|
||||
{ 34: 'REQUEST_URI' } '',
|
||||
{ 35: 'CONTENT' } '',
|
||||
{ 36: 'XHTTPREQUESTEDWITH' } '',
|
||||
{ 37: 'HTTP_AUTHORIZATION' } FieldAuthorization,
|
||||
{ 38: 'SCRIPT_URI' } '',
|
||||
{ 39: 'SCRIPT_URL' } '',
|
||||
{ 40: 'CONTEXT_DOCUMENT_ROOT' } '',
|
||||
{ 41: 'CONTEXT_PREFIX' } '',
|
||||
{ 42: 'HTTP_CACHE_CONTROL' } '',
|
||||
{ 43: 'HTTP_PRAGMA' } '',
|
||||
{ 44: 'REQUEST_SCHEME' } ''
|
||||
{ 25: 'HTTP_CONNECTION' } (h:hhConnection; v : hvUnknown),
|
||||
{ 26: 'HTTP_ACCEPT_LANGUAGE' } (h:hhAcceptLanguage; v : hvUnknown),
|
||||
{ 27: 'HTTP_HOST' } (h:hhHost; v : hvUnknown),
|
||||
{ 28: 'SERVER_SIGNATURE' } (h:hhUnknown; v : hvUnknown),
|
||||
{ 29: 'SERVER_ADDR' } (h:hhUnknown; v : hvUnknown),
|
||||
{ 30: 'DOCUMENT_ROOT' } (h:hhUnknown; v : hvUnknown),
|
||||
{ 31: 'SERVER_ADMIN' } (h:hhUnknown; v : hvUnknown),
|
||||
{ 32: 'SCRIPT_FILENAME' } (h:hhUnknown; v : hvUnknown),
|
||||
{ 33: 'REMOTE_PORT' } (h:hhUnknown; v : hvUnknown),
|
||||
{ 34: 'REQUEST_URI' } (h:hhUnknown; v : hvUnknown),
|
||||
{ 35: 'CONTENT' } (h:hhUnknown; v : hvContent),
|
||||
{ 36: 'XHTTPREQUESTEDWITH' } (h:hhUnknown; v : hvXRequestedWith),
|
||||
{ 37: 'HTTP_AUTHORIZATION' } (h:hhAuthorization; v : hvUnknown),
|
||||
{ 38: 'SCRIPT_URI' } (h:hhUnknown; v : hvUnknown),
|
||||
{ 39: 'SCRIPT_URL' } (h:hhUnknown; v : hvURL),
|
||||
{ 40: 'CONTEXT_DOCUMENT_ROOT' } (h:hhUnknown; v : hvUnknown),
|
||||
{ 41: 'CONTEXT_PREFIX' } (h:hhUnknown; v : hvUnknown),
|
||||
{ 42: 'HTTP_CACHE_CONTROL' } (h:hhCacheControl; v : hvUnknown),
|
||||
{ 43: 'HTTP_PRAGMA' } (h:hhPragma; v : hvUnknown),
|
||||
{ 44: 'REQUEST_SCHEME' } (h:hhUnknown; v : hvUnknown)
|
||||
);
|
||||
|
||||
procedure TCgiHandler.GetCGIVarList(List: TStrings);
|
||||
@ -282,7 +305,20 @@ begin
|
||||
FCGI:=ACGI;
|
||||
end;
|
||||
|
||||
function TCGIRequest.GetCustomHeader(const Name: String): String;
|
||||
begin
|
||||
Result:=inherited GetCustomHeader(Name);
|
||||
// Check environment
|
||||
if (Result='') then
|
||||
Result:=DoGetCGIVAr('HTTP_'+StringReplace(Uppercase(Name),'-','_',[rfReplaceAll]));
|
||||
end;
|
||||
|
||||
{ TCGIHTTPRequest }
|
||||
function TCGIRequest.DoGetCGIVar(AVarName : String) : String;
|
||||
|
||||
begin
|
||||
GetEnvironmentVariable(AVarName);
|
||||
end;
|
||||
|
||||
function TCGIRequest.GetCGIVar(Index: integer): String;
|
||||
|
||||
@ -290,41 +326,51 @@ Var
|
||||
R : String;
|
||||
|
||||
begin
|
||||
Case Index of
|
||||
1 : R:=GetEnvironmentVariable(CGIVarNames[4]); // Property GatewayInterface : String Index 1 Read GetCGIVar;
|
||||
2 : R:=GetEnvironmentVariable(CGIVarNames[10]); // Property RemoteIdent : String Index 2 read GetCGIVar;
|
||||
3 : R:=GetEnvironmentVariable(CGIVarNames[11]); // Property RemoteUser : String Index 3 read GetCGIVar;
|
||||
4 : R:=GetEnvironmentVariable(CGIVarNames[12]); // Property RequestMethod : String Index 4 read GetCGIVar;
|
||||
5 : R:=GetEnvironmentVariable(CGIVarNames[14]); // Property ServerName : String Index 5 read GetCGIVar;
|
||||
6 : R:=GetEnvironmentVariable(CGIVarNames[16]); // Property ServerProtocol : String Index 6 read GetCGIVar;
|
||||
7 : R:=GetEnvironmentVariable(CGIVarNames[17]); // Property ServerSoftware : String Index 7 read GetCGIVar;
|
||||
end;
|
||||
if Index in [1..CGIVarCount] then
|
||||
R:=DoGetCGIVar(CGIVarNames[Index])
|
||||
else
|
||||
R:='';
|
||||
Result:=HTTPDecode(R);
|
||||
end;
|
||||
|
||||
function TCGIRequest.DoMapCgiToHTTP(const AVariableName: String; out
|
||||
AHeaderType: THeader; Out AVariableType: THTTPVariableType): Boolean;
|
||||
Var
|
||||
I : Integer;
|
||||
begin
|
||||
I:=IndexOfCGIVar(AVariableName);
|
||||
Result:=I<>-1;
|
||||
if Result then
|
||||
begin
|
||||
AHeaderType:=MapCgiToHTTP[i].H;
|
||||
AVariableType:=MapCgiToHTTP[i].V;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCGIRequest.InitFromEnvironment;
|
||||
|
||||
|
||||
Var
|
||||
I : Integer;
|
||||
N,V,OV : String;
|
||||
|
||||
V,OV : String;
|
||||
M : TMap;
|
||||
|
||||
begin
|
||||
For I:=1 to CGIVarCount do
|
||||
begin
|
||||
N:=MapCgiToHTTP[i];
|
||||
if (N<>'') then
|
||||
begin
|
||||
OV:=GetFieldByName(N);
|
||||
V:=GetEnvironmentVariable(CGIVarNames[I]);
|
||||
If (OV='') or (V<>'') then
|
||||
if (V<>'') then
|
||||
begin
|
||||
if (N<>'QUERY_STRING') then
|
||||
M:=MapCgiToHTTP[i];
|
||||
if M.H<>hhUnknown then
|
||||
SetHeader(M.H,HTTPDecode(V))
|
||||
else if M.V<>hvUnknown then
|
||||
begin
|
||||
if M.V<>hvQuery then
|
||||
V:=HTTPDecode(V);
|
||||
SetFieldByName(N,V);
|
||||
end;
|
||||
SetHTTPVariable(M.V,V)
|
||||
end;
|
||||
end
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -390,35 +436,6 @@ begin
|
||||
FOnContentRead(Self,B,Len,Result);
|
||||
end;
|
||||
|
||||
function TCGIRequest.GetFieldValue(Index: Integer): String;
|
||||
|
||||
Function DecodeVar(I : Integer; DoDecode : Boolean = true) : String;
|
||||
|
||||
begin
|
||||
Result:=GetEnvironmentVariable(CGIVarNames[I]);
|
||||
if DoDecode then
|
||||
Result:=HttpDecode(Result)
|
||||
end;
|
||||
|
||||
begin
|
||||
Case Index of
|
||||
21,
|
||||
34 : Result:=DecodeVar(14); // Property ServerName and Host
|
||||
25 : Result:=Decodevar(5); // Property PathInfo
|
||||
26 : Result:=DecodeVar(6); // Property PathTranslated
|
||||
27 : Result:=DecodeVar(8); // Property RemoteAddress
|
||||
28 : Result:=DecodeVar(9); // Property RemoteHost
|
||||
29 : Result:=DecodeVar(13); // Property ScriptName
|
||||
30 : Result:=DecodeVar(15); // Property ServerPort
|
||||
31 : Result:=DecodeVar(12); // Property RequestMethod
|
||||
32 : Result:=DecodeVar(34); // Property URI
|
||||
33 : Result:=DecodeVar(7,False); // Property QueryString
|
||||
36 : Result:=DecodeVar(36); // Property XRequestedWith
|
||||
else
|
||||
Result:=Inherited GetFieldValue(Index);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{ TCGIResponse }
|
||||
|
||||
|
||||
@ -36,7 +36,7 @@ uses
|
||||
{$else}
|
||||
winsock2, windows,
|
||||
{$endif}
|
||||
Sockets, custweb, custcgi, fastcgi;
|
||||
Sockets, custweb, cgiprotocol, httpprotocol, custcgi, fastcgi;
|
||||
|
||||
Type
|
||||
{ TFCGIRequest }
|
||||
@ -62,11 +62,10 @@ Type
|
||||
FUR: TUnknownRecordEvent;
|
||||
FLog : TLogEvent;
|
||||
FSTDin : String;
|
||||
procedure GetNameValuePairsFromContentRecord(const ARecord : PFCGI_ContentRecord; NameValueList : TStrings);
|
||||
Protected
|
||||
function DoGetCGIVar(AVarName: String): String; override;
|
||||
procedure GetNameValuePairsFromContentRecord(const ARecord : PFCGI_ContentRecord; NameValueList : TStrings); virtual;
|
||||
Procedure Log(EventType : TEventType; Const Msg : String);
|
||||
Function GetFieldValue(Index : Integer) : String; override;
|
||||
procedure ReadContent; override;
|
||||
Public
|
||||
destructor Destroy; override;
|
||||
function ProcessFCGIRecord(AFCGIRecord : PFCGI_Header) : boolean; virtual;
|
||||
@ -240,11 +239,6 @@ end;
|
||||
|
||||
{ TFCGIHTTPRequest }
|
||||
|
||||
procedure TFCGIRequest.ReadContent;
|
||||
begin
|
||||
// Nothing has to be done. This should never be called
|
||||
end;
|
||||
|
||||
destructor TFCGIRequest.Destroy;
|
||||
begin
|
||||
FCGIParams.Free;
|
||||
@ -297,6 +291,11 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TFCGIRequest.DoGetCGIVar(AVarName: String): String;
|
||||
begin
|
||||
Result:=FCGIParams.Values[AVarName];
|
||||
end;
|
||||
|
||||
procedure TFCGIRequest.GetNameValuePairsFromContentRecord(const ARecord: PFCGI_ContentRecord; NameValueList: TStrings);
|
||||
|
||||
var
|
||||
@ -327,21 +326,44 @@ var
|
||||
end;
|
||||
|
||||
var
|
||||
NameLength, ValueLength : Integer;
|
||||
VarNo,NameLength, ValueLength : Integer;
|
||||
RecordLength : Integer;
|
||||
Name,Value : String;
|
||||
h : THeader;
|
||||
v : THTTPVariableType;
|
||||
|
||||
begin
|
||||
Touch('pairs-enter');
|
||||
i := 0;
|
||||
RecordLength:=BetoN(ARecord^.Header.contentLength);
|
||||
while i < RecordLength do
|
||||
begin
|
||||
NameLength:=GetVarLength;
|
||||
ValueLength:=GetVarLength;
|
||||
|
||||
Name:=GetString(NameLength);
|
||||
Value:=GetString(ValueLength);
|
||||
NameValueList.Add(Name+'='+Value);
|
||||
VarNo:=IndexOfCGIVar(Name);
|
||||
Touch('pairs_'+Name+'__'+Value);
|
||||
if Not DoMapCgiToHTTP(Name,H,V) then
|
||||
NameValueList.Add(Name+'='+Value)
|
||||
else if (H<>hhUnknown) then
|
||||
SetHeader(H,Value)
|
||||
else if (v<>hvUnknown) then
|
||||
begin
|
||||
Touch('pairs_var_'+Name+'__'+Value);
|
||||
if (V=hvPathInfo) and (Copy(Value,1,2)='//') then //mod_proxy_fcgi gives double slashes at the beginning for some reason
|
||||
Delete(Value,1,3);
|
||||
if (V<>hvQuery) then
|
||||
Value:=HTTPDecode(Value);
|
||||
SetHTTPVariable(v,Value);
|
||||
Touch('pairs_var_done_'+Name+'__'+Value);
|
||||
end
|
||||
else
|
||||
begin
|
||||
Touch('pairs_other_'+Name+'__'+Value);
|
||||
NameValueList.Add(Name+'='+Value)
|
||||
end;
|
||||
Inc(I);
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -351,74 +373,8 @@ begin
|
||||
FLog(EventType,Msg);
|
||||
end;
|
||||
|
||||
|
||||
Function TFCGIRequest.GetFieldValue(Index : Integer) : String;
|
||||
|
||||
Type THttpToCGI = array[1..37] of byte;
|
||||
|
||||
const HttpToCGI : THttpToCGI =
|
||||
(
|
||||
18, // 1 'HTTP_ACCEPT' - field Accept
|
||||
19, // 2 'HTTP_ACCEPT_CHARSET' - field AcceptCharset
|
||||
20, // 3 'HTTP_ACCEPT_ENCODING' - field AcceptEncoding
|
||||
26, // 4 'HTTP_ACCEPT_LANGUAGE' - field AcceptLanguage
|
||||
37, // 5 HTTP_AUTHORIZATION - field Authorization
|
||||
0, // 6
|
||||
0, // 7
|
||||
0, // 8
|
||||
2, // 9 'CONTENT_LENGTH'
|
||||
3, // 10 'CONTENT_TYPE' - fieldAcceptEncoding
|
||||
24, // 11 'HTTP_COOKIE' - fieldCookie
|
||||
0, // 12
|
||||
0, // 13
|
||||
0, // 14
|
||||
21, // 15 'HTTP_IF_MODIFIED_SINCE'- fieldIfModifiedSince
|
||||
0, // 16
|
||||
0, // 17
|
||||
0, // 18
|
||||
22, // 19 'HTTP_REFERER' - fieldReferer
|
||||
0, // 20
|
||||
0, // 21
|
||||
0, // 22
|
||||
23, // 23 'HTTP_USER_AGENT' - fieldUserAgent
|
||||
1, // 24 'AUTH_TYPE' - fieldWWWAuthenticate
|
||||
5, // 25 'PATH_INFO'
|
||||
6, // 26 'PATH_TRANSLATED'
|
||||
8, // 27 'REMOTE_ADDR'
|
||||
9, // 28 'REMOTE_HOST'
|
||||
13, // 29 'SCRIPT_NAME'
|
||||
15, // 30 'SERVER_PORT'
|
||||
12, // 31 'REQUEST_METHOD'
|
||||
0, // 32
|
||||
7, // 33 'QUERY_STRING'
|
||||
27, // 34 'HTTP_HOST'
|
||||
0, // 35 'CONTENT'
|
||||
36, // 36 'XHTTPREQUESTEDWITH'
|
||||
37 // 37 'HTTP_AUTHORIZATION'
|
||||
);
|
||||
|
||||
var ACgiVarNr : Integer;
|
||||
|
||||
begin
|
||||
|
||||
Result := '';
|
||||
if assigned(FCGIParams) and (index <= high(HttpToCGI)) and (index > 0) and (index<>35) then
|
||||
begin
|
||||
ACgiVarNr:=HttpToCGI[Index];
|
||||
if ACgiVarNr>0 then
|
||||
begin
|
||||
Result:=FCGIParams.Values[CgiVarNames[ACgiVarNr]];
|
||||
if (ACgiVarNr = 5) and //PATH_INFO
|
||||
(length(Result)>=2)and(word(Pointer(@Result[1])^)=$2F2F)then //mod_proxy_fcgi gives double slashes at the beginning for some reason
|
||||
Delete(Result, 1, 1); //Remove the extra first one
|
||||
end else
|
||||
Result := '';
|
||||
end
|
||||
else
|
||||
Result:=inherited GetFieldValue(Index);
|
||||
end;
|
||||
|
||||
{ TCGIResponse }
|
||||
|
||||
procedure TFCGIResponse.Write_FCGIRecord(ARecord : PFCGI_Header);
|
||||
|
||||
var ErrorCode,
|
||||
|
||||
@ -23,65 +23,7 @@ Interface
|
||||
uses
|
||||
CustApp,Classes,SysUtils, httpdefs, fphttp, eventlog;
|
||||
|
||||
Const
|
||||
CGIVarCount = 44 ;
|
||||
|
||||
Type
|
||||
TCGIVarArray = Array[1..CGIVarCount] of String;
|
||||
|
||||
Const
|
||||
CgiVarNames : TCGIVarArray =
|
||||
({ 1 } 'AUTH_TYPE',
|
||||
{ 2 } 'CONTENT_LENGTH',
|
||||
{ 3 } 'CONTENT_TYPE',
|
||||
{ 4 } 'GATEWAY_INTERFACE',
|
||||
{ 5 } 'PATH_INFO',
|
||||
{ 6 } 'PATH_TRANSLATED',
|
||||
{ 7 } 'QUERY_STRING',
|
||||
{ 8 } 'REMOTE_ADDR',
|
||||
{ 9 } 'REMOTE_HOST',
|
||||
{ 10 } 'REMOTE_IDENT',
|
||||
{ 11 } 'REMOTE_USER',
|
||||
{ 12 } 'REQUEST_METHOD',
|
||||
{ 13 } 'SCRIPT_NAME',
|
||||
{ 14 } 'SERVER_NAME',
|
||||
{ 15 } 'SERVER_PORT',
|
||||
{ 16 } 'SERVER_PROTOCOL',
|
||||
{ 17 } 'SERVER_SOFTWARE',
|
||||
{ 18 } 'HTTP_ACCEPT',
|
||||
{ 19 } 'HTTP_ACCEPT_CHARSET',
|
||||
{ 20 } 'HTTP_ACCEPT_ENCODING',
|
||||
{ 21 } 'HTTP_IF_MODIFIED_SINCE',
|
||||
{ 22 } 'HTTP_REFERER',
|
||||
{ 23 } 'HTTP_USER_AGENT',
|
||||
{ 24 } 'HTTP_COOKIE',
|
||||
|
||||
// Additional Apache vars
|
||||
{ 25 } 'HTTP_CONNECTION',
|
||||
{ 26 } 'HTTP_ACCEPT_LANGUAGE',
|
||||
{ 27 } 'HTTP_HOST',
|
||||
{ 28 } 'SERVER_SIGNATURE',
|
||||
{ 29 } 'SERVER_ADDR',
|
||||
{ 30 } 'DOCUMENT_ROOT',
|
||||
{ 31 } 'SERVER_ADMIN',
|
||||
{ 32 } 'SCRIPT_FILENAME',
|
||||
{ 33 } 'REMOTE_PORT',
|
||||
{ 34 } 'REQUEST_URI',
|
||||
{ 35 } 'CONTENT',
|
||||
{ 36 } 'HTTP_X_REQUESTED_WITH',
|
||||
{ 37 } 'HTTP_AUTHORIZATION',
|
||||
{ 38 } 'SCRIPT_URI',
|
||||
{ 39 } 'SCRIPT_URL',
|
||||
{ 40 } 'CONTEXT_DOCUMENT_ROOT',
|
||||
{ 41 } 'CONTEXT_PREFIX',
|
||||
{ 42 } 'HTTP_CACHE_CONTROL',
|
||||
{ 43 } 'HTTP_PRAGMA',
|
||||
{ 44 } 'REQUEST_SCHEME'
|
||||
|
||||
);
|
||||
|
||||
Type
|
||||
|
||||
{ TCustomWebApplication }
|
||||
|
||||
TGetModuleEvent = Procedure (Sender : TObject; ARequest : TRequest;
|
||||
|
||||
@ -18,7 +18,7 @@ unit fpapache;
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils,Classes,CustWeb,httpDefs,fpHTTP,httpd, apr, SyncObjs;
|
||||
SysUtils,Classes,CustWeb,httpDefs,fpHTTP,httpd,httpprotocol, apr, SyncObjs;
|
||||
|
||||
Type
|
||||
|
||||
@ -31,11 +31,11 @@ Type
|
||||
FApache : TApacheHandler;
|
||||
FRequest : PRequest_rec;
|
||||
Protected
|
||||
Function GetFieldValue(Index : Integer) : String; override;
|
||||
Procedure InitFromRequest;
|
||||
procedure ReadContent; override;
|
||||
Public
|
||||
Constructor CreateReq(App : TApacheHandler; ARequest : PRequest_rec);
|
||||
Function GetCustomHeader(const Name: String) : String; override;
|
||||
Property ApacheRequest : Prequest_rec Read FRequest;
|
||||
Property ApacheApp : TApacheHandler Read FApache;
|
||||
end;
|
||||
@ -179,6 +179,12 @@ const
|
||||
HPRIO : Array[THandlerPriority] of Integer
|
||||
= (APR_HOOK_FIRST,APR_HOOK_MIDDLE,APR_HOOK_LAST);
|
||||
|
||||
Function MaybeP(P : Pchar) : String;
|
||||
|
||||
begin
|
||||
If (P<>Nil) then
|
||||
Result:=StrPas(P);
|
||||
end;
|
||||
|
||||
Procedure InitApache;
|
||||
|
||||
@ -448,60 +454,6 @@ end;
|
||||
|
||||
{ TApacheRequest }
|
||||
|
||||
function TApacheRequest.GetFieldValue(Index: Integer): String;
|
||||
|
||||
Function MaybeP(P : Pchar) : String;
|
||||
|
||||
begin
|
||||
If (P<>Nil) then
|
||||
Result:=StrPas(P);
|
||||
end;
|
||||
|
||||
var
|
||||
FN : String;
|
||||
I : Integer;
|
||||
|
||||
begin
|
||||
Result:='';
|
||||
If (Index in [1..NoHTTPFields]) then
|
||||
begin
|
||||
FN:=HTTPFieldNames[Index];
|
||||
Result:=MaybeP(apr_table_get(FRequest^.headers_in,pchar(FN)));
|
||||
end;
|
||||
if (Result='') and Assigned(FRequest) then
|
||||
case Index of
|
||||
0 : Result:=MaybeP(FRequest^.protocol); // ProtocolVersion
|
||||
7 : Result:=MaybeP(FRequest^.content_encoding); //ContentEncoding
|
||||
25 : Result:=MaybeP(FRequest^.path_info); // PathInfo
|
||||
26 : Result:=MaybeP(FRequest^.filename); // PathTranslated
|
||||
27 : // RemoteAddr
|
||||
If (FRequest^.Connection<>Nil) then
|
||||
Result:=MaybeP(FRequest^.Connection^.remote_ip);
|
||||
28 : // RemoteHost
|
||||
If (FRequest^.Connection<>Nil) then
|
||||
begin
|
||||
Result:=MaybeP(ap_get_remote_host(FRequest^.Connection,
|
||||
FRequest^.per_dir_config,
|
||||
// nil,
|
||||
REMOTE_NAME,@i));
|
||||
end;
|
||||
29 : begin // ScriptName
|
||||
Result:=MaybeP(FRequest^.unparsed_uri);
|
||||
I:=Pos('?',Result)-1;
|
||||
If (I=-1) then
|
||||
I:=Length(Result);
|
||||
Result:=Copy(Result,1,I-Length(PathInfo));
|
||||
end;
|
||||
30 : Result:=IntToStr(ap_get_server_port(FRequest)); // ServerPort
|
||||
31 : Result:=MaybeP(FRequest^.method); // Method
|
||||
32 : Result:=MaybeP(FRequest^.unparsed_uri); // URL
|
||||
33 : Result:=MaybeP(FRequest^.args); // Query
|
||||
34 : Result:=MaybeP(FRequest^.HostName); // Host
|
||||
else
|
||||
Result:=inherited GetFieldValue(Index);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TApacheRequest.ReadContent;
|
||||
|
||||
Function MinS(A,B : Integer) : Integer;
|
||||
@ -542,11 +494,46 @@ begin
|
||||
end;
|
||||
|
||||
procedure TApacheRequest.InitFromRequest;
|
||||
|
||||
|
||||
Var
|
||||
H : THeader;
|
||||
V : String;
|
||||
I : Integer;
|
||||
|
||||
begin
|
||||
ParseCookies;
|
||||
For H in THeader do
|
||||
begin
|
||||
V:=MaybeP(apr_table_get(FRequest^.headers_in,PAnsiChar(HTTPHeaderNames[h])));
|
||||
If (V<>'') then
|
||||
SetHeader(H,V);
|
||||
end;
|
||||
// Some Specials;
|
||||
SetHeader(hhContentEncoding,MaybeP(FRequest^.content_encoding));
|
||||
SetHTTPVariable(hvHTTPVersion,MaybeP(FRequest^.protocol));
|
||||
SetHTTPVariable(hvPathInfo,MaybeP(FRequest^.path_info));
|
||||
SetHTTPVariable(hvPathTranslated,MaybeP(FRequest^.filename));
|
||||
If (FRequest^.Connection<>Nil) then
|
||||
begin
|
||||
SetHTTPVariable(hvRemoteAddress,MaybeP(FRequest^.Connection^.remote_ip));
|
||||
SetHTTPVariable(hvRemoteHost,MaybeP(ap_get_remote_host(FRequest^.Connection,
|
||||
FRequest^.per_dir_config, REMOTE_NAME,@i)));
|
||||
end;
|
||||
V:=MaybeP(FRequest^.unparsed_uri);
|
||||
I:=Pos('?',V)-1;
|
||||
If (I=-1) then
|
||||
I:=Length(V);
|
||||
SetHTTPVariable(hvScriptName,Copy(V,1,I-Length(PathInfo)));
|
||||
SetHTTPVariable(hvServerPort,IntToStr(ap_get_server_port(FRequest)));
|
||||
SetHTTPVariable(hvMethod,MaybeP(FRequest^.method));
|
||||
SetHTTPVariable(hvURL,FRequest^.unparsed_uri);
|
||||
SetHTTPVariable(hvQuery,MaybeP(FRequest^.args));
|
||||
SetHeader(hhHost,MaybeP(FRequest^.HostName));
|
||||
end;
|
||||
|
||||
Constructor TApacheRequest.CreateReq(App : TApacheHandler; ARequest : PRequest_rec);
|
||||
constructor TApacheRequest.CreateReq(App: TApacheHandler; ARequest: PRequest_rec
|
||||
);
|
||||
|
||||
begin
|
||||
FApache:=App;
|
||||
@ -556,6 +543,13 @@ begin
|
||||
InitFromRequest;
|
||||
end;
|
||||
|
||||
function TApacheRequest.GetCustomHeader(const Name: String): String;
|
||||
begin
|
||||
Result:=inherited GetCustomHeader(Name);
|
||||
if Result='' then
|
||||
Result:=MaybeP(apr_table_get(FRequest^.headers_in,pchar(Name)));
|
||||
end;
|
||||
|
||||
{ TApacheResponse }
|
||||
|
||||
procedure TApacheResponse.DoSendHeaders(Headers: TStrings);
|
||||
|
||||
@ -29,52 +29,76 @@ unit HTTPDefs;
|
||||
|
||||
interface
|
||||
|
||||
uses Classes,Sysutils;
|
||||
uses typinfo,Classes, Sysutils, httpprotocol;
|
||||
|
||||
const
|
||||
DefaultTimeOut = 15;
|
||||
SFPWebSession = 'FPWebSession'; // Cookie name for session.
|
||||
|
||||
fieldAccept = 'Accept';
|
||||
fieldAcceptCharset = 'Accept-Charset';
|
||||
fieldAcceptEncoding = 'Accept-Encoding';
|
||||
fieldAcceptLanguage = 'Accept-Language';
|
||||
fieldAuthorization = 'Authorization';
|
||||
fieldConnection = 'Connection';
|
||||
fieldContentEncoding = 'Content-Encoding';
|
||||
fieldContentLanguage = 'Content-Language';
|
||||
fieldContentLength = 'Content-Length';
|
||||
fieldContentType = 'Content-Type';
|
||||
fieldCookie = 'Cookie';
|
||||
fieldDate = 'Date';
|
||||
fieldExpires = 'Expires';
|
||||
fieldFrom = 'From';
|
||||
fieldIfModifiedSince = 'If-Modified-Since';
|
||||
fieldLastModified = 'Last-Modified';
|
||||
fieldLocation = 'Location';
|
||||
fieldPragma = 'Pragma';
|
||||
fieldReferer = 'Referer';
|
||||
fieldRetryAfter = 'Retry-After';
|
||||
fieldServer = 'Server';
|
||||
fieldSetCookie = 'Set-Cookie';
|
||||
fieldUserAgent = 'User-Agent';
|
||||
fieldWWWAuthenticate = 'WWW-Authenticate';
|
||||
// These cannot be added to the NoHTTPFields constant
|
||||
// They are in the extra array.
|
||||
fieldHost = 'Host';
|
||||
fieldCacheControl = 'Cache-Control';
|
||||
fieldXRequestedWith = 'X-Requested-With';
|
||||
|
||||
fieldAccept = HeaderAccept deprecated;
|
||||
FieldAcceptCharset = HeaderAcceptCharset deprecated;
|
||||
FieldAcceptEncoding = HeaderAcceptEncoding deprecated;
|
||||
FieldAcceptLanguage = HeaderAcceptLanguage deprecated;
|
||||
FieldAcceptRanges = HeaderAcceptRanges deprecated;
|
||||
FieldAge = HeaderAge deprecated;
|
||||
FieldAllow = HeaderAllow deprecated;
|
||||
FieldAuthorization = HeaderAuthorization deprecated;
|
||||
FieldCacheControl = HeaderCacheControl deprecated;
|
||||
FieldConnection = HeaderConnection deprecated;
|
||||
FieldContentEncoding = HeaderContentEncoding deprecated;
|
||||
FieldContentLanguage = HeaderContentLanguage deprecated;
|
||||
FieldContentLength = HeaderContentLength deprecated;
|
||||
FieldContentLocation = HeaderContentLocation deprecated;
|
||||
FieldContentMD5 = HeaderContentMD5 deprecated;
|
||||
FieldContentRange = HeaderContentRange deprecated;
|
||||
FieldContentType = HeaderContentType deprecated;
|
||||
FieldDate = HeaderDate deprecated;
|
||||
FieldETag = HeaderETag deprecated;
|
||||
FieldExpires = HeaderExpires deprecated;
|
||||
FieldExpect = HeaderExpect deprecated;
|
||||
FieldFrom = HeaderFrom deprecated;
|
||||
FieldHost = HeaderHost deprecated;
|
||||
FieldIfMatch = HeaderIfMatch deprecated;
|
||||
FieldIfModifiedSince = HeaderIfModifiedSince deprecated;
|
||||
FieldIfNoneMatch = HeaderIfNoneMatch deprecated;
|
||||
FieldIfRange = HeaderIfRange deprecated;
|
||||
FieldIfUnModifiedSince = HeaderIfUnModifiedSince deprecated;
|
||||
FieldLastModified = HeaderLastModified deprecated;
|
||||
FieldLocation = HeaderLocation deprecated;
|
||||
FieldMaxForwards = HeaderMaxForwards deprecated;
|
||||
FieldPragma = HeaderPragma deprecated;
|
||||
FieldProxyAuthenticate = HeaderProxyAuthenticate deprecated;
|
||||
FieldProxyAuthorization = HeaderProxyAuthorization deprecated;
|
||||
FieldRange = HeaderRange deprecated;
|
||||
FieldReferer = HeaderReferer deprecated;
|
||||
FieldRetryAfter = HeaderRetryAfter deprecated;
|
||||
FieldServer = HeaderServer deprecated;
|
||||
FieldTE = HeaderTE deprecated;
|
||||
FieldTrailer = HeaderTrailer deprecated;
|
||||
FieldTransferEncoding = HeaderTransferEncoding deprecated;
|
||||
FieldUpgrade = HeaderUpgrade deprecated;
|
||||
FieldUserAgent = HeaderUserAgent deprecated;
|
||||
FieldVary = HeaderVary deprecated;
|
||||
FieldVia = HeaderVia deprecated;
|
||||
FieldWarning = HeaderWarning deprecated;
|
||||
FieldWWWAuthenticate = HeaderWWWAuthenticate deprecated;
|
||||
|
||||
// These fields are NOT in the HTTP 1.1 definition.
|
||||
FieldXRequestedWith = HeaderXRequestedWith deprecated;
|
||||
FieldCookie = HeaderCookie deprecated;
|
||||
FieldSetCookie = HeaderSetCookie deprecated;
|
||||
|
||||
NoHTTPFields = 27;
|
||||
|
||||
HTTPDateFmt = '"%s", dd "%s" yyyy hh:mm:ss'; // For use in FormatDateTime
|
||||
SCookieExpire = ' "Expires="'+HTTPDateFmt+' "GMT"';
|
||||
SCookieDomain = ' Domain=%s';
|
||||
SCookiePath = ' Path=%s';
|
||||
SCookieSecure = ' Secure';
|
||||
SCookieHttpOnly = ' HttpOnly';
|
||||
HTTPDateFmt = httpProtocol.HTTPDateFmt;
|
||||
SCookieExpire = httpProtocol.SCookieExpire;
|
||||
SCookieDomain = httpProtocol.SCookieDomain;
|
||||
SCookiePath = httpProtocol.SCookiePath;
|
||||
SCookieSecure = httpProtocol.SCookieSecure;
|
||||
SCookieHttpOnly = httpProtocol.SCookieHttpOnly;
|
||||
|
||||
HTTPMonths: array[1..12] of string[3] = (
|
||||
HTTPMonths : array[1..12] of string[3] = (
|
||||
'Jan', 'Feb', 'Mar', 'Apr',
|
||||
'May', 'Jun', 'Jul', 'Aug',
|
||||
'Sep', 'Oct', 'Nov', 'Dec');
|
||||
@ -82,13 +106,20 @@ const
|
||||
'Sun', 'Mon', 'Tue', 'Wed',
|
||||
'Thu', 'Fri', 'Sat');
|
||||
|
||||
Type
|
||||
// HTTP related variables.
|
||||
THTTPVariableType = (hvUnknown,hvHTTPVersion, hvMethod, hvCookie, hvSetCookie, hvXRequestedWith,
|
||||
hvPathInfo,hvPathTranslated,hvRemoteAddress,hvRemoteHost,hvScriptName,
|
||||
hvServerPort,hvURL,hvQuery,hvContent);
|
||||
THTTPVariableTypes = Set of THTTPVariableType;
|
||||
|
||||
Type
|
||||
THttpFields = Array[1..NoHTTPFields] of string;
|
||||
THttpIndexes = Array[1..NoHTTPFields] of integer;
|
||||
|
||||
THTTPVariables = Array[THTTPVariableType] of string;
|
||||
THttpFields = Array[1..NoHTTPFields] of string deprecated;
|
||||
THttpIndexes = Array[1..NoHTTPFields] of integer deprecated;
|
||||
|
||||
Const
|
||||
HeaderBasedVariables = [hvCookie,hvSetCookie,hvXRequestedWith];
|
||||
// For this constant, the header names corresponds to the property index used in THTTPHeader.
|
||||
HTTPFieldNames : THttpFields
|
||||
= (fieldAccept, fieldAcceptCharset, fieldAcceptEncoding,
|
||||
@ -98,7 +129,8 @@ Const
|
||||
fieldFrom, fieldIfModifiedSince, fieldLastModified, fieldLocation,
|
||||
fieldPragma, fieldReferer, fieldRetryAfter, fieldServer,
|
||||
fieldSetCookie, fieldUserAgent, fieldWWWAuthenticate,
|
||||
fieldHost, fieldCacheControl,fieldXRequestedWith);
|
||||
fieldHost, fieldCacheControl,fieldXRequestedWith) deprecated;
|
||||
|
||||
// Map header names on indexes in property getter/setter. 0 means not mapped !
|
||||
HTTPFieldIndexes : THTTPIndexes
|
||||
= (1,2,3,
|
||||
@ -108,7 +140,7 @@ Const
|
||||
14,15,16,17,
|
||||
18,19,20,21,
|
||||
22,23,24,
|
||||
34,0,36);
|
||||
34,0,36) deprecated;
|
||||
|
||||
|
||||
|
||||
@ -256,88 +288,116 @@ type
|
||||
FCookieFields: TStrings;
|
||||
FHTTPVersion: String;
|
||||
FHTTPXRequestedWith: String;
|
||||
FFields : THttpFields;
|
||||
FFields : THeadersArray;
|
||||
FVariables : THTTPVariables;
|
||||
FQueryFields: TStrings;
|
||||
FCustomHeaders : TStringList;
|
||||
function GetCustomHeaders: TStringList;
|
||||
function GetSetField(AIndex: Integer): String;
|
||||
function GetSetFieldName(AIndex: Integer): String;
|
||||
procedure SetCookieFields(const AValue: TStrings);
|
||||
Function GetFieldCount : Integer;
|
||||
Function GetContentLength : Integer;
|
||||
Procedure SetContentLength(Value : Integer);
|
||||
Function GetFieldIndex(AIndex : Integer) : Integer;
|
||||
Function GetFieldOrigin(AIndex : Integer; Out H : THeader; V : THTTPVAriableType) : Boolean;
|
||||
Function GetServerPort : Word;
|
||||
Procedure SetServerPort(AValue : Word);
|
||||
Function GetSetFieldValue(Index : Integer) : String; virtual;
|
||||
// These are private, because we need to know for sure the index is in the correct enumerated.
|
||||
Function GetHeaderValue(AIndex : Integer) : String;
|
||||
Procedure SetHeaderValue(AIndex : Integer; AValue : String);
|
||||
procedure SetHTTPVariable(AIndex: Integer; AValue: String);
|
||||
Function GetHTTPVariable(AIndex : Integer) : String;
|
||||
Protected
|
||||
Function GetFieldValue(Index : Integer) : String; virtual;
|
||||
Procedure SetFieldValue(Index : Integer; Value : String); virtual;
|
||||
// Kept for backwards compatibility
|
||||
Class Function IndexToHTTPHeader (AIndex : Integer) : THeader;
|
||||
Class Function IndexToHTTPVariable (AIndex : Integer) : THTTPVariableType;
|
||||
procedure SetHTTPVariable(AVariable : THTTPVariableType; AValue: String);
|
||||
Function GetFieldValue(Index : Integer) : String; virtual; deprecated;
|
||||
Procedure SetFieldValue(Index : Integer; Value : String); virtual; deprecated;
|
||||
procedure ParseFirstHeaderLine(const line: String);virtual;
|
||||
Procedure ParseCookies; virtual;
|
||||
public
|
||||
constructor Create; virtual;
|
||||
destructor Destroy; override;
|
||||
// This is the clean way to get HTTP headers.
|
||||
Function HeaderIsSet(AHeader : THeader) : Boolean;
|
||||
Function GetHeader(AHeader : THeader) : String;
|
||||
Procedure SetHeader(AHeader : THeader; Const AValue : String);
|
||||
// Get/Set a field by name. These calls handle 'known' fields. For unknown fields, Get/SetCustomheader is called.
|
||||
procedure SetFieldByName(const AName, AValue: String);
|
||||
function GetFieldByName(const AName: String): String;
|
||||
// Variables
|
||||
Class Function GetVariableHeaderName(AVariable : THTTPVariableType) : String;
|
||||
Function GetHTTPVariable(AVariable : THTTPVariableType) : String;
|
||||
// Get/Set custom headers.
|
||||
Function GetCustomHeader(const Name: String) : String; virtual;
|
||||
Procedure SetCustomHeader(const Name, Value: String); virtual;
|
||||
Function LoadFromStream(Stream : TStream; IncludeCommand : Boolean) : integer;
|
||||
Function LoadFromStrings(Strings: TStrings; IncludeCommand : Boolean) : integer; virtual;
|
||||
// Common access
|
||||
// This is an internal table. We should try to get rid of it,
|
||||
// It requires a lot of duplication.
|
||||
property FieldCount: Integer read GetFieldCount;
|
||||
property Fields[AIndex: Integer]: String read GetSetField;
|
||||
property FieldNames[AIndex: Integer]: String read GetSetFieldName;
|
||||
property FieldValues[AIndex: Integer]: String read GetSetFieldValue;
|
||||
// Various properties.
|
||||
Property HttpVersion : String Index 0 Read GetFieldValue Write SetFieldValue;
|
||||
Property ProtocolVersion : String Index 0 Read GetFieldValue Write SetFieldValue;
|
||||
property Accept: String Index 1 read GetFieldValue write SetFieldValue;
|
||||
property AcceptCharset: String Index 2 Read GetFieldValue Write SetFieldValue;
|
||||
property AcceptEncoding: String Index 3 Read GetFieldValue Write SetFieldValue;
|
||||
property AcceptLanguage: String Index 4 Read GetFieldValue Write SetFieldValue;
|
||||
property Authorization: String Index 5 Read GetFieldValue Write SetFieldValue;
|
||||
property Connection: String Index 6 Read GetFieldValue Write SetFieldValue;
|
||||
property ContentEncoding: String Index 7 Read GetFieldValue Write SetFieldValue;
|
||||
property ContentLanguage: String Index 8 Read GetFieldValue Write SetFieldValue;
|
||||
property FieldCount: Integer read GetFieldCount; deprecated;
|
||||
property Fields[AIndex: Integer]: String read GetSetField ; deprecated;
|
||||
property FieldNames[AIndex: Integer]: String read GetSetFieldName ;deprecated;
|
||||
property FieldValues[AIndex: Integer]: String read GetSetFieldValue ;deprecated;
|
||||
// Official HTTP headers.
|
||||
property Accept: String Index Ord(hhAccept) read GetHeaderValue write SetHeaderValue;
|
||||
property AcceptCharset: String Index Ord(hhAcceptCharset) Read GetHeaderValue Write SetHeaderValue;
|
||||
property AcceptEncoding: String Index Ord(hhAcceptEncoding) Read GetHeaderValue Write SetHeaderValue;
|
||||
property AcceptLanguage: String Index Ord(hhAcceptLanguage) Read GetHeaderValue Write SetHeaderValue;
|
||||
property Authorization: String Index Ord(hhAuthorization) Read GetHeaderValue Write SetHeaderValue;
|
||||
property Connection: String Index Ord(hhConnection) Read GetHeaderValue Write SetHeaderValue;
|
||||
property ContentEncoding: String Index Ord(hhContentEncoding) Read GetHeaderValue Write SetHeaderValue;
|
||||
property ContentLanguage: String Index Ord(hhContentLanguage) Read GetHeaderValue Write SetHeaderValue;
|
||||
property ContentLength: Integer Read GetContentLength Write SetContentLength; // Index 9
|
||||
property ContentType: String Index 10 Read GetFieldValue Write SetFieldValue;
|
||||
property Cookie: String Index 11 Read GetFieldValue Write SetFieldValue;
|
||||
property Date: String Index 12 Read GetFieldValue Write SetFieldValue;
|
||||
property Expires: String Index 13 Read GetFieldValue Write SetFieldValue;
|
||||
property From: String Index 14 Read GetFieldValue Write SetFieldValue;
|
||||
property IfModifiedSince: String Index 15 Read GetFieldValue Write SetFieldValue;
|
||||
property LastModified: String Index 16 Read GetFieldValue Write SetFieldValue;
|
||||
property Location: String Index 17 Read GetFieldValue Write SetFieldValue;
|
||||
property Pragma: String Index 18 Read GetFieldValue Write SetFieldValue;
|
||||
property Referer: String Index 19 Read GetFieldValue Write SetFieldValue;
|
||||
property RetryAfter: String Index 20 Read GetFieldValue Write SetFieldValue;
|
||||
property Server: String Index 21 Read GetFieldValue Write SetFieldValue;
|
||||
property SetCookie: String Index 22 Read GetFieldValue Write SetFieldValue;
|
||||
property UserAgent: String Index 23 Read GetFieldValue Write SetFieldValue;
|
||||
property WWWAuthenticate: String Index 24 Read GetFieldValue Write SetFieldValue;
|
||||
// Various aliases, for compatibility
|
||||
Property PathInfo : String index 25 read GetFieldValue Write SetFieldValue;
|
||||
Property PathTranslated : String Index 26 read GetFieldValue Write SetFieldValue;
|
||||
Property RemoteAddress : String Index 27 read GetFieldValue Write SetFieldValue;
|
||||
Property RemoteAddr : String Index 27 read GetFieldValue Write SetFieldValue; // Alias, Delphi-compat
|
||||
Property RemoteHost : String Index 28 read GetFieldValue Write SetFieldValue;
|
||||
Property ScriptName : String Index 29 read GetFieldValue Write SetFieldValue;
|
||||
property ContentType: String Index Ord(hhContentType) Read GetHeaderValue Write SetHeaderValue;
|
||||
property Date: String Index Ord(hhDate) Read GetHeaderValue Write SetHeaderValue;
|
||||
property Expires: String Index Ord(hhExpires) Read GetHeaderValue Write SetHeaderValue;
|
||||
property From: String Index Ord(hhFrom) Read GetHeaderValue Write SetHeaderValue;
|
||||
Property Host : String Index Ord(hhHost) Read GetFieldValue Write SetFieldValue;
|
||||
property IfModifiedSince: String Index Ord(hhIfModifiedSince) Read GetHeaderValue Write SetHeaderValue;
|
||||
property LastModified: String Index Ord(hhLastModified) Read GetHeaderValue Write SetHeaderValue;
|
||||
property Location: String Index Ord(hhLocation) Read GetHeaderValue Write SetHeaderValue;
|
||||
property Pragma: String Index Ord(hhPragma) Read GetHeaderValue Write SetHeaderValue;
|
||||
property Referer: String Index Ord(hhReferer) Read GetHeaderValue Write SetHeaderValue;
|
||||
property RetryAfter: String Index Ord(hhRetryAfter) Read GetHeaderValue Write SetHeaderValue;
|
||||
property Server: String Index Ord(hhServer) Read GetHeaderValue Write SetHeaderValue;
|
||||
property UserAgent: String Index Ord(hhUserAgent) Read GetHeaderValue Write SetHeaderValue;
|
||||
property Warning: String Index Ord(hhWarning) Read GetHeaderValue Write SetHeaderValue;
|
||||
property WWWAuthenticate: String Index Ord(hhWWWAuthenticate) Read GetHeaderValue Write SetHeaderValue;
|
||||
property Via: String Index Ord(hhVia) Read GetHeaderValue Write SetHeaderValue;
|
||||
// HTTP headers, Delphi compatibility
|
||||
Property HTTPAccept : String Index Ord(hhAccept) read GetFieldValue Write SetFieldValue;
|
||||
Property HTTPAcceptCharset : String Index Ord(hhAcceptCharset) read GetFieldValue Write SetFieldValue;
|
||||
Property HTTPAcceptEncoding : String Index Ord(hhAcceptEncoding) read GetFieldValue Write SetFieldValue;
|
||||
Property HTTPIfModifiedSince : String Index Ord(hhIfModifiedSince) read GetFieldValue Write SetFieldValue; // Maybe change to TDateTime ??
|
||||
Property HTTPReferer : String Index Ord(hhReferer) read GetFieldValue Write SetFieldValue;
|
||||
Property HTTPUserAgent : String Index Ord(hhUserAgent) read GetFieldValue Write SetFieldValue;
|
||||
// Headers, not in HTTP spec.
|
||||
property Cookie: String Index Ord(hvCookie) Read GetHTTPVariable Write SetHTTPVariable;
|
||||
property SetCookie: String Index Ord(hvSetCookie) Read GetHTTPVariable Write SetHTTPVariable;
|
||||
Property HTTPXRequestedWith : String Index Ord(hvXRequestedWith) read GetHTTPVariable Write SetHTTPVariable;
|
||||
Property HttpVersion : String Index ord(hvHTTPVErsion) Read GetHTTPVariable Write SetHTTPVariable;
|
||||
Property ProtocolVersion : String Index ord(hvHTTPVErsion) Read GetHTTPVariable Write SetHTTPVariable;
|
||||
// Specials, mostly from CGI protocol/Apache.
|
||||
Property PathInfo : String index Ord(hvPathInfo) read GetHTTPVariable Write SetHTTPVariable;
|
||||
Property PathTranslated : String index Ord(hvPathInfo) read GetHTTPVariable Write SetHTTPVariable;
|
||||
Property RemoteAddress : String Index Ord(hvRemoteAddress) read GetHTTPVariable Write SetHTTPVariable;
|
||||
Property RemoteAddr : String Index Ord(hvRemoteAddress) read GetHTTPVariable Write SetHTTPVariable; // Alias, Delphi-compat
|
||||
Property RemoteHost : String Index Ord(hvRemoteHost) read GetHTTPVariable Write SetHTTPVariable;
|
||||
Property ScriptName : String Index Ord(hvScriptName) read GetHTTPVariable Write SetHTTPVariable;
|
||||
Property ServerPort : Word Read GetServerPort Write SetServerPort; // Index 30
|
||||
Property HTTPAccept : String Index 1 read GetFieldValue Write SetFieldValue;
|
||||
Property HTTPAcceptCharset : String Index 2 read GetFieldValue Write SetFieldValue;
|
||||
Property HTTPAcceptEncoding : String Index 3 read GetFieldValue Write SetFieldValue;
|
||||
Property HTTPIfModifiedSince : String Index 15 read GetFieldValue Write SetFieldValue; // Maybe change to TDateTime ??
|
||||
Property HTTPReferer : String Index 19 read GetFieldValue Write SetFieldValue;
|
||||
Property HTTPUserAgent : String Index 23 read GetFieldValue Write SetFieldValue;
|
||||
Property Method : String Index 31 read GetFieldValue Write SetFieldValue;
|
||||
Property URL : String Index 32 read GetFieldValue Write SetFieldValue;
|
||||
Property Query : String Index 33 read GetFieldValue Write SetFieldValue;
|
||||
Property Host : String Index 34 Read GetFieldValue Write SetFieldValue;
|
||||
Property Content : String Index 35 Read GetFieldValue Write SetFieldValue;
|
||||
Property HTTPXRequestedWith : String Index 36 read GetFieldValue Write SetFieldValue;
|
||||
Property Method : String Index Ord(hvMethod) read GetHTTPVariable Write SetHTTPVariable;
|
||||
Property URL : String Index Ord(hvURL) read GetHTTPVariable Write SetHTTPVariable;
|
||||
Property Query : String Index Ord(hvQuery) read GetHTTPVariable Write SetHTTPVariable;
|
||||
Property Content : String Index Ord(hvContent) Read GetHTTPVariable Write SetHTTPVariable;
|
||||
// Lists
|
||||
Property CookieFields : TStrings Read FCookieFields Write SetCookieFields;
|
||||
Property ContentFields: TStrings read FContentFields;
|
||||
property QueryFields : TStrings read FQueryFields;
|
||||
Property CustomHeaders: TStringList read GetCustomHeaders;
|
||||
end;
|
||||
|
||||
TOnUnknownEncodingEvent = Procedure (Sender : TRequest; Const ContentType : String;Stream : TStream) of object;
|
||||
@ -391,11 +451,18 @@ type
|
||||
Property CommandLine : String Read FCommandLine;
|
||||
Property Command : String read FCommand;
|
||||
Property URI : String read FURI; // Uniform Resource Identifier
|
||||
Property QueryString : String Index 33 read GetFieldValue Write SetFieldValue; // Alias
|
||||
Property QueryString : String Index Ord(hvQuery) read GetHTTPVariable Write SetHTTPVariable;
|
||||
Property HeaderLine : String read GetFirstHeaderLine;
|
||||
Property Files : TUploadedFiles Read FFiles;
|
||||
Property HandleGetOnPost : Boolean Read FHandleGetOnPost Write FHandleGetOnPost;
|
||||
Property OnUnknownEncoding : TOnUnknownEncodingEvent Read FOnUnknownEncoding Write FOnUnknownEncoding;
|
||||
Property IfMatch : String Index ord(hhIfMatch) Read GetHeaderValue Write SetHeaderValue;
|
||||
Property IfNoneMatch : String Index ord(hhIfNoneMatch) Read GetHeaderValue Write SetHeaderValue;
|
||||
Property IfRange : String Index ord(hhIfRange) Read GetHeaderValue Write SetHeaderValue;
|
||||
Property IfUnModifiedSince : String Index ord(hhIfUnmodifiedSince) Read GetHeaderValue Write SetHeaderValue;
|
||||
Property ContentRange : String Index ord(hhContentRange) Read GetHeaderValue Write SetHeaderValue;
|
||||
Property TE : String Index ord(hhTE) Read GetHeaderValue Write SetHeaderValue;
|
||||
Property Upgrade : String Index ord(hhUpgrade) Read GetHeaderValue Write SetHeaderValue;
|
||||
end;
|
||||
|
||||
|
||||
@ -403,7 +470,6 @@ type
|
||||
|
||||
TResponse = class(THttpHeader)
|
||||
private
|
||||
FCacheControl: String;
|
||||
FContents: TStrings;
|
||||
FContentStream : TStream;
|
||||
FCode: Integer;
|
||||
@ -413,7 +479,6 @@ type
|
||||
FContentSent: Boolean;
|
||||
FRequest : TRequest;
|
||||
FCookies : TCookies;
|
||||
FCustomHeaders : TStringList;
|
||||
function GetContent: String;
|
||||
procedure SetContent(const AValue: String);
|
||||
procedure SetContents(AValue: TStrings);
|
||||
@ -431,13 +496,19 @@ type
|
||||
Procedure SendContent;
|
||||
Procedure SendHeaders;
|
||||
Procedure SendResponse; // Delphi compatibility
|
||||
Function GetCustomHeader(const Name: String) : String;
|
||||
Procedure SetCustomHeader(const Name, Value: String);
|
||||
Procedure SendRedirect(const TargetURL:String);
|
||||
Property Request : TRequest Read FRequest;
|
||||
Property Code: Integer Read FCode Write FCode;
|
||||
Property CodeText: String Read FCodeText Write FCodeText;
|
||||
Property CacheControl : String Read FCacheControl Write FCacheControl;
|
||||
Property Age : String Index Ord(hhAge) Read GetHeaderValue Write SetHeaderValue;
|
||||
Property Allow : String Index Ord(hhAllow) Read GetHeaderValue Write SetHeaderValue;
|
||||
Property CacheControl : String Index Ord(hhCacheControl) Read GetHeaderValue Write SetHeaderValue;
|
||||
Property ContentLocation : String Index Ord(hhContentLocation) Read GetHeaderValue Write SetHeaderValue;
|
||||
Property ContentMD5 : String Index Ord(hhContentMD5) Read GetHeaderValue Write SetHeaderValue;
|
||||
Property ContentRange : String Index Ord(hhContentRange) Read GetHeaderValue Write SetHeaderValue;
|
||||
Property ETag : String Index Ord(hhEtag) Read GetHeaderValue Write SetHeaderValue;
|
||||
Property ProxyAuthenticate : String Index Ord(hhProxyAuthenticate) Read GetHeaderValue Write SetHeaderValue;
|
||||
Property RetryAfter : String Index Ord(hhRetryAfter) Read GetHeaderValue Write SetHeaderValue;
|
||||
Property FirstHeaderLine : String Read GetFirstHeaderLine Write SetFirstHeaderLine;
|
||||
Property ContentStream : TStream Read FContentStream Write SetContentStream;
|
||||
Property Content : String Read GetContent Write SetContent;
|
||||
@ -445,7 +516,6 @@ type
|
||||
Property HeadersSent : Boolean Read FHeadersSent;
|
||||
Property ContentSent : Boolean Read FContentSent;
|
||||
property Cookies: TCookies read FCookies;
|
||||
Property CustomHeaders: TStringList read FCustomHeaders;
|
||||
Property FreeContentStream : Boolean Read FFreeContentStream Write FFreeContentStream;
|
||||
end;
|
||||
|
||||
@ -521,6 +591,8 @@ Var
|
||||
MimeItemsClass : TMimeItemsClass = TMimeItems;
|
||||
MimeItemClass : TMimeItemClass = nil;
|
||||
|
||||
Procedure Touch(Const AName : String);
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
@ -545,6 +617,11 @@ const
|
||||
{ ---------------------------------------------------------------------
|
||||
Auxiliary functions
|
||||
---------------------------------------------------------------------}
|
||||
Procedure Touch(Const AName : String);
|
||||
|
||||
begin
|
||||
FileClose(FileCreate('/tmp/touch-'+StringReplace(AName,'/','_',[rfReplaceAll])));
|
||||
end;
|
||||
|
||||
Function GetFieldNameIndex(AName : String) : Integer;
|
||||
|
||||
@ -559,107 +636,22 @@ begin
|
||||
Result:=HTTPFieldIndexes[Result];
|
||||
end;
|
||||
|
||||
function HTTPDecode(const AStr: String): String;
|
||||
|
||||
var
|
||||
S,SS, R : PChar;
|
||||
H : String[3];
|
||||
L,C : Integer;
|
||||
Function HTTPDecode(const AStr: String): String;
|
||||
|
||||
begin
|
||||
L:=Length(Astr);
|
||||
SetLength(Result,L);
|
||||
If (L=0) then
|
||||
exit;
|
||||
S:=PChar(AStr);
|
||||
SS:=S;
|
||||
R:=PChar(Result);
|
||||
while (S-SS)<L do
|
||||
begin
|
||||
case S^ of
|
||||
'+': R^ := ' ';
|
||||
'%': begin
|
||||
Inc(S);
|
||||
if ((S-SS)<L) then
|
||||
begin
|
||||
if (S^='%') then
|
||||
R^:='%'
|
||||
else
|
||||
begin
|
||||
H:='$00';
|
||||
H[2]:=S^;
|
||||
Inc(S);
|
||||
If (S-SS)<L then
|
||||
begin
|
||||
H[3]:=S^;
|
||||
Val(H,PByte(R)^,C);
|
||||
If (C<>0) then
|
||||
R^:=' ';
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
else
|
||||
R^ := S^;
|
||||
end;
|
||||
Inc(R);
|
||||
Inc(S);
|
||||
end;
|
||||
SetLength(Result,R-PChar(Result));
|
||||
Result:=httpProtocol.HTTPDecode(AStr);
|
||||
end;
|
||||
|
||||
function HTTPEncode(const AStr: String): String;
|
||||
|
||||
const
|
||||
HTTPAllowed = ['A'..'Z','a'..'z',
|
||||
'*','@','.','_','-',
|
||||
'0'..'9',
|
||||
'$','!','''','(',')'];
|
||||
|
||||
var
|
||||
SS,S,R: PChar;
|
||||
H : String[2];
|
||||
L : Integer;
|
||||
Function HTTPEncode(const AStr: String): String;
|
||||
|
||||
begin
|
||||
L:=Length(AStr);
|
||||
SetLength(Result,L*3); // Worst case scenario
|
||||
if (L=0) then
|
||||
exit;
|
||||
R:=PChar(Result);
|
||||
S:=PChar(AStr);
|
||||
SS:=S; // Avoid #0 limit !!
|
||||
while ((S-SS)<L) do
|
||||
begin
|
||||
if S^ in HTTPAllowed then
|
||||
R^:=S^
|
||||
else if (S^=' ') then
|
||||
R^:='+'
|
||||
else
|
||||
begin
|
||||
R^:='%';
|
||||
H:=HexStr(Ord(S^),2);
|
||||
Inc(R);
|
||||
R^:=H[1];
|
||||
Inc(R);
|
||||
R^:=H[2];
|
||||
end;
|
||||
Inc(R);
|
||||
Inc(S);
|
||||
end;
|
||||
SetLength(Result,R-PChar(Result));
|
||||
Result:=httpProtocol.HTTPEncode(AStr);
|
||||
end;
|
||||
|
||||
function IncludeHTTPPathDelimiter(const AStr: String): String;
|
||||
|
||||
Var
|
||||
l : Integer;
|
||||
Function IncludeHTTPPathDelimiter(const AStr: String): String;
|
||||
|
||||
begin
|
||||
Result:=AStr;
|
||||
L:=Length(Result);
|
||||
If (L>0) and (Result[L]<>'/') then
|
||||
Result:=Result+'/';
|
||||
Result:=httpProtocol.IncludeHTTPPathDelimiter(AStr);
|
||||
end;
|
||||
|
||||
{ -------------------------------------------------------------------
|
||||
@ -797,16 +789,20 @@ end;
|
||||
THTTPHeader
|
||||
---------------------------------------------------------------------}
|
||||
|
||||
function THttpHeader.GetFieldCount: Integer;
|
||||
function THTTPHeader.GetFieldCount: Integer;
|
||||
|
||||
|
||||
Var
|
||||
I : Integer;
|
||||
h : THeader;
|
||||
|
||||
begin
|
||||
Result:=0;
|
||||
For I:=1 to NoHTTPFields do
|
||||
If (GetFieldValue(i)<>'') then
|
||||
For H in THeader do
|
||||
If HeaderIsSet(H) then
|
||||
Inc(Result);
|
||||
Inc(Result,Ord(FVariables[hvXRequestedWith]<>''));
|
||||
Inc(Result,Ord(FVariables[hvSetCookie]<>''));
|
||||
Inc(Result,Ord(FVariables[hvCookie]<>''));
|
||||
end;
|
||||
|
||||
function THTTPHeader.GetContentLength: Integer;
|
||||
@ -820,23 +816,47 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
Function THttpHeader.GetFieldIndex(AIndex : Integer) : Integer;
|
||||
function THTTPHeader.GetFieldOrigin(AIndex: Integer; out H: THeader;
|
||||
V: THTTPVAriableType): Boolean;
|
||||
|
||||
var
|
||||
I : Integer;
|
||||
|
||||
begin
|
||||
I:=1;
|
||||
While (I<=NoHTTPFields) and (AIndex>=0) do
|
||||
V:=hvUnknown;
|
||||
H:=Succ(hhUnknown);
|
||||
While (H<=High(THeader)) and (AIndex>=0) do
|
||||
begin
|
||||
If (GetFieldValue(i)<>'') then
|
||||
If (GetHeader(H)<>'') then
|
||||
Dec(AIndex);
|
||||
Inc(I);
|
||||
H:=Succ(H);
|
||||
end;
|
||||
If (AIndex=-1) then
|
||||
Result:=I-1
|
||||
else
|
||||
Result:=-1;
|
||||
Result:=(AIndex<0);
|
||||
if Result then
|
||||
begin
|
||||
H:=Pred(H);
|
||||
Exit;
|
||||
end;
|
||||
h:=hhUnknown;
|
||||
if (AIndex>=0) then
|
||||
begin
|
||||
H:=hhUnknown;
|
||||
V:=hvXRequestedWith;
|
||||
if (FVariables[V]<>'') then
|
||||
Dec(AIndex);
|
||||
end;
|
||||
if (AIndex>=0) then
|
||||
begin
|
||||
V:=hvSetCookie;
|
||||
if (FVariables[V]<>'') then
|
||||
Dec(AIndex);
|
||||
end;
|
||||
if (AIndex>=0) then
|
||||
begin
|
||||
V:=hvCookie;
|
||||
if (FVariables[V]<>'') then
|
||||
Dec(AIndex);
|
||||
end;
|
||||
Result:=(AIndex<0);
|
||||
if not Result then V:=hvUnknown
|
||||
end;
|
||||
|
||||
function THTTPHeader.GetServerPort: Word;
|
||||
@ -844,7 +864,19 @@ begin
|
||||
Result:=StrToIntDef(GetFieldValue(30),0);
|
||||
end;
|
||||
|
||||
Procedure THTTPHeader.SetServerPort(AValue : Word);
|
||||
procedure THTTPHeader.SetHTTPVariable(AIndex: Integer; AValue: String);
|
||||
begin
|
||||
if (AIndex>=0) and (Aindex<=Ord(High(THTTPVariableType))) then
|
||||
SetHTTPVariable(THTTPVariableType(AIndex),AValue);
|
||||
end;
|
||||
|
||||
procedure THTTPHeader.SetHTTPVariable(AVariable: THTTPVariableType; AValue: String);
|
||||
begin
|
||||
Touch(GetEnumName(TypeInfo(THTTPVariableType),Ord(AVariable))+'='+AValue);
|
||||
FVariables[AVariable]:=AValue
|
||||
end;
|
||||
|
||||
procedure THTTPHeader.SetServerPort(AValue: Word);
|
||||
|
||||
begin
|
||||
SetFieldValue(30,IntToStr(AValue));
|
||||
@ -853,46 +885,138 @@ end;
|
||||
function THTTPHeader.GetSetFieldValue(Index: Integer): String;
|
||||
|
||||
Var
|
||||
I : Integer;
|
||||
H : THeader;
|
||||
V : THTTPVariableType;
|
||||
|
||||
begin
|
||||
I:=GetFieldIndex(Index);
|
||||
If (I<>-1) then
|
||||
Result:=GetFieldValue(I);
|
||||
if GetFieldOrigin(Index,H,V) then
|
||||
begin
|
||||
if H<>hhUnknown then
|
||||
Result:=GetHeader(H)
|
||||
else if V<>hVUnknown then
|
||||
Result:=GetHTTPVariable(V);
|
||||
end;
|
||||
end;
|
||||
|
||||
function THTTPHeader.GetHeaderValue(AIndex: Integer): String;
|
||||
begin
|
||||
if (AIndex>=0) and (AIndex<=Ord(High(THeader))) then
|
||||
Result:=GetHeader(THeader(AIndex))
|
||||
else
|
||||
Result:='';
|
||||
end;
|
||||
|
||||
procedure THTTPHeader.SetHeaderValue(AIndex: Integer; AValue: String);
|
||||
begin
|
||||
if (AIndex>=0) and (AIndex<=Ord(High(THeader))) then
|
||||
SetHeader(THeader(AIndex),AValue);
|
||||
end;
|
||||
|
||||
function THTTPHeader.GetHTTPVariable(AVariable: THTTPVariableType): String;
|
||||
|
||||
begin
|
||||
Result:=FVariables[AVariable];
|
||||
end;
|
||||
|
||||
function THTTPHeader.GetHTTPVariable(AIndex: Integer): String;
|
||||
begin
|
||||
if (AIndex>=0) and (AIndex<=Ord(High(THTTPVariableType))) then
|
||||
Result:=GetHTTPVariable(THTTPVariableType(AIndex))
|
||||
else
|
||||
Result:='';
|
||||
end;
|
||||
|
||||
class function THTTPHeader.IndexToHTTPHeader(AIndex: Integer): THeader;
|
||||
|
||||
Const
|
||||
IDX : Array[THeader] of Integer =
|
||||
(-1,
|
||||
1,2,3,4,
|
||||
-1,-1,-1,5,-1,
|
||||
6,7,8,
|
||||
9,-1,-1,-1,
|
||||
10,12,-1,13,-1,
|
||||
14,34,-1,15,-1,
|
||||
-1,-1,16,17,-1,
|
||||
18,-1,-1,-1,19,
|
||||
20,21,-1,-1,
|
||||
-1,-1,23,-1,
|
||||
-1,-1,24);
|
||||
|
||||
begin
|
||||
Result:=High(THeader);
|
||||
While (Result>hhUnknown) and (IDX[Result]<>AIndex) do
|
||||
Result:=Pred(Result);
|
||||
end;
|
||||
|
||||
class function THTTPHeader.IndexToHTTPVariable(AIndex: Integer
|
||||
): THTTPVariableType;
|
||||
|
||||
Const
|
||||
IDX : Array[THTTPVariableType] of Integer =
|
||||
(-1,
|
||||
0,31,11,22,36,
|
||||
25,26,27,28,29,
|
||||
30,32,33,35);
|
||||
|
||||
begin
|
||||
Result:=High(THTTPVariableType);
|
||||
While (Result>hvUnknown) and (IDX[Result]<>AIndex) do
|
||||
Result:=Pred(Result);
|
||||
end;
|
||||
|
||||
function THTTPHeader.GetSetField(AIndex: Integer): String;
|
||||
var
|
||||
I : Integer;
|
||||
|
||||
Var
|
||||
H : THeader;
|
||||
V : THTTPVariableType;
|
||||
|
||||
begin
|
||||
I:=GetFieldIndex(AIndex);
|
||||
If (I<>-1) then
|
||||
Result := HTTPFieldNames[I] + ': ' + GetFieldValue(I);
|
||||
if GetFieldOrigin(AIndex,H,V) then
|
||||
if H<>hhUnknown then
|
||||
Result:=HTTPHeaderNames[H]+': '+GetHeader(H)
|
||||
else if V<>hVUnknown then
|
||||
Result:=GetVariableHeaderName(V)+': '+GetHTTPVariable(V);
|
||||
end;
|
||||
|
||||
function THTTPHeader.GetCustomHeaders: TStringList;
|
||||
begin
|
||||
If FCustomHeaders=Nil then
|
||||
FCustomHeaders:=TStringList.Create;
|
||||
Result:=FCustomHeaders;
|
||||
end;
|
||||
|
||||
function THTTPHeader.GetSetFieldName(AIndex: Integer): String;
|
||||
var
|
||||
I : Integer;
|
||||
|
||||
Var
|
||||
H : THeader;
|
||||
V : THTTPVariableType;
|
||||
|
||||
begin
|
||||
I:=GetFieldIndex(AIndex);
|
||||
if (I<>-1) then
|
||||
Result:=HTTPFieldNames[I];
|
||||
if GetFieldOrigin(AIndex,H,V) then
|
||||
if H<>hhUnknown then
|
||||
Result:=HTTPHeaderNames[H]
|
||||
else
|
||||
Result:=GetVariableHeaderName(V);
|
||||
end;
|
||||
|
||||
|
||||
Function THttpHeader.GetFieldValue(Index : Integer) : String;
|
||||
function THTTPHeader.GetFieldValue(Index: Integer): String;
|
||||
|
||||
Var
|
||||
H : THeader;
|
||||
V : THTTPVariableType;
|
||||
|
||||
begin
|
||||
if (Index>=1) and (Index<=NoHTTPFields) then
|
||||
Result:=FFields[Index]
|
||||
Result:='';
|
||||
H:=IndexToHTTPHeader(Index);
|
||||
if (H<>hhUnknown) then
|
||||
Result:=GetHeader(H)
|
||||
else
|
||||
case Index of
|
||||
0 : Result:=FHTTPVersion;
|
||||
36 : Result:=FHTTPXRequestedWith;
|
||||
else
|
||||
Result := '';
|
||||
begin
|
||||
V:=IndexToHTTPVariable(Index);
|
||||
if V<>hvUnknown then
|
||||
Result:=GetHTTPVariable(V)
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -902,10 +1026,24 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
Procedure THttpHeader.SetFieldValue(Index : Integer; Value : String);
|
||||
procedure THTTPHeader.SetFieldValue(Index: Integer; Value: String);
|
||||
|
||||
|
||||
Var
|
||||
H : THeader;
|
||||
V : THTTPVariableType;
|
||||
|
||||
begin
|
||||
if (Index>=1) and (Index<=NoHTTPFields) then
|
||||
H:=IndexToHTTPHeader(Index);
|
||||
if (H<>hhUnknown) then
|
||||
SetHeader(H,Value)
|
||||
else
|
||||
begin
|
||||
V:=IndexToHTTPVariable(Index);
|
||||
if V<>hvUnknown then
|
||||
SetHTTPVariable(V,Value)
|
||||
end;
|
||||
(* if (Index>=1) and (Index<=NoHTTPFields) then
|
||||
begin
|
||||
FFields[Index]:=Value;
|
||||
If (Index=11) then
|
||||
@ -922,6 +1060,7 @@ begin
|
||||
30 : ; // Property ServerPort : Word Read GetServerPort; // Index 30 in TRequest
|
||||
36 : FHTTPXRequestedWith:=Value;
|
||||
end;
|
||||
*)
|
||||
end;
|
||||
|
||||
procedure THTTPHeader.ParseFirstHeaderLine(const line: String);
|
||||
@ -952,7 +1091,7 @@ begin
|
||||
{$ifdef cgidebug} SendMethodExit('Parsecookies done');{$endif}
|
||||
end;
|
||||
|
||||
constructor THttpHeader.Create;
|
||||
constructor THTTPHeader.Create;
|
||||
begin
|
||||
FCookieFields:=TStringList.Create;
|
||||
FQueryFields:=TStringList.Create;
|
||||
@ -960,9 +1099,10 @@ begin
|
||||
FHttpVersion := '1.1';
|
||||
end;
|
||||
|
||||
destructor THttpHeader.Destroy;
|
||||
destructor THTTPHeader.Destroy;
|
||||
|
||||
begin
|
||||
FreeAndNil(FCustomHeaders);
|
||||
FreeAndNil(FContentFields);
|
||||
FreeAndNil(FQueryFields);
|
||||
FreeAndNil(FCookieFields);
|
||||
@ -970,7 +1110,24 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
function THttpHeader.GetFieldByName(const AName: String): String;
|
||||
function THTTPHeader.HeaderIsSet(AHeader: THeader): Boolean;
|
||||
begin
|
||||
Result:=(FFields[AHeader]<>'');
|
||||
end;
|
||||
|
||||
function THTTPHeader.GetHeader(AHeader: THeader): String;
|
||||
begin
|
||||
Result:=FFields[AHeader];
|
||||
end;
|
||||
|
||||
procedure THTTPHeader.SetHeader(AHeader: THeader; const AValue: String);
|
||||
begin
|
||||
Touch(GetEnumName(TypeInfo(THEader),ORd(AHeader))+'='+AValue);
|
||||
FFields[AHeader]:=AValue;
|
||||
end;
|
||||
|
||||
|
||||
function THTTPHeader.GetFieldByName(const AName: String): String;
|
||||
var
|
||||
i: Integer;
|
||||
|
||||
@ -978,11 +1135,38 @@ begin
|
||||
I:=GetFieldNameIndex(AName);
|
||||
If (I<>0) then
|
||||
Result:=self.GetFieldValue(i)
|
||||
else
|
||||
Result:=GetCustomHeader(AName);
|
||||
end;
|
||||
|
||||
class function THTTPHeader.GetVariableHeaderName(AVariable: THTTPVariableType
|
||||
): String;
|
||||
begin
|
||||
Case AVariable of
|
||||
hvSetCookie : Result:=HeaderSetCookie;
|
||||
hvCookie : Result:=HeaderCookie;
|
||||
hvXRequestedWith : Result:=HeaderXRequestedWith;
|
||||
end;
|
||||
end;
|
||||
|
||||
function THTTPHeader.GetCustomHeader(const Name: String): String;
|
||||
begin
|
||||
if Assigned(FCustomHeaders) then
|
||||
Result:=CustomHeaders.Values[Name]
|
||||
else
|
||||
Result:='';
|
||||
end;
|
||||
|
||||
Function THTTPHeader.LoadFromStream(Stream: TStream; IncludeCommand : Boolean) : Integer;
|
||||
procedure THTTPHeader.SetCustomHeader(const Name, Value: String);
|
||||
begin
|
||||
if GetCustomHeader(Name) = '' then
|
||||
CustomHeaders.Add(Name + '=' + Value)
|
||||
else
|
||||
CustomHeaders.Values[Name] := Value;
|
||||
end;
|
||||
|
||||
function THTTPHeader.LoadFromStream(Stream: TStream; IncludeCommand: Boolean
|
||||
): integer;
|
||||
|
||||
Var
|
||||
S : TStrings;
|
||||
@ -997,7 +1181,8 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
Function THTTPHeader.LoadFromStrings(Strings: TStrings; IncludeCommand : Boolean) : integer;
|
||||
function THTTPHeader.LoadFromStrings(Strings: TStrings; IncludeCommand: Boolean
|
||||
): integer;
|
||||
|
||||
Var
|
||||
P : Integer;
|
||||
@ -1029,14 +1214,16 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure THttpHeader.SetFieldByName(const AName, AValue: String);
|
||||
procedure THTTPHeader.SetFieldByName(const AName, AValue: String);
|
||||
var
|
||||
i: Integer;
|
||||
|
||||
begin
|
||||
I:=GetFieldNameIndex(AName);
|
||||
If (I<>0) then
|
||||
SetFieldValue(i,AValue);
|
||||
SetFieldValue(i,AValue)
|
||||
else
|
||||
SetCustomHeader(AName,AValue);
|
||||
end;
|
||||
|
||||
{ ---------------------------------------------------------------------
|
||||
@ -1617,7 +1804,7 @@ end;
|
||||
|
||||
procedure TRequest.InitContent(var AContent: String);
|
||||
begin
|
||||
FContent:=AContent;
|
||||
FVariables[hvContent]:=AContent;
|
||||
FContentRead:=True;
|
||||
end;
|
||||
|
||||
@ -1824,7 +2011,6 @@ begin
|
||||
FreeAndNil(FContentStream);
|
||||
FreeAndNil(FCookies);
|
||||
FreeAndNil(FContents);
|
||||
FreeAndNil(FCustomHeaders);
|
||||
inherited destroy;
|
||||
end;
|
||||
|
||||
@ -1865,18 +2051,6 @@ begin
|
||||
SendContent;
|
||||
end;
|
||||
|
||||
function TResponse.GetCustomHeader(const Name: String): String;
|
||||
begin
|
||||
Result := FCustomHeaders.Values[Name];
|
||||
end;
|
||||
|
||||
procedure TResponse.SetCustomHeader(const Name, Value: String);
|
||||
begin
|
||||
if GetCustomHeader(Name) = '' then
|
||||
FCustomHeaders.Add(Name + '=' + Value)
|
||||
else
|
||||
FCustomHeaders.Values[Name] := Value;
|
||||
end;
|
||||
|
||||
procedure TResponse.SendRedirect(const TargetURL: String);
|
||||
begin
|
||||
@ -1964,6 +2138,8 @@ procedure TResponse.CollectHeaders(Headers: TStrings);
|
||||
|
||||
Var
|
||||
I : Integer;
|
||||
H : THeader;
|
||||
N,V : String;
|
||||
|
||||
begin
|
||||
Headers.add(Format('Status: %d %s',[Code,CodeText]));
|
||||
@ -1975,11 +2151,17 @@ begin
|
||||
SendInteger('Nr of cookies',FCookies.Count);
|
||||
{$endif}
|
||||
For I:=0 to FCookies.Count-1 do
|
||||
Headers.Add('Set-Cookie: '+FCookies[i].AsString);
|
||||
For I:=0 to FieldCount-1 do
|
||||
Headers.Add(Fields[i]);
|
||||
For I:=0 to FCustomHeaders.Count - 1 do if FCustomHeaders[I] <> '' then
|
||||
Headers.Add(FCustomHeaders.Names[I] + ': ' + FCustomHeaders.ValueFromIndex[I]);
|
||||
Headers.Add(HeaderSetCookie+': '+FCookies[i].AsString);
|
||||
For H in THeader do
|
||||
if (hdResponse in HTTPHeaderDirections[H]) and HeaderIsSet(H) then
|
||||
Headers.Add(HTTPHeaderNames[H]+': '+GetHeader(H));
|
||||
if Assigned(FCustomHeaders) then
|
||||
For I:=0 to FCustomHeaders.Count - 1 do
|
||||
begin
|
||||
FCustomHeaders.GetNameValue(I,N,V);
|
||||
if (V<>'') then
|
||||
Headers.Add(N+': '+V);
|
||||
end;
|
||||
Headers.Add('');
|
||||
{$ifdef cgidebug} SendMethodExit('Collectheaders');{$endif}
|
||||
end;
|
||||
|
||||
269
packages/fcl-web/src/base/httpprotocol.pp
Normal file
269
packages/fcl-web/src/base/httpprotocol.pp
Normal file
@ -0,0 +1,269 @@
|
||||
unit httpprotocol;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils;
|
||||
|
||||
Type
|
||||
// HTTP 1.1 defined headers.
|
||||
THeader = (hhUnknown,
|
||||
hhAccept,hhAcceptCharset,hhAcceptEncoding, hhAcceptLanguage,
|
||||
hhAcceptRanges, hhAge, hhAllow, hhAuthorization, hhCacheControl,
|
||||
hhConnection, hhContentEncoding, hhContentLanguage,
|
||||
hhContentLength,hhContentLocation, hhContentMD5, hhContentRange,
|
||||
hhContentType, hhDate, hhETag, hhExpires, hhExpect,
|
||||
hhFrom, hhHost, hhIfMatch, hhIfModifiedSince, hhIfNoneMatch,
|
||||
hhIfRange, hhIfUnModifiedSince, hhLastModified, hhLocation, hhMaxForwards,
|
||||
hhPragma, hhProxyAuthenticate, hhProxyAuthorization, hhRange, hhReferer,
|
||||
hhRetryAfter, hhServer, hhTE, hhTrailer,
|
||||
hhTransferEncoding, hhUpgrade , hhUserAgent, hhVary,
|
||||
hhVia, hhWarning, hhWWWAuthenticate);
|
||||
THeaders = Set of THeader;
|
||||
THeaderDirection = (hdRequest,hdResponse);
|
||||
THeaderDirections = Set of THeaderDirection;
|
||||
|
||||
THeadersArray = Array[THeader] of string;
|
||||
|
||||
Const
|
||||
HeaderAccept = 'Accept';
|
||||
HeaderAcceptCharset = 'Accept-Charset';
|
||||
HeaderAcceptEncoding = 'Accept-Encoding';
|
||||
HeaderAcceptLanguage = 'Accept-Language';
|
||||
HeaderAcceptRanges = 'Accept-Ranges';
|
||||
HeaderAge = 'Age';
|
||||
HeaderAllow = 'Allow';
|
||||
HeaderAuthorization = 'Authorization';
|
||||
HeaderCacheControl = 'Cache-Control';
|
||||
HeaderConnection = 'Connection';
|
||||
HeaderContentEncoding = 'Content-Encoding';
|
||||
HeaderContentLanguage = 'Content-Language';
|
||||
HeaderContentLength = 'Content-Length';
|
||||
HeaderContentLocation = 'Content-Location';
|
||||
HeaderContentMD5 = 'Content-MD5';
|
||||
HeaderContentRange = 'Content-Range';
|
||||
HeaderContentType = 'Content-Type';
|
||||
HeaderDate = 'Date';
|
||||
HeaderETag = 'ETag';
|
||||
HeaderExpires = 'Expires';
|
||||
HeaderExpect = 'Expect';
|
||||
HeaderFrom = 'From';
|
||||
HeaderHost = 'Host';
|
||||
HeaderIfMatch = 'If-Match';
|
||||
HeaderIfModifiedSince = 'If-Modified-Since';
|
||||
HeaderIfNoneMatch = 'If-None-Match';
|
||||
HeaderIfRange = 'If-Range';
|
||||
HeaderIfUnModifiedSince = 'If-Unmodified-Since';
|
||||
HeaderLastModified = 'Last-Modified';
|
||||
HeaderLocation = 'Location';
|
||||
HeaderMaxForwards = 'Max-Forwards';
|
||||
HeaderPragma = 'Pragma';
|
||||
HeaderProxyAuthenticate = 'Proxy-Authenticate';
|
||||
HeaderProxyAuthorization = 'Proxy-Authorization';
|
||||
HeaderRange = 'Range';
|
||||
HeaderReferer = 'Referer';
|
||||
HeaderRetryAfter = 'Retry-After';
|
||||
HeaderServer = 'Server';
|
||||
HeaderTE = 'TE';
|
||||
HeaderTrailer = 'Trailer';
|
||||
HeaderTransferEncoding = 'Transfer-Encoding';
|
||||
HeaderUpgrade = 'Upgrade';
|
||||
HeaderUserAgent = 'User-Agent';
|
||||
HeaderVary = 'Vary';
|
||||
HeaderVia = 'Via';
|
||||
HeaderWarning = 'Warning';
|
||||
HeaderWWWAuthenticate = 'WWW-Authenticate';
|
||||
|
||||
// These Headers are NOT in the HTTP 1.1 definition.
|
||||
HeaderXRequestedWith = 'X-Requested-With';
|
||||
HeaderCookie = 'Cookie';
|
||||
HeaderSetCookie = 'Set-Cookie';
|
||||
|
||||
HTTPDateFmt = '"%s", dd "%s" yyyy hh:mm:ss'; // For use in FormatDateTime
|
||||
SCookieExpire = ' "Expires="'+HTTPDateFmt+' "GMT"';
|
||||
SCookieDomain = ' Domain=%s';
|
||||
SCookiePath = ' Path=%s';
|
||||
SCookieSecure = ' Secure';
|
||||
SCookieHttpOnly = ' HttpOnly';
|
||||
|
||||
HTTPMonths: array[1..12] of string[3] = (
|
||||
'Jan', 'Feb', 'Mar', 'Apr',
|
||||
'May', 'Jun', 'Jul', 'Aug',
|
||||
'Sep', 'Oct', 'Nov', 'Dec');
|
||||
HTTPDays: array[1..7] of string[3] = (
|
||||
'Sun', 'Mon', 'Tue', 'Wed',
|
||||
'Thu', 'Fri', 'Sat');
|
||||
|
||||
|
||||
Const
|
||||
HTTPHeaderDirections : Array[THeader] of THeaderDirections = (
|
||||
[],
|
||||
[hdRequest],[hdRequest],[hdRequest], [hdRequest],
|
||||
[hdResponse], [hdResponse], [hdResponse], [hdRequest], [hdRequest,hdResponse],
|
||||
[hdRequest,hdResponse], [hdRequest,hdResponse], [hdRequest,hdResponse],
|
||||
[hdRequest,hdResponse],[hdRequest,hdResponse], [hdRequest,hdResponse], [hdRequest,hdResponse],
|
||||
[hdRequest,hdResponse], [hdRequest,hdResponse], [hdResponse], [hdRequest,hdResponse], [hdRequest],
|
||||
[hdRequest], [hdRequest], [hdRequest], [hdRequest], [hdRequest],
|
||||
[hdRequest], [hdRequest], [hdRequest,hdResponse], [hdResponse], [hdRequest],
|
||||
[hdRequest, hdResponse] , [hdResponse], [hdRequest], [hdRequest,hdResponse], [hdRequest],
|
||||
[hdResponse], [hdResponse], [hdRequest], [hdRequest,hdResponse],
|
||||
[hdRequest,hdResponse], [hdRequest,hdResponse], [hdRequest], [hdRequest,hdResponse],
|
||||
[hdRequest,hdResponse], [hdRequest,hdResponse], [hdResponse]);
|
||||
|
||||
HTTPHeaderNames : THeadersArray
|
||||
= ('',
|
||||
HeaderAccept,HeaderAcceptCharset,HeaderAcceptEncoding, HeaderAcceptLanguage,
|
||||
HeaderAcceptRanges, HeaderAge, HeaderAllow, HeaderAuthorization, HeaderCacheControl,
|
||||
HeaderConnection, HeaderContentEncoding, HeaderContentLanguage,
|
||||
HeaderContentLength,HeaderContentLocation, HeaderContentMD5, HeaderContentRange,
|
||||
HeaderContentType, HeaderDate, HeaderETag, HeaderExpires, HeaderExpect,
|
||||
HeaderFrom, HeaderHost, HeaderIfMatch, HeaderIfModifiedSince, HeaderIfNoneMatch,
|
||||
HeaderIfRange, HeaderIfModifiedSince, HeaderLastModified, HeaderLocation, HeaderMaxForwards ,
|
||||
HeaderPragma, HeaderProxyAuthenticate, HeaderProxyAuthorization, HeaderRange, HeaderReferer,
|
||||
HeaderRetryAfter, HeaderServer, HeaderTE, HeaderTrailer,
|
||||
HeaderTransferEncoding, HeaderUpgrade , HeaderUserAgent, HeaderVary,
|
||||
HeaderVia, HeaderWarning, HeaderWWWAuthenticate);
|
||||
|
||||
Function HeaderName(AHeader : THeader) : String;
|
||||
Function HeaderType(AHeader : String) : THeader;
|
||||
Function HTTPDecode(const AStr: String): String;
|
||||
Function HTTPEncode(const AStr: String): String;
|
||||
Function IncludeHTTPPathDelimiter(const AStr: String): String;
|
||||
Function ExcludeHTTPPathDelimiter(const AStr: String): String;
|
||||
|
||||
implementation
|
||||
|
||||
function HeaderName(AHeader: THeader): String;
|
||||
|
||||
begin
|
||||
Result:=HTTPHeaderNames[AHeader];
|
||||
end;
|
||||
|
||||
function HeaderType(AHeader: String): THeader;
|
||||
|
||||
begin
|
||||
Result:=High(THeader);
|
||||
While (Result>hhUnknown) and (CompareText(HTTPHeaderNames[Result],AHeader)<>0) do
|
||||
Result:=Pred(Result);
|
||||
end;
|
||||
|
||||
function HTTPDecode(const AStr: String): String;
|
||||
|
||||
var
|
||||
S,SS, R : PChar;
|
||||
H : String[3];
|
||||
L,C : Integer;
|
||||
|
||||
begin
|
||||
L:=Length(Astr);
|
||||
SetLength(Result,L);
|
||||
If (L=0) then
|
||||
exit;
|
||||
S:=PChar(AStr);
|
||||
SS:=S;
|
||||
R:=PChar(Result);
|
||||
while (S-SS)<L do
|
||||
begin
|
||||
case S^ of
|
||||
'+': R^ := ' ';
|
||||
'%': begin
|
||||
Inc(S);
|
||||
if ((S-SS)<L) then
|
||||
begin
|
||||
if (S^='%') then
|
||||
R^:='%'
|
||||
else
|
||||
begin
|
||||
H:='$00';
|
||||
H[2]:=S^;
|
||||
Inc(S);
|
||||
If (S-SS)<L then
|
||||
begin
|
||||
H[3]:=S^;
|
||||
Val(H,PByte(R)^,C);
|
||||
If (C<>0) then
|
||||
R^:=' ';
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
else
|
||||
R^ := S^;
|
||||
end;
|
||||
Inc(R);
|
||||
Inc(S);
|
||||
end;
|
||||
SetLength(Result,R-PChar(Result));
|
||||
end;
|
||||
|
||||
function HTTPEncode(const AStr: String): String;
|
||||
|
||||
const
|
||||
HTTPAllowed = ['A'..'Z','a'..'z',
|
||||
'*','@','.','_','-',
|
||||
'0'..'9',
|
||||
'$','!','''','(',')'];
|
||||
|
||||
var
|
||||
SS,S,R: PChar;
|
||||
H : String[2];
|
||||
L : Integer;
|
||||
|
||||
begin
|
||||
L:=Length(AStr);
|
||||
SetLength(Result,L*3); // Worst case scenario
|
||||
if (L=0) then
|
||||
exit;
|
||||
R:=PChar(Result);
|
||||
S:=PChar(AStr);
|
||||
SS:=S; // Avoid #0 limit !!
|
||||
while ((S-SS)<L) do
|
||||
begin
|
||||
if S^ in HTTPAllowed then
|
||||
R^:=S^
|
||||
else if (S^=' ') then
|
||||
R^:='+'
|
||||
else
|
||||
begin
|
||||
R^:='%';
|
||||
H:=HexStr(Ord(S^),2);
|
||||
Inc(R);
|
||||
R^:=H[1];
|
||||
Inc(R);
|
||||
R^:=H[2];
|
||||
end;
|
||||
Inc(R);
|
||||
Inc(S);
|
||||
end;
|
||||
SetLength(Result,R-PChar(Result));
|
||||
end;
|
||||
|
||||
function IncludeHTTPPathDelimiter(const AStr: String): String;
|
||||
|
||||
Var
|
||||
l : Integer;
|
||||
|
||||
begin
|
||||
Result:=AStr;
|
||||
L:=Length(Result);
|
||||
If (L>0) and (Result[L]<>'/') then
|
||||
Result:=Result+'/';
|
||||
end;
|
||||
|
||||
function ExcludeHTTPPathDelimiter(const AStr: String): String;
|
||||
|
||||
Var
|
||||
l : Integer;
|
||||
|
||||
begin
|
||||
L:=Length(AStr);
|
||||
If (L>0) and (AStr[L]='/') then
|
||||
Result:=Copy(AStr,1,L-1)
|
||||
else
|
||||
Result:=AStr;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@ -18,7 +18,7 @@ unit webutil;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, httpdefs;
|
||||
Classes, SysUtils, httpprotocol, httpdefs;
|
||||
|
||||
procedure DumpRequest (ARequest : TRequest; Dump : TStrings; Environment : Boolean = False);
|
||||
|
||||
@ -37,32 +37,58 @@ procedure DumpRequest (ARequest : TRequest; Dump : TStrings; Environment : Boole
|
||||
Var
|
||||
I,J : integer;
|
||||
N,V : String;
|
||||
H : THeader;
|
||||
VA : THTTPVariableType;
|
||||
|
||||
begin
|
||||
With ARequest, Dump do
|
||||
begin
|
||||
// All possible headers
|
||||
Add('<H1>All possible request headers:</H1>');
|
||||
Add('<H1>HTTP 1.1 request headers:</H1>');
|
||||
Add('<TABLE BORDER="1"><TR><TD>Header</TD><TD>Value</TD></TR>');
|
||||
For I:=1 to NoHTTPFields do
|
||||
begin
|
||||
AddNV(HTTPFieldNames[i],GetFieldByName(HTTPFieldNames[i]));
|
||||
end;
|
||||
For H in THeader do
|
||||
if (hdRequest in HTTPHeaderDirections[H]) then
|
||||
AddNV(HTTPHeaderNames[H],GetHeader(H));
|
||||
Add('</TABLE><P>');
|
||||
|
||||
// Actually sent headers
|
||||
Add('<H1>Actually sent request headers:</H1>');
|
||||
Add('<TABLE BORDER="1"><TR><TD>Header</TD><TD>Value</TD></TR>');
|
||||
For I:=0 to FieldCount-1 do
|
||||
AddNV(FieldNames[I],FieldValues[I]);
|
||||
For H in THeader do
|
||||
if (hdRequest in HTTPHeaderDirections[H]) and HeaderIsSet(H) then
|
||||
AddNV(HTTPHeaderNames[H],GetHeader(H));
|
||||
For Va in HeaderBasedVariables do
|
||||
begin
|
||||
V:=GetHTTPVariable(Va);
|
||||
if V<>'' then
|
||||
AddNV(THTTPHeader.GetVariableHeaderName(Va),V);
|
||||
end;
|
||||
For I:=0 to CustomHeaders.Count-1 do
|
||||
begin
|
||||
CustomHeaders.GetNameValue(I,N,V);
|
||||
AddNV(N,V);
|
||||
end;
|
||||
Add('</TABLE><P>');
|
||||
|
||||
// Actually sent headers, as text
|
||||
Add('<H1>Actually sent request headers as text:</H1>');
|
||||
For I:=0 to FieldCount-1 do
|
||||
Add(Fields[I]+'<BR>');
|
||||
|
||||
Add('<pre>');
|
||||
For H in THeader do
|
||||
if (hdRequest in HTTPHeaderDirections[H]) and HeaderIsSet(H) then
|
||||
Add(HTTPHeaderNames[H]+': '+GetHeader(H));
|
||||
For Va in HeaderBasedVariables do
|
||||
begin
|
||||
V:=GetHTTPVariable(Va);
|
||||
if V<>'' then
|
||||
Add(THTTPHeader.GetVariableHeaderName(Va)+': '+V);
|
||||
end;
|
||||
For I:=0 to CustomHeaders.Count-1 do
|
||||
begin
|
||||
CustomHeaders.GetNameValue(I,N,V);
|
||||
Add(N+': '+V);
|
||||
end;
|
||||
Add('</PRE>');
|
||||
// Additional headers
|
||||
Add('<H1>Additional headers:</H1>');
|
||||
Add('<H1>Additional protocol variables:</H1>');
|
||||
Add('<TABLE BORDER="1"><TR><TD>Header</TD><TD>Value</TD></TR>');
|
||||
AddNV('PathInfo',PathInfo);
|
||||
AddNV('PathTranslated',PathTranslated);
|
||||
|
||||
Loading…
Reference in New Issue
Block a user