02/06: installer: Check if ci.guix.gnu.org can be reached.

[guix-commits]

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

commit 4b66e6a3b9427d4d1fbd8b18636ee881b6b5a168
Author: Mathieu Othacehe <othacehe@gnu.org>
AuthorDate: Tue Dec 28 11:19:55 2021 +0100

    installer: Check if ci.guix.gnu.org can be reached.
    
    * gnu/installer.scm (installer-program): Add gnutls extension.
    * gnu/installer/newt/network.scm (wait-service-online): Check if the CI 
server
    can be reached.
---
 gnu/installer.scm              |  3 ++-
 gnu/installer/newt/network.scm | 21 +++++++++++++++++++--
 2 files changed, 21 insertions(+), 3 deletions(-)

diff --git a/gnu/installer.scm b/gnu/installer.scm
index 600fb76de0..c8b7a66cfc 100644
--- a/gnu/installer.scm
+++ b/gnu/installer.scm
@@ -44,6 +44,7 @@
   #:use-module (gnu packages linux)
   #:use-module (gnu packages ncurses)
   #:use-module (gnu packages package-management)
+  #:use-module (gnu packages tls)
   #:use-module (gnu packages xorg)
   #:use-module (gnu system locale)
   #:use-module (ice-9 match)
@@ -351,7 +352,7 @@ selected keymap."
     ;; packages …), etc. modules.
     (with-extensions (list guile-gcrypt guile-newt
                            guile-parted guile-bytestructures
-                           guile-json-3 guile-git guix)
+                           guile-json-3 guile-git guix gnutls)
       (with-imported-modules `(,@(source-module-closure
                                   `(,@modules
                                     (gnu services herd)
diff --git a/gnu/installer/newt/network.scm b/gnu/installer/newt/network.scm
index 4af7143d63..fb221483c3 100644
--- a/gnu/installer/newt/network.scm
+++ b/gnu/installer/newt/network.scm
@@ -30,6 +30,8 @@
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
   #:use-module (ice-9 match)
+  #:use-module (web client)
+  #:use-module (web response)
   #:use-module (newt)
   #:export (run-network-page))
 
@@ -119,8 +121,23 @@ network devices were found. Do you want to continue 
anyway?"))
 (define (wait-service-online)
   "Display a newt scale until connman detects an Internet access. Do
 FULL-VALUE tentatives, spaced by 1 second."
+  (define (ci-available?)
+    (dynamic-wind
+      (lambda ()
+        (sigaction SIGALRM
+          (lambda _ #f))
+        (alarm 3))
+      (lambda ()
+        (false-if-exception
+         (= (response-code
+             (http-request "https://ci.guix.gnu.org";))
+            200)))
+      (lambda ()
+        (alarm 0))))
+
   (define (online?)
-    (or (connman-online?)
+    (or (and (connman-online?)
+             (ci-available?))
         (file-exists? "/tmp/installer-assume-online")))
 
   (let* ((full-value 5))
@@ -137,7 +154,7 @@ FULL-VALUE tentatives, spaced by 1 second."
     (unless (online?)
       (run-error-page
        (G_ "The selected network does not provide access to the \
-Internet, please try again.")
+Internet and the Guix substitute server, please try again.")
        (G_ "Connection error"))
       (raise
        (condition