2 files changed, 117 insertions(+), 49 deletions(-)

M doc/guix.texi
M gnu/services/admin.scm

@@ 9543,7 9543,7 @@ services admin)} module provides an interface to GNU@tie{}Rot[t]log, a
 log rotation tool (@pxref{Top,,, rottlog, GNU Rot[t]log Manual}).
 
 The example below defines an operating system that provides log rotation
-with the default settings.
+with the default settings, for commonly encountered log files.
 
 @lisp
 (use-modules (guix) (gnu))


@@ 9576,33 9576,53 @@ The Rottlog package to use.
 The Rottlog configuration file to use (@pxref{Mandatory RC Variables,,,
 rottlog, GNU Rot[t]log Manual}).
 
-@item @code{periodic-rotations} (default: @code{`(("weekly" %default-rotations))})
-A list of Rottlog period-name/period-config tuples.
+@item @code{rotations} (default: @code{%default-rotations})
+A list of @code{log-rotation} objects as defined below.
 
-For example, taking an example from the Rottlog manual (@pxref{Period
-Related File Examples,,, rottlog, GNU Rot[t]log Manual}), a valid tuple
-might be:
+@item @code{jobs}
+This is a list of gexps where each gexp corresponds to an mcron job
+specification (@pxref{Scheduled Job Execution}).
+@end table
+@end deftp
+
+@deftp {Data Type} log-rotation
+Data type representing the rotation of a group of log files.
+
+Taking an example from the Rottlog manual (@pxref{Period Related File
+Examples,,, rottlog, GNU Rot[t]log Manual}), a log rotation might be
+defined like this:
 
 @example
-("daily" ,(plain-file "daily"
-                      "\
-     /var/log/apache/* @{
-        storedir apache-archives
-        rotate 6
-        notifempty
-        nocompress
-     @}"))
+(log-rotation
+  (frequency 'daily)
+  (files '("/var/log/apache/*"))
+  (options '("storedir apache-archives"
+             "rotate 6"
+             "notifempty"
+             "nocompress")))
 @end example
 
-@item @code{jobs}
-This is a list of gexps where each gexp corresponds to an mcron job
-specification (@pxref{Scheduled Job Execution}).
+The list of fields is as follows:
+
+@table @asis
+@item @code{frequency} (default: @code{'weekly})
+The log rotation frequency, a symbol.
+
+@item @code{files}
+The list of files or file glob patterns to rotate.
+
+@item @code{options} (default: @code{'()})
+The list of rottlog options for this rotation (@pxref{Configuration
+parameters,,, rottlog, GNU Rot[t]lg Manual}).
+
+@item @code{post-rotate} (default: @code{#f})
+Either @code{#f} or a gexp to execute once the rotation has completed.
 @end table
 @end deftp
 
 @defvr {Scheme Variable} %default-rotations
 Specifies weekly rotation of @var{%rotated-files} and
-@code{"/var/log/shepherd.log"}.
+a couple of other files.
 @end defvr
 
 @defvr {Scheme Variable} %rotated-files

@@ 27,8 27,17 @@
   #:use-module (guix packages)
   #:use-module (guix records)
   #:use-module (srfi srfi-1)
+  #:use-module (ice-9 vlist)
   #:export (%default-rotations
             %rotated-files
+
+            log-rotation
+            log-rotation?
+            log-rotation-frequency
+            log-rotation-files
+            log-rotation-options
+            log-rotation-post-rotate
+
             rottlog-configuration
             rottlog-configuration?
             rottlog-service


@@ 40,41 49,78 @@
 ;;; /etc/rottlog/{rc,hourly|daily|weekly}.  Example usage
 ;;;
 ;;;     (mcron-service)
-;;;     (service rottlog-service-type (rottlog-configuration))
+;;;     (service rottlog-service-type)
 ;;;
 ;;; Code:
 
+(define-record-type* <log-rotation> log-rotation make-log-rotation
+  log-rotation?
+  (files       log-rotation-files)                ;list of strings
+  (frequency   log-rotation-frequency             ;symbol
+               (default 'weekly))
+  (post-rotate log-rotation-post-rotate           ;#f | gexp
+               (default #f))
+  (options     log-rotation-options               ;list of strings
+               (default '())))
+
 (define %rotated-files
   ;; Syslog files subject to rotation.
   '("/var/log/messages" "/var/log/secure" "/var/log/maillog"))
 
-(define (syslog-rotation-config files)
-  #~(string-append #$(string-join files ",")
-                 " {
-        sharedscripts
-        postrotate
-        " #$coreutils "/bin/kill -HUP $(cat /var/run/syslog.pid) 2> /dev/null
-        endscript
-}
-"))
-
-(define (simple-rotation-config files)
-  #~(string-append #$(string-join files ",") " {
-        sharedscripts
-}
-"))
-
 (define %default-rotations
-  `(("weekly"
-     ,(computed-file "rottlog.weekly"
-                     #~(call-with-output-file #$output
-                         (lambda (port)
-                           (display #$(syslog-rotation-config %rotated-files)
-                                    port)
-                           (display #$(simple-rotation-config
-                                       '("/var/log/shepherd.log"
-                                         "/var/log/guix-daemon.log"))
-                                    port)))))))
+  (list (log-rotation                             ;syslog files
+         (files %rotated-files)
+
+         ;; Restart syslogd after rotation.
+         (options '("sharedscripts"))
+         (post-rotate #~(let ((pid (call-with-input-file "/var/run/syslog.pid"
+                                     read)))
+                          (kill pid SIGHUP))))
+        (log-rotation
+         (files '("/var/log/shepherd.log" "/var/log/guix-daemon.log")))))
+
+(define (log-rotation->config rotation)
+  "Return a string-valued gexp representing the rottlog configuration snippet
+for ROTATION."
+  (define post-rotate
+    (let ((post (log-rotation-post-rotate rotation)))
+      (and post
+           (program-file "rottlog-post-rotate.scm" post))))
+
+  #~(let ((post #$post-rotate))
+      (string-append (string-join '#$(log-rotation-files rotation) ",")
+                     " {"
+                     #$(string-join (log-rotation-options rotation)
+                                    "\n  " 'prefix)
+                     (if post
+                         (string-append "\n  postrotate\n    " post
+                                        "\n  endscript\n")
+                         "")
+                     "\n}\n")))
+
+(define (log-rotations->/etc-entries rotations)
+  "Return the list of /etc entries for ROTATIONS, a list of <log-rotation>."
+  (define (frequency-file frequency rotations)
+    (computed-file (string-append "rottlog." (symbol->string frequency))
+                   #~(call-with-output-file #$output
+                       (lambda (port)
+                         (for-each (lambda (str)
+                                     (display str port))
+                                   (list #$@(map log-rotation->config
+                                                 rotations)))))))
+
+  (let* ((frequencies (delete-duplicates
+                       (map log-rotation-frequency rotations)))
+         (table       (fold (lambda (rotation table)
+                              (vhash-consq (log-rotation-frequency rotation)
+                                           rotation table))
+                            vlist-null
+                            rotations)))
+    (map (lambda (frequency)
+           `(,(symbol->string frequency)
+             ,(frequency-file frequency
+                              (vhash-foldq* cons '() frequency table))))
+         frequencies)))
 
 (define (default-jobs rottlog)
   (list #~(job '(next-hour '(0))                  ;midnight


@@ 91,15 137,17 @@
                       (default rottlog))
   (rc-file            rottlog-rc-file             ;file-like
                       (default (file-append rottlog "/etc/rc")))
-  (periodic-rotations rottlog-periodic-rotations  ;list of (name file) tuples
+  (rotations          rottlog-rotations           ;list of <log-rotation>
                       (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))))))
+  `(("rottlog"
+     ,(file-union "rottlog"
+                  (cons `("rc" ,(rottlog-rc-file config))
+                        (log-rotations->/etc-entries
+                         (rottlog-rotations config)))))))
 
 (define (rottlog-jobs-or-default config)
   (or (rottlog-jobs config)