Просмотр исходного кода

* Rework header treatment, deprecated some calls/properties

git-svn-id: trunk@30550 -
michael 10 лет назад
Родитель
Сommit
4769a5407c

+ 2 - 0
.gitattributes

@@ -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

+ 11 - 0
packages/fcl-web/fpmake.pp

@@ -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 - 0
packages/fcl-web/src/base/cgiprotocol.pp

@@ -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.
+

+ 119 - 102
packages/fcl-web/src/base/custcgi.pp

@@ -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 }
 

+ 35 - 79
packages/fcl-web/src/base/custfcgi.pp

@@ -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,

+ 0 - 58
packages/fcl-web/src/base/custweb.pp

@@ -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;

+ 51 - 57
packages/fcl-web/src/base/fpapache.pp

@@ -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);

Разница между файлами не показана из-за своего большого размера
+ 449 - 275
packages/fcl-web/src/base/httpdefs.pp


+ 269 - 0
packages/fcl-web/src/base/httpprotocol.pp

@@ -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.
+

+ 39 - 13
packages/fcl-web/src/base/webutil.pp

@@ -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);

Некоторые файлы не были показаны из-за большого количества измененных файлов