Permalink
Browse files

enhanced logged information

especially when no .map/.mab information is available or under FPC
  • Loading branch information...
Arnaud Bouchez
Arnaud Bouchez committed Feb 2, 2018
1 parent 4c99304 commit 4b7786c3be0d1aec5abaad26f9de90e58edcce16
@@ -767,7 +767,7 @@ procedure TDDDDaemon.DoStart(Sender: TService);
begin
{$ifdef WITHLOG}
SQLite3Log.Add.LogThreadName('Service Start Handler', true);
log := SQLite3Log.Enter(self);
log := SQLite3Log.Enter(self, 'DoStart');
with ExeVersion do
log.Log(sllNewRun, 'Daemon Start svc=% ver=% usr=%',
[fSettings.ServiceName, Version.Detailed, LowerCase(User)], self);
@@ -779,13 +779,16 @@ procedure TDDDDaemon.DoStart(Sender: TService);
end;
procedure TDDDDaemon.DoStop(Sender: TService);
{$ifdef WITHLOG}
var log: ISynLog;
begin
{$ifdef WITHLOG}
SQLite3Log.Add.LogThreadName('Service Stop Handler', true);
SQLite3Log.Enter(self).
Log(sllNewRun, 'Daemon Stop svc=% ver=% usr=%', [fSettings.ServiceName,
ExeVersion.Version.Detailed, LowerCase(ExeVersion.User)], self);
{$endif}
log := SQLite3Log.Enter(self, 'DoStop');
log.Log(sllNewRun, 'Daemon Stop svc=% ver=% usr=%', [fSettings.ServiceName,
ExeVersion.Version.Detailed, LowerCase(ExeVersion.User)], self);
{$else}
begin
{$endif}
fDaemon := nil; // will stop the daemon
end;
@@ -808,10 +811,13 @@ function TDDDDaemon.NewDaemon: TDDDAdministratedDaemon;
end;
procedure TDDDDaemon.Execute;
{$ifdef WITHLOG}
var log: ISynLog;
begin
{$ifdef WITHLOG}
SQLite3Log.Enter(self);
{$endif}
log := SQLite3Log.Enter(self, 'Execute');
{$else}
begin
{$endif}
fDaemon := NewDaemon;
fDaemon.Start;
end;
@@ -1298,10 +1304,13 @@ destructor TDDDSocketThread.Destroy;
end;
procedure TDDDSocketThread.ExecuteConnect;
{$ifdef WITHLOG}
var log: ISynLog;
begin
{$ifdef WITHLOG}
FLog.Enter('ExecuteConnect %:%',[fHost,fPort],self);
{$endif}
log := FLog.Enter('ExecuteConnect %:%',[fHost,fPort],self);
{$else}
begin
{$endif}
if fSocket <> nil then
raise EDDDInfraException.CreateUTF8('%.ExecuteConnect: fSocket<>nil', [self]);
if fMonitoring.State <> tpsDisconnected then
@@ -1320,14 +1329,14 @@ procedure TDDDSocketThread.ExecuteConnect;
fMonitoring.State := tpsConnected; // to be done ASAP to allow sending
InternalExecuteConnected;
{$ifdef WITHLOG}
FLog.Log(sllTrace, 'ExecuteConnect: Connected via Socket % - %',
log.Log(sllTrace, 'ExecuteConnect: Connected via Socket % - %',
[fSocket.Identifier, fMonitoring], self);
{$endif}
except
on E: Exception do begin
fMonitoring.ProcessException(E);
{$ifdef WITHLOG}
FLog.Log(sllTrace, 'ExecuteConnect: Impossible to Connect to %:% (%) %',
log.Log(sllTrace, 'ExecuteConnect: Impossible to Connect to %:% (%) %',
[Host, Port, E.ClassType, fMonitoring], self);
{$endif}
fSocket := nil;
@@ -1340,19 +1349,22 @@ procedure TDDDSocketThread.ExecuteConnect;
else if fSettings.ConnectionAttemptsInterval > 0 then // on error, retry
if SleepOrTerminated(fSettings.ConnectionAttemptsInterval * 1000) then
{$ifdef WITHLOG}
FLog.Log(sllTrace, 'ExecuteConnect: thread terminated', self)
log.Log(sllTrace, 'ExecuteConnect: thread terminated', self)
else
FLog.Log(sllTrace, 'ExecuteConnect: wait finished -> retry connect', self)
log.Log(sllTrace, 'ExecuteConnect: wait finished -> retry connect', self)
{$endif};
end;
procedure TDDDSocketThread.ExecuteDisconnect;
var
info: RawUTF8;
{$ifdef WITHLOG}
log: ISynLog;
begin
{$ifdef WITHLOG}
FLog.Enter('ExecuteDisconnect %:%',[fHost,fPort],self);
{$endif}
log := FLog.Enter('ExecuteDisconnect %:%',[fHost,fPort],self);
{$else}
begin
{$endif}
try
fSafe.Lock;
try
@@ -1368,7 +1380,7 @@ procedure TDDDSocketThread.ExecuteDisconnect;
fSocket := nil;
end;
{$ifdef WITHLOG}
FLog.Log(sllTrace, 'Socket % disconnected', [info], self);
log.Log(sllTrace, 'Socket % disconnected', [info], self);
{$endif}
InternalLogMonitoring;
finally
@@ -1378,7 +1390,7 @@ procedure TDDDSocketThread.ExecuteDisconnect;
on E: Exception do begin
fMonitoring.ProcessException(E);
{$ifdef WITHLOG}
FLog.Log(sllTrace, 'Socket disconnection error (%)', [E.ClassType], self);
log.Log(sllTrace, 'Socket disconnection error (%)', [E.ClassType], self);
{$endif}
end;
end;
@@ -2031,28 +2043,28 @@ function TDDDAdministratedDaemonAsProxy.StartProxy(const aDDDRestClientSettings:
begin
CqrsBeginMethod(qaNone, result);
if (fProxy <> nil) or (fProxyClient <> nil) then begin
CqrsSetResult(cqrsAlreadyExists);
CqrsSetResult(cqrsAlreadyExists,result);
exit;
end;
def := TDDDRestClientSettings.Create;
try
JSONToObject(def, pointer(VariantSaveJSON(aDDDRestClientSettings)), valid);
if not valid then begin
CqrsSetResultMsg(cqrsBadRequest, '%.StartProxy(%): invalid def', [self,
aDDDRestClientSettings]);
aDDDRestClientSettings],result);
exit;
end;
try
fProxyClient := AdministratedDaemonClient(def);
if not fProxyClient.Services.Resolve(IAdministratedDaemon, fProxy) then
raise EDDDRestClient.CreateUTF8('%.StartProxy(%): IAdministratedDaemon not supported',
[self, aDDDRestClientSettings]);
CqrsSetResult(cqrsSuccess);
CqrsSetResult(cqrsSuccess,result);
except
on E: Exception do begin
fProxy := nil;
FreeAndNil(fProxyClient);
CqrsSetResult(E);
CqrsSetResult(E,result);
end;
end;
finally
@@ -2227,6 +2239,7 @@ constructor TDDDRestClientWebSockets.Create(aSettings: TDDDRestClientSettings;
var
u: TURI;
t: integer;
log: ISynLog;
begin
DefineApplication; // should fill fApplicationName
fOnFailed := ClientFailed;
@@ -2239,7 +2252,7 @@ constructor TDDDRestClientWebSockets.Create(aSettings: TDDDRestClientSettings;
if not u.From(aSettings.ORM.ServerName) then
raise EDDDRestClient.CreateUTF8('%.Create(%): invalid ORM.ServerName=%',
[self, fApplicationName, aSettings.ORM.ServerName]);
SQLite3Log.Enter('Create(%): connect to %', [fApplicationName, aSettings.ORM.ServerName], self);
log := SQLite3Log.Enter('Create(%): connect to %', [fApplicationName, aSettings.ORM.ServerName], self);
t := aSettings.Timeout;
inherited Create(u.Server, u.Port, CreateModel(aSettings), t, t, t);
Model.Owner := self; // just allocated by CreateModel()
@@ -2256,7 +2269,7 @@ constructor TDDDRestClientWebSockets.Create(aSettings: TDDDRestClientSettings;
destructor TDDDRestClientWebSockets.Destroy;
begin
fLogClass.Enter(self);
with fLogClass.Enter(self, 'Destroy') do
try
ClientDisconnect;
finally
View
@@ -38981,8 +38981,8 @@ procedure TSQLRestServer.Shutdown(const aStateFileName: TFileName);
if fSessions=nil then
exit; // avoid GPF e.g. in case of missing sqlite3-64.dll
{$ifdef WITHLOG}
log := fLogClass.Enter('Shutdown CurrentRequestCount=% File=%',
[fStats.AddCurrentRequestCount(0),aStateFileName],self);
log := fLogClass.Enter('Shutdown(%) % CurrentRequestCount=%',
[aStateFileName,fModel.Root,fStats.AddCurrentRequestCount(0)],self);
{$endif}
OnNotifyCallback := nil;
fSessions.Safe.Lock;
@@ -44301,7 +44301,7 @@ procedure CreatePipe;
end;
begin
{$ifdef WITHLOG}
log := fLogClass.Enter(self);
log := fLogClass.Enter(self, 'InternalCheckOpen');
{$endif}
{$ifdef ANONYMOUSNAMEDPIPE}
if not ImpersonateAnonymousToken(GetCurrentThread) then
@@ -44372,7 +44372,7 @@ procedure TSQLRestClientURINamedPipe.InternalURI(var Call: TSQLRestURIParams);
{$endif}
begin
{$ifdef WITHLOG}
log := fLogClass.Enter(self);
log := fLogClass.Enter(self, 'InternalURI');
{$endif}
Call.OutStatus := HTTP_NOTIMPLEMENTED; // 501 (no valid application or library)
fSafe.Enter;
@@ -49607,7 +49607,7 @@ procedure TSQLRestClientURIMessage.InternalURI(var Call: TSQLRestURIParams);
{$endif}
begin
{$ifdef WITHLOG}
log := fLogClass.Enter(self);
log := fLogClass.Enter(self, 'InternalURI');
{$endif}
if (fClientWindow=0) or not InternalCheckOpen then begin
Call.OutStatus := HTTP_NOTIMPLEMENTED; // 501
@@ -577,11 +577,12 @@ function ToText(sec: TSQLHttpServerSecurity): PShortString;
function TSQLHttpServer.AddServer(aServer: TSQLRestServer;
aRestAccessRights: PSQLAccessRights; aHttpServerSecurity: TSQLHttpServerSecurity): boolean;
var i,n: integer;
log: ISynLog;
begin
result := False;
if (self=nil) or (aServer=nil) or (aServer.Model=nil) then
exit;
fLog.Enter(self);
log := fLog.Enter(self, 'AddServer');
fDBServersSafe.Enter;
try
n := length(fDBServers);
@@ -601,8 +602,8 @@ function TSQLHttpServer.AddServer(aServer: TSQLRestServer;
result := true;
finally
fDBServersSafe.Leave;
fLog.Add.Log(sllHttp,'%.AddServer(%,Root=%,Port=%,Public=%:%)=%',
[self,aServer,aServer.Model.Root,fPort,fPublicAddress,fPublicPort,
log.Log(sllHttp,'AddServer(%,Root=%,Port=%,Public=%:%)=%',
[aServer,aServer.Model.Root,fPort,fPublicAddress,fPublicPort,
BOOL_STR[result]],self);
end;
end;
@@ -622,11 +623,12 @@ function TSQLHttpServer.DBServerFind(aServer: TSQLRestServer): integer;
function TSQLHttpServer.RemoveServer(aServer: TSQLRestServer): boolean;
var i,j,n: integer;
log: ISynLog;
begin
result := False;
if (self=nil) or (aServer=nil) or (aServer.Model=nil) then
exit;
fLog.Enter(self);
log := fLog.Enter(self, 'RemoveServer');
fDBServersSafe.Enter;
try
n := high(fDBServers);
@@ -636,7 +638,7 @@ function TSQLHttpServer.RemoveServer(aServer: TSQLRestServer): boolean;
if fHttpServer.InheritsFrom(THttpApiServer) then
if THttpApiServer(fHttpServer).RemoveUrl(aServer.Model.Root,fPublicPort,
fDBServers[i].Security=secSSL,fDomainName)<>NO_ERROR then
fLog.Add.Log(sllLastError,'%.RemoveUrl(%)',[self,aServer.Model.Root],self);
log.Log(sllLastError,'%.RemoveUrl(%)',[self,aServer.Model.Root],self);
{$endif}
for j := i to n-1 do
fDBServers[j] := fDBServers[j+1];
@@ -648,7 +650,7 @@ function TSQLHttpServer.RemoveServer(aServer: TSQLRestServer): boolean;
end;
finally
fDBServersSafe.Leave;
fLog.Add.Log(sllHttp,'%.RemoveServer(Root=%)=%',
log.Log(sllHttp,'%.RemoveServer(Root=%)=%',
[self,aServer.Model.Root,BOOL_STR[result]],self);
end;
end;
@@ -668,12 +670,13 @@ constructor TSQLHttpServer.Create(const aPort: AnsiString;
var i,j: integer;
ServersRoot: RawUTF8;
ErrMsg: RawUTF8;
log: ISynLog;
begin
{$ifdef WITHLOG} // this is the only place where we check for WITHLOG
if high(aServers)<0 then
fLog := TSQLLog else
fLog := aServers[0].LogClass;
fLog.Enter('Create % (%) on port %',[ToText(aHttpServerKind)^,
log := fLog.Enter('Create % (%) on port %',[ToText(aHttpServerKind)^,
ToText(aHttpServerSecurity)^,aPort],self);
{$endif}
fDBServersSafe := TAutoLocker.Create;
@@ -722,7 +725,7 @@ constructor TSQLHttpServer.Create(const aPort: AnsiString;
fHttpServerKind=useHttpApiRegisteringURI,true);
except
on E: Exception do begin
fLog.Add.Log(sllError,'% for % at% -> fallback to socket-based server',
log.Log(sllError,'% for % at% -> fallback to socket-based server',
[E,fHttpServer,ServersRoot],self);
FreeAndNil(fHttpServer); // if http.sys initialization failed
end;
@@ -759,7 +762,7 @@ constructor TSQLHttpServer.Create(const aPort: AnsiString;
if fHttpServer.CanNotifyCallback then
for i := 0 to high(fDBServers) do
fDBServers[i].Server.OnNotifyCallback := NotifyCallback;
fLog.Add.Log(sllHttp,'% initialized for%',[fHttpServer,ServersRoot],self);
log.Log(sllHttp,'% initialized for%',[fHttpServer,ServersRoot],self);
end;
constructor TSQLHttpServer.Create(const aPort: AnsiString;
@@ -775,8 +778,9 @@ constructor TSQLHttpServer.Create(const aPort: AnsiString;
end;
destructor TSQLHttpServer.Destroy;
var log: ISynLog;
begin
fLog.Enter(self);
log := fLog.Enter(self, 'Destroy');
fLog.Add.Log(sllHttp,'% finalized for %',[fHttpServer,
Plural('server',length(fDBServers))],self);
Shutdown(true); // but don't call fDBServers[i].Server.Shutdown
@@ -786,9 +790,10 @@ destructor TSQLHttpServer.Destroy;
procedure TSQLHttpServer.Shutdown(noRestServerShutdown: boolean);
var i: integer;
log: ISynLog;
begin
if (self<>nil) and not fShutdownInProgress then begin
fLog.Enter('Shutdown(%)',[BOOL_STR[noRestServerShutdown]],self);
log := fLog.Enter('Shutdown(%)',[BOOL_STR[noRestServerShutdown]],self);
fShutdownInProgress := true;
fHttpServer.Shutdown;
fDBServersSafe.Enter;
@@ -1135,7 +1135,7 @@ destructor TSQLRestServerDB.Destroy;
{$ifdef WITHLOG}
Log: ISynLog;
begin
Log := fLogClass.Enter(self);
Log := fLogClass.Enter(self, 'Destroy');
{$else}
begin
{$endif}
@@ -2714,8 +2714,6 @@ procedure TSQLRestStorageShardDB.InitShards;
end;
function RegisterVirtualTableModule(aModule: TSQLVirtualTableClass; aDatabase: TSQLDataBase): TSQLVirtualTableModule;
begin
result := TSQLVirtualTableModuleSQLite3.Create(aModule,nil);
@@ -886,8 +886,9 @@ destructor TService.Destroy;
end;
procedure TService.DoCtrlHandle(Code: DWORD);
var log: ISynLog;
begin
ServiceLog.Enter(self);
log := ServiceLog.Enter(self, 'DoCtrlHandle');
ServiceLog.Add.Log(sllInfo,'%: command % received from OS',[ServiceName,Code],self);
try
case Code of
View
@@ -2261,7 +2261,7 @@ destructor TWebSocketProcess.Destroy;
timeout: Int64;
log: ISynLog;
begin
log := WebSocketLog.Enter(self);
log := WebSocketLog.Enter(self, 'Destroy');
if (fState<>wpsClose) and not fNoConnectionCloseAtDestroy then
try
InterlockedIncrement(fProcessCount);
@@ -3605,7 +3605,7 @@ procedure TAsynchConnections.IdleEverySecond;
if fConnection[i].fLastOperation<allowed then
try
if log=nil then
log := fLog.Enter(self);
log := fLog.Enter(self, 'IdleEverySecond');
fConnection[i].OnLastOperationIdle(self);
inc(n);
except
View
@@ -6783,7 +6783,6 @@ procedure TSQLDBStatement.SetForceDateWithMS(value: boolean);
constructor TSQLDBStatement.Create(aConnection: TSQLDBConnection);
begin
// SynDBLog.Enter(self);
inherited Create;
fConnection := aConnection;
fStripSemicolon := true;
Oops, something went wrong.

0 comments on commit 4b7786c

Please sign in to comment.