aboutsummaryrefslogtreecommitdiff
path: root/gnu/services
diff options
context:
space:
mode:
authorMarius Bakke <mbakke@fastmail.com>2018-12-03 19:15:17 +0100
committerMarius Bakke <mbakke@fastmail.com>2018-12-03 19:15:17 +0100
commit99f63f011df2aab38e98d7ee4608a8c70bf74c4d (patch)
tree3f224028f30c60f2ed7b9846365ad926192fc7e9 /gnu/services
parente9a8b603337802a77ff2d68f0d30dc0e67721e3a (diff)
parent4f03aa23e805bd653de774e1d74ed2f50826899b (diff)
downloadguix-99f63f011df2aab38e98d7ee4608a8c70bf74c4d.tar
guix-99f63f011df2aab38e98d7ee4608a8c70bf74c4d.tar.gz
Merge branch 'master' into staging
Diffstat (limited to 'gnu/services')
-rw-r--r--gnu/services/admin.scm180
-rw-r--r--gnu/services/base.scm142
-rw-r--r--gnu/services/cuirass.scm6
-rw-r--r--gnu/services/desktop.scm12
-rw-r--r--gnu/services/dns.scm168
-rw-r--r--gnu/services/games.scm3
-rw-r--r--gnu/services/herd.scm20
-rw-r--r--gnu/services/mail.scm51
-rw-r--r--gnu/services/mcron.scm2
-rw-r--r--gnu/services/networking.scm210
-rw-r--r--gnu/services/shepherd.scm39
-rw-r--r--gnu/services/ssh.scm20
-rw-r--r--gnu/services/version-control.scm180
-rw-r--r--gnu/services/web.scm302
14 files changed, 1016 insertions, 319 deletions
diff --git a/gnu/services/admin.scm b/gnu/services/admin.scm
index aaf0b904fd..d7bda61ed7 100644
--- a/gnu/services/admin.scm
+++ b/gnu/services/admin.scm
@@ -20,19 +20,14 @@
(define-module (gnu services admin)
#:use-module (gnu packages admin)
#:use-module (gnu packages base)
- #:use-module (gnu packages logging)
#:use-module (gnu services)
#:use-module (gnu services mcron)
#:use-module (gnu services shepherd)
- #:use-module (gnu services web)
- #:use-module (gnu system shadow)
#:use-module (guix gexp)
- #:use-module (guix store)
#:use-module (guix packages)
#:use-module (guix records)
#:use-module (srfi srfi-1)
#:use-module (ice-9 vlist)
- #:use-module (ice-9 match)
#:export (%default-rotations
%rotated-files
@@ -46,29 +41,7 @@
rottlog-configuration
rottlog-configuration?
rottlog-service
- rottlog-service-type
-
- <tailon-configuration-file>
- tailon-configuration-file
- tailon-configuration-file?
- tailon-configuration-file-files
- tailon-configuration-file-bind
- tailon-configuration-file-relative-root
- tailon-configuration-file-allow-transfers?
- tailon-configuration-file-follow-names?
- tailon-configuration-file-tail-lines
- tailon-configuration-file-allowed-commands
- tailon-configuration-file-debug?
- tailon-configuration-file-http-auth
- tailon-configuration-file-users
-
- <tailon-configuration>
- tailon-configuration
- tailon-configuration?
- tailon-configuration-config-file
- tailon-configuration-package
-
- tailon-service-type))
+ rottlog-service-type))
;;; Commentary:
;;;
@@ -152,11 +125,9 @@ for ROTATION."
(define (default-jobs rottlog)
(list #~(job '(next-hour '(0)) ;midnight
- (lambda ()
- (system* #$(file-append rottlog "/sbin/rottlog"))))
+ #$(file-append rottlog "/sbin/rottlog"))
#~(job '(next-hour '(12)) ;noon
- (lambda ()
- (system* #$(file-append rottlog "/sbin/rottlog"))))))
+ #$(file-append rottlog "/sbin/rottlog"))))
(define-record-type* <rottlog-configuration>
rottlog-configuration make-rottlog-configuration
@@ -203,149 +174,4 @@ Old log files are removed or compressed according to the configuration.")
rotations)))))
(default-value (rottlog-configuration))))
-
-;;;
-;;; Tailon
-;;;
-
-(define-record-type* <tailon-configuration-file>
- tailon-configuration-file make-tailon-configuration-file
- tailon-configuration-file?
- (files tailon-configuration-file-files
- (default '("/var/log")))
- (bind tailon-configuration-file-bind
- (default "localhost:8080"))
- (relative-root tailon-configuration-file-relative-root
- (default #f))
- (allow-transfers? tailon-configuration-file-allow-transfers?
- (default #t))
- (follow-names? tailon-configuration-file-follow-names?
- (default #t))
- (tail-lines tailon-configuration-file-tail-lines
- (default 200))
- (allowed-commands tailon-configuration-file-allowed-commands
- (default '("tail" "grep" "awk")))
- (debug? tailon-configuration-file-debug?
- (default #f))
- (wrap-lines tailon-configuration-file-wrap-lines
- (default #t))
- (http-auth tailon-configuration-file-http-auth
- (default #f))
- (users tailon-configuration-file-users
- (default #f)))
-
-(define (tailon-configuration-files-string files)
- (string-append
- "\n"
- (string-join
- (map
- (lambda (x)
- (string-append
- " - "
- (cond
- ((string? x)
- (simple-format #f "'~A'" x))
- ((list? x)
- (string-join
- (cons (simple-format #f "'~A':" (car x))
- (map
- (lambda (x) (simple-format #f " - '~A'" x))
- (cdr x)))
- "\n"))
- (else (error x)))))
- files)
- "\n")))
-
-(define-gexp-compiler (tailon-configuration-file-compiler
- (file <tailon-configuration-file>) system target)
- (match file
- (($ <tailon-configuration-file> files bind relative-root
- allow-transfers? follow-names?
- tail-lines allowed-commands debug?
- wrap-lines http-auth users)
- (text-file
- "tailon-config.yaml"
- (string-concatenate
- (filter-map
- (match-lambda
- ((key . #f) #f)
- ((key . value) (string-append key ": " value "\n")))
-
- `(("files" . ,(tailon-configuration-files-string files))
- ("bind" . ,bind)
- ("relative-root" . ,relative-root)
- ("allow-transfers" . ,(if allow-transfers? "true" "false"))
- ("follow-names" . ,(if follow-names? "true" "false"))
- ("tail-lines" . ,(number->string tail-lines))
- ("commands" . ,(string-append "["
- (string-join allowed-commands ", ")
- "]"))
- ("debug" . ,(if debug? "true" #f))
- ("wrap-lines" . ,(if wrap-lines "true" "false"))
- ("http-auth" . ,http-auth)
- ("users" . ,(if users
- (string-concatenate
- (cons "\n"
- (map (match-lambda
- ((user . pass)
- (string-append
- " " user ":" pass)))
- users)))
- #f)))))))))
-
-(define-record-type* <tailon-configuration>
- tailon-configuration make-tailon-configuration
- tailon-configuration?
- (config-file tailon-configuration-config-file
- (default (tailon-configuration-file)))
- (package tailon-configuration-package
- (default tailon)))
-
-(define tailon-shepherd-service
- (match-lambda
- (($ <tailon-configuration> config-file package)
- (list (shepherd-service
- (provision '(tailon))
- (documentation "Run the tailon daemon.")
- (start #~(make-forkexec-constructor
- `(,(string-append #$package "/bin/tailon")
- "-c" ,#$config-file)
- #:user "tailon"
- #:group "tailon"))
- (stop #~(make-kill-destructor)))))))
-
-(define %tailon-accounts
- (list (user-group (name "tailon") (system? #t))
- (user-account
- (name "tailon")
- (group "tailon")
- (system? #t)
- (comment "tailon")
- (home-directory "/var/empty")
- (shell (file-append shadow "/sbin/nologin")))))
-
-(define tailon-service-type
- (service-type
- (name 'tailon)
- (description
- "Run Tailon, a Web application for monitoring, viewing, and searching log
-files.")
- (extensions
- (list (service-extension shepherd-root-service-type
- tailon-shepherd-service)
- (service-extension account-service-type
- (const %tailon-accounts))))
- (compose concatenate)
- (extend (lambda (parameter files)
- (tailon-configuration
- (inherit parameter)
- (config-file
- (let ((old-config-file
- (tailon-configuration-config-file parameter)))
- (tailon-configuration-file
- (inherit old-config-file)
- (files (append (tailon-configuration-file-files old-config-file)
- files))))))))
- (default-value (tailon-configuration))))
-
;;; admin.scm ends here
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 921914ccdf..228d3c5926 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -6,6 +6,7 @@
;;; Copyright © 2016, 2017 Leo Famulari <leo@famulari.name>
;;; Copyright © 2016 David Craven <david@craven.ch>
;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -685,17 +686,20 @@ to add @var{device} to the kernel's entropy pool. The service will fail if
(shepherd-service-type
'virtual-terminal
(lambda (utf8?)
- (shepherd-service
- (documentation "Set virtual terminals in UTF-8 module.")
- (provision '(virtual-terminal))
- (requirement '(root-file-system))
- (start #~(lambda _
- (call-with-output-file
- "/sys/module/vt/parameters/default_utf8"
- (lambda (port)
- (display 1 port)))
- #t))
- (stop #~(const #f))))
+ (let ((knob "/sys/module/vt/parameters/default_utf8"))
+ (shepherd-service
+ (documentation "Set virtual terminals in UTF-8 module.")
+ (provision '(virtual-terminal))
+ (requirement '(root-file-system))
+ (start #~(lambda _
+ ;; In containers /sys is read-only so don't insist on
+ ;; writing to this file.
+ (unless (= 1 (call-with-input-file #$knob read))
+ (call-with-output-file #$knob
+ (lambda (port)
+ (display 1 port))))
+ #t))
+ (stop #~(const #f)))))
#t)) ;default to UTF-8
(define console-keymap-service-type
@@ -1248,18 +1252,57 @@ the tty to run, among other things."
(string-concatenate
(map cache->config caches)))))))
+(define (nscd-action-procedure nscd config option)
+ ;; XXX: This is duplicated from mcron; factorize.
+ #~(lambda (_ . args)
+ ;; Run 'nscd' in a pipe so we can explicitly redirect its output to
+ ;; 'current-output-port', which at this stage is bound to the client
+ ;; connection.
+ (let ((pipe (apply open-pipe* OPEN_READ #$nscd
+ "-f" #$config #$option args)))
+ (let loop ()
+ (match (read-line pipe 'concat)
+ ((? eof-object?)
+ (catch 'system-error
+ (lambda ()
+ (zero? (close-pipe pipe)))
+ (lambda args
+ ;; There's a race with the SIGCHLD handler, which could
+ ;; call 'waitpid' before 'close-pipe' above does. If we
+ ;; get ECHILD, that means we lost the race, but that's
+ ;; fine.
+ (or (= ECHILD (system-error-errno args))
+ (apply throw args)))))
+ (line
+ (display line)
+ (loop)))))))
+
+(define (nscd-actions nscd config)
+ "Return Shepherd actions for NSCD."
+ ;; Make this functionality available as actions because that's a simple way
+ ;; to run the right 'nscd' binary with the right config file.
+ (list (shepherd-action
+ (name 'statistics)
+ (documentation "Display statistics about nscd usage.")
+ (procedure (nscd-action-procedure nscd config "--statistics")))
+ (shepherd-action
+ (name 'invalidate)
+ (documentation
+ "Invalidate the given cache--e.g., 'hosts' for host name lookups.")
+ (procedure (nscd-action-procedure nscd config "--invalidate")))))
+
(define (nscd-shepherd-service config)
"Return a shepherd service for CONFIG, an <nscd-configuration> object."
- (let ((nscd.conf (nscd.conf-file config))
+ (let ((nscd (file-append (nscd-configuration-glibc config)
+ "/sbin/nscd"))
+ (nscd.conf (nscd.conf-file config))
(name-services (nscd-configuration-name-services config)))
(list (shepherd-service
(documentation "Run libc's name service cache daemon (nscd).")
(provision '(nscd))
(requirement '(user-processes))
(start #~(make-forkexec-constructor
- (list #$(file-append (nscd-configuration-glibc config)
- "/sbin/nscd")
- "-f" #$nscd.conf "--foreground")
+ (list #$nscd "-f" #$nscd.conf "--foreground")
;; Wait for the PID file. However, the PID file is
;; written before nscd is actually listening on its
@@ -1273,7 +1316,12 @@ the tty to run, among other things."
(string-append dir "/lib"))
(list #$@name-services))
":")))))
- (stop #~(make-kill-destructor))))))
+ (stop #~(make-kill-destructor))
+ (modules `((ice-9 popen) ;for the actions
+ (ice-9 rdelim)
+ (ice-9 match)
+ ,@%default-modules))
+ (actions (nscd-actions nscd nscd.conf))))))
(define nscd-activation
;; Actions to take before starting nscd.
@@ -1846,16 +1894,9 @@ item of @var{packages}."
(documentation "Populate the /dev directory, dynamically.")
(start #~(lambda ()
- (define find
- (@ (srfi srfi-1) find))
-
(define udevd
- ;; Choose the right 'udevd'.
- (find file-exists?
- (map (lambda (suffix)
- (string-append #$udev suffix))
- '("/libexec/udev/udevd" ;udev
- "/sbin/udevd")))) ;eudev
+ ;; 'udevd' from eudev.
+ #$(file-append udev "/sbin/udevd"))
(define (wait-for-udevd)
;; Wait until someone's listening on udevd's control
@@ -1888,27 +1929,28 @@ item of @var{packages}."
(string-append linux-module-directory "/"
kernel-release))
(old-umask (umask #o022)))
- (make-static-device-nodes directory)
+ ;; If we're in a container, DIRECTORY might not exist,
+ ;; for instance because the host runs a different
+ ;; kernel. In that case, skip it; we'll just miss a few
+ ;; nodes like /dev/fuse.
+ (when (file-exists? directory)
+ (make-static-device-nodes directory))
(umask old-umask))
- (let ((pid (primitive-fork)))
- (case pid
- ((0)
- (exec-command (list udevd)))
- (else
- ;; Wait until udevd is up and running. This
- ;; appears to be needed so that the events
- ;; triggered below are actually handled.
- (wait-for-udevd)
-
- ;; Trigger device node creation.
- (system* #$(file-append udev "/bin/udevadm")
- "trigger" "--action=add")
-
- ;; Wait for things to settle down.
- (system* #$(file-append udev "/bin/udevadm")
- "settle")
- pid)))))
+ (let ((pid (fork+exec-command (list udevd))))
+ ;; Wait until udevd is up and running. This appears to
+ ;; be needed so that the events triggered below are
+ ;; actually handled.
+ (wait-for-udevd)
+
+ ;; Trigger device node creation.
+ (system* #$(file-append udev "/bin/udevadm")
+ "trigger" "--action=add")
+
+ ;; Wait for things to settle down.
+ (system* #$(file-append udev "/bin/udevadm")
+ "settle")
+ pid)))
(stop #~(make-kill-destructor))
;; When halting the system, 'udev' is actually killed by
@@ -2043,6 +2085,8 @@ This service is not part of @var{%base-services}."
(default (file-append shadow "/bin/login")))
(login-arguments kmscon-configuration-login-arguments
(default '("-p")))
+ (auto-login kmscon-configuration-auto-login
+ (default #f))
(hardware-acceleration? kmscon-configuration-hardware-acceleration?
(default #f))) ; #t causes failure
@@ -2054,14 +2098,20 @@ This service is not part of @var{%base-services}."
(virtual-terminal (kmscon-configuration-virtual-terminal config))
(login-program (kmscon-configuration-login-program config))
(login-arguments (kmscon-configuration-login-arguments config))
+ (auto-login (kmscon-configuration-auto-login config))
(hardware-acceleration? (kmscon-configuration-hardware-acceleration? config)))
(define kmscon-command
#~(list
#$(file-append kmscon "/bin/kmscon") "--login"
"--vt" #$virtual-terminal
+ "--no-switchvt" ;Prevent a switch to the virtual terminal.
#$@(if hardware-acceleration? '("--hwaccel") '())
- "--" #$login-program #$@login-arguments))
+ "--login" "--"
+ #$login-program #$@login-arguments
+ #$@(if auto-login
+ #~(#$auto-login)
+ #~())))
(shepherd-service
(documentation "kmscon virtual terminal")
@@ -2133,7 +2183,7 @@ This service is not part of @var{%base-services}."
AF_INET INADDR_ANY 0)))
(set-network-interface-flags sock #$interface 0)
(close-port sock)
-: #f)))
+ #f)))
(respawn? #f))))))
(define (static-networking-etc-files interfaces)
diff --git a/gnu/services/cuirass.scm b/gnu/services/cuirass.scm
index 496b2d06c8..36e90fc825 100644
--- a/gnu/services/cuirass.scm
+++ b/gnu/services/cuirass.scm
@@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
-;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2017 Jan Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
@@ -54,6 +54,8 @@
(default "/var/log/cuirass.log"))
(cache-directory cuirass-configuration-cache-directory ;string (dir-name)
(default "/var/cache/cuirass"))
+ (ttl cuirass-configuration-ttl ;integer
+ (default (* 30 24 3600)))
(user cuirass-configuration-user ;string
(default "cuirass"))
(group cuirass-configuration-group ;string
@@ -86,6 +88,7 @@
(group (cuirass-configuration-group config))
(interval (cuirass-configuration-interval config))
(database (cuirass-configuration-database config))
+ (ttl (cuirass-configuration-ttl config))
(port (cuirass-configuration-port config))
(host (cuirass-configuration-host config))
(specs (cuirass-configuration-specifications config))
@@ -102,6 +105,7 @@
"--specifications"
#$(scheme-file "cuirass-specs.scm" specs)
"--database" #$database
+ "--ttl" #$(string-append (number->string ttl) "s")
"--port" #$(number->string port)
"--listen" #$host
"--interval" #$(number->string interval)
diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm
index 1e8c02c02a..47d1096c6d 100644
--- a/gnu/services/desktop.scm
+++ b/gnu/services/desktop.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 Andy Wingo <wingo@igalia.com>
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2016 Sou Bunnbu <iyzsong@gmail.com>
@@ -672,7 +672,7 @@ include the @command{udisksctl} command, part of UDisks, and GNOME Disks."
("KillUserProcesses" (yesno elogind-kill-user-processes?))
("KillOnlyUsers" (user-name-list elogind-kill-only-users))
("KillExcludeUsers" (user-name-list elogind-kill-exclude-users))
- ("InhibitDelayMaxSecs" (non-negative-integer elogind-inhibit-delay-max-seconds))
+ ("InhibitDelayMaxSec" (non-negative-integer elogind-inhibit-delay-max-seconds))
("HandlePowerKey" (handle-action elogind-handle-power-key))
("HandleSuspendKey" (handle-action elogind-handle-suspend-key))
("HandleHibernateKey" (handle-action elogind-handle-hibernate-key))
@@ -682,16 +682,16 @@ include the @command{udisksctl} command, part of UDisks, and GNOME Disks."
("SuspendKeyIgnoreInhibited" (yesno elogind-suspend-key-ignore-inhibited?))
("HibernateKeyIgnoreInhibited" (yesno elogind-hibernate-key-ignore-inhibited?))
("LidSwitchIgnoreInhibited" (yesno elogind-lid-switch-ignore-inhibited?))
- ("HoldoffTimeoutSecs" (non-negative-integer elogind-holdoff-timeout-seconds))
+ ("HoldoffTimeoutSec" (non-negative-integer elogind-holdoff-timeout-seconds))
("IdleAction" (handle-action elogind-idle-action))
- ("IdleActionSeconds" (non-negative-integer elogind-idle-action-seconds))
+ ("IdleActionSec" (non-negative-integer elogind-idle-action-seconds))
("RuntimeDirectorySize"
(identity
(lambda (config)
(match (elogind-runtime-directory-size-percent config)
(#f (non-negative-integer (elogind-runtime-directory-size config)))
(percent (string-append (non-negative-integer percent) "%"))))))
- ("RemoveIpc" (yesno elogind-remove-ipc?))
+ ("RemoveIPC" (yesno elogind-remove-ipc?))
"[Sleep]"
("SuspendState" (sleep-list elogind-suspend-state))
("SuspendMode" (sleep-list elogind-suspend-mode))
@@ -996,7 +996,7 @@ as expected.")))
(elogind-service)
(dbus-service)
- (ntp-service)
+ (service ntp-service-type)
x11-socket-directory-service
diff --git a/gnu/services/dns.scm b/gnu/services/dns.scm
index 2c57a36b84..24ef886682 100644
--- a/gnu/services/dns.scm
+++ b/gnu/services/dns.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Julien Lepiller <julien@lepiller.eu>
+;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -45,7 +46,10 @@
zone-entry
dnsmasq-service-type
- dnsmasq-configuration))
+ dnsmasq-configuration
+
+ ddclient-service-type
+ ddclient-configuration))
;;;
;;; Knot DNS.
@@ -670,3 +674,165 @@
(compose list dnsmasq-shepherd-service))))
(default-value (dnsmasq-configuration))
(description "Run the dnsmasq DNS server.")))
+
+
+;;;
+;;; ddclient
+;;;
+
+(define (uglify-field-name field-name)
+ (string-delete #\? (symbol->string field-name)))
+
+(define (serialize-field field-name val)
+ (format #t "~a=~a\n" (uglify-field-name field-name) val))
+
+(define (serialize-boolean field-name val)
+ (serialize-field field-name (if val "yes" "no")))
+
+(define (serialize-integer field-name val)
+ (serialize-field field-name (number->string val)))
+
+(define (serialize-string field-name val)
+ (if (and (string? val) (string=? val ""))
+ ""
+ (serialize-field field-name val)))
+
+(define (serialize-list field-name val)
+ (if (null? val) "" (serialize-field field-name (string-join val))))
+
+(define (serialize-extra-options extra-options)
+ (string-join extra-options "\n" 'suffix))
+
+(define-configuration ddclient-configuration
+ (ddclient
+ (package ddclient)
+ "The ddclient package.")
+ (daemon
+ (integer 300)
+ "The period after which ddclient will retry to check IP and domain name.")
+ (syslog
+ (boolean #t)
+ "Use syslog for the output.")
+ (mail
+ (string "root")
+ "Mail to user.")
+ (mail-failure
+ (string "root")
+ "Mail failed update to user.")
+ (pid
+ (string "/var/run/ddclient/ddclient.pid")
+ "The ddclient PID file.")
+ (ssl
+ (boolean #t)
+ "Enable SSL support.")
+ (user
+ (string "ddclient")
+ "Specifies the user name or ID that is used when running ddclient
+program.")
+ (group
+ (string "ddclient")
+ "Group of the user who will run the ddclient program.")
+ (secret-file
+ (string "/etc/ddclient/secrets.conf")
+ "Secret file which will be appended to @file{ddclient.conf} file. This
+file contains credentials for use by ddclient. You are expected to create it
+manually.")
+ (extra-options
+ (list '())
+ "Extra options will be appended to @file{ddclient.conf} file."))
+
+(define (ddclient-account config)
+ "Return the user accounts and user groups for CONFIG."
+ (let ((ddclient-user (ddclient-configuration-user config))
+ (ddclient-group (ddclient-configuration-group config)))
+ (list (user-group
+ (name ddclient-group)
+ (system? #t))
+ (user-account
+ (name ddclient-user)
+ (system? #t)
+ (group ddclient-group)
+ (comment "ddclientd privilege separation user")
+ (home-directory (string-append "/var/run/" ddclient-user))))))
+
+(define (ddclient-activation config)
+ "Return the activation GEXP for CONFIG."
+ (with-imported-modules '((guix build utils)
+ (ice-9 rdelim))
+ #~(begin
+ (use-modules (guix build utils)
+ (ice-9 rdelim))
+ (let ((ddclient-user
+ (passwd:uid (getpw #$(ddclient-configuration-user config))))
+ (ddclient-group
+ (passwd:gid (getpw #$(ddclient-configuration-group config))))
+ (ddclient-secret-file
+ #$(ddclient-configuration-secret-file config)))
+ ;; 'ddclient' complains about ddclient.conf file permissions, which
+ ;; rules out /gnu/store. Thus we copy the ddclient.conf to /etc.
+ (for-each (lambda (dir)
+ (mkdir-p dir)
+ (chmod dir #o700)
+ (chown dir ddclient-user ddclient-group))
+ '("/var/cache/ddclient" "/var/run/ddclient"
+ "/etc/ddclient"))
+ (with-output-to-file "/etc/ddclient/ddclient.conf"
+ (lambda ()
+ (display
+ (string-append
+ "# Generated by 'ddclient-service'.\n\n"
+ #$(with-output-to-string
+ (lambda ()
+ (serialize-configuration config
+ ddclient-configuration-fields)))
+ (if (string-null? ddclient-secret-file)
+ ""
+ (format #f "\n\n# Appended from '~a'.\n\n~a"
+ ddclient-secret-file
+ (with-input-from-file ddclient-secret-file
+ read-string)))))))
+ (chmod "/etc/ddclient/ddclient.conf" #o600)
+ (chown "/etc/ddclient/ddclient.conf"
+ ddclient-user ddclient-group)))))
+
+(define (ddclient-shepherd-service config)
+ "Return a <shepherd-service> for ddclient with CONFIG."
+ (let ((ddclient (ddclient-configuration-ddclient config))
+ (ddclient-pid (ddclient-configuration-pid config))
+ (ddclient-user (ddclient-configuration-user config))
+ (ddclient-group (ddclient-configuration-group config)))
+ (list (shepherd-service
+ (provision '(ddclient))
+ (documentation "Run ddclient daemon.")
+ (start #~(make-forkexec-constructor
+ (list #$(file-append ddclient "/bin/ddclient")
+ "-foreground"
+ "-file" "/etc/ddclient/ddclient.conf")
+ #:pid-file #$ddclient-pid
+ #:environment-variables
+ (list "SSL_CERT_DIR=/run/current-system/profile\
+/etc/ssl/certs"
+ "SSL_CERT_FILE=/run/current-system/profile\
+/etc/ssl/certs/ca-certificates.crt")
+ #:user #$ddclient-user
+ #:group #$ddclient-group))
+ (stop #~(make-kill-destructor))))))
+
+(define ddclient-service-type
+ (service-type
+ (name 'ddclient)
+ (extensions
+ (list (service-extension account-service-type
+ ddclient-account)
+ (service-extension shepherd-root-service-type
+ ddclient-shepherd-service)
+ (service-extension activation-service-type
+ ddclient-activation)))
+ (default-value (ddclient-configuration))
+ (description "Configure address updating utility for dynamic DNS services,
+ddclient.")))
+
+(define (generate-ddclient-documentation)
+ (generate-documentation
+ `((ddclient-configuration ,ddclient-configuration-fields))
+ 'ddclient-configuration))
diff --git a/gnu/services/games.scm b/gnu/services/games.scm
index b9d78e078d..b743f6a4b6 100644
--- a/gnu/services/games.scm
+++ b/gnu/services/games.scm
@@ -65,7 +65,8 @@
(modules '((gnu build shepherd)))
(start #~(make-forkexec-constructor/container
(list #$(file-append package "/bin/wesnothd")
- "-p" #$(number->string port))))
+ "-p" #$(number->string port))
+ #:user "wesnothd" #:group "wesnothd"))
(stop #~(make-kill-destructor)))))))
(define wesnothd-service-type
diff --git a/gnu/services/herd.scm b/gnu/services/herd.scm
index 8c96b70731..8ff817759d 100644
--- a/gnu/services/herd.scm
+++ b/gnu/services/herd.scm
@@ -50,6 +50,7 @@
unload-services
unload-service
load-services
+ load-services/safe
start-service
stop-service))
@@ -232,6 +233,25 @@ returns a shepherd <service> object."
`(primitive-load ,file))
files))))
+(define (load-services/safe files)
+ "This is like 'load-services', but make sure only the subset of FILES that
+can be safely reloaded is actually reloaded.
+
+This is done to accommodate the Shepherd < 0.15.0 where services lacked the
+'replacement' slot, and where 'register-services' would throw an exception
+when passed a service with an already-registered name."
+ (eval-there `(let* ((services (map primitive-load ',files))
+ (slots (map slot-definition-name
+ (class-slots <service>)))
+ (can-replace? (memq 'replacement slots)))
+ (define (registered? service)
+ (not (null? (lookup-services (canonical-name service)))))
+
+ (apply register-services
+ (if can-replace?
+ services
+ (remove registered? services))))))
+
(define (start-service name)
(with-shepherd-action name ('start) result
result))
diff --git a/gnu/services/mail.scm b/gnu/services/mail.scm
index 573efa0433..fcaedd038b 100644
--- a/gnu/services/mail.scm
+++ b/gnu/services/mail.scm
@@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Andy Wingo <wingo@igalia.com>
-;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
+;;; Copyright © 2017, 2018 Clément Lassieur <clement@lassieur.org>
;;; Copyright © 2017 Carlo Zancanaro <carlo@zancanaro.id.au>
;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
;;;
@@ -290,11 +290,21 @@ the section name.")
"Listeners for the service. A listener is either an
@code{unix-listener-configuration}, a @code{fifo-listener-configuration}, or
an @code{inet-listener-configuration}.")
+ (client-limit
+ (non-negative-integer 0)
+ "Maximum number of simultaneous client connections per process. Once this
+number of connections is received, the next incoming connection will prompt
+Dovecot to spawn another process. If set to 0, @code{default-client-limit} is
+used instead.")
(service-count
(non-negative-integer 1)
"Number of connections to handle before starting a new process.
Typically the only useful values are 0 (unlimited) or 1. 1 is more
secure, but 0 is faster. <doc/wiki/LoginProcess.txt>.")
+ (process-limit
+ (non-negative-integer 0)
+ "Maximum number of processes that can exist for this service. If set to 0,
+@code{default-process-limit} is used instead.")
(process-min-avail
(non-negative-integer 0)
"Number of processes to always keep waiting for more connections.")
@@ -475,6 +485,8 @@ complex, customize the address and port fields of the
(list
(service-configuration
(kind "imap-login")
+ (client-limit 0)
+ (process-limit 0)
(listeners
(list
(inet-listener-configuration (protocol "imap") (port 143) (ssl? #f))
@@ -487,24 +499,33 @@ complex, customize the address and port fields of the
(inet-listener-configuration (protocol "pop3s") (port 995) (ssl? #t)))))
(service-configuration
(kind "lmtp")
+ (client-limit 1)
+ (process-limit 0)
(listeners
(list (unix-listener-configuration (path "lmtp") (mode "0666")))))
- (service-configuration (kind "imap"))
- (service-configuration (kind "pop3"))
- (service-configuration (kind "auth")
- ;; In what could be taken to be a bug, the default value of 1 for
- ;; service-count makes it so that a PAM auth worker can't fork off
- ;; subprocesses for making blocking queries. The result is that nobody
- ;; can log in -- very secure, but not very useful! If we simply omit
- ;; the service-count, it will default to the value of
- ;; auth-worker-max-count, which is 30, instead of defaulting to 1, which
- ;; is the default for all other services. As a hack, bump this value to
- ;; 30.
- (service-count 30)
+ (service-configuration
+ (kind "imap")
+ (client-limit 1)
+ (process-limit 1024))
+ (service-configuration
+ (kind "pop3")
+ (client-limit 1)
+ (process-limit 1024))
+ (service-configuration
+ (kind "auth")
+ (service-count 0)
+ (client-limit 0)
+ (process-limit 1)
(listeners
(list (unix-listener-configuration (path "auth-userdb")))))
- (service-configuration (kind "auth-worker"))
- (service-configuration (kind "dict")
+ (service-configuration
+ (kind "auth-worker")
+ (client-limit 1)
+ (process-limit 0))
+ (service-configuration
+ (kind "dict")
+ (client-limit 1)
+ (process-limit 0)
(listeners (list (unix-listener-configuration (path "dict")))))))
"List of services to enable. Available services include @samp{imap},
@samp{imap-login}, @samp{pop3}, @samp{pop3-login}, @samp{auth}, and
diff --git a/gnu/services/mcron.scm b/gnu/services/mcron.scm
index 5757bf8cf6..120b663e3e 100644
--- a/gnu/services/mcron.scm
+++ b/gnu/services/mcron.scm
@@ -86,7 +86,7 @@ files."
(lambda ()
(zero? (close-pipe pipe)))
(lambda args
- ;; There's with race between the SIGCHLD handler, which
+ ;; There's a race with the SIGCHLD handler, which
;; could call 'waitpid' before 'close-pipe' above does. If
;; we get ECHILD, that means we lost the race, but that's
;; fine.
diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm
index d5d0cf9d1d..bfa6e297e6 100644
--- a/gnu/services/networking.scm
+++ b/gnu/services/networking.scm
@@ -1,12 +1,14 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2016, 2018 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2016 John Darrington <jmd@gnu.org>
;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
;;; Copyright © 2017 Thomas Danckaert <post@thomasdanckaert.be>
-;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com>
+;;; Copyright © 2017, 2018 Marius Bakke <mbakke@fastmail.com>
;;; Copyright © 2018 Tobias Geerinckx-Rice <me@tobias.gr>
+;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
+;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -51,6 +53,7 @@
static-networking-service-type)
#:export (%facebook-host-aliases
dhcp-client-service
+ dhcp-client-service-type
dhcpd-service-type
dhcpd-configuration
@@ -99,10 +102,27 @@
modem-manager-configuration
modem-manager-configuration?
modem-manager-service-type
+
+ <wpa-supplicant-configuration>
+ wpa-supplicant-configuration
+ wpa-supplicant-configuration?
+ wpa-supplicant-configuration-wpa-supplicant
+ wpa-supplicant-configuration-pid-file
+ wpa-supplicant-configuration-dbus?
+ wpa-supplicant-configuration-interface
+ wpa-supplicant-configuration-config-file
+ wpa-supplicant-configuration-extra-options
wpa-supplicant-service-type
openvswitch-service-type
- openvswitch-configuration))
+ openvswitch-configuration
+
+ iptables-configuration
+ iptables-configuration?
+ iptables-configuration-iptables
+ iptables-configuration-ipv4-rules
+ iptables-configuration-ipv6-rules
+ iptables-service-type))
;;; Commentary:
;;;
@@ -182,22 +202,11 @@ fe80::1%lo0 apps.facebook.com\n")
(cons* #$dhclient "-nw"
"-pf" #$pid-file ifaces))))
(and (zero? (cdr (waitpid pid)))
- (let loop ()
- (catch 'system-error
- (lambda ()
- (call-with-input-file #$pid-file read))
- (lambda args
- ;; 'dhclient' returned before PID-FILE was created,
- ;; so try again.
- (let ((errno (system-error-errno args)))
- (if (= ENOENT errno)
- (begin
- (sleep 1)
- (loop))
- (apply throw args))))))))))
- (stop #~(make-kill-destructor))))))
-
-(define* (dhcp-client-service #:key (dhcp isc-dhcp))
+ (read-pid-file #$pid-file)))))
+ (stop #~(make-kill-destructor))))
+ isc-dhcp))
+
+(define* (dhcp-client-service #:key (dhcp isc-dhcp)) ;deprecated
"Return a service that runs @var{dhcp}, a Dynamic Host Configuration
Protocol (DHCP) client, on all the non-loopback network interfaces."
(service dhcp-client-service-type dhcp))
@@ -288,7 +297,8 @@ Protocol (DHCP) client, on all the non-loopback network interfaces."
ntp-configuration?
(ntp ntp-configuration-ntp
(default ntp))
- (servers ntp-configuration-servers)
+ (servers ntp-configuration-servers
+ (default %ntp-servers))
(allow-large-adjustment? ntp-allow-large-adjustment?
(default #f)))
@@ -361,9 +371,10 @@ restrict -6 ::1\n"))
(description
"Run the @command{ntpd}, the Network Time Protocol (NTP)
daemon of the @uref{http://www.ntp.org, Network Time Foundation}. The daemon
-will keep the system clock synchronized with that of the given servers.")))
+will keep the system clock synchronized with that of the given servers.")
+ (default-value (ntp-configuration))))
-(define* (ntp-service #:key (ntp ntp)
+(define* (ntp-service #:key (ntp ntp) ;deprecated
(servers %ntp-servers)
allow-large-adjustment?)
"Return a service that runs the daemon from @var{ntp}, the
@@ -576,7 +587,9 @@ demand.")))
(config-file tor-configuration-config-file
(default (plain-file "empty" "")))
(hidden-services tor-configuration-hidden-services
- (default '())))
+ (default '()))
+ (socks-socket-type tor-configuration-socks-socket-type ; 'tcp or 'unix
+ (default 'tcp)))
(define %tor-accounts
;; User account and groups for Tor.
@@ -598,7 +611,7 @@ demand.")))
(define (tor-configuration->torrc config)
"Return a 'torrc' file for CONFIG."
(match config
- (($ <tor-configuration> tor config-file services)
+ (($ <tor-configuration> tor config-file services socks-socket-type)
(computed-file
"torrc"
(with-imported-modules '((guix build utils))
@@ -612,7 +625,12 @@ demand.")))
### These lines were generated from your system configuration:
User tor
DataDirectory /var/lib/tor
+PidFile /var/run/tor/tor.pid
Log notice syslog\n" port)
+ (when (eq? 'unix '#$socks-socket-type)
+ (display "\
+SocksPort unix:/var/run/tor/socks-sock
+UnixSocksGroupWritable 1\n" port))
(for-each (match-lambda
((service (ports hosts) ...)
@@ -639,7 +657,7 @@ HiddenServicePort ~a ~a~%"
#t))))))))
(define (tor-shepherd-service config)
- "Return a <shepherd-service> running TOR."
+ "Return a <shepherd-service> running Tor."
(match config
(($ <tor-configuration> tor)
(let ((torrc (tor-configuration->torrc config)))
@@ -665,12 +683,17 @@ HiddenServicePort ~a ~a~%"
(writable? #t))
(file-system-mapping
(source "/dev/log") ;for syslog
- (target source)))))
+ (target source))
+ (file-system-mapping
+ (source "/var/run/tor")
+ (target source)
+ (writable? #t)))
+ #:pid-file "/var/run/tor/tor.pid"))
(stop #~(make-kill-destructor))
(documentation "Run the Tor anonymous network overlay."))))))))
-(define (tor-hidden-service-activation config)
- "Return the activation gexp for SERVICES, a list of hidden services."
+(define (tor-activation config)
+ "Set up directories for Tor and its hidden services, if any."
#~(begin
(use-modules (guix build utils))
@@ -686,6 +709,15 @@ HiddenServicePort ~a ~a~%"
;; The daemon bails out if we give wider permissions.
(chmod directory #o700)))
+ ;; Allow Tor to write its PID file.
+ (mkdir-p "/var/run/tor")
+ (chown "/var/run/tor" (passwd:uid %user) (passwd:gid %user))
+ ;; Set the group permissions to rw so that if the system administrator
+ ;; has specified UnixSocksGroupWritable=1 in their torrc file, members
+ ;; of the "tor" group will be able to use the SOCKS socket.
+ (chmod "/var/run/tor" #o750)
+
+ ;; Allow Tor to access the hidden services' directories.
(mkdir-p "/var/lib/tor")
(chown "/var/lib/tor" (passwd:uid %user) (passwd:gid %user))
(chmod "/var/lib/tor" #o700)
@@ -705,7 +737,7 @@ HiddenServicePort ~a ~a~%"
(service-extension account-service-type
(const %tor-accounts))
(service-extension activation-service-type
- tor-hidden-service-activation)))
+ tor-activation)))
;; This can be extended with hidden services.
(compose concatenate)
@@ -1001,28 +1033,62 @@ networking."))))
;;; WPA supplicant
;;;
-
-(define (wpa-supplicant-shepherd-service wpa-supplicant)
- "Return a shepherd service for wpa_supplicant"
- (list (shepherd-service
- (documentation "Run WPA supplicant with dbus interface")
- (provision '(wpa-supplicant))
- (requirement '(user-processes dbus-system loopback))
- (start #~(make-forkexec-constructor
- (list (string-append #$wpa-supplicant
- "/sbin/wpa_supplicant")
- "-u" "-B" "-P/var/run/wpa_supplicant.pid")
- #:pid-file "/var/run/wpa_supplicant.pid"))
- (stop #~(make-kill-destructor)))))
+(define-record-type* <wpa-supplicant-configuration>
+ wpa-supplicant-configuration make-wpa-supplicant-configuration
+ wpa-supplicant-configuration?
+ (wpa-supplicant wpa-supplicant-configuration-wpa-supplicant ;<package>
+ (default wpa-supplicant))
+ (pid-file wpa-supplicant-configuration-pid-file ;string
+ (default "/var/run/wpa_supplicant.pid"))
+ (dbus? wpa-supplicant-configuration-dbus? ;Boolean
+ (default #t))
+ (interface wpa-supplicant-configuration-interface ;#f | string
+ (default #f))
+ (config-file wpa-supplicant-configuration-config-file ;#f | <file-like>
+ (default #f))
+ (extra-options wpa-supplicant-configuration-extra-options ;list of strings
+ (default '())))
+
+(define wpa-supplicant-shepherd-service
+ (match-lambda
+ (($ <wpa-supplicant-configuration> wpa-supplicant pid-file dbus? interface
+ config-file extra-options)
+ (list (shepherd-service
+ (documentation "Run the WPA supplicant daemon")
+ (provision '(wpa-supplicant))
+ (requirement '(user-processes dbus-system loopback))
+ (start #~(make-forkexec-constructor
+ (list (string-append #$wpa-supplicant
+ "/sbin/wpa_supplicant")
+ (string-append "-P" #$pid-file)
+ "-B" ;run in background
+ #$@(if dbus?
+ #~("-u")
+ #~())
+ #$@(if interface
+ #~((string-append "-i" #$interface))
+ #~())
+ #$@(if config-file
+ #~((string-append "-c" #$config-file))
+ #~())
+ #$@extra-options)
+ #:pid-file #$pid-file))
+ (stop #~(make-kill-destructor)))))))
(define wpa-supplicant-service-type
- (service-type (name 'wpa-supplicant)
- (extensions
- (list (service-extension shepherd-root-service-type
- wpa-supplicant-shepherd-service)
- (service-extension dbus-root-service-type list)
- (service-extension profile-service-type list)))
- (default-value wpa-supplicant)))
+ (let ((config->package
+ (match-lambda
+ (($ <wpa-supplicant-configuration> wpa-supplicant)
+ (list wpa-supplicant)))))
+ (service-type (name 'wpa-supplicant)
+ (extensions
+ (list (service-extension shepherd-root-service-type
+ wpa-supplicant-shepherd-service)
+ (service-extension dbus-root-service-type config->package)
+ (service-extension profile-service-type config->package)))
+ (description "Run the WPA Supplicant daemon, a service that
+implements authentication, key negotiation and more for wireless networks.")
+ (default-value (wpa-supplicant-configuration)))))
;;;
@@ -1086,4 +1152,50 @@ networking."))))
switch designed to enable massive network automation through programmatic
extension.")))
+;;;
+;;; iptables
+;;;
+
+(define %iptables-accept-all-rules
+ (plain-file "iptables-accept-all.rules"
+ "*filter
+:INPUT ACCEPT
+:FORWARD ACCEPT
+:OUTPUT ACCEPT
+COMMIT
+"))
+
+(define-record-type* <iptables-configuration>
+ iptables-configuration make-iptables-configuration iptables-configuration?
+ (iptables iptables-configuration-iptables
+ (default iptables))
+ (ipv4-rules iptables-configuration-ipv4-rules
+ (default %iptables-accept-all-rules))
+ (ipv6-rules iptables-configuration-ipv6-rules
+ (default %iptables-accept-all-rules)))
+
+(define iptables-shepherd-service
+ (match-lambda
+ (($ <iptables-configuration> iptables ipv4-rules ipv6-rules)
+ (let ((iptables-restore (file-append iptables "/sbin/iptables-restore"))
+ (ip6tables-restore (file-append iptables "/sbin/ip6tables-restore")))
+ (shepherd-service
+ (documentation "Packet filtering framework")
+ (provision '(iptables))
+ (start #~(lambda _
+ (invoke #$iptables-restore #$ipv4-rules)
+ (invoke #$ip6tables-restore #$ipv6-rules)))
+ (stop #~(lambda _
+ (invoke #$iptables-restore #$%iptables-accept-all-rules)
+ (invoke #$ip6tables-restore #$%iptables-accept-all-rules))))))))
+
+(define iptables-service-type
+ (service-type
+ (name 'iptables)
+ (description
+ "Run @command{iptables-restore}, setting up the specified rules.")
+ (extensions
+ (list (service-extension shepherd-root-service-type
+ (compose list iptables-shepherd-service))))))
+
;;; networking.scm ends here
diff --git a/gnu/services/shepherd.scm b/gnu/services/shepherd.scm
index 4cd2249841..49d08cc30f 100644
--- a/gnu/services/shepherd.scm
+++ b/gnu/services/shepherd.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2016, 2018 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
+;;; Copyright © 2018 Carlo Zancanaro <carlo@zancanaro.id.au>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -58,6 +59,7 @@
%default-modules
shepherd-service-file
+ %containerized-shepherd-service
shepherd-service-lookup-procedure
shepherd-service-back-edges
@@ -326,10 +328,25 @@ symbols provided/required by a service."
(lambda (service)
(vhash-foldq* cons '() service edges)))
+(define %containerized-shepherd-service
+ ;; XXX: This service works around a bug in the Shepherd 0.5.0: shepherd
+ ;; calls reboot(2) (via 'disable-reboot-on-ctrl-alt-del') when it starts,
+ ;; but in a container that fails with EINVAL. This was fixed in Shepherd
+ ;; commit 92e806bac1abaeeaf5d60f0ab50d1ae85ba6a62f.
+ (simple-service 'containerized-shepherd
+ shepherd-root-service-type
+ (list (shepherd-service
+ (provision '(containerized-shepherd))
+ (start #~(lambda ()
+ (set! (@@ (shepherd)
+ disable-reboot-on-ctrl-alt-del)
+ (const #t))
+ #t))))))
+
(define (shepherd-service-upgrade live target)
"Return two values: the subset of LIVE (a list of <live-service>) that needs
to be unloaded, and the subset of TARGET (a list of <shepherd-service>) that
-needs to be loaded."
+need to be restarted to complete their upgrade."
(define (essential? service)
(memq (first (live-service-provision service))
'(root shepherd)))
@@ -346,12 +363,6 @@ needs to be loaded."
(and=> (lookup-live (shepherd-service-canonical-name service))
live-service-running))
- (define (stopped service)
- (match (lookup-live (shepherd-service-canonical-name service))
- (#f #f)
- (service (and (not (live-service-running service))
- service))))
-
(define live-service-dependents
(shepherd-service-back-edges live
#:provision live-service-provision
@@ -362,16 +373,14 @@ needs to be loaded."
(#f (every obsolete? (live-service-dependents service)))
(_ #f)))
- (define to-load
- ;; Only load services that are either new or currently stopped.
- (remove running? target))
+ (define to-restart
+ ;; Restart services that are currently running.
+ (filter running? target))
(define to-unload
- ;; Unload services that are (1) no longer required, or (2) are in TO-LOAD.
- (remove essential?
- (append (filter obsolete? live)
- (filter-map stopped to-load))))
+ ;; Unload services that are no longer required.
+ (remove essential? (filter obsolete? live)))
- (values to-unload to-load))
+ (values to-unload to-restart))
;;; shepherd.scm ends here
diff --git a/gnu/services/ssh.scm b/gnu/services/ssh.scm
index dd96ad6aec..bb94c5f41a 100644
--- a/gnu/services/ssh.scm
+++ b/gnu/services/ssh.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 David Craven <david@craven.ch>
;;; Copyright © 2016 Julien Lepiller <julien@lepiller.eu>
;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
@@ -319,6 +319,10 @@ The other options should be self-descriptive."
(accepted-environment openssh-configuration-accepted-environment
(default '()))
+ ;; symbol
+ (log-level openssh-configuration-log-level
+ (default 'info))
+
;; list of user-name/file-like tuples
(authorized-keys openssh-authorized-keys
(default '()))
@@ -451,6 +455,10 @@ of user-name/file-like tuples."
(format port "PrintLastLog ~a\n"
#$(if (openssh-configuration-print-last-log? config)
"yes" "no"))
+ (format port "LogLevel ~a\n"
+ #$(string-upcase
+ (symbol->string
+ (openssh-configuration-log-level config))))
;; Add '/etc/authorized_keys.d/%u', which we populate.
(format port "AuthorizedKeysFile \
@@ -510,7 +518,15 @@ of user-name/file-like tuples."
(service-extension activation-service-type
openssh-activation)
(service-extension account-service-type
- (const %openssh-accounts))))
+ (const %openssh-accounts))
+
+ ;; Install OpenSSH in the system profile. That way,
+ ;; 'scp' is found when someone tries to copy to or from
+ ;; this machine.
+ (service-extension profile-service-type
+ (lambda (config)
+ (list (openssh-configuration-openssh
+ config))))))
(compose concatenate)
(extend extend-openssh-authorized-keys)
(default-value (openssh-configuration))))
diff --git a/gnu/services/version-control.scm b/gnu/services/version-control.scm
index 58274c8bee..13669925ab 100644
--- a/gnu/services/version-control.scm
+++ b/gnu/services/version-control.scm
@@ -3,6 +3,7 @@
;;; Copyright © 2016 Sou Bunnbu <iyzsong@member.fsf.org>
;;; Copyright © 2017 Oleg Pykhalov <go.wigust@gmail.com>
;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
+;;; Copyright © 2018 Christopher Baines <mail@cbaines.net>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -32,6 +33,7 @@
#:use-module (guix store)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
+ #:use-module (ice-9 format)
#:use-module (ice-9 match)
#:export (git-daemon-service
git-daemon-service-type
@@ -40,7 +42,23 @@
git-http-configuration
git-http-configuration?
- git-http-nginx-location-configuration))
+ git-http-nginx-location-configuration
+
+ <gitolite-configuration>
+ gitolite-configuration
+ gitolite-configuration-package
+ gitolite-configuration-user
+ gitolite-configuration-rc-file
+ gitolite-configuration-admin-pubkey
+
+ <gitolite-rc-file>
+ gitolite-rc-file
+ gitolite-rc-file-umask
+ gitolite-rc-file-git-config-keys
+ gitolite-rc-file-roles
+ gitolite-rc-file-enable
+
+ gitolite-service-type))
;;; Commentary:
;;;
@@ -197,3 +215,163 @@ access to exported repositories under @file{/srv/git}."
"")
(list "fastcgi_param GIT_PROJECT_ROOT " git-root ";")
"fastcgi_param PATH_INFO $1;"))))))
+
+
+;;;
+;;; Gitolite
+;;;
+
+(define-record-type* <gitolite-rc-file>
+ gitolite-rc-file make-gitolite-rc-file
+ gitolite-rc-file?
+ (umask gitolite-rc-file-umask
+ (default #o0077))
+ (git-config-keys gitolite-rc-file-git-config-keys
+ (default ""))
+ (roles gitolite-rc-file-roles
+ (default '(("READERS" . 1)
+ ("WRITERS" . 1))))
+ (enable gitolite-rc-file-enable
+ (default '("help"
+ "desc"
+ "info"
+ "perms"
+ "writable"
+ "ssh-authkeys"
+ "git-config"
+ "daemon"
+ "gitweb"))))
+
+(define-gexp-compiler (gitolite-rc-file-compiler
+ (file <gitolite-rc-file>) system target)
+ (match file
+ (($ <gitolite-rc-file> umask git-config-keys roles enable)
+ (apply text-file* "gitolite.rc"
+ `("%RC = (\n"
+ " UMASK => " ,(format #f "~4,'0o" umask) ",\n"
+ " GIT_CONFIG_KEYS => '" ,git-config-keys "',\n"
+ " ROLES => {\n"
+ ,@(map (match-lambda
+ ((role . value)
+ (simple-format #f " ~A => ~A,\n" role value)))
+ roles)
+ " },\n"
+ "\n"
+ " ENABLE => [\n"
+ ,@(map (lambda (value)
+ (simple-format #f " '~A',\n" value))
+ enable)
+ " ],\n"
+ ");\n"
+ "\n"
+ "1;\n")))))
+
+(define-record-type* <gitolite-configuration>
+ gitolite-configuration make-gitolite-configuration
+ gitolite-configuration?
+ (package gitolite-configuration-package
+ (default gitolite))
+ (user gitolite-configuration-user
+ (default "git"))
+ (group gitolite-configuration-group
+ (default "git"))
+ (home-directory gitolite-configuration-home-directory
+ (default "/var/lib/gitolite"))
+ (rc-file gitolite-configuration-rc-file
+ (default (gitolite-rc-file)))
+ (admin-pubkey gitolite-configuration-admin-pubkey))
+
+(define gitolite-accounts
+ (match-lambda
+ (($ <gitolite-configuration> package user group home-directory
+ rc-file admin-pubkey)
+ ;; User group and account to run Gitolite.
+ (list (user-group (name user) (system? #t))
+ (user-account
+ (name user)
+ (group group)
+ (system? #t)
+ (comment "Gitolite user")
+ (home-directory home-directory))))))
+
+(define gitolite-activation
+ (match-lambda
+ (($ <gitolite-configuration> package user group home
+ rc-file admin-pubkey)
+ #~(begin
+ (use-modules (ice-9 match)
+ (guix build utils))
+
+ (let* ((user-info (getpwnam #$user))
+ (admin-pubkey #$admin-pubkey)
+ (pubkey-file (string-append
+ #$home "/"
+ (basename
+ (strip-store-file-name admin-pubkey)))))
+
+ (simple-format #t "guix: gitolite: installing ~A\n" #$rc-file)
+ (copy-file #$rc-file #$(string-append home "/.gitolite.rc"))
+
+ ;; The key must be writable, so copy it from the store
+ (copy-file admin-pubkey pubkey-file)
+
+ (chmod pubkey-file #o500)
+ (chown pubkey-file
+ (passwd:uid user-info)
+ (passwd:gid user-info))
+
+ ;; Set the git configuration, to avoid gitolite trying to use
+ ;; the hostname command, as the network might not be up yet
+ (with-output-to-file #$(string-append home "/.gitconfig")
+ (lambda ()
+ (display "[user]
+ name = GNU Guix
+ email = guix@localhost
+")))
+ ;; Run Gitolite setup, as this updates the hooks and include the
+ ;; admin pubkey if specified. The admin pubkey is required for
+ ;; initial setup, and will replace the previous key if run after
+ ;; initial setup
+ (match (primitive-fork)
+ (0
+ ;; Exit with a non-zero status code if an exception is thrown.
+ (dynamic-wind
+ (const #t)
+ (lambda ()
+ (setenv "HOME" (passwd:dir user-info))
+ (setenv "USER" #$user)
+ (setgid (passwd:gid user-info))
+ (setuid (passwd:uid user-info))
+ (primitive-exit
+ (system* #$(file-append package "/bin/gitolite")
+ "setup"
+ "-m" "gitolite setup by GNU Guix"
+ "-pk" pubkey-file)))
+ (lambda ()
+ (primitive-exit 1))))
+ (pid (waitpid pid)))
+
+ (when (file-exists? pubkey-file)
+ (delete-file pubkey-file)))))))
+
+(define gitolite-service-type
+ (service-type
+ (name 'gitolite)
+ (extensions
+ (list (service-extension activation-service-type
+ gitolite-activation)
+ (service-extension account-service-type
+ gitolite-accounts)
+ (service-extension profile-service-type
+ ;; The Gitolite package in Guix uses
+ ;; gitolite-shell in the authorized_keys file, so
+ ;; gitolite-shell needs to be on the PATH for
+ ;; gitolite to work.
+ (lambda (config)
+ (list
+ (gitolite-configuration-package config))))))
+ (description
+ "Setup @command{gitolite}, a Git hosting tool providing access over SSH..
+By default, the @code{git} user is used, but this is configurable.
+Additionally, Gitolite can integrate with with tools like gitweb or cgit to
+provide a web interface to view selected repositories.")))
diff --git a/gnu/services/web.scm b/gnu/services/web.scm
index 97976509b6..fcf453c248 100644
--- a/gnu/services/web.scm
+++ b/gnu/services/web.scm
@@ -1,12 +1,14 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 David Thompson <davet@gnu.org>
-;;; Copyright © 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Nils Gillmann <ng0@n0.is>
;;; Copyright © 2016, 2017, 2018 Julien Lepiller <julien@lepiller.eu>
;;; Copyright © 2017 Christopher Baines <mail@cbaines.net>
;;; 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 © 2018 Marius Bakke <mbakke@fastmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -26,15 +28,18 @@
(define-module (gnu services web)
#:use-module (gnu services)
#:use-module (gnu services shepherd)
+ #:use-module (gnu services admin)
#:use-module (gnu system pam)
#:use-module (gnu system shadow)
#:use-module (gnu packages admin)
#:use-module (gnu packages web)
#:use-module (gnu packages php)
#:use-module (gnu packages guile)
+ #:use-module (gnu packages logging)
#:use-module (guix records)
#:use-module (guix modules)
#:use-module (guix gexp)
+ #:use-module ((guix store) #:select (text-file))
#:use-module ((guix utils) #:select (version-major))
#:use-module ((guix packages) #:select (package-version))
#:use-module (srfi srfi-1)
@@ -65,6 +70,11 @@
httpd-config-file-user
httpd-config-file-group
+ <httpd-module>
+ httpd-module
+ httpd-module?
+ %default-httpd-modules
+
httpd-service-type
<nginx-configuration>
@@ -164,7 +174,43 @@
hpcguix-web-configuration
hpcguix-web-configuration?
- hpcguix-web-service-type))
+ hpcguix-web-service-type
+
+ <tailon-configuration-file>
+ tailon-configuration-file
+ tailon-configuration-file?
+ tailon-configuration-file-files
+ tailon-configuration-file-bind
+ tailon-configuration-file-relative-root
+ tailon-configuration-file-allow-transfers?
+ tailon-configuration-file-follow-names?
+ tailon-configuration-file-tail-lines
+ tailon-configuration-file-allowed-commands
+ tailon-configuration-file-debug?
+ tailon-configuration-file-http-auth
+ tailon-configuration-file-users
+
+ <tailon-configuration>
+ tailon-configuration
+ tailon-configuration?
+ tailon-configuration-config-file
+ tailon-configuration-package
+
+ tailon-service-type
+
+ <varnish-configuration>
+ varnish-configuration
+ varnish-configuration?
+ varnish-configuration-package
+ varnish-configuration-name
+ varnish-configuration-backend
+ varnish-configuration-vcl
+ varnish-configuration-listen
+ varnish-configuration-storage
+ varnish-configuration-parameters
+ varnish-configuration-extra-options
+
+ varnish-service-type))
;;; Commentary:
;;;
@@ -599,19 +645,31 @@ of index files."
<nginx-configuration>
(nginx file run-directory)
(let* ((nginx-binary (file-append nginx "/sbin/nginx"))
+ (pid-file (in-vicinity run-directory "pid"))
(nginx-action
(lambda args
#~(lambda _
(invoke #$nginx-binary "-c"
#$(or file
(default-nginx-config config))
- #$@args)))))
+ #$@args)
+ (match '#$args
+ (("-s" . _) #f)
+ (_
+ ;; When FILE is true, we cannot be sure that PID-FILE will
+ ;; be created, so assume it won't show up. When FILE is
+ ;; false, read PID-FILE.
+ #$(if file
+ #~#t
+ #~(read-pid-file #$pid-file))))))))
;; TODO: Add 'reload' action.
(list (shepherd-service
(provision '(nginx))
(documentation "Run the nginx daemon.")
(requirement '(user-processes loopback))
+ (modules `((ice-9 match)
+ ,@%default-modules))
(start (nginx-action "-p" run-directory))
(stop (nginx-action "-s" "stop")))))))
@@ -937,6 +995,14 @@ a webserver.")
(chown home-dir (passwd:uid user) (passwd:gid user))
(chmod home-dir #o755))))
+(define %hpcguix-web-log-file
+ "/var/log/hpcguix-web.log")
+
+(define %hpcguix-web-log-rotations
+ (list (log-rotation
+ (files (list %hpcguix-web-log-file))
+ (frequency 'weekly))))
+
(define (hpcguix-web-shepherd-service config)
(let ((specs (hpcguix-web-configuration-specs config))
(hpcguix-web (hpcguix-web-package config)))
@@ -953,7 +1019,9 @@ a webserver.")
#:user "hpcguix-web"
#:group "hpcguix-web"
#:environment-variables
- (list "XDG_CACHE_HOME=/var/cache")))
+ (list "XDG_CACHE_HOME=/var/cache"
+ "SSL_CERT_DIR=/etc/ssl/certs")
+ #:log-file #$%hpcguix-web-log-file))
(stop #~(make-kill-destructor))))))
(define hpcguix-web-service-type
@@ -965,5 +1033,231 @@ a webserver.")
(const %hpcguix-web-accounts))
(service-extension activation-service-type
(const %hpcguix-web-activation))
+ (service-extension rottlog-service-type
+ (const %hpcguix-web-log-rotations))
(service-extension shepherd-root-service-type
(compose list hpcguix-web-shepherd-service))))))
+
+
+;;;
+;;; Tailon
+;;;
+
+(define-record-type* <tailon-configuration-file>
+ tailon-configuration-file make-tailon-configuration-file
+ tailon-configuration-file?
+ (files tailon-configuration-file-files
+ (default '("/var/log")))
+ (bind tailon-configuration-file-bind
+ (default "localhost:8080"))
+ (relative-root tailon-configuration-file-relative-root
+ (default #f))
+ (allow-transfers? tailon-configuration-file-allow-transfers?
+ (default #t))
+ (follow-names? tailon-configuration-file-follow-names?
+ (default #t))
+ (tail-lines tailon-configuration-file-tail-lines
+ (default 200))
+ (allowed-commands tailon-configuration-file-allowed-commands
+ (default '("tail" "grep" "awk")))
+ (debug? tailon-configuration-file-debug?
+ (default #f))
+ (wrap-lines tailon-configuration-file-wrap-lines
+ (default #t))
+ (http-auth tailon-configuration-file-http-auth
+ (default #f))
+ (users tailon-configuration-file-users
+ (default #f)))
+
+(define (tailon-configuration-files-string files)
+ (string-append
+ "\n"
+ (string-join
+ (map
+ (lambda (x)
+ (string-append
+ " - "
+ (cond
+ ((string? x)
+ (simple-format #f "'~A'" x))
+ ((list? x)
+ (string-join
+ (cons (simple-format #f "'~A':" (car x))
+ (map
+ (lambda (x) (simple-format #f " - '~A'" x))
+ (cdr x)))
+ "\n"))
+ (else (error x)))))
+ files)
+ "\n")))
+
+(define-gexp-compiler (tailon-configuration-file-compiler
+ (file <tailon-configuration-file>) system target)
+ (match file
+ (($ <tailon-configuration-file> files bind relative-root
+ allow-transfers? follow-names?
+ tail-lines allowed-commands debug?
+ wrap-lines http-auth users)
+ (text-file
+ "tailon-config.yaml"
+ (string-concatenate
+ (filter-map
+ (match-lambda
+ ((key . #f) #f)
+ ((key . value) (string-append key ": " value "\n")))
+
+ `(("files" . ,(tailon-configuration-files-string files))
+ ("bind" . ,bind)
+ ("relative-root" . ,relative-root)
+ ("allow-transfers" . ,(if allow-transfers? "true" "false"))
+ ("follow-names" . ,(if follow-names? "true" "false"))
+ ("tail-lines" . ,(number->string tail-lines))
+ ("commands" . ,(string-append "["
+ (string-join allowed-commands ", ")
+ "]"))
+ ("debug" . ,(if debug? "true" #f))
+ ("wrap-lines" . ,(if wrap-lines "true" "false"))
+ ("http-auth" . ,http-auth)
+ ("users" . ,(if users
+ (string-concatenate
+ (cons "\n"
+ (map (match-lambda
+ ((user . pass)
+ (string-append
+ " " user ":" pass)))
+ users)))
+ #f)))))))))
+
+(define-record-type* <tailon-configuration>
+ tailon-configuration make-tailon-configuration
+ tailon-configuration?
+ (config-file tailon-configuration-config-file
+ (default (tailon-configuration-file)))
+ (package tailon-configuration-package
+ (default tailon)))
+
+(define tailon-shepherd-service
+ (match-lambda
+ (($ <tailon-configuration> config-file package)
+ (list (shepherd-service
+ (provision '(tailon))
+ (documentation "Run the tailon daemon.")
+ (start #~(make-forkexec-constructor
+ `(,(string-append #$package "/bin/tailon")
+ "-c" ,#$config-file)
+ #:user "tailon"
+ #:group "tailon"))
+ (stop #~(make-kill-destructor)))))))
+
+(define %tailon-accounts
+ (list (user-group (name "tailon") (system? #t))
+ (user-account
+ (name "tailon")
+ (group "tailon")
+ (system? #t)
+ (comment "tailon")
+ (home-directory "/var/empty")
+ (shell (file-append shadow "/sbin/nologin")))))
+
+(define tailon-service-type
+ (service-type
+ (name 'tailon)
+ (description
+ "Run Tailon, a Web application for monitoring, viewing, and searching log
+files.")
+ (extensions
+ (list (service-extension shepherd-root-service-type
+ tailon-shepherd-service)
+ (service-extension account-service-type
+ (const %tailon-accounts))))
+ (compose concatenate)
+ (extend (lambda (parameter files)
+ (tailon-configuration
+ (inherit parameter)
+ (config-file
+ (let ((old-config-file
+ (tailon-configuration-config-file parameter)))
+ (tailon-configuration-file
+ (inherit old-config-file)
+ (files (append (tailon-configuration-file-files old-config-file)
+ files))))))))
+ (default-value (tailon-configuration))))
+
+
+;;;
+;;; Varnish
+;;;
+
+(define-record-type* <varnish-configuration>
+ varnish-configuration make-varnish-configuration
+ varnish-configuration?
+ (package varnish-configuration-package ;<package>
+ (default varnish))
+ (name varnish-configuration-name ;string
+ (default "default"))
+ (backend varnish-configuration-backend ;string
+ (default "localhost:8080"))
+ (vcl varnish-configuration-vcl ;#f | <file-like>
+ (default #f))
+ (listen varnish-configuration-listen ;list of strings
+ (default '("localhost:80")))
+ (storage varnish-configuration-storage ;list of strings
+ (default '("malloc,128m")))
+ (parameters varnish-configuration-parameters ;list of string pairs
+ (default '()))
+ (extra-options varnish-configuration-extra-options ;list of strings
+ (default '())))
+
+(define %varnish-accounts
+ (list (user-group
+ (name "varnish")
+ (system? #t))
+ (user-account
+ (name "varnish")
+ (group "varnish")
+ (system? #t)
+ (comment "Varnish Cache User")
+ (home-directory "/var/varnish")
+ (shell (file-append shadow "/sbin/nologin")))))
+
+(define varnish-shepherd-service
+ (match-lambda
+ (($ <varnish-configuration> package name backend vcl listen storage
+ parameters extra-options)
+ (list (shepherd-service
+ (provision (list (symbol-append 'varnish- (string->symbol name))))
+ (documentation (string-append "The Varnish Web Accelerator"
+ " (" name ")"))
+ (requirement '(networking))
+ (start #~(make-forkexec-constructor
+ (list #$(file-append package "/sbin/varnishd")
+ "-n" #$name
+ #$@(if vcl
+ #~("-f" #$vcl)
+ #~("-b" #$backend))
+ #$@(append-map (lambda (a) (list "-a" a)) listen)
+ #$@(append-map (lambda (s) (list "-s" s)) storage)
+ #$@(append-map (lambda (p)
+ (list "-p" (format #f "~a=~a"
+ (car p) (cdr p))))
+ parameters)
+ #$@extra-options)
+ ;; Varnish will drop privileges to the "varnish" user when
+ ;; it exists. Not passing #:user here allows the service
+ ;; to bind to ports < 1024.
+ #:pid-file (if (string-prefix? "/" #$name)
+ (string-append #$name "/_.pid")
+ (string-append "/var/varnish/" #$name "/_.pid"))))
+ (stop #~(make-kill-destructor)))))))
+
+(define varnish-service-type
+ (service-type
+ (name 'varnish)
+ (description "Run the Varnish cache server.")
+ (extensions
+ (list (service-extension account-service-type
+ (const %varnish-accounts))
+ (service-extension shepherd-root-service-type
+ varnish-shepherd-service)))
+ (default-value
+ (varnish-configuration))))