05/08: installer: Add page with which the wifi password can be entered.

[John Darrington]

jmd pushed a commit to branch wip-installer
in repository guix.

commit 7f84313787a0a5bf92fe1818b122f763c60bcb71
Author: John Darrington <address@hidden>
Date:   Mon Jan 2 07:04:02 2017 +0100

    installer: Add page with which the wifi password can be entered.
    
    * gnu/system/installer/passphrase.scm: New file.
    * gnu/local.mk (GNU_SYSTEM_MODULES): Add it.
    * gnu/system/installer/wireless.scm (wireless-connect): New procedure.
---
 gnu/local.mk                        |    2 +
 gnu/system/installer/passphrase.scm |  132 +++++++++++++++++++++++++++++++++++
 gnu/system/installer/wireless.scm   |  116 ++++++++++++++++--------------
 3 files changed, 197 insertions(+), 53 deletions(-)

diff --git a/gnu/local.mk b/gnu/local.mk
index 13d528b..264a006 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -9,6 +9,7 @@
 # Copyright © 2016 Adonay "adfeno" Felipe Nogueira 
<https://libreplanet.org/wiki/User:Adfeno> <address@hidden>
 # Copyright © 2016 Ricardo Wurmus <address@hidden>
 # Copyright © 2016 Ben Woodcroft <address@hidden>
+# Copyright © 2016, 2017 John Darrington <address@hidden>
 #
 # This file is part of GNU Guix.
 #
@@ -450,6 +451,7 @@ GNU_SYSTEM_MODULES =                                \
   %D%/system/installer/file-browser.scm         \
   %D%/system/installer/utils.scm                \
   %D%/system/installer/page.scm                 \
+  %D%/system/installer/passphrase.scm           \
   %D%/system/installer/configure.scm            \
   %D%/system/installer/time-zone.scm            \
   %D%/system/installer/misc.scm                 \
