aboutsummaryrefslogtreecommitdiff
path: root/gnu
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2019-04-07 18:02:39 +0200
committerLudovic Courtès <ludo@gnu.org>2019-04-07 18:02:39 +0200
commit7d1030a63592aa2f94f6617786f22cfa83fb346f (patch)
treec261d44ed8da00a6795e8dbcd96fdcfa93cf0afc /gnu
parent75988317b22efee2b2719e7d559fa9ff01a9db9a (diff)
downloadguix-7d1030a63592aa2f94f6617786f22cfa83fb346f.tar
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.
Diffstat (limited to 'gnu')
-rw-r--r--gnu/installer/newt/services.scm19
-rw-r--r--gnu/installer/services.scm19
-rw-r--r--gnu/installer/steps.scm2
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))))