From 3c2d2b453832167df02f4aa25de4857a003fbecf Mon Sep 17 00:00:00 2001 From: muradm Date: Tue, 23 Aug 2022 23:13:55 +0300 Subject: [PATCH] gnu: security: Add fail2ban-service-type. * gnu/services/security.scm: New module. * gnu/tests/security.scm: New module. * gnu/local.mk: Add new security module and tests. * doc/guix.text: Add fail2ban-service-type documentation. Signed-off-by: Maxim Cournoyer --- doc/guix.texi | 249 +++++++++++++++++++++++ gnu/local.mk | 3 + gnu/services/security.scm | 415 ++++++++++++++++++++++++++++++++++++++ gnu/tests/security.scm | 221 ++++++++++++++++++++ 4 files changed, 888 insertions(+) create mode 100644 gnu/services/security.scm create mode 100644 gnu/tests/security.scm diff --git a/doc/guix.texi b/doc/guix.texi index 7bce8a567c..4f6973518f 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -36311,6 +36311,255 @@ Extra command line options for @code{nix-service-type}. @end table @end deftp +@cindex Fail2Ban +@subsubheading Fail2Ban service + +@uref{http://www.fail2ban.org/, @code{fail2ban}} scans log files +(e.g. @code{/var/log/apache/error_log}) and bans IP addresses that show +malicious signs -- repeated password failures, attempts to make use of +exploits, etc. + +@code{fail2ban-service-type} service type is provided by the @code{(gnu +services security)} module. + +This service type runs the @code{fail2ban} daemon. It can be configured +in various ways, which are: + +@table @asis +@item Basic configuration +The basic parameters of the Fail2Ban service can be configured via its +@code{fail2ban} configuration, which is documented below. + +@item User-specified jail extensions +The @code{fail2ban-jail-service} function can be used to add new +Fail2Ban jails. + +@item Shepherd extension mechanism +Service developers can extend the @code{fail2ban-service-type} service +type itself via the usual service extension mechanism. +@end table + +@defvr {Scheme Variable} fail2ban-service-type + +This is the type of the service that runs @code{fail2ban} daemon. Below +is an example of a basic, explicit configuration: + +@lisp +(append + (list + (service fail2ban-service-type + (fail2ban-configuration + (extra-jails + (list + (fail2ban-jail-configuration + (name "sshd") + (enabled #t)))))) + ;; There is no implicit dependency on an actual SSH + ;; service, so you need to provide one. + (service openssh-service-type)) + %base-services) +@end lisp +@end defvr + +@deffn {Scheme Procedure} fail2ban-jail-service @var{svc-type} @var{jail} +Extend @var{svc-type}, a @code{} object with @var{jail}, a +@code{fail2ban-jail-configuration} object. + +For example: + +@lisp +(append + (list + (service + ;; The 'fail2ban-jail-service' procedure can extend any service type + ;; with a fail2ban jail. This removes the requirement to explicitly + ;; extend services with fail2ban-service-type. + (fail2ban-jail-service + openssh-service-type + (fail2ban-jail-configuration + (name "sshd") + (enabled #t))) + (openssh-configuration ...)))) +@end lisp +@end deffn + +Below is the reference for the different @code{jail-service-type} +configuration records. + +@c The documentation is to be auto-generated via +@c 'generate-documentation'. See at the bottom of (gnu services +@c security). + +@deftp {Data Type} fail2ban-configuration +Available @code{fail2ban-configuration} fields are: + +@table @asis +@item @code{fail2ban} (default: @code{fail2ban}) (type: package) +The @code{fail2ban} package to use. It is used for both binaries and as +base default configuration that is to be extended with +@code{} objects. + +@item @code{run-directory} (default: @code{"/var/run/fail2ban"}) (type: string) +The state directory for the @code{fail2ban} daemon. + +@item @code{jails} (default: @code{()}) (type: list-of-fail2ban-jail-configurations) +Instances of @code{} collected from +extensions. + +@item @code{extra-jails} (default: @code{()}) (type: list-of-fail2ban-jail-configurations) +Instances of @code{} explicitly provided. + +@item @code{extra-content} (type: maybe-string) +Extra raw content to add to the end of the @file{jail.local} file. + +@end table + +@end deftp + +@deftp {Data Type} fail2ban-ignore-cache-configuration +Available @code{fail2ban-ignore-cache-configuration} fields are: + +@table @asis +@item @code{key} (type: string) +Cache key. + +@item @code{max-count} (type: integer) +Cache size. + +@item @code{max-time} (type: integer) +Cache time. + +@end table + +@end deftp + +@deftp {Data Type} fail2ban-jail-action-configuration +Available @code{fail2ban-jail-action-configuration} fields are: + +@table @asis +@item @code{name} (type: string) +Action name. + +@item @code{arguments} (default: @code{()}) (type: list-of-arguments) +Action arguments. + +@end table + +@end deftp + +@deftp {Data Type} fail2ban-jail-configuration +Available @code{fail2ban-jail-configuration} fields are: + +@table @asis +@item @code{name} (type: string) +Required name of this jail configuration. + +@item @code{enabled?} (default: @code{#t}) (type: boolean) +Whether this jail is enabled. + +@item @code{backend} (type: maybe-symbol) +Backend to use to detect changes in the @code{ogpath}. The default is +'auto. To consult the defaults of the jail configuration, refer to the +@file{/etc/fail2ban/jail.conf} file of the @code{fail2ban} package. + +@item @code{max-retry} (type: maybe-integer) +The number of failures before a host get banned (e.g. @code{(max-retry +5)}). + +@item @code{max-matches} (type: maybe-integer) +The number of matches stored in ticket (resolvable via tag +@code{}) in action. + +@item @code{find-time} (type: maybe-string) +The time window during which the maximum retry count must be reached for +an IP address to be banned. A host is banned if it has generated +@code{max-retry} during the last @code{find-time} seconds (e.g. +@code{(find-time "10m")}). It can be provided in seconds or using +Fail2Ban's "time abbreviation format", as described in @command{man 5 +jail.conf}. + +@item @code{ban-time} (type: maybe-string) +The duration, in seconds or time abbreviated format, that a ban should +last. (e.g. @code{(ban-time "10m")}). + +@item @code{ban-time-increment?} (type: maybe-boolean) +Whether to consider past bans to compute increases to the default ban +time of a specific IP address. + +@item @code{ban-time-factor} (type: maybe-string) +The coefficient to use to compute an exponentially growing ban time. + +@item @code{ban-time-formula} (type: maybe-string) +This is the formula used to calculate the next value of a ban time. + +@item @code{ban-time-multipliers} (type: maybe-string) +Used to calculate next value of ban time instead of formula. + +@item @code{ban-time-max-time} (type: maybe-string) +The maximum number of seconds a ban should last. + +@item @code{ban-time-rnd-time} (type: maybe-string) +The maximum number of seconds a randomized ban time should last. This +can be useful to stop ``clever'' botnets calculating the exact time an +IP address can be unbanned again. + +@item @code{ban-time-overall-jails?} (type: maybe-boolean) +When true, it specifies the search of an IP address in the database +should be made across all jails. Otherwise, only the current jail of +the ban IP address is considered. + +@item @code{ignore-self?} (type: maybe-boolean) +Never ban the local machine's own IP address. + +@item @code{ignore-ip} (default: @code{()}) (type: list-of-strings) +A list of IP addresses, CIDR masks or DNS hosts to ignore. +@code{fail2ban} will not ban a host which matches an address in this +list. + +@item @code{ignore-cache} (type: maybe-fail2ban-ignore-cache-configuration) +Provide cache parameters for the ignore failure check. + +@item @code{filter} (type: maybe-fail2ban-jail-filter-configuration) +The filter to use by the jail, specified via a +@code{} object. By default, jails +have names matching their filter name. + +@item @code{log-time-zone} (type: maybe-string) +The default time zone for log lines that do not have one. + +@item @code{log-encoding} (type: maybe-symbol) +The encoding of the log files handled by the jail. Possible values are: +@code{'ascii}, @code{'utf-8} and @code{'auto}. + +@item @code{log-path} (default: @code{()}) (type: list-of-strings) +The file names of the log files to be monitored. + +@item @code{action} (default: @code{()}) (type: list-of-fail2ban-jail-actions) +A list of @code{}. + +@item @code{extra-content} (type: maybe-string) +Extra content for the jail configuration. + +@end table + +@end deftp + +@deftp {Data Type} fail2ban-jail-filter-configuration +Available @code{fail2ban-jail-filter-configuration} fields are: + +@table @asis +@item @code{name} (type: string) +Filter to use. + +@item @code{mode} (type: maybe-string) +Mode for filter. + +@end table + +@end deftp + +@c End of auto-generated fail2ban documentation. + @node Setuid Programs @section Setuid Programs diff --git a/gnu/local.mk b/gnu/local.mk index 027cb8e3cb..fcbbdbd1fb 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -51,6 +51,7 @@ # Copyright © 2022 Remco van 't Veer # Copyright © 2022 Artyom V. Poptsov # Copyright © 2022 John Kehayias +# Copyright © 2022 muradm # # This file is part of GNU Guix. # @@ -672,6 +673,7 @@ GNU_SYSTEM_MODULES = \ %D%/services/nfs.scm \ %D%/services/pam-mount.scm \ %D%/services/science.scm \ + %D%/services/security.scm \ %D%/services/security-token.scm \ %D%/services/shepherd.scm \ %D%/services/sound.scm \ @@ -756,6 +758,7 @@ GNU_SYSTEM_MODULES = \ %D%/tests/package-management.scm \ %D%/tests/reconfigure.scm \ %D%/tests/rsync.scm \ + %D%/tests/security.scm \ %D%/tests/security-token.scm \ %D%/tests/singularity.scm \ %D%/tests/ssh.scm \ diff --git a/gnu/services/security.scm b/gnu/services/security.scm new file mode 100644 index 0000000000..1e0360c07f --- /dev/null +++ b/gnu/services/security.scm @@ -0,0 +1,415 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2022 muradm +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (gnu services security) + #:use-module (gnu packages admin) + #:use-module (gnu services) + #:use-module (gnu services configuration) + #:use-module (gnu services shepherd) + #:use-module (guix gexp) + #:use-module (guix packages) + #:use-module (guix records) + #:use-module (guix ui) + #:use-module (ice-9 format) + #:use-module (ice-9 match) + #:use-module (srfi srfi-1) + #:export (fail2ban-configuration + fail2ban-ignore-cache-configuration + fail2ban-jail-action-configuration + fail2ban-jail-configuration + fail2ban-jail-filter-configuration + fail2ban-jail-service + fail2ban-service-type)) + +(define-configuration/no-serialization fail2ban-ignore-cache-configuration + (key string "Cache key.") + (max-count integer "Cache size.") + (max-time integer "Cache time.")) + +(define serialize-fail2ban-ignore-cache-configuration + (match-lambda + (($ _ key max-count max-time) + (format #f "key=\"~a\", max-count=~d, max-time=~d" + key max-count max-time)))) + +(define-maybe/no-serialization string) + +(define-configuration/no-serialization fail2ban-jail-filter-configuration + (name string "Filter to use.") + (mode maybe-string "Mode for filter.")) + +(define serialize-fail2ban-jail-filter-configuration + (match-lambda + (($ _ name mode) + (format #f "~a~@[[mode=~a]~]" name (maybe-value mode))))) + +(define (argument? a) + (and (pair? a) + (string? (car a)) + (or (string? (cdr a)) + (list-of-strings? (cdr a))))) + +(define list-of-arguments? (list-of argument?)) + +(define-configuration/no-serialization fail2ban-jail-action-configuration + (name string "Action name.") + (arguments (list-of-arguments '()) "Action arguments.")) + +(define list-of-fail2ban-jail-actions? + (list-of fail2ban-jail-action-configuration?)) + +(define (serialize-fail2ban-jail-action-configuration-arguments args) + (let* ((multi-value + (lambda (v) + (format #f "~a" (string-join v ",")))) + (any-value + (lambda (v) + (if (list? v) (string-append "\"" (multi-value v) "\"") v))) + (key-value + (lambda (e) + (format #f "~a=~a" (car e) (any-value (cdr e)))))) + (format #f "~a" (string-join (map key-value args) ",")))) + +(define serialize-fail2ban-jail-action-configuration + (match-lambda + (($ _ name arguments) + (format + #f "~a~a" + name + (if (null? arguments) "" + (format + #f "[~a]" + (serialize-fail2ban-jail-action-configuration-arguments + arguments))))))) + +(define fail2ban-backend->string + (match-lambda + ('auto "auto") + ('pyinotify "pyinotify") + ('gamin "gamin") + ('polling "polling") + ('systemd "systemd") + (unknown + (leave (G_ "fail2ban: '~a' is not a supported backend~%") unknown)))) + +(define fail2ban-log-encoding->string + (match-lambda + ('auto "auto") + ('utf-8 "utf-8") + ('ascii "ascii") + (unknown + (leave (G_ "fail2ban: '~a' is not a supported log encoding~%") unknown)))) + +(define (fail2ban-jail-configuration-serialize-field-name name) + (cond ((symbol? name) + (fail2ban-jail-configuration-serialize-field-name + (symbol->string name))) + ((string-suffix? "?" name) + (fail2ban-jail-configuration-serialize-field-name + (string-drop-right name 1))) + ((string-prefix? "ban-time-" name) + (fail2ban-jail-configuration-serialize-field-name + (string-append "bantime." (substring name 9)))) + ((string-contains name "-") + (fail2ban-jail-configuration-serialize-field-name + (string-filter (lambda (c) (equal? c #\-)) name))) + (else name))) + +(define (fail2ban-jail-configuration-serialize-string field-name value) + #~(string-append + #$(fail2ban-jail-configuration-serialize-field-name field-name) + " = " #$value "\n")) + +(define (fail2ban-jail-configuration-serialize-integer field-name value) + (fail2ban-jail-configuration-serialize-string + field-name (number->string value))) + +(define (fail2ban-jail-configuration-serialize-boolean field-name value) + (fail2ban-jail-configuration-serialize-string + field-name (if value "true" "false"))) + +(define (fail2ban-jail-configuration-serialize-backend field-name value) + (if (maybe-value-set? value) + (fail2ban-jail-configuration-serialize-string + field-name (fail2ban-backend->string value)) + "")) + +(define (fail2ban-jail-configuration-serialize-fail2ban-ignore-cache-configuration field-name value) + (fail2ban-jail-configuration-serialize-string + field-name (serialize-fail2ban-ignore-cache-configuration value))) + +(define (fail2ban-jail-configuration-serialize-fail2ban-jail-filter-configuration field-name value) + (fail2ban-jail-configuration-serialize-string + field-name (serialize-fail2ban-jail-filter-configuration value))) + +(define (fail2ban-jail-configuration-serialize-log-encoding field-name value) + (if (maybe-value-set? value) + (fail2ban-jail-configuration-serialize-string + field-name (fail2ban-log-encoding->string value)) + "")) + +(define (fail2ban-jail-configuration-serialize-list-of-strings field-name value) + (if (null? value) + "" + (fail2ban-jail-configuration-serialize-string + field-name (string-join value " ")))) + +(define (fail2ban-jail-configuration-serialize-list-of-fail2ban-jail-actions field-name value) + (if (null? value) + "" + (fail2ban-jail-configuration-serialize-string + field-name (string-join + (map serialize-fail2ban-jail-action-configuration value) "\n")))) + +(define (fail2ban-jail-configuration-serialize-symbol field-name value) + (fail2ban-jail-configuration-serialize-string field-name (symbol->string value))) + +(define (fail2ban-jail-configuration-serialize-extra-content field-name value) + (if (maybe-value-set? value) + (string-append "\n" value "\n") + "")) + +(define-maybe integer (prefix fail2ban-jail-configuration-)) +(define-maybe string (prefix fail2ban-jail-configuration-)) +(define-maybe boolean (prefix fail2ban-jail-configuration-)) +(define-maybe symbol (prefix fail2ban-jail-configuration-)) +(define-maybe fail2ban-ignore-cache-configuration (prefix fail2ban-jail-configuration-)) +(define-maybe fail2ban-jail-filter-configuration (prefix fail2ban-jail-configuration-)) + +(define-configuration fail2ban-jail-configuration + (name + string + "Required name of this jail configuration.") + (enabled? + (boolean #t) + "Whether this jail is enabled.") + (backend + maybe-symbol + "Backend to use to detect changes in the @code{ogpath}. The default is +'auto. To consult the defaults of the jail configuration, refer to the +@file{/etc/fail2ban/jail.conf} file of the @code{fail2ban} package." +fail2ban-jail-configuration-serialize-backend) + (max-retry + maybe-integer + "The number of failures before a host get banned +(e.g. @code{(max-retry 5)}).") + (max-matches + maybe-integer + "The number of matches stored in ticket (resolvable via +tag @code{}) in action.") + (find-time + maybe-string + "The time window during which the maximum retry count must be reached for +an IP address to be banned. A host is banned if it has generated +@code{max-retry} during the last @code{find-time} +seconds (e.g. @code{(find-time \"10m\")}). It can be provided in seconds or +using Fail2Ban's \"time abbreviation format\", as described in @command{man 5 +jail.conf}.") + (ban-time + maybe-string + "The duration, in seconds or time abbreviated format, that a ban should last. +(e.g. @code{(ban-time \"10m\")}).") + (ban-time-increment? + maybe-boolean + "Whether to consider past bans to compute increases to the default ban time +of a specific IP address.") + (ban-time-factor + maybe-string + "The coefficient to use to compute an exponentially growing ban time.") + (ban-time-formula + maybe-string + "This is the formula used to calculate the next value of a ban time.") + (ban-time-multipliers + maybe-string + "Used to calculate next value of ban time instead of formula.") + (ban-time-max-time + maybe-string + "The maximum number of seconds a ban should last.") + (ban-time-rnd-time + maybe-string + "The maximum number of seconds a randomized ban time should last. This can +be useful to stop ``clever'' botnets calculating the exact time an IP address +can be unbanned again.") + (ban-time-overall-jails? + maybe-boolean + "When true, it specifies the search of an IP address in the database should +be made across all jails. Otherwise, only the current jail of the ban IP +address is considered.") + (ignore-self? + maybe-boolean + "Never ban the local machine's own IP address.") + (ignore-ip + (list-of-strings '()) + "A list of IP addresses, CIDR masks or DNS hosts to ignore. +@code{fail2ban} will not ban a host which matches an address in this list.") + (ignore-cache + maybe-fail2ban-ignore-cache-configuration + "Provide cache parameters for the ignore failure check.") + (filter + maybe-fail2ban-jail-filter-configuration + "The filter to use by the jail, specified via a +@code{} object. By default, jails have +names matching their filter name.") + (log-time-zone + maybe-string + "The default time zone for log lines that do not have one.") + (log-encoding + maybe-symbol + "The encoding of the log files handled by the jail. +Possible values are: @code{'ascii}, @code{'utf-8} and @code{'auto}." +fail2ban-jail-configuration-serialize-log-encoding) + (log-path + (list-of-strings '()) + "The file names of the log files to be monitored.") + (action + (list-of-fail2ban-jail-actions '()) + "A list of @code{}.") + (extra-content + maybe-string + "Extra content for the jail configuration." + fail2ban-jail-configuration-serialize-extra-content) + (prefix fail2ban-jail-configuration-)) + +(define list-of-fail2ban-jail-configurations? + (list-of fail2ban-jail-configuration?)) + +(define (serialize-fail2ban-jail-configuration config) + #~(string-append + #$(format #f "[~a]\n" (fail2ban-jail-configuration-name config)) + #$(serialize-configuration + config fail2ban-jail-configuration-fields))) + +(define-configuration/no-serialization fail2ban-configuration + (fail2ban + (package fail2ban) + "The @code{fail2ban} package to use. It is used for both binaries and as +base default configuration that is to be extended with +@code{} objects.") + (run-directory + (string "/var/run/fail2ban") + "The state directory for the @code{fail2ban} daemon.") + (jails + (list-of-fail2ban-jail-configurations '()) + "Instances of @code{} collected from +extensions.") + (extra-jails + (list-of-fail2ban-jail-configurations '()) + "Instances of @code{} explicitly provided.") + (extra-content + maybe-string + "Extra raw content to add to the end of the @file{jail.local} file.")) + +(define (serialize-fail2ban-configuration config) + (let* ((jails (fail2ban-configuration-jails config)) + (extra-jails (fail2ban-configuration-extra-jails config)) + (extra-content (fail2ban-configuration-extra-content config))) + (interpose + (append (map serialize-fail2ban-jail-configuration + (append jails extra-jails)) + (list (if (maybe-value-set? extra-content) + extra-content + "")))))) + +(define (config->fail2ban-etc-directory config) + (let* ((fail2ban (fail2ban-configuration-fail2ban config)) + (jail-local (apply mixed-text-file "jail.local" + (serialize-fail2ban-configuration config)))) + (directory-union + "fail2ban-configuration" + (list (computed-file + "etc-fail2ban" + (with-imported-modules '((guix build utils)) + #~(begin + (use-modules (guix build utils)) + (let ((etc (string-append #$output "/etc"))) + (mkdir-p etc) + (symlink #$(file-append fail2ban "/etc/fail2ban") + (string-append etc "/fail2ban")))))) + (computed-file + "etc-fail2ban-jail.local" + (with-imported-modules '((guix build utils)) + #~(begin + (use-modules (guix build utils)) + (define etc/fail2ban (string-append #$output + "/etc/fail2ban")) + (mkdir-p etc/fail2ban) + (symlink #$jail-local (string-append etc/fail2ban + "/jail.local"))))))))) + +(define (fail2ban-shepherd-service config) + (match-record config + (fail2ban run-directory) + (let* ((fail2ban-server (file-append fail2ban "/bin/fail2ban-server")) + (pid-file (in-vicinity run-directory "fail2ban.pid")) + (socket-file (in-vicinity run-directory "fail2ban.sock")) + (config-dir (file-append (config->fail2ban-etc-directory config) + "/etc/fail2ban")) + (fail2ban-action (lambda args + #~(lambda _ + (invoke #$fail2ban-server + "-c" #$config-dir + "-p" #$pid-file + "-s" #$socket-file + "-b" + #$@args))))) + + ;; TODO: Add 'reload' action. + (list (shepherd-service + (provision '(fail2ban)) + (documentation "Run the fail2ban daemon.") + (requirement '(user-processes)) + (modules `((ice-9 match) + ,@%default-modules)) + (start (fail2ban-action "start")) + (stop (fail2ban-action "stop"))))))) + +(define fail2ban-service-type + (service-type (name 'fail2ban) + (extensions + (list (service-extension shepherd-root-service-type + fail2ban-shepherd-service))) + (compose concatenate) + (extend (lambda (config jails) + (fail2ban-configuration + (inherit config) + (jails (append (fail2ban-configuration-jails config) + jails))))) + (default-value (fail2ban-configuration)) + (description "Run the fail2ban server."))) + +(define (fail2ban-jail-service svc-type jail) + "Convenience procedure to add a fail2ban service extension to SVC-TYPE, a + object. The fail2ban extension is specified by JAIL, a + object." + (service-type + (inherit svc-type) + (extensions + (append (service-type-extensions svc-type) + (list (service-extension fail2ban-service-type + (lambda _ (list jail)))))))) + + +;;; +;;; Documentation generation. +;;; +(define (generate-doc) + (configuration->documentation 'fail2ban-configuration) + (configuration->documentation 'fail2ban-ignore-cache-configuration) + (configuration->documentation 'fail2ban-jail-action-configuration) + (configuration->documentation 'fail2ban-jail-configuration) + (configuration->documentation 'fail2ban-jail-filter-configuration)) diff --git a/gnu/tests/security.scm b/gnu/tests/security.scm new file mode 100644 index 0000000000..ca6c857899 --- /dev/null +++ b/gnu/tests/security.scm @@ -0,0 +1,221 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2022 muradm +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (gnu tests security) + #:use-module (guix gexp) + #:use-module (gnu packages admin) + #:use-module (gnu services) + #:use-module (gnu services security) + #:use-module (gnu services ssh) + #:use-module (gnu system) + #:use-module (gnu system vm) + #:use-module (gnu tests) + #:export (%test-fail2ban-basic + %test-fail2ban-extension + %test-fail2ban-simple)) + + +;;; +;;; fail2ban tests +;;; + +(define-syntax-rule (fail2ban-test test-name test-os tests-more ...) + (lambda () + (define os + (marionette-operating-system + test-os + #:imported-modules '((gnu services herd)))) + + (define vm + (virtual-machine + (operating-system os) + (port-forwardings '()))) + + (define test + (with-imported-modules '((gnu build marionette) + (guix build utils)) + #~(begin + (use-modules (srfi srfi-64) + (gnu build marionette)) + + (define marionette (make-marionette (list #$vm))) + + (test-runner-current (system-test-runner #$output)) + (test-begin test-name) + + (test-assert "fail2ban running" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (start-service 'fail2ban)) + marionette)) + + (test-assert "fail2ban socket ready" + (wait-for-unix-socket + "/var/run/fail2ban/fail2ban.sock" marionette)) + + (test-assert "fail2ban running after restart" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (restart-service 'fail2ban)) + marionette)) + + (test-assert "fail2ban socket ready after restart" + (wait-for-unix-socket + "/var/run/fail2ban/fail2ban.sock" marionette)) + + (test-assert "fail2ban pid ready" + (marionette-eval + '(file-exists? "/var/run/fail2ban/fail2ban.pid") + marionette)) + + (test-assert "fail2ban log file" + (marionette-eval + '(file-exists? "/var/log/fail2ban.log") + marionette)) + + tests-more ... + + (test-end)))) + + (gexp->derivation test-name test))) + +(define run-fail2ban-basic-test + (fail2ban-test + "fail2ban-basic-test" + + (simple-operating-system + (service fail2ban-service-type)))) + +(define %test-fail2ban-basic + (system-test + (name "fail2ban-basic") + (description "Test basic fail2ban running capability.") + (value (run-fail2ban-basic-test)))) + +(define %fail2ban-server-cmd + (program-file + "fail2ban-server-cmd" + #~(begin + (let ((cmd #$(file-append fail2ban "/bin/fail2ban-server"))) + (apply execl cmd cmd `("-p" "/var/run/fail2ban/fail2ban.pid" + "-s" "/var/run/fail2ban/fail2ban.sock" + ,@(cdr (program-arguments)))))))) + +(define run-fail2ban-simple-test + (fail2ban-test + "fail2ban-basic-test" + + (simple-operating-system + (service fail2ban-service-type (fail2ban-configuration + (jails (list (fail2ban-jail-configuration + (name "sshd"))))))) + + (test-equal "fail2ban sshd jail running status output" + '("Status for the jail: sshd" + "|- Filter" + "| |- Currently failed:\t0" + "| |- Total failed:\t0" + "| `- File list:\t/var/log/secure" + "`- Actions" + " |- Currently banned:\t0" + " |- Total banned:\t0" + " `- Banned IP list:\t" + "") + (marionette-eval + '(begin + (use-modules (ice-9 rdelim) (ice-9 popen) (rnrs io ports)) + (let ((call-command + (lambda (cmd) + (let* ((err-cons (pipe)) + (port (with-error-to-port (cdr err-cons) + (lambda () (open-input-pipe cmd)))) + (_ (setvbuf (car err-cons) 'block + (* 1024 1024 16))) + (result (read-delimited "" port))) + (close-port (cdr err-cons)) + (values result (read-delimited "" (car err-cons))))))) + (string-split + (call-command + (string-join (list #$%fail2ban-server-cmd "status" "sshd") " ")) + #\newline))) + marionette)) + + (test-equal "fail2ban sshd jail running exit code" + 0 + (marionette-eval + '(status:exit-val (system* #$%fail2ban-server-cmd "status" "sshd")) + marionette)))) + +(define %test-fail2ban-simple + (system-test + (name "fail2ban-simple") + (description "Test simple fail2ban running capability.") + (value (run-fail2ban-simple-test)))) + +(define run-fail2ban-extension-test + (fail2ban-test + "fail2ban-extension-test" + + (simple-operating-system + (service (fail2ban-jail-service openssh-service-type (fail2ban-jail-configuration + (name "sshd") (enabled? #t))) + (openssh-configuration))) + + (test-equal "fail2ban sshd jail running status output" + '("Status for the jail: sshd" + "|- Filter" + "| |- Currently failed:\t0" + "| |- Total failed:\t0" + "| `- File list:\t/var/log/secure" + "`- Actions" + " |- Currently banned:\t0" + " |- Total banned:\t0" + " `- Banned IP list:\t" + "") + (marionette-eval + '(begin + (use-modules (ice-9 rdelim) (ice-9 popen) (rnrs io ports)) + (let ((call-command + (lambda (cmd) + (let* ((err-cons (pipe)) + (port (with-error-to-port (cdr err-cons) + (lambda () (open-input-pipe cmd)))) + (_ (setvbuf (car err-cons) 'block + (* 1024 1024 16))) + (result (read-delimited "" port))) + (close-port (cdr err-cons)) + (values result (read-delimited "" (car err-cons))))))) + (string-split + (call-command + (string-join (list #$%fail2ban-server-cmd "status" "sshd") " ")) + #\newline))) + marionette)) + + (test-equal "fail2ban sshd jail running exit code" + 0 + (marionette-eval + '(status:exit-val (system* #$%fail2ban-server-cmd "status" "sshd")) + marionette)))) + +(define %test-fail2ban-extension + (system-test + (name "fail2ban-extension") + (description "Test extension fail2ban running capability.") + (value (run-fail2ban-extension-test))))