Support for X-HTTP-Method-Override to work behind corporate firewalls.

2024-11-15 07:45:54 +01:00 · 2019-05-10 00:46:03 +02:00 · 2019-05-10 00:46:03 +02:00 · 7b39d94537
commit 7b39d94537
parent 6a664d608c
7 changed files with 98 additions and 44 deletions
--- a/README.md
+++ b/README.md
@ -71,27 +71,47 @@ Congratulations to Daniele Teti and all the staff for the excellent work!" -- Ma
 ```delphi
 //Now is really easy to add "_links" property automatically for each collection element while rendering
 Render<TPerson>(People, True,
-  procedure(const Person: TPerson; const Links: TMVCStringDictionary)
-  begin
-    Links['x-ref'] := '/api/people/' + Person.ID;
-    Links['x-child-ref'] := '/api/people/' + Person.ID + '/child';
-  end);
+    procedure(const APerson: TPerson; const Links: IMVCLinks)
+    begin
+      Links.AddRefLink
+        .Add(HATEOAS.HREF, '/people/' + APerson.ID.ToString)
+        .Add(HATEOAS.REL, 'self')
+        .Add(HATEOAS._TYPE, 'application/json')
+        .Add('title', 'Details for ' + APerson.FullName);
+      Links.AddRefLink
+        .Add(HATEOAS.HREF, '/people')
+        .Add(HATEOAS.REL, 'people')
+        .Add(HATEOAS._TYPE, 'application/json');
+    end);
+
 		
 //Datasets have a similar anon method to do the same thing
 Render(lDM.qryCustomers, False,
-  procedure(const DS: TDataset; const Links: TMVCStringDictionary)
+  procedure(const DS: TDataset; const Links: IMVCLinks)
  begin
-    Links['x-ref'] := '/api/customers/' + DS.FieldByName('cust_no').AsString;
-    Links['x-ref-orders'] := '/api/customers/' + DS.FieldByName('cust_no').AsString + '/orders';		
+	Links.AddRefLink
+	  .Add(HATEOAS.HREF, '/customers/' + DS.FieldByName('cust_no').AsString)
+	  .Add(HATEOAS.REL, 'self')
+	  .Add(HATEOAS._TYPE, 'application/json');
+	Links.AddRefLink
+	  .Add(HATEOAS.HREF, '/customers/' + DS.FieldByName('cust_no').AsString + '/orders')
+	  .Add(HATEOAS.REL, 'orders')
+	  .Add(HATEOAS._TYPE, 'application/json');
  end);

 //Single object rendering allows HATEOAS too!
 Render(lPerson, False,
-  procedure(const AObject: TObject; const Links: TMVCStringDictionary)
+  procedure(const AObject: TObject; const Links: IMVCLinks)
  begin
-    Links['x-self'] := '/people/' + TPerson(AObject).ID.ToString;
-    Links['x-self-list'] := '/people';
-  end);	
+	Links.AddRefLink
+	  .Add(HATEOAS.HREF, '/people/' + TPerson(AObject).ID.ToString)
+	  .Add(HATEOAS.REL, 'self')
+	  .Add(HATEOAS._TYPE, TMVCMediaType.APPLICATION_JSON);
+	Links.AddRefLink
+	  .Add(HATEOAS.HREF, '/people')
+	  .Add(HATEOAS.REL, 'people')
+	  .Add(HATEOAS._TYPE, TMVCMediaType.APPLICATION_JSON);
+  end);
 	
 ```	

