projects/guix·blob java-team · refs

1034 lines · 39.7 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2017 Julien Lepiller <[email protected]>
3;;; Copyright © 2017 Clément Lassieur <[email protected]>
4;;; Copyright © 2017 Mathieu Othacehe <[email protected]>
5;;; Copyright © 2021 Guillaume Le Vaillant <[email protected]>
6;;; Copyright © 2021 Solene Rapenne <[email protected]>
7;;; Copyright © 2021 Domagoj Stolfa <[email protected]>
8;;; Copyright © 2021 Tobias Geerinckx-Rice <[email protected]>
9;;; Copyright © 2021 Raghav Gururajan <[email protected]>
10;;; Copyright © 2021 jgart <[email protected]>
11;;; Copyright © 2021 Nathan Dehnel <[email protected]>
12;;; Copyright © 2022 Cameron V Chaparro <[email protected]>
13;;; Copyright © 2022 Timo Wilken <[email protected]>
14;;; Copyright © 2023 Maxim Cournoyer <[email protected]>
15;;; Copyright © 2024 Richard Sent <[email protected]>
16;;; Copyright © 2025 Carlo Zancanaro <[email protected]>
17;;;
18;;; This file is part of GNU Guix.
19;;;
20;;; GNU Guix is free software; you can redistribute it and/or modify it
21;;; under the terms of the GNU General Public License as published by
22;;; the Free Software Foundation; either version 3 of the License, or (at
23;;; your option) any later version.
24;;;
25;;; GNU Guix is distributed in the hope that it will be useful, but
26;;; WITHOUT ANY WARRANTY; without even the implied warranty of
27;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
28;;; GNU General Public License for more details.
29;;;
30;;; You should have received a copy of the GNU General Public License
31;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
32
33(define-module (gnu services vpn)
34 #:use-module (gnu services)
35 #:use-module (gnu services configuration)
36 #:use-module (gnu services dbus)
37 #:use-module (gnu services shepherd)
38 #:use-module (gnu system shadow)
39 #:use-module (gnu packages admin)
40 #:use-module (gnu packages vpn)
41 #:use-module (guix modules)
42 #:use-module (guix packages)
43 #:use-module (guix records)
44 #:use-module (guix gexp)
45 #:use-module (guix diagnostics)
46 #:use-module (guix i18n)
47 #:use-module (guix deprecation)
48 #:use-module (srfi srfi-1)
49 #:use-module (ice-9 format)
50 #:use-module (ice-9 match)
51 #:use-module (ice-9 regex)
52 #:export (openvpn-client-service ; deprecated
53 openvpn-server-service ; deprecated
54 openvpn-client-service-type
55 openvpn-server-service-type
56 openvpn-client-configuration
57 openvpn-server-configuration
58 openvpn-remote-configuration
59 openvpn-ccd-configuration
60 generate-openvpn-client-documentation
61 generate-openvpn-server-documentation
62
63 strongswan-configuration
64 strongswan-service-type
65
66 wireguard-peer
67 wireguard-peer?
68 wireguard-peer-name
69 wireguard-peer-endpoint
70 wireguard-peer-allowed-ips
71 wireguard-peer-public-key
72 wireguard-peer-preshared-key
73 wireguard-peer-keep-alive
74
75 wireguard-configuration
76 wireguard-configuration?
77 wireguard-configuration-wireguard
78 wireguard-configuration-interface
79 wireguard-configuration-addresses
80 wireguard-configuration-port
81 wireguard-configuration-dns
82 wireguard-configuration-monitor-ips?
83 wireguard-configuration-monitor-ips-interval
84 wireguard-configuration-private-key
85 wireguard-configuration-bootstrap-private-key?
86 wireguard-configuration-peers
87 wireguard-configuration-pre-up
88 wireguard-configuration-post-up
89 wireguard-configuration-pre-down
90 wireguard-configuration-post-down
91 wireguard-configuration-shepherd-requirement
92 wireguard-configuration-table
93 wireguard-configuration-auto-start?
94
95 wireguard-configuration-file
96
97 wireguard-service-type))
98
99;;;
100;;; Bitmask.
101;;;
102
103(define-public bitmask-service-type
104 (service-type
105 (name 'bitmask)
106 (description "Setup the @uref{https://bitmask.net, Bitmask} VPN application.")
107 (default-value bitmask)
108 (extensions
109 (list
110 ;; Add bitmask to the system profile.
111 (service-extension profile-service-type list)
112 ;; Configure polkit policy of bitmask.
113 (service-extension polkit-service-type list)))))
114
115;;;
116;;; OpenVPN.
117;;;
118
119(define (uglify-field-name name)
120 (match name
121 ('verbosity "verb")
122 (_ (let ((str (symbol->string name)))
123 (if (string-suffix? "?" str)
124 (substring str 0 (1- (string-length str)))
125 str)))))
126
127(define (serialize-field field-name val)
128 (if (eq? field-name 'pid-file)
129 (format #t "")
130 (format #t "~a ~a\n" (uglify-field-name field-name) val)))
131(define serialize-string serialize-field)
132(define-maybe string)
133(define (serialize-boolean field-name val)
134 (if val
135 (serialize-field field-name "")
136 (format #t "")))
137
138(define (ip-mask? val)
139 (and (string? val)
140 (if (string-match "^([0-9]+\\.){3}[0-9]+ ([0-9]+\\.){3}[0-9]+$" val)
141 (let ((numbers (string-tokenize val char-set:digit)))
142 (all-lte numbers (list 255 255 255 255 255 255 255 255)))
143 #f)))
144(define serialize-ip-mask serialize-string)
145
146(define-enumerated-field-type proto
147 (udp tcp udp6 tcp6))
148(define-enumerated-field-type dev
149 (tun tap))
150
151(define key-usage? boolean?)
152(define (serialize-key-usage field-name value)
153 (if value
154 (format #t "remote-cert-tls server\n")
155 #f))
156
157(define bind? boolean?)
158(define (serialize-bind field-name value)
159 (if value
160 #f
161 (format #t "nobind\n")))
162
163(define resolv-retry? boolean?)
164(define (serialize-resolv-retry field-name value)
165 (if value
166 (format #t "resolv-retry infinite\n")
167 #f))
168
169(define (serialize-tls-auth role location)
170 (if location
171 (serialize-field 'tls-auth
172 (string-append location " " (match role
173 ('server "0")
174 ('client "1"))))
175 #f))
176(define (tls-auth? val)
177 (or (eq? val #f)
178 (string? val)))
179(define (serialize-tls-auth-server field-name val)
180 (serialize-tls-auth 'server val))
181(define (serialize-tls-auth-client field-name val)
182 (serialize-tls-auth 'client val))
183(define tls-auth-server? tls-auth?)
184(define tls-auth-client? tls-auth?)
185
186(define (serialize-number field-name val)
187 (serialize-field field-name (number->string val)))
188
189(define (all-lte left right)
190 (if (eq? left '())
191 (eq? right '())
192 (and (<= (string->number (car left)) (car right))
193 (all-lte (cdr left) (cdr right)))))
194
195(define (cidr4? val)
196 (if (string? val)
197 (if (string-match "^([0-9]+\\.){3}[0-9]+/[0-9]+$" val)
198 (let ((numbers (string-tokenize val char-set:digit)))
199 (all-lte numbers (list 255 255 255 255 32)))
200 #f)
201 (eq? val #f)))
202
203(define (cidr6? val)
204 (if (string? val)
205 (string-match "^([0-9a-f]{0,4}:){0,8}/[0-9]{1,3}$" val)
206 (eq? val #f)))
207
208(define (serialize-cidr4 field-name val)
209 (if (eq? val #f) #f (serialize-field field-name val)))
210
211(define (serialize-cidr6 field-name val)
212 (if (eq? val #f) #f (serialize-field field-name val)))
213
214(define (ip? val)
215 (if (string? val)
216 (if (string-match "^([0-9]+\\.){3}[0-9]+$" val)
217 (let ((numbers (string-tokenize val char-set:digit)))
218 (all-lte numbers (list 255 255 255 255)))
219 #f)
220 (eq? val #f)))
221(define (serialize-ip field-name val)
222 (if (eq? val #f) #f (serialize-field field-name val)))
223
224(define (keepalive? val)
225 (and (list? val)
226 (and (number? (car val))
227 (number? (car (cdr val))))))
228(define (serialize-keepalive field-name val)
229 (format #t "~a ~a ~a\n" (uglify-field-name field-name)
230 (number->string (car val)) (number->string (car (cdr val)))))
231
232(define gateway? boolean?)
233(define (serialize-gateway field-name val)
234 (and val
235 (format #t "push \"redirect-gateway\"\n")))
236
237
238(define-configuration openvpn-remote-configuration
239 (name
240 (string "my-server")
241 "Server name.")
242 (port
243 (number 1194)
244 "Port number the server listens to."))
245
246(define-configuration openvpn-ccd-configuration
247 (name
248 (string "client")
249 "Client name.")
250 (iroute
251 (ip-mask #f)
252 "Client own network")
253 (ifconfig-push
254 (ip-mask #f)
255 "Client VPN IP."))
256
257(define (openvpn-remote-list? val)
258 (and (list? val)
259 (or (eq? val '())
260 (and (openvpn-remote-configuration? (car val))
261 (openvpn-remote-list? (cdr val))))))
262(define (serialize-openvpn-remote-list field-name val)
263 (for-each (lambda (remote)
264 (format #t "remote ~a ~a\n" (openvpn-remote-configuration-name remote)
265 (number->string (openvpn-remote-configuration-port remote))))
266 val))
267
268(define (openvpn-ccd-list? val)
269 (and (list? val)
270 (or (eq? val '())
271 (and (openvpn-ccd-configuration? (car val))
272 (openvpn-ccd-list? (cdr val))))))
273(define (serialize-openvpn-ccd-list field-name val)
274 #f)
275
276(define (create-ccd-directory val)
277 "Create a ccd directory containing files for the ccd configuration option
278of OpenVPN. Each file in this directory represents particular settings for a
279client. Each file is named after the name of the client."
280 (let ((files (map (lambda (ccd)
281 (list (openvpn-ccd-configuration-name ccd)
282 (with-output-to-string
283 (lambda ()
284 (serialize-configuration
285 ccd openvpn-ccd-configuration-fields)))))
286 val)))
287 (computed-file "ccd"
288 (with-imported-modules '((guix build utils))
289 #~(begin
290 (use-modules (guix build utils))
291 (use-modules (ice-9 match))
292 (mkdir-p #$output)
293 (for-each
294 (lambda (ccd)
295 (match ccd
296 ((name config-string)
297 (call-with-output-file
298 (string-append #$output "/" name)
299 (lambda (port) (display config-string port))))))
300 '#$files))))))
301
302(define-syntax define-split-configuration
303 (lambda (x)
304 (syntax-case x ()
305 ((_ name1 name2 (common-option ...) (first-option ...) (second-option ...))
306 #`(begin
307 (define-configuration #,#'name1
308 common-option ...
309 first-option ...)
310 (define-configuration #,#'name2
311 common-option ...
312 second-option ...))))))
313
314(define-split-configuration openvpn-client-configuration
315 openvpn-server-configuration
316 ((openvpn
317 (file-like openvpn)
318 "The OpenVPN package.")
319
320 (pid-file
321 (string "/var/run/openvpn/openvpn.pid")
322 "The OpenVPN pid file.")
323
324 (proto
325 (proto 'udp)
326 "The protocol (UDP or TCP) used to open a channel between clients and
327servers.")
328
329 (dev
330 (dev 'tun)
331 "The device type used to represent the VPN connection.")
332
333 (ca
334 (maybe-string "/etc/openvpn/ca.crt")
335 "The certificate authority to check connections against.")
336
337 (cert
338 (maybe-string "/etc/openvpn/client.crt")
339 "The certificate of the machine the daemon is running on. It should be signed
340by the authority given in @code{ca}.")
341
342 (key
343 (maybe-string "/etc/openvpn/client.key")
344 "The key of the machine the daemon is running on. It must be the key whose
345certificate is @code{cert}.")
346
347 (comp-lzo?
348 (boolean #t)
349 "Whether to use the lzo compression algorithm.")
350
351 (persist-key?
352 (boolean #t)
353 "Don't re-read key files across SIGUSR1 or --ping-restart.")
354
355 (persist-tun?
356 (boolean #t)
357 "Don't close and reopen TUN/TAP device or run up/down scripts across
358SIGUSR1 or --ping-restart restarts.")
359
360 (fast-io?
361 (boolean #f)
362 "(Experimental) Optimize TUN/TAP/UDP I/O writes by avoiding a call to
363poll/epoll/select prior to the write operation.")
364
365 (verbosity
366 (number 3)
367 "Verbosity level."))
368 ;; client-specific configuration
369 ((tls-auth
370 (tls-auth-client #f)
371 "Add an additional layer of HMAC authentication on top of the TLS control
372channel to protect against DoS attacks.")
373
374 (auth-user-pass
375 maybe-string
376 "Authenticate with server using username/password. The option is a file
377containing username/password on 2 lines. Do not use a file-like object as it
378would be added to the store and readable by any user.")
379
380 (verify-key-usage?
381 (key-usage #t)
382 "Whether to check the server certificate has server usage extension.")
383
384 (bind?
385 (bind #f)
386 "Bind to a specific local port number.")
387
388 (resolv-retry?
389 (resolv-retry #t)
390 "Retry resolving server address.")
391
392 (remote
393 (openvpn-remote-list '())
394 "A list of remote servers to connect to."))
395 ;; server-specific configuration
396 ((tls-auth
397 (tls-auth-server #f)
398 "Add an additional layer of HMAC authentication on top of the TLS control
399channel to protect against DoS attacks.")
400
401 (port
402 (number 1194)
403 "Specifies the port number on which the server listens.")
404
405 (server
406 (ip-mask "10.8.0.0 255.255.255.0")
407 "An ip and mask specifying the subnet inside the virtual network.")
408
409 (server-ipv6
410 (cidr6 #f)
411 "A CIDR notation specifying the IPv6 subnet inside the virtual network.")
412
413 (dh
414 (string "/etc/openvpn/dh2048.pem")
415 "The Diffie-Hellman parameters file.")
416
417 (ifconfig-pool-persist
418 (string "/etc/openvpn/ipp.txt")
419 "The file that records client IPs.")
420
421 (redirect-gateway?
422 (gateway #f)
423 "When true, the server will act as a gateway for its clients.")
424
425 (client-to-client?
426 (boolean #f)
427 "When true, clients are allowed to talk to each other inside the VPN.")
428
429 (keepalive
430 (keepalive '(10 120))
431 "Causes ping-like messages to be sent back and forth over the link so that
432each side knows when the other side has gone down. @code{keepalive} requires
433a pair. The first element is the period of the ping sending, and the second
434element is the timeout before considering the other side down.")
435
436 (max-clients
437 (number 100)
438 "The maximum number of clients.")
439
440 (status
441 (string "/var/run/openvpn/status")
442 "The status file. This file shows a small report on current connection. It
443is truncated and rewritten every minute.")
444
445 (client-config-dir
446 (openvpn-ccd-list '())
447 "The list of configuration for some clients.")))
448
449(define (openvpn-config-file role config)
450 (let ((config-str
451 (with-output-to-string
452 (lambda ()
453 (serialize-configuration config
454 (match role
455 ('server
456 openvpn-server-configuration-fields)
457 ('client
458 openvpn-client-configuration-fields))))))
459 (ccd-dir (match role
460 ('server (create-ccd-directory
461 (openvpn-server-configuration-client-config-dir
462 config)))
463 ('client #f))))
464 (computed-file "openvpn.conf"
465 #~(begin
466 (use-modules (ice-9 match))
467 (call-with-output-file #$output
468 (lambda (port)
469 (match '#$role
470 ('server (display "" port))
471 ('client (display "client\n" port)))
472 (display #$config-str port)
473 (match '#$role
474 ('server (display
475 (string-append "client-config-dir "
476 #$ccd-dir "\n") port))
477 ('client (display "" port)))))))))
478
479(define (openvpn-shepherd-service role)
480 (lambda (config)
481 (let* ((config-file (openvpn-config-file role config))
482 (pid-file ((match role
483 ('server openvpn-server-configuration-pid-file)
484 ('client openvpn-client-configuration-pid-file))
485 config))
486 (openvpn ((match role
487 ('server openvpn-server-configuration-openvpn)
488 ('client openvpn-client-configuration-openvpn))
489 config))
490 (log-file (match role
491 ('server "/var/log/openvpn-server.log")
492 ('client "/var/log/openvpn-client.log"))))
493 (list (shepherd-service
494 (documentation (string-append "Run the OpenVPN "
495 (match role
496 ('server "server")
497 ('client "client"))
498 " daemon."))
499 (provision (match role
500 ('server '(vpn-server))
501 ('client '(vpn-client))))
502 (requirement '(user-processes networking))
503 (start #~(make-forkexec-constructor
504 (list (string-append #$openvpn "/sbin/openvpn")
505 "--writepid" #$pid-file "--config" #$config-file
506 "--daemon")
507 #:pid-file #$pid-file
508 #:log-file #$log-file))
509 (stop #~(make-kill-destructor)))))))
510
511(define %openvpn-accounts
512 (list (user-group (name "openvpn") (system? #t))
513 (user-account
514 (name "openvpn")
515 (group "openvpn")
516 (system? #t)
517 (comment "Openvpn daemon user")
518 (home-directory "/var/empty")
519 (shell (file-append shadow "/sbin/nologin")))))
520
521(define %openvpn-activation
522 #~(begin
523 (use-modules (guix build utils))
524 (mkdir-p "/var/run/openvpn")))
525
526(define openvpn-server-service-type
527 (service-type (name 'openvpn-server)
528 (extensions
529 (list (service-extension shepherd-root-service-type
530 (openvpn-shepherd-service 'server))
531 (service-extension account-service-type
532 (const %openvpn-accounts))
533 (service-extension activation-service-type
534 (const %openvpn-activation))))
535 (description "Run the OpenVPN server, which allows you to
536@emph{host} a @acronym{VPN, virtual private network}.")
537 (default-value (openvpn-server-configuration))))
538
539(define openvpn-client-service-type
540 (service-type (name 'openvpn-client)
541 (extensions
542 (list (service-extension shepherd-root-service-type
543 (openvpn-shepherd-service 'client))
544 (service-extension account-service-type
545 (const %openvpn-accounts))
546 (service-extension activation-service-type
547 (const %openvpn-activation))))
548 (description
549 "Run the OpenVPN client service, which allows you to connect
550to an existing @acronym{VPN, virtual private network}.")
551 (default-value (openvpn-client-configuration))))
552
553(define-deprecated
554 (openvpn-client-service #:key (config (openvpn-client-configuration)))
555 openvpn-client-service-type
556 (service openvpn-client-service-type config))
557
558(define-deprecated
559 (openvpn-server-service #:key (config (openvpn-server-configuration)))
560 openvpn-server-service-type
561 (service openvpn-server-service-type config))
562
563(define (generate-openvpn-server-documentation)
564 (generate-documentation
565 `((openvpn-server-configuration
566 ,openvpn-server-configuration-fields
567 (ccd openvpn-ccd-configuration))
568 (openvpn-ccd-configuration ,openvpn-ccd-configuration-fields))
569 'openvpn-server-configuration))
570
571(define (generate-openvpn-client-documentation)
572 (generate-documentation
573 `((openvpn-client-configuration
574 ,openvpn-client-configuration-fields
575 (remote openvpn-remote-configuration))
576 (openvpn-remote-configuration ,openvpn-remote-configuration-fields))
577 'openvpn-client-configuration))
578
579;;;
580;;; Strongswan.
581;;;
582
583(define-record-type* <strongswan-configuration>
584 strongswan-configuration make-strongswan-configuration
585 strongswan-configuration?
586 (strongswan strongswan-configuration-strongswan ;file-like
587 (default strongswan))
588 (ipsec-conf strongswan-configuration-ipsec-conf ;string|#f
589 (default #f))
590 (ipsec-secrets strongswan-configuration-ipsec-secrets ;string|#f
591 (default #f)))
592
593;; In the future, it might be worth implementing a record type to configure
594;; all of the plugins, but for *most* basic use cases, simply creating the
595;; files will be sufficient. Same is true of charon-plugins.
596(define strongswand-configuration-files
597 (list "charon" "charon-logging" "pki" "pool" "scepclient"
598 "swanctl" "tnc"))
599
600;; Plugins to load. All of these plugins end up as configuration files in
601;; strongswan.d/charon/.
602(define charon-plugins
603 (list "aes" "aesni" "attr" "attr-sql" "chapoly" "cmac" "constraints"
604 "counters" "curl" "curve25519" "dhcp" "dnskey" "drbg" "eap-aka-3gpp"
605 "eap-aka" "eap-dynamic" "eap-identity" "eap-md5" "eap-mschapv2"
606 "eap-peap" "eap-radius" "eap-simaka-pseudonym" "eap-simaka-reauth"
607 "eap-simaka-sql" "eap-sim" "eap-sim-file" "eap-tls" "eap-tnc"
608 "eap-ttls" "ext-auth" "farp" "fips-prf" "gmp" "ha" "hmac"
609 "kernel-netlink" "led" "md4" "md5" "mgf1" "nonce" "openssl" "pem"
610 "pgp" "pkcs12" "pkcs1" "pkcs7" "pkcs8" "pubkey" "random" "rc2"
611 "resolve" "revocation" "sha1" "sha2" "socket-default" "soup" "sql"
612 "sqlite" "sshkey" "tnc-tnccs" "vici" "x509" "xauth-eap" "xauth-generic"
613 "xauth-noauth" "xauth-pam" "xcbc"))
614
615(define (strongswan-configuration-file config)
616 (match-record config <strongswan-configuration>
617 (strongswan ipsec-conf ipsec-secrets)
618 (if (eq? (string? ipsec-conf) (string? ipsec-secrets))
619 (let* ((strongswan-dir
620 (computed-file
621 "strongswan.d"
622 #~(begin
623 (mkdir #$output)
624 ;; Create all of the configuration files strongswan.d/.
625 (map (lambda (conf-file)
626 (let* ((filename (string-append
627 #$output "/"
628 conf-file ".conf")))
629 (call-with-output-file filename
630 (lambda (port)
631 (display
632 "# Created by 'strongswan-service'\n"
633 port)))))
634 (list #$@strongswand-configuration-files))
635 (mkdir (string-append #$output "/charon"))
636 ;; Create all of the plugin configuration files.
637 (map (lambda (plugin)
638 (let* ((filename (string-append
639 #$output "/charon/"
640 plugin ".conf")))
641 (call-with-output-file filename
642 (lambda (port)
643 (format port "~a {
644 load = yes
645}"
646 plugin)))))
647 (list #$@charon-plugins))))))
648 ;; Generate our strongswan.conf to reflect the user configuration.
649 (computed-file
650 "strongswan.conf"
651 #~(begin
652 (call-with-output-file #$output
653 (lambda (port)
654 (display "# Generated by 'strongswan-service'.\n" port)
655 (format port "charon {
656 load_modular = yes
657 plugins {
658 include ~a/charon/*.conf"
659 #$strongswan-dir)
660 (if #$ipsec-conf
661 (format port "
662 stroke {
663 load = yes
664 secrets_file = ~a
665 }
666 }
667}
668
669starter {
670 config_file = ~a
671}
672
673include ~a/*.conf"
674 #$ipsec-secrets
675 #$ipsec-conf
676 #$strongswan-dir)
677 (format port "
678 }
679}
680include ~a/*.conf"
681 #$strongswan-dir)))))))
682 (throw 'error
683 (G_ "strongSwan ipsec-conf and ipsec-secrets must both be (un)set")))))
684
685(define (strongswan-shepherd-service config)
686 (let* ((ipsec (file-append strongswan "/sbin/ipsec"))
687 (strongswan-conf-path (strongswan-configuration-file config)))
688 (list (shepherd-service
689 (requirement '(user-processes networking))
690 (provision '(ipsec))
691 (start #~(make-forkexec-constructor
692 (list #$ipsec "start" "--nofork")
693 #:environment-variables
694 (list (string-append "STRONGSWAN_CONF="
695 #$strongswan-conf-path))))
696 (stop #~(make-kill-destructor))
697 (documentation
698 "strongSwan's charon IKE keying daemon for IPsec VPN.")))))
699
700(define strongswan-service-type
701 (service-type
702 (name 'strongswan)
703 (extensions
704 (list (service-extension shepherd-root-service-type
705 strongswan-shepherd-service)))
706 (default-value (strongswan-configuration))
707 (description
708 "Connect to an IPsec @acronym{VPN, Virtual Private Network} with
709strongSwan.")))
710
711;;;
712;;; Wireguard.
713;;;
714
715(define-record-type* <wireguard-peer>
716 wireguard-peer make-wireguard-peer
717 wireguard-peer?
718 (name wireguard-peer-name)
719 (endpoint wireguard-peer-endpoint
720 (default #f)) ;string
721 (public-key wireguard-peer-public-key) ;string
722 (preshared-key wireguard-peer-preshared-key
723 (default #f)) ;string
724 (allowed-ips wireguard-peer-allowed-ips) ;list of strings
725 (keep-alive wireguard-peer-keep-alive
726 (default #f))) ;integer
727
728(define-record-type* <wireguard-configuration>
729 wireguard-configuration make-wireguard-configuration
730 wireguard-configuration?
731 (wireguard wireguard-configuration-wireguard ;file-like
732 (default wireguard-tools))
733 (interface wireguard-configuration-interface ;string
734 (default "wg0"))
735 (addresses wireguard-configuration-addresses ;string
736 (default '("10.0.0.1/32")))
737 (port wireguard-configuration-port ;integer
738 (default 51820))
739 (private-key wireguard-configuration-private-key ;maybe-string
740 (default "/etc/wireguard/private.key"))
741 (bootstrap-private-key? wireguard-configuration-bootstrap-private-key? ;boolean
742 (default #t))
743 (peers wireguard-configuration-peers ;list of <wiregard-peer>
744 (default '()))
745 (dns wireguard-configuration-dns ;list of strings
746 (default '()))
747 (monitor-ips? wireguard-configuration-monitor-ips? ;boolean
748 (default #f))
749 (monitor-ips-interval wireguard-configuration-monitor-ips-interval
750 (default "*/5 * * * *")) ;string | list
751 (pre-up wireguard-configuration-pre-up ;list of strings
752 (default '()))
753 (post-up wireguard-configuration-post-up ;list of strings
754 (default '()))
755 (pre-down wireguard-configuration-pre-down ;list of strings
756 (default '()))
757 (post-down wireguard-configuration-post-down ;list of strings
758 (default '()))
759 (shepherd-requirement wireguard-configuration-shepherd-requirement ; list of symbols
760 (default '()))
761 (table wireguard-configuration-table ;string
762 (default "auto"))
763 (auto-start? wireguard-configuration-auto-start? ;boolean
764 (default #t)))
765
766(define (wireguard-configuration-file config)
767 (define (peer->config peer)
768 (match-record peer <wireguard-peer>
769 (name public-key endpoint allowed-ips keep-alive)
770 (let ((lines (list
771 (format #f "[Peer] #~a" name)
772 (format #f "PublicKey = ~a" public-key)
773 (format #f "AllowedIPs = ~{~a~^, ~}" allowed-ips)
774 (format #f "~@[Endpoint = ~a~]" endpoint)
775 (format #f "~@[PersistentKeepalive = ~a~]" keep-alive))))
776 (string-join (remove string-null? lines) "\n"))))
777
778 (define (peers->preshared-keys peer keys)
779 (let ((public-key (wireguard-peer-public-key peer))
780 (preshared-key (wireguard-peer-preshared-key peer)))
781 (if preshared-key
782 (cons* public-key preshared-key keys)
783 keys)))
784
785 (match-record config <wireguard-configuration>
786 (wireguard interface addresses port private-key peers dns
787 pre-up post-up pre-down post-down table)
788 (let* ((config-file (string-append interface ".conf"))
789 (peer-keys (fold peers->preshared-keys (list) peers))
790 (peers (map peer->config peers))
791 (config
792 (computed-file
793 "wireguard-config"
794 #~(begin
795 (use-modules (ice-9 format)
796 (srfi srfi-1))
797
798 (define lines
799 (list
800 "[Interface]"
801 (if (null? '#$addresses)
802 ""
803 (format #f "Address = ~{~a~^, ~}"
804 (list #$@addresses)))
805 (format #f "~@[Table = ~a~]" #$table)
806 (if (null? '#$pre-up)
807 ""
808 (format #f "~{PreUp = ~a~%~}" (list #$@pre-up)))
809 (if #$private-key
810 (format #f "PostUp = ~a set %i private-key ~a\
811~{ peer ~a preshared-key ~a~}"
812 #$(file-append wireguard "/bin/wg")
813 #$private-key (list #$@peer-keys))
814 "")
815 (if (null? '#$post-up)
816 ""
817 (format #f "~{PostUp = ~a~%~}" (list #$@post-up)))
818 (if (null? '#$pre-down)
819 ""
820 (format #f "~{PreDown = ~a~%~}" (list #$@pre-down)))
821 (if (null? '#$post-down)
822 ""
823 (format #f "~{PostDown = ~a~%~}" (list #$@post-down)))
824 (format #f "~@[ListenPort = ~a~]" #$port)
825 (if (null? '#$dns)
826 ""
827 (format #f "DNS = ~{~a~^, ~}" (list #$@dns)))))
828
829 (mkdir #$output)
830 (chdir #$output)
831 (call-with-output-file #$config-file
832 (lambda (port)
833 (format port "~a~%~%~{~a~%~^~%~}"
834 (string-join (remove string-null? lines) "\n")
835 '#$peers)))))))
836 (file-append config "/" config-file))))
837
838(define (wireguard-activation config)
839 (match-record config <wireguard-configuration>
840 (private-key bootstrap-private-key? wireguard)
841 #~(begin
842 (use-modules (guix build utils)
843 (ice-9 popen)
844 (ice-9 rdelim))
845 (when (and #$private-key
846 #$bootstrap-private-key?)
847 (mkdir-p (dirname #$private-key))
848 (unless (file-exists? #$private-key)
849 (let* ((pipe
850 (open-input-pipe (string-append
851 #$(file-append wireguard "/bin/wg")
852 " genkey")))
853 (key (read-line pipe)))
854 (call-with-output-file #$private-key
855 (lambda (port)
856 (display key port)))
857 (chmod #$private-key #o400)
858 (close-pipe pipe)))))))
859
860;;; XXX: Copied from (guix scripts pack), changing define to define*.
861(define-syntax-rule (define-with-source (variable args ...) body body* ...)
862 "Bind VARIABLE to a procedure accepting ARGS defined as BODY, also setting
863its source property."
864 (begin
865 (define* (variable args ...)
866 body body* ...)
867 (eval-when (load eval)
868 (set-procedure-property! variable 'source
869 '(define* (variable args ...) body body* ...)))))
870
871(define (wireguard-service-name interface)
872 "Return the WireGuard service name (a symbol) configured to use INTERFACE."
873 (symbol-append 'wireguard- (string->symbol interface)))
874
875(define-with-source (strip-port/maybe endpoint #:key ipv6?)
876 "Strip the colon and port, if present in ENDPOINT, a string."
877 (if ipv6?
878 (if (string-prefix? "[" endpoint)
879 (first (string-split (string-drop endpoint 1) #\])) ;ipv6
880 endpoint)
881 (first (string-split endpoint #\:)))) ;ipv4
882
883(define* (ipv4-address? address)
884 "Predicate to check whether ADDRESS is a valid IPv4 address."
885 (let ((address (strip-port/maybe address)))
886 (false-if-exception
887 (->bool (getaddrinfo address #f AI_NUMERICHOST AF_INET)))))
888
889(define* (ipv6-address? address)
890 "Predicate to check whether ADDRESS is a valid IPv6 address."
891 (let ((address (strip-port/maybe address #:ipv6? #t)))
892 (false-if-exception
893 (->bool (getaddrinfo address #f AI_NUMERICHOST AF_INET6)))))
894
895(define (host-name? name)
896 "Predicate to check whether NAME is a host name, i.e. not an IP address."
897 (not (or (ipv6-address? name) (ipv4-address? name))))
898
899(define (endpoint-host-names peers)
900 "Return an association list of endpoint host names keyed by their peer
901public key, if any."
902 (reverse
903 (fold (lambda (peer host-names)
904 (let ((public-key (wireguard-peer-public-key peer))
905 (endpoint (wireguard-peer-endpoint peer)))
906 (if (and endpoint (host-name? endpoint))
907 (cons (cons public-key endpoint) host-names)
908 host-names)))
909 '()
910 peers)))
911
912(define (wireguard-monitoring-program config)
913 (match-record config <wireguard-configuration>
914 (interface monitor-ips-interval peers)
915 (let ((host-names (endpoint-host-names peers)))
916 (when (null? host-names)
917 (warning (G_ "'monitor-ips?' is #t but no host name to monitor~%")))
918
919 ;; Loosely based on WireGuard's own 'reresolve-dns.sh' shell script
920 ;; (see: https://raw.githubusercontent.com/WireGuard/wireguard-tools/
921 ;; master/contrib/reresolve-dns/reresolve-dns.sh).
922 (program-file
923 (format #f "wireguard-~a-monitoring" interface)
924 (with-imported-modules (source-module-closure
925 '((gnu services herd)
926 (guix build utils)))
927 #~(begin
928 (use-modules (gnu services herd)
929 (guix build utils)
930 (ice-9 popen)
931 (ice-9 match)
932 (ice-9 textual-ports)
933 (srfi srfi-1)
934 (srfi srfi-26))
935
936 (define (resolve-host name)
937 "Return the IP address resolved from NAME."
938 (let* ((ai (car (getaddrinfo name)))
939 (sa (addrinfo:addr ai)))
940 (inet-ntop (sockaddr:fam sa)
941 (sockaddr:addr sa))))
942
943 (define wg #$(file-append wireguard-tools "/bin/wg"))
944
945 #$(procedure-source strip-port/maybe)
946
947 (define service-name
948 '#$(wireguard-service-name interface))
949
950 (when (live-service-running
951 (current-service service-name))
952 (let* ((pipe (open-pipe* OPEN_READ wg "show"
953 #$interface "endpoints"))
954 (lines (string-split (get-string-all pipe)
955 #\newline))
956 ;; IPS is an association list mapping
957 ;; public keys to IP addresses.
958 (ips (map (match-lambda
959 ((public-key ip)
960 (cons public-key
961 (strip-port/maybe ip))))
962 (map (cut string-split <> #\tab)
963 (remove string-null?
964 lines)))))
965 (close-pipe pipe)
966 (for-each
967 (match-lambda
968 ((key . host-name)
969 (let ((resolved-ip (resolve-host
970 (strip-port/maybe
971 host-name)))
972 (current-ip (assoc-ref ips key)))
973 (unless (string=? resolved-ip current-ip)
974 (format #t "resetting `~a' peer \
975endpoint to `~a' due to stale IP (`~a' instead of `~a')~%"
976 key host-name
977 current-ip resolved-ip)
978 (invoke wg "set" #$interface "peer" key
979 "endpoint" host-name)))))
980 '#$host-names)))))))))
981
982(define (wireguard-shepherd-services config)
983 (match-record config <wireguard-configuration>
984 (wireguard interface monitor-ips? monitor-ips-interval shepherd-requirement)
985 (let ((wg-quick (file-append wireguard "/bin/wg-quick"))
986 (auto-start? (wireguard-configuration-auto-start? config))
987 (config-file (wireguard-configuration-file config)))
988 (define monitoring-service
989 (and monitor-ips?
990 (shepherd-service
991 (provision (list (symbol-append
992 (wireguard-service-name interface)
993 '-monitoring)))
994 (requirement (list 'user-processes
995 (wireguard-service-name interface)))
996 (modules '((shepherd service timer)))
997 (start #~(make-timer-constructor
998 #$(if (string? monitor-ips-interval)
999 #~(cron-string->calendar-event
1000 #$monitor-ips-interval)
1001 monitor-ips-interval)
1002 (command '(#$(wireguard-monitoring-program config)))
1003 #:wait-for-termination? #t))
1004 (stop #~(make-timer-destructor))
1005 (documentation "Monitor the Wireguard VPN tunnel.")
1006 (actions (list shepherd-trigger-action)))))
1007
1008 (cons (shepherd-service
1009 (requirement `(networking user-processes ,@shepherd-requirement))
1010 (provision (list (wireguard-service-name interface)))
1011 (start #~(lambda _
1012 (invoke #$wg-quick "up" #$config-file)))
1013 (stop #~(lambda _
1014 (invoke #$wg-quick "down" #$config-file)
1015 #f)) ;stopped!
1016 (actions (list (shepherd-configuration-action config-file)))
1017 (auto-start? auto-start?)
1018 (documentation "Run the Wireguard VPN tunnel"))
1019 (or (and=> monitoring-service list)
1020 '())))))
1021
1022(define wireguard-service-type
1023 (service-type
1024 (name 'wireguard)
1025 (extensions
1026 (list (service-extension shepherd-root-service-type
1027 wireguard-shepherd-services)
1028 (service-extension activation-service-type
1029 wireguard-activation)
1030 (service-extension profile-service-type
1031 (compose list
1032 wireguard-configuration-wireguard))))
1033 (description "Set up Wireguard @acronym{VPN, Virtual Private Network}
1034tunnels.")))