fixed and enhanced TSynLog OnArchive() process

- now also used during file rotation
- properly create unique backup file names
- a lot of fixes to this feature

src/core/mormot.core.log.pas

@@ -519,14 +519,14 @@   TSynLogFamily = class;
   end;
 
   /// this event can be set for a TSynLogFamily to archive any deprecated log
-  // into a custom compressed format
-  // - will be called by TSynLogFamily when TSynLogFamily.Destroy identify
-  // some outdated files
+  // into a custom compressed format, i.e. compress and delete them
+  // - called by TSynLogFamily.Destroy with files older than ArchiveAfterDays,
+  // or by TSynLog.PerformRotation when some rotated files need to be deleted
   // - the aOldLogFileName will contain the .log file with full path
   // - the aDestinationPath parameter will contain 'ArchivePath\log\YYYYMM\'
   // - should return true on success, false on error
   // - example of matching event handler are EventArchiveDelete,
-  // EventArchiveSynLZ, EventArchiveLizard or EventArchiveZip in SynZip.pas
+  // EventArchiveSynLZ, EventArchiveLizard or EventArchiveZip
   // - this event handler will be called one time per .log file to archive,
   // then one last time with aOldLogFileName='' in order to close any pending
   // archive (used e.g. by EventArchiveZip to open the .zip only once)
@@ -660,6 +660,8 @@   TSynLogFamily = class
     procedure SetEchoToConsoleUseJournal(aValue: boolean);
     procedure SetEchoCustom(const aEvent: TOnTextWriterEcho);
     function GetSynLogClassName: string;
+    function ArchiveAndDeleteFile(const aFileName: TFileName): boolean;
+    function GetArchiveDestPath(age: TDateTime): TFileName;
     {$ifndef NOEXCEPTIONINTERCEPT}
     function GetExceptionIgnoreCurrentThread: boolean;
     procedure SetExceptionIgnoreCurrentThread(aExceptionIgnoreCurrentThread: boolean);
@@ -669,8 +671,8 @@   TSynLogFamily = class
     // - add it in the global SynLogFileFamily[] list
     constructor Create(aSynLog: TSynLogClass);
     /// release associated memory
-    // - will archive older DestinationPath\*.log files, according to
-    // ArchiveAfterDays value and ArchivePath
+    // - will also find and archive DestinationPath\*.log files older than
+    // ArchiveAfterDays into ArchivePath
     destructor Destroy; override;
 
     /// retrieve the corresponding log file of this thread and family
@@ -727,16 +729,16 @@   TSynLogFamily = class
     property OnBeforeException: TOnBeforeException
       read fOnBeforeException write fOnBeforeException;
     {$endif NOEXCEPTIONINTERCEPT}
-    /// event called to archive the .log content after a defined delay
-    // - Destroy will parse DestinationPath folder for *.log files matching
-    // ArchiveAfterDays property value
-    // - you can set this property to EventArchiveDelete in order to delete deprecated
-    // files, or EventArchiveSynLZ to compress the .log file into our propertary
-    // SynLZ format: resulting file name will be ArchivePath\log\YYYYMM\*.log.synlz
-    // (use FileUnSynLZ function to uncompress it)
-    // - if you use SynZip.EventArchiveZip, the log files will be archived in
-    // ArchivePath\log\YYYYMM.zip
-    // - the aDestinationPath parameter will contain 'ArchivePath\log\YYYYMM\'
+    /// event called to archive - i.e. compress and delete - .log files
+    // - called by TSynLogFamily.Destroy with files older than ArchiveAfterDays,
+    // or by TSynLog.PerformRotation when some rotated files need to be deleted
+    // - set this property to EventArchiveDelete in order to delete deprecated
+    // files, or EventArchiveSynLZ/EventArchiveLizard to archive the .log files
+    // into our proprietary SynLZ/Lizard format: resulting file name will be
+    // 'ArchivePath\log\YYYYMM\*.log.synlz/synliz' - use AlgoSynLZ.FileUnCompress
+    // or AlgoLizard.FileUnCompress functions to uncompress them
+    // - if you use EventArchiveZip from mormot.core.zip, the log files will be
+    // archived in 'ArchivePath\log\YYYYMM.zip'
     // - this event handler will be called one time per .log file to archive,
     // then one last time with aOldLogFileName='' in order to close any pending
     // archive (used e.g. by EventArchiveZip to open the .zip only once)
@@ -822,6 +824,7 @@   TSynLogFamily = class
       read fCustomFileName write fCustomFileName;
     /// the folder where old log files must be compressed
     // - by default, is in the executable folder, i.e. the same as DestinationPath
+    // - you can use a remote folder (e.g. on a file server) as backup target
     // - the 'log\' sub folder name will always be appended to this value
     // - will then be used by OnArchive event handler to produce, with the
     // current file date year and month, the final path (e.g.
@@ -1460,7 +1463,7 @@   TSynLogSettings = class(TSynPersistent)
   end;
 
 
