--- Merging r21447 into '.':

U    packages/fcl-json/src/fpjson.pp
--- Merging r21476 into '.':
G    packages/fcl-json/src/fpjson.pp
--- Merging r21487 into '.':
G    packages/fcl-json/src/fpjson.pp
--- Merging r21628 into '.':
U    packages/fcl-json/src/fpjsonrtti.pp
--- Merging r21635 into '.':
G    packages/fcl-json/src/fpjson.pp
--- Merging r21755 into '.':
U    packages/fcl-web/src/base/httpdefs.pp
--- Merging r21679 into '.':
U    ide/fp.pas
--- Merging r21770 into '.':
U    packages/fcl-web/src/base/iniwebsession.pp
--- Merging r21836 into '.':
G    packages/fcl-web/src/base/httpdefs.pp

# revisions: 21447,21476,21487,21628,21635,21755,21679,21770,21836
r21447 | michael | 2012-05-31 23:06:22 +0200 (Thu, 31 May 2012) | 1 line
Changed paths:
   M /trunk/packages/fcl-json/src/fpjson.pp

* Easy access functions in TJSONObject
r21476 | marco | 2012-06-03 16:54:44 +0200 (Sun, 03 Jun 2012) | 4 lines
Changed paths:
   M /trunk/packages/fcl-json/src/fpjson.pp

 * Patch from #22183 by Luiz. Fix a copy paste error and 
  change some redundant AS statements to casts. (redundant 
  because they were found by find for the respective type)
r21487 | michael | 2012-06-04 21:04:44 +0200 (Mon, 04 Jun 2012) | 1 line
Changed paths:
   M /trunk/packages/fcl-json/src/fpjson.pp

* Applied rename patch from Luiz Americo
r21628 | michael | 2012-06-17 10:26:34 +0200 (Sun, 17 Jun 2012) | 1 line
Changed paths:
   M /trunk/packages/fcl-json/src/fpjsonrtti.pp

* Added jsoCheckEmptyDateTime option to check for 0 date/time
r21635 | marco | 2012-06-17 19:44:58 +0200 (Sun, 17 Jun 2012) | 2 lines
Changed paths:
   M /trunk/packages/fcl-json/src/fpjson.pp

 * fix bug in .find (copy-and-paste?) mentioned by Ludo in #22273
r21755 | michael | 2012-07-02 09:33:14 +0200 (Mon, 02 Jul 2012) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/base/httpdefs.pp

* Patch from Silvio Clecio to implement httponly cookie property
r21679 | marco | 2012-06-22 15:31:48 +0200 (Fri, 22 Jun 2012) | 2 lines
Changed paths:
   M /trunk/ide/fp.pas

 * fix bug #22300, "C" prefix of configuration file.
r21770 | michael | 2012-07-04 14:59:18 +0200 (Wed, 04 Jul 2012) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/base/iniwebsession.pp

* Allow session file prefix. Make sessiondir readable
r21836 | michael | 2012-07-10 08:16:49 +0200 (Tue, 10 Jul 2012) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/base/httpdefs.pp

* Patch from Silvio Clecio to implement TCookie.Expire (bug id 22361)

git-svn-id: branches/fixes_2_6@21993 -

ide/fp.pas

@@ -177,8 +177,9 @@ begin
           'C' : { custom config file (BP compatiblity) }
            if BeforeINI then
             begin
+              delete(param,1,1); // delete C
               if (length(Param)>=1) and (Param[1] in['=',':']) then
-                Delete(Param,1,1); { eat separator }
+                Delete(Param,1,1); { eat optional separator }
               IniFileName:=Param;
             end;
           'R' : { enter the directory last exited from (BP comp.) }

packages/fcl-json/src/fpjson.pp

@@ -394,6 +394,15 @@ Type
     procedure Iterate(Iterator : TJSONObjectIterator; Data: TObject);
     function IndexOf(Item: TJSONData): Integer;
     Function IndexOfName(const AName: TJSONStringType; CaseInsensitive : Boolean = False): Integer;
+    Function Find(Const AName : String) : TJSONData; overload;
+    Function Find(Const AName : String; AType : TJSONType) : TJSONData; overload;
+    Function Get(Const AName : String; ADefault : TJSONFloat) : TJSONFloat;
+    Function Get(Const AName : String; ADefault : Integer) : Integer;
+    Function Get(Const AName : String; ADefault : Int64) : Int64;
+    Function Get(Const AName : String; ADefault : Boolean) : Boolean;
+    Function Get(Const AName : String; ADefault : TJSONStringType) : TJSONStringTYpe;
+    Function Get(Const AName : String; ADefault : TJSONArray) : TJSONArray;
+    Function Get(Const AName : String; ADefault : TJSONObject) : TJSONObject;
     // Manipulate
     Procedure Clear;  override;
     function Add(const AName: TJSONStringType; AValue: TJSONData): Integer; overload;
