aboutsummaryrefslogtreecommitdiff
path: root/gnu/services
diff options
context:
space:
mode:
authorMaxim Cournoyer <maxim.cournoyer@gmail.com>2020-10-19 12:51:57 -0400
committerMaxim Cournoyer <maxim.cournoyer@gmail.com>2020-10-19 13:11:40 -0400
commit5e2140511c1ad9ccd731438b74d61b62111da1e6 (patch)
treea4ff748ad26e121b88469b5d921001ef1382be8f /gnu/services
parent9e3a5ee417ea7fe9721be8804ff047e80c4f22ed (diff)
parent353bdae32f72b720c7ddd706576ccc40e2b43f95 (diff)
downloadguix-5e2140511c1ad9ccd731438b74d61b62111da1e6.tar
guix-5e2140511c1ad9ccd731438b74d61b62111da1e6.tar.gz
Merge branch 'staging'
Conflicts: gnu/packages/admin.scm gnu/packages/commencement.scm gnu/packages/gdb.scm gnu/packages/llvm.scm gnu/packages/package-management.scm gnu/packages/tls.scm
Diffstat (limited to 'gnu/services')
-rw-r--r--gnu/services/base.scm18
-rw-r--r--gnu/services/cuirass.scm48
-rw-r--r--gnu/services/desktop.scm129
-rw-r--r--gnu/services/dict.scm2
-rw-r--r--gnu/services/dns.scm70
-rw-r--r--gnu/services/docker.scm20
-rw-r--r--gnu/services/ganeti.scm2
-rw-r--r--gnu/services/guix.scm437
-rw-r--r--gnu/services/messaging.scm12
-rw-r--r--gnu/services/networking.scm6
-rw-r--r--gnu/services/ssh.scm131
-rw-r--r--gnu/services/version-control.scm9
-rw-r--r--gnu/services/virtualization.scm154
-rw-r--r--gnu/services/web.scm27
-rw-r--r--gnu/services/xorg.scm3
15 files changed, 947 insertions, 121 deletions
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index d560ad5a13..04bc991356 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -1570,6 +1570,9 @@ proxy of 'guix-daemon'...~%")
;; the 'set-http-proxy' action.
(or (getenv "http_proxy") #$http-proxy))
+ ;; Start the guix-daemon from a container, when supported,
+ ;; to solve an installation issue. See the comment below for
+ ;; more details.
(fork+exec-command/container
(cons* #$(file-append guix "/bin/guix-daemon")
"--build-users-group" #$build-group
@@ -1600,6 +1603,8 @@ proxy of 'guix-daemon'...~%")
;; operate from within the same MNT namespace as the
;; installation container. In that case only, enter the
;; namespace of the process PID passed as start argument.
+ ;; Otherwise, for symmetry purposes enter the caller
+ ;; namespaces which is a no-op.
#:pid (match args
((pid) (string->number pid))
(else (getpid)))
@@ -1648,10 +1653,15 @@ proxy of 'guix-daemon'...~%")
;; otherwise call 'chown' here, but the problem is that on a COW overlayfs,
;; chown leads to an entire copy of the tree, which is a bad idea.
- ;; Optionally authorize substitute server keys.
- (if authorize-key?
- (substitute-key-authorization keys guix)
- #~#f))))
+ ;; Generate a key pair and optionally authorize substitute server keys.
+ #~(begin
+ (unless (file-exists? "/etc/guix/signing-key.pub")
+ (system* #$(file-append guix "/bin/guix") "archive"
+ "--generate-key"))
+
+ #$(if authorize-key?
+ (substitute-key-authorization keys guix)
+ #~#f)))))
(define* (references-file item #:optional (name "references"))
"Return a file that contains the list of references of ITEM."
diff --git a/gnu/services/cuirass.scm b/gnu/services/cuirass.scm
index 0f4f0f9948..a50f583807 100644
--- a/gnu/services/cuirass.scm
+++ b/gnu/services/cuirass.scm
@@ -54,6 +54,11 @@
(default "/var/log/cuirass.log"))
(web-log-file cuirass-configuration-web-log-file ;string
(default "/var/log/cuirass-web.log"))
+ (queries-log-file cuirass-configuration-queries-log-file ;string
+ (default #f))
+ (web-queries-log-file
+ cuirass-configuration-web-queries-log-file ;string
+ (default #f))
(cache-directory cuirass-configuration-cache-directory ;string (dir-name)
(default "/var/cache/cuirass"))
(ttl cuirass-configuration-ttl ;integer
@@ -87,6 +92,9 @@
(cache-directory (cuirass-configuration-cache-directory config))
(web-log-file (cuirass-configuration-web-log-file config))
(log-file (cuirass-configuration-log-file config))
+ (queries-log-file (cuirass-configuration-queries-log-file config))
+ (web-queries-log-file
+ (cuirass-configuration-web-queries-log-file config))
(user (cuirass-configuration-user config))
(group (cuirass-configuration-group config))
(interval (cuirass-configuration-interval config))
@@ -111,6 +119,10 @@
"--database" #$database
"--ttl" #$(string-append (number->string ttl) "s")
"--interval" #$(number->string interval)
+ #$@(if queries-log-file
+ (list (string-append "--log-queries="
+ queries-log-file))
+ '())
#$@(if use-substitutes? '("--use-substitutes") '())
#$@(if one-shot? '("--one-shot") '())
#$@(if fallback? '("--fallback") '())
@@ -140,6 +152,10 @@
"--port" #$(number->string port)
"--listen" #$host
"--interval" #$(number->string interval)
+ #$@(if web-queries-log-file
+ (list (string-append "--log-queries="
+ web-queries-log-file))
+ '())
#$@(if use-substitutes? '("--use-substitutes") '())
#$@(if fallback? '("--fallback") '())
#$@extra-options)
@@ -170,6 +186,9 @@
(db (dirname (cuirass-configuration-database config)))
(user (cuirass-configuration-user config))
(log "/var/log/cuirass")
+ (queries-log-file (cuirass-configuration-queries-log-file config))
+ (web-queries-log-file
+ (cuirass-configuration-web-queries-log-file config))
(group (cuirass-configuration-group config)))
(with-imported-modules '((guix build utils))
#~(begin
@@ -183,14 +202,33 @@
(gid (group:gid (getgr #$group))))
(chown #$cache uid gid)
(chown #$db uid gid)
- (chown #$log uid gid))))))
+ (chown #$log uid gid)
+
+ (let ((queries-log-file #$queries-log-file))
+ (when queries-log-file
+ (call-with-output-file queries-log-file (const #t))
+ (chown #$queries-log-file uid gid)))
+
+ (let ((web-queries-log-file #$web-queries-log-file))
+ (when web-queries-log-file
+ (call-with-output-file web-queries-log-file (const #t))
+ (chown web-queries-log-file uid gid))))))))
(define (cuirass-log-rotations config)
"Return the list of log rotations that corresponds to CONFIG."
- (list (log-rotation
- (files (list (cuirass-configuration-log-file config)))
- (frequency 'weekly)
- (options '("rotate 40"))))) ;worth keeping
+ (let ((queries-log-file (cuirass-configuration-queries-log-file config))
+ (web-queries-log-file
+ (cuirass-configuration-web-queries-log-file config)))
+ (list (log-rotation
+ (files `(,(cuirass-configuration-log-file config)
+ ,@(if queries-log-file
+ (list queries-log-file)
+ '())
+ ,@(if web-queries-log-file
+ (list web-queries-log-file)
+ '())))
+ (frequency 'weekly)
+ (options '("rotate 40")))))) ;worth keeping
(define cuirass-service-type
(service-type
diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm
index bdbea5dddf..3a3fd8fd1b 100644
--- a/gnu/services/desktop.scm
+++ b/gnu/services/desktop.scm
@@ -3,7 +3,7 @@
;;; Copyright © 2015 Andy Wingo <wingo@igalia.com>
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2016 Sou Bunnbu <iyzsong@gmail.com>
-;;; Copyright © 2017 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2017, 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2017 Nikita <nikita@n0.is>
;;; Copyright © 2018, 2020 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
@@ -54,6 +54,7 @@
#:use-module (gnu packages linux)
#:use-module (gnu packages libusb)
#:use-module (gnu packages mate)
+ #:use-module (gnu packages nfs)
#:use-module (gnu packages enlightenment)
#:use-module (guix deprecation)
#:use-module (guix records)
@@ -470,6 +471,7 @@ site} for more information."
,(bluetooth-directory config)))))
(service-extension shepherd-root-service-type
(compose list bluetooth-shepherd-service))))
+ (default-value (bluetooth-configuration))
(description "Run the @command{bluetoothd} daemon, which manages all the
Bluetooth devices and provides a number of D-Bus interfaces.")))
@@ -595,64 +597,66 @@ include the @command{udisksctl} command, part of UDisks, and GNOME Disks."
(define-record-type* <elogind-configuration> elogind-configuration
make-elogind-configuration
elogind-configuration?
- (elogind elogind-package
- (default elogind))
- (kill-user-processes? elogind-kill-user-processes?
- (default #f))
- (kill-only-users elogind-kill-only-users
- (default '()))
- (kill-exclude-users elogind-kill-exclude-users
- (default '("root")))
- (inhibit-delay-max-seconds elogind-inhibit-delay-max-seconds
- (default 5))
- (handle-power-key elogind-handle-power-key
- (default 'poweroff))
- (handle-suspend-key elogind-handle-suspend-key
- (default 'suspend))
- (handle-hibernate-key elogind-handle-hibernate-key
- ;; (default 'hibernate)
- ;; XXX Ignore it for now, since we don't
- ;; yet handle resume-from-hibernation in
- ;; our initrd.
- (default 'ignore))
- (handle-lid-switch elogind-handle-lid-switch
- (default 'suspend))
- (handle-lid-switch-docked elogind-handle-lid-switch-docked
- (default 'ignore))
- (power-key-ignore-inhibited? elogind-power-key-ignore-inhibited?
- (default #f))
- (suspend-key-ignore-inhibited? elogind-suspend-key-ignore-inhibited?
- (default #f))
- (hibernate-key-ignore-inhibited? elogind-hibernate-key-ignore-inhibited?
- (default #f))
- (lid-switch-ignore-inhibited? elogind-lid-switch-ignore-inhibited?
- (default #t))
- (holdoff-timeout-seconds elogind-holdoff-timeout-seconds
- (default 30))
- (idle-action elogind-idle-action
- (default 'ignore))
- (idle-action-seconds elogind-idle-action-seconds
- (default (* 30 60)))
- (runtime-directory-size-percent elogind-runtime-directory-size-percent
- (default 10))
- (runtime-directory-size elogind-runtime-directory-size
- (default #f))
- (remove-ipc? elogind-remove-ipc?
- (default #t))
-
- (suspend-state elogind-suspend-state
- (default '("mem" "standby" "freeze")))
- (suspend-mode elogind-suspend-mode
- (default '()))
- (hibernate-state elogind-hibernate-state
- (default '("disk")))
- (hibernate-mode elogind-hibernate-mode
- (default '("platform" "shutdown")))
- (hybrid-sleep-state elogind-hybrid-sleep-state
- (default '("disk")))
- (hybrid-sleep-mode elogind-hybrid-sleep-mode
- (default
- '("suspend" "platform" "shutdown"))))
+ (elogind elogind-package
+ (default elogind))
+ (kill-user-processes? elogind-kill-user-processes?
+ (default #f))
+ (kill-only-users elogind-kill-only-users
+ (default '()))
+ (kill-exclude-users elogind-kill-exclude-users
+ (default '("root")))
+ (inhibit-delay-max-seconds elogind-inhibit-delay-max-seconds
+ (default 5))
+ (handle-power-key elogind-handle-power-key
+ (default 'poweroff))
+ (handle-suspend-key elogind-handle-suspend-key
+ (default 'suspend))
+ (handle-hibernate-key elogind-handle-hibernate-key
+ ;; (default 'hibernate)
+ ;; XXX Ignore it for now, since we don't
+ ;; yet handle resume-from-hibernation in
+ ;; our initrd.
+ (default 'ignore))
+ (handle-lid-switch elogind-handle-lid-switch
+ (default 'suspend))
+ (handle-lid-switch-docked elogind-handle-lid-switch-docked
+ (default 'ignore))
+ (handle-lid-switch-external-power elogind-handle-lid-switch-external-power
+ (default 'ignore))
+ (power-key-ignore-inhibited? elogind-power-key-ignore-inhibited?
+ (default #f))
+ (suspend-key-ignore-inhibited? elogind-suspend-key-ignore-inhibited?
+ (default #f))
+ (hibernate-key-ignore-inhibited? elogind-hibernate-key-ignore-inhibited?
+ (default #f))
+ (lid-switch-ignore-inhibited? elogind-lid-switch-ignore-inhibited?
+ (default #t))
+ (holdoff-timeout-seconds elogind-holdoff-timeout-seconds
+ (default 30))
+ (idle-action elogind-idle-action
+ (default 'ignore))
+ (idle-action-seconds elogind-idle-action-seconds
+ (default (* 30 60)))
+ (runtime-directory-size-percent elogind-runtime-directory-size-percent
+ (default 10))
+ (runtime-directory-size elogind-runtime-directory-size
+ (default #f))
+ (remove-ipc? elogind-remove-ipc?
+ (default #t))
+
+ (suspend-state elogind-suspend-state
+ (default '("mem" "standby" "freeze")))
+ (suspend-mode elogind-suspend-mode
+ (default '()))
+ (hibernate-state elogind-hibernate-state
+ (default '("disk")))
+ (hibernate-mode elogind-hibernate-mode
+ (default '("platform" "shutdown")))
+ (hybrid-sleep-state elogind-hybrid-sleep-state
+ (default '("disk")))
+ (hybrid-sleep-mode elogind-hybrid-sleep-mode
+ (default
+ '("suspend" "platform" "shutdown"))))
(define (elogind-configuration-file config)
(define (yesno x)
@@ -704,6 +708,7 @@ include the @command{udisksctl} command, part of UDisks, and GNOME Disks."
("HandleHibernateKey" (handle-action elogind-handle-hibernate-key))
("HandleLidSwitch" (handle-action elogind-handle-lid-switch))
("HandleLidSwitchDocked" (handle-action elogind-handle-lid-switch-docked))
+ ("HandleLidSwitchExternalPower" (handle-action elogind-handle-lid-switch-external-power))
("PowerKeyIgnoreInhibited" (yesno elogind-power-key-ignore-inhibited?))
("SuspendKeyIgnoreInhibited" (yesno elogind-suspend-key-ignore-inhibited?))
("HibernateKeyIgnoreInhibited" (yesno elogind-hibernate-key-ignore-inhibited?))
@@ -1202,6 +1207,12 @@ or setting its password with passwd.")))
;; perform administrative tasks (similar to "sudo").
polkit-wheel-service
+ ;; Allow desktop users to also mount NTFS and NFS file systems
+ ;; without root.
+ (simple-service 'mount-setuid-helpers setuid-program-service-type
+ (list (file-append nfs-utils "/sbin/mount.nfs")
+ (file-append ntfs-3g "/sbin/mount.ntfs-3g")))
+
;; The global fontconfig cache directory can sometimes contain
;; stale entries, possibly referencing fonts that have been GC'd,
;; so mount it read-only.
diff --git a/gnu/services/dict.scm b/gnu/services/dict.scm
index 519ed3eca2..a97ad8f608 100644
--- a/gnu/services/dict.scm
+++ b/gnu/services/dict.scm
@@ -187,7 +187,7 @@ of DICT server (@pxref{Dicod,,, dico, GNU Dico Manual}).
The optional @var{config} argument specifies the configuration for
@command{dicod}, which should be a @code{<dicod-configuration>} object, by
-default it serves the GNU Collaborative International Dictonary of English.
+default it serves the GNU Collaborative International Dictionary of English.
You can add @command{open localhost} to your @file{~/.dico} file to make
@code{localhost} the default server for @command{dico}
diff --git a/gnu/services/dns.scm b/gnu/services/dns.scm
index 9caa3611be..572880561c 100644
--- a/gnu/services/dns.scm
+++ b/gnu/services/dns.scm
@@ -757,7 +757,29 @@ cache.size = 100 * MB
(cache-size dnsmasq-configuration-cache-size
(default 150)) ;integer
(negative-cache? dnsmasq-configuration-negative-cache?
- (default #t))) ;boolean
+ (default #t)) ;boolean
+ (tftp-enable? dnsmasq-configuration-tftp-enable?
+ (default #f)) ;boolean
+ (tftp-no-fail? dnsmasq-configuration-tftp-no-fail?
+ (default #f)) ;boolean
+ (tftp-single-port? dnsmasq-configuration-tftp-single-port?
+ (default #f)) ;boolean
+ (tftp-secure? dnsmasq-tftp-secure?
+ (default #f)) ;boolean
+ (tftp-max dnsmasq-tftp-max
+ (default #f)) ;integer
+ (tftp-mtu dnsmasq-tftp-mtu
+ (default #f)) ;integer
+ (tftp-no-blocksize? dnsmasq-tftp-no-blocksize?
+ (default #f)) ;boolean
+ (tftp-lowercase? dnsmasq-tftp-lowercase?
+ (default #f)) ;boolean
+ (tftp-port-range dnsmasq-tftp-port-range
+ (default #f)) ;string
+ (tftp-root dnsmasq-tftp-root
+ (default "/var/empty,lo")) ;string
+ (tftp-unique-root dnsmasq-tftp-unique-root
+ (default #f))) ;"" or "ip" or "mac"
(define dnsmasq-shepherd-service
(match-lambda
@@ -765,7 +787,12 @@ cache.size = 100 * MB
no-hosts?
port local-service? listen-addresses
resolv-file no-resolv? servers
- addresses cache-size negative-cache?)
+ addresses cache-size negative-cache?
+ tftp-enable? tftp-no-fail?
+ tftp-single-port? tftp-secure?
+ tftp-max tftp-mtu tftp-no-blocksize?
+ tftp-lowercase? tftp-port-range
+ tftp-root tftp-unique-root)
(shepherd-service
(provision '(dnsmasq))
(requirement '(networking))
@@ -794,7 +821,44 @@ cache.size = 100 * MB
#$(format #f "--cache-size=~a" cache-size)
#$@(if negative-cache?
'()
- '("--no-negcache")))
+ '("--no-negcache"))
+ #$@(if tftp-enable?
+ '("--enable-tftp")
+ '())
+ #$@(if tftp-no-fail?
+ '("--tftp-no-fail")
+ '())
+ #$@(if tftp-single-port?
+ '("--tftp-single-port")
+ '())
+ #$@(if tftp-secure?
+ '("--tftp-secure?")
+ '())
+ #$@(if tftp-max
+ (list (format #f "--tftp-max=~a" tftp-max))
+ '())
+ #$@(if tftp-mtu
+ (list (format #f "--tftp-mtu=~a" tftp-mtu))
+ '())
+ #$@(if tftp-no-blocksize?
+ '("--tftp-no-blocksize")
+ '())
+ #$@(if tftp-lowercase?
+ '("--tftp-lowercase")
+ '())
+ #$@(if tftp-port-range
+ (list (format #f "--tftp-port-range=~a"
+ tftp-port-range))
+ '())
+ #$@(if tftp-root
+ (list (format #f "--tftp-root=~a" tftp-root))
+ '())
+ #$@(if tftp-unique-root
+ (list
+ (if (> (length tftp-unique-root) 0)
+ (format #f "--tftp-unique-root=~a" tftp-unique-root)
+ (format #f "--tftp-unique-root")))
+ '()))
#:pid-file "/run/dnsmasq.pid"))
(stop #~(make-kill-destructor))))))
diff --git a/gnu/services/docker.scm b/gnu/services/docker.scm
index 2fb2ae2c47..7acfbea49f 100644
--- a/gnu/services/docker.scm
+++ b/gnu/services/docker.scm
@@ -3,6 +3,7 @@
;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2020 Efraim Flashner <efraim@flashner.co.il>
+;;; Copyright © 2020 Jesse Dowell <jessedowell@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -45,6 +46,9 @@
(docker
(package docker)
"Docker daemon package.")
+ (docker-cli
+ (package docker-cli)
+ "Docker client package.")
(containerd
(package containerd)
"containerd package.")
@@ -80,7 +84,8 @@ loop-back communications.")
(define (containerd-shepherd-service config)
(let* ((package (docker-configuration-containerd config))
- (debug? (docker-configuration-debug? config)))
+ (debug? (docker-configuration-debug? config))
+ (containerd (docker-configuration-containerd config)))
(shepherd-service
(documentation "containerd daemon.")
(provision '(containerd))
@@ -89,6 +94,9 @@ loop-back communications.")
#$@(if debug?
'("--log-level=debug")
'()))
+ ;; For finding containerd-shim binary.
+ #:environment-variables
+ (list (string-append "PATH=" #$containerd "/bin"))
#:log-file "/var/log/containerd.log"))
(stop #~(make-kill-destructor)))))
@@ -118,9 +126,11 @@ loop-back communications.")
#$@(if debug?
'("--debug" "--log-level=debug")
'())
- (if #$enable-proxy? "--userland-proxy" "")
- "--userland-proxy-path" (string-append #$proxy
- "/bin/proxy")
+ #$@(if enable-proxy?
+ (list "--userland-proxy=true"
+ #~(string-append
+ "--userland-proxy-path=" #$proxy "/bin/proxy"))
+ '("--userland-proxy=false"))
(if #$enable-iptables?
"--iptables"
"--iptables=false"))
@@ -136,7 +146,7 @@ bundles in Docker containers.")
(list
;; Make sure the 'docker' command is available.
(service-extension profile-service-type
- (list docker-cli))
+ (compose list docker-configuration-docker-cli))
(service-extension activation-service-type
%docker-activation)
(service-extension shepherd-root-service-type
diff --git a/gnu/services/ganeti.scm b/gnu/services/ganeti.scm
index e2a2ec63e1..d87db5b9ac 100644
--- a/gnu/services/ganeti.scm
+++ b/gnu/services/ganeti.scm
@@ -430,7 +430,7 @@ appropriate requests to this daemon.")))
(description
"@command{ganeti-luxid} is a daemon used to answer queries
related to the configuration and the current live state of a Ganeti cluster.
-Additionally, it is the autorative daemon for the Ganeti job queue. Jobs can
+Additionally, it is the authorative daemon for the Ganeti job queue. Jobs can
be submitted via this daemon and it schedules and starts them.")))
(define-record-type* <ganeti-rapi-configuration>
diff --git a/gnu/services/guix.scm b/gnu/services/guix.scm
index 10a8581a62..a47c4bd941 100644
--- a/gnu/services/guix.scm
+++ b/gnu/services/guix.scm
@@ -17,20 +17,67 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu services guix)
+ #:use-module (srfi srfi-1)
#:use-module (ice-9 match)
#:use-module (guix gexp)
#:use-module (guix records)
+ #:use-module (guix packages)
#:use-module ((gnu packages base)
#:select (glibc-utf8-locales))
#:use-module (gnu packages admin)
+ #:use-module (gnu packages databases)
#:use-module (gnu packages web)
+ #:use-module (gnu packages guile)
+ #:use-module (gnu packages guile-xyz)
+ #:use-module (gnu packages package-management)
#:use-module (gnu services)
#:use-module (gnu services base)
#:use-module (gnu services admin)
#:use-module (gnu services shepherd)
#:use-module (gnu services getmail)
#:use-module (gnu system shadow)
- #:export (<guix-data-service-configuration>
+ #:export (guix-build-coordinator-configuration
+ guix-build-coordinator-configuration?
+ guix-build-coordinator-configuration-package
+ guix-build-coordinator-configuration-user
+ guix-build-coordinator-configuration-group
+ guix-build-coordinator-configuration-datastore-uri-string
+ guix-build-coordinator-configuration-agent-communication-uri-string
+ guix-build-coordinator-configuration-client-communication-uri-string
+ guix-build-coordinator-configuration-allocation-strategy
+ guix-build-coordinator-configuration-hooks
+ guix-build-coordinator-configuration-guile
+
+ guix-build-coordinator-service-type
+
+ guix-build-coordinator-agent-configuration
+ guix-build-coordinator-agent-configuration?
+ guix-build-coordinator-agent-configuration-package
+ guix-build-coordinator-agent-configuration-user
+ guix-build-coordinator-agent-configuration-coordinator
+ guix-build-coordinator-agent-configuration-uuid
+ guix-build-coordinator-agent-configuration-password
+ guix-build-coordinator-agent-configuration-password-file
+ guix-build-coordinator-agent-configuration-systems
+ guix-build-coordinator-agent-configuration-max-parallel-builds
+ guix-build-coordinator-agent-configuration-derivation-substitute-urls
+ guix-build-coordinator-agent-configuration-non-derivation-substitute-urls
+
+ guix-build-coordinator-agent-service-type
+
+ guix-build-coordinator-queue-builds-configuration
+ guix-build-coordinator-queue-builds-configuration?
+ guix-build-coordinator-queue-builds-configuration-package
+ guix-build-coordinator-queue-builds-configuration-user
+ guix-build-coordinator-queue-builds-coordinator
+ guix-build-coordinator-queue-builds-configuration-systems
+ guix-build-coordinator-queue-builds-configuration-system-and-targets
+ guix-build-coordinator-queue-builds-configuration-guix-data-service
+ guix-build-coordinator-queue-builds-configuration-processed-commits-file
+
+ guix-build-coordinator-queue-builds-service-type
+
+ <guix-data-service-configuration>
guix-data-service-configuration
guix-data-service-configuration?
guix-data-service-package
@@ -45,11 +92,391 @@
;;;; Commentary:
;;;
-;;; This module implements a service that to run instances of the Guix Data
-;;; Service, which provides data about Guix over time.
+;;; Services specifically related to GNU Guix.
;;;
;;;; Code:
+(define-record-type* <guix-build-coordinator-configuration>
+ guix-build-coordinator-configuration make-guix-build-coordinator-configuration
+ guix-build-coordinator-configuration?
+ (package guix-build-coordinator-configuration-package
+ (default guix-build-coordinator))
+ (user guix-build-coordinator-configuration-user
+ (default "guix-build-coordinator"))
+ (group guix-build-coordinator-configuration-group
+ (default "guix-build-coordinator"))
+ (database-uri-string
+ guix-build-coordinator-configuration-datastore-uri-string
+ (default "sqlite:///var/lib/guix-build-coordinator/guix_build_coordinator.db"))
+ (agent-communication-uri-string
+ guix-build-coordinator-configuration-agent-communication-uri-string
+ (default "http://0.0.0.0:8745"))
+ (client-communication-uri-string
+ guix-build-coordinator-configuration-client-communication-uri-string
+ (default "http://127.0.0.1:8746"))
+ (allocation-strategy
+ guix-build-coordinator-configuration-allocation-strategy
+ (default #~basic-build-allocation-strategy))
+ (hooks guix-build-coordinator-configuration-hooks
+ (default '()))
+ (guile guix-build-coordinator-configuration-guile
+ (default guile-3.0-latest)))
+
+(define-record-type* <guix-build-coordinator-agent-configuration>
+ guix-build-coordinator-agent-configuration
+ make-guix-build-coordinator-agent-configuration
+ guix-build-coordinator-agent-configuration?
+ (package guix-build-coordinator-agent-configuration-package
+ (default guix-build-coordinator))
+ (user guix-build-coordinator-agent-configuration-user
+ (default "guix-build-coordinator-agent"))
+ (coordinator guix-build-coordinator-agent-configuration-coordinator
+ (default "http://localhost:8745"))
+ (uuid guix-build-coordinator-agent-configuration-uuid)
+ (password guix-build-coordinator-agent-configuration-password
+ (default #f))
+ (password-file guix-build-coordinator-agent-configuration-password-file
+ (default #f))
+ (systems guix-build-coordinator-agent-configuration-systems
+ (default #f))
+ (max-parallel-builds
+ guix-build-coordinator-agent-configuration-max-parallel-builds
+ (default 1))
+ (derivation-substitute-urls
+ guix-build-coordinator-agent-configuration-derivation-substitute-urls
+ (default #f))
+ (non-derivation-substitute-urls
+ guix-build-coordinator-agent-configuration-non-derivation-substitute-urls
+ (default #f)))
+
+(define-record-type* <guix-build-coordinator-queue-builds-configuration>
+ guix-build-coordinator-queue-builds-configuration
+ make-guix-build-coordinator-queue-builds-configuration
+ guix-build-coordinator-queue-builds-configuration?
+ (package guix-build-coordinator-queue-builds-configuration-package
+ (default guix-build-coordinator))
+ (user guix-build-coordinator-queue-builds-configuration-user
+ (default "guix-build-coordinator-queue-builds"))
+ (coordinator guix-build-coordinator-queue-builds-coordinator
+ (default "http://localhost:8745"))
+ (systems guix-build-coordinator-queue-builds-configuration-systems
+ (default #f))
+ (systems-and-targets
+ guix-build-coordinator-queue-builds-configuration-system-and-targets
+ (default #f))
+ (guix-data-service
+ guix-build-coordinator-queue-builds-configuration-guix-data-service
+ (default "https://data.guix.gnu.org"))
+ (processed-commits-file
+ guix-build-coordinator-queue-builds-configuration-processed-commits-file
+ (default "/var/cache/guix-build-coordinator-queue-builds/processed-commits")))
+
+(define* (make-guix-build-coordinator-start-script database-uri-string
+ allocation-strategy
+ pid-file
+ guix-build-coordinator-package
+ #:key
+ agent-communication-uri-string
+ client-communication-uri-string
+ (hooks '())
+ (guile guile-3.0))
+ (program-file
+ "start-guix-build-coordinator"
+ (with-extensions (cons guix-build-coordinator-package
+ ;; This is a poorly constructed Guile load path,
+ ;; since it contains things that aren't Guile
+ ;; libraries, but it means that the Guile libraries
+ ;; needed for the Guix Build Coordinator don't need
+ ;; to be individually specified here.
+ (map second (package-inputs
+ guix-build-coordinator-package)))
+ #~(begin
+ (use-modules (srfi srfi-1)
+ (ice-9 match)
+ (web uri)
+ (prometheus)
+ (guix-build-coordinator hooks)
+ (guix-build-coordinator datastore)
+ (guix-build-coordinator build-allocator)
+ (guix-build-coordinator coordinator))
+
+ (let* ((metrics-registry (make-metrics-registry
+ #:namespace
+ "guixbuildcoordinator_"))
+ (datastore (database-uri->datastore
+ #$database-uri-string
+ #:metrics-registry metrics-registry))
+ (hooks
+ (list #$@(map (match-lambda
+ ((name . hook-gexp)
+ #~(cons name #$hook-gexp)))
+ hooks)))
+ (hooks-with-defaults
+ `(,@hooks
+ ,@(remove (match-lambda
+ ((name . _) (assq-ref hooks name)))
+ %default-hooks)))
+ (build-coordinator (make-build-coordinator
+ #:datastore datastore
+ #:hooks hooks-with-defaults
+ #:metrics-registry metrics-registry
+ #:allocation-strategy #$allocation-strategy)))
+
+ (run-coordinator-service
+ build-coordinator
+ #:update-datastore? #t
+ #:pid-file #$pid-file
+ #:agent-communication-uri (string->uri
+ #$agent-communication-uri-string)
+ #:client-communication-uri (string->uri
+ #$client-communication-uri-string)))))
+ #:guile guile))
+
+(define (guix-build-coordinator-shepherd-services config)
+ (match-record config <guix-build-coordinator-configuration>
+ (package user group database-uri-string
+ agent-communication-uri-string
+ client-communication-uri-string
+ allocation-strategy
+ hooks
+ guile)
+ (list
+ (shepherd-service
+ (documentation "Guix Build Coordinator")
+ (provision '(guix-build-coordinator))
+ (requirement '(networking))
+ (start #~(make-forkexec-constructor
+ (list #$(make-guix-build-coordinator-start-script
+ database-uri-string
+ allocation-strategy
+ "/var/run/guix-build-coordinator/pid"
+ package
+ #:agent-communication-uri-string
+ agent-communication-uri-string
+ #:client-communication-uri-string
+ client-communication-uri-string
+ #:hooks hooks
+ #:guile guile))
+ #:user #$user
+ #:group #$group
+ #:pid-file "/var/run/guix-build-coordinator/pid"
+ ;; Allow time for migrations to run
+ #:pid-file-timeout 60
+ #:environment-variables
+ `(,(string-append
+ "GUIX_LOCPATH=" #$glibc-utf8-locales "/lib/locale")
+ "LC_ALL=en_US.utf8")
+ #:log-file "/var/log/guix-build-coordinator/coordinator.log"))
+ (stop #~(make-kill-destructor))))))
+
+(define (guix-build-coordinator-activation config)
+ #~(begin
+ (use-modules (guix build utils))
+
+ (define %user (getpw "guix-build-coordinator"))
+
+ (chmod "/var/lib/guix-build-coordinator" #o755)
+
+ (mkdir-p "/var/log/guix-build-coordinator")
+
+ ;; Allow writing the PID file
+ (mkdir-p "/var/run/guix-build-coordinator")
+ (chown "/var/run/guix-build-coordinator"
+ (passwd:uid %user)
+ (passwd:gid %user))))
+
+(define (guix-build-coordinator-account config)
+ (match-record config <guix-build-coordinator-configuration>
+ (user group)
+ (list (user-group
+ (name group)
+ (system? #t))
+ (user-account
+ (name user)
+ (group group)
+ (system? #t)
+ (comment "Guix Build Coordinator user")
+ (home-directory "/var/lib/guix-build-coordinator")
+ (shell (file-append shadow "/sbin/nologin"))))))
+
+(define guix-build-coordinator-service-type
+ (service-type
+ (name 'guix-build-coordinator)
+ (extensions
+ (list
+ (service-extension shepherd-root-service-type
+ guix-build-coordinator-shepherd-services)
+ (service-extension activation-service-type
+ guix-build-coordinator-activation)
+ (service-extension account-service-type
+ guix-build-coordinator-account)))
+ (default-value
+ (guix-build-coordinator-configuration))
+ (description
+ "Run an instance of the Guix Build Coordinator.")))
+
+(define (guix-build-coordinator-agent-shepherd-services config)
+ (match-record config <guix-build-coordinator-agent-configuration>
+ (package user coordinator uuid password password-file max-parallel-builds
+ derivation-substitute-urls non-derivation-substitute-urls
+ systems)
+ (list
+ (shepherd-service
+ (documentation "Guix Build Coordinator Agent")
+ (provision '(guix-build-coordinator-agent))
+ (requirement '(networking))
+ (start #~(make-forkexec-constructor
+ (list #$(file-append package "/bin/guix-build-coordinator-agent")
+ #$(string-append "--coordinator=" coordinator)
+ #$(string-append "--uuid=" uuid)
+ #$@(if password
+ #~(#$(string-append "--password=" password))
+ #~())
+ #$@(if password-file
+ #~(#$(string-append "--password-file=" password-file))
+ #~())
+ #$(simple-format #f "--max-parallel-builds=~A"
+ max-parallel-builds)
+ #$@(if derivation-substitute-urls
+ #~(#$(string-append
+ "--derivation-substitute-urls="
+ (string-join derivation-substitute-urls " ")))
+ #~())
+ #$@(if non-derivation-substitute-urls
+ #~(#$(string-append
+ "--non-derivation-substitute-urls="
+ (string-join derivation-substitute-urls " ")))
+ #~())
+ #$@(map (lambda (system)
+ (string-append "--system=" system))
+ (or systems '())))
+ #:user #$user
+ #:pid-file "/var/run/guix-build-coordinator-agent/pid"
+ #:environment-variables
+ `(,(string-append
+ "GUIX_LOCPATH=" #$glibc-utf8-locales "/lib/locale")
+ "LC_ALL=en_US.utf8")
+ #:log-file "/var/log/guix-build-coordinator/agent.log"))
+ (stop #~(make-kill-destructor))))))
+
+(define (guix-build-coordinator-agent-activation config)
+ #~(begin
+ (use-modules (guix build utils))
+
+ (mkdir-p "/var/log/guix-build-coordinator")
+
+ ;; Allow writing the PID file
+ (mkdir-p "/var/run/guix-build-coordinator-agent")
+ (chown "/var/run/guix-build-coordinator-agent"
+ (passwd:uid %user)
+ (passwd:gid %user))))
+
+(define (guix-build-coordinator-agent-account config)
+ (list (user-account
+ (name (guix-build-coordinator-agent-configuration-user config))
+ (group "nogroup")
+ (system? #t)
+ (comment "Guix Build Coordinator agent user")
+ (home-directory "/var/empty")
+ (shell (file-append shadow "/sbin/nologin")))))
+
+(define guix-build-coordinator-agent-service-type
+ (service-type
+ (name 'guix-build-coordinator-agent)
+ (extensions
+ (list
+ (service-extension shepherd-root-service-type
+ guix-build-coordinator-agent-shepherd-services)
+ (service-extension activation-service-type
+ guix-build-coordinator-agent-activation)
+ (service-extension account-service-type
+ guix-build-coordinator-agent-account)))
+ (description
+ "Run a Guix Build Coordinator agent.")))
+
+(define (guix-build-coordinator-queue-builds-shepherd-services config)
+ (match-record config <guix-build-coordinator-queue-builds-configuration>
+ (package user coordinator systems systems-and-targets
+ guix-data-service processed-commits-file)
+ (list
+ (shepherd-service
+ (documentation "Guix Build Coordinator queue builds from Guix Data Service")
+ (provision '(guix-build-coordinator-queue-builds))
+ (requirement '(networking))
+ (start
+ #~(make-forkexec-constructor
+ (list
+ #$(file-append
+ package
+ "/bin/guix-build-coordinator-queue-builds-from-guix-data-service")
+ #$(string-append "--coordinator=" coordinator)
+ #$@(map (lambda (system)
+ (string-append "--system=" system))
+ (or systems '()))
+ #$@(map (match-lambda
+ ((system . target)
+ (string-append "--system-and-target=" system "=" target)))
+ (or systems-and-targets '()))
+ #$@(if guix-data-service
+ #~(#$(string-append "--guix-data-service=" guix-data-service))
+ #~())
+ #$@(if processed-commits-file
+ #~(#$(string-append "--processed-commits-file="
+ processed-commits-file))
+ #~()))
+ #:user #$user
+ #:pid-file "/var/run/guix-build-coordinator-queue-builds/pid"
+ #:environment-variables
+ `(,(string-append
+ "GUIX_LOCPATH=" #$glibc-utf8-locales "/lib/locale")
+ "LC_ALL=en_US.utf8")
+ #:log-file "/var/log/guix-build-coordinator/queue-builds.log"))
+ (stop #~(make-kill-destructor))))))
+
+(define (guix-build-coordinator-queue-builds-activation config)
+ #~(begin
+ (use-modules (guix build utils))
+
+ (mkdir-p "/var/log/guix-build-coordinator")
+
+ ;; Allow writing the PID file
+ (mkdir-p "/var/run/guix-build-coordinator-queue-builds")
+ (chown "/var/run/guix-build-coordinator-queue-builds"
+ (passwd:uid %user)
+ (passwd:gid %user))))
+
+(define (guix-build-coordinator-queue-builds-account config)
+ (list (user-account
+ (name (guix-build-coordinator-queue-builds-configuration-user config))
+ (group "nogroup")
+ (system? #t)
+ (comment "Guix Build Coordinator queue-builds user")
+ (home-directory "/var/empty")
+ (shell (file-append shadow "/sbin/nologin")))))
+
+(define guix-build-coordinator-queue-builds-service-type
+ (service-type
+ (name 'guix-build-coordinator-queue-builds)
+ (extensions
+ (list
+ (service-extension shepherd-root-service-type
+ guix-build-coordinator-queue-builds-shepherd-services)
+ (service-extension activation-service-type
+ guix-build-coordinator-queue-builds-activation)
+ (service-extension account-service-type
+ guix-build-coordinator-queue-builds-account)))
+ (description
+ "Run the guix-build-coordinator-queue-builds-from-guix-data-service
+script.
+
+This is a script to assist in having the Guix Build Coordinator build
+derivations stored in an instance of the Guix Data Service.")))
+
+
+;;;
+;;; Guix Data Service
+;;;
+
(define-record-type* <guix-data-service-configuration>
guix-data-service-configuration make-guix-data-service-configuration
guix-data-service-configuration?
@@ -108,7 +535,7 @@ ca-certificates.crt file in the system profile."
#:environment-variables
`(,(string-append
"GUIX_LOCPATH=" #$glibc-utf8-locales "/lib/locale")
- "LC_ALL=en_US.utf8")
+ "LC_ALL=en_US.UTF-8")
#:log-file "/var/log/guix-data-service/web.log"))
(stop #~(make-kill-destructor)))
@@ -132,7 +559,7 @@ ca-certificates.crt file in the system profile."
"GIT_SSL_CAINFO=/etc/ssl/certs/ca-certificates.crt"
,(string-append
"GUIX_LOCPATH=" #$glibc-utf8-locales "/lib/locale")
- "LC_ALL=en_US.utf8")
+ "LC_ALL=en_US.UTF-8")
#:log-file "/var/log/guix-data-service/process-jobs.log"))
(stop #~(make-kill-destructor))))))
diff --git a/gnu/services/messaging.scm b/gnu/services/messaging.scm
index 11b41f2bf6..8f2f3914cf 100644
--- a/gnu/services/messaging.scm
+++ b/gnu/services/messaging.scm
@@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017, 2018 Clément Lassieur <clement@lassieur.org>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
-;;; Copyright © 2015, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2018 Pierre-Antoine Rouby <contact@parouby.fr>
;;;
;;; This file is part of GNU Guix.
@@ -813,14 +813,15 @@ string, you could instantiate a prosody service like this:
(match-lambda
(($ <bitlbee-configuration> bitlbee interface port
plugins extra-settings)
- (let ((conf (mixed-text-file "bitlbee.conf"
+ (let* ((plugins (directory-union "bitlbee-plugins" plugins))
+ (conf (mixed-text-file "bitlbee.conf"
"
[settings]
User = bitlbee
ConfigDir = /var/lib/bitlbee
DaemonInterface = " interface "
DaemonPort = " (number->string port) "
- PluginDir = " (directory-union "bitlbee-plugins" plugins) "/lib/bitlbee
+ PluginDir = " plugins "/lib/bitlbee
" extra-settings)))
(with-imported-modules (source-module-closure
@@ -840,6 +841,11 @@ string, you could instantiate a prosody service like this:
(list #$(file-append bitlbee "/sbin/bitlbee")
"-n" "-F" "-u" "bitlbee" "-c" #$conf)
+ ;; Allow 'bitlbee-purple' to use libpurple plugins.
+ #:environment-variables
+ (list (string-append "PURPLE_PLUGIN_PATH="
+ #$plugins "/lib/purple-2"))
+
#:pid-file "/var/run/bitlbee.pid"
#:mappings (list (file-system-mapping
(source "/var/lib/bitlbee")
diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm
index e45b116218..64f54e787f 100644
--- a/gnu/services/networking.scm
+++ b/gnu/services/networking.scm
@@ -1324,7 +1324,7 @@ whatever the thing is supposed to do).")))
(wpa-supplicant wpa-supplicant-configuration-wpa-supplicant ;<package>
(default wpa-supplicant))
(requirement wpa-supplicant-configuration-requirement ;list of symbols
- (default '(user-processes dbus-system loopback syslogd)))
+ (default '(user-processes loopback syslogd)))
(pid-file wpa-supplicant-configuration-pid-file ;string
(default "/var/run/wpa_supplicant.pid"))
(dbus? wpa-supplicant-configuration-dbus? ;Boolean
@@ -1343,7 +1343,9 @@ whatever the thing is supposed to do).")))
(list (shepherd-service
(documentation "Run the WPA supplicant daemon")
(provision '(wpa-supplicant))
- (requirement requirement)
+ (requirement (if dbus?
+ (cons 'dbus-system requirement)
+ requirement))
(start #~(make-forkexec-constructor
(list (string-append #$wpa-supplicant
"/sbin/wpa_supplicant")
diff --git a/gnu/services/ssh.scm b/gnu/services/ssh.scm
index ced21c0742..1891db0487 100644
--- a/gnu/services/ssh.scm
+++ b/gnu/services/ssh.scm
@@ -5,6 +5,7 @@
;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
;;; Copyright © 2019 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2020 pinoaffe <pinoaffe@airmail.cc>
+;;; Copyright © 2020 Oleg Pykhalov <go.wigust@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -26,6 +27,7 @@
#:use-module (gnu packages admin)
#:use-module (gnu services)
#:use-module (gnu services shepherd)
+ #:use-module (gnu services web)
#:use-module (gnu system pam)
#:use-module (gnu system shadow)
#:use-module (guix gexp)
@@ -50,7 +52,12 @@
autossh-configuration
autossh-configuration?
- autossh-service-type))
+ autossh-service-type
+
+ webssh-configuration
+ webssh-configuration?
+ webssh-service-type
+ %webssh-configuration-nginx))
;;; Commentary:
;;;
@@ -732,4 +739,126 @@ object."
autossh-service-activation)))
(default-value (autossh-configuration))))
+
+;;;
+;;; WebSSH
+;;;
+
+(define-record-type* <webssh-configuration>
+ webssh-configuration make-webssh-configuration
+ webssh-configuration?
+ (package webssh-configuration-package ;package
+ (default webssh))
+ (user-name webssh-configuration-user-name ;string
+ (default "webssh"))
+ (group-name webssh-configuration-group-name ;string
+ (default "webssh"))
+ (policy webssh-configuration-policy ;symbol
+ (default #f))
+ (known-hosts webssh-configuration-known-hosts ;list of strings
+ (default #f))
+ (port webssh-configuration-port ;number
+ (default #f))
+ (address webssh-configuration-address ;string
+ (default #f))
+ (log-file webssh-configuration-log-file ;string
+ (default "/var/log/webssh.log"))
+ (log-level webssh-configuration-log-level ;symbol
+ (default #f)))
+
+(define %webssh-configuration-nginx
+ (nginx-server-configuration
+ (listen '("80"))
+ (locations
+ (list (nginx-location-configuration
+ (uri "/")
+ (body '("proxy_pass http://127.0.0.1:8888;"
+ "proxy_http_version 1.1;"
+ "proxy_read_timeout 300;"
+ "proxy_set_header Upgrade $http_upgrade;"
+ "proxy_set_header Connection \"upgrade\";"
+ "proxy_set_header Host $http_host;"
+ "proxy_set_header X-Real-IP $remote_addr;"
+ "proxy_set_header X-Real-PORT $remote_port;")))))))
+
+(define webssh-account
+ ;; Return the user accounts and user groups for CONFIG.
+ (match-lambda
+ (($ <webssh-configuration> _ user-name group-name _ _ _ _ _ _)
+ (list (user-group
+ (name group-name))
+ (user-account
+ (name user-name)
+ (group group-name)
+ (comment "webssh privilege separation user")
+ (home-directory (string-append "/var/run/" user-name))
+ (shell #~(string-append #$shadow "/sbin/nologin")))))))
+
+(define webssh-activation
+ ;; Return the activation GEXP for CONFIG.
+ (match-lambda
+ (($ <webssh-configuration> _ user-name group-name policy known-hosts _ _
+ log-file _)
+ (with-imported-modules '((guix build utils))
+ #~(begin
+ (let* ((home-dir (string-append "/var/run/" #$user-name))
+ (ssh-dir (string-append home-dir "/.ssh"))
+ (known-hosts-file (string-append ssh-dir "/known_hosts")))
+ (call-with-output-file #$log-file (const #t))
+ (mkdir-p ssh-dir)
+ (case '#$policy
+ ((reject)
+ (if '#$known-hosts
+ (call-with-output-file known-hosts-file
+ (lambda (port)
+ (for-each (lambda (host) (display host port) (newline port))
+ '#$known-hosts)))
+ (display-hint (G_ "webssh: reject policy requires `known-hosts'.")))))
+ (for-each (lambda (file)
+ (chown file
+ (passwd:uid (getpw #$user-name))
+ (group:gid (getpw #$group-name))))
+ (list #$log-file ssh-dir known-hosts-file))
+ (chmod ssh-dir #o700)))))))
+
+(define webssh-shepherd-service
+ (match-lambda
+ (($ <webssh-configuration> package user-name group-name policy _ port
+ address log-file log-level)
+ (list (shepherd-service
+ (provision '(webssh))
+ (documentation "Run webssh daemon.")
+ (start #~(make-forkexec-constructor
+ `(,(string-append #$webssh "/bin/wssh")
+ ,(string-append "--log-file-prefix=" #$log-file)
+ ,@(case '#$log-level
+ ((debug) '("--logging=debug"))
+ (else '()))
+ ,@(case '#$policy
+ ((reject) '("--policy=reject"))
+ (else '()))
+ ,@(if #$port
+ (list (string-append "--port=" (number->string #$port)))
+ '())
+ ,@(if #$address
+ (list (string-append "--address=" #$address))
+ '()))
+ #:user #$user-name
+ #:group #$group-name))
+ (stop #~(make-kill-destructor)))))))
+
+(define webssh-service-type
+ (service-type
+ (name 'webssh)
+ (extensions
+ (list (service-extension shepherd-root-service-type
+ webssh-shepherd-service)
+ (service-extension account-service-type
+ webssh-account)
+ (service-extension activation-service-type
+ webssh-activation)))
+ (default-value (webssh-configuration))
+ (description
+ "Run the webssh.")))
+
;;; ssh.scm ends here
diff --git a/gnu/services/version-control.scm b/gnu/services/version-control.scm
index cc07f8025b..f3df0b979f 100644
--- a/gnu/services/version-control.scm
+++ b/gnu/services/version-control.scm
@@ -307,10 +307,15 @@ access to exported repositories under @file{/srv/git}."
(pubkey-file (string-append
#$home "/"
(basename
- (strip-store-file-name admin-pubkey)))))
+ (strip-store-file-name admin-pubkey))))
+ (rc-file #$(string-append home "/.gitolite.rc")))
(simple-format #t "guix: gitolite: installing ~A\n" #$rc-file)
- (copy-file #$rc-file #$(string-append home "/.gitolite.rc"))
+ (copy-file #$rc-file rc-file)
+ ;; ensure gitolite's user can read the configuration
+ (chown rc-file
+ (passwd:uid user-info)
+ (passwd:gid user-info))
;; The key must be writable, so copy it from the store
(copy-file admin-pubkey pubkey-file)
diff --git a/gnu/services/virtualization.scm b/gnu/services/virtualization.scm
index 20e104f48c..edd0b644f5 100644
--- a/gnu/services/virtualization.scm
+++ b/gnu/services/virtualization.scm
@@ -23,6 +23,8 @@
#:use-module (gnu bootloader grub)
#:use-module (gnu image)
#:use-module (gnu packages admin)
+ #:use-module (gnu packages gdb)
+ #:use-module (gnu packages package-management)
#:use-module (gnu packages ssh)
#:use-module (gnu packages virtualization)
#:use-module (gnu services base)
@@ -840,8 +842,12 @@ can only be accessed by their host.")))
that will be listening to receive secret keys on port 1004, TCP."
(operating-system
(inherit os)
- (services (cons (service secret-service-type 1004)
- (operating-system-user-services os)))))
+ ;; Arrange so that the secret service activation snippet shows up before
+ ;; the OpenSSH and Guix activation snippets. That way, we receive OpenSSH
+ ;; and Guix keys before the activation snippets try to generate fresh keys
+ ;; for nothing.
+ (services (append (operating-system-user-services os)
+ (list (service secret-service-type 1004))))))
;;;
@@ -857,6 +863,9 @@ that will be listening to receive secret keys on port 1004, TCP."
(bootloader grub-minimal-bootloader)
(target "/dev/vda")
(timeout 0)))
+ (packages (cons* gdb-minimal
+ (operating-system-packages
+ %hurd-default-operating-system)))
(services (cons*
(service openssh-service-type
(openssh-configuration
@@ -900,6 +909,7 @@ is added to the OS specified in CONFIG."
(system-image
(image
(inherit hurd-disk-image)
+ (format 'compressed-qcow2)
(size disk-size)
(operating-system os)))))
@@ -937,13 +947,19 @@ is added to the OS specified in CONFIG."
(provisions '(hurd-vm childhurd)))
(define vm-command
- #~(list
- (string-append #$qemu "/bin/qemu-system-i386")
- #$@(if (file-exists? "/dev/kvm") '("--enable-kvm") '())
- "-m" (number->string #$memory-size)
- #$@net-options
- #$@options
- "--hda" #+image))
+ #~(append (list #$(file-append qemu "/bin/qemu-system-i386")
+ "-m" (number->string #$memory-size)
+ #$@net-options
+ #$@options
+ "--hda" #+image
+
+ ;; Cause the service to be respawned if the guest
+ ;; reboots (it can reboot for instance if it did not
+ ;; receive valid secrets, or if it crashed.)
+ "--no-reboot")
+ (if (file-exists? "/dev/kvm")
+ '("--enable-kvm")
+ '())))
(list
(shepherd-service
@@ -959,28 +975,120 @@ is added to the OS specified in CONFIG."
(with-imported-modules
(source-module-closure '((gnu build secret-service)
(guix build utils)))
- #~(let ((spawn (make-forkexec-constructor #$vm-command)))
- (lambda _
- (let ((pid (spawn))
- (port #$(hurd-vm-port config %hurd-vm-secrets-port))
- (root #$(hurd-vm-configuration-secret-root config)))
- (catch #t
- (lambda _
- (secret-service-send-secrets port root))
- (lambda (key . args)
- (kill (- pid) SIGTERM)
- (apply throw key args)))
- pid)))))
+ #~(lambda ()
+ (let ((pid (fork+exec-command #$vm-command
+ #:user "childhurd"
+ ;; XXX TODO: use "childhurd" after
+ ;; updating Shepherd
+ #:group "kvm"
+ #:environment-variables
+ ;; QEMU tries to write to /var/tmp
+ ;; by default.
+ '("TMPDIR=/tmp")))
+ (port #$(hurd-vm-port config %hurd-vm-secrets-port))
+ (root #$(hurd-vm-configuration-secret-root config)))
+ (catch #t
+ (lambda _
+ ;; XXX: 'secret-service-send-secrets' won't complete until
+ ;; the guest has booted and its secret service server is
+ ;; running, which could take 20+ seconds during which PID 1
+ ;; is stuck waiting.
+ (if (secret-service-send-secrets port root)
+ pid
+ (begin
+ (kill (- pid) SIGTERM)
+ #f)))
+ (lambda (key . args)
+ (kill (- pid) SIGTERM)
+ (apply throw key args)))))))
(modules `((gnu build secret-service)
(guix build utils)
,@%default-modules))
(stop #~(make-kill-destructor))))))
+(define %hurd-vm-accounts
+ (list (user-group (name "childhurd") (system? #t))
+ (user-account
+ (name "childhurd")
+ (group "childhurd")
+ (supplementary-groups '("kvm"))
+ (comment "Privilege separation user for the childhurd")
+ (home-directory "/var/empty")
+ (shell (file-append shadow "/sbin/nologin"))
+ (system? #t))))
+
+(define (initialize-hurd-vm-substitutes)
+ "Initialize the Hurd VM's key pair and ACL and store it on the host."
+ (define run
+ (with-imported-modules '((guix build utils))
+ #~(begin
+ (use-modules (guix build utils)
+ (ice-9 match))
+
+ (define host-key
+ "/etc/guix/signing-key.pub")
+
+ (define host-acl
+ "/etc/guix/acl")
+
+ (match (command-line)
+ ((_ guest-config-directory)
+ (setenv "GUIX_CONFIGURATION_DIRECTORY"
+ guest-config-directory)
+ (invoke #+(file-append guix "/bin/guix") "archive"
+ "--generate-key")
+
+ (when (file-exists? host-acl)
+ ;; Copy the host ACL.
+ (copy-file host-acl
+ (string-append guest-config-directory
+ "/acl")))
+
+ (when (file-exists? host-key)
+ ;; Add the host key to the childhurd's ACL.
+ (let ((key (open-fdes host-key O_RDONLY)))
+ (close-fdes 0)
+ (dup2 key 0)
+ (execl #+(file-append guix "/bin/guix")
+ "guix" "archive" "--authorize"))))))))
+
+ (program-file "initialize-hurd-vm-substitutes" run))
+
+(define (hurd-vm-activation config)
+ "Return a gexp to activate the Hurd VM according to CONFIG."
+ (with-imported-modules '((guix build utils))
+ #~(begin
+ (use-modules (guix build utils))
+
+ (define secret-directory
+ #$(hurd-vm-configuration-secret-root config))
+
+ (define ssh-directory
+ (string-append secret-directory "/etc/ssh"))
+
+ (define guix-directory
+ (string-append secret-directory "/etc/guix"))
+
+ (unless (file-exists? ssh-directory)
+ ;; Generate SSH host keys under SSH-DIRECTORY.
+ (mkdir-p ssh-directory)
+ (invoke #$(file-append openssh "/bin/ssh-keygen")
+ "-A" "-f" secret-directory))
+
+ (unless (file-exists? guix-directory)
+ (invoke #$(initialize-hurd-vm-substitutes)
+ guix-directory)))))
+
(define hurd-vm-service-type
(service-type
(name 'hurd-vm)
(extensions (list (service-extension shepherd-root-service-type
- hurd-vm-shepherd-service)))
+ hurd-vm-shepherd-service)
+ (service-extension account-service-type
+ (const %hurd-vm-accounts))
+ (service-extension activation-service-type
+ hurd-vm-activation)))
(default-value (hurd-vm-configuration))
(description
- "Provide a Virtual Machine running the GNU/Hurd.")))
+ "Provide a virtual machine (VM) running GNU/Hurd, also known as a
+@dfn{childhurd}.")))
diff --git a/gnu/services/web.scm b/gnu/services/web.scm
index c8ffc19d83..a74c6c54b4 100644
--- a/gnu/services/web.scm
+++ b/gnu/services/web.scm
@@ -13,6 +13,7 @@
;;; Copyright © 2020 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2020 Arun Isaac <arunisaac@systemreboot.net>
+;;; Copyright © 2020 Oleg Pykhalov <go.wigust@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -90,7 +91,7 @@
nginx-configuration
nginx-configuration?
- nginx-configuartion-nginx
+ nginx-configuration-nginx
nginx-configuration-log-directory
nginx-configuration-run-directory
nginx-configuration-server-blocks
@@ -525,6 +526,10 @@
(modules nginx-configuration-modules (default '()))
(global-directives nginx-configuration-global-directives
(default '((events . ()))))
+ (lua-package-path nginx-lua-package-path ;list of <package>
+ (default #f))
+ (lua-package-cpath nginx-lua-package-cpath ;list of <package>
+ (default #f))
(extra-content nginx-configuration-extra-content
(default ""))
(file nginx-configuration-file ;#f | string | file-like
@@ -630,6 +635,8 @@ of index files."
server-names-hash-bucket-max-size
modules
global-directives
+ lua-package-path
+ lua-package-cpath
extra-content)
(apply mixed-text-file "nginx.conf"
(flatten
@@ -646,11 +653,19 @@ of index files."
" scgi_temp_path " run-directory "/scgi_temp;\n"
" access_log " log-directory "/access.log;\n"
" include " nginx "/share/nginx/conf/mime.types;\n"
- (if server-names-hash-bucket-size
- (string-append
- " server_names_hash_bucket_size "
- (number->string server-names-hash-bucket-size)
- ";\n")
+ (if lua-package-path
+ #~(format #f " lua_package_path ~s;~%"
+ (string-join (map (lambda (path)
+ (string-append path "/lib/?.lua"))
+ '#$lua-package-path)
+ ";"))
+ "")
+ (if lua-package-cpath
+ #~(format #f " lua_package_cpath ~s;~%"
+ (string-join (map (lambda (cpath)
+ (string-append cpath "/lib/lua/?.lua"))
+ '#$lua-package-cpath)
+ ";"))
"")
(if server-names-hash-bucket-max-size
(string-append
diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm
index ca39994516..4590709187 100644
--- a/gnu/services/xorg.scm
+++ b/gnu/services/xorg.scm
@@ -7,6 +7,7 @@
;;; Copyright © 2019 Tim Gesthuizen <tim.gesthuizen@yahoo.de>
;;; Copyright © 2020 shtwzrd <shtwzrd@protonmail.com>
;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
+;;; Copyright © 2020 Alex Griffin <a@ajgrf.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -925,7 +926,7 @@ the GNOME desktop environment.")
(inherit (unix-pam-service "gdm-autologin"
#:login-uid? #t))
(auth (list (pam-entry
- (control "[success=ok default=1]")
+ (control "optional")
(module (file-append (gdm-configuration-gdm config)
"/lib/security/pam_gdm.so")))
(pam-entry