X-Git-Url: https://git.hcoop.net/jackhill/guix/guix.git/blobdiff_plain/3d3c56500843b5573ba6419db5e66075fb8ac8ef..79501f26ab6d82c0256ff786a5dfb0000b52ccd3:/gnu/services/admin.scm diff --git a/gnu/services/admin.scm b/gnu/services/admin.scm index 6ac24e32b0..6ed3de9423 100644 --- a/gnu/services/admin.scm +++ b/gnu/services/admin.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2016 Jan Nieuwenhuizen -;;; Copyright © 2016, 2017 Ludovic Courtès +;;; Copyright © 2016, 2017, 2018, 2019, 2020 Ludovic Courtès +;;; Copyright © 2020 Brice Waegeneire ;;; ;;; This file is part of GNU Guix. ;;; @@ -14,25 +15,46 @@ ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;; GNU General Public License for more details. ;;; -;;; You should have received a copy of thye GNU General Public License +;;; You should have received a copy of the GNU General Public License ;;; along with GNU Guix. If not, see . (define-module (gnu services admin) #:use-module (gnu packages admin) - #:use-module (gnu packages base) + #:use-module (gnu packages certs) + #:use-module (gnu packages package-management) #:use-module (gnu services) #:use-module (gnu services mcron) #:use-module (gnu services shepherd) #:use-module (guix gexp) + #:use-module (guix modules) #:use-module (guix packages) #:use-module (guix records) #:use-module (srfi srfi-1) + #:use-module (ice-9 vlist) #:export (%default-rotations %rotated-files + + log-rotation + log-rotation? + log-rotation-frequency + log-rotation-files + log-rotation-options + log-rotation-post-rotate + rottlog-configuration rottlog-configuration? rottlog-service - rottlog-service-type)) + rottlog-service-type + + unattended-upgrade-service-type + unattended-upgrade-configuration + unattended-upgrade-configuration? + unattended-upgrade-configuration-channels + unattended-upgrade-configuration-schedule + unattended-upgrade-configuration-services-to-restart + unattended-upgrade-configuration-system-expiration + unattended-upgrade-configuration-maximum-duration + unattended-upgrade-configuration-log-file)) ;;; Commentary: ;;; @@ -40,49 +62,88 @@ ;;; /etc/rottlog/{rc,hourly|daily|weekly}. Example usage ;;; ;;; (mcron-service) -;;; (service rottlog-service-type (rottlog-configuration)) +;;; (service rottlog-service-type) ;;; ;;; Code: +(define-record-type* log-rotation make-log-rotation + log-rotation? + (files log-rotation-files) ;list of strings + (frequency log-rotation-frequency ;symbol + (default 'weekly)) + (post-rotate log-rotation-post-rotate ;#f | gexp + (default #f)) + (options log-rotation-options ;list of strings + (default '()))) + (define %rotated-files ;; Syslog files subject to rotation. - '("/var/log/messages" "/var/log/secure" "/var/log/maillog")) - -(define (syslog-rotation-config files) - #~(string-append #$(string-join files ",") - " { - sharedscripts - postrotate - " #$coreutils "/bin/kill -HUP $(cat /var/run/syslog.pid) 2> /dev/null - endscript -} -")) - -(define (simple-rotation-config files) - #~(string-append #$(string-join files ",") " { - sharedscripts -} -")) + '("/var/log/messages" "/var/log/secure" "/var/log/debug" + "/var/log/maillog")) (define %default-rotations - `(("weekly" - ,(computed-file "rottlog.weekly" - #~(call-with-output-file #$output - (lambda (port) - (display #$(syslog-rotation-config %rotated-files) - port) - (display #$(simple-rotation-config - '("/var/log/shepherd.log" - "/var/log/guix-daemon.log")) - port))))))) + (list (log-rotation ;syslog files + (files %rotated-files) + + (options '(;; Run post-rotate once per rotation + "sharedscripts" + ;; Append .gz to rotated files + "storefile @FILENAME.@COMP_EXT")) + ;; Restart syslogd after rotation. + (post-rotate #~(let ((pid (call-with-input-file "/var/run/syslog.pid" + read))) + (kill pid SIGHUP)))) + (log-rotation + (files '("/var/log/guix-daemon.log"))))) + +(define (log-rotation->config rotation) + "Return a string-valued gexp representing the rottlog configuration snippet +for ROTATION." + (define post-rotate + (let ((post (log-rotation-post-rotate rotation))) + (and post + (program-file "rottlog-post-rotate.scm" post)))) + + #~(let ((post #$post-rotate)) + (string-append (string-join '#$(log-rotation-files rotation) ",") + " {" + #$(string-join (log-rotation-options rotation) + "\n " 'prefix) + (if post + (string-append "\n postrotate\n " post + "\n endscript\n") + "") + "\n}\n"))) + +(define (log-rotations->/etc-entries rotations) + "Return the list of /etc entries for ROTATIONS, a list of ." + (define (frequency-file frequency rotations) + (computed-file (string-append "rottlog." (symbol->string frequency)) + #~(call-with-output-file #$output + (lambda (port) + (for-each (lambda (str) + (display str port)) + (list #$@(map log-rotation->config + rotations))))))) + + (let* ((frequencies (delete-duplicates + (map log-rotation-frequency rotations))) + (table (fold (lambda (rotation table) + (vhash-consq (log-rotation-frequency rotation) + rotation table)) + vlist-null + rotations))) + (map (lambda (frequency) + `(,(symbol->string frequency) + ,(frequency-file frequency + (vhash-foldq* cons '() frequency table)))) + frequencies))) (define (default-jobs rottlog) (list #~(job '(next-hour '(0)) ;midnight - (lambda () - (system* #$(file-append rottlog "/sbin/rottlog")))) + #$(file-append rottlog "/sbin/rottlog")) #~(job '(next-hour '(12)) ;noon - (lambda () - (system* #$(file-append rottlog "/sbin/rottlog")))))) + #$(file-append rottlog "/sbin/rottlog")))) (define-record-type* rottlog-configuration make-rottlog-configuration @@ -91,15 +152,17 @@ (default rottlog)) (rc-file rottlog-rc-file ;file-like (default (file-append rottlog "/etc/rc"))) - (periodic-rotations rottlog-periodic-rotations ;list of (name file) tuples + (rotations rottlog-rotations ;list of (default %default-rotations)) (jobs rottlog-jobs ;list of (default #f))) (define (rottlog-etc config) - `(("rottlog" ,(file-union "rottlog" - (cons `("rc" ,(rottlog-rc-file config)) - (rottlog-periodic-rotations config)))))) + `(("rottlog" + ,(file-union "rottlog" + (cons `("rc" ,(rottlog-rc-file config)) + (log-rotations->/etc-entries + (rottlog-rotations config))))))) (define (rottlog-jobs-or-default config) (or (rottlog-jobs config) @@ -108,6 +171,9 @@ (define rottlog-service-type (service-type (name 'rottlog) + (description + "Periodically rotate log files using GNU@tie{}Rottlog and GNU@tie{}mcron. +Old log files are removed or compressed according to the configuration.") (extensions (list (service-extension etc-service-type rottlog-etc) (service-extension mcron-service-type rottlog-jobs-or-default) @@ -116,6 +182,135 @@ ;; the documentation. (service-extension profile-service-type (compose list rottlog-rottlog)))) + (compose concatenate) + (extend (lambda (config rotations) + (rottlog-configuration + (inherit config) + (rotations (append (rottlog-rotations config) + rotations))))) (default-value (rottlog-configuration)))) + +;;; +;;; Unattended upgrade. +;;; + +(define-record-type* + unattended-upgrade-configuration make-unattended-upgrade-configuration + unattended-upgrade-configuration? + (schedule unattended-upgrade-configuration-schedule + (default "30 01 * * 0")) + (channels unattended-upgrade-configuration-channels + (default #~%default-channels)) + (services-to-restart unattended-upgrade-configuration-services-to-restart + (default '(mcron))) + (system-expiration unattended-upgrade-system-expiration + (default (* 3 30 24 3600))) + (maximum-duration unattended-upgrade-maximum-duration + (default 3600)) + (log-file unattended-upgrade-configuration-log-file + (default %unattended-upgrade-log-file))) + +(define %unattended-upgrade-log-file + "/var/log/unattended-upgrade.log") + +(define (unattended-upgrade-mcron-jobs config) + (define channels + (scheme-file "channels.scm" + (unattended-upgrade-configuration-channels config))) + + (define log + (unattended-upgrade-configuration-log-file config)) + + (define services + (unattended-upgrade-configuration-services-to-restart config)) + + (define expiration + (unattended-upgrade-system-expiration config)) + + (define code + (with-imported-modules (source-module-closure '((guix build utils) + (gnu services herd))) + #~(begin + (use-modules (guix build utils) + (gnu services herd) + (srfi srfi-19) + (srfi srfi-34)) + + (define log + (open-file #$log "a0")) + + (define (timestamp) + (date->string (time-utc->date (current-time time-utc)) + "[~4]")) + + (define (alarm-handler . _) + (format #t "~a time is up, aborting upgrade~%" + (timestamp)) + (exit 1)) + + (define-syntax-rule (with-logging exp ...) + (with-output-to-port log + (lambda () + (with-error-to-port log + (lambda () + exp ...))))) + + ;; 'guix time-machine' needs X.509 certificates to authenticate the + ;; Git host. + (setenv "SSL_CERT_DIR" + #$(file-append nss-certs "/etc/ssl/certs")) + + ;; Make sure the upgrade doesn't take too long. + (sigaction SIGALRM alarm-handler) + (alarm #$(unattended-upgrade-maximum-duration config)) + + (with-logging + (format #t "~a starting upgrade...~%" (timestamp)) + (guard (c ((invoke-error? c) + (report-invoke-error c))) + (invoke #$(file-append guix "/bin/guix") + "time-machine" "-C" #$channels + "--" "system" "reconfigure" + "/run/current-system/configuration.scm") + + ;; 'guix system delete-generations' fails when there's no + ;; matching generation. Thus, catch 'invoke-error?'. + (guard (c ((invoke-error? c) + (report-invoke-error c))) + (invoke #$(file-append guix "/bin/guix") + "system" "delete-generations" + #$(string-append (number->string expiration) + "s"))) + + (format #t "~a restarting services...~%" (timestamp)) + (for-each restart-service '#$services) + + ;; XXX: If 'mcron' has been restarted, perhaps this isn't + ;; reached. + (format #t "~a upgrade complete~%" (timestamp))))))) + + (define upgrade + (program-file "unattended-upgrade" code)) + + (list #~(job #$(unattended-upgrade-configuration-schedule config) + #$upgrade))) + +(define (unattended-upgrade-log-rotations config) + (list (log-rotation + (files + (list (unattended-upgrade-configuration-log-file config)))))) + +(define unattended-upgrade-service-type + (service-type + (name 'unattended-upgrade) + (extensions + (list (service-extension mcron-service-type + unattended-upgrade-mcron-jobs) + (service-extension rottlog-service-type + unattended-upgrade-log-rotations))) + (description + "Periodically upgrade the system from the current configuration.") + (default-value (unattended-upgrade-configuration)))) + ;;; admin.scm ends here