Patchwork gnu: rottlog: rotate messages daily.

login
register
mail settings
Submitter Jan Nieuwenhuizen
Date Sept. 22, 2016, 8:51 p.m.
Message ID <87bmzfd5eq.fsf@gnu.org>
Download mbox | patch
Permalink /patch/15943/
State New
Headers show

Comments

Jan Nieuwenhuizen - Sept. 22, 2016, 8:51 p.m.
Ludovic Courtès writes:

Hi!

> The ‘rottlog-configuration’ is actually a macro.  So at every call site
> where a default value is used, the default value code is duplicated,
> leading to code bloat if that default value is a big expression.

Ah, ok.

>> I'm not sure if we should export the %default-rotations or if we should
>> describe their contents in the manual.
>
> Probably worth exporting and documenting, so people can ‘cons’ on it.

Ok.

>> +(define (syslog-rotation-config file)
>> + (let ((coreutils
>> "/gnu/store/56x9fvx59i300wav3c193h84cp80bslr-coreutils-8.25")) ;;
>> FIXME
>
> Good point…

Hmm... :-)

> I think we cannot use ‘plain-file’ here because of the computed ‘kill’
> file name.  So instead, this would be something along the lines of
> (moving ‘string-append’ from the host side to the build side):
>
>   (define (syslog-rotation-config file)
>     #~(string-append #$file " {\n" …
>                      #$coreutils "/bin/kill -HUP …"
>                      "}\n"))
>
> and:
>
>   (define %default-rotations
>     `(("weekly" ,(computed-file "rottlog.weekly"
>                                 #~(call-with-output-file #$output
>                                     (lambda (port)
>                                       (display #$(syslog-rotation-file …)
>                                                port)))))))
> HTH!

Yes, that helps a lot.  Attached a working version...I still feel like
fighting a bit with #~ and '#$...IWBN to get rid of `(apply append '#$(map',
usually append-map works for that, but the gexp boundary seems a bit too
tricksy for me here.

> Thanks again for taking the time and coping with half-baked advice!

Rotating my logs for quite some time already here, and learning quite
a bit about guix and scheme in the process too ;-)

Thanks!
Greetings,
Jan
Ludovic Courtès - Oct. 2, 2016, 10:39 p.m.
Jan Nieuwenhuizen <janneke@gnu.org> skribis:

> From f4b03963d6ba6a232fca4ed749695423547d0ad5 Mon Sep 17 00:00:00 2001
> From: Jan Nieuwenhuizen <janneke@gnu.org>
> Date: Thu, 8 Sep 2016 01:20:43 +0200
> Subject: [PATCH] gnu: services: add rottlog.
>
> * gnu/services/admin.scm: New file.
> * gnu/local.mk (GNU_SYSTEM_MODULES): Add it.
> * doc/guix.texi (Log Rotation): Document it.

I’ve pushed it as 92c03a871559590f7f3b0640e3a6cfd83c8044e6 with minor
changes: typos in the doc and code, an additional introduction sentence
in the doc, removal of the “nocompress” option in the default rotations.

Thanks!

Ludo’.

Patch

From f4b03963d6ba6a232fca4ed749695423547d0ad5 Mon Sep 17 00:00:00 2001
From: Jan Nieuwenhuizen <janneke@gnu.org>
Date: Thu, 8 Sep 2016 01:20:43 +0200
Subject: [PATCH] gnu: services: add rottlog.

* gnu/services/admin.scm: New file.
* gnu/local.mk (GNU_SYSTEM_MODULES): Add it.
* doc/guix.texi (Log Rotation): Document it.
---
 doc/guix.texi          |  65 +++++++++++++++++++++++++-
 gnu/local.mk           |   1 +
 gnu/services/admin.scm | 122 +++++++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 187 insertions(+), 1 deletion(-)
 create mode 100644 gnu/services/admin.scm

diff --git a/doc/guix.texi b/doc/guix.texi
index d5ece55..3db3d28 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -26,7 +26,8 @@  Copyright @copyright{} 2016 Ben Woodcroft@*
 Copyright @copyright{} 2016 Chris Marusich@*
 Copyright @copyright{} 2016 Efraim Flashner@*
 Copyright @copyright{} 2016 John Darrington@*
-Copyright @copyright{} 2016 ng0
+Copyright @copyright{} 2016 ng0@*
+Copyright @copyright{} 2016 Jan Nieuwenhuizen
 
 Permission is granted to copy, distribute and/or modify this document
 under the terms of the GNU Free Documentation License, Version 1.3 or
@@ -213,6 +214,7 @@  Services
 
 * Base Services::               Essential system services.
 * Scheduled Job Execution::     The mcron service.
+* Log Rotation::                The rottlog service.
 * Networking Services::         Network setup, SSH daemon, etc.
 * X Window::                    Graphical display.
 * Desktop Services::            D-Bus and desktop services.
@@ -7622,6 +7624,7 @@  declaration.
 @menu
 * Base Services::               Essential system services.
 * Scheduled Job Execution::     The mcron service.
+* Log Rotation::                The rottlog service.
 * Networking Services::         Network setup, SSH daemon, etc.
 * X Window::                    Graphical display.
 * Desktop Services::            D-Bus and desktop services.
@@ -8096,6 +8099,66 @@  specifications,, mcron, GNU@tie{}mcron}).
 @end deftp
 
 
