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 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 packages base)
  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          ;; Restart syslogd after rotation.
  76          (options '("sharedscripts"))
  77          (post-rotate #~(let ((pid (call-with-input-file "/var/run/syslog.pid"
  78                                      read)))
  79                           (kill pid SIGHUP))))
  80         (log-rotation
  81          (files '("/var/log/guix-daemon.log")))))
  82
  83 (define (log-rotation->config rotation)
  84   "Return a string-valued gexp representing the rottlog configuration snippet
  85 for ROTATION."
  86   (define post-rotate
  87     (let ((post (log-rotation-post-rotate rotation)))
  88       (and post
  89            (program-file "rottlog-post-rotate.scm" post))))
  90
  91   #~(let ((post #$post-rotate))
  92       (string-append (string-join '#$(log-rotation-files rotation) ",")
  93                      " {"
  94                      #$(string-join (log-rotation-options rotation)
  95                                     "\n  " 'prefix)
  96                      (if post
  97                          (string-append "\n  postrotate\n    " post
  98                                         "\n  endscript\n")
  99                          "")
 100                      "\n}\n")))
 101
 102 (define (log-rotations->/etc-entries rotations)
 103   "Return the list of /etc entries for ROTATIONS, a list of <log-rotation>."
 104   (define (frequency-file frequency rotations)
 105     (computed-file (string-append "rottlog." (symbol->string frequency))
 106                    #~(call-with-output-file #$output
 107                        (lambda (port)
 108                          (for-each (lambda (str)
 109                                      (display str port))
 110                                    (list #$@(map log-rotation->config
 111                                                  rotations)))))))
 112
 113   (let* ((frequencies (delete-duplicates
 114                        (map log-rotation-frequency rotations)))
 115          (table       (fold (lambda (rotation table)
 116                               (vhash-consq (log-rotation-frequency rotation)
 117                                            rotation table))
 118                             vlist-null
 119                             rotations)))
 120     (map (lambda (frequency)
 121            `(,(symbol->string frequency)
 122              ,(frequency-file frequency
 123                               (vhash-foldq* cons '() frequency table))))
 124          frequencies)))
 125
 126 (define (default-jobs rottlog)
 127   (list #~(job '(next-hour '(0))                  ;midnight
 128                #$(file-append rottlog "/sbin/rottlog"))
 129         #~(job '(next-hour '(12))                 ;noon
 130                #$(file-append rottlog "/sbin/rottlog"))))
 131
 132 (define-record-type* <rottlog-configuration>
 133   rottlog-configuration make-rottlog-configuration
 134   rottlog-configuration?
 135   (rottlog            rottlog-rottlog             ;package
 136                       (default rottlog))
 137   (rc-file            rottlog-rc-file             ;file-like
 138                       (default (file-append rottlog "/etc/rc")))
 139   (rotations          rottlog-rotations           ;list of <log-rotation>
 140                       (default %default-rotations))
 141   (jobs               rottlog-jobs                ;list of <mcron-job>
 142                       (default #f)))
 143
 144 (define (rottlog-etc config)
 145   `(("rottlog"
 146      ,(file-union "rottlog"
 147                   (cons `("rc" ,(rottlog-rc-file config))
 148                         (log-rotations->/etc-entries
 149                          (rottlog-rotations config)))))))
 150
 151 (define (rottlog-jobs-or-default config)
 152   (or (rottlog-jobs config)
 153       (default-jobs (rottlog-rottlog config))))
 154
 155 (define rottlog-service-type
 156   (service-type
 157    (name 'rottlog)
 158    (description
 159     "Periodically rotate log files using GNU@tie{}Rottlog and GNU@tie{}mcron.
 160 Old log files are removed or compressed according to the configuration.")
 161    (extensions (list (service-extension etc-service-type rottlog-etc)
 162                      (service-extension mcron-service-type
 163                                         rottlog-jobs-or-default)
 164
 165                      ;; Add Rottlog to the global profile so users can access
 166                      ;; the documentation.
 167                      (service-extension profile-service-type
 168                                         (compose list rottlog-rottlog))))
 169    (compose concatenate)
 170    (extend (lambda (config rotations)
 171              (rottlog-configuration
 172               (inherit config)
 173               (rotations (append (rottlog-rotations config)
 174                                  rotations)))))
 175    (default-value (rottlog-configuration))))
 176
 177 ;;; admin.scm ends here