Merge branch 'middleware_etag' into middleware_staticfiles

samples/middleware_etag/App1MainControllerU.pas

@@ -0,0 +1,50 @@
+unit App1MainControllerU;
+
+interface
+
+{$I dmvcframework.inc}
+
+
+uses
+  MVCFramework,
+  MVCFramework.Logger,
+  MVCFramework.Commons,
+  Web.HTTPApp;
+
+type
+
+  [MVCPath('/')]
+  TApp1MainController = class(TMVCController)
+  public
+    [MVCPath('/welcome/($Name)')]
+    [MVCHTTPMethod([httpGET])]
+    [MVCProduces(TMVCMediaType.TEXT_HTML)]
+    procedure Welcome(const Name: string);
+
+    [MVCPath('/image')]
+    [MVCHTTPMethod([httpGET])]
+    procedure GetImage;
+  end;
+
+implementation
+
+uses
+  System.SysUtils,
+  MVCFramework.Serializer.JSONDataObjects,
+  MVCFramework.Serializer.Commons,
+  JSONDataObjects;
+
+{ TApp1MainController }
+
+procedure TApp1MainController.GetImage;
+begin
+  Context.Response.ContentType := TMVCMediaType.IMAGE_PNG;
+  SendFile(IncludeTrailingPathDelimiter(AppPath) + 'www\logo.png');
+end;
+
+procedure TApp1MainController.Welcome(const Name: string);
+begin
+  Render(Name + ', welcome to DMVCFramework!');
+end;
+
+end.

samples/middleware_etag/WebModuleUnit1.dfm

@@ -0,0 +1,13 @@
+object WebModule1: TWebModule1
+  OldCreateOrder = False
+  OnCreate = WebModuleCreate
+  OnDestroy = WebModuleDestroy
+  Actions = <
+    item
+      Default = True
+      Name = 'DefaultHandler'
+      PathInfo = '/'
+    end>
+  Height = 230
+  Width = 415
+end

samples/middleware_etag/WebModuleUnit1.pas

@@ -0,0 +1,52 @@
+unit WebModuleUnit1;
+
+interface
+
+uses
+  System.SysUtils,
+  System.Classes,
+  Web.HTTPApp,
+  MVCFramework;
+
+type
+  TWebModule1 = class(TWebModule)
+    procedure WebModuleCreate(Sender: TObject);
+    procedure WebModuleDestroy(Sender: TObject);
+
+  private
+    FEngine: TMVCEngine;
+
+  public
+    { Public declarations }
+  end;
+
+var
+  WebModuleClass: TComponentClass = TWebModule1;
+
+implementation
+
+uses
+  App1MainControllerU,
+  MVCFramework.Commons,
+  MVCFramework.Middleware.ETag;
+
+{$R *.dfm}
+
+
+procedure TWebModule1.WebModuleCreate(Sender: TObject);
+begin
+  FEngine := TMVCEngine.Create(Self);
+
+  FEngine.Config[TMVCConfigKey.DocumentRoot] := '.\www';
+
+  FEngine.AddMiddleware(TMVCETagMiddleware.Create);
+
+  FEngine.AddController(TApp1MainController);
+end;
+
+procedure TWebModule1.WebModuleDestroy(Sender: TObject);
+begin
+  FEngine.free;
+end;
+
+end.

samples/middleware_etag/middleware_etag.dpr

