diff options
Diffstat (limited to 'battering/services/opensnitch.scm')
| -rw-r--r-- | battering/services/opensnitch.scm | 231 |
1 files changed, 206 insertions, 25 deletions
diff --git a/battering/services/opensnitch.scm b/battering/services/opensnitch.scm index 2e31d0e..d5e7e3b 100644 --- a/battering/services/opensnitch.scm +++ b/battering/services/opensnitch.scm @@ -10,9 +10,172 @@ #:use-module (srfi srfi-171) #:export (opensnitch-configuration - serialize-json-configuration + opensnitch-rule opensnitch-service-type)) +;; Turns lisp-case into dot.case +(define (dot-field-name field-name) + (string-join + (string-tokenize (format #f "~a" field-name) + char-set:letter) + ".")) + +(define methods-list '(ftrace audit ebpf proc)) +(define actions-list '(allow deny reject)) +(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 (port? val) + (or (integer? val) + ((list-of integer?) val))) + +(define-maybe string) +(define-maybe file-like) +(define-maybe port) +(define-maybe path) + +(define-configuration/no-serialization opensnitch-rule + (name + (string) + "Name of the rule") + (description + (string "") + "Description of the rule") + (action + (action 'allow) + "Action to execute on the rule.") + (nolog? + (boolean #f) + "Should connections with this rule be ignored from logging?") + (precedence? + (boolean #f) + "Should this rule have priority over others?") + (regexp-fields + (list '("dest.port")) + "Opensnich fields with regular expressions.") + (sensitive? + (boolean #f) + "Are fields case-sensitive") + (process-path + maybe-file-like + "Command-line of the process") + (process-command + maybe-file-like + "Path of the process") + (dest-host + maybe-string + "Destination host") + (dest-ip + maybe-string + "Destination ip") + (dest-network + maybe-string + "Destination network") + (dest-port + maybe-port + "Destination port") + (dest-iface + maybe-string + "Outside interface") + (protocol + maybe-string + "Protocol") + (user + maybe-string + "User ID") + (hosts-file + maybe-string + "List of domains") + (hosts-regex? + maybe-string + "List of domains is a list of regexes?")) + +(define (serialize-opensnitch-rule rule) + (match-record rule + <opensnitch-rule> + (name + description + action + nolog? precedence? sensitive? + regexp-fields + process-path process-command + dest-host dest-ip dest-network dest-port dest-iface + protocol user hosts-file hosts-regex?) + + (define (parse-port port) + (if (not (eq? %unset-value port)) + (if (integer? port) + (format #f "~a" port) + (format #f "^(~a)$" + (string-join + (map number->string port) + "|"))) + %unset-value)) + + (with-extensions (list guile-json-4) + (with-imported-modules (source-module-closure '((json builder))) + #~(begin + (use-modules (json builder) + (srfi srfi-1)) + + (define (serialize-single-operand operand) + (let* ((name (car operand)) + (data (cdr operand)) + (type (if (find + (lambda (s) (string= name s)) + '#$regexp-fields) + "regexp" + "simple"))) + (if (not (eq? data '#$%unset-value)) + `((operand . ,name) + (data . ,data) + (type . ,type) + (sensitive . #$sensitive?)) + #f))) + + (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) + (#$(if hosts-regex? + "lists.domain_regexp" + "lists.domain") . #$hosts-file)))) + + (begin + (scm->json + `((name . #$name) + (description . #$description) + (action . #$action) + ;; These rules will be read-only in the store and always present at + ;; boot, so "on restart" would be functionally the same as "always", and + ;; "once" would be nonsensical. Plus, Opensnich wouldn't be able to + ;; delete them. + (duration . "always") + (precedence . #$precedence?) + (enabled . #t) + (nolog . #$nolog?) + (operator + ,@(if (= (length serialized-fields) 1) + (car serialized-fields) + `((sensitive . #$sensitive?) + (list . #(,@serialized-fields)) + (operand . "list") + (data . "") + (type . "list")))))))))))) + ;; Turns lisp-case into PascalCase (define (pascal-field-name field-name) (apply @@ -41,16 +204,6 @@ ("LogFile" . "/dev/stdout")) serialized))) -(define methods-list '(ftrace audit ebpf proc)) -(define actions-list '(allow deny reject)) -(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) @@ -58,7 +211,7 @@ field-name (string-join (string-split (format #f "~a" val) #\-)))) -(define (serialize-json-configuration config fields) +(define (serialize-opensnitch-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) @@ -69,10 +222,17 @@ corresponding to the FIELDS of CONFIG." '#$(list-transduce (base-transducer config) rcons fields) #:pretty #t))))) +(define list-of-opensnitch-rules? + (list-of opensnitch-rule?)) + (define-configuration opensnitch-configuration (opensnitchd (file-like opensnitchd) "Opensnitchd package to use.") + (rules + (list-of-opensnitch-rules '()) + "List of rules to add in /etc/opensnitchd/rules." + (serializer empty-serializer)) (address (string "unix:///tmp/osui.sock") "Opensnitch UI socket path.") @@ -99,21 +259,42 @@ corresponding to the FIELDS of CONFIG." "Duration of the rules created automatically.") (intercept-unknown? (boolean #f) - "Intercept unknown network connections?") - (rules - (list '()) - "List of rules to add in /etc/opensnitchd/rules.")) + "Intercept unknown network connections?")) (define (opensnitch-activation config) "Create the opensnitch rules and configuration according to CONFIG." - (match-record config <opensnitch-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/system-fw.json") - "/etc/opensnitchd/system-fw.json")))))) + (match-record config <opensnitch-configuration> (opensnitchd rules) + (with-extensions (list guile-json-4) + (with-imported-modules '((guix build utils)) + #~(begin + (use-modules (guix build utils) + (ice-9 ftw)) + (when (not (file-exists? "/etc/opensnitchd")) + (mkdir-p "/etc/opensnitchd/rules/") + (copy-file #$(file-append opensnitchd "/etc/system-fw.json") + "/etc/opensnitchd/system-fw.json")) + + ;; Not the most elegant of solutions. I'd be happy to find + ;; something more Guix-y, or even Guix-ish. + (nftw "/etc/opensnitchd/rules" + (lambda (filename s flag b l) + (when (eq? flag 'symlink) + (delete-file filename)) + #t) + 'physical) + + #$@(map + (lambda (rule) + (let ((rule-name + (string-append (opensnitch-rule-name rule) ".json"))) + #~(symlink + #$(computed-file + rule-name + #~(with-output-to-file #$output + (lambda _ + #$(serialize-opensnitch-rule rule)))) + #$(string-append "/etc/opensnitchd/rules/" rule-name)))) + rules)))))) (define (opensnitch-shepherd-service config) "Return a <shepherd-service> for opensnitch with CONFIG." @@ -122,7 +303,7 @@ corresponding to the FIELDS of CONFIG." "opensnitchd-config.json" #~(with-output-to-file #$output (lambda _ - #$(serialize-json-configuration + #$(serialize-opensnitch-configuration config opensnitch-configuration-fields)))))) (list (shepherd-service |