Re: [PATCH] gnu: rottlog: rotate messages daily.

[Jan Nieuwenhuizen]

Jan Nieuwenhuizen writes:

Hi!

>> ‘rottlog’ was looking for config files in OUT/etc, which made it
>> impossible for people to configure it.  So in commit
>> 268ad34e0eadf8a015798b5c5587aad65b9f3a61 I changed it to look for
>> configuration files in /etc/rottlog.
>>
>> Consequently, running “rottlog” alone won’t work; one has to provide
>> /etc/rottlog/{rc,daily} first.  We should have a GuixSD service that
>> does that.
>
> Ah, yes configuration was the bit I was wondering about.  A service
> that initializes/writes these sounds like a good idea!

I made an attempt at a simple version of such a service.  Its currently
just copying rc and writing a daily/weekly, find a working example
attached.

Greetings,
Jan

>From cf93c7b59d0dc71ff23b4f9d435106d3844a9b9a Mon Sep 17 00:00:00 2001
From: Jan Nieuwenhuizen <address@hidden>
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.
---
 gnu/local.mk           |   1 +
 gnu/services/admin.scm | 106 +++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 107 insertions(+)
 create mode 100644 gnu/services/admin.scm

diff --git a/gnu/local.mk b/gnu/local.mk
index cd29ae0..3fed7fc 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..097e8a6
--- /dev/null
+++ b/gnu/services/admin.scm
@@ -0,0 +1,106 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2016 Jan Nieuwenhuizen <address@hidden>
+;;;
+;;; 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 the 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 shepherd)
+  #:use-module (guix gexp)
+  #:use-module (guix records)
+  #:export (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
+;;; 
+;;;   (define rottlog-job
+;;;     #~(job '(next-hour '(5))
+;;;            (lambda ()
+;;;              (system (string-append  #$rottlog "/sbin/rottlog")))))
+;;;
+;;;  Add to operating-system services
+;;;
+;;;     (mcron-service (list rottlog-job))
+;;;     (rottlog-service)
+;;;
+;;; Code:
+
+(define-record-type* <rottlog-configuration>
+  rottlog-configuration make-rottlog-configuration
+  rottlog-configuration?
+  (period rottlog-period)
+  (initialize? rottlog-initialize?))
+
+(define (rottlog-initialization period)
+  "Return the gexp to initialize the ROTTLOG service for PERIOD."
+  #~(begin
+      (use-modules (ice-9 rdelim))
+      (let* ((dir "/etc/rottlog")
+             (period-config (format #f "~a/~a" dir '#$period))
+             (rc-config (string-append dir "/rc")))
+
+        (mkdir-p dir)
+
+        ;; TODO: substitutions
+        (unless (file-exists? rc-config)
+          (format #t "creating rottlog config '~a'...~%" rc-config)
+          (let* ((file (open-file rc-config "w"))
+                 (template (string-append #$rottlog "/etc/rc"))
+                 (config (with-input-from-file template read-string)))
+            (display config file)
+            (close file)))
+
+        ;; TODO: list of periods?
+        (if (not (memq '#$period '(hourly daily weekly)))
+            (format (current-error-port) "cowardly refusing to create rottlog 
config for unknown period: '~a'~%" '#$period)
+            (unless (file-exists? period-config)
+              (format #t "creating rottlog config'~a'...~%" period-config)
+              (let* ((file (open-file period-config "w")))
+                (format file "/var/log/messages {
+       sharedscripts
+       postrotate
+               ~a/bin/kill -HUP $(~a/bin/cat /var/run/syslog.pid) 2> /dev/null
+       endscript
+       nocompress
+}
+" #$coreutils #$coreutils)
+                (close file)))))))
+
+(define (rottlog-activation config)
+  "Return the activation gexp for CONFIG."
+  #~(begin
+      #$(if (rottlog-initialize? config)
+            (rottlog-initialization (rottlog-period config))
+            #t)))
+
+(define rottlog-service-type
+  (service-type (name 'rottlog)
+                (extensions
+                 (list (service-extension activation-service-type
+                                          rottlog-activation)))))
+
+(define* (rottlog-service #:key (period 'daily) (initialize? #t))
+  (service rottlog-service-type
+           (rottlog-configuration (period period)
+                                  (initialize? initialize?))))
+;;; admin.scm ends here
-- 
2.9.3

-- 
Jan Nieuwenhuizen <address@hidden> | GNU LilyPond http://lilypond.org
Freelance IT http://JoyofSource.com | Avatar®  http://AvatarAcademy.nl