From 5dfd80e1c5c9803a281804801592d191cf9148ae Mon Sep 17 00:00:00 2001 From: Chris Marusich Date: Sun, 22 Jul 2018 16:23:53 -0700 Subject: services: tor: Add a system test. * gnu/services/networking.scm (tor-configuration->torrc): Set PidFile to /var/run/tor/tor.pid in the base torrc configuration. (tor-shepherd-service) : Call make-forkexec-constructor/container with a new #:pid-file argument to tell Shepherd where to find the PID file. Add a a new to its existing #:mappings argument to share /var/run/tor with the the container. (tor-hidden-services-activation): Update docstring. Create /var/run/tor and set its permissions so only the tor user can access it. * gnu/tests/networking.scm (%test-tor, %tor-os): New variables. (run-tor-test): New procedure. --- gnu/services/networking.scm | 22 +++++++++++++++++++--- 1 file changed, 19 insertions(+), 3 deletions(-) (limited to 'gnu/services') diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm index d5d0cf9d1..66772e48b 100644 --- a/gnu/services/networking.scm +++ b/gnu/services/networking.scm @@ -7,6 +7,7 @@ ;;; Copyright © 2017 Thomas Danckaert ;;; Copyright © 2017 Marius Bakke ;;; Copyright © 2018 Tobias Geerinckx-Rice +;;; Copyright © 2018 Chris Marusich ;;; ;;; This file is part of GNU Guix. ;;; @@ -612,6 +613,7 @@ 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) (for-each (match-lambda @@ -639,7 +641,7 @@ HiddenServicePort ~a ~a~%" #t)))))))) (define (tor-shepherd-service config) - "Return a running TOR." + "Return a running Tor." (match config (($ tor) (let ((torrc (tor-configuration->torrc config))) @@ -665,12 +667,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." + "Set up directories for Tor and its hidden services, if any." #~(begin (use-modules (guix build utils)) @@ -686,6 +693,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) -- cgit v1.3 From d973915e4842b8b1bfc2266ed42d3b8c2ca77e93 Mon Sep 17 00:00:00 2001 From: Chris Marusich Date: Wed, 25 Jul 2018 02:51:41 -0700 Subject: services: tor: Rename activation procedure. * gnu/services/networking.scm: Rename the procedure tor-hidden-service-activation to tor-activation. --- gnu/services/networking.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'gnu/services') diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm index 66772e48b..b7f2bfe7b 100644 --- a/gnu/services/networking.scm +++ b/gnu/services/networking.scm @@ -676,7 +676,7 @@ HiddenServicePort ~a ~a~%" (stop #~(make-kill-destructor)) (documentation "Run the Tor anonymous network overlay.")))))))) -(define (tor-hidden-service-activation config) +(define (tor-activation config) "Set up directories for Tor and its hidden services, if any." #~(begin (use-modules (guix build utils)) @@ -721,7 +721,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) -- cgit v1.3 From 3bcb305b98e02f6c9d98e7325813fc00f18f0e6c Mon Sep 17 00:00:00 2001 From: Chris Marusich Date: Tue, 31 Jul 2018 01:13:48 -0700 Subject: services: tor: Make it easier to use UNIX sockets. * doc/guix.texi (Networking Services): Document it, and mention that tor-service is deprecated. * gnu/services/networking.scm () : New field. (tor-configuration->torrc): When socks-socket-type is 'unix, set SocksPort to UNIX domain socket /var/run/tor/socks-sock and set UnixSocksGroupWritable to 1. * gnu/tests/networking.scm (%tor-os/unix-socks-socket): Instead of using a custom config file, just set socks-socket-type to 'unix. --- doc/guix.texi | 55 +++++++++++++++++++++++++++++++++++++++------ gnu/services/networking.scm | 10 +++++++-- gnu/tests/networking.scm | 8 +------ 3 files changed, 57 insertions(+), 16 deletions(-) (limited to 'gnu/services') diff --git a/doc/guix.texi b/doc/guix.texi index d2d278df4..3a3368b78 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -11450,16 +11450,57 @@ detailed discussion of each configuration field. @end deftp @cindex Tor -@deffn {Scheme Procedure} tor-service [@var{config-file}] [#:tor @var{tor}] -Return a service to run the @uref{https://torproject.org, Tor} anonymous -networking daemon. +@defvr {Scheme Variable} tor-service-type +This is the type for a service that runs the @uref{https://torproject.org, +Tor} anonymous networking daemon. The service is configured using a +@code{} record. By default, the Tor daemon runs as the +@code{tor} unprivileged user, which is a member of the @code{tor} group. + +@end defvr -The daemon runs as the @code{tor} unprivileged user. It is passed -@var{config-file}, a file-like object, with an additional @code{User tor} line -and lines for hidden services added via @code{tor-hidden-service}. Run -@command{man tor} for information about the configuration file. +@deffn {Scheme Procedure} tor-service [@var{config-file}] [#:tor @var{tor}] +This procedure is deprecated and will be removed in a future release. Return +a service of the @code{tor-service-type} type. @var{config-file} and +@var{tor} have the same meaning as in @code{}. @end deffn +@deftp {Data Type} tor-configuration +@table @asis +@item @code{tor} (default: @code{tor}) +The package that provides the Tor daemon. This package is expected to provide +the daemon at @file{bin/tor} relative to its output directory. The default +package is the @uref{https://www.torproject.org, Tor Project's} +implementation. + +@item @code{config-file} (default: @code{(plain-file "empty" "")}) +The configuration file to use. It will be appended to a default configuration +file, and the final configuration file will be passed to @code{tor} via its +@code{-f} option. This may be any ``file-like'' object (@pxref{G-Expressions, +file-like objects}). See @code{man tor} for details on the configuration file +syntax. + +@item @code{hidden-services} (default: @code{'()}) +The list of @code{} records to use. For any hidden service +you include in this list, appropriate configuration to enable the hidden +service will be automatically added to the default configuration file. You +may conveniently create @code{} records using the +@code{tor-hidden-service} procedure described below. + +@item @code{socks-socket-type} (default: @code{'tcp}) +The default socket type that Tor should use for its SOCKS socket. This must +be either @code{'tcp} or @code{'unix}. If it is @code{'tcp}, then by default +Tor will listen on TCP port 9050 on the loopback interface (i.e., localhost). +If it is @code{'unix}, then Tor will listen on the UNIX domain socket +@file{/var/run/tor/socks-sock}, which will be made writable by members of the +@code{tor} group. + +If you want to customize the SOCKS socket in more detail, leave +@code{socks-socket-type} at its default value of @code{'tcp} and use +@code{config-file} to override the default by providing your own +@code{SocksPort} option. +@end table +@end deftp + @cindex hidden service @deffn {Scheme Procedure} tor-hidden-service @var{name} @var{mapping} Define a new Tor @dfn{hidden service} called @var{name} and implementing diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm index b7f2bfe7b..b6b5ee3fe 100644 --- a/gnu/services/networking.scm +++ b/gnu/services/networking.scm @@ -577,7 +577,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. @@ -599,7 +601,7 @@ demand."))) (define (tor-configuration->torrc config) "Return a 'torrc' file for CONFIG." (match config - (($ tor config-file services) + (($ tor config-file services socks-socket-type) (computed-file "torrc" (with-imported-modules '((guix build utils)) @@ -615,6 +617,10 @@ 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) ...) diff --git a/gnu/tests/networking.scm b/gnu/tests/networking.scm index 7ca71f0c2..381c5caf1 100644 --- a/gnu/tests/networking.scm +++ b/gnu/tests/networking.scm @@ -354,13 +354,7 @@ subnet 192.168.1.0 netmask 255.255.255.0 { (simple-operating-system (service tor-service-type (tor-configuration - (config-file - (plain-file "test-torrc" - "\ -SocksPort unix:/var/run/tor/socks-sock -UnixSocksGroupWritable 1 -") - ))))) + (socks-socket-type 'unix))))) (define (run-tor-test) (define os -- cgit v1.3 From 6772ed1e07d6b8ce557199d91aaa1442c77186c7 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 28 Aug 2018 12:33:50 +0200 Subject: services: openssh: Add 'log-level' field. * gnu/services/ssh.scm ()[log-level]: New field. (openssh-config-file): Honor it. * doc/guix.texi (Networking Services): Document it. --- doc/guix.texi | 6 ++++++ gnu/services/ssh.scm | 10 +++++++++- 2 files changed, 15 insertions(+), 1 deletion(-) (limited to 'gnu/services') diff --git a/doc/guix.texi b/doc/guix.texi index 3a3368b78..cd0e74a2d 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -11782,6 +11782,12 @@ Additional authorized keys can be specified @i{via} Note that this does @emph{not} interfere with the use of @file{~/.ssh/authorized_keys}. + +@item @code{log-level} (default: @code{'info}) +This is a symbol specifying the logging level: @code{quiet}, @code{fatal}, +@code{error}, @code{info}, @code{verbose}, @code{debug}, etc. See the man +page for @file{sshd_config} for the full list of level names. + @end table @end deftp diff --git a/gnu/services/ssh.scm b/gnu/services/ssh.scm index dd96ad6ae..056602248 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 +;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès ;;; Copyright © 2016 David Craven ;;; Copyright © 2016 Julien Lepiller ;;; Copyright © 2017 Clément Lassieur @@ -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 \ -- cgit v1.3 From 8490a8346b5c8207f5798be55bea1de865b0bd42 Mon Sep 17 00:00:00 2001 From: Oleg Pykhalov Date: Fri, 13 Jul 2018 11:49:13 +0300 Subject: services: Add ddclient service. * gnu/services/dns.scm (ddclient-configuration, ddclient-service-type): New variables. (uglify-field-name, serialize-field, serialize-boolean, serialize-integer, serialize-string, serialize-list, serialize-extra-options, ddclient-activation, ddclient-shepherd-service, generate-ddclient-documentation): New procedures. * doc/guix.texi (DNS Services): Document it. --- doc/guix.texi | 108 +++++++++++++++++++++++++++++++++ gnu/services/dns.scm | 168 ++++++++++++++++++++++++++++++++++++++++++++++++++- 2 files changed, 275 insertions(+), 1 deletion(-) (limited to 'gnu/services') diff --git a/doc/guix.texi b/doc/guix.texi index cd0e74a2d..97631d52e 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -17263,6 +17263,114 @@ When false, disable negative caching. @end table @end deftp +@subsubheading ddclient Service + +@cindex ddclient +The ddclient service described below runs the ddclient daemon, which takes +care of automatically updating DNS entries for service providers such as +@uref{https://dyn.com/dns/, Dyn}. + +The following example show instantiates the service with its default +configuration: + +@example +(service ddclient-service-type) +@end example + +Note that ddclient needs to access credentials that are stored in a +@dfn{secret file}, by default @file{/etc/ddclient/secrets} (see +@code{secret-file} below.) You are expected to create this file manually, in +an ``out-of-band'' fashion (you @emph{could} make this file part of the +service configuration, for instance by using @code{plain-file}, but it will be +world-readable @i{via} @file{/gnu/store}.) See the examples in the +@file{share/ddclient} directory of the @code{ddclient} package. + +@c %start of fragment + +Available @code{ddclient-configuration} fields are: + +@deftypevr {@code{ddclient-configuration} parameter} package ddclient +The ddclient package. + +@end deftypevr + +@deftypevr {@code{ddclient-configuration} parameter} integer daemon +The period after which ddclient will retry to check IP and domain name. + +Defaults to @samp{300}. + +@end deftypevr + +@deftypevr {@code{ddclient-configuration} parameter} boolean syslog +Use syslog for the output. + +Defaults to @samp{#t}. + +@end deftypevr + +@deftypevr {@code{ddclient-configuration} parameter} string mail +Mail to user. + +Defaults to @samp{"root"}. + +@end deftypevr + +@deftypevr {@code{ddclient-configuration} parameter} string mail-failure +Mail failed update to user. + +Defaults to @samp{"root"}. + +@end deftypevr + +@deftypevr {@code{ddclient-configuration} parameter} string pid +The ddclient PID file. + +Defaults to @samp{"/var/run/ddclient/ddclient.pid"}. + +@end deftypevr + +@deftypevr {@code{ddclient-configuration} parameter} boolean ssl +Enable SSL support. + +Defaults to @samp{#t}. + +@end deftypevr + +@deftypevr {@code{ddclient-configuration} parameter} string user +Specifies the user name or ID that is used when running ddclient +program. + +Defaults to @samp{"ddclient"}. + +@end deftypevr + +@deftypevr {@code{ddclient-configuration} parameter} string group +Group of the user who will run the ddclient program. + +Defaults to @samp{"ddclient"}. + +@end deftypevr + +@deftypevr {@code{ddclient-configuration} parameter} string secret-file +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. + +Defaults to @samp{"/etc/ddclient/secrets.conf"}. + +@end deftypevr + +@deftypevr {@code{ddclient-configuration} parameter} list extra-options +Extra options will be appended to @file{ddclient.conf} file. + +Defaults to @samp{()}. + +@end deftypevr + + +@c %end of fragment + + @node VPN Services @subsubsection VPN Services @cindex VPN (virtual private network) diff --git a/gnu/services/dns.scm b/gnu/services/dns.scm index 2c57a36b8..16bd039f5 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 +;;; Copyright © 2018 Oleg Pykhalov ;;; ;;; 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 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)) -- cgit v1.3 From 9fc2922794ffaae48e0a7c536e530ea2e0d46cf3 Mon Sep 17 00:00:00 2001 From: Clément Lassieur Date: Mon, 13 Aug 2018 21:05:55 +0200 Subject: services: nginx: Get the Shepherd to respawn NGINX. * gnu/services/web.scm (nginx-shepherd-service): Change 'start' (that is, all actions that don't send a signal to the master process) to return the PID. Wait until the PID file is created and contains an integer because it might be created after the parent process exits. --- gnu/services/web.scm | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) (limited to 'gnu/services') diff --git a/gnu/services/web.scm b/gnu/services/web.scm index 97976509b..467656444 100644 --- a/gnu/services/web.scm +++ b/gnu/services/web.scm @@ -599,19 +599,33 @@ of index files." (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" . _) #t) + (_ + (let loop ((duration 0)) + ;; https://bugs.launchpad.net/ubuntu/+source/nginx/+bug/1581864/comments/7 + (sleep duration) + (if (file-exists? #$pid-file) + (let ((pid (call-with-input-file #$pid-file read))) + ;; it could be # + (if (integer? pid) pid (loop 1))) + (loop 1))))))))) ;; 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"))))))) -- cgit v1.3 From 7df945656cd448b13969f90a7a95d8a4e9d442f7 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 6 Sep 2018 13:49:06 +0200 Subject: services: hpcguix-web: Set SSL_CERT_DIR. Previously Git pulls over HTTPS would fail with: guix/git.scm:132:7: In procedure update-cached-checkout: Throw to key `git-error' with args `(#< code: -17 message: "the SSL certificate is invalid" class: 16>)'. * gnu/services/web.scm (hpcguix-web-shepherd-service): Pass "SSL_CERT_DIR=/etc/ssl/certs". * doc/guix.texi (Web Services): Mention certificates. --- doc/guix.texi | 11 +++++++++++ gnu/services/web.scm | 3 ++- 2 files changed, 13 insertions(+), 1 deletion(-) (limited to 'gnu/services') diff --git a/doc/guix.texi b/doc/guix.texi index 9375aac30..c328af40c 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -16848,6 +16848,17 @@ A typical hpcguix-web service declaration looks like this: (menu '(("/about" "ABOUT")))))))) @end example +@quotation Note +The hpcguix-web service periodically updates the package list it publishes by +pulling channels from Git. To that end, it needs to access X.509 certificates +so that it can authenticate Git servers when communicating over HTTPS, and it +assumes that @file{/etc/ssl/certs} contains those certificates. + +Thus, make sure to add @code{nss-certs} or another certificate package to the +@code{packages} field of your configuration. @ref{X.509 Certificates}, for +more information on X.509 certificates. +@end quotation + @node Certificate Services @subsubsection Certificate Services diff --git a/gnu/services/web.scm b/gnu/services/web.scm index 467656444..3778efd04 100644 --- a/gnu/services/web.scm +++ b/gnu/services/web.scm @@ -967,7 +967,8 @@ 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"))) (stop #~(make-kill-destructor)))))) (define hpcguix-web-service-type -- cgit v1.3 From 985975ae80fe5a8e58319b3a5aaf14da940c4419 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 8 Sep 2018 18:48:48 +0200 Subject: services: nginx: Don't read PID file when passed a custom config file. Fixes . * gnu/services/web.scm (nginx-shepherd-service): Check whether FILE is true and don't read the PID file if it is; use 'read-pid-file' instead of a potentially endless loop. --- gnu/services/web.scm | 14 ++++++-------- 1 file changed, 6 insertions(+), 8 deletions(-) (limited to 'gnu/services') diff --git a/gnu/services/web.scm b/gnu/services/web.scm index 3778efd04..1c993b29f 100644 --- a/gnu/services/web.scm +++ b/gnu/services/web.scm @@ -610,14 +610,12 @@ of index files." (match '#$args (("-s" . _) #t) (_ - (let loop ((duration 0)) - ;; https://bugs.launchpad.net/ubuntu/+source/nginx/+bug/1581864/comments/7 - (sleep duration) - (if (file-exists? #$pid-file) - (let ((pid (call-with-input-file #$pid-file read))) - ;; it could be # - (if (integer? pid) pid (loop 1))) - (loop 1))))))))) + ;; 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 -- cgit v1.3 From e80c725db7d11618dec7c3f92845f71b0a9715b0 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 8 Sep 2018 18:50:55 +0200 Subject: services: nginx: 'stop' returns #f. Previously we'd return #t, which the Shepherd would consider a failure to stop the service. * gnu/services/web.scm (nginx-shepherd-service): In 'nginx-action', return #f when stopping the service. --- gnu/services/web.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'gnu/services') diff --git a/gnu/services/web.scm b/gnu/services/web.scm index 1c993b29f..df82a6de6 100644 --- a/gnu/services/web.scm +++ b/gnu/services/web.scm @@ -608,7 +608,7 @@ of index files." (default-nginx-config config)) #$@args) (match '#$args - (("-s" . _) #t) + (("-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 -- cgit v1.3 From 19de8273eefceac1ba6ddc8d7e374a13f57c678b Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 7 Sep 2018 22:29:40 +0200 Subject: services: tailon: Move to (gnu services web). This allows (gnu services admin) to remain deeper in the module graph and to be used by (gnu services web). * gnu/services/admin.scm () (tailon-configuration-files-string) (tailon-configuration-file-compiler, ) (tailon-shepherd-service, %tailon-accounts) (tailon-service-type): Move to... * gnu/services/web.scm: ... here. * gnu/tests/admin.scm: Remove. Move test to... * gnu/tests/web.scm (%tailon-os) (run-tailon-test, %test-tailon): ... here. --- gnu/local.mk | 1 - gnu/services/admin.scm | 174 +------------------------------------------------ gnu/services/web.scm | 172 +++++++++++++++++++++++++++++++++++++++++++++++- gnu/tests/admin.scm | 127 ------------------------------------ gnu/tests/web.scm | 99 +++++++++++++++++++++++++++- 5 files changed, 270 insertions(+), 303 deletions(-) delete mode 100644 gnu/tests/admin.scm (limited to 'gnu/services') diff --git a/gnu/local.mk b/gnu/local.mk index 374e25165..bc01a3cd3 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -529,7 +529,6 @@ GNU_SYSTEM_MODULES = \ %D%/build/vm.scm \ \ %D%/tests.scm \ - %D%/tests/admin.scm \ %D%/tests/audio.scm \ %D%/tests/base.scm \ %D%/tests/databases.scm \ diff --git a/gnu/services/admin.scm b/gnu/services/admin.scm index aaf0b904f..f08c89633 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-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-config-file - tailon-configuration-package - - tailon-service-type)) + rottlog-service-type)) ;;; Commentary: ;;; @@ -203,149 +176,4 @@ Old log files are removed or compressed according to the configuration.") rotations))))) (default-value (rottlog-configuration)))) - -;;; -;;; Tailon -;;; - -(define-record-type* - 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 ) system target) - (match 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 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 - (($ 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/web.scm b/gnu/services/web.scm index df82a6de6..16e77f824 100644 --- a/gnu/services/web.scm +++ b/gnu/services/web.scm @@ -7,6 +7,7 @@ ;;; Copyright © 2017 nee ;;; Copyright © 2017, 2018 Clément Lassieur ;;; Copyright © 2018 Pierre-Antoine Rouby +;;; Copyright © 2017 Christopher Baines ;;; ;;; This file is part of GNU Guix. ;;; @@ -32,9 +33,11 @@ #: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) @@ -164,7 +167,29 @@ hpcguix-web-configuration hpcguix-web-configuration? - hpcguix-web-service-type)) + hpcguix-web-service-type + + + 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-config-file + tailon-configuration-package + + tailon-service-type)) ;;; Commentary: ;;; @@ -980,3 +1005,148 @@ a webserver.") (const %hpcguix-web-activation)) (service-extension shepherd-root-service-type (compose list hpcguix-web-shepherd-service)))))) + + +;;; +;;; Tailon +;;; + +(define-record-type* + 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 ) system target) + (match 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 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 + (($ 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)))) diff --git a/gnu/tests/admin.scm b/gnu/tests/admin.scm deleted file mode 100644 index a5abbe9ad..000000000 --- a/gnu/tests/admin.scm +++ /dev/null @@ -1,127 +0,0 @@ -;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2017 Christopher Baines -;;; Copyright © 2018 Clément Lassieur -;;; -;;; This file is part of GNU Guix. -;;; -;;; GNU Guix is free software; you can redistribute it and/or modify it -;;; under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 3 of the License, or (at -;;; your option) any later version. -;;; -;;; GNU Guix is distributed in the hope that it will be useful, but -;;; WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with GNU Guix. If not, see . - -(define-module (gnu tests admin) - #:use-module (gnu tests) - #:use-module (gnu system) - #:use-module (gnu system file-systems) - #:use-module (gnu system shadow) - #:use-module (gnu system vm) - #:use-module (gnu services) - #:use-module (gnu services admin) - #:use-module (gnu services networking) - #:use-module (guix gexp) - #:use-module (guix store) - #:use-module (guix monads) - #:export (%test-tailon)) - -(define %tailon-os - ;; Operating system under test. - (simple-operating-system - (dhcp-client-service) - (service tailon-service-type - (tailon-configuration - (config-file - (tailon-configuration-file - (bind "0.0.0.0:8080"))))))) - -(define* (run-tailon-test #:optional (http-port 8081)) - "Run tests in %TAILON-OS, which has tailon running and listening on -HTTP-PORT." - (define os - (marionette-operating-system - %tailon-os - #:imported-modules '((gnu services herd) - (guix combinators)))) - - (define vm - (virtual-machine - (operating-system os) - (port-forwardings `((,http-port . 8080))))) - - (define test - (with-imported-modules '((gnu build marionette)) - #~(begin - (use-modules (srfi srfi-11) (srfi srfi-64) - (ice-9 match) - (gnu build marionette) - (web uri) - (web client) - (web response)) - - (define marionette - ;; Forward the guest's HTTP-PORT, where tailon is listening, to - ;; port 8080 in the host. - (make-marionette (list #$vm))) - - (mkdir #$output) - (chdir #$output) - - (test-begin "tailon") - - (test-assert "service running" - (marionette-eval - '(begin - (use-modules (gnu services herd)) - (start-service 'tailon)) - marionette)) - - (define* (retry-on-error f #:key times delay) - (let loop ((attempt 1)) - (match (catch - #t - (lambda () - (cons #t - (f))) - (lambda args - (cons #f - args))) - ((#t . return-value) - return-value) - ((#f . error-args) - (if (>= attempt times) - error-args - (begin - (sleep delay) - (loop (+ 1 attempt)))))))) - - (test-equal "http-get" - 200 - (retry-on-error - (lambda () - (let-values (((response text) - (http-get #$(format - #f - "http://localhost:~A/" - http-port) - #:decode-body? #t))) - (response-code response))) - #:times 10 - #:delay 5)) - - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) - - (gexp->derivation "tailon-test" test)) - -(define %test-tailon - (system-test - (name "tailon") - (description "Connect to a running Tailon server.") - (value (run-tailon-test)))) diff --git a/gnu/tests/web.scm b/gnu/tests/web.scm index 73d502dd0..45fcb668f 100644 --- a/gnu/tests/web.scm +++ b/gnu/tests/web.scm @@ -33,7 +33,8 @@ #:export (%test-httpd %test-nginx %test-php-fpm - %test-hpcguix-web)) + %test-hpcguix-web + %test-tailon)) (define %index.html-contents ;; Contents of the /index.html file. @@ -359,3 +360,99 @@ HTTP-PORT, along with php-fpm." (name "hpcguix-web") (description "Connect to a running hpcguix-web server.") (value (run-hpcguix-web-server-test name %hpcguix-web-os)))) + + +(define %tailon-os + ;; Operating system under test. + (simple-operating-system + (dhcp-client-service) + (service tailon-service-type + (tailon-configuration + (config-file + (tailon-configuration-file + (bind "0.0.0.0:8080"))))))) + +(define* (run-tailon-test #:optional (http-port 8081)) + "Run tests in %TAILON-OS, which has tailon running and listening on +HTTP-PORT." + (define os + (marionette-operating-system + %tailon-os + #:imported-modules '((gnu services herd) + (guix combinators)))) + + (define vm + (virtual-machine + (operating-system os) + (port-forwardings `((,http-port . 8080))))) + + (define test + (with-imported-modules '((gnu build marionette)) + #~(begin + (use-modules (srfi srfi-11) (srfi srfi-64) + (ice-9 match) + (gnu build marionette) + (web uri) + (web client) + (web response)) + + (define marionette + ;; Forward the guest's HTTP-PORT, where tailon is listening, to + ;; port 8080 in the host. + (make-marionette (list #$vm))) + + (mkdir #$output) + (chdir #$output) + + (test-begin "tailon") + + (test-assert "service running" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (start-service 'tailon)) + marionette)) + + (define* (retry-on-error f #:key times delay) + (let loop ((attempt 1)) + (match (catch + #t + (lambda () + (cons #t + (f))) + (lambda args + (cons #f + args))) + ((#t . return-value) + return-value) + ((#f . error-args) + (if (>= attempt times) + error-args + (begin + (sleep delay) + (loop (+ 1 attempt)))))))) + + (test-equal "http-get" + 200 + (retry-on-error + (lambda () + (let-values (((response text) + (http-get #$(format + #f + "http://localhost:~A/" + http-port) + #:decode-body? #t))) + (response-code response))) + #:times 10 + #:delay 5)) + + (test-end) + (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + + (gexp->derivation "tailon-test" test)) + +(define %test-tailon + (system-test + (name "tailon") + (description "Connect to a running Tailon server.") + (value (run-tailon-test)))) -- cgit v1.3 From 81317071fb9ad704ee75d40b5e8830650d37b34b Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 7 Sep 2018 22:47:34 +0200 Subject: services: hpcguix-web: Produce a log file and rotate it. * gnu/services/web.scm (%hpcguix-web-log-file) (%hpcguix-web-log-rotations): New variables. (hpcguix-web-shepherd-service): Pass #:log-file. (hpcguix-web-service-type): Extend ROTTLOG-SERVICE-TYPE. --- gnu/services/web.scm | 16 ++++++++++++++-- 1 file changed, 14 insertions(+), 2 deletions(-) (limited to 'gnu/services') diff --git a/gnu/services/web.scm b/gnu/services/web.scm index 16e77f824..1c38e7d8d 100644 --- a/gnu/services/web.scm +++ b/gnu/services/web.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015 David Thompson -;;; Copyright © 2015, 2016, 2017 Ludovic Courtès +;;; Copyright © 2015, 2016, 2017, 2018 Ludovic Courtès ;;; Copyright © 2016 Nils Gillmann ;;; Copyright © 2016, 2017, 2018 Julien Lepiller ;;; Copyright © 2017 Christopher Baines @@ -27,6 +27,7 @@ (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) @@ -974,6 +975,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))) @@ -991,7 +1000,8 @@ a webserver.") #:group "hpcguix-web" #:environment-variables (list "XDG_CACHE_HOME=/var/cache" - "SSL_CERT_DIR=/etc/ssl/certs"))) + "SSL_CERT_DIR=/etc/ssl/certs") + #:log-file #$%hpcguix-web-log-file)) (stop #~(make-kill-destructor)))))) (define hpcguix-web-service-type @@ -1003,6 +1013,8 @@ 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)))))) -- cgit v1.3 From 7fd3082522e7007b47a6aa765d10a9cc3277b36d Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 19 Sep 2018 10:54:46 +0200 Subject: services: udev: Simplify 'start' method. * gnu/services/base.scm (udev-shepherd-service)[start](find): Remove. (udev): Hardwire the eudev file name. Use 'fork+exec-command' instead of 'primitive-fork' and 'exec-command'. --- gnu/services/base.scm | 43 ++++++++++++++++--------------------------- 1 file changed, 16 insertions(+), 27 deletions(-) (limited to 'gnu/services') diff --git a/gnu/services/base.scm b/gnu/services/base.scm index 921914ccd..beb473151 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -1846,16 +1846,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 @@ -1891,24 +1884,20 @@ item of @var{packages}." (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 -- cgit v1.3 From 241358dc94b3c2039a4aa05bcb18b4d1ef6f6d35 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 19 Sep 2018 12:41:45 +0200 Subject: services: networking: Remove unbound variable reference in 'stop'. * gnu/services/base.scm (static-networking-shepherd-service): Remove spurious ":" in 'stop' method inadvertently introduced in commit c9436025a90b86047ba2203d58bbf238f8f9b2f9. --- gnu/services/base.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'gnu/services') diff --git a/gnu/services/base.scm b/gnu/services/base.scm index beb473151..5ba2c6b86 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -2122,7 +2122,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) -- cgit v1.3 From 9926b8f8096a0198cc34585bf7424eba0c98aee2 Mon Sep 17 00:00:00 2001 From: Arun Isaac Date: Fri, 17 Aug 2018 16:39:07 +0530 Subject: gnu: services: Add iptables service. * gnu/services/networking.scm (): New record type. (iptables-service-type): New variable. * gnu/tests/networking.scm (run-iptables-test): New procedure. (%test-iptables): New variable. * doc/guix.texi (Networking Services): Document it. --- doc/guix.texi | 48 +++++++++++++++++ gnu/services/networking.scm | 56 ++++++++++++++++++- gnu/tests/networking.scm | 129 +++++++++++++++++++++++++++++++++++++++++++- 3 files changed, 231 insertions(+), 2 deletions(-) (limited to 'gnu/services') diff --git a/doc/guix.texi b/doc/guix.texi index 8987b20fa..b925485be 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -11612,6 +11612,54 @@ Thus, it can be instantiated like this: @end lisp @end defvr +@cindex iptables +@defvr {Scheme Variable} iptables-service-type +This is the service type to set up an iptables configuration. iptables is a +packet filtering framework supported by the Linux kernel. This service +supports configuring iptables for both IPv4 and IPv6. A simple example +configuration rejecting all incoming connections except those to the ssh port +22 is shown below. + +@lisp +(service iptables-service-type + (iptables-configuration + (ipv4-rules (plain-file "iptables.rules" "*filter +:INPUT ACCEPT +:FORWARD ACCEPT +:OUTPUT ACCEPT +-A INPUT -p tcp --dport 22 -j ACCEPT +-A INPUT -j REJECT --reject-with icmp-port-unreachable +COMMIT +")) + (ipv6-rules (plain-file "ip6tables.rules" "*filter +:INPUT ACCEPT +:FORWARD ACCEPT +:OUTPUT ACCEPT +-A INPUT -p tcp --dport 22 -j ACCEPT +-A INPUT -j REJECT --reject-with icmp6-port-unreachable +COMMIT +")))) +@end lisp +@end defvr + +@deftp {Data Type} iptables-configuration +The data type representing the configuration of iptables. + +@table @asis +@item @code{iptables} (default: @code{iptables}) +The iptables package that provides @code{iptables-restore} and +@code{ip6tables-restore}. +@item @code{ipv4-rules} (default: @code{%iptables-accept-all-rules}) +The iptables rules to use. It will be passed to @code{iptables-restore}. +This may be any ``file-like'' object (@pxref{G-Expressions, file-like +objects}). +@item @code{ipv6-rules} (default: @code{%iptables-accept-all-rules}) +The ip6tables rules to use. It will be passed to @code{ip6tables-restore}. +This may be any ``file-like'' object (@pxref{G-Expressions, file-like +objects}). +@end table +@end deftp + @cindex NTP @cindex real time clock @deffn {Scheme Procedure} ntp-service [#:ntp @var{ntp}] @ diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm index b6b5ee3fe..bd1d5a270 100644 --- a/gnu/services/networking.scm +++ b/gnu/services/networking.scm @@ -8,6 +8,7 @@ ;;; Copyright © 2017 Marius Bakke ;;; Copyright © 2018 Tobias Geerinckx-Rice ;;; Copyright © 2018 Chris Marusich +;;; Copyright © 2018 Arun Isaac ;;; ;;; This file is part of GNU Guix. ;;; @@ -103,7 +104,14 @@ 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: ;;; @@ -1108,4 +1116,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 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 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/tests/networking.scm b/gnu/tests/networking.scm index 381c5caf1..ceba7f7d5 100644 --- a/gnu/tests/networking.scm +++ b/gnu/tests/networking.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2017 Thomas Danckaert ;;; Copyright © 2017 Marius Bakke ;;; Copyright © 2018 Chris Marusich +;;; Copyright © 2018 Arun Isaac ;;; ;;; This file is part of GNU Guix. ;;; @@ -29,9 +30,11 @@ #:use-module (guix store) #:use-module (guix monads) #:use-module (gnu packages bash) + #:use-module (gnu packages linux) #:use-module (gnu packages networking) #:use-module (gnu services shepherd) - #:export (%test-inetd %test-openvswitch %test-dhcpd %test-tor)) + #:use-module (ice-9 match) + #:export (%test-inetd %test-openvswitch %test-dhcpd %test-tor %test-iptables)) (define %inetd-os ;; Operating system with 2 inetd services. @@ -434,3 +437,127 @@ subnet 192.168.1.0 netmask 255.255.255.0 { (name "tor") (description "Test a running Tor daemon configuration.") (value (run-tor-test)))) + +(define* (run-iptables-test) + "Run tests of 'iptables-service-type'." + (define iptables-rules + "*filter +:INPUT ACCEPT +:FORWARD ACCEPT +:OUTPUT ACCEPT +-A INPUT -p tcp -m tcp --dport 7 -j REJECT --reject-with icmp-port-unreachable +COMMIT +") + + (define ip6tables-rules + "*filter +:INPUT ACCEPT +:FORWARD ACCEPT +:OUTPUT ACCEPT +-A INPUT -p tcp -m tcp --dport 7 -j REJECT --reject-with icmp6-port-unreachable +COMMIT +") + + (define inetd-echo-port 7) + + (define os + (marionette-operating-system + (simple-operating-system + (dhcp-client-service) + (service inetd-service-type + (inetd-configuration + (entries (list + (inetd-entry + (name "echo") + (socket-type 'stream) + (protocol "tcp") + (wait? #f) + (user "root")))))) + (service iptables-service-type + (iptables-configuration + (ipv4-rules (plain-file "iptables.rules" iptables-rules)) + (ipv6-rules (plain-file "ip6tables.rules" ip6tables-rules))))) + #:imported-modules '((gnu services herd)) + #:requirements '(inetd iptables))) + + (define test + (with-imported-modules '((gnu build marionette)) + #~(begin + (use-modules (srfi srfi-64) + (gnu build marionette)) + (define marionette + (make-marionette (list #$(virtual-machine os)))) + + (define (dump-iptables iptables-save marionette) + (marionette-eval + `(begin + (use-modules (ice-9 popen) + (ice-9 rdelim) + (ice-9 regex)) + (call-with-output-string + (lambda (out) + (call-with-port + (open-pipe* OPEN_READ ,iptables-save) + (lambda (in) + (let loop ((line (read-line in))) + ;; iptables-save does not output rules in the exact + ;; same format we loaded using iptables-restore. It + ;; adds comments, packet counters, etc. We remove + ;; these additions. + (unless (eof-object? line) + (cond + ;; Remove comments + ((string-match "^#" line) #t) + ;; Remove packet counters + ((string-match "^:([A-Z]*) ([A-Z]*) .*" line) + => (lambda (match-record) + (format out ":~a ~a~%" + (match:substring match-record 1) + (match:substring match-record 2)))) + ;; Pass other lines without modification + (else (display line out) + (newline out))) + (loop (read-line in))))))))) + marionette)) + + (mkdir #$output) + (chdir #$output) + + (test-begin "iptables") + + (test-equal "iptables-save dumps the same rules that were loaded" + (dump-iptables #$(file-append iptables "/sbin/iptables-save") + marionette) + #$iptables-rules) + + (test-equal "ip6tables-save dumps the same rules that were loaded" + (dump-iptables #$(file-append iptables "/sbin/ip6tables-save") + marionette) + #$ip6tables-rules) + + (test-error "iptables firewall blocks access to inetd echo service" + 'misc-error + (wait-for-tcp-port inetd-echo-port marionette #:timeout 5)) + + ;; TODO: This test freezes up at the login prompt without any + ;; relevant messages on the console. Perhaps it is waiting for some + ;; timeout. Find and fix this issue. + ;; (test-assert "inetd echo service is accessible after iptables firewall is stopped" + ;; (begin + ;; (marionette-eval + ;; '(begin + ;; (use-modules (gnu services herd)) + ;; (stop-service 'iptables)) + ;; marionette) + ;; (wait-for-tcp-port inetd-echo-port marionette #:timeout 5))) + + (test-end) + (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + + (gexp->derivation "iptables" test)) + +(define %test-iptables + (system-test + (name "iptables") + (description "Test a running iptables daemon.") + (value (run-iptables-test)))) -- cgit v1.3 From 3b97a1779f3b65d582b8edc8c154b6414314b946 Mon Sep 17 00:00:00 2001 From: Marius Bakke Date: Sun, 26 Aug 2018 23:33:48 +0200 Subject: services: Add Varnish service. * gnu/services/web.scm (): New record type. (%varnish-accounts, %varnish-service-type): New variables. (varnish-shepherd-service): New procedure. * gnu/tests/web.scm (%varnish-vcl, %varnish-os): New variables. (%test-varnish): New test. * doc/guix.texi (Web Services): Document it. --- doc/guix.texi | 80 +++++++++++++++++++++++++++++++++++++++++++ gnu/services/web.scm | 96 +++++++++++++++++++++++++++++++++++++++++++++++++++- gnu/tests/web.scm | 41 ++++++++++++++++++++++ 3 files changed, 216 insertions(+), 1 deletion(-) (limited to 'gnu/services') diff --git a/doc/guix.texi b/doc/guix.texi index 76ec718b0..6b4b06f46 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -16888,6 +16888,86 @@ body of a named location block cannot contain location blocks. @end table @end deftp +@subsubheading Varnish Cache +@cindex Varnish +Varnish is a fast cache server that sits in between web applications +and end users. It proxies requests from clients and caches the +accessed URLs such that multiple requests for the same resource only +creates one request to the back-end. + +@defvr {Scheme Variable} varnish-service-type +Service type for the Varnish daemon. +@end defvr + +@deftp {Data Type} varnish-configuration +Data type representing the @code{varnish} service configuration. +This type has the following parameters: + +@table @asis +@item @code{package} (default: @code{varnish}) +The Varnish package to use. + +@item @code{name} (default: @code{"default"}) +A name for this Varnish instance. Varnish will create a directory in +@file{/var/varnish/} with this name and keep temporary files there. If +the name starts with a forward slash, it is interpreted as an absolute +directory name. + +Pass the @code{-n} argument to other Varnish programs to connect to the +named instance, e.g. @command{varnishncsa -n default}. + +@item @code{backend} (default: @code{"localhost:8080"}) +The backend to use. This option has no effect if @code{vcl} is set. + +@item @code{vcl} (default: #f) +The @dfn{VCL} (Varnish Configuration Language) program to run. If this +is @code{#f}, Varnish will proxy @code{backend} using the default +configuration. Otherwise this must be a file-like object with valid +VCL syntax. + +@c Varnish does not support HTTPS, so keep this URL to avoid confusion. +For example, to mirror @url{http://www.gnu.org,www.gnu.org} with VCL you +can do something along these lines: + +@example +(define %gnu-mirror + (plain-file + "gnu.vcl" + "vcl 4.1; +backend gnu @{ .host = "www.gnu.org"; @}")) + +(operating-system + ... + (services (cons (service varnish-service-type + (varnish-configuration + (listen '(":80")) + (vcl %gnu-mirror))) + %base-services))) +@end example + +The configuration of an already running Varnish instance can be inspected +and changed using the @command{varnishadm} program. + +Consult the @url{https://varnish-cache.org/docs/,Varnish User Guide} and +@url{https://book.varnish-software.com/4.0/,Varnish Book} for +comprehensive documentation on Varnish and its configuration language. + +@item @code{listen} (default: @code{'("localhost:80")}) +List of addresses Varnish will listen on. + +@item @code{storage} (default: @code{'("malloc,128m")}) +List of storage backends that will be available in VCL. + +@item @code{parameters} (default: @code{'()}) +List of run-time parameters in the form @code{'(("parameter" . "value"))}. + +@item @code{extra-options} (default: @code{'()}) +Additional arguments to pass to the @command{varnishd} process. + +@end table +@end deftp + +@subsubheading FastCGI @cindex fastcgi @cindex fcgiwrap FastCGI is an interface between the front-end and the back-end of a web diff --git a/gnu/services/web.scm b/gnu/services/web.scm index 1c38e7d8d..1edb1f4d3 100644 --- a/gnu/services/web.scm +++ b/gnu/services/web.scm @@ -8,6 +8,7 @@ ;;; Copyright © 2017, 2018 Clément Lassieur ;;; Copyright © 2018 Pierre-Antoine Rouby ;;; Copyright © 2017 Christopher Baines +;;; Copyright © 2018 Marius Bakke ;;; ;;; This file is part of GNU Guix. ;;; @@ -190,7 +191,21 @@ tailon-configuration-config-file tailon-configuration-package - tailon-service-type)) + tailon-service-type + + + 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: ;;; @@ -1162,3 +1177,82 @@ files.") (files (append (tailon-configuration-file-files old-config-file) files)))))))) (default-value (tailon-configuration)))) + + +;;; +;;; Varnish +;;; + +(define-record-type* + varnish-configuration make-varnish-configuration + varnish-configuration? + (package varnish-configuration-package ; + (default varnish)) + (name varnish-configuration-name ;string + (default "default")) + (backend varnish-configuration-backend ;string + (default "localhost:8080")) + (vcl varnish-configuration-vcl ;#f | + (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 + (($ 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)))) diff --git a/gnu/tests/web.scm b/gnu/tests/web.scm index 45fcb668f..bcc919137 100644 --- a/gnu/tests/web.scm +++ b/gnu/tests/web.scm @@ -32,6 +32,7 @@ #:use-module (guix store) #:export (%test-httpd %test-nginx + %test-varnish %test-php-fpm %test-hpcguix-web %test-tailon)) @@ -167,6 +168,46 @@ HTTP-PORT." (value (run-webserver-test name %nginx-os #:log-file "/var/log/nginx/access.log")))) + +;;; +;;; Varnish +;;; + +(define %varnish-vcl + (mixed-text-file + "varnish-test.vcl" + "vcl 4.0; +backend dummy { .host = \"127.1.1.1\"; } +sub vcl_recv { return(synth(200, \"OK\")); } +sub vcl_synth { + synthetic(\"" %index.html-contents "\"); + set resp.http.Content-Type = \"text/plain\"; + return(deliver); +}")) + +(define %varnish-os + (simple-operating-system + (dhcp-client-service) + ;; Pretend to be a web server that serves %index.html-contents. + (service varnish-service-type + (varnish-configuration + (name "/tmp/server") + ;; Use a small VSL buffer to fit in the test VM. + (parameters '(("vsl_space" . "4M"))) + (vcl %varnish-vcl))) + ;; Proxy the "server" using the builtin configuration. + (service varnish-service-type + (varnish-configuration + (parameters '(("vsl_space" . "4M"))) + (backend "localhost:80") + (listen '(":8080")))))) + +(define %test-varnish + (system-test + (name "varnish") + (description "Test the Varnish Cache server.") + (value (run-webserver-test "varnish-default" %varnish-os)))) + ;;; ;;; PHP-FPM -- cgit v1.3 From 4245ddcbc9f935804c17c97872b90ec1050c2d75 Mon Sep 17 00:00:00 2001 From: Carlo Zancanaro Date: Sun, 26 Aug 2018 21:54:14 +1000 Subject: guix system: Load all services on reconfigure, not just stopped ones. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This uses the 'replacement' service slot introduced in the Shepherd version 0.5.0. * gnu/services/shepherd.scm (shepherd-service-upgrade): Return a list of services that need to be restarted to complete their upgrade. * guix/scripts/system.scm (call-with-service-upgrade-info): Rename an internal variable to reflect the change to shepherd-service-upgrade. (upgrade-shepherd-services): Call 'load-services/safe' instead of 'load-services'. Print a message about services that need to be manually restarted. * gnu/services/herd.scm (load-services/safe): New procedure. * doc/guix.texi (Invoking guix system): Document the new behaviour. Co-authored-by: Ludovic Courtès --- doc/guix.texi | 8 ++++---- gnu/services/herd.scm | 20 ++++++++++++++++++++ gnu/services/shepherd.scm | 23 ++++++++--------------- guix/scripts/system.scm | 25 ++++++++++++++++--------- 4 files changed, 48 insertions(+), 28 deletions(-) (limited to 'gnu/services') diff --git a/doc/guix.texi b/doc/guix.texi index 6b4b06f46..e1046eb51 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -33,7 +33,7 @@ Copyright @copyright{} 2016 Alex ter Weele@* Copyright @copyright{} 2017, 2018 Clément Lassieur@* Copyright @copyright{} 2017 Mathieu Othacehe@* Copyright @copyright{} 2017 Federico Beffa@* -Copyright @copyright{} 2017 Carlo Zancanaro@* +Copyright @copyright{} 2017, 2018 Carlo Zancanaro@* Copyright @copyright{} 2017 Thomas Danckaert@* Copyright @copyright{} 2017 humanitiesNerd@* Copyright @copyright{} 2017 Christopher Allan Webber@* @@ -21920,9 +21920,9 @@ systems already running GuixSD.}. This effects all the configuration specified in @var{file}: user accounts, system services, global package list, setuid programs, etc. The command starts system services specified in @var{file} that are not -currently running; if a service is currently running, it does not -attempt to upgrade it since this would not be possible without stopping it -first. +currently running; if a service is currently running this command will +arrange for it to be upgraded the next time it is stopped (eg. by +@code{herd stop X} or @code{herd restart X}). This command creates a new generation whose number is one greater than the current generation (as reported by @command{guix system diff --git a/gnu/services/herd.scm b/gnu/services/herd.scm index 8c96b7073..8ff817759 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 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 ))) + (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/shepherd.scm b/gnu/services/shepherd.scm index 4cd224984..4c7e72049 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 ;;; Copyright © 2017 Clément Lassieur +;;; Copyright © 2018 Carlo Zancanaro ;;; ;;; This file is part of GNU Guix. ;;; @@ -329,7 +330,7 @@ symbols provided/required by a service." (define (shepherd-service-upgrade live target) "Return two values: the subset of LIVE (a list of ) that needs to be unloaded, and the subset of TARGET (a list of ) 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 +347,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 +357,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/guix/scripts/system.scm b/guix/scripts/system.scm index 69bd05b51..1e7620f14 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -310,9 +310,9 @@ names of services to load (upgrade), and the list of names of services to unload." (match (current-services) ((services ...) - (let-values (((to-unload to-load) + (let-values (((to-unload to-restart) (shepherd-service-upgrade services new-services))) - (mproc to-load + (mproc to-restart (map (compose first live-service-provision) to-unload)))) (#f @@ -335,25 +335,32 @@ bring the system down." ;; Arrange to simply emit a warning if the service upgrade fails. (with-shepherd-error-handling (call-with-service-upgrade-info new-services - (lambda (to-load to-unload) + (lambda (to-restart to-unload) (for-each (lambda (unload) (info (G_ "unloading service '~a'...~%") unload) (unload-service unload)) to-unload) (with-monad %store-monad - (munless (null? to-load) - (let ((to-load-names (map shepherd-service-canonical-name to-load)) - (to-start (filter shepherd-service-auto-start? to-load))) - (info (G_ "loading new services:~{ ~a~}...~%") to-load-names) + (munless (null? new-services) + (let ((new-service-names (map shepherd-service-canonical-name new-services)) + (to-restart-names (map shepherd-service-canonical-name to-restart)) + (to-start (filter shepherd-service-auto-start? new-services))) + (info (G_ "loading new services:~{ ~a~}...~%") new-service-names) + (unless (null? to-restart-names) + ;; Listing TO-RESTART-NAMES in the message below wouldn't help + ;; because many essential services cannot be meaningfully + ;; restarted. See . + (format #t (G_ "To complete the upgrade, run 'herd restart SERVICE' to stop, +upgrade, and restart each service that was not automatically restarted.\n"))) (mlet %store-monad ((files (mapm %store-monad (compose lower-object shepherd-service-file) - to-load))) + new-services))) ;; Here we assume that FILES are exactly those that were computed ;; as part of the derivation that built OS, which is normally the ;; case. - (load-services (map derivation->output-path files)) + (load-services/safe (map derivation->output-path files)) (for-each start-service (map shepherd-service-canonical-name to-start)) -- cgit v1.3 From 6f03b08089167ec863361352ab200830bffeb0b7 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 26 Sep 2018 22:30:16 +0200 Subject: services: dhcp-client: Use 'read-pid-file'. * gnu/services/networking.scm (dhcp-client-service-type)[start]: Use 'read-pid-file' instead of the custom and possibly infinite loop. --- gnu/services/networking.scm | 16 ++-------------- 1 file changed, 2 insertions(+), 14 deletions(-) (limited to 'gnu/services') diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm index bd1d5a270..3fdb2bb9f 100644 --- a/gnu/services/networking.scm +++ b/gnu/services/networking.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès +;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès ;;; Copyright © 2015 Mark H Weaver ;;; Copyright © 2016, 2018 Efraim Flashner ;;; Copyright © 2016 John Darrington @@ -191,19 +191,7 @@ 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)))))))))) + (read-pid-file #$pid-file))))) (stop #~(make-kill-destructor)))))) (define* (dhcp-client-service #:key (dhcp isc-dhcp)) -- cgit v1.3 From a56c4eb8f43ae5555985d8a84308d150c0763c5a Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 26 Sep 2018 22:52:38 +0200 Subject: services: shepherd: Add workaround for 0.5.0 in containers. * gnu/services/shepherd.scm (%containerized-shepherd-service): New service. * gnu/system.scm (essential-services): Use it when CONTAINER? is true. --- gnu/services/shepherd.scm | 16 ++++++++++++++++ gnu/system.scm | 2 +- 2 files changed, 17 insertions(+), 1 deletion(-) (limited to 'gnu/services') diff --git a/gnu/services/shepherd.scm b/gnu/services/shepherd.scm index 4c7e72049..49d08cc30 100644 --- a/gnu/services/shepherd.scm +++ b/gnu/services/shepherd.scm @@ -59,6 +59,7 @@ %default-modules shepherd-service-file + %containerized-shepherd-service shepherd-service-lookup-procedure shepherd-service-back-edges @@ -327,6 +328,21 @@ 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 ) that needs to be unloaded, and the subset of TARGET (a list of ) that diff --git a/gnu/system.scm b/gnu/system.scm index e4a57475a..99bc09873 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -501,7 +501,7 @@ a container or that of a \"bare metal\" system." ;; Add the firmware service, unless we are building for a ;; container. (if container? - '() + (list %containerized-shepherd-service) (list %linux-bare-metal-service (service firmware-service-type (operating-system-firmware os)))))))) -- cgit v1.3 From 23784f0c3342a0fab5bf2a1c15c300b9f0856872 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 26 Sep 2018 22:58:23 +0200 Subject: services: udev: Don't attempt to read "modules.devname" from a container. Fixes . Reported by Julien Lepiller . * gnu/services/base.scm (udev-shepherd-service)[start]: Check whether DIRECTORY exists and skip 'make-static-device-nodes' call if it doesn't. --- gnu/services/base.scm | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) (limited to 'gnu/services') diff --git a/gnu/services/base.scm b/gnu/services/base.scm index 5ba2c6b86..9dfabd980 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -1881,7 +1881,12 @@ 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 (fork+exec-command (list udevd)))) -- cgit v1.3 From 09b7300c01a8e7100467c6caae9b2c8d8e673971 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 26 Sep 2018 23:01:33 +0200 Subject: services: virtual-terminal: Write to "default_utf8" only if necessary. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Fixes a bug in containers whereby 'virtual-terminal' would always fail to start because writing to /sys/…/default_utf8 would fail with EROFS. * gnu/services/base.scm (virtual-terminal-service-type): Read from "default_utf8" before attempting to write to it. --- gnu/services/base.scm | 25 ++++++++++++++----------- 1 file changed, 14 insertions(+), 11 deletions(-) (limited to 'gnu/services') diff --git a/gnu/services/base.scm b/gnu/services/base.scm index 9dfabd980..47c7d8bb2 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -685,17 +685,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 -- cgit v1.3 From 258a6d944ed891fa92fa87a16731e5dfe0bac477 Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Fri, 13 Jul 2018 20:39:46 +0100 Subject: services: Add Gitolite. * gnu/services/version-control.scm (, ): New record types. (gitolite-accounts, gitolite-activation): New procedures. (gitolite-service-type): New variables. * gnu/tests/version-control.scm (%gitolite-test-admin-keypair, %gitolite-os, %test-gitolite): New variables. (run-gitolite-test): New procedure. * doc/guix.texi (Version Control): Document the gitolite service. --- doc/guix.texi | 94 ++++++++++++++++++++ gnu/services/version-control.scm | 179 ++++++++++++++++++++++++++++++++++++++- gnu/tests/version-control.scm | 114 ++++++++++++++++++++++++- 3 files changed, 385 insertions(+), 2 deletions(-) (limited to 'gnu/services') diff --git a/doc/guix.texi b/doc/guix.texi index e1046eb51..94bb0ec4e 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -21028,6 +21028,100 @@ could instantiate a cgit service like this: (cgitrc ""))) @end example +@subsubheading Gitolite Service + +@cindex Gitolite service +@cindex Git, hosting +@uref{http://gitolite.com/gitolite/, Gitolite} is a tool for hosting Git +repositories on a central server. + +Gitolite can handle multiple repositories and users, and supports flexible +configuration of the permissions for the users on the repositories. + +The following example will configure Gitolite using the default @code{git} +user, and the provided SSH public key. + +@example +(service gitolite-service-type + (gitolite-configuration + (admin-pubkey (plain-file + "yourname.pub" + "ssh-rsa AAAA... guix@@example.com")))) +@end example + +Gitolite is configured through a special admin repository which you can clone, +for example, if you setup Gitolite on @code{example.com}, you would run the +following command to clone the admin repository. + +@example +git clone git@@example.com:gitolite-admin +@end example + +When the Gitolite service is activated, the provided @code{admin-pubkey} will +be inserted in to the @file{keydir} directory in the gitolite-admin +repository. If this results in a change in the repository, it will be +committed using the message ``gitolite setup by GNU Guix''. + +@deftp {Data Type} gitolite-configuration +Data type representing the configuration for @code{gitolite-service-type}. + +@table @asis +@item @code{package} (default: @var{gitolite}) +Gitolite package to use. + +@item @code{user} (default: @var{git}) +User to use for Gitolite. This will be user that you use when accessing +Gitolite over SSH. + +@item @code{group} (default: @var{git}) +Group to use for Gitolite. + +@item @code{home-directory} (default: @var{"/var/lib/gitolite"}) +Directory in which to store the Gitolite configuration and repositories. + +@item @code{rc-file} (default: @var{(gitolite-rc-file)}) +A ``file-like'' object (@pxref{G-Expressions, file-like objects}), +representing the configuration for Gitolite. + +@item @code{admin-pubkey} (default: @var{#f}) +A ``file-like'' object (@pxref{G-Expressions, file-like objects}) used to +setup Gitolite. This will be inserted in to the @file{keydir} directory +within the gitolite-admin repository. + +To specify the SSH key as a string, use the @code{plain-file} function. + +@example +(plain-file "yourname.pub" "ssh-rsa AAAA... guix@@example.com") +@end example + +@end table +@end deftp + +@deftp {Data Type} gitolite-rc-file +Data type representing the Gitolite RC file. + +@table @asis +@item @code{umask} (default: @code{#o0077}) +This controls the permissions Gitolite sets on the repositories and their +contents. + +A value like @code{#o0027} will give read access to the group used by Gitolite +(by default: @code{git}). This is necessary when using Gitolite with software +like cgit or gitweb. + +@item @code{git-config-keys} (default: @code{""}) +Gitolite allows you to set git config values using the "config" keyword. This +setting allows control over the config keys to accept. + +@item @code{roles} (default: @code{'(("READERS" . 1) ("WRITERS" . ))}) +Set the role names allowed to be used by users running the perms command. + +@item @code{enable} (default: @code{'("help" "desc" "info" "perms" "writable" "ssh-authkeys" "git-config" "daemon" "gitweb")}) +This setting controls the commands and features to enable within Gitolite. + +@end table +@end deftp + @node Game Services @subsubsection Game Services diff --git a/gnu/services/version-control.scm b/gnu/services/version-control.scm index 58274c8be..cc8cd2202 100644 --- a/gnu/services/version-control.scm +++ b/gnu/services/version-control.scm @@ -3,6 +3,7 @@ ;;; Copyright © 2016 Sou Bunnbu ;;; Copyright © 2017 Oleg Pykhalov ;;; Copyright © 2017 Clément Lassieur +;;; Copyright © 2018 Christopher Baines ;;; ;;; This file is part of GNU Guix. ;;; @@ -40,7 +41,23 @@ git-http-configuration git-http-configuration? - git-http-nginx-location-configuration)) + git-http-nginx-location-configuration + + + gitolite-configuration + gitolite-configuration-package + gitolite-configuration-user + gitolite-configuration-rc-file + gitolite-configuration-admin-pubkey + + + 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 +214,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 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 ) system target) + (match 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 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 + (($ 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 + (($ 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/tests/version-control.scm b/gnu/tests/version-control.scm index 3b935a1b4..4409b8a12 100644 --- a/gnu/tests/version-control.scm +++ b/gnu/tests/version-control.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2017, 2018 Oleg Pykhalov ;;; Copyright © 2017, 2018 Ludovic Courtès ;;; Copyright © 2017, 2018 Clément Lassieur +;;; Copyright © 2018 Christopher Baines ;;; ;;; This file is part of GNU Guix. ;;; @@ -27,14 +28,17 @@ #:use-module (gnu services) #:use-module (gnu services version-control) #:use-module (gnu services cgit) + #:use-module (gnu services ssh) #:use-module (gnu services web) #:use-module (gnu services networking) #:use-module (gnu packages version-control) + #:use-module (gnu packages ssh) #:use-module (guix gexp) #:use-module (guix store) #:use-module (guix modules) #:export (%test-cgit - %test-git-http)) + %test-git-http + %test-gitolite)) (define README-contents "Hello! This is what goes inside the 'README' file.") @@ -300,3 +304,111 @@ HTTP-PORT." (name "git-http") (description "Connect to a running Git HTTP server.") (value (run-git-http-test)))) + + +;;; +;;; Gitolite. +;;; + +(define %gitolite-test-admin-keypair + (computed-file + "gitolite-test-admin-keypair" + (with-imported-modules (source-module-closure + '((guix build utils))) + #~(begin + (use-modules (ice-9 match) (srfi srfi-26) + (guix build utils)) + + (mkdir #$output) + (invoke #$(file-append openssh "/bin/ssh-keygen") + "-f" (string-append #$output "/test-admin") + "-t" "rsa" + "-q" + "-N" ""))))) + +(define %gitolite-os + (simple-operating-system + (dhcp-client-service) + (service openssh-service-type) + (service gitolite-service-type + (gitolite-configuration + (admin-pubkey + (file-append %gitolite-test-admin-keypair "/test-admin.pub")))))) + +(define (run-gitolite-test) + (define os + (marionette-operating-system + %gitolite-os + #:imported-modules '((gnu services herd) + (guix combinators)))) + + (define vm + (virtual-machine + (operating-system os) + (port-forwardings `((2222 . 22))))) + + (define test + (with-imported-modules '((gnu build marionette) + (guix build utils)) + #~(begin + (use-modules (srfi srfi-64) + (rnrs io ports) + (gnu build marionette) + (guix build utils)) + + (define marionette + (make-marionette (list #$vm))) + + (mkdir #$output) + (chdir #$output) + + (test-begin "gitolite") + + ;; Wait for sshd to be up and running. + (test-assert "service running" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (start-service 'ssh-daemon)) + marionette)) + + (display #$%gitolite-test-admin-keypair) + + (setenv "GIT_SSH_VARIANT" "ssh") + (setenv "GIT_SSH_COMMAND" + (string-join + '(#$(file-append openssh "/bin/ssh") + "-i" #$(file-append %gitolite-test-admin-keypair + "/test-admin") + "-o" "UserKnownHostsFile=/dev/null" + "-o" "StrictHostKeyChecking=no"))) + + (test-assert "cloning the admin repository" + (invoke #$(file-append git "/bin/git") + "clone" "-v" + "ssh://git@localhost:2222/gitolite-admin" + "/tmp/clone")) + + (test-assert "admin key exists" + (file-exists? "/tmp/clone/keydir/test-admin.pub")) + + (with-directory-excursion "/tmp/clone" + (invoke #$(file-append git "/bin/git") + "-c" "user.name=Guix" "-c" "user.email=guix" + "commit" + "-m" "Test commit" + "--allow-empty") + + (test-assert "pushing, and the associated hooks" + (invoke #$(file-append git "/bin/git") "push"))) + + (test-end) + (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + + (gexp->derivation "gitolite" test)) + +(define %test-gitolite + (system-test + (name "gitolite") + (description "Clone the Gitolite admin repository.") + (value (run-gitolite-test)))) -- cgit v1.3 From 17bea1803cf706d8db053d8d73302a4455684d29 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Sat, 29 Sep 2018 21:18:45 -0400 Subject: Revert "services: Add Gitolite." This reverts commit 258a6d944ed891fa92fa87a16731e5dfe0bac477. --- doc/guix.texi | 94 -------------------- gnu/services/version-control.scm | 179 +-------------------------------------- gnu/tests/version-control.scm | 114 +------------------------ 3 files changed, 2 insertions(+), 385 deletions(-) (limited to 'gnu/services') diff --git a/doc/guix.texi b/doc/guix.texi index 94bb0ec4e..e1046eb51 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -21028,100 +21028,6 @@ could instantiate a cgit service like this: (cgitrc ""))) @end example -@subsubheading Gitolite Service - -@cindex Gitolite service -@cindex Git, hosting -@uref{http://gitolite.com/gitolite/, Gitolite} is a tool for hosting Git -repositories on a central server. - -Gitolite can handle multiple repositories and users, and supports flexible -configuration of the permissions for the users on the repositories. - -The following example will configure Gitolite using the default @code{git} -user, and the provided SSH public key. - -@example -(service gitolite-service-type - (gitolite-configuration - (admin-pubkey (plain-file - "yourname.pub" - "ssh-rsa AAAA... guix@@example.com")))) -@end example - -Gitolite is configured through a special admin repository which you can clone, -for example, if you setup Gitolite on @code{example.com}, you would run the -following command to clone the admin repository. - -@example -git clone git@@example.com:gitolite-admin -@end example - -When the Gitolite service is activated, the provided @code{admin-pubkey} will -be inserted in to the @file{keydir} directory in the gitolite-admin -repository. If this results in a change in the repository, it will be -committed using the message ``gitolite setup by GNU Guix''. - -@deftp {Data Type} gitolite-configuration -Data type representing the configuration for @code{gitolite-service-type}. - -@table @asis -@item @code{package} (default: @var{gitolite}) -Gitolite package to use. - -@item @code{user} (default: @var{git}) -User to use for Gitolite. This will be user that you use when accessing -Gitolite over SSH. - -@item @code{group} (default: @var{git}) -Group to use for Gitolite. - -@item @code{home-directory} (default: @var{"/var/lib/gitolite"}) -Directory in which to store the Gitolite configuration and repositories. - -@item @code{rc-file} (default: @var{(gitolite-rc-file)}) -A ``file-like'' object (@pxref{G-Expressions, file-like objects}), -representing the configuration for Gitolite. - -@item @code{admin-pubkey} (default: @var{#f}) -A ``file-like'' object (@pxref{G-Expressions, file-like objects}) used to -setup Gitolite. This will be inserted in to the @file{keydir} directory -within the gitolite-admin repository. - -To specify the SSH key as a string, use the @code{plain-file} function. - -@example -(plain-file "yourname.pub" "ssh-rsa AAAA... guix@@example.com") -@end example - -@end table -@end deftp - -@deftp {Data Type} gitolite-rc-file -Data type representing the Gitolite RC file. - -@table @asis -@item @code{umask} (default: @code{#o0077}) -This controls the permissions Gitolite sets on the repositories and their -contents. - -A value like @code{#o0027} will give read access to the group used by Gitolite -(by default: @code{git}). This is necessary when using Gitolite with software -like cgit or gitweb. - -@item @code{git-config-keys} (default: @code{""}) -Gitolite allows you to set git config values using the "config" keyword. This -setting allows control over the config keys to accept. - -@item @code{roles} (default: @code{'(("READERS" . 1) ("WRITERS" . ))}) -Set the role names allowed to be used by users running the perms command. - -@item @code{enable} (default: @code{'("help" "desc" "info" "perms" "writable" "ssh-authkeys" "git-config" "daemon" "gitweb")}) -This setting controls the commands and features to enable within Gitolite. - -@end table -@end deftp - @node Game Services @subsubsection Game Services diff --git a/gnu/services/version-control.scm b/gnu/services/version-control.scm index cc8cd2202..58274c8be 100644 --- a/gnu/services/version-control.scm +++ b/gnu/services/version-control.scm @@ -3,7 +3,6 @@ ;;; Copyright © 2016 Sou Bunnbu ;;; Copyright © 2017 Oleg Pykhalov ;;; Copyright © 2017 Clément Lassieur -;;; Copyright © 2018 Christopher Baines ;;; ;;; This file is part of GNU Guix. ;;; @@ -41,23 +40,7 @@ git-http-configuration git-http-configuration? - git-http-nginx-location-configuration - - - gitolite-configuration - gitolite-configuration-package - gitolite-configuration-user - gitolite-configuration-rc-file - gitolite-configuration-admin-pubkey - - - gitolite-rc-file - gitolite-rc-file-umask - gitolite-rc-file-git-config-keys - gitolite-rc-file-roles - gitolite-rc-file-enable - - gitolite-service-type)) + git-http-nginx-location-configuration)) ;;; Commentary: ;;; @@ -214,163 +197,3 @@ 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 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 ) system target) - (match 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 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 - (($ 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 - (($ 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/tests/version-control.scm b/gnu/tests/version-control.scm index 4409b8a12..3b935a1b4 100644 --- a/gnu/tests/version-control.scm +++ b/gnu/tests/version-control.scm @@ -2,7 +2,6 @@ ;;; Copyright © 2017, 2018 Oleg Pykhalov ;;; Copyright © 2017, 2018 Ludovic Courtès ;;; Copyright © 2017, 2018 Clément Lassieur -;;; Copyright © 2018 Christopher Baines ;;; ;;; This file is part of GNU Guix. ;;; @@ -28,17 +27,14 @@ #:use-module (gnu services) #:use-module (gnu services version-control) #:use-module (gnu services cgit) - #:use-module (gnu services ssh) #:use-module (gnu services web) #:use-module (gnu services networking) #:use-module (gnu packages version-control) - #:use-module (gnu packages ssh) #:use-module (guix gexp) #:use-module (guix store) #:use-module (guix modules) #:export (%test-cgit - %test-git-http - %test-gitolite)) + %test-git-http)) (define README-contents "Hello! This is what goes inside the 'README' file.") @@ -304,111 +300,3 @@ HTTP-PORT." (name "git-http") (description "Connect to a running Git HTTP server.") (value (run-git-http-test)))) - - -;;; -;;; Gitolite. -;;; - -(define %gitolite-test-admin-keypair - (computed-file - "gitolite-test-admin-keypair" - (with-imported-modules (source-module-closure - '((guix build utils))) - #~(begin - (use-modules (ice-9 match) (srfi srfi-26) - (guix build utils)) - - (mkdir #$output) - (invoke #$(file-append openssh "/bin/ssh-keygen") - "-f" (string-append #$output "/test-admin") - "-t" "rsa" - "-q" - "-N" ""))))) - -(define %gitolite-os - (simple-operating-system - (dhcp-client-service) - (service openssh-service-type) - (service gitolite-service-type - (gitolite-configuration - (admin-pubkey - (file-append %gitolite-test-admin-keypair "/test-admin.pub")))))) - -(define (run-gitolite-test) - (define os - (marionette-operating-system - %gitolite-os - #:imported-modules '((gnu services herd) - (guix combinators)))) - - (define vm - (virtual-machine - (operating-system os) - (port-forwardings `((2222 . 22))))) - - (define test - (with-imported-modules '((gnu build marionette) - (guix build utils)) - #~(begin - (use-modules (srfi srfi-64) - (rnrs io ports) - (gnu build marionette) - (guix build utils)) - - (define marionette - (make-marionette (list #$vm))) - - (mkdir #$output) - (chdir #$output) - - (test-begin "gitolite") - - ;; Wait for sshd to be up and running. - (test-assert "service running" - (marionette-eval - '(begin - (use-modules (gnu services herd)) - (start-service 'ssh-daemon)) - marionette)) - - (display #$%gitolite-test-admin-keypair) - - (setenv "GIT_SSH_VARIANT" "ssh") - (setenv "GIT_SSH_COMMAND" - (string-join - '(#$(file-append openssh "/bin/ssh") - "-i" #$(file-append %gitolite-test-admin-keypair - "/test-admin") - "-o" "UserKnownHostsFile=/dev/null" - "-o" "StrictHostKeyChecking=no"))) - - (test-assert "cloning the admin repository" - (invoke #$(file-append git "/bin/git") - "clone" "-v" - "ssh://git@localhost:2222/gitolite-admin" - "/tmp/clone")) - - (test-assert "admin key exists" - (file-exists? "/tmp/clone/keydir/test-admin.pub")) - - (with-directory-excursion "/tmp/clone" - (invoke #$(file-append git "/bin/git") - "-c" "user.name=Guix" "-c" "user.email=guix" - "commit" - "-m" "Test commit" - "--allow-empty") - - (test-assert "pushing, and the associated hooks" - (invoke #$(file-append git "/bin/git") "push"))) - - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) - - (gexp->derivation "gitolite" test)) - -(define %test-gitolite - (system-test - (name "gitolite") - (description "Clone the Gitolite admin repository.") - (value (run-gitolite-test)))) -- cgit v1.3 From f8e710684e5c3f866413dff825ba17bdffceac5d Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Fri, 13 Jul 2018 20:39:46 +0100 Subject: services: Add Gitolite. * gnu/services/version-control.scm (, ): New record types. (gitolite-accounts, gitolite-activation): New procedures. (gitolite-service-type): New variables. * gnu/tests/version-control.scm (%gitolite-test-admin-keypair, %gitolite-os, %test-gitolite): New variables. (run-gitolite-test): New procedure. * doc/guix.texi (Version Control): Document the gitolite service. --- doc/guix.texi | 94 ++++++++++++++++++++ gnu/services/version-control.scm | 180 ++++++++++++++++++++++++++++++++++++++- gnu/tests/version-control.scm | 114 ++++++++++++++++++++++++- 3 files changed, 386 insertions(+), 2 deletions(-) (limited to 'gnu/services') diff --git a/doc/guix.texi b/doc/guix.texi index e1046eb51..94bb0ec4e 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -21028,6 +21028,100 @@ could instantiate a cgit service like this: (cgitrc ""))) @end example +@subsubheading Gitolite Service + +@cindex Gitolite service +@cindex Git, hosting +@uref{http://gitolite.com/gitolite/, Gitolite} is a tool for hosting Git +repositories on a central server. + +Gitolite can handle multiple repositories and users, and supports flexible +configuration of the permissions for the users on the repositories. + +The following example will configure Gitolite using the default @code{git} +user, and the provided SSH public key. + +@example +(service gitolite-service-type + (gitolite-configuration + (admin-pubkey (plain-file + "yourname.pub" + "ssh-rsa AAAA... guix@@example.com")))) +@end example + +Gitolite is configured through a special admin repository which you can clone, +for example, if you setup Gitolite on @code{example.com}, you would run the +following command to clone the admin repository. + +@example +git clone git@@example.com:gitolite-admin +@end example + +When the Gitolite service is activated, the provided @code{admin-pubkey} will +be inserted in to the @file{keydir} directory in the gitolite-admin +repository. If this results in a change in the repository, it will be +committed using the message ``gitolite setup by GNU Guix''. + +@deftp {Data Type} gitolite-configuration +Data type representing the configuration for @code{gitolite-service-type}. + +@table @asis +@item @code{package} (default: @var{gitolite}) +Gitolite package to use. + +@item @code{user} (default: @var{git}) +User to use for Gitolite. This will be user that you use when accessing +Gitolite over SSH. + +@item @code{group} (default: @var{git}) +Group to use for Gitolite. + +@item @code{home-directory} (default: @var{"/var/lib/gitolite"}) +Directory in which to store the Gitolite configuration and repositories. + +@item @code{rc-file} (default: @var{(gitolite-rc-file)}) +A ``file-like'' object (@pxref{G-Expressions, file-like objects}), +representing the configuration for Gitolite. + +@item @code{admin-pubkey} (default: @var{#f}) +A ``file-like'' object (@pxref{G-Expressions, file-like objects}) used to +setup Gitolite. This will be inserted in to the @file{keydir} directory +within the gitolite-admin repository. + +To specify the SSH key as a string, use the @code{plain-file} function. + +@example +(plain-file "yourname.pub" "ssh-rsa AAAA... guix@@example.com") +@end example + +@end table +@end deftp + +@deftp {Data Type} gitolite-rc-file +Data type representing the Gitolite RC file. + +@table @asis +@item @code{umask} (default: @code{#o0077}) +This controls the permissions Gitolite sets on the repositories and their +contents. + +A value like @code{#o0027} will give read access to the group used by Gitolite +(by default: @code{git}). This is necessary when using Gitolite with software +like cgit or gitweb. + +@item @code{git-config-keys} (default: @code{""}) +Gitolite allows you to set git config values using the "config" keyword. This +setting allows control over the config keys to accept. + +@item @code{roles} (default: @code{'(("READERS" . 1) ("WRITERS" . ))}) +Set the role names allowed to be used by users running the perms command. + +@item @code{enable} (default: @code{'("help" "desc" "info" "perms" "writable" "ssh-authkeys" "git-config" "daemon" "gitweb")}) +This setting controls the commands and features to enable within Gitolite. + +@end table +@end deftp + @node Game Services @subsubsection Game Services diff --git a/gnu/services/version-control.scm b/gnu/services/version-control.scm index 58274c8be..13669925a 100644 --- a/gnu/services/version-control.scm +++ b/gnu/services/version-control.scm @@ -3,6 +3,7 @@ ;;; Copyright © 2016 Sou Bunnbu ;;; Copyright © 2017 Oleg Pykhalov ;;; Copyright © 2017 Clément Lassieur +;;; Copyright © 2018 Christopher Baines ;;; ;;; 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-package + gitolite-configuration-user + gitolite-configuration-rc-file + gitolite-configuration-admin-pubkey + + + 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 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 ) system target) + (match 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 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 + (($ 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 + (($ 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/tests/version-control.scm b/gnu/tests/version-control.scm index 3b935a1b4..4409b8a12 100644 --- a/gnu/tests/version-control.scm +++ b/gnu/tests/version-control.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2017, 2018 Oleg Pykhalov ;;; Copyright © 2017, 2018 Ludovic Courtès ;;; Copyright © 2017, 2018 Clément Lassieur +;;; Copyright © 2018 Christopher Baines ;;; ;;; This file is part of GNU Guix. ;;; @@ -27,14 +28,17 @@ #:use-module (gnu services) #:use-module (gnu services version-control) #:use-module (gnu services cgit) + #:use-module (gnu services ssh) #:use-module (gnu services web) #:use-module (gnu services networking) #:use-module (gnu packages version-control) + #:use-module (gnu packages ssh) #:use-module (guix gexp) #:use-module (guix store) #:use-module (guix modules) #:export (%test-cgit - %test-git-http)) + %test-git-http + %test-gitolite)) (define README-contents "Hello! This is what goes inside the 'README' file.") @@ -300,3 +304,111 @@ HTTP-PORT." (name "git-http") (description "Connect to a running Git HTTP server.") (value (run-git-http-test)))) + + +;;; +;;; Gitolite. +;;; + +(define %gitolite-test-admin-keypair + (computed-file + "gitolite-test-admin-keypair" + (with-imported-modules (source-module-closure + '((guix build utils))) + #~(begin + (use-modules (ice-9 match) (srfi srfi-26) + (guix build utils)) + + (mkdir #$output) + (invoke #$(file-append openssh "/bin/ssh-keygen") + "-f" (string-append #$output "/test-admin") + "-t" "rsa" + "-q" + "-N" ""))))) + +(define %gitolite-os + (simple-operating-system + (dhcp-client-service) + (service openssh-service-type) + (service gitolite-service-type + (gitolite-configuration + (admin-pubkey + (file-append %gitolite-test-admin-keypair "/test-admin.pub")))))) + +(define (run-gitolite-test) + (define os + (marionette-operating-system + %gitolite-os + #:imported-modules '((gnu services herd) + (guix combinators)))) + + (define vm + (virtual-machine + (operating-system os) + (port-forwardings `((2222 . 22))))) + + (define test + (with-imported-modules '((gnu build marionette) + (guix build utils)) + #~(begin + (use-modules (srfi srfi-64) + (rnrs io ports) + (gnu build marionette) + (guix build utils)) + + (define marionette + (make-marionette (list #$vm))) + + (mkdir #$output) + (chdir #$output) + + (test-begin "gitolite") + + ;; Wait for sshd to be up and running. + (test-assert "service running" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (start-service 'ssh-daemon)) + marionette)) + + (display #$%gitolite-test-admin-keypair) + + (setenv "GIT_SSH_VARIANT" "ssh") + (setenv "GIT_SSH_COMMAND" + (string-join + '(#$(file-append openssh "/bin/ssh") + "-i" #$(file-append %gitolite-test-admin-keypair + "/test-admin") + "-o" "UserKnownHostsFile=/dev/null" + "-o" "StrictHostKeyChecking=no"))) + + (test-assert "cloning the admin repository" + (invoke #$(file-append git "/bin/git") + "clone" "-v" + "ssh://git@localhost:2222/gitolite-admin" + "/tmp/clone")) + + (test-assert "admin key exists" + (file-exists? "/tmp/clone/keydir/test-admin.pub")) + + (with-directory-excursion "/tmp/clone" + (invoke #$(file-append git "/bin/git") + "-c" "user.name=Guix" "-c" "user.email=guix" + "commit" + "-m" "Test commit" + "--allow-empty") + + (test-assert "pushing, and the associated hooks" + (invoke #$(file-append git "/bin/git") "push"))) + + (test-end) + (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + + (gexp->derivation "gitolite" test)) + +(define %test-gitolite + (system-test + (name "gitolite") + (description "Clone the Gitolite admin repository.") + (value (run-gitolite-test)))) -- cgit v1.3 From 89fdd9ee0cc8817283449b33a8c1a2604c575c7e Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 3 Oct 2018 22:44:11 +0200 Subject: services: rottlog: Use command strings in the mcron jobs. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/services/admin.scm (default-jobs): Remove the lambda around "/…/bin/rottlog" to make "herd schedule mcron" more transparent (otherwise it just says "Lambda function"). --- gnu/services/admin.scm | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) (limited to 'gnu/services') diff --git a/gnu/services/admin.scm b/gnu/services/admin.scm index f08c89633..d7bda61ed 100644 --- a/gnu/services/admin.scm +++ b/gnu/services/admin.scm @@ -125,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 make-rottlog-configuration -- cgit v1.3 From acce0a474c1493ab18912bc46285248e4ccb0314 Mon Sep 17 00:00:00 2001 From: Marius Bakke Date: Mon, 9 Apr 2018 01:04:10 +0200 Subject: services: wpa-supplicant: Extend to support configuration parameters. This allows using WPA Supplicant "standalone" without an additional network manager. The default configuration is unchanged. * gnu/services/networking.scm (): New record type. (wpa-supplicant-shepherd-service): Pass configuration records to the daemon. (wpa-supplicant-service-type): Adjust accordingly. * doc/guix.texi (Networking Services): Document the new service type. --- doc/guix.texi | 35 +++++++++++++----- gnu/services/networking.scm | 86 ++++++++++++++++++++++++++++++++++----------- 2 files changed, 91 insertions(+), 30 deletions(-) (limited to 'gnu/services') diff --git a/doc/guix.texi b/doc/guix.texi index 5ae80917a..2cea52f02 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -11737,18 +11737,35 @@ When true, enable connman's vpn plugin. @defvr {Scheme Variable} wpa-supplicant-service-type This is the service type to run @url{https://w1.fi/wpa_supplicant/,WPA supplicant}, an authentication daemon required to authenticate against -encrypted WiFi or ethernet networks. It is configured to listen for -requests on D-Bus. +encrypted WiFi or ethernet networks. +@end defvr -The value of this service is the @code{wpa-supplicant} package to use. -Thus, it can be instantiated like this: +@deftp {Data Type} wpa-supplicant-configuration +Data type representing the configuration of WPA Supplicant. -@lisp -(use-modules (gnu services networking)) +It takes the following parameters: -(service wpa-supplicant-service-type) -@end lisp -@end defvr +@table @asis +@item @code{wpa-supplicant} (default: @code{wpa-supplicant}) +The WPA Supplicant package to use. + +@item @code{dbus?} (default: @code{#t}) +Whether to listen for requests on D-Bus. + +@item @code{pid-file} (default: @code{"/var/run/wpa_supplicant.pid"}) +Where to store the PID file. + +@item @code{interface} (default: @code{#f}) +If this is set, it must specify the name of a network interface that +WPA supplicant will control. + +@item @code{config-file} (default: @code{#f}) +Optional configuration file to use. + +@item @code{extra-options} (default: @code{'()}) +List of additional command-line arguments to pass to the daemon. +@end table +@end deftp @cindex iptables @defvr {Scheme Variable} iptables-service-type diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm index 3fdb2bb9f..c809b4a4a 100644 --- a/gnu/services/networking.scm +++ b/gnu/services/networking.scm @@ -5,7 +5,7 @@ ;;; Copyright © 2016 John Darrington ;;; Copyright © 2017 Clément Lassieur ;;; Copyright © 2017 Thomas Danckaert -;;; Copyright © 2017 Marius Bakke +;;; Copyright © 2017, 2018 Marius Bakke ;;; Copyright © 2018 Tobias Geerinckx-Rice ;;; Copyright © 2018 Chris Marusich ;;; Copyright © 2018 Arun Isaac @@ -101,6 +101,16 @@ modem-manager-configuration modem-manager-configuration? modem-manager-service-type + + + 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 @@ -1019,28 +1029,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 make-wpa-supplicant-configuration + wpa-supplicant-configuration? + (wpa-supplicant wpa-supplicant-configuration-wpa-supplicant ; + (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 | + (default #f)) + (extra-options wpa-supplicant-configuration-extra-options ;list of strings + (default '()))) + +(define wpa-supplicant-shepherd-service + (match-lambda + (($ 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) + (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))))) ;;; -- cgit v1.3 From 39d7fdce453b0ca23ecbed72048647debbaa58a6 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 18 Oct 2018 00:45:05 +0200 Subject: services: dhcp-client: Deprecate 'dhcp-client-service' procedure. * gnu/services/networking.scm (dhcp-client-service-type): Add default value. * gnu/system/examples/bare-bones.tmpl: Use (service dhcp-client-service-type) instead of (dhcp-client-service). * gnu/system/examples/beaglebone-black.tmpl: Likewise. * gnu/tests/base.scm (%avahi-os): Likewise. * gnu/tests/databases.scm (%memcached-os): Likewise. (%mongodb-os): Likewise. * gnu/tests/dict.scm (%dicod-os): Likewise. * gnu/tests/mail.scm (%opensmtpd-os): Likewise. (%exim-os): Likewise. (%dovecot-os): Likewise. * gnu/tests/messaging.scm (run-xmpp-test): Likewise. (run-bitlbee-test): Likewise. * gnu/tests/monitoring.scm (%prometheus-node-exporter-os): Likewise. * gnu/tests/networking.scm (%inetd-os): Likewise. (run-iptables-test): Likewise. * gnu/tests/nfs.scm (%base-os): Likewise. * gnu/tests/rsync.scm (%rsync-os): Likewise. * gnu/tests/ssh.scm (run-ssh-test): Likewise. * gnu/tests/version-control.scm (%cgit-os): Likewise. (%git-http-os): Likewise. (%gitolite-os): Likewise. * gnu/tests/virtualization.scm (%libvirt-os): Likewise. * gnu/tests/web.scm (%httpd-os): Likewise. (%nginx-os): Likewise. (%varnish-os): Likewise. (%php-fpm-os): Likewise. (%hpcguix-web-os): Likewise. (%tailon-os): Likewise. * tests/guix-system.sh: Likewise. * doc/guix.texi (Networking Services): Document 'dhcp-client-service-type' and remove 'dhcp-client-service'. --- doc/guix.texi | 11 ++++++----- gnu/services/networking.scm | 6 ++++-- gnu/system/examples/bare-bones.tmpl | 2 +- gnu/system/examples/beaglebone-black.tmpl | 2 +- gnu/tests/base.scm | 2 +- gnu/tests/databases.scm | 4 ++-- gnu/tests/dict.scm | 2 +- gnu/tests/mail.scm | 6 +++--- gnu/tests/messaging.scm | 4 ++-- gnu/tests/monitoring.scm | 2 +- gnu/tests/networking.scm | 4 ++-- gnu/tests/nfs.scm | 2 +- gnu/tests/rsync.scm | 2 +- gnu/tests/ssh.scm | 2 +- gnu/tests/version-control.scm | 6 +++--- gnu/tests/virtualization.scm | 2 +- gnu/tests/web.scm | 12 ++++++------ guix/gexp.scm | 8 ++++++++ tests/guix-system.sh | 4 ++-- 19 files changed, 47 insertions(+), 36 deletions(-) (limited to 'gnu/services') diff --git a/doc/guix.texi b/doc/guix.texi index fde7892cf..f4f19949f 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -11546,10 +11546,11 @@ The @code{(gnu services networking)} module provides services to configure the network interface. @cindex DHCP, networking service -@deffn {Scheme Procedure} dhcp-client-service [#:dhcp @var{isc-dhcp}] -Return a service that runs @var{dhcp}, a Dynamic Host Configuration -Protocol (DHCP) client, on all the non-loopback network interfaces. -@end deffn +@defvr {Scheme Variable} dhcp-client-service-type +This is the type of services that run @var{dhcp}, a Dynamic Host Configuration +Protocol (DHCP) client, on all the non-loopback network interfaces. Its value +is the DHCP client package to use, @code{isc-dhcp} by default. +@end defvr @deffn {Scheme Procedure} dhcpd-service-type This type defines a service that runs a DHCP daemon. To create a @@ -17168,7 +17169,7 @@ A helper function to quickly add php to an @code{nginx-server-configuration}. A simple services setup for nginx with php can look like this: @example -(services (cons* (dhcp-client-service) +(services (cons* (service dhcp-client-service-type) (service php-fpm-service-type) (service nginx-service-type (nginx-server-configuration diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm index c809b4a4a..61a0e975c 100644 --- a/gnu/services/networking.scm +++ b/gnu/services/networking.scm @@ -53,6 +53,7 @@ static-networking-service-type) #:export (%facebook-host-aliases dhcp-client-service + dhcp-client-service-type dhcpd-service-type dhcpd-configuration @@ -202,9 +203,10 @@ fe80::1%lo0 apps.facebook.com\n") "-pf" #$pid-file ifaces)))) (and (zero? (cdr (waitpid pid))) (read-pid-file #$pid-file))))) - (stop #~(make-kill-destructor)))))) + (stop #~(make-kill-destructor)))) + isc-dhcp)) -(define* (dhcp-client-service #:key (dhcp 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)) diff --git a/gnu/system/examples/bare-bones.tmpl b/gnu/system/examples/bare-bones.tmpl index b763258e5..889dcabe6 100644 --- a/gnu/system/examples/bare-bones.tmpl +++ b/gnu/system/examples/bare-bones.tmpl @@ -44,7 +44,7 @@ ;; Add services to the baseline: a DHCP client and ;; an SSH server. - (services (cons* (dhcp-client-service) + (services (cons* (service dhcp-client-service-type) (service openssh-service-type (openssh-configuration (port-number 2222))) diff --git a/gnu/system/examples/beaglebone-black.tmpl b/gnu/system/examples/beaglebone-black.tmpl index d1130c76b..efef682e3 100644 --- a/gnu/system/examples/beaglebone-black.tmpl +++ b/gnu/system/examples/beaglebone-black.tmpl @@ -45,7 +45,7 @@ ;; Globally-installed packages. (packages (cons* screen openssh %base-packages)) - (services (cons* (dhcp-client-service) + (services (cons* (service dhcp-client-service-type) ;; mingetty does not work on serial lines. ;; Use agetty with board-specific serial parameters. (agetty-service diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm index f97581de3..896d4a8f8 100644 --- a/gnu/tests/base.scm +++ b/gnu/tests/base.scm @@ -673,7 +673,7 @@ non-ASCII names from /tmp.") (name-service-switch %mdns-host-lookup-nss) (services (cons* (avahi-service #:debug? #t) (dbus-service) - (dhcp-client-service) ;needed for multicast + (service dhcp-client-service-type) ;needed for multicast ;; Enable heavyweight debugging output. (modify-services (operating-system-user-services diff --git a/gnu/tests/databases.scm b/gnu/tests/databases.scm index 5c8ca85c1..e0544bbcd 100644 --- a/gnu/tests/databases.scm +++ b/gnu/tests/databases.scm @@ -35,7 +35,7 @@ (define %memcached-os (simple-operating-system - (dhcp-client-service) + (service dhcp-client-service-type) (service memcached-service-type))) (define* (run-memcached-test #:optional (port 11211)) @@ -130,7 +130,7 @@ (operating-system (inherit (simple-operating-system - (dhcp-client-service) + (service dhcp-client-service-type) (service mongodb-service-type))) (packages (cons* mongodb %base-packages)))) diff --git a/gnu/tests/dict.scm b/gnu/tests/dict.scm index dd60ffd46..c50e3cd6d 100644 --- a/gnu/tests/dict.scm +++ b/gnu/tests/dict.scm @@ -34,7 +34,7 @@ (define %dicod-os (simple-operating-system - (dhcp-client-service) + (service dhcp-client-service-type) (service dicod-service-type (dicod-configuration (interfaces '("0.0.0.0")) diff --git a/gnu/tests/mail.scm b/gnu/tests/mail.scm index 5677969fa..33aa4d343 100644 --- a/gnu/tests/mail.scm +++ b/gnu/tests/mail.scm @@ -36,7 +36,7 @@ (define %opensmtpd-os (simple-operating-system - (dhcp-client-service) + (service dhcp-client-service-type) (service opensmtpd-service-type (opensmtpd-configuration (config-file @@ -155,7 +155,7 @@ accept from any for local deliver to mbox (define %exim-os (simple-operating-system - (dhcp-client-service) + (service dhcp-client-service-type) (service mail-aliases-service-type '()) (service exim-service-type (exim-configuration @@ -283,7 +283,7 @@ acl_check_data: (define %dovecot-os (simple-operating-system - (dhcp-client-service) + (service dhcp-client-service-type) (dovecot-service #:config (dovecot-configuration (disable-plaintext-auth? #f) diff --git a/gnu/tests/messaging.scm b/gnu/tests/messaging.scm index f5f99b9f5..36afb987a 100644 --- a/gnu/tests/messaging.scm +++ b/gnu/tests/messaging.scm @@ -35,7 +35,7 @@ "Run a test of an OS running XMPP-SERVICE, which writes its PID to PID-FILE." (define os (marionette-operating-system - (simple-operating-system (dhcp-client-service) + (simple-operating-system (service dhcp-client-service-type) xmpp-service) #:imported-modules '((gnu services herd)))) @@ -167,7 +167,7 @@ (define (run-bitlbee-test) (define os (marionette-operating-system - (simple-operating-system (dhcp-client-service) + (simple-operating-system (service dhcp-client-service-type) (service bitlbee-service-type (bitlbee-configuration (interface "0.0.0.0")))) diff --git a/gnu/tests/monitoring.scm b/gnu/tests/monitoring.scm index 67899987c..3320a19a7 100644 --- a/gnu/tests/monitoring.scm +++ b/gnu/tests/monitoring.scm @@ -85,7 +85,7 @@ (define %prometheus-node-exporter-os (simple-operating-system - (dhcp-client-service) + (service dhcp-client-service-type) (service prometheus-node-exporter-service-type (prometheus-node-exporter-configuration)))) diff --git a/gnu/tests/networking.scm b/gnu/tests/networking.scm index ceba7f7d5..9f12a4ae8 100644 --- a/gnu/tests/networking.scm +++ b/gnu/tests/networking.scm @@ -39,7 +39,7 @@ (define %inetd-os ;; Operating system with 2 inetd services. (simple-operating-system - (dhcp-client-service) + (service dhcp-client-service-type) (service inetd-service-type (inetd-configuration (entries (list @@ -463,7 +463,7 @@ COMMIT (define os (marionette-operating-system (simple-operating-system - (dhcp-client-service) + (service dhcp-client-service-type) (service inetd-service-type (inetd-configuration (entries (list diff --git a/gnu/tests/nfs.scm b/gnu/tests/nfs.scm index 140f03779..7ef9f1f7b 100644 --- a/gnu/tests/nfs.scm +++ b/gnu/tests/nfs.scm @@ -55,7 +55,7 @@ (services (cons* (service rpcbind-service-type (rpcbind-configuration)) - (dhcp-client-service) + (service dhcp-client-service-type) %base-services)))) (define (run-nfs-test name socket) diff --git a/gnu/tests/rsync.scm b/gnu/tests/rsync.scm index a6f8fa2bd..096580022 100644 --- a/gnu/tests/rsync.scm +++ b/gnu/tests/rsync.scm @@ -111,7 +111,7 @@ PORT." ;; Return operating system under test. (let ((base-os (simple-operating-system - (dhcp-client-service) + (service dhcp-client-service-type) (service rsync-service-type)))) (operating-system (inherit base-os) diff --git a/gnu/tests/ssh.scm b/gnu/tests/ssh.scm index 2e40122ad..e5cd439cd 100644 --- a/gnu/tests/ssh.scm +++ b/gnu/tests/ssh.scm @@ -39,7 +39,7 @@ empty-password logins. When SFTP? is true, run an SFTP server test." (define os (marionette-operating-system - (simple-operating-system (dhcp-client-service) ssh-service) + (simple-operating-system (service dhcp-client-service-type) ssh-service) #:imported-modules '((gnu services herd) (guix combinators)))) (define vm diff --git a/gnu/tests/version-control.scm b/gnu/tests/version-control.scm index 4409b8a12..230aa9edf 100644 --- a/gnu/tests/version-control.scm +++ b/gnu/tests/version-control.scm @@ -92,7 +92,7 @@ ;; Operating system under test. (let ((base-os (simple-operating-system - (dhcp-client-service) + (service dhcp-client-service-type) (service cgit-service-type (cgit-configuration (nginx %cgit-configuration-nginx))) @@ -237,7 +237,7 @@ HTTP-PORT." (define %git-http-os (simple-operating-system - (dhcp-client-service) + (service dhcp-client-service-type) (service fcgiwrap-service-type) (service nginx-service-type %git-nginx-configuration) %test-repository-service)) @@ -328,7 +328,7 @@ HTTP-PORT." (define %gitolite-os (simple-operating-system - (dhcp-client-service) + (service dhcp-client-service-type) (service openssh-service-type) (service gitolite-service-type (gitolite-configuration diff --git a/gnu/tests/virtualization.scm b/gnu/tests/virtualization.scm index c2939355b..fbdec2080 100644 --- a/gnu/tests/virtualization.scm +++ b/gnu/tests/virtualization.scm @@ -32,7 +32,7 @@ (define %libvirt-os (simple-operating-system - (dhcp-client-service) + (service dhcp-client-service-type) (dbus-service) (polkit-service) (service libvirt-service-type))) diff --git a/gnu/tests/web.scm b/gnu/tests/web.scm index 2e209fee9..319655396 100644 --- a/gnu/tests/web.scm +++ b/gnu/tests/web.scm @@ -125,7 +125,7 @@ HTTP-PORT." (define %httpd-os (simple-operating-system - (dhcp-client-service) + (service dhcp-client-service-type) (service httpd-service-type (httpd-configuration (config @@ -154,7 +154,7 @@ HTTP-PORT." (define %nginx-os ;; Operating system under test. (simple-operating-system - (dhcp-client-service) + (service dhcp-client-service-type) (service nginx-service-type (nginx-configuration (log-directory "/var/log/nginx") @@ -188,7 +188,7 @@ sub vcl_synth { (define %varnish-os (simple-operating-system - (dhcp-client-service) + (service dhcp-client-service-type) ;; Pretend to be a web server that serves %index.html-contents. (service varnish-service-type (varnish-configuration @@ -237,7 +237,7 @@ echo(\"Computed by php:\".((string)(2+3))); (define %php-fpm-os ;; Operating system under test. (simple-operating-system - (dhcp-client-service) + (service dhcp-client-service-type) (service php-fpm-service-type) (service nginx-service-type (nginx-configuration @@ -392,7 +392,7 @@ HTTP-PORT, along with php-fpm." (define %hpcguix-web-os (simple-operating-system - (dhcp-client-service) + (service dhcp-client-service-type) (service hpcguix-web-service-type (hpcguix-web-configuration (specs %hpcguix-web-specs))))) @@ -407,7 +407,7 @@ HTTP-PORT, along with php-fpm." (define %tailon-os ;; Operating system under test. (simple-operating-system - (dhcp-client-service) + (service dhcp-client-service-type) (service tailon-service-type (tailon-configuration (config-file diff --git a/guix/gexp.scm b/guix/gexp.scm index f7a23db87..ba0d642b1 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -438,6 +438,14 @@ This is the declarative counterpart of 'gexp->file'." (base file-append-base) ; | | ... (suffix file-append-suffix)) ;list of strings +(define (write-file-append file port) + (match file + (($ base suffix) + (format port "#" base + (string-join suffix))))) + +(set-record-type-printer! write-file-append) + (define (file-append base . suffix) "Return a object that expands to the concatenation of BASE and SUFFIX." diff --git a/tests/guix-system.sh b/tests/guix-system.sh index a129efdfc..23d2da490 100644 --- a/tests/guix-system.sh +++ b/tests/guix-system.sh @@ -153,8 +153,8 @@ cat > "$tmpfile" < Date: Fri, 19 Oct 2018 03:03:05 +0200 Subject: services: WPA Supplicant: Fix syntax error. This is a followup to commit acce0a474c1493ab18912bc46285248e4ccb0314. No idea how these disappeared.. :-/ * gnu/services/networking.scm (wpa-supplicant-shepherd-service): Add missing parens. --- gnu/services/networking.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'gnu/services') diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm index 61a0e975c..b764cde5a 100644 --- a/gnu/services/networking.scm +++ b/gnu/services/networking.scm @@ -1064,10 +1064,10 @@ networking.")))) #~("-u") #~()) #$@(if interface - #~(string-append "-i" #$interface) + #~((string-append "-i" #$interface)) #~()) #$@(if config-file - #~(string-append "-c" #$config-file) + #~((string-append "-c" #$config-file)) #~()) #$@extra-options) #:pid-file #$pid-file)) -- cgit v1.3 From 64791eb7e1dceb0940cc881e84820f0170298b34 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 19 Oct 2018 22:46:23 +0200 Subject: services: ntp: Document 'ntp-service-type' and 'ntp-configuration'. * gnu/services/networking.scm ()[servers]: Add default value. (ntp-service-type)[default-value]: New field. (ntp-service): Mark as deprecated. * gnu/services/desktop.scm (%desktop-services): Use (service ntp-service-type) instead of calling 'ntp-service'. * doc/guix.texi (Networking Services): Document 'ntp-service-type' and 'ntp-configuration'. --- doc/guix.texi | 39 ++++++++++++++++++++++++++++----------- gnu/services/desktop.scm | 4 ++-- gnu/services/networking.scm | 8 +++++--- 3 files changed, 35 insertions(+), 16 deletions(-) (limited to 'gnu/services') diff --git a/doc/guix.texi b/doc/guix.texi index f4f19949f..12346c4b8 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -11817,20 +11817,37 @@ objects}). @end table @end deftp -@cindex NTP +@cindex NTP (Network Time Protocol), service @cindex real time clock -@deffn {Scheme Procedure} ntp-service [#:ntp @var{ntp}] @ - [#:servers @var{%ntp-servers}] @ - [#:allow-large-adjustment? #f] -Return a service that runs the daemon from @var{ntp}, the -@uref{http://www.ntp.org, Network Time Protocol package}. The daemon will -keep the system clock synchronized with that of @var{servers}. -@var{allow-large-adjustment?} determines whether @command{ntpd} is allowed to -make an initial adjustment of more than 1,000 seconds. -@end deffn +@defvr {Scheme Variable} ntp-service-type +This is the type of the service running the the @uref{http://www.ntp.org, +Network Time Protocol (NTP)} daemon, @command{ntpd}. The daemon will keep the +system clock synchronized with that of the specified NTP servers. + +The value of this service is an @code{ntpd-configuration} object, as described +below. +@end defvr + +@deftp {Data Type} ntp-configuration +This is the data type for the NTP service configuration. + +@table @asis +@item @code{servers} (default: @code{%ntp-servers}) +This is the list of servers (host names) with which @command{ntpd} will be +synchronized. + +@item @code{allow-large-adjustment?} (default: @code{#f}) +This determines whether @command{ntpd} is allowed to make an initial +adjustment of more than 1,000 seconds. + +@item @code{ntp} (default: @code{ntp}) +The NTP package to use. +@end table +@end deftp @defvr {Scheme Variable} %ntp-servers -List of host names used as the default NTP servers. +List of host names used as the default NTP servers. These are servers of the +@uref{https://www.ntppool.org/en/, NTP Pool Project}. @end defvr @cindex OpenNTPD diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm index 1e8c02c02..e038f9768 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 +;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès ;;; Copyright © 2015 Andy Wingo ;;; Copyright © 2015 Mark H Weaver ;;; Copyright © 2016 Sou Bunnbu @@ -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/networking.scm b/gnu/services/networking.scm index b764cde5a..bfa6e297e 100644 --- a/gnu/services/networking.scm +++ b/gnu/services/networking.scm @@ -297,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))) @@ -370,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 -- cgit v1.3 From abc98e3be5fbccf88fe69399db4d83f902b65a15 Mon Sep 17 00:00:00 2001 From: Florian Pelz Date: Sat, 20 Oct 2018 18:44:03 +0200 Subject: services: httpd: Allow using it with PHP. * gnu/services/web.scm (httpd): Make existing httpd-module API public. * doc/guix.texi (Apache HTTP Server): Document its usage with PHP-FPM. Signed-off-by: Christopher Baines --- doc/guix.texi | 31 +++++++++++++++++++++++++++++++ gnu/services/web.scm | 5 +++++ 2 files changed, 36 insertions(+) (limited to 'gnu/services') diff --git a/doc/guix.texi b/doc/guix.texi index 12346c4b8..87579d414 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -50,6 +50,7 @@ Copyright @copyright{} 2018 Oleg Pykhalov@* Copyright @copyright{} 2018 Mike Gerwitz@* Copyright @copyright{} 2018 Pierre-Antoine Rouby@* Copyright @copyright{} 2018 Gábor Boskovits@* +Copyright @copyright{} 2018 Florian Pelz@* Permission is granted to copy, distribute and/or modify this document under the terms of the GNU Free Documentation License, Version 1.3 or @@ -16612,6 +16613,10 @@ within the store, for example @code{(file-append mod-wsgi @end table @end deffn +@defvr {Scheme Variable} %default-httpd-modules +A default list of @code{httpd-module} objects. +@end defvr + @deffn {Data Type} httpd-config-file This data type represents a configuration file for the httpd service. @@ -16620,6 +16625,32 @@ This data type represents a configuration file for the httpd service. The modules to load. Additional modules can be added here, or loaded by additional configuration. +For example, in order to handle requests for PHP files, you can use Apache’s +@code{mod_proxy_fcgi} module along with @code{php-fpm-service-type}: + +@example +(service httpd-service-type + (httpd-configuration + (config + (httpd-config-file + (modules (cons* + (httpd-module + (name "proxy_module") + (file "modules/mod_proxy.so")) + (httpd-module + (name "proxy_fcgi_module") + (file "modules/mod_proxy_fcgi.so")) + %default-httpd-modules)) + (extra-config (list "\ + + SetHandler \"proxy:unix:/var/run/php-fpm.sock|fcgi://localhost/\" +")))))) +(service php-fpm-service-type + (php-fpm-configuration + (socket "/var/run/php-fpm.sock") + (socket-group "httpd"))) +@end example + @item @code{server-root} (default: @code{httpd}) The @code{ServerRoot} in the configuration file, defaults to the httpd package. Directives including @code{Include} and @code{LoadModule} are diff --git a/gnu/services/web.scm b/gnu/services/web.scm index 1edb1f4d3..fcf453c24 100644 --- a/gnu/services/web.scm +++ b/gnu/services/web.scm @@ -70,6 +70,11 @@ httpd-config-file-user httpd-config-file-group + + httpd-module + httpd-module? + %default-httpd-modules + httpd-service-type -- cgit v1.3 From 7f860a8be150df26bdb69024f4dce2cb8acaa43a Mon Sep 17 00:00:00 2001 From: Oleg Pykhalov Date: Mon, 29 Oct 2018 01:47:32 +0300 Subject: gnu: services: dns: Fix 'ddclient-activation'. * gnu/services/dns.scm (ddclient-activation): Fix procedure. --- gnu/services/dns.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'gnu/services') diff --git a/gnu/services/dns.scm b/gnu/services/dns.scm index 16bd039f5..24ef88668 100644 --- a/gnu/services/dns.scm +++ b/gnu/services/dns.scm @@ -763,9 +763,9 @@ manually.") (use-modules (guix build utils) (ice-9 rdelim)) (let ((ddclient-user - #$(passwd:uid (getpw (ddclient-configuration-user config)))) + (passwd:uid (getpw #$(ddclient-configuration-user config)))) (ddclient-group - #$(passwd:gid (getpw (ddclient-configuration-group config)))) + (passwd:gid (getpw #$(ddclient-configuration-group config)))) (ddclient-secret-file #$(ddclient-configuration-secret-file config))) ;; 'ddclient' complains about ddclient.conf file permissions, which -- cgit v1.3 From f4e8bc5f250bcf5f7daf5eb28b0b9f1131e4ac61 Mon Sep 17 00:00:00 2001 From: Mathieu Othacehe Date: Sun, 28 Oct 2018 11:01:03 +0900 Subject: services: kmscon: Do not switch to vt at start. * gnu/services/base.scm (kmscon-service-type): Add "--no-switchvt" to kmscon command. --- gnu/services/base.scm | 1 + 1 file changed, 1 insertion(+) (limited to 'gnu/services') diff --git a/gnu/services/base.scm b/gnu/services/base.scm index 47c7d8bb2..5b30cedde 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -2057,6 +2057,7 @@ This service is not part of @var{%base-services}." #~(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)) -- cgit v1.3 From 2d9dace8c297c957953fa77bfef785b9dc7b4d2e Mon Sep 17 00:00:00 2001 From: Mathieu Othacehe Date: Sun, 28 Oct 2018 11:10:52 +0900 Subject: services: kmscon: Add an auto-login option. Add an auto-login option that behaves as the one of mingetty-service. * gnu/services/base.scm (kmscon-configuration)[auto-login]: New field. (kmscon-service-type): Pass it to kmscon command. * doc/guix.texi (Base Services): Document it. --- doc/guix.texi | 6 +++++- gnu/services/base.scm | 10 +++++++++- 2 files changed, 14 insertions(+), 2 deletions(-) (limited to 'gnu/services') diff --git a/doc/guix.texi b/doc/guix.texi index d410f2a55..53aee4a14 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -31,7 +31,7 @@ Copyright @copyright{} 2016, 2017, 2018 Jan Nieuwenhuizen@* Copyright @copyright{} 2016 Julien Lepiller@* Copyright @copyright{} 2016 Alex ter Weele@* Copyright @copyright{} 2017, 2018 Clément Lassieur@* -Copyright @copyright{} 2017 Mathieu Othacehe@* +Copyright @copyright{} 2017, 2018 Mathieu Othacehe@* Copyright @copyright{} 2017 Federico Beffa@* Copyright @copyright{} 2017, 2018 Carlo Zancanaro@* Copyright @copyright{} 2017 Thomas Danckaert@* @@ -10939,6 +10939,10 @@ A gexp denoting the name of the log-in program. The default log-in program is @item @code{login-arguments} (default: @code{'("-p")}) A list of arguments to pass to @command{login}. +@item @code{auto-login} (default: @code{#f}) +When passed a login name, as a string, the specified user will be logged +in automatically without prompting for their login name or password. + @item @code{hardware-acceleration?} (default: #f) Whether to use hardware acceleration. diff --git a/gnu/services/base.scm b/gnu/services/base.scm index 5b30cedde..3409bd352 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -6,6 +6,7 @@ ;;; Copyright © 2016, 2017 Leo Famulari ;;; Copyright © 2016 David Craven ;;; Copyright © 2016 Ricardo Wurmus +;;; Copyright © 2018 Mathieu Othacehe ;;; ;;; This file is part of GNU Guix. ;;; @@ -2040,6 +2041,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 @@ -2051,6 +2054,7 @@ 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 @@ -2059,7 +2063,11 @@ This service is not part of @var{%base-services}." "--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") -- cgit v1.3 From dcb45127e01ce2eeabc9270b64e817aa1d644672 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 7 Nov 2018 16:01:17 +0100 Subject: services: cuirass: Add 'ttl' configuration field. * gnu/services/cuirass.scm ()[ttl]: New field. (cuirass-shepherd-service): Honor it. --- doc/guix.texi | 5 +++++ gnu/services/cuirass.scm | 6 +++++- 2 files changed, 10 insertions(+), 1 deletion(-) (limited to 'gnu/services') diff --git a/doc/guix.texi b/doc/guix.texi index 53aee4a14..d021875bb 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -18672,6 +18672,11 @@ Cuirass jobs. Location of sqlite database which contains the build results and previously added specifications. +@item @code{ttl} (default: @code{(* 30 24 3600)}) +Specifies the time-to-live (TTL) in seconds of garbage collector roots that +are registered for build results. This means that build results are protected +from garbage collection for at least @var{ttl} seconds. + @item @code{port} (default: @code{8081}) Port number used by the HTTP server. diff --git a/gnu/services/cuirass.scm b/gnu/services/cuirass.scm index 496b2d06c..36e90fc82 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 -;;; Copyright © 2016, 2017 Ludovic Courtès +;;; Copyright © 2016, 2017, 2018 Ludovic Courtès ;;; Copyright © 2017 Mathieu Othacehe ;;; Copyright © 2017 Jan Nieuwenhuizen ;;; Copyright © 2018 Ricardo Wurmus @@ -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) -- cgit v1.3 From ec868631136d19ca3748e2f6f82d157f943cd7ee Mon Sep 17 00:00:00 2001 From: Stefan Stefanović Date: Wed, 7 Nov 2018 16:37:34 +0100 Subject: services: elogind: Fix spelling errors of left value fields in elogind config file. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/services/desktop.scm (elogind-configuration-file)[ini-file]: Fix spelling of left value fields: InhibitDelayMaxSecs, HoldoffTimeoutSecs, IdleActionSeconds, RemoveIpc. Signed-off-by: Ludovic Courtès --- gnu/services/desktop.scm | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'gnu/services') diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm index e038f9768..47d1096c6 100644 --- a/gnu/services/desktop.scm +++ b/gnu/services/desktop.scm @@ -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)) -- cgit v1.3 From 8d9bb4b4d05a20bef1cf7b1da2b1c5fb05f9b071 Mon Sep 17 00:00:00 2001 From: Clément Lassieur Date: Sat, 10 Nov 2018 15:14:28 +0100 Subject: services: dovecot: Allow to set 'client-limit'. * doc/guix.texi (Mail Services): Update accordingly. * gnu/services/mail.scm (service-configuration)[client-limit]: New field. (dovecot-configuration)[services]: Set 'client-limit' to its correct default value. --- doc/guix.texi | 10 ++++++++++ gnu/services/mail.scm | 27 ++++++++++++++++++++++----- 2 files changed, 32 insertions(+), 5 deletions(-) (limited to 'gnu/services') diff --git a/doc/guix.texi b/doc/guix.texi index 441b65bca..d4178ce9e 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -14349,6 +14349,16 @@ Defaults to @samp{#t}. @end deftypevr +@deftypevr {@code{service-configuration} parameter} non-negative-integer client-limit +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. + +Defaults to @samp{0}. + +@end deftypevr + @deftypevr {@code{service-configuration} parameter} non-negative-integer service-count Number of connections to handle before starting a new process. Typically the only useful values are 0 (unlimited) or 1. 1 is more diff --git a/gnu/services/mail.scm b/gnu/services/mail.scm index 573efa043..abc1c15cf 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 -;;; Copyright © 2017 Clément Lassieur +;;; Copyright © 2017, 2018 Clément Lassieur ;;; Copyright © 2017 Carlo Zancanaro ;;; Copyright © 2017 Tobias Geerinckx-Rice ;;; @@ -290,6 +290,12 @@ 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. @@ -475,6 +481,7 @@ complex, customize the address and port fields of the (list (service-configuration (kind "imap-login") + (client-limit 0) (listeners (list (inet-listener-configuration (protocol "imap") (port 143) (ssl? #f)) @@ -487,10 +494,15 @@ 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) (listeners (list (unix-listener-configuration (path "lmtp") (mode "0666"))))) - (service-configuration (kind "imap")) - (service-configuration (kind "pop3")) + (service-configuration + (kind "imap") + (client-limit 1)) + (service-configuration + (kind "pop3") + (client-limit 1)) (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 @@ -501,10 +513,15 @@ complex, customize the address and port fields of the ;; is the default for all other services. As a hack, bump this value to ;; 30. (service-count 30) + (client-limit 0) (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)) + (service-configuration + (kind "dict") + (client-limit 1) (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 -- cgit v1.3 From be8dd4a5fec804f2f004dd3a87c2872af44dc88d Mon Sep 17 00:00:00 2001 From: Clément Lassieur Date: Sat, 10 Nov 2018 18:45:27 +0100 Subject: services: dovecot: Allow to set 'process-limit'. * doc/guix.texi (Mail Services): Update accordingly. * gnu/services/mail.scm (service-configuration)[process-limit]: New field. (dovecot-configuration)[services]: Set 'process-limit' to its correct default value. --- doc/guix.texi | 9 +++++++++ gnu/services/mail.scm | 17 ++++++++++++++--- 2 files changed, 23 insertions(+), 3 deletions(-) (limited to 'gnu/services') diff --git a/doc/guix.texi b/doc/guix.texi index d4178ce9e..c74351dd8 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -14364,6 +14364,15 @@ 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. . Defaults to @samp{1}. + +@end deftypevr + +@deftypevr {@code{service-configuration} parameter} non-negative-integer process-limit +Maximum number of processes that can exist for this service. If set to +0, @code{default-process-limit} is used instead. + +Defaults to @samp{0}. + @end deftypevr @deftypevr {@code{service-configuration} parameter} non-negative-integer process-min-avail diff --git a/gnu/services/mail.scm b/gnu/services/mail.scm index abc1c15cf..dfbdf6d6c 100644 --- a/gnu/services/mail.scm +++ b/gnu/services/mail.scm @@ -301,6 +301,10 @@ used instead.") "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. .") + (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.") @@ -482,6 +486,7 @@ complex, customize the address and port fields of the (service-configuration (kind "imap-login") (client-limit 0) + (process-limit 0) (listeners (list (inet-listener-configuration (protocol "imap") (port 143) (ssl? #f)) @@ -495,14 +500,17 @@ complex, customize the address and port fields of the (service-configuration (kind "lmtp") (client-limit 1) + (process-limit 0) (listeners (list (unix-listener-configuration (path "lmtp") (mode "0666"))))) (service-configuration (kind "imap") - (client-limit 1)) + (client-limit 1) + (process-limit 1024)) (service-configuration (kind "pop3") - (client-limit 1)) + (client-limit 1) + (process-limit 1024)) (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 @@ -514,14 +522,17 @@ complex, customize the address and port fields of the ;; 30. (service-count 30) (client-limit 0) + (process-limit 1) (listeners (list (unix-listener-configuration (path "auth-userdb"))))) (service-configuration (kind "auth-worker") - (client-limit 1)) + (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 -- cgit v1.3 From a7553a7360ac07ff114b807fc3026f08158d34c8 Mon Sep 17 00:00:00 2001 From: Clément Lassieur Date: Sat, 10 Nov 2018 18:37:55 +0100 Subject: services: dovecot: Set correct default value for the "auth" service. * gnu/services/mail.scm (dovecot-configuration): Set 'service-count' to 0 for the "auth" service. --- gnu/services/mail.scm | 13 +++---------- 1 file changed, 3 insertions(+), 10 deletions(-) (limited to 'gnu/services') diff --git a/gnu/services/mail.scm b/gnu/services/mail.scm index dfbdf6d6c..fcaedd038 100644 --- a/gnu/services/mail.scm +++ b/gnu/services/mail.scm @@ -511,16 +511,9 @@ complex, customize the address and port fields of the (kind "pop3") (client-limit 1) (process-limit 1024)) - (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 "auth") + (service-count 0) (client-limit 0) (process-limit 1) (listeners -- cgit v1.3 From 190877748eeadff475dca822847fb3a5cc4467b9 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 13 Nov 2018 10:36:37 +0100 Subject: services: mcron: Fix typo in comment. * gnu/services/mcron.scm (shepherd-schedule-action): Fix typo in comment. --- gnu/services/mcron.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'gnu/services') diff --git a/gnu/services/mcron.scm b/gnu/services/mcron.scm index 5757bf8cf..120b663e3 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. -- cgit v1.3 From d3f75179e5741db29358e3e723146fd20ec79de9 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 13 Nov 2018 11:02:13 +0100 Subject: services: nscd: Add 'invalidate' and 'statistics' actions. * gnu/services/base.scm (nscd-action-procedure, nscd-actions): New procedures. (nscd-shepherd-service): Add 'modules' and 'actions' fields. * gnu/tests/base.scm (run-basic-test)["nscd invalidate action"] ["nscd invalidate action, wrong table"]: New tests. * doc/guix.texi (Services): Mention 'herd doc nscd action'. (Base Services): Document the actions. --- doc/guix.texi | 26 ++++++++++++++++++++++++- gnu/services/base.scm | 54 ++++++++++++++++++++++++++++++++++++++++++++++----- gnu/tests/base.scm | 14 +++++++++++++ 3 files changed, 88 insertions(+), 6 deletions(-) (limited to 'gnu/services') diff --git a/doc/guix.texi b/doc/guix.texi index 4b082c5f8..0ba034e82 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -10563,11 +10563,14 @@ Start,,, shepherd, The GNU Shepherd Manual}). For example: The above command, run as @code{root}, lists the currently defined services. The @command{herd doc} command shows a synopsis of the given -service: +service and its associated actions: @example # herd doc nscd Run libc's name service cache daemon (nscd). + +# herd doc nscd action invalidate +invalidate: Invalidate the given cache--e.g., 'hosts' for host name lookups. @end example The @command{start}, @command{stop}, and @command{restart} sub-commands @@ -10965,6 +10968,27 @@ The Kmscon package to use. Return a service that runs the libc name service cache daemon (nscd) with the given @var{config}---an @code{} object. @xref{Name Service Switch}, for an example. + +For convenience, the Shepherd service for nscd provides the following actions: + +@table @code +@item invalidate +@cindex cache invalidation, nscd +@cindex nscd, cache invalidation +This invalidate the given cache. For instance, running: + +@example +herd invalidate nscd hosts +@end example + +@noindent +invalidates the host name lookup cache of nscd. + +@item statistics +Running @command{herd statistics nscd} displays information about nscd usage +and caches. +@end table + @end deffn @defvr {Scheme Variable} %nscd-default-configuration diff --git a/gnu/services/base.scm b/gnu/services/base.scm index 3409bd352..228d3c592 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -1252,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 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 @@ -1277,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. diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm index 896d4a8f8..02882f4b4 100644 --- a/gnu/tests/base.scm +++ b/gnu/tests/base.scm @@ -335,6 +335,20 @@ info --version") (x (pk 'failure x #f)))) + (test-equal "nscd invalidate action" + '(#t) ;one value, #t + (marionette-eval '(with-shepherd-action 'nscd ('invalidate "hosts") + result + result) + marionette)) + + (test-equal "nscd invalidate action, wrong table" + '(#f) ;one value, #f + (marionette-eval '(with-shepherd-action 'nscd ('invalidate "xyz") + result + result) + marionette)) + (test-equal "host not found" #f (marionette-eval -- cgit v1.3 From 662e2285f502b65600b0b5a12c040d050be8999d Mon Sep 17 00:00:00 2001 From: Arun Isaac Date: Tue, 20 Nov 2018 22:39:37 +0530 Subject: services: wesnothd: Run as wesnothd user and group. * gnu/services/games.scm (wesnothd-shepherd-service): Run as wesnothd user and group. --- gnu/services/games.scm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'gnu/services') diff --git a/gnu/services/games.scm b/gnu/services/games.scm index b9d78e078..b743f6a4b 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 -- cgit v1.3 From 0c17f72070cbfb04f311b776a080849b369aac25 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 24 Nov 2018 16:07:30 +0100 Subject: services: openssh: Install OpenSSH in the system profile. This ensures one can scp to or from the GuixSD machine that uses the service. * gnu/services/ssh.scm (openssh-service-type)[extensions]: Add PROFILE-SERVICE-TYPE extension. * gnu/system/examples/bare-bones.tmpl : Remove OPENSSH. * doc/guix.texi (Using the Configuration System): Adjust accordingly. --- doc/guix.texi | 6 +++--- gnu/services/ssh.scm | 10 +++++++++- gnu/system/examples/bare-bones.tmpl | 4 ++-- 3 files changed, 14 insertions(+), 6 deletions(-) (limited to 'gnu/services') diff --git a/doc/guix.texi b/doc/guix.texi index a2af1e9cb..917a3e9d5 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -9727,9 +9727,9 @@ environment variable---in addition to the per-user profiles provides all the tools one would expect for basic user and administrator tasks---including the GNU Core Utilities, the GNU Networking Utilities, the GNU Zile lightweight text editor, @command{find}, @command{grep}, -etc. The example above adds GNU@tie{}Screen and OpenSSH to those, -taken from the @code{(gnu packages screen)} and @code{(gnu packages ssh)} -modules (@pxref{Package Modules}). The +etc. The example above adds GNU@tie{}Screen to those, +taken from the @code{(gnu packages screen)} +module (@pxref{Package Modules}). The @code{(list package output)} syntax can be used to add a specific output of a package: diff --git a/gnu/services/ssh.scm b/gnu/services/ssh.scm index 056602248..bb94c5f41 100644 --- a/gnu/services/ssh.scm +++ b/gnu/services/ssh.scm @@ -518,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/system/examples/bare-bones.tmpl b/gnu/system/examples/bare-bones.tmpl index 889dcabe6..902dacbe5 100644 --- a/gnu/system/examples/bare-bones.tmpl +++ b/gnu/system/examples/bare-bones.tmpl @@ -3,7 +3,7 @@ (use-modules (gnu)) (use-service-modules networking ssh) -(use-package-modules screen ssh) +(use-package-modules screen) (operating-system (host-name "komputilo") @@ -40,7 +40,7 @@ %base-user-accounts)) ;; Globally-installed packages. - (packages (cons* screen openssh %base-packages)) + (packages (cons screen %base-packages)) ;; Add services to the baseline: a DHCP client and ;; an SSH server. -- cgit v1.3