diff options
author | Ludovic Courtès <ludo@gnu.org> | 2022-03-31 23:14:39 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2022-04-04 22:58:03 +0200 |
commit | 3b9b3b49316596bc1fab2834ef156091b553b4b7 (patch) | |
tree | 43af3bb62a9701bcb1657452a4987fb9f4b50f57 /gnu | |
parent | 2bef31fe25523ee482c9e54b4bf0a7682f0c2382 (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.
Diffstat (limited to 'gnu')
-rw-r--r-- | gnu/services/admin.scm | 53 |
1 files changed, 52 insertions, 1 deletions
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. ;;; |