-/// a TSynLogArchiveEvent handler which will delete older .log files
+/// a TSynLogArchiveEvent handler which will just delete older .log files
 function EventArchiveDelete(
   const aOldLogFileName, aDestinationPath: TFileName): boolean;
 
@@ -3990,19 +3993,58 @@ procedure TSynLogFamily.StartAutoFlush;
     AutoFlushThread := TAutoFlushThread.Create;
 end;
 
+function TSynLogFamily.ArchiveAndDeleteFile(const aFileName: TFileName): boolean;
+var
+  age: TDateTime;
+  dest: TFileName;
+begin
+  result := false;
+  age := FileAgeToDateTime(aFileName);
+  if age = 0 then
+    exit; // not found
+  if Assigned(OnArchive) then
+  begin
+    // we can ignore ArchiveAfterDays because the file is about to be deleted
+    dest := GetArchiveDestPath(age);
+    if dest <> '' then // the archive folder has been created
+    try
+      result := OnArchive(aFileName, dest); // archive and delete
+    finally
+      OnArchive('', dest); // always eventually close .zip
+    end;
+  end
+  else
+    result := DeleteFile(aFileName);
+end;
+
+function TSynLogFamily.GetArchiveDestPath(age: TDateTime): TFileName;
+var
+  Y, M, D: word;
+  tmp: array[0..7] of AnsiChar;
+begin
+  // returns 'ArchivePath\log\YYYYMM\'
+  result := EnsureDirectoryExists(ArchivePath + 'log');
+  if result = '' then
+    exit; // impossible to create the archive folder
+  DecodeDate(age, Y, M, D);
+  YearToPChar(Y, @tmp[0]);
+  PWord(@tmp[4])^ := TwoDigitLookupW[M];
+  PWord(@tmp[6])^ := ord(PathDelim);
+  result := result + Ansi7ToString(tmp, 7);
+end;
+
 destructor TSynLogFamily.Destroy;
 var
   SR: TSearchRec;
   oldTime, aTime: TDateTime;
-  Y, M, D: word;
   aOldLogFileName, aPath: TFileName;
-  tmp: array[0..7] of AnsiChar;
 begin
   fDestroying := true;
   EchoRemoteStop;
   ExceptionIgnore.Free;
   try
     if Assigned(OnArchive) then
+      // search for logs older than ArchiveAfterDays to trigger OnArchive()
       if FindFirst(fDestinationPath + '*' + fDefaultExtension, faAnyFile, SR) = 0 then
       try
         if ArchiveAfterDays < 0 then
@@ -4018,24 +4060,15 @@ destructor TSynLogFamily.Destroy;
             continue;
           aOldLogFileName := fDestinationPath + SR.Name;
           if {%H-}aPath = '' then
-          begin
-            aPath := EnsureDirectoryExists(ArchivePath + 'log');
-            if aPath = '' then
-              break; // impossible to create the archive folder
-            DecodeDate(aTime, Y, M, D);
-            YearToPChar(Y, @tmp[0]);
-            PWord(@tmp[4])^ := TwoDigitLookupW[M];
-            PWord(@tmp[6])^ := ord(PathDelim);
-            aPath := aPath + Ansi7ToString(tmp, 7);
-          end;
-          OnArchive(aOldLogFileName, aPath);
+            aPath := GetArchiveDestPath(aTime);
+          if aPath = '' then
+            break; // impossible to create the archive folder
+          OnArchive(aOldLogFileName, aPath); // archive and delete
         until FindNext(SR) <> 0;
       finally
-        try
-          OnArchive('', aPath); // indicates end of archival (e.g. close .zip)
-        finally
-          FindClose(SR);
-        end;
+        FindClose(SR);
+        if aPath <> '' then     // if OnArchive() was called
+          OnArchive('', aPath); // always eventually close .zip
       end;
   finally
     inherited Destroy;
@@ -5417,6 +5450,7 @@ procedure TSynLog.PerformRotation;
   begin
     if fFamily.fRotateFileCount > 1 then
     begin
+      // rotate e.g. xxx.1.synlz ... xxx.9.synlz files
       ext := '.log';
       if LogCompressAlgo <> nil then
         ext := LogCompressAlgo.AlgoFileExt;
@@ -5429,33 +5463,45 @@ procedure TSynLog.PerformRotation;
           currentMaxSynLZ := i;
       end;
       if currentMaxSynLZ = fFamily.fRotateFileCount - 1 then
-        DeleteFile(FN[currentMaxSynLZ - 1]); // delete e.g. '9.synlz'
+        // delete (and archive) xxx.9.synlz
+        fFamily.ArchiveAndDeleteFile(FN[currentMaxSynLZ - 1]);
       for i := fFamily.fRotateFileCount - 2 downto 1 do
-        RenameFile(FN[i - 1], FN[i]); // e.g. '8.synlz' -> '9.synlz'
-      if (AutoFlushThread <> nil) and
-         (AutoFlushThread.fToCompress = '') and
-         RenameFile(fFileName, FN[0]) then
+        // e.g. xxx.8.synlz -> xxx.9.synlz
+        RenameFile(FN[i - 1], FN[i]);
+      // compress the current .log file into FN[0] = xxx.1.synlz
+      if LogCompressAlgo = nil then
+        // no compression
+        RenameFile(fFileName, FN[0])
+      else if (AutoFlushThread <> nil) and
+              (AutoFlushThread.fToCompress = '') and
+              RenameFile(fFileName, FN[0]) then
       begin
