paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-07 13:10:34 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Fixed bug ID #25263

Browse Source 
git-svn-id: trunk@26578 -
This commit is contained in:
michael 2014-01-24 16:49:07 +00:00
parent fa4aa67f35
commit 03b859947f
1 changed files with 38 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

56
packages/fcl-web/src/base/httpdefs.pp
View File

@ -59,8 +59,13 @@ const
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';
NoHTTPFields = 24;
NoHTTPFields = 27;
HTTPDateFmt = '"%s", dd "%s" yyyy hh:mm:ss'; // For use in FormatDateTime
SCookieExpire = ' "Expires="'+HTTPDateFmt+' "GMT"';
@ -79,9 +84,12 @@ const
Type
THttpFields = Array[1..NoHTTPFields] of string;
THttpFields = Array[1..NoHTTPFields] of string;
THttpIndexes = Array[1..NoHTTPFields] of integer;
Const
// For this constant, the header names corresponds to the property index used in THTTPHeader.
HTTPFieldNames : THttpFields
= (fieldAccept, fieldAcceptCharset, fieldAcceptEncoding,
fieldAcceptLanguage, fieldAuthorization, fieldConnection,
@ -89,8 +97,20 @@ Const
fieldContentType, fieldCookie, fieldDate, fieldExpires,
fieldFrom, fieldIfModifiedSince, fieldLastModified, fieldLocation,
fieldPragma, fieldReferer, fieldRetryAfter, fieldServer,
fieldSetCookie, fieldUserAgent, fieldWWWAuthenticate);
fieldSetCookie, fieldUserAgent, fieldWWWAuthenticate,
fieldHost, fieldCacheControl,fieldXRequestedWith);
// Map header names on indexes in property getter/setter. 0 means not mapped !
HTTPFieldIndexes : THTTPIndexes
= (1,2,3,
4,5,6,
7,8,9,
10,11,12,13,
14,15,16,17,
18,19,20,21,
22,23,24,
34,0,36);
type
TRequest = Class;
@ -242,7 +262,6 @@ type
function GetSetFieldName(AIndex: Integer): String;
procedure SetCookieFields(const AValue: TStrings);
Function GetFieldCount : Integer;
Function GetFieldName(Index : Integer) : String;
Function GetContentLength : Integer;
Procedure SetContentLength(Value : Integer);
Function GetFieldIndex(AIndex : Integer) : Integer;
@ -331,6 +350,8 @@ type
FHandleGetOnPost: Boolean;
FOnUnknownEncoding: TOnUnknownEncodingEvent;
FPathInfo,
FHost : string;
FRequestedWith : String;
FURI: String;
FFiles : TUploadedFiles;
FReturnedPathInfo : String;
@ -382,6 +403,7 @@ type
TResponse = class(THttpHeader)
private
FCacheControl: String;
FContents: TStrings;
FContentStream : TStream;
FCode: Integer;
@ -415,6 +437,7 @@ type
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 FirstHeaderLine : String Read GetFirstHeaderLine Write SetFirstHeaderLine;
Property ContentStream : TStream Read FContentStream Write SetContentStream;
Property Content : String Read GetContent Write SetContent;
@ -519,6 +542,8 @@ begin
Result:=NoHTTPFields;
While (Result>0) and (UpperCase(HTTPFieldNames[Result])<>Name) do
Dec(Result);
If Result>0 then
Result:=HTTPFieldIndexes[Result];
end;
function HTTPDecode(const AStr: String): String;
@ -835,17 +860,6 @@ begin
end;
function THttpHeader.GetFieldName(Index: Integer): String;
Var
I : Integer;
begin
I:=GetFieldIndex(Index);
If (I<>-1) then
Result := HTTPFieldNames[i];
end;
Function THttpHeader.GetFieldValue(Index : Integer) : String;
begin
@ -869,7 +883,7 @@ end;
Procedure THttpHeader.SetFieldValue(Index : Integer; Value : String);
begin
if (Index>1) and (Index<NoHTTPFields) then
if (Index>1) and (Index<=NoHTTPFields) then
begin
FFields[Index]:=Value;
If (Index=11) then
@ -941,7 +955,9 @@ var
begin
I:=GetFieldNameIndex(AName);
If (I<>0) then
Result:=self.GetFieldValue(i);
Result:=self.GetFieldValue(i)
else
Result:='';
end;
Function THTTPHeader.LoadFromStream(Stream: TStream; IncludeCommand : Boolean) : Integer;
@ -1308,6 +1324,8 @@ begin
25 : Result:=FPathInfo;
31 : Result:=FCommand;
32 : Result:=FURI;
34 : Result:=FHost;
36 : Result:=FRequestedWith;
35 : begin
If Not FContentRead and AllowReadContent then
begin
@ -1328,6 +1346,8 @@ begin
30 : FServerPort:=Value;
31 : FCommand:=Value;
32 : FURI:=Value;
34 : FHost:=Value;
36 : FRequestedWith:=Value;
else
inherited SetFieldValue(Index, Value);
end