mORMot and Open Source friends
Check-in [80a92148c9]
Not logged in
Home Documentation Forum Download Blog Donate Timeline Tickets Wiki Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:{4915} added aThreadName parameter to TSynLogFamily.OnBeforeException callback
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 80a92148c91549d19d1f5289f6e7c3133859204a
User & Date: ab 2018-12-14 09:00:02
Context
2018-12-14
16:55
{4916} published PDynArrayRec to allow TDynArray.GetCount inlining check-in: 6c70430e85 user: ab tags: trunk
09:00
{4915} added aThreadName parameter to TSynLogFamily.OnBeforeException callback check-in: 80a92148c9 user: ab tags: trunk
2018-12-13
21:20
{4914} new GetDiskPartitions/GetDiskPartitionsText functions check-in: 28090d8b33 user: ab tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to SynLog.pas. 

424
425
426
427
428
429
430
431

432
433
434
435
436
437
438
...
562
563
564
565
566
567
568

569
570
571
572
573
574
575
....
2624
2625
2626
2627
2628
2629
2630

2631
2632
2633
2634
2635
2636
2637
....
2641
2642
2643
2644
2645
2646
2647
2648



2649


2650
2651

2652
2653

2654
2655
2656
2657
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700

2701

2702
2703

2704
2705
2706
2707
2708
2709
2710
....
3684
3685
3686
3687
3688
3689
3690
3691
3692
3693
3694
3695
3696
3697
3698

  TSynLogStackTraceUse = (stManualAndAPI,stOnlyAPI,stOnlyManual);

  /// how file existing shall be handled during logging
  TSynLogExistsAction = (acOverwrite, acAppend);

  /// callback signature used by TSynLogFamilly.OnBeforeException
  // - should return false to log the exception, or true to ignore it
  TSynLogOnBeforeException = function(aExceptionContext: TSynLogExceptionContext): boolean of object;


  /// store simple log-related settings
  // - see also TDDDLogSettings in dddInfraSettings.pas and TSynDaemonSettings
  // in mORMotService.pas, which may be more integrated
  TSynLogSettings = class(TSynPersistent)
  protected
    fLevels: TSynLogInfos;
................................................................................
    /// you can add some exceptions to be ignored to this list
    // - for instance, EConvertError may be added to the list, as such:
    // ! TSQLLog.Family.ExceptionIgnore.Add(EConvertError);
    // - you may also trigger ESynLogSilent exceptions for silent process
    property ExceptionIgnore: TList read fExceptionIgnore;
    /// you can let exceptions be ignored from a callback
    // - if set and returns true, the given exception won't be logged

    // - may be handy e.g. when working with code triggerring a lot of
    // exceptions (e.g. Indy), where ExceptionIgnore could be refined
    property OnBeforeException: TSynLogOnBeforeException
      read fOnBeforeException write fOnBeforeException;
    /// event called to archive the .log content after a defined delay
    // - Destroy will parse DestinationPath folder for *.log files matching
    // ArchiveAfterDays property value
................................................................................
      finally
        SynLogFileList.Safe.UnLock;
      end;
    end;
  end;
var SynLog: TSynLog;
    info: ^TSynLogExceptionInfo;

    {$ifdef FPC}i: integer;{$endif}
