Merge remote-tracking branch 'remotes/origin/dev'

Author: mobius1qwe

src/base/PascalRAL.inc

@@ -35,6 +35,32 @@
   {$IFDEF CLR}
     {$DEFINE DELPHINET}
   {$ENDIF}
+  
+  {$IF Defined(VER370) or (CompilerVersion >= 37)}
+    {$DEFINE DELPHI13UP}
+    {$DEFINE DELPHI12UP}
+    {$DEFINE DELPHI11UP}
+    {$DEFINE DELPHI10_4UP}
+    {$DEFINE DELPHI10_3UP}
+    {$DEFINE DELPHI10_2UP}
+    {$DEFINE DELPHI10_1UP}
+    {$DEFINE DELPHI10_0UP}
+    {$DEFINE DELPHIXE8UP}
+    {$DEFINE DELPHIXE7UP}
+    {$DEFINE DELPHIXE6UP}
+    {$DEFINE DELPHIXE5UP}
+    {$DEFINE DELPHIXE4UP}
+    {$DEFINE DELPHIXE3UP}
+    {$DEFINE DELPHIXE2UP}
+    {$DEFINE DELPHIXEUP}
+    {$DEFINE DELPHI2010UP}
+    {$DEFINE DELPHI2009UP}
+    {$DEFINE DELPHI2007UP}
+    {$DEFINE DELPHI2006UP}
+    {$DEFINE DELPHI2005UP}
+    {$DEFINE DELPHI8UP}
+    {$DEFINE DELPHI7UP}
+  {$IFEND ~VER370}  
 
   {$IF Defined(VER360) or (CompilerVersion >= 36)}
     {$DEFINE DELPHI12UP}

src/base/RALConsts.pas

@@ -13,10 +13,10 @@ interface
 
 const
   // Versionamento
-  RALVERSION = '0.12.0-4 beta';
+  RALVERSION = '0.12.1-3 beta';
   RALVERSION_MAJOR = 0;
   RALVERSION_MINOR = 12;
-  RALVERSION_PATCH = 0;
+  RALVERSION_PATCH = 1;
   RALVERSION_FULL  = RALVERSION_MAJOR * 10000
                    + RALVERSION_MINOR * 100
                    + RALVERSION_PATCH;

src/base/RALServer.pas

@@ -167,6 +167,8 @@   TRALSecurity = class(TPersistent)
     property WhiteIPList: TStringList read GetWhiteIPList write SetWhiteIPList;
   end;
 
+  TRALOnServerError = procedure(Error: Exception) of object;
+
   { TRALServer }
 
   // Base class for HTTP Server components
@@ -182,6 +184,7 @@   TRALServer = class(TRALComponent)
     FIPConfig: TRALIPConfig;
     FListSubModules: TList;
     FPort: IntegerRAL;
+    FRaiseError: boolean;
     FRoutes: TRALRoutes;
     FSecurity: TRALSecurity;
     FServerStatus: TStringList;
@@ -190,9 +193,10 @@   TRALServer = class(TRALComponent)
     FSSL: TRALSSL;
     FResponsePages: TRALResponsePages;
 
-    FOnRequest: TRALOnReply;
-    FOnResponse: TRALOnReply;
     FOnClientBlock: TRALOnClientBlock;
+    FOnRequest: TRALOnReply;
+    FOnResponse: TRALOnReply;    
+    FOnServerError: TRALOnServerError;
   protected
     // Adds a fixed subroute from other components into server routes
     procedure AddSubRoute(ASubRoute: TRALModuleRoutes);
@@ -262,6 +266,8 @@   TRALServer = class(TRALComponent)
     property Port: IntegerRAL read FPort write SetPort;
     // Route configuration of the server, a.k.a endpoints
     property Routes: TRALRoutes read FRoutes write FRoutes;
+    // Whether the server will raise error to the application or not (exception raise^), default value is false
+    property RaiseError: boolean read FRaiseError write FRaiseError default false;
     // Security configurations of the server
     property Security: TRALSecurity read FSecurity write FSecurity;
     // Default text answered by the server without WebModule when requesting the route '/'
@@ -270,12 +276,15 @@   TRALServer = class(TRALComponent)
     property SessionTimeout: IntegerRAL read FSessionTimeout write SetSessionTimeout default 30000;
     // Boolean check to whether or not show the default text for route '/'
     property ShowServerStatus: boolean read FShowServerStatus write FShowServerStatus;
+
     // Event fired whenever an incoming IP gets blocked by the server
     property OnClientBlock: TRALOnClientBlock read FOnClientBlock write FOnClientBlock;
     // Event fired whenever any request is received by the server
     property OnRequest: TRALOnReply read FOnRequest write FOnRequest;
     // Event fired whenever any response is sent by the server
     property OnResponse: TRALOnReply read FOnResponse write FOnResponse;
