diff options
Diffstat (limited to 'gnu/services')
| -rw-r--r-- | gnu/services/cuirass.scm | 128 | ||||
| -rw-r--r-- | gnu/services/databases.scm | 25 | ||||
| -rw-r--r-- | gnu/services/file-sharing.scm | 804 | ||||
| -rw-r--r-- | gnu/services/guix.scm | 88 | ||||
| -rw-r--r-- | gnu/services/networking.scm | 13 | ||||
| -rw-r--r-- | gnu/services/shepherd.scm | 10 | ||||
| -rw-r--r-- | gnu/services/vpn.scm | 138 | ||||
| -rw-r--r-- | gnu/services/web.scm | 112 |
8 files changed, 1270 insertions, 48 deletions
diff --git a/gnu/services/cuirass.scm b/gnu/services/cuirass.scm index 1cebbfcb6e..4d5e3a1041 100644 --- a/gnu/services/cuirass.scm +++ b/gnu/services/cuirass.scm @@ -22,11 +22,13 @@ ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (gnu services cuirass) + #:use-module (guix channels) #:use-module (guix gexp) #:use-module (guix records) #:use-module (guix utils) #:use-module (gnu packages admin) #:use-module (gnu packages ci) + #:use-module (gnu packages databases) #:use-module (gnu packages version-control) #:use-module (gnu services) #:use-module (gnu services base) @@ -34,6 +36,8 @@ #:use-module (gnu services shepherd) #:use-module (gnu services admin) #:use-module (gnu system shadow) + #:use-module (srfi srfi-1) + #:use-module (ice-9 match) #:export (<cuirass-remote-server-configuration> cuirass-remote-server-configuration cuirass-remote-server-configuration? @@ -46,7 +50,17 @@ <cuirass-remote-worker-configuration> cuirass-remote-worker-configuration cuirass-remote-worker-configuration? - cuirass-remote-worker-service-type)) + cuirass-remote-worker-service-type + + <build-manifest> + build-manifest + build-manifest? + + <simple-cuirass-configuration> + simple-cuirass-configuration + simple-cuirass-configuration? + + simple-cuirass-configuration->specs)) ;;;; Commentary: ;;; @@ -93,6 +107,8 @@ (default "cuirass")) (interval cuirass-configuration-interval ;integer (seconds) (default 60)) + (parameters cuirass-configuration-parameters ;string + (default #f)) (remote-server cuirass-configuration-remote-server (default #f)) (database cuirass-configuration-database ;string @@ -109,8 +125,6 @@ (default #f)) (fallback? cuirass-configuration-fallback? ;boolean (default #f)) - (zabbix-uri cuirass-configuration-zabbix-uri ;string - (default #f)) (extra-options cuirass-configuration-extra-options (default '()))) @@ -123,6 +137,7 @@ (user (cuirass-configuration-user config)) (group (cuirass-configuration-group config)) (interval (cuirass-configuration-interval config)) + (parameters (cuirass-configuration-parameters config)) (remote-server (cuirass-configuration-remote-server config)) (database (cuirass-configuration-database config)) (port (cuirass-configuration-port config)) @@ -131,12 +146,11 @@ (use-substitutes? (cuirass-configuration-use-substitutes? config)) (one-shot? (cuirass-configuration-one-shot? config)) (fallback? (cuirass-configuration-fallback? config)) - (zabbix-uri (cuirass-configuration-zabbix-uri config)) (extra-options (cuirass-configuration-extra-options config))) `(,(shepherd-service (documentation "Run Cuirass.") (provision '(cuirass)) - (requirement '(guix-daemon postgres networking)) + (requirement '(guix-daemon postgres postgres-roles networking)) (start #~(make-forkexec-constructor (list (string-append #$cuirass "/bin/cuirass") "--cache-directory" #$cache-directory @@ -144,6 +158,11 @@ #$(scheme-file "cuirass-specs.scm" specs) "--database" #$database "--interval" #$(number->string interval) + #$@(if parameters + (list (string-append + "--parameters=" + parameters)) + '()) #$@(if remote-server '("--build-remote") '()) #$@(if use-substitutes? '("--use-substitutes") '()) #$@(if one-shot? '("--one-shot") '()) @@ -162,7 +181,7 @@ ,(shepherd-service (documentation "Run Cuirass web interface.") (provision '(cuirass-web)) - (requirement '(guix-daemon postgres networking)) + (requirement '(cuirass)) (start #~(make-forkexec-constructor (list (string-append #$cuirass "/bin/cuirass") "--cache-directory" #$cache-directory @@ -171,13 +190,13 @@ "--port" #$(number->string port) "--listen" #$host "--interval" #$(number->string interval) - #$@(if use-substitutes? '("--use-substitutes") '()) - #$@(if fallback? '("--fallback") '()) - #$@(if zabbix-uri + #$@(if parameters (list (string-append - "--zabbix-uri=" - zabbix-uri)) + "--parameters=" + parameters)) '()) + #$@(if use-substitutes? '("--use-substitutes") '()) + #$@(if fallback? '("--fallback") '()) #$@extra-options) #:user #$user @@ -192,7 +211,7 @@ (shepherd-service (documentation "Run Cuirass remote build server.") (provision '(cuirass-remote-server)) - (requirement '(avahi-daemon cuirass guix-daemon networking)) + (requirement '(avahi-daemon cuirass)) (start #~(make-forkexec-constructor (list (string-append #$cuirass "/bin/remote-server") (string-append "--database=" #$database) @@ -208,6 +227,11 @@ "--publish-port=" (number->string publish-port))) '()) + #$@(if parameters + (list (string-append + "--parameters=" + parameters)) + '()) #$@(if trigger-url (list (string-append @@ -299,6 +323,8 @@ (service-extension activation-service-type cuirass-activation) (service-extension shepherd-root-service-type cuirass-shepherd-service) (service-extension account-service-type cuirass-account) + ;; Make sure postgresql and postgresql-role are instantiated. + (service-extension postgresql-service-type (const #t)) (service-extension postgresql-role-service-type cuirass-postgresql-role))) (description @@ -311,6 +337,8 @@ (default cuirass)) (workers cuirass-remote-worker-workers ;int (default 1)) + (server cuirass-remote-worker-server ;string + (default #f)) (systems cuirass-remote-worker-systems ;list (default (list (%current-system)))) (log-file cuirass-remote-worker-log-file ;string @@ -326,7 +354,8 @@ "Return a <shepherd-service> for the Cuirass remote worker service with CONFIG." (match-record config <cuirass-remote-worker-configuration> - (cuirass workers systems log-file publish-port public-key private-key) + (cuirass workers server systems log-file publish-port + public-key private-key) (list (shepherd-service (documentation "Run Cuirass remote build worker.") (provision '(cuirass-remote-worker)) @@ -335,6 +364,9 @@ CONFIG." (list (string-append #$cuirass "/bin/remote-worker") (string-append "--workers=" #$(number->string workers)) + #$@(if server + (list (string-append "--server=" server)) + '()) #$@(if systems (list (string-append "--systems=" @@ -367,3 +399,73 @@ CONFIG." cuirass-remote-worker-shepherd-service))) (description "Run the Cuirass remote build worker service."))) + +(define-record-type* <build-manifest> + build-manifest make-build-manifest + build-manifest? + (channel-name build-manifest-channel-name) ;symbol + (manifest build-manifest-manifest)) ;string + +(define-record-type* <simple-cuirass-configuration> + simple-cuirass-configuration make-simple-cuirass-configuration + simple-cuirass-configuration? + (build simple-cuirass-configuration-build + (default 'all)) ;symbol or list of <build-manifest> + (channels simple-cuirass-configuration-channels + (default %default-channels)) ;list of <channel> + (non-package-channels simple-cuirass-configuration-package-channels + (default '())) ;list of channels name + (systems simple-cuirass-configuration-systems + (default (list (%current-system))))) ;list of strings + +(define* (simple-cuirass-configuration->specs config) + (define (format-name name) + (if (string? name) + name + (symbol->string name))) + + (define (format-manifests build-manifests) + (map (lambda (build-manifest) + (match-record build-manifest <build-manifest> + (channel-name manifest) + (cons (format-name channel-name) manifest))) + build-manifests)) + + (define (channel->input channel) + (let ((name (channel-name channel)) + (url (channel-url channel)) + (branch (channel-branch channel))) + `((#:name . ,(format-name name)) + (#:url . ,url) + (#:load-path . ".") + (#:branch . ,branch) + (#:no-compile? #t)))) + + (define (package-path channels non-package-channels) + (filter-map (lambda (channel) + (let ((name (channel-name channel))) + (and (not (member name non-package-channels)) + (not (eq? name 'guix)) + (format-name name)))) + channels)) + + (define (config->spec config) + (match-record config <simple-cuirass-configuration> + (build channels non-package-channels systems) + `((#:name . "simple-config") + (#:load-path-inputs . ("guix")) + (#:package-path-inputs . ,(package-path channels + non-package-channels)) + (#:proc-input . "guix") + (#:proc-file . "build-aux/cuirass/gnu-system.scm") + (#:proc . cuirass-jobs) + (#:proc-args . ((systems . ,systems) + ,@(if (eq? build 'all) + '() + `((subset . "manifests") + (manifests . ,(format-manifests build)))))) + (#:inputs . ,(map channel->input channels)) + (#:build-outputs . ()) + (#:priority . 1)))) + + #~(list '#$(config->spec config))) diff --git a/gnu/services/databases.scm b/gnu/services/databases.scm index d908b86af8..979f3dd6c8 100644 --- a/gnu/services/databases.scm +++ b/gnu/services/databases.scm @@ -331,7 +331,9 @@ host all all ::1/128 md5")) (const %postgresql-accounts)) (service-extension profile-service-type - (compose list postgresql-configuration-postgresql)))))) + (compose list postgresql-configuration-postgresql)))) + (default-value (postgresql-configuration + (postgresql postgresql-10))))) (define-deprecated (postgresql-service #:key (postgresql postgresql) (port 5432) @@ -408,13 +410,8 @@ rolname = '" ,name "')) as not_exists;\n" (let ((host (postgresql-role-configuration-host config)) (roles (postgresql-role-configuration-roles config))) - (program-file - "postgresql-create-roles" - #~(begin - (let ((psql #$(file-append postgresql "/bin/psql"))) - (execl psql psql "-a" - "-h" #$host - "-f" #$(roles->queries roles))))))) + #~(let ((psql #$(file-append postgresql "/bin/psql"))) + (list psql "-a" "-h" #$host "-f" #$(roles->queries roles))))) (define (postgresql-role-shepherd-service config) (match-record config <postgresql-role-configuration> @@ -423,10 +420,14 @@ rolname = '" ,name "')) as not_exists;\n" (requirement '(postgres)) (provision '(postgres-roles)) (one-shot? #t) - (start #~(make-forkexec-constructor - (list #$(postgresql-create-roles config)) - #:user "postgres" #:group "postgres" - #:log-file #$log)) + (start + #~(lambda args + (let ((pid (fork+exec-command + #$(postgresql-create-roles config) + #:user "postgres" + #:group "postgres" + #:log-file #$log))) + (zero? (cdr (waitpid pid)))))) (documentation "Create PostgreSQL roles."))))) (define postgresql-role-service-type diff --git a/gnu/services/file-sharing.scm b/gnu/services/file-sharing.scm new file mode 100644 index 0000000000..72cd6478d6 --- /dev/null +++ b/gnu/services/file-sharing.scm @@ -0,0 +1,804 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2020 Simon South <simon@simonsouth.net> +;;; +;;; 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 <http://www.gnu.org/licenses/>. + +(define-module (gnu services file-sharing) + #:use-module (gcrypt base16) + #:use-module (gcrypt hash) + #:use-module (gcrypt random) + #:use-module (gnu services) + #:use-module (gnu services admin) + #:use-module (gnu services configuration) + #:use-module (gnu services shepherd) + #:use-module (gnu packages admin) + #:use-module (gnu packages bittorrent) + #:use-module (gnu packages gnupg) + #:use-module (gnu packages guile) + #:use-module (gnu system shadow) + #:use-module (guix diagnostics) + #:use-module (guix gexp) + #:use-module (guix i18n) + #:use-module (guix modules) + #:use-module (guix packages) + #:use-module (guix records) + #:use-module (ice-9 format) + #:use-module (ice-9 match) + #:use-module (rnrs bytevectors) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-34) + #:use-module (srfi srfi-35) + #:export (transmission-daemon-configuration + transmission-daemon-service-type + transmission-password-hash + transmission-random-salt)) + +;;; +;;; Transmission Daemon. +;;; + +(define %transmission-daemon-user "transmission") +(define %transmission-daemon-group "transmission") + +(define %transmission-daemon-configuration-directory + "/var/lib/transmission-daemon") +(define %transmission-daemon-log-file + "/var/log/transmission.log") + +(define %transmission-salt-length 8) + +(define (transmission-password-hash password salt) + "Returns a string containing the result of hashing @var{password} together +with @var{salt}, in the format recognized by Transmission clients for their +@code{rpc-password} configuration setting. + +@var{salt} must be an eight-character string. The +@code{transmission-random-salt} procedure can be used to generate a suitable +salt value at random." + (if (not (and (string? salt) + (eq? (string-length salt) %transmission-salt-length))) + (raise (formatted-message + (G_ "salt value must be a string of ~d characters") + %transmission-salt-length)) + (string-append "{" + (bytevector->base16-string + (sha1 (string->utf8 (string-append password salt)))) + salt))) + +(define (transmission-random-salt) + "Returns a string containing a random, eight-character salt value of the +type generated and used by Transmission clients, suitable for passing to the +@code{transmission-password-hash} procedure." + ;; This implementation matches a portion of Transmission's tr_ssha1 + ;; function. See libtransmission/crypto-utils.c in the Transmission source + ;; distribution. + (let ((salter (string-append "0123456789" + "abcdefghijklmnopqrstuvwxyz" + "ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "./"))) + (list->string + (map (lambda (u8) + (string-ref salter (modulo u8 (string-length salter)))) + (bytevector->u8-list + (gen-random-bv %transmission-salt-length %gcry-strong-random)))))) + +(define (uglify-field-name field-name) + (string-delete #\? (symbol->string field-name))) + +(define (serialize-field field-name val) + ;; "Serialize" each configuration field as a G-expression containing a + ;; name-value pair, the collection of which will subsequently be serialized + ;; to disk as a JSON object. + #~(#$(uglify-field-name field-name) . #$val)) + +(define serialize-boolean serialize-field) +(define serialize-integer serialize-field) +(define serialize-rational serialize-field) + +(define serialize-string serialize-field) +(define-maybe string) +;; Override the definition of "serialize-maybe-string", as we need to output a +;; name-value pair for the JSON builder. +(set! serialize-maybe-string + (lambda (field-name val) + (serialize-string field-name + (if (and (symbol? val) + (eq? val 'disabled)) + "" + val)))) + +(define (string-list? val) + (and (list? val) + (and-map (lambda (x) + (and (string? x) + (not (string-index x #\,)))) + val))) +(define (serialize-string-list field-name val) + (serialize-field field-name (string-join val ","))) + +(define days + '((sunday . #b0000001) + (monday . #b0000010) + (tuesday . #b0000100) + (wednesday . #b0001000) + (thursday . #b0010000) + (friday . #b0100000) + (saturday . #b1000000))) +(define day-lists + (list (cons 'weekdays '(monday tuesday wednesday thursday friday)) + (cons 'weekends '(saturday sunday)) + (cons 'all (map car days)))) +(define (day-list? val) + (or (and (symbol? val) + (assq val day-lists)) + (and (list? val) + (and-map (lambda (x) + (and (symbol? x) + (assq x days))) + val)))) +(define (serialize-day-list field-name val) + (serialize-integer field-name + (reduce logior + #b0000000 + (map (lambda (day) + (assq-ref days day)) + (if (symbol? val) + (assq-ref day-lists val) + val))))) + +(define encryption-modes + '((prefer-unencrypted-connections . 0) + (prefer-encrypted-connections . 1) + (require-encrypted-connections . 2))) +(define (encryption-mode? val) + (and (symbol? val) + (assq val encryption-modes))) +(define (serialize-encryption-mode field-name val) + (serialize-integer field-name (assq-ref encryption-modes val))) + +(define serialize-file-like serialize-field) + +(define (file-object? val) + (or (string? val) + (file-like? val))) +(define (serialize-file-object field-name val) + (if (file-like? val) + (serialize-file-like field-name val) + (serialize-string field-name val))) +(define-maybe file-object) +(set! serialize-maybe-file-object + (lambda (field-name val) + (if (and (symbol? val) + (eq? val 'disabled)) + (serialize-string field-name "") + (serialize-file-object field-name val)))) + +(define (file-object-list? val) + (and (list? val) + (and-map file-object? val))) +(define serialize-file-object-list serialize-field) + +(define message-levels + '((none . 0) + (error . 1) + (info . 2) + (debug . 3))) +(define (message-level? val) + (and (symbol? val) + (assq val message-levels))) +(define (serialize-message-level field-name val) + (serialize-integer field-name (assq-ref message-levels val))) + +(define (non-negative-integer? val) + (and (integer? val) + (not (negative? val)))) +(define serialize-non-negative-integer serialize-integer) + +(define (non-negative-rational? val) + (and (rational? val) + (not (negative? val)))) +(define serialize-non-negative-rational serialize-rational) + +(define (port-number? val) + (and (integer? val) + (>= val 1) + (<= val 65535))) +(define serialize-port-number serialize-integer) + +(define preallocation-modes + '((none . 0) + (fast . 1) + (sparse . 1) + (full . 2))) +(define (preallocation-mode? val) + (and (symbol? val) + (assq val preallocation-modes))) +(define (serialize-preallocation-mode field-name val) + (serialize-integer field-name (assq-ref preallocation-modes val))) + +(define tcp-types-of-service + '((default . "default") + (low-cost . "lowcost") + (throughput . "throughput") + (low-delay . "lowdelay") + (reliability . "reliability"))) +(define (tcp-type-of-service? val) + (and (symbol? val) + (assq val tcp-types-of-service))) +(define (serialize-tcp-type-of-service field-name val) + (serialize-string field-name (assq-ref tcp-types-of-service val))) + +(define (transmission-password-hash? val) + (and (string? val) + (= (string-length val) 49) + (eqv? (string-ref val 0) #\{) + (string-every char-set:hex-digit val 1 41))) +(define serialize-transmission-password-hash serialize-string) +(define-maybe transmission-password-hash) +(set! serialize-maybe-transmission-password-hash serialize-maybe-string) + +(define (umask? val) + (and (integer? val) + (>= val #o000) + (<= val #o777))) +(define serialize-umask serialize-integer) ; must use decimal representation + +(define-configuration transmission-daemon-configuration + ;; Settings internal to this service definition. + (transmission + (package transmission) + "The Transmission package to use.") + (stop-wait-period + (non-negative-integer 10) + "The period, in seconds, to wait when stopping the service for +@command{transmission-daemon} to exit before killing its process. This allows +the daemon time to complete its housekeeping and send a final update to +trackers as it shuts down. On slow hosts, or hosts with a slow network +connection, this value may need to be increased.") + + ;; Files and directories. + (download-dir + (string (string-append %transmission-daemon-configuration-directory + "/downloads")) + "The directory to which torrent files are downloaded.") + (incomplete-dir-enabled? + (boolean #f) + "If @code{#t}, files will be held in @code{incomplete-dir} while their +torrent is being downloaded, then moved to @code{download-dir} once the +torrent is complete. Otherwise, files for all torrents (including those still +being downloaded) will be placed in @code{download-dir}.") + (incomplete-dir + (maybe-string 'disabled) + "The directory in which files from incompletely downloaded torrents will be +held when @code{incomplete-dir-enabled?} is @code{#t}.") + (umask + (umask #o022) + "The file mode creation mask used for downloaded files. (See the +@command{umask} man page for more information.)") + (rename-partial-files? + (boolean #t) + "When @code{#t}, ``.part'' is appended to the name of partially downloaded +files.") + (preallocation + (preallocation-mode 'fast) + "The mode by which space should be preallocated for downloaded files, one +of @code{none}, @code{fast} (or @code{sparse}) and @code{full}. Specifying +@code{full} will minimize disk fragmentation at a cost to file-creation +speed.") + (watch-dir-enabled? + (boolean #f) + "If @code{#t}, the directory specified by @code{watch-dir} will be watched +for new @file{.torrent} files and the torrents they describe added +automatically (and the original files removed, if +@code{trash-original-torrent-files?} is @code{#t}).") + (watch-dir + (maybe-string 'disabled) + "The directory to be watched for @file{.torrent} files indicating new +torrents to be added, when @code{watch-dir-enabled} is @code{#t}.") + (trash-original-torrent-files? + (boolean #f) + "When @code{#t}, @file{.torrent} files will be deleted from the watch +directory once their torrent has been added (see +@code{watch-directory-enabled?}).") + + ;; Bandwidth limits. + (speed-limit-down-enabled? + (boolean #f) + "When @code{#t}, the daemon's download speed will be limited to the rate +specified by @code{speed-limit-down}.") + (speed-limit-down + (non-negative-integer 100) + "The default global-maximum download speed, in kilobytes per second.") + (speed-limit-up-enabled? + (boolean #f) + "When @code{#t}, the daemon's upload speed will be limited to the rate +specified by @code{speed-limit-up}.") + (speed-limit-up + (non-negative-integer 100) + "The default global-maximum upload speed, in kilobytes per second.") + (alt-speed-enabled? + (boolean #f) + "When @code{#t}, the alternate speed limits @code{alt-speed-down} and +@code{alt-speed-up} are used (in place of @code{speed-limit-down} and +@code{speed-limit-up}, if they are enabled) to constrain the daemon's +bandwidth usage. This can be scheduled to occur automatically at certain +times during the week; see @code{alt-speed-time-enabled?}.") + (alt-speed-down + (non-negative-integer 50) + "The alternate global-maximum download speed, in kilobytes per second.") + (alt-speed-up + (non-negative-integer 50) + "The alternate global-maximum upload speed, in kilobytes per second.") + + ;; Bandwidth-limit scheduling. + (alt-speed-time-enabled? + (boolean #f) + "When @code{#t}, the alternate speed limits @code{alt-speed-down} and +@code{alt-speed-up} will be enabled automatically during the periods specified +by @code{alt-speed-time-day}, @code{alt-speed-time-begin} and +@code{alt-time-speed-end}.") + (alt-speed-time-day + (day-list 'all) + "The days of the week on which the alternate-speed schedule should be used, +specified either as a list of days (@code{sunday}, @code{monday}, and so on) +or using one of the symbols @code{weekdays}, @code{weekends} or @code{all}.") + (alt-speed-time-begin + (non-negative-integer 540) + "The time of day at which to enable the alternate speed limits, +expressed as a number of minutes since midnight.") + (alt-speed-time-end + (non-negative-integer 1020) + "The time of day at which to disable the alternate speed limits, +expressed as a number of minutes since midnight.") + + ;; Peer networking. + (bind-address-ipv4 + (string "0.0.0.0") + "The IP address at which to listen for peer connections, or ``0.0.0.0'' to +listen at all available IP addresses.") + (bind-address-ipv6 + (string "::") + "The IPv6 address at which to listen for peer connections, or ``::'' to +listen at all available IPv6 addresses.") + (peer-port-random-on-start? + (boolean #f) + "If @code{#t}, when the daemon starts it will select a port at random on +which to listen for peer connections, from the range specified (inclusively) +by @code{peer-port-random-low} and @code{peer-port-random-high}. Otherwise, +it listens on the port specified by @code{peer-port}.") + (peer-port-random-low + (port-number 49152) + "The lowest selectable port number when @code{peer-port-random-on-start?} +is @code{#t}.") + (peer-port-random-high + (port-number 65535) + "The highest selectable port number when @code{peer-port-random-on-start} +is @code{#t}.") + (peer-port + (port-number 51413) + "The port on which to listen for peer connections when +@code{peer-port-random-on-start?} is @code{#f}.") + (port-forwarding-enabled? + (boolean #t) + "If @code{#t}, the daemon will attempt to configure port-forwarding on an +upstream gateway automatically using @acronym{UPnP} and @acronym{NAT-PMP}.") + (encryption + (encryption-mode 'prefer-encrypted-connections) + "The encryption preference for peer connections, one of +@code{prefer-unencrypted-connections}, @code{prefer-encrypted-connections} or +@code{require-encrypted-connections}.") + (peer-congestion-algorithm + (maybe-string 'disabled) + "The TCP congestion-control algorithm to use for peer connections, +specified using a string recognized by the operating system in calls to +@code{setsockopt} (or set to @code{disabled}, in which case the +operating-system default is used). + +Note that on GNU/Linux systems, the kernel must be configured to allow +processes to use a congestion-control algorithm not in the default set; +otherwise, it will deny these requests with ``Operation not permitted''. To +see which algorithms are available on your system and which are currently +permitted for use, look at the contents of the files +@file{tcp_available_congestion_control} and +@file{tcp_allowed_congestion_control} in the @file{/proc/sys/net/ipv4} +directory. + +As an example, to have Transmission Daemon use +@uref{http://www-ece.rice.edu/networks/TCP-LP/, the TCP Low Priority +congestion-control algorithm}, you'll need to modify your kernel configuration +to build in support for the algorithm, then update your operating-system +configuration to allow its use by adding a @code{sysctl-service-type} +service (or updating the existing one's configuration) with lines like the +following: + +@lisp +(service sysctl-service-type + (sysctl-configuration + (settings + (\"net.ipv4.tcp_allowed_congestion_control\" . + \"reno cubic lp\")))) +@end lisp + +The Transmission Daemon configuration can then be updated with + +@lisp +(peer-congestion-algorithm \"lp\") +@end lisp + +and the system reconfigured to have the changes take effect.") + (peer-socket-tos + (tcp-type-of-service 'default) + "The type of service to request in outgoing @acronym{TCP} packets, +one of @code{default}, @code{low-cost}, @code{throughput}, @code{low-delay} +and @code{reliability}.") + (peer-limit-global + (non-negative-integer 200) + "The global limit on the number of connected peers.") + (peer-limit-per-torrent + (non-negative-integer 50) + "The per-torrent limit on the number of connected peers.") + (upload-slots-per-torrent + (non-negative-integer 14) + "The maximum number of peers to which the daemon will upload data +simultaneously for each torrent.") + (peer-id-ttl-hours + (non-negative-integer 6) + "The maximum lifespan, in hours, of the peer ID associated with each public +torrent before it is regenerated.") + + ;; Peer blocklists. + (blocklist-enabled? + (boolean #f) + "When @code{#t}, the daemon will ignore peers mentioned in the blocklist it +has most recently downloaded from @code{blocklist-url}.") + (blocklist-url + (maybe-string 'disabled) + "The URL of a peer blocklist (in @acronym{P2P}-plaintext or eMule +@file{.dat} format) to be periodically downloaded and applied when +@code{blocklist-enabled?} is @code{#t}.") + + ;; Queueing. + (download-queue-enabled? + (boolean #t) + "If @code{#t}, the daemon will be limited to downloading at most +@code{download-queue-size} non-stalled torrents simultaneously.") + (download-queue-size + (non-negative-integer 5) + "The size of the daemon's download queue, which limits the number of +non-stalled torrents it will download at any one time when +@code{download-queue-enabled?} is @code{#t}.") + (seed-queue-enabled? + (boolean #f) + "If @code{#t}, the daemon will be limited to seeding at most +@code{seed-queue-size} non-stalled torrents simultaneously.") + (seed-queue-size + (non-negative-integer 10) + "The size of the daemon's seed queue, which limits the number of +non-stalled torrents it will seed at any one time when +@code{seed-queue-enabled?} is @code{#t}.") + (queue-stalled-enabled? + (boolean #t) + "When @code{#t}, the daemon will consider torrents for which it has not +shared data in the past @code{queue-stalled-minutes} minutes to be stalled and +not count them against its @code{download-queue-size} and +@code{seed-queue-size} limits.") + (queue-stalled-minutes + (non-negative-integer 30) + "The maximum period, in minutes, a torrent may be idle before it is +considered to be stalled, when @code{queue-stalled-enabled?} is @code{#t}.") + + ;; Seeding limits. + (ratio-limit-enabled? + (boolean #f) + "When @code{#t}, a torrent being seeded will automatically be paused once +it reaches the ratio specified by @code{ratio-limit}.") + (ratio-limit + (non-negative-rational 2.0) + "The ratio at which a torrent being seeded will be paused, when +@code{ratio-limit-enabled?} is @code{#t}.") + (idle-seeding-limit-enabled? + (boolean #f) + "When @code{#t}, a torrent being seeded will automatically be paused once +it has been idle for @code{idle-seeding-limit} minutes.") + (idle-seeding-limit + (non-negative-integer 30) + "The maximum period, in minutes, a torrent being seeded may be idle before +it is paused, when @code{idle-seeding-limit-enabled?} is @code{#t}.") + + ;; BitTorrent extensions. + (dht-enabled? + (boolean #t) + "Enable @uref{http://bittorrent.org/beps/bep_0005.html, the distributed +hash table (@acronym{DHT}) protocol}, which supports the use of trackerless +torrents.") + (lpd-enabled? + (boolean #f) + "Enable @url{https://en.wikipedia.org/wiki/Local_Peer_Discovery, local peer +discovery} (@acronym{LPD}), which allows the discovery of peers on the local +network and may reduce the amount of data sent over the public Internet.") + (pex-enabled? + (boolean #t) + "Enable @url{https://en.wikipedia.org/wiki/Peer_exchange, peer +exchange} (@acronym{PEX}), which reduces the daemon's reliance on external +trackers and may improve its performance.") + (utp-enabled? + (boolean #t) + "Enable @url{http://bittorrent.org/beps/bep_0029.html, the micro transport +protocol} (@acronym{uTP}), which aims to reduce the impact of BitTorrent +traffic on other users of the local network while maintaining full utilization +of the available bandwidth.") + + ;; Remote procedure call (RPC) interface. + (rpc-enabled? + (boolean #t) + "If @code{#t}, enable the remote procedure call (@acronym{RPC}) interface, +which allows remote control of the daemon via its Web interface, the +@command{transmission-remote} command-line client, and similar tools.") + (rpc-bind-address + (string "0.0.0.0") + "The IP address at which to listen for @acronym{RPC} connections, or +``0.0.0.0'' to listen at all available IP addresses.") + (rpc-port + (port-number 9091) + "The port on which to listen for @acronym{RPC} connections.") + (rpc-url + (string "/transmission/") + "The path prefix to use in the @acronym{RPC}-endpoint @acronym{URL}.") + (rpc-authentication-required? + (boolean #f) + "When @code{#t}, clients must authenticate (see @code{rpc-username} and +@code{rpc-password}) when using the @acronym{RPC} interface. Note this has +the side effect of disabling host-name whitelisting (see +@code{rpc-host-whitelist-enabled?}.") + (rpc-username + (maybe-string 'disabled) + "The username required by clients to access the @acronym{RPC} interface +when @code{rpc-authentication-required?} is @code{#t}.") + (rpc-password + (maybe-transmission-password-hash 'disabled) + "The password required by clients to access the @acronym{RPC} interface +when @code{rpc-authentication-required?} is @code{#t}. This must be specified +using a password hash in the format recognized by Transmission clients, either +copied from an existing @file{settings.json} file or generated using the +@code{transmission-password-hash} procedure.") + (rpc-whitelist-enabled? + (boolean #t) + "When @code{#t}, @acronym{RPC} requests will be accepted only when they +originate from an address specified in @code{rpc-whitelist}.") + (rpc-whitelist + (string-list '("127.0.0.1" "::1")) + "The list of IP and IPv6 addresses from which @acronym{RPC} requests will +be accepted when @code{rpc-whitelist-enabled?} is @code{#t}. Wildcards may be +specified using @samp{*}.") + (rpc-host-whitelist-enabled? + (boolean #t) + "When @code{#t}, @acronym{RPC} requests will be accepted only when they are +addressed to a host named in @code{rpc-host-whitelist}. Note that requests to +``localhost'' or ``localhost.'', or to a numeric address, are always accepted +regardless of these settings. + +Note also this functionality is disabled when +@code{rpc-authentication-required?} is @code{#t}.") + (rpc-host-whitelist + (string-list '()) + "The list of host names recognized by the @acronym{RPC} server when +@code{rpc-host-whitelist-enabled?} is @code{#t}.") + + ;; Miscellaneous. + (message-level + (message-level 'info) + "The minimum severity level of messages to be logged (to +@file{/var/log/transmission.log}) by the daemon, one of @code{none} (no +logging), @code{error}, @code{info} and @code{debug}.") + (start-added-torrents? + (boolean #t) + "When @code{#t}, torrents are started as soon as they are added; otherwise, +they are added in ``paused'' state.") + (script-torrent-done-enabled? + (boolean #f) + "When @code{#t}, the script specified by +@code{script-torrent-done-filename} will be invoked each time a torrent +completes.") + (script-torrent-done-filename + (maybe-file-object 'disabled) + "A file name or file-like object specifying a script to run each time a +torrent completes, when @code{script-torrent-done-enabled?} is @code{#t}.") + (scrape-paused-torrents-enabled? + (boolean #t) + "When @code{#t}, the daemon will scrape trackers for a torrent even when +the torrent is paused.") + (cache-size-mb + (non-negative-integer 4) + "The amount of memory, in megabytes, to allocate for the daemon's in-memory +cache. A larger value may increase performance by reducing the frequency of +disk I/O.") + (prefetch-enabled? + (boolean #t) + "When @code{#t}, the daemon will try to improve I/O performance by hinting +to the operating system which data is likely to be read next from disk to +satisfy requests from peers.")) + +(define (transmission-daemon-shepherd-service config) + "Return a <shepherd-service> for Transmission Daemon with CONFIG." + (let ((transmission + (transmission-daemon-configuration-transmission config)) + (stop-wait-period + (transmission-daemon-configuration-stop-wait-period config))) + (list + (shepherd-service + (provision '(transmission-daemon transmission bittorrent)) + (requirement '(networking)) + (documentation "Share files using the BitTorrent protocol.") + (start #~(make-forkexec-constructor + '(#$(file-append transmission "/bin/transmission-daemon") + "--config-dir" + #$%transmission-daemon-configuration-directory + "--foreground") + #:user #$%transmission-daemon-user + #:group #$%transmission-daemon-group + #:directory #$%transmission-daemon-configuration-directory + #:log-file #$%transmission-daemon-log-file + #:environment-variables + '("CURL_CA_BUNDLE=/etc/ssl/certs/ca-certificates.crt"))) + (stop #~(lambda (pid) + (kill pid SIGTERM) + + ;; Transmission Daemon normally needs some time to shut down, + ;; as it will complete some housekeeping and send a final + ;; update to trackers before it exits. + ;; + ;; Wait a reasonable period for it to stop before continuing. + ;; If we don't do this, restarting the service can fail as the + ;; new daemon process finds the old one still running and + ;; attached to the port used for peer connections. + (let wait-before-killing ((period #$stop-wait-period)) + (if (zero? (car (waitpid pid WNOHANG))) + (if (positive? period) + (begin + (sleep 1) + (wait-before-killing (- period 1))) + (begin + (format #t + #$(G_ "Wait period expired; killing \ +transmission-daemon (pid ~a).~%") + pid) + (display #$(G_ "(If you see this message \ +regularly, you may need to increase the value +of 'stop-wait-period' in the service configuration.)\n")) + (kill pid SIGKILL))))) + #f)) + (actions + (list + (shepherd-action + (name 'reload) + (documentation "Reload the settings file from disk.") + (procedure #~(lambda (pid) + (if pid + (begin + (kill pid SIGHUP) + (display #$(G_ "Service transmission-daemon has \ +been asked to reload its settings file."))) + (display #$(G_ "Service transmission-daemon is not \ +running.")))))))))))) + +(define %transmission-daemon-accounts + (list (user-group + (name %transmission-daemon-group) + (system? #t)) + (user-account + (name %transmission-daemon-user) + (group %transmission-daemon-group) + (comment "Transmission Daemon service account") + (home-directory %transmission-daemon-configuration-directory) + (shell (file-append shadow "/sbin/nologin")) + (system? #t)))) + +(define %transmission-daemon-log-rotations + (list (log-rotation + (files (list %transmission-daemon-log-file))))) + +(define (transmission-daemon-computed-settings-file config) + "Return a @code{computed-file} object that, when unquoted in a G-expression, +produces a Transmission settings file (@file{settings.json}) matching CONFIG." + (let ((settings + ;; "Serialize" the configuration settings as a list of G-expressions + ;; containing a name-value pair, which will ultimately be sorted and + ;; serialized to the settings file as a JSON object. + (map + (lambda (field) + ((configuration-field-serializer field) + (configuration-field-name field) + ((configuration-field-getter field) config))) + (filter + (lambda (field) + ;; Omit configuration fields that are used only internally by + ;; this service definition. + (not (memq (configuration-field-name field) + '(transmission stop-wait-period)))) + transmission-daemon-configuration-fields)))) + (computed-file + "settings.json" + (with-extensions (list guile-gcrypt guile-json-4) + (with-imported-modules (source-module-closure '((json builder))) + #~(begin + (use-modules (json builder)) + + (with-output-to-file #$output + (lambda () + (scm->json (sort-list '(#$@settings) + (lambda (x y) + (string<=? (car x) (car y)))) + #:pretty #t))))))))) + +(define (transmission-daemon-activation config) + "Return the Transmission Daemon activation GEXP for CONFIG." + (let ((config-dir %transmission-daemon-configuration-directory) + (incomplete-dir-enabled + (transmission-daemon-configuration-incomplete-dir-enabled? config)) + (incomplete-dir + (transmission-daemon-configuration-incomplete-dir config)) + (watch-dir-enabled + (transmission-daemon-configuration-watch-dir-enabled? config)) + (watch-dir + (transmission-daemon-configuration-watch-dir config))) + (with-imported-modules (source-module-closure '((guix build utils))) + #~(begin + (use-modules (guix build utils)) + + (let ((owner (getpwnam #$%transmission-daemon-user))) + (define (mkdir-p/perms directory perms) + (mkdir-p directory) + (chown directory (passwd:uid owner) (passwd:gid owner)) + (chmod directory perms)) + + ;; Create the directories Transmission Daemon is configured to use + ;; and assign them suitable permissions. + (for-each (lambda (directory-specification) + (apply mkdir-p/perms directory-specification)) + '(#$@(append + `((,config-dir #o750)) + (if incomplete-dir-enabled + `((,incomplete-dir #o750)) + '()) + (if watch-dir-enabled + `((,watch-dir #o770)) + '()))))) + + ;; Generate and activate the daemon's settings file, settings.json. + (activate-special-files + '((#$(string-append config-dir "/settings.json") + #$(transmission-daemon-computed-settings-file config)))))))) + +(define transmission-daemon-service-type + (service-type + (name 'transmission) + (extensions + (list (service-extension shepherd-root-service-type + transmission-daemon-shepherd-service) + (service-extension account-service-type + (const %transmission-daemon-accounts)) + (service-extension rottlog-service-type + (const %transmission-daemon-log-rotations)) + (service-extension activation-service-type + transmission-daemon-activation))) + (default-value (transmission-daemon-configuration)) + (description "Share files using the BitTorrent protocol."))) + +(define (generate-transmission-daemon-documentation) + (generate-documentation + `((transmission-daemon-configuration + ,transmission-daemon-configuration-fields)) + 'transmission-daemon-configuration)) diff --git a/gnu/services/guix.scm b/gnu/services/guix.scm index 88d23f746a..d1d31febdc 100644 --- a/gnu/services/guix.scm +++ b/gnu/services/guix.scm @@ -55,14 +55,32 @@ guix-build-coordinator-agent-configuration-package guix-build-coordinator-agent-configuration-user guix-build-coordinator-agent-configuration-coordinator - guix-build-coordinator-agent-configuration-uuid - guix-build-coordinator-agent-configuration-password - guix-build-coordinator-agent-configuration-password-file + guix-build-coordinator-agent-configuration-authentication guix-build-coordinator-agent-configuration-systems guix-build-coordinator-agent-configuration-max-parallel-builds guix-build-coordinator-agent-configuration-derivation-substitute-urls guix-build-coordinator-agent-configuration-non-derivation-substitute-urls + guix-build-coordinator-agent-password-auth + guix-build-coordinator-agent-password-auth? + guix-build-coordinator-agent-password-auth-uuid + guix-build-coordinator-agent-password-auth-password + + guix-build-coordinator-agent-password-file-auth + guix-build-coordinator-agent-password-file-auth? + guix-build-coordinator-agent-password-file-auth-uuid + guix-build-coordinator-agent-password-file-auth-password-file + + guix-build-coordinator-agent-dynamic-auth + guix-build-coordinator-agent-dynamic-auth? + guix-build-coordinator-agent-dynamic-auth-agent-name + guix-build-coordinator-agent-dynamic-auth-token + + guix-build-coordinator-agent-dynamic-auth-with-file + guix-build-coordinator-agent-dynamic-auth-with-file? + guix-build-coordinator-agent-dynamic-auth-with-file-agent-name + guix-build-coordinator-agent-dynamic-auth-with-file-token-file + guix-build-coordinator-agent-service-type guix-build-coordinator-queue-builds-configuration @@ -132,11 +150,7 @@ (default "guix-build-coordinator-agent")) (coordinator guix-build-coordinator-agent-configuration-coordinator (default "http://localhost:8745")) - (uuid guix-build-coordinator-agent-configuration-uuid) - (password guix-build-coordinator-agent-configuration-password - (default #f)) - (password-file guix-build-coordinator-agent-configuration-password-file - (default #f)) + (authentication guix-build-coordinator-agent-configuration-authentication) (systems guix-build-coordinator-agent-configuration-systems (default #f)) (max-parallel-builds @@ -149,6 +163,35 @@ guix-build-coordinator-agent-configuration-non-derivation-substitute-urls (default #f))) +(define-record-type* <guix-build-coordinator-agent-password-auth> + guix-build-coordinator-agent-password-auth + make-guix-build-coordinator-agent-password-auth + guix-build-coordinator-agent-password-auth? + (uuid guix-build-coordinator-agent-password-auth-uuid) + (password guix-build-coordinator-agent-password-auth-password)) + +(define-record-type* <guix-build-coordinator-agent-password-file-auth> + guix-build-coordinator-agent-password-file-auth + make-guix-build-coordinator-agent-password-file-auth + guix-build-coordinator-agent-password-file-auth? + (uuid guix-build-coordinator-agent-password-file-auth-uuid) + (password-file + guix-build-coordinator-agent-password-file-auth-password-file)) + +(define-record-type* <guix-build-coordinator-agent-dynamic-auth> + guix-build-coordinator-agent-dynamic-auth + make-guix-build-coordinator-agent-dynamic-auth + guix-build-coordinator-agent-dynamic-auth? + (agent-name guix-build-coordinator-agent-dynamic-auth-agent-name) + (token guix-build-coordinator-agent-dynamic-auth-token)) + +(define-record-type* <guix-build-coordinator-agent-dynamic-auth-with-file> + guix-build-coordinator-agent-dynamic-auth-with-file + make-guix-build-coordinator-agent-dynamic-auth-with-file + guix-build-coordinator-agent-dynamic-auth-with-file? + (agent-name guix-build-coordinator-agent-dynamic-auth-with-file-agent-name) + (token-file guix-build-coordinator-agent-dynamic-auth-with-file-token-file)) + (define-record-type* <guix-build-coordinator-queue-builds-configuration> guix-build-coordinator-queue-builds-configuration make-guix-build-coordinator-queue-builds-configuration @@ -326,7 +369,7 @@ (define (guix-build-coordinator-agent-shepherd-services config) (match-record config <guix-build-coordinator-agent-configuration> - (package user coordinator uuid password password-file max-parallel-builds + (package user coordinator authentication max-parallel-builds derivation-substitute-urls non-derivation-substitute-urls systems) (list @@ -337,13 +380,26 @@ (start #~(make-forkexec-constructor (list #$(file-append package "/bin/guix-build-coordinator-agent") #$(string-append "--coordinator=" coordinator) - #$(string-append "--uuid=" uuid) - #$@(if password - #~(#$(string-append "--password=" password)) - #~()) - #$@(if password-file - #~(#$(string-append "--password-file=" password-file)) - #~()) + #$@(match authentication + (($ <guix-build-coordinator-agent-password-auth> + uuid password) + #~(#$(string-append "--uuid=" uuid) + #$(string-append "--password=" password))) + (($ <guix-build-coordinator-agent-password-file-auth> + uuid password-file) + #~(#$(string-append "--uuid=" uuid) + #$(string-append "--password-file=" + password-file))) + (($ <guix-build-coordinator-agent-dynamic-auth> + agent-name token) + #~(#$(string-append "--name=" agent-name) + #$(string-append "--dynamic-auth-token=" token))) + (($ + <guix-build-coordinator-agent-dynamic-auth-with-file> + agent-name token-file) + #~(#$(string-append "--name=" agent-name) + #$(string-append "--dynamic-auth-token-file=" + token-file)))) #$(simple-format #f "--max-parallel-builds=~A" max-parallel-builds) #$@(if derivation-substitute-urls diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm index a4d4ac0646..231a9f66c7 100644 --- a/gnu/services/networking.scm +++ b/gnu/services/networking.scm @@ -15,6 +15,7 @@ ;;; Copyright © 2019 Alex Griffin <a@ajgrf.com> ;;; Copyright © 2020 Brice Waegeneire <brice@waegenei.re> ;;; Copyright © 2021 Oleg Pykhalov <go.wigust@gmail.com> +;;; Copyright © 2021 Christopher Lemmer Webber <cwebber@dustycloud.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -744,7 +745,9 @@ demand."))) (hidden-services tor-configuration-hidden-services (default '())) (socks-socket-type tor-configuration-socks-socket-type ; 'tcp or 'unix - (default 'tcp))) + (default 'tcp)) + (control-socket? tor-control-socket-path + (default #f))) (define %tor-accounts ;; User account and groups for Tor. @@ -766,7 +769,8 @@ demand."))) (define (tor-configuration->torrc config) "Return a 'torrc' file for CONFIG." (match config - (($ <tor-configuration> tor config-file services socks-socket-type) + (($ <tor-configuration> tor config-file services + socks-socket-type control-socket?) (computed-file "torrc" (with-imported-modules '((guix build utils)) @@ -786,6 +790,11 @@ Log notice syslog\n" port) (display "\ SocksPort unix:/var/run/tor/socks-sock UnixSocksGroupWritable 1\n" port)) + (when #$control-socket? + (display "\ +ControlSocket unix:/var/run/tor/control-sock GroupWritable RelaxDirModeCheck +ControlSocketsGroupWritable 1\n" + port)) (for-each (match-lambda ((service (ports hosts) ...) diff --git a/gnu/services/shepherd.scm b/gnu/services/shepherd.scm index e2ec59f5aa..7277273686 100644 --- a/gnu/services/shepherd.scm +++ b/gnu/services/shepherd.scm @@ -73,7 +73,9 @@ shepherd-service-back-edges shepherd-service-upgrade - user-processes-service-type)) + user-processes-service-type + + assert-valid-graph)) ;;; Commentary: ;;; @@ -97,7 +99,11 @@ #~(begin ;; Keep track of the booted system. (false-if-exception (delete-file "/run/booted-system")) - (symlink (readlink "/run/current-system") + + ;; Make /run/booted-system, an indirect GC root, point to the store item + ;; /run/current-system points to. Use 'canonicalize-path' rather than + ;; 'readlink' to make sure we get the store item. + (symlink (canonicalize-path "/run/current-system") "/run/booted-system") ;; Close any remaining open file descriptors to be on the safe diff --git a/gnu/services/vpn.scm b/gnu/services/vpn.scm index 70f2617c7e..3e315a6df2 100644 --- a/gnu/services/vpn.scm +++ b/gnu/services/vpn.scm @@ -40,7 +40,24 @@ openvpn-remote-configuration openvpn-ccd-configuration generate-openvpn-client-documentation - generate-openvpn-server-documentation)) + generate-openvpn-server-documentation + + wireguard-peer + wireguard-peer? + wireguard-peer-name + wireguard-peer-endpoint + wireguard-peer-allowed-ips + + wireguard-configuration + wireguard-configuration? + wireguard-configuration-wireguard + wireguard-configuration-interface + wireguard-configuration-addresses + wireguard-configuration-port + wireguard-configuration-private-key + wireguard-configuration-peers + + wireguard-service-type)) ;;; ;;; OpenVPN. @@ -507,3 +524,122 @@ is truncated and rewritten every minute.") (remote openvpn-remote-configuration)) (openvpn-remote-configuration ,openvpn-remote-configuration-fields)) 'openvpn-client-configuration)) + + +;;; +;;; Wireguard. +;;; + +(define-record-type* <wireguard-peer> + wireguard-peer make-wireguard-peer + wireguard-peer? + (name wireguard-peer-name) + (endpoint wireguard-peer-endpoint + (default #f)) ;string + (public-key wireguard-peer-public-key) ;string + (allowed-ips wireguard-peer-allowed-ips)) ;list of strings + +(define-record-type* <wireguard-configuration> + wireguard-configuration make-wireguard-configuration + wireguard-configuration? + (wireguard wireguard-configuration-wireguard ;<package> + (default wireguard-tools)) + (interface wireguard-configuration-interface ;string + (default "wg0")) + (addresses wireguard-configuration-addresses ;string + (default '("10.0.0.1/32"))) + (port wireguard-configuration-port ;integer + (default 51820)) + (private-key wireguard-configuration-private-key ;string + (default "/etc/wireguard/private.key")) + (peers wireguard-configuration-peers ;list of <wiregard-peer> + (default '()))) + +(define (wireguard-configuration-file config) + (define (peer->config peer) + (let ((name (wireguard-peer-name peer)) + (public-key (wireguard-peer-public-key peer)) + (endpoint (wireguard-peer-endpoint peer)) + (allowed-ips (wireguard-peer-allowed-ips peer))) + (format #f "[Peer] #~a +PublicKey = ~a +AllowedIPs = ~a +~a" + name + public-key + (string-join allowed-ips ",") + (if endpoint + (format #f "Endpoint = ~a\n" endpoint) + "\n")))) + + (match-record config <wireguard-configuration> + (wireguard interface addresses port private-key peers) + (let* ((config-file (string-append interface ".conf")) + (peers (map peer->config peers)) + (config + (computed-file + "wireguard-config" + #~(begin + (mkdir #$output) + (chdir #$output) + (call-with-output-file #$config-file + (lambda (port) + (let ((format (@ (ice-9 format) format))) + (format port "[Interface] +Address = ~a +PostUp = ~a set %i private-key ~a +~a +~{~a~^~%~}" + #$(string-join addresses ",") + #$(file-append wireguard "/bin/wg") + #$private-key + #$(if port + (format #f "ListenPort = ~a" port) + "") + (list #$@peers))))))))) + (file-append config "/" config-file)))) + +(define (wireguard-activation config) + (match-record config <wireguard-configuration> + (private-key) + #~(begin + (use-modules (guix build utils) + (ice-9 popen) + (ice-9 rdelim)) + (mkdir-p (dirname #$private-key)) + (unless (file-exists? #$private-key) + (let* ((pipe + (open-input-pipe (string-append + #$(file-append wireguard-tools "/bin/wg") + " genkey"))) + (key (read-line pipe))) + (call-with-output-file #$private-key + (lambda (port) + (display key port))) + (chmod #$private-key #o400) + (close-pipe pipe)))))) + +(define (wireguard-shepherd-service config) + (match-record config <wireguard-configuration> + (wireguard interface) + (let ((wg-quick (file-append wireguard "/bin/wg-quick")) + (config (wireguard-configuration-file config))) + (list (shepherd-service + (requirement '(networking)) + (provision (list + (symbol-append 'wireguard- + (string->symbol interface)))) + (start #~(lambda _ + (invoke #$wg-quick "up" #$config))) + (stop #~(lambda _ + (invoke #$wg-quick "down" #$config))) + (documentation "Run the Wireguard VPN tunnel")))))) + +(define wireguard-service-type + (service-type + (name 'wireguard) + (extensions + (list (service-extension shepherd-root-service-type + wireguard-shepherd-service) + (service-extension activation-service-type + wireguard-activation))))) diff --git a/gnu/services/web.scm b/gnu/services/web.scm index ff7b262b6a..aa688a4328 100644 --- a/gnu/services/web.scm +++ b/gnu/services/web.scm @@ -14,7 +14,7 @@ ;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr> ;;; Copyright © 2020 Arun Isaac <arunisaac@systemreboot.net> ;;; Copyright © 2020 Oleg Pykhalov <go.wigust@gmail.com> -;;; Copyright © 2020 Alexandru-Sergiu Marton <brown121407@posteo.ro> +;;; Copyright © 2020, 2021 Alexandru-Sergiu Marton <brown121407@posteo.ro> ;;; ;;; This file is part of GNU Guix. ;;; @@ -50,6 +50,7 @@ #:use-module (gnu packages guile) #:use-module (gnu packages logging) #:use-module (gnu packages mail) + #:use-module (gnu packages rust-apps) #:use-module (guix packages) #:use-module (guix records) #:use-module (guix modules) @@ -263,7 +264,25 @@ gmnisrv-configuration-package gmnisrv-configuration-config-file - gmnisrv-service-type)) + gmnisrv-service-type + + agate-configuration + agate-configuration? + agate-configuration-package + agate-configuration-content + agate-configuration-cert + agate-configuration-key + agate-configuration-addr + agate-configuration-hostname + agate-configuration-lang + agate-configuration-silent + agate-configuration-serve-secret + agate-configuration-log-ip + agate-configuration-user + agate-configuration-group + agate-configuration-log-file + + agate-service-type)) ;;; Commentary: ;;; @@ -1885,3 +1904,92 @@ root=/srv/gemini "Run the gmnisrv Gemini server.") (default-value (gmnisrv-configuration)))) + +(define-record-type* <agate-configuration> + agate-configuration make-agate-configuration + agate-configuration? + (package agate-configuration-package + (default agate)) + (content agate-configuration-content + (default "/srv/gemini")) + (cert agate-configuration-cert + (default #f)) + (key agate-configuration-key + (default #f)) + (addr agate-configuration-addr + (default '("0.0.0.0:1965" "[::]:1965"))) + (hostname agate-configuration-hostname + (default #f)) + (lang agate-configuration-lang + (default #f)) + (silent? agate-configuration-silent + (default #f)) + (serve-secret? agate-configuration-serve-secret + (default #f)) + (log-ip? agate-configuration-log-ip + (default #t)) + (user agate-configuration-user + (default "agate")) + (group agate-configuration-group + (default "agate")) + (log-file agate-configuration-log + (default "/var/log/agate.log"))) + +(define agate-shepherd-service + (match-lambda + (($ <agate-configuration> package content cert key addr + hostname lang silent? serve-secret? + log-ip? user group log-file) + (list (shepherd-service + (provision '(agate)) + (requirement '(networking)) + (documentation "Run the agate Gemini server.") + (start (let ((agate (file-append package "/bin/agate"))) + #~(make-forkexec-constructor + (list #$agate + "--content" #$content + "--cert" #$cert + "--key" #$key + "--addr" #$@addr + #$@(if lang + (list "--lang" lang) + '()) + #$@(if hostname + (list "--hostname" hostname) + '()) + #$@(if silent? '("--silent") '()) + #$@(if serve-secret? '("--serve-secret") '()) + #$@(if log-ip? '("--log-ip") '())) + #:user #$user #:group #$group + #:log-file #$log-file))) + (stop #~(make-kill-destructor))))))) + +(define agate-accounts + (match-lambda + (($ <agate-configuration> _ _ _ _ _ + _ _ _ _ + _ user group _) + `(,@(if (equal? group "agate") + '() + (list (user-group (name "agate") (system? #t)))) + ,(user-group + (name group) + (system? #t)) + ,(user-account + (name user) + (group group) + (supplementary-groups '("agate")) + (system? #t) + (comment "agate server user") + (home-directory "/var/empty") + (shell (file-append shadow "/sbin/nologin"))))))) + +(define agate-service-type + (service-type + (name 'guix) + (extensions + (list (service-extension account-service-type + agate-accounts) + (service-extension shepherd-root-service-type + agate-shepherd-service))) + (default-value (agate-configuration)))) |