label adr,fin;
begin
  {$ifdef CPU64DELPHI} // Delphi<XE6 in System.pas to retrieve x64 dll exit code
  {$ifndef ISDELPHIXE6}
  if (Ctxt.EInstance<>nil) and // Ctxt.EClass is EExternalException
     (PShortString(PPointer(PPtrInt(Ctxt.EInstance)^+vmtClassName)^)^=
................................................................................
  {$endif CPU64DELPHI}
  SynLog := GlobalCurrentHandleExceptionSynLog;
  if (SynLog=nil) or not SynLog.fFamily.fHandleExceptions then
    SynLog := GetHandleExceptionSynLog;
  if (SynLog=nil) or not (Ctxt.ELevel in SynLog.fFamily.Level) then
    exit;
  if (Ctxt.EClass=ESynLogSilent) or
     (SynLog.fFamily.ExceptionIgnore.IndexOf(Ctxt.EClass)>=0) or



     (Assigned(SynLog.fFamily.OnBeforeException) and


      SynLog.fFamily.OnBeforeException(Ctxt)) then
    exit;

  if SynLog.LogHeaderLock(Ctxt.ELevel,false) then
  try

    if GlobalLastExceptionIndex=MAX_EXCEPTHISTORY then
      GlobalLastExceptionIndex := 0 else
      inc(GlobalLastExceptionIndex);
    info := @GlobalLastException[GlobalLastExceptionIndex];
    info^.Context := Ctxt;
    {$ifdef FPC}
    if @BackTraceStrFunc<>@SysBackTraceStr then
      ShortStringToAnsi7String(BackTraceStrFunc(pointer(Ctxt.EAddr)),info^.Addr) else
    {$endif FPC}
      info^.Addr := '';
    if (Ctxt.ELevel=sllException) and (Ctxt.EInstance<>nil) then begin
      info^.Message := Ctxt.EInstance.Message;
      if Ctxt.EInstance.InheritsFrom(ESynException) then begin
        ESynException(Ctxt.EInstance).RaisedAt := pointer(Ctxt.EAddr);
        if ESynException(Ctxt.EInstance).CustomLog(SynLog.fWriter,Ctxt) then
          goto fin;
        goto adr;
      end;
    end else
      info^.Message := '';
    if Assigned(DefaultSynLogExceptionToStr) and
       DefaultSynLogExceptionToStr(SynLog.fWriter,Ctxt) then
      goto fin;
adr:SynLog.fWriter.AddShort(' at ');
    {$ifdef FPC} // note: BackTraceStrFunc is slower than TSynMapFile.Log
    with SynLog.fWriter do
    if @BackTraceStrFunc=@SysBackTraceStr then begin // no debug information
      AddPointer(Ctxt.EAddr); // write addresses as hexa
      for i := 0 to Ctxt.EStackCount-1 do
        if (i=0) or (Ctxt.EStack[i]<>Ctxt.EStack[i-1]) then begin
          Add(' ');
          AddPointer(Ctxt.EStack[i]);
        end;
    end else begin
      AddString(info^.Addr);
      for i := 0 to Ctxt.EStackCount-1 do
        if (i=0) or (Ctxt.EStack[i]<>Ctxt.EStack[i-1]) then
          AddShort(BackTraceStrFunc(pointer(Ctxt.EStack[i])));
    end;
    {$else}
    TSynMapFile.Log(SynLog.fWriter,Ctxt.EAddr,true);
    {$ifndef WITH_VECTOREXCEPT} // stack frame OK for RTLUnwindProc by now
    SynLog.AddStackTrace(Ctxt.EStack);
    {$endif}
    {$endif FPC}
fin:SynLog.fWriter.AddEndOfLine(SynLog.fCurrentLevel);
    SynLog.fWriter.FlushToStream; // we expect exceptions to be available on disk

  finally

    GlobalCurrentHandleExceptionSynLog := SynLog.fThreadHandleExceptionBackup;
    LeaveCriticalSection(GlobalThreadLock);

  end;
end;

{$ifdef WITH_PATCHEXCEPT}

var
  // Delphi 5 doesn't define the needed RTLUnwindProc variable :(
................................................................................
  fThreadContext^.ID := fThreadID;
end;

procedure TSynLog.ThreadContextRehash;
var i: integer;
    id, hash: PtrUInt;
    secondpass: boolean;
    ctxt: ^TSynLogThreadContext;
begin // should match TSynLog.GetThreadContextInternal
  if fFamily.fPerThreadLog=ptNoThreadProcess then
    exit;
  FillcharFast(fThreadHash[0],MAXLOGTHREAD*sizeof(fThreadHash[0]),0);
  ctxt := pointer(fThreadContexts);
  for i := 1 to fThreadContextCount do begin
    id := PtrUInt(ctxt^.ID); // TThreadID  = ^TThreadRec under BSD







|
>







 







>







 







>







 







|
>
>
>
|
>
>
|
|
>
|
<
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
>

>
|
|
>







 







|








424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
...
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
....
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
....
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661

2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
....
3696
3697
3698
3699
3700
3701
3702
3703
3704
3705
3706
3707
3708
3709
3710

  TSynLogStackTraceUse = (stManualAndAPI,stOnlyAPI,stOnlyManual);

  /// how file existing shall be handled during logging
  TSynLogExistsAction = (acOverwrite, acAppend);

  /// callback signature used by TSynLogFamilly.OnBeforeException
  // - should return false to log the exception, or true to ignore it
  TSynLogOnBeforeException = function(aExceptionContext: TSynLogExceptionContext;
    const aThreadName: RawUTF8): boolean of object;

  /// store simple log-related settings
  // - see also TDDDLogSettings in dddInfraSettings.pas and TSynDaemonSettings
  // in mORMotService.pas, which may be more integrated
  TSynLogSettings = class(TSynPersistent)
  protected
    fLevels: TSynLogInfos;
................................................................................
    /// you can add some exceptions to be ignored to this list
    // - for instance, EConvertError may be added to the list, as such:
    // ! TSQLLog.Family.ExceptionIgnore.Add(EConvertError);
    // - you may also trigger ESynLogSilent exceptions for silent process
    property ExceptionIgnore: TList read fExceptionIgnore;
    /// you can let exceptions be ignored from a callback
    // - if set and returns true, the given exception won't be logged
    // - execution of this event handler is protected via the logs global lock
    // - may be handy e.g. when working with code triggerring a lot of
    // exceptions (e.g. Indy), where ExceptionIgnore could be refined
    property OnBeforeException: TSynLogOnBeforeException
      read fOnBeforeException write fOnBeforeException;
    /// event called to archive the .log content after a defined delay
    // - Destroy will parse DestinationPath folder for *.log files matching
    // ArchiveAfterDays property value
................................................................................
      finally
        SynLogFileList.Safe.UnLock;
      end;
    end;
  end;
var SynLog: TSynLog;
    info: ^TSynLogExceptionInfo;
    locked: boolean;
    {$ifdef FPC}i: integer;{$endif}
label adr,fin;
begin
  {$ifdef CPU64DELPHI} // Delphi<XE6 in System.pas to retrieve x64 dll exit code
  {$ifndef ISDELPHIXE6}
  if (Ctxt.EInstance<>nil) and // Ctxt.EClass is EExternalException
     (PShortString(PPointer(PPtrInt(Ctxt.EInstance)^+vmtClassName)^)^=
................................................................................
  {$endif CPU64DELPHI}
  SynLog := GlobalCurrentHandleExceptionSynLog;
  if (SynLog=nil) or not SynLog.fFamily.fHandleExceptions then
    SynLog := GetHandleExceptionSynLog;
  if (SynLog=nil) or not (Ctxt.ELevel in SynLog.fFamily.Level) then
    exit;
  if (Ctxt.EClass=ESynLogSilent) or
     (SynLog.fFamily.ExceptionIgnore.IndexOf(Ctxt.EClass)>=0) then
    exit;
  locked := false;
  try
    if Assigned(SynLog.fFamily.OnBeforeException) then begin
      SynLog.LockAndGetThreadContext; // protect and set fThreadContext
      locked := true;
      if SynLog.fFamily.OnBeforeException(Ctxt,SynLog.fThreadContext^.ThreadName) then
        exit;
    end;
    if SynLog.LogHeaderLock(Ctxt.ELevel,locked) then begin

      locked := true;
      if GlobalLastExceptionIndex=MAX_EXCEPTHISTORY then
        GlobalLastExceptionIndex := 0 else
        inc(GlobalLastExceptionIndex);
      info := @GlobalLastException[GlobalLastExceptionIndex];
      info^.Context := Ctxt;
      {$ifdef FPC}
      if @BackTraceStrFunc<>@SysBackTraceStr then
        ShortStringToAnsi7String(BackTraceStrFunc(pointer(Ctxt.EAddr)),info^.Addr) else
      {$endif FPC}
        info^.Addr := '';
      if (Ctxt.ELevel=sllException) and (Ctxt.EInstance<>nil) then begin
        info^.Message := Ctxt.EInstance.Message;
        if Ctxt.EInstance.InheritsFrom(ESynException) then begin
          ESynException(Ctxt.EInstance).RaisedAt := pointer(Ctxt.EAddr);
          if ESynException(Ctxt.EInstance).CustomLog(SynLog.fWriter,Ctxt) then
            goto fin;
          goto adr;
        end;
      end else
        info^.Message := '';
      if Assigned(DefaultSynLogExceptionToStr) and
         DefaultSynLogExceptionToStr(SynLog.fWriter,Ctxt) then
        goto fin;
adr:  SynLog.fWriter.AddShort(' at ');
      {$ifdef FPC} // note: BackTraceStrFunc is slower than TSynMapFile.Log
      with SynLog.fWriter do
      if @BackTraceStrFunc=@SysBackTraceStr then begin // no debug information
        AddPointer(Ctxt.EAddr); // write addresses as hexa
        for i := 0 to Ctxt.EStackCount-1 do
          if (i=0) or (Ctxt.EStack[i]<>Ctxt.EStack[i-1]) then begin
            Add(' ');
            AddPointer(Ctxt.EStack[i]);
          end;
      end else begin
        AddString(info^.Addr);
        for i := 0 to Ctxt.EStackCount-1 do
          if (i=0) or (Ctxt.EStack[i]<>Ctxt.EStack[i-1]) then
            AddShort(BackTraceStrFunc(pointer(Ctxt.EStack[i])));
      end;
      {$else}
      TSynMapFile.Log(SynLog.fWriter,Ctxt.EAddr,true);
      {$ifndef WITH_VECTOREXCEPT} // stack frame OK for RTLUnwindProc by now
      SynLog.AddStackTrace(Ctxt.EStack);
      {$endif}
      {$endif FPC}
fin:  SynLog.fWriter.AddEndOfLine(SynLog.fCurrentLevel);
      SynLog.fWriter.FlushToStream; // we expect exceptions to be available on disk
    end;
  finally
    if locked then begin
      GlobalCurrentHandleExceptionSynLog := SynLog.fThreadHandleExceptionBackup;
      LeaveCriticalSection(GlobalThreadLock);
    end;
  end;
end;

{$ifdef WITH_PATCHEXCEPT}

var
  // Delphi 5 doesn't define the needed RTLUnwindProc variable :(
................................................................................
  fThreadContext^.ID := fThreadID;
end;

procedure TSynLog.ThreadContextRehash;
var i: integer;
    id, hash: PtrUInt;
    secondpass: boolean;
    ctxt: PSynLogThreadContext;
begin // should match TSynLog.GetThreadContextInternal
  if fFamily.fPerThreadLog=ptNoThreadProcess then
    exit;
  FillcharFast(fThreadHash[0],MAXLOGTHREAD*sizeof(fThreadHash[0]),0);
  ctxt := pointer(fThreadContexts);
  for i := 1 to fThreadContextCount do begin
    id := PtrUInt(ctxt^.ID); // TThreadID  = ^TThreadRec under BSD

Changes to SynopseCommit.inc. 

1

'1.18.4914'

|

1

'1.18.4915'

©2010-2022 Synopse Informatique