unit uWebMod; interface {$I 'GlobalDefs.inc'} uses System.SysUtils, System.Classes, System.Generics.Collections, Web.HTTPApp, MVCFramework, MVCFramework.Commons, MVCFramework.Controllers.Register, MVCFramework.Middleware.Redirect //{$IF DEFINED(CUSTOM_CTRL_INCOSystems)} ,uCtrlCustom {$ENDIF} //{$IF DEFINED(CUSTOM_CTRL_GatemaSD)} ,uCtrlCustomSDG {$ENDIF} {$IF DEFINED(CUSTOM_CTRL_Rootvin) OR DEFINED(CUSTOM_CTRL_INCOSystems) OR DEFINED(CUSTOM_CTRL_EMPolar) OR DEFINED(CUSTOM_CTRL_Koramex) OR DEFINED(CUSTOM_CTRL_Westra) OR DEFINED(CUSTOM_CTRL_Gornicky)} ,uCtrlCustom {$UNDEF CUSTOM_CTRL_GatemaSD} {$ENDIF} ; const CRLF = #13#10; type TWebModule1 = class(TWebModule) procedure WebModuleCreate(Sender: TObject); procedure WebModuleDestroy(Sender: TObject); private FEngine: TMVCEngine; public Port: integer; end; THDCDZJWTAuthentication = class(TInterfacedObject, IMVCAuthenticationHandler) protected procedure OnRequest(const AContext: TWebContext; const ControllerQualifiedClassName: string; const ActionName: string; var AuthenticationRequired: Boolean); procedure OnAuthentication(const AContext: TWebContext; const UserName: string; const Password: string; UserRoles: TList; var IsValid: Boolean; const SessionData: TSessionData); procedure OnAuthorization(const AContext: TWebContext; UserRoles: TList; const ControllerQualifiedClassName: string; const ActionName: string; var IsAuthorized: Boolean); end; var WebModuleClass: TComponentClass = TWebModule1; jeLoginMod: boolean; dataZoneKlic: string; implementation { %CLASSGROUP 'Vcl.Controls.TControl' } uses MVCFramework.Middleware.CORS, MVCFramework.Middleware.Compression, MVCFramework.Middleware.StaticFiles, {$IF DEFINED(SEC_ACCESS) or DEFINED(SWAGGER)} MVCFramework.Middleware.JWT, {$ENDIF} {$IFDEF SEC_ACCESS} MVCFramework.JWT, {$ENDIF} MVCFramework.Middleware.Swagger, MVCFramework.Swagger.Commons, uWinService, uCtrlBase, uCtrlZamestnanci, uCtrlObehZbozi, uCtrlKmenZbozi, uCtrlVyroba, uCtrlObecne, uCtrlOrganizace, uCtrlQMS, uDataMod {$IF DEFINED(CUSTOM_CTRL_GatemaSD)} , uCtrlCustomSDG {$ENDIF} ; {$R *.dfm} // TODO: JWT autentifikaci procedure THDCDZJWTAuthentication.OnAuthentication (const AContext: TWebContext; const UserName: string; const Password: string; UserRoles: TList; var IsValid: Boolean; const SessionData: TSessionData); begin IsValid := (not UserName.IsEmpty) and UserName.Equals(Password); // hey!, this is just a demo!!! if IsValid then begin if UserName = 'user_raise_exception' then begin raise EMVCException.Create(500, 1024, 'This is a custom exception raised in "TAuthenticationSample.OnAuthentication"'); end; if UserName = 'user1' then begin UserRoles.Add('role1'); end; if UserName = 'user2' then begin UserRoles.Add('role2'); end; if UserName = 'user3' then // all the roles begin UserRoles.Add('role1'); UserRoles.Add('role2'); end; // You can add custom data to the logged user SessionData.AddOrSetValue('customkey1', 'customvalue1'); SessionData.AddOrSetValue('customkey2', 'customvalue2'); end else begin UserRoles.Clear; end; end; procedure THDCDZJWTAuthentication.OnAuthorization (const AContext: TWebContext; UserRoles: TList; const ControllerQualifiedClassName: string; const ActionName: string; var IsAuthorized: Boolean); begin IsAuthorized := False; if ActionName = 'Logout' then IsAuthorized := True; // you can always call logout if ActionName = 'OnlyRole2' then IsAuthorized := UserRoles.Contains('role2'); if ActionName = 'OnlyRole1' then IsAuthorized := UserRoles.Contains('role1'); if ActionName = 'OnlyRole1EmittingJSON' then IsAuthorized := UserRoles.Contains('role1'); end; procedure THDCDZJWTAuthentication.OnRequest (const AContext: TWebContext; const ControllerQualifiedClassName: string; const ActionName: string; var AuthenticationRequired: Boolean); begin AuthenticationRequired := ControllerQualifiedClassName = 'AppControllerU.TAdminController'; end; procedure TWebModule1.WebModuleCreate (Sender: TObject); var LSwagInfo: TMVCSwaggerInfo; LClaimsSetup: TJWTClaimsSetup; swagP: TMVCTransferProtocolSchemes; begin // FEngine := TMVCEngine.Create(self); FEngine := TMVCEngine.Create(self, procedure(AConfig: TMVCConfig) begin // AConfig[TMVCConfigKey.SessionTimeout] := '0'; // session cookie AConfig[TMVCConfigKey.LoadSystemControllers]:= 'false'; AConfig[TMVCConfigKey.ExposeServerSignature] := 'false'; AConfig[TMVCConfigKey.ExposeXPoweredBy] := 'false'; AConfig[TMVCConfigKey.DefaultContentType]:= TMVCMediaType.APPLICATION_JSON; end ); {$IFDEF SEC_ACCESS} // if (jeLoginMod) then { FEngine.AddMiddleware(TMVCBasicAuthenticationMiddleware.Create( TMVCDefaultAuthenticationHandler.New .SetOnAuthentication( procedure(const AUserName, APassword: string; AUserRoles: TList; var IsValid: Boolean; const ASessionData: TDictionary) var lSQL, u, p: string; i: integer; begin // IsValid:= AUserName.Equals('dmvc') and APassword.Equals('123'); IsValid:= false; if (uDataMod.datMod.sqlConn.Connected) then begin i:= 0; u:= AUserName.Replace(' ', '').Replace(';', '').Replace('--', '').Replace(' OR', '').Trim; // sanitizace pro SQL p:= APassword.Replace(' ', '').Replace(';', '').Replace('--', '').Replace(' OR', '').Trim; // sanitizace pro SQL lSQL:= 'DECLARE @id INT; SET @id=ISNULL( (SELECT ID FROM dbo.hdc_DataZone_APIUsers WHERE LoginName=N' + QuotedStr(u); lSQL:= lSQL + ' AND Aktivni=1 AND HashPwd=HASHBYTES(''SHA2_512'', N' + QuotedStr(p) + ')), 0); SELECT @id AS ID' + CRLF; uDataMod.datMod.sqlQry1.Open(lSQL); if (uDataMod.datMod.sqlQry1.RecordCount>0) then i:= uDataMod.datMod.sqlQry1.FieldByName('ID').AsInteger; IsValid:= (i>0); end; end ) )); } {$ENDIF} //{$IFDEF SWAGGER_ON} swagP:= [psHTTP, psHTTPS]; if (uWinService.jeSSL) then swagP:= [psHTTPS]; LSwagInfo.Title:= 'HDC API - dokumentace'; LSwagInfo.Version:= 'v1'; LSwagInfo.Description:= 'Swagger dokumentace konektoru HDC API'; LSwagInfo.ContactName:= 'HD Consulting s.r.o. Strakonice'; LSwagInfo.ContactEmail:= 'info@hdconsulting.cz'; LSwagInfo.ContactUrl:= 'https://www.hdconsulting.cz/#footer'; FEngine.AddMiddleware (TMVCSwaggerMiddleware.Create (FEngine, LSwagInfo, '/api/swagger.json', 'Method for authentication using JSON Web Token (JWT)', false, '', '', '', swagP)); FEngine.AddMiddleware (TMVCStaticFilesMiddleware.Create ( '/swagger', // StaticFilesPath '.\hdcdzapi-swagger', // DocumentRoot 'index.html' // IndexDocument - Before it was named fallbackresource )); //{$ENDIF} FEngine.AddMiddleware (TCORSMiddleware.Create( '*', // TMVCCORSDefaults.ALLOWS_ORIGIN_URL, false, // TMVCCORSDefaults.ALLOWS_CREDENTIALS '*, Content-Security-Policy, Location, Authorization', // TMVCCORSDefaults.EXPOSE_HEADERS, 'Content-Type, origin, Accept', //TMVCCORSDefaults.ALLOWS_HEADERS 'POST,GET,OPTIONS') ); // HTTP Cross-Origin Resource Sharing FEngine.AddMiddleware (TMVCCompressionMiddleware.Create(256)); FEngine.AddMiddleware (TMVCRedirectMiddleware.Create(['/'], '/swagger')); FEngine.AddController (TObecnyController); FEngine.AddController (TAktivitaController); FEngine.AddController (TUkolAktivityController); // FEngine.AddController (TRedirectController); FEngine.AddController (TZamestnanciController); FEngine.AddController (TOrganizaceController); FEngine.AddController (TDokumentController); FEngine.AddController (TPlanKalendarController); FEngine.AddController (TSkupinaZboziController); FEngine.AddController (TKmenZboziController); FEngine.AddController (TStavSkladuController); FEngine.AddController (TDokladOZController); FEngine.AddController (TPolozkaOZController); FEngine.AddController (TTPVKusovnikDilceController); FEngine.AddController (TTPVOperaceDilceController); FEngine.AddController (TTPVPracovisteController); FEngine.AddController (TTPVStrojController); FEngine.AddController (TTPVCisKooperaciController); FEngine.AddController (TTPVCiselnikZmenController); FEngine.AddController (TTPVPrednastaveniOperaciController); FEngine.AddController (TTPVZakazkoveModifikaceController); FEngine.AddController (TTPVZakazkoveModifikaceDilceController); FEngine.AddController (TVyrobniPrikazController); FEngine.AddController (TMaterialPrikazuController); FEngine.AddController (TVyrobniOperaceController); FEngine.AddController (TVyrobaEvidRozpracOperaceController); FEngine.AddController (TVyrobaEvidenceOperaciController); FEngine.AddController (TQMSUdrzbaStrojuAZarizeniController); FEngine.AddController (TQMSObecneController); FEngine.AddController (TQMSKontrolniPlanController); FEngine.AddController (TQMSKontrolniPostupyController); FEngine.AddController (TKooperacniObjednavkaController); // pokud mam povoleno SD Gatema, nesmim mit povoleno Rootvin !!! {$IFDEF CUSTOM_CTRL_Rootvin} FEngine.AddController(TRTNController); // {$I '_custom/Rootvin/uWebModCustom.inc'} {$UNDEF CUSTOM_CTRL_GatemaSD} {$ENDIF} {$IFDEF CUSTOM_CTRL_INCOSystems} {$I '_custom/INCOSystems/uWebModCustom.inc'} {$ENDIF} {$IFDEF CUSTOM_CTRL_GatemaSD} {$I '_custom/GatemaSD/uWebModCustomSDG.inc'} {$ENDIF} {$IFDEF CUSTOM_CTRL_Gornicky} {$I '_custom/Gornicky/uWebModCustom.inc'} {$ENDIF} {$IFDEF CUSTOM_CTRL_Westra} {$I '_custom/Westra/uWebModCustom.inc'} {$ENDIF} {$IFDEF CUSTOM_CTRL_EMPolar} {$I '_custom/EMPolar/uWebModCustom.inc'} {$ENDIF} end; procedure TWebModule1.WebModuleDestroy (Sender: TObject); begin if (FEngine<>nil) then FEngine.Free; end; end.