Files
HDCApi/uWebMod.pas
2026-03-03 16:18:27 +01:00

327 lines
10 KiB
ObjectPascal

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<System.string>; var IsValid: Boolean; const SessionData: TSessionData);
procedure OnAuthorization(const AContext: TWebContext; UserRoles: TList<System.string>;
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<System.string>; 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<System.string>;
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<string>; var IsValid: Boolean; const ASessionData: TDictionary<String, String>)
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.