diff options
Diffstat (limited to 'gnu/services')
| -rw-r--r-- | gnu/services/configuration.scm | 40 | ||||
| -rw-r--r-- | gnu/services/cups.scm | 32 | ||||
| -rw-r--r-- | gnu/services/kerberos.scm | 15 | ||||
| -rw-r--r-- | gnu/services/mail.scm | 142 | ||||
| -rw-r--r-- | gnu/services/ssh.scm | 42 |
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 |