* Merging revisions r45421,r45422 from trunk:

    ------------------------------------------------------------------------
    r45421 | michael | 2020-05-18 17:07:13 +0200 (Mon, 18 May 2020) | 1 line
    
    * Patch from Fabio Girardi to support ifNoneChanged header using enumerated
    ------------------------------------------------------------------------
    r45422 | michael | 2020-05-18 17:08:49 +0200 (Mon, 18 May 2020) | 1 line
    
    * Support generating API
    ------------------------------------------------------------------------

git-svn-id: branches/fixes_3_2@46584 -

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

@@ -89,7 +89,7 @@ const
   FieldCookie = HeaderCookie deprecated;
   FieldSetCookie = HeaderSetCookie deprecated;
 
-  NoHTTPFields    = 27;
+  NoHTTPFields    = 28;
 
   HTTPDateFmt     = httpProtocol.HTTPDateFmt;
   SCookieExpire   = httpProtocol.SCookieExpire;
@@ -129,7 +129,7 @@ Const
                  fieldFrom, fieldIfModifiedSince, fieldLastModified, fieldLocation,
                  fieldPragma, fieldReferer, fieldRetryAfter, fieldServer,
                  fieldSetCookie, fieldUserAgent, fieldWWWAuthenticate,
-                  fieldHost, fieldCacheControl,fieldXRequestedWith) deprecated;
+                  fieldHost, fieldCacheControl,fieldXRequestedWith,fieldIfNoneMatch) deprecated;
 
   // Map header names on indexes in property getter/setter. 0 means not mapped !
   HTTPFieldIndexes : THTTPIndexes
@@ -140,7 +140,7 @@ Const
                        14,15,16,17,
                        18,19,20,21,
                        22,23,24,
-                       34,0,36) deprecated;
+                       34,0,36,26) deprecated;
 
 
 
@@ -553,6 +553,8 @@ type
     Procedure RemoveVariable(VariableName : String); virtual; abstract;
     // Terminate session
     Procedure Terminate; virtual; abstract;
+    // checks if session variable exists
+    Function SessionVariableExists(VarName : String) : Boolean; Virtual; abstract;
     // Session timeout in minutes
     Property TimeOutMinutes : Integer Read FTimeOut Write FTimeOut default 15;
     // ID of this session.
@@ -595,6 +597,7 @@ type
 
   THandleCORSOption = (hcDetect, // Detect OPTIONS request, send full headers
                        hcFull,   // Force sending full headers
+                       hcHumanReadable, // Human readable result
                        hcSend    // In case of full headers, send response
                        );
   THandleCORSOptions = set of THandleCORSOption;
@@ -1092,7 +1095,7 @@ Const
        6,7,8,
        9,-1,-1,-1,
        10,12,-1,13,-1,
-       14,34,-1,15,-1,
+       14,34,-1,15,26,
        -1,-1,16,17,-1,
        18,-1,-1,-1,19,
        20,21,-1,-1,

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

@@ -46,6 +46,7 @@ Type
   Public
     Destructor Destroy; override;
     Procedure Terminate; override;
+    function SessionVariableExists(VarName: String): Boolean; override;
     Procedure UpdateResponse(AResponse : TResponse); override;
     Procedure InitSession(ARequest : TRequest; OnNewSession, OnExpired: TNotifyEvent); override;
     Procedure InitResponse(AResponse : TResponse); override;
@@ -359,6 +360,12 @@ begin
   RemoveFromSessionState(ssExpired);
 end;
 
+function TIniWebSession.SessionVariableExists(VarName: String): Boolean;
+begin
+  CheckSession;
+  Result:=FIniFile.ValueExists(SData,VarName);
+end;
+
 procedure TIniWebSession.UpdateResponse(AResponse: TResponse);
 begin
   // Do nothing. Init has done the job.

packages/fcl-web/src/jsonrpc/webjsonrpc.pp

@@ -20,7 +20,7 @@ unit webjsonrpc;
 interface
 
 uses
