services: 'references-file' depends on Guile-Gcrypt.
[jackhill/guix/guix.git] / gnu / services / admin.scm
CommitLineData
92c03a87
JN
1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
79501f26 3;;; Copyright © 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
ab034adf 4;;; Copyright © 2020 Brice Waegeneire <brice@waegenei.re>
92c03a87
JN
5;;;
6;;; This file is part of GNU Guix.
7;;;
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.
12;;;
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.
17;;;
83715a7e 18;;; You should have received a copy of the GNU General Public License
92c03a87
JN
19;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
20
21(define-module (gnu services admin)
22 #:use-module (gnu packages admin)
79501f26
LC
23 #:use-module (gnu packages certs)
24 #:use-module (gnu packages package-management)
92c03a87
JN
25 #:use-module (gnu services)
26 #:use-module (gnu services mcron)
27 #:use-module (gnu services shepherd)
28 #:use-module (guix gexp)
79501f26 29 #:use-module (guix modules)
92c03a87
JN
30 #:use-module (guix packages)
31 #:use-module (guix records)
32 #:use-module (srfi srfi-1)
81fa2229 33 #:use-module (ice-9 vlist)
92c03a87
JN
34 #:export (%default-rotations
35 %rotated-files
81fa2229
LC
36
37 log-rotation
38 log-rotation?
39 log-rotation-frequency
40 log-rotation-files
41 log-rotation-options
42 log-rotation-post-rotate
43
92c03a87
JN
44 rottlog-configuration
45 rottlog-configuration?
46 rottlog-service
79501f26
LC
47 rottlog-service-type
48
49 unattended-upgrade-service-type
50 unattended-upgrade-configuration
51 unattended-upgrade-configuration?
0d203eea 52 unattended-upgrade-configuration-operating-system-file
79501f26
LC
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))
92c03a87
JN
59
60;;; Commentary:
61;;;
62;;; This module implements configuration of rottlog by writing
63;;; /etc/rottlog/{rc,hourly|daily|weekly}. Example usage
64;;;
65;;; (mcron-service)
81fa2229 66;;; (service rottlog-service-type)
92c03a87
JN
67;;;
68;;; Code:
69
81fa2229
LC
70(define-record-type* <log-rotation> log-rotation make-log-rotation
71 log-rotation?
72 (files log-rotation-files) ;list of strings
73 (frequency log-rotation-frequency ;symbol
74 (default 'weekly))
75 (post-rotate log-rotation-post-rotate ;#f | gexp
76 (default #f))
77 (options log-rotation-options ;list of strings
78 (default '())))
79
92c03a87 80(define %rotated-files
4d67ed70 81 ;; Syslog files subject to rotation.
7fe1432a
LC
82 '("/var/log/messages" "/var/log/secure" "/var/log/debug"
83 "/var/log/maillog"))
92c03a87 84
92c03a87 85(define %default-rotations
81fa2229
LC
86 (list (log-rotation ;syslog files
87 (files %rotated-files)
88
ab034adf
BW
89 (options '(;; Run post-rotate once per rotation
90 "sharedscripts"
91 ;; Append .gz to rotated files
92 "storefile @FILENAME.@COMP_EXT"))
81fa2229 93 ;; Restart syslogd after rotation.
81fa2229
LC
94 (post-rotate #~(let ((pid (call-with-input-file "/var/run/syslog.pid"
95 read)))
96 (kill pid SIGHUP))))
97 (log-rotation
ca5b7311 98 (files '("/var/log/guix-daemon.log")))))
81fa2229
LC
99
100(define (log-rotation->config rotation)
101 "Return a string-valued gexp representing the rottlog configuration snippet
102for ROTATION."
103 (define post-rotate
104 (let ((post (log-rotation-post-rotate rotation)))
105 (and post
106 (program-file "rottlog-post-rotate.scm" post))))
107
108 #~(let ((post #$post-rotate))
109 (string-append (string-join '#$(log-rotation-files rotation) ",")
110 " {"
111 #$(string-join (log-rotation-options rotation)
112 "\n " 'prefix)
113 (if post
114 (string-append "\n postrotate\n " post
115 "\n endscript\n")
116 "")
117 "\n}\n")))
118
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
124 (lambda (port)
125 (for-each (lambda (str)
126 (display str port))
127 (list #$@(map log-rotation->config
128 rotations)))))))
129
130 (let* ((frequencies (delete-duplicates
131 (map log-rotation-frequency rotations)))
132 (table (fold (lambda (rotation table)
133 (vhash-consq (log-rotation-frequency rotation)
134 rotation table))
135 vlist-null
136 rotations)))
137 (map (lambda (frequency)
138 `(,(symbol->string frequency)
139 ,(frequency-file frequency
140 (vhash-foldq* cons '() frequency table))))
141 frequencies)))
92c03a87
JN
142
143(define (default-jobs rottlog)
144 (list #~(job '(next-hour '(0)) ;midnight
89fdd9ee 145 #$(file-append rottlog "/sbin/rottlog"))
92c03a87 146 #~(job '(next-hour '(12)) ;noon
89fdd9ee 147 #$(file-append rottlog "/sbin/rottlog"))))
92c03a87
JN
148
149(define-record-type* <rottlog-configuration>
150 rottlog-configuration make-rottlog-configuration
151 rottlog-configuration?
152 (rottlog rottlog-rottlog ;package
153 (default rottlog))
154 (rc-file rottlog-rc-file ;file-like
155 (default (file-append rottlog "/etc/rc")))
81fa2229 156 (rotations rottlog-rotations ;list of <log-rotation>
92c03a87
JN
157 (default %default-rotations))
158 (jobs rottlog-jobs ;list of <mcron-job>
159 (default #f)))
160
161(define (rottlog-etc config)
81fa2229
LC
162 `(("rottlog"
163 ,(file-union "rottlog"
164 (cons `("rc" ,(rottlog-rc-file config))
165 (log-rotations->/etc-entries
166 (rottlog-rotations config)))))))
92c03a87
JN
167
168(define (rottlog-jobs-or-default config)
169 (or (rottlog-jobs config)
170 (default-jobs (rottlog-rottlog config))))
171
172(define rottlog-service-type
173 (service-type
174 (name 'rottlog)
21b71b01
LC
175 (description
176 "Periodically rotate log files using GNU@tie{}Rottlog and GNU@tie{}mcron.
177Old log files are removed or compressed according to the configuration.")
92c03a87
JN
178 (extensions (list (service-extension etc-service-type rottlog-etc)
179 (service-extension mcron-service-type
26cfc415
LC
180 rottlog-jobs-or-default)
181
182 ;; Add Rottlog to the global profile so users can access
183 ;; the documentation.
184 (service-extension profile-service-type
3d3c5650 185 (compose list rottlog-rottlog))))
254ea3f9
LC
186 (compose concatenate)
187 (extend (lambda (config rotations)
188 (rottlog-configuration
189 (inherit config)
190 (rotations (append (rottlog-rotations config)
191 rotations)))))
3d3c5650 192 (default-value (rottlog-configuration))))
92c03a87 193
79501f26
LC
194\f
195;;;
196;;; Unattended upgrade.
197;;;
198
199(define-record-type* <unattended-upgrade-configuration>
200 unattended-upgrade-configuration make-unattended-upgrade-configuration
201 unattended-upgrade-configuration?
0d203eea
LC
202 (operating-system-file unattended-upgrade-operating-system-file
203 (default "/run/current-system/configuration.scm"))
79501f26
LC
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
209 (default '(mcron)))
210 (system-expiration unattended-upgrade-system-expiration
211 (default (* 3 30 24 3600)))
212 (maximum-duration unattended-upgrade-maximum-duration
213 (default 3600))
214 (log-file unattended-upgrade-configuration-log-file
215 (default %unattended-upgrade-log-file)))
216
217(define %unattended-upgrade-log-file
218 "/var/log/unattended-upgrade.log")
219
220(define (unattended-upgrade-mcron-jobs config)
221 (define channels
222 (scheme-file "channels.scm"
223 (unattended-upgrade-configuration-channels config)))
224
225 (define log
226 (unattended-upgrade-configuration-log-file config))
227
228 (define services
229 (unattended-upgrade-configuration-services-to-restart config))
230
231 (define expiration
232 (unattended-upgrade-system-expiration config))
233
0d203eea
LC
234 (define config-file
235 (unattended-upgrade-operating-system-file config))
236
79501f26
LC
237 (define code
238 (with-imported-modules (source-module-closure '((guix build utils)
239 (gnu services herd)))
240 #~(begin
241 (use-modules (guix build utils)
242 (gnu services herd)
243 (srfi srfi-19)
244 (srfi srfi-34))
245
246 (define log
247 (open-file #$log "a0"))
248
249 (define (timestamp)
250 (date->string (time-utc->date (current-time time-utc))
251 "[~4]"))
252
253 (define (alarm-handler . _)
254 (format #t "~a time is up, aborting upgrade~%"
255 (timestamp))
256 (exit 1))
257
79501f26
LC
258 ;; 'guix time-machine' needs X.509 certificates to authenticate the
259 ;; Git host.
260 (setenv "SSL_CERT_DIR"
261 #$(file-append nss-certs "/etc/ssl/certs"))
262
263 ;; Make sure the upgrade doesn't take too long.
264 (sigaction SIGALRM alarm-handler)
265 (alarm #$(unattended-upgrade-maximum-duration config))
266
fe42e5f3
LC
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))
270
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)
277
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)
285 "s")))
286
287 (format #t "~a restarting services...~%" (timestamp))
288 (for-each restart-service '#$services)
289
290 ;; XXX: If 'mcron' has been restarted, perhaps this isn't
291 ;; reached.
292 (format #t "~a upgrade complete~%" (timestamp))))))
79501f26
LC
293
294 (define upgrade
295 (program-file "unattended-upgrade" code))
296
297 (list #~(job #$(unattended-upgrade-configuration-schedule config)
298 #$upgrade)))
299
300(define (unattended-upgrade-log-rotations config)
301 (list (log-rotation
302 (files
303 (list (unattended-upgrade-configuration-log-file config))))))
304
305(define unattended-upgrade-service-type
306 (service-type
307 (name 'unattended-upgrade)
308 (extensions
309 (list (service-extension mcron-service-type
310 unattended-upgrade-mcron-jobs)
311 (service-extension rottlog-service-type
312 unattended-upgrade-log-rotations)))
313 (description
314 "Periodically upgrade the system from the current configuration.")
315 (default-value (unattended-upgrade-configuration))))
316
92c03a87 317;;; admin.scm ends here