projects/guix·blob python-team · refs

415 lines · 16.3 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2022 muradm <[email protected]>
3;;; Copyright © 2022 Ludovic Courtès <[email protected]>
4;;;
5;;; This file is part of GNU Guix.
6;;;
7;;; GNU Guix is free software; you can redistribute it and/or modify it
8;;; under the terms of the GNU General Public License as published by
9;;; the Free Software Foundation; either version 3 of the License, or (at
10;;; your option) any later version.
11;;;
12;;; GNU Guix is distributed in the hope that it will be useful, but
13;;; WITHOUT ANY WARRANTY; without even the implied warranty of
14;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15;;; GNU General Public License for more details.
16;;;
17;;; You should have received a copy of the GNU General Public License
18;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
19
20(define-module (gnu services security)
21 #:use-module (gnu packages admin)
22 #:use-module (gnu services)
23 #:use-module (gnu services configuration)
24 #:use-module (gnu services shepherd)
25 #:use-module (guix gexp)
26 #:use-module (guix packages)
27 #:use-module (guix records)
28 #:use-module (guix ui)
29 #:use-module (ice-9 format)
30 #:use-module (ice-9 match)
31 #:use-module (srfi srfi-1)
32 #:export (fail2ban-configuration
33 fail2ban-ignore-cache-configuration
34 fail2ban-jail-action-configuration
35 fail2ban-jail-configuration
36 fail2ban-jail-filter-configuration
37 fail2ban-jail-service
38 fail2ban-service-type))
39
40(define-configuration/no-serialization fail2ban-ignore-cache-configuration
41 (key string "Cache key.")
42 (max-count integer "Cache size.")
43 (max-time integer "Cache time."))
44
45(define (serialize-fail2ban-ignore-cache-configuration config)
46 (match-record config <fail2ban-ignore-cache-configuration>
47 (key max-count max-time)
48 (format #f "key=\"~a\", max-count=~d, max-time=~d"
49 key max-count max-time)))
50
51(define-maybe/no-serialization string)
52
53(define-configuration/no-serialization fail2ban-jail-filter-configuration
54 (name string "Filter to use.")
55 (mode maybe-string "Mode for filter."))
56
57(define (serialize-fail2ban-jail-filter-configuration config)
58 (match-record config <fail2ban-jail-filter-configuration>
59 (name mode)
60 (format #f "~a~@[[mode=~a]~]" name (maybe-value mode))))
61
62(define (argument? a)
63 (and (pair? a)
64 (string? (car a))
65 (or (string? (cdr a))
66 (list-of-strings? (cdr a)))))
67
68(define list-of-arguments? (list-of argument?))
69
70(define-configuration/no-serialization fail2ban-jail-action-configuration
71 (name string "Action name.")
72 (arguments (list-of-arguments '()) "Action arguments."))
73
74(define list-of-fail2ban-jail-actions?
75 (list-of fail2ban-jail-action-configuration?))
76
77(define (serialize-fail2ban-jail-action-configuration-arguments args)
78 (let* ((multi-value
79 (lambda (v)
80 (format #f "~a" (string-join v ","))))
81 (any-value
82 (lambda (v)
83 (if (list? v) (string-append "\"" (multi-value v) "\"") v)))
84 (key-value
85 (lambda (e)
86 (format #f "~a=~a" (car e) (any-value (cdr e))))))
87 (format #f "~a" (string-join (map key-value args) ","))))
88
89(define (serialize-fail2ban-jail-action-configuration config)
90 (match-record config <fail2ban-jail-action-configuration>
91 (name arguments)
92 (format
93 #f "~a~a"
94 name
95 (if (null? arguments) ""
96 (format
97 #f "[~a]"
98 (serialize-fail2ban-jail-action-configuration-arguments
99 arguments))))))
100
101(define fail2ban-backend->string
102 (match-lambda
103 ('auto "auto")
104 ('pyinotify "pyinotify")
105 ('gamin "gamin")
106 ('polling "polling")
107 ('systemd "systemd")
108 (unknown
109 (leave (G_ "fail2ban: '~a' is not a supported backend~%") unknown))))
110
111(define fail2ban-log-encoding->string
112 (match-lambda
113 ('auto "auto")
114 ('utf-8 "utf-8")
115 ('ascii "ascii")
116 (unknown
117 (leave (G_ "fail2ban: '~a' is not a supported log encoding~%") unknown))))
118
119(define (fail2ban-jail-configuration-serialize-field-name name)
120 (cond ((symbol? name)
121 (fail2ban-jail-configuration-serialize-field-name
122 (symbol->string name)))
123 ((string-suffix? "?" name)
124 (fail2ban-jail-configuration-serialize-field-name
125 (string-drop-right name 1)))
126 ((string-prefix? "ban-time-" name)
127 (fail2ban-jail-configuration-serialize-field-name
128 (string-append "bantime." (substring name 9))))
129 ((string-contains name "-")
130 (fail2ban-jail-configuration-serialize-field-name
131 (string-filter (lambda (c) (not (equal? c #\-))) name)))
132 (else name)))
133
134(define (fail2ban-jail-configuration-serialize-string field-name value)
135 #~(string-append
136 #$(fail2ban-jail-configuration-serialize-field-name field-name)
137 " = " #$value "\n"))
138
139(define (fail2ban-jail-configuration-serialize-integer field-name value)
140 (fail2ban-jail-configuration-serialize-string
141 field-name (number->string value)))
142
143(define (fail2ban-jail-configuration-serialize-boolean field-name value)
144 (fail2ban-jail-configuration-serialize-string
145 field-name (if value "true" "false")))
146
147(define (fail2ban-jail-configuration-serialize-backend field-name value)
148 (if (maybe-value-set? value)
149 (fail2ban-jail-configuration-serialize-string
150 field-name (fail2ban-backend->string value))
151 ""))
152
153(define (fail2ban-jail-configuration-serialize-fail2ban-ignore-cache-configuration field-name value)
154 (fail2ban-jail-configuration-serialize-string
155 field-name (serialize-fail2ban-ignore-cache-configuration value)))
156
157(define (fail2ban-jail-configuration-serialize-fail2ban-jail-filter-configuration field-name value)
158 (fail2ban-jail-configuration-serialize-string
159 field-name (serialize-fail2ban-jail-filter-configuration value)))
160
161(define (fail2ban-jail-configuration-serialize-log-encoding field-name value)
162 (if (maybe-value-set? value)
163 (fail2ban-jail-configuration-serialize-string
164 field-name (fail2ban-log-encoding->string value))
165 ""))
166
167(define (fail2ban-jail-configuration-serialize-list-of-strings field-name value)
168 (if (null? value)
169 ""
170 (fail2ban-jail-configuration-serialize-string
171 field-name (string-join value " "))))
172
173(define (fail2ban-jail-configuration-serialize-list-of-fail2ban-jail-actions field-name value)
174 (if (null? value)
175 ""
176 (fail2ban-jail-configuration-serialize-string
177 field-name (string-join
178 (map serialize-fail2ban-jail-action-configuration value) "\n"))))
179
180(define (fail2ban-jail-configuration-serialize-symbol field-name value)
181 (fail2ban-jail-configuration-serialize-string field-name (symbol->string value)))
182
183(define-maybe integer (prefix fail2ban-jail-configuration-))
184(define-maybe string (prefix fail2ban-jail-configuration-))
185(define-maybe boolean (prefix fail2ban-jail-configuration-))
186(define-maybe symbol (prefix fail2ban-jail-configuration-))
187(define-maybe fail2ban-ignore-cache-configuration (prefix fail2ban-jail-configuration-))
188(define-maybe fail2ban-jail-filter-configuration (prefix fail2ban-jail-configuration-))
189
190(define-configuration fail2ban-jail-configuration
191 (name
192 string
193 "Required name of this jail configuration."
194 empty-serializer)
195 (enabled?
196 (boolean #t)
197 "Whether this jail is enabled.")
198 (backend
199 maybe-symbol
200 "Backend to use to detect changes in the @code{log-path}. The default is
201'auto. To consult the defaults of the jail configuration, refer to the
202@file{/etc/fail2ban/jail.conf} file of the @code{fail2ban} package."
203 (serializer fail2ban-jail-configuration-serialize-backend))
204 (max-retry
205 maybe-integer
206 "The number of failures before a host get banned
207(e.g. @code{(max-retry 5)}).")
208 (max-matches
209 maybe-integer
210 "The number of matches stored in ticket (resolvable via
211tag @code{<matches>}) in action.")
212 (find-time
213 maybe-string
214 "The time window during which the maximum retry count must be reached for
215an IP address to be banned. A host is banned if it has generated
216@code{max-retry} during the last @code{find-time}
217seconds (e.g. @code{(find-time \"10m\")}). It can be provided in seconds or
218using Fail2Ban's \"time abbreviation format\", as described in @command{man 5
219jail.conf}.")
220 (ban-time
221 maybe-string
222 "The duration, in seconds or time abbreviated format, that a ban should last.
223(e.g. @code{(ban-time \"10m\")}).")
224 (ban-time-increment?
225 maybe-boolean
226 "Whether to consider past bans to compute increases to the default ban time
227of a specific IP address.")
228 (ban-time-factor
229 maybe-string
230 "The coefficient to use to compute an exponentially growing ban time.")
231 (ban-time-formula
232 maybe-string
233 "This is the formula used to calculate the next value of a ban time.")
234 (ban-time-multipliers
235 maybe-string
236 "Used to calculate next value of ban time instead of formula.")
237 (ban-time-max-time
238 maybe-string
239 "The maximum number of seconds a ban should last.")
240 (ban-time-rnd-time
241 maybe-string
242 "The maximum number of seconds a randomized ban time should last. This can
243be useful to stop ``clever'' botnets calculating the exact time an IP address
244can be unbanned again.")
245 (ban-time-overall-jails?
246 maybe-boolean
247 "When true, it specifies the search of an IP address in the database should
248be made across all jails. Otherwise, only the current jail of the ban IP
249address is considered.")
250 (ignore-self?
251 maybe-boolean
252 "Never ban the local machine's own IP address.")
253 (ignore-ip
254 (list-of-strings '())
255 "A list of IP addresses, CIDR masks or DNS hosts to ignore.
256@code{fail2ban} will not ban a host which matches an address in this list.")
257 (ignore-cache
258 maybe-fail2ban-ignore-cache-configuration
259 "Provide cache parameters for the ignore failure check.")
260 (filter
261 maybe-fail2ban-jail-filter-configuration
262 "The filter to use by the jail, specified via a
263@code{<fail2ban-jail-filter-configuration>} object. By default, jails have
264names matching their filter name.")
265 (log-time-zone
266 maybe-string
267 "The default time zone for log lines that do not have one.")
268 (log-encoding
269 maybe-symbol
270 "The encoding of the log files handled by the jail.
271Possible values are: @code{'ascii}, @code{'utf-8} and @code{'auto}."
272 (serializer fail2ban-jail-configuration-serialize-log-encoding))
273 (log-path
274 (list-of-strings '())
275 "The file names of the log files to be monitored.")
276 (action
277 (list-of-fail2ban-jail-actions '())
278 "A list of @code{<fail2ban-jail-action-configuration>}.")
279 (extra-content
280 (text-config '())
281 "Extra content for the jail configuration, provided as a list of file-like
282objects."
283 (serializer serialize-text-config))
284 (prefix fail2ban-jail-configuration-))
285
286(define list-of-fail2ban-jail-configurations?
287 (list-of fail2ban-jail-configuration?))
288
289(define (serialize-fail2ban-jail-configuration config)
290 #~(string-append
291 #$(format #f "[~a]\n" (fail2ban-jail-configuration-name config))
292 #$(serialize-configuration
293 config fail2ban-jail-configuration-fields)))
294
295(define-configuration/no-serialization fail2ban-configuration
296 (fail2ban
297 (package fail2ban)
298 "The @code{fail2ban} package to use. It is used for both binaries and as
299base default configuration that is to be extended with
300@code{<fail2ban-jail-configuration>} objects.")
301 (run-directory
302 (string "/var/run/fail2ban")
303 "The state directory for the @code{fail2ban} daemon.")
304 (jails
305 (list-of-fail2ban-jail-configurations '())
306 "Instances of @code{<fail2ban-jail-configuration>} collected from
307extensions.")
308 (extra-jails
309 (list-of-fail2ban-jail-configurations '())
310 "Instances of @code{<fail2ban-jail-configuration>} explicitly provided.")
311 (extra-content
312 (text-config '())
313 "Extra raw content to add to the end of the @file{jail.local} file,
314provided as a list of file-like objects."))
315
316(define (serialize-fail2ban-configuration config)
317 (let* ((jails (fail2ban-configuration-jails config))
318 (extra-jails (fail2ban-configuration-extra-jails config))
319 (extra-content (fail2ban-configuration-extra-content config)))
320 (interpose
321 (append (map serialize-fail2ban-jail-configuration
322 (append jails extra-jails))
323 (list (serialize-text-config 'extra-content extra-content))))))
324
325(define (config->fail2ban-etc-directory config)
326 (let* ((fail2ban (fail2ban-configuration-fail2ban config))
327 (jail-local (apply mixed-text-file "jail.local"
328 (serialize-fail2ban-configuration config))))
329 (directory-union
330 "fail2ban-configuration"
331 (list (computed-file
332 "etc-fail2ban"
333 (with-imported-modules '((guix build utils))
334 #~(begin
335 (use-modules (guix build utils))
336 (let ((etc (string-append #$output "/etc")))
337 (mkdir-p etc)
338 (symlink #$(file-append fail2ban "/etc/fail2ban")
339 (string-append etc "/fail2ban"))))))
340 (computed-file
341 "etc-fail2ban-jail.local"
342 (with-imported-modules '((guix build utils))
343 #~(begin
344 (use-modules (guix build utils))
345 (define etc/fail2ban (string-append #$output
346 "/etc/fail2ban"))
347 (mkdir-p etc/fail2ban)
348 (symlink #$jail-local (string-append etc/fail2ban
349 "/jail.local")))))))))
350
351(define (fail2ban-shepherd-service config)
352 (match-record config <fail2ban-configuration>
353 (fail2ban run-directory)
354 (let* ((fail2ban-server (file-append fail2ban "/bin/fail2ban-server"))
355 (fail2ban-client (file-append fail2ban "/bin/fail2ban-client"))
356 (pid-file (in-vicinity run-directory "fail2ban.pid"))
357 (socket-file (in-vicinity run-directory "fail2ban.sock"))
358 (config-dir (file-append (config->fail2ban-etc-directory config)
359 "/etc/fail2ban"))
360 (fail2ban-action (lambda args
361 #~(invoke #$fail2ban-client #$@args))))
362
363 ;; TODO: Add 'reload' action (see 'fail2ban.service.in' in the source).
364 (list (shepherd-service
365 (provision '(fail2ban))
366 (documentation "Run the fail2ban daemon.")
367 (requirement '(user-processes))
368 (start #~(make-forkexec-constructor
369 (list #$fail2ban-server
370 "-c" #$config-dir "-s" #$socket-file
371 "-p" #$pid-file "-xf" "start")
372 #:pid-file #$pid-file))
373 (stop #~(lambda (_)
374 #$(fail2ban-action "stop")
375 #f))))))) ;successfully stopped
376
377(define fail2ban-service-type
378 (service-type (name 'fail2ban)
379 (extensions
380 (list (service-extension shepherd-root-service-type
381 fail2ban-shepherd-service)
382 ;; For the fail2ban-client and fail2ban-regex commands.
383 (service-extension
384 profile-service-type
385 (compose list fail2ban-configuration-fail2ban))))
386 (compose concatenate)
387 (extend (lambda (config jails)
388 (fail2ban-configuration
389 (inherit config)
390 (jails (append (fail2ban-configuration-jails config)
391 jails)))))
392 (default-value (fail2ban-configuration))
393 (description "Run the fail2ban server.")))
394
395(define (fail2ban-jail-service svc-type jail)
396 "Convenience procedure to add a fail2ban service extension to SVC-TYPE, a
397<service-type> object. The fail2ban extension is specified by JAIL, a
398<fail2ban-jail-configuration> object."
399 (service-type
400 (inherit svc-type)
401 (extensions
402 (append (service-type-extensions svc-type)
403 (list (service-extension fail2ban-service-type
404 (lambda _ (list jail))))))))
405
406
407;;;
408;;; Documentation generation.
409;;;
410(define (generate-doc)
411 (configuration->documentation 'fail2ban-configuration)
412 (configuration->documentation 'fail2ban-ignore-cache-configuration)
413 (configuration->documentation 'fail2ban-jail-action-configuration)
414 (configuration->documentation 'fail2ban-jail-configuration)
415 (configuration->documentation 'fail2ban-jail-filter-configuration))