summaryrefslogtreecommitdiff
path: root/gnu/services
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/services')
-rw-r--r--gnu/services/cuirass.scm120
-rw-r--r--gnu/services/mail.scm4
-rw-r--r--gnu/services/networking.scm82
-rw-r--r--gnu/services/virtualization.scm2
-rw-r--r--gnu/services/xorg.scm23
5 files changed, 166 insertions, 65 deletions
diff --git a/gnu/services/cuirass.scm b/gnu/services/cuirass.scm
index 7bd43cd427..914a0d337f 100644
--- a/gnu/services/cuirass.scm
+++ b/gnu/services/cuirass.scm
@@ -81,70 +81,68 @@
(define (cuirass-shepherd-service config)
"Return a <shepherd-service> for the Cuirass service with CONFIG."
- (and
- (cuirass-configuration? config)
- (let ((cuirass (cuirass-configuration-cuirass config))
- (cache-directory (cuirass-configuration-cache-directory config))
- (web-log-file (cuirass-configuration-web-log-file config))
- (log-file (cuirass-configuration-log-file config))
- (user (cuirass-configuration-user config))
- (group (cuirass-configuration-group config))
- (interval (cuirass-configuration-interval config))
- (database (cuirass-configuration-database config))
- (ttl (cuirass-configuration-ttl config))
- (port (cuirass-configuration-port config))
- (host (cuirass-configuration-host config))
- (specs (cuirass-configuration-specifications config))
- (use-substitutes? (cuirass-configuration-use-substitutes? config))
- (one-shot? (cuirass-configuration-one-shot? config))
- (fallback? (cuirass-configuration-fallback? config)))
- (list (shepherd-service
- (documentation "Run Cuirass.")
- (provision '(cuirass))
- (requirement '(guix-daemon networking))
- (start #~(make-forkexec-constructor
- (list (string-append #$cuirass "/bin/cuirass")
- "--cache-directory" #$cache-directory
- "--specifications"
- #$(scheme-file "cuirass-specs.scm" specs)
- "--database" #$database
- "--ttl" #$(string-append (number->string ttl) "s")
- "--interval" #$(number->string interval)
- #$@(if use-substitutes? '("--use-substitutes") '())
- #$@(if one-shot? '("--one-shot") '())
- #$@(if fallback? '("--fallback") '()))
+ (let ((cuirass (cuirass-configuration-cuirass config))
+ (cache-directory (cuirass-configuration-cache-directory config))
+ (web-log-file (cuirass-configuration-web-log-file config))
+ (log-file (cuirass-configuration-log-file config))
+ (user (cuirass-configuration-user config))
+ (group (cuirass-configuration-group config))
+ (interval (cuirass-configuration-interval config))
+ (database (cuirass-configuration-database config))
+ (ttl (cuirass-configuration-ttl config))
+ (port (cuirass-configuration-port config))
+ (host (cuirass-configuration-host config))
+ (specs (cuirass-configuration-specifications config))
+ (use-substitutes? (cuirass-configuration-use-substitutes? config))
+ (one-shot? (cuirass-configuration-one-shot? config))
+ (fallback? (cuirass-configuration-fallback? config)))
+ (list (shepherd-service
+ (documentation "Run Cuirass.")
+ (provision '(cuirass))
+ (requirement '(guix-daemon networking))
+ (start #~(make-forkexec-constructor
+ (list (string-append #$cuirass "/bin/cuirass")
+ "--cache-directory" #$cache-directory
+ "--specifications"
+ #$(scheme-file "cuirass-specs.scm" specs)
+ "--database" #$database
+ "--ttl" #$(string-append (number->string ttl) "s")
+ "--interval" #$(number->string interval)
+ #$@(if use-substitutes? '("--use-substitutes") '())
+ #$@(if one-shot? '("--one-shot") '())
+ #$@(if fallback? '("--fallback") '()))
- #:environment-variables
- (list "GIT_SSL_CAINFO=/etc/ssl/certs/ca-certificates.crt"
- (string-append "GIT_EXEC_PATH=" #$git
- "/libexec/git-core"))
+ #:environment-variables
+ (list "GIT_SSL_CAINFO=/etc/ssl/certs/ca-certificates.crt"
+ (string-append "GIT_EXEC_PATH=" #$git
+ "/libexec/git-core"))
- #:user #$user
- #:group #$group
- #:log-file #$log-file))
- (stop #~(make-kill-destructor)))
- (shepherd-service
- (documentation "Run Cuirass web interface.")
- (provision '(cuirass-web))
- (requirement '(guix-daemon networking))
- (start #~(make-forkexec-constructor
- (list (string-append #$cuirass "/bin/cuirass")
- "--cache-directory" #$cache-directory
- "--specifications"
- #$(scheme-file "cuirass-specs.scm" specs)
- "--database" #$database
- "--ttl" #$(string-append (number->string ttl) "s")
- "--web"
- "--port" #$(number->string port)
- "--listen" #$host
- "--interval" #$(number->string interval)
- #$@(if use-substitutes? '("--use-substitutes") '())
- #$@(if fallback? '("--fallback") '()))
+ #:user #$user
+ #:group #$group
+ #:log-file #$log-file))
+ (stop #~(make-kill-destructor)))
+ (shepherd-service
+ (documentation "Run Cuirass web interface.")
+ (provision '(cuirass-web))
+ (requirement '(guix-daemon networking))
+ (start #~(make-forkexec-constructor
+ (list (string-append #$cuirass "/bin/cuirass")
+ "--cache-directory" #$cache-directory
+ "--specifications"
+ #$(scheme-file "cuirass-specs.scm" specs)
+ "--database" #$database
+ "--ttl" #$(string-append (number->string ttl) "s")
+ "--web"
+ "--port" #$(number->string port)
+ "--listen" #$host
+ "--interval" #$(number->string interval)
+ #$@(if use-substitutes? '("--use-substitutes") '())
+ #$@(if fallback? '("--fallback") '()))
- #:user #$user
- #:group #$group
- #:log-file #$web-log-file))
- (stop #~(make-kill-destructor)))))))
+ #:user #$user
+ #:group #$group
+ #:log-file #$web-log-file))
+ (stop #~(make-kill-destructor))))))
(define (cuirass-account config)
"Return the user accounts and user groups for CONFIG."
diff --git a/gnu/services/mail.scm b/gnu/services/mail.scm
index 3de0b4c2f3..2606aa9e3e 100644
--- a/gnu/services/mail.scm
+++ b/gnu/services/mail.scm
@@ -137,7 +137,7 @@
(define (free-form-fields? val)
(match val
(() #t)
- ((((? symbol?) . (? string)) . val) (free-form-fields? val))
+ ((((? symbol?) . (? string?)) . val) (free-form-fields? val))
(_ #f)))
(define (serialize-free-form-fields field-name val)
(for-each (match-lambda ((k . v) (serialize-field k v))) val))
@@ -145,7 +145,7 @@
(define (free-form-args? val)
(match val
(() #t)
- ((((? symbol?) . (? string)) . val) (free-form-args? val))
+ ((((? symbol?) . (? string?)) . val) (free-form-args? val))
(_ #f)))
(define (serialize-free-form-args field-name val)
(serialize-field field-name
diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm
index c775242f99..dd63009116 100644
--- a/gnu/services/networking.scm
+++ b/gnu/services/networking.scm
@@ -11,6 +11,7 @@
;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net>
;;; Copyright © 2019 Florian Pelz <pelzflorian@pelzflorian.de>
;;; Copyright © 2019 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2019 Sou Bunnbu <iyzsong@member.fsf.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -144,7 +145,14 @@
iptables-configuration-iptables
iptables-configuration-ipv4-rules
iptables-configuration-ipv6-rules
- iptables-service-type))
+ iptables-service-type
+
+ nftables-service-type
+ nftables-configuration
+ nftables-configuration?
+ nftables-configuration-package
+ nftables-configuration-ruleset
+ %default-nftables-ruleset))
;;; Commentary:
;;;
@@ -1415,4 +1423,76 @@ COMMIT
(list (service-extension shepherd-root-service-type
(compose list iptables-shepherd-service))))))
+;;;
+;;; nftables
+;;;
+
+(define %default-nftables-ruleset
+ (plain-file "nftables.conf"
+ "# A simple and safe firewall
+table inet filter {
+ chain input {
+ type filter hook input priority 0; policy drop;
+
+ # early drop of invalid connections
+ ct state invalid drop
+
+ # allow established/related connections
+ ct state { established, related } accept
+
+ # allow from loopback
+ iifname lo accept
+
+ # allow icmp
+ ip protocol icmp accept
+ ip6 nexthdr icmpv6 accept
+
+ # allow ssh
+ tcp dport ssh accept
+
+ # reject everything else
+ reject with icmpx type port-unreachable
+ }
+ chain forward {
+ type filter hook forward priority 0; policy drop;
+ }
+ chain output {
+ type filter hook output priority 0; policy accept;
+ }
+}
+"))
+
+(define-record-type* <nftables-configuration>
+ nftables-configuration
+ make-nftables-configuration
+ nftables-configuration?
+ (package nftables-configuration-package
+ (default nftables))
+ (ruleset nftables-configuration-ruleset ; file-like object
+ (default %default-nftables-ruleset)))
+
+(define nftables-shepherd-service
+ (match-lambda
+ (($ <nftables-configuration> package ruleset)
+ (let ((nft (file-append package "/sbin/nft")))
+ (shepherd-service
+ (documentation "Packet filtering and classification")
+ (provision '(nftables))
+ (start #~(lambda _
+ (invoke #$nft "--file" #$ruleset)))
+ (stop #~(lambda _
+ (invoke #$nft "flush" "ruleset"))))))))
+
+(define nftables-service-type
+ (service-type
+ (name 'nftables)
+ (description
+ "Run @command{nft}, setting up the specified ruleset.")
+ (extensions
+ (list (service-extension shepherd-root-service-type
+ (compose list nftables-shepherd-service))
+ (service-extension profile-service-type
+ (compose list nftables-configuration-package))))
+ (default-value (nftables-configuration))))
+
;;; networking.scm ends here
diff --git a/gnu/services/virtualization.scm b/gnu/services/virtualization.scm
index 3eecd2c085..bc8ac9b40a 100644
--- a/gnu/services/virtualization.scm
+++ b/gnu/services/virtualization.scm
@@ -313,7 +313,7 @@ be logged:
Multiple filters can be defined in a single filters statement, they just
need to be separated by spaces.")
(log-outputs
- (string "3:stderr")
+ (string "3:syslog:libvirtd")
"Logging outputs.
An output is one of the places to save logging information
diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm
index 06d72b5f60..1d55e388a1 100644
--- a/gnu/services/xorg.scm
+++ b/gnu/services/xorg.scm
@@ -773,6 +773,27 @@ the GNOME desktop environment.")
(home-directory "/var/lib/gdm")
(shell (file-append shadow "/sbin/nologin")))))
+(define %gdm-activation
+ ;; Ensure /var/lib/gdm is owned by the "gdm" user. This is normally the
+ ;; case but could be wrong if the "gdm" user was created, then removed, and
+ ;; then recreated under a different UID/GID: <https://bugs.gnu.org/37423>.
+ (with-imported-modules '((guix build utils))
+ #~(begin
+ (use-modules (guix build utils))
+
+ (let* ((gdm (getpwnam "gdm"))
+ (uid (passwd:uid gdm))
+ (gid (passwd:gid gdm))
+ (st (stat "/var/lib/gdm" #f)))
+ ;; Recurse into /var/lib/gdm only if it has wrong ownership.
+ (when (and st
+ (or (not (= uid (stat:uid st)))
+ (not (= gid (stat:gid st)))))
+ (for-each (lambda (file)
+ (chown file uid gid))
+ (find-files "/var/lib/gdm"
+ #:directories? #t)))))))
+
(define dbus-daemon-wrapper
(program-file
"gdm-dbus-wrapper"
@@ -915,6 +936,8 @@ the GNOME desktop environment.")
(extensions
(list (service-extension shepherd-root-service-type
gdm-shepherd-service)
+ (service-extension activation-service-type
+ (const %gdm-activation))
(service-extension account-service-type
(const %gdm-accounts))
(service-extension pam-root-service-type
generated by cgit v1.2.3 (git 2.25.4) at 2024-06-11 19:41:33 +0000