From 55b4c3cbef71fee9359c358dd9d9e222f598432c Mon Sep 17 00:00:00 2001 From: Mobius One Date: Wed, 26 Apr 2023 08:01:24 -0300 Subject: [PATCH 1/7] =?UTF-8?q?-=20Ajuste=20de=20Basich=20Authentication,?= =?UTF-8?q?=20movendo=20fun=C3=A7=C3=B5es=20e=20valida=C3=A7=C3=B5es=20pro?= =?UTF-8?q?=20componente.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- .../Basic/Mechanics/uRESTDWAuthenticators.pas | 45 ++- CORE/Source/Basic/uRESTDWBasic.pas | 308 +++++++++--------- CORE/Source/Basic/uRESTDWComponentEvents.pas | 4 +- .../Plugins/DMDados/uRESTDWDatamodule.pas | 20 +- 4 files changed, 210 insertions(+), 167 deletions(-) diff --git a/CORE/Source/Basic/Mechanics/uRESTDWAuthenticators.pas b/CORE/Source/Basic/Mechanics/uRESTDWAuthenticators.pas index 9cc67b15e..af13d437e 100644 --- a/CORE/Source/Basic/Mechanics/uRESTDWAuthenticators.pas +++ b/CORE/Source/Basic/Mechanics/uRESTDWAuthenticators.pas @@ -27,9 +27,26 @@ interface uses Classes, SysUtils, DateUtils, uRESTDWConsts, uRESTDWAbout, uRESTDWDataUtils, uRESTDWJSONInterface, - uRESTDWTools; + uRESTDWTools, uRESTDWParams; type + TOnBasicAuth = Procedure(Welcomemsg, AccessTag, + Username, Password : String; + Var Params : TRESTDWParams; + Var ErrorCode : Integer; + Var ErrorMessage : String; + Var Accept : Boolean) Of Object; + TOnGetToken = Procedure(Welcomemsg, + AccessTag : String; + Params : TRESTDWParams; +// AuthOptions : TRESTDWAuthToken; + Var ErrorCode : Integer; + Var ErrorMessage : String; + Var TokenID : String; + Var Accept : Boolean) Of Object; + TOnRenewToken = Procedure() of Object; + + TRESTDWAuthenticatorBase = class(TRESTDWComponent) private FAuthDialog: Boolean; @@ -44,12 +61,16 @@ TRESTDWAuthBasic = class(TRESTDWAuthenticatorBase) private FPassword: String; FUserName: String; + FOnBasicAuth: TOnBasicAuth; public constructor Create(aOwner: TComponent); override; destructor Destroy; override; + function ValidateAuth(aUserName, aPassword: string): boolean; published property UserName: String read FUserName write FUserName; property Password: String read FPassword write FPassword; + //eventos + property OnBasicAuth: TOnBasicAuth read FOnBasicAuth write FOnBasicAuth; end; TRESTDWAuthToken = class(TRESTDWAuthenticatorBase) @@ -69,6 +90,8 @@ TRESTDWAuthToken = class(TRESTDWAuthenticatorBase) FToken: String; FAutoGetToken: Boolean; FAutoRenewToken: Boolean; + FOnGetToken: TOnGetToken; + FOnRenewToken: TOnRenewToken; procedure ClearToken; procedure SetGetTokenEvent(AValue: String); procedure SetToken(AValue: String); @@ -100,6 +123,9 @@ TRESTDWAuthToken = class(TRESTDWAuthenticatorBase) property Token: String read FToken write SetToken; property AutoGetToken: Boolean read FAutoGetToken write FAutoGetToken; property AutoRenewToken: Boolean read FAutoRenewToken write FAutoRenewToken; + // eventos + Property OnGetToken: TOnGetToken Read FOnGetToken Write FOnGetToken; + Property OnRenewToken: TOnRenewToken Read FOnRenewToken Write FOnRenewToken; end; TRESTDWAuthOAuth = class(TRESTDWAuthenticatorBase) @@ -146,6 +172,11 @@ destructor TRESTDWAuthBasic.Destroy; inherited; end; +function TRESTDWAuthBasic.ValidateAuth(aUserName, aPassword: string): boolean; +begin + Result := (aUserName = UserName) and (aPassword = Password) +end; + { TRESTDWAuthToken } procedure TRESTDWAuthToken.Assign(ASource: TPersistent); @@ -469,11 +500,15 @@ function TRESTDWAuthToken.ValidateToken(AValue: String): Boolean; if Result then begin Result := False; - LHeader := DecodeStrings(LHeader{$IFDEF RESTDWLAZARUS}, csUndefined{$ENDIF}); - LBody := DecodeStrings(LBody{$IFDEF RESTDWLAZARUS}, csUndefined{$ENDIF}); - Secrets := DecodeStrings(GetSecretsValue(LBody){$IFDEF RESTDWLAZARUS}, csUndefined{$ENDIF}); + LHeader := DecodeStrings(LHeader{$IFDEF RESTDWLAZARUS}, + csUndefined{$ENDIF}); + LBody := DecodeStrings(LBody{$IFDEF RESTDWLAZARUS}, + csUndefined{$ENDIF}); + Secrets := DecodeStrings(GetSecretsValue(LBody){$IFDEF RESTDWLAZARUS}, + csUndefined{$ENDIF}); Secrets := DecodeStrings - (GetSecretsValue(Secrets){$IFDEF RESTDWLAZARUS}, csUndefined{$ENDIF}); + (GetSecretsValue(Secrets){$IFDEF RESTDWLAZARUS}, + csUndefined{$ENDIF}); Result := ReadBody(LBody); end; finally diff --git a/CORE/Source/Basic/uRESTDWBasic.pas b/CORE/Source/Basic/uRESTDWBasic.pas index c552d4234..5de031cdf 100644 --- a/CORE/Source/Basic/uRESTDWBasic.pas +++ b/CORE/Source/Basic/uRESTDWBasic.pas @@ -2818,102 +2818,134 @@ procedure TRESTClientPoolerBase.SetIpVersion(IpV: TRESTDWClientIpVersions); End; TServerMethodDatamodule(vTempServerMethods).SetClientWelcomeMessage(vWelcomeMessage); If vAuthenticator <> Nil Then - Begin + Begin vAcceptAuth := False; vErrorCode := 401; vErrorMessage := cInvalidAuth; - If vAuthenticator is TRESTDWAuthBasic Then - Begin {$REGION AuthBasic} - vNeedAuthorization := False; - vTempEvent := ReturnEventValidation(TServerMethodDatamodule(vTempServerMethods), vUrlToExec); - If vTempEvent = Nil Then - Begin - vTempContext := ReturnContextValidation(TServerMethodDatamodule(vTempServerMethods), vUrlToExec); - If vTempContext <> Nil Then - vNeedAuthorization := vTempContext.NeedAuthorization - Else - vNeedAuthorization := True; - End + // verifica se precisa autenticação + vNeedAuthorization := False; + vTempEvent := ReturnEventValidation(TServerMethodDatamodule(vTempServerMethods), vUrlToExec); + If vTempEvent = Nil Then + Begin + vTempContext := ReturnContextValidation(TServerMethodDatamodule(vTempServerMethods), vUrlToExec); + If vTempContext <> Nil Then + vNeedAuthorization := vTempContext.NeedAuthorization Else - vNeedAuthorization := vTempEvent.NeedAuthorization; - If vNeedAuthorization Then - Begin - vAuthenticationString := DecodeStrings(StringReplace(RawHeaders.Values['Authorization'], 'Basic ', '', [rfReplaceAll]){$IFDEF FPC}, vDatabaseCharSet{$ENDIF});; //Authentication.Authentication;// RawHeaders.Values['Authorization']; - If (vAuthenticationString <> '') And - ((AuthUsername = '') And (AuthPassword = '')) Then - PrepareBasicAuth(vAuthenticationString, AuthUsername, AuthPassword); - If Assigned(TServerMethodDatamodule(vTempServerMethods).OnUserBasicAuth) Then - Begin - TServerMethodDatamodule(vTempServerMethods).OnUserBasicAuth(vWelcomeMessage, vAccessTag, - AuthUsername, - AuthPassword, - DWParams, vErrorCode, vErrorMessage, vAcceptAuth); - If Not vAcceptAuth Then - Begin - AuthRealm := cAuthRealm; - WriteError; - DestroyComponents; - Exit; - End; - End - Else If Not ((AuthUsername = TRESTDWAuthBasic(vAuthenticator).UserName) And - (AuthPassword = TRESTDWAuthBasic(vAuthenticator).Password)) Then - Begin - AuthRealm := cAuthRealm; + vNeedAuthorization := True; + End + Else + vNeedAuthorization := vTempEvent.NeedAuthorization; + + If vNeedAuthorization Then + If vAuthenticator is TRESTDWAuthBasic Then + Begin {$REGION AuthBasic} + + vAuthenticationString := DecodeStrings(StringReplace(RawHeaders.Values['Authorization'], 'Basic ', '', [rfReplaceAll]){$IFDEF FPC}, vDatabaseCharSet{$ENDIF}); + If (vAuthenticationString <> '') And ((AuthUsername = '') And + (AuthPassword = '')) Then + PrepareBasicAuth(vAuthenticationString, AuthUsername, AuthPassword); + + if Assigned(TRESTDWAuthBasic(Authenticator).OnBasicAuth) then + TRESTDWAuthBasic(Authenticator).OnBasicAuth(vWelcomeMessage, + vAccessTag, + AuthUsername, + AuthPassword, + DWParams, + vErrorCode, + vErrorMessage, + vAcceptAuth) + else + vAcceptAuth := TRESTDWAuthBasic(vAuthenticator).ValidateAuth( + AuthUsername, AuthPassword); + + If Not vAcceptAuth Then + Begin + AuthRealm := cAuthRealm; WriteError; DestroyComponents; Exit; - End; - End; - End {$ENDREGION} - Else If vAuthenticator is TRESTDWAuthToken Then - Begin {$REGION AuthToken} - vUrlToken := Lowercase(vUrlToExec); - If Copy(vUrlToken, InitStrPos, 1) = '/' then - Delete(vUrlToken, InitStrPos, 1); - If vUrlToken = - Lowercase(TRESTDWAuthToken(vAuthenticator).GetTokenEvent) Then - Begin - vGettoken := True; - vErrorCode := 404; - vErrorMessage := cEventNotFound; - If (RequestTypeToRoute(RequestType) In TRESTDWAuthToken(vAuthenticator).GetTokenRoutes) Or - (crAll in TRESTDWAuthToken(vAuthenticator).GetTokenRoutes) Then + End; + + // If Assigned(TServerMethodDatamodule(vTempServerMethods).OnUserBasicAuth) Then + // Begin + // TServerMethodDatamodule(vTempServerMethods).OnUserBasicAuth(vWelcomeMessage, vAccessTag, + // AuthUsername, + // AuthPassword, + // DWParams, vErrorCode, vErrorMessage, vAcceptAuth); + // If Not vAcceptAuth Then + // Begin + // AuthRealm := cAuthRealm; + // WriteError; + // DestroyComponents; + // Exit; + // End; + // End + // Else If Not ((AuthUsername = TRESTDWAuthBasic(vAuthenticator).UserName) And + // (AuthPassword = TRESTDWAuthBasic(vAuthenticator).Password)) Then + // Begin + // AuthRealm := cAuthRealm; + // WriteError; + // DestroyComponents; + // Exit; + // End; + End {$ENDREGION} + Else If vAuthenticator is TRESTDWAuthToken Then + Begin {$REGION AuthToken} + vUrlToken := Lowercase(vUrlToExec); + If Copy(vUrlToken, InitStrPos, 1) = '/' then + Delete(vUrlToken, InitStrPos, 1); + If vUrlToken = + Lowercase(TRESTDWAuthToken(vAuthenticator).GetTokenEvent) Then Begin - If CORS Then - Begin - PCustomHeaders := @ResponseHeaders; - BuildCORS(TRESTDWAuthToken(vAuthenticator).GetTokenRoutes, TStrings(PCustomHeaders^)); - End; - If Assigned(TServerMethodDatamodule(vTempServerMethods).OnGetToken) Then + vGettoken := True; + vErrorCode := 404; + vErrorMessage := cEventNotFound; + If (RequestTypeToRoute(RequestType) In TRESTDWAuthToken(vAuthenticator).GetTokenRoutes) Or + (crAll in TRESTDWAuthToken(vAuthenticator).GetTokenRoutes) Then Begin - vTokenValidate := True; - vAuthTokenParam := TRESTDWAuthToken.Create(self); - vAuthTokenParam.Assign(TRESTDWAuthToken(vAuthenticator)); - {$IFNDEF FPC} - If Trim(Token) <> '' Then - vToken := Token - Else - vToken := RawHeaders.Values['Authorization']; - {$ENDIF} - If DWParams.ItemsString['RDWParams'] <> Nil Then + If CORS Then Begin - DWParamsD := TRESTDWParams.Create; - if vCripto.Use then - DWParamsD.FromJSON(vCripto.Decrypt(DWParams.ItemsString['RDWParams'].Value)) - else - DWParamsD.FromJSON(DWParams.ItemsString['RDWParams'].Value); - TServerMethodDatamodule(vTempServerMethods).OnGetToken(vWelcomeMessage, vAccessTag, DWParamsD, - TRESTDWAuthToken(vAuthTokenParam), - vErrorCode, vErrorMessage, vToken, vAcceptAuth); - FreeAndNil(DWParamsD); + PCustomHeaders := @ResponseHeaders; + BuildCORS(TRESTDWAuthToken(vAuthenticator).GetTokenRoutes, TStrings(PCustomHeaders^)); + End; + if Assigned(TRESTDWAuthToken(vAuthenticator).OnGetToken) then +// If Assigned(TServerMethodDatamodule(vTempServerMethods).OnGetToken) Then + Begin + vTokenValidate := True; + vAuthTokenParam := TRESTDWAuthToken.Create(self); + vAuthTokenParam.Assign(TRESTDWAuthToken(vAuthenticator)); + {$IFNDEF FPC} + If Trim(Token) <> '' Then + vToken := Token + Else + vToken := RawHeaders.Values['Authorization']; + {$ENDIF} + If DWParams.ItemsString['RDWParams'] <> Nil Then + Begin + DWParamsD := TRESTDWParams.Create; + if vCripto.Use then + DWParamsD.FromJSON(vCripto.Decrypt(DWParams.ItemsString['RDWParams'].Value)) + else + DWParamsD.FromJSON(DWParams.ItemsString['RDWParams'].Value); + TRESTDWAuthToken(vAuthenticator).OnGetToken(vWelcomeMessage, vAccessTag, DWParamsD, + vErrorCode, vErrorMessage, vToken, vAcceptAuth); +// TServerMethodDatamodule(vTempServerMethods).OnGetToken(vWelcomeMessage, vAccessTag, DWParamsD, +// TRESTDWAuthToken(vAuthTokenParam), +// vErrorCode, vErrorMessage, vToken, vAcceptAuth); + FreeAndNil(DWParamsD); + End + Else + TRESTDWAuthToken(vAuthenticator).OnGetToken(vWelcomeMessage, vAccessTag, DWParamsD, + vErrorCode, vErrorMessage, vToken, vAcceptAuth); + If Not vAcceptAuth Then + Begin + WriteError; + DestroyComponents; + Exit; + End; End Else - TServerMethodDatamodule(vTempServerMethods).OnGetToken(vWelcomeMessage, vAccessTag, DWParams, - TRESTDWAuthToken(vAuthTokenParam), - vErrorCode, vErrorMessage, vToken, vAcceptAuth); - If Not vAcceptAuth Then Begin WriteError; DestroyComponents; @@ -2929,81 +2961,57 @@ procedure TRESTClientPoolerBase.SetIpVersion(IpV: TRESTDWClientIpVersions); End Else Begin - WriteError; - DestroyComponents; - Exit; - End; - End - Else - Begin - vErrorCode := 401; - vErrorMessage := cInvalidAuth; - vTokenValidate := True; - vNeedAuthorization := False; - vTempEvent := ReturnEventValidation(TServerMethodDatamodule(vTempServerMethods), vUrlToExec); - If vTempEvent = Nil Then - Begin - vTempContext := ReturnContextValidation(TServerMethodDatamodule(vTempServerMethods), vUrlToExec); - If vTempContext <> Nil Then - vNeedAuthorization := vTempContext.NeedAuthorization - Else - vNeedAuthorization := True; - End - Else - vNeedAuthorization := vTempEvent.NeedAuthorization; - If vNeedAuthorization Then - Begin - vAuthTokenParam := TRESTDWAuthToken.Create(self); - vAuthTokenParam.Assign(TRESTDWAuthToken(vAuthenticator)); - If DWParams.ItemsString[TRESTDWAuthToken(vAuthenticator).Key] <> Nil Then - vToken := DWParams.ItemsString[TRESTDWAuthToken(vAuthenticator).Key].AsString - Else - Begin - If Trim(Token) <> '' Then - vToken := Token + vErrorCode := 401; + vErrorMessage := cInvalidAuth; + vTokenValidate := True; + vAuthTokenParam := TRESTDWAuthToken.Create(self); + vAuthTokenParam.Assign(TRESTDWAuthToken(vAuthenticator)); + If DWParams.ItemsString[TRESTDWAuthToken(vAuthenticator).Key] <> Nil Then + vToken := DWParams.ItemsString[TRESTDWAuthToken(vAuthenticator).Key].AsString Else - vToken := RawHeaders.Values['Authorization']; - If Trim(vToken) <> '' Then Begin - aToken := GetTokenString(vToken); - If aToken = '' Then - aToken := GetBearerString(vToken); - If aToken = '' Then - aToken := Token; - vToken := aToken; + If Trim(Token) <> '' Then + vToken := Token + Else + vToken := RawHeaders.Values['Authorization']; + If Trim(vToken) <> '' Then + Begin + aToken := GetTokenString(vToken); + If aToken = '' Then + aToken := GetBearerString(vToken); + If aToken = '' Then + aToken := Token; + vToken := aToken; + End; End; - End; - If Not vAuthTokenParam.ValidateToken(vToken) Then - Begin - WriteError; - DestroyComponents; - Exit; - End - Else - vTokenValidate := False; - If Assigned(TServerMethodDatamodule(vTempServerMethods).OnUserTokenAuth) Then - Begin - TServerMethodDatamodule(vTempServerMethods).OnUserTokenAuth(vWelcomeMessage, vAccessTag, DWParams, - TRESTDWAuthToken(vAuthTokenParam), - vErrorCode, vErrorMessage, vToken, vAcceptAuth); - vTokenValidate := Not(vAcceptAuth); - If Not vAcceptAuth Then + If Not vAuthTokenParam.ValidateToken(vToken) Then Begin WriteError; DestroyComponents; Exit; + End + Else + vTokenValidate := False; + If Assigned(TServerMethodDatamodule(vTempServerMethods).OnUserTokenAuth) Then + Begin + TServerMethodDatamodule(vTempServerMethods).OnUserTokenAuth(vWelcomeMessage, vAccessTag, DWParams, + TRESTDWAuthToken(vAuthTokenParam), + vErrorCode, vErrorMessage, vToken, vAcceptAuth); + vTokenValidate := Not(vAcceptAuth); + If Not vAcceptAuth Then + Begin + WriteError; + DestroyComponents; + Exit; + End; End; - End; - End - Else - vTokenValidate := False; - End; - End{$ENDREGION} - Else If vAuthenticator is TRESTDWAuthOAuth Then - raise Exception.Create(cErrorOAuthNotImplenented); - vErrorCode := 200; - vErrorMessage := ''; - End; + End; + End{$ENDREGION} + Else If vAuthenticator is TRESTDWAuthOAuth Then + raise Exception.Create(cErrorOAuthNotImplenented); + vErrorCode := 200; + vErrorMessage := ''; + End; If Assigned(TServerMethodDatamodule(vTempServerMethods).OnWelcomeMessage) then TServerMethodDatamodule(vTempServerMethods).OnWelcomeMessage(vWelcomeMessage, vAccessTag, vdwConnectionDefs, WelcomeAccept, vContentType, vErrorMessage); End; diff --git a/CORE/Source/Basic/uRESTDWComponentEvents.pas b/CORE/Source/Basic/uRESTDWComponentEvents.pas index 9672b98b0..fe6ada704 100644 --- a/CORE/Source/Basic/uRESTDWComponentEvents.pas +++ b/CORE/Source/Basic/uRESTDWComponentEvents.pas @@ -27,8 +27,8 @@ interface Uses SysUtils, Classes, Db, - uRESTDWDataUtils, uRESTDWParams, uRESTDWBasicTypes, uRESTDWProtoTypes, uRESTDWConsts, - uRESTDWMassiveBuffer, uRESTDWAuthenticators; + uRESTDWDataUtils, uRESTDWParams, uRESTDWBasicTypes, uRESTDWProtoTypes, + uRESTDWConsts, uRESTDWMassiveBuffer, uRESTDWAuthenticators; Type TOnCreate = Procedure(Sender : TObject) Of Object; diff --git a/CORE/Source/Plugins/DMDados/uRESTDWDatamodule.pas b/CORE/Source/Plugins/DMDados/uRESTDWDatamodule.pas index dfcddb0dc..f08958a40 100644 --- a/CORE/Source/Plugins/DMDados/uRESTDWDatamodule.pas +++ b/CORE/Source/Plugins/DMDados/uRESTDWDatamodule.pas @@ -9,12 +9,12 @@ interface uRESTDWBasicTypes, uRESTDWConsts, uRESTDWJSONObject, uRESTDWParams, uRESTDWAuthenticators; Type - TUserBasicAuth = Procedure(Welcomemsg, AccessTag, - Username, Password : String; - Var Params : TRESTDWParams; - Var ErrorCode : Integer; - Var ErrorMessage : String; - Var Accept : Boolean) Of Object; +// TUserBasicAuth = Procedure(Welcomemsg, AccessTag, +// Username, Password : String; +// Var Params : TRESTDWParams; +// Var ErrorCode : Integer; +// Var ErrorMessage : String; +// Var Accept : Boolean) Of Object; TUserTokenAuth = Procedure(Welcomemsg, AccessTag : String; Params : TRESTDWParams; @@ -56,9 +56,9 @@ interface vReplyEvent : TRESTDWReplyEvent; vWelcomeMessage : TWelcomeMessage; vMassiveProcess : TMassiveProcess; - vUserBasicAuth : TUserBasicAuth; +// vUserBasicAuth : TUserBasicAuth; vUserTokenAuth : TUserTokenAuth; - vOnGetToken : TOnGetToken; +// vOnGetToken : TOnGetToken; vOnMassiveBegin, vOnMassiveAfterStartTransaction, vOnMassiveAfterBeforeCommit, @@ -94,9 +94,9 @@ interface Property OnMassiveAfterBeforeCommit : TMassiveEvent Read vOnMassiveAfterBeforeCommit Write vOnMassiveAfterBeforeCommit; Property OnMassiveAfterAfterCommit : TMassiveEvent Read vOnMassiveAfterAfterCommit Write vOnMassiveAfterAfterCommit; Property OnMassiveEnd : TMassiveEvent Read vOnMassiveEnd Write vOnMassiveEnd; - Property OnUserBasicAuth : TUserBasicAuth Read vUserBasicAuth Write vUserBasicAuth; +// Property OnUserBasicAuth : TUserBasicAuth Read vUserBasicAuth Write vUserBasicAuth; Property OnUserTokenAuth : TUserTokenAuth Read vUserTokenAuth Write vUserTokenAuth; - Property OnGetToken : TOnGetToken Read vOnGetToken Write vOnGetToken; +// Property OnGetToken : TOnGetToken Read vOnGetToken Write vOnGetToken; Property QueuedRequest : Boolean Read vQueuedRequest Write vQueuedRequest; End; From cc9176b58d62aa0f076b4da3857546f00e43da34 Mon Sep 17 00:00:00 2001 From: Mobius One Date: Tue, 2 May 2023 20:17:19 -0300 Subject: [PATCH 2/7] =?UTF-8?q?-=20Ajuste=20de=20=C3=ADcone=20de=20socket?= =?UTF-8?q?=20fpHttp.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- .../Lazarus/Connectors/Fphttp/RESTDWfphttpSockets.lrs | 10 +++++----- .../Lazarus/Connectors/Fphttp/restdwfphttpsockets.lpk | 7 ++++++- CORE/Source/Sockets/Fphttp/uRESTDWFphttpReg.pas | 5 +++-- 3 files changed, 14 insertions(+), 8 deletions(-) diff --git a/CORE/Packages/Lazarus/Connectors/Fphttp/RESTDWfphttpSockets.lrs b/CORE/Packages/Lazarus/Connectors/Fphttp/RESTDWfphttpSockets.lrs index 89537e54a..c1756ffb0 100644 --- a/CORE/Packages/Lazarus/Connectors/Fphttp/RESTDWfphttpSockets.lrs +++ b/CORE/Packages/Lazarus/Connectors/Fphttp/RESTDWfphttpSockets.lrs @@ -1,4 +1,4 @@ -LazarusResources.Add('TRESTDWFhttpClientPooler','PNG',[ +LazarusResources.Add('TRESTDWfpHttpClientPooler','PNG',[ #137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#25#0#0#0#25#8#6#0#0#0#196#233#133 +'c'#0#0#0#9'pHYs'#0#0#8'N'#0#0#8'N'#1#140'1'#0#236#0#0#0#1'sRGB'#0#174#206#28 +#233#0#0#0#4'gAMA'#0#0#177#143#11#252'a'#5#0#0#2#230'IDATx'#1#189'V;H[Q'#24 @@ -34,7 +34,7 @@ LazarusResources.Add('TRESTDWFhttpClientPooler','PNG',[ +#129#249'y'#252' "'#6#215#136'-+'#12#137#228#233#21'wr'#191'D'#183#134#191 +#234#2#25'{'#18#21#230' '#0#0#0#0'IEND'#174'B`'#130 ]); -LazarusResources.Add('TRESTDWFhttpClientREST','PNG',[ +LazarusResources.Add('TRESTDWfpHttpClientREST','PNG',[ #137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#24#0#0#0#25#8#6#0#0#0'++'#238']'#0 +#0#0#9'pHYs'#0#0#8'N'#0#0#8'N'#1#140'1'#0#236#0#0#0#1'sRGB'#0#174#206#28#233 +#0#0#0#4'gAMA'#0#0#177#143#11#252'a'#5#0#0#3')IDATx'#1#189'V=LSQ'#20#254'Z' @@ -74,7 +74,7 @@ LazarusResources.Add('TRESTDWFhttpClientREST','PNG',[ +#231#127#2'f'#161#166#166#230#151'y'#18#252's'#252#4#203#244'Q{'#183#149#205 +'9'#0#0#0#0'IEND'#174'B`'#130 ]); -LazarusResources.Add('TRESTDWFhttpDataBase','PNG',[ +LazarusResources.Add('TRESTDWfpHttpDataBase','PNG',[ #137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#25#0#0#0#25#8#6#0#0#0#196#233#133 +'c'#0#0#0#9'pHYs'#0#0#8'N'#0#0#8'N'#1#140'1'#0#236#0#0#0#1'sRGB'#0#174#206#28 +#233#0#0#0#4'gAMA'#0#0#177#143#11#252'a'#5#0#0#3'AIDATx'#1#205'VMH[A'#16#254 @@ -113,7 +113,7 @@ LazarusResources.Add('TRESTDWFhttpDataBase','PNG',[ +#228#161'Fg'#18#145'a'#139#166#237#27#195'O'#28'xPw'#162#30#238#28#0#0#0#0'I' +'END'#174'B`'#130 ]); -LazarusResources.Add('TRESTDWFhttpPoolerList','PNG',[ +LazarusResources.Add('TRESTDWfpHttpPoolerList','PNG',[ #137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#25#0#0#0#25#8#6#0#0#0#196#233#133 +'c'#0#0#0#9'pHYs'#0#0#8'N'#0#0#8'N'#1#140'1'#0#236#0#0#0#1'sRGB'#0#174#206#28 +#233#0#0#0#4'gAMA'#0#0#177#143#11#252'a'#5#0#0#2#144'IDATx'#1#237#150'=hZQ' @@ -146,7 +146,7 @@ LazarusResources.Add('TRESTDWFhttpPoolerList','PNG',[ +#142#15'}'#182#208#23#139#241#244#20'_on0'#12'}'#183'='#196'h4'#254'c'#163#10 +#232'x'#160#216#19#227#15'#V'#23'UL'#21'C'#252#0#0#0#0'IEND'#174'B`'#130 ]); -LazarusResources.Add('TRESTDWFhttpServicePooler','PNG',[ +LazarusResources.Add('TRESTDWfpHttpServicePooler','PNG',[ #137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#25#0#0#0#25#8#6#0#0#0#196#233#133 +'c'#0#0#0#9'pHYs'#0#0#8'N'#0#0#8'N'#1#140'1'#0#236#0#0#0#1'sRGB'#0#174#206#28 +#233#0#0#0#4'gAMA'#0#0#177#143#11#252'a'#5#0#0#2#219'IDATx'#1#189'VMK[A'#20 diff --git a/CORE/Packages/Lazarus/Connectors/Fphttp/restdwfphttpsockets.lpk b/CORE/Packages/Lazarus/Connectors/Fphttp/restdwfphttpsockets.lpk index c10f0e480..93b5a04c2 100644 --- a/CORE/Packages/Lazarus/Connectors/Fphttp/restdwfphttpsockets.lpk +++ b/CORE/Packages/Lazarus/Connectors/Fphttp/restdwfphttpsockets.lpk @@ -10,7 +10,7 @@ - + @@ -18,6 +18,7 @@ + @@ -32,6 +33,10 @@ + + + + diff --git a/CORE/Source/Sockets/Fphttp/uRESTDWFphttpReg.pas b/CORE/Source/Sockets/Fphttp/uRESTDWFphttpReg.pas index b25603db4..0a03e66c4 100644 --- a/CORE/Source/Sockets/Fphttp/uRESTDWFphttpReg.pas +++ b/CORE/Source/Sockets/Fphttp/uRESTDWFphttpReg.pas @@ -26,7 +26,7 @@ interface uses - Classes, PropEdits, uRESTDWFphttpBase; + Classes, PropEdits, uRESTDWFphttpBase, LResources; Type TPoolersList = Class(TStringProperty) @@ -77,10 +77,11 @@ procedure TPoolersList.GetValues(Proc: TGetStrProc); Procedure Register; Begin - RegisterComponents('REST Dataware - Service', [TRESTDWFphttpServicePooler]); + RegisterComponents('REST Dataware - Service', [TRESTDWfpHttpServicePooler]); End; initialization +{$I RESTDWfpHttpSockets.lrs} Finalization From 88ebe5fa4b6b6d9298c1f477852bcd51ad48ebca Mon Sep 17 00:00:00 2001 From: Mobius One Date: Wed, 17 May 2023 13:21:53 -0300 Subject: [PATCH 3/7] - Ajuste em ferramenta de testes --- testes/Delphi/FMX/src/DAO/uRDWDBWareDAO.pas | 2 +- testes/Delphi/FMX/src/DAO/uRDWRESTDAO.pas | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/testes/Delphi/FMX/src/DAO/uRDWDBWareDAO.pas b/testes/Delphi/FMX/src/DAO/uRDWDBWareDAO.pas index 059791384..4895643ef 100644 --- a/testes/Delphi/FMX/src/DAO/uRDWDBWareDAO.pas +++ b/testes/Delphi/FMX/src/DAO/uRDWDBWareDAO.pas @@ -4,7 +4,7 @@ interface uses System.SysUtils, - uRESTDWIdBase, uRESTDWBasicDB, uRESTDWDataUtils; + uRESTDWIdBase, uRESTDWBasicDB, uRESTDWDataUtils, uRESTDWConsts; type TRDWDBWareDAO = class diff --git a/testes/Delphi/FMX/src/DAO/uRDWRESTDAO.pas b/testes/Delphi/FMX/src/DAO/uRDWRESTDAO.pas index 82ab440a6..ebbd4233a 100644 --- a/testes/Delphi/FMX/src/DAO/uRDWRESTDAO.pas +++ b/testes/Delphi/FMX/src/DAO/uRDWRESTDAO.pas @@ -4,7 +4,7 @@ interface uses System.Classes, uConsts, System.SysUtils, - uRESTDWDataUtils, uRESTDWResponseTranslator, uRESTDWIdBase; + uRESTDWDataUtils, uRESTDWResponseTranslator, uRESTDWIdBase, uRESTDWConsts; type TRDWRESTDAO = Class From 2fda55380050be6f647510049d06d4954cd23bfc Mon Sep 17 00:00:00 2001 From: Mobius One Date: Wed, 17 May 2023 13:24:14 -0300 Subject: [PATCH 4/7] =?UTF-8?q?-=20Remo=C3=A7=C3=A3o=20de=20binarycompatib?= =?UTF-8?q?le=20do=20c=C3=B3digo?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- .../Basic/Mechanics/uRESTDWAuthenticators.pas | 2 +- .../Basic/Mechanics/uRESTDWDataUtils.pas | 82 ++++++------------- CORE/Source/Basic/uRESTDWBasicDB.pas | 38 ++++----- CORE/Source/Basic/uRESTDWBasicTypes.pas | 59 +++++-------- CORE/Source/Basic/uRESTDWPoolermethod.pas | 48 +++++------ CORE/Source/Consts/uRESTDWConsts.pas | 9 +- .../FireDAC.Phys.RESTDWBase.pas | 2 +- .../ZeosPhysLink/uRESTDWZDbcStatement.pas | 2 +- .../Sockets/Fphttp/uRESTDWFphttpBase.pas | 3 - CORE/Source/Sockets/Indy/uRESTDWIdBase.pas | 10 --- 10 files changed, 92 insertions(+), 163 deletions(-) diff --git a/CORE/Source/Basic/Mechanics/uRESTDWAuthenticators.pas b/CORE/Source/Basic/Mechanics/uRESTDWAuthenticators.pas index af13d437e..4e830ee43 100644 --- a/CORE/Source/Basic/Mechanics/uRESTDWAuthenticators.pas +++ b/CORE/Source/Basic/Mechanics/uRESTDWAuthenticators.pas @@ -30,7 +30,7 @@ interface uRESTDWTools, uRESTDWParams; type - TOnBasicAuth = Procedure(Welcomemsg, AccessTag, + TOnBasicAuth = Procedure(Welcomemsg, AccessTag, DataRoute, Username, Password : String; Var Params : TRESTDWParams; Var ErrorCode : Integer; diff --git a/CORE/Source/Basic/Mechanics/uRESTDWDataUtils.pas b/CORE/Source/Basic/Mechanics/uRESTDWDataUtils.pas index 619d5a4ef..c80da0a0e 100644 --- a/CORE/Source/Basic/Mechanics/uRESTDWDataUtils.pas +++ b/CORE/Source/Basic/Mechanics/uRESTDWDataUtils.pas @@ -33,14 +33,6 @@ interface DateUtils; Type - // TODO mover isso daqui pro authenticator na próxima versão. - TRESTDWAuthOptionTypes = (rdwOATBasic, rdwOATBearer, rdwOATToken); - TRESTDWAuthOption = (rdwAONone, rdwAOBasic, rdwAOBearer, - rdwAOToken, rdwOAuth); - TRESTDWTokenType = (rdwTS, rdwJWT, rdwPersonal); - TRESTDWAuthOptions = Set of TRESTDWAuthOption; - TRESTDWCryptType = (rdwAES256, rdwHSHA256, rdwRSA); - TRESTDWTokenRequest = (rdwtHeader, rdwtRequest); {$IFDEF RESTDWLAZARUS} DWInteger = Longint; DWInt64 = Int64; @@ -87,7 +79,6 @@ interface DataSize : DWInt64; //new for ver15 End; -Type TTokenValue = Class Private vInitRequest, @@ -124,7 +115,6 @@ interface Property Token : String Read ToToken; End; -Type TRESTDWAuthOptionParam = Class(TPersistent) Private vCustom404TitleMessage, @@ -148,7 +138,6 @@ interface Property CustomAuthErrorPage : TStringList Read vCustomAuthErrorPage Write SetCustomAuthErrorPage; End; -Type TRESTDWAuthTokenParam = Class(TRESTDWAuthOptionParam) Private vInitRequest, @@ -188,7 +177,6 @@ interface Property LifeCycle : Integer Read vLifeCycle Write vLifeCycle; End; -Type TRESTDWAuthOptionBasic = Class(TRESTDWAuthOptionParam) Private vUserName, @@ -202,7 +190,6 @@ interface Property Password : String Read vPassword Write vPassword; End; -Type TRESTDWAuthOAuth = Class(TRESTDWAuthOptionParam) Private vRedirectURI, @@ -234,7 +221,6 @@ interface Property Expires_in : TDateTime Read vExpiresin; End; -Type TRESTDWAuthOptionBearerClient = Class(TRESTDWAuthOptionParam) Private vGetTokenName, @@ -267,7 +253,6 @@ interface Property AutoRenewToken : Boolean Read vAutoRenewToken Write vAutoRenewToken; End; -Type TRESTDWAuthOptionTokenClient = Class(TRESTDWAuthOptionParam) Private vSecrets, @@ -300,7 +285,6 @@ interface Property AutoRenewToken : Boolean Read vAutoRenewToken Write vAutoRenewToken; End; -Type TRESTDWAuthOptionBearerServer = Class(TRESTDWAuthTokenParam) Private Protected @@ -309,7 +293,6 @@ interface Function FromToken(Value : String) : Boolean; Override; End; -Type TRESTDWAuthOptionTokenServer = Class(TRESTDWAuthTokenParam) Private Protected @@ -318,7 +301,6 @@ interface Function FromToken(Value : String) : Boolean; Override; End; -Type TRESTDWServerAuthOptionParams = Class(TPersistent) Private FOwner : TPersistent; @@ -338,7 +320,6 @@ interface Property OptionParams : TRESTDWAuthOptionParam Read RDWAuthOptionParam Write RDWAuthOptionParam; End; -Type TRESTDWClientAuthOptionParams = Class(TPersistent) Private FOwner : TPersistent; @@ -357,7 +338,6 @@ interface Property OptionParams : TRESTDWAuthOptionParam Read RDWAuthOptionParam Write RDWAuthOptionParam; End; -Type TRESTDWAuthRequest = Class Private vToken : String; @@ -366,7 +346,6 @@ interface Property Token : String Read vToken Write vToken; End; -Type TRESTDWDataUtils = Class Public Class Procedure ParseRESTURL (Const Cmd : String; @@ -433,8 +412,6 @@ interface {$ENDIF}) : Boolean; End; - - Function GettokenValue (Value : String) : String; Function GetTokenType (Value : String) : TRESTDWTokenType; Function CountExpression(Value : String; @@ -708,7 +685,7 @@ implementation Result := Format('{"alg": "%s", "typ": "%s"}', [GetCryptType, GetTokenType]); End; -Function TTokenValue.ToToken : String; +Function TTokenValue.ToToken : String; Var viss, vBuildData : String; @@ -745,39 +722,30 @@ implementation vBuildData := Format(cValueToken, [viss, IntToStr(DateTimeToUnix(vFinalRequest, False)), IntToStr(DateTimeToUnix(vInitRequest, False)), - EncodeStrings(Format(cValueKeyToken, [EncodeStrings(vSecrets{$IFDEF FPC}, csUndefined{$ENDIF}), vMD5]) - {$IFDEF FPC}, csUndefined{$ENDIF})]) + EncodeStrings(Format(cValueKeyToken, [EncodeStrings(vSecrets{$IFDEF RESTDWLAZARUS}, csUndefined{$ENDIF}), vMD5]) + {$IFDEF RESTDWLAZARUS}, csUndefined{$ENDIF})]) Else vBuildData := Format(cValueTokenNoLife, [viss, IntToStr(DateTimeToUnix(vInitRequest, False)), - EncodeStrings(Format(cValueKeyToken, [EncodeStrings(vSecrets{$IFDEF FPC}, csUndefined{$ENDIF}), vMD5]) - {$IFDEF FPC}, csUndefined{$ENDIF})]); - Result := Result + '.' + EncodeStrings(vBuildData{$IFDEF FPC}, csUndefined{$ENDIF}); + EncodeStrings(Format(cValueKeyToken, [EncodeStrings(vSecrets{$IFDEF RESTDWLAZARUS}, csUndefined{$ENDIF}), vMD5]) + {$IFDEF RESTDWLAZARUS}, csUndefined{$ENDIF})]); + Result := Result + '.' + EncodeStrings(vBuildData{$IFDEF RESTDWLAZARUS}, csUndefined{$ENDIF}); Result := Format(cTokenStringRDWTS, [Result + '.' + vCripto.Encrypt(Result)]); End; End; End; -Function TTokenValue.ToJSON : String; +Function TTokenValue.ToJSON : String; Begin - Result := ''; - Case vRDWTokenType Of - rdwTS, - rdwPersonal : Begin - Result := EncodeStrings(GetHeader{$IFDEF RESTDWLAZARUS}, csUndefined{$ENDIF}); - End; - rdwJWT : Begin - Result := EncodeStrings(GetHeader{$IFDEF RESTDWLAZARUS}, csUndefined{$ENDIF}); - End; - End; + Result := EncodeStrings(GetHeader{$IFDEF RESTDWLAZARUS}, csUndefined{$ENDIF}); End; -Procedure TTokenValue.SetSecrets (Value : String); +Procedure TTokenValue.SetSecrets (Value : String); Begin - vSecrets := Value; + vSecrets := Value; End; -Procedure TTokenValue.SetTokenHash(Token : String); +Procedure TTokenValue.SetTokenHash(Token : String); Begin vTokenHash := Token; vCripto.Key := vTokenHash; @@ -905,7 +873,7 @@ implementation Inherited Assign(Source); End; -Function TRESTDWAuthOptionTokenServer.FromToken(Value : String) : Boolean; +Function TRESTDWAuthOptionTokenServer.FromToken(Value : String) : Boolean; Var vHeader, vBody, @@ -1025,7 +993,7 @@ implementation End; End; -Function TRESTDWAuthOptionTokenServer.GetToken(aSecrets : String = '') : String; +Function TRESTDWAuthOptionTokenServer.GetToken(aSecrets : String = '') : String; Var vTokenValue : TTokenValue; Begin @@ -1115,7 +1083,7 @@ implementation Inherited Assign(Source); End; -Function TRESTDWAuthOptionBearerServer.FromToken(Value : String) : Boolean; +Function TRESTDWAuthOptionBearerServer.FromToken(Value : String) : Boolean; Var vHeader, vBody, @@ -1232,7 +1200,7 @@ implementation End; End; -Function TRESTDWAuthOptionBearerServer.GetToken(aSecrets : String = '') : String; +Function TRESTDWAuthOptionBearerServer.GetToken(aSecrets : String = '') : String; Var vTokenValue : TTokenValue; Begin @@ -1258,7 +1226,7 @@ implementation Inherited; End; -Procedure TRESTDWServerAuthOptionParams.CopyServerAuthParams(Var Value : TRESTDWAuthOptionParam); +Procedure TRESTDWServerAuthOptionParams.CopyServerAuthParams(Var Value : TRESTDWAuthOptionParam); Begin If RDWAuthOptionParam is TRESTDWAuthTokenParam Then Begin @@ -1403,7 +1371,7 @@ implementation Begin inherited; vToken := ''; - vRDWTokenType := rdwTS; + vRDWTokenType := rdwJWT; vTokenRequest := rdwtHeader; vSecrets := ''; vGetTokenName := 'GetToken'; @@ -1422,8 +1390,8 @@ implementation vGetTokenName := 'GetToken'; vTokenName := 'token'; vLifeCycle := 1800;//30 Minutos - vRDWTokenType := rdwTS; - vRDWCryptType := rdwAES256; + vRDWTokenType := rdwJWT; + vRDWCryptType := rdwHSHA256; vServerSignature := ''; vInitRequest := 0; vFinalRequest := 0; @@ -1449,17 +1417,17 @@ implementation Inherited Assign(Source); End; -Destructor TRESTDWAuthTokenParam.Destroy; +Destructor TRESTDWAuthTokenParam.Destroy; Begin Inherited; End; -Procedure TRESTDWAuthTokenParam.SetTokenHash(Token : String); +Procedure TRESTDWAuthTokenParam.SetTokenHash(Token : String); Begin vTokenHash := Token; End; -Function TRESTDWAuthTokenParam.GetTokenType (Value : String) : TRESTDWTokenType; +Function TRESTDWAuthTokenParam.GetTokenType (Value : String) : TRESTDWTokenType; Begin Result := rdwTS; If Lowercase(Value) = 'jwt' Then @@ -1468,7 +1436,7 @@ implementation Result := rdwPersonal; End; -Function TRESTDWAuthTokenParam.GetCryptType (Value : String) : TRESTDWCryptType; +Function TRESTDWAuthTokenParam.GetCryptType (Value : String) : TRESTDWCryptType; Begin Result := rdwAES256; If Lowercase(Value) = 'hs256' Then @@ -1477,12 +1445,12 @@ implementation Result := rdwRSA; End; -Procedure TRESTDWAuthTokenParam.SetCryptType (Value : TRESTDWCryptType); +Procedure TRESTDWAuthTokenParam.SetCryptType (Value : TRESTDWCryptType); Begin vRDWCryptType := Value; End; -Procedure TRESTDWAuthTokenParam.SetGetTokenName(Value : String); +Procedure TRESTDWAuthTokenParam.SetGetTokenName(Value : String); Begin If Length(Value) > 0 Then vGetTokenName := Value diff --git a/CORE/Source/Basic/uRESTDWBasicDB.pas b/CORE/Source/Basic/uRESTDWBasicDB.pas index 0f05753eb..ecce19b65 100644 --- a/CORE/Source/Basic/uRESTDWBasicDB.pas +++ b/CORE/Source/Basic/uRESTDWBasicDB.pas @@ -376,7 +376,7 @@ interface Procedure Loaded; override; Public Procedure SetConnection (Value : Boolean; - aBinaryRequest : Boolean = False); //Seta o Estado da Conexão + aBinaryRequest : Boolean = True); //Seta o Estado da Conexão Procedure DestroyClientPooler; Procedure ExecuteCommand (Var PoolerMethodClient : TRESTDWPoolerMethodClient; Var SQL : TStringList; @@ -386,8 +386,7 @@ interface Var Result : TJSONValue; Var RowsAffected : Integer; Execute : Boolean = False; - BinaryRequest : Boolean = False; - BinaryCompatibleMode : Boolean = False; + BinaryRequest : Boolean = True; Metadata : Boolean = False; RESTClientPooler : TRESTClientPoolerBase = Nil); Procedure ExecuteCommandTB (Var PoolerMethodClient : TRESTDWPoolerMethodClient; @@ -398,7 +397,6 @@ interface Var Result : TJSONValue; Var RowsAffected : Integer; BinaryRequest : Boolean = False; - BinaryCompatibleMode : Boolean = False; Metadata : Boolean = False; RESTClientPooler : TRESTClientPoolerBase = Nil); Procedure ExecuteProcedure (Var PoolerMethodClient : TRESTDWPoolerMethodClient; @@ -3482,7 +3480,6 @@ procedure TRESTDWDatabasebaseBase.Loaded; Var Result : TJSONValue; Var RowsAffected : Integer; BinaryRequest : Boolean = False; - BinaryCompatibleMode : Boolean = False; Metadata : Boolean = False; RESTClientPooler : TRESTClientPoolerBase = Nil); Var @@ -3524,7 +3521,7 @@ procedure TRESTDWDatabasebaseBase.Loaded; vDataRoute, Tablename, DWParams, Error, - MessageError, SocketError, RowsAffected, BinaryRequest, BinaryCompatibleMode, + MessageError, SocketError, RowsAffected, BinaryRequest, Metadata, vTimeOut, vConnectTimeOut, vClientConnectionDefs.vConnectionDefs, vRESTClientPooler); FreeAndNil(DWParams); End @@ -3533,7 +3530,7 @@ procedure TRESTDWDatabasebaseBase.Loaded; vDataRoute, Tablename, Error, - MessageError, SocketError, RowsAffected, BinaryRequest, BinaryCompatibleMode, + MessageError, SocketError, RowsAffected, BinaryRequest, Metadata, vTimeOut, vConnectTimeOut, vClientConnectionDefs.vConnectionDefs, vRESTClientPooler); If SocketError Then Begin @@ -3581,7 +3578,7 @@ procedure TRESTDWDatabasebaseBase.Loaded; vFailOverConnections[I].vDataRoute, Tablename, DWParams, Error, - MessageError, SocketError, RowsAffected, BinaryRequest, BinaryCompatibleMode, + MessageError, SocketError, RowsAffected, BinaryRequest, Metadata, vTimeOut, vConnectTimeOut, vClientConnectionDefs.vConnectionDefs, vRESTClientPooler); FreeAndNil(DWParams); End @@ -3590,7 +3587,7 @@ procedure TRESTDWDatabasebaseBase.Loaded; vFailOverConnections[I].vDataRoute, Tablename, Error, - MessageError, SocketError, RowsAffected, BinaryRequest, BinaryCompatibleMode, + MessageError, SocketError, RowsAffected, BinaryRequest, Metadata, vTimeOut, vConnectTimeOut, vClientConnectionDefs.vConnectionDefs, vRESTClientPooler); If Not SocketError Then Begin @@ -3700,8 +3697,7 @@ procedure TRESTDWDatabasebaseBase.Loaded; Var Result : TJSONValue; Var RowsAffected : Integer; Execute : Boolean = False; - BinaryRequest : Boolean = False; - BinaryCompatibleMode : Boolean = False; + BinaryRequest : Boolean = True; Metadata : Boolean = False; RESTClientPooler : TRESTClientPoolerBase = Nil); Var @@ -3761,7 +3757,7 @@ procedure TRESTDWDatabasebaseBase.Loaded; LDataSetList := vRESTConnectionDB.ExecuteCommandJSON(vRestPooler, vDataRoute, vSQL, DWParams, Error, - MessageError, SocketError, RowsAffected, Execute, BinaryRequest, BinaryCompatibleMode, + MessageError, SocketError, RowsAffected, Execute, BinaryRequest, Metadata, vTimeOut, vConnectTimeOut, vClientConnectionDefs.vConnectionDefs, vRESTClientPooler); FreeAndNil(DWParams); End @@ -3769,7 +3765,7 @@ procedure TRESTDWDatabasebaseBase.Loaded; LDataSetList := vRESTConnectionDB.ExecuteCommandPureJSON(vRestPooler, vDataRoute, vSQL, Error, - MessageError, SocketError, RowsAffected, Execute, BinaryRequest, BinaryCompatibleMode, + MessageError, SocketError, RowsAffected, Execute, BinaryRequest, Metadata, vTimeOut, vConnectTimeOut, vClientConnectionDefs.vConnectionDefs, vRESTClientPooler); If SocketError Then Begin @@ -3819,7 +3815,7 @@ procedure TRESTDWDatabasebaseBase.Loaded; LDataSetList := vRESTConnectionDB.ExecuteCommandJSON(vFailOverConnections[I].vRestPooler, vFailOverConnections[I].vDataRoute, GetLineSQL(SQL), DWParams, Error, - MessageError, SocketError, RowsAffected, Execute, BinaryRequest, BinaryCompatibleMode, + MessageError, SocketError, RowsAffected, Execute, BinaryRequest, Metadata, vTimeOut, vConnectTimeOut, vClientConnectionDefs.vConnectionDefs, vRESTClientPooler); FreeAndNil(DWParams); End @@ -3827,7 +3823,7 @@ procedure TRESTDWDatabasebaseBase.Loaded; LDataSetList := vRESTConnectionDB.ExecuteCommandPureJSON(vFailOverConnections[I].vRestPooler, vFailOverConnections[I].vDataRoute, GetLineSQL(SQL), Error, - MessageError, SocketError, RowsAffected, Execute, BinaryRequest, BinaryCompatibleMode, + MessageError, SocketError, RowsAffected, Execute, BinaryRequest, Metadata, vTimeOut, vConnectTimeOut, vClientConnectionDefs.vConnectionDefs, vRESTClientPooler); If Not SocketError Then Begin @@ -5200,7 +5196,7 @@ procedure TRESTDWDatabasebaseBase.Loaded; End; Procedure TRESTDWDatabasebaseBase.SetConnection(Value : Boolean; - aBinaryRequest : Boolean = False); + aBinaryRequest : Boolean = True); Var vRESTConnectionDB : TRESTDWPoolerMethodClient; Begin @@ -8175,7 +8171,7 @@ function TRESTDWClientSQL.ExecSQL(Var Error: String): Boolean; If Not vRESTDataBase.Active then Exit; vRESTDataBase.ExecuteCommand(vActualPoolerMethodClient, vSQL, vParams, vError, vMessageError, - vResult, vRowsAffected, True, False, False, False, vRESTDataBase.RESTClientPooler); + vResult, vRowsAffected, True, False, False, vRESTDataBase.RESTClientPooler); Result := Not vError; Error := vMessageError; If Assigned(vResult) Then @@ -9521,11 +9517,7 @@ constructor TRESTDWThreadRequest.Create(aSelf : TComponent; vAbortData := AbortData; vOnThreadRequestError := OnThreadRequestError; {$IFNDEF RESTDWLAZARUS} - {$If DEFINED(RESTDWFMX)} - Priority := 1; - {$ELSE} Priority := tpLowest; - {$IFEND} {$ENDIF} End; @@ -10160,7 +10152,7 @@ procedure TRESTDWClientSQL.PrepareDetailsNew; If DataSet = Nil Then Begin vRESTDataBase.ExecuteCommandTB(vActualPoolerMethodClient, vTablename, vParams, vError, vMessageError, LDataSetList, - vRowsAffected, BinaryRequest, True, Fields.Count = 0, Nil); + vRowsAffected, BinaryRequest, Fields.Count = 0, Nil); If LDataSetList <> Nil Then Begin If BinaryRequest Then @@ -10452,7 +10444,7 @@ procedure TRESTDWClientSQL.PrepareDetailsNew; For I := 0 To 1 Do Begin vRESTDataBase.ExecuteCommand(vActualPoolerMethodClient, vSQL, vParams, vError, vMessageError, LDataSetList, - vRowsAffected, False, BinaryRequest, True, vMetaData, vRESTDataBase.RESTClientPooler); + vRowsAffected, False, BinaryRequest, vMetaData, vRESTDataBase.RESTClientPooler); If Not(vError) or (vMessageError <> cInvalidAuth) Then Break; End; diff --git a/CORE/Source/Basic/uRESTDWBasicTypes.pas b/CORE/Source/Basic/uRESTDWBasicTypes.pas index e71c7bdd6..49f45d502 100644 --- a/CORE/Source/Basic/uRESTDWBasicTypes.pas +++ b/CORE/Source/Basic/uRESTDWBasicTypes.pas @@ -165,8 +165,7 @@ TSQLTimeStampOffset = record Function RouteExists(Var Value : String) : Boolean; Procedure Delete(Index : Integer); Overload; Function Add (Item : TRESTDWDataRoute) : Integer; Overload; - Function GetServerMethodClass(Var DataRoute, - FullRequest : String; + Function GetServerMethodClass(Var DataRoute : String; Var ServerMethodClass : TComponentClass) : Boolean; Property Items [Index : Integer] : TRESTDWDataRoute Read GetRec Write PutRec; Default; End; @@ -688,20 +687,16 @@ TSQLTimeStampOffset = record Function TRESTDWDataRouteList.RouteExists(Var Value : String) : Boolean; Var - I : Integer; - vTempRoute, - vTempValue : String; + I: Integer; Begin - Result := False; - If Length(Value) = 0 Then - Exit; - For I := 0 To Count -1 Do + Result := False; + If Length(Value) = 0 Then + Exit; + For I := 0 To Count -1 Do Begin - vTempRoute := Lowercase(Items[I].DataRoute); - vTempValue := Lowercase(Value); - Result := vTempRoute = Copy(vTempValue, 1, Length(vTempRoute)); - If Result Then - Break; + Result := Lowercase(Items[I].DataRoute) = Lowercase(value); + If Result Then + Break; End; End; @@ -733,32 +728,20 @@ TSQLTimeStampOffset = record End; End; -Function TRESTDWDataRouteList.GetServerMethodClass(Var DataRoute, - FullRequest : String; +Function TRESTDWDataRouteList.GetServerMethodClass(Var DataRoute : String; Var ServerMethodClass : TComponentClass) : Boolean; Var - I : Integer; - vTempRoute, - vTempValue : String; -Begin - Result := False; - ServerMethodClass := Nil; - Result := False; - If Length(DataRoute) = 0 Then - Exit; - For I := 0 To Self.Count -1 Do - Begin - vTempRoute := Lowercase(TRESTDWDataRoute(TList(Self).Items[I]^).DataRoute); - vTempValue := Lowercase(DataRoute); - Result := vTempRoute = Copy(vTempValue, 1, Length(vTempRoute)); - If (Result) Then - Begin - ServerMethodClass := TRESTDWDataRoute(TList(Self).Items[I]^).ServerMethodClass; - DataRoute := Copy(vTempValue, Length(vTempRoute), Length(DataRoute) - (Length(vTempRoute) -1)); - FullRequest := Copy(FullRequest, Length(vTempRoute), Length(FullRequest) - (Length(vTempRoute) -1)); - Break; - End; - End; + I : Integer; +Begin + Result := False; + ServerMethodClass := Nil; + for I := 0 to Self.Count -1 do + if Self.Items[I].DataRoute = DataRoute then + begin + ServerMethodClass := Self.Items[I].ServerMethodClass; + Result := True; + break; + end; End; Function TRESTDWDataRouteList.Add(Item : TRESTDWDataRoute) : Integer; diff --git a/CORE/Source/Basic/uRESTDWPoolermethod.pas b/CORE/Source/Basic/uRESTDWPoolermethod.pas index 7b8c1a29d..93b8f421b 100644 --- a/CORE/Source/Basic/uRESTDWPoolermethod.pas +++ b/CORE/Source/Basic/uRESTDWPoolermethod.pas @@ -235,7 +235,6 @@ Var RowsAffected : Integer; Execute : Boolean; BinaryRequest : Boolean; - BinaryCompatibleMode : Boolean; Metadata : Boolean; TimeOut : Integer = 3000; ConnectTimeOut : Integer = 3000; @@ -250,7 +249,6 @@ Var SocketError : Boolean; Var RowsAffected : Integer; BinaryRequest : Boolean; - BinaryCompatibleMode : Boolean; Metadata : Boolean; TimeOut : Integer = 3000; ConnectTimeOut : Integer = 3000; @@ -274,7 +272,6 @@ Var RowsAffected : Integer; Execute : Boolean; BinaryRequest : Boolean; - BinaryCompatibleMode : Boolean; Metadata : Boolean; TimeOut : Integer = 3000; ConnectTimeOut : Integer = 3000; @@ -288,7 +285,6 @@ Var SocketError : Boolean; Var RowsAffected : Integer; BinaryRequest : Boolean; - BinaryCompatibleMode : Boolean; Metadata : Boolean; TimeOut : Integer = 3000; ConnectTimeOut : Integer = 3000; @@ -1746,7 +1742,6 @@ implementation Var SocketError : Boolean; Var RowsAffected : Integer; BinaryRequest : Boolean; - BinaryCompatibleMode : Boolean; Metadata : Boolean; TimeOut : Integer = 3000; ConnectTimeOut : Integer = 3000; @@ -1847,11 +1842,11 @@ implementation JSONParam.ObjectDirection := odIn; JSONParam.AsBoolean := BinaryRequest; DWParams.Add(JSONParam); - JSONParam := TJSONParam.Create(RESTClientPoolerExec.Encoding); - JSONParam.ParamName := 'BinaryCompatibleMode'; - JSONParam.ObjectDirection := odIn; - JSONParam.AsBoolean := BinaryCompatibleMode; - DWParams.Add(JSONParam); +// JSONParam := TJSONParam.Create(RESTClientPoolerExec.Encoding); +// JSONParam.ParamName := 'BinaryCompatibleMode'; +// JSONParam.ObjectDirection := odIn; +// JSONParam.AsBoolean := BinaryCompatibleMode; +// DWParams.Add(JSONParam); JSONParam := TJSONParam.Create(RESTClientPoolerExec.Encoding); JSONParam.ParamName := 'MetadataRequest'; JSONParam.ObjectDirection := odIn; @@ -1949,7 +1944,6 @@ implementation Var RowsAffected : Integer; Execute : Boolean; BinaryRequest : Boolean; - BinaryCompatibleMode : Boolean; Metadata : Boolean; TimeOut : Integer = 3000; ConnectTimeOut : Integer = 3000; @@ -2065,11 +2059,11 @@ implementation JSONParam.ObjectDirection := odIn; JSONParam.AsBoolean := BinaryRequest; DWParams.Add(JSONParam); - JSONParam := TJSONParam.Create(RESTClientPoolerExec.Encoding); - JSONParam.ParamName := 'BinaryCompatibleMode'; - JSONParam.ObjectDirection := odIn; - JSONParam.AsBoolean := BinaryCompatibleMode; - DWParams.Add(JSONParam); +// JSONParam := TJSONParam.Create(RESTClientPoolerExec.Encoding); +// JSONParam.ParamName := 'BinaryCompatibleMode'; +// JSONParam.ObjectDirection := odIn; +// JSONParam.AsBoolean := BinaryCompatibleMode; +// DWParams.Add(JSONParam); JSONParam := TJSONParam.Create(RESTClientPoolerExec.Encoding); JSONParam.ParamName := 'MetadataRequest'; JSONParam.ObjectDirection := odIn; @@ -2169,7 +2163,6 @@ implementation Var SocketError : Boolean; Var RowsAffected : Integer; BinaryRequest : Boolean; - BinaryCompatibleMode : Boolean; Metadata : Boolean; TimeOut : Integer = 3000; ConnectTimeOut : Integer = 3000; @@ -2260,11 +2253,11 @@ implementation JSONParam.ObjectDirection := odIn; JSONParam.AsBoolean := BinaryRequest; DWParams.Add(JSONParam); - JSONParam := TJSONParam.Create(RESTClientPoolerExec.Encoding); - JSONParam.ParamName := 'BinaryCompatibleMode'; - JSONParam.ObjectDirection := odIn; - JSONParam.AsBoolean := BinaryCompatibleMode; - DWParams.Add(JSONParam); +// JSONParam := TJSONParam.Create(RESTClientPoolerExec.Encoding); +// JSONParam.ParamName := 'BinaryCompatibleMode'; +// JSONParam.ObjectDirection := odIn; +// JSONParam.AsBoolean := BinaryCompatibleMode; +// DWParams.Add(JSONParam); JSONParam := TJSONParam.Create(RESTClientPoolerExec.Encoding); JSONParam.ParamName := 'MetadataRequest'; JSONParam.ObjectDirection := odIn; @@ -2371,7 +2364,6 @@ implementation Var RowsAffected : Integer; Execute : Boolean; BinaryRequest : Boolean; - BinaryCompatibleMode : Boolean; Metadata : Boolean; TimeOut : Integer = 3000; ConnectTimeOut : Integer = 3000; @@ -2477,11 +2469,11 @@ implementation JSONParam.ObjectDirection := odIn; JSONParam.AsBoolean := BinaryRequest; DWParams.Add(JSONParam); - JSONParam := TJSONParam.Create(RESTClientPoolerExec.Encoding); - JSONParam.ParamName := 'BinaryCompatibleMode'; - JSONParam.ObjectDirection := odIn; - JSONParam.AsBoolean := BinaryCompatibleMode; - DWParams.Add(JSONParam); +// JSONParam := TJSONParam.Create(RESTClientPoolerExec.Encoding); +// JSONParam.ParamName := 'BinaryCompatibleMode'; +// JSONParam.ObjectDirection := odIn; +// JSONParam.AsBoolean := BinaryCompatibleMode; +// DWParams.Add(JSONParam); JSONParam := TJSONParam.Create(RESTClientPoolerExec.Encoding); JSONParam.ParamName := 'MetadataRequest'; JSONParam.ObjectDirection := odIn; diff --git a/CORE/Source/Consts/uRESTDWConsts.pas b/CORE/Source/Consts/uRESTDWConsts.pas index 708638bde..eba4f66d7 100644 --- a/CORE/Source/Consts/uRESTDWConsts.pas +++ b/CORE/Source/Consts/uRESTDWConsts.pas @@ -36,7 +36,14 @@ zlib, DWDCPrijndael, DWDCPsha256; Type - TEncodeSelect = (esASCII, esUtf8, esANSI); + TEncodeSelect = (esASCII, esUtf8, esANSI); + TRESTDWAuthOptionTypes = (rdwOATBasic, rdwOATBearer, rdwOATToken); + TRESTDWAuthOption = (rdwAONone, rdwAOBasic, rdwAOBearer, + rdwAOToken, rdwOAuth); + TRESTDWTokenType = (rdwTS, rdwJWT, rdwPersonal); + TRESTDWAuthOptions = Set of TRESTDWAuthOption; + TRESTDWCryptType = (rdwAES256, rdwHSHA256, rdwRSA); + TRESTDWTokenRequest = (rdwtHeader, rdwtRequest); Const tScriptsDetected : Array [0..1] of string = ('.map', '.webdwpc'); diff --git a/CORE/Source/Database_Drivers/FireDACPhysLink/FireDAC.Phys.RESTDWBase.pas b/CORE/Source/Database_Drivers/FireDACPhysLink/FireDAC.Phys.RESTDWBase.pas index a977b8a9d..4578f9a76 100644 --- a/CORE/Source/Database_Drivers/FireDACPhysLink/FireDAC.Phys.RESTDWBase.pas +++ b/CORE/Source/Database_Drivers/FireDACPhysLink/FireDAC.Phys.RESTDWBase.pas @@ -666,7 +666,7 @@ function TFDPhysRDWCommand.RDWExecuteComand(exec: Boolean): Longint; try vRESTDataBase.ExecuteCommand(vPoolermethod, vSQL, vParams, vError, vMessageError, vDataSetList, vRowsAffected, exec, (not exec), - (not exec), False, vRESTDataBase.RESTClientPooler); + (not exec), vRESTDataBase.RESTClientPooler); FStream.Size := 0; if (vDataSetList <> nil) and (not vDataSetList.IsNull) then diff --git a/CORE/Source/Database_Drivers/ZeosPhysLink/uRESTDWZDbcStatement.pas b/CORE/Source/Database_Drivers/ZeosPhysLink/uRESTDWZDbcStatement.pas index 631784198..c464d40d7 100644 --- a/CORE/Source/Database_Drivers/ZeosPhysLink/uRESTDWZDbcStatement.pas +++ b/CORE/Source/Database_Drivers/ZeosPhysLink/uRESTDWZDbcStatement.pas @@ -355,7 +355,7 @@ function TZAbstractRESTDWPreparedStatement.RDWExecuteComand( try vRESTDataBase.ExecuteCommand(vPoolermethod, vSQL, vParams, vError, vMessageError, vDataSetList, vRowsAffected, - exec, (not exec), (not exec), False, + exec, (not exec), (not exec), vRESTDataBase.RESTClientPooler); FStream.Size := 0; if (vDataSetList <> nil) and (not vDataSetList.IsNull) then diff --git a/CORE/Source/Sockets/Fphttp/uRESTDWFphttpBase.pas b/CORE/Source/Sockets/Fphttp/uRESTDWFphttpBase.pas index e2762fe0f..993051bed 100644 --- a/CORE/Source/Sockets/Fphttp/uRESTDWFphttpBase.pas +++ b/CORE/Source/Sockets/Fphttp/uRESTDWFphttpBase.pas @@ -289,8 +289,6 @@ procedure TRESTDWFphttpServicePooler.ExecRequest(Sender: TObject; AResponse.Code := StatusCode; - - if (vResponseString <> '') Or (ErrorMessage <> '') Then begin if Assigned(ResultStream) then @@ -302,7 +300,6 @@ procedure TRESTDWFphttpServicePooler.ExecRequest(Sender: TObject; ResultStream := TStringStream.Create(ErrorMessage); end; - for I := 0 To vResponseHeader.Count -1 Do AResponse.CustomHeaders.AddPair(vResponseHeader.Names [I], vResponseHeader.Values[vResponseHeader.Names[I]]); diff --git a/CORE/Source/Sockets/Indy/uRESTDWIdBase.pas b/CORE/Source/Sockets/Indy/uRESTDWIdBase.pas index 255716dbf..acb3a9843 100644 --- a/CORE/Source/Sockets/Indy/uRESTDWIdBase.pas +++ b/CORE/Source/Sockets/Indy/uRESTDWIdBase.pas @@ -3013,16 +3013,6 @@ TIdHTTPAccess = class(TIdHTTP) Else AResponseInfo.CharSet := 'ansi'; AResponseInfo.ResponseNo := StatusCode; - If (vResponseString <> '') Or - (ErrorMessage <> '') Then - Begin - If Assigned(ResultStream) Then - FreeAndNil(ResultStream); - If (vResponseString <> '') Then - ResultStream := TStringStream.Create(vResponseString) - Else - ResultStream := TStringStream.Create(ErrorMessage); - End; If Assigned(ResultStream) Then Begin AResponseInfo.FreeContentStream := True; From da2aa76a2d47188f2fb1d484cd817b0d9b9bff72 Mon Sep 17 00:00:00 2001 From: Mobius One Date: Wed, 17 May 2023 13:25:25 -0300 Subject: [PATCH 5/7] =?UTF-8?q?-=20Refatora=C3=A7=C3=A3o=20inicial=20de=20?= =?UTF-8?q?CommandExec=20e=20autenticadores?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- CORE/Source/Basic/uRESTDWBasic.pas | 1407 +++++++++++++--------------- 1 file changed, 663 insertions(+), 744 deletions(-) diff --git a/CORE/Source/Basic/uRESTDWBasic.pas b/CORE/Source/Basic/uRESTDWBasic.pas index f6abc4023..543a27312 100644 --- a/CORE/Source/Basic/uRESTDWBasic.pas +++ b/CORE/Source/Basic/uRESTDWBasic.pas @@ -37,11 +37,6 @@ interface TRedirect = Procedure(Url : String; AResponse : TObject) {$IFNDEF RESTDWLAZARUS}Of Object{$ENDIF}; - TJvComponent = class(TRESTDWComponent) - private - published - end; - TServerMethodClass = Class(TComponent) End; @@ -62,7 +57,7 @@ TRESTDWServerIpVersionConfig = class(TPersistent) vIPv6Address: String; Public Constructor Create; - Destructor Destroy; + Destructor Destroy; override; Published Property ServerIpVersion : TRESTDWServerIpVersions Read vServerIpVersion Write vServerIpVersion default sivIPv4; Property IPv4Address : String Read vIPv4Address Write vIPv4Address; @@ -449,7 +444,6 @@ TRESTDWServerIpVersionConfig = class(TPersistent) RequestHeader : TStringList; BinaryEvent : Boolean; Metadata : Boolean; - BinaryCompatibleMode : Boolean; CompareContext : Boolean) : Boolean; Procedure ExecuteCommandPureJSON (ServerMethodsClass : TComponent; Var Pooler : String; @@ -458,8 +452,7 @@ TRESTDWServerIpVersionConfig = class(TPersistent) hEncodeStrings : Boolean; AccessTag : String; BinaryEvent : Boolean; - Metadata : Boolean; - BinaryCompatibleMode : Boolean); + Metadata : Boolean); Procedure ExecuteCommandPureJSONTB (ServerMethodsClass : TComponent; Var Pooler : String; Var DWParams : TRESTDWParams; @@ -467,8 +460,7 @@ TRESTDWServerIpVersionConfig = class(TPersistent) hEncodeStrings : Boolean; AccessTag : String; BinaryEvent : Boolean; - Metadata : Boolean; - BinaryCompatibleMode : Boolean); + Metadata : Boolean); Procedure ExecuteCommandJSON (ServerMethodsClass : TComponent; Var Pooler : String; Var DWParams : TRESTDWParams; @@ -476,8 +468,7 @@ TRESTDWServerIpVersionConfig = class(TPersistent) hEncodeStrings : Boolean; AccessTag : String; BinaryEvent : Boolean; - Metadata : Boolean; - BinaryCompatibleMode : Boolean); + Metadata : Boolean); Procedure ExecuteCommandJSONTB (ServerMethodsClass : TComponent; Var Pooler : String; Var DWParams : TRESTDWParams; @@ -485,8 +476,7 @@ TRESTDWServerIpVersionConfig = class(TPersistent) hEncodeStrings : Boolean; AccessTag : String; BinaryEvent : Boolean; - Metadata : Boolean; - BinaryCompatibleMode : Boolean); + Metadata : Boolean); Procedure InsertMySQLReturnID (ServerMethodsClass : TComponent; Var Pooler : String; Var DWParams : TRESTDWParams; @@ -513,8 +503,7 @@ TRESTDWServerIpVersionConfig = class(TPersistent) ConnectionDefs : TConnectionDefs; hEncodeStrings : Boolean; AccessTag : String; - BinaryRequest : Boolean; - BinaryCompatible : Boolean); + BinaryRequest : Boolean); Procedure ApplyUpdates_MassiveCache(ServerMethodsClass : TComponent; Var Pooler : String; Var DWParams : TRESTDWParams; @@ -567,12 +556,12 @@ TRESTDWServerIpVersionConfig = class(TPersistent) procedure Notification(AComponent: TComponent; Operation: TOperation); override; procedure SetAuthenticator(const Value: TRESTDWAuthenticatorBase); Public - Procedure EchoPooler (ServerMethodsClass : TComponent; - AContext : TComponent; - Var Pooler, MyIP : String; - AccessTag : String; - Var InvalidTag : Boolean);Virtual;Abstract; - Procedure SetActive (Value : Boolean);Virtual; +Procedure EchoPooler (ServerMethodsClass : TComponent; + AContext : TComponent; + Var Pooler, MyIP : String; + AccessTag : String; + Var InvalidTag : Boolean);Virtual;Abstract; + Procedure SetActive (Value : Boolean);Virtual; Function CommandExec (Const AContext : TComponent; Url, RawHTTPCommand : String; @@ -661,7 +650,7 @@ TRESTDWServerIpVersionConfig = class(TPersistent) Constructor Create(AOwner: TComponent);Override; End; - Procedure SaveLogData(Filename, Content : String); +Procedure SaveLogData(Filename, Content : String); Implementation @@ -1476,13 +1465,12 @@ procedure TRESTClientPoolerBase.SetIpVersion(IpV: TRESTDWClientIpVersions); vAuthenticationString, LBoundaryStart, LBoundaryEnd, - vBaseData : String; + vBaseData, + vDataRoute : String; vAuthTokenParam : TRESTDWAuthToken; vdwConnectionDefs : TConnectionDefs; vTempServerMethods : TObject; ContentStream : TStream; -// newdecoder, -// Decoder : TIdMessageDecoder; JSONParam : TJSONParam; JSONValue : TJSONValue; vAcceptAuth, @@ -1505,7 +1493,7 @@ procedure TRESTClientPoolerBase.SetIpVersion(IpV: TRESTDWClientIpVersions); vIsQueryParam, msgEnd, LBoundaryFound, - LIsStartBoundary : Boolean; + LIsStartBoundary : Boolean; vServerBaseMethod : TComponentClass; vServerMethod : TComponentClass; ServerContextStream : TMemoryStream; @@ -1520,6 +1508,7 @@ procedure TRESTClientPoolerBase.SetIpVersion(IpV: TRESTDWClientIpVersions); PCustomHeaders : ^TStrings; vTempContext : TRESTDWContext; vTempEvent : TRESTDWEvent; + Function ExcludeTag(Value : String) : String; Begin Result := Value; @@ -1537,6 +1526,7 @@ procedure TRESTClientPoolerBase.SetIpVersion(IpV: TRESTDWClientIpVersions); Delete(Result, 1, 1); Result := Trim(Result); End; + Function GetFileOSDir(Value : String) : String; Begin {$IFDEF RESTDWFMX} @@ -1548,6 +1538,7 @@ procedure TRESTClientPoolerBase.SetIpVersion(IpV: TRESTDWClientIpVersions); Result := StringReplace(Result, '/', '\', [rfReplaceAll]); {$ENDIF} End; + Function GetLastMethod(Value : String) : String; Var I : Integer; @@ -1567,6 +1558,7 @@ procedure TRESTClientPoolerBase.SetIpVersion(IpV: TRESTDWClientIpVersions); End; End; End; + procedure ReadRawHeaders; var I: Integer; @@ -1665,6 +1657,7 @@ procedure TRESTClientPoolerBase.SetIpVersion(IpV: TRESTDWClientIpVersions); tmp := ''; End; End; + Procedure WriteError; Begin {$IFDEF RESTDWLAZARUS} @@ -1685,6 +1678,7 @@ procedure TRESTClientPoolerBase.SetIpVersion(IpV: TRESTDWClientIpVersions); If Assigned(mb) Then FreeAndNil(mb); End; + Procedure WriteStream(Source, Dest : TStream); Begin Source.Position := 0; @@ -1692,6 +1686,7 @@ procedure TRESTClientPoolerBase.SetIpVersion(IpV: TRESTDWClientIpVersions); Dest.CopyFrom(Source, Source.Size); Dest.Position := 0; End; + Procedure DestroyComponents; Begin If Assigned(DWParams) Then @@ -1715,6 +1710,7 @@ procedure TRESTClientPoolerBase.SetIpVersion(IpV: TRESTDWClientIpVersions); End; End; End; + Function ReturnEventValidation(ServerMethodsClass : TComponent; urlContext : String) : TRESTDWEvent; Var @@ -1740,6 +1736,7 @@ procedure TRESTClientPoolerBase.SetIpVersion(IpV: TRESTDWClientIpVersions); End; End; End; + Function ReturnContextValidation(ServerMethodsClass : TComponent; urlContext : String) : TRESTDWContext; Var @@ -1776,6 +1773,7 @@ procedure TRESTClientPoolerBase.SetIpVersion(IpV: TRESTDWClientIpVersions); End; End; End; + Function ClearRequestType(Value : String) : String; Begin Result := Value; @@ -1794,6 +1792,7 @@ procedure TRESTClientPoolerBase.SetIpVersion(IpV: TRESTDWClientIpVersions); Else If (Pos('OPTIONS ', UpperCase(Result)) > 0) Then Result := StringReplace(Result, 'OPTIONS ', '', [rfReplaceAll, rfIgnoreCase]); End; + Function CompareBaseURL(Var Value : String) : Boolean; Var vTempValue : String; @@ -1814,13 +1813,78 @@ procedure TRESTClientPoolerBase.SetIpVersion(IpV: TRESTDWClientIpVersions); End; End; End; + Procedure PrepareBasicAuth(AuthenticationString : String; Var AuthUsername, AuthPassword : String); Begin AuthUsername := Copy(AuthenticationString, InitStrPos, Pos(':', AuthenticationString) -1); Delete(AuthenticationString, InitStrPos, Pos(':', AuthenticationString)); AuthPassword := AuthenticationString; End; + + Procedure WriteResponseText(aText: string; aStatusCode: integer; aContentType: string = 'application/json'); + var + aStreamResponse: TStream; + begin + StatusCode := aStatusCode; + ContentType := aContentType; + If compresseddata Then + aStreamResponse := TStringStream(ZCompressStreamNew(aText)) + Else + aStreamResponse := TStringStream.Create(aText{$IFDEF DELPHIXEUP}, TEncoding.UTF8{$ENDIF}); + aStreamResponse.Position := 0; + + If Not (Assigned(ResultStream)) Then + ResultStream := TStringStream.Create(''{$IFDEF DELPHIXEUP}, TEncoding.UTF8{$ENDIF}); + + ResultStream.CopyFrom(aStreamResponse, aStreamResponse.Size); + FreeAndNil(aStreamResponse); + DestroyComponents; + end; + + Procedure WriteResponseStream(aStream: TStream; aStatusCode: integer; aContentType: string); + var + aStreamResponse: TStream; + begin + StatusCode := aStatusCode; + ContentType := aContentType; + if not Assigned(ResultStream) then + ResultStream := TMemoryStream.Create; + + If compresseddata Then + begin + ZCompressStream(aStream, aStreamResponse); + aStreamResponse.Position := 0; + ResultStream.CopyFrom(aStreamResponse, aStreamResponse.Size); + end + else + ResultStream.CopyFrom(aStream, aStream.Size); + + FreeAndNil(aStreamResponse); + DestroyComponents; + end; + + Procedure WriteResponseFile(aFileName: string; aStatusCode: integer); + var + aStreamResponse: TFileStream; + begin + StatusCode := aStatusCode; + ContentType := TRESTDWMIMEType.GetMIMEType(aFileName); + if not Assigned(ResultStream) then + ResultStream := TMemoryStream.Create; + + aStreamResponse.Create(aFileName, fmCreate); + aStreamResponse.Position := 0; + If compresseddata Then + ZCompressStream(ResultStream, aStreamResponse) + else + ResultStream.CopyFrom(aStreamResponse, aStreamResponse.Size); + + FreeAndNil(aStreamResponse); + DestroyComponents; + end; + Begin + vDataRoute := ''; ResultStream := Nil; Result := True; decoder := Nil; @@ -1852,7 +1916,6 @@ procedure TRESTClientPoolerBase.SetIpVersion(IpV: TRESTDWClientIpVersions); vServerContextCall := False; dwassyncexec := False; vBinaryEvent := False; - vBinaryCompatibleMode := False; vMetadata := False; vdwCriptKey := False; vGettoken := False; @@ -1866,264 +1929,255 @@ procedure TRESTClientPoolerBase.SetIpVersion(IpV: TRESTDWClientIpVersions); vCompareContext := False; Cmd := RemoveBackslashCommands(Trim(RawHTTPCommand)); Try - sCharSet := ''; - If (UpperCase(Copy (Cmd, 1, 3)) = 'GET') Then + sCharSet := ''; + If (UpperCase(Copy (Cmd, 1, 3)) = 'GET') Then Begin - If (Pos('.HTML', UpperCase(Cmd)) > 0) Then + // trocar isso daqui por MIMEType + If (Pos('.HTML', UpperCase(Cmd)) > 0) Then Begin - sContentType:='text/html'; - sCharSet := 'utf-8'; + sContentType:='text/html'; + sCharSet := 'utf-8'; End - Else If (Pos('.PNG', UpperCase(Cmd)) > 0) Then - sContentType := 'image/png' - Else If (Pos('.ICO', UpperCase(Cmd)) > 0) Then - sContentType := 'image/ico' - Else If (Pos('.GIF', UpperCase(Cmd)) > 0) Then - sContentType := 'image/gif' - Else If (Pos('.JPG', UpperCase(Cmd)) > 0) Then - sContentType := 'image/jpg' - Else If (Pos('.JS', UpperCase(Cmd)) > 0) Then - sContentType := 'application/javascript' - Else If (Pos('.PDF', UpperCase(Cmd)) > 0) Then - sContentType := 'application/pdf' - Else If (Pos('.CSS', UpperCase(Cmd)) > 0) Then - sContentType:='text/css'; - sFile := Url; - If Pos(vTempText, sFile) >= InitStrPos Then - Delete(sFile, Pos(vTempText, sFile) - FinalStrPos, Length(vTempText)); - sFile := IncludeTrailingPathDelimiter(FRootPath) + sFile; - {$IFDEF RESTDWWINDOWS} + Else If (Pos('.PNG', UpperCase(Cmd)) > 0) Then + sContentType := 'image/png' + Else If (Pos('.ICO', UpperCase(Cmd)) > 0) Then + sContentType := 'image/ico' + Else If (Pos('.GIF', UpperCase(Cmd)) > 0) Then + sContentType := 'image/gif' + Else If (Pos('.JPG', UpperCase(Cmd)) > 0) Then + sContentType := 'image/jpg' + Else If (Pos('.JS', UpperCase(Cmd)) > 0) Then + sContentType := 'application/javascript' + Else If (Pos('.PDF', UpperCase(Cmd)) > 0) Then + sContentType := 'application/pdf' + Else If (Pos('.CSS', UpperCase(Cmd)) > 0) Then + sContentType:='text/css'; + // + + sFile := Url; + If Pos(vTempText, sFile) >= InitStrPos Then + Delete(sFile, Pos(vTempText, sFile) - FinalStrPos, Length(vTempText)); + sFile := IncludeTrailingPathDelimiter(FRootPath) + sFile; + {$IFDEF RESTDWWINDOWS} sFile := StringReplace(sFile, '/', '\', [rfReplaceAll]); sFile := StringReplace(sFile, '\\', '\', [rfReplaceAll]); - {$ELSE} + {$ELSE} sFile := StringReplace(sFile, '//', '/', [rfReplaceAll]); - {$ENDIF} - If (vPathTraversalRaiseError) And - (RESTDWFileExists(sFile, FRootPath)) And - (SystemProtectFiles(sFile)) Then - Begin - StatusCode := 404; - If compresseddata Then - mb := TStringStream(ZCompressStreamNew(cEventNotFound)) - Else - mb := TStringStream.Create(cEventNotFound{$IFNDEF FPC}{$IF CompilerVersion > 21}, TEncoding.UTF8{$IFEND}{$ENDIF}); - mb.Position := 0; - If Not (Assigned(ResultStream)) Then - ResultStream := TStringStream.Create(''); - ResultStream.CopyFrom(mb, mb.Size); - FreeAndNil(mb); - DestroyComponents; - Exit; - End; - If RESTDWFileExists(sFile, FRootPath) then - Begin - StatusCode := 200; - ContentType := TRESTDWMIMEType.GetMIMEType(sFile); - ServerContextStream := TMemoryStream.Create; - ServerContextStream.LoadFromFile(sFile); - ServerContextStream.Position := 0; - If Not (Assigned(ResultStream)) Then - ResultStream := TMemoryStream.Create; - ResultStream.CopyFrom(ServerContextStream, ServerContextStream.Size); - FreeAndNil(ServerContextStream); - DestroyComponents; - Exit; - End; + {$ENDIF} + + If vPathTraversalRaiseError And ((RESTDWFileExists(sFile, FRootPath) And + SystemProtectFiles(sFile)) or TravertalPathFind(Trim(RawHTTPCommand))) Then + begin + WriteResponseText(cEventNotFound, 404); + exit; + end; + + If RESTDWFileExists(sFile, FRootPath) then + begin + WriteResponseFile(sFile, 200); + exit; + end; End; - If (vPathTraversalRaiseError) And (TravertalPathFind(Trim(RawHTTPCommand))) Then - Begin - StatusCode := 404; - If compresseddata Then - mb := TStringStream(ZCompressStreamNew(cEventNotFound)) - Else - mb := TStringStream.Create(cEventNotFound{$IFNDEF FPC}{$IF CompilerVersion > 21}, TEncoding.UTF8{$IFEND}{$ENDIF}); - mb.Position := 0; - If Not (Assigned(ResultStream)) Then - ResultStream := TStringStream.Create(''); - ResultStream.CopyFrom(mb, mb.Size); - FreeAndNil(mb); - DestroyComponents; - Exit; - End; - Cmd := RemoveBackslashCommands(Trim(RawHTTPCommand)); - vRequestHeader.Add(Cmd); - Cmd := StringReplace(Cmd, ' HTTP/1.0', '', [rfReplaceAll]); - Cmd := StringReplace(Cmd, ' HTTP/1.1', '', [rfReplaceAll]); - Cmd := StringReplace(Cmd, ' HTTP/2.0', '', [rfReplaceAll]); - Cmd := StringReplace(Cmd, ' HTTP/2.1', '', [rfReplaceAll]); - If (UpperCase(Copy (Cmd, 1, 3)) = 'GET' ) OR - (UpperCase(Copy (Cmd, 1, 4)) = 'POST') OR - (UpperCase(Copy (Cmd, 1, 3)) = 'PUT') OR - (UpperCase(Copy (Cmd, 1, 4)) = 'DELE') OR - (UpperCase(Copy (Cmd, 1, 4)) = 'PATC') OR - (UpperCase(Copy (Cmd, 1, 4)) = 'OPTI') Then + +// If (vPathTraversalRaiseError) And (TravertalPathFind(Trim(RawHTTPCommand))) Then +// Begin +// StatusCode := 404; +// If compresseddata Then +// mb := TStringStream(ZCompressStreamNew(cEventNotFound)) +// Else +// mb := TStringStream.Create(cEventNotFound{$IFDEF DELPHIXEUP}, TEncoding.UTF8{$ENDIF}); +// mb.Position := 0; +// If Not (Assigned(ResultStream)) Then +// ResultStream := TStringStream.Create(''); +// ResultStream.CopyFrom(mb, mb.Size); +// FreeAndNil(mb); +// DestroyComponents; +// Exit; +// End; + + Cmd := RemoveBackslashCommands(Trim(RawHTTPCommand)); + vRequestHeader.Add(Cmd); + Cmd := StringReplace(Cmd, ' HTTP/1.0', '', [rfReplaceAll]); + Cmd := StringReplace(Cmd, ' HTTP/1.1', '', [rfReplaceAll]); + Cmd := StringReplace(Cmd, ' HTTP/2.0', '', [rfReplaceAll]); + Cmd := StringReplace(Cmd, ' HTTP/2.1', '', [rfReplaceAll]); + If (UpperCase(Copy (Cmd, 1, 3)) = 'GET' ) OR + (UpperCase(Copy (Cmd, 1, 4)) = 'POST') OR + (UpperCase(Copy (Cmd, 1, 3)) = 'PUT') OR + (UpperCase(Copy (Cmd, 1, 4)) = 'DELE') OR + (UpperCase(Copy (Cmd, 1, 4)) = 'PATC') OR + (UpperCase(Copy (Cmd, 1, 4)) = 'OPTI') Then Begin - RequestType := rtGet; - If (UpperCase(Copy (Cmd, 1, 4)) = 'POST') Then - RequestType := rtPost - Else If (UpperCase(Copy (Cmd, 1, 3)) = 'PUT') Then - RequestType := rtPut - Else If (UpperCase(Copy (Cmd, 1, 4)) = 'DELE') Then - RequestType := rtDelete - Else If (UpperCase(Copy (Cmd, 1, 4)) = 'PATC') Then - RequestType := rtPatch - Else If (UpperCase(Copy (Cmd, 1, 4)) = 'OPTI') Then - RequestType := rtOption; - If Url = '/favicon.ico' Then + RequestType := rtGet; + If (UpperCase(Copy (Cmd, 1, 4)) = 'POST') Then + RequestType := rtPost + Else If (UpperCase(Copy (Cmd, 1, 3)) = 'PUT') Then + RequestType := rtPut + Else If (UpperCase(Copy (Cmd, 1, 4)) = 'DELE') Then + RequestType := rtDelete + Else If (UpperCase(Copy (Cmd, 1, 4)) = 'PATC') Then + RequestType := rtPatch + Else If (UpperCase(Copy (Cmd, 1, 4)) = 'OPTI') Then + RequestType := rtOption; + + If Url = '/favicon.ico' Then Exit; - Cmd := ClearRequestType(Cmd); - vIsQueryParam := (Pos('?', Lowercase(Url)) > 0) And - (Pos('=', Lowercase(Url)) > 0); - If Not vIsQueryParam Then - vIsQueryParam := (Pos('?', Lowercase(RawHTTPCommand)) > 0); - If (cmd = '') or (cmd = '/') Then - vOldRequest := aDefaultUrl - Else - vOldRequest := Cmd; - If vIsQueryParam Then - vUrlToExec := Url - Else - vUrlToExec := Cmd; - If (Cmd <> '/') And (Cmd <> '') Then - ReadRawHeaders; - vCompareContext := CompareBaseURL(Cmd); // := aDefaultUrl; - If Cmd <> '' Then - TRESTDWDataUtils.ParseRESTURL (ClearRequestType(Cmd), vEncoding, vmark{$IFDEF FPC}, vDatabaseCharSet{$ENDIF}, DWParams); - If ((Params.Count > 0) And (RequestType In [rtGet, rtDelete])) Then + Cmd := ClearRequestType(Cmd); + vIsQueryParam := (Pos('?', Lowercase(Url)) > 0) And + (Pos('=', Lowercase(Url)) > 0); + + If Not vIsQueryParam Then + vIsQueryParam := (Pos('?', Lowercase(RawHTTPCommand)) > 0); + + If (cmd = '') or (cmd = '/') Then + vOldRequest := aDefaultUrl + Else + vOldRequest := Cmd; + + If vIsQueryParam Then + vUrlToExec := Url + Else + vUrlToExec := Cmd; + + If (Cmd <> '/') And (Cmd <> '') Then + ReadRawHeaders; + + vCompareContext := CompareBaseURL(Cmd); // := aDefaultUrl; + + If Cmd <> '' Then + TRESTDWDataUtils.ParseRESTURL (ClearRequestType(Cmd), vEncoding, vmark{$IFDEF RESTDWLAZARUS}, vDatabaseCharSet{$ENDIF}, DWParams); + + // + // DataRoute DR001 + // + if (pos('/', cmd, 2) > 0) or (pos('\', cmd, 1) > 0) then + vDataRoute := Copy(cmd, 1, pos('/', cmd, 2)); + + if not vDataRouteList.RouteExists(vDataRoute) then vDataRoute := ''; + + // DataRoute block + + If ((Params.Count > 0) And (RequestType In [rtGet, rtDelete])) Then Begin - vRequestHeader.Add(Url); - vRequestHeader.Add(Params.Text); - vRequestHeader.Add(QueryParams); - TRESTDWDataUtils.ParseWebFormsParams(Params, Url, QueryParams, - vmark, vEncoding{$IFDEF FPC}, vDatabaseCharSet{$ENDIF}, DWParams, RequestType); - If DWParams <> Nil Then + vRequestHeader.Add(Url); + vRequestHeader.Add(Params.Text); + vRequestHeader.Add(QueryParams); + TRESTDWDataUtils.ParseWebFormsParams(Params, Url, QueryParams, + vmark, vEncoding{$IFDEF RESTDWLAZARUS}, vDatabaseCharSet{$ENDIF}, DWParams, RequestType); + If DWParams <> Nil Then Begin - If (DWParams.ItemsString['dwwelcomemessage'] <> Nil) Then - vWelcomeMessage := DecodeStrings(DWParams.ItemsString['dwwelcomemessage'].AsString{$IFDEF FPC}, vDatabaseCharSet{$ENDIF}); - If (DWParams.ItemsString['dwaccesstag'] <> Nil) Then - vAccessTag := DecodeStrings(DWParams.ItemsString['dwaccesstag'].AsString{$IFDEF FPC}, vDatabaseCharSet{$ENDIF}); - If (DWParams.ItemsString['datacompression'] <> Nil) Then - compresseddata := StringToBoolean(DWParams.ItemsString['datacompression'].AsString); - If (DWParams.ItemsString['dwencodestrings'] <> Nil) Then - encodestrings := StringToBoolean(DWParams.ItemsString['dwencodestrings'].AsString); - If (DWParams.ItemsString['dwusecript'] <> Nil) Then - vdwCriptKey := StringToBoolean(DWParams.ItemsString['dwusecript'].AsString); - If (DWParams.ItemsString['BinaryCompatibleMode'] <> Nil) Then - vBinaryCompatibleMode := DWParams.ItemsString['BinaryCompatibleMode'].Value; - If (DWParams.ItemsString['dwservereventname'] <> Nil) Then + If (DWParams.ItemsString['dwwelcomemessage'] <> Nil) Then + vWelcomeMessage := DecodeStrings(DWParams.ItemsString['dwwelcomemessage'].AsString{$IFDEF RESTDWLAZARUS}, vDatabaseCharSet{$ENDIF}); + If (DWParams.ItemsString['dwaccesstag'] <> Nil) Then + vAccessTag := DecodeStrings(DWParams.ItemsString['dwaccesstag'].AsString{$IFDEF RESTDWLAZARUS}, vDatabaseCharSet{$ENDIF}); + If (DWParams.ItemsString['datacompression'] <> Nil) Then + compresseddata := StringToBoolean(DWParams.ItemsString['datacompression'].AsString); + If (DWParams.ItemsString['dwencodestrings'] <> Nil) Then + encodestrings := StringToBoolean(DWParams.ItemsString['dwencodestrings'].AsString); + If (DWParams.ItemsString['dwusecript'] <> Nil) Then + vdwCriptKey := StringToBoolean(DWParams.ItemsString['dwusecript'].AsString); + If (DWParams.ItemsString['dwservereventname'] <> Nil) Then Begin - If vdwservereventname <> GetEventName(Lowercase(DWParams.ItemsString['dwservereventname'].AsString)) Then - vdwservereventname := DecodeStrings(DWParams.ItemsString['dwservereventname'].AsString{$IFDEF FPC}, vDatabaseCharSet{$ENDIF}); + If vdwservereventname <> GetEventName(Lowercase(DWParams.ItemsString['dwservereventname'].AsString)) Then + vdwservereventname := DecodeStrings(DWParams.ItemsString['dwservereventname'].AsString{$IFDEF RESTDWLAZARUS}, vDatabaseCharSet{$ENDIF}); End; End; End - Else + Else Begin - If (RequestType In [rtGet, rtDelete]) Then + If (RequestType In [rtGet, rtDelete]) Then Begin - aurlContext := vUrlToExec; - If Not Assigned(DWParams) Then - TRESTDWDataUtils.ParseRESTURL (Url, vEncoding, vmark{$IFDEF FPC}, vDatabaseCharSet{$ENDIF}, DWParams); - vOldMethod := vUrlToExec; - If DWParams <> Nil Then + aurlContext := vUrlToExec; + If Not Assigned(DWParams) Then + TRESTDWDataUtils.ParseRESTURL (Url, vEncoding, vmark{$IFDEF RESTDWLAZARUS}, vDatabaseCharSet{$ENDIF}, DWParams); + vOldMethod := vUrlToExec; + If DWParams <> Nil Then Begin - If DWParams.ItemsString['dwwelcomemessage'] <> Nil Then - vWelcomeMessage := DecodeStrings(DWParams.ItemsString['dwwelcomemessage'].AsString{$IFDEF FPC}, vDatabaseCharSet{$ENDIF}); - If (DWParams.ItemsString['dwaccesstag'] <> Nil) Then - vAccessTag := DecodeStrings(DWParams.ItemsString['dwaccesstag'].AsString{$IFDEF FPC}, vDatabaseCharSet{$ENDIF}); - If (DWParams.ItemsString['datacompression'] <> Nil) Then - compresseddata := StringToBoolean(DWParams.ItemsString['datacompression'].AsString); - If (DWParams.ItemsString['dwencodestrings'] <> Nil) Then - encodestrings := StringToBoolean(DWParams.ItemsString['dwencodestrings'].AsString); - If (DWParams.ItemsString['dwservereventname'] <> Nil) Then + If DWParams.ItemsString['dwwelcomemessage'] <> Nil Then + vWelcomeMessage := DecodeStrings(DWParams.ItemsString['dwwelcomemessage'].AsString{$IFDEF RESTDWLAZARUS}, vDatabaseCharSet{$ENDIF}); + If (DWParams.ItemsString['dwaccesstag'] <> Nil) Then + vAccessTag := DecodeStrings(DWParams.ItemsString['dwaccesstag'].AsString{$IFDEF RESTDWLAZARUS}, vDatabaseCharSet{$ENDIF}); + If (DWParams.ItemsString['datacompression'] <> Nil) Then + compresseddata := StringToBoolean(DWParams.ItemsString['datacompression'].AsString); + If (DWParams.ItemsString['dwencodestrings'] <> Nil) Then + encodestrings := StringToBoolean(DWParams.ItemsString['dwencodestrings'].AsString); + If (DWParams.ItemsString['dwservereventname'] <> Nil) Then Begin - If vdwservereventname <> GetEventName(Lowercase(DWParams.ItemsString['dwservereventname'].AsString)) Then - vdwservereventname := DecodeStrings(DWParams.ItemsString['dwservereventname'].AsString{$IFDEF FPC}, vDatabaseCharSet{$ENDIF}); + If vdwservereventname <> GetEventName(Lowercase(DWParams.ItemsString['dwservereventname'].AsString)) Then + vdwservereventname := DecodeStrings(DWParams.ItemsString['dwservereventname'].AsString{$IFDEF RESTDWLAZARUS}, vDatabaseCharSet{$ENDIF}); End; - If (DWParams.ItemsString['dwusecript'] <> Nil) Then - vdwCriptKey := StringToBoolean(DWParams.ItemsString['dwusecript'].AsString); - If (DWParams.ItemsString['dwassyncexec'] <> Nil) And (Not (dwassyncexec)) Then - dwassyncexec := StringToBoolean(DWParams.ItemsString['dwassyncexec'].AsString); - If (DWParams.ItemsString['BinaryCompatibleMode'] <> Nil) Then - vBinaryCompatibleMode := DWParams.ItemsString['BinaryCompatibleMode'].Value; + If (DWParams.ItemsString['dwusecript'] <> Nil) Then + vdwCriptKey := StringToBoolean(DWParams.ItemsString['dwusecript'].AsString); + If (DWParams.ItemsString['dwassyncexec'] <> Nil) And (Not (dwassyncexec)) Then + dwassyncexec := StringToBoolean(DWParams.ItemsString['dwassyncexec'].AsString); End; If (vUrlToExec = '') And (aurlContext <> '') Then vUrlToExec := aurlContext; End; - If (RequestType In [rtPut, rtPatch, rtDelete]) Then //New Code to Put + + If (RequestType In [rtPut, rtPatch, rtDelete]) Then //New Code to Put Begin If QueryParams <> '' Then Begin - TRESTDWDataUtils.ParseFormParamsToDWParam(QueryParams, vEncoding, DWParams{$IFDEF FPC}, vDatabaseCharSet{$ENDIF}); - If (DWParams.ItemsString['dwwelcomemessage'] <> Nil) Then - vWelcomeMessage := DecodeStrings(DWParams.ItemsString['dwwelcomemessage'].AsString{$IFDEF FPC}, vDatabaseCharSet{$ENDIF}); - If (DWParams.ItemsString['dwaccesstag'] <> Nil) Then - vAccessTag := DecodeStrings(DWParams.ItemsString['dwaccesstag'].AsString{$IFDEF FPC}, vDatabaseCharSet{$ENDIF}); - If (DWParams.ItemsString['datacompression'] <> Nil) Then - compresseddata := StringToBoolean(DWParams.ItemsString['datacompression'].AsString); - If (DWParams.ItemsString['dwencodestrings'] <> Nil) Then - encodestrings := StringToBoolean(DWParams.ItemsString['dwencodestrings'].AsString); - If (DWParams.ItemsString['dwservereventname'] <> Nil) Then + TRESTDWDataUtils.ParseFormParamsToDWParam(QueryParams, vEncoding, DWParams{$IFDEF RESTDWLAZARUS}, vDatabaseCharSet{$ENDIF}); + If (DWParams.ItemsString['dwwelcomemessage'] <> Nil) Then + vWelcomeMessage := DecodeStrings(DWParams.ItemsString['dwwelcomemessage'].AsString{$IFDEF RESTDWLAZARUS}, vDatabaseCharSet{$ENDIF}); + If (DWParams.ItemsString['dwaccesstag'] <> Nil) Then + vAccessTag := DecodeStrings(DWParams.ItemsString['dwaccesstag'].AsString{$IFDEF RESTDWLAZARUS}, vDatabaseCharSet{$ENDIF}); + If (DWParams.ItemsString['datacompression'] <> Nil) Then + compresseddata := StringToBoolean(DWParams.ItemsString['datacompression'].AsString); + If (DWParams.ItemsString['dwencodestrings'] <> Nil) Then + encodestrings := StringToBoolean(DWParams.ItemsString['dwencodestrings'].AsString); + If (DWParams.ItemsString['dwservereventname'] <> Nil) Then Begin If vdwservereventname <> GetEventName(Lowercase(DWParams.ItemsString['dwservereventname'].AsString)) Then vdwservereventname := DWParams.ItemsString['dwservereventname'].AsString; End; - If (DWParams.ItemsString['dwusecript'] <> Nil) Then - vdwCriptKey := StringToBoolean(DWParams.ItemsString['dwusecript'].AsString); - If (DWParams.ItemsString['dwassyncexec'] <> Nil) And (Not (dwassyncexec)) Then - dwassyncexec := StringToBoolean(DWParams.ItemsString['dwassyncexec'].AsString); - If (DWParams.ItemsString['BinaryCompatibleMode'] <> Nil) Then - vBinaryCompatibleMode := DWParams.ItemsString['BinaryCompatibleMode'].Value; + If (DWParams.ItemsString['dwusecript'] <> Nil) Then + vdwCriptKey := StringToBoolean(DWParams.ItemsString['dwusecript'].AsString); + If (DWParams.ItemsString['dwassyncexec'] <> Nil) And (Not (dwassyncexec)) Then + dwassyncexec := StringToBoolean(DWParams.ItemsString['dwassyncexec'].AsString); End; End; - If Assigned(ContentStringStream) Then + + If Assigned(ContentStringStream) Then Begin ContentStringStream.Position := 0; - If Not vBinaryEvent Then + If Not vBinaryEvent Then Begin - Try -// mb := TStringStream.Create(''); //{$IFNDEF FPC}{$if CompilerVersion > 21}, TEncoding.UTF8{$IFEND}{$ENDIF}); Try -// mb.CopyFrom(ContentStringStream, ContentStringStream.Size); -// ContentStringStream.Position := 0; -// mb.Position := 0; -// If (pos('--', TStringStream(mb).DataString) > 0) and (pos('boundary', ContentType) > 0) Then - If (pos('boundary', ContentType) > 0) Then - Begin - msgEnd := False; - LBoundaryFound := False; - LIsStartBoundary := False; - boundary := ExtractHeaderSubItem(ContentType, 'boundary', QuoteHTTP); - LBoundaryStart := '--' + boundary; - LBoundaryEnd := LBoundaryStart + '--'; - decoder := TRESTDWMessageDecoderMIME.Create(nil); - TRESTDWMessageDecoderMIME(decoder).MIMEBoundary := boundary; - decoder.SourceStream := ContentStringStream; - decoder.FreeSourceStream := False; - Repeat - tmp := ReadLnFromStream(ContentStringStream, -1, True); - If tmp = LBoundaryStart then - Begin - LBoundaryFound := True; - LIsStartBoundary := True; - End - Else If tmp = LBoundaryEnd Then - LBoundaryFound := True; - Until LBoundaryFound; -// boundary := ExtractHeaderSubItem(ContentType, 'boundary', QuoteHTTP); -// startboundary := '--' + boundary; -// Repeat -// tmp := ReadLnFromStream(ContentStringStream, -1, True); -// Until tmp = startboundary; + Try + If (pos('boundary', ContentType) > 0) Then + Begin + msgEnd := False; + LBoundaryFound := False; + LIsStartBoundary := False; + boundary := ExtractHeaderSubItem(ContentType, 'boundary', QuoteHTTP); + LBoundaryStart := '--' + boundary; + LBoundaryEnd := LBoundaryStart + '--'; + decoder := TRESTDWMessageDecoderMIME.Create(nil); + TRESTDWMessageDecoderMIME(decoder).MIMEBoundary := boundary; + decoder.SourceStream := ContentStringStream; + decoder.FreeSourceStream := False; + Repeat + tmp := ReadLnFromStream(ContentStringStream, -1, True); + If tmp = LBoundaryStart then + Begin + LBoundaryFound := True; + LIsStartBoundary := True; + End + Else If tmp = LBoundaryEnd Then + LBoundaryFound := True; + Until LBoundaryFound; + End; + Finally + End; - Finally -// If Assigned(mb) Then -// FreeAndNil(mb); + Except End; - Except - End; End; - If (ContentStringStream.Size > 0) And (boundary <> '') Then + + If (ContentStringStream.Size > 0) And (boundary <> '') Then Begin Try If Assigned(decoder) then @@ -2160,7 +2214,11 @@ procedure TRESTClientPoolerBase.SetIpVersion(IpV: TRESTDWClientIpVersions); Else TRESTDWDataUtils.ParseWebFormsParams (Params, Url, QueryParams, - vmark, vEncoding{$IFDEF RESTDWLAZARUS}, vDatabaseCharSet{$ENDIF}, DWParams, RequestType); + vmark, vEncoding + {$IFDEF RESTDWLAZARUS} + , vDatabaseCharSet + {$ENDIF} + , DWParams, RequestType); End; JSONParam := TJSONParam.Create(DWParams.Encoding); JSONParam.ObjectDirection := odIN; @@ -2316,8 +2374,6 @@ procedure TRESTClientPoolerBase.SetIpVersion(IpV: TRESTDWClientIpVersions); dwassyncexec := StringToBoolean(DWParams.ItemsString['dwassyncexec'].AsString); If (DWParams.ItemsString['binaryrequest'] <> Nil) Then vBinaryEvent := StringToBoolean(DWParams.ItemsString['binaryrequest'].AsString); - If (DWParams.ItemsString['BinaryCompatibleMode'] <> Nil) Then - vBinaryCompatibleMode := DWParams.ItemsString['BinaryCompatibleMode'].Value; End; If Assigned(decoder) Then FreeAndNil(decoder); @@ -2361,28 +2417,27 @@ procedure TRESTClientPoolerBase.SetIpVersion(IpV: TRESTDWClientIpVersions); FreeAndNil(decoder); End; End - Else + Else Begin - If (ContentStringStream.Size > 0) And (boundary = '') Then + If (ContentStringStream.Size > 0) And (boundary = '') Then Begin - mb := TStringStream.Create(''); + mb := TStringStream.Create(''); Try ContentStringStream.Position := 0; mb.CopyFrom(ContentStringStream, ContentStringStream.Size); ContentStringStream.Position := 0; mb.Position := 0; If Not Assigned(DWParams) Then - TRESTDWDataUtils.ParseWebFormsParams (Params, Url, - QueryParams, + TRESTDWDataUtils.ParseWebFormsParams (Params, Url, QueryParams, vmark, vEncoding{$IFDEF RESTDWLAZARUS}, vDatabaseCharSet{$ENDIF}, DWParams, RequestType); - If Assigned(DWParams.ItemsString['dwReadBodyRaw']) And (DWParams.ItemsString['dwReadBodyRaw'].AsString='1') Then - TRESTDWDataUtils.ParseBodyRawToDWParam(TStringStream(mb).DataString, vEncoding, DWParams{$IFDEF RESTDWLAZARUS}, vDatabaseCharSet{$ENDIF}) - Else If (Assigned(DWParams.ItemsString['dwReadBodyBin']) And - (DWParams.ItemsString['dwReadBodyBin'].AsString='1')) Then - TRESTDWDataUtils.ParseBodyBinToDWParam(TStringStream(mb).DataString, vEncoding, DWParams{$IFDEF RESTDWLAZARUS}, vDatabaseCharSet{$ENDIF}) - Else If (vBinaryEvent) Then + If Assigned(DWParams.ItemsString['dwReadBodyRaw']) And (DWParams.ItemsString['dwReadBodyRaw'].AsString='1') Then + TRESTDWDataUtils.ParseBodyRawToDWParam(TStringStream(mb).DataString, vEncoding, DWParams{$IFDEF RESTDWLAZARUS}, vDatabaseCharSet{$ENDIF}) + Else If (Assigned(DWParams.ItemsString['dwReadBodyBin']) And + (DWParams.ItemsString['dwReadBodyBin'].AsString='1')) Then + TRESTDWDataUtils.ParseBodyBinToDWParam(TStringStream(mb).DataString, vEncoding, DWParams{$IFDEF RESTDWLAZARUS}, vDatabaseCharSet{$ENDIF}) + Else If (vBinaryEvent) Then Begin - If (pos('--', TStringStream(mb).DataString) > 0) and (pos('boundary', ContentType) > 0) Then + If (pos('--', TStringStream(mb).DataString) > 0) and (pos('boundary', ContentType) > 0) Then Begin msgEnd := False; boundary := ExtractHeaderSubItem(ContentType, 'boundary', QuoteHTTP); @@ -2400,7 +2455,7 @@ procedure TRESTClientPoolerBase.SetIpVersion(IpV: TRESTDWClientIpVersions); decoder.ReadHeader; Inc(I); Case Decoder.PartType of - mcptAttachment: + mcptAttachment: {$REGION mcptAttachment} Begin ms := TMemoryStream.Create; ms.Position := 0; @@ -2422,7 +2477,12 @@ procedure TRESTClientPoolerBase.SetIpVersion(IpV: TRESTDWClientIpVersions); Else TRESTDWDataUtils.ParseWebFormsParams (Params, Url, QueryParams, - vmark, vEncoding{$IFDEF FPC}, vDatabaseCharSet{$ENDIF}, DWParams, RequestType); + vmark, vEncoding + {$IFDEF RESTDWLAZARUS} + , vDatabaseCharSet + {$ENDIF} + , DWParams, + RequestType); End; JSONParam := TJSONParam.Create(DWParams.Encoding); JSONParam.ObjectDirection := odIN; @@ -2452,9 +2512,9 @@ procedure TRESTClientPoolerBase.SetIpVersion(IpV: TRESTDWClientIpVersions); If Assigned(JSONParam) Then FreeAndNil(JSONParam); If (DWParams.ItemsString['dwwelcomemessage'] <> Nil) Then - vWelcomeMessage := DecodeStrings(DWParams.ItemsString['dwwelcomemessage'].AsString{$IFDEF FPC}, vDatabaseCharSet{$ENDIF}); + vWelcomeMessage := DecodeStrings(DWParams.ItemsString['dwwelcomemessage'].AsString{$IFDEF RESTDWLAZARUS}, vDatabaseCharSet{$ENDIF}); If (DWParams.ItemsString['dwaccesstag'] <> Nil) Then - vAccessTag := DecodeStrings(DWParams.ItemsString['dwaccesstag'].AsString{$IFDEF FPC}, vDatabaseCharSet{$ENDIF}); + vAccessTag := DecodeStrings(DWParams.ItemsString['dwaccesstag'].AsString{$IFDEF RESTDWLAZARUS}, vDatabaseCharSet{$ENDIF}); If (DWParams.ItemsString['datacompression'] <> Nil) Then compresseddata := StringToBoolean(DWParams.ItemsString['datacompression'].AsString); If (DWParams.ItemsString['dwencodestrings'] <> Nil) Then @@ -2470,8 +2530,6 @@ procedure TRESTClientPoolerBase.SetIpVersion(IpV: TRESTDWClientIpVersions); dwassyncexec := StringToBoolean(DWParams.ItemsString['dwassyncexec'].AsString); If (DWParams.ItemsString['binaryrequest'] <> Nil) Then vBinaryEvent := StringToBoolean(DWParams.ItemsString['binaryrequest'].AsString); - If (DWParams.ItemsString['BinaryCompatibleMode'] <> Nil) Then - vBinaryCompatibleMode := DWParams.ItemsString['BinaryCompatibleMode'].Value; if DWParams.ItemsString['dwConnectionDefs'] <> Nil then begin if not Assigned(vdwConnectionDefs) then @@ -2522,8 +2580,8 @@ procedure TRESTClientPoolerBase.SetIpVersion(IpV: TRESTDWClientIpVersions); DWParams.Add(JSONParam); FreeAndNil(ms); FreeAndNil(vDecoderHeaderList); - End; - mcptText : + End; {$ENDREGION mcptAttachment} + mcptText : {$REGION mcptText} begin {$IFDEF RESTDWLAZARUS} ms := TStringStream.Create(''); @@ -2605,21 +2663,20 @@ procedure TRESTClientPoolerBase.SetIpVersion(IpV: TRESTDWClientIpVersions); {$IFNDEF RESTDWLAZARUS}ms.Size := 0;{$ENDIF} FreeAndNil(ms); FreeAndNil(newdecoder); - end; - mcptIgnore : + end; {$ENDREGION mcptAttachment} + mcptIgnore : {$REGION mcptIgnore} Begin Try If decoder <> Nil Then FreeAndNil(decoder); Finally End; - End; - - mcptEOF: - Begin + End; {$ENDREGION mcptAttachment} + mcptEOF: + Begin FreeAndNil(decoder); msgEnd := True - End; + End; End; Until (Decoder = Nil) Or (msgEnd); @@ -2642,20 +2699,8 @@ procedure TRESTClientPoolerBase.SetIpVersion(IpV: TRESTDWClientIpVersions); TRESTDWDataUtils.ParseBodyRawToDWParam(TStringStream(mb).DataString, vEncoding, DWParams{$IFDEF RESTDWLAZARUS}, vDatabaseCharSet{$ENDIF}); End Else - Begin - If vEncoding = esUtf8 Then - Begin -// TRESTDWDataUtils.ParseDWParamsURL(utf8decode(TStringStream(mb).DataString), vEncoding, DWParams{$IFDEF FPC}, vDatabaseCharSet{$ENDIF}); - if DWParams.ItemsString['undefined'] = nil then + if DWParams.ItemsString['undefined'] = nil then TRESTDWDataUtils.ParseBodyRawToDWParam(mb, vEncoding, DWParams{$IFDEF RESTDWLAZARUS}, vDatabaseCharSet{$ENDIF}); - End - Else - Begin -// TRESTDWDataUtils.ParseDWParamsURL(TStringStream(mb).DataString, vEncoding, DWParams{$IFDEF FPC}, vDatabaseCharSet{$ENDIF}); - if DWParams.ItemsString['undefined'] = nil then - TRESTDWDataUtils.ParseBodyRawToDWParam(mb, vEncoding, DWParams{$IFDEF RESTDWLAZARUS}, vDatabaseCharSet{$ENDIF}); - End; - End; {Fim alteração feita por Tiago Istuque - 28/12/2018} Finally mb.Free; @@ -2674,14 +2719,14 @@ procedure TRESTClientPoolerBase.SetIpVersion(IpV: TRESTDWClientIpVersions); If Trim(QueryParams) <> '' Then Begin vRequestHeader.Add(Url + '?' + QueryParams + '&' + QueryParams); - TRESTDWDataUtils.ParseRESTURL (Url + '?' + QueryParams + '&' + QueryParams, vEncoding, vmark{$IFDEF FPC}, vDatabaseCharSet{$ENDIF}, DWParams); + TRESTDWDataUtils.ParseRESTURL (Url + '?' + QueryParams + '&' + QueryParams, vEncoding, vmark, vDatabaseCharSet, DWParams); End Else Begin vRequestHeader.Add(Url + '?' + QueryParams); - TRESTDWDataUtils.ParseRESTURL (Url + '?' + QueryParams, vEncoding, vmark{$IFDEF FPC}, vDatabaseCharSet{$ENDIF}, DWParams); + TRESTDWDataUtils.ParseRESTURL (Url + '?' + QueryParams, vEncoding, vmark, vDatabaseCharSet, DWParams); If DWParams.ItemsString['dwwelcomemessage'] <> Nil Then // Ico Menezes - Post Receber WelcomeMessage - 20-12-2018 - vWelcomeMessage := DecodeStrings(DWParams.ItemsString['dwwelcomemessage'].AsString{$IFDEF FPC}, vDatabaseCharSet{$ENDIF}); + vWelcomeMessage := DecodeStrings(DWParams.ItemsString['dwwelcomemessage'].AsString, vDatabaseCharSet; End; End Else @@ -2692,7 +2737,7 @@ procedure TRESTClientPoolerBase.SetIpVersion(IpV: TRESTDWClientIpVersions); TRESTDWDataUtils.ParseWebFormsParams (Params, Url, QueryParams, - vmark, vEncoding{$IFDEF FPC}, vDatabaseCharSet{$ENDIF}, DWParams, RequestType); + vmark, vEncoding, vDatabaseCharSet, DWParams, RequestType); End; {$ELSE} If QueryParams <> '' Then @@ -2707,7 +2752,7 @@ procedure TRESTClientPoolerBase.SetIpVersion(IpV: TRESTDWClientIpVersions); vRequestHeader.Add(Url + '?' + QueryParams); TRESTDWDataUtils.ParseRESTURL (Url + '?' + QueryParams, vEncoding, vmark, DWParams); If DWParams.ItemsString['dwwelcomemessage'] <> Nil Then // Ico Menezes - Post Receber WelcomeMessage - 20-12-2018 - vWelcomeMessage := DecodeStrings(DWParams.ItemsString['dwwelcomemessage'].AsString{$IFDEF FPC}, vDatabaseCharSet{$ENDIF}); + vWelcomeMessage := DecodeStrings(DWParams.ItemsString['dwwelcomemessage'].AsString); End; End Else @@ -2730,80 +2775,66 @@ procedure TRESTClientPoolerBase.SetIpVersion(IpV: TRESTDWClientIpVersions); vRequestHeader.Add(Params.Text); vRequestHeader.Add(Url); vRequestHeader.Add(QueryParams); - TRESTDWDataUtils.ParseWebFormsParams (Params, Url, - QueryParams, - vmark, vEncoding{$IFDEF RESTDWLAZARUS}, vDatabaseCharSet{$ENDIF}, DWParams, RequestType); + TRESTDWDataUtils.ParseWebFormsParams (Params, Url, QueryParams, vmark, + vEncoding, vDatabaseCharSet, DWParams, RequestType); {$ELSE} vRequestHeader.Add(Params.Text); vRequestHeader.Add(Url); vRequestHeader.Add(QueryParams); If Not Assigned(DWParams) Then - TRESTDWDataUtils.ParseWebFormsParams (Params, Url, - QueryParams, - vmark, vEncoding, DWParams, RequestType); + TRESTDWDataUtils.ParseWebFormsParams (Params, Url, QueryParams, vmark, + vEncoding, DWParams, RequestType); {$ENDIF} End; + If ((vUrlToExec = '') And (aurlContext <> '')) And (Not (RequestType In [rtGet, rtDelete])) Then vUrlToExec := aurlContext; End; End; + WelcomeAccept := True; tmp := ''; vAuthenticationString := ''; vToken := ''; vGettoken := False; vAcceptAuth := False; - If (vDataRouteList.Count > 0) Then - Begin - If Not vDataRouteList.RouteExists(vUrlToExec) Then - Begin - vErrorCode := 400; - JSONStr := GetPairJSONInt(-5, cInvalidRequest); - End - Else - Begin - If (vUrlToExec <> '') Then - Begin - If Not vDataRouteList.GetServerMethodClass(vUrlToExec, vOldRequest, vServerMethod) Then - Begin - vErrorCode := 400; - JSONStr := GetPairJSONInt(-5, cInvalidDataContext); - End; - End - Else - Begin - If Not vDataRouteList.GetServerMethodClass(vUrlToExec, vOldRequest, vServerMethod) Then - Begin - vErrorCode := 400; - JSONStr := GetPairJSONInt(-5, cInvalidDataContext); - End; - End; - End; - End - Else + + If (vDataRouteList.Count > 0) and + not(vDataRouteList.GetServerMethodClass(vDataRoute, vServerMethod)) then + begin + vErrorCode := 400; + JSONStr := GetPairJSONInt(-5, cInvalidRequest); + end + Else if vDataRouteList.Count = 0 then vServerMethod := aServerMethod; + If Assigned(vServerMethod) Then Begin If DWParams.ItemsString['dwwelcomemessage'] <> Nil Then vWelcomeMessage := DecodeStrings(DWParams.ItemsString['dwwelcomemessage'].AsString{$IFDEF RESTDWLAZARUS}, vDatabaseCharSet{$ENDIF}); + If (DWParams.ItemsString['dwaccesstag'] <> Nil) Then vAccessTag := DecodeStrings(DWParams.ItemsString['dwaccesstag'].AsString{$IFDEF RESTDWLAZARUS}, vDatabaseCharSet{$ENDIF}); + Try vTempServerMethods := vServerMethod.Create(Nil); If Not vCORS Then FreeAndNil(CORSCustomHeaders); - If TServerMethodDataModule(vTempServerMethods).GetAction(vOldRequest, DWParams, CORSCustomHeaders) Then + + If TServerMethodDataModule(vTempServerMethods).GetAction(vOldRequest, DWParams, CORSCustomHeaders) Then Begin If ((vCORS) And (RequestType = rtOption)) Then vErrorCode := 200; End; + vUrlToExec := vOldRequest; Finally End; + If (vTempServerMethods.ClassType = TServerMethodDatamodule) Or (vTempServerMethods.ClassType.InheritsFrom(TServerMethodDatamodule)) Then - Begin + Begin TServerMethodDatamodule(vTempServerMethods).SetClientInfo(ClientIP, UserAgent, vUrlToExec, ClientPort); If TServerMethodDatamodule(vTempServerMethods).QueuedRequest Then Begin @@ -2816,7 +2847,9 @@ procedure TRESTClientPoolerBase.SetIpVersion(IpV: TRESTDWClientIpVersions); vCriticalSection.Acquire; {$ENDIF} End; + TServerMethodDatamodule(vTempServerMethods).SetClientWelcomeMessage(vWelcomeMessage); + If vAuthenticator <> Nil Then Begin vAcceptAuth := False; @@ -2840,8 +2873,7 @@ procedure TRESTClientPoolerBase.SetIpVersion(IpV: TRESTDWClientIpVersions); If vNeedAuthorization Then If vAuthenticator is TRESTDWAuthBasic Then Begin {$REGION AuthBasic} - - vAuthenticationString := DecodeStrings(StringReplace(RawHeaders.Values['Authorization'], 'Basic ', '', [rfReplaceAll]){$IFDEF FPC}, vDatabaseCharSet{$ENDIF}); + vAuthenticationString := DecodeStrings(StringReplace(RawHeaders.Values['Authorization'], 'Basic ', '', [rfReplaceAll]){$IFDEF RESTDWLAZARUS}, vDatabaseCharSet{$ENDIF}); If (vAuthenticationString <> '') And ((AuthUsername = '') And (AuthPassword = '')) Then PrepareBasicAuth(vAuthenticationString, AuthUsername, AuthPassword); @@ -2849,6 +2881,7 @@ procedure TRESTClientPoolerBase.SetIpVersion(IpV: TRESTDWClientIpVersions); if Assigned(TRESTDWAuthBasic(Authenticator).OnBasicAuth) then TRESTDWAuthBasic(Authenticator).OnBasicAuth(vWelcomeMessage, vAccessTag, + vDataRoute, AuthUsername, AuthPassword, DWParams, @@ -2866,29 +2899,6 @@ procedure TRESTClientPoolerBase.SetIpVersion(IpV: TRESTDWClientIpVersions); DestroyComponents; Exit; End; - - // If Assigned(TServerMethodDatamodule(vTempServerMethods).OnUserBasicAuth) Then - // Begin - // TServerMethodDatamodule(vTempServerMethods).OnUserBasicAuth(vWelcomeMessage, vAccessTag, - // AuthUsername, - // AuthPassword, - // DWParams, vErrorCode, vErrorMessage, vAcceptAuth); - // If Not vAcceptAuth Then - // Begin - // AuthRealm := cAuthRealm; - // WriteError; - // DestroyComponents; - // Exit; - // End; - // End - // Else If Not ((AuthUsername = TRESTDWAuthBasic(vAuthenticator).UserName) And - // (AuthPassword = TRESTDWAuthBasic(vAuthenticator).Password)) Then - // Begin - // AuthRealm := cAuthRealm; - // WriteError; - // DestroyComponents; - // Exit; - // End; End {$ENDREGION} Else If vAuthenticator is TRESTDWAuthToken Then Begin {$REGION AuthToken} @@ -3011,429 +3021,348 @@ procedure TRESTClientPoolerBase.SetIpVersion(IpV: TRESTDWClientIpVersions); raise Exception.Create(cErrorOAuthNotImplenented); vErrorCode := 200; vErrorMessage := ''; - End; + End + Else If Assigned(TServerMethodDatamodule(vTempServerMethods).OnWelcomeMessage) then - TServerMethodDatamodule(vTempServerMethods).OnWelcomeMessage(vWelcomeMessage, vAccessTag, vdwConnectionDefs, WelcomeAccept, vContentType, vErrorMessage); + TServerMethodDatamodule(vTempServerMethods).OnWelcomeMessage(vWelcomeMessage, + vAccessTag, vdwConnectionDefs, WelcomeAccept, vContentType, + vErrorMessage); End; End - Else + Else Begin - If vErrorCode <> 400 Then - Begin - vErrorCode := 401; - JSONStr := GetPairJSONInt(-5, cServerMethodClassNotAssigned); - End; + vErrorCode := 400; + JSONStr := GetPairJSONInt(-5, cServerMethodClassNotAssigned); End; - Try - If Assigned(vLastRequest) Then + End; + + Try + If vEncoding = esUtf8 Then + sCharSet := 'utf-8' + Else + sCharSet := 'ansi'; + + If Assigned(vLastRequest) Then + Begin + Try + If Assigned(vLastRequest) Then + vLastRequest(UserAgent + sLineBreak + RawHTTPCommand); + Finally + End; + End; + + If (vUrlToExec = '') Then + vUrlToExec := vOldMethod; + + If vTempServerMethods <> Nil Then + Begin + ContentType := cDefaultContentType; + If (vUrlToExec = '') Or + (vUrlToExec = '/') Then Begin - Try - If Assigned(vLastRequest) Then - vLastRequest(UserAgent + sLineBreak + - RawHTTPCommand); - Finally - End; - End; - If (vUrlToExec = '') Then - vUrlToExec := vOldMethod; - vSpecialServer := False; - If vTempServerMethods <> Nil Then + If vDefaultPage.Count > 0 Then + vReplyString := vDefaultPage.Text + Else + if vErrorMessage <> EmptyStr then + begin + vReplyString := vErrorMessage; + vErrorCode := 401; + ContentType := 'text/html'; + end + else + begin + vReplyString := TServerStatusHTML; + vErrorCode := 200; + ContentType := 'text/html'; + end + End + Else Begin - ContentType := cDefaultContentType; //'text';//'application/octet-stream'; - If (vUrlToExec = '') Or - (vUrlToExec = '/') Then + If DWParams <> Nil Then Begin - If vDefaultPage.Count > 0 Then - vReplyString := vDefaultPage.Text - Else - if vErrorMessage <> EmptyStr then - begin - vReplyString := vErrorMessage; - vErrorCode := 401; - ContentType := 'text/html'; - end - else - begin - vReplyString := TServerStatusHTML; - vErrorCode := 200; - ContentType := 'text/html'; - End - end - Else + If (DWParams.ItemsString['dwassyncexec'] <> Nil) And (Not (dwassyncexec)) Then + dwassyncexec := DWParams.ItemsString['dwassyncexec'].AsBoolean; + If DWParams.ItemsString['dwusecript'] <> Nil Then + vdwCriptKey := DWParams.ItemsString['dwusecript'].AsBoolean; + End; + + If dwassyncexec Then + WriteResponseText(vReplyString, 200); + + If DWParams.itemsstring['binaryRequest'] <> Nil Then + vBinaryEvent := DWParams.itemsstring['binaryRequest'].Value; + + If DWParams.itemsstring['MetadataRequest'] <> Nil Then + vMetadata := DWParams.itemsstring['MetadataRequest'].value; + + If Assigned(DWParams) And Assigned(vCripto) Then + DWParams.SetCriptOptions(vdwCriptKey, vCripto.Key); + + If (vTempServerMethods.ClassType = TServerMethodDatamodule) Or + vTempServerMethods.ClassType.InheritsFrom(TServerMethodDatamodule) Then Begin - If vEncoding = esUtf8 Then - sCharSet := 'utf-8' - Else - sCharSet := 'ansi'; - If DWParams <> Nil Then - Begin - If (DWParams.ItemsString['dwassyncexec'] <> Nil) And (Not (dwassyncexec)) Then - dwassyncexec := DWParams.ItemsString['dwassyncexec'].AsBoolean; - If DWParams.ItemsString['dwusecript'] <> Nil Then - vdwCriptKey := DWParams.ItemsString['dwusecript'].AsBoolean; - End; - If dwassyncexec Then - Begin - StatusCode := 200; - vReplyString := AssyncCommandMSG; - If compresseddata Then - mb := TStringStream(ZCompressStreamNew(vReplyString)) - Else - mb := TStringStream.Create(vReplyString{$IFDEF DELPHIXEUP}, TEncoding.UTF8{$ENDIF}); - mb.Position := 0; - If Not (Assigned(ResultStream)) Then - ResultStream := TStringStream.Create(''); - WriteStream(mb, ResultStream); - FreeAndNil(mb); - End; - If DWParams.itemsstring['binaryRequest'] <> Nil Then - vBinaryEvent := DWParams.itemsstring['binaryRequest'].Value; - If DWParams.itemsstring['BinaryCompatibleMode'] <> Nil Then - vBinaryCompatibleMode := DWParams.itemsstring['BinaryCompatibleMode'].Value; - If DWParams.itemsstring['MetadataRequest'] <> Nil Then - vMetadata := DWParams.itemsstring['MetadataRequest'].value; - If (Assigned(DWParams)) And (Assigned(vCripto)) Then - DWParams.SetCriptOptions(vdwCriptKey, vCripto.Key); - If (vTempServerMethods.ClassType = TServerMethodDatamodule) Or - (vTempServerMethods.ClassType.InheritsFrom(TServerMethodDatamodule)) Then - Begin - TServerMethodDatamodule(vTempServerMethods).SetClientInfo(ClientIP, UserAgent, vUrlToExec, ClientPort); - End; - If (Not (vGettoken)) And (Not (vTokenValidate)) Then + TServerMethodDatamodule(vTempServerMethods).SetClientInfo(ClientIP, + UserAgent, vUrlToExec, ClientPort); + End; + + If Not(vGettoken) And Not(vTokenValidate) Then + Begin + If Not ServiceMethods(TComponent(vTempServerMethods), AContext, + vUrlToExec, vdwservereventname, DWParams, + JSONStr, DataMode, vErrorCode, vContentType, + vServerContextCall, ServerContextStream, + vdwConnectionDefs, EncodeStrings, vAccessTag, + WelcomeAccept, RequestType, vMark, + vRequestHeader, vBinaryEvent, vMetadata, + vCompareContext) + Or (lowercase(vContentType) = 'application/php') Then Begin - If Not ServiceMethods(TComponent(vTempServerMethods), AContext, vUrlToExec, vdwservereventname, DWParams, - JSONStr, DataMode, vErrorCode, vContentType, vServerContextCall, ServerContextStream, - vdwConnectionDefs, EncodeStrings, vAccessTag, WelcomeAccept, RequestType, vMark, - vRequestHeader, vBinaryEvent, vMetadata, vBinaryCompatibleMode, vCompareContext) Or (lowercase(vContentType) = 'application/php') Then + Result := False; + If Not dwassyncexec Then Begin - Result := False; - If Not dwassyncexec Then + If Url <> '' Then + sFile := GetFileOSDir(ExcludeTag(tmp + Url)) + Else + sFile := GetFileOSDir(ExcludeTag(Cmd)); + + vFileExists := RESTDWFileExists(sFile, FRootPath); + If Not vFileExists Then Begin - If Not vSpecialServer Then - Begin - If Url <> '' Then + tmp := ''; + If Url <> '' Then sFile := GetFileOSDir(ExcludeTag(tmp + Url)) - Else + Else sFile := GetFileOSDir(ExcludeTag(Cmd)); - vFileExists := RESTDWFileExists(sFile, FRootPath); - If Not vFileExists Then - Begin - tmp := ''; -// If Referer <> '' Then -// tmp := GetLastMethod(Referer); - If Url <> '' Then - sFile := GetFileOSDir(ExcludeTag(tmp + Url)) - Else - sFile := GetFileOSDir(ExcludeTag(Cmd)); - vFileExists := RESTDWFileExists(sFile, FRootPath); - End; - vTagReply := vFileExists or scripttags(ExcludeTag(Cmd)); - If vTagReply Then - Begin - ContentType := TRESTDWMIMEType.GetMIMEType(sFile); - If scripttags(ExcludeTag(Cmd)) and Not vFileExists Then - ContentStream := TMemoryStream.Create - Else - ContentStream := TRESTDWReadFileExclusiveStream.Create(sFile); - ContentStream.Position := 0; - StatusCode := 200; - If Not (Assigned(ResultStream)) Then - ResultStream := TStringStream.Create(''); - WriteStream(ContentStream, ResultStream); - FreeAndNil(ContentStream); - Result := True; - End; - End; + vFileExists := RESTDWFileExists(sFile, FRootPath); End; + + vTagReply := vFileExists or scripttags(ExcludeTag(Cmd)); + If vTagReply Then + begin + WriteResponseFile(sFile, 200); + Result := true; + end; End; - End - Else - Begin - JSONStr := vToken; - DataMode := dmRAW; - vErrorCode := 200; - Result := True; End; + End + Else + Begin + JSONStr := vToken; + DataMode := dmRAW; + vErrorCode := 200; + Result := True; End; End; - Try + End; + + try //limpeza dos componentes If Assigned(vRequestHeader) Then - Begin + Begin vRequestHeader.Clear; FreeAndNil(vRequestHeader); - End; + End; + If Assigned(vServerMethod) Then - If Assigned(vTempServerMethods) Then + If Assigned(vTempServerMethods) Then Begin - If TServerMethodDatamodule(vTempServerMethods).QueuedRequest Then + If TServerMethodDatamodule(vTempServerMethods).QueuedRequest Then Begin {$IFDEF RESTDWLAZARUS} LeaveCriticalSection(vCriticalSection); DoneCriticalSection(vCriticalSection); {$ELSE} - If Assigned(vCriticalSection) Then - Begin - vCriticalSection.Release; - FreeAndNil(vCriticalSection); - End; + If Assigned(vCriticalSection) Then + Begin + vCriticalSection.Release; + FreeAndNil(vCriticalSection); + End; {$ENDIF} End; - Try - vTempServerMethods.free; - vTempServerMethods := Nil; - Except - End; + + Try + vTempServerMethods.free; + vTempServerMethods := Nil; + Except + End; End; - If Not dwassyncexec Then + + If Not dwassyncexec Then + Begin + If Not(vTagReply) Then Begin - If (Not (vTagReply)) Then + If vContentType <> '' Then + ContentType := vContentType; + If Not vServerContextCall Then Begin - If vEncoding = esUtf8 Then - sCharSet := 'utf-8' - Else - sCharSet := 'ansi'; - If vContentType <> '' Then - ContentType := vContentType; - If Not vServerContextCall Then + If (vUrlToExec <> '') Then Begin - If (vUrlToExec <> '') Then + If DataMode in [dmDataware] Then Begin - If DataMode in [dmDataware] Then + If Trim(JSONStr) <> '' Then Begin - If Trim(JSONStr) <> '' Then + If Not(((Pos('{', JSONStr) > 0) And + (Pos('}', JSONStr) > 0)) Or + ((Pos('[', JSONStr) > 0) And + (Pos(']', JSONStr) > 0))) Then Begin - If Not(((Pos('{', JSONStr) > 0) And - (Pos('}', JSONStr) > 0)) Or - ((Pos('[', JSONStr) > 0) And - (Pos(']', JSONStr) > 0))) Then - Begin - If Not (WelcomeAccept) And (vErrorMessage <> '') Then - JSONStr := escape_chars(vErrorMessage) - Else If Not((JSONStr[InitStrPos] = '"') And - (JSONStr[Length(JSONStr)] = '"')) Then - JSONStr := '"' + JSONStr + '"'; - End; + If Not (WelcomeAccept) And (vErrorMessage <> '') Then + JSONStr := escape_chars(vErrorMessage) + Else If Not((JSONStr[InitStrPos] = '"') And + (JSONStr[Length(JSONStr)] = '"')) Then + JSONStr := '"' + JSONStr + '"'; End; -// vErrorCode := 200; - If (RequestType <> rtOption) Then + End; + + If (RequestType <> rtOption) Then + Begin + If vBinaryEvent Then + vReplyString := JSONStr + Else Begin - If vBinaryEvent Then - vReplyString := JSONStr - Else - Begin - If Not(((vUrlToExec = '') Or (vUrlToExec = '/')) And (RequestType = rtGet)) Then - If Not (WelcomeAccept) And (vErrorMessage <> '') Then - Begin - If vEncode_Errors then - vReplyString := escape_chars(vErrorMessage) - Else - vReplyString := vErrorMessage; - End + If Not(((vUrlToExec = '') Or (vUrlToExec = '/')) And (RequestType = rtGet)) Then + If Not (WelcomeAccept) And (vErrorMessage <> '') Then + Begin + If vEncode_Errors then + vReplyString := escape_chars(vErrorMessage) Else - vReplyString := Format(TValueDisp, [GetParamsReturn(DWParams), JSONStr]); - End; + vReplyString := vErrorMessage; + End + Else + vReplyString := Format(TValueDisp, [GetParamsReturn(DWParams), JSONStr]); End; - End - Else If DataMode = dmRAW Then - Begin - If (Trim(JSONStr) = '') And (WelcomeAccept) Then - vReplyString := '{}' - Else If Not (WelcomeAccept) And (vErrorMessage <> '') Then - vReplyString := escape_chars(vErrorMessage) - Else - vReplyString := JSONStr; End; - End; - If Assigned(DWParams) Then + End + Else If DataMode = dmRAW Then Begin - If DWParams.RequestHeaders.Output.Count > 0 Then - Begin - For I := 0 To DWParams.RequestHeaders.Output.Count -1 Do - RequestHeaders.Add(DWParams.RequestHeaders.Output[I]); - End; + If (Trim(JSONStr) = '') And (WelcomeAccept) Then + vReplyString := '{}' + Else If Not (WelcomeAccept) And (vErrorMessage <> '') Then + vReplyString := escape_chars(vErrorMessage) + Else + vReplyString := JSONStr; End; - StatusCode := vErrorCode; - If Assigned(DWParams) And - (Pos(DWParams.Url_Redirect, Cmd) = 0) And - (DWParams.Url_Redirect <> '') Then + End; + + If Assigned(DWParams) Then + Begin + If DWParams.RequestHeaders.Output.Count > 0 Then Begin - vUrlRedirect := DWParams.Url_Redirect; - If Assigned(Redirect) Then - Redirect(vUrlRedirect, AContext); + For I := 0 To DWParams.RequestHeaders.Output.Count -1 Do + RequestHeaders.Add(DWParams.RequestHeaders.Output[I]); End; - If compresseddata Then + End; + + If Assigned(DWParams) And + (Pos(DWParams.Url_Redirect, Cmd) = 0) And + (DWParams.Url_Redirect <> '') Then + Begin + vUrlRedirect := DWParams.Url_Redirect; + If Assigned(Redirect) Then + Redirect(vUrlRedirect, AContext); + End; + + if vBinaryEvent then + begin + ms := TMemoryStream.Create; + If vGettoken Then Begin - If vBinaryEvent Then - Begin - ms := TMemoryStream.Create; - If vGettoken Then - Begin - DWParams.Clear; - DWParams.CreateParam('token', vReplyString); - End; - Try - If DWParams.ItemsString['MessageError'] = Nil Then - Begin - DWParams.CreateParam('MessageError'); - DWParams.ItemsString['MessageError'].ObjectDirection := odOut; - End; - If ((JSONStr <> TReplyOK) and (JSONStr <> Trim(''))) then - Begin - If DWParams.ItemsString['MessageError'].AsString = '' Then - DWParams.ItemsString['MessageError'].AsString := JSONStr; - End - Else - DWParams.ItemsString['MessageError'].AsString := ''; - DWParams.SaveToStream(ms, tdwpxt_OUT); - ZCompressStreamD(ms, ResultStream); - Finally - FreeAndNil(ms); - End; - End - Else + DWParams.Clear; + DWParams.CreateParam('token', vReplyString); + End; + + Try + If DWParams.ItemsString['MessageError'] = Nil Then Begin - If Assigned(ResultStream) Then - FreeAndNil(ResultStream); - ResultStream := TStringStream(ZCompressStreamNew(vReplyString)); + DWParams.CreateParam('MessageError'); + DWParams.ItemsString['MessageError'].ObjectDirection := odOut; End; - If vErrorCode <> 200 Then - ResponseString := escape_chars(vReplyString) - End - Else - Begin - {$IFNDEF FPC} - {$IFDEF DELPHIXEUP} - If vBinaryEvent Then - Begin - mb := TStringStream.Create(''); - Try - DWParams.SaveToStream(mb, tdwpxt_OUT); - Finally - End; - End - Else - mb := TStringStream.Create(vReplyString{$IFDEF DELPHIXEUP}, TEncoding.UTF8{$ENDIF}); - mb.Position := 0; - If Not (Assigned(ResultStream)) Then - ResultStream := TStringStream.Create(''); - WriteStream(mb, ResultStream); - FreeAndNil(mb); - {$ELSE} - If vBinaryEvent Then - Begin - mb := TStringStream.Create(''); - Try - DWParams.SaveToStream(mb, tdwpxt_OUT); - Finally - End; - If Not (Assigned(ResultStream)) Then - ResultStream := TStringStream.Create(''); - WriteStream(mb, ResultStream); - FreeAndNil(mb); - End - Else - ResponseString := vReplyString; - {$ENDIF} - {$ELSE} - If vBinaryEvent Then - Begin - mb := TStringStream.Create(''); - Try - DWParams.SaveToStream(mb, tdwpxt_OUT); - Finally - End; - If Not (Assigned(ResultStream)) Then - ResultStream := TStringStream.Create(''); - WriteStream(mb, ResultStream); - FreeAndNil(mb); - End + + If ((JSONStr <> TReplyOK) and (JSONStr <> Trim(''))) then + Begin + If DWParams.ItemsString['MessageError'].AsString = '' Then + DWParams.ItemsString['MessageError'].AsString := JSONStr; + End Else - Begin - If vEncoding = esUtf8 Then - mb := TStringStream.Create(Utf8Encode(vReplyString)) - Else - mb := TStringStream.Create(vReplyString); - mb.Position := 0; - If Not (Assigned(ResultStream)) Then - ResultStream := TStringStream.Create(''); - WriteStream(mb, ResultStream); - FreeAndNil(mb); - End; - {$ENDIF} + DWParams.ItemsString['MessageError'].AsString := ''; + + DWParams.SaveToStream(ms, tdwpxt_OUT); + WriteResponseStream(ms, vErrorCode, ContentType); + Finally + FreeAndNil(ms); End; + end + else + WriteResponseText(vReplyString, vErrorCode, ContentType); + + End + Else + Begin + LocalDoc := ''; +// If TEncodeSelect(vEncoding) = esUtf8 Then +// sCharset := 'utf-8' +// Else +// sCharset := 'ansi'; + + StatusCode := vErrorCode; + If ServerContextStream <> Nil Then + Begin + If Not (Assigned(ResultStream)) Then + ResultStream := TStringStream.Create(''); + WriteStream(ServerContextStream, ResultStream); + FreeAndNil(ServerContextStream); End - Else + Else Begin - LocalDoc := ''; - If TEncodeSelect(vEncoding) = esUtf8 Then - sCharset := 'utf-8' - Else If TEncodeSelect(vEncoding) in [esANSI, esASCII] Then - sCharset := 'ansi'; - If Not vSpecialServer Then - Begin - StatusCode := vErrorCode; - If ServerContextStream <> Nil Then - Begin - If Not (Assigned(ResultStream)) Then - ResultStream := TStringStream.Create(''); - WriteStream(ServerContextStream, ResultStream); - FreeAndNil(ServerContextStream); - End - Else - Begin - {$IFDEF FPC} - If vEncoding = esUtf8 Then - mb := TStringStream.Create(Utf8Encode(JSONStr)) - Else - mb := TStringStream.Create(JSONStr); - mb.Position := 0; - If Not (Assigned(ResultStream)) Then - ResultStream := TStringStream.Create(''); WriteStream(mb, ResultStream); - FreeAndNil(mb); - {$ELSE} - {$IF CompilerVersion > 21} - mb := TStringStream.Create(JSONStr{$IFNDEF FPC}{$IF CompilerVersion > 21}, TEncoding.UTF8{$IFEND}{$ENDIF}); - mb.Position := 0; - If Not (Assigned(ResultStream)) Then - ResultStream := TStringStream.Create(''); - WriteStream(mb, ResultStream); - FreeAndNil(mb); - {$ELSE} - ResponseString := JSONStr; - {$IFEND} - {$ENDIF} - End; - End; + {$IFDEF RESTDWLAZARUS} + If vEncoding = esUtf8 Then + mb := TStringStream.Create(Utf8Encode(JSONStr)) + Else + mb := TStringStream.Create(JSONStr); + mb.Position := 0; + If Not (Assigned(ResultStream)) Then + ResultStream := TStringStream.Create(''); + WriteStream(mb, ResultStream); + FreeAndNil(mb); + {$ELSEIF Defined(DELPHIXEUP)} + mb := TStringStream.Create(JSONStr, TEncoding.UTF8); + mb.Position := 0; + If Not (Assigned(ResultStream)) Then + ResultStream := TStringStream.Create('', TEncoding.UTF8); + WriteStream(mb, ResultStream); + FreeAndNil(mb); + {$ELSE} + ResponseString := JSONStr; + {$IFEND} End; End; End; - Finally -// FreeAndNil(mb); End; - If Assigned(vLastResponse) Then - Begin - Try - If vReplyString = '' Then - vLastResponse(JSONStr) - Else - vLastResponse(vReplyString); - Finally - End; - End; Finally - If Assigned(vServerMethod) Then - If Assigned(vTempServerMethods) Then - Begin - Try - {$IFDEF POSIX} //no linux nao precisa libertar porque é [weak] - {$ELSE} - FreeAndNil(vTempServerMethods); //.free; - {$ENDIF} - vTempServerMethods := Nil; - Except - End; - End; + End; + + If Assigned(vLastResponse) Then + Begin + Try + If vReplyString = '' Then + vLastResponse(JSONStr) + Else + vLastResponse(vReplyString); + Finally + End; + End; + Finally + If Assigned(vServerMethod) Then + If Assigned(vTempServerMethods) Then + Begin + Try + {$IFNDEF POSIX} //no linux nao precisa libertar porque é [weak] + FreeAndNil(vTempServerMethods); //.free; + {$ENDIF} + vTempServerMethods := Nil; + Except + End; + End; End; Finally DestroyComponents; @@ -3772,7 +3701,6 @@ procedure TRESTServiceBase.SetAuthenticator( RequestHeader : TStringList; BinaryEvent : Boolean; Metadata : Boolean; - BinaryCompatibleMode : Boolean; CompareContext : Boolean) : Boolean; Var vJsonMSG, @@ -3917,7 +3845,7 @@ procedure TRESTServiceBase.SetAuthenticator( Else If vUrlMethod = UpperCase('ExecuteCommandPureJSON') Then Begin vResult := DWParams.ItemsString['Pooler'].Value; - ExecuteCommandPureJSON(BaseObject, vResult, DWParams, ConnectionDefs, hEncodeStrings, AccessTag, BinaryEvent, Metadata, BinaryCompatibleMode); + ExecuteCommandPureJSON(BaseObject, vResult, DWParams, ConnectionDefs, hEncodeStrings, AccessTag, BinaryEvent, Metadata); Result := True; If Not(DWParams.ItemsString['Error'].AsBoolean) Then JSONStr := TReplyOK @@ -3927,7 +3855,7 @@ procedure TRESTServiceBase.SetAuthenticator( Else If vUrlMethod = UpperCase('ExecuteCommandPureJSONTB') Then Begin vResult := DWParams.ItemsString['Pooler'].Value; - ExecuteCommandPureJSONTB(BaseObject, vResult, DWParams, ConnectionDefs, hEncodeStrings, AccessTag, BinaryEvent, Metadata, BinaryCompatibleMode); + ExecuteCommandPureJSONTB(BaseObject, vResult, DWParams, ConnectionDefs, hEncodeStrings, AccessTag, BinaryEvent, Metadata); Result := True; If Not(DWParams.ItemsString['Error'].AsBoolean) Then JSONStr := TReplyOK @@ -3937,7 +3865,7 @@ procedure TRESTServiceBase.SetAuthenticator( Else If vUrlMethod = UpperCase('ExecuteCommandJSON') Then Begin vResult := DWParams.ItemsString['Pooler'].Value; - ExecuteCommandJSON(BaseObject, vResult, DWParams, ConnectionDefs, hEncodeStrings, AccessTag, BinaryEvent, Metadata, BinaryCompatibleMode); + ExecuteCommandJSON(BaseObject, vResult, DWParams, ConnectionDefs, hEncodeStrings, AccessTag, BinaryEvent, Metadata); Result := True; If Not(DWParams.ItemsString['Error'].AsBoolean) Then JSONStr := TReplyOK @@ -3947,7 +3875,7 @@ procedure TRESTServiceBase.SetAuthenticator( Else If vUrlMethod = UpperCase('ExecuteCommandJSONTB') Then Begin vResult := DWParams.ItemsString['Pooler'].Value; - ExecuteCommandJSONTB(BaseObject, vResult, DWParams, ConnectionDefs, hEncodeStrings, AccessTag, BinaryEvent, Metadata, BinaryCompatibleMode); + ExecuteCommandJSONTB(BaseObject, vResult, DWParams, ConnectionDefs, hEncodeStrings, AccessTag, BinaryEvent, Metadata); Result := True; If Not(DWParams.ItemsString['Error'].AsBoolean) Then JSONStr := TReplyOK @@ -4057,7 +3985,7 @@ procedure TRESTServiceBase.SetAuthenticator( Else If vUrlMethod = UpperCase('OpenDatasets') Then Begin vResult := DWParams.ItemsString['Pooler'].Value; - OpenDatasets(BaseObject, vResult, DWParams, ConnectionDefs, hEncodeStrings, AccessTag, BinaryEvent, BinaryCompatibleMode); + OpenDatasets(BaseObject, vResult, DWParams, ConnectionDefs, hEncodeStrings, AccessTag, BinaryEvent); Result := True; If Not(DWParams.ItemsString['Error'].AsBoolean) Then JSONStr := TReplyOK @@ -4271,8 +4199,7 @@ procedure TRESTServiceBase.SetAuthenticator( hEncodeStrings : Boolean; AccessTag : String; BinaryEvent : Boolean; - Metadata : Boolean; - BinaryCompatibleMode : Boolean); + Metadata : Boolean); Var vRowsAffected, I : Integer; @@ -4322,8 +4249,7 @@ procedure TRESTServiceBase.SetAuthenticator( vMessageError, BinaryBlob, vRowsAffected, - vExecute, BinaryEvent, Metadata, - BinaryCompatibleMode); + vExecute, BinaryEvent, Metadata); Except On E : Exception Do Begin @@ -4368,8 +4294,7 @@ procedure TRESTServiceBase.SetAuthenticator( hEncodeStrings : Boolean; AccessTag : String; BinaryEvent : Boolean; - Metadata : Boolean; - BinaryCompatibleMode : Boolean); + Metadata : Boolean); Var vRowsAffected, I : Integer; @@ -4418,8 +4343,7 @@ procedure TRESTServiceBase.SetAuthenticator( vMessageError, BinaryBlob, vRowsAffected, - BinaryEvent, Metadata, - BinaryCompatibleMode); + BinaryEvent, Metadata); Except On E : Exception Do Begin @@ -4464,8 +4388,7 @@ procedure TRESTServiceBase.SetAuthenticator( hEncodeStrings : Boolean; AccessTag : String; BinaryEvent : Boolean; - Metadata : Boolean; - BinaryCompatibleMode : Boolean); + Metadata : Boolean); Var vRowsAffected, I : Integer; @@ -4522,8 +4445,7 @@ procedure TRESTServiceBase.SetAuthenticator( DWParamsD, vError, vMessageError, BinaryBlob, vRowsAffected, - vExecute, BinaryEvent, Metadata, - BinaryCompatibleMode); + vExecute, BinaryEvent, Metadata); DWParamsD.Free; End Else @@ -4576,8 +4498,7 @@ procedure TRESTServiceBase.SetAuthenticator( hEncodeStrings : Boolean; AccessTag : String; BinaryEvent : Boolean; - Metadata : Boolean; - BinaryCompatibleMode : Boolean); + Metadata : Boolean); Var vRowsAffected, I : Integer; @@ -4633,8 +4554,7 @@ procedure TRESTServiceBase.SetAuthenticator( vTempJSON := TRESTDWPoolerDB(ServerMethodsClass.Components[i]).RESTDriver.ExecuteCommandTB(vTablename, DWParamsD, vError, vMessageError, BinaryBlob, vRowsAffected, - BinaryEvent, Metadata, - BinaryCompatibleMode); + BinaryEvent, Metadata); DWParamsD.Free; End Else @@ -4981,8 +4901,7 @@ procedure TRESTServiceBase.Notification(AComponent: TComponent; ConnectionDefs : TConnectionDefs; hEncodeStrings : Boolean; AccessTag : String; - BinaryRequest : Boolean; - BinaryCompatible : Boolean); + BinaryRequest : Boolean); Var I : Integer; vTempJSON : TJSONValue; @@ -5031,7 +4950,7 @@ procedure TRESTServiceBase.Notification(AComponent: TComponent; Begin DWParams.ItemsString['DatasetStream'].SaveToStream(aDataPack); BinaryBlob := TMemoryStream(TRESTDWPoolerDB(ServerMethodsClass.Components[i]).RESTDriver.OpenDatasets(aDataPack, vError, vMessageError, - BinaryBlob, BinaryRequest, BinaryCompatible)); + BinaryBlob, BinaryRequest)); FreeAndNil(aDataPack); If Assigned(BinaryBlob) Then DWParams.ItemsString['Result'].LoadFromStream(BinaryBlob) From 7c80d1353f19c0468c1e206fcf244f751db8bb98 Mon Sep 17 00:00:00 2001 From: Mobius One Date: Wed, 17 May 2023 14:28:02 -0300 Subject: [PATCH 6/7] =?UTF-8?q?-=20Corre=C3=A7=C3=A3o=20de=20chamada=20de?= =?UTF-8?q?=20endpoint?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- CORE/Source/Basic/uRESTDWBasic.pas | 5 ++++- CORE/Source/Plugins/DMDados/uRESTDWDatamodule.pas | 4 ++++ 2 files changed, 8 insertions(+), 1 deletion(-) diff --git a/CORE/Source/Basic/uRESTDWBasic.pas b/CORE/Source/Basic/uRESTDWBasic.pas index 543a27312..e386b7771 100644 --- a/CORE/Source/Basic/uRESTDWBasic.pas +++ b/CORE/Source/Basic/uRESTDWBasic.pas @@ -2817,11 +2817,14 @@ procedure TRESTClientPoolerBase.SetIpVersion(IpV: TRESTDWClientIpVersions); If (DWParams.ItemsString['dwaccesstag'] <> Nil) Then vAccessTag := DecodeStrings(DWParams.ItemsString['dwaccesstag'].AsString{$IFDEF RESTDWLAZARUS}, vDatabaseCharSet{$ENDIF}); - Try + Try // identificando o evento a ser chamado no datamodule vTempServerMethods := vServerMethod.Create(Nil); If Not vCORS Then FreeAndNil(CORSCustomHeaders); + // remover o dataroute do request pra função abaixo poder achar o endpoint + vOldRequest := Copy(vOldrequest, Length(vDataRoute), Length(vOldRequest)); + If TServerMethodDataModule(vTempServerMethods).GetAction(vOldRequest, DWParams, CORSCustomHeaders) Then Begin If ((vCORS) And (RequestType = rtOption)) Then diff --git a/CORE/Source/Plugins/DMDados/uRESTDWDatamodule.pas b/CORE/Source/Plugins/DMDados/uRESTDWDatamodule.pas index f08958a40..1949aa1a1 100644 --- a/CORE/Source/Plugins/DMDados/uRESTDWDatamodule.pas +++ b/CORE/Source/Plugins/DMDados/uRESTDWDatamodule.pas @@ -132,6 +132,7 @@ implementation vTempURL, ParamsURI : String; vParamMethods : TRESTDWParamsMethods; + Procedure ParseParams; Var lst : TStringList; @@ -187,6 +188,7 @@ implementation FreeAndNil(lst); End; End; + Procedure CopyParams(SourceParams : TRESTDWParamsMethods); Var isrc : Integer; @@ -205,6 +207,7 @@ implementation End; End; End; + Procedure ParseURL; Begin vPosQuery := Pos('?', URL); @@ -229,6 +232,7 @@ implementation If URL = '' Then URL := '/'; End; + Begin Result := False; If Length(URL) = 0 Then From 5bd8c7636c28b4d878ff442dd9c8fdd52f32e953 Mon Sep 17 00:00:00 2001 From: Mobius One Date: Wed, 17 May 2023 15:00:06 -0300 Subject: [PATCH 7/7] =?UTF-8?q?-=20Corre=C3=A7=C3=A3o=20de=20valida=C3=A7?= =?UTF-8?q?=C3=A3o=20de=20DataRoute.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- CORE/Source/Basic/uRESTDWBasic.pas | 18 ++++++++++++------ CORE/Source/Consts/uRESTDWConsts.pas | 1 - 2 files changed, 12 insertions(+), 7 deletions(-) diff --git a/CORE/Source/Basic/uRESTDWBasic.pas b/CORE/Source/Basic/uRESTDWBasic.pas index e386b7771..d5f2a1d09 100644 --- a/CORE/Source/Basic/uRESTDWBasic.pas +++ b/CORE/Source/Basic/uRESTDWBasic.pas @@ -15,7 +15,6 @@ XyberX (Gilberto Rocha) - Admin - Criador e Administrador do pacote. Alexandre Abbade - Admin - Administrador do desenvolvimento de DEMOS, coordenador do Grupo. - Anderson Fiori - Admin - Gerencia de Organização dos Projetos Flávio Motta - Member Tester and DEMO Developer. Mobius One - Devel, Tester and Admin. Gustavo - Criptografia and Devel. @@ -2049,11 +2048,18 @@ procedure TRESTClientPoolerBase.SetIpVersion(IpV: TRESTDWClientIpVersions); // // DataRoute DR001 - // - if (pos('/', cmd, 2) > 0) or (pos('\', cmd, 1) > 0) then - vDataRoute := Copy(cmd, 1, pos('/', cmd, 2)); - - if not vDataRouteList.RouteExists(vDataRoute) then vDataRoute := ''; + // verifica o dataroute na URL do request: "cmd" + if vDataRouteList.Count > 0 then + begin + if (pos('/', cmd, 2) > 0) or (pos('\', cmd, 1) > 0) then + vDataRoute := Copy(cmd, 1, pos('/', cmd, 2)); + + if not vDataRouteList.RouteExists(vDataRoute) then + begin + WriteResponseText(cInvalidRequest, 400); + exit; + end; + end; // DataRoute block diff --git a/CORE/Source/Consts/uRESTDWConsts.pas b/CORE/Source/Consts/uRESTDWConsts.pas index eba4f66d7..517fbf435 100644 --- a/CORE/Source/Consts/uRESTDWConsts.pas +++ b/CORE/Source/Consts/uRESTDWConsts.pas @@ -15,7 +15,6 @@ XyberX (Gilberto Rocha) - Admin - Criador e Administrador do pacote. Alexandre Abbade - Admin - Administrador do desenvolvimento de DEMOS, coordenador do Grupo. - Anderson Fiori - Admin - Gerencia de Organização dos Projetos Flávio Motta - Member Tester and DEMO Developer. Mobius One - Devel, Tester and Admin. Gustavo - Criptografia and Devel.