1 ;;; GNU Guix --- Functional package management for GNU
2 ;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
3 ;;; Copyright © 2016-2022 Ludovic Courtès <ludo@gnu.org>
4 ;;; Copyright © 2020 Brice Waegeneire <brice@waegenei.re>
6 ;;; This file is part of GNU Guix.
8 ;;; GNU Guix is free software; you can redistribute it and/or modify it
9 ;;; under the terms of the GNU General Public License as published by
10 ;;; the Free Software Foundation; either version 3 of the License, or (at
11 ;;; your option) any later version.
13 ;;; GNU Guix is distributed in the hope that it will be useful, but
14 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
15 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 ;;; GNU General Public License for more details.
18 ;;; You should have received a copy of the GNU General Public License
19 ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
21 (define-module (gnu services admin)
22 #:use-module (gnu packages admin)
23 #:use-module (gnu packages certs)
24 #:use-module (gnu packages package-management)
25 #:use-module (gnu services)
26 #:use-module (gnu services mcron)
27 #:use-module (gnu services shepherd)
28 #:use-module (guix gexp)
29 #:use-module (guix modules)
30 #:use-module (guix packages)
31 #:use-module (guix records)
32 #:use-module (srfi srfi-1)
33 #:use-module (ice-9 vlist)
34 #:export (%default-rotations
39 log-rotation-frequency
42 log-rotation-post-rotate
45 rottlog-configuration?
49 log-cleanup-service-type
50 log-cleanup-configuration
51 log-cleanup-configuration?
52 log-cleanup-configuration-directory
53 log-cleanup-configuration-expiry
54 log-cleanup-configuration-schedule
56 unattended-upgrade-service-type
57 unattended-upgrade-configuration
58 unattended-upgrade-configuration?
59 unattended-upgrade-configuration-operating-system-file
60 unattended-upgrade-configuration-channels
61 unattended-upgrade-configuration-schedule
62 unattended-upgrade-configuration-services-to-restart
63 unattended-upgrade-configuration-system-expiration
64 unattended-upgrade-configuration-maximum-duration
65 unattended-upgrade-configuration-log-file))
69 ;;; This module implements configuration of rottlog by writing
70 ;;; /etc/rottlog/{rc,hourly|daily|weekly}. Example usage
73 ;;; (service rottlog-service-type)
77 (define-record-type* <log-rotation> log-rotation make-log-rotation
79 (files log-rotation-files) ;list of strings
80 (frequency log-rotation-frequency ;symbol
82 (post-rotate log-rotation-post-rotate ;#f | gexp
84 (options log-rotation-options ;list of strings
87 (define %rotated-files
88 ;; Syslog files subject to rotation.
89 '("/var/log/messages" "/var/log/secure" "/var/log/debug"
90 "/var/log/maillog" "/var/log/mcron.log"))
92 (define %default-rotations
93 (list (log-rotation ;syslog files
94 (files %rotated-files)
96 (options '(;; Run post-rotate once per rotation
98 ;; Append .gz to rotated files
99 "storefile @FILENAME.@COMP_EXT"))
100 ;; Restart syslogd after rotation.
101 (post-rotate #~(let ((pid (call-with-input-file "/var/run/syslog.pid"
105 (files '("/var/log/guix-daemon.log"))
106 (options '("rotate 4" ;don't keep too many of them
107 "storefile @FILENAME.@COMP_EXT")))))
109 (define (log-rotation->config rotation)
110 "Return a string-valued gexp representing the rottlog configuration snippet
113 (let ((post (log-rotation-post-rotate rotation)))
115 (program-file "rottlog-post-rotate.scm" post))))
117 #~(let ((post #$post-rotate))
118 (string-append (string-join '#$(log-rotation-files rotation) ",")
120 #$(string-join (log-rotation-options rotation)
123 (string-append "\n postrotate\n " post
128 (define (log-rotations->/etc-entries rotations)
129 "Return the list of /etc entries for ROTATIONS, a list of <log-rotation>."
130 (define (frequency-file frequency rotations)
131 (computed-file (string-append "rottlog." (symbol->string frequency))
132 #~(call-with-output-file #$output
134 (for-each (lambda (str)
136 (list #$@(map log-rotation->config
139 (let* ((frequencies (delete-duplicates
140 (map log-rotation-frequency rotations)))
141 (table (fold (lambda (rotation table)
142 (vhash-consq (log-rotation-frequency rotation)
146 (map (lambda (frequency)
147 `(,(symbol->string frequency)
148 ,(frequency-file frequency
149 (vhash-foldq* cons '() frequency table))))
152 (define (default-jobs rottlog)
153 (list #~(job '(next-hour '(0)) ;midnight
154 #$(file-append rottlog "/sbin/rottlog"))
155 #~(job '(next-hour '(12)) ;noon
156 #$(file-append rottlog "/sbin/rottlog"))))
158 (define-record-type* <rottlog-configuration>
159 rottlog-configuration make-rottlog-configuration
160 rottlog-configuration?
161 (rottlog rottlog-rottlog ;file-like
163 (rc-file rottlog-rc-file ;file-like
164 (default (file-append rottlog "/etc/rc")))
165 (rotations rottlog-rotations ;list of <log-rotation>
166 (default %default-rotations))
167 (jobs rottlog-jobs ;list of <mcron-job>
170 (define (rottlog-etc config)
172 ,(file-union "rottlog"
173 (cons `("rc" ,(rottlog-rc-file config))
174 (log-rotations->/etc-entries
175 (rottlog-rotations config)))))))
177 (define (rottlog-jobs-or-default config)
178 (or (rottlog-jobs config)
179 (default-jobs (rottlog-rottlog config))))
181 (define rottlog-service-type
185 "Periodically rotate log files using GNU@tie{}Rottlog and GNU@tie{}mcron.
186 Old log files are removed or compressed according to the configuration.")
187 (extensions (list (service-extension etc-service-type rottlog-etc)
188 (service-extension mcron-service-type
189 rottlog-jobs-or-default)
191 ;; Add Rottlog to the global profile so users can access
192 ;; the documentation.
193 (service-extension profile-service-type
194 (compose list rottlog-rottlog))))
195 (compose concatenate)
196 (extend (lambda (config rotations)
197 (rottlog-configuration
199 (rotations (append (rottlog-rotations config)
201 (default-value (rottlog-configuration))))
205 ;;; Build log removal.
208 (define-record-type* <log-cleanup-configuration>
209 log-cleanup-configuration make-log-cleanup-configuration
210 log-cleanup-configuration?
211 (directory log-cleanup-configuration-directory) ;string
212 (expiry log-cleanup-configuration-expiry ;integer (seconds)
213 (default (* 6 30 24 3600)))
214 (schedule log-cleanup-configuration-schedule ;string or gexp
215 (default "30 12 01,08,15,22 * *")))
217 (define (log-cleanup-program directory expiry)
218 (program-file "delete-old-logs"
219 (with-imported-modules '((guix build utils))
221 (use-modules (guix build utils))
223 (let* ((now (car (gettimeofday)))
224 (logs (find-files #$directory
226 (> (- now (stat:mtime stat))
228 (format #t "deleting ~a log files from '~a'...~%"
229 (length logs) #$directory)
230 (for-each delete-file logs))))))
232 (define (log-cleanup-mcron-jobs configuration)
233 (match-record configuration <log-cleanup-configuration>
234 (directory expiry schedule)
235 (list #~(job #$schedule
236 #$(log-cleanup-program directory expiry)))))
238 (define log-cleanup-service-type
242 (list (service-extension mcron-service-type
243 log-cleanup-mcron-jobs)))
245 "Periodically delete old log files.")))
249 ;;; Unattended upgrade.
252 (define-record-type* <unattended-upgrade-configuration>
253 unattended-upgrade-configuration make-unattended-upgrade-configuration
254 unattended-upgrade-configuration?
255 (operating-system-file unattended-upgrade-operating-system-file
256 (default "/run/current-system/configuration.scm"))
257 (schedule unattended-upgrade-configuration-schedule
258 (default "30 01 * * 0"))
259 (channels unattended-upgrade-configuration-channels
260 (default #~%default-channels))
261 (services-to-restart unattended-upgrade-configuration-services-to-restart
263 (system-expiration unattended-upgrade-system-expiration
264 (default (* 3 30 24 3600)))
265 (maximum-duration unattended-upgrade-maximum-duration
267 (log-file unattended-upgrade-configuration-log-file
268 (default %unattended-upgrade-log-file)))
270 (define %unattended-upgrade-log-file
271 "/var/log/unattended-upgrade.log")
273 (define (unattended-upgrade-mcron-jobs config)
275 (scheme-file "channels.scm"
276 (unattended-upgrade-configuration-channels config)))
279 (unattended-upgrade-configuration-log-file config))
282 (unattended-upgrade-configuration-services-to-restart config))
285 (unattended-upgrade-system-expiration config))
288 (unattended-upgrade-operating-system-file config))
291 (with-imported-modules (source-module-closure '((guix build utils)
292 (gnu services herd)))
294 (use-modules (guix build utils)
300 (open-file #$log "a0"))
303 (date->string (time-utc->date (current-time time-utc))
306 (define (alarm-handler . _)
307 (format #t "~a time is up, aborting upgrade~%"
311 ;; 'guix time-machine' needs X.509 certificates to authenticate the
313 (setenv "SSL_CERT_DIR"
314 #$(file-append nss-certs "/etc/ssl/certs"))
316 ;; Make sure the upgrade doesn't take too long.
317 (sigaction SIGALRM alarm-handler)
318 (alarm #$(unattended-upgrade-maximum-duration config))
320 ;; Redirect stdout/stderr to LOG to save the output of 'guix' below.
321 (redirect-port log (current-output-port))
322 (redirect-port log (current-error-port))
324 (format #t "~a starting upgrade...~%" (timestamp))
325 (guard (c ((invoke-error? c)
326 (report-invoke-error c)))
327 (invoke #$(file-append guix "/bin/guix")
328 "time-machine" "-C" #$channels
329 "--" "system" "reconfigure" #$config-file)
331 ;; 'guix system delete-generations' fails when there's no
332 ;; matching generation. Thus, catch 'invoke-error?'.
333 (guard (c ((invoke-error? c)
334 (report-invoke-error c)))
335 (invoke #$(file-append guix "/bin/guix")
336 "system" "delete-generations"
337 #$(string-append (number->string expiration)
340 (format #t "~a restarting services...~%" (timestamp))
341 (for-each restart-service '#$services)
343 ;; XXX: If 'mcron' has been restarted, perhaps this isn't
345 (format #t "~a upgrade complete~%" (timestamp))))))
348 (program-file "unattended-upgrade" code))
350 (list #~(job #$(unattended-upgrade-configuration-schedule config)
353 (define (unattended-upgrade-log-rotations config)
356 (list (unattended-upgrade-configuration-log-file config))))))
358 (define unattended-upgrade-service-type
360 (name 'unattended-upgrade)
362 (list (service-extension mcron-service-type
363 unattended-upgrade-mcron-jobs)
364 (service-extension rottlog-service-type
365 unattended-upgrade-log-rotations)))
367 "Periodically upgrade the system from the current configuration.")
368 (default-value (unattended-upgrade-configuration))))
370 ;;; admin.scm ends here