diff options
| -rw-r--r-- | doc/guix.texi | 28 | ||||
| -rw-r--r-- | gnu/services/admin.scm | 53 |
2 files changed, 80 insertions, 1 deletions
diff --git a/doc/guix.texi b/doc/guix.texi index e8ef4286be..ad2763ec8a 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -17641,6 +17641,34 @@ The list of syslog-controlled files to be rotated. By default it is: "/var/log/maillog")}. @end defvr +Some log files just need to be deleted periodically once they are old, +without any other criterion and without any archival step. This is the +case of build logs stored by @command{guix-daemon} under +@file{/var/log/guix/drvs} (@pxref{Invoking guix-daemon}). The +@code{log-cleanup} service addresses this use case. + +@defvr {Scheme Variable} log-cleanup-service-type +This is the type of the service to delete old logs. Its value must be a +@code{log-cleanup-configuration} record as described below. +@end defvr + +@deftp {Data Type} log-cleanup-configuration +Data type representing the log cleanup configuration + +@table @asis +@item @code{directory} +Name of the directory containing log files. + +@item @code{expiry} (default: @code{(* 6 30 24 3600)}) +Age in seconds after which a file is subject to deletion (six months by +default). + +@item @code{schedule} (default: @code{"30 12 01,08,15,22 * *"}) +String or gexp denoting the corresponding mcron job schedule +(@pxref{Scheduled Job Execution}). +@end table +@end deftp + @node Networking Setup @subsection Networking Setup diff --git a/gnu/services/admin.scm b/gnu/services/admin.scm index 043517262f..3096acdf5a 100644 --- a/gnu/services/admin.scm +++ b/gnu/services/admin.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org> -;;; Copyright © 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2016-2022 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2020 Brice Waegeneire <brice@waegenei.re> ;;; ;;; This file is part of GNU Guix. @@ -46,6 +46,13 @@ rottlog-service rottlog-service-type + log-cleanup-service-type + log-cleanup-configuration + log-cleanup-configuration? + log-cleanup-configuration-directory + log-cleanup-configuration-expiry + log-cleanup-configuration-schedule + unattended-upgrade-service-type unattended-upgrade-configuration unattended-upgrade-configuration? @@ -193,6 +200,50 @@ Old log files are removed or compressed according to the configuration.") ;;; +;;; Build log removal. +;;; + +(define-record-type* <log-cleanup-configuration> + log-cleanup-configuration make-log-cleanup-configuration + log-cleanup-configuration? + (directory log-cleanup-configuration-directory) ;string + (expiry log-cleanup-configuration-expiry ;integer (seconds) + (default (* 6 30 24 3600))) + (schedule log-cleanup-configuration-schedule ;string or gexp + (default "30 12 01,08,15,22 * *"))) + +(define (log-cleanup-program directory expiry) + (program-file "delete-old-logs" + (with-imported-modules '((guix build utils)) + #~(begin + (use-modules (guix build utils)) + + (let* ((now (car (gettimeofday))) + (logs (find-files #$directory + (lambda (file stat) + (> (- now (stat:mtime stat)) + #$expiry))))) + (format #t "deleting ~a log files from '~a'...~%" + (length logs) #$directory) + (for-each delete-file logs)))))) + +(define (log-cleanup-mcron-jobs configuration) + (match-record configuration <log-cleanup-configuration> + (directory expiry schedule) + (list #~(job #$schedule + #$(log-cleanup-program directory expiry))))) + +(define log-cleanup-service-type + (service-type + (name 'log-cleanup) + (extensions + (list (service-extension mcron-service-type + log-cleanup-mcron-jobs))) + (description + "Periodically delete old log files."))) + + +;;; ;;; Unattended upgrade. ;;; |