diff options
author | Ludovic Courtès <ludo@gnu.org> | 2019-04-07 18:02:39 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2019-04-07 18:02:39 +0200 |
commit | 7d1030a63592aa2f94f6617786f22cfa83fb346f (patch) | |
tree | c261d44ed8da00a6795e8dbcd96fdcfa93cf0afc | |
parent | 75988317b22efee2b2719e7d559fa9ff01a9db9a (diff) | |
download | gnu-guix-7d1030a63592aa2f94f6617786f22cfa83fb346f.tar gnu-guix-7d1030a63592aa2f94f6617786f22cfa83fb346f.tar.gz |
installer: Add dialog to select networking services.
* gnu/installer/newt/services.scm (run-networking-cbt-page): New procedure.
(run-services-page): Call it.
* gnu/installer/services.scm (%system-services): Add OpenSSH and Tor.
(networking-system-service?): New procedure.
* gnu/installer/steps.scm (format-configuration): Add 'networking' and
'ssh' to the service modules.
-rw-r--r-- | gnu/installer/newt/services.scm | 19 | ||||
-rw-r--r-- | gnu/installer/services.scm | 19 | ||||
-rw-r--r-- | gnu/installer/steps.scm | 2 |
3 files changed, 36 insertions, 4 deletions
diff --git a/gnu/installer/newt/services.scm b/gnu/installer/newt/services.scm index 2cbfc5ca36..e1faf4871d 100644 --- a/gnu/installer/newt/services.scm +++ b/gnu/installer/newt/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. ;;; @@ -44,5 +45,21 @@ choose the one to use on the log-in screen.") (condition (&installer-step-abort)))))) +(define (run-networking-cbt-page) + "Run a page allowing the user to select networking services." + (run-checkbox-tree-page + #:info-text (G_ "You can now select networking services to run on your +system.") + #:title (G_ "Network service") + #:items (filter networking-system-service? %system-services) + #:item->text system-service-name + #:checkbox-tree-height 5 + #:exit-button-callback-procedure + (lambda () + (raise + (condition + (&installer-step-abort)))))) + (define (run-services-page) - (run-desktop-environments-cbt-page)) + (append (run-desktop-environments-cbt-page) + (run-networking-cbt-page))) diff --git a/gnu/installer/services.scm b/gnu/installer/services.scm index 8e482b7246..cb1ddc8de8 100644 --- a/gnu/installer/services.scm +++ b/gnu/installer/services.scm @@ -26,6 +26,7 @@ system-service-snippet desktop-system-service? + networking-system-service? %system-services system-services->configuration)) @@ -34,7 +35,7 @@ system-service make-system-service system-service? (name system-service-name) ;string - (type system-service-type) ;symbol + (type system-service-type) ;'desktop | 'networking (snippet system-service-snippet)) ;sexp ;; This is the list of desktop environments supported as services. @@ -58,12 +59,26 @@ (snippet '(service mate-desktop-service-type))) (desktop-environment (name "Enlightenment") - (snippet '(service enlightenment-desktop-service-type)))))) + (snippet '(service enlightenment-desktop-service-type))) + + ;; Networking. + (system-service + (name "OpenSSH secure shell daemon (sshd)") + (type 'networking) + (snippet '(service openssh-service-type))) + (system-service + (name "Tor anonymous network router") + (type 'networking) + (snippet '(service tor-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 (map system-service-snippet services)) diff --git a/gnu/installer/steps.scm b/gnu/installer/steps.scm index 3f0bdad4f7..96cfdd03d1 100644 --- a/gnu/installer/steps.scm +++ b/gnu/installer/steps.scm @@ -215,7 +215,7 @@ found in RESULTS." '()))) steps)) (modules '((use-modules (gnu)) - (use-service-modules desktop)))) + (use-service-modules desktop networking ssh)))) `(,@modules () (operating-system ,@configuration)))) |