From 85eef8920f1765c53d66756138376f6d46fd2c0b Mon Sep 17 00:00:00 2001 From: Daniele Teti Date: Sat, 12 Aug 2023 01:24:10 +0200 Subject: [PATCH] Added server side session with file persistence --- samples/session_file_based/AppControllerU.pas | 102 ++ .../FileBasedSessionSample.dpr | 55 ++ .../FileBasedSessionSample.dproj | 899 ++++++++++++++++++ samples/session_file_based/WebModuleUnit1.dfm | 11 + samples/session_file_based/WebModuleUnit1.pas | 44 + sources/MVCFramework.Session.pas | 263 ++++- sources/MVCFramework.pas | 91 +- 7 files changed, 1403 insertions(+), 62 deletions(-) create mode 100644 samples/session_file_based/AppControllerU.pas create mode 100644 samples/session_file_based/FileBasedSessionSample.dpr create mode 100644 samples/session_file_based/FileBasedSessionSample.dproj create mode 100644 samples/session_file_based/WebModuleUnit1.dfm create mode 100644 samples/session_file_based/WebModuleUnit1.pas diff --git a/samples/session_file_based/AppControllerU.pas b/samples/session_file_based/AppControllerU.pas new file mode 100644 index 00000000..bdac9165 --- /dev/null +++ b/samples/session_file_based/AppControllerU.pas @@ -0,0 +1,102 @@ +unit AppControllerU; + +interface + +uses + MVCFramework, + MVCFramework.Commons, + MVCFramework.Logger; + +type + [MVCPath('/')] + TApp1MainController = class(TMVCController) + public + [MVCPath('/name')] + [MVCHTTPMethod([httpGET])] + procedure Index; + + [MVCPath('/list')] + [MVCHTTPMethod([httpGET])] + procedure GetCustomSessionData; + + [MVCPath('/login/($username)')] + [MVCHTTPMethod([httpGET])] + procedure DoLogin(username: String); + + [MVCPath('/fruit/($nameOfFruit)')] + [MVCHTTPMethod([httpGET])] + procedure RegisterFruit(nameOfFruit: String); + + [MVCPath('/logout')] + [MVCHTTPMethod([httpGET])] + procedure DoLogout; + + end; + +implementation + +uses + System.SysUtils, + System.Classes; + +{ TApp1MainController } + +procedure TApp1MainController.DoLogin(username: String); +begin + Session['username'] := username; + ResponseStream + .AppendLine('Logged as ' + username) + .AppendLine + .AppendLine('in address of browser type: ') + .AppendLine('http://localhost:8080/list to check the current values in session ') + .AppendLine('http://localhost:8080/fruit/apple to register apple ') + .AppendLine('http://localhost:8080/fruit/banana to register banana ') + .AppendLine('http://localhost:8080/logout to end session ') + .AppendLine('http://localhost:8080/login/johndoe to login as johndoe'); + RenderResponseStream; +end; + +procedure TApp1MainController.RegisterFruit(nameOfFruit: String); +begin + Session[nameOfFruit] := nameOfFruit; + Redirect('/list'); +end; + +procedure TApp1MainController.DoLogout; +begin + Context.SessionStop(false); + Render('Logout'); +end; + +procedure TApp1MainController.GetCustomSessionData; +var + I: Integer; + lList: TArray; +begin + lList := Session.Keys; + ResponseStream.AppendLine('List of fruits:'); + for I := 0 to Length(lList) - 1 do + begin + ResponseStream.AppendLine(IntToStr(I + 1) + '-' + Session[lList[I]]); + end; + RenderResponseStream; +end; + +procedure TApp1MainController.Index; +begin + ContentType := TMVCMediaType.TEXT_PLAIN; + + // do not create session if not already created + if Context.SessionStarted then + begin + // automaticaly create the session + Render('Session[''username''] = ' + Session['username']); + end + else + begin + Render(400, 'Session not created. Do login first'); + end; +end; + +end. + diff --git a/samples/session_file_based/FileBasedSessionSample.dpr b/samples/session_file_based/FileBasedSessionSample.dpr new file mode 100644 index 00000000..bf342dbd --- /dev/null +++ b/samples/session_file_based/FileBasedSessionSample.dpr @@ -0,0 +1,55 @@ +program FileBasedSessionSample; + +{$APPTYPE CONSOLE} + + +uses + System.SysUtils, + MVCFramework, + MVCFramework.Signal, + {$IFDEF MSWINDOWS} + Winapi.Windows, + Winapi.ShellAPI, + {$ENDIF } + Web.WebReq, + Web.WebBroker, + IdHTTPWebBrokerBridge, + WebModuleUnit1 in 'WebModuleUnit1.pas' {WebModule1: TWebModule}, + AppControllerU in 'AppControllerU.pas'; + +{$R *.res} + + +procedure RunServer(APort: Integer); +var + LServer: TIdHTTPWebBrokerBridge; +begin + Writeln(Format('Starting HTTP Server or port %d', [APort])); + LServer := TIdHTTPWebBrokerBridge.Create(nil); + try + LServer.DefaultPort := APort; + LServer.Active := True; + {$IFDEF MSWINDOWS} + //ShellExecute(0, 'open', PChar('http://localhost:' + IntToStr(APort) + '/login/john'), nil, nil, SW_SHOW); + {$ENDIF} + Writeln('CTRL+C to stop the server'); + WaitForTerminationSignal; + EnterInShutdownState; + finally + LServer.Free; + end; +end; + +begin + ReportMemoryLeaksOnShutdown := True; + try + if WebRequestHandler <> nil then + WebRequestHandler.WebModuleClass := WebModuleClass; + WebRequestHandlerProc.MaxConnections := 1024; + RunServer(8080); + except + on E: Exception do + Writeln(E.ClassName, ': ', E.Message); + end + +end. diff --git a/samples/session_file_based/FileBasedSessionSample.dproj b/samples/session_file_based/FileBasedSessionSample.dproj new file mode 100644 index 00000000..4e9c4a3c --- /dev/null +++ b/samples/session_file_based/FileBasedSessionSample.dproj @@ -0,0 +1,899 @@ + + + {F9CBCE21-869A-478F-992C-88FCAC97BC8B} + 19.5 + VCL + FileBasedSessionSample.dpr + True + Debug + Win32 + 1 + Console + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + $(BDS)\bin\delphi_PROJECTICNS.icns + FileBasedSessionSample + ..\..\sources;..\..\lib\delphistompclient;..\..\lib\loggerpro;..\..\lib\dmustache;$(DCC_UnitSearchPath) + CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= + None + 1040 + $(BDS)\bin\delphi_PROJECTICON.ico + System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) + .\$(Platform)\$(Config) + .\$(Platform)\$(Config) + false + false + false + false + false + + + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + 1033 + cxPivotGridChartRS17;JvMM;dxSkinSevenRS17;dxSkinBlueprintRS17;dxSkinHighContrastRS17;dxSkinOffice2007BlackRS17;dxCoreRS17;cxPageControldxBarPopupMenuRS17;dxSkinXmas2008BlueRS17;dxPSDBTeeChartRS17;JvCrypt;dxPSTeeChartRS17;dxSkinSummer2008RS17;dxPScxSchedulerLnkRS17;dxSkinBlueRS17;dxSkinDarkRoomRS17;DBXInterBaseDriver;DataSnapServer;DataSnapCommon;dxPScxTLLnkRS17;JvNet;JvDotNetCtrls;dxRibbonRS17;DbxCommonDriver;cxDataRS17;vclimg;dxSkinsdxBarPainterRS17;dxPSdxDBTVLnkRS17;dbxcds;DatasnapConnectorsFreePascal;NxDBGridDsgn_dxe3;JvXPCtrls;dxSkinMoneyTwinsRS17;vcldb;cxExportRS17;dxPSCoreRS17;dxBarExtItemsRS17;dxGDIPlusRS17;FMXfrx17;dxNavBarRS17;CustomIPTransport;cxLibraryRS17;cxGridRS17;dxSkinOffice2010BlackRS17;dsnap;IndyIPServer;IndyCore;dxSkinMcSkinRS17;CloudService;dxPScxCommonRS17;FmxTeeUI;frxDB17;AnyDAC_PhysDb2_D17;dxSkinsdxDLPainterRS17;dxSkiniMaginaryRS17;JvDB;JvRuntimeDesign;dxPScxVGridLnkRS17;JclDeveloperTools;dxSkinSevenClassicRS17;dxPScxExtCommonRS17;MyFrameTestPackage;dxPScxSSLnkRS17;NxGridRun_dxe3;dxSkinLilianRS17;fs17;dxPSdxLCLnkRS17;dxSkinOffice2010BlueRS17;NxCommonRun_dxe3;bindcompfmx;DataBindingsVCL170;dxSkinOffice2010SilverRS17;vcldbx;cxSchedulerGridRS17;dbrtl;bindcomp;inetdb;JvPluginSystem;dxBarRS17;DataBindings;DBXOdbcDriver;IcsCommonDXE3Run;JvCmp;dxBarDBNavRS17;dxSkinWhiteprintRS17;JvTimeFramework;xmlrtl;dxSkinsdxRibbonPainterRS17;ibxpress;dxDockingRS17;vclactnband;bindengine;soaprtl;FMXTee;dxADOServerModeRS17;bindcompvcl;dxBarExtDBItemsRS17;dxPSPrVwRibbonRS17;Jcl;vclie;dxSkinOffice2007PinkRS17;cxPageControlRS17;dxSkinscxPCPainterRS17;AnyDAC_PhysADS_D17;AnyDAC_PhysIB_D17;dxmdsRS17;dxSkinTheAsphaltWorldRS17;DBXInformixDriver;Intraweb;dxPsPrVwAdvRS17;NxInspectorRun_dxe3;dxSkinSilverRS17;dxdborRS17;dsnapcon;DBXFirebirdDriver;fsDB17;inet;dorm_runtime_xe3;JvPascalInterpreter;vclx;dxSkinStardustRS17;cxEditorsRS17;DBXSybaseASADriver;NxInspectorDsgn_dxe3;dbexpress;IndyIPClient;AnyDAC_PhysMySQL_D17;cxTreeListdxBarPopupMenuRS17;dxSkinVS2010RS17;NxGridDsgn_dxe3;dxThemeRS17;DBXSqliteDriver;dxPScxGridLnkRS17;fmx;JvDlgs;IndySystem;TeeDB;dxSkinValentineRS17;vclib;inetdbbde;DataSnapClient;dxSkinDevExpressStyleRS17;DataSnapProviderClient;DBXSybaseASEDriver;cxBarEditItemRS17;AnyDAC_PhysMSAcc_D17;dxServerModeRS17;cxPivotGridOLAPRS17;cxSchedulerRS17;MetropolisUILiveTile;AnyDAC_PhysSQLITE_D17;dxPSLnksRS17;dxSkinPumpkinRS17;dxPSdxDBOCLnkRS17;cxVerticalGridRS17;dxSkinSpringTimeRS17;vcldsnap;dxSkinDevExpressDarkStyleRS17;DBXDb2Driver;AnyDAC_ComI_D17;DBXOracleDriver;AnyDAC_PhysMSSQL_D17;JvCore;NxDBGridRun_dxe3;vclribbon;AnyDAC_Comp_D17;cxSpreadSheetRS17;dxSkinLiquidSkyRS17;AnyDAC_PhysODBC_D17;fmxase;vcl;dxSkinOffice2007SilverRS17;AnyDAC_PhysPg_D17;IndyIPCommon;DBXMSSQLDriver;CodeSiteExpressPkg;dxPSdxOCLnkRS17;dcldxSkinsCoreRS17;JvAppFrm;AnyDAC_PhysASA_D17;inetdbxpress;webdsnap;NxCollectionRun_dxe3;AnyDAC_PhysOracle_D17;dxSkinCoffeeRS17;JvDocking;adortl;dxSkinscxSchedulerPainterRS17;JvWizards;NxCollectionDsgn_dxe3;frx17;NxCommonDsgn_dxe3;dxtrmdRS17;dxPScxPCProdRS17;AnyDAC_GUIxForms_D17;JvBands;rtl;DbxClientDriver;AnyDAC_PhysTDBX_D17;dxTabbedMDIRS17;dxComnRS17;dxSkinSharpPlusRS17;dxSkinsCoreRS17;dxSkinLondonLiquidSkyRS17;dxdbtrRS17;Tee;JclContainers;NxAddonsRun_dxe3;CPortLibDXE;JvSystem;dxorgcRS17;svnui;dxSkinBlackRS17;JvControls;NxSheetRun_dxe3;IndyProtocols;DBXMySQLDriver;dxLayoutControlRS17;bindcompdbx;TeeUI;JvJans;JvPrintPreview;JvPageComps;JvStdCtrls;JvCustom;dxSkinOffice2007BlueRS17;dxPScxPivotGridLnkRS17;dxSpellCheckerRS17;vcltouch;dxSkinOffice2007GreenRS17;dxSkinSharpRS17;websnap;dxSkinFoggyRS17;dxTileControlRS17;VclSmp;FMXfrxDB17;dxSkinDarkSideRS17;cxPivotGridRS17;DataSnapConnectors;AnyDAC_Phys_D17;fmxobj;SynEdit_RXE3;JclVcl;cxTreeListRS17;dxPSdxFCLnkRS17;dxSkinGlassOceansRS17;frxe17;svn;dxFlowChartRS17;fmxdae;dxSkinsdxNavBarPainterRS17;bdertl;VirtualTreesR;DataSnapIndy10ServerTransport;dxDBXServerModeRS17;dxSkinCaramelRS17;$(DCC_UsePackage) + + + cxPivotGridChartRS17;JvMM;dxSkinSevenRS17;dxSkinBlueprintRS17;dxSkinHighContrastRS17;dxSkinOffice2007BlackRS17;dxCoreRS17;cxPageControldxBarPopupMenuRS17;dxSkinXmas2008BlueRS17;dxPSDBTeeChartRS17;JvCrypt;dxPSTeeChartRS17;dxSkinSummer2008RS17;dxPScxSchedulerLnkRS17;dxSkinBlueRS17;dxSkinDarkRoomRS17;DBXInterBaseDriver;DataSnapServer;DataSnapCommon;dxPScxTLLnkRS17;JvNet;dxRibbonRS17;DbxCommonDriver;cxDataRS17;vclimg;dxSkinsdxBarPainterRS17;dxPSdxDBTVLnkRS17;dbxcds;DatasnapConnectorsFreePascal;NxDBGridDsgn_dxe3;dxSkinMoneyTwinsRS17;vcldb;cxExportRS17;dxPSCoreRS17;dxBarExtItemsRS17;dxGDIPlusRS17;dxNavBarRS17;CustomIPTransport;cxLibraryRS17;cxGridRS17;dxSkinOffice2010BlackRS17;dsnap;IndyIPServer;IndyCore;dxSkinMcSkinRS17;dxPScxCommonRS17;AnyDAC_PhysDb2_D17;dxSkinsdxDLPainterRS17;dxSkiniMaginaryRS17;JvDB;dxPScxVGridLnkRS17;dxSkinSevenClassicRS17;dxPScxExtCommonRS17;dxPScxSSLnkRS17;NxGridRun_dxe3;dxSkinLilianRS17;dxPSdxLCLnkRS17;dxSkinOffice2010BlueRS17;NxCommonRun_dxe3;bindcompfmx;dxSkinOffice2010SilverRS17;cxSchedulerGridRS17;dbrtl;bindcomp;inetdb;JvPluginSystem;dxBarRS17;DBXOdbcDriver;JvCmp;dxBarDBNavRS17;dxSkinWhiteprintRS17;JvTimeFramework;xmlrtl;dxSkinsdxRibbonPainterRS17;ibxpress;dxDockingRS17;vclactnband;bindengine;soaprtl;dxADOServerModeRS17;bindcompvcl;dxBarExtDBItemsRS17;dxPSPrVwRibbonRS17;vclie;dxSkinOffice2007PinkRS17;cxPageControlRS17;dxSkinscxPCPainterRS17;AnyDAC_PhysADS_D17;AnyDAC_PhysIB_D17;dxmdsRS17;dxSkinTheAsphaltWorldRS17;DBXInformixDriver;dxPsPrVwAdvRS17;NxInspectorRun_dxe3;dxSkinSilverRS17;dxdborRS17;dsnapcon;DBXFirebirdDriver;inet;JvPascalInterpreter;vclx;dxSkinStardustRS17;cxEditorsRS17;DBXSybaseASADriver;NxInspectorDsgn_dxe3;dbexpress;IndyIPClient;AnyDAC_PhysMySQL_D17;cxTreeListdxBarPopupMenuRS17;dxSkinVS2010RS17;NxGridDsgn_dxe3;dxThemeRS17;DBXSqliteDriver;dxPScxGridLnkRS17;fmx;JvDlgs;IndySystem;TeeDB;dxSkinValentineRS17;vclib;DataSnapClient;dxSkinDevExpressStyleRS17;DataSnapProviderClient;DBXSybaseASEDriver;cxBarEditItemRS17;AnyDAC_PhysMSAcc_D17;dxServerModeRS17;cxPivotGridOLAPRS17;cxSchedulerRS17;AnyDAC_PhysSQLITE_D17;dxPSLnksRS17;dxSkinPumpkinRS17;dxPSdxDBOCLnkRS17;cxVerticalGridRS17;dxSkinSpringTimeRS17;vcldsnap;dxSkinDevExpressDarkStyleRS17;DBXDb2Driver;AnyDAC_ComI_D17;DBXOracleDriver;AnyDAC_PhysMSSQL_D17;JvCore;NxDBGridRun_dxe3;AnyDAC_Comp_D17;cxSpreadSheetRS17;dxSkinLiquidSkyRS17;AnyDAC_PhysODBC_D17;fmxase;vcl;dxSkinOffice2007SilverRS17;AnyDAC_PhysPg_D17;IndyIPCommon;DBXMSSQLDriver;dxPSdxOCLnkRS17;dcldxSkinsCoreRS17;JvAppFrm;AnyDAC_PhysASA_D17;inetdbxpress;webdsnap;NxCollectionRun_dxe3;AnyDAC_PhysOracle_D17;dxSkinCoffeeRS17;adortl;dxSkinscxSchedulerPainterRS17;JvWizards;NxCollectionDsgn_dxe3;NxCommonDsgn_dxe3;dxtrmdRS17;dxPScxPCProdRS17;AnyDAC_GUIxForms_D17;JvBands;rtl;DbxClientDriver;AnyDAC_PhysTDBX_D17;dxTabbedMDIRS17;dxComnRS17;dxSkinSharpPlusRS17;dxSkinsCoreRS17;dxSkinLondonLiquidSkyRS17;dxdbtrRS17;Tee;NxAddonsRun_dxe3;JvSystem;dxorgcRS17;dxSkinBlackRS17;JvControls;NxSheetRun_dxe3;IndyProtocols;DBXMySQLDriver;dxLayoutControlRS17;bindcompdbx;TeeUI;JvJans;JvPrintPreview;JvPageComps;JvStdCtrls;JvCustom;dxSkinOffice2007BlueRS17;dxPScxPivotGridLnkRS17;dxSpellCheckerRS17;vcltouch;dxSkinOffice2007GreenRS17;dxSkinSharpRS17;websnap;dxSkinFoggyRS17;dxTileControlRS17;VclSmp;dxSkinDarkSideRS17;cxPivotGridRS17;DataSnapConnectors;AnyDAC_Phys_D17;fmxobj;SynEdit_RXE3;cxTreeListRS17;dxPSdxFCLnkRS17;dxSkinGlassOceansRS17;dxFlowChartRS17;fmxdae;dxSkinsdxNavBarPainterRS17;DataSnapIndy10ServerTransport;dxDBXServerModeRS17;dxSkinCaramelRS17;$(DCC_UsePackage) + + + DEBUG;$(DCC_Define) + true + false + true + true + true + + + 3 + true + 1033 + false + + + false + RELEASE;$(DCC_Define) + 0 + 0 + + + + MainSource + + +
WebModule1
+ TWebModule + + + + Base + + + Cfg_1 + Base + + + Cfg_2 + Base + + + + Delphi.Personality.12 + + + + + False + False + 1 + 0 + 0 + 0 + False + False + False + False + False + 1040 + 1252 + + + + + 1.0.0.0 + + + + + + 1.0.0.0 + + + + + + + + + + + + FileBasedSessionSample.dpr + + + Microsoft Office 2000 Beispiele für gekapselte Komponenten für Automatisierungsserver + Microsoft Office XP Beispiele für gekapselte Komponenten für Automation Server + + + + + + FileBasedSessionSample.exe + true + + + + + + 1 + + + 0 + + + + + classes + 64 + + + classes + 64 + + + + + res\xml + 1 + + + res\xml + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + library\lib\armeabi + 1 + + + library\lib\armeabi + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + library\lib\mips + 1 + + + library\lib\mips + 1 + + + + + library\lib\armeabi-v7a + 1 + + + library\lib\arm64-v8a + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\values-v21 + 1 + + + res\values-v21 + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-xxhdpi + 1 + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + + + + res\drawable-ldpi + 1 + + + res\drawable-ldpi + 1 + + + + + res\drawable-mdpi + 1 + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + res\drawable-xhdpi + 1 + + + + + res\drawable-mdpi + 1 + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + res\drawable-xhdpi + 1 + + + + + res\drawable-xxhdpi + 1 + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + + + + res\drawable-small + 1 + + + res\drawable-small + 1 + + + + + res\drawable-normal + 1 + + + res\drawable-normal + 1 + + + + + res\drawable-large + 1 + + + res\drawable-large + 1 + + + + + res\drawable-xlarge + 1 + + + res\drawable-xlarge + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + 1 + + + 1 + + + 0 + + + + + 1 + .framework + + + 1 + .framework + + + 1 + .framework + + + 0 + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + 0 + .dll;.bpl + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + 0 + .bpl + + + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + + + 1 + + + 1 + + + + + + + + Contents\Resources + 1 + + + Contents\Resources + 1 + + + Contents\Resources + 1 + + + + + library\lib\armeabi-v7a + 1 + + + library\lib\arm64-v8a + 1 + + + 1 + + + 1 + + + 1 + + + 1 + + + 1 + + + 1 + + + 1 + + + 0 + + + + + library\lib\armeabi-v7a + 1 + + + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + + + + 1 + + + 1 + + + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + + + + + + + + + + + + + True + False + + + 12 + + + + + diff --git a/samples/session_file_based/WebModuleUnit1.dfm b/samples/session_file_based/WebModuleUnit1.dfm new file mode 100644 index 00000000..2c58d387 --- /dev/null +++ b/samples/session_file_based/WebModuleUnit1.dfm @@ -0,0 +1,11 @@ +object WebModule1: TWebModule1 + OnCreate = WebModuleCreate + Actions = < + item + Default = True + Name = 'DefaultHandler' + PathInfo = '/' + end> + Height = 230 + Width = 415 +end diff --git a/samples/session_file_based/WebModuleUnit1.pas b/samples/session_file_based/WebModuleUnit1.pas new file mode 100644 index 00000000..b7d8a556 --- /dev/null +++ b/samples/session_file_based/WebModuleUnit1.pas @@ -0,0 +1,44 @@ +unit WebModuleUnit1; + +interface + +uses + System.SysUtils, + System.Classes, + Web.HTTPApp, + MVCFramework; + +type + TWebModule1 = class(TWebModule) + procedure WebModuleCreate(Sender: TObject); + + private + MVC: TMVCEngine; + + public + { Public declarations } + end; + +var + WebModuleClass: TComponentClass = TWebModule1; + +implementation + +{$R *.dfm} + + +uses AppControllerU, MVCFramework.Commons; + +procedure TWebModule1.WebModuleCreate(Sender: TObject); +begin + MVC := TMVCEngine.Create(Self, + procedure(Config: TMVCConfig) + begin + Config[TMVCConfigKey.SessionTimeout] := '10'; // 10minutes + Config[TMVCConfigKey.DefaultContentType] := 'text/plain'; + Config[TMVCConfigKey.SessionType] := 'file'; + end); + MVC.AddController(TApp1MainController); +end; + +end. diff --git a/sources/MVCFramework.Session.pas b/sources/MVCFramework.Session.pas index 18cbc8f7..075afca7 100644 --- a/sources/MVCFramework.Session.pas +++ b/sources/MVCFramework.Session.pas @@ -32,15 +32,18 @@ uses System.SyncObjs, System.SysUtils, System.DateUtils, - System.Generics.Collections; + System.Generics.Collections, MVCFramework.Commons; const - DEFAULT_SESSION_INACTIVITY = 60; // in minutes type + EMVCSession = class(EMVCException) - TWebSession = class abstract + end; + + + TMVCWebSession = class abstract private FSessionId: string; FLastAccess: TDateTime; @@ -48,22 +51,25 @@ type protected function GetItems(const AKey: string): string; virtual; abstract; procedure SetItems(const AKey, AValue: string); virtual; abstract; + procedure SetLastAccess(Value: TDateTime); public constructor Create(const ASessionId: string; const ATimeout: UInt64); virtual; destructor Destroy; override; procedure MarkAsUsed; virtual; function ToString: string; override; function IsExpired: Boolean; virtual; - + function Keys: TArray; virtual; abstract; + class function TryFindSessionID(const ASessionID: String): Boolean; virtual; + class procedure TryDeleteSessionID(const ASessionID: String); virtual; property Items[const AKey: string]: string read GetItems write SetItems; default; property SessionId: string read FSessionId; property LastAccess: TDateTime read FLastAccess; property Timeout: UInt64 read FTimeout; end; - TWebSessionClass = class of TWebSession; + TMVCWebSessionClass = class of TMVCWebSession; - TWebSessionMemory = class(TWebSession) + TMVCWebSessionMemory = class(TMVCWebSession) private FData: TDictionary; protected @@ -72,37 +78,61 @@ type public constructor Create(const ASessionId: string; const ATimeout: UInt64); override; destructor Destroy; override; - function ToString: string; override; - property Data: TDictionary read FData; end; + + TMVCWebSessionFile = class(TMVCWebSessionMemory) + private + fSessionFolder: String; + protected + procedure StartLoading; + procedure EndLoading; + function GetFileName: String; overload; + class function GetFileName(const SessionFolder, SessionID: String): String; overload; + procedure LoadFromFile; + procedure SaveToFile; + procedure OnValueNotify(Sender: TObject; const Item: String; Action: TCollectionNotification); + public + constructor Create(const SessionID: string; const Timeout: UInt64); override; + destructor Destroy; override; + function Keys: System.TArray; override; + class function TryFindSessionID(const ASessionID: String): Boolean; override; + class procedure TryDeleteSessionID(const ASessionID: String); override; + end; + TMVCSessionFactory = class sealed private - FRegisteredSessionTypes: TDictionary; + FRegisteredSessionTypes: TDictionary; protected class var cInstance: TMVCSessionFactory; constructor Create; public destructor Destroy; override; - procedure RegisterSessionType(const AName: string; AWebSessionClass: TWebSessionClass); - function CreateNewByType(const AName, ASessionId: string; const ATimeout: UInt64): TWebSession; - + procedure RegisterSessionType(const AName: string; AWebSessionClass: TMVCWebSessionClass); + function CreateNewByType(const AName, ASessionId: string; const ATimeout: UInt64): TMVCWebSession; + function TryFindSessionID(const AName: string; const ASessionID: String): Boolean; + procedure TryDeleteSessionID(const AName: string; const ASessionID: String); class function GetInstance: TMVCSessionFactory; static; // class procedure DestroyInstance; static; end; -function GlobalSessionList: TObjectDictionary; +function GlobalSessionList: TObjectDictionary; implementation +uses + System.IOUtils, + System.Classes, + MVCFramework.Serializer.Commons; + var - GlSessionList: TObjectDictionary = nil; + GlSessionList: TObjectDictionary = nil; GlLastSessionListClear: TDateTime; GlCriticalSection: TCriticalSection; -function GlobalSessionList: TObjectDictionary; +function GlobalSessionList: TObjectDictionary; var S: string; begin @@ -111,7 +141,9 @@ begin GlCriticalSection.Enter; try if not Assigned(GlSessionList) then - GlSessionList := TObjectDictionary.Create([doOwnsValues]); + begin + GlSessionList := TObjectDictionary.Create([doOwnsValues]); + end; finally GlCriticalSection.Leave; end; @@ -122,7 +154,7 @@ begin TMonitor.Enter(GlSessionList); try for S in GlSessionList.Keys do - if TWebSession(GlSessionList.Items[S]).IsExpired then + if TMVCWebSession(GlSessionList.Items[S]).IsExpired then GlSessionList.Remove(S); GlLastSessionListClear := Now; finally @@ -135,19 +167,19 @@ end; { TWebSession } -constructor TWebSession.Create(const ASessionId: string; const ATimeout: UInt64); +constructor TMVCWebSession.Create(const ASessionId: string; const ATimeout: UInt64); begin inherited Create; FSessionId := ASessionId; FTimeout := ATimeout; end; -destructor TWebSession.Destroy; +destructor TMVCWebSession.Destroy; begin inherited Destroy; end; -function TWebSession.IsExpired: Boolean; +function TMVCWebSession.IsExpired: Boolean; begin if (FTimeout = 0) then Result := MinutesBetween(Now, LastAccess) > DEFAULT_SESSION_INACTIVITY @@ -155,31 +187,46 @@ begin Result := MinutesBetween(Now, LastAccess) > FTimeout; end; -procedure TWebSession.MarkAsUsed; +procedure TMVCWebSession.MarkAsUsed; begin FLastAccess := Now; end; -function TWebSession.ToString: string; +procedure TMVCWebSession.SetLastAccess(Value: TDateTime); +begin + FLastAccess := Value; +end; + +function TMVCWebSession.ToString: string; begin Result := ''; end; +class procedure TMVCWebSession.TryDeleteSessionID(const ASessionID: String); +begin + //do nothing +end; + +class function TMVCWebSession.TryFindSessionID(const ASessionID: String): Boolean; +begin + Result := False; +end; + { TWebSessionMemory } -constructor TWebSessionMemory.Create(const ASessionId: string; const ATimeout: UInt64); +constructor TMVCWebSessionMemory.Create(const ASessionId: string; const ATimeout: UInt64); begin inherited Create(ASessionId, ATimeout); FData := TDictionary.Create; end; -destructor TWebSessionMemory.Destroy; +destructor TMVCWebSessionMemory.Destroy; begin FData.Free; inherited Destroy; end; -function TWebSessionMemory.GetItems(const AKey: string): string; +function TMVCWebSessionMemory.GetItems(const AKey: string): string; begin TMonitor.Enter(Self); try @@ -190,7 +237,7 @@ begin end; end; -procedure TWebSessionMemory.SetItems(const AKey, AValue: string); +procedure TMVCWebSessionMemory.SetItems(const AKey, AValue: string); begin TMonitor.Enter(Self); try @@ -200,7 +247,7 @@ begin end; end; -function TWebSessionMemory.ToString: string; +function TMVCWebSessionMemory.ToString: string; var LKey: string; begin @@ -214,15 +261,15 @@ end; constructor TMVCSessionFactory.Create; begin inherited Create; - FRegisteredSessionTypes := TDictionary.Create; + FRegisteredSessionTypes := TDictionary.Create; end; -function TMVCSessionFactory.CreateNewByType(const AName, ASessionId: string; const ATimeout: UInt64): TWebSession; +function TMVCSessionFactory.CreateNewByType(const AName, ASessionId: string; const ATimeout: UInt64): TMVCWebSession; var - Clazz: TWebSessionClass; + Clazz: TMVCWebSessionClass; begin if not FRegisteredSessionTypes.TryGetValue(AName, Clazz) then - raise Exception.Create('Unknown application session type'); + raise EMVCSession.Create('Unknown application session type: ' + AName); Result := Clazz.Create(ASessionId, ATimeout); end; @@ -241,14 +288,164 @@ begin Result := cInstance; end; -procedure TMVCSessionFactory.RegisterSessionType(const AName: string; AWebSessionClass: TWebSessionClass); +procedure TMVCSessionFactory.RegisterSessionType(const AName: string; AWebSessionClass: TMVCWebSessionClass); begin FRegisteredSessionTypes.AddOrSetValue(AName, AWebSessionClass); end; +procedure TMVCSessionFactory.TryDeleteSessionID(const AName, ASessionID: String); +var + Clazz: TMVCWebSessionClass; +begin + if not FRegisteredSessionTypes.TryGetValue(AName, Clazz) then + raise EMVCSession.Create('Unknown application session type: ' + AName); + Clazz.TryDeleteSessionID(ASessionID); +end; + +function TMVCSessionFactory.TryFindSessionID(const AName: string; const ASessionID: String): Boolean; +var + Clazz: TMVCWebSessionClass; +begin + if not FRegisteredSessionTypes.TryGetValue(AName, Clazz) then + raise EMVCSession.Create('Unknown application session type: ' + AName); + Result := Clazz.TryFindSessionID(ASessionID); +end; + +{ TWebSessionMemoryController } + +constructor TMVCWebSessionFile.Create(const SessionID: string; const Timeout: UInt64); +begin + inherited Create(SessionID, Timeout); + Data.OnValueNotify := OnValueNotify; + fSessionFolder := TPath.Combine(AppPath, 'sessions'); + TDirectory.CreateDirectory(fSessionFolder); + LoadFromFile; + MarkAsUsed; + SaveToFile; +end; + +destructor TMVCWebSessionFile.Destroy; +begin + inherited; +end; + +procedure TMVCWebSessionFile.EndLoading; +begin + Data.OnValueNotify := OnValueNotify; +end; + +class function TMVCWebSessionFile.GetFileName(const SessionFolder, + SessionID: String): String; +begin + Result := TPath.Combine(SessionFolder, SessionId); +end; + +function TMVCWebSessionFile.GetFileName: String; +begin + Result := GetFileName(fSessionFolder, SessionId); +end; + +function TMVCWebSessionFile.Keys: System.TArray; +begin + Result := Data.Keys.ToArray; +end; + +procedure TMVCWebSessionFile.LoadFromFile; +var + lFileName: String; + lFile: TStreamReader; + lLine: string; + lPieces: TArray; +begin + lFileName := GetFileName; + if not TFile.Exists(lFileName) then + begin + Exit; + end; + //Log.Info('Loading session %s from %s', [SessionId, lFileName], 'file_session_events'); + lFile := TFile.OpenText(lFileName); + try + StartLoading; + try + SetLastAccess(ISOTimeStampToDateTime(lFile.ReadLine)); + while not lFile.EndOfStream do + begin + lLine := lFile.ReadLine; + lPieces := lLine.Split(['=']); + Data.Add(lPieces[0], lPieces[1]); + end; + finally + EndLoading; + end; + finally + lFile.Free; + end; +end; + +procedure TMVCWebSessionFile.OnValueNotify(Sender: TObject; const Item: String; + Action: TCollectionNotification); +begin + if Action in [cnAdded, cnExtracted, cnRemoved] then + begin + //Log.Info('Saving session %s because item changed [%s]', [SessionId, Item], 'file_session_events'); + SaveToFile; + end; +end; + +procedure TMVCWebSessionFile.SaveToFile; +var + lFileName: String; + lPair: TPair; + lFile: TStreamWriter; +begin + MarkAsUsed; + lFileName := GetFileName; + lFile := TFile.CreateText(lFileName); + try + lFile.WriteLine(DateTimeToISOTimeStamp(LastAccess)); + for lPair in Data do + begin + lFile.WriteLine(String.Join('=', [lPair.Key, lPair.Value])); + end; + lFile.Close; + finally + lFile.Free; + end; +end; + +procedure TMVCWebSessionFile.StartLoading; +begin + Data.OnValueNotify := nil; +end; + +class procedure TMVCWebSessionFile.TryDeleteSessionID(const ASessionID: String); +var + lSessionFolder: string; +begin + inherited; + lSessionFolder := TPath.Combine(AppPath, 'sessions'); + if TFile.Exists(GetFileName(lSessionFolder, ASessionID)) then + begin + TFile.Delete(GetFileName(lSessionFolder, ASessionID)); + end; +end; + +class function TMVCWebSessionFile.TryFindSessionID( + const ASessionID: String): Boolean; +var + lSessionFolder: string; +begin + inherited; + lSessionFolder := TPath.Combine(AppPath, 'sessions'); + Result := TFile.Exists(GetFileName(lSessionFolder, ASessionID)); +end; + + initialization -TMVCSessionFactory.GetInstance.RegisterSessionType('memory', TWebSessionMemory); +TMVCSessionFactory.GetInstance.RegisterSessionType('memory', TMVCWebSessionMemory); +TMVCSessionFactory.GetInstance.RegisterSessionType('file', TMVCWebSessionFile); + GlCriticalSection := TCriticalSection.Create; finalization diff --git a/sources/MVCFramework.pas b/sources/MVCFramework.pas index 1abe66bd..da2a2c1f 100644 --- a/sources/MVCFramework.pas +++ b/sources/MVCFramework.pas @@ -505,8 +505,8 @@ type function IsValid: Boolean; procedure Clear; - procedure SaveToSession(const AWebSession: TWebSession); - function LoadFromSession(const AWebSession: TWebSession): Boolean; + procedure SaveToSession(const AWebSession: TMVCWebSession); + function LoadFromSession(const AWebSession: TMVCWebSession): Boolean; property UserName: string read FUserName write FUserName; property Roles: TList read FRoles; @@ -524,10 +524,10 @@ type FIsSessionStarted: Boolean; FSessionMustBeClose: Boolean; FLoggedUser: TUser; - FWebSession: TWebSession; + FWebSession: TMVCWebSession; FData: TMVCStringDictionary; fIntfObject: IInterface; - function GetWebSession: TWebSession; + function GetWebSession: TMVCWebSession; function GetLoggedUser: TUser; function GetParamsTable: TMVCRequestParamsTable; procedure SetParamsTable(const AValue: TMVCRequestParamsTable); @@ -540,14 +540,14 @@ type procedure BindToSession(const ASessionId: string); function SendSessionCookie(const AContext: TWebContext): string; function AddSessionToTheSessionList(const ASessionType, ASessionId: string; - const ASessionTimeout: Integer): TWebSession; + const ASessionTimeout: Integer): TMVCWebSession; function GetData: TMVCStringDictionary; public constructor Create(const ARequest: TWebRequest; const AResponse: TWebResponse; const AConfig: TMVCConfig; const ASerializers: TDictionary); destructor Destroy; override; - procedure SessionStart; virtual; + procedure SessionStart(const SessionType: String); virtual; procedure SessionStop(const ARaiseExceptionIfExpired: Boolean = True); virtual; function SessionStarted: Boolean; @@ -559,7 +559,7 @@ type property LoggedUser: TUser read GetLoggedUser; property Request: TMVCWebRequest read FRequest; property Response: TMVCWebResponse read FResponse; - property Session: TWebSession read GetWebSession; + property Session: TMVCWebSession read GetWebSession; property Config: TMVCConfig read FConfig; property Data: TMVCStringDictionary read GetData; property CustomIntfObject: IInterface read GetIntfObject write SetIntfObject; @@ -776,7 +776,7 @@ type private FViewModel: TMVCViewDataObject; FViewDataSets: TMVCViewDataSet; - function GetSession: TWebSession; + function GetSession: TMVCWebSession; function GetViewData(const aModelName: string): TObject; function GetViewDataset(const aDataSetName: string): TDataSet; procedure SetViewData(const aModelName: string; const Value: TObject); @@ -812,7 +812,7 @@ type /// procedure LoadViewFragment(const AViewFragment: string); - function SessionAs: T; + function SessionAs: T; procedure RaiseSessionExpired; virtual; // Avoiding mid-air collisions - support @@ -823,7 +823,7 @@ type // Properties property Context: TWebContext read GetContext write FContext; - property Session: TWebSession read GetSession; + property Session: TMVCWebSession read GetSession; property ContentType: string read GetContentType write SetContentType; property StatusCode: Integer read GetStatusCode write SetStatusCode; procedure PushObjectToView(const aModelName: string; const AModel: TObject); @@ -985,7 +985,7 @@ type const AResponse: TWebResponse): Boolean; virtual; public class function GetCurrentSession(const ASessionId: string; - const ARaiseExceptionIfExpired: Boolean = True): TWebSession; static; + const ARaiseExceptionIfExpired: Boolean = True): TMVCWebSession; static; class function ExtractSessionIdFromWebRequest(const AWebRequest: TWebRequest): string; static; class function SendSessionCookie(const AContext: TWebContext): string; overload; static; class function SendSessionCookie(const AContext: TWebContext; const ASessionId: string): string; @@ -996,7 +996,7 @@ type const ACustomLogger: ILogWriter = nil); reintroduce; destructor Destroy; override; - function GetSessionBySessionId(const ASessionId: string): TWebSession; + function GetSessionBySessionId(const ASessionId: string): TMVCWebSession; { webcontext events} procedure OnWebContextCreate(const WebContextCreateEvent: TWebContextCreateEvent); @@ -1916,7 +1916,7 @@ begin Result := (not UserName.IsEmpty) and (LoggedSince > 0); end; -function TUser.LoadFromSession(const AWebSession: TWebSession): Boolean; +function TUser.LoadFromSession(const AWebSession: TMVCWebSession): Boolean; var SerObj: string; Pieces: TArray; @@ -1940,7 +1940,7 @@ begin end; end; -procedure TUser.SaveToSession(const AWebSession: TWebSession); +procedure TUser.SaveToSession(const AWebSession: TMVCWebSession); var LRoles: string; begin @@ -1968,9 +1968,9 @@ end; { TWebContext } function TWebContext.AddSessionToTheSessionList(const ASessionType, ASessionId: string; - const ASessionTimeout: Integer): TWebSession; + const ASessionTimeout: Integer): TMVCWebSession; var - Session: TWebSession; + Session: TMVCWebSession; begin if (Trim(ASessionType) = EmptyStr) then raise EMVCException.Create('Empty Session Type'); @@ -2142,16 +2142,35 @@ begin Result := FRequest.ParamsTable; end; -function TWebContext.GetWebSession: TWebSession; +function TWebContext.GetWebSession: TMVCWebSession; +var + lSessionIDFromRequest: string; + lSessionType: String; begin if not Assigned(FWebSession) then begin - FWebSession := TMVCEngine.GetCurrentSession( - TMVCEngine.ExtractSessionIdFromWebRequest(FRequest.RawWebRequest), False); + lSessionIDFromRequest := TMVCEngine.ExtractSessionIdFromWebRequest(FRequest.RawWebRequest); + FWebSession := TMVCEngine.GetCurrentSession(lSessionIDFromRequest, False); if not Assigned(FWebSession) then - SessionStart + begin + lSessionType := Config[TMVCConfigKey.SessionType]; + if not TMVCSessionFactory.GetInstance.TryFindSessionID(lSessionType, lSessionIDFromRequest) then + begin + SessionStart(lSessionType); + end + else + begin + FWebSession := AddSessionToTheSessionList( + lSessionType, + lSessionIDFromRequest, + StrToInt(Config[TMVCConfigKey.SessionTimeout])); + TMVCEngine.SendSessionCookie(Self, FWebSession.SessionId); + end; + end else + begin TMVCEngine.SendSessionCookie(Self, FWebSession.SessionId); + end; end; Result := FWebSession; Result.MarkAsUsed; @@ -2179,14 +2198,14 @@ begin Result := FSessionMustBeClose; end; -procedure TWebContext.SessionStart; +procedure TWebContext.SessionStart(const SessionType: String); var ID: string; begin if not Assigned(FWebSession) then begin ID := TMVCEngine.SendSessionCookie(Self); - FWebSession := AddSessionToTheSessionList(Config[TMVCConfigKey.SessionType], ID, + FWebSession := AddSessionToTheSessionList(SessionType, ID, StrToInt64(Config[TMVCConfigKey.SessionTimeout])); FIsSessionStarted := True; FSessionMustBeClose := False; @@ -2229,10 +2248,20 @@ begin begin raise EMVCSessionExpiredException.Create('Session not started'); end; + GlobalSessionList.Remove(SId); + if SId <> '' then begin FWebSession := nil; + try + TMVCSessionFactory.GetInstance.TryDeleteSessionID(Config[TMVCConfigKey.SessionType], SId); + except + on E: Exception do + begin + LogException(E, 'Cannot delete session file for sessionid: ' + SId); + end; + end; end; finally TMonitor.Exit(GlobalSessionList); @@ -3093,8 +3122,8 @@ begin end; end; -class function TMVCEngine.GetCurrentSession(const ASessionId: string; const ARaiseExceptionIfExpired: Boolean): TWebSession; -var lSessionList: TObjectDictionary; +class function TMVCEngine.GetCurrentSession(const ASessionId: string; const ARaiseExceptionIfExpired: Boolean): TMVCWebSession; +var lSessionList: TObjectDictionary; begin Result := nil; lSessionList := GlobalSessionList; @@ -3128,7 +3157,7 @@ begin end; end; -function TMVCEngine.GetSessionBySessionId(const ASessionId: string): TWebSession; +function TMVCEngine.GetSessionBySessionId(const ASessionId: string): TMVCWebSession; begin Result := TMVCEngine.GetCurrentSession(ASessionId, False); if Assigned(Result) then @@ -3340,10 +3369,14 @@ begin end; class function TMVCEngine.SendSessionCookie(const AContext: TWebContext): string; -var SId: string; +var + SId: string; begin - SId := StringReplace(StringReplace(StringReplace('DT' + GUIDToString(TGUID.NewGuid), '}', '', []), - '{', '', []), '-', '', [rfReplaceAll]); + SId := StringReplace(StringReplace(StringReplace( + 'DT' + GUIDToString(TGUID.NewGuid) + GUIDToString(TGUID.NewGuid), + '}', '', [rfReplaceAll]), + '{', '', [rfReplaceAll]), + '-', '', [rfReplaceAll]); Result := SendSessionCookie(AContext, SId); end; @@ -3621,7 +3654,7 @@ begin Result := Context.Request.GetHeader('If-Match'); end; -function TMVCController.GetSession: TWebSession; +function TMVCController.GetSession: TMVCWebSession; begin Result := GetContext.Session; end;