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.
This commit is contained in:
Ludovic Courtès 2022-03-31 23:14:39 +02:00
parent 2bef31fe25
commit 3b9b3b4931
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 80 additions and 1 deletions

View file

@ -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

View file

@ -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 @@ (define-module (gnu services admin)
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?
@ -191,6 +198,50 @@ (define rottlog-service-type
rotations)))))
(default-value (rottlog-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.