Merge branch 'master' into core-updates

1 files changed, 123 insertions, 35 deletions

diff --git a/gnu/installer/services.scm b/gnu/installer/services.scm
index ed44b87682..fbfcdac4e5 100644
--- a/gnu/installer/services.scm
+++ b/gnu/installer/services.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -18,42 +19,129 @@
 
 (define-module (gnu installer services)
   #:use-module (guix records)
-  #:export (<desktop-environment>
-            desktop-environment
-            make-desktop-environment
-            desktop-environment-name
-            desktop-environment-snippet
+  #:use-module (srfi srfi-1)
+  #:export (system-service?
+            system-service-name
+            system-service-type
+            system-service-recommended?
+            system-service-snippet
+            system-service-packages
 
-            %desktop-environments
-            desktop-environments->configuration))
+            desktop-system-service?
+            networking-system-service?
 
-(define-record-type* <desktop-environment>
-  desktop-environment make-desktop-environment
-  desktop-environment?
-  (name            desktop-environment-name) ;string
-  (snippet         desktop-environment-snippet)) ;symbol
+            %system-services
+            system-services->configuration))
+
+(define-record-type* <system-service>
+  system-service make-system-service
+  system-service?
+  (name            system-service-name)           ;string
+  (type            system-service-type)           ;'desktop | 'networking
+  (recommended?    system-service-recommended?    ;Boolean
+                   (default #f))
+  (snippet         system-service-snippet         ;list of sexps
+                   (default '()))
+  (packages        system-service-packages        ;list of sexps
+                   (default '())))
 
 ;; This is the list of desktop environments supported as services.
-(define %desktop-environments
-  (list
-   (desktop-environment
-    (name "GNOME")
-    (snippet '(gnome-desktop-service)))
-   (desktop-environment
-    (name "Xfce")
-    (snippet '(xfce-desktop-service)))
-   (desktop-environment
-    (name "MATE")
-    (snippet '(mate-desktop-service)))
-   (desktop-environment
-    (name "Enlightenment")
-    (snippet '(service enlightenment-desktop-service-type)))))
-
-(define (desktop-environments->configuration desktop-environments)
-  "Return the configuration field for DESKTOP-ENVIRONMENTS."
-  (let ((snippets
-         (map desktop-environment-snippet desktop-environments)))
-    `(,@(if (null? snippets)
-            '()
-            `((services (cons* ,@snippets
-                               %desktop-services)))))))
+(define %system-services
+  (let-syntax ((desktop-environment (syntax-rules ()
+                                      ((_ fields ...)
+                                       (system-service
+                                        (type 'desktop)
+                                        fields ...))))
+               (G_ (syntax-rules ()               ;for xgettext
+                     ((_ str) str))))
+    (list
+     (desktop-environment
+      (name "GNOME")
+      (snippet '((service gnome-desktop-service-type))))
+     (desktop-environment
+      (name "Xfce")
+      (snippet '((service xfce-desktop-service-type))))
+     (desktop-environment
+      (name "MATE")
+      (snippet '((service mate-desktop-service-type))))
+     (desktop-environment
+      (name "Enlightenment")
+      (snippet '((service enlightenment-desktop-service-type))))
+     (desktop-environment
+      (name "Openbox")
+      (packages '((specification->package "openbox"))))
+     (desktop-environment
+      (name "awesome")
+      (packages '((specification->package "awesome"))))
+     (desktop-environment
+      (name "i3")
+      (packages '((specification->package "i3-wm"))))
+     (desktop-environment
+      (name "ratpoison")
+      (packages '((specification->package "ratpoison"))))
+
+     ;; Networking.
+     (system-service
+      (name (G_ "OpenSSH secure shell daemon (sshd)"))
+      (type 'networking)
+      (snippet '((service openssh-service-type))))
+     (system-service
+      (name (G_ "Tor anonymous network router"))
+      (type 'networking)
+      (snippet '((service tor-service-type))))
+     (system-service
+      (name (G_ "Mozilla NSS certificates, for HTTPS access"))
+      (type 'networking)
+      (packages '((specification->package "nss-certs")))
+      (recommended? #t))
+
+     ;; Network connectivity management.
+     (system-service
+      (name (G_ "NetworkManager network connection manager"))
+      (type 'network-management)
+      (snippet '((service network-manager-service-type)
+                 (service wpa-supplicant-service-type))))
+     (system-service
+      (name (G_ "Connman network connection manager"))
+      (type 'network-management)
+      (snippet '((service connman-service-type)
+                 (service wpa-supplicant-service-type))))
+     (system-service
+      (name (G_ "DHCP client (dynamic IP address assignment)"))
+      (type 'network-management)
+      (snippet '((service dhcp-client-service-type)))))))
+
+(define (desktop-system-service? service)
+  "Return true if SERVICE is a desktop environment service."
+  (eq? 'desktop (system-service-type service)))
+
+(define (networking-system-service? service)
+  "Return true if SERVICE is a desktop environment service."
+  (eq? 'networking (system-service-type service)))
+
+(define (system-services->configuration services)
+  "Return the configuration field for SERVICES."
+  (let* ((snippets (append-map system-service-snippet services))
+         (packages (append-map system-service-packages services))
+         (desktop? (find desktop-system-service? services))
+         (base     (if desktop?
+                       '%desktop-services
+                       '%base-services)))
+    (if (null? snippets)
+        `(,@(if (null? packages)
+                '()
+                `((packages (list ,@packages))))
+          (services ,base))
+        `(,@(if (null? packages)
+                '()
+                `((packages (list ,@packages))))
+          (services (append (list ,@snippets
+
+                                  ,@(if desktop?
+                                        ;; XXX: Assume 'keyboard-layout' is in
+                                        ;; scope.
+                                        '((set-xorg-configuration
+                                           (xorg-configuration
+                                            (keyboard-layout keyboard-layout))))
+                                        '()))
+                           ,base))))))