diff --git a/doc/guix.texi b/doc/guix.texi
index 1ecdcd2182fac145f44e8ede5684959cd1701a37..58b9675a3f4a46c3ab4aeb8ed2ae9fc419f62490 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -10342,9 +10342,8 @@ with the default settings, for commonly encountered log files.
(operating-system
;; @dots{}
- (services (cons* (service mcron-service-type)
- (service rottlog-service-type)
- %base-services)))
+ (services (cons (service rottlog-service-type)
+ %base-services)))
@end lisp
@defvr {Scheme Variable} rottlog-service-type
@@ -18269,8 +18268,6 @@ The following example will configure the service with default values.
By default, Cgit can be accessed on port 80 (@code{http://localhost:80}).
@example
-(service nginx-service-type)
-(service fcgiwrap-service-type)
(service cgit-service-type)
@end example
diff --git a/gnu/services.scm b/gnu/services.scm
index 15fc6dcb4918f36bb8022f604b8a9f1e3a8c3d20..b020d971fd4920f233af5ac6f4f0170d1a2d7bc8 100644
--- a/gnu/services.scm
+++ b/gnu/services.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
;;;
;;; This file is part of GNU Guix.
@@ -24,6 +24,7 @@ (define-module (gnu services)
#:use-module (guix records)
#:use-module (guix profiles)
#:use-module (guix discovery)
+ #:use-module (guix combinators)
#:use-module (guix sets)
#:use-module (guix ui)
#:use-module ((guix utils) #:select (source-properties->location))
@@ -66,6 +67,7 @@ (define-module (gnu services)
simple-service
modify-services
service-back-edges
+ instantiate-missing-services
fold-services
service-error?
@@ -630,6 +632,18 @@ (define-condition-type &ambiguous-target-service-error &service-error
(service ambiguous-target-service-error-service)
(target-type ambiguous-target-service-error-target-type))
+(define (missing-target-error service target-type)
+ (raise
+ (condition (&missing-target-service-error
+ (service service)
+ (target-type target-type))
+ (&message
+ (message
+ (format #f (G_ "no target of type '~a' for service '~a'")
+ (service-type-name target-type)
+ (service-type-name
+ (service-kind service))))))))
+
(define (service-back-edges services)
"Return a procedure that, when passed a <service>, returns the list of
<service> objects that depend on it."
@@ -642,16 +656,7 @@ (define (add-edge extension edges)
((target)
(vhash-consq target service edges))
(()
- (raise
- (condition (&missing-target-service-error
- (service service)
- (target-type target-type))
- (&message
- (message
- (format #f (G_ "no target of type '~a' for service '~a'")
- (service-type-name target-type)
- (service-type-name
- (service-kind service))))))))
+ (missing-target-error service target-type))
(x
(raise
(condition (&ambiguous-target-service-error
@@ -669,6 +674,38 @@ (define (add-edge extension edges)
(lambda (node)
(reverse (vhash-foldq* cons '() node edges)))))
+(define (instantiate-missing-services services)
+ "Return SERVICES, a list, augmented with any services targeted by extensions
+and missing from SERVICES. Only service types with a default value can be
+instantiated; other missing services lead to a
+'&missing-target-service-error'."
+ (define (adjust-service-list svc result instances)
+ (fold2 (lambda (extension result instances)
+ (define target-type
+ (service-extension-target extension))
+
+ (match (vhash-assq target-type instances)
+ (#f
+ (let ((default (service-type-default-value target-type)))
+ (if (eq? &no-default-value default)
+ (missing-target-error svc target-type)
+ (let ((new (service target-type)))
+ (values (cons new result)
+ (vhash-consq target-type new instances))))))
+ (_
+ (values result instances))))
+ result
+ instances
+ (service-type-extensions (service-kind svc))))
+
+ (let ((instances (fold (lambda (service result)
+ (vhash-consq (service-kind service) service
+ result))
+ vlist-null services)))
+ (fold2 adjust-service-list
+ services instances
+ services)))
+
(define* (fold-services services
#:key (target-type system-service-type))
"Fold SERVICES by propagating their extensions down to the root of type
diff --git a/gnu/services/version-control.scm b/gnu/services/version-control.scm
index 6bf656949af46fef2e2e5ab422904d4b5cf0c582..7166ed3d4fff56dea928ca94ce403d9e4662d6ba 100644
--- a/gnu/services/version-control.scm
+++ b/gnu/services/version-control.scm
@@ -263,7 +263,11 @@ (define cgit-service-type
(list (service-extension activation-service-type
cgit-activation)
(service-extension nginx-service-type
- cgit-configuration-nginx-config)))
+ cgit-configuration-nginx-config)
+
+ ;; Make sure fcgiwrap is instantiated.
+ (service-extension fcgiwrap-service-type
+ (const #t))))
(default-value (cgit-configuration))
(description
"Run the Cgit web interface, which allows users to browse Git
diff --git a/gnu/system.scm b/gnu/system.scm
index 40e259f4301f533b7998b115331cf7a22766a411..39452304ba88e1eff90b6540826da57c8ab03f6f 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2015, 2016 Alex Kost <alezost@gmail.com>
;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
@@ -492,8 +492,9 @@ (define known-fs
(define* (operating-system-services os #:key container?)
"Return all the services of OS, including \"internal\" services that do not
explicitly appear in OS."
- (append (operating-system-user-services os)
- (essential-services os #:container? container?)))
+ (instantiate-missing-services
+ (append (operating-system-user-services os)
+ (essential-services os #:container? container?))))
;;;
diff --git a/gnu/tests/version-control.scm b/gnu/tests/version-control.scm
index c20e59985eaf5299b4402bddc7ed7e1d8ba8bd98..9882cdbe28027b4d5988eaab70dc2b38a8ef68cb 100644
--- a/gnu/tests/version-control.scm
+++ b/gnu/tests/version-control.scm
@@ -88,8 +88,6 @@ (define %cgit-os
(let ((base-os
(simple-operating-system
(dhcp-client-service)
- (service nginx-service-type)
- (service fcgiwrap-service-type)
(service cgit-service-type
(cgit-configuration
(nginx %cgit-configuration-nginx)))
diff --git a/tests/services.scm b/tests/services.scm
index ca32b565c49ad57c56baad3e0c3682ea75e58fb9..b146a0dec2a33139582d00368c44e5a2a70f0dfd 100644
--- a/tests/services.scm
+++ b/tests/services.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -122,6 +122,36 @@ (define live-service
(fold-services (list s) #:target-type t1)
#f)))
+(test-assert "instantiate-missing-services"
+ (let* ((t1 (service-type (name 't1) (extensions '())
+ (default-value 'dflt)
+ (compose concatenate)
+ (extend cons)))
+ (t2 (service-type (name 't2)
+ (extensions
+ (list (service-extension t1 list)))))
+ (s1 (service t1 'hey!))
+ (s2 (service t2 42)))
+ (and (lset= equal?
+ (list (service t1) s2)
+ (instantiate-missing-services (list s2)))
+ (equal? (list s1 s2)
+ (instantiate-missing-services (list s1 s2))))))
+
+(test-assert "instantiate-missing-services, no default value"
+ (let* ((t1 (service-type (name 't1) (extensions '())))
+ (t2 (service-type (name 't2)
+ (extensions
+ (list (service-extension t1 list)))))
+ (s (service t2 42)))
+ (guard (c ((missing-target-service-error? c)
+ (and (eq? (missing-target-service-error-target-type c)
+ t1)
+ (eq? (missing-target-service-error-service c)
+ s))))
+ (instantiate-missing-services (list s))
+ #f)))
+
(test-assert "shepherd-service-lookup-procedure"
(let* ((s1 (shepherd-service (provision '(s1 s1b)) (start #f)))
(s2 (shepherd-service (provision '(s2 s2b)) (start #f)))