-  Classes, SysUtils, fpjson, fpjsonrpc, httpdefs, fphttp, jsonparser, uriparser;
+  Classes, SysUtils, fpjson, fpjsonrpc, httpdefs, fphttp, jsonscanner, jsonparser;
 
 Type
 { ---------------------------------------------------------------------
@@ -82,9 +82,20 @@ Type
   end;
 
   { TCustomJSONRPCModule }
+  TAPIRequestSource = (asURL,  // Next part of URL: RPC/API
+                       asQuery // Next part of URL: RPC?API=1
+                      );
+Const
+  DefaultAPIRequestSources = [asURL, asQuery];
+
+type
+  TAPIRequestSources = Set of TAPIRequestSource;
 
   TCustomJSONRPCModule = Class(TJSONRPCDispatchModule)
   private
+    FAPICreateOptions: TCreateAPIOptions;
+    FAPIRequestName: String;
+    FAPIRequestSources: TAPIRequestSources;
     FDispatcher: TCustomJSONRPCDispatcher;
     FOptions: TJSONRPCDispatchOptions;
     FRequest: TRequest;
@@ -92,11 +103,20 @@ Type
     FResponseContentType: String;
     procedure SetDispatcher(const AValue: TCustomJSONRPCDispatcher);
   Protected
+    function GetAPI(aDisp: TCustomJSONRPCDispatcher; ARequest: TRequest): TJSONStringType; virtual;
     Function GetResponseContentType : String;
     Function CreateDispatcher : TCustomJSONRPCDispatcher; virtual;
-    procedure Notification(AComponent: TComponent; Operation: TOperation);override;
+    Function IsAPIRequest(ARequest : TRequest) : Boolean; virtual;
+    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
     Property Dispatcher :  TCustomJSONRPCDispatcher Read FDispatcher Write SetDispatcher;
+    // Options to use when creating a custom dispatcher
     Property DispatchOptions : TJSONRPCDispatchOptions Read FOptions Write FOptions default DefaultDispatchOptions;
+    // Where to look for API request
+    property APIRequestSources : TAPIRequestSources Read FAPIRequestSources Write FAPIRequestSources default DefaultAPIRequestSources;
+    // URL part or variable name to check for API request
+    property APIRequestName : String Read FAPIRequestName Write FAPIRequestName;
+    // API create options when creating a custom dispatcher
+    Property APICreateOptions : TCreateAPIOptions Read FAPICreateOptions Write FAPICreateOptions;
   Public
     Constructor CreateNew(AOwner : TComponent; CreateMode : Integer); override;
     Procedure HandleRequest(ARequest : TRequest; AResponse : TResponse); override;
@@ -117,9 +137,12 @@ Type
   TJSONRPCModule = Class(TCustomJSONRPCModule)
   Published
     Property Dispatcher;
+    // Only if Dispatcher is not set
     Property DispatchOptions;
     Property ResponseContentType;
     Property CORS;
+    Property APIRequestSources;
+    Property APIRequestName;
   end;
 
 implementation
@@ -150,7 +173,7 @@ Var
 
 begin
   Disp:=Self.GetDispatcher;
-  P:= TJSONParser.Create(ARequest.Content);
+  P:= TJSONParser.Create(ARequest.Content,[joUTF8]);
   try
     Res:=Nil;
     Req:=Nil;
@@ -239,9 +262,20 @@ Var
 begin
   S:=TSessionJSONRPCDispatcher.Create(Self);
   S.Options:=DispatchOptions;
+  S.APICreator.DefaultOptions:=APICreateOptions;
+  S.APICreator.URL:=Self.BaseURL;
   Result:=S;
 end;
 
+function TCustomJSONRPCModule.IsAPIRequest(ARequest: TRequest): Boolean;
+begin
+  Result:=False;
+  if (asURL in APIRequestSources) then
+    Result:=SameText(aRequest.GetNextPathInfo,APIRequestName);
+  if (asQuery in APIRequestSources) then
+    Result:=Result or (aRequest.QueryFields.Values[APIRequestName]<>'');
+end;
+
 
 procedure TCustomJSONRPCModule.Notification(AComponent: TComponent;
   Operation: TOperation);
@@ -255,13 +289,36 @@ constructor TCustomJSONRPCModule.CreateNew(AOwner: TComponent;
   CreateMode: Integer);
 begin
   inherited CreateNew(AOwner, CreateMode);
-  FOptions:=DefaultDispatchOptions+[jdoSearchRegistry];
+  FOptions := DefaultDispatchOptions+[jdoSearchRegistry];
+  APIRequestSources := DefaultAPIRequestSources;
+  APICreateOptions:=[caoFullParams];
 end;
 
+Function TCustomJSONRPCModule.GetAPI(aDisp : TCustomJSONRPCDispatcher; ARequest: TRequest) : TJSONStringType;
+
+var
+  B : Boolean;
+  APIOptions : TCreateAPIOptions;
 
+begin
+  B:=False;
+  APIOptions:=[];
+  if (aRequest.QueryFields.Values['extended']<>'') or (aRequest.QueryFields.Values['full']<>'') then
+    begin
+    Include(APIOptions,caoFullParams);
+    B:=true;
+    end;
+  if (aRequest.QueryFields.Values['formatted']<>'') or (aRequest.QueryFields.Values['humanreadable']<>'') then
+    begin
+    Include(APIOptions,caoFormatted);
+    B:=true;
+    end;
+  if Not B then
+    APIOptions:=aDisp.APICreator.DefaultOptions;
+  Result:=aDisp.APIAsString(APIOptions);
+end;
 
-procedure TCustomJSONRPCModule.HandleRequest(ARequest: TRequest;
-  AResponse: TResponse);
+procedure TCustomJSONRPCModule.HandleRequest(ARequest: TRequest; AResponse: TResponse);
 
 Var
   Disp : TCustomJSONRPCDispatcher;
@@ -269,31 +326,42 @@ Var
   R : TJSONStringType;
 
 begin
-  if SameText(ARequest.Method,'OPTIONS') then
-  if not CORS.HandleRequest(aRequest,aResponse,[hcDetect,hcSend]) then
+  if CORS.HandleRequest(aRequest,aResponse,[hcDetect,hcSend]) then
+    exit;
+  If (Dispatcher=Nil) then
+    Dispatcher:=CreateDispatcher;
+  Disp:=Dispatcher;
+  R:='';
+  if IsAPIRequest(aRequest) then
+    begin
+    if (jdoAllowAPI in TJSONRPCDispatcher(Disp).Options) then
+      R:=GetAPI(Disp,aRequest)
+    else
+      begin
+      Response.Code:=403;
+      Response.CodeText:='FORBIDDEN';
+      end;
+    end
+  else
     begin
-    If (Dispatcher=Nil) then
-      Dispatcher:=CreateDispatcher;
-    Disp:=Dispatcher;
     Res:=DispatchRequest(ARequest,Disp);
     try
-      CORS.HandleRequest(aRequest,aResponse,[]);
-      If Assigned(Res) then
-        begin
-        AResponse.FreeContentStream:=True;
-        AResponse.ContentStream:=TMemoryStream.Create;
+      if Assigned(Res) then
         R:=Res.AsJSON;
-        if Length(R)>0 then
-          AResponse.ContentStream.WriteBuffer(R[1],Length(R));
-        AResponse.ContentLength:=AResponse.ContentStream.Size;
-        R:=''; // Free up mem
-        AResponse.ContentType:=GetResponseContentType;
-        end;
-      AResponse.SendResponse;
     finally
       Res.Free;
     end;
     end;
+  AResponse.ContentType:=GetResponseContentType;
+  if (R<>'') then
+    begin
+    AResponse.FreeContentStream:=True;
+    AResponse.ContentStream:=TMemoryStream.Create;
+    AResponse.ContentStream.WriteBuffer(R[1],Length(R));
+    AResponse.ContentLength:=AResponse.ContentStream.Size;
+    R:=''; // Free up mem
+    end;
+  AResponse.SendResponse;
 end;
 
 { TJSONRPCSessionContext }
@@ -322,7 +390,7 @@ var
 
 
 begin
-  P:= TJSONParser.Create(ARequest.Content);
+  P:= TJSONParser.Create(ARequest.Content,[joUTF8]);
   try
     Result:=Nil;
     Req:=Nil;