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 ;;; Copyright © 2020 Brice Waegeneire <brice@waegenei.re>
   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 ;;;
  18 ;;; You should have received a copy of the GNU General Public License
  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)
  23   #:use-module (gnu services)
  24   #:use-module (gnu services mcron)
  25   #:use-module (gnu services shepherd)
  26   #:use-module (guix gexp)
  27   #:use-module (guix packages)
  28   #:use-module (guix records)
  29   #:use-module (srfi srfi-1)
  30   #:use-module (ice-9 vlist)
  31   #:export (%default-rotations
  32             %rotated-files
  33
  34             log-rotation
  35             log-rotation?
  36             log-rotation-frequency
  37             log-rotation-files
  38             log-rotation-options
  39             log-rotation-post-rotate
  40
  41             rottlog-configuration
  42             rottlog-configuration?
  43             rottlog-service
  44             rottlog-service-type))
  45
  46 ;;; Commentary:
  47 ;;;
  48 ;;; This module implements configuration of rottlog by writing
  49 ;;; /etc/rottlog/{rc,hourly|daily|weekly}.  Example usage
  50 ;;;
  51 ;;;     (mcron-service)
  52 ;;;     (service rottlog-service-type)
  53 ;;;
  54 ;;; Code:
  55
  56 (define-record-type* <log-rotation> log-rotation make-log-rotation
  57   log-rotation?
  58   (files       log-rotation-files)                ;list of strings
  59   (frequency   log-rotation-frequency             ;symbol
  60                (default 'weekly))
  61   (post-rotate log-rotation-post-rotate           ;#f | gexp
  62                (default #f))
  63   (options     log-rotation-options               ;list of strings
  64                (default '())))
  65
  66 (define %rotated-files
  67   ;; Syslog files subject to rotation.
  68   '("/var/log/messages" "/var/log/secure" "/var/log/debug"
  69     "/var/log/maillog"))
  70
  71 (define %default-rotations
  72   (list (log-rotation                             ;syslog files
  73          (files %rotated-files)
  74
  75          (options '(;; Run post-rotate once per rotation
  76                     "sharedscripts"
  77                     ;; Append .gz to rotated files
  78                     "storefile @FILENAME.@COMP_EXT"))
  79          ;; Restart syslogd after rotation.
  80          (post-rotate #~(let ((pid (call-with-input-file "/var/run/syslog.pid"
  81                                      read)))
  82                           (kill pid SIGHUP))))
  83         (log-rotation
  84          (files '("/var/log/guix-daemon.log")))))
  85
  86 (define (log-rotation->config rotation)
  87   "Return a string-valued gexp representing the rottlog configuration snippet
  88 for ROTATION."
  89   (define post-rotate
  90     (let ((post (log-rotation-post-rotate rotation)))
  91       (and post
  92            (program-file "rottlog-post-rotate.scm" post))))
  93
  94   #~(let ((post #$post-rotate))
  95       (string-append (string-join '#$(log-rotation-files rotation) ",")
  96                      " {"
  97                      #$(string-join (log-rotation-options rotation)
  98                                     "\n  " 'prefix)
  99                      (if post
 100                          (string-append "\n  postrotate\n    " post
 101                                         "\n  endscript\n")
 102                          "")
 103                      "\n}\n")))
 104
 105 (define (log-rotations->/etc-entries rotations)
 106   "Return the list of /etc entries for ROTATIONS, a list of <log-rotation>."
 107   (define (frequency-file frequency rotations)
 108     (computed-file (string-append "rottlog." (symbol->string frequency))
 109                    #~(call-with-output-file #$output
 110                        (lambda (port)
 111                          (for-each (lambda (str)
 112                                      (display str port))
 113                                    (list #$@(map log-rotation->config
 114                                                  rotations)))))))
 115
 116   (let* ((frequencies (delete-duplicates
 117                        (map log-rotation-frequency rotations)))
 118          (table       (fold (lambda (rotation table)
 119                               (vhash-consq (log-rotation-frequency rotation)
 120                                            rotation table))
 121                             vlist-null
 122                             rotations)))
 123     (map (lambda (frequency)
 124            `(,(symbol->string frequency)
 125              ,(frequency-file frequency
 126                               (vhash-foldq* cons '() frequency table))))
 127          frequencies)))
 128
 129 (define (default-jobs rottlog)
 130   (list #~(job '(next-hour '(0))                  ;midnight
 131                #$(file-append rottlog "/sbin/rottlog"))
 132         #~(job '(next-hour '(12))                 ;noon
 133                #$(file-append rottlog "/sbin/rottlog"))))
 134
 135 (define-record-type* <rottlog-configuration>
 136   rottlog-configuration make-rottlog-configuration
 137   rottlog-configuration?
 138   (rottlog            rottlog-rottlog             ;package
 139                       (default rottlog))
 140   (rc-file            rottlog-rc-file             ;file-like
 141                       (default (file-append rottlog "/etc/rc")))
 142   (rotations          rottlog-rotations           ;list of <log-rotation>
 143                       (default %default-rotations))
 144   (jobs               rottlog-jobs                ;list of <mcron-job>
 145                       (default #f)))
 146
 147 (define (rottlog-etc config)
 148   `(("rottlog"
 149      ,(file-union "rottlog"
 150                   (cons `("rc" ,(rottlog-rc-file config))
 151                         (log-rotations->/etc-entries
 152                          (rottlog-rotations config)))))))
 153
 154 (define (rottlog-jobs-or-default config)
 155   (or (rottlog-jobs config)
 156       (default-jobs (rottlog-rottlog config))))
 157
 158 (define rottlog-service-type
 159   (service-type
 160    (name 'rottlog)
 161    (description
 162     "Periodically rotate log files using GNU@tie{}Rottlog and GNU@tie{}mcron.
 163 Old log files are removed or compressed according to the configuration.")
 164    (extensions (list (service-extension etc-service-type rottlog-etc)
 165                      (service-extension mcron-service-type
 166                                         rottlog-jobs-or-default)
 167
 168                      ;; Add Rottlog to the global profile so users can access
 169                      ;; the documentation.
 170                      (service-extension profile-service-type
 171                                         (compose list rottlog-rottlog))))
 172    (compose concatenate)
 173    (extend (lambda (config rotations)
 174              (rottlog-configuration
 175               (inherit config)
 176               (rotations (append (rottlog-rotations config)
 177                                  rotations)))))
 178    (default-value (rottlog-configuration))))
 179
 180 ;;; admin.scm ends here