[bug#59003] [PATCH 0/7] [Installer] Warn about unsupported devices

[bug#59003] [PATCH 0/7] [Installer] Warn about unsupported devices

[Ludovic Courtès]

Hello Guix!

As discussed at <https://issues.guix.gnu.org/58357>, this patch
series is an attempt to improve user experience by having the
installer warn early on about devices that are known to not be
supported by free software.

Currently only one such device is listed (Intel WiFi, the ‘iwlwifi’
Linux module) but I count on you, dear reader, to suggest a few
more.  What’s particularly important here are things that will
lead to important loss of functionality: WiFi, Ethernet, sound
support, graphics, etc.  Newer laptops are known to require
non-free firmware a range of devices¹ and it would be nice to
cover the important ones.

Thoughts?

Ludo’.

¹ https://blog.einval.com/2022/04/19#firmware-what-do-we-do

Ludovic Courtès (7):
  installer: Warn about hardware support after the welcome page.
  linux-modules: Add support for listing PCI devices.
  linux-modules: Add 'load-pci-device-database'.
  installer: Use 'current-guix' for extensions.
  installer: Error page width is parameterized.
  installer: Report known-unsupported PCI devices.
  installer: Remove unused variable.

 gnu/build/linux-modules.scm    | 135 ++++++++++++++++++++++++++++-
 gnu/installer.scm              |   8 +-
 gnu/installer/newt.scm         |   8 +-
 gnu/installer/newt/page.scm    |  12 +--
 gnu/installer/newt/welcome.scm | 153 ++++++++++++++++++++++++---------
 gnu/installer/record.scm       |   2 +-
 6 files changed, 260 insertions(+), 58 deletions(-)


base-commit: 973dc4564e874107ac56d39ece2a2224cf926fe6
-- 
2.38.0

[bug#59003] [PATCH 1/7] installer: Warn about hardware support after the welcome page.

[Ludovic Courtès]

This is a followup to 682639c107908426fe6bf0a1b8404b98b7820290, which
added the uvesafb upfront, before welcome page hard been displayed.

* gnu/installer/newt/welcome.scm (check-hardware-support): New
procedure.
(run-welcome-page): Use it.
---
 gnu/installer/newt/welcome.scm | 85 ++++++++++++++++++----------------
 1 file changed, 44 insertions(+), 41 deletions(-)

diff --git a/gnu/installer/newt/welcome.scm b/gnu/installer/newt/welcome.scm
index 326996b005..1c7372b3be 100644
--- a/gnu/installer/newt/welcome.scm
+++ b/gnu/installer/newt/welcome.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
-;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2020, 2022 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2022 Florian Pelz <pelzflorian@pelzflorian.de>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -121,55 +121,58 @@ (define (choice->item str)
         (lambda ()
           (destroy-form-and-pop form))))))
 
