Commit | Line | Data |
---|---|---|
92c03a87 JN |
1 | ;;; GNU Guix --- Functional package management for GNU |
2 | ;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org> | |
3104a743 | 3 | ;;; Copyright © 2016, 2017, 2018, 2019, 2020, 2021 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 | 82 | '("/var/log/messages" "/var/log/secure" "/var/log/debug" |
3104a743 | 83 | "/var/log/maillog" "/var/log/mcron.log")) |
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 | |
102 | for 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. | |
177 | Old 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 |