@@ -405,8 +414,10 @@ Type
     function Add(const AName: TJSONStringType): Integer; overload;
     function Add(const AName: TJSONStringType; AValue : TJSONArray): Integer; overload;
     procedure Delete(Index : Integer);
+    procedure Delete(Const AName : string);
     procedure Remove(Item : TJSONData);
     Function Extract(Index : Integer) : TJSONData;
+    Function Extract(Const AName : string) : TJSONData;
 
     // Easy access properties.
     property Names[Index : Integer] : TJSONStringType read GetNameOf;
@@ -2013,6 +2024,17 @@ begin
   FHash.Delete(Index);
 end;
 
+procedure TJSONObject.Delete(Const AName: string);
+
+Var
+  I : Integer;
+
+begin
+  I:=IndexOfName(AName);
+  if (I<>-1) then
+    Delete(I);
+end;
+
 procedure TJSONObject.Remove(Item: TJSONData);
 begin
   FHash.Remove(Item);
@@ -2024,5 +2046,130 @@ begin
   FHash.Extract(Result);
 end;
 
+function TJSONObject.Extract(const AName: string): TJSONData;
+
+Var
+  I : Integer;
+
+begin
+  I:=IndexOfName(AName);
+  if (I<>-1) then
+    Result:=Extract(I)
+  else
+    Result:=Nil
+end;
+
+function TJSONObject.Get(const AName: String; ADefault: TJSONFloat
+  ): TJSONFloat;
+
+Var
+  D : TJSONData;
+
+begin
+  D:=Find(AName,jtNumber);
+  If D<>Nil then
+    Result:=D.AsFloat
+  else
+    Result:=ADefault;
+end;
+
+function TJSONObject.Get(const AName: String; ADefault: Integer
+  ): Integer;
+
+Var
+  D : TJSONData;
+
+begin
+  D:=Find(AName,jtNumber);
+  If D<>Nil then
+    Result:=D.AsInteger
+  else
+    Result:=ADefault;
+end;
+
+function TJSONObject.Get(const AName: String; ADefault: Int64): Int64;
+Var
+  D : TJSONData;
+
+begin
+  D:=Find(AName,jtNumber);
+  If D<>Nil then
+    Result:=D.AsInt64
+  else
+    Result:=ADefault;
+end;
+
+function TJSONObject.Get(const AName: String; ADefault: Boolean
+  ): Boolean;
+Var
+  D : TJSONData;
+
+begin
+  D:=Find(AName,jtBoolean);
+  If D<>Nil then
+    Result:=D.AsBoolean
+  else
+    Result:=ADefault;
+end;
+
+function TJSONObject.Get(const AName: String; ADefault: TJSONStringType
+  ): TJSONStringType;
+Var
+  D : TJSONData;
+
+begin
+  D:=Find(AName,jtString);
+  If (D<>Nil) then
+    Result:=D.AsString
+  else
+    Result:=ADefault;
+end;
+
+function TJSONObject.Get(const AName: String; ADefault: TJSONArray
+  ): TJSONArray;
+Var
+  D : TJSONData;
+
+begin
+  D:=Find(AName,jtArray);
+  If (D<>Nil) then
+    Result:=TJSONArray(D)
+  else
+    Result:=ADefault;
+end;
+
+function TJSONObject.Get(const AName: String; ADefault: TJSONObject
+  ): TJSONObject;
+Var
+  D : TJSONData;
+
+begin
+  D:=Find(AName,jtObject);
+  If (D<>Nil) then
+    Result:=TJSONObject(D)
+  else
+    Result:=ADefault;
+end;
+
+function TJSONObject.Find(const AName: String): TJSONData;
+
+Var
+  I : Integer;
+
+begin
+  I:=IndexOfName(AName);
+  If (I<>-1) then
+    Result:=Items[i]
+  else
+    Result:=Nil;
+end;
+
+function TJSONObject.Find(const AName: String; AType: TJSONType): TJSONData;
+begin
+  Result:=Find(AName);
+  If Assigned(Result) and (Result.JSONType<>AType) then
+    Result:=Nil;
+end;
+
 end.
 

packages/fcl-json/src/fpjsonrtti.pp

