;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
-;;; Copyright © 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2020 Brice Waegeneire <brice@waegenei.re>
;;;
;;; This file is part of GNU Guix.
;;;
;;; 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 <http://www.gnu.org/licenses/>.
(define-module (gnu services admin)
#:use-module (gnu packages admin)
- #:use-module (gnu packages base)
- #:use-module (gnu packages logging)
+ #: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 (gnu services web)
- #:use-module (gnu system shadow)
#:use-module (guix gexp)
- #:use-module (guix store)
+ #:use-module (guix modules)
#:use-module (guix packages)
#:use-module (guix records)
#:use-module (srfi srfi-1)
#:use-module (ice-9 vlist)
- #:use-module (ice-9 match)
#:export (%default-rotations
%rotated-files
rottlog-service
rottlog-service-type
- <tailon-configuration-file>
- tailon-configuration-file
- tailon-configuration-file?
- tailon-configuration-file-files
- tailon-configuration-file-bind
- tailon-configuration-file-relative-root
- tailon-configuration-file-allow-transfers?
- tailon-configuration-file-follow-names?
- tailon-configuration-file-tail-lines
- tailon-configuration-file-allowed-commands
- tailon-configuration-file-debug?
- tailon-configuration-file-http-auth
- tailon-configuration-file-users
-
- <tailon-configuration>
- tailon-configuration
- tailon-configuration?
- tailon-configuration-config-file
- tailon-configuration-package
-
- tailon-service-type))
+ unattended-upgrade-service-type
+ unattended-upgrade-configuration
+ unattended-upgrade-configuration?
+ unattended-upgrade-configuration-operating-system-file
+ 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:
;;;
(define %rotated-files
;; Syslog files subject to rotation.
'("/var/log/messages" "/var/log/secure" "/var/log/debug"
- "/var/log/maillog"))
+ "/var/log/maillog" "/var/log/mcron.log"))
(define %default-rotations
(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.
- (options '("sharedscripts"))
(post-rotate #~(let ((pid (call-with-input-file "/var/run/syslog.pid"
read)))
(kill pid SIGHUP))))
(log-rotation
- (files '("/var/log/shepherd.log" "/var/log/guix-daemon.log")))))
+ (files '("/var/log/guix-daemon.log")))))
(define (log-rotation->config rotation)
"Return a string-valued gexp representing the rottlog configuration snippet
(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>
rottlog-configuration make-rottlog-configuration
\f
;;;
-;;; Tailon
+;;; Unattended upgrade.
;;;
-(define-record-type* <tailon-configuration-file>
- tailon-configuration-file make-tailon-configuration-file
- tailon-configuration-file?
- (files tailon-configuration-file-files
- (default '("/var/log")))
- (bind tailon-configuration-file-bind
- (default "localhost:8080"))
- (relative-root tailon-configuration-file-relative-root
- (default #f))
- (allow-transfers? tailon-configuration-file-allow-transfers?
- (default #t))
- (follow-names? tailon-configuration-file-follow-names?
- (default #t))
- (tail-lines tailon-configuration-file-tail-lines
- (default 200))
- (allowed-commands tailon-configuration-file-allowed-commands
- (default '("tail" "grep" "awk")))
- (debug? tailon-configuration-file-debug?
- (default #f))
- (wrap-lines tailon-configuration-file-wrap-lines
- (default #t))
- (http-auth tailon-configuration-file-http-auth
- (default #f))
- (users tailon-configuration-file-users
- (default #f)))
-
-(define (tailon-configuration-files-string files)
- (string-append
- "\n"
- (string-join
- (map
- (lambda (x)
- (string-append
- " - "
- (cond
- ((string? x)
- (simple-format #f "'~A'" x))
- ((list? x)
- (string-join
- (cons (simple-format #f "'~A':" (car x))
- (map
- (lambda (x) (simple-format #f " - '~A'" x))
- (cdr x)))
- "\n"))
- (else (error x)))))
- files)
- "\n")))
-
-(define-gexp-compiler (tailon-configuration-file-compiler
- (file <tailon-configuration-file>) system target)
- (match file
- (($ <tailon-configuration-file> files bind relative-root
- allow-transfers? follow-names?
- tail-lines allowed-commands debug?
- wrap-lines http-auth users)
- (text-file
- "tailon-config.yaml"
- (string-concatenate
- (filter-map
- (match-lambda
- ((key . #f) #f)
- ((key . value) (string-append key ": " value "\n")))
-
- `(("files" . ,(tailon-configuration-files-string files))
- ("bind" . ,bind)
- ("relative-root" . ,relative-root)
- ("allow-transfers" . ,(if allow-transfers? "true" "false"))
- ("follow-names" . ,(if follow-names? "true" "false"))
- ("tail-lines" . ,(number->string tail-lines))
- ("commands" . ,(string-append "["
- (string-join allowed-commands ", ")
- "]"))
- ("debug" . ,(if debug? "true" #f))
- ("wrap-lines" . ,(if wrap-lines "true" "false"))
- ("http-auth" . ,http-auth)
- ("users" . ,(if users
- (string-concatenate
- (cons "\n"
- (map (match-lambda
- ((user . pass)
- (string-append
- " " user ":" pass)))
- users)))
- #f)))))))))
-
-(define-record-type* <tailon-configuration>
- tailon-configuration make-tailon-configuration
- tailon-configuration?
- (config-file tailon-configuration-config-file
- (default (tailon-configuration-file)))
- (package tailon-configuration-package
- (default tailon)))
-
-(define tailon-shepherd-service
- (match-lambda
- (($ <tailon-configuration> config-file package)
- (list (shepherd-service
- (provision '(tailon))
- (documentation "Run the tailon daemon.")
- (start #~(make-forkexec-constructor
- `(,(string-append #$package "/bin/tailon")
- "-c" ,#$config-file)
- #:user "tailon"
- #:group "tailon"))
- (stop #~(make-kill-destructor)))))))
-
-(define %tailon-accounts
- (list (user-group (name "tailon") (system? #t))
- (user-account
- (name "tailon")
- (group "tailon")
- (system? #t)
- (comment "tailon")
- (home-directory "/var/empty")
- (shell (file-append shadow "/sbin/nologin")))))
-
-(define tailon-service-type
+(define-record-type* <unattended-upgrade-configuration>
+ unattended-upgrade-configuration make-unattended-upgrade-configuration
+ unattended-upgrade-configuration?
+ (operating-system-file unattended-upgrade-operating-system-file
+ (default "/run/current-system/configuration.scm"))
+ (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 config-file
+ (unattended-upgrade-operating-system-file 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))
+
+ ;; '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))
+
+ ;; Redirect stdout/stderr to LOG to save the output of 'guix' below.
+ (redirect-port log (current-output-port))
+ (redirect-port log (current-error-port))
+
+ (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" #$config-file)
+
+ ;; '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 'tailon)
- (description
- "Run Tailon, a Web application for monitoring, viewing, and searching log
-files.")
+ (name 'unattended-upgrade)
(extensions
- (list (service-extension shepherd-root-service-type
- tailon-shepherd-service)
- (service-extension account-service-type
- (const %tailon-accounts))))
- (compose concatenate)
- (extend (lambda (parameter files)
- (tailon-configuration
- (inherit parameter)
- (config-file
- (let ((old-config-file
- (tailon-configuration-config-file parameter)))
- (tailon-configuration-file
- (inherit old-config-file)
- (files (append (tailon-configuration-file-files old-config-file)
- files))))))))
- (default-value (tailon-configuration))))
+ (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
HCoop / jackhill / guix / guix.git / blobdiff