mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-06-07 16:18:46 +02:00
* Add logging, better configuration
git-svn-id: trunk@60764 -
This commit is contained in:
parent
683497c137
commit
3348e9e12b
@ -7,7 +7,7 @@ object RestDataModule: TRestDataModule
|
|||||||
Width = 407
|
Width = 407
|
||||||
PPI = 96
|
PPI = 96
|
||||||
object Dispatcher: TSQLDBRestDispatcher
|
object Dispatcher: TSQLDBRestDispatcher
|
||||||
Active = True
|
Active = False
|
||||||
Connections = <
|
Connections = <
|
||||||
item
|
item
|
||||||
ConnectionType = 'PostgreSQL'
|
ConnectionType = 'PostgreSQL'
|
||||||
@ -23,9 +23,15 @@ object RestDataModule: TRestDataModule
|
|||||||
item
|
item
|
||||||
Schema = ExpensesSchema
|
Schema = ExpensesSchema
|
||||||
end>
|
end>
|
||||||
DispatchOptions = [rdoExposeMetadata, rdoAccessCheckNeedsDB]
|
DefaultConnection = 'Expenses'
|
||||||
|
DispatchOptions = [rdoConnectionInURL, rdoExposeMetadata, rdoCustomView, rdoAccessCheckNeedsDB, rdoConnectionResource]
|
||||||
Authenticator = AuthBasic
|
Authenticator = AuthBasic
|
||||||
EnforceLimit = 0
|
EnforceLimit = 0
|
||||||
|
CORSMaxAge = 86400
|
||||||
|
CORSAllowCredentials = True
|
||||||
|
LogOptions = [rloUser, rtloHTTP, rloResource, rloConnection, rloAuthentication, rloResultStatus]
|
||||||
|
LogSQLOptions = [detCustom, detPrepare, detExecute, detFetch, detCommit, detRollBack, detActualSQL]
|
||||||
|
OnLog = DispatcherLog
|
||||||
left = 72
|
left = 72
|
||||||
top = 32
|
top = 32
|
||||||
end
|
end
|
||||||
@ -242,6 +248,9 @@ object RestDataModule: TRestDataModule
|
|||||||
AuthenticateUserSQL.Strings = (
|
AuthenticateUserSQL.Strings = (
|
||||||
'select uID from users where (uLogin=:UserName) and (uPassword=:Password)'
|
'select uID from users where (uLogin=:UserName) and (uPassword=:Password)'
|
||||||
)
|
)
|
||||||
|
DefaultUserName = 'me'
|
||||||
|
DefaultPassword = 'secret'
|
||||||
|
DefaultUserID = 'me'
|
||||||
left = 136
|
left = 136
|
||||||
top = 104
|
top = 104
|
||||||
end
|
end
|
||||||
|
@ -5,7 +5,7 @@ unit dmRestBridge;
|
|||||||
interface
|
interface
|
||||||
|
|
||||||
uses
|
uses
|
||||||
Classes, SysUtils, sqldbrestbridge, sqldbrestschema, pqconnection, sqldbrestauth,db,
|
Classes, SysUtils, sqldbrestbridge, sqldbrestschema, pqconnection, ibconnection, sqldbrestauth,db,
|
||||||
// Register formats
|
// Register formats
|
||||||
sqldbrestcsv ,sqldbrestxml, sqldbrestcds, sqldbrestado;
|
sqldbrestcsv ,sqldbrestxml, sqldbrestcds, sqldbrestado;
|
||||||
|
|
||||||
@ -19,6 +19,8 @@ type
|
|||||||
ExpensesSchema: TSQLDBRestSchema;
|
ExpensesSchema: TSQLDBRestSchema;
|
||||||
BPProjects: TSQLDBRestBusinessProcessor;
|
BPProjects: TSQLDBRestBusinessProcessor;
|
||||||
procedure DataModuleCreate(Sender: TObject);
|
procedure DataModuleCreate(Sender: TObject);
|
||||||
|
procedure DispatcherLog(Sender: TObject; aType: TRestDispatcherLogOption;
|
||||||
|
const aMessage: UTF8String);
|
||||||
procedure DoAllowedOperations(aSender: TObject; aContext: TBaseRestContext; var aOperations: TRestOperations);
|
procedure DoAllowedOperations(aSender: TObject; aContext: TBaseRestContext; var aOperations: TRestOperations);
|
||||||
procedure DoAllowedRecord(aSender: TObject; aContext: TBaseRestContext; aDataSet: TDataset; var allowRecord: Boolean);
|
procedure DoAllowedRecord(aSender: TObject; aContext: TBaseRestContext; aDataSet: TDataset; var allowRecord: Boolean);
|
||||||
procedure DoAllowResource(aSender: TObject; aContext: TBaseRestContext; var allowResource: Boolean);
|
procedure DoAllowResource(aSender: TObject; aContext: TBaseRestContext; var allowResource: Boolean);
|
||||||
@ -36,35 +38,72 @@ implementation
|
|||||||
|
|
||||||
{$R *.lfm}
|
{$R *.lfm}
|
||||||
|
|
||||||
uses sqldbrestini;
|
uses sqldbrestini, custapp;
|
||||||
|
|
||||||
{ TRestDataModule }
|
{ TRestDataModule }
|
||||||
|
|
||||||
procedure TRestDataModule.DataModuleCreate(Sender: TObject);
|
procedure TRestDataModule.DataModuleCreate(Sender: TObject);
|
||||||
|
|
||||||
|
Var
|
||||||
|
D,Cfg : String;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if FileExists('connection.ini') then
|
D:=ExtractFilePath(ParamStr(0));
|
||||||
|
if CustomApplication.Hasoption('c','connection') then
|
||||||
|
Cfg:=CustomApplication.GetoptionValue('c','connection')
|
||||||
|
else
|
||||||
|
Cfg:=D+'connection.ini';
|
||||||
|
if FileExists(Cfg) then
|
||||||
Dispatcher.Connections[0].LoadFromFile('connection.ini');
|
Dispatcher.Connections[0].LoadFromFile('connection.ini');
|
||||||
|
if CustomApplication.Hasoption('c','connection') then
|
||||||
|
Cfg:=CustomApplication.GetoptionValue('i','ini')
|
||||||
|
else
|
||||||
|
Cfg:=D+'server.ini';
|
||||||
|
if FileExists(Cfg) then
|
||||||
|
Dispatcher.LoadFromFile('server.ini',[]);
|
||||||
|
// Manual config
|
||||||
|
if CustomApplication.Hasoption('b','basedir') then
|
||||||
|
Dispatcher.BasePath:=CustomApplication.GetoptionValue('b','basedir');
|
||||||
|
if CustomApplication.HasOption('q','quiet') then
|
||||||
|
begin
|
||||||
|
Dispatcher.OnLog:=Nil;
|
||||||
|
Dispatcher.LogOptions:=[];
|
||||||
|
end
|
||||||
|
else if CustomApplication.HasOption('v','verbose') then
|
||||||
|
Dispatcher.LogOptions:=Dispatcher.LogOptions+[rloSQL];
|
||||||
|
// Activate
|
||||||
|
Dispatcher.Active:=True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TRestDataModule.DispatcherLog(Sender: TObject;
|
||||||
|
aType: TRestDispatcherLogOption; const aMessage: UTF8String);
|
||||||
|
begin
|
||||||
|
if isConsole then
|
||||||
|
Writeln('['+LogNames[aType]+'] '+aMessage)
|
||||||
|
else if Assigned(CustomApplication) then
|
||||||
|
CustomApplication.Log(etInfo,'['+LogNames[aType]+'] '+aMessage);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TRestDataModule.DoAllowedOperations(aSender: TObject;
|
procedure TRestDataModule.DoAllowedOperations(aSender: TObject;
|
||||||
aContext: TBaseRestContext; var aOperations: TRestOperations);
|
aContext: TBaseRestContext; var aOperations: TRestOperations);
|
||||||
begin
|
begin
|
||||||
if IsConsole then
|
if IsConsole then
|
||||||
Writeln('AllowedOperations for ',aContext.UserID);
|
Writeln('[Debug] AllowedOperations for ',aContext.UserID);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TRestDataModule.DoAllowedRecord(aSender: TObject;
|
procedure TRestDataModule.DoAllowedRecord(aSender: TObject;
|
||||||
aContext: TBaseRestContext; aDataSet: TDataset; var allowRecord: Boolean);
|
aContext: TBaseRestContext; aDataSet: TDataset; var allowRecord: Boolean);
|
||||||
begin
|
begin
|
||||||
if IsConsole then
|
if IsConsole then
|
||||||
Writeln('AllowedRecord for ',aContext.UserID);
|
Writeln('[Debug] AllowedRecord for ',aContext.UserID);
|
||||||
|
AllowRecord:=True;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TRestDataModule.DoAllowResource(aSender: TObject;
|
procedure TRestDataModule.DoAllowResource(aSender: TObject;
|
||||||
aContext: TBaseRestContext; var allowResource: Boolean);
|
aContext: TBaseRestContext; var allowResource: Boolean);
|
||||||
begin
|
begin
|
||||||
if IsConsole then
|
if IsConsole then
|
||||||
Writeln('AllowedResource for ',aContext.UserID);
|
Writeln('[Debug] AllowedResource for ',aContext.UserID);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TRestDataModule.DoCheckParams(aSender: TObject;
|
procedure TRestDataModule.DoCheckParams(aSender: TObject;
|
||||||
|
@ -64,7 +64,7 @@
|
|||||||
</SearchPaths>
|
</SearchPaths>
|
||||||
</CompilerOptions>
|
</CompilerOptions>
|
||||||
<Debugging>
|
<Debugging>
|
||||||
<Exceptions Count="3">
|
<Exceptions Count="4">
|
||||||
<Item1>
|
<Item1>
|
||||||
<Name Value="EAbort"/>
|
<Name Value="EAbort"/>
|
||||||
</Item1>
|
</Item1>
|
||||||
@ -74,6 +74,9 @@
|
|||||||
<Item3>
|
<Item3>
|
||||||
<Name Value="EFOpenError"/>
|
<Name Value="EFOpenError"/>
|
||||||
</Item3>
|
</Item3>
|
||||||
|
<Item4>
|
||||||
|
<Name Value="EHTTPRoute"/>
|
||||||
|
</Item4>
|
||||||
</Exceptions>
|
</Exceptions>
|
||||||
</Debugging>
|
</Debugging>
|
||||||
</CONFIG>
|
</CONFIG>
|
||||||
|
@ -3,12 +3,88 @@ program restserver;
|
|||||||
{$mode objfpc}{$H+}
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
uses
|
uses
|
||||||
fphttpapp, dmRestBridge;
|
{$ifdef unix} cwstring, {$endif}
|
||||||
|
sysutils, fphttpapp, dmRestBridge, custApp, fpwebfile;
|
||||||
|
|
||||||
|
Type
|
||||||
|
|
||||||
|
{ TRestHTTPApplication }
|
||||||
|
|
||||||
|
TRestHTTPApplication = class(THTTPApplication)
|
||||||
|
Public
|
||||||
|
Procedure Usage(Msg : String);
|
||||||
|
Procedure DoRun; override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TRestHTTPApplication }
|
||||||
|
|
||||||
|
procedure TRestHTTPApplication.Usage(Msg: String);
|
||||||
|
begin
|
||||||
|
if (Msg<>'') then
|
||||||
|
Writeln('Error : ',msg);
|
||||||
|
Writeln('Usage : ',ChangeFileExt(ExtractFileName(ParamStr(0)),''), '[Options]');
|
||||||
|
Writeln('Where options is one or more of');
|
||||||
|
Writeln('-h --help this message');
|
||||||
|
Writeln('-c --connection=file File with connection definitions');
|
||||||
|
Writeln('-f --files[=Dir] Serve files from directory');
|
||||||
|
Writeln('-i --ini=file File with dispatched settings');
|
||||||
|
Writeln('-p --port=Num Listen on port');
|
||||||
|
Writeln('-q --quiet do not log anything (overrides .ini settings)');
|
||||||
|
{$IFNDEF VER3_0}
|
||||||
|
Writeln('-s --ssl Use SSL protocol');
|
||||||
|
{$Endif}
|
||||||
|
Writeln('-v --verbose Log more (includes SQL logging)');
|
||||||
|
ExitCode:=Ord(Msg<>'');
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TRestHTTPApplication.DoRun;
|
||||||
|
|
||||||
|
Var
|
||||||
|
S,aDir,Header : String;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
Application.CreateForm(TRestDataModule,RestDataModule);
|
|
||||||
Application.Title:='restserver';
|
Application.Title:='restserver';
|
||||||
Application.Port:=8080;
|
S:=CheckOptions('hb:c:i:p:vqf::',['help','base:','connection:','ini:','quiet','verbose','port:','file::']);
|
||||||
|
if (S<>'') or HasOption('h','help') then
|
||||||
|
begin
|
||||||
|
Usage(S);
|
||||||
|
Terminate;
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
Port:=StrToIntDef(GetOptionvalue('p','port'),8080);
|
||||||
|
Header:='Started REST server. listening on port: '+intToStr(Port);
|
||||||
|
{$IFNDEF VER3_0}
|
||||||
|
UseSSL:=Hasoption('s','ssl');
|
||||||
|
if UseSSL then
|
||||||
|
Header:=Header+'; Using SSL');
|
||||||
|
{$Endif}
|
||||||
|
if HasOption('f','file') then
|
||||||
|
begin
|
||||||
|
aDir:=GetOptionValue('f','file');
|
||||||
|
if aDir='' then
|
||||||
|
aDir:=ExtractFilePath(ParamStr(0))
|
||||||
|
else
|
||||||
|
ADir:=IncludeTrailingPathDelimiter(ADir);
|
||||||
|
{$IFNDEF VER3_0}
|
||||||
|
TSimpleFileModule.BaseDir:=aDir;
|
||||||
|
TSimpleFileModule.RegisterDefaultRoute;
|
||||||
|
{$else}
|
||||||
|
RegisterFileLocation('files',aDir);
|
||||||
|
{$Endif}
|
||||||
|
Header:=Header+'; Serving files from: '+aDir;
|
||||||
|
end;
|
||||||
|
If IsConsole then
|
||||||
|
Writeln(Header)
|
||||||
|
else
|
||||||
|
Log(etInfo,Header);
|
||||||
|
inherited DoRun;
|
||||||
|
end;
|
||||||
|
|
||||||
|
begin
|
||||||
|
FreeAndNil(Application);
|
||||||
|
Application:=TRestHTTPApplication.Create(Nil);
|
||||||
|
CustomApplication:=Application;
|
||||||
|
Application.CreateForm(TRestDataModule,RestDataModule);
|
||||||
Application.Initialize;
|
Application.Initialize;
|
||||||
Application.Run;
|
Application.Run;
|
||||||
end.
|
end.
|
||||||
|
Loading…
Reference in New Issue
Block a user