Commit | Line | Data |
---|---|---|
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? | |
52 | unattended-upgrade-configuration-channels | |
53 | unattended-upgrade-configuration-schedule | |
54 | unattended-upgrade-configuration-services-to-restart | |
55 | unattended-upgrade-configuration-system-expiration | |
56 | unattended-upgrade-configuration-maximum-duration | |
57 | unattended-upgrade-configuration-log-file)) | |
92c03a87 JN |
58 | |
59 | ;;; Commentary: | |
60 | ;;; | |
61 | ;;; This module implements configuration of rottlog by writing | |
62 | ;;; /etc/rottlog/{rc,hourly|daily|weekly}. Example usage | |
63 | ;;; | |
64 | ;;; (mcron-service) | |
81fa2229 | 65 | ;;; (service rottlog-service-type) |
92c03a87 JN |
66 | ;;; |
67 | ;;; Code: | |
68 | ||
81fa2229 LC |
69 | (define-record-type* <log-rotation> log-rotation make-log-rotation |
70 | log-rotation? | |
71 | (files log-rotation-files) ;list of strings | |
72 | (frequency log-rotation-frequency ;symbol | |
73 | (default 'weekly)) | |
74 | (post-rotate log-rotation-post-rotate ;#f | gexp | |
75 | (default #f)) | |
76 | (options log-rotation-options ;list of strings | |
77 | (default '()))) | |
78 | ||
92c03a87 | 79 | (define %rotated-files |
4d67ed70 | 80 | ;; Syslog files subject to rotation. |
7fe1432a LC |
81 | '("/var/log/messages" "/var/log/secure" "/var/log/debug" |
82 | "/var/log/maillog")) | |
92c03a87 | 83 | |
92c03a87 | 84 | (define %default-rotations |
81fa2229 LC |
85 | (list (log-rotation ;syslog files |
86 | (files %rotated-files) | |
87 | ||
ab034adf BW |
88 | (options '(;; Run post-rotate once per rotation |
89 | "sharedscripts" | |
90 | ;; Append .gz to rotated files | |
91 | "storefile @FILENAME.@COMP_EXT")) | |
81fa2229 | 92 | ;; Restart syslogd after rotation. |
81fa2229 LC |
93 | (post-rotate #~(let ((pid (call-with-input-file "/var/run/syslog.pid" |
94 | read))) | |
95 | (kill pid SIGHUP)))) | |
96 | (log-rotation | |
ca5b7311 | 97 | (files '("/var/log/guix-daemon.log"))))) |
81fa2229 LC |
98 | |
99 | (define (log-rotation->config rotation) | |
100 | "Return a string-valued gexp representing the rottlog configuration snippet | |
101 | for ROTATION." | |
102 | (define post-rotate | |
103 | (let ((post (log-rotation-post-rotate rotation))) | |
104 | (and post | |
105 | (program-file "rottlog-post-rotate.scm" post)))) | |
106 | ||
107 | #~(let ((post #$post-rotate)) | |
108 | (string-append (string-join '#$(log-rotation-files rotation) ",") | |
109 | " {" | |
110 | #$(string-join (log-rotation-options rotation) | |
111 | "\n " 'prefix) | |
112 | (if post | |
113 | (string-append "\n postrotate\n " post | |
114 | "\n endscript\n") | |
115 | "") | |
116 | "\n}\n"))) | |
117 | ||
118 | (define (log-rotations->/etc-entries rotations) | |
119 | "Return the list of /etc entries for ROTATIONS, a list of <log-rotation>." | |
120 | (define (frequency-file frequency rotations) | |
121 | (computed-file (string-append "rottlog." (symbol->string frequency)) | |
122 | #~(call-with-output-file #$output | |
123 | (lambda (port) | |
124 | (for-each (lambda (str) | |
125 | (display str port)) | |
126 | (list #$@(map log-rotation->config | |
127 | rotations))))))) | |
128 | ||
129 | (let* ((frequencies (delete-duplicates | |
130 | (map log-rotation-frequency rotations))) | |
131 | (table (fold (lambda (rotation table) | |
132 | (vhash-consq (log-rotation-frequency rotation) | |
133 | rotation table)) | |
134 | vlist-null | |
135 | rotations))) | |
136 | (map (lambda (frequency) | |
137 | `(,(symbol->string frequency) | |
138 | ,(frequency-file frequency | |
139 | (vhash-foldq* cons '() frequency table)))) | |
140 | frequencies))) | |
92c03a87 JN |
141 | |
142 | (define (default-jobs rottlog) | |
143 | (list #~(job '(next-hour '(0)) ;midnight | |
89fdd9ee | 144 | #$(file-append rottlog "/sbin/rottlog")) |
92c03a87 | 145 | #~(job '(next-hour '(12)) ;noon |
89fdd9ee | 146 | #$(file-append rottlog "/sbin/rottlog")))) |
92c03a87 JN |
147 | |
148 | (define-record-type* <rottlog-configuration> | |
149 | rottlog-configuration make-rottlog-configuration | |
150 | rottlog-configuration? | |
151 | (rottlog rottlog-rottlog ;package | |
152 | (default rottlog)) | |
153 | (rc-file rottlog-rc-file ;file-like | |
154 | (default (file-append rottlog "/etc/rc"))) | |
81fa2229 | 155 | (rotations rottlog-rotations ;list of <log-rotation> |
92c03a87 JN |
156 | (default %default-rotations)) |
157 | (jobs rottlog-jobs ;list of <mcron-job> | |
158 | (default #f))) | |
159 | ||
160 | (define (rottlog-etc config) | |
81fa2229 LC |
161 | `(("rottlog" |
162 | ,(file-union "rottlog" | |
163 | (cons `("rc" ,(rottlog-rc-file config)) | |
164 | (log-rotations->/etc-entries | |
165 | (rottlog-rotations config))))))) | |
92c03a87 JN |
166 | |
167 | (define (rottlog-jobs-or-default config) | |
168 | (or (rottlog-jobs config) | |
169 | (default-jobs (rottlog-rottlog config)))) | |
170 | ||
171 | (define rottlog-service-type | |
172 | (service-type | |
173 | (name 'rottlog) | |
21b71b01 LC |
174 | (description |
175 | "Periodically rotate log files using GNU@tie{}Rottlog and GNU@tie{}mcron. | |
176 | Old log files are removed or compressed according to the configuration.") | |
92c03a87 JN |
177 | (extensions (list (service-extension etc-service-type rottlog-etc) |
178 | (service-extension mcron-service-type | |
26cfc415 LC |
179 | rottlog-jobs-or-default) |
180 | ||
181 | ;; Add Rottlog to the global profile so users can access | |
182 | ;; the documentation. | |
183 | (service-extension profile-service-type | |
3d3c5650 | 184 | (compose list rottlog-rottlog)))) |
254ea3f9 LC |
185 | (compose concatenate) |
186 | (extend (lambda (config rotations) | |
187 | (rottlog-configuration | |
188 | (inherit config) | |
189 | (rotations (append (rottlog-rotations config) | |
190 | rotations))))) | |
3d3c5650 | 191 | (default-value (rottlog-configuration)))) |
92c03a87 | 192 | |
79501f26 LC |
193 | \f |
194 | ;;; | |
195 | ;;; Unattended upgrade. | |
196 | ;;; | |
197 | ||
198 | (define-record-type* <unattended-upgrade-configuration> | |
199 | unattended-upgrade-configuration make-unattended-upgrade-configuration | |
200 | unattended-upgrade-configuration? | |
201 | (schedule unattended-upgrade-configuration-schedule | |
202 | (default "30 01 * * 0")) | |
203 | (channels unattended-upgrade-configuration-channels | |
204 | (default #~%default-channels)) | |
205 | (services-to-restart unattended-upgrade-configuration-services-to-restart | |
206 | (default '(mcron))) | |
207 | (system-expiration unattended-upgrade-system-expiration | |
208 | (default (* 3 30 24 3600))) | |
209 | (maximum-duration unattended-upgrade-maximum-duration | |
210 | (default 3600)) | |
211 | (log-file unattended-upgrade-configuration-log-file | |
212 | (default %unattended-upgrade-log-file))) | |
213 | ||
214 | (define %unattended-upgrade-log-file | |
215 | "/var/log/unattended-upgrade.log") | |
216 | ||
217 | (define (unattended-upgrade-mcron-jobs config) | |
218 | (define channels | |
219 | (scheme-file "channels.scm" | |
220 | (unattended-upgrade-configuration-channels config))) | |
221 | ||
222 | (define log | |
223 | (unattended-upgrade-configuration-log-file config)) | |
224 | ||
225 | (define services | |
226 | (unattended-upgrade-configuration-services-to-restart config)) | |
227 | ||
228 | (define expiration | |
229 | (unattended-upgrade-system-expiration config)) | |
230 | ||
231 | (define code | |
232 | (with-imported-modules (source-module-closure '((guix build utils) | |
233 | (gnu services herd))) | |
234 | #~(begin | |
235 | (use-modules (guix build utils) | |
236 | (gnu services herd) | |
237 | (srfi srfi-19) | |
238 | (srfi srfi-34)) | |
239 | ||
240 | (define log | |
241 | (open-file #$log "a0")) | |
242 | ||
243 | (define (timestamp) | |
244 | (date->string (time-utc->date (current-time time-utc)) | |
245 | "[~4]")) | |
246 | ||
247 | (define (alarm-handler . _) | |
248 | (format #t "~a time is up, aborting upgrade~%" | |
249 | (timestamp)) | |
250 | (exit 1)) | |
251 | ||
252 | (define-syntax-rule (with-logging exp ...) | |
253 | (with-output-to-port log | |
254 | (lambda () | |
255 | (with-error-to-port log | |
256 | (lambda () | |
257 | exp ...))))) | |
258 | ||
259 | ;; 'guix time-machine' needs X.509 certificates to authenticate the | |
260 | ;; Git host. | |
261 | (setenv "SSL_CERT_DIR" | |
262 | #$(file-append nss-certs "/etc/ssl/certs")) | |
263 | ||
264 | ;; Make sure the upgrade doesn't take too long. | |
265 | (sigaction SIGALRM alarm-handler) | |
266 | (alarm #$(unattended-upgrade-maximum-duration config)) | |
267 | ||
268 | (with-logging | |
269 | (format #t "~a starting upgrade...~%" (timestamp)) | |
270 | (guard (c ((invoke-error? c) | |
271 | (report-invoke-error c))) | |
272 | (invoke #$(file-append guix "/bin/guix") | |
273 | "time-machine" "-C" #$channels | |
274 | "--" "system" "reconfigure" | |
275 | "/run/current-system/configuration.scm") | |
276 | ||
277 | ;; 'guix system delete-generations' fails when there's no | |
278 | ;; matching generation. Thus, catch 'invoke-error?'. | |
279 | (guard (c ((invoke-error? c) | |
280 | (report-invoke-error c))) | |
281 | (invoke #$(file-append guix "/bin/guix") | |
282 | "system" "delete-generations" | |
283 | #$(string-append (number->string expiration) | |
284 | "s"))) | |
285 | ||
286 | (format #t "~a restarting services...~%" (timestamp)) | |
287 | (for-each restart-service '#$services) | |
288 | ||
289 | ;; XXX: If 'mcron' has been restarted, perhaps this isn't | |
290 | ;; reached. | |
291 | (format #t "~a upgrade complete~%" (timestamp))))))) | |
292 | ||
293 | (define upgrade | |
294 | (program-file "unattended-upgrade" code)) | |
295 | ||
296 | (list #~(job #$(unattended-upgrade-configuration-schedule config) | |
297 | #$upgrade))) | |
298 | ||
299 | (define (unattended-upgrade-log-rotations config) | |
300 | (list (log-rotation | |
301 | (files | |
302 | (list (unattended-upgrade-configuration-log-file config)))))) | |
303 | ||
304 | (define unattended-upgrade-service-type | |
305 | (service-type | |
306 | (name 'unattended-upgrade) | |
307 | (extensions | |
308 | (list (service-extension mcron-service-type | |
309 | unattended-upgrade-mcron-jobs) | |
310 | (service-extension rottlog-service-type | |
311 | unattended-upgrade-log-rotations))) | |
312 | (description | |
313 | "Periodically upgrade the system from the current configuration.") | |
314 | (default-value (unattended-upgrade-configuration)))) | |
315 | ||
92c03a87 | 316 | ;;; admin.scm ends here |