gnu/services/admin.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
   3 ;;; Copyright © 2016 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 thye 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   #:export (%default-rotations
  31             %rotated-files
  32             rottlog-configuration
  33             rottlog-configuration?
  34             rottlog-service
  35             rottlog-service-type))
  36
  37 ;;; Commentary:
  38 ;;;
  39 ;;; This module implements configuration of rottlog by writing
  40 ;;; /etc/rottlog/{rc,hourly|daily|weekly}.  Example usage
  41 ;;;
  42 ;;;     (mcron-service)
  43 ;;;     (service rottlog-service-type (rottlog-configuration))
  44 ;;;
  45 ;;; Code:
  46
  47 (define %rotated-files
  48   ;; Syslog files subject to rotation.
  49   '("/var/log/messages" "/var/log/secure" "/var/log/maillog"))
  50
  51 (define (syslog-rotation-config files)
  52   #~(string-append #$(string-join files ",")
  53                  " {
  54         sharedscripts
  55         postrotate
  56         " #$coreutils "/bin/kill -HUP $(cat /var/run/syslog.pid) 2> /dev/null
  57         endscript
  58 }
  59 "))
  60
  61 (define (simple-rotation-config files)
  62   #~(string-append #$(string-join files ",") " {
  63         sharedscripts
  64 }
  65 "))
  66
  67 (define %default-rotations
  68   `(("weekly"
  69      ,(computed-file "rottlog.weekly"
  70                      #~(call-with-output-file #$output
  71                          (lambda (port)
  72                            (display #$(syslog-rotation-config %rotated-files)
  73                                     port)
  74                            (display #$(simple-rotation-config
  75                                        '("/var/log/shepherd.log"
  76                                          "/var/log/guix-daemon.log"))
  77                                     port)))))))
  78
  79 (define (default-jobs rottlog)
  80   (list #~(job '(next-hour '(0))                  ;midnight
  81                (lambda ()
  82                  (system* #$(file-append rottlog "/sbin/rottlog"))))
  83         #~(job '(next-hour '(12))                 ;noon
  84                (lambda ()
  85                  (system* #$(file-append rottlog "/sbin/rottlog"))))))
  86
  87 (define-record-type* <rottlog-configuration>
  88   rottlog-configuration make-rottlog-configuration
  89   rottlog-configuration?
  90   (rottlog            rottlog-rottlog             ;package
  91                       (default rottlog))
  92   (rc-file            rottlog-rc-file             ;file-like
  93                       (default (file-append rottlog "/etc/rc")))
  94   (periodic-rotations rottlog-periodic-rotations  ;list of (name file) tuples
  95                       (default %default-rotations))
  96   (jobs               rottlog-jobs                ;list of <mcron-job>
  97                       (default #f)))
  98
  99 (define (rottlog-etc config)
 100   `(("rottlog" ,(file-union "rottlog"
 101                             (cons `("rc" ,(rottlog-rc-file config))
 102                                   (rottlog-periodic-rotations config))))))
 103
 104 (define (rottlog-jobs-or-default config)
 105   (or (rottlog-jobs config)
 106       (default-jobs (rottlog-rottlog config))))
 107
 108 (define rottlog-service-type
 109   (service-type
 110    (name 'rottlog)
 111    (extensions (list (service-extension etc-service-type rottlog-etc)
 112                      (service-extension mcron-service-type
 113                                         rottlog-jobs-or-default)
 114
 115                      ;; Add Rottlog to the global profile so users can access
 116                      ;; the documentation.
 117                      (service-extension profile-service-type
 118                                         (compose list rottlog-rottlog))))))
 119
 120 ;;; admin.scm ends here