mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-25 05:48:07 -05:00
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:
parent
2bef31fe25
commit
3b9b3b4931
2 changed files with 80 additions and 1 deletions
|
@ -17641,6 +17641,34 @@ The list of syslog-controlled files to be rotated. By default it is:
|
||||||
"/var/log/maillog")}.
|
"/var/log/maillog")}.
|
||||||
@end defvr
|
@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
|
@node Networking Setup
|
||||||
@subsection Networking Setup
|
@subsection Networking Setup
|
||||||
|
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; GNU Guix --- Functional package management for GNU
|
||||||
;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
|
;;; 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>
|
;;; Copyright © 2020 Brice Waegeneire <brice@waegenei.re>
|
||||||
;;;
|
;;;
|
||||||
;;; This file is part of GNU Guix.
|
;;; This file is part of GNU Guix.
|
||||||
|
@ -46,6 +46,13 @@ (define-module (gnu services admin)
|
||||||
rottlog-service
|
rottlog-service
|
||||||
rottlog-service-type
|
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-service-type
|
||||||
unattended-upgrade-configuration
|
unattended-upgrade-configuration
|
||||||
unattended-upgrade-configuration?
|
unattended-upgrade-configuration?
|
||||||
|
@ -191,6 +198,50 @@ (define rottlog-service-type
|
||||||
rotations)))))
|
rotations)))))
|
||||||
(default-value (rottlog-configuration))))
|
(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.
|
;;; Unattended upgrade.
|
||||||
|
|
Loading…
Reference in a new issue