diff options
Diffstat (limited to 'gnu/services')
| -rw-r--r-- | gnu/services/admin.scm | 180 | ||||
| -rw-r--r-- | gnu/services/base.scm | 142 | ||||
| -rw-r--r-- | gnu/services/cuirass.scm | 6 | ||||
| -rw-r--r-- | gnu/services/desktop.scm | 12 | ||||
| -rw-r--r-- | gnu/services/dns.scm | 168 | ||||
| -rw-r--r-- | gnu/services/games.scm | 3 | ||||
| -rw-r--r-- | gnu/services/herd.scm | 20 | ||||
| -rw-r--r-- | gnu/services/mail.scm | 51 | ||||
| -rw-r--r-- | gnu/services/mcron.scm | 2 | ||||
| -rw-r--r-- | gnu/services/networking.scm | 210 | ||||
| -rw-r--r-- | gnu/services/shepherd.scm | 39 | ||||
| -rw-r--r-- | gnu/services/ssh.scm | 20 | ||||
| -rw-r--r-- | gnu/services/version-control.scm | 180 | ||||
| -rw-r--r-- | gnu/services/web.scm | 302 |
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)))) |