1206 lines
51 KiB
ObjectPascal
1206 lines
51 KiB
ObjectPascal
/// shared DDD Infrastructure: Application/Daemon settings classes
|
|
// - this unit is a part of the freeware Synopse mORMot framework,
|
|
// licensed under a MPL/GPL/LGPL tri-license; version 1.18
|
|
unit dddInfraSettings;
|
|
|
|
{
|
|
This file is part of Synopse mORMot framework.
|
|
|
|
Synopse mORMot framework. Copyright (C) 2022 Arnaud Bouchez
|
|
Synopse Informatique - https://synopse.info
|
|
|
|
*** BEGIN LICENSE BLOCK *****
|
|
Version: MPL 1.1/GPL 2.0/LGPL 2.1
|
|
|
|
The contents of this file are subject to the Mozilla Public License Version
|
|
1.1 (the "License"); you may not use this file except in compliance with
|
|
the License. You may obtain a copy of the License at
|
|
http://www.mozilla.org/MPL
|
|
|
|
Software distributed under the License is distributed on an "AS IS" basis,
|
|
WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
|
|
for the specific language governing rights and limitations under the License.
|
|
|
|
The Original Code is Synopse mORMot framework.
|
|
|
|
The Initial Developer of the Original Code is Arnaud Bouchez.
|
|
|
|
Portions created by the Initial Developer are Copyright (C) 2022
|
|
the Initial Developer. All Rights Reserved.
|
|
|
|
Contributor(s):
|
|
|
|
|
|
Alternatively, the contents of this file may be used under the terms of
|
|
either the GNU General Public License Version 2 or later (the "GPL"), or
|
|
the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
|
|
in which case the provisions of the GPL or the LGPL are applicable instead
|
|
of those above. If you wish to allow use of your version of this file only
|
|
under the terms of either the GPL or the LGPL, and not to allow others to
|
|
use your version of this file under the terms of the MPL, indicate your
|
|
decision by deleting the provisions above and replace them with the notice
|
|
and other provisions required by the GPL or the LGPL. If you do not delete
|
|
the provisions above, a recipient may use your version of this file under
|
|
the terms of any one of the MPL, the GPL or the LGPL.
|
|
|
|
***** END LICENSE BLOCK *****
|
|
|
|
TODO:
|
|
- store settings in database, or in a centralized service?
|
|
|
|
}
|
|
|
|
{$I Synopse.inc} // define HASINLINE DDDNOSYNDB DDDNOMONGODB WITHLOG
|
|
|
|
{.$define DDDNOSYNDB}
|
|
// if defined, SynDB / external SQL DB won't be linked to the executable
|
|
{.$define DDDNOMONGODB}
|
|
// if defined, the Mongo DB client won't be linked to the executable
|
|
|
|
interface
|
|
|
|
uses
|
|
{$ifdef MSWINDOWS}
|
|
Windows, // for DeleteFile() inlining under Delphi 2006/2007
|
|
{$endif}
|
|
SysUtils,
|
|
Classes,
|
|
SynCommons,
|
|
SynTable,
|
|
SynLog,
|
|
SynCrypto,
|
|
mORMot,
|
|
mORMotDDD,
|
|
SynCrtSock,
|
|
SynSQLite3,
|
|
mORMotSQLite3, // for internal SQlite3 database
|
|
{$ifndef DDDNOSYNDB}
|
|
SynDB,
|
|
mORMotDB, // for TDDDRestSettings on external SQL database
|
|
{$endif}
|
|
{$ifndef DDDNOMONGODB}
|
|
SynMongoDB,
|
|
mORMotMongoDB, // for TDDDRestSettings on external NoSQL database
|
|
{$endif}
|
|
mORMotWrappers; // for TDDDRestSettings to publish wrapper methods
|
|
|
|
|
|
{ ----- Manage Service/Daemon settings }
|
|
|
|
type
|
|
/// settings used to define how logging take place
|
|
// - will map the most used TSynLogFamily parameters
|
|
TDDDLogSettings = class(TSynPersistent)
|
|
protected
|
|
fLevels: TSynLogInfos;
|
|
fConsoleLevels: TSynLogInfos;
|
|
fAutoFlush: integer;
|
|
fStackTraceViaAPI: boolean;
|
|
fLowLevelWebSocketsFrames: boolean;
|
|
fDestinationPath: TFileName;
|
|
fCustomFileName: TFileName;
|
|
fRotateFileCount: cardinal;
|
|
fRotateFileSize: cardinal;
|
|
fRotateFileAtHour: integer;
|
|
fSyslogLevels: TSynLogInfos;
|
|
fSyslogFacility: TSyslogFacility;
|
|
fSyslogServer: RawUTF8;
|
|
public
|
|
/// initialize the settings to their (TSynLogFamily) default values
|
|
constructor Create; override;
|
|
published
|
|
/// the log levels to be used for the log file
|
|
// - i.e. a combination of none or several logging event
|
|
// - if "*" is serialized, unneeded sllNone won't be part of the set
|
|
property Levels: TSynLogInfos read fLevels write fLevels;
|
|
/// the optional log levels to be used for the console
|
|
// - by default, only errors would be logged to the console
|
|
// - you can specify here another set of levels, e.g. '*' for a verbose
|
|
// console output - note that console is very slow to write, so usually
|
|
// you should better not set a verbose definition here, unless you are
|
|
// in debugging mode
|
|
property ConsoleLevels: TSynLogInfos read fConsoleLevels write fConsoleLevels;
|
|
/// if low-level WebSockets frames should be logged
|
|
// - disabled by default, to minimize logged content
|
|
// - may be enabled to monitor most (asynchronous) activity, especially
|
|
// in background threads
|
|
property LowLevelWebSocketsFrames: boolean read fLowLevelWebSocketsFrames write fLowLevelWebSocketsFrames;
|
|
/// the time (in seconds) after which the log content must be written on
|
|
// disk, whatever the current content size is
|
|
// - by default, the log file will be written for every 4 KB of log (see
|
|
// TSynLogFamily.BufferSize property) - this will ensure that the main
|
|
// application won't be slow down by logging
|
|
// - in order not to loose any log, a background thread can be created
|
|
// and will be responsible of flushing all pending log content every
|
|
// period of time (e.g. every 10 seconds)
|
|
property AutoFlushTimeOut: integer read fAutoFlush write fAutoFlush;
|
|
/// by default (false), logging will use manual stack trace browsing
|
|
// - if you experiment unexpected EAccessViolation, try to set this setting
|
|
// to TRUE so that the RtlCaptureStackBackTrace() API would be used instead
|
|
property StackTraceViaAPI: boolean read FStackTraceViaAPI write FStackTraceViaAPI;
|
|
/// allows to customize where the log files will be stored
|
|
property DestinationPath: TFileName read FDestinationPath write FDestinationPath;
|
|
/// allows to customize the log file name
|
|
property CustomFileName: TFileName read fCustomFileName write fCustomFileName;
|
|
/// auto-rotation of logging files
|
|
// - set to 0 by default, meaning no rotation
|
|
property RotateFileCount: cardinal read fRotateFileCount write fRotateFileCount;
|
|
/// maximum size of auto-rotated logging files, in kilo-bytes (per 1024 bytes)
|
|
property RotateFileSizeKB: cardinal read fRotateFileSize write fRotateFileSize;
|
|
/// fixed hour of the day where logging files rotation should be performed
|
|
property RotateFileDailyAtHour: integer read fRotateFileAtHour write fRotateFileAtHour;
|
|
/// the optional log levels to be used for remote UDP syslog server sending
|
|
// - works in conjunction with SyslogServer property
|
|
// - default will transmit all warnings, errors and exceptions
|
|
property SyslogLevels: TSynLogInfos read fSyslogLevels write fSyslogLevels;
|
|
/// the optional log levels to be used for remote UDP syslog server sending
|
|
// - works in conjunction with SyslogServer/SyslogLevels properties
|
|
// - default is sfLocal0
|
|
property SyslogFacility: TSyslogFacility read fSyslogFacility write fSyslogFacility;
|
|
/// the optional remote UDP syslog server
|
|
// - expecting https://tools.ietf.org/html/rfc5424 messages over UDP
|
|
// - e.g. '1.2.3.4' to connect to UDP server 1.2.3.4 using default port 514 -
|
|
// but you can specify an alternative port as '1.2.3.4:2514'
|
|
// - works in conjunction with SyslogLevels/SyslogFacility properties
|
|
// - default is '' to disable syslog remote logging
|
|
property SyslogServer: RawUTF8 read fSyslogServer write fSyslogServer;
|
|
end;
|
|
|
|
TDDDAppSettingsAbstract = class;
|
|
|
|
/// abstract parent class for storing application settings
|
|
TDDDAppSettingsStorageAbstract = class(TSynAutoCreateFields)
|
|
protected
|
|
fInitialJsonContent: RawUTF8;
|
|
fOwner: TDDDAppSettingsAbstract;
|
|
/// called by TDDDAppSettingsAbstract.Create
|
|
function SetOwner(aOwner: TDDDAppSettingsAbstract): boolean;
|
|
/// inherited classes would override this to persist fInitialJsonContent
|
|
procedure InternalStore; virtual; abstract;
|
|
public
|
|
/// initialize the storage instance
|
|
constructor Create(const aInitialJSON: RawUTF8); reintroduce; virtual;
|
|
/// TDDDAppSettingsAbstract would use this to actually persist the data
|
|
procedure Store(const aJSON: RawUTF8); virtual;
|
|
/// the JSON content, as specified when creating the instance
|
|
// - will allow SettingsDidChange to check if has changed
|
|
// - here the JSON content is stored with default ObjectToJSON() options,
|
|
// so will be the normalized representation of the content, which may not
|
|
// match the JSON supplied to SetInitialJsonContent() protected method
|
|
property InitialJsonContent: RawUTF8 read fInitialJsonContent;
|
|
/// the associated settings values
|
|
property Owner: TDDDAppSettingsAbstract read fOwner;
|
|
end;
|
|
|
|
/// abstract class for storing application settings
|
|
// - this class implements IAutoCreateFieldsResolve so is able to inject
|
|
// its own values to any TInjectableAutoCreateFields instance
|
|
// - you have to manage instance lifetime of these inherited classes with a
|
|
// local IAutoCreateFieldsResolve variable, just like any TInterfaceObject
|
|
TDDDAppSettingsAbstract = class(TInterfacedObjectAutoCreateFields,
|
|
IAutoCreateFieldsResolve, IDDDSettingsStorable)
|
|
protected
|
|
fAllProps: PPropInfoDynArray;
|
|
fDescription: string;
|
|
fLog: TDDDLogSettings;
|
|
fSyslog: TCrtSocket;
|
|
fSyslogProcID: RawUTF8;
|
|
fStorage: TDDDAppSettingsStorageAbstract;
|
|
procedure SetProperties(Instance: TObject); virtual;
|
|
function SyslogEvent(Sender: TTextWriter; Level: TSynLogInfo;
|
|
const Text: RawUTF8): boolean;
|
|
public
|
|
/// initialize the settings, with a corresponding storage process
|
|
constructor Create(aStorage: TDDDAppSettingsStorageAbstract); reintroduce;
|
|
/// persist if needed, and finalize the settings
|
|
destructor Destroy; override;
|
|
/// to be called when the application starts, to initialize settings
|
|
// - you can specify a default Description value
|
|
// - it will set the global SQLite3Log.Family according to Log values
|
|
procedure Initialize(const aDescription: string); virtual;
|
|
/// persist the settings if needed
|
|
// - just a wrapper around Storage.Store(AsJson)
|
|
// - implements IDDDSettingsStorable for "#settings save" admin command
|
|
procedure StoreIfUpdated; virtual;
|
|
/// serialize the settings as JSON
|
|
// - any enumerated or set published property will be commented with their
|
|
// textual values, and 'stored false' properties would be included
|
|
// - returns the new JSON content corresponding to the updated settings
|
|
function AsJson: RawUTF8; virtual;
|
|
/// low-level method returning all TSynPersistentPassword full paths
|
|
// of all previously created TDDDAppSettingsStorageFile .settings
|
|
// - as settingsfile=class1@full.path.to.pass1,class2@full.path.to.pass2,...
|
|
// - you may use this method to create a 'passwords' resource for
|
|
// /HardenPasswords command line switch as implemented in dddInfraSettings.pas:
|
|
// ! passwords := SynLZCompress(TDDDAppSettingsAbstract.PasswordFields);
|
|
// ! FileFromString(passwords, 'passwords.data');
|
|
// then create e.g. a passwords.rc file as such:
|
|
// $ passwords 10 "passwords.data"
|
|
// compile this resource:
|
|
// $ brcc32 passwords.rc
|
|
// and link the resulting .res file to your daemon executable:
|
|
// ! {$R passwords.res}
|
|
// then /HardenPasswords and /PlainPasswords command line switchs will
|
|
// cypher/uncypher all TSynPersistentPassword protected fields using safe
|
|
// per-user CryptDataForCurrentUser() encryption
|
|
class function PasswordFields: RawUTF8;
|
|
/// access to the associated settings storage
|
|
property Storage: TDDDAppSettingsStorageAbstract read fStorage;
|
|
/// transmitted as PROCID as part of any Log.SyslogServer message
|
|
property SyslogProcID: RawUTF8 read fSyslogProcID write fSyslogProcID;
|
|
published
|
|
/// some text which will be used to describe this application
|
|
property Description: string read FDescription write FDescription;
|
|
/// defines how logging will be done for this application
|
|
property Log: TDDDLogSettings read fLog;
|
|
end;
|
|
|
|
/// class type used for storing application settings
|
|
TDDDAppSettingsAbstractClass = class of TDDDAppSettingsAbstract;
|
|
|
|
/// class used for storing application settings as a JSON file
|
|
TDDDAppSettingsStorageFile = class(TDDDAppSettingsStorageAbstract)
|
|
protected
|
|
fSettingsJsonFileName: TFileName;
|
|
procedure InternalStore; override;
|
|
public
|
|
/// initialize and read the settings from the supplied JSON file name
|
|
// - if no file name is specified, will use the executable name with
|
|
// '.settings' as extension
|
|
constructor Create(const aSettingsJsonFileName: TFileName=''); reintroduce; virtual;
|
|
/// compute a file name relative to the .settings file path
|
|
function FileNameRelativeToSettingsFile(const aFileName: TFileName): TFileName;
|
|
/// the .settings file name, including full path
|
|
property SettingsJsonFileName: TFileName
|
|
read fSettingsJsonFileName write fSettingsJsonFileName;
|
|
end;
|
|
|
|
/// some options to be used for TDDDRestSettings
|
|
// - as part of the .settings, they may be tuned for specific installations,
|
|
// whereas TDDDNewRestInstanceOptions are defined in code
|
|
TDDDRestSettingsOption =
|
|
(optEraseDBFileAtStartup,
|
|
optSQlite3FileSafeSlowMode,
|
|
optSQlite3FileSafeNonExclusive,
|
|
optNoSystemUse,
|
|
optSQlite3File4MBCacheSize,
|
|
optForceAjaxJson,
|
|
optSQLite3LogQueryPlan);
|
|
|
|
/// define options to be used for TDDDRestSettings
|
|
TDDDRestSettingsOptions = set of TDDDRestSettingsOption;
|
|
|
|
/// how TDDDRestSettings.NewRestInstance would create its instances
|
|
// - riOwnModel will set ModelInstance.Owner := RestInstance
|
|
// - riHandleAuthentication will set the corresponding parameter to true
|
|
// - riDefaultLocalSQlite3IfNone/riDefaultInMemorySQLite3IfNone will create
|
|
// a SQLite3 engine with a local file/memory storage, if
|
|
// TDDDRestSettings.ORM.Kind is not set
|
|
// - riDefaultFullMemoryIfNone will create a TSQLRestServerFullMemory non
|
|
// persistent storage, or riDefaultLocalBinaryFullMemoryIfNone with a
|
|
// binary local file, if TDDDRestSettings.ORM.Kind is not set
|
|
// - riCreateMissingTables will call RestInstance.CreateMissingTables
|
|
// - riRaiseExceptionIfNoRest will raise an EDDDInfraException if
|
|
// TDDDRestSettings.NewRestInstance would return nil
|
|
// - riWithInternalState will enable 'Server-InternalState:' header transmission
|
|
// i.e. disable rsoNoInternalState for TSQLRestServer.Options
|
|
TDDDNewRestInstanceOptions = set of (
|
|
riOwnModel, riCreateVoidModelIfNone,
|
|
riHandleAuthentication,
|
|
riDefaultLocalSQlite3IfNone, riDefaultInMemorySQLite3IfNone,
|
|
riDefaultFullMemoryIfNone, riDefaultLocalBinaryFullMemoryIfNone,
|
|
riCreateMissingTables,
|
|
riRaiseExceptionIfNoRest,
|
|
riWithInternalState);
|
|
|
|
/// storage class for initializing an ORM REST class
|
|
// - this class will contain some generic properties to initialize a TSQLRest
|
|
// pointing to a local or remote SQL/NoSQL database, with optional wrappers
|
|
TDDDRestSettings = class(TSynAutoCreateFields)
|
|
protected
|
|
fORM: TSynConnectionDefinition;
|
|
fDefaultDataFolder: TFileName;
|
|
fDefaultDataFileName: RawUTF8;
|
|
fRoot: RawUTF8;
|
|
fWrapperTemplateFolder: TFileName;
|
|
fWrapperSourceFolders: TFileName;
|
|
fOptions: TDDDRestSettingsOptions;
|
|
fWrapperTemplateFolderFixed: TFileName;
|
|
fWrapperSourceFolderFixed: TFileName;
|
|
public
|
|
/// is able to instantiate a REST instance according to the stored definition
|
|
// - Definition.Kind will identify the TSQLRestServer or TSQLRestClient class
|
|
// to be instantiated, or if equals 'MongoDB'/'MongoDBS' use a full MongoDB
|
|
// engine, or an external SQL database if it matches a TSQLDBConnectionProperties
|
|
// classname
|
|
// - if aDefaultLocalSQlite3 is TRUE, then if Definition.Kind is '',
|
|
// a local SQlite3 file database will be initiated
|
|
// - if aMongoDBIdentifier is not 0, then it will be supplied to every
|
|
// TSQLRestStorageMongoDB.SetEngineAddComputeIdentifier() created
|
|
// - will return nil if the supplied Definition is not correct
|
|
// - note that the supplied Model.Root is expected to be the default root
|
|
// URI, which will be overriden with this TDDDRestSettings.Root property
|
|
// - will also publish /wrapper HTML page if WrapperTemplateFolder is set
|
|
function NewRestInstance(aRootSettings: TDDDAppSettingsAbstract;
|
|
aModel: TSQLModel; aOptions: TDDDNewRestInstanceOptions
|
|
{$ifndef DDDNOSYNDB}; aExternalDBOptions:
|
|
TVirtualTableExternalRegisterOptions=[regDoNotRegisterUserGroupTables]{$endif}
|
|
{$ifndef DDDNOMONGODB}; aMongoDBIdentifier: word=0; aMongoDBOptions:
|
|
TStaticMongoDBRegisterOptions=[mrDoNotRegisterUserGroupTables]{$endif}): TSQLRest; overload; virtual;
|
|
/// is able to instantiate a REST instance according to the stored definition
|
|
// - just an overloaded version which will create an owned TSQLModel with
|
|
// the supplied TSQLRecord classes
|
|
function NewRestInstance(aRootSettings: TDDDAppSettingsAbstract;
|
|
const aTables: array of TSQLRecordClass; aOptions: TDDDNewRestInstanceOptions
|
|
{$ifndef DDDNOSYNDB}; aExternalDBOptions:
|
|
TVirtualTableExternalRegisterOptions=[regDoNotRegisterUserGroupTables]{$endif}
|
|
{$ifndef DDDNOMONGODB}; aMongoDBIdentifier: word=0; aMongoDBOptions:
|
|
TStaticMongoDBRegisterOptions=[mrDoNotRegisterUserGroupTables]{$endif}): TSQLRest; overload; virtual;
|
|
/// initialize a stand-alone TSQLRestServerDB instance
|
|
// - with its own database file located in DefaultDataFileName + aDBFileName
|
|
// - will own its own TSQLModel with aModelRoot/aModelTables
|
|
// - you can tune aCacheSize if the default 40MB value is not right
|
|
// - will eventually call CreateMissingTables
|
|
// - define custom TDDDRestSettingsOptions if needed
|
|
function NewRestServerDB(const aDBFileName: TFileName; const aModelRoot: RawUTF8;
|
|
const aModelTables: array of TSQLRecordClass; aOptions: TDDDRestSettingsOptions=[];
|
|
aCacheSize: cardinal=10000): TSQLRestServerDB;
|
|
/// if DB is a TSQLRestServerDB, will define the expection options
|
|
// - DB.FileName will be erased from disk if optEraseDBFileAtStartup is defined
|
|
// - force LockingMode=exclusive and Synchrounous=off unless
|
|
// optSQlite3FileSafeNonExclusive/optSQlite3FileSafeSlowMode options are set
|
|
class procedure RestServerDBSetOptions(DB: TSQLRestServer; Options: TDDDRestSettingsOptions);
|
|
/// returns the WrapperTemplateFolder property, all / chars replaced by \
|
|
// - so that you would be able to store the paths with /, avoiding JSON escape
|
|
function WrapperTemplateFolderFixed(ReturnLocalIfNoneSet: boolean=false): TFileName;
|
|
/// returns the WrapperSourceFolder property, all / chars replaced by \
|
|
// - so that you would be able to store the paths with /, avoiding JSON escape
|
|
function WrapperSourceFolderFixed: TFileName;
|
|
/// generate API documentation corresponding to REST SOA interfaces
|
|
procedure WrapperGenerate(Rest: TSQLRestServer; Port: integer;
|
|
const DestFile: TFileName; const Template: TFileName = 'API.adoc.mustache');
|
|
/// the default folder where database files are to be stored
|
|
// - will be used by NewRestInstance instead of the .exe folder, if set
|
|
property DefaultDataFolder: TFileName read fDefaultDataFolder write fDefaultDataFolder;
|
|
/// the default database file name
|
|
property DefaultDataFileName: RawUTF8 read fDefaultDataFileName write fDefaultDataFileName;
|
|
published
|
|
/// the URI Root to be used for the REST Model
|
|
property Root: RawUTF8 read fRoot write fRoot;
|
|
/// defines a mean of access to a TSQLRest instance
|
|
// - using Kind/ServerName/DatabaseName/User properties: Kind would define
|
|
// the TSQLRest class to be instantiated by function NewRestInstance()
|
|
property ORM: TSynConnectionDefinition read fORM;
|
|
/// if set to a valid folder, the generated TSQLRest will publish a
|
|
// '/Root/wrapper' HTML page so that client code could be generated
|
|
property WrapperTemplateFolder: TFileName
|
|
read fWrapperTemplateFolder write fWrapperTemplateFolder;
|
|
/// where the source code may be searched, for comment extraction of types
|
|
// - several folders may be defined, separated by ; (just like in Delphi IDE)
|
|
// - only used if WrapperTemplateFolder is defined
|
|
property WrapperSourceFolders: TFileName
|
|
read fWrapperSourceFolders write fWrapperSourceFolders;
|
|
/// how the REST instance is to be initialized
|
|
property Options: TDDDRestSettingsOptions read fOptions write fOptions;
|
|
end;
|
|
|
|
/// parent class for storing REST-based application settings
|
|
// - this class could be used for an application with a single REST server
|
|
// running on a given HTTP port
|
|
TDDDAppSettingsRest = class(TDDDAppSettingsAbstract)
|
|
protected
|
|
fRest: TDDDRestSettings;
|
|
fServerPort: RawUTF8;
|
|
public
|
|
/// to be called when the application starts, to initialize settings
|
|
// - will call inherited TDDDAppSettingsFile.Initialize, and
|
|
// set ServerPort to a default 888/8888 value under Windows/Linux
|
|
procedure Initialize(const aDescription: string); override;
|
|
published
|
|
/// allow to instantiate a REST instance from its JSON definition
|
|
property Rest: TDDDRestSettings read fRest;
|
|
/// the IP port to be used for the HTTP server associated with the application
|
|
property ServerPort: RawUTF8 read fServerPort write fServerPort;
|
|
end;
|
|
|
|
/// define how an administrated service/daemon is remotely accessed via REST
|
|
// - the IAdministratedDaemon service will be published to administrate
|
|
// this service/daemon instance
|
|
// - those values should match the ones used on administrative tool side
|
|
TDDDAdministratedDaemonRemoteAdminSettings = class(TSynAutoCreateFields)
|
|
protected
|
|
FAuthRootURI: RawUTF8;
|
|
FAuthHashedPassword: RawUTF8;
|
|
FAuthUserName: RawUTF8;
|
|
FAuthNamedPipeName: TFileName;
|
|
FAuthHttp: TSQLHttpServerDefinition;
|
|
public
|
|
published
|
|
/// the root URI used for the REST data model
|
|
// - default URI is 'admin'
|
|
property AuthRootURI: RawUTF8 read FAuthRootURI write FAuthRootURI;
|
|
/// if set, expect authentication with this single user name
|
|
// - that is, the TSQLRestServer will register a single TSQLAuthUser
|
|
// instance with the supplied AuthUserName/AuthHashedPassword credentials
|
|
property AuthUserName: RawUTF8 read FAuthUserName write FAuthUserName;
|
|
/// the SHA-256 hashed password to authenticate AuthUserName
|
|
// - follows the TSQLAuthUser.ComputeHashedPassword() encryption
|
|
// - marked as 'stored false' so that it won't appear e.g. in the logs
|
|
property AuthHashedPassword: RawUTF8 read FAuthHashedPassword write FAuthHashedPassword
|
|
stored false;
|
|
/// if defined, the following pipe name would be used for REST publishing
|
|
// - by definition, will work only on Windows
|
|
property AuthNamedPipeName: TFileName read FAuthNamedPipeName write FAuthNamedPipeName;
|
|
/// if defined, these parameters would be used for REST publishing over HTTP
|
|
property AuthHttp: TSQLHttpServerDefinition read FAuthHttp;
|
|
end;
|
|
|
|
/// parent class for storing a service/daemon settings
|
|
// - under Windows, some Service* properties will handle installation as a
|
|
// regular Windows Service, thanks to TDDDDaemon
|
|
TDDDAdministratedDaemonSettings = class(TDDDAppSettingsAbstract)
|
|
protected
|
|
FRemoteAdmin: TDDDAdministratedDaemonRemoteAdminSettings;
|
|
FServiceDisplayName: string;
|
|
FServiceName: string;
|
|
FServiceDependencies: TStringDynArray;
|
|
FServiceAutoStart: boolean;
|
|
FAppUserModelID: string;
|
|
public
|
|
/// to be called when the application starts, to initialize settings
|
|
// - you can specify default Description and Service identifiers
|
|
// - the service-related parameters are Windows specific, and will be
|
|
// ignored on other platforms
|
|
procedure Initialize(const aDescription,
|
|
aServiceName,aServiceDisplayName,aAppUserModelID: string;
|
|
const aServiceDependencies: TStringDynArray = nil); reintroduce; virtual;
|
|
/// returns the folder containing .settings files - .exe folder by default
|
|
function SettingsFolder: TFileName; virtual;
|
|
/// under Windows, will define optional Service internal Dependencies
|
|
// - not published by default: could be defined if needed, or e.g. set in
|
|
// overriden constructor
|
|
property ServiceDependencies: TStringDynArray read FServiceDependencies write FServiceDependencies;
|
|
published
|
|
/// define how this administrated service/daemon is accessed via REST
|
|
property RemoteAdmin: TDDDAdministratedDaemonRemoteAdminSettings read FRemoteAdmin;
|
|
/// under Windows, will define the Service internal name
|
|
property ServiceName: string read FServiceName write FServiceName;
|
|
/// under Windows, will define the Service displayed name
|
|
property ServiceDisplayName: string read FServiceDisplayName write FServiceDisplayName;
|
|
/// under Windows, will define if the Service should auto-start at boot
|
|
// - FALSE means that it should be started on demand
|
|
property ServiceAutoStart: boolean read FServiceAutoStart write FServiceAutoStart;
|
|
/// under Windows 7 and later, will set an unique application-defined
|
|
// Application User Model ID (AppUserModelID) that identifies the current
|
|
// process to the taskbar
|
|
// - this identifier allows an application to group its associated processes
|
|
// and windows under a single taskbar button
|
|
// - should follow SetAppUserModelID() expectations, i.e. 'Company.Product'
|
|
property AppUserModelID: string read FAppUserModelID write FAppUserModelID;
|
|
end;
|
|
|
|
/// a Factory event allowing to customize/mock a socket connection
|
|
// - the supplied aOwner should be a TDDDSocketThread instance
|
|
// - returns a IDDDSocket interface instance (e.g. a TDDDSynCrtSocket)
|
|
TOnIDDDSocketThreadCreate = procedure(aOwner: TObject; out Obj) of object;
|
|
|
|
/// the settings of a TDDDThreadSocketProcess thread
|
|
// - defines how to connect (and reconnect) to the associated TCP server
|
|
TDDDSocketThreadSettings = class(TSynAutoCreateFields)
|
|
protected
|
|
fHost: RawUTF8;
|
|
fPort: integer;
|
|
fSocketLoopPeriod: integer;
|
|
fSocketTimeout: integer;
|
|
fSocketBufferBytes: integer;
|
|
fSocketMaxBufferBytes: integer;
|
|
fConnectionAttemptsInterval: Integer;
|
|
fAutoReconnectAfterSocketError: boolean;
|
|
fMonitoringInterval: integer;
|
|
fOnIDDDSocketThreadCreate: TOnIDDDSocketThreadCreate;
|
|
public
|
|
/// used to set the default values
|
|
constructor Create; override;
|
|
/// set Host and Port values from a 'ip:port' or 'ip' text
|
|
function SetHostPort(const IpPort: RawByteString; defaultPort: integer): boolean;
|
|
/// retrieve Host and Port values as a single 'ip:port' text
|
|
function GetHostPort: RawUTF8;
|
|
/// you could set here a factory method to mock the socket connection
|
|
// - this property is public, but not published, since it should not be
|
|
// serialized on the settings file, but overloaded at runtime
|
|
property OnIDDDSocketThreadCreate: TOnIDDDSocketThreadCreate
|
|
read fOnIDDDSocketThreadCreate write fOnIDDDSocketThreadCreate;
|
|
published
|
|
/// the associated TCP server host
|
|
property Host: RawUTF8 read FHost write FHost;
|
|
/// the associated TCP server port
|
|
property Port: integer read FPort write FPort;
|
|
/// how many millisecond the main socket reading loop should wait
|
|
// for pending data, before calling TDDDSocketThread.InternalExecuteIdle
|
|
// - default is 100 ms
|
|
property SocketLoopPeriod: integer read fSocketLoopPeriod write fSocketLoopPeriod;
|
|
/// the time out period, in milliseconds, for socket access
|
|
// - default is 2000 ms, i.e. 2 seconds
|
|
property SocketTimeout: integer read FSocketTimeout write FSocketTimeout;
|
|
/// the internal size of the input socket buffer
|
|
// - default is 32768, i.e. 32 KB
|
|
property SocketBufferBytes: integer read FSocketBufferBytes write FSocketBufferBytes;
|
|
/// the maximum size of the thread input buffer
|
|
// - i.e. how many bytes are stored in fSocketInputBuffer memory, before
|
|
// nothing is retrieved from the socket buffer
|
|
// - set to avoid any "out of memory" of the currrent process, if the
|
|
// incoming data is not processed fast enough
|
|
// - default is 16777216, i.e. 16 MB
|
|
property SocketMaxBufferBytes: integer read FSocketMaxBufferBytes write FSocketMaxBufferBytes;
|
|
/// the time, in seconds, between any reconnection attempt
|
|
// - default value is 5 - i.e. five seconds
|
|
// - if you set -1 as value, thread would end without any retrial
|
|
property ConnectionAttemptsInterval: Integer
|
|
read fConnectionAttemptsInterval write fConnectionAttemptsInterval;
|
|
/// if TRUE, any communication error would try to reconnect the socket
|
|
property AutoReconnectAfterSocketError: boolean
|
|
read FAutoReconnectAfterSocketError write FAutoReconnectAfterSocketError;
|
|
/// the period, in milliseconds, on which Monitoring information is logged
|
|
// - default value is 120000, i.e. 2 minutes
|
|
property MonitoringLogInterval: integer read FMonitoringInterval write FMonitoringInterval;
|
|
end;
|
|
|
|
/// storage class for a ServicesLog settings
|
|
TDDDServicesLogRestSettings = class(TDDDRestSettings)
|
|
protected
|
|
fShardDBCount: Integer;
|
|
public
|
|
/// compute a stand-alone REST instance for interface-based services logging
|
|
// - all services of aMainRestWithServices would log their calling information
|
|
// into a dedicated table, but the methods defined in aExcludedMethodNamesCSV
|
|
// (which should be specified, even as '', to avoid FPC compilation error)
|
|
// - by default, will create a local SQLite3 file for storage, optionally
|
|
// via TSQLRestStorageShardDB if ShardDBCount is set
|
|
// - the first supplied item of aLogClass array would be used for the
|
|
// service logging; any additional item would be part of the model of the
|
|
// returned REST instance, but may be used later on (e.g. to handle
|
|
// DB-based asynchronous remote notifications as processed by
|
|
// TServiceFactoryClient.SendNotificationsVia method)
|
|
// - if aLogClass=[], plain TSQLRecordServiceLog would be used as default
|
|
// - aShardRange is used for TSQLRestStorageShardDB if ShardDBCount>0
|
|
function NewRestInstance(aRootSettings: TDDDAppSettingsAbstract;
|
|
aMainRestWithServices: TSQLRestServer; const aLogClass: array of TSQLRecordServiceLogClass;
|
|
const aExcludedMethodNamesCSV: RawUTF8; aShardRange: TID=50000): TSQLRest; reintroduce;
|
|
published
|
|
/// if set, will define MaxShardCount for TSQLRestStorageShardDB persistence
|
|
property ShardDBCount: Integer read fShardDBCount write fShardDBCount;
|
|
end;
|
|
|
|
/// parent class for storing a HTTP published service/daemon settings
|
|
TDDDAdministratedDaemonHttpSettings = class(TDDDAdministratedDaemonSettings)
|
|
protected
|
|
fRest: TDDDRestSettings;
|
|
fHttp: TSQLHttpServerDefinition;
|
|
fServicesLog: TDDDServicesLogRestSettings;
|
|
published
|
|
/// how the main REST server is implemented
|
|
// - most probably using a TSQLRestServerDB, i.e. local SQLite3 storage
|
|
property Rest: TDDDRestSettings read fRest;
|
|
/// how the HTTP server should be defined
|
|
property Http: TSQLHttpServerDefinition read fHttp;
|
|
/// how the SOA calls would be logged into their own SQlite3 database
|
|
property ServicesLog: TDDDServicesLogRestSettings read fServicesLog;
|
|
end;
|
|
|
|
/// stand-alone property to publish a secondary TSQLRestServer over HTTP
|
|
TDDDRestHttpSettings = class(TSynAutoCreateFields)
|
|
protected
|
|
fRest: TDDDRestSettings;
|
|
fHttp: TSQLHttpServerDefinition;
|
|
published
|
|
/// how the REST server is implemented
|
|
// - most probably using a TSQLRestServerDB, i.e. local SQLite3 storage
|
|
property Rest: TDDDRestSettings read fRest;
|
|
/// how the HTTP server should be defined
|
|
property Http: TSQLHttpServerDefinition read fHttp;
|
|
end;
|
|
|
|
/// stand-alone property to publish a secondary logged service over HTTP
|
|
TDDDRestHttpLogSettings = class(TDDDRestHttpSettings)
|
|
protected
|
|
fServicesLog: TDDDServicesLogRestSettings;
|
|
published
|
|
/// how the SOA calls would be logged into their own SQlite3 database
|
|
property ServicesLog: TDDDServicesLogRestSettings read fServicesLog;
|
|
end;
|
|
|
|
/// storage class for a remote MongoDB server direct access settings
|
|
TDDDMongoDBRestSettings = class(TDDDRestSettings)
|
|
public
|
|
/// set the default values for direct MongoDB server connection
|
|
// - if MongoServerAddress is e.g. '?:27017', entry with default value would
|
|
// be saved in the settings, but NewRestInstance() would ignore it: once the
|
|
// remote MongoDB server IP is known, you may just replace '?' to use it
|
|
// - if MongoUser and MongoPassword are set, would call TMongoClient.OpenAuth()
|
|
procedure SetDefaults(const Root, MongoServerAddress, MongoDatabase,
|
|
MongoUser, MongoPassword: RawUTF8; TLS: boolean=false);
|
|
end;
|
|
|
|
TDDDEmailerSettings = class(TSynPersistent)
|
|
protected
|
|
fSMTP: RawUTF8;
|
|
fRecipients: RawUTF8;
|
|
public
|
|
constructor Create; override;
|
|
published
|
|
property SMTP: RawUTF8 read fSMTP write fSMTP;
|
|
property Recipients: RawUTF8 read fRecipients write fRecipients;
|
|
end;
|
|
|
|
|
|
implementation
|
|
|
|
{ TDDDAppSettingsAbstract }
|
|
|
|
procedure TDDDAppSettingsAbstract.Initialize(const aDescription: string);
|
|
var
|
|
uri: TURI;
|
|
begin
|
|
{$ifdef WITHLOG}
|
|
with SQLite3Log.Family do begin
|
|
Level := Log.Levels-[sllNone]; // '*' would include sllNone
|
|
if Log.ConsoleLevels<>[] then
|
|
EchoToConsole := Log.ConsoleLevels-[sllNone];
|
|
PerThreadLog := ptIdentifiedInOnFile;
|
|
if Log.DestinationPath<>'' then
|
|
DestinationPath := Log.DestinationPath;
|
|
if Log.CustomFileName<>'' then
|
|
CustomFileName := Log.CustomFileName;
|
|
RotateFileCount := Log.RotateFileCount;
|
|
RotateFileSizeKB := Log.RotateFileSizeKB;
|
|
RotateFileDailyAtHour := Log.RotateFileDailyAtHour;
|
|
if Log.RotateFileCount<=0 then
|
|
HighResolutionTimestamp := true;
|
|
FileExistsAction := acAppend; // default rotation mode
|
|
if Log.StackTraceViaAPI then
|
|
StackTraceUse := stOnlyAPI;
|
|
// AutoFlushTimeOut not set now, since won't work with /form
|
|
if (Log.SyslogServer<>'') and (Log.SyslogServer[1]<>'?') and
|
|
not Assigned(EchoCustom) and (fSyslog=nil) and (Log.SyslogLevels<>[]) and
|
|
uri.From(Log.SyslogServer,'514') then
|
|
try
|
|
fSyslog := TCrtSocket.Open(uri.Server,uri.Port,cslUDP,2000);
|
|
EchoCustom := SyslogEvent;
|
|
except
|
|
fSyslog := nil;
|
|
end;
|
|
end;
|
|
{$endif}
|
|
if fDescription='' then
|
|
fDescription := aDescription;
|
|
end;
|
|
|
|
function TDDDAppSettingsAbstract.SyslogEvent(Sender: TTextWriter; Level: TSynLogInfo;
|
|
const Text: RawUTF8): boolean;
|
|
var
|
|
buf: array[0..511] of AnsiChar; // 512 bytes for fast unfragmented UDP packet
|
|
len: PtrInt;
|
|
begin
|
|
result := false;
|
|
if (fSyslog=nil) or not (Level in Log.SyslogLevels) then
|
|
exit;
|
|
len := SyslogMessage(Log.SyslogFacility,LOG_TO_SYSLOG[Level],Text,
|
|
fSyslogProcID,ToText(Level),@buf,sizeof(buf),true);
|
|
if len<>0 then
|
|
if fSyslog.TrySndLow(@buf,len) then // works even if no server is available
|
|
result := true else
|
|
raise ESynException.CreateUTF8('%.SyslogEvent failed for %:% as error %',
|
|
[self,fSyslog.Server,fSyslog.Port,fSyslog.LastLowSocketError]);
|
|
end;
|
|
|
|
procedure TDDDAppSettingsAbstract.SetProperties(Instance: TObject);
|
|
begin
|
|
CopyObject(self,Instance);
|
|
end;
|
|
|
|
destructor TDDDAppSettingsAbstract.Destroy;
|
|
begin
|
|
StoreIfUpdated;
|
|
inherited Destroy;
|
|
fStorage.Free;
|
|
if fSyslog<>nil then begin
|
|
{$ifdef WITHLOG}
|
|
SQLite3Log.Family.EchoCustom := nil;
|
|
{$endif}
|
|
FreeAndNil(fSyslog);
|
|
end;
|
|
end;
|
|
|
|
function TDDDAppSettingsAbstract.AsJson: RawUTF8;
|
|
begin
|
|
result := ObjectToJSON(Self,[woHumanReadable,woStoreStoredFalse,
|
|
woHumanReadableFullSetsAsStar,woHumanReadableEnumSetAsComment]);
|
|
end;
|
|
|
|
procedure TDDDAppSettingsAbstract.StoreIfUpdated;
|
|
begin
|
|
if fStorage<>nil then
|
|
fStorage.Store(AsJson);
|
|
end;
|
|
|
|
var
|
|
TDDDAppSettingsAbstractFiles: array of record
|
|
FileName: RawUTF8;
|
|
SettingClass: TDDDAppSettingsAbstractClass;
|
|
end;
|
|
|
|
constructor TDDDAppSettingsAbstract.Create(aStorage: TDDDAppSettingsStorageAbstract);
|
|
begin
|
|
inherited Create;
|
|
if aStorage=nil then
|
|
aStorage := TDDDAppSettingsStorageFile.Create;
|
|
fStorage := aStorage;
|
|
fStorage.SetOwner(self);
|
|
if aStorage.InheritsFrom(TDDDAppSettingsStorageFile) then begin
|
|
SetLength(TDDDAppSettingsAbstractFiles,length(TDDDAppSettingsAbstractFiles)+1);
|
|
with TDDDAppSettingsAbstractFiles[high(TDDDAppSettingsAbstractFiles)] do begin
|
|
FileName := Split(StringToUTF8(ExtractFileName(TDDDAppSettingsStorageFile(aStorage).
|
|
fSettingsJsonFileName)),'.');
|
|
SettingClass := pointer(ClassType);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
class function TDDDAppSettingsAbstract.PasswordFields: RawUTF8;
|
|
procedure InternalAdd(const path: RawUTF8; C: TClass; var res: TRawUTF8DynArray);
|
|
var PI,PP: PPropInfo;
|
|
CT: TClass;
|
|
p: RawUTF8;
|
|
i: integer;
|
|
offset: pointer;
|
|
begin
|
|
offset := TSynPersistentWithPassword(nil).GetPasswordFieldAddress;
|
|
while C<>nil do begin
|
|
for i := 1 to InternalClassPropInfo(C,PI) do begin
|
|
if PI^.PropType^.Kind=tkClass then begin
|
|
FormatUTF8('%%.',[path,PI^.Name],p);
|
|
CT := PI^.PropType^.ClassType^.ClassType;
|
|
if CT.InheritsFrom(TSynPersistentWithPassword) then begin
|
|
PP := ClassFieldPropWithParentsFromClassOffset(CT,offset);
|
|
if PP<>nil then
|
|
AddRawUTF8(res,FormatUTF8('%@%%', [ClassNameShort(CT)^, p, PP^.Name]));
|
|
end;
|
|
InternalAdd(p,CT,res); // recursive search of all password fields
|
|
end;
|
|
PI := PI^.Next;
|
|
end;
|
|
C := GetClassParent(C);
|
|
end;
|
|
end;
|
|
var i: integer;
|
|
res: TRawUTF8DynArray;
|
|
begin
|
|
result := '';
|
|
for i := 0 to high(TDDDAppSettingsAbstractFiles) do
|
|
with TDDDAppSettingsAbstractFiles[i] do begin
|
|
res := nil;
|
|
InternalAdd('',SettingClass,res);
|
|
if res<>nil then
|
|
result := FormatUTF8('%%=%'#13#10,[result,FileName,RawUTF8ArrayToCSV(res)]);
|
|
end;
|
|
end;
|
|
|
|
|
|
{ TDDDLogSettings }
|
|
|
|
constructor TDDDLogSettings.Create;
|
|
begin
|
|
inherited Create;
|
|
fLevels := [low(TSynLogInfo)..high(TSynLogInfo)]; // "Levels":"*" by default
|
|
fRotateFileAtHour := -1;
|
|
fRotateFileCount := 20;
|
|
fRotateFileSize := 128*1024; // 128 MB per rotation log by default
|
|
fAutoFlush := 5;
|
|
fSyslogLevels := [sllWarning,sllLastError,sllError,
|
|
sllException,sllExceptionOS,sllNewRun,sllDDDError];
|
|
fSyslogFacility := sfLocal0;
|
|
end;
|
|
|
|
|
|
{ TDDDRestSettings }
|
|
|
|
function TDDDRestSettings.NewRestInstance(aRootSettings: TDDDAppSettingsAbstract;
|
|
const aTables: array of TSQLRecordClass; aOptions: TDDDNewRestInstanceOptions
|
|
{$ifndef DDDNOSYNDB}; aExternalDBOptions: TVirtualTableExternalRegisterOptions {$endif}
|
|
{$ifndef DDDNOMONGODB}; aMongoDBIdentifier: word;
|
|
aMongoDBOptions: TStaticMongoDBRegisterOptions{$endif}): TSQLRest;
|
|
begin
|
|
include(aOptions,riOwnModel);
|
|
result := NewRestInstance(aRootSettings,TSQLModel.Create(aTables,fRoot),aOptions
|
|
{$ifndef DDDNOSYNDB},aExternalDBOptions{$endif}
|
|
{$ifndef DDDNOMONGODB},aMongoDBIdentifier,aMongoDBOptions{$endif});
|
|
end;
|
|
|
|
function TDDDRestSettings.NewRestInstance(aRootSettings: TDDDAppSettingsAbstract;
|
|
aModel: TSQLModel; aOptions: TDDDNewRestInstanceOptions
|
|
{$ifndef DDDNOSYNDB}; aExternalDBOptions: TVirtualTableExternalRegisterOptions{$endif}
|
|
{$ifndef DDDNOMONGODB}; aMongoDBIdentifier: word;
|
|
aMongoDBOptions: TStaticMongoDBRegisterOptions{$endif}): TSQLRest;
|
|
|
|
procedure ComputeDefaultORMServerName(const Ext: RawUTF8);
|
|
var FN: RawUTF8;
|
|
begin
|
|
if fORM.ServerName='' then begin
|
|
if fDefaultDataFolder='' then
|
|
fDefaultDataFolder := ExeVersion.ProgramFilePath;
|
|
if fDefaultDataFileName='' then
|
|
FN := ExeVersion.ProgramName else
|
|
FN := fDefaultDataFileName;
|
|
fORM.ServerName := StringToUTF8(IncludeTrailingPathDelimiter(
|
|
fDefaultDataFolder))+FN+Ext;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
if aModel=nil then
|
|
if riCreateVoidModelIfNone in aOptions then begin
|
|
aModel := TSQLModel.Create([],fRoot);
|
|
include(aOptions,riOwnModel);
|
|
end else
|
|
raise EDDDInfraException.CreateUTF8('%.NewRestInstance(aModel=nil)',[self]);
|
|
if fRoot='' then // supplied TSQLModel.Root is the default root URI
|
|
fRoot := aModel.Root else
|
|
aModel.Root := fRoot;
|
|
if fORM.Kind='' then
|
|
if riDefaultLocalSQlite3IfNone in aOptions then begin
|
|
fORM.Kind := 'TSQLRestServerDB'; // SQlite3 engine by default
|
|
ComputeDefaultORMServerName('.db');
|
|
end else
|
|
if riDefaultInMemorySQLite3IfNone in aOptions then begin
|
|
fORM.Kind := 'TSQLRestServerDB';
|
|
fORM.ServerName := SQLITE_MEMORY_DATABASE_NAME;
|
|
end else
|
|
if riDefaultFullMemoryIfNone in aOptions then
|
|
fORM.Kind := 'TSQLRestServerFullMemory' else
|
|
if riDefaultLocalBinaryFullMemoryIfNone in aOptions then begin
|
|
fORM.Kind := 'TSQLRestServerFullMemory';
|
|
fORM.DatabaseName := 'binary'; // as TSQLRestServerFullMemory.DefinitionTo
|
|
ComputeDefaultORMServerName('.data');
|
|
end;
|
|
result := nil;
|
|
try
|
|
if fORM.Kind='' then
|
|
exit;
|
|
if (optEraseDBFileAtStartup in Options) and (fORM.ServerName<>'') then
|
|
if (fORM.Kind='TSQLRestServerDB') or
|
|
(fORM.Kind='TSQLRestServerFullMemory') then
|
|
DeleteFile(UTF8ToString(fORM.ServerName));
|
|
{$ifndef DDDNOMONGODB}
|
|
result := TSQLRestMongoDBCreate(aModel,ORM,
|
|
riHandleAuthentication in aOptions,aMongoDBOptions,aMongoDBIdentifier);
|
|
{$endif}
|
|
{$ifdef DDDNOSYNDB}
|
|
result := TSQLRest.CreateTryFrom(aModel,ORM,riHandleAuthentication in aOptions);
|
|
{$else}
|
|
if result=nil then // failed to use MongoDB -> try external or internal DB
|
|
result := TSQLRestExternalDBCreate(aModel,ORM,
|
|
riHandleAuthentication in aOptions,aExternalDBOptions);
|
|
{$endif}
|
|
if result=nil then
|
|
exit; // no match or wrong parameters
|
|
if result.InheritsFrom(TSQLRestServer) then
|
|
try // initialize server features
|
|
if (WrapperTemplateFolder<>'') and DirectoryExists(WrapperTemplateFolderFixed) then
|
|
AddToServerWrapperMethod(TSQLRestServer(result),[WrapperTemplateFolderFixed],
|
|
WrapperSourceFolderFixed);
|
|
RestServerDBSetOptions(TSQLRestServer(result), Options);
|
|
if not (riWithInternalState in aOptions) then
|
|
TSQLRestServer(result).Options := TSQLRestServer(result).Options+[rsoNoInternalState];
|
|
if riCreateMissingTables in aOptions then
|
|
TSQLRestServer(result).CreateMissingTables;
|
|
except
|
|
FreeAndNil(result);
|
|
end; // note: TSQLRestClient.SetUser() has been called in TSQLRest*DBCreate()
|
|
if not(optNoSystemUse in Options) then
|
|
// if not already set, update cpu/ram info every 10 sec + 10 min history
|
|
result.SystemUseTrack(10);
|
|
finally
|
|
if riOwnModel in aOptions then
|
|
if result=nil then // avoid memory leak
|
|
aModel.Free else
|
|
aModel.Owner := result;
|
|
if (result=nil) and (riRaiseExceptionIfNoRest in aOptions) then
|
|
raise EDDDInfraException.CreateUTF8('Impossible to initialize % on %/%',
|
|
[fORM.Kind,fORM.ServerName,fRoot]);
|
|
end;
|
|
end;
|
|
|
|
class procedure TDDDRestSettings.RestServerDBSetOptions(DB: TSQLRestServer;
|
|
Options: TDDDRestSettingsOptions);
|
|
begin
|
|
if DB = nil then
|
|
exit;
|
|
if DB.InheritsFrom(TSQLRestServerDB) then
|
|
with TSQLRestServerDB(DB).DB do begin // tune internal SQlite3 engine
|
|
if optEraseDBFileAtStartup in Options then
|
|
DeleteFile(FileName);
|
|
if optSQlite3FileSafeNonExclusive in Options then
|
|
LockingMode := lmNormal else
|
|
LockingMode := lmExclusive;
|
|
if optSQlite3FileSafeSlowMode in Options then
|
|
Synchronous := smNormal else
|
|
Synchronous := smOff;
|
|
if optSQlite3File4MBCacheSize in Options then
|
|
CacheSize := (4 shl 20) div PageSize;
|
|
if optSQLite3LogQueryPlan in Options then
|
|
TSQLRestServerDB(DB).StatementPreparedSelectQueryPlan := true;
|
|
end;
|
|
DB.NoAJAXJSON := not (optForceAjaxJson in Options);
|
|
end;
|
|
|
|
function TDDDRestSettings.NewRestServerDB(const aDBFileName: TFileName;
|
|
const aModelRoot: RawUTF8; const aModelTables: array of TSQLRecordClass;
|
|
aOptions: TDDDRestSettingsOptions; aCacheSize: cardinal): TSQLRestServerDB;
|
|
begin
|
|
result := TSQLRestServerDB.CreateWithOwnModel(aModelTables, DefaultDataFolder +
|
|
UTF8ToString(DefaultDataFileName) + aDBFileName, false, aModelRoot, '', aCacheSize);
|
|
RestServerDBSetOptions(result, Options); // tune internal SQlite3 engine
|
|
result.Options := result.Options+[rsoNoInternalState];
|
|
result.CreateMissingTables;
|
|
end;
|
|
|
|
procedure TDDDRestSettings.WrapperGenerate(Rest: TSQLRestServer; Port: integer;
|
|
const DestFile, Template: TFileName);
|
|
var dest: TFileName;
|
|
mus: RawUTF8;
|
|
begin
|
|
if (self = nil) or (Rest = nil) then
|
|
exit;
|
|
if DestFile = '' then
|
|
dest := ExeVersion.ProgramFilePath+'mORMotClient.asc' else
|
|
dest := DestFile;
|
|
mus := StringFromFile(WrapperTemplateFolderFixed(true)+Template);
|
|
FileFromString(WrapperFromModel(Rest,mus,'',Port),dest);
|
|
end;
|
|
|
|
function TDDDRestSettings.WrapperSourceFolderFixed: TFileName;
|
|
begin
|
|
if fWrapperSourceFolders='' then
|
|
result := '' else begin
|
|
if fWrapperSourceFolderFixed='' then
|
|
fWrapperSourceFolderFixed := IncludeTrailingPathDelimiter(StringReplace(
|
|
fWrapperSourceFolders,'/',PathDelim,[rfReplaceAll]));
|
|
result := fWrapperSourceFolders;
|
|
end;
|
|
end;
|
|
|
|
function TDDDRestSettings.WrapperTemplateFolderFixed(ReturnLocalIfNoneSet: boolean): TFileName;
|
|
begin
|
|
if fWrapperTemplateFolder='' then
|
|
if ReturnLocalIfNoneSet then
|
|
result := ExeVersion.ProgramFilePath
|
|
else
|
|
result := '' else begin
|
|
if fWrapperTemplateFolderFixed='' then
|
|
fWrapperTemplateFolderFixed := StringReplace(
|
|
fWrapperTemplateFolder,'/',PathDelim,[rfReplaceAll]);
|
|
result := fWrapperTemplateFolder;
|
|
end;
|
|
end;
|
|
|
|
|
|
{ TDDDAppSettingsRest }
|
|
|
|
procedure TDDDAppSettingsRest.Initialize(const aDescription: string);
|
|
begin
|
|
inherited Initialize(aDescription);
|
|
if ServerPort='' then
|
|
ServerPort := {$ifdef LINUX}'8888'{$else}'888'{$endif};
|
|
end;
|
|
|
|
|
|
|
|
{ TDDDAdministratedDaemonSettings }
|
|
|
|
procedure TDDDAdministratedDaemonSettings.Initialize(
|
|
const aDescription, aServiceName, aServiceDisplayName, aAppUserModelID: string;
|
|
const aServiceDependencies: TStringDynArray);
|
|
begin
|
|
inherited Initialize(aDescription);
|
|
if FServiceName='' then
|
|
FServiceName := aServiceName;
|
|
if FServiceDisplayName='' then
|
|
FServiceDisplayName := aServiceDisplayName;
|
|
FServiceDependencies := aServiceDependencies;
|
|
if FAppUserModelID='' then
|
|
FAppUserModelID := aAppUserModelID;
|
|
end;
|
|
|
|
function TDDDAdministratedDaemonSettings.SettingsFolder: TFileName;
|
|
begin
|
|
if fStorage.InheritsFrom(TDDDAppSettingsStorageFile) then
|
|
result := ExtractFilePath(TDDDAppSettingsStorageFile(fStorage).fSettingsJsonFileName)
|
|
else
|
|
result := ExeVersion.ProgramFilePath;
|
|
end;
|
|
|
|
|
|
{ TDDDSocketThreadSettings }
|
|
|
|
constructor TDDDSocketThreadSettings.Create;
|
|
begin
|
|
inherited Create;
|
|
fSocketLoopPeriod := 100;
|
|
fConnectionAttemptsInterval := 5;
|
|
fMonitoringInterval := 120*1000; // log monitoring information every 2 minutes
|
|
fSocketBufferBytes := 32768; // 32KB
|
|
fSocketMaxBufferBytes := 16777216; // 16MB
|
|
end;
|
|
|
|
function TDDDSocketThreadSettings.GetHostPort: RawUTF8;
|
|
begin
|
|
FormatUTF8('%:%', [fHost, fPort], result);
|
|
end;
|
|
|
|
function TDDDSocketThreadSettings.SetHostPort(
|
|
const IpPort: RawByteString; defaultPort: integer): boolean;
|
|
var p: RawUTF8;
|
|
begin
|
|
Split(IpPort,':',fHost,p);
|
|
result := false;
|
|
if trim(fHost) = '' then
|
|
exit;
|
|
fPort := GetIntegerDef(pointer(p), defaultPort);
|
|
result := fPort > 0;
|
|
end;
|
|
|
|
|
|
{ TDDDServicesLogRestSettings }
|
|
|
|
function TDDDServicesLogRestSettings.NewRestInstance(
|
|
aRootSettings: TDDDAppSettingsAbstract; aMainRestWithServices: TSQLRestServer;
|
|
const aLogClass: array of TSQLRecordServiceLogClass;
|
|
const aExcludedMethodNamesCSV: RawUTF8; aShardRange: TID): TSQLRest;
|
|
var classes: TSQLRecordClassDynArray;
|
|
server: TSQLRestServer;
|
|
fn: TFileName;
|
|
i: integer;
|
|
begin
|
|
if length(aLogClass)=0 then begin
|
|
SetLength(classes,1);
|
|
classes[0] := TSQLRecordServiceLog;
|
|
end else begin
|
|
SetLength(classes,length(aLogClass));
|
|
for i := 0 to high(aLogClass) do
|
|
classes[i] := aLogClass[i];
|
|
end;
|
|
if (fShardDBCount > 0) and (aShardRange > 100) and (length(classes)=1) then
|
|
{$WARNINGS OFF} // methods are pure abstract, but fine with a single class
|
|
result := TSQLRestServer.CreateWithOwnModel(classes,false,fRoot) else
|
|
{$WARNINGS ON}
|
|
result := inherited NewRestInstance(aRootSettings,TSQLModel.Create(classes),
|
|
[riOwnModel,riDefaultLocalSQlite3IfNone,riCreateMissingTables]);
|
|
if result=nil then
|
|
exit;
|
|
if (fShardDBCount > 0) and (aShardRange > 100) then begin
|
|
server := result as TSQLRestServer;
|
|
fn := IncludeTrailingPathDelimiter(fDefaultDataFolder)+TFileName(fDefaultDataFileName);
|
|
if not server.StaticDataAdd(TSQLRestStorageShardDB.Create(
|
|
classes[0], server, aShardRange, [], fn, fShardDBCount)) then
|
|
raise EDDDInfraException.CreateUTF8('%.NewRestInstance(%) StaticDataAdd(%)=false',
|
|
[self,fRoot,classes[0]]);
|
|
end else
|
|
if result.InheritsFrom(TSQLRestServerDB) then
|
|
TSQLRestServerDB(result).DB.UseCache := false;
|
|
// set the first supplied class type to log services
|
|
if (aMainRestWithServices <> nil) and classes[0].InheritsFrom(TSQLRecordServiceLog) then
|
|
(aMainRestWithServices.ServiceContainer as TServiceContainerServer).
|
|
SetServiceLog(result,TSQLRecordServiceLogClass(classes[0]),aExcludedMethodNamesCSV);
|
|
end;
|
|
|
|
|
|
{ TDDDAppSettingsStorageAbstract }
|
|
|
|
constructor TDDDAppSettingsStorageAbstract.Create(
|
|
const aInitialJSON: RawUTF8);
|
|
begin
|
|
inherited Create;
|
|
if aInitialJSON='' then
|
|
exit;
|
|
fInitialJsonContent := aInitialJSON;
|
|
end;
|
|
|
|
function TDDDAppSettingsStorageAbstract.SetOwner(
|
|
aOwner: TDDDAppSettingsAbstract): boolean;
|
|
begin
|
|
if self=nil then
|
|
result := false
|
|
else begin
|
|
fOwner := aOwner;
|
|
result := JSONSettingsToObject(fInitialJsonContent, fOwner);
|
|
end;
|
|
end;
|
|
|
|
procedure TDDDAppSettingsStorageAbstract.Store(const aJSON: RawUTF8);
|
|
begin
|
|
if aJSON=fInitialJsonContent then
|
|
exit;
|
|
fInitialJsonContent := aJSON;
|
|
InternalStore;
|
|
end;
|
|
|
|
|
|
{ TDDDAppSettingsStorageFile }
|
|
|
|
constructor TDDDAppSettingsStorageFile.Create(const aSettingsJsonFileName: TFileName);
|
|
var content: RawUTF8;
|
|
begin
|
|
if aSettingsJsonFileName<>'' then
|
|
fSettingsJsonFileName := aSettingsJsonFileName else
|
|
fSettingsJsonFileName := ChangeFileExt(ExeVersion.ProgramFileName,'.settings');
|
|
fSettingsJsonFileName := ExpandFileName(fSettingsJsonFileName);
|
|
content := AnyTextFileToRawUTF8(fSettingsJsonFileName,true);
|
|
inherited Create(content);
|
|
end;
|
|
|
|
function TDDDAppSettingsStorageFile.FileNameRelativeToSettingsFile(
|
|
const aFileName: TFileName): TFileName;
|
|
var path,settings: TFileName;
|
|
begin
|
|
path := ExtractFilePath(ExpandFileName(aFileName));
|
|
settings := ExtractFilePath(ExpandFileName(SettingsJsonFileName));
|
|
result := ExtractRelativePath(settings,path)+ExtractFileName(aFileName);
|
|
end;
|
|
|
|
procedure TDDDAppSettingsStorageFile.InternalStore;
|
|
begin
|
|
FileFromString(fInitialJsonContent,fSettingsJsonFileName);
|
|
end;
|
|
|
|
|
|
{ TDDDMongoDBRestSettings }
|
|
|
|
procedure TDDDMongoDBRestSettings.SetDefaults(const Root, MongoServerAddress,
|
|
MongoDatabase, MongoUser, MongoPassword: RawUTF8; TLS: boolean);
|
|
begin
|
|
if fORM.Kind<>'' then
|
|
exit;
|
|
fRoot := Root;
|
|
if TLS then
|
|
fORM.Kind := 'MongoDBS' else
|
|
fORM.Kind := 'MongoDB';
|
|
fORM.ServerName := MongoServerAddress;
|
|
fORM.DatabaseName := MongoDatabase;
|
|
fORM.User := MongoUser;
|
|
fORM.PasswordPlain := MongoPassword;
|
|
end;
|
|
|
|
|
|
{ TDDDEmailerSettings }
|
|
|
|
constructor TDDDEmailerSettings.Create;
|
|
begin
|
|
inherited Create;
|
|
fSMTP := SMTP_DEFAULT;
|
|
end;
|
|
|
|
initialization
|
|
TSynPersistentWithPasswordUserCrypt := CryptDataForCurrentUser;
|
|
|
|
end.
|