Add working log rotation using new Shepherd 1.0 log-rotation service.

M  whispers/services/whispers.scm
   Add boolean flag log-rotation to whispers-configuration record
   Add log-rotation-service to lieutenant list type when flag is toggled
   Move whispers-service-type? procedure at earlier position in source
   Remove uncalled leftover whispers-log-rotation procedure
   Remove uncalled leftover whispers-tree-log-files procedure

1 files changed, 13 insertions, 38 deletions

diff --git a/whispers/services/whispers.scm b/whispers/services/whispers.scm
index d5405e5..e61d647 100644
--- a/whispers/services/whispers.scm
+++ b/whispers/services/whispers.scm
@@ -58,6 +58,9 @@
   ;; A list of guix service objects
   (lieutenants                      whispers-configuration-lieutenants
                                     (default '()))
+  ;; A boolean value
+  (log-rotation?                    whispers-configuration-log-rotation?
+                                    (default #t))
   ;; A list of symbols
   (requires                         whispers-configuration-requires
                                     (default '()))
@@ -142,6 +145,11 @@ string PARENT-PATH."
                                  parent-group) config)
         ((service-extension-compute extension) config))))
 
+(define (whispers-service-type? service)
+  "Returns a predicate which is true if SERVICE, a service object, is a
+service of type whispers-service-type"
+  (equal? (service-kind service) whispers-service-type))
+
 (define (shepherd-services-lieutenate parent-path parent-user parent-group)
   "Message-passing along the strings PARENT-USER and PARENT-GROUP,
 returns a one argument procedure taking a record of the
@@ -167,7 +175,11 @@ of a whispers tree or sub-tree, as defined by the string PARENT-PATH."
                 (map (shepherd-services-lieutenate parent-path
                                                    parent-user
                                                    parent-group)
-                     (whispers-configuration-lieutenants config)))))
+                     (append (whispers-configuration-lieutenants config)
+                             (if (whispers-configuration-log-rotation?
+                                  config)
+                                 (list (service log-rotation-service-type))
+                                 (list)))))))
 
 (define (shepherd-configuration-file parent-path
                                      parent-user
@@ -651,43 +663,6 @@ action.")
                   ret))
         (auto-start? (whispers-configuration-auto-start? config)))))))
 
-(define (whispers-service-type? service)
-  "Returns a predicate which is true if SERVICE, a service object, is a
-service of type whispers-service-type"
-  (equal? (service-kind service) whispers-service-type))
-
-(define (whispers-tree-log-files parent-path)
-  "Returns a one argument procedure taking a record of the
-<whispers-configuration> type as its argement and returning the list of
-log files from the whispers-service-type services located under the
-string PARENT-PATH in the whispers service top-level tree or sub-tree
-configured by the aforementioned configuration record."
-  (lambda (config)
-    (let* ((name-sym (whispers-configuration-name config))
-           (name-str (symbol->string name-sym))
-           (lieutenants (whispers-configuration-lieutenants config)))
-      (append `(,(string-append "/var/log"
-                                parent-path
-                                "/"
-                                name-str
-                                ".log"))
-              (apply append
-                     (map (whispers-tree-log-files (string-append parent-path
-                                                                  "/"
-                                                                  name-str))
-                          (map service-value
-                               (filter whispers-service-type?
-                                       lieutenants))))))))
-
-(define (whispers-log-rotation config)
-  "Returns a record of the <log-rotation> type specifying the log
-rotations of the whispers-service-type type services contained inside
-the whispers tree of a top-level service of the whisper-service-type
-type, configurable by CONFIG, a record of the <whispers-configuration>
-type."
-  (list (log-rotation (frequency 'daily)
-                      (files ((whispers-tree-log-files "") config)))))
-
 (define (whispers-user-accounts config)
   "Returns a list of group and user records needed to support a whispers
 service tree, configuration by CONFIG, a record of the