summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2022-03-31 23:14:39 +0200
committerLudovic Courtès <ludo@gnu.org>2022-04-04 22:58:03 +0200
commit3b9b3b49316596bc1fab2834ef156091b553b4b7 (patch)
tree43af3bb62a9701bcb1657452a4987fb9f4b50f57
parent2bef31fe25523ee482c9e54b4bf0a7682f0c2382 (diff)
services: Add 'log-cleanup-service-type'.
* gnu/services/admin.scm (<log-cleanup-configuration>): New record type. (log-cleanup-program, log-cleanup-mcron-jobs): New procedures. (log-cleanup-service-type): New variable. * doc/guix.texi (Log Rotation): Document it.
-rw-r--r--doc/guix.texi28
-rw-r--r--gnu/services/admin.scm53
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.
;;;