gnu/installer/services.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
   3 ;;; Copyright © 2019, 2022 Ludovic Courtès <ludo@gnu.org>
   4 ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
   5 ;;; Copyright © 2021 Tobias Geerinckx-Rice <me@tobias.gr>
   6 ;;; Copyright © 2021 Leo Famulari <leo@famulari.name>
   7 ;;;
   8 ;;; This file is part of GNU Guix.
   9 ;;;
  10 ;;; GNU Guix is free software; you can redistribute it and/or modify it
  11 ;;; under the terms of the GNU General Public License as published by
  12 ;;; the Free Software Foundation; either version 3 of the License, or (at
  13 ;;; your option) any later version.
  14 ;;;
  15 ;;; GNU Guix is distributed in the hope that it will be useful, but
  16 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;;; GNU General Public License for more details.
  19 ;;;
  20 ;;; You should have received a copy of the GNU General Public License
  21 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 (define-module (gnu installer services)
  24   #:use-module (guix records)
  25   #:use-module (guix read-print)
  26   #:use-module (srfi srfi-1)
  27   #:export (system-service?
  28             system-service-name
  29             system-service-type
  30             system-service-recommended?
  31             system-service-snippet
  32             system-service-packages
  33
  34             desktop-system-service?
  35
  36             %system-services
  37             system-services->configuration))
  38
  39 (define-syntax-rule (G_ str)
  40   ;; In this file, translatable strings are annotated with 'G_' so xgettext
  41   ;; catches them, but translation happens later on at run time.
  42   str)
  43
  44 (define-record-type* <system-service>
  45   system-service make-system-service
  46   system-service?
  47   (name            system-service-name)           ;string
  48   (type            system-service-type)           ;'desktop|'networking|…
  49   (recommended?    system-service-recommended?    ;Boolean
  50                    (default #f))
  51   (snippet         system-service-snippet         ;list of sexps
  52                    (default '()))
  53   (packages        system-service-packages        ;list of sexps
  54                    (default '())))
  55
  56 (define %system-services
  57   (let-syntax ((desktop-environment (syntax-rules ()
  58                                       ((_ fields ...)
  59                                        (system-service
  60                                         (type 'desktop)
  61                                         fields ...)))))
  62     (list
  63      ;; This is the list of desktop environments supported as services.
  64      (desktop-environment
  65       (name "GNOME")
  66       (snippet '((service gnome-desktop-service-type))))
  67      (desktop-environment
  68       (name "Xfce")
  69       (snippet '((service xfce-desktop-service-type))))
  70      (desktop-environment
  71       (name "MATE")
  72       (snippet '((service mate-desktop-service-type))))
  73      (desktop-environment
  74       (name "Enlightenment")
  75       (snippet '((service enlightenment-desktop-service-type))))
  76      (desktop-environment
  77       (name "Openbox")
  78       (packages '((specification->package "openbox"))))
  79      (desktop-environment
  80       (name "awesome")
  81       (packages '((specification->package "awesome"))))
  82      (desktop-environment
  83       (name "i3")
  84       (packages (map (lambda (package)
  85                        `(specification->package ,package))
  86                      '("i3-wm" "i3status" "dmenu" "st"))))
  87      (desktop-environment
  88       (name "ratpoison")
  89       (packages '((specification->package "ratpoison")
  90                   (specification->package "xterm"))))
  91      (desktop-environment
  92       (name "Emacs EXWM")
  93       (packages '((specification->package "emacs")
  94                   (specification->package "emacs-exwm")
  95                   (specification->package "emacs-desktop-environment"))))
  96
  97      ;; Networking.
  98      (system-service
  99       (name (G_ "OpenSSH secure shell daemon (sshd)"))
 100       (type 'networking)
 101       (snippet `(,(vertical-space 1)
 102                  ,(comment
 103                    (G_ "\
 104 ;; To configure OpenSSH, pass an 'openssh-configuration'
 105 ;; record as a second argument to 'service' below.\n"))
 106                  (service openssh-service-type))))
 107      (system-service
 108       (name (G_ "Tor anonymous network router"))
 109       (type 'networking)
 110       (snippet '((service tor-service-type))))
 111      (system-service
 112       (name (G_ "Mozilla NSS certificates, for HTTPS access"))
 113       (type 'networking)
 114       (packages '((specification->package "nss-certs")))
 115       (recommended? #t))
 116
 117      ;; Miscellaneous system administration services.
 118      (system-service
 119        (name (G_ "Network time service (NTP), to set the clock automatically"))
 120        (type 'administration)
 121        (recommended? #t)
 122        (snippet '((service ntp-service-type))))
 123      (system-service
 124        (name (G_ "GPM mouse daemon, to use the mouse on the console"))
 125        (type 'administration)
 126        (snippet '((service gpm-service-type))))
 127
 128      ;; Network connectivity management.
 129      (system-service
 130       (name (G_ "NetworkManager network connection manager"))
 131       (type 'network-management)
 132       (snippet '((service network-manager-service-type)
 133                  (service wpa-supplicant-service-type))))
 134      (system-service
 135       (name (G_ "Connman network connection manager"))
 136       (type 'network-management)
 137       (snippet '((service connman-service-type)
 138                  (service wpa-supplicant-service-type))))
 139      (system-service
 140       (name (G_ "DHCP client (dynamic IP address assignment)"))
 141       (type 'network-management)
 142       (snippet '((service dhcp-client-service-type))))
 143
 144      ;; Dealing with documents.
 145      (system-service
 146       (name (G_ "CUPS printing system (no Web interface by default)"))
 147       (type 'document)
 148       (snippet '((service cups-service-type)))))))
 149
 150 (define (desktop-system-service? service)
 151   "Return true if SERVICE is a desktop environment service."
 152   (eq? 'desktop (system-service-type service)))
 153
 154 (define (system-services->configuration services)
 155   "Return the configuration field for SERVICES."
 156   (let* ((snippets (append-map system-service-snippet services))
 157          (packages (append-map system-service-packages services))
 158          (desktop? (find desktop-system-service? services))
 159          (base     (if desktop?
 160                        '%desktop-services
 161                        '%base-services))
 162          (heading  (list (vertical-space 1)
 163                          (comment (G_ "\
 164 ;; Below is the list of system services.  To search for available
 165 ;; services, run 'guix system search KEYWORD' in a terminal.\n")))))
 166
 167     (if (null? snippets)
 168         `(,@(if (null? packages)
 169                 '()
 170                 `((packages (append (list ,@packages)
 171                                     %base-packages))))
 172
 173           ,@heading
 174           (services ,base))
 175         `(,@(if (null? packages)
 176                 '()
 177                 `((packages (append (list ,@packages)
 178                                     %base-packages))))
 179
 180           ,@heading
 181           (services (append (list ,@snippets
 182
 183                                   ,@(if desktop?
 184                                         ;; XXX: Assume 'keyboard-layout' is in
 185                                         ;; scope.
 186                                         `((set-xorg-configuration
 187                                            (xorg-configuration
 188                                             (keyboard-layout keyboard-layout))))
 189                                         '()))
 190
 191                             ,(vertical-space 1)
 192                             ,(comment (G_ "\
 193 ;; This is the default list of services we
 194 ;; are appending to.\n"))
 195                             ,base))))))