1 ;;; GNU Guix --- Functional package management for GNU
2 ;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
3 ;;; Copyright © 2016, 2017, 2018, 2019, 2020 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 unattended-upgrade-service-type
50 unattended-upgrade-configuration
51 unattended-upgrade-configuration?
52 unattended-upgrade-configuration-operating-system-file
53 unattended-upgrade-configuration-channels
54 unattended-upgrade-configuration-schedule
55 unattended-upgrade-configuration-services-to-restart
56 unattended-upgrade-configuration-system-expiration
57 unattended-upgrade-configuration-maximum-duration
58 unattended-upgrade-configuration-log-file))
62 ;;; This module implements configuration of rottlog by writing
63 ;;; /etc/rottlog/{rc,hourly|daily|weekly}. Example usage
66 ;;; (service rottlog-service-type)
70 (define-record-type* <log-rotation> log-rotation make-log-rotation
72 (files log-rotation-files) ;list of strings
73 (frequency log-rotation-frequency ;symbol
75 (post-rotate log-rotation-post-rotate ;#f | gexp
77 (options log-rotation-options ;list of strings
80 (define %rotated-files
81 ;; Syslog files subject to rotation.
82 '("/var/log/messages" "/var/log/secure" "/var/log/debug"
85 (define %default-rotations
86 (list (log-rotation ;syslog files
87 (files %rotated-files)
89 (options '(;; Run post-rotate once per rotation
91 ;; Append .gz to rotated files
92 "storefile @FILENAME.@COMP_EXT"))
93 ;; Restart syslogd after rotation.
94 (post-rotate #~(let ((pid (call-with-input-file "/var/run/syslog.pid"
98 (files '("/var/log/guix-daemon.log")))))
100 (define (log-rotation->config rotation)
101 "Return a string-valued gexp representing the rottlog configuration snippet
104 (let ((post (log-rotation-post-rotate rotation)))
106 (program-file "rottlog-post-rotate.scm" post))))
108 #~(let ((post #$post-rotate))
109 (string-append (string-join '#$(log-rotation-files rotation) ",")
111 #$(string-join (log-rotation-options rotation)
114 (string-append "\n postrotate\n " post
119 (define (log-rotations->/etc-entries rotations)
120 "Return the list of /etc entries for ROTATIONS, a list of <log-rotation>."
121 (define (frequency-file frequency rotations)
122 (computed-file (string-append "rottlog." (symbol->string frequency))
123 #~(call-with-output-file #$output
125 (for-each (lambda (str)
127 (list #$@(map log-rotation->config
130 (let* ((frequencies (delete-duplicates
131 (map log-rotation-frequency rotations)))
132 (table (fold (lambda (rotation table)
133 (vhash-consq (log-rotation-frequency rotation)
137 (map (lambda (frequency)
138 `(,(symbol->string frequency)
139 ,(frequency-file frequency
140 (vhash-foldq* cons '() frequency table))))
143 (define (default-jobs rottlog)
144 (list #~(job '(next-hour '(0)) ;midnight
145 #$(file-append rottlog "/sbin/rottlog"))
146 #~(job '(next-hour '(12)) ;noon
147 #$(file-append rottlog "/sbin/rottlog"))))
149 (define-record-type* <rottlog-configuration>
150 rottlog-configuration make-rottlog-configuration
151 rottlog-configuration?
152 (rottlog rottlog-rottlog ;package
154 (rc-file rottlog-rc-file ;file-like
155 (default (file-append rottlog "/etc/rc")))
156 (rotations rottlog-rotations ;list of <log-rotation>
157 (default %default-rotations))
158 (jobs rottlog-jobs ;list of <mcron-job>
161 (define (rottlog-etc config)
163 ,(file-union "rottlog"
164 (cons `("rc" ,(rottlog-rc-file config))
165 (log-rotations->/etc-entries
166 (rottlog-rotations config)))))))
168 (define (rottlog-jobs-or-default config)
169 (or (rottlog-jobs config)
170 (default-jobs (rottlog-rottlog config))))
172 (define rottlog-service-type
176 "Periodically rotate log files using GNU@tie{}Rottlog and GNU@tie{}mcron.
177 Old log files are removed or compressed according to the configuration.")
178 (extensions (list (service-extension etc-service-type rottlog-etc)
179 (service-extension mcron-service-type
180 rottlog-jobs-or-default)
182 ;; Add Rottlog to the global profile so users can access
183 ;; the documentation.
184 (service-extension profile-service-type
185 (compose list rottlog-rottlog))))
186 (compose concatenate)
187 (extend (lambda (config rotations)
188 (rottlog-configuration
190 (rotations (append (rottlog-rotations config)
192 (default-value (rottlog-configuration))))
196 ;;; Unattended upgrade.
199 (define-record-type* <unattended-upgrade-configuration>
200 unattended-upgrade-configuration make-unattended-upgrade-configuration
201 unattended-upgrade-configuration?
202 (operating-system-file unattended-upgrade-operating-system-file
203 (default "/run/current-system/configuration.scm"))
204 (schedule unattended-upgrade-configuration-schedule
205 (default "30 01 * * 0"))
206 (channels unattended-upgrade-configuration-channels
207 (default #~%default-channels))
208 (services-to-restart unattended-upgrade-configuration-services-to-restart
210 (system-expiration unattended-upgrade-system-expiration
211 (default (* 3 30 24 3600)))
212 (maximum-duration unattended-upgrade-maximum-duration
214 (log-file unattended-upgrade-configuration-log-file
215 (default %unattended-upgrade-log-file)))
217 (define %unattended-upgrade-log-file
218 "/var/log/unattended-upgrade.log")
220 (define (unattended-upgrade-mcron-jobs config)
222 (scheme-file "channels.scm"
223 (unattended-upgrade-configuration-channels config)))
226 (unattended-upgrade-configuration-log-file config))
229 (unattended-upgrade-configuration-services-to-restart config))
232 (unattended-upgrade-system-expiration config))
235 (unattended-upgrade-operating-system-file config))
238 (with-imported-modules (source-module-closure '((guix build utils)
239 (gnu services herd)))
241 (use-modules (guix build utils)
247 (open-file #$log "a0"))
250 (date->string (time-utc->date (current-time time-utc))
253 (define (alarm-handler . _)
254 (format #t "~a time is up, aborting upgrade~%"
258 ;; 'guix time-machine' needs X.509 certificates to authenticate the
260 (setenv "SSL_CERT_DIR"
261 #$(file-append nss-certs "/etc/ssl/certs"))
263 ;; Make sure the upgrade doesn't take too long.
264 (sigaction SIGALRM alarm-handler)
265 (alarm #$(unattended-upgrade-maximum-duration config))
267 ;; Redirect stdout/stderr to LOG to save the output of 'guix' below.
268 (redirect-port log (current-output-port))
269 (redirect-port log (current-error-port))
271 (format #t "~a starting upgrade...~%" (timestamp))
272 (guard (c ((invoke-error? c)
273 (report-invoke-error c)))
274 (invoke #$(file-append guix "/bin/guix")
275 "time-machine" "-C" #$channels
276 "--" "system" "reconfigure" #$config-file)
278 ;; 'guix system delete-generations' fails when there's no
279 ;; matching generation. Thus, catch 'invoke-error?'.
280 (guard (c ((invoke-error? c)
281 (report-invoke-error c)))
282 (invoke #$(file-append guix "/bin/guix")
283 "system" "delete-generations"
284 #$(string-append (number->string expiration)
287 (format #t "~a restarting services...~%" (timestamp))
288 (for-each restart-service '#$services)
290 ;; XXX: If 'mcron' has been restarted, perhaps this isn't
292 (format #t "~a upgrade complete~%" (timestamp))))))
295 (program-file "unattended-upgrade" code))
297 (list #~(job #$(unattended-upgrade-configuration-schedule config)
300 (define (unattended-upgrade-log-rotations config)
303 (list (unattended-upgrade-configuration-log-file config))))))
305 (define unattended-upgrade-service-type
307 (name 'unattended-upgrade)
309 (list (service-extension mcron-service-type
310 unattended-upgrade-mcron-jobs)
311 (service-extension rottlog-service-type
312 unattended-upgrade-log-rotations)))
314 "Periodically upgrade the system from the current configuration.")
315 (default-value (unattended-upgrade-configuration))))
317 ;;; admin.scm ends here