gnu/services/admin.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
   3 ;;; Copyright © 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
   4 ;;;
   5 ;;; This file is part of GNU Guix.
   6 ;;;
   7 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   8 ;;; under the terms of the GNU General Public License as published by
   9 ;;; the Free Software Foundation; either version 3 of the License, or (at
  10 ;;; your option) any later version.
  11 ;;;
  12 ;;; GNU Guix is distributed in the hope that it will be useful, but
  13 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;;; GNU General Public License for more details.
  16 ;;;
  17 ;;; You should have received a copy of the GNU General Public License
  18 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  19
  20 (define-module (gnu services admin)
  21   #:use-module (gnu packages admin)
  22   #:use-module (gnu services)
  23   #:use-module (gnu services mcron)
  24   #:use-module (gnu services shepherd)
  25   #:use-module (guix gexp)
  26   #:use-module (guix packages)
  27   #:use-module (guix records)
  28   #:use-module (srfi srfi-1)
  29   #:use-module (ice-9 vlist)
  30   #:export (%default-rotations
  31             %rotated-files
  32
  33             log-rotation
  34             log-rotation?
  35             log-rotation-frequency
  36             log-rotation-files
  37             log-rotation-options
  38             log-rotation-post-rotate
  39
  40             rottlog-configuration
  41             rottlog-configuration?
  42             rottlog-service
  43             rottlog-service-type))
  44
  45 ;;; Commentary:
  46 ;;;
  47 ;;; This module implements configuration of rottlog by writing
  48 ;;; /etc/rottlog/{rc,hourly|daily|weekly}.  Example usage
  49 ;;;
  50 ;;;     (mcron-service)
  51 ;;;     (service rottlog-service-type)
  52 ;;;
  53 ;;; Code:
  54
  55 (define-record-type* <log-rotation> log-rotation make-log-rotation
  56   log-rotation?
  57   (files       log-rotation-files)                ;list of strings
  58   (frequency   log-rotation-frequency             ;symbol
  59                (default 'weekly))
  60   (post-rotate log-rotation-post-rotate           ;#f | gexp
  61                (default #f))
  62   (options     log-rotation-options               ;list of strings
  63                (default '())))
  64
  65 (define %rotated-files
  66   ;; Syslog files subject to rotation.
  67   '("/var/log/messages" "/var/log/secure" "/var/log/debug"
  68     "/var/log/maillog"))
  69
  70 (define %default-rotations
  71   (list (log-rotation                             ;syslog files
  72          (files %rotated-files)
  73
  74          ;; Restart syslogd after rotation.
  75          (options '("sharedscripts"))
  76          (post-rotate #~(let ((pid (call-with-input-file "/var/run/syslog.pid"
  77                                      read)))
  78                           (kill pid SIGHUP))))
  79         (log-rotation
  80          (files '("/var/log/guix-daemon.log")))))
  81
  82 (define (log-rotation->config rotation)
  83   "Return a string-valued gexp representing the rottlog configuration snippet
  84 for ROTATION."
  85   (define post-rotate
  86     (let ((post (log-rotation-post-rotate rotation)))
  87       (and post
  88            (program-file "rottlog-post-rotate.scm" post))))
  89
  90   #~(let ((post #$post-rotate))
  91       (string-append (string-join '#$(log-rotation-files rotation) ",")
  92                      " {"
  93                      #$(string-join (log-rotation-options rotation)
  94                                     "\n  " 'prefix)
  95                      (if post
  96                          (string-append "\n  postrotate\n    " post
  97                                         "\n  endscript\n")
  98                          "")
  99                      "\n}\n")))
 100
 101 (define (log-rotations->/etc-entries rotations)
 102   "Return the list of /etc entries for ROTATIONS, a list of <log-rotation>."
 103   (define (frequency-file frequency rotations)
 104     (computed-file (string-append "rottlog." (symbol->string frequency))
 105                    #~(call-with-output-file #$output
 106                        (lambda (port)
 107                          (for-each (lambda (str)
 108                                      (display str port))
 109                                    (list #$@(map log-rotation->config
 110                                                  rotations)))))))
 111
 112   (let* ((frequencies (delete-duplicates
 113                        (map log-rotation-frequency rotations)))
 114          (table       (fold (lambda (rotation table)
 115                               (vhash-consq (log-rotation-frequency rotation)
 116                                            rotation table))
 117                             vlist-null
 118                             rotations)))
 119     (map (lambda (frequency)
 120            `(,(symbol->string frequency)
 121              ,(frequency-file frequency
 122                               (vhash-foldq* cons '() frequency table))))
 123          frequencies)))
 124
 125 (define (default-jobs rottlog)
 126   (list #~(job '(next-hour '(0))                  ;midnight
 127                #$(file-append rottlog "/sbin/rottlog"))
 128         #~(job '(next-hour '(12))                 ;noon
 129                #$(file-append rottlog "/sbin/rottlog"))))
 130
 131 (define-record-type* <rottlog-configuration>
 132   rottlog-configuration make-rottlog-configuration
 133   rottlog-configuration?
 134   (rottlog            rottlog-rottlog             ;package
 135                       (default rottlog))
 136   (rc-file            rottlog-rc-file             ;file-like
 137                       (default (file-append rottlog "/etc/rc")))
 138   (rotations          rottlog-rotations           ;list of <log-rotation>
 139                       (default %default-rotations))
 140   (jobs               rottlog-jobs                ;list of <mcron-job>
 141                       (default #f)))
 142
 143 (define (rottlog-etc config)
 144   `(("rottlog"
 145      ,(file-union "rottlog"
 146                   (cons `("rc" ,(rottlog-rc-file config))
 147                         (log-rotations->/etc-entries
 148                          (rottlog-rotations config)))))))
 149
 150 (define (rottlog-jobs-or-default config)
 151   (or (rottlog-jobs config)
 152       (default-jobs (rottlog-rottlog config))))
 153
 154 (define rottlog-service-type
 155   (service-type
 156    (name 'rottlog)
 157    (description
 158     "Periodically rotate log files using GNU@tie{}Rottlog and GNU@tie{}mcron.
 159 Old log files are removed or compressed according to the configuration.")
 160    (extensions (list (service-extension etc-service-type rottlog-etc)
 161                      (service-extension mcron-service-type
 162                                         rottlog-jobs-or-default)
 163
 164                      ;; Add Rottlog to the global profile so users can access
 165                      ;; the documentation.
 166                      (service-extension profile-service-type
 167                                         (compose list rottlog-rottlog))))
 168    (compose concatenate)
 169    (extend (lambda (config rotations)
 170              (rottlog-configuration
 171               (inherit config)
 172               (rotations (append (rottlog-rotations config)
 173                                  rotations)))))
 174    (default-value (rottlog-configuration))))
 175
 176 ;;; admin.scm ends here