aboutsummaryrefslogtreecommitdiff
path: root/gnu/services
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2019-06-13 13:24:35 +0200
committerLudovic Courtès <ludo@gnu.org>2019-06-13 13:24:35 +0200
commitd9bbfe042e06df35c12e4b8f53bfb1889cba90bf (patch)
tree9f34077cd824e8955be4ed2b5f1a459aa8076489 /gnu/services
parentf87a7cc60e058d2e07560d0d602747b567d9dce4 (diff)
parent47f2168b6fabb105565526b2a1243eeeb13008fe (diff)
downloadpatches-d9bbfe042e06df35c12e4b8f53bfb1889cba90bf.tar
patches-d9bbfe042e06df35c12e4b8f53bfb1889cba90bf.tar.gz
Merge branch 'master' into core-updates
Diffstat (limited to 'gnu/services')
-rw-r--r--gnu/services/auditd.scm54
-rw-r--r--gnu/services/base.scm117
-rw-r--r--gnu/services/cgit.scm3
-rw-r--r--gnu/services/cups.scm2
-rw-r--r--gnu/services/docker.scm61
-rw-r--r--gnu/services/getmail.scm380
-rw-r--r--gnu/services/herd.scm4
-rw-r--r--gnu/services/nix.scm113
-rw-r--r--gnu/services/sddm.scm16
-rw-r--r--gnu/services/web.scm368
-rw-r--r--gnu/services/xorg.scm2
11 files changed, 1068 insertions, 52 deletions
diff --git a/gnu/services/auditd.scm b/gnu/services/auditd.scm
new file mode 100644
index 0000000000..8a9292015f
--- /dev/null
+++ b/gnu/services/auditd.scm
@@ -0,0 +1,54 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2019 Danny Milosavljevic <dannym@scratchpost.org>
+;;;
+;;; 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 auditd)
+ #:use-module (gnu services)
+ #:use-module (gnu services configuration)
+ #:use-module (gnu services base)
+ #:use-module (gnu services shepherd)
+ #:use-module (gnu packages admin)
+ #:use-module (guix records)
+ #:use-module (guix gexp)
+ #:use-module (guix packages)
+ #:export (auditd-configuration
+ auditd-service-type))
+
+; /etc/audit/audit.rules
+
+(define-configuration auditd-configuration
+ (audit
+ (package audit)
+ "Audit package."))
+
+(define (auditd-shepherd-service config)
+ (let* ((audit (auditd-configuration-audit config)))
+ (list (shepherd-service
+ (documentation "Auditd allows you to audit file system accesses.")
+ (provision '(auditd))
+ (start #~(make-forkexec-constructor
+ (list (string-append #$audit "/sbin/auditd"))))
+ (stop #~(make-kill-destructor))))))
+
+(define auditd-service-type
+ (service-type (name 'auditd)
+ (description "Allows auditing file system accesses.")
+ (extensions
+ (list
+ (service-extension shepherd-root-service-type
+ auditd-shepherd-service)))
+ (default-value (auditd-configuration))))
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index f709ca5519..3c1827fb70 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -28,6 +28,7 @@
#:use-module (guix store)
#:use-module (guix deprecation)
#:use-module (gnu services)
+ #:use-module (gnu services admin)
#:use-module (gnu services shepherd)
#:use-module (gnu system pam)
#:use-module (gnu system shadow) ; 'user-account', etc.
@@ -142,7 +143,8 @@
guix-publish-configuration-guix
guix-publish-configuration-port
guix-publish-configuration-host
- guix-publish-configuration-compression-level
+ guix-publish-configuration-compression
+ guix-publish-configuration-compression-level ;deprecated
guix-publish-configuration-nar-path
guix-publish-configuration-cache
guix-publish-configuration-ttl
@@ -1748,8 +1750,12 @@ archive' public keys, with GUIX."
(default 80))
(host guix-publish-configuration-host ;string
(default "localhost"))
- (compression-level guix-publish-configuration-compression-level ;integer
- (default 3))
+ (compression guix-publish-configuration-compression
+ (thunked)
+ (default (default-compression this-record
+ (current-source-location))))
+ (compression-level %guix-publish-configuration-compression-level ;deprecated
+ (default #f))
(nar-path guix-publish-configuration-nar-path ;string
(default "nar"))
(cache guix-publish-configuration-cache ;#f | string
@@ -1759,42 +1765,69 @@ archive' public keys, with GUIX."
(ttl guix-publish-configuration-ttl ;#f | integer
(default #f)))
-(define guix-publish-shepherd-service
- (match-lambda
- (($ <guix-publish-configuration> guix port host compression
- nar-path cache workers ttl)
- (list (shepherd-service
- (provision '(guix-publish))
- (requirement '(guix-daemon))
- (start #~(make-forkexec-constructor
- (list #$(file-append guix "/bin/guix")
- "publish" "-u" "guix-publish"
- "-p" #$(number->string port)
- "-C" #$(number->string compression)
- (string-append "--nar-path=" #$nar-path)
- (string-append "--listen=" #$host)
- #$@(if workers
- #~((string-append "--workers="
- #$(number->string
- workers)))
- #~())
- #$@(if ttl
- #~((string-append "--ttl="
- #$(number->string ttl)
- "s"))
- #~())
- #$@(if cache
- #~((string-append "--cache=" #$cache))
- #~()))
-
- ;; Make sure we run in a UTF-8 locale so we can produce
- ;; nars for packages that contain UTF-8 file names such
- ;; as 'nss-certs'. See <https://bugs.gnu.org/26948>.
- #:environment-variables
- (list (string-append "GUIX_LOCPATH="
- #$glibc-utf8-locales "/lib/locale")
- "LC_ALL=en_US.utf8")))
- (stop #~(make-kill-destructor)))))))
+(define-deprecated (guix-publish-configuration-compression-level config)
+ "Return a compression level, the old way."
+ (match (guix-publish-configuration-compression config)
+ (((_ level) _ ...) level)))
+
+(define (default-compression config properties)
+ "Return the default 'guix publish' compression according to CONFIG, and
+raise a deprecation warning if the 'compression-level' field was used."
+ (match (%guix-publish-configuration-compression-level config)
+ (#f
+ '(("gzip" 3)))
+ (level
+ (warn-about-deprecation 'compression-level properties
+ #:replacement 'compression)
+ `(("gzip" ,level)))))
+
+(define (guix-publish-shepherd-service config)
+ (define (config->compression-options config)
+ (match (guix-publish-configuration-compression config)
+ (() ;empty list means "no compression"
+ '("-C0"))
+ (lst
+ (append-map (match-lambda
+ ((type level)
+ `("-C" ,(string-append type ":"
+ (number->string level)))))
+ lst))))
+
+ (match-record config <guix-publish-configuration>
+ (guix port host nar-path cache workers ttl)
+ (list (shepherd-service
+ (provision '(guix-publish))
+ (requirement '(guix-daemon))
+ (start #~(make-forkexec-constructor
+ (list #$(file-append guix "/bin/guix")
+ "publish" "-u" "guix-publish"
+ "-p" #$(number->string port)
+ #$@(config->compression-options config)
+ (string-append "--nar-path=" #$nar-path)
+ (string-append "--listen=" #$host)
+ #$@(if workers
+ #~((string-append "--workers="
+ #$(number->string
+ workers)))
+ #~())
+ #$@(if ttl
+ #~((string-append "--ttl="
+ #$(number->string ttl)
+ "s"))
+ #~())
+ #$@(if cache
+ #~((string-append "--cache=" #$cache))
+ #~()))
+
+ ;; Make sure we run in a UTF-8 locale so we can produce
+ ;; nars for packages that contain UTF-8 file names such
+ ;; as 'nss-certs'. See <https://bugs.gnu.org/26948>.
+ #:environment-variables
+ (list (string-append "GUIX_LOCPATH="
+ #$glibc-utf8-locales "/lib/locale")
+ "LC_ALL=en_US.utf8")
+ #:log-file "/var/log/guix-publish.log"))
+ (stop #~(make-kill-destructor))))))
(define %guix-publish-accounts
(list (user-group (name "guix-publish") (system? #t))
@@ -1806,6 +1839,10 @@ archive' public keys, with GUIX."
(home-directory "/var/empty")
(shell (file-append shadow "/sbin/nologin")))))
+(define %guix-publish-log-rotations
+ (list (log-rotation
+ (files (list "/var/log/guix-publish.log")))))
+
(define (guix-publish-activation config)
(let ((cache (guix-publish-configuration-cache config)))
(if cache
@@ -1827,6 +1864,8 @@ archive' public keys, with GUIX."
guix-publish-shepherd-service)
(service-extension account-service-type
(const %guix-publish-accounts))
+ (service-extension rottlog-service-type
+ (const %guix-publish-log-rotations))
(service-extension activation-service-type
guix-publish-activation)))
(default-value (guix-publish-configuration))
diff --git a/gnu/services/cgit.scm b/gnu/services/cgit.scm
index a84a2dadb2..94ca9e281a 100644
--- a/gnu/services/cgit.scm
+++ b/gnu/services/cgit.scm
@@ -2,6 +2,7 @@
;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
;;; Copyright © 2018 Christopher Baines <mail@cbaines.net>
+;;; Copyright © 2019 Arun Isaac <arunisaac@systemreboot.net>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -581,7 +582,7 @@ removed for the URL and name.")
(root-readme
(string "")
"The content of the file specified with this option will be included
-verbatim below thef \"about\" link on the repository index page.")
+verbatim below the \"about\" link on the repository index page.")
(root-title
(string "")
"Text printed as heading on the repository index page.")
diff --git a/gnu/services/cups.scm b/gnu/services/cups.scm
index 9125139ef3..9d21b6e70c 100644
--- a/gnu/services/cups.scm
+++ b/gnu/services/cups.scm
@@ -2,6 +2,7 @@
;;; Copyright © 2016 Andy Wingo <wingo@pobox.com>
;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2019 Alex Griffin <a@ajgrf.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -895,6 +896,7 @@ IPP specifications.")
(mkdir-p/perms "/var/spool/cups" user #o755)
(mkdir-p/perms "/var/spool/cups/tmp" user #o755)
(mkdir-p/perms "/var/log/cups" user #o755)
+ (mkdir-p/perms "/var/cache/cups" user #o770)
(mkdir-p/perms "/etc/cups" user #o755)
(mkdir-p/perms "/etc/cups/ssl" user #o700)
;; This certificate is used for HTTPS connections to the CUPS web
diff --git a/gnu/services/docker.scm b/gnu/services/docker.scm
index 94a04c8996..04f9127346 100644
--- a/gnu/services/docker.scm
+++ b/gnu/services/docker.scm
@@ -24,12 +24,14 @@
#:use-module (gnu services shepherd)
#:use-module (gnu system shadow)
#:use-module (gnu packages docker)
+ #:use-module (gnu packages linux) ;singularity
#:use-module (guix records)
#:use-module (guix gexp)
#:use-module (guix packages)
#:export (docker-configuration
- docker-service-type))
+ docker-service-type
+ singularity-service-type))
;;; We're not using serialize-configuration, but we must define this because
;;; the define-configuration macro validates it exists.
@@ -120,3 +122,60 @@ bundles in Docker containers.")
(service-extension account-service-type
(const %docker-accounts))))
(default-value (docker-configuration))))
+
+
+;;;
+;;; Singularity.
+;;;
+
+(define %singularity-activation
+ (with-imported-modules '((guix build utils))
+ #~(begin
+ (use-modules (guix build utils))
+
+ (define %mount-directory
+ "/var/singularity/mnt/")
+
+ ;; Create the directories that Singularity 2.6 expects to find. Make
+ ;; them #o755 like the 'install-data-hook' rule in 'Makefile.am' of
+ ;; Singularity 2.6.1.
+ (for-each (lambda (directory)
+ (let ((directory (string-append %mount-directory
+ directory)))
+ (mkdir-p directory)
+ (chmod directory #o755)))
+ '("container" "final" "overlay" "session"))
+ (chmod %mount-directory #o755))))
+
+(define (singularity-setuid-programs singularity)
+ "Return the setuid-root programs that SINGULARITY needs."
+ (define helpers
+ ;; The helpers, under a meaningful name.
+ (computed-file "singularity-setuid-helpers"
+ #~(begin
+ (mkdir #$output)
+ (for-each (lambda (program)
+ (symlink (string-append #$singularity
+ "/libexec/singularity"
+ "/bin/"
+ program "-suid")
+ (string-append #$output
+ "/singularity-"
+ program
+ "-helper")))
+ '("action" "mount" "start")))))
+
+ (list (file-append helpers "/singularity-action-helper")
+ (file-append helpers "/singularity-mount-helper")
+ (file-append helpers "/singularity-start-helper")))
+
+(define singularity-service-type
+ (service-type (name 'singularity)
+ (description
+ "Install the Singularity application bundle tool.")
+ (extensions
+ (list (service-extension setuid-program-service-type
+ singularity-setuid-programs)
+ (service-extension activation-service-type
+ (const %singularity-activation))))
+ (default-value singularity)))
diff --git a/gnu/services/getmail.scm b/gnu/services/getmail.scm
new file mode 100644
index 0000000000..b807bb3a5d
--- /dev/null
+++ b/gnu/services/getmail.scm
@@ -0,0 +1,380 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2019 Christopher Baines <mail@cbaines.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 getmail)
+ #:use-module (gnu services)
+ #:use-module (gnu services base)
+ #:use-module (gnu services configuration)
+ #:use-module (gnu services shepherd)
+ #:use-module (gnu system pam)
+ #:use-module (gnu system shadow)
+ #:use-module (gnu packages mail)
+ #:use-module (gnu packages admin)
+ #:use-module (gnu packages tls)
+ #:use-module (guix records)
+ #:use-module (guix store)
+ #:use-module (guix packages)
+ #:use-module (guix gexp)
+ #:use-module (ice-9 match)
+ #:use-module (ice-9 format)
+ #:use-module (srfi srfi-1)
+ #:export (getmail-retriever-configuration
+ getmail-retriever-configuration-extra-parameters
+ getmail-destination-configuration
+ getmail-options-configuration
+ getmail-configuration-file
+ getmail-configuration
+ getmail-service-type))
+
+;;; Commentary:
+;;;
+;;; Service for the getmail mail retriever.
+;;;
+;;; 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)
+ #~(let ((val '#$val))
+ (format #f "~a = ~a\n"
+ #$(uglify-field-name field-name)
+ (cond
+ ((list? val)
+ (string-append
+ "("
+ (string-concatenate
+ (map (lambda (list-val)
+ (format #f "\"~a\", " list-val))
+ val))
+ ")"))
+ (else
+ val)))))
+
+(define (serialize-string field-name val)
+ (if (string=? val "")
+ ""
+ (serialize-field field-name val)))
+
+(define (string-or-filelike? val)
+ (or (string? val)
+ (file-like? val)))
+(define (serialize-string-or-filelike field-name val)
+ (if (equal? val "")
+ ""
+ (serialize-field field-name val)))
+
+(define (serialize-boolean field-name val)
+ (serialize-field field-name (if val "true" "false")))
+
+(define (non-negative-integer? val)
+ (and (exact-integer? val) (not (negative? val))))
+(define (serialize-non-negative-integer field-name val)
+ (serialize-field field-name val))
+
+(define serialize-list serialize-field)
+
+(define parameter-alist? list?)
+(define (serialize-parameter-alist field-name val)
+ #~(string-append
+ #$@(map (match-lambda
+ ((key . value)
+ (serialize-field key value)))
+ val)))
+
+(define (serialize-getmail-retriever-configuration field-name val)
+ (serialize-configuration val getmail-retriever-configuration-fields))
+
+(define-configuration getmail-retriever-configuration
+ (type
+ (string "SimpleIMAPSSLRetriever")
+ "The type of mail retriever to use. Valid values include
+@samp{passwd} and @samp{static}.")
+ (server
+ (string 'unset)
+ "Space separated list of arguments to the userdb driver.")
+ (username
+ (string 'unset)
+ "Space separated list of arguments to the userdb driver.")
+ (port
+ (non-negative-integer #f)
+ "Space separated list of arguments to the userdb driver.")
+ (password
+ (string "")
+ "Override fields from passwd.")
+ (password-command
+ (list '())
+ "Override fields from passwd.")
+ (keyfile
+ (string "")
+ "PEM-formatted key file to use for the TLS negotiation")
+ (certfile
+ (string "")
+ "PEM-formatted certificate file to use for the TLS negotiation")
+ (ca-certs
+ (string "")
+ "CA certificates to use")
+ (extra-parameters
+ (parameter-alist '())
+ "Extra retriever parameters"))
+
+(define (serialize-getmail-destination-configuration field-name val)
+ (serialize-configuration val getmail-destination-configuration-fields))
+
+(define-configuration getmail-destination-configuration
+ (type
+ (string 'unset)
+ "The type of mail destination. Valid values include @samp{Maildir},
+@samp{Mboxrd} and @samp{MDA_external}.")
+ (path
+ (string-or-filelike "")
+ "The path option for the mail destination. The behaviour depends on the
+chosen type.")
+ (extra-parameters
+ (parameter-alist '())
+ "Extra destination parameters"))
+
+(define (serialize-getmail-options-configuration field-name val)
+ (serialize-configuration val getmail-options-configuration-fields))
+
+(define-configuration getmail-options-configuration
+ (verbose
+ (non-negative-integer 1)
+ "If set to @samp{0}, getmail will only print warnings and errors. A value
+of @samp{1} means that messages will be printed about retrieving and deleting
+messages. If set to @samp{2}, getmail will print messages about each of it's
+actions.")
+ (read-all
+ (boolean #t)
+ "If true, getmail will retrieve all available messages. Otherwise it will
+only retrieve messages it hasn't seen previously.")
+ (delete
+ (boolean #f)
+ "If set to true, messages will be deleted from the server after retrieving
+and successfully delivering them. Otherwise, messages will be left on the
+server.")
+ (delete-after
+ (non-negative-integer 0)
+ "Getmail will delete messages this number of days after seeing them, if
+they have not been delivered. This means messages will be left on the server
+this number of days after delivering them. A value of @samp{0} disabled this
+feature.")
+ (delete-bigger-than
+ (non-negative-integer 0)
+ "Delete messages larger than this of bytes after retrieving them, even if
+the delete and delete-after options are disabled. A value of @samp{0}
+disables this feature.")
+ (max-bytes-per-session
+ (non-negative-integer 0)
+ "Retrieve messages totalling up to this number of bytes before closing the
+session with the server. A value of @samp{0} disables this feature.")
+ (max-message-size
+ (non-negative-integer 0)
+ "Don't retrieve messages larger than this number of bytes. A value of
+@samp{0} disables this feature.")
+ (delivered-to
+ (boolean #t)
+ "If true, getmail will add a Delivered-To header to messages.")
+ (received
+ (boolean #t)
+ "If set, getmail adds a Received header to the messages.")
+ (message-log
+ (string "")
+ "Getmail will record a log of its actions to the named file. A value of
+@samp{\"\"} disables this feature.")
+ (message-log-syslog
+ (boolean #t)
+ "If true, getmail will record a log of its actions using the system
+logger.")
+ (message-log-verbose
+ (boolean #t)
+ "If true, getmail will log information about messages not retrieved and the
+reason for not retrieving them, as well as starting and ending information
+lines.")
+ (extra-parameters
+ (parameter-alist '())
+ "Extra options to include."))
+
+(define (serialize-getmail-configuration-file field-name val)
+ (match val
+ (($ <getmail-configuration-file> location
+ retriever destination options)
+ #~(string-append
+ "[retriever]\n"
+ #$(serialize-getmail-retriever-configuration #f retriever)
+ "\n[destination]\n"
+ #$(serialize-getmail-destination-configuration #f destination)
+ "\n[options]\n"
+ #$(serialize-getmail-options-configuration #f options)))))
+
+(define-configuration getmail-configuration-file
+ (retriever
+ (getmail-retriever-configuration (getmail-retriever-configuration))
+ "What mail account to retrieve mail from, and how to access that account.")
+ (destination
+ (getmail-destination-configuration (getmail-destination-configuration))
+ "What to do with retrieved messages.")
+ (options
+ (getmail-options-configuration (getmail-options-configuration))
+ "Configure getmail."))
+
+(define (serialize-symbol field-name val) "")
+(define (serialize-getmail-configuration field-name val) "")
+
+(define-configuration getmail-configuration
+ (name
+ (symbol "unset")
+ "A symbol to identify the getmail service.")
+ (package
+ (package getmail)
+ "The getmail package to use.")
+ (user
+ (string "getmail")
+ "The user to run getmail as.")
+ (group
+ (string "getmail")
+ "The group to run getmail as.")
+ (directory
+ (string "/var/lib/getmail/default")
+ "The getmail directory to use.")
+ (rcfile
+ (getmail-configuration-file (getmail-configuration-file))
+ "The getmail configuration file to use.")
+ (idle
+ (list '())
+ "A list of mailboxes that getmail should wait on the server for new mail
+notifications. This depends on the server supporting the IDLE extension.")
+ (environment-variables
+ (list '())
+ "Environment variables to set for getmail."))
+
+(define (generate-getmail-documentation)
+ (generate-documentation
+ `((getmail-configuration
+ ,getmail-configuration-fields
+ (rcfile getmail-configuration-file))
+ (getmail-configuration-file
+ ,getmail-configuration-file-fields
+ (retriever getmail-retriever-configuration)
+ (destination getmail-destination-configuration)
+ (options getmail-options-configuration))
+ (getmail-retriever-configuration ,getmail-retriever-configuration-fields)
+ (getmail-destination-configuration ,getmail-destination-configuration-fields)
+ (getmail-options-configuration ,getmail-options-configuration-fields))
+ 'getmail-configuration))
+
+(define-gexp-compiler (getmail-configuration-file-compiler
+ (rcfile <getmail-configuration-file>) system target)
+ (gexp->derivation
+ "getmailrc"
+ #~(call-with-output-file #$output
+ (lambda (port)
+ (display #$(serialize-getmail-configuration-file #f rcfile)
+ port)))
+ #:system system
+ #:target target))
+
+(define (getmail-accounts configs)
+ (let ((users (delete-duplicates
+ (map getmail-configuration-user
+ configs)))
+ (groups (delete-duplicates
+ (map getmail-configuration-group
+ configs))))
+ (append
+ (map (lambda (group)
+ (user-group
+ (name group)
+ (system? #t)))
+ groups)
+ (map (lambda (user)
+ (user-account
+ (name user)
+ (group (getmail-configuration-group
+ (find (lambda (config)
+ (and
+ (string=? user (getmail-configuration-user config))
+ (getmail-configuration-group config)))
+ configs)))
+ (system? #t)
+ (comment "Getmail user")
+ (home-directory "/var/empty")
+ (shell (file-append shadow "/sbin/nologin"))))
+ users))))
+
+(define (getmail-activation configs)
+ "Return the activation GEXP for CONFIGS."
+ (with-imported-modules '((guix build utils))
+ #~(begin
+ (use-modules (guix build utils))
+ #$@(map
+ (lambda (config)
+ #~(let* ((pw (getpw #$(getmail-configuration-user config)))
+ (uid (passwd:uid pw))
+ (gid (passwd:gid pw))
+ (getmaildir #$(getmail-configuration-directory config)))
+ (mkdir-p getmaildir)
+ (chown getmaildir uid gid)))
+ configs))))
+
+(define (getmail-shepherd-services configs)
+ "Return a list of <shepherd-service> for CONFIGS."
+ (map (match-lambda
+ (($ <getmail-configuration> location name package
+ user group directory rcfile idle
+ environment-variables)
+ (shepherd-service
+ (documentation "Run getmail.")
+ (provision (list (symbol-append 'getmail- name)))
+ (requirement '(networking))
+ (start #~(make-forkexec-constructor
+ `(#$(file-append package "/bin/getmail")
+ ,(string-append "--getmaildir=" #$directory)
+ #$@(map (lambda (idle)
+ (string-append "--idle=" idle))
+ idle)
+ ,(string-append "--rcfile=" #$rcfile))
+ #:user #$user
+ #:group #$group
+ #:environment-variables
+ (list #$@environment-variables)
+ #:log-file
+ #$(string-append "/var/log/getmail-"
+ (symbol->string name)))))))
+ configs))
+
+(define getmail-service-type
+ (service-type
+ (name 'getmail)
+ (extensions
+ (list (service-extension shepherd-root-service-type
+ getmail-shepherd-services)
+ (service-extension activation-service-type
+ getmail-activation)
+ (service-extension account-service-type
+ getmail-accounts)))
+ (description
+ "Run @command{getmail}, a mail retriever program.")
+ (default-value '())
+ (compose concatenate)
+ (extend append)))
diff --git a/gnu/services/herd.scm b/gnu/services/herd.scm
index 9fe757fb73..0008746fe9 100644
--- a/gnu/services/herd.scm
+++ b/gnu/services/herd.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;;
;;; This file is part of GNU Guix.
@@ -76,7 +76,7 @@ return the socket."
(catch 'system-error
(lambda ()
(connect sock address)
- (setvbuf sock _IOFBF 1024)
+ (setvbuf sock 'block 1024)
sock)
(lambda args
(close-port sock)
diff --git a/gnu/services/nix.scm b/gnu/services/nix.scm
new file mode 100644
index 0000000000..dfe33991d0
--- /dev/null
+++ b/gnu/services/nix.scm
@@ -0,0 +1,113 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2019 Oleg Pykhalov <go.wigust@gmail.com>
+;;;
+;;; 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 nix)
+ #:use-module (gnu packages admin)
+ #:use-module (gnu packages package-management)
+ #:use-module (gnu services base)
+ #:use-module (gnu services configuration)
+ #:use-module (gnu services shepherd)
+ #:use-module (gnu services web)
+ #:use-module (gnu services)
+ #:use-module (gnu system shadow)
+ #:use-module (guix gexp)
+ #:use-module (guix packages)
+ #:use-module (guix records)
+ #:use-module (guix store)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-26)
+ #:export (nix-service-type))
+
+;;; Commentary:
+;;;
+;;; This module provides a service definition for the Nix daemon.
+;;;
+;;; Code:
+
+
+;;;
+;;; Accounts
+;;;
+
+;; Copied from gnu/services/base.scm
+(define* (nix-build-accounts count #:key
+ (group "nixbld")
+ (shadow shadow))
+ "Return a list of COUNT user accounts for Nix build users with the given
+GID."
+ (unfold (cut > <> count)
+ (lambda (n)
+ (user-account
+ (name (format #f "nixbld~2,'0d" n))
+ (system? #t)
+ (group group)
+ (supplementary-groups (list group "kvm"))
+ (comment (format #f "Nix Build User ~2d" n))
+ (home-directory "/var/empty")
+ (shell (file-append shadow "/sbin/nologin"))))
+ 1+
+ 1))
+(define (nix-accounts _)
+ "Return the user accounts and user groups."
+ (cons (user-group
+ (name "nixbld")
+ (system? #t)
+
+ ;; Use a fixed GID so that we can create the store with the right
+ ;; owner.
+ (id 40000))
+ (nix-build-accounts 10 #:group "nixbld")))
+
+(define (nix-activation _)
+ "Return the activation gexp."
+ (with-imported-modules '((guix build utils))
+ #~(begin
+ (use-modules (guix build utils)
+ (srfi srfi-26))
+ (for-each (cut mkdir-p <>) '("/nix/store" "/nix/var/log"
+ "/nix/var/nix/gcroots/per-user"
+ "/nix/var/nix/profiles/per-user"))
+ (chown "/nix/store"
+ (passwd:uid (getpw "root")) (group:gid (getpw "nixbld01")))
+ (chmod "/nix/store" #o775)
+ (for-each (cut chmod <> #o777) '("/nix/var/nix/profiles"
+ "/nix/var/nix/profiles/per-user")))))
+
+(define (nix-shepherd-service _)
+ "Return a <shepherd-service> for Nix."
+ (list
+ (shepherd-service
+ (provision '(nix-daemon))
+ (documentation "Run nix-daemon.")
+ (requirement '())
+ (start #~(make-forkexec-constructor
+ (list (string-append #$nix "/bin/nix-daemon"))))
+ (respawn? #f)
+ (stop #~(make-kill-destructor)))))
+
+(define nix-service-type
+ (service-type
+ (name 'nix)
+ (extensions
+ (list (service-extension shepherd-root-service-type nix-shepherd-service)
+ (service-extension account-service-type nix-accounts)
+ (service-extension activation-service-type nix-activation)))
+ (default-value '())
+ (description "Run the Nix daemon.")))
+
+;;; nix.scm ends here
diff --git a/gnu/services/sddm.scm b/gnu/services/sddm.scm
index b433c59e12..b0e6d40260 100644
--- a/gnu/services/sddm.scm
+++ b/gnu/services/sddm.scm
@@ -175,7 +175,7 @@ Relogin=" (if (sddm-configuration-relogin? config)
(define (sddm-etc-service config)
(list `("sddm.conf" ,(sddm-configuration-file config))))
-(define (sddm-pam-service)
+(define (sddm-pam-service config)
"Return a PAM service for @command{sddm}."
(pam-service
(name "sddm")
@@ -190,7 +190,9 @@ Relogin=" (if (sddm-configuration-relogin? config)
(pam-entry
(control "required")
(module "pam_succeed_if.so")
- (arguments (list "uid >= 1000" "quiet")))
+ (arguments (list (string-append "uid >= "
+ (number->string (sddm-configuration-minimum-uid config)))
+ "quiet")))
;; should be factored out into system-auth
(pam-entry
(control "required")
@@ -249,7 +251,7 @@ Relogin=" (if (sddm-configuration-relogin? config)
(control "required")
(module "pam_unix.so"))))))
-(define (sddm-autologin-pam-service)
+(define (sddm-autologin-pam-service config)
"Return a PAM service for @command{sddm-autologin}"
(pam-service
(name "sddm-autologin")
@@ -261,7 +263,9 @@ Relogin=" (if (sddm-configuration-relogin? config)
(pam-entry
(control "required")
(module "pam_succeed_if.so")
- (arguments (list "uid >= 1000" "quiet")))
+ (arguments (list (string-append "uid >= "
+ (number->string (sddm-configuration-minimum-uid config)))
+ "quiet")))
(pam-entry
(control "required")
(module "pam_permit.so"))))
@@ -282,9 +286,9 @@ Relogin=" (if (sddm-configuration-relogin? config)
(module "sddm"))))))
(define (sddm-pam-services config)
- (list (sddm-pam-service)
+ (list (sddm-pam-service config)
(sddm-greeter-pam-service)
- (sddm-autologin-pam-service)))
+ (sddm-autologin-pam-service config)))
(define %sddm-accounts
(list (user-group (name "sddm") (system? #t))
diff --git a/gnu/services/web.scm b/gnu/services/web.scm
index 84294db53b..35efddb0ae 100644
--- a/gnu/services/web.scm
+++ b/gnu/services/web.scm
@@ -7,7 +7,7 @@
;;; Copyright © 2017 nee <nee-git@hidamari.blue>
;;; Copyright © 2017, 2018 Clément Lassieur <clement@lassieur.org>
;;; Copyright © 2018 Pierre-Antoine Rouby <pierre-antoine.rouby@inria.fr>
-;;; Copyright © 2017 Christopher Baines <mail@cbaines.net>
+;;; Copyright © 2017, 2018, 2019 Christopher Baines <mail@cbaines.net>
;;; Copyright © 2018 Marius Bakke <mbakke@fastmail.com>
;;;
;;; This file is part of GNU Guix.
@@ -29,14 +29,23 @@
#:use-module (gnu services)
#:use-module (gnu services shepherd)
#:use-module (gnu services admin)
+ #:use-module (gnu services getmail)
+ #:use-module (gnu services mail)
#:use-module (gnu system pam)
#:use-module (gnu system shadow)
#:use-module (gnu packages admin)
+ #:use-module (gnu packages databases)
#:use-module (gnu packages web)
+ #:use-module (gnu packages patchutils)
#:use-module (gnu packages php)
+ #:use-module (gnu packages python)
+ #:use-module (gnu packages gnupg)
+ #:use-module (gnu packages guile)
#:use-module (gnu packages logging)
+ #:use-module (guix packages)
#:use-module (guix records)
#:use-module (guix modules)
+ #:use-module (guix utils)
#:use-module (guix gexp)
#:use-module ((guix store) #:select (text-file))
#:use-module ((guix utils) #:select (version-major))
@@ -210,7 +219,42 @@
varnish-configuration-parameters
varnish-configuration-extra-options
- varnish-service-type))
+ varnish-service-type
+
+ <patchwork-database-configuration>
+ patchwork-database-configuration
+ patchwork-database-configuration?
+ patchwork-database-configuration-engine
+ patchwork-database-configuration-name
+ patchwork-database-configuration-user
+ patchwork-database-configuration-password
+ patchwork-database-configuration-host
+ patchwork-database-configuration-port
+
+ <patchwork-settings-module>
+ patchwork-settings-module
+ patchwork-settings-module?
+ patchwork-settings-module-database-configuration
+ patchwork-settings-module-secret-key
+ patchwork-settings-module-allowed-hosts
+ patchwork-settings-module-default-from-email
+ patchwork-settings-module-static-url
+ patchwork-settings-module-admins
+ patchwork-settings-module-debug?
+ patchwork-settings-module-enable-rest-api?
+ patchwork-settings-module-enable-xmlrpc?
+ patchwork-settings-module-force-https-links?
+ patchwork-settings-module-extra-settings
+
+ <patchwork-configuration>
+ patchwork-configuration
+ patchwork-configuration?
+ patchwork-configuration-patchwork
+ patchwork-configuration-settings-module
+ patchwork-configuration-domain
+
+ patchwork-virtualhost
+ patchwork-service-type))
;;; Commentary:
;;;
@@ -1268,3 +1312,323 @@ files.")
varnish-shepherd-service)))
(default-value
(varnish-configuration))))
+
+
+;;;
+;;; Patchwork
+;;;
+
+(define-record-type* <patchwork-database-configuration>
+ patchwork-database-configuration make-patchwork-database-configuration
+ patchwork-database-configuration?
+ (engine patchwork-database-configuration-engine
+ (default "django.db.backends.postgresql_psycopg2"))
+ (name patchwork-database-configuration-name
+ (default "patchwork"))
+ (user patchwork-database-configuration-user
+ (default "httpd"))
+ (password patchwork-database-configuration-password
+ (default ""))
+ (host patchwork-database-configuration-host
+ (default ""))
+ (port patchwork-database-configuration-port
+ (default "")))
+
+(define-record-type* <patchwork-settings-module>
+ patchwork-settings-module make-patchwork-settings-module
+ patchwork-settings-module?
+ (database-configuration patchwork-settings-module-database-configuration
+ (default (patchwork-database-configuration)))
+ (secret-key-file patchwork-settings-module-secret-key-file
+ (default "/etc/patchwork/django-secret-key"))
+ (allowed-hosts patchwork-settings-module-allowed-hosts)
+ (default-from-email patchwork-settings-module-default-from-email)
+ (static-url patchwork-settings-module-static-url
+ (default "/static/"))
+ (admins patchwork-settings-module-admins
+ (default '()))
+ (debug? patchwork-settings-module-debug?
+ (default #f))
+ (enable-rest-api? patchwork-settings-module-enable-rest-api?
+ (default #t))
+ (enable-xmlrpc? patchwork-settings-module-enable-xmlrpc?
+ (default #t))
+ (force-https-links? patchwork-settings-module-force-https-links?
+ (default #t))
+ (extra-settings patchwork-settings-module-extra-settings
+ (default "")))
+
+(define-record-type* <patchwork-configuration>
+ patchwork-configuration make-patchwork-configuration
+ patchwork-configuration?
+ (patchwork patchwork-configuration-patchwork
+ (default patchwork))
+ (domain patchwork-configuration-domain)
+ (settings-module patchwork-configuration-settings-module)
+ (static-path patchwork-configuration-static-url
+ (default "/static/"))
+ (getmail-retriever-config getmail-retriever-config))
+
+;; Django uses a Python module for configuration, so this compiler generates a
+;; Python module from the configuration record.
+(define-gexp-compiler (patchwork-settings-module-compiler
+ (file <patchwork-settings-module>) system target)
+ (match file
+ (($ <patchwork-settings-module> database-configuration secret-key-file
+ allowed-hosts default-from-email
+ static-url admins debug? enable-rest-api?
+ enable-xmlrpc? force-https-links?
+ extra-configuration)
+ (gexp->derivation
+ "patchwork-settings"
+ (with-imported-modules '((guix build utils))
+ #~(let ((output #$output))
+ (define (create-__init__.py filename)
+ (call-with-output-file filename
+ (lambda (port) (display "" port))))
+
+ (use-modules (guix build utils)
+ (srfi srfi-1))
+
+ (mkdir-p (string-append output "/guix/patchwork"))
+ (create-__init__.py
+ (string-append output "/guix/__init__.py"))
+ (create-__init__.py
+ (string-append output "/guix/patchwork/__init__.py"))
+
+ (call-with-output-file
+ (string-append output "/guix/patchwork/settings.py")
+ (lambda (port)
+ (display
+ (string-append "from patchwork.settings.base import *
+
+# Configuration from Guix
+with open('" #$secret-key-file "') as f:
+ SECRET_KEY = f.read().strip()
+
+ALLOWED_HOSTS = [
+" #$(string-concatenate
+ (map (lambda (allowed-host)
+ (string-append " '" allowed-host "'\n"))
+ allowed-hosts))
+"]
+
+ADMINS = [
+" #$(string-concatenate
+ (map (match-lambda
+ ((name email-address)
+ (string-append
+ "('" name "','" email-address "'),")))
+ admins))
+"]
+
+DEBUG = " #$(if debug? "True" "False") "
+
+ENABLE_REST_API = " #$(if enable-xmlrpc? "True" "False") "
+ENABLE_XMLRPC = " #$(if enable-xmlrpc? "True" "False") "
+
+FORCE_HTTPS_LINKS = " #$(if force-https-links? "True" "False") "
+
+DATABASES = {
+ 'default': {
+" #$(match database-configuration
+ (($ <patchwork-database-configuration>
+ engine name user password host port)
+ (string-append
+ " 'ENGINE': '" engine "',\n"
+ " 'NAME': '" name "',\n"
+ " 'USER': '" user "',\n"
+ " 'PASSWORD': '" password "',\n"
+ " 'HOST': '" host "',\n"
+ " 'PORT': '" port "',\n"))) "
+ },
+}
+
+" #$(if debug?
+ #~(string-append "STATIC_ROOT = '"
+ #$(file-append patchwork "/share/patchwork/htdocs")
+ "'")
+ #~(string-append "STATIC_URL = '" #$static-url "'")) "
+
+STATICFILES_STORAGE = (
+ 'django.contrib.staticfiles.storage.StaticFilesStorage'
+)
+
+# Guix Extra Configuration
+" #$extra-configuration "
+") port)))
+ #t))
+ #:local-build? #t))))
+
+(define patchwork-virtualhost
+ (match-lambda
+ (($ <patchwork-configuration> patchwork domain
+ settings-module static-path
+ getmail-retriever-config)
+ (define wsgi.py
+ (file-append patchwork
+ (string-append
+ "/lib/python"
+ (version-major+minor
+ (package-version python))
+ "/site-packages/patchwork/wsgi.py")))
+
+ (httpd-virtualhost
+ "*:8080"
+ `("ServerAdmin admin@example.com`
+ServerName " ,domain "
+
+LogFormat \"%v %h %l %u %t \\\"%r\\\" %>s %b \\\"%{Referer}i\\\" \\\"%{User-Agent}i\\\"\" customformat
+LogLevel info
+CustomLog \"/var/log/httpd/" ,domain "-access_log\" customformat
+
+ErrorLog /var/log/httpd/error.log
+
+WSGIScriptAlias / " ,wsgi.py "
+WSGIDaemonProcess " ,(package-name patchwork) " user=httpd group=httpd processes=1 threads=2 display-name=%{GROUP} lang='en_US.UTF-8' locale='en_US.UTF-8' python-path=" ,settings-module "
+WSGIProcessGroup " ,(package-name patchwork) "
+WSGIPassAuthorization On
+
+<Files " ,wsgi.py ">
+ Require all granted
+</Files>
+
+" ,@(if static-path
+ `("Alias " ,static-path " " ,patchwork "/share/patchwork/htdocs/")
+ '())
+"
+<Directory \"/srv/http/" ,domain "/\">
+ AllowOverride None
+ Options MultiViews Indexes SymlinksIfOwnerMatch IncludesNoExec
+ Require method GET POST OPTIONS
+</Directory>")))))
+
+(define (patchwork-httpd-configuration patchwork-configuration)
+ (list "WSGISocketPrefix /var/run/mod_wsgi"
+ (list "LoadModule wsgi_module "
+ (file-append mod-wsgi "/modules/mod_wsgi.so"))
+ (patchwork-virtualhost patchwork-configuration)))
+
+(define (patchwork-django-admin-gexp patchwork settings-module)
+ #~(lambda command
+ (let ((pid (primitive-fork))
+ (user (getpwnam "httpd")))
+ (if (eq? pid 0)
+ (dynamic-wind
+ (const #t)
+ (lambda ()
+ (setgid (passwd:gid user))
+ (setuid (passwd:uid user))
+
+ (setenv "DJANGO_SETTINGS_MODULE" "guix.patchwork.settings")
+ (setenv "PYTHONPATH" #$settings-module)
+ (primitive-exit
+ (if (zero?
+ (apply system*
+ #$(file-append patchwork "/bin/patchwork-admin")
+ command))
+ 0
+ 1)))
+ (lambda ()
+ (primitive-exit 1)))
+ (zero? (cdr (waitpid pid)))))))
+
+(define (patchwork-django-admin-action patchwork settings-module)
+ (shepherd-action
+ (name 'django-admin)
+ (documentation
+ "Run a django admin command for patchwork")
+ (procedure (patchwork-django-admin-gexp patchwork settings-module))))
+
+(define patchwork-shepherd-services
+ (match-lambda
+ (($ <patchwork-configuration> patchwork domain
+ settings-module static-path
+ getmail-retriever-config)
+ (define secret-key-file-creation-gexp
+ (if (patchwork-settings-module? settings-module)
+ (with-extensions (list guile-gcrypt)
+ #~(let ((secret-key-file
+ #$(patchwork-settings-module-secret-key-file
+ settings-module)))
+ (use-modules (guix build utils)
+ (gcrypt random))
+
+ (unless (file-exists? secret-key-file)
+ (mkdir-p (dirname secret-key-file))
+ (call-with-output-file secret-key-file
+ (lambda (port)
+ (display (random-token 30 'very-strong) port)))
+ (let* ((pw (getpwnam "httpd"))
+ (uid (passwd:uid pw))
+ (gid (passwd:gid pw)))
+ (chown secret-key-file uid gid)
+ (chmod secret-key-file #o400)))))
+ #~()))
+
+ (list (shepherd-service
+ (requirement '(postgres))
+ (provision (list (string->symbol
+ (string-append (package-name patchwork)
+ "-setup"))))
+ (start
+ #~(lambda ()
+ (define run-django-admin-command
+ #$(patchwork-django-admin-gexp patchwork
+ settings-module))
+
+ #$secret-key-file-creation-gexp
+
+ (run-django-admin-command "migrate")))
+ (stop #~(const #f))
+ (actions
+ (list (patchwork-django-admin-action patchwork
+ settings-module)))
+ (respawn? #f)
+ (documentation "Setup Patchwork."))))))
+
+(define patchwork-getmail-configs
+ (match-lambda
+ (($ <patchwork-configuration> patchwork domain
+ settings-module static-path
+ getmail-retriever-config)
+ (list
+ (getmail-configuration
+ (name (string->symbol (package-name patchwork)))
+ (user "httpd")
+ (directory (string-append
+ "/var/lib/getmail/" (package-name patchwork)))
+ (rcfile
+ (getmail-configuration-file
+ (retriever getmail-retriever-config)
+ (destination
+ (getmail-destination-configuration
+ (type "MDA_external")
+ (path (file-append patchwork "/bin/patchwork-admin"))
+ (extra-parameters
+ '((arguments . ("parsemail"))))))
+ (options
+ (getmail-options-configuration
+ (read-all #f)
+ (delivered-to #f)
+ (received #f)))))
+ (idle (assq-ref
+ (getmail-retriever-configuration-extra-parameters
+ getmail-retriever-config)
+ 'mailboxes))
+ (environment-variables
+ (list "DJANGO_SETTINGS_MODULE=guix.patchwork.settings"
+ #~(string-append "PYTHONPATH=" #$settings-module))))))))
+
+(define patchwork-service-type
+ (service-type
+ (name 'patchwork-setup)
+ (extensions
+ (list (service-extension httpd-service-type
+ patchwork-httpd-configuration)
+ (service-extension shepherd-root-service-type
+ patchwork-shepherd-services)
+ (service-extension getmail-service-type
+ patchwork-getmail-configs)))
+ (description
+ "Patchwork patch tracking system.")))
diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm
index 0a38b4013c..06d72b5f60 100644
--- a/gnu/services/xorg.scm
+++ b/gnu/services/xorg.scm
@@ -465,7 +465,7 @@ desktop session from the system or user profile will be used."
(define %default-slim-theme-name
;; This must be the name of the sub-directory in %DEFAULT-SLIM-THEME that
;; contains the actual theme files.
- "0.x")
+ "1.x")
(define-record-type* <slim-configuration>
slim-configuration make-slim-configuration