aboutsummaryrefslogtreecommitdiff
path: root/gnu/installer
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/installer')
-rw-r--r--gnu/installer/locale.scm21
-rw-r--r--gnu/installer/newt/locale.scm24
-rw-r--r--gnu/installer/newt/network.scm4
-rw-r--r--gnu/installer/newt/services.scm37
-rw-r--r--gnu/installer/newt/welcome.scm8
-rw-r--r--gnu/installer/services.scm120
-rw-r--r--gnu/installer/steps.scm2
7 files changed, 152 insertions, 64 deletions
diff --git a/gnu/installer/locale.scm b/gnu/installer/locale.scm
index 2b45b2200a..284062a6e7 100644
--- a/gnu/installer/locale.scm
+++ b/gnu/installer/locale.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.
;;;
@@ -69,6 +70,24 @@
(codeset . ,(match:substring matches 5))
(modifier . ,(match:substring matches 7)))))
+(define (normalize-codeset codeset)
+ "Compute the \"normalized\" variant of CODESET."
+ ;; info "(libc) Using gettextized software", for the algorithm used to
+ ;; compute the normalized codeset.
+ (letrec-syntax ((-> (syntax-rules ()
+ ((_ proc value)
+ (proc value))
+ ((_ proc rest ...)
+ (proc (-> rest ...))))))
+ (-> (lambda (str)
+ (if (string-every char-set:digit str)
+ (string-append "iso" str)
+ str))
+ string-downcase
+ (lambda (str)
+ (string-filter char-set:letter+digit str))
+ codeset)))
+
(define (locale->locale-string locale)
"Reverse operation of locale-string->locale."
(let ((language (locale-language locale))
@@ -81,7 +100,7 @@
`("_" ,territory)
'())
,@(if codeset
- `("." ,codeset)
+ `("." ,(normalize-codeset codeset))
'())
,@(if modifier
`("@" ,modifier)
diff --git a/gnu/installer/newt/locale.scm b/gnu/installer/newt/locale.scm
index 4fa07df81e..b819d06691 100644
--- a/gnu/installer/newt/locale.scm
+++ b/gnu/installer/newt/locale.scm
@@ -33,14 +33,8 @@
(let ((title (G_ "Locale language")))
(run-listbox-selection-page
#:title title
- #:info-text (G_ "Choose the locale's language to be used for the \
-installation process. A locale is a regional variant of your language \
-encompassing number, date and currency format, among other details.
-
-Based on the language you choose, you will possibly be asked to \
-select a locale's territory, codeset and modifier in the next \
-steps. The locale will also be used as the default one for the \
-installed system.")
+ #:info-text (G_ "Choose the language to use for the \
+installation process and for the installed system.")
#:info-textbox-width 70
#:listbox-items languages
#:listbox-item->text language->text
@@ -56,8 +50,7 @@ installed system.")
(let ((title (G_ "Locale location")))
(run-listbox-selection-page
#:title title
- #:info-text (G_ "Choose your locale's location. This is a shortlist of \
-locations based on the language you selected.")
+ #:info-text (G_ "Choose a territory for this language.")
#:listbox-items territories
#:listbox-item->text territory->text
#:button-text (G_ "Back")
@@ -71,8 +64,7 @@ locations based on the language you selected.")
(let ((title (G_ "Locale codeset")))
(run-listbox-selection-page
#:title title
- #:info-text (G_ "Choose your locale's codeset. If UTF-8 is available, \
- it should be preferred.")
+ #:info-text (G_ "Choose the locale encoding.")
#:listbox-items codesets
#:listbox-item->text identity
#:listbox-default-item "UTF-8"
@@ -191,9 +183,11 @@ glibc locale string and return it."
;; narrow down the search of a locale.
(break-on-locale-found locales)
- ;; Otherwise, ask for a codeset.
- (run-codeset-page
- (delete-duplicates (map locale-codeset locales)))))))
+ ;; Otherwise, choose a codeset.
+ (let ((codesets (delete-duplicates (map locale-codeset locales))))
+ (if (member "UTF-8" codesets)
+ "UTF-8" ;don't even ask
+ (run-codeset-page codesets)))))))
(installer-step
(id 'modifier)
(compute
diff --git a/gnu/installer/newt/network.scm b/gnu/installer/newt/network.scm
index f13176dc61..37a2a45411 100644
--- a/gnu/installer/newt/network.scm
+++ b/gnu/installer/newt/network.scm
@@ -59,7 +59,7 @@ Internet and return the selected technology. For now, only technologies with
(G_ "Internet access")
(G_ "Continue")
(G_ "Exit")
- (G_ "The install process requires an internet access, but no \
+ (G_ "The install process requires Internet access but no \
network device were found. Do you want to continue anyway?"))
((1) (raise
(condition
@@ -68,7 +68,7 @@ network device were found. Do you want to continue anyway?"))
(condition
(&installer-step-abort)))))
(run-listbox-selection-page
- #:info-text (G_ "The install process requires an internet access.\
+ #:info-text (G_ "The install process requires Internet access.\
Please select a network device.")
#:title (G_ "Internet access")
#:listbox-items items
diff --git a/gnu/installer/newt/services.scm b/gnu/installer/newt/services.scm
index 6bcb6244ae..10c19115ca 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.
;;;
@@ -32,11 +33,33 @@
environments."
(run-checkbox-tree-page
#:info-text (G_ "Please select the desktop(s) environment(s) you wish to \
-install. If you select multiple desktops environments, we will be able to \
-choose the one to use on the log-in screen with F1.")
+install. If you select multiple desktops environments, you will be able to \
+choose the one to use on the log-in screen.")
#:title (G_ "Desktop environment")
- #:items %desktop-environments
- #:item->text desktop-environment-name
+ #:items (filter desktop-system-service? %system-services)
+ #:item->text system-service-name ;no i18n for DE names
+ #:checkbox-tree-height 5
+ #:exit-button-callback-procedure
+ (lambda ()
+ (raise
+ (condition
+ (&installer-step-abort))))))
+
+(define (run-networking-cbt-page network-management?)
+ "Run a page allowing the user to select networking services. When
+NETWORK-MANAGEMENT? is true, include network management services like
+NetworkManager."
+ (run-checkbox-tree-page
+ #:info-text (G_ "You can now select networking services to run on your \
+system.")
+ #:title (G_ "Network service")
+ #:items (filter (let ((types (if network-management?
+ '(network-management networking)
+ '(networking))))
+ (lambda (service)
+ (memq (system-service-type service) types)))
+ %system-services)
+ #:item->text (compose G_ system-service-name)
#:checkbox-tree-height 5
#:exit-button-callback-procedure
(lambda ()
@@ -45,4 +68,8 @@ choose the one to use on the log-in screen with F1.")
(&installer-step-abort))))))
(define (run-services-page)
- (run-desktop-environments-cbt-page))
+ (let ((desktop (run-desktop-environments-cbt-page)))
+ ;; When the user did not select any desktop services, and thus didn't get
+ ;; '%desktop-services', offer network management services.
+ (append desktop
+ (run-networking-cbt-page (null? desktop)))))
diff --git a/gnu/installer/newt/welcome.scm b/gnu/installer/newt/welcome.scm
index b0b5429c0f..aec3e7a612 100644
--- a/gnu/installer/newt/welcome.scm
+++ b/gnu/installer/newt/welcome.scm
@@ -95,9 +95,11 @@ installation and reboot."
(G_ "GNU Guix install")
(G_ "Welcome to GNU Guix system installer!
-Please note that the present graphical installer is still under heavy \
-development, so you might want to prefer using the shell based process. \
-The documentation is accessible at any time by pressing CTRL-ALT-F2.")
+You will be guided through a graphical installation program.
+
+If you are familiar with GNU/Linux and you want tight control over \
+the installation process, you can instead choose manual installation. \
+Documentation is accessible at any time by pressing Ctrl-Alt-F2.")
logo
#:listbox-items
`((,(G_ "Graphical install using a terminal based interface")
diff --git a/gnu/installer/services.scm b/gnu/installer/services.scm
index 2b6625f6af..46ade0f8fa 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,44 +19,89 @@
(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-snippet
- %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
+ (snippet system-service-snippet)) ;sexp
;; This is the list of desktop environments supported as services.
-(define %desktop-environments
- (list
- (desktop-environment
- (name "GNOME")
- (snippet '(service gnome-desktop-service-type)))
- (desktop-environment
- (name "Xfce")
- ;; TODO: Use 'xfce-desktop-service-type' when the 'guix' package provides
- ;; it with a default value.
- (snippet '(xfce-desktop-service)))
- (desktop-environment
- (name "MATE")
- (snippet '(service mate-desktop-service-type)))
- (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")
+ ;; TODO: Use 'xfce-desktop-service-type' when the 'guix' package provides
+ ;; it with a default value.
+ (snippet '(xfce-desktop-service)))
+ (desktop-environment
+ (name "MATE")
+ (snippet '(service mate-desktop-service-type)))
+ (desktop-environment
+ (name "Enlightenment")
+ (snippet '(service enlightenment-desktop-service-type)))
+
+ ;; 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)))
+
+ ;; Network connectivity management.
+ (system-service
+ (name (G_ "NetworkManager network connection manager"))
+ (type 'network-management)
+ (snippet '(service network-manager-service-type)))
+ (system-service
+ (name (G_ "Connman network connection manager"))
+ (type 'network-management)
+ (snippet '(service connman-service-type)))
+ (system-service
+ (name (G_ "DHCP client (dynamic IP address assignment)"))
+ (type 'network-management)
+ (snippet '(service dhcp-client-service))))))
+
+(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))
+ (desktop? (find desktop-system-service? services))
+ (base (if desktop?
+ '%desktop-services
+ '%base-services)))
+ (if (null? snippets)
+ `((services ,base))
+ `((services (cons* ,@snippets ,base))))))
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))))