@@ -20,8 +20,9 @@ Type
                        jsoComponentsInline,       // Always stream components inline. Default is to stream name, unless csSubcomponent in ComponentStyle
                        jsoTStringsAsArray,        // Stream TStrings as an array of strings. Associated objects are not streamed.
                        jsoTStringsAsObject,       // Stream TStrings as an object : string = { object }
-                       jsoDateTimeAsString,
-                       jsoUseFormatString);       // Use FormatString when creating JSON strings.
+                       jsoDateTimeAsString,       // Format a TDateTime value as a string
+                       jsoUseFormatString,        // Use FormatString when creating JSON strings.
+                       jsoCheckEmptyDateTime);    // If TDateTime value is empty and jsoDateTimeAsString is used, 0 date returns empty string
   TJSONStreamOptions = Set of TJSONStreamOption;
 
   TJSONFiler = Class(TComponent)
@@ -999,7 +1000,9 @@ Var
   S: String;
 
 begin
-  if (DateTimeFormat<>'') then
+  if (jsoCheckEmptyDateTime in Options) and (DateTime=0) then
+    S:=''
+  else if (DateTimeFormat<>'') then
     S:=FormatDateTime(DateTimeFormat,DateTime)
   else if Frac(DateTime)=0 then
     S:=DateToStr(DateTime)

packages/fcl-web/src/base/httpdefs.pp

@@ -62,11 +62,12 @@ const
 
   NoHTTPFields = 24;
 
-  HTTPDateFmt   = '"%s", dd "%s" yyyy hh:mm:ss'; // For use in FormatDateTime
-  SCookieExpire = ' "expires="'+HTTPDateFmt+' "GMT;"';
-  SCookieDomain = ' domain=%s;';
-  SCookiePath   = ' path=%s;';
-  SCookieSecure = ' secure';
+  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',
@@ -98,6 +99,7 @@ type
 
   TCookie = class(TCollectionItem)
   private
+    FHttpOnly: Boolean;
     FName: string;
     FValue: string;
     FPath: string;
@@ -109,12 +111,14 @@ type
   public
     constructor Create(ACollection: TCollection); override;
     procedure Assign(Source: TPersistent); override;
+    procedure Expire;
     property Name: string read FName write FName;
     property Value: string read FValue write FValue;
     property Domain: string read FDomain write FDomain;
     property Path: string read FPath write FPath;
     property Expires: TDateTime read FExpires write FExpires;
     property Secure: Boolean read FSecure write FSecure;
+    property HttpOnly: Boolean read FHttpOnly write FHttpOnly;
     Property AsString : String Read GetAsString;
   end;
 
@@ -427,7 +431,7 @@ Resourcestring
   SErrUnknownCookie             = 'Unknown cookie: "%s"';
   SErrUnsupportedContentType    = 'Unsupported content type: "%s"';
   SErrNoRequestMethod           = 'No REQUEST_METHOD passed from server.';
-  SErrInvalidRequestMethod      = 'Invalid REQUEST_METHOD passed from server.';
+  SErrInvalidRequestMethod      = 'Invalid REQUEST_METHOD passed from server: %s.';
 
 const
    hexTable = '0123456789ABCDEF';
@@ -1223,7 +1227,7 @@ begin
     if FHandleGetOnPost then
       InitGetVars;
     end
-  else if (CompareText(R,'GET')=0) or (CompareText(R,'HEAD')=0) then
+  else if (CompareText(R,'GET')=0) or (CompareText(R,'HEAD')=0) or (CompareText(R,'OPTIONS')=0) then
     InitGetVars
   else
     Raise Exception.CreateFmt(SErrInvalidRequestMethod,[R]);
@@ -1655,29 +1659,37 @@ end;
 
 function TCookie.GetAsString: string;
 
+  Procedure AddToResult(S : String);
+  
+  begin
+    Result:=Result+';'+S;
+  end;
+
 Var
   Y,M,D : Word;
 
 begin
 {$ifdef cgidebug}SendMethodEnter('TCookie.GetAsString');{$endif}
   try
-    Result:=Format('%s=%s;',[HTTPEncode(FName),HTTPEncode(FValue)]);
+    Result:=Format('%s=%s',[HTTPEncode(FName),HTTPEncode(FValue)]);
     if (Length(FDomain)>0) then
-      Result:=Result+Format(SCookieDomain,[FDomain]);
+      AddToResult(Format(SCookieDomain,[FDomain]));
     if (Length(FPath)>0) then
-      Result:=Result+Format(SCookiePath,[FPath]);
+      AddToResult(Format(SCookiePath,[FPath]));
     if (FExpires>-1) then
       begin
       DecodeDate(Expires,Y,M,D);
