summaryrefslogtreecommitdiff
path: root/gnu
diff options
context:
space:
mode:
Diffstat (limited to 'gnu')
-rw-r--r--gnu/services/admin.scm53
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.
;;;