+@node Log Rotation
+@subsubsection Log Rotation
+
+@cindex rottlog
+@cindex log rotation
+The @code{(gnu services admin)} module provides an interface to
+GNU@tie{}rottlog, a log rotator @pxref{rottlog,,,GNU Rot[t]log Manual}.
+
+The example below defines an operating system that provides
+log rotation.
+
+@lisp
+(use-modules (guix) (gnu) (gnu services admin) (gnu services mcron))
+(use-package-modules base idutils)
+
+(operating-system
+  ;; @dots{}
+  (services (cons* (mcron-service)
+                   (service rottlog-service-type (rottlog-configuration)) 
+                   %base-services)))
+@end lisp
+
+@defvr {Scheme Variable} rottlog-service-type
+This is the type of the @code{rottlog} service, whose value is an
+@code{rottlog-configuration} object.
+
+This service type can define @var{mcron}-jobs (@pxref{Scheduled Job
+Execution}) to run the rottlog service.
+@end defvr
+
+@deftp {Data Type} rottlog-configuration
+Data type representing the configuration of rottlog.
+
+@table @asis
+@item @code{rottlog} (default: @var{rottlog})
+The rottlog package to use.
+
+@item @code{rc-file} (default: (file-append rottlog "/etc/rc")
+The rottlog @var{rc-file} to use.
+
+@item @code{periodic-rotations} (default: `(("weekly" %default-rotatations)))
+A list of rottlog period-name/period-config tuples.
+
+@item @code{jobs}
+This is a list of gexps (@pxref{G-Expressions}), where each gexp
+corresponds to an mcron job specification (@pxref{Syntax, mcron job
+specifications,, mcron, GNU@tie{}mcron}).
+@end table
+@end deftp
+
+@defvr {Scheme Variable} %default-rotatations
+Specifies weekly rotation of @var{%rotated-files} and
+@code{"/var/log/shepherd.log"}.
+@end defvr
+
+@defvr {Scheme Variable} %rotated-files
+The list of syslog-controlled files to be rotated (default:
+'("/var/log/messages" "/var/log/secure"))
+@end defvr
+
 @node Networking Services
 @subsubsection Networking Services
 
diff --git a/gnu/local.mk b/gnu/local.mk
index 0da41f7..baa10f9 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -381,6 +381,7 @@  GNU_SYSTEM_MODULES =				\
   %D%/packages/zip.scm				\
 						\
   %D%/services.scm				\
+  %D%/services/admin.scm			\
   %D%/services/avahi.scm			\
   %D%/services/base.scm				\
   %D%/services/databases.scm			\
diff --git a/gnu/services/admin.scm b/gnu/services/admin.scm
new file mode 100644
index 0000000..36ee997
--- /dev/null
+++ b/gnu/services/admin.scm
@@ -0,0 +1,122 @@ 
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; 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
+;;; 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 services)
+  #:use-module (gnu services mcron)
+  #:use-module (gnu services shepherd)
+  #:use-module (guix gexp)
+  #:use-module (guix packages)
+  #:use-module (guix records)
+  #:use-module (srfi srfi-1)
+  #:export (%default-rotations
+            %rotated-files
+            rottlog-configuration
+            rottlog-configuration?
+            rottlog-service
+            rottlog-service-type))
+
+;;; Commentary:
+;;;
+;;; This module implements configuration of rottlog by writing
+;;; /etc/rottlog/{rc,hourly|daily|weekly}.  Example usage
+;;; 
+;;;     (mcron-service)
+;;;     (service rottlog-service-typeo (rottlog-configuration))
+;;;
+;;; Code:
+
+(define %rotated-files
+  '("/var/log/messages" "/var/log/secure"))
+
+(define (syslog-rotation-config file)
+  #~(#$file " {
+	sharedscripts
+	postrotate
+	" #$coreutils "/bin/kill -HUP $(cat /var/run/syslog.pid) 2> /dev/null
+	endscript
+	nocompress
+}
+"))
+
+(define (simple-rotation-config file)
+  (string-append file " {
+	sharedscripts
+	postrotate
+	endscript
+	nocompress
+}
+"))
+
+(define %default-rotations
+  `(("weekly"
+     ,(computed-file "rottlog.weekly"
+                     #~(call-with-output-file #$output
+                         (lambda (port)
+                           (display
+                            (string-join
+                             (apply append '#$(map syslog-rotation-config
+                                                   %rotated-files))
+                             "")
+                            port)
+                           (display #$(simple-rotation-config
+                                       "/var/log/shepherd.log")
+                                    port)))))))
+
+(define (default-jobs rottlog)
+  (list #~(job
+           '(next-hour '(0))
+           (lambda ()
+             (system* (strinng-append #$rottlog "/sbin/rottlog"))))
+        #~(job
+           '(next-hour '(12))
+           (lambda ()
+             (system* (string-append #$rottlog "/sbin/rottlog"))))))
+
+(define-record-type* <rottlog-configuration>
+  rottlog-configuration make-rottlog-configuration
+  rottlog-configuration?
+  (rottlog            rottlog-rottlog            ; package
+                      (default rottlog))
+  (rc-file            rottlog-rc-file            ; file
+                      (default (file-append rottlog "/etc/rc")))
+  (periodic-rotations rottlog-periodic-rotations ; list of (name file) tuples
+                      (default %default-rotations))
+  (jobs               rottlog-jobs               ; list of <mcron-job>
+                      (default #f)))
+
+(define (rottlog-etc config)
+  `(("rottlog" ,(file-union "rottlog"
+                            (cons `("rc" ,(rottlog-rc-file config))
+                                  (rottlog-periodic-rotations config))))))
+
+(define (rottlog-jobs-or-default config)
+  (or (rottlog-jobs config)
+      (default-jobs (rottlog-rottlog config))))
+
+(define rottlog-service-type
+  (service-type
+   (name 'rottlog)
+   (extensions
+    (list
+     (service-extension etc-service-type rottlog-etc)
+     (service-extension mcron-service-type rottlog-jobs-or-default)))))
+
+;;; admin.scm ends here
-- 
2.9.3