-        AutoFlushThread.fToCompress := FN[0]; // background compression
+        // background compression
+        AutoFlushThread.fToCompress := FN[0];
         AutoFlushThread.fEvent.SetEvent;
       end
       else
-        // blocking compression in the processing thread
+      begin
+        // blocking compression in the main processing thread
         LogCompressAlgo.FileCompress(fFileName, FN[0], LOG_MAGIC, true);
-    end;
-    DeleteFile(fFileName);
+        DeleteFile(fFileName);
+      end;
+    end
+    else
+      fFamily.ArchiveAndDeleteFile(fFileName);
   end;
+  // initialize a brand new log file
   CreateLogWriter;
   LogFileHeader;
   if fFamily.fPerThreadLog = ptIdentifiedInOneFile then
   begin
+    // write the current thread names as TSynLog.LogThreadName lines
     c := pointer(fThreadContexts);
     for i := 1 to fThreadContextCount do
     begin
       if (PtrUInt(c^.ID) <> 0) and
          (c^.ThreadName <> '') then
       begin
-        // generate same output than TSynLog.LogThreadName
         LogCurrentTime;
         fWriter.AddInt18ToChars3(i);
         fWriter.AddShorter(LOG_LEVEL_TEXT[sllInfo]);

src/core/mormot.core.zip.pas

@@ -1982,8 +1982,8 @@ destructor TZipWriteCompressor.Destroy;
 begin
   // flush output compression buffers
   inherited Destroy;
-  if fOwner = nil then
-    exit; // paranoid: if Create() failed
+  if fOwner = nil then // paranoid: if Create() failed
+    exit;
   // set final zip entry state
   with fOwner.Entry[fOwner.Count] do
   begin
@@ -2023,7 +2023,7 @@ function TZipWrite.AddDeflatedStream(const aZipName: TFileName;
     CompressLevel := Z_DEFLATED; // method (if not Z_STORED=0)
   NewEntry(CompressLevel, 0, FileAge);
   WriteHeader(aZipName);
-  // caller now calls TZipWriteCompressor.Write then TZipWriteCompressor.Destroy
+  // caller now makes TZipWriteCompressor.Write then TZipWriteCompressor.Free
 end;
 
 function TZipWrite.AddFolder(const FolderName: TFileName;
@@ -3065,35 +3065,42 @@ function EventArchiveZip(const aOldLogFileName, aDestinationPath: TFileName): bo
       FreeAndNilSafe(EventArchiveZipWrite)
     else
     begin
+      // add aOldLogFileName into the .zip
       age := FileAgeToDateTime(aOldLogFileName);
       if age = 0 then
         exit; // paranoid
-      if EventArchiveZipWrite = nil then // first call: open the .zip
+      // ensure the .zip archive is opened
+      if EventArchiveZipWrite = nil then
         EventArchiveZipWrite := TZipWrite.CreateFrom(
           copy(aDestinationPath, 1, length(aDestinationPath) - 1) + '.zip');
+      // compute readable, but unique timestamped filename in the .zip
       n := EventArchiveZipWrite.Count;
-      zipname := FormatString('%-%.log', [DateTimeToFileShort(age), n]); // unique
+      zipname := FormatString('%-%.log',
+        [DateTimeToFileShort(age), ToHexShort(@n, SizeOf(n))]);
+      // add the file content to the .zip
       if (LogCompressAlgo = nil) or
          not LogCompressAlgo.FileIsCompressed(aOldLogFileName, LOG_MAGIC) then
-        // old file is a plain text log so can be compressed into .zip directly
+        // file is a plain text log so can be directly compressed into .zip
         EventArchiveZipWrite.AddDeflated(
           aOldLogFileName, false, EventArchiveZipCompressLevel, zipname)
       else
       begin
-        // decompress and recompress the .synlz old file into .zip
+        // decompress and re-compress the .synlz/.synliz content into .zip
         s := FileStreamSequentialRead(aOldLogFileName);
         try
           z := EventArchiveZipWrite.AddDeflatedStream(zipname,
              DateTimeToWindowsFileTime(age), EventArchiveZipCompressLevel);
           try
+            // re-compression is done for each TAlgoCompress chunk
             LogCompressAlgo.StreamUnCompress(s, z, LOG_MAGIC, {hash32=}true);
           finally
-            z.Free;
+            z.Free; // finalize the .zip entry
           end;
         finally
           s.Free;
         end;
       end;
+      // eventually delete the archived log file
       if (EventArchiveZipWrite.Count = n + 1) and
          DeleteFile(aOldLogFileName) then
         result := true;

src/mormot.commit.inc

@@ -1 +1 @@
-'2.2.6651'
+'2.2.6652'