battering: services: Serialize opensntich config into a json filer

* battering/services/opensnitch.scm
(opensnitchd-configuration): Add serializing logic.
(opensnitchd-service-type): Use the serialized  json config.

1 files changed, 96 insertions, 19 deletions

diff --git a/battering/services/opensnitch.scm b/battering/services/opensnitch.scm
index 5e04bcd..435e9f7 100644
--- a/battering/services/opensnitch.scm
+++ b/battering/services/opensnitch.scm
@@ -1,58 +1,135 @@
 (define-module (battering services opensnitch)
   #:use-module (guix gexp)
   #:use-module (guix records)
+  #:use-module (guix modules)
   #:use-module (gnu services)
   #:use-module (gnu services shepherd)
   #:use-module (gnu services configuration)
+  #:use-module (gnu packages guile)
   #:use-module (battering packages opensnitch)
+  #:use-module (srfi srfi-171)
 
   #:export (opensnitchd-configuration
+            serialize-json-configuration
             opensnitchd-service-type))
 
-(define list-of-file-likes?
-  (list-of file-like?))
+;; Turns lisp-case into PascalCase
+(define (pascal-field-name field-name)
+  (apply
+   string-append
+   (map string-capitalize (string-tokenize
+                           (format #f "~a" field-name)
+                           char-set:letter))))
 
-(define-configuration/no-serialization opensnitchd-configuration
+(define (serialize-field field-name val)
+  `(,(pascal-field-name field-name) . ,val))
+
+(define serialize-boolean serialize-field)
+
+(define (serialize-integer field-name val)
+  (let ((serialized (serialize-field field-name val)))
+    (if (eq? field-name 'workers)
+        `("Stats" ,serialized)
+        serialized)))
+
+(define (serialize-string field-name val)
+  (let ((serialized (serialize-field field-name val)))
+    (if (eq? field-name 'address)
+        `("Server" ,serialized
+          ;; LogFile should always be stdout because logging will be managed
+          ;; by Shepherd
+          ("LogFile" . "/dev/stdout"))
+        serialized)))
+
+(define methods-list '(ftrace audit ebpf proc))
+(define actions-list '(allow deny))
+(define durations-list '(once until-restart forever))
+(define (method? val)
+  (memq val methods-list))
+(define (action? val)
+  (memq val actions-list))
+(define (duration? val)
+  (memq val durations-list))
+
+(define serialize-method serialize-field)
+(define serialize-action serialize-field)
+(define (serialize-duration field-name val)
+  (serialize-field
+   field-name
+   (string-join (string-split (format #f "~a" val) #\-))))
+
+(define (serialize-json-configuration config fields)
+  "Return a G-expression that contains a json representation the values
+corresponding to the FIELDS of CONFIG."
+  (with-extensions (list guile-json-4)
+    (with-imported-modules (source-module-closure '((json builder)))
+      #~(begin
+          (use-modules (json builder))
+          (scm->json
+           '#$(list-transduce (base-transducer config) rcons fields)
+           #:pretty #t)))))
+
+(define-configuration opensnitchd-configuration
   (opensnitchd
    (file-like opensnitchd)
    "Opensnitchd package to use.")
-  (config-file
-   (string "/etc/opensnitchd/default-config.json")
-   "Daemon configuration file.")
+  (address
+   (string "unix:///tmp/osui.sock")
+   "Opensnitch UI socket path.")
+  (workers
+   (integer 6)
+   "Number of workers started by the daemon.")
+  (log-utc?
+   (boolean #t)
+   "Use UTC timestamps in event logging?")
+  (log-micro?
+   (boolean #f)
+   "Include microseconds in event timestamps?")
+  (log-level
+   (integer 2)
+   "Daemon log level.")
   (process-monitor-method
-   (symbol 'proc)
-   "Process monitor method to use."))
+   (method 'proc)
+   "Process monitor method to use.")
+  (default-action
+    (action 'allow)
+    "Default action to take when the UI isn't connected.")
+  (default-duration
+    (duration 'once)
+    "Duration of the rules created automatically.")
+  (intercept-unknown?
+   (boolean #f)
+   "Intercept unknown network connections?"))
 
 (define (opensnitchd-activation config)
   "Create the opensnitchd rules and configuration according to CONFIG."
-  (match-record config <opensnitchd-configuration>
-                (opensnitchd config-file)
+  (match-record config <opensnitchd-configuration> (opensnitchd)
     (with-imported-modules '((guix build utils))
       #~(begin
           (use-modules (guix build utils))
           (when (not (file-exists? "/etc/opensnitchd"))
             (mkdir-p "/etc/opensnitchd/rules/")
-            (copy-file #$(file-append opensnitchd "/etc/default-config.json")
-                       #$config-file)
             (copy-file #$(file-append opensnitchd "/etc/system-fw.json")
                        "/etc/opensnitchd/system-fw.json"))))))
 
 (define (opensnitchd-shepherd-service config)
   "Return a <shepherd-service> for opensnitchd with CONFIG."
-  (let ((config-file (opensnitchd-configuration-config-file config))
-        (process-monitor-method
-         (symbol->string
-          (opensnitchd-configuration-process-monitor-method config))))
+  (let ((default-config
+          (computed-file
+           "opensnitchd-config.json"
+           #~(with-output-to-file #$output
+               (lambda _
+                 #$(serialize-json-configuration
+                    config
+                    opensnitchd-configuration-fields))))))
     (list (shepherd-service
            (documentation "Opensnitchd daemon.")
            (requirement '(syslogd loopback))
            (provision '(opensnitchd))
-
            (start
             #~(make-forkexec-constructor
                (list #$(file-append opensnitchd "/bin/opensnitchd")
-                     "-process-monitor-method" #$process-monitor-method
-                     "-config-file" #$config-file)))
+                     "-config-file" #$default-config)))
            (stop #~(make-kill-destructor))))))
 
 (define opensnitchd-service-type