diff --git a/gnu/system/installer/passphrase.scm 
b/gnu/system/installer/passphrase.scm
new file mode 100644
index 0000000..f7b165b
--- /dev/null
+++ b/gnu/system/installer/passphrase.scm
@@ -0,0 +1,132 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2017 John Darrington <address@hidden>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu system installer passphrase)
+  #:use-module (gnu system installer page)
+  #:use-module (gnu system installer misc)
+  #:use-module (gnu system installer utils)
+  #:use-module (gnu system installer wireless)
+  #:use-module (gurses form)
+  #:use-module (gurses buttons)
+  #:use-module (ncurses curses)
+  #:use-module (ice-9 regex)
+
+  #:export (make-passphrase-page))
+
+(define max-length ((const 60)))
+
+(define my-fields `((passphrase   ,(N_ "Passphrase") ,max-length)))
+
+(define (make-passphrase-page parent title ifce network)
+  (let ((page
+         (make-page (page-surface parent)
+                    title
+                    passphrase-refresh
+                    passphrase-key-handler)))
+    (page-set-datum! page 'network network)
+    (page-set-datum! page 'ifce ifce)
+    page))
+
+(define (passphrase-refresh page)
+  (when (not (page-initialised? page))
+    (passphrase-init page)
+    (page-set-initialised! page #t))
+
+  (let ((form  (page-datum page 'form))
+        (text-window (page-datum page 'text-window)))
+    (clear text-window)
+    (addstr*
+     text-window
+     (gettext
+      (format #f "Enter the passphrase for the network ~a."
+              (page-datum page 'network))))
+    (refresh text-window)
+    (refresh (outer (page-wwin page)))
+    (refresh (form-window form))))
+
+(define (passphrase-key-handler page ch)
+  (let ((form  (page-datum page 'form))
+        (nav   (page-datum page 'navigation))
+        (dev   (page-datum page 'device)))
+
+    (cond
+     ((buttons-key-matches-symbol? nav ch 'back)
+      (set! page-stack (cdr page-stack))
+      ((page-refresh (car page-stack)) (car page-stack)))
+
+     ((eq? ch #\tab)
+      (form-set-enabled! form #f)
+      (buttons-select-next nav))
+
+     ((eq? ch KEY_UP)
+      (buttons-unselect-all nav)
+      (form-set-enabled! form #t))
+
+     ((eq? ch KEY_DOWN)
+      (buttons-unselect-all nav)
+      (form-set-enabled! form #t))
+
+     ((select-key? ch)
+      (wireless-connect
+       (page-datum page 'ifce)
+       (page-datum page 'network)
+       (form-get-value form 'passphrase))
+
+      (set! page-stack (cdr (cdr page-stack)))
+      ((page-refresh (car page-stack)) (car page-stack)))
+
+     (else
+      (form-enter form ch)))
+    #f))
+
+(define my-buttons `((back ,(N_ "Back") #f)))
+
+(define (passphrase-init p)
+  (let* ((s (page-surface p))
+         (pr (make-boxed-window
+              #f
+              (- (getmaxy s) 4) (- (getmaxx s) 2)
+              2 1
+              #:title (page-title p)))
+
+         (text-window (derwin (inner pr) 5 (getmaxx (inner pr))
+                              0 0))
+
+         (bwin (derwin (inner pr)
+                       3 (getmaxx (inner pr))
+                       (- (getmaxy (inner pr)) 3) 0
+                       #:panel #f))
+
+         (nav (make-buttons my-buttons 1))
+
+         (fw (derwin (inner pr)
+                     2
+                     (getmaxx (inner pr))
+                     (getmaxy text-window) 0))
+
+
+         (form (make-form my-fields)))
+
+    (page-set-datum! p 'navigation nav)
+    (page-set-datum! p 'text-window text-window)
+    (page-set-datum! p 'form form)
+
+    (form-post form fw)
+    (buttons-post nav bwin)
+    (page-set-wwin! p pr)
+    (refresh (outer pr))))
diff --git a/gnu/system/installer/wireless.scm 
b/gnu/system/installer/wireless.scm
index 65b60df..a03715a 100644
--- a/gnu/system/installer/wireless.scm
+++ b/gnu/system/installer/wireless.scm
@@ -19,6 +19,7 @@
 (define-module (gnu system installer wireless)
   #:use-module (gnu system installer page)
   #:use-module (gnu system installer ping)
+  #:use-module (gnu system installer passphrase)
   #:use-module (gnu system installer misc)
   #:use-module (gnu system installer utils)
   #:use-module (ice-9 format)
@@ -29,6 +30,7 @@
   #:use-module (guix store)
   #:use-module (guix utils)
 
+  #:export (wireless-connect)
   #:export (make-essid-page))
 
 
@@ -42,13 +44,12 @@
     page))
 
 
-(define my-buttons `((continue ,(N_ "_Continue") #t)))
+(define my-buttons `((back ,(N_ "_Back") #t)))
 
 (define (essid-page-key-handler page ch)
-
   (let ((nav  (page-datum page 'navigation))
         (menu  (page-datum page 'menu))
-       (test-window  (page-datum page 'test-window)))
+        (test-window  (page-datum page 'test-window)))
 
     (cond
      ((eq? ch KEY_RIGHT)
@@ -57,10 +58,10 @@
      ((eq? ch #\tab)
       (cond
        ((eqv? (buttons-selected nav) (1- (buttons-n-buttons nav)))
-       (buttons-unselect-all nav))
+        (buttons-unselect-all nav))
 
        (else
-       (buttons-select-next nav))))
+        (buttons-select-next nav))))
 
      ((eq? ch KEY_LEFT)
       (buttons-select-prev nav))
@@ -68,30 +69,18 @@
      ((eq? ch KEY_UP)
       (buttons-unselect-all nav))
 
+     ((buttons-key-matches-symbol? nav ch 'back)
+      (set! page-stack (cdr page-stack))
+      ((page-refresh (car page-stack)) (car page-stack)))
 
-     ((buttons-key-matches-symbol? nav ch 'continue)
-
-      (with-output-to-file "/tmp/wpa_supplicant.conf"
-        (lambda ()
-         (format #t "
-network={
-\tssid=\"~a\"
-\tkey_mgmt=WPA-PSK
-\tpsk=\"~a\"
-}
-"
-                 (assq-ref (menu-get-current-item menu) 'essid)
-                 "Passphrase")))
-
-      (and (zero? (system* "wpa_supplicant" "-c" "/tmp/wpa_supplicant.conf" 
"-i"
-               (page-datum page 'ifce)
-               "-B"))
-           (zero? (system* "dhclient" (page-datum page 'ifce))))
-
-      (delwin (outer (page-wwin page)))
-      (delwin (inner (page-wwin page)))
-
-      (set! page-stack (cdr page-stack))))
+     ((select-key? ch)
+      (let ((next (make-passphrase-page
+                   page
+                   (N_ "Passphrase entry")
+                   (page-datum page 'ifce)
+                   (assq-ref (menu-get-current-item menu) 'essid))))
+        (set! page-stack (cons next page-stack))
+        ((page-refresh next) next))))
 
 
     (std-menu-key-handler menu ch)
@@ -110,28 +99,28 @@ network={
 
 (define (essid-page-init p)
   (let* ((s (page-surface p))
-        (pr (make-boxed-window  #f
-             (- (getmaxy s) 4) (- (getmaxx s) 2)
-             2 1
-             #:title (page-title p)))
-        (text-window (derwin
-                      (inner pr)
-                      5 (getmaxx (inner pr))
-                      0 0
-                      #:panel #f))
-                       
-        (bwin (derwin (inner pr)
-                      3 (getmaxx (inner pr))
-                      (- (getmaxy (inner pr)) 3) 0
-                         #:panel #f))
-        (buttons (make-buttons my-buttons 1))
-
-        (mwin (derwin (inner pr)
-                      (- (getmaxy (inner pr)) (getmaxy text-window) 3)
-                      (- (getmaxx (inner pr)) 0)
-                      (getmaxy text-window) 0 #:panel #f))
-
-        (menu (make-menu
+         (pr (make-boxed-window  #f
+                                 (- (getmaxy s) 4) (- (getmaxx s) 2)
+                                 2 1
+                                 #:title (page-title p)))
+         (text-window (derwin
+                       (inner pr)
+                       5 (getmaxx (inner pr))
+                       0 0
+                       #:panel #f))
+
+         (bwin (derwin (inner pr)
+                       3 (getmaxx (inner pr))
+                       (- (getmaxy (inner pr)) 3) 0
+                       #:panel #f))
+         (buttons (make-buttons my-buttons 1))
+
+         (mwin (derwin (inner pr)
+                       (- (getmaxy (inner pr)) (getmaxy text-window) 3)
+                       (- (getmaxx (inner pr)) 0)
+                       (getmaxy text-window) 0 #:panel #f))
+
+         (menu (make-menu
                 ;; Present a menu of available Access points in decreasing
                 ;; order of signal strength
                 (sort
@@ -149,8 +138,8 @@ network={
                               (N_ "Clear")))))))
 
     (addstr*   text-window  (format #f
-             (gettext
-              "Select an access point to connect.")))
+                                    (gettext
+                                     "Select an access point to connect.")))
 
     (page-set-wwin! p pr)
     (page-set-datum! p 'menu menu)
@@ -160,7 +149,7 @@ network={
     (refresh (outer pr))
     (refresh text-window)
     (refresh bwin)))
-                       
+
 
 
 (use-modules (ice-9 pretty-print))
@@ -231,3 +220,24 @@ network={
                     (else
                      prev))))
           '() (scan-wifi ifce))))
+
+
+
+(define (wireless-connect ifce essid passphrase)
+  "Connect the wireless interface IFCE to the network advertising ESSID using
+the key PASSPHRASE."
+  (call-with-temporary-output-file
+   (lambda (filename port)
+     (format port "
+network={
+\tssid=\"~a\"
+\tkey_mgmt=WPA-PSK
+\tpsk=\"~a\"
+}
+"
+             essid
+             passphrase)
+     (force-output port)
+
+     (and (zero? (system* "wpa_supplicant" "-c" filename "-i" ifce "-B"))
+          (zero? (system* "dhclient" ifce))))))