-      Result:=Result+Format(FormatDateTime(SCookieExpire,Expires),
-                          [HTTPDays[DayOfWeek(Expires)],HTTPMonths[M]]);
+      AddToResult(Format(FormatDateTime(SCookieExpire,Expires),
+                         [HTTPDays[DayOfWeek(Expires)],HTTPMonths[M]]));
       end;
-    if Secure then
-      Result:=Result+SCookieSecure;
+    if FHttpOnly then
+      AddToResult(SCookieHttpOnly);
+    if FSecure then
+      AddToResult(SCookieSecure);
   except
 {$ifdef cgidebug}
     On E : Exception do
-      SendDebug('Exception in cookie asstring : '+E.Message)
+      SendDebug('Exception in cookie AsString: '+E.Message)
 {$endif}
   end;
 {$ifdef cgidebug}SendMethodExit('TCookie.GetAsString');{$endif}
@@ -1699,12 +1711,18 @@ begin
       Self.FDomain:=Domain;
       Self.FPath:=Path;
       Self.FExpires:=Expires;
+      Self.FHttpOnly:=HttpOnly;
       Self.FSecure:=Secure;
       end
   else
     inherited Assign(Source);
 end;
 
+procedure TCookie.Expire;
+begin
+  FExpires := EncodeDate(1970, 1, 1);
+end;
+
 { TCookieCollection }
 
 function TCookies.GetCookie(Index: Integer): TCookie;

packages/fcl-web/src/base/iniwebsession.pp

@@ -48,6 +48,7 @@ Type
     Procedure InitSession(ARequest : TRequest; OnNewSession, OnExpired: TNotifyEvent); override;
     Procedure InitResponse(AResponse : TResponse); override;
     Procedure RemoveVariable(VariableName : String); override;
+    Function GetSessionDir : String;
   end;
   TIniWebSessionClass = Class of TIniWebSession;
 
@@ -68,6 +69,7 @@ Type
     // Sweep session direcory and delete expired files.
     procedure DoCleanupSessions; override;
     Procedure DoDoneSession(Var ASession : TCustomSession); override;
+    Function SessionFilePrefix : String; virtual; 
   Public
     // Directory where sessions are kept.
     Property SessionDir : String Read FSessionDir Write SetSessionDir;
@@ -212,8 +214,20 @@ begin
   FreeAndNil(ASession);
 end;
 
+Function TIniSessionFactory.SessionFilePrefix : String; 
+
+begin
+  Result:='';
+end;
+
 { TIniWebSession }
 
+Function TIniWebSession.GetSessionDir : String;
+
+begin
+  Result:=SessionDir;
+end;
+
 function TIniWebSession.GetSessionID: String;
 begin
   If (SID='') then
@@ -282,8 +296,10 @@ procedure TIniWebSession.InitSession(ARequest: TRequest; OnNewSession,OnExpired:
 
 Var
   S : String;
-
+  SF : TIniSessionFactory;
+  
 begin
+  SF:=SessionFactory as TIniSessionFactory;
 {$ifdef cgidebug}SendMethodEnter('TIniWebSession.InitSession');{$endif}
   // First initialize all session-dependent properties to their default, because
   // in Apache-modules or fcgi programs the session-instance is re-used
@@ -299,13 +315,13 @@ begin
   If (S<>'') then
     begin
 {$ifdef cgidebug}SendDebug('Reading ini file:'+S);{$endif}
-    FIniFile:=TMemIniFile.Create(IncludeTrailingPathDelimiter(SessionDir)+S);
-    if (SessionFactory as TIniSessionFactory).SessionExpired(FIniFile) then
+    FIniFile:=TMemIniFile.Create(IncludeTrailingPathDelimiter(SessionDir)+SF.SessionFilePrefix+S);
+    if SF.SessionExpired(FIniFile) then
       begin
       // Expire session.
       If Assigned(OnExpired) then
         OnExpired(Self);
-      (SessionFactory as TIniSessionFactory).DeleteSessionFile(FIniFIle.FileName);
+      SF.DeleteSessionFile(FIniFIle.FileName);
       FreeAndNil(FInifile);
       S:='';
       end
@@ -317,7 +333,7 @@ begin
     If Assigned(OnNewSession) then
       OnNewSession(Self);
     GetSessionID;
-    S:=IncludeTrailingPathDelimiter(SessionDir)+SessionID;
+    S:=IncludeTrailingPathDelimiter(SessionDir)+SF.SessionFilePrefix+SessionID;
 {$ifdef cgidebug}SendDebug('Creating new Ini file : '+S);{$endif}
     FIniFile:=TMemIniFile.Create(S);
     FIniFile.WriteDateTime(SSession,KeyStart,Now);