summary refs log tree commit diff
path: root/gnu/installer
diff options
context:
space:
mode:
authorMarius Bakke <mbakke@fastmail.com>2019-04-08 00:54:01 +0200
committerMarius Bakke <mbakke@fastmail.com>2019-04-08 00:54:01 +0200
commitba00235a9652bb129ff6867ffc3c7cfafe1cca09 (patch)
tree1ce56f512707e89362e1fed3d5b26d690462fbda /gnu/installer
parentf19ccdc62ca721b68745c35b046826b356f46c62 (diff)
parent0e2b0b05accdea7c3f016f8483d0ec04021114d3 (diff)
downloadguix-ba00235a9652bb129ff6867ffc3c7cfafe1cca09.tar.gz
Merge branch 'master' into staging
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))))