diff --git a/src/core/mormot.core.log.pas b/src/core/mormot.core.log.pas index c78707b8e..445b0697a 100644 --- a/src/core/mormot.core.log.pas +++ b/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]); diff --git a/src/core/mormot.core.zip.pas b/src/core/mormot.core.zip.pas index 6c7b884d3..0d88368a3 100644 --- a/src/core/mormot.core.zip.pas +++ b/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; diff --git a/src/mormot.commit.inc b/src/mormot.commit.inc index ee336a9d1..837df4e6d 100644 --- a/src/mormot.commit.inc +++ b/src/mormot.commit.inc @@ -1 +1 @@ -'2.2.6651' +'2.2.6652'