diff options
Diffstat (limited to 'gnu/installer/services.scm')
| -rw-r--r-- | gnu/installer/services.scm | 158 |
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)))))) |