+    // Event fired whenever any error happens inside the server
+    property OnServerError: TRALOnServerError read FOnServerError write FOnServerError;
   end;
 
   { TRALModuleRoutes }
@@ -556,142 +565,149 @@ procedure TRALServer.ProcessCommands(ARequest: TRALRequest; AResponse: TRALRespo
 begin
   if AResponse.StatusCode >= HTTP_BadRequest then
     Exit;
+  try
+    vRouteIsAuth := False;
 
-  vRouteIsAuth := False;
-
-  AResponse.ContentCompress := ARequest.AcceptCompress;
-  if AResponse.ContentCompress = ctNone then
-    AResponse.ContentCompress := FCompressType;
+    AResponse.ContentCompress := ARequest.AcceptCompress;
+    if AResponse.ContentCompress = ctNone then
+      AResponse.ContentCompress := FCompressType;
 
-  AResponse.ContentCripto := crNone;
-  if CriptoOptions.Key <> '' then
-  begin
-    AResponse.ContentCripto := ARequest.AcceptCripto;
-    AResponse.CriptoKey := CriptoOptions.Key;
-  end;
+    AResponse.ContentCripto := crNone;
+    if CriptoOptions.Key <> '' then
+    begin
+      AResponse.ContentCripto := ARequest.AcceptCripto;
+      AResponse.CriptoKey := CriptoOptions.Key;
+    end;
 
-  vRoute := FRoutes.CanAnswerRoute(ARequest);
+    vRoute := FRoutes.CanAnswerRoute(ARequest);
 
-  vInt := 0;
-  while (vRoute = nil) and (vInt < FListSubModules.Count) do
-  begin
-    vSubRoute := TRALModuleRoutes(FListSubModules.Items[vInt]);
-    vRoute := vSubRoute.CanAnswerRoute(ARequest, AResponse);
-    vInt := vInt + 1;
-  end;
+    vInt := 0;
+    while (vRoute = nil) and (vInt < FListSubModules.Count) do
+    begin
+      vSubRoute := TRALModuleRoutes(FListSubModules.Items[vInt]);
+      vRoute := vSubRoute.CanAnswerRoute(ARequest, AResponse);
+      vInt := vInt + 1;
+    end;
 
-  if (vRoute = nil) and (FAuthentication <> nil) then
-  begin
-    vRoute := FAuthentication.CanAnswerRoute(ARequest, AResponse);
-    if vRoute <> nil then
-      vRouteIsAuth := True;
-  end;
+    if (vRoute = nil) and (FAuthentication <> nil) then
+    begin
+      vRoute := FAuthentication.CanAnswerRoute(ARequest, AResponse);
+      if vRoute <> nil then
+        vRouteIsAuth := True;
+    end;
 
-  if Assigned(FOnRequest) then
-    FOnRequest(ARequest, AResponse);
+    if Assigned(FOnRequest) then
+      FOnRequest(ARequest, AResponse);
 
-  if Assigned(vRoute) then
-  begin
-    CheckCORS(vRoute.IsMethodAllowed(amOPTIONS), vRoute.GetAllowMethods, ARequest, AResponse);
-    if ARequest.Method = amOPTIONS then
-    begin
-      if vRoute.IsMethodAllowed(amOPTIONS) then
-        goto aFIM
-      else
-        goto a404;
-    end
-    else if vRouteIsAuth then
+    if Assigned(vRoute) then
     begin
-      FAuthentication.BeforeValidate(ARequest, AResponse);
-      goto aFIM;
-    end
-    else if vRoute.IsMethodAllowed(ARequest.Method) then
-    begin
-      if FAuthentication <> nil then
+      CheckCORS(vRoute.IsMethodAllowed(amOPTIONS), vRoute.GetAllowMethods, ARequest, AResponse);
+      if ARequest.Method = amOPTIONS then
       begin
-        if vRoute.IsMethodSkipped(ARequest.Method) then
-        begin
-          goto aOK;
-        end
+        if vRoute.IsMethodAllowed(amOPTIONS) then
+          goto aFIM
         else
+          goto a404;
+      end
+      else if vRouteIsAuth then
+      begin
+        FAuthentication.BeforeValidate(ARequest, AResponse);
+        goto aFIM;
+      end
+      else if vRoute.IsMethodAllowed(ARequest.Method) then
+      begin
+        if FAuthentication <> nil then
         begin
-          vCheckBruteForce := (rsoBruteForceProtection in Security.Options);
-          // client e valido se o numero de tentativas <= ao max de tentativas
-          vCheckBruteForceTries :=
-            (vCheckBruteForce and (Security.CheckBlockClientTry(
-            ARequest.ClientInfo.IP)));
-
-          // devido algumas auths que adiciona o header realm
-          vCheck_Authentication := ValidateAuth(ARequest, AResponse);
-
-          if vCheck_Authentication then
-            goto aOK
-          else if (vCheckBruteForceTries) or (AResponse.StatusCode = HTTP_Unauthorized) then
-            goto a401
+          if vRoute.IsMethodSkipped(ARequest.Method) then
+          begin
+            goto aOK;
+          end
           else
-            goto a403;
-        end;
+          begin
+            vCheckBruteForce := (rsoBruteForceProtection in Security.Options);
+            // client e valido se o numero de tentativas <= ao max de tentativas
+            vCheckBruteForceTries :=
+              (vCheckBruteForce and (Security.CheckBlockClientTry(
+              ARequest.ClientInfo.IP)));
+
+            // devido algumas auths que adiciona o header realm
+            vCheck_Authentication := ValidateAuth(ARequest, AResponse);
+
+            if vCheck_Authentication then
+              goto aOK
+            else if (vCheckBruteForceTries) or (AResponse.StatusCode = HTTP_Unauthorized) then
+              goto a401
+            else
+              goto a403;
+          end;
+        end
+        else
+          goto aOK;
       end
       else
-        goto aOK;
+        goto a403;
     end
+    else if (ARequest.Query = '/') and (FShowServerStatus) then
+      goto aSTATUS
     else
-      goto a403;
-  end
-  else if (ARequest.Query = '/') and (FShowServerStatus) then
-    goto aSTATUS
-  else
-    goto a404;
+      goto a404;
 
-  aSTATUS:
-  begin
-    CheckCORS(True, 'GET', ARequest, AResponse);
-    if ARequest.Method <> amOPTIONS then
+    aSTATUS:
     begin
-      vString := Trim(FServerStatus.Text);
-      if vString = EmptyStr then
-        vString := RALDefaultPage;
-      vString := StringReplace(vString, '%ralengine%', FEngine, [rfReplaceAll]);
-      AResponse.Answer(HTTP_OK, vString, rctTEXTHTML);
+      CheckCORS(True, 'GET', ARequest, AResponse);
+      if ARequest.Method <> amOPTIONS then
+      begin
+        vString := Trim(FServerStatus.Text);
+        if vString = EmptyStr then
+          vString := RALDefaultPage;
+        vString := StringReplace(vString, '%ralengine%', FEngine, [rfReplaceAll]);
+        AResponse.Answer(HTTP_OK, vString, rctTEXTHTML);
+      end;
+      goto aFIM;
     end;
-    goto aFIM;
-  end;
 
-  aOK:
-  begin
-    Security.UnblockClient(ARequest.ClientInfo.IP);
-    vRoute.Execute(ARequest, AResponse);
-    goto aFIM;
-  end;
+    aOK:
+    begin
+      Security.UnblockClient(ARequest.ClientInfo.IP);
+      vRoute.Execute(ARequest, AResponse);
+      goto aFIM;
+    end;
 
-  a401:
-  begin
-    Security.BlockClient(ARequest.ClientInfo.IP);
-    AResponse.Answer(HTTP_Unauthorized);
-    goto aFIM;
-  end;
+    a401:
+    begin
+      Security.BlockClient(ARequest.ClientInfo.IP);
+      AResponse.Answer(HTTP_Unauthorized);
+      goto aFIM;
+    end;
 
-  a403:
-  begin
-    Security.BlockClient(ARequest.ClientInfo.IP);
-    if Assigned(FOnClientBlock) then
-      FOnClientBlock(Self, ARequest.ClientInfo.IP);
-    AResponse.Answer(HTTP_Forbidden);
-    goto aFIM;
-  end;
+    a403:
+    begin
+      Security.BlockClient(ARequest.ClientInfo.IP);
+      if Assigned(FOnClientBlock) then
+        FOnClientBlock(Self, ARequest.ClientInfo.IP);
+      AResponse.Answer(HTTP_Forbidden);
+      goto aFIM;
+    end;
 
-  a404:
-  begin
-    AResponse.Answer(HTTP_NotFound);
-    goto aFIM;
-  end;
+    a404:
+    begin
+      AResponse.Answer(HTTP_NotFound);
+      goto aFIM;
+    end;
 
-  aFIM:
-  begin
-    if Assigned(FOnResponse) then
-      FOnResponse(ARequest, AResponse);
+    aFIM:
+    begin
+      if Assigned(FOnResponse) then
+        FOnResponse(ARequest, AResponse);
 
-    ARequest.Params.ClearParams;
+      ARequest.Params.ClearParams;
+    end;
+  except
+    on e: exception do
+      if assigned(OnServerError) then
+        OnServerError(e)
+      else if RaiseError then
+        raise;
   end;
 end;