@ -116,8 +136,10 @@ Render(lPerson, False,
 - Improved! JSONRPC Automatic Object Publishing can not invoke inherited methods if not explicitely defined with `MVCInheritable` attribute.
 - Improved! Datasets serialization speed improvement. In some case the performace [improves of 2 order of magnitude](https://github.com/danieleteti/delphimvcframework/issues/205#issuecomment-479513158). (Thanks to https://github.com/pedrooliveira01)
 - New! Added `in` operator in RQL parser (Thank you [João Antônio Duarte](https://github.com/joaoduarte19))
+- New! Added `TMVCActiveRecord.Count<T>(RQL)` to count record based on RQL criteria
 - New! Calling `<jsonrpcendpoint>/describe` returns the methods list available for that endpoint.
 - New! Experimental (alpha stage) support for Android servers!
+- New! Added support for `X-HTTP-Method-Override` to work behind corporate firewalls.
 - New Installation procedure! Just open the project group, build all and install the design-time package (which is `dmvcframeworkDT`)


--- a/samples/renders/RenderSampleControllerU.pas
+++ b/samples/renders/RenderSampleControllerU.pas
@ -358,7 +358,6 @@ begin
          .Add(HATEOAS.HREF, '/customers/' + DS.FieldByName('cust_no').AsString + '/orders')
          .Add(HATEOAS.REL, 'orders')
          .Add(HATEOAS._TYPE, 'application/json');
-
      end);
  finally
    lDM.Free;
@ -614,6 +613,10 @@ begin
        .Add(HATEOAS.REL, 'self')
        .Add(HATEOAS._TYPE, 'application/json')
        .Add('title', 'Details for ' + APerson.FullName);
+      Links.AddRefLink
+        .Add(HATEOAS.HREF, '/people')
+        .Add(HATEOAS.REL, 'people')
+        .Add(HATEOAS._TYPE, 'application/json');
    end);
 end;

--- a/samples/renders/renders.dproj
+++ b/samples/renders/renders.dproj
@ -327,37 +327,37 @@
                        <Overwrite>true</Overwrite>
                    </Platform>
                </DeployFile>
+                <DeployFile LocalName="ModelSupport_renders\renders\default.txaPackage" Configuration="Debug" Class="ProjectFile">
+                    <Platform Name="Win32">
+                        <RemoteDir>.\</RemoteDir>
+                        <Overwrite>true</Overwrite>
+                    </Platform>
+                </DeployFile>
+                <DeployFile LocalName="ModelSupport_renders\renders1\default.txvpck" Configuration="Release" Class="ProjectFile">
+                    <Platform Name="Win32">
+                        <RemoteDir>.\</RemoteDir>
+                        <Overwrite>true</Overwrite>
+                    </Platform>
+                </DeployFile>
                <DeployFile LocalName="ModelSupport_renders\renders1\default.txvpck" Configuration="Debug" Class="ProjectFile">
                    <Platform Name="Linux64">
                        <RemoteDir>.\</RemoteDir>
                        <Overwrite>true</Overwrite>
                    </Platform>
                </DeployFile>
-                <DeployFile LocalName="ModelSupport_renders\renders\default.txvpck" Configuration="Debug" Class="ProjectFile">
-                    <Platform Name="Linux64">
-                        <RemoteDir>.\</RemoteDir>
-                        <Overwrite>true</Overwrite>
-                    </Platform>
-                </DeployFile>
-                <DeployFile LocalName="ModelSupport_renders\default.txvpck" Configuration="Release" Class="ProjectFile">
-                    <Platform Name="Win32">
-                        <RemoteDir>.\</RemoteDir>
-                        <Overwrite>true</Overwrite>
-                    </Platform>
-                </DeployFile>
                <DeployFile LocalName="bin\renders.exe" Configuration="Release" Class="ProjectOutput">
                    <Platform Name="Win32">
                        <RemoteName>renders.exe</RemoteName>
                        <Overwrite>true</Overwrite>
                    </Platform>
                </DeployFile>
-                <DeployFile LocalName="ModelSupport_renders\renders1\default.txvpck" Configuration="Release" Class="ProjectFile">
-                    <Platform Name="Win32">
+                <DeployFile LocalName="ModelSupport_renders\renders\default.txvpck" Configuration="Debug" Class="ProjectFile">
+                    <Platform Name="Linux64">
                        <RemoteDir>.\</RemoteDir>
                        <Overwrite>true</Overwrite>
                    </Platform>
                </DeployFile>
-                <DeployFile LocalName="ModelSupport_renders\renders\default.txaPackage" Configuration="Debug" Class="ProjectFile">
+                <DeployFile LocalName="ModelSupport_renders\default.txvpck" Configuration="Release" Class="ProjectFile">
                    <Platform Name="Win32">
                        <RemoteDir>.\</RemoteDir>
                        <Overwrite>true</Overwrite>
--- a/sources/MVCFramework.Commons.pas
+++ b/sources/MVCFramework.Commons.pas
@ -117,6 +117,7 @@ type
    OneKiB = 1024;
    DEFAULT_MAX_REQUEST_SIZE = OneMiB * 5; // 5 MiB
    HATEOAS_PROP_NAME = '_links';
+    X_HTTP_Method_Override = 'X-HTTP-Method-Override';
  end;

  HATEOAS = record
--- a/sources/MVCFramework.JSONRPC.pas
+++ b/sources/MVCFramework.JSONRPC.pas
@ -1126,19 +1126,6 @@ begin
    RequestID := TValue.Empty;
  Method := JSON.S[JSONRPC_METHOD];
  Params.Clear;
-  // if JSON.Types[JSONRPC_PARAMS] = jdtArray then
-  // begin
-  // lParams := JSON.A[JSONRPC_PARAMS];
-  // for I := 0 to lParams.Count - 1 do
-  // begin
-  // { TODO -oDanieleT -cGeneral : Qui devo sapere cosa si aspetta la classe, altrimenti non posso castare al tipo corretto }
-  // AddParam(Params,lParams[I]);
-  // end;
-  // end
-  // else if JSON.Types[JSONRPC_PARAMS] <> jdtNone then
-  // begin
-  // raise EMVCJSONRPCException.Create('Params must be a JSON array or null');
-  // end;
 end;

 constructor TJSONRPCNotification.Create(const aMethod: String);
--- a/sources/MVCFramework.pas
+++ b/sources/MVCFramework.pas
@ -192,6 +192,7 @@ type
    function ClientIp: string;
    function ClientPrefer(const AMediaType: string): Boolean;
    function ClientPreferHTML: Boolean;
+    function GetOverwrittenHTTPMethod: TMVCHTTPMethodType;

    function SegmentParam(const AParamName: string; out AValue: string): Boolean;
    function SegmentParamsCount: Integer;
@ -687,7 +688,6 @@ type
      const AControllerQualifiedClassName: string; const AActionName: string; var AHandled: Boolean);
    procedure ExecuteAfterControllerActionMiddleware(const AContext: TWebContext; const AActionName: string;
      const AHandled: Boolean);
-
    procedure DefineDefaultResponseHeaders(const AContext: TWebContext);
    procedure OnBeforeDispatch(ASender: TObject; ARequest: TWebRequest; AResponse: TWebResponse;
      var AHandled: Boolean); virtual;
@ -1126,6 +1126,21 @@ begin
  Result := LowerCase(FWebRequest.GetFieldByName('X-Requested-With')) = 'xmlhttprequest';
 end;

+function TMVCWebRequest.GetOverwrittenHTTPMethod: TMVCHTTPMethodType;
+var
+  lOverriddenMethod: string;
+begin
+  lOverriddenMethod := Headers[TMVCConstants.X_HTTP_Method_Override];
+  if lOverriddenMethod.IsEmpty then
+  begin
+    Exit(HTTPMethod);
+  end
+  else
+  begin
+    Result := TMVCRouter.StringMethodToHTTPMetod(FWebRequest.Method);
+  end;
+end;
+
 function TMVCWebRequest.GetParamAsInt64(const AParamName: string): Int64;
 begin
  Result := StrToInt64(GetParams(AParamName));
@ -1766,6 +1781,7 @@ var
  LSelectedController: TMVCController;
  LActionFormalParams: TArray<TRttiParameter>;
  LActualParams: TArray<TValue>;
+  lHTTPMethod: TMVCHTTPMethodType;
 begin
  Result := False;

@ -1799,8 +1815,8 @@ begin
            ExecuteBeforeRoutingMiddleware(LContext, LHandled);
            if not LHandled then
            begin
-              {TODO -oDanieleT -cGeneral : Allow for HTTP method override}
-              if LRouter.ExecuteRouting(ARequest.PathInfo, LContext.Request.HTTPMethod,
+              { TODO -oDanieleT -cGeneral : Allow for HTTP method override }
+              if LRouter.ExecuteRouting(ARequest.PathInfo, LContext.Request.GetOverwrittenHTTPMethod { LContext.Request.HTTPMethod } ,
                ARequest.ContentType, ARequest.Accept, FControllers, FConfig[TMVCConfigKey.DefaultContentType],
                FConfig[TMVCConfigKey.DefaultContentCharset], LParamsTable, LResponseContentMediaType,
                LResponseContentCharset) then
--- a/unittests/general/Several/LiveServerTestU.pas
+++ b/unittests/general/Several/LiveServerTestU.pas
@ -61,6 +61,8 @@ type

  [TestFixture]
  TServerTest = class(TBaseServerTest)
+  private
+
  public
    [Test]
    [TestCase('request url /fault', '/fault')]
@ -86,6 +88,8 @@ type
    [Test]
    procedure TestPOSTWithObjectJSONBody;
    [Test]
+    procedure TestXHTTPMethodOverride_POST_as_PUT;
+    [Test]
    procedure TestPUTWithParamsAndJSONBody;
    [Test]
    procedure TestCookies;
@ -1028,6 +1032,27 @@ begin
  end;
 end;

+procedure TServerTest.TestXHTTPMethodOverride_POST_as_PUT;
+var
+  r: IRESTResponse;
+  JSON: System.JSON.TJSONObject;
+begin
+  JSON := System.JSON.TJSONObject.Create;
+  JSON.AddPair('client', 'clientdata');
+  r := RESTClient
+    .Header(TMVCConstants.X_HTTP_Method_Override, 'PUT')
+    .doPOST('/echo', ['1', '2', '3'], TSystemJSON.JSONValueToString(JSON));
+
+  JSON := TSystemJSON.StringAsJSONObject(r.BodyAsString);
+  try
+    Assert.areEqual('clientdata', JSON.Get('client').JsonValue.Value);
+    Assert.areEqual('from server', JSON.Get('echo').JsonValue.Value);
+  finally
+    JSON.Free;
+  end;
+end;
+
+
 procedure TServerTest.TestReqWithParams;
 var
  ss: TStringStream;