-(define (run-welcome-page logo)
-  "Run a welcome page with the given textual LOGO displayed at the center of
-the page. Ask the user to choose between manual installation, graphical
-installation and reboot."
-  (begin
-    (when (member "uvesafb" (modules-loaded))
-      (run-error-page (G_ "\
+(define (check-hardware-support)
+  "Warn about unsupported devices."
+  (when (member "uvesafb" (modules-loaded))
+    (run-error-page (G_ "\
 This may be a false alarm, but possibly your graphics hardware does not
 work well with only free software.  Expect trouble.  If after installation,
 the system does not boot, perhaps you will need to add nomodeset to the
 kernel arguments and need to configure the uvesafb kernel module.")
-                      (G_ "Pre-install warning")))
-    (when (file-exists? %core-dump)
-      (match
-          (choice-window
-           (G_ "Previous installation failed")
-           (G_ "Continue")
-           (G_ "Report the failure")
-           (G_ "It seems that the previous installation exited unexpectedly \
+                    (G_ "Pre-install warning"))))
+
+(define (run-welcome-page logo)
+  "Run a welcome page with the given textual LOGO displayed at the center of
+the page. Ask the user to choose between manual installation, graphical
+installation and reboot."
+  (when (file-exists? %core-dump)
+    (match (choice-window
+            (G_ "Previous installation failed")
+            (G_ "Continue")
+            (G_ "Report the failure")
+            (G_ "It seems that the previous installation exited unexpectedly \
 and generated a core dump.  Do you want to continue or to report the failure \
 first?"))
-        (1 #t)
-        (2 (raise
-            (condition
-             (&user-abort-error))))))
-    (run-menu-page
-     (G_ "GNU Guix install")
-     (G_ "Welcome to GNU Guix system installer!
+      (1 #t)
+      (2 (raise
+          (condition
+           (&user-abort-error))))))
+
+  (run-menu-page
+   (G_ "GNU Guix install")
+   (G_ "Welcome to GNU Guix system installer!
 
 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")
-        .
-        ,(const #t))
-       (,(G_ "Install using the shell based process")
-        .
-        ,(lambda ()
-           ;; Switch to TTY3, where a root shell is available for shell based
-           ;; install. The other root TTY's would have been ok too.
-           (system* "chvt" "3")
-           (run-welcome-page logo)))
-       (,(G_ "Reboot")
-        .
-        ,(lambda ()
-           (newt-finish)
-           (reboot))))
-     #:listbox-item->text car)))
+   logo
+   #:listbox-items
+   `((,(G_ "Graphical install using a terminal based interface")
+      .
+      ,check-hardware-support)
+     (,(G_ "Install using the shell based process")
+      .
+      ,(lambda ()
+         (check-hardware-support)
+         ;; Switch to TTY3, where a root shell is available for shell based
+         ;; install. The other root TTY's would have been ok too.
+         (system* "chvt" "3")
+         (run-welcome-page logo)))
+     (,(G_ "Reboot")
+      .
+      ,(lambda ()
+         (newt-finish)
+         (reboot))))
+   #:listbox-item->text car))
-- 
2.38.0

[bug#59003] [PATCH 2/7] linux-modules: Add support for listing PCI devices.

[Ludovic Courtès]

* gnu/build/linux-modules.scm (<pci-device>): New record type.
(pci-device-class-predicate, storage-pci-device?, network-pci-device?)
(display-pci-device?, pci-devices?): New procedures.
---
 gnu/build/linux-modules.scm | 61 ++++++++++++++++++++++++++++++++++++-
 1 file changed, 60 insertions(+), 1 deletion(-)

diff --git a/gnu/build/linux-modules.scm b/gnu/build/linux-modules.scm
index 053720574b..09cf752bef 100644
--- a/gnu/build/linux-modules.scm
+++ b/gnu/build/linux-modules.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2016, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2016, 2018, 2019, 2022 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2018 Danny Milosavljevic <dannym@scratchpost.org>
 ;;;
@@ -28,6 +28,7 @@ (define-module (gnu build linux-modules)
   #:use-module (rnrs io ports)
   #:use-module (rnrs bytevectors)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9 gnu)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
   #:use-module (ice-9 ftw)
@@ -50,6 +51,16 @@ (define-module (gnu build linux-modules)
             load-linux-module*
             load-linux-modules-from-directory
 
+            pci-devices
+            pci-device?
+            pci-device-vendor
+            pci-device-id
+            pci-device-class
+            pci-device-module-alias
+            storage-pci-device?
+            network-pci-device?
+            display-pci-device?
+
             current-module-debugging-port
 
             device-module-aliases
@@ -429,6 +440,54 @@ (define (read-uevent port)
       (line
        (loop (cons (key=value->pair line) result))))))
 
+;; PCI device known to the Linux kernel.
+(define-immutable-record-type <pci-device>
+  (pci-device vendor device class module-alias)
+  pci-device?
+  (vendor       pci-device-vendor)                ;integer
+  (device       pci-device-id)                    ;integer
+  (class        pci-device-class)                 ;integer
+  (module-alias pci-device-module-alias))         ;string | #f
+
+(define (pci-device-class-predicate mask bits)
+  (lambda (device)
+    "Return true if DEVICE has the chosen class."
+    (= (logand mask (pci-device-class device)) bits)))
+
+(define storage-pci-device?                   ;"Mass storage controller" class
+  (pci-device-class-predicate #xff0000 #x010000))
+(define network-pci-device?                       ;"Network controller" class
+  (pci-device-class-predicate #xff0000 #x020000))
+(define display-pci-device?                       ;"Display controller" class
+  (pci-device-class-predicate #xff0000 #x030000))
+
+(define (pci-devices)
+  "Return the list of PCI devices of the system (<pci-device> records)."
+  (define (read-hex port)
+    (let ((line (read-line port)))
+      (and (string? line)
+           (string-prefix? "0x" line)
+           (string->number (string-drop line 2) 16))))
+
+  (filter-map (lambda (directory)
+                (define properties
+                  (call-with-input-file (string-append directory "/uevent")
+                    read-uevent))
+                (define vendor
+                  (call-with-input-file (string-append directory "/vendor")
+                    read-hex))
+                (define device
+                  (call-with-input-file (string-append directory "/device")
+                    read-hex))
+                (define class
+                  (call-with-input-file (string-append directory "/class")
+                    read-hex))
+
+                (pci-device vendor device class
+                            (assq-ref properties 'MODALIAS)))
+              (find-files "/sys/bus/pci/devices"
+                          #:stat lstat)))
+
 (define (device-module-aliases device)
   "Return the list of module aliases required by DEVICE, a /dev file name, as
 in this example:
-- 
2.38.0

[bug#59003] [PATCH 2/7] linux-modules: Add support for listing PCI devices.

[pelzflorian (Florian Pelz)]

Ludovic Courtès <ludo@gnu.org> writes:

> * gnu/build/linux-modules.scm (<pci-device>): New record type.
> (pci-device-class-predicate, storage-pci-device?, network-pci-device?)
> (display-pci-device?, pci-devices?): New procedures.

The last procedure is called pci-devices without question mark.

Regards,
Florian

[bug#59003] [PATCH 3/7] linux-modules: Add 'load-pci-device-database'.

[Ludovic Courtès]

* gnu/build/linux-modules.scm (read-pci-device-database)
(load-pci-device-database): New procedures.
---
 gnu/build/linux-modules.scm | 74 +++++++++++++++++++++++++++++++++++++
 1 file changed, 74 insertions(+)

diff --git a/gnu/build/linux-modules.scm b/gnu/build/linux-modules.scm
index 09cf752bef..3b1f512663 100644
--- a/gnu/build/linux-modules.scm
+++ b/gnu/build/linux-modules.scm
@@ -60,6 +60,7 @@ (define-module (gnu build linux-modules)
             storage-pci-device?
             network-pci-device?
             display-pci-device?
+            load-pci-device-database
 
             current-module-debugging-port
 
@@ -488,6 +489,79 @@ (define class
               (find-files "/sys/bus/pci/devices"
                           #:stat lstat)))
 
+(define (read-pci-device-database port)
+  "Parse the 'pci.ids' database that ships with the pciutils package and is
+maintained at <https://pci-ids.ucw.cz/>."
+  (define (comment? str)
+    (string-prefix? "#" (string-trim str)))
+  (define (blank? str)
+    (string-null? (string-trim-both str)))
+  (define (device? str)
+    (eqv? #\tab (string-ref str 0)))
+  (define (subvendor? str)
+    (string-prefix? "\t\t" str))
+  (define (class? str)
+    (string-prefix? "C " str))
+  (define (parse-id-line str)
+    (let* ((str   (string-trim-both str))
+           (space (string-index str char-set:whitespace)))
+      (values (string->number (string-take str space) 16)
+              (string-trim (string-drop str (+ 1 space))))))
+  (define (finish vendor vendor-id devices table)
+    (fold (lambda (device table)
+            (match device
+              ((device-id . name)
+               (vhash-consv (logior (ash vendor-id 16) device-id)
+                            (cons vendor name)
+                            table))))
+          table
+          devices))
+
+  (let loop ((table vlist-null)
+             (vendor-id #f)
+             (vendor #f)
+             (devices '()))
+    (match (read-line port)
+      ((? eof-object?)
+       (let ((table (if (and vendor vendor-id)
+                        (finish vendor vendor-id devices table)
+                        table)))
+         (lambda (vendor device)
+           (match (vhash-assv (logior (ash vendor 16) device) table)
+             (#f
+              (values #f #f))
+             ((_ . (vendor . name))
+              (values vendor name))))))
+      ((? comment?)
+       (loop table vendor-id vendor devices))
+      ((? blank?)
+       (loop table vendor-id vendor devices))
+      ((? subvendor?)                             ;currently ignored
+       (loop table vendor-id vendor devices))
+      ((? class?)                                 ;currently ignored
+       (loop table vendor-id vendor devices))
+      ((? device? line)
+       (let-values (((id name) (parse-id-line line)))
+         (loop table vendor-id vendor
+               (if (and vendor-id vendor)         ;class or device?
+                   (alist-cons id name devices)
+                   devices))))
+      (line
+       (let ((table (if (and vendor vendor-id)
+                        (finish vendor vendor-id devices table)
+                        table)))
+         (let-values (((vendor-id vendor) (parse-id-line line)))
+           (loop table vendor-id vendor '())))))))
+
+(define (load-pci-device-database file)
+  "Read the 'pci.ids' database at FILE (get it from the pciutils package or
+from <https://pci-ids.ucw.cz/>) and return a lookup procedure that takes a PCI
+vendor ID and a device ID (two integers) and returns the vendor name and
+device name as two values."
+  (let ((port (open-file file "r0")))
+    (call-with-gzip-input-port port
+      read-pci-device-database)))
+
 (define (device-module-aliases device)
   "Return the list of module aliases required by DEVICE, a /dev file name, as
 in this example:
-- 
2.38.0

[bug#59003] [PATCH 4/7] installer: Use 'current-guix' for extensions.

[Ludovic Courtès]

This lets us use the latest (gnu build linux-modules) for instance.
Note that items listed in 'with-extensions' come first in the load path,
before the directory containing the modules in 'with-imported-modules'.

* gnu/installer.scm (installer-program): Use (current-guix) instead of
'guix' in 'with-extensions'.
---
 gnu/installer.scm | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/gnu/installer.scm b/gnu/installer.scm
index 5cd1af8edf..df7625e05c 100644
--- a/gnu/installer.scm
+++ b/gnu/installer.scm
@@ -358,7 +358,7 @@ (define installer-builder
     (with-extensions (list guile-gcrypt guile-newt
                            guile-parted guile-bytestructures
                            guile-json-3 guile-git guile-webutils
-                           guix gnutls)
+                           (current-guix) gnutls)
       (with-imported-modules `(,@(source-module-closure
                                   `(,@modules
                                     (gnu services herd)
-- 
2.38.0

[bug#59003] [PATCH 4/7] installer: Use 'current-guix' for extensions.

[pelzflorian (Florian Pelz)]

Ludovic Courtès <ludo@gnu.org> writes:
> -                           guix gnutls)
> +                           (current-guix) gnutls)

This change is bad, it seems.

Having applied the patch on a local checkout on a machine which is not
in the .guix-authorizations file,

* when I run
./pre-inst-env guix system image -t iso9660 gnu/system/install.scm
breaks build for me because the commit is not authorized.  This is a bad
regression.

* when I `guix pull` with the guix channel pointing to the local
checkout,
guix system image -t iso9660 gnu/system/install.scm
produces an installer image with the old installer from the guix
package.

I haven’t fully understood (current-guix), but it seems better to update
the guix package, maybe.

Regards,
Florian

[bug#59003] [PATCH 4/7] installer: Use 'current-guix' for extensions.

[Ludovic Courtès]

Hi Florian,

"pelzflorian (Florian Pelz)" <pelzflorian@pelzflorian.de> skribis:

> Ludovic Courtès <ludo@gnu.org> writes:
>> -                           guix gnutls)
>> +                           (current-guix) gnutls)
>
> This change is bad, it seems.

Yes, it’s not great.  We could skip it provided we first upgrade the
‘guix’ package (with “make update-guix-package”) so that we get the
latest (gnu build linux-modules) module.  You can do that to test things
locally.

We’re doing:

  (with-extension (list … guix …)
    (with-imported-modules (list … guix modules …)
      …))

and it turns out that extensions take precedence in %load-path.  So
merely adding (gnu build linux-modules) to the ‘with-imported-modules’
list isn’t enough, unfortunately.

Ludo’.

[bug#59003] [PATCH 5/7] installer: Error page width is parameterized.

[Ludovic Courtès]

* gnu/installer/newt/page.scm (run-error-page): Add #:width and honor
it.
---
 gnu/installer/newt/page.scm | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/gnu/installer/newt/page.scm b/gnu/installer/newt/page.scm
index 0f508a31c0..e1623a51fd 100644
--- a/gnu/installer/newt/page.scm
+++ b/gnu/installer/newt/page.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
-;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2019, 2020, 2022 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2019 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -278,12 +278,12 @@ (define* (run-input-page text title
                    (destroy-form-and-pop form)
                    input))))))))
 
-(define (run-error-page text title)
-  "Run a page to inform the user of an error. The page contains the given TEXT
-to explain the error and an \"OK\" button to acknowledge the error. The title
-of the page is set to TITLE."
+(define* (run-error-page text title #:key (width 40))
+  "Run a page to inform the user of an error.  The page is WIDTH column wide
+and contains the given TEXT to explain the error and an \"OK\" button to
+acknowledge the error.  The title of the page is set to TITLE."
   (let* ((text-box
-          (make-reflowed-textbox -1 -1 text 40
+          (make-reflowed-textbox -1 -1 text width
                                  #:flags FLAG-BORDER))
          (grid (make-grid 1 2))
          (ok-button (make-button -1 -1 "OK"))
-- 
2.38.0

[bug#59003] [PATCH 6/7] installer: Report known-unsupported PCI devices.

[Ludovic Courtès]

* gnu/installer.scm (installer-steps): Pass #:pci-database to the
'welcome' step procedure.
* gnu/installer/newt.scm (welcome-page): Add #:pci-database and pass it
to 'run-welcome-page'.
* gnu/installer/newt/welcome.scm (%unsupported-linux-modules): New
variable.
(unsupported-pci-device?, pci-device-description): New procedures.
(check-hardware-support): Add #:pci-database.  Enumerate unsupported PCI
devices and run an error page when unsupported devices are found.
(run-welcome-page): Add #:pci-database and pass it to
'check-hardware-support'.
* gnu/installer/record.scm (<installer>)[welcome-page]: Adjust comment.
---
 gnu/installer.scm              |  6 ++-
 gnu/installer/newt.scm         |  4 +-
 gnu/installer/newt/welcome.scm | 78 +++++++++++++++++++++++++++++++---
 gnu/installer/record.scm       |  2 +-
 4 files changed, 80 insertions(+), 10 deletions(-)

diff --git a/gnu/installer.scm b/gnu/installer.scm
index df7625e05c..e1b040088b 100644
--- a/gnu/installer.scm
+++ b/gnu/installer.scm
@@ -46,6 +46,7 @@ (define-module (gnu installer)
   #:use-module (gnu packages nano)
   #:use-module (gnu packages ncurses)
   #:use-module (gnu packages package-management)
+  #:use-module (gnu packages pciutils)
   #:use-module (gnu packages tls)
   #:use-module (gnu packages xorg)
   #:use-module (gnu system locale)
@@ -226,7 +227,9 @@ (define (installer-steps)
           (id 'welcome)
           (compute (lambda _
                      ((installer-welcome-page current-installer)
-                      #$(local-file "installer/aux-files/logo.txt")))))
+                      #$(local-file "installer/aux-files/logo.txt")
+                      #:pci-database
+                      #$(file-append pciutils "/share/hwdata/pci.ids.gz")))))
 
          ;; Ask the user to select a timezone under glibc format.
          (installer-step
@@ -358,6 +361,7 @@ (define installer-builder
     (with-extensions (list guile-gcrypt guile-newt
                            guile-parted guile-bytestructures
                            guile-json-3 guile-git guile-webutils
+                           guile-zlib           ;for (gnu build linux-modules)
                            (current-guix) gnutls)
       (with-imported-modules `(,@(source-module-closure
                                   `(,@modules
diff --git a/gnu/installer/newt.scm b/gnu/installer/newt.scm
index 0bd0856219..60f9e75b81 100644
--- a/gnu/installer/newt.scm
+++ b/gnu/installer/newt.scm
@@ -176,8 +176,8 @@ (define* (locale-page #:key
 (define (timezone-page zonetab)
   (run-timezone-page zonetab))
 
-(define (welcome-page logo)
-  (run-welcome-page logo))
+(define* (welcome-page logo #:key pci-database)
+  (run-welcome-page logo #:pci-database pci-database))
 
 (define (menu-page steps)
   (run-menu-page steps))
diff --git a/gnu/installer/newt/welcome.scm b/gnu/installer/newt/welcome.scm
index 1c7372b3be..e9a4e0bbb4 100644
--- a/gnu/installer/newt/welcome.scm
+++ b/gnu/installer/newt/welcome.scm
@@ -19,7 +19,15 @@
 
 (define-module (gnu installer newt welcome)
   #:use-module ((gnu build linux-modules)
-                #:select (modules-loaded))
+                #:select (modules-loaded
+                          known-module-aliases
+                          matching-modules
+                          pci-devices
+                          pci-device-id
+                          pci-device-vendor
+                          pci-device-module-alias
+                          network-pci-device?
+                          load-pci-device-database))
   #:use-module (gnu installer dump)
   #:use-module (gnu installer steps)
   #:use-module (gnu installer utils)
@@ -30,6 +38,8 @@ (define-module (gnu installer newt welcome)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
+  #:use-module (srfi srfi-71)
+  #:use-module (ice-9 format)
   #:use-module (ice-9 match)
   #:use-module (ice-9 receive)
   #:use-module (newt)
@@ -121,7 +131,43 @@ (define (choice->item str)
         (lambda ()
           (destroy-form-and-pop form))))))
 
-(define (check-hardware-support)
+(define %unsupported-linux-modules
+  ;; List of Linux modules that are useless without non-free firmware.
+  '("iwlwifi"))
+
+(define unsupported-pci-device?
+  ;; Arrange to load the module alias database only once.
+  (let ((aliases (delay (known-module-aliases))))
+    (lambda (device)
+      "Return true if DEVICE is known to not be supported by free software."
+      (any (lambda (module)
+             (member module %unsupported-linux-modules))
+           (matching-modules (pci-device-module-alias device)
+                             (force aliases))))))
+
+(define (pci-device-description pci-database)
+  "Return a procedure that, given a PCI device, returns a string describing
+it."
+  (define (with-fallback lookup)
+    (lambda (vendor-id id)
+      (let ((vendor name (lookup vendor-id id)))
+        (values (or vendor (number->string vendor-id 16))
+                (or name (number->string id 16))))))
+
+  (define pci-lookup
+    (with-fallback (load-pci-device-database pci-database)))
+
+  (lambda (device)
+    (let ((vendor name (pci-lookup (pci-device-vendor device)
+                                   (pci-device-id device))))
+      (if (network-pci-device? device)
+          ;; TRANSLATORS: The two placeholders are the manufacturer
+          ;; and name of a PCI device.
+          (format #f (G_ "~a ~a (networking device)")
+                  vendor name)
+          (string-append vendor " " name)))))
+
+(define (check-hardware-support pci-database)
   "Warn about unsupported devices."
   (when (member "uvesafb" (modules-loaded))
     (run-error-page (G_ "\
@@ -129,9 +175,28 @@ (define (check-hardware-support)
 work well with only free software.  Expect trouble.  If after installation,
 the system does not boot, perhaps you will need to add nomodeset to the
 kernel arguments and need to configure the uvesafb kernel module.")
-                    (G_ "Pre-install warning"))))
+                    (G_ "Pre-install warning")))
 
-(define (run-welcome-page logo)
+  (let ((devices (pci-devices)))
+    (match (filter unsupported-pci-device? devices)
+      (()                                         ;no unsupported device
+       #t)
+      (unsupported
+       (run-error-page (format #f (G_ "\
+Devices not supported by free software were found on your computer:
+
+~{  - ~a~%~}
+Unfortunately, it means those devices will not be usable.
+
+To address it, we recommend choosing hardware that respects your freedom as a \
+user--hardware for which free drivers and firmware exist.  See \"Hardware \
+Considerations\" in the manual for more information.")
+                               (map (pci-device-description pci-database)
+                                    unsupported))
+                       (G_ "Hardware support warning")
+                       #:width 76)))))
+
+(define* (run-welcome-page logo #:key pci-database)
   "Run a welcome page with the given textual LOGO displayed at the center of
 the page. Ask the user to choose between manual installation, graphical
 installation and reboot."
@@ -161,11 +226,12 @@ (define (run-welcome-page logo)
    #:listbox-items
    `((,(G_ "Graphical install using a terminal based interface")
       .
-      ,check-hardware-support)
+      ,(lambda ()
+         (check-hardware-support pci-database)))
      (,(G_ "Install using the shell based process")
       .
       ,(lambda ()
-         (check-hardware-support)
+         (check-hardware-support pci-database)
          ;; Switch to TTY3, where a root shell is available for shell based
          ;; install. The other root TTY's would have been ok too.
          (system* "chvt" "3")
diff --git a/gnu/installer/record.scm b/gnu/installer/record.scm
index 20519a26c3..5e0264682f 100644
--- a/gnu/installer/record.scm
+++ b/gnu/installer/record.scm
@@ -89,7 +89,7 @@ (define-record-type* <installer>
   (partition-page installer-partition-page)
   ;; procedure void -> void
   (services-page installer-services-page)
-  ;; procedure (logo) -> void
+  ;; procedure (logo #:pci-database) -> void
   (welcome-page installer-welcome-page)
   ;; procedure (menu-proc) -> void
   (parameters-menu installer-parameters-menu)
-- 
2.38.0

[bug#59003] [PATCH 6/7] installer: Report known-unsupported PCI devices.

[pelzflorian (Florian Pelz)]

This is great work.

To test, I reverted the (current-guix) patch and instead pointed the
guix package source to (url "/home/florian/src/guix") and doing

GUIX_ALLOW_ME_TO_USE_PRIVATE_COMMIT=y make update-guix-package

so I could test the patch.  I also had to guix pull from a channel with
this local checkout, because

./pre-inst-env guix system image -t iso9660 gnu/system/install.scm

still insists on authenticating

florian@floriandesktop ~/src/guix [env]$ ./pre-inst-env guix system image -t iso9660 gnu/system/install.scm 
;;; compiling /home/florian/src/guix/gnu/system/examples/bare-bones.tmpl
;;; compiled /home/florian/.cache/guile/ccache/3.0-LE-8-4.6/home/florian/src/guix/gnu/system/examples/bare-bones.tmpl.go
;;; compiling /home/florian/src/guix/gnu/system/examples/bare-bones.tmpl
;;; compiled /home/florian/.cache/guile/ccache/3.0-LE-8-4.6/home/florian/src/guix/gnu/system/examples/bare-bones.tmpl.go
;;; compiling /home/florian/src/guix/gnu/system/examples/bare-bones.tmpl
;;; compiled /home/florian/.cache/guile/ccache/3.0-LE-8-4.6/home/florian/src/guix/gnu/system/examples/bare-bones.tmpl.go
Updating channel 'guix' from Git repository at '/home/florian/src/guix/'...
Authenticating channel 'guix', commits 9edb3f6 to 8d31a8c (977 new commits)...
[                                                                              ]guix system: error: commit 8d31a8c042bcedf34d911047c628ee4290f0b3cd lacks a signature


Why does it authenticate?  This is a strange antifeature, but I can’t
tell where in the code the authentication is called.

Anyway, after `guix pull`ing a guix channel with the local checkout,
`guix system image -t iso9660 gnu/system/install.scm` went fine.

I digress.  About the patch:

Ludovic Courtès <ludo@gnu.org> writes:
> Newer laptops are known to require
> non-free firmware a range of devices¹ and it would be nice to
> cover the important ones.
> 
> Thoughts?
> 
> Ludo’.
> 
> ¹ https://blog.einval.com/2022/04/19#firmware-what-do-we-do

In my limited experience, much hardware was always broken.
I don’t have modern hardware with iwlwifi, but my ancient laptop has
broken hardware, namely a SiS 191 Gigabit Ethernet Adapter.

While the adapter can download things with wget, when I use this
Ethernet controller to guix system init, Guix gets stuck immediately,
even though
<https://h-node.org/ethernetcards/catalogue/en/1/1/Silicon-Integrated-Systems-SiS/undef/undef/undef/ethernet-works/undef>
makes the dubitable claim that this Ethernet controller works fine.
Note that I have no issues with USB Ethernet adapters.  Therefore,

> +(define %unsupported-linux-modules
> +  ;; List of Linux modules that are useless without non-free firmware.
> +  '("iwlwifi"))

I added "sis190".  The patch works!  The install image prints:

Devices not supported by free software were found on your computer:

  - Silicon Integrated Systems [SiS] 191 Gigabit Ethernet Adapter
(networking device)


Yay!  Maybe you could add "sis190", maybe it doesn’t matter because it
is so old, maybe it is even just my laptop’s SiS that is broken.

By the way, looking for modern, working consumer wi-fi hardware (I
believe it does not exist), I find Realtek devices on h-node that it
claims are working with aircrack-ng, but recently there was a commit

commit b8f2eb286ec52c97048e23d326d94ae5772797e8
Author: Tobias Geerinckx-Rice <me@tobias.gr>
Date:   Sun Aug 14 02:00:00 2022 +0200

    gnu: Remove Realtek WiFi drivers with firmware blobs.
    
    rtl8821ce-linux-module contains, e.g., halhwimg8821c_fw.c and
    hal8821c_fw.c.  rtl8812au-aircrack-ng-linux-module has, e.g.,
    hal8814a_fw.c, hal8812a_fw.c, and hal8821a_fw.c.  Each of these
    examples contains non-free firmware blobs disguised as C arrays.
    
    * gnu/packages/linux.scm (rtl8821ce-linux-module)
    (rtl8812au-aircrack-ng-linux-module): Remove variables.
    
    Reported by Jacob K <jacobk@disroot.org>


But a warning for these Realtek devices can be added later when someone
actually has such hardware.  That would have been an external module
though.  Anyway, without realtek hardware I cannot judge.

Now, back to the patch:

> +(define unsupported-pci-device?
> +  ;; Arrange to load the module alias database only once.
> +  (let ((aliases (delay (known-module-aliases))))
> +    (lambda (device)
> +      "Return true if DEVICE is known to not be supported by free software."
> […]
> +(define (check-hardware-support pci-database)
> […]
> +  (let ((devices (pci-devices)))
> +    (match (filter unsupported-pci-device? devices)
> +      (()                                         ;no unsupported device
> +       #t)
> +      (unsupported
> +       (run-error-page (format #f (G_ "\
> +Devices not supported by free software were found on your computer:

In my view it would be better to lay the blame on the hardware
manufacturers, because they are the ones who should distribute free
drivers.  That is to turn it around and maybe say:

Devices with no support for free software were found on your computer:

or maybe at least “with” instead of “by”:

"Return true if DEVICE is known to not be supported with free software.


Either way, thank you!

Regards,
Florian

[bug#59003] [PATCH 6/7] installer: Report known-unsupported PCI devices.

[Ludovic Courtès]

Hi,

"pelzflorian (Florian Pelz)" <pelzflorian@pelzflorian.de> skribis:

> ./pre-inst-env guix system image -t iso9660 gnu/system/install.scm
>
> still insists on authenticating

Ah, for that you need to replace (current-guix) in (gnu system install)
with just ‘guix’.

This is annoying; we should allow users to skip authentication of
‘current-guix’ through an environment variable.

Ludo’.

[bug#59003] [PATCH 6/7] installer: Report known-unsupported PCI devices.

[pelzflorian (Florian Pelz)]

Ludovic Courtès <ludo@gnu.org> writes:
> Ah, for that you need to replace (current-guix) in (gnu system install)
> with just ‘guix’.

Ahh indeed, now it goes well.

> This is annoying; we should allow users to skip authentication of
> ‘current-guix’ through an environment variable.

That would be good.  Then patch 4 “installer: Use 'current-guix' for
extensions.” would not be bad anymore, because non-commiters would no
longer be left behind by it.

Regards,
Florian

[bug#59003] [PATCH 0/7] [Installer] Warn about unsupported devices

[Mathieu Othacehe]

Hey Ludo,

Overall, this is a very welcomed improvement :)

> -(define (check-hardware-support)
> +(define %unsupported-linux-modules
> +  ;; List of Linux modules that are useless without non-free firmware.
> +  '("iwlwifi"))
> +
> +(define unsupported-pci-device?
> +  ;; Arrange to load the module alias database only once.
> +  (let ((aliases (delay (known-module-aliases))))
> +    (lambda (device)
> +      "Return true if DEVICE is known to not be supported by free software."
> +      (any (lambda (module)
> +             (member module %unsupported-linux-modules))
> +           (matching-modules (pci-device-module-alias device)
> +                             (force aliases))))))
> +

I feel like all the hardware related part should not be part of the
gnu/installer/newt/ directory which is intended to contain mostly
Newt/GUI related stuff.

It would also be more logical for the contributors to browse the
gnu/installer/hardware.scm file for the %unsupported-linux-modules list
than the gnu/installer/newt/welcome.scm file. This can be done as a
follow up though.

I'm currently testing this patchset on a few machines with unsupported
hardware and will report back.

Thanks for this patchset,

Mathieu

[bug#59003] [PATCH 0/7] [Installer] Warn about unsupported devices

[Mathieu Othacehe]

[-- Attachment #1: Type: text/plain, Size: 105 bytes --]


On a laptop with a non-free WiFi chip, the warning message is displayed,
as expected, nice :).

Mathieu

[-- Attachment #2: non-free.png --]
[-- Type: image/png, Size: 1151090 bytes --]

[bug#59003] [PATCH 0/7] [Installer] Warn about unsupported devices

[Ludovic Courtès]

Mathieu Othacehe <othacehe@gnu.org> skribis:

> On a laptop with a non-free WiFi chip, the warning message is displayed,
> as expected, nice :).

Great, thanks for testing!

Ludo’.

[bug#59003] [PATCH 7/7] installer: Remove unused variable.

[Ludovic Courtès]

* gnu/installer/newt.scm (newt-run-command): Remove
'displayed-command'.
---
 gnu/installer/newt.scm | 4 ----
 1 file changed, 4 deletions(-)

diff --git a/gnu/installer/newt.scm b/gnu/installer/newt.scm
index 60f9e75b81..798ff53af2 100644
--- a/gnu/installer/newt.scm
+++ b/gnu/installer/newt.scm
@@ -117,10 +117,6 @@ (define command-output "")
   (define (line-accumulator line)
     (set! command-output
           (string-append/shared command-output line "\n")))
-  (define displayed-command
-    (string-join
-     (map (lambda (s) (string-append "\"" s "\"")) args)
-     " "))
   (define result (run-external-command-with-line-hooks (list line-accumulator)
                                                        args))
   (define exit-val (status:exit-val result))
-- 
2.38.0

[bug#59003] [PATCH 1/7] installer: Warn about hardware support after the welcome page.

[pelzflorian (Florian Pelz)]

Ludovic Courtès <ludo@gnu.org> writes:

> This is a followup to 682639c107908426fe6bf0a1b8404b98b7820290, which
> added the uvesafb upfront, before welcome page hard been displayed.
>
> * gnu/installer/newt/welcome.scm (check-hardware-support): New
> procedure.
> (run-welcome-page): Use it.

Yes, good idea.  Tested in QEMU when provoking the hardware support
error by pressing F10 in GRUB and adding nomodeset to the linux boot
arguments.

Regards,
Florian

[bug#59003] [PATCH 1/7] installer: Warn about hardware support after the welcome page.

[pelzflorian (Florian Pelz)]

P.S.

Ludovic Courtès <ludo@gnu.org> writes:
> This is a followup to 682639c107908426fe6bf0a1b8404b98b7820290, which
> added the uvesafb upfront, before welcome page hard been displayed.

“had been displayed.”

Regards,
Florian

[bug#59003] [PATCH v2 0/6] [Installer] Warn about unsupported devices

[Ludovic Courtès]

Hi!

Here’s an updated version taking into account comments by
Florian and Mathieu.  Changes since v1:

  • Hardware-related bits moved to a new (gnu installer
    hardware) module.

  • The list in ‘%unsupported-linux-modules’ has been expanded
    using a manual method, as explained in the comment.  I’m
    open to improvements in this area :-), though I think this
    can come later.

  • Typos fixed.

Thoughts?

Ludo’.

Ludovic Courtès (6):
  installer: Warn about hardware support after the welcome page.
  linux-modules: Add support for listing PCI devices.
  linux-modules: Add 'load-pci-device-database'.
  installer: Use 'current-guix' for extensions.
  installer: Error page width is parameterized.
  installer: Report known-unsupported PCI devices.

 gnu/build/linux-modules.scm    | 135 ++++++++++++++++++++++++++++++++-
 gnu/installer.scm              |   8 +-
 gnu/installer/hardware.scm     |  90 ++++++++++++++++++++++
 gnu/installer/newt.scm         |   4 +-
 gnu/installer/newt/page.scm    |  12 +--
 gnu/installer/newt/welcome.scm | 111 +++++++++++++++++----------
 gnu/installer/record.scm       |   2 +-
 gnu/local.mk                   |   1 +
 po/guix/POTFILES.in            |   1 +
 9 files changed, 310 insertions(+), 54 deletions(-)
 create mode 100644 gnu/installer/hardware.scm


base-commit: d9ca9cdd01bf1097343a047b51a1392131c7cf58
-- 
2.38.0

[bug#59003] [PATCH v2 1/6] installer: Warn about hardware support after the welcome page.

[Ludovic Courtès]

This is a followup to 682639c107908426fe6bf0a1b8404b98b7820290, which
added the uvesafb upfront, before welcome page had been displayed.

* gnu/installer/newt/welcome.scm (check-hardware-support): New
procedure.
(run-welcome-page): Use it.
---
 gnu/installer/newt/welcome.scm | 85 ++++++++++++++++++----------------
 1 file changed, 44 insertions(+), 41 deletions(-)

diff --git a/gnu/installer/newt/welcome.scm b/gnu/installer/newt/welcome.scm
index 326996b005..1c7372b3be 100644
--- a/gnu/installer/newt/welcome.scm
+++ b/gnu/installer/newt/welcome.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
-;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2020, 2022 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2022 Florian Pelz <pelzflorian@pelzflorian.de>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -121,55 +121,58 @@ (define (choice->item str)
         (lambda ()
           (destroy-form-and-pop form))))))
 
-(define (run-welcome-page logo)
-  "Run a welcome page with the given textual LOGO displayed at the center of
-the page. Ask the user to choose between manual installation, graphical
-installation and reboot."
-  (begin
-    (when (member "uvesafb" (modules-loaded))
-      (run-error-page (G_ "\
+(define (check-hardware-support)
+  "Warn about unsupported devices."
+  (when (member "uvesafb" (modules-loaded))
+    (run-error-page (G_ "\
 This may be a false alarm, but possibly your graphics hardware does not
 work well with only free software.  Expect trouble.  If after installation,
 the system does not boot, perhaps you will need to add nomodeset to the
 kernel arguments and need to configure the uvesafb kernel module.")
-                      (G_ "Pre-install warning")))
-    (when (file-exists? %core-dump)
-      (match
-          (choice-window
-           (G_ "Previous installation failed")
-           (G_ "Continue")
-           (G_ "Report the failure")
-           (G_ "It seems that the previous installation exited unexpectedly \
+                    (G_ "Pre-install warning"))))
+
+(define (run-welcome-page logo)
+  "Run a welcome page with the given textual LOGO displayed at the center of
+the page. Ask the user to choose between manual installation, graphical
+installation and reboot."
+  (when (file-exists? %core-dump)
+    (match (choice-window
+            (G_ "Previous installation failed")
+            (G_ "Continue")
+            (G_ "Report the failure")
+            (G_ "It seems that the previous installation exited unexpectedly \
 and generated a core dump.  Do you want to continue or to report the failure \
 first?"))
-        (1 #t)
-        (2 (raise
-            (condition
-             (&user-abort-error))))))
-    (run-menu-page
-     (G_ "GNU Guix install")
-     (G_ "Welcome to GNU Guix system installer!
+      (1 #t)
+      (2 (raise
+          (condition
+           (&user-abort-error))))))
+
+  (run-menu-page
+   (G_ "GNU Guix install")
+   (G_ "Welcome to GNU Guix system installer!
 
 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")
-        .
-        ,(const #t))
-       (,(G_ "Install using the shell based process")
-        .
-        ,(lambda ()
-           ;; Switch to TTY3, where a root shell is available for shell based
-           ;; install. The other root TTY's would have been ok too.
-           (system* "chvt" "3")
-           (run-welcome-page logo)))
-       (,(G_ "Reboot")
-        .
-        ,(lambda ()
-           (newt-finish)
-           (reboot))))
-     #:listbox-item->text car)))
+   logo
+   #:listbox-items
+   `((,(G_ "Graphical install using a terminal based interface")
+      .
+      ,check-hardware-support)
+     (,(G_ "Install using the shell based process")
+      .
+      ,(lambda ()
+         (check-hardware-support)
+         ;; Switch to TTY3, where a root shell is available for shell based
+         ;; install. The other root TTY's would have been ok too.
+         (system* "chvt" "3")
+         (run-welcome-page logo)))
+     (,(G_ "Reboot")
+      .
+      ,(lambda ()
+         (newt-finish)
+         (reboot))))
+   #:listbox-item->text car))
-- 
2.38.0

[bug#59003] [PATCH v2 2/6] linux-modules: Add support for listing PCI devices.

[Ludovic Courtès]

* gnu/build/linux-modules.scm (<pci-device>): New record type.
(pci-device-class-predicate, storage-pci-device?, network-pci-device?)
(display-pci-device?, pci-devices?): New procedures.
---
 gnu/build/linux-modules.scm | 61 ++++++++++++++++++++++++++++++++++++-
 1 file changed, 60 insertions(+), 1 deletion(-)

diff --git a/gnu/build/linux-modules.scm b/gnu/build/linux-modules.scm
index 053720574b..09cf752bef 100644
--- a/gnu/build/linux-modules.scm
+++ b/gnu/build/linux-modules.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2016, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2016, 2018, 2019, 2022 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2018 Danny Milosavljevic <dannym@scratchpost.org>
 ;;;
@@ -28,6 +28,7 @@ (define-module (gnu build linux-modules)
   #:use-module (rnrs io ports)
   #:use-module (rnrs bytevectors)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9 gnu)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
   #:use-module (ice-9 ftw)
@@ -50,6 +51,16 @@ (define-module (gnu build linux-modules)
             load-linux-module*
             load-linux-modules-from-directory
 
+            pci-devices
+            pci-device?
+            pci-device-vendor
+            pci-device-id
+            pci-device-class
+            pci-device-module-alias
+            storage-pci-device?
+            network-pci-device?
+            display-pci-device?
+
             current-module-debugging-port
 
             device-module-aliases
@@ -429,6 +440,54 @@ (define (read-uevent port)
       (line
        (loop (cons (key=value->pair line) result))))))
 
+;; PCI device known to the Linux kernel.
+(define-immutable-record-type <pci-device>
+  (pci-device vendor device class module-alias)
+  pci-device?
+  (vendor       pci-device-vendor)                ;integer
+  (device       pci-device-id)                    ;integer
+  (class        pci-device-class)                 ;integer
+  (module-alias pci-device-module-alias))         ;string | #f
+
+(define (pci-device-class-predicate mask bits)
+  (lambda (device)
+    "Return true if DEVICE has the chosen class."
+    (= (logand mask (pci-device-class device)) bits)))
+
+(define storage-pci-device?                   ;"Mass storage controller" class
+  (pci-device-class-predicate #xff0000 #x010000))
+(define network-pci-device?                       ;"Network controller" class
+  (pci-device-class-predicate #xff0000 #x020000))
+(define display-pci-device?                       ;"Display controller" class
+  (pci-device-class-predicate #xff0000 #x030000))
+
+(define (pci-devices)
+  "Return the list of PCI devices of the system (<pci-device> records)."
+  (define (read-hex port)
+    (let ((line (read-line port)))
+      (and (string? line)
+           (string-prefix? "0x" line)
+           (string->number (string-drop line 2) 16))))
+
+  (filter-map (lambda (directory)
+                (define properties
+                  (call-with-input-file (string-append directory "/uevent")
+                    read-uevent))
+                (define vendor
+                  (call-with-input-file (string-append directory "/vendor")
+                    read-hex))
+                (define device
+                  (call-with-input-file (string-append directory "/device")
+                    read-hex))
+                (define class
+                  (call-with-input-file (string-append directory "/class")
+                    read-hex))
+
+                (pci-device vendor device class
+                            (assq-ref properties 'MODALIAS)))
+              (find-files "/sys/bus/pci/devices"
+                          #:stat lstat)))
+
 (define (device-module-aliases device)
   "Return the list of module aliases required by DEVICE, a /dev file name, as
 in this example:
-- 
2.38.0

[bug#59003] [PATCH v2 3/6] linux-modules: Add 'load-pci-device-database'.

[Ludovic Courtès]

* gnu/build/linux-modules.scm (read-pci-device-database)
(load-pci-device-database): New procedures.
---
 gnu/build/linux-modules.scm | 74 +++++++++++++++++++++++++++++++++++++
 1 file changed, 74 insertions(+)

diff --git a/gnu/build/linux-modules.scm b/gnu/build/linux-modules.scm
index 09cf752bef..3b1f512663 100644
--- a/gnu/build/linux-modules.scm
+++ b/gnu/build/linux-modules.scm
@@ -60,6 +60,7 @@ (define-module (gnu build linux-modules)
             storage-pci-device?
             network-pci-device?
             display-pci-device?
+            load-pci-device-database
 
             current-module-debugging-port
 
@@ -488,6 +489,79 @@ (define class
               (find-files "/sys/bus/pci/devices"
                           #:stat lstat)))
 
+(define (read-pci-device-database port)
+  "Parse the 'pci.ids' database that ships with the pciutils package and is
+maintained at <https://pci-ids.ucw.cz/>."
+  (define (comment? str)
+    (string-prefix? "#" (string-trim str)))
+  (define (blank? str)
+    (string-null? (string-trim-both str)))
+  (define (device? str)
+    (eqv? #\tab (string-ref str 0)))
+  (define (subvendor? str)
+    (string-prefix? "\t\t" str))
+  (define (class? str)
+    (string-prefix? "C " str))
+  (define (parse-id-line str)
+    (let* ((str   (string-trim-both str))
+           (space (string-index str char-set:whitespace)))
+      (values (string->number (string-take str space) 16)
+              (string-trim (string-drop str (+ 1 space))))))
+  (define (finish vendor vendor-id devices table)
+    (fold (lambda (device table)
+            (match device
+              ((device-id . name)
+               (vhash-consv (logior (ash vendor-id 16) device-id)
+                            (cons vendor name)
+                            table))))
+          table
+          devices))
+
+  (let loop ((table vlist-null)
+             (vendor-id #f)
+             (vendor #f)
+             (devices '()))
+    (match (read-line port)
+      ((? eof-object?)
+       (let ((table (if (and vendor vendor-id)
+                        (finish vendor vendor-id devices table)
+                        table)))
+         (lambda (vendor device)
+           (match (vhash-assv (logior (ash vendor 16) device) table)
+             (#f
+              (values #f #f))
+             ((_ . (vendor . name))
+              (values vendor name))))))
+      ((? comment?)
+       (loop table vendor-id vendor devices))
+      ((? blank?)
+       (loop table vendor-id vendor devices))
+      ((? subvendor?)                             ;currently ignored
+       (loop table vendor-id vendor devices))
+      ((? class?)                                 ;currently ignored
+       (loop table vendor-id vendor devices))
+      ((? device? line)
+       (let-values (((id name) (parse-id-line line)))
+         (loop table vendor-id vendor
+               (if (and vendor-id vendor)         ;class or device?
+                   (alist-cons id name devices)
+                   devices))))
+      (line
+       (let ((table (if (and vendor vendor-id)
+                        (finish vendor vendor-id devices table)
+                        table)))
+         (let-values (((vendor-id vendor) (parse-id-line line)))
+           (loop table vendor-id vendor '())))))))
+
+(define (load-pci-device-database file)
+  "Read the 'pci.ids' database at FILE (get it from the pciutils package or
+from <https://pci-ids.ucw.cz/>) and return a lookup procedure that takes a PCI
+vendor ID and a device ID (two integers) and returns the vendor name and
+device name as two values."
+  (let ((port (open-file file "r0")))
+    (call-with-gzip-input-port port
+      read-pci-device-database)))
+
 (define (device-module-aliases device)
   "Return the list of module aliases required by DEVICE, a /dev file name, as
 in this example:
-- 
2.38.0

[bug#59003] [PATCH v2 4/6] installer: Use 'current-guix' for extensions.

[Ludovic Courtès]

This lets us use the latest (gnu build linux-modules) for instance.
Note that items listed in 'with-extensions' come first in the load path,
before the directory containing the modules in 'with-imported-modules'.

* gnu/installer.scm (installer-program): Use (current-guix) instead of
'guix' in 'with-extensions'.
---
 gnu/installer.scm | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/gnu/installer.scm b/gnu/installer.scm
index 5cd1af8edf..df7625e05c 100644
--- a/gnu/installer.scm
+++ b/gnu/installer.scm
@@ -358,7 +358,7 @@ (define installer-builder
     (with-extensions (list guile-gcrypt guile-newt
                            guile-parted guile-bytestructures
                            guile-json-3 guile-git guile-webutils
-                           guix gnutls)
+                           (current-guix) gnutls)
       (with-imported-modules `(,@(source-module-closure
                                   `(,@modules
                                     (gnu services herd)
-- 
2.38.0

[bug#59003] [PATCH v2 5/6] installer: Error page width is parameterized.

[Ludovic Courtès]

* gnu/installer/newt/page.scm (run-error-page): Add #:width and honor
it.
---
 gnu/installer/newt/page.scm | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/gnu/installer/newt/page.scm b/gnu/installer/newt/page.scm
index 0f508a31c0..e1623a51fd 100644
--- a/gnu/installer/newt/page.scm
+++ b/gnu/installer/newt/page.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
-;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2019, 2020, 2022 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2019 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -278,12 +278,12 @@ (define* (run-input-page text title
                    (destroy-form-and-pop form)
                    input))))))))
 
-(define (run-error-page text title)
-  "Run a page to inform the user of an error. The page contains the given TEXT
-to explain the error and an \"OK\" button to acknowledge the error. The title
-of the page is set to TITLE."
+(define* (run-error-page text title #:key (width 40))
+  "Run a page to inform the user of an error.  The page is WIDTH column wide
+and contains the given TEXT to explain the error and an \"OK\" button to
+acknowledge the error.  The title of the page is set to TITLE."
   (let* ((text-box
-          (make-reflowed-textbox -1 -1 text 40
+          (make-reflowed-textbox -1 -1 text width
                                  #:flags FLAG-BORDER))
          (grid (make-grid 1 2))
          (ok-button (make-button -1 -1 "OK"))
-- 
2.38.0

[bug#59003] [PATCH v2 6/6] installer: Report known-unsupported PCI devices.

[Ludovic Courtès]

* gnu/installer/hardware.scm: New file.
* gnu/local.mk (INSTALLER_MODULES): Add it.
* po/guix/POTFILES.in: Add it.
* gnu/installer.scm (installer-steps): Pass #:pci-database to the
'welcome' step procedure.
* gnu/installer/newt.scm (welcome-page): Add #:pci-database and pass it
to 'run-welcome-page'.
* gnu/installer/newt/welcome.scm (check-hardware-support): Add #:pci-database.
Enumerate unsupported PCI devices and run an error page when unsupported
devices are found.
(run-welcome-page): Add #:pci-database and pass it to
'check-hardware-support'.
* gnu/installer/record.scm (<installer>)[welcome-page]: Adjust comment.
---
 gnu/installer.scm              |  6 ++-
 gnu/installer/hardware.scm     | 90 ++++++++++++++++++++++++++++++++++
 gnu/installer/newt.scm         |  4 +-
 gnu/installer/newt/welcome.scm | 36 +++++++++++---
 gnu/installer/record.scm       |  2 +-
 gnu/local.mk                   |  1 +
 po/guix/POTFILES.in            |  1 +
 7 files changed, 130 insertions(+), 10 deletions(-)
 create mode 100644 gnu/installer/hardware.scm

diff --git a/gnu/installer.scm b/gnu/installer.scm
index df7625e05c..e1b040088b 100644
--- a/gnu/installer.scm
+++ b/gnu/installer.scm
@@ -46,6 +46,7 @@ (define-module (gnu installer)
   #:use-module (gnu packages nano)
   #:use-module (gnu packages ncurses)
   #:use-module (gnu packages package-management)
+  #:use-module (gnu packages pciutils)
   #:use-module (gnu packages tls)
   #:use-module (gnu packages xorg)
   #:use-module (gnu system locale)
@@ -226,7 +227,9 @@ (define (installer-steps)
           (id 'welcome)
           (compute (lambda _
                      ((installer-welcome-page current-installer)
-                      #$(local-file "installer/aux-files/logo.txt")))))
+                      #$(local-file "installer/aux-files/logo.txt")
+                      #:pci-database
+                      #$(file-append pciutils "/share/hwdata/pci.ids.gz")))))
 
          ;; Ask the user to select a timezone under glibc format.
          (installer-step
@@ -358,6 +361,7 @@ (define installer-builder
     (with-extensions (list guile-gcrypt guile-newt
                            guile-parted guile-bytestructures
                            guile-json-3 guile-git guile-webutils
+                           guile-zlib           ;for (gnu build linux-modules)
                            (current-guix) gnutls)
       (with-imported-modules `(,@(source-module-closure
                                   `(,@modules
diff --git a/gnu/installer/hardware.scm b/gnu/installer/hardware.scm
new file mode 100644
index 0000000000..cd1a1767d8
--- /dev/null
+++ b/gnu/installer/hardware.scm
@@ -0,0 +1,90 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2022 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; 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
+;;;
+;;; 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 installer hardware)
+  #:use-module (gnu build linux-modules)
+  #:use-module (guix i18n)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-71)
+  #:export (unsupported-pci-device?
+            pci-device-description))
+
+(define %unsupported-linux-modules
+  ;; List of Linux modules that are useless without non-free firmware.
+  ;;
+  ;; Currently only drivers for PCI devices are listed.  USB devices such as
+  ;; "btintel" would require support to list USB devices and read the USB
+  ;; device ID database.  Punt for now as this is usually less critical.
+  ;;
+  ;; This list is currently manually maintained based on information on
+  ;; non-free firmware available from
+  ;; <https://packages.debian.org/search?keywords=firmware&searchon=names&suite=stable&section=all>.
+  '(;; WiFi.
+    "brcmfmac"
+    "ipw2100"
+    "ipw2200"
+    "iwlwifi"
+    "mwl8k"
+    "rtl8188ee"
+    "rtl818x_pci"
+    "rtl8192ce"
+    "rtl8192de"
+    "rtl8192ee"
+
+    ;; Ethernet.
+    "bnx2"
+    "bnx2x"
+    "liquidio"
+
+    ;; Graphics.
+    "amdgpu"
+    "radeon"
+
+    ;; Multimedia.
+    "ivtv"))
+
+(define unsupported-pci-device?
+  ;; Arrange to load the module alias database only once.
+  (let ((aliases (delay (known-module-aliases))))
+    (lambda (device)
+      "Return true if DEVICE is known to not be supported by free software."
+      (any (lambda (module)
+             (member module %unsupported-linux-modules))
+           (matching-modules (pci-device-module-alias device)
+                             (force aliases))))))
+
+(define (pci-device-description pci-database)
+  "Return a procedure that, given a PCI device, returns a string describing
+it."
+  (define (with-fallback lookup)
+    (lambda (vendor-id id)
+      (let ((vendor name (lookup vendor-id id)))
+        (values (or vendor (number->string vendor-id 16))
+                (or name (number->string id 16))))))
+
+  (define pci-lookup
+    (with-fallback (load-pci-device-database pci-database)))
+
+  (lambda (device)
+    (let ((vendor name (pci-lookup (pci-device-vendor device)
+                                   (pci-device-id device))))
+      (if (network-pci-device? device)
+          ;; TRANSLATORS: The two placeholders are the manufacturer
+          ;; and name of a PCI device.
+          (format #f (G_ "~a ~a (networking device)")
+                  vendor name)
+          (string-append vendor " " name)))))
diff --git a/gnu/installer/newt.scm b/gnu/installer/newt.scm
index 0bd0856219..60f9e75b81 100644
--- a/gnu/installer/newt.scm
+++ b/gnu/installer/newt.scm
@@ -176,8 +176,8 @@ (define* (locale-page #:key
 (define (timezone-page zonetab)
   (run-timezone-page zonetab))
 
-(define (welcome-page logo)
-  (run-welcome-page logo))
+(define* (welcome-page logo #:key pci-database)
+  (run-welcome-page logo #:pci-database pci-database))
 
 (define (menu-page steps)
   (run-menu-page steps))
diff --git a/gnu/installer/newt/welcome.scm b/gnu/installer/newt/welcome.scm
index 1c7372b3be..e8ac587e2e 100644
--- a/gnu/installer/newt/welcome.scm
+++ b/gnu/installer/newt/welcome.scm
@@ -19,8 +19,10 @@
 
 (define-module (gnu installer newt welcome)
   #:use-module ((gnu build linux-modules)
-                #:select (modules-loaded))
+                #:select (modules-loaded
+                          pci-devices))
   #:use-module (gnu installer dump)
+  #:use-module (gnu installer hardware)
   #:use-module (gnu installer steps)
   #:use-module (gnu installer utils)
   #:use-module (gnu installer newt page)
@@ -30,6 +32,8 @@ (define-module (gnu installer newt welcome)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
+  #:use-module (srfi srfi-71)
+  #:use-module (ice-9 format)
   #:use-module (ice-9 match)
   #:use-module (ice-9 receive)
   #:use-module (newt)
@@ -121,7 +125,7 @@ (define (choice->item str)
         (lambda ()
           (destroy-form-and-pop form))))))
 
-(define (check-hardware-support)
+(define (check-hardware-support pci-database)
   "Warn about unsupported devices."
   (when (member "uvesafb" (modules-loaded))
     (run-error-page (G_ "\
@@ -129,9 +133,28 @@ (define (check-hardware-support)
 work well with only free software.  Expect trouble.  If after installation,
 the system does not boot, perhaps you will need to add nomodeset to the
 kernel arguments and need to configure the uvesafb kernel module.")
-                    (G_ "Pre-install warning"))))
+                    (G_ "Pre-install warning")))
 
-(define (run-welcome-page logo)
+  (let ((devices (pci-devices)))
+    (match (filter unsupported-pci-device? devices)
+      (()                                         ;no unsupported device
+       #t)
+      (unsupported
+       (run-error-page (format #f (G_ "\
+Devices not supported by free software were found on your computer:
+
+~{  - ~a~%~}
+Unfortunately, it means those devices will not be usable.
+
+To address it, we recommend choosing hardware that respects your freedom as a \
+user--hardware for which free drivers and firmware exist.  See \"Hardware \
+Considerations\" in the manual for more information.")
+                               (map (pci-device-description pci-database)
+                                    unsupported))
+                       (G_ "Hardware support warning")
+                       #:width 76)))))
+
+(define* (run-welcome-page logo #:key pci-database)
   "Run a welcome page with the given textual LOGO displayed at the center of
 the page. Ask the user to choose between manual installation, graphical
 installation and reboot."
@@ -161,11 +184,12 @@ (define (run-welcome-page logo)
    #:listbox-items
    `((,(G_ "Graphical install using a terminal based interface")
       .
-      ,check-hardware-support)
+      ,(lambda ()
+         (check-hardware-support pci-database)))
      (,(G_ "Install using the shell based process")
       .
       ,(lambda ()
-         (check-hardware-support)
+         (check-hardware-support pci-database)
          ;; Switch to TTY3, where a root shell is available for shell based
          ;; install. The other root TTY's would have been ok too.
          (system* "chvt" "3")
diff --git a/gnu/installer/record.scm b/gnu/installer/record.scm
index 20519a26c3..5e0264682f 100644
--- a/gnu/installer/record.scm
+++ b/gnu/installer/record.scm
@@ -89,7 +89,7 @@ (define-record-type* <installer>
   (partition-page installer-partition-page)
   ;; procedure void -> void
   (services-page installer-services-page)
-  ;; procedure (logo) -> void
+  ;; procedure (logo #:pci-database) -> void
   (welcome-page installer-welcome-page)
   ;; procedure (menu-proc) -> void
   (parameters-menu installer-parameters-menu)
diff --git a/gnu/local.mk b/gnu/local.mk
index 27b31ea27f..2859be63cb 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -787,6 +787,7 @@ INSTALLER_MODULES =                             \
   %D%/installer/connman.scm			\
   %D%/installer/dump.scm			\
   %D%/installer/final.scm			\
+  %D%/installer/hardware.scm			\
   %D%/installer/hostname.scm			\
   %D%/installer/keymap.scm			\
   %D%/installer/locale.scm			\
diff --git a/po/guix/POTFILES.in b/po/guix/POTFILES.in
index ed3fdb6be0..228ce04240 100644
--- a/po/guix/POTFILES.in
+++ b/po/guix/POTFILES.in
@@ -30,6 +30,7 @@ guix/import/pypi.scm
 guix/import/texlive.scm
 gnu/installer.scm
 gnu/installer/connman.scm
+gnu/installer/hardware.scm
 gnu/installer/hostname.scm
 gnu/installer/keymap.scm
 gnu/installer/locale.scm
-- 
2.38.0

[bug#59003] [PATCH v2 6/6] installer: Report known-unsupported PCI devices.

[pelzflorian (Florian Pelz)]

Okay, the blame on the hardware manufacturer is fine as is.

I tested again by creating a dummy gpg key, locally adding it to
guix-authorizations and changing guix/channels.scm’s
%guix-channel-introduction.

Ludovic Courtès <ludo@gnu.org> writes:
> +(define %unsupported-linux-modules
> +  '([…]
> +    ;; Graphics.
> +    "amdgpu"
> +    "radeon"

Yes, this is fine, I think, even though AMD users will have also gotten
the uvesafb warning before and even though allegedly some AMD devices
work okay without firmware (except for 3d, according to h-node).

Also with the previous v1 patch revision (I had missed that), and now
testing on a PC with non-working AMD graphics, when I first select
shell-based install, I get the warning, then switch back to the
installer with Alt-F1 and select graphical installation, after first
seeing the uvesafb warning, the installer crashes.  installer-backtrace
is this:

In ice-9/boot-9.scm:
  1752:10 19 (with-exception-handler _ _ #:unwind? _ #:unwind-for-type _)
In ice-9/eval.scm:
    619:8 18 (_ #(#(#(#<directory (guile-user) 7fb5fdc4dc80>)) #<variable 7fb5ebe9a9c0 value: #<undefined>>))
   626:19 17 (_ #(#(#(#<directory (guile-user) 7fb5fdc4dc80>)) #<variable 7fb5ebe9a9c0 value: #<undefined>>))
In gnu/installer/utils.scm:
   353:14 16 (call-with-server-socket _)
In ./gnu/installer/steps.scm:
   150:13 15 (run () #:todo-steps _ #:done-steps _)
   148:23 14 (run ((locale . "en_AG.utf8")) #:todo-steps _ #:done-steps _)
In ./gnu/installer/newt/welcome.scm:
   118:18 13 (run-menu-page "GNU Guix install" "Welcome to GNU Guix system installer!\n\nYou will be guided through a graphical installation program.\n\nIf you are familiar with GNU/Linux and you…" …)
   118:18 12 (run-menu-page "GNU Guix install" "Welcome to GNU Guix system installer!\n\nYou will be guided through a graphical installation program.\n\nIf you are familiar with GNU/Linux and you…" …)
   152:36 11 (check-hardware-support #f)
In ./gnu/installer/hardware.scm:
    80:19 10 (pci-device-description #f)
In gnu/build/linux-modules.scm:
   561:14  9 (load-pci-device-database _)
In unknown file:
           8 (open-file #f "r0")
In ice-9/boot-9.scm:
  1685:16  7 (raise-exception _ #:continuable? _)
  1780:13  6 (_ #<&compound-exception components: (#<&assertion-failure> #<&origin origin: #f> #<&message message: "Wrong type (expecting ~A): ~S"> #<&irritants irritants: ("string" #f)> #<&except…>)
In ice-9/eval.scm:
    619:8  5 (_ #(#(#(#<directory (guile-user) 7fb5fdc4dc80>) wrong-type-arg (#f "Wrong type (expecting ~A): ~S" ("string" #f) (#f))) #<variable 7fb5e7f01690 value: #<unspecified>> #<variable 7…> …))
   626:19  4 (_ #(#(#(#<directory (guile-user) 7fb5fdc4dc80>) wrong-type-arg (#f "Wrong type (expecting ~A): ~S" ("string" #f) (#f))) #<variable 7fb5e7f01690 value: #<unspecified>> #<variable 7…> …))
In ./gnu/installer/dump.scm:
     58:4  3 (prepare-dump wrong-type-arg (#f "Wrong type (expecting ~A): ~S" ("string" #f) (#f)) #:result _)
In ice-9/ports.scm:
   433:17  2 (call-with-output-file _ _ #:binary _ #:encoding _)
In ./gnu/installer/dump.scm:
    60:27  1 (_ #<output: installer-backtrace 20>)
In unknown file:
           0 (make-stack #t)
./gnu/installer/dump.scm:62:36: Wrong type (expecting string): #f


Regards,
Florian

bug#59003: [PATCH 0/7] [Installer] Warn about unsupported devices

[Ludovic Courtès]

Hi,

"pelzflorian (Florian Pelz)" <pelzflorian@pelzflorian.de> skribis:

> Ludovic Courtès <ludo@gnu.org> writes:
>> +(define %unsupported-linux-modules
>> +  '([…]
>> +    ;; Graphics.
>> +    "amdgpu"
>> +    "radeon"
>
> Yes, this is fine, I think, even though AMD users will have also gotten
> the uvesafb warning before and even though allegedly some AMD devices
> work okay without firmware (except for 3d, according to h-node).

Right, I think it’s only 3D that won’t work.  Maybe we should remove
them?  Dunno, we also want to warn about things that will not work to
its fullest.  Maybe we should reword the sentence?  Like:

  Unfortunately, it means those devices will not be usable.
  ->
  Unfortunately, it means those devices will not be usable or that some
  features will be unavailable.

WDYT?

> Also with the previous v1 patch revision (I had missed that), and now
> testing on a PC with non-working AMD graphics, when I first select
> shell-based install, I get the warning, then switch back to the
> installer with Alt-F1 and select graphical installation, after first
> seeing the uvesafb warning, the installer crashes.  installer-backtrace
> is this:

Oops, thanks; I fixed that recursive call in ‘run-welcome-page’.

I also added a sentence under “Hardware Considerations” mentioning this
warning and pushed the whole thing, in the hope we can call for testing
real soon.

  514fedbf39 * installer: Report known-unsupported PCI devices.
  6b39c3afcc * installer: Error page width is parameterized.
  938d6161cb * installer: Use 'current-guix' for extensions.
  afbd4d8470 * linux-modules: Add 'load-pci-device-database'.
  655fb8feac * linux-modules: Add support for listing PCI devices.
  4f7ffb97a4 * installer: Warn about hardware support after the welcome page.

Thanks,
Ludo’.

[bug#59003] [PATCH 0/7] [Installer] Warn about unsupported devices

[pelzflorian (Florian Pelz)]

Ludovic Courtès <ludo@gnu.org> writes:
> "pelzflorian (Florian Pelz)" <pelzflorian@pelzflorian.de> skribis:
>> Ludovic Courtès <ludo@gnu.org> writes:
>>> +(define %unsupported-linux-modules
>>> +  '([…]
>>> +    ;; Graphics.
>>> +    "amdgpu"
>>> +    "radeon"
>> Yes, this is fine, I think, even though AMD users will have also gotten
>> the uvesafb warning before and even though allegedly some AMD devices
>> work okay without firmware (except for 3d, according to h-node).
> Right, I think it’s only 3D that won’t work.  Maybe we should remove
> them?

Allegedly for some people only 3d is broken, but my AMD PCs’ screens get
frozen, also Philip’s
<https://lists.gnu.org/archive/html/help-guix/2021-10/msg00047.html>.
was unusable.

> Dunno, we also want to warn about things that will not work to
> its fullest.  Maybe we should reword the sentence?  Like:
>
>   Unfortunately, it means those devices will not be usable.
>   ->
>   Unfortunately, it means those devices will not be usable or that some
>   features will be unavailable.
>
> WDYT?

It is closer to the truth, so yes, but is not important.  The uvesafb
message before will have told AMD users that there may be a false alarm.

> Oops, thanks; I fixed that recursive call in ‘run-welcome-page’.

Ahh.  It works.

Regards,
Florian