mirror of
https://git.savannah.gnu.org/git/guix.git
synced 2025-01-19 14:07:01 +01:00
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.
This commit is contained in:
parent
75988317b2
commit
7d1030a635
3 changed files with 36 additions and 4 deletions
|
@ -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 @@ (define (run-desktop-environments-cbt-page)
|
|||
(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)))
|
||||
|
|
|
@ -26,6 +26,7 @@ (define-module (gnu installer services)
|
|||
system-service-snippet
|
||||
|
||||
desktop-system-service?
|
||||
networking-system-service?
|
||||
|
||||
%system-services
|
||||
system-services->configuration))
|
||||
|
@ -34,7 +35,7 @@ (define-record-type* <system-service>
|
|||
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 @@ (define %system-services
|
|||
(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))
|
||||
|
|
|
@ -215,7 +215,7 @@ (define (format-configuration steps results)
|
|||
'())))
|
||||
steps))
|
||||
(modules '((use-modules (gnu))
|
||||
(use-service-modules desktop))))
|
||||
(use-service-modules desktop networking ssh))))
|
||||
`(,@modules
|
||||
()
|
||||
(operating-system ,@configuration))))
|
||||
|
|
Loading…
Reference in a new issue