diff --git a/README.md b/README.md index f39e5ec..001d725 100644 --- a/README.md +++ b/README.md @@ -2,8 +2,8 @@ `simple-log` is a small convenience layer on top of Racket's logging system. It provides generated procedures for the standard log levels and supports -logging to the display, a file, custom callbacks, and a filterable in-memory -store. +logging to the display, regular or daily rotating files, custom callbacks, and +a filterable in-memory store. ```racket #lang racket @@ -31,3 +31,22 @@ Topic filters can select multiple topics or invert a match: The Scribble manual documents logger definitions, destinations, log levels, synchronization, and all in-memory store operations. +## Rotating log files + +Daily rotation keeps the current log as plain text and gzip-compresses older +days. The retention value counts the current day as well. + +```racket +(sl-log-to-rotating-file "application.log") ; 7 days +(sl-log-to-rotating-file "application.log" 14) ; 14 days +``` + +With a retention of 7 days the files look like this: + +```text +application.log +application.log.2026-08-28.gz +application.log.2026-08-27.gz +... +``` + diff --git a/info.rkt b/info.rkt index f2d5f5e..9aea6c6 100644 --- a/info.rkt +++ b/info.rkt @@ -1,7 +1,7 @@ #lang info (define pkg-authors '(hnmdijkema)) -(define version "0.2.2") +(define version "0.2.3") (define license 'MIT) (define collection "simple-log") (define pkg-desc "simple-log - A simple wrapper around the racket logging system") diff --git a/main.rkt b/main.rkt index 3471c07..904fbd5 100644 --- a/main.rkt +++ b/main.rkt @@ -7,11 +7,13 @@ data/queue "private/loghash.rkt" "private/store.rkt" + "private/rotating-file.rkt" ) (provide sl-def-log sl-log-to sl-log-to-file + sl-log-to-rotating-file sl-log-to-display sl-log-to-store sl-log-to-file&display @@ -211,6 +213,24 @@ (dbg-simple-log "log-to-file enabled with file ~a" filename) ) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; goal : Enable daily rotating file logging. +; pre : filename is a path string and retention-days is a positive integer. +; post : The current day is logged as plain text. Older retained days are +; stored as .YYYY-MM-DD.gz. +; result : void +; internals : retention-days includes the current, uncompressed day. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(define (sl-log-to-rotating-file filename [retention-days 7]) + (unless (exact-positive-integer? retention-days) + (raise-argument-error 'sl-log-to-rotating-file + "exact-positive-integer?" + retention-days)) + (sl-log-to file (make-rotating-log-callback filename retention-days)) + (dbg-simple-log "rotating log-to-file enabled with file ~a and retention ~a days" + filename retention-days) + ) + (define-syntax def-log2 (syntax-rules () ((_ id parent receiver log-callbacks dbgn infon warnn errn fataln syncn) diff --git a/private/rotating-file.rkt b/private/rotating-file.rkt new file mode 100644 index 0000000..1de85d8 --- /dev/null +++ b/private/rotating-file.rkt @@ -0,0 +1,132 @@ +#lang racket + +(require file/gzip + racket/date + racket-sprintf) + +(provide make-rotating-log-callback) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Supporting functions +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (iso-date seconds [local-time? #t]) + (let ((d (seconds->date seconds local-time?))) + (sprintf "%04d-%02d-%02d" + (date-year d) + (date-month d) + (date-day d)))) + +(define (rotate-log-file! filename log-date) + (when (file-exists? filename) + (if (> (file-size filename) 0) + (let* ((filename-path (if (path? filename) filename (string->path filename))) + (archive + (string->path + (string-append (path->string filename-path) "." log-date ".gz")))) + (gzip filename archive) + (delete-file filename)) + (delete-file filename)))) + +(define (remove-expired-log-files! filename log-date retention-days) + (let* ((filename-path (if (path? filename) filename (string->path filename))) + (directory (or (path-only filename-path) (current-directory))) + (base-name (path->string (file-name-from-path filename-path))) + (archive-regexp + (regexp + (format "^~a\\.([0-9][0-9][0-9][0-9]-[0-9][0-9]-[0-9][0-9])\\.gz$" + (regexp-quote base-name)))) + (date-match + (regexp-match #rx"^([0-9][0-9][0-9][0-9])-([0-9][0-9])-([0-9][0-9])$" + log-date)) + (year (string->number (cadr date-match))) + (month (string->number (caddr date-match))) + (day (string->number (cadddr date-match))) + (date-seconds (find-seconds 0 0 12 day month year #f)) + (cutoff-seconds (- date-seconds (* 86400 (sub1 retention-days)))) + (cutoff-date (iso-date cutoff-seconds #f))) + (for-each + (λ (entry) + (let* ((entry-name (path->string entry)) + (archive-match (regexp-match archive-regexp entry-name)) + (archive-path (build-path directory entry))) + (when (and archive-match + (string.YYYY-MM-DD.gz. +; result : A simple-log callback procedure. +; internals : Rotation is checked for every log entry using the entry timestamp. +; retention-days includes the current, uncompressed day. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(define (make-rotating-log-callback filename retention-days) + (let ((active-date (iso-date (current-seconds))) + (out #f)) + + ;; A file left by an earlier process belongs to the day on which it was + ;; last written. Keep today's file plain, and archive an older one first. + (when (file-exists? filename) + (let ((file-date + (iso-date (file-or-directory-modify-seconds filename)))) + (when (not (string=? file-date active-date)) + (rotate-log-file! filename file-date)))) + + (remove-expired-log-files! filename active-date retention-days) + (set! out (open-output-file filename #:exists 'append)) + + (λ (topic level dt msg) + (let ((entry-date (substring dt 0 10))) + (when (not (string=? entry-date active-date)) + (close-output-port out) + (rotate-log-file! filename active-date) + (set! active-date entry-date) + (remove-expired-log-files! filename active-date retention-days) + (set! out (open-output-file filename #:exists 'append))) + + (displayln (format "~a:~a:~a:~a" topic level dt msg) out) + (flush-output out))))) + +(module+ test + (require rackunit + racket/file + file/gunzip) + + (let ((test-directory (make-temporary-file "simple-log-rotation~a" 'directory))) + (dynamic-wind + void + (λ () + (let* ((logfile (build-path test-directory "application.log")) + (archive (build-path test-directory "application.log.2026-08-28.gz")) + (expired (build-path test-directory "application.log.2026-08-26.gz"))) + + (call-with-output-file logfile + (λ (out) (displayln "previous day" out)) + #:exists 'replace) + (call-with-output-file expired + (λ (out) (displayln "expired" out)) + #:exists 'replace) + + (rotate-log-file! logfile "2026-08-28") + (check-false (file-exists? logfile)) + (check-true (file-exists? archive)) + + (let ((out (open-output-bytes))) + (call-with-input-file archive + (λ (in) (gunzip-through-ports in out))) + (check-equal? (get-output-bytes out) #"previous day\n")) + + (remove-expired-log-files! logfile "2026-08-29" 2) + (check-true (file-exists? archive)) + (check-false (file-exists? expired)))) + (λ () + (delete-directory/files test-directory))))) diff --git a/scrbl/simple-log.scrbl b/scrbl/simple-log.scrbl index 4d6ab62..e73e672 100644 --- a/scrbl/simple-log.scrbl +++ b/scrbl/simple-log.scrbl @@ -101,6 +101,34 @@ opened with @racket['replace], and the output is flushed after every line. Calling the procedure again replaces the existing file destination. } +@defproc[(sl-log-to-rotating-file + [filename path-string?] + [retention-days exact-positive-integer? 7]) + void?]{ + +Registers a daily rotating file destination. The current day's log is kept as +plain text in @racket[filename]. When the date changes, the previous file is +compressed with gzip and stored as +@tt{filename.YYYY-MM-DD.gz}. + +@racket[retention-days] is the total number of calendar days retained, including +the current uncompressed day. With the default value of @racket[7], the current +day and at most the previous six calendar days are retained. Compressed files +older than that period are removed. + +If @racket[filename] already exists when rotating logging is enabled, a file +modified today is appended to. An older file is first archived under its last +modification date. This makes restarting an application on the same day preserve +the current day's log. + +For example: + +@racketblock[ +(sl-log-to-rotating-file "application.log") +(sl-log-to-rotating-file "application.log" 14) +] +} + @defproc[(sl-log-to-file&display [filename path-string?]) void?]{ Enables both the display and file destinations.