aboutsummaryrefslogtreecommitdiff
path: root/gnu/services
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/services')
-rw-r--r--gnu/services/base.scm67
-rw-r--r--gnu/services/databases.scm93
-rw-r--r--gnu/services/mail.scm147
-rw-r--r--gnu/services/shepherd.scm26
-rw-r--r--gnu/services/ssh.scm7
5 files changed, 209 insertions, 131 deletions
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 343123a377..be1bfce578 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -62,6 +62,7 @@
%default-console-font
console-font-service-type
console-font-service
+ virtual-terminal-service-type
udev-configuration
udev-configuration?
@@ -665,22 +666,27 @@ to add @var{device} to the kernel's entropy pool. The service will fail if
"Return a service that sets the host name to @var{name}."
(service host-name-service-type name))
-(define (unicode-start tty)
- "Return a gexp to start Unicode support on @var{tty}."
- (with-imported-modules '((guix build syscalls))
- #~(let* ((fd (open-fdes #$tty O_RDWR))
- (termios (tcgetattr fd)))
- (define (set-utf8-input termios)
- (set-field termios (termios-input-flags)
- (logior (input-flags IUTF8)
- (termios-input-flags termios))))
-
- (tcsetattr fd (tcsetattr-action TCSAFLUSH)
- (set-utf8-input termios))
-
- ;; TODO: ioctl(fd, KDSKBMODE, K_UNICODE);
- (close-fdes fd)
- #t)))
+(define virtual-terminal-service-type
+ ;; Ensure that virtual terminals run in UTF-8 mode. This is the case by
+ ;; default with recent Linux kernels, but this service allows us to ensure
+ ;; this. This service must start before any 'term-' service so that newly
+ ;; created terminals inherit this property. See
+ ;; <https://bugs.gnu.org/30505> for a discussion.
+ (shepherd-service-type
+ 'virtual-terminal
+ (lambda (utf8?)
+ (shepherd-service
+ (documentation "Set virtual terminals in UTF-8 module.")
+ (provision '(virtual-terminal))
+ (requirement '(root-file-system))
+ (start #~(lambda _
+ (call-with-output-file
+ "/sys/module/vt/parameters/default_utf8"
+ (lambda (port)
+ (display 1 port)))
+ #t))
+ (stop #~(const #f))))
+ #t)) ;default to UTF-8
(define console-keymap-service-type
(shepherd-service-type
@@ -719,8 +725,6 @@ to add @var{device} to the kernel's entropy pool. The service will fail if
(requirement (list (symbol-append 'term-
(string->symbol tty))))
- (modules '((guix build syscalls) ;for 'tcsetattr'
- (srfi srfi-9 gnu))) ;for 'set-field'
(start #~(lambda _
;; It could be that mingetty is not fully ready yet,
;; which we check by calling 'ttyname'.
@@ -732,16 +736,18 @@ to add @var{device} to the kernel's entropy pool. The service will fail if
(usleep 500)
(loop (- i 1))))
- (and #$(unicode-start device)
- ;; 'setfont' returns EX_OSERR (71) when an
- ;; KDFONTOP ioctl fails, for example. Like
- ;; systemd's vconsole support, let's not treat
- ;; this as an error.
- (case (status:exit-val
- (system* #$(file-append kbd "/bin/setfont")
- "-C" #$device #$font))
- ((0 71) #t)
- (else #f)))))
+ ;; Assume the VT is already in UTF-8 mode, thanks to
+ ;; the 'virtual-terminal' service.
+ ;;
+ ;; 'setfont' returns EX_OSERR (71) when an
+ ;; KDFONTOP ioctl fails, for example. Like
+ ;; systemd's vconsole support, let's not treat
+ ;; this as an error.
+ (case (status:exit-val
+ (system* #$(file-append kbd "/bin/setfont")
+ "-C" #$device #$font))
+ ((0 71) #t)
+ (else #f))))
(stop #~(const #t))
(respawn? #f)))))
tty+font))
@@ -1093,7 +1099,7 @@ the tty to run, among other things."
;; Since the login prompt shows the host name, wait for the 'host-name'
;; service to be done. Also wait for udev essentially so that the tty
;; text is not lost in the middle of kernel messages (XXX).
- (requirement '(user-processes host-name udev))
+ (requirement '(user-processes host-name udev virtual-terminal))
(start #~(make-forkexec-constructor
(list #$(file-append mingetty "/sbin/mingetty")
@@ -2034,7 +2040,7 @@ This service is not part of @var{%base-services}."
(shepherd-service
(documentation "kmscon virtual terminal")
- (requirement '(user-processes udev dbus-system))
+ (requirement '(user-processes udev dbus-system virtual-terminal))
(provision (list (symbol-append 'term- (string->symbol virtual-terminal))))
(start #~(make-forkexec-constructor #$kmscon-command))
(stop #~(make-kill-destructor)))))))
@@ -2044,6 +2050,7 @@ This service is not part of @var{%base-services}."
;; Convenience variable holding the basic services.
(list (login-service)
+ (service virtual-terminal-service-type)
(service console-font-service-type
(map (lambda (tty)
(cons tty %default-console-font))
diff --git a/gnu/services/databases.scm b/gnu/services/databases.scm
index 3ca8f471fc..8ae248ebe4 100644
--- a/gnu/services/databases.scm
+++ b/gnu/services/databases.scm
@@ -29,9 +29,25 @@
#:use-module (guix modules)
#:use-module (guix records)
#:use-module (guix gexp)
+ #:use-module (srfi srfi-1)
#:use-module (ice-9 match)
- #:export (postgresql-configuration
+ #:export (<postgresql-config-file>
+ postgresql-config-file
+ postgresql-config-file?
+ postgresql-config-file-log-destination
+ postgresql-config-file-hba-file
+ postgresql-config-file-ident-file
+ postgresql-config-file-extra-config
+
+ <postgresql-configuration>
+ postgresql-configuration
postgresql-configuration?
+ postgresql-configuration-postgresql
+ postgresql-configuration-port
+ postgresql-configuration-locale
+ postgresql-configuration-file
+ postgresql-configuration-data-directory
+
postgresql-service
postgresql-service-type
@@ -68,6 +84,60 @@
;;;
;;; Code:
+(define %default-postgres-hba
+ (plain-file "pg_hba.conf"
+ "
+local all all trust
+host all all 127.0.0.1/32 trust
+host all all ::1/128 trust"))
+
+(define %default-postgres-ident
+ (plain-file "pg_ident.conf"
+ "# MAPNAME SYSTEM-USERNAME PG-USERNAME"))
+
+(define-record-type* <postgresql-config-file>
+ postgresql-config-file make-postgresql-config-file
+ postgresql-config-file?
+ (log-destination postgresql-config-file-log-destination
+ (default "syslog"))
+ (hba-file postgresql-config-file-hba-file
+ (default %default-postgres-hba))
+ (ident-file postgresql-config-file-ident-file
+ (default %default-postgres-ident))
+ (extra-config postgresql-config-file-extra-config
+ (default '())))
+
+(define-gexp-compiler (postgresql-config-file-compiler
+ (file <postgresql-config-file>) system target)
+ (match file
+ (($ <postgresql-config-file> log-destination hba-file
+ ident-file extra-config)
+ (define (single-quote string)
+ (if string
+ (list "'" string "'")
+ '()))
+
+ (define contents
+ (append-map
+ (match-lambda
+ ((key) '())
+ ((key . #f) '())
+ ((key values ...) `(,key " = " ,@values "\n")))
+
+ `(("log_destination" ,@(single-quote log-destination))
+ ("hba_file" ,@(single-quote hba-file))
+ ("ident_file" ,@(single-quote ident-file))
+ ,@extra-config)))
+
+ (gexp->derivation
+ "postgresql.conf"
+ #~(call-with-output-file (ungexp output "out")
+ (lambda (port)
+ (display
+ (string-append #$@contents)
+ port)))
+ #:local-build? #t))))
+
(define-record-type* <postgresql-configuration>
postgresql-configuration make-postgresql-configuration
postgresql-configuration?
@@ -78,27 +148,10 @@
(locale postgresql-configuration-locale
(default "en_US.utf8"))
(config-file postgresql-configuration-file
- (default %default-postgres-config))
+ (default (postgresql-config-file)))
(data-directory postgresql-configuration-data-directory
(default "/var/lib/postgresql/data")))
-(define %default-postgres-hba
- (plain-file "pg_hba.conf"
- "
-local all all trust
-host all all 127.0.0.1/32 trust
-host all all ::1/128 trust"))
-
-(define %default-postgres-ident
- (plain-file "pg_ident.conf"
- "# MAPNAME SYSTEM-USERNAME PG-USERNAME"))
-
-(define %default-postgres-config
- (mixed-text-file "postgresql.conf"
- "log_destination = 'syslog'\n"
- "hba_file = '" %default-postgres-hba "'\n"
- "ident_file = '" %default-postgres-ident "'\n"))
-
(define %postgresql-accounts
(list (user-group (name "postgres") (system? #t))
(user-account
@@ -192,7 +245,7 @@ host all all ::1/128 trust"))
(define* (postgresql-service #:key (postgresql postgresql)
(port 5432)
(locale "en_US.utf8")
- (config-file %default-postgres-config)
+ (config-file (postgresql-config-file))
(data-directory "/var/lib/postgresql/data"))
"Return a service that runs @var{postgresql}, the PostgreSQL database server.
diff --git a/gnu/services/mail.scm b/gnu/services/mail.scm
index ab90942739..573efa0433 100644
--- a/gnu/services/mail.scm
+++ b/gnu/services/mail.scm
@@ -1435,90 +1435,91 @@ greyed out, instead of only later giving \"not selectable\" popup error.
(home-directory "/var/empty")
(shell (file-append shadow "/sbin/nologin")))))
-(define %dovecot-activation
+(define (%dovecot-activation config)
;; Activation gexp.
- #~(begin
- (use-modules (guix build utils))
- (define (mkdir-p/perms directory owner perms)
- (mkdir-p directory)
- (chown "/var/run/dovecot" (passwd:uid owner) (passwd:gid owner))
- (chmod directory perms))
- (define (build-subject parameters)
- (string-concatenate
- (map (lambda (pair)
- (let ((k (car pair)) (v (cdr pair)))
- (define (escape-char str chr)
- (string-join (string-split str chr) (string #\\ chr)))
- (string-append "/" k "="
- (escape-char (escape-char v #\=) #\/))))
- (filter (lambda (pair) (cdr pair)) parameters))))
- (define* (create-self-signed-certificate-if-absent
- #:key private-key public-key (owner (getpwnam "root"))
- (common-name (gethostname))
- (organization-name "GuixSD")
- (organization-unit-name "Default Self-Signed Certificate")
- (subject-parameters `(("CN" . ,common-name)
- ("O" . ,organization-name)
- ("OU" . ,organization-unit-name)))
- (subject (build-subject subject-parameters)))
- ;; Note that by default, OpenSSL outputs keys in PEM format. This
- ;; is what we want.
- (unless (file-exists? private-key)
- (cond
- ((zero? (system* (string-append #$openssl "/bin/openssl")
- "genrsa" "-out" private-key "2048"))
- (chown private-key (passwd:uid owner) (passwd:gid owner))
- (chmod private-key #o400))
- (else
- (format (current-error-port)
- "Failed to create private key at ~a.\n" private-key))))
- (unless (file-exists? public-key)
- (cond
- ((zero? (system* (string-append #$openssl "/bin/openssl")
- "req" "-new" "-x509" "-key" private-key
- "-out" public-key "-days" "3650"
- "-batch" "-subj" subject))
- (chown public-key (passwd:uid owner) (passwd:gid owner))
- (chmod public-key #o444))
- (else
- (format (current-error-port)
- "Failed to create public key at ~a.\n" public-key)))))
- (let ((user (getpwnam "dovecot")))
- (mkdir-p/perms "/var/run/dovecot" user #o755)
- (mkdir-p/perms "/var/lib/dovecot" user #o755)
- (mkdir-p/perms "/etc/dovecot" user #o755)
- (mkdir-p/perms "/etc/dovecot/private" user #o700)
- (create-self-signed-certificate-if-absent
- #:private-key "/etc/dovecot/private/default.pem"
- #:public-key "/etc/dovecot/default.pem"
- #:owner (getpwnam "root")
- #:common-name (format #f "Dovecot service on ~a" (gethostname))))))
+ (let ((config-str
+ (cond
+ ((opaque-dovecot-configuration? config)
+ (opaque-dovecot-configuration-string config))
+ (else
+ (with-output-to-string
+ (lambda ()
+ (serialize-configuration config
+ dovecot-configuration-fields)))))))
+ #~(begin
+ (use-modules (guix build utils))
+ (define (mkdir-p/perms directory owner perms)
+ (mkdir-p directory)
+ (chown "/var/run/dovecot" (passwd:uid owner) (passwd:gid owner))
+ (chmod directory perms))
+ (define (build-subject parameters)
+ (string-concatenate
+ (map (lambda (pair)
+ (let ((k (car pair)) (v (cdr pair)))
+ (define (escape-char str chr)
+ (string-join (string-split str chr) (string #\\ chr)))
+ (string-append "/" k "="
+ (escape-char (escape-char v #\=) #\/))))
+ (filter (lambda (pair) (cdr pair)) parameters))))
+ (define* (create-self-signed-certificate-if-absent
+ #:key private-key public-key (owner (getpwnam "root"))
+ (common-name (gethostname))
+ (organization-name "GuixSD")
+ (organization-unit-name "Default Self-Signed Certificate")
+ (subject-parameters `(("CN" . ,common-name)
+ ("O" . ,organization-name)
+ ("OU" . ,organization-unit-name)))
+ (subject (build-subject subject-parameters)))
+ ;; Note that by default, OpenSSL outputs keys in PEM format. This
+ ;; is what we want.
+ (unless (file-exists? private-key)
+ (cond
+ ((zero? (system* (string-append #$openssl "/bin/openssl")
+ "genrsa" "-out" private-key "2048"))
+ (chown private-key (passwd:uid owner) (passwd:gid owner))
+ (chmod private-key #o400))
+ (else
+ (format (current-error-port)
+ "Failed to create private key at ~a.\n" private-key))))
+ (unless (file-exists? public-key)
+ (cond
+ ((zero? (system* (string-append #$openssl "/bin/openssl")
+ "req" "-new" "-x509" "-key" private-key
+ "-out" public-key "-days" "3650"
+ "-batch" "-subj" subject))
+ (chown public-key (passwd:uid owner) (passwd:gid owner))
+ (chmod public-key #o444))
+ (else
+ (format (current-error-port)
+ "Failed to create public key at ~a.\n" public-key)))))
+ (let ((user (getpwnam "dovecot")))
+ (mkdir-p/perms "/var/run/dovecot" user #o755)
+ (mkdir-p/perms "/var/lib/dovecot" user #o755)
+ (mkdir-p/perms "/etc/dovecot" user #o755)
+ (copy-file #$(plain-file "dovecot.conf" config-str)
+ "/etc/dovecot/dovecot.conf")
+ (mkdir-p/perms "/etc/dovecot/private" user #o700)
+ (create-self-signed-certificate-if-absent
+ #:private-key "/etc/dovecot/private/default.pem"
+ #:public-key "/etc/dovecot/default.pem"
+ #:owner (getpwnam "root")
+ #:common-name (format #f "Dovecot service on ~a" (gethostname)))))))
(define (dovecot-shepherd-service config)
"Return a list of <shepherd-service> for CONFIG."
- (let* ((config-str
- (cond
- ((opaque-dovecot-configuration? config)
- (opaque-dovecot-configuration-string config))
- (else
- (with-output-to-string
- (lambda ()
- (serialize-configuration config
- dovecot-configuration-fields))))))
- (config-file (plain-file "dovecot.conf" config-str))
- (dovecot (if (opaque-dovecot-configuration? config)
- (opaque-dovecot-configuration-dovecot config)
- (dovecot-configuration-dovecot config))))
+ (let ((dovecot (if (opaque-dovecot-configuration? config)
+ (opaque-dovecot-configuration-dovecot config)
+ (dovecot-configuration-dovecot config))))
(list (shepherd-service
(documentation "Run the Dovecot POP3/IMAP mail server.")
(provision '(dovecot))
(requirement '(networking))
(start #~(make-forkexec-constructor
(list (string-append #$dovecot "/sbin/dovecot")
- "-F" "-c" #$config-file)))
+ "-F")))
(stop #~(make-forkexec-constructor
(list (string-append #$dovecot "/sbin/dovecot")
- "-c" #$config-file "stop")))))))
+ "stop")))))))
(define %dovecot-pam-services
(list (unix-pam-service "dovecot")))
@@ -1533,7 +1534,7 @@ greyed out, instead of only later giving \"not selectable\" popup error.
(service-extension pam-root-service-type
(const %dovecot-pam-services))
(service-extension activation-service-type
- (const %dovecot-activation))))))
+ %dovecot-activation)))))
(define* (dovecot-service #:key (config (dovecot-configuration)))
"Return a service that runs @command{dovecot}, a mail server that can run
diff --git a/gnu/services/shepherd.scm b/gnu/services/shepherd.scm
index f7c6983cb0..000e85eb86 100644
--- a/gnu/services/shepherd.scm
+++ b/gnu/services/shepherd.scm
@@ -104,14 +104,24 @@
;; <shepherd-service> objects.
(service shepherd-root-service-type '()))
-(define-syntax-rule (shepherd-service-type service-name proc)
- "Return a <service-type> denoting a simple shepherd service--i.e., the type
-for a service that extends SHEPHERD-ROOT-SERVICE-TYPE and nothing else."
- (service-type
- (name service-name)
- (extensions
- (list (service-extension shepherd-root-service-type
- (compose list proc))))))
+(define-syntax shepherd-service-type
+ (syntax-rules ()
+ "Return a <service-type> denoting a simple shepherd service--i.e., the type
+for a service that extends SHEPHERD-ROOT-SERVICE-TYPE and nothing else. When
+DEFAULT is given, use it as the service's default value."
+ ((_ service-name proc default)
+ (service-type
+ (name service-name)
+ (extensions
+ (list (service-extension shepherd-root-service-type
+ (compose list proc))))
+ (default-value default)))
+ ((_ service-name proc)
+ (service-type
+ (name service-name)
+ (extensions
+ (list (service-extension shepherd-root-service-type
+ (compose list proc))))))))
(define %default-imported-modules
;; Default set of modules imported for a service's consumption.
diff --git a/gnu/services/ssh.scm b/gnu/services/ssh.scm
index 301ba74041..f1d2be3f6b 100644
--- a/gnu/services/ssh.scm
+++ b/gnu/services/ssh.scm
@@ -302,6 +302,10 @@ The other options should be self-descriptive."
(subsystems openssh-configuration-subsystems
(default '(("sftp" "internal-sftp"))))
+ ;; list of strings
+ (accepted-environment openssh-configuration-accepted-environment
+ (default '()))
+
;; list of user-name/file-like tuples
(authorized-keys openssh-authorized-keys
(default '()))
@@ -430,6 +434,9 @@ of user-name/file-like tuples."
(format port "AuthorizedKeysFile \
.ssh/authorized_keys .ssh/authorized_keys2 /etc/ssh/authorized_keys.d/%u\n")
+ (for-each (lambda (s) (format port "AcceptEnv ~a\n" s))
+ '#$(openssh-configuration-accepted-environment config))
+
(for-each
(match-lambda
((name command) (format port "Subsystem\t~a\t~a\n" name command)))
generated by cgit v1.2.3 (git 2.45.0) at 2024-11-26 08:42:18 +0000