summaryrefslogtreecommitdiff
path: root/gnu/services
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/services')
-rw-r--r--gnu/services/configuration.scm40
-rw-r--r--gnu/services/cups.scm32
-rw-r--r--gnu/services/kerberos.scm15
-rw-r--r--gnu/services/mail.scm142
-rw-r--r--gnu/services/ssh.scm42
5 files changed, 216 insertions, 55 deletions
diff --git a/gnu/services/configuration.scm b/gnu/services/configuration.scm
index a98db64fa5..2ad3a637a4 100644
--- a/gnu/services/configuration.scm
+++ b/gnu/services/configuration.scm
@@ -39,14 +39,6 @@
define-configuration
validate-configuration
generate-documentation
- serialize-field
- serialize-string
- serialize-name
- serialize-space-separated-string-list
- space-separated-string-list?
- serialize-file-name
- file-name?
- serialize-boolean
serialize-package))
;;; Commentary:
@@ -140,41 +132,9 @@
#,(id #'stem #'stem #'-fields))
conf))))))))
-(define (uglify-field-name field-name)
- (let ((str (symbol->string field-name)))
- (string-concatenate
- (map string-titlecase
- (string-split (if (string-suffix? "?" str)
- (substring str 0 (1- (string-length str)))
- str)
- #\-)))))
-
-(define (serialize-field field-name val)
- (format #t "~a ~a\n" (uglify-field-name field-name) val))
-
(define (serialize-package field-name val)
#f)
-(define (serialize-string field-name val)
- (serialize-field field-name val))
-
-(define (space-separated-string-list? val)
- (and (list? val)
- (and-map (lambda (x)
- (and (string? x) (not (string-index x #\space))))
- val)))
-(define (serialize-space-separated-string-list field-name val)
- (serialize-field field-name (string-join val " ")))
-
-(define (file-name? val)
- (and (string? val)
- (string-prefix? "/" val)))
-(define (serialize-file-name field-name val)
- (serialize-string field-name val))
-
-(define (serialize-boolean field-name val)
- (serialize-string field-name (if val "yes" "no")))
-
;; A little helper to make it easier to document all those fields.
(define (generate-documentation documentation documentation-name)
(define (str x) (object->string x))
diff --git a/gnu/services/cups.scm b/gnu/services/cups.scm
index 70b858479a..70a71eff0a 100644
--- a/gnu/services/cups.scm
+++ b/gnu/services/cups.scm
@@ -57,6 +57,21 @@
(home-directory "/var/empty")
(shell (file-append shadow "/sbin/nologin")))))
+(define (uglify-field-name field-name)
+ (let ((str (symbol->string field-name)))
+ (string-concatenate
+ (map string-titlecase
+ (string-split (if (string-suffix? "?" str)
+ (substring str 0 (1- (string-length str)))
+ str)
+ #\-)))))
+
+(define (serialize-field field-name val)
+ (format #t "~a ~a\n" (uglify-field-name field-name) val))
+
+(define (serialize-string field-name val)
+ (serialize-field field-name val))
+
(define (multiline-string-list? val)
(and (list? val)
(and-map (lambda (x)
@@ -65,11 +80,28 @@
(define (serialize-multiline-string-list field-name val)
(for-each (lambda (str) (serialize-field field-name str)) val))
+(define (space-separated-string-list? val)
+ (and (list? val)
+ (and-map (lambda (x)
+ (and (string? x) (not (string-index x #\space))))
+ val)))
+(define (serialize-space-separated-string-list field-name val)
+ (serialize-field field-name (string-join val " ")))
+
(define (space-separated-symbol-list? val)
(and (list? val) (and-map symbol? val)))
(define (serialize-space-separated-symbol-list field-name val)
(serialize-field field-name (string-join (map symbol->string val) " ")))
+(define (file-name? val)
+ (and (string? val)
+ (string-prefix? "/" val)))
+(define (serialize-file-name field-name val)
+ (serialize-string field-name val))
+
+(define (serialize-boolean field-name val)
+ (serialize-string field-name (if val "yes" "no")))
+
(define (non-negative-integer? val)
(and (exact-integer? val) (not (negative? val))))
(define (serialize-non-negative-integer field-name val)
diff --git a/gnu/services/kerberos.scm b/gnu/services/kerberos.scm
index cb33a7c53d..f09f47893c 100644
--- a/gnu/services/kerberos.scm
+++ b/gnu/services/kerberos.scm
@@ -96,6 +96,12 @@ trailing '?' removed."
(unless (eq? val unset-field)
(serialize-field* field-name (string-join val " "))))
+(define (space-separated-string-list? val)
+ (and (list? val)
+ (and-map (lambda (x)
+ (and (string? x) (not (string-index x #\space))))
+ val)))
+
(define space-separated-string-list/unset?
(predicate/unset space-separated-string-list?))
@@ -118,10 +124,19 @@ trailing '?' removed."
(lambda (val)
(string-prefix? "/" val))))
+(define (serialize-field field-name val)
+ (format #t "~a ~a\n" (uglify-field-name field-name) val))
+
+(define (serialize-string field-name val)
+ (serialize-field field-name val))
+
(define (serialize-file-name field-name val)
(unless (eq? val unset-field)
(serialize-string field-name val)))
+(define (serialize-space-separated-string-list field-name val)
+ (serialize-field field-name (string-join val " ")))
+
(define (non-negative-integer? val)
(and (exact-integer? val) (not (negative? val))))
diff --git a/gnu/services/mail.scm b/gnu/services/mail.scm
index 30b1672d33..05978e0068 100644
--- a/gnu/services/mail.scm
+++ b/gnu/services/mail.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Andy Wingo <wingo@igalia.com>
;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
+;;; Copyright © 2017 Carlo Zancanaro <carlo@zancanaro.id.au>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -33,6 +34,7 @@
#:use-module (guix packages)
#:use-module (guix gexp)
#:use-module (ice-9 match)
+ #:use-module (ice-9 format)
#:export (dovecot-service
dovecot-service-type
dovecot-configuration
@@ -53,7 +55,12 @@
opensmtpd-configuration
opensmtpd-configuration?
opensmtpd-service-type
- %default-opensmtpd-config-file))
+ %default-opensmtpd-config-file
+
+ exim-configuration
+ exim-configuration?
+ exim-service-type
+ %default-exim-config-file))
;;; Commentary:
;;;
@@ -62,6 +69,27 @@
;;;
;;; Code:
+(define (uglify-field-name field-name)
+ (let ((str (symbol->string field-name)))
+ (string-join (string-split (if (string-suffix? "?" str)
+ (substring str 0 (1- (string-length str)))
+ str)
+ #\-)
+ "_")))
+
+(define (serialize-field field-name val)
+ (format #t "~a=~a\n" (uglify-field-name field-name) val))
+
+(define (serialize-string field-name val)
+ (serialize-field field-name val))
+
+(define (space-separated-string-list? val)
+ (and (list? val)
+ (and-map (lambda (x)
+ (and (string? x) (not (string-index x #\space))))
+ val)))
+(define (serialize-space-separated-string-list field-name val)
+ (serialize-field field-name (string-join val " ")))
(define (comma-separated-string-list? val)
(and (list? val)
@@ -71,6 +99,12 @@
(define (serialize-comma-separated-string-list field-name val)
(serialize-field field-name (string-join val ",")))
+(define (file-name? val)
+ (and (string? val)
+ (string-prefix? "/" val)))
+(define (serialize-file-name field-name val)
+ (serialize-string field-name val))
+
(define (colon-separated-file-name-list? val)
(and (list? val)
;; Trailing slashes not needed and not
@@ -78,6 +112,9 @@
(define (serialize-colon-separated-file-name-list field-name val)
(serialize-field field-name (string-join val ":")))
+(define (serialize-boolean field-name val)
+ (serialize-string field-name (if val "yes" "no")))
+
(define (non-negative-integer? val)
(and (exact-integer? val) (not (negative? val))))
(define (serialize-non-negative-integer field-name val)
@@ -158,8 +195,9 @@
(define-configuration unix-listener-configuration
(path
- (file-name (configuration-missing-field 'unix-listener 'path))
- "The file name on which to listen.")
+ (string (configuration-missing-field 'unix-listener 'path))
+ "Path to the file, relative to @code{base-dir} field. This is also used as
+the section name.")
(mode
(string "0600")
"The access mode for the socket.")
@@ -177,8 +215,9 @@
(define-configuration fifo-listener-configuration
(path
- (file-name (configuration-missing-field 'fifo-listener 'path))
- "The file name on which to listen.")
+ (string (configuration-missing-field 'fifo-listener 'path))
+ "Path to the file, relative to @code{base-dir} field. This is also used as
+the section name.")
(mode
(string "0600")
"The access mode for the socket.")
@@ -1620,3 +1659,96 @@ accept from local for any relay
(compose list opensmtpd-configuration-package))
(service-extension shepherd-root-service-type
opensmtpd-shepherd-service)))))
+
+
+;;;
+;;; Exim.
+;;;
+
+(define-record-type* <exim-configuration> exim-configuration
+ make-exim-configuration
+ exim-configuration?
+ (package exim-configuration-package ;<package>
+ (default exim))
+ (config-file exim-configuration-config-file ;file-like
+ (default #f))
+ (aliases exim-configuration-aliases ;; list of lists
+ (default '())))
+
+(define %exim-accounts
+ (list (user-group
+ (name "exim")
+ (system? #t))
+ (user-account
+ (name "exim")
+ (group "exim")
+ (system? #t)
+ (comment "Exim Daemon")
+ (home-directory "/var/empty")
+ (shell (file-append shadow "/sbin/nologin")))))
+
+(define (exim-computed-config-file package config-file)
+ (computed-file "exim.conf"
+ #~(call-with-output-file #$output
+ (lambda (port)
+ (format port "
+exim_user = exim
+exim_group = exim
+.include ~a"
+ #$(or config-file
+ (file-append package "/etc/exim.conf")))))))
+
+(define exim-shepherd-service
+ (match-lambda
+ (($ <exim-configuration> package config-file aliases)
+ (list (shepherd-service
+ (provision '(exim mta))
+ (documentation "Run the exim daemon.")
+ (requirement '(networking))
+ (start #~(make-forkexec-constructor
+ '(#$(file-append package "/bin/exim")
+ "-bd" "-v" "-C"
+ #$(exim-computed-config-file package config-file))))
+ (stop #~(make-kill-destructor)))))))
+
+(define exim-activation
+ (match-lambda
+ (($ <exim-configuration> package config-file aliases)
+ (with-imported-modules '((guix build utils))
+ #~(begin
+ (use-modules (guix build utils))
+
+ (let ((uid (passwd:uid (getpw "exim")))
+ (gid (group:gid (getgr "exim"))))
+ (mkdir-p "/var/spool/exim")
+ (chown "/var/spool/exim" uid gid))
+
+ (zero? (system* #$(file-append package "/bin/exim")
+ "-bV" "-C" #$(exim-computed-config-file package config-file))))))))
+
+(define exim-etc
+ (match-lambda
+ (($ <exim-configuration> package config-file aliases)
+ `(("aliases" ,(plain-file "aliases"
+ ;; Ideally we'd use a format string like
+ ;; "~:{~a: ~{~a~^,~}\n~}", but it gives a
+ ;; warning that I can't figure out how to fix,
+ ;; so we'll just use string-join below instead.
+ (format #f "~:{~a: ~a\n~}"
+ (map (lambda (entry)
+ (list (car entry)
+ (string-join (cdr entry) ",")))
+ aliases))))))))
+
+(define exim-profile
+ (compose list exim-configuration-package))
+
+(define exim-service-type
+ (service-type
+ (name 'exim)
+ (extensions
+ (list (service-extension shepherd-root-service-type exim-shepherd-service)
+ (service-extension account-service-type (const %exim-accounts))
+ (service-extension activation-service-type exim-activation)
+ (service-extension profile-service-type exim-profile)
+ (service-extension etc-service-type exim-etc)))))
diff --git a/gnu/services/ssh.scm b/gnu/services/ssh.scm
index c1d42e70ce..d8a3ad35ad 100644
--- a/gnu/services/ssh.scm
+++ b/gnu/services/ssh.scm
@@ -274,12 +274,14 @@ The other options should be self-descriptive."
(default #t))
(public-key-authentication? openssh-configuration-public-key-authentication?
(default #t)) ;Boolean
- (rsa-authentication? openssh-configuration-rsa-authentication? ;Boolean
- (default #t))
(x11-forwarding? openssh-configuration-x11-forwarding? ;Boolean
(default #f))
- (protocol-number openssh-configuration-protocol-number ;integer
- (default 2)))
+ (challenge-response-authentication? openssh-challenge-response-authentication?
+ (default #f)) ;Boolean
+ (use-pam? openssh-configuration-use-pam?
+ (default #t)) ;Boolean
+ (print-last-log? openssh-configuration-print-last-log?
+ (default #t))) ;Boolean
(define %openssh-accounts
(list (user-group (name "sshd") (system? #t))
@@ -298,6 +300,14 @@ The other options should be self-descriptive."
(mkdir-p "/etc/ssh")
(mkdir-p (dirname #$(openssh-configuration-pid-file config)))
+ (define (touch file-name)
+ (call-with-output-file file-name (const #t)))
+
+ (let ((lastlog "/var/log/lastlog"))
+ (when #$(openssh-configuration-print-last-log? config)
+ (unless (file-exists? lastlog)
+ (touch lastlog))))
+
;; Generate missing host keys.
(system* (string-append #$(openssh-configuration-openssh config)
"/bin/ssh-keygen") "-A")))
@@ -309,9 +319,6 @@ The other options should be self-descriptive."
#~(call-with-output-file #$output
(lambda (port)
(display "# Generated by 'openssh-service'.\n" port)
- (format port "Protocol ~a\n"
- #$(if (eq? (openssh-configuration-protocol-number config) 1)
- "1" "2"))
(format port "Port ~a\n"
#$(number->string (openssh-configuration-port-number config)))
(format port "PermitRootLogin ~a\n"
@@ -328,14 +335,20 @@ The other options should be self-descriptive."
(format port "PubkeyAuthentication ~a\n"
#$(if (openssh-configuration-public-key-authentication? config)
"yes" "no"))
- (format port "RSAAuthentication ~a\n"
- #$(if (openssh-configuration-rsa-authentication? config)
- "yes" "no"))
(format port "X11Forwarding ~a\n"
#$(if (openssh-configuration-x11-forwarding? config)
"yes" "no"))
(format port "PidFile ~a\n"
#$(openssh-configuration-pid-file config))
+ (format port "ChallengeResponseAuthentication ~a\n"
+ #$(if (openssh-challenge-response-authentication? config)
+ "yes" "no"))
+ (format port "UsePAM ~a\n"
+ #$(if (openssh-configuration-use-pam? config)
+ "yes" "no"))
+ (format port "PrintLastLog ~a\n"
+ #$(if (openssh-configuration-print-last-log? config)
+ "yes" "no"))
#t))))
(define (openssh-shepherd-service config)
@@ -356,11 +369,20 @@ The other options should be self-descriptive."
#:pid-file #$pid-file))
(stop #~(make-kill-destructor)))))
+(define (openssh-pam-services config)
+ "Return a list of <pam-services> for sshd with CONFIG."
+ (list (unix-pam-service
+ "sshd"
+ #:allow-empty-passwords?
+ (openssh-configuration-allow-empty-passwords? config))))
+
(define openssh-service-type
(service-type (name 'openssh)
(extensions
(list (service-extension shepherd-root-service-type
openssh-shepherd-service)
+ (service-extension pam-root-service-type
+ openssh-pam-services)
(service-extension activation-service-type
openssh-activation)
(service-extension account-service-type
generated by cgit v1.2.3 (git 2.45.2) at 2024-08-04 14:18:29 +0000