|
@@ -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
|
|
|
+ V:=GetEnvironmentVariable(CGIVarNames[I]);
|
|
|
+ if (V<>'') then
|
|
|
begin
|
|
|
- OV:=GetFieldByName(N);
|
|
|
- V:=GetEnvironmentVariable(CGIVarNames[I]);
|
|
|
- If (OV='') or (V<>'') then
|
|
|
+ M:=MapCgiToHTTP[i];
|
|
|
+ if M.H<>hhUnknown then
|
|
|
+ SetHeader(M.H,HTTPDecode(V))
|
|
|
+ else if M.V<>hvUnknown then
|
|
|
begin
|
|
|
- if (N<>'QUERY_STRING') then
|
|
|
+ if M.V<>hvQuery then
|
|
|
V:=HTTPDecode(V);
|
|
|
- SetFieldByName(N,V);
|
|
|
+ SetHTTPVariable(M.V,V)
|
|
|
end;
|
|
|
- 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 }
|
|
|
|