aboutsummaryrefslogtreecommitdiff
path: root/battering
diff options
context:
space:
mode:
Diffstat (limited to 'battering')
-rw-r--r--battering/services/opensnitch.scm35
1 files changed, 20 insertions, 15 deletions
diff --git a/battering/services/opensnitch.scm b/battering/services/opensnitch.scm
index d5e7e3b..70164ea 100644
--- a/battering/services/opensnitch.scm
+++ b/battering/services/opensnitch.scm
@@ -35,6 +35,7 @@
((list-of integer?) val)))
(define-maybe string)
+(define-maybe gexp)
(define-maybe file-like)
(define-maybe port)
(define-maybe path)
@@ -65,7 +66,7 @@
maybe-file-like
"Command-line of the process")
(process-command
- maybe-file-like
+ maybe-gexp
"Path of the process")
(dest-host
maybe-string
@@ -108,21 +109,25 @@
protocol user hosts-file hosts-regex?)
(define (parse-port port)
- (if (not (eq? %unset-value port))
+ (if (maybe-value-set? port)
(if (integer? port)
(format #f "~a" port)
(format #f "^(~a)$"
(string-join
(map number->string port)
"|")))
- %unset-value))
+ port))
(with-extensions (list guile-json-4)
- (with-imported-modules (source-module-closure '((json builder)))
+ (with-imported-modules (source-module-closure
+ '((json builder)))
#~(begin
(use-modules (json builder)
(srfi srfi-1))
+ ;; Uuuuurgh ugly hack.
+ (define %unset-marker% '%unset-marker%)
+
(define (serialize-single-operand operand)
(let* ((name (car operand))
(data (cdr operand))
@@ -131,7 +136,7 @@
'#$regexp-fields)
"regexp"
"simple")))
- (if (not (eq? data '#$%unset-value))
+ (if (not (eq? data %unset-marker%))
`((operand . ,name)
(data . ,data)
(type . ,type)
@@ -141,18 +146,18 @@
(define serialized-fields
(filter-map
serialize-single-operand
- '(("process.path" . #$process-path)
- ("process.command" . #$process-command)
- ("dest.host" . #$dest-host)
- ("dest.ip" . #$dest-ip)
- ("dest.network" . #$dest-network)
- ("dest.port" . #$(parse-port dest-port))
- ("iface.out" . #$dest-iface)
- ("protocol" . #$protocol)
- ("user.id" . #$user)
+ `(("process.path" . ,#$process-path)
+ ("process.command" . ,#$process-command)
+ ("dest.host" . ,#$dest-host)
+ ("dest.ip" . ,#$dest-ip)
+ ("dest.network" . ,#$dest-network)
+ ("dest.port" . ,#$(parse-port dest-port))
+ ("iface.out" . ,#$dest-iface)
+ ("protocol" . ,#$protocol)
+ ("user.id" . ,#$user)
(#$(if hosts-regex?
"lists.domain_regexp"
- "lists.domain") . #$hosts-file))))
+ "lists.domain") . ,#$hosts-file))))
(begin
(scm->json