@@ -0,0 +1,115 @@
+program middleware_etag;
+
+{$APPTYPE CONSOLE}
+
+
+uses
+  System.SysUtils,
+  Web.WebReq,
+  Web.WebBroker,
+  IdHTTPWebBrokerBridge,
+  MVCFramework.REPLCommandsHandlerU,
+  MVCFramework.Logger,
+  WebModuleUnit1 in 'WebModuleUnit1.pas' {WebModule1: TWebModule},
+  App1MainControllerU in 'App1MainControllerU.pas',
+  MVCFramework.Middleware.ETag in '..\..\sources\MVCFramework.Middleware.ETag.pas';
+
+{$R *.res}
+
+
+procedure RunServer(APort: Integer);
+var
+  lServer: TIdHTTPWebBrokerBridge;
+  lCustomHandler: TMVCCustomREPLCommandsHandler;
+  lCmd, lStartupCommand: string;
+begin
+  if ParamCount >= 1 then
+    lStartupCommand := ParamStr(1)
+  else
+    lStartupCommand := 'start';
+
+  lCustomHandler := function(const Value: String; const Server: TIdHTTPWebBrokerBridge; out Handled: Boolean): THandleCommandResult
+    begin
+      Handled := False;
+      Result := THandleCommandResult.Unknown;
+
+      // Write here your custom command for the REPL using the following form...
+      // ***
+      // Handled := False;
+      // if (Value = 'apiversion') then
+      // begin
+      // REPLEmit('Print my API version number');
+      // Result := THandleCommandResult.Continue;
+      // Handled := True;
+      // end
+      // else if (Value = 'datetime') then
+      // begin
+      // REPLEmit(DateTimeToStr(Now));
+      // Result := THandleCommandResult.Continue;
+      // Handled := True;
+      // end;
+    end;
+
+  // Writeln(Format('Starting HTTP Server or port %d', [APort]));
+  LServer := TIdHTTPWebBrokerBridge.Create(nil);
+  try
+    LServer.DefaultPort := APort;
+    LogI(Format('Server started on port %d', [APort]));
+
+    { more info about MaxConnections
+      http://www.indyproject.org/docsite/html/frames.html?frmname=topic&frmfile=TIdCustomTCPServer_MaxConnections.html }
+    LServer.MaxConnections := 0;
+
+    { more info about ListenQueue
+      http://www.indyproject.org/docsite/html/frames.html?frmname=topic&frmfile=TIdCustomTCPServer_ListenQueue.html }
+    LServer.ListenQueue := 200;
+
+    WriteLn('Write "quit" or "exit" to shutdown the server');
+    repeat
+      // TextColor(RED);
+      // TextColor(LightRed);
+      Write('-> ');
+      // TextColor(White);
+      if lStartupCommand.IsEmpty then
+        ReadLn(lCmd)
+      else
+      begin
+        lCmd := lStartupCommand;
+        lStartupCommand := '';
+        WriteLn(lCmd);
+      end;
+
+      case HandleCommand(lCmd.ToLower, LServer, lCustomHandler) of
+        THandleCommandResult.Continue:
+          begin
+            Continue;
+          end;
+        THandleCommandResult.Break:
+          begin
+            Break;
+          end;
+        THandleCommandResult.Unknown:
+          begin
+            REPLEmit('Unknown command: ' + lCmd);
+          end;
+      end;
+    until false;
+
+  finally
+    LServer.Free;
+  end;
+end;
+
+begin
+  ReportMemoryLeaksOnShutdown := True;
+  try
+    if WebRequestHandler <> nil then
+      WebRequestHandler.WebModuleClass := WebModuleClass;
+    WebRequestHandlerProc.MaxConnections := 1024;
+    RunServer(8080);
+  except
+    on E: Exception do
+      Writeln(E.ClassName, ': ', E.Message);
+  end;
+
+end.

sources/MVCFramework.Middleware.ETag.pas

@@ -0,0 +1,129 @@
+// ***************************************************************************
+//
+// Delphi MVC Framework
+//
+// Copyright (c) 2010-2020 Daniele Teti and the DMVCFramework Team
+//
+// https://github.com/danieleteti/delphimvcframework
+//
+// Collaborators on this file:
+// João Antônio Duarte (https://github.com/joaoduarte19)
+//
+// ***************************************************************************
+//
+// Licensed under the Apache License, Version 2.0 (the "License");
+// you may not use this file except in compliance with the License.
+// You may obtain a copy of the License at
+//
+// http://www.apache.org/licenses/LICENSE-2.0
+//
+// Unless required by applicable law or agreed to in writing, software
+// distributed under the License is distributed on an "AS IS" BASIS,
+// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+// See the License for the specific language governing permissions and
+// limitations under the License.
+//
+// *************************************************************************** }
+
+unit MVCFramework.Middleware.ETag;
+
+{$I dmvcframework.inc}
+
+interface
+
+uses
+  MVCFramework,
+  System.Classes;
+
+type
+  /// <summary>
+  /// The <b>ETag</b> HTTP response header is an identifier for a specific version of a resource. It lets caches be
+  /// more efficient and save bandwidth, as a web server does not need to resend a full response if the content has
+  /// not changed. See more about the specification: <see href="https://tools.ietf.org/html/rfc7232#section-2.3">RFC
+  /// 7232</see>
+  /// </summary>
+  TMVCETagMiddleware = class(TInterfacedObject, IMVCMiddleware)
+  private
+    function GetHashMD5FromStream(AStream: TStream): string;
+  public
+    procedure OnBeforeRouting(AContext: TWebContext; var AHandled: Boolean);
+    procedure OnBeforeControllerAction(AContext: TWebContext; const AControllerQualifiedClassName: string;
+      const AActionName: string; var AHandled: Boolean);
+    procedure OnAfterControllerAction(AContext: TWebContext; const AActionName: string; const AHandled: Boolean);
+  end;
+
+implementation
+
+uses
+{$IF defined(SEATTLEORBETTER)}
+  System.Hash,
+{$ELSE}
+  IdHashMessageDigest,
+{$ENDIF}
+  System.SysUtils,
+  MVCFramework.Commons;
+
+{ TMVCETagMiddleware }
+
+function TMVCETagMiddleware.GetHashMD5FromStream(AStream: TStream): string;
+{$IF not defined(SEATTLEORBETTER)}
+var
+  lMD5Hash: TIdHashMessageDigest5;
+{$ENDIF}
+begin
+{$IF defined(SEATTLEORBETTER)}
+  Result := THashMD5.GetHashString(AStream);
+{$ELSE}
+  lMD5Hash := TIdHashMessageDigest5.Create;
+  try
+    Result := lMD5Hash.HashStreamAsHex(AStream);
+  finally
+    lMD5Hash.Free;
+  end;
+{$ENDIF}
+end;
+
+procedure TMVCETagMiddleware.OnAfterControllerAction(AContext: TWebContext; const AActionName: string;
+  const AHandled: Boolean);
+var
+  lContentStream: TStream;
+  lRequestETag: string;
+  lETag: string;
+begin
+  lContentStream := AContext.Response.RawWebResponse.ContentStream;
+  if not Assigned(lContentStream) then
+    Exit;
+
+  lRequestETag := AContext.Request.Headers['If-None-Match'];
+  lETag := GetHashMD5FromStream(lContentStream);
+
+  AContext.Response.SetCustomHeader('ETag', lETag);
+
+  if (lETag <> '') and (lRequestETag = lETag) then
+  begin
+    AContext.Response.Content := '';
+    if lContentStream is TFileStream then
+    begin
+      AContext.Response.RawWebResponse.ContentStream := nil;
+    end
+    else
+    begin
+      lContentStream.Size := 0;
+    end;
+    AContext.Response.StatusCode := HTTP_STATUS.NotModified;
+    AContext.Response.ReasonString := 'Not Modified'
+  end;
+end;
+
+procedure TMVCETagMiddleware.OnBeforeControllerAction(AContext: TWebContext; const AControllerQualifiedClassName,
+  AActionName: string; var AHandled: Boolean);
+begin
+  // do nothing
+end;
+
+procedure TMVCETagMiddleware.OnBeforeRouting(AContext: TWebContext; var AHandled: Boolean);
+begin
+  // do nothing
+end;
+
+end.