From patchwork Thu Nov 3 19:19:34 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 44274 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id EA09127BBEB; Thu, 3 Nov 2022 19:21:21 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-3.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,RCVD_IN_MSPIKE_H2,SPF_HELO_PASS, URIBL_BLOCKED autolearn=ham autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 741AD27BBEA for ; Thu, 3 Nov 2022 19:21:20 +0000 (GMT) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1oqfm3-00054d-2Z; Thu, 03 Nov 2022 15:21:11 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1oqflx-00050K-T7 for guix-patches@gnu.org; Thu, 03 Nov 2022 15:21:07 -0400 Received: from debbugs.gnu.org ([209.51.188.43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1oqflx-0004mo-LQ for guix-patches@gnu.org; Thu, 03 Nov 2022 15:21:05 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1oqflx-0004q8-Gs for guix-patches@gnu.org; Thu, 03 Nov 2022 15:21:05 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#59003] [PATCH 6/7] installer: Report known-unsupported PCI devices. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Thu, 03 Nov 2022 19:21:05 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 59003 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 59003@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 59003-submit@debbugs.gnu.org id=B59003.166750320618455 (code B ref 59003); Thu, 03 Nov 2022 19:21:05 +0000 Received: (at 59003) by debbugs.gnu.org; 3 Nov 2022 19:20:06 +0000 Received: from localhost ([127.0.0.1]:50777 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1oqfkz-0004na-J6 for submit@debbugs.gnu.org; Thu, 03 Nov 2022 15:20:06 -0400 Received: from eggs.gnu.org ([209.51.188.92]:46750) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1oqfkq-0004lM-Px for 59003@debbugs.gnu.org; Thu, 03 Nov 2022 15:19:57 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1oqfkk-0004UO-K5; Thu, 03 Nov 2022 15:19:50 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:References:In-Reply-To:Date:Subject:To: From; bh=TDvpcVv/w7bwmSti93U1Nc1C/rog6c0eJGa0f9WxbIQ=; b=LX5Kfds5xSTmyZGTacd6 AGyunZbDm/mh+ol7KfjaGCZ2RDhDJ9dozPyUgV+tCExZWCnefVreNAGJ0K8EfHCDqopn23ckAU4yE gZ3znrvbUIljVgDw2U/+EXAoo0lFm1s+nOkpvQuYB+woFNI0VexKRMIdeaTNFu/pvaRSnLDXAdOMH PX988IdD3kPezQyYZ6RqO6QUzwxmxA32G7ROi/a+HLVf1p2zYEf9NOeIRppAMiOc3GulUt3TfPb8h xi+pbwVkp/x0UhZm+4apwtcudAQ5Lc6+oFRV3drwCbG5cCbQmRtPDl+dzj8+3s44Z7uzLWu8wiqWY 7rdayUTYWglwiQ==; Received: from 91-160-117-201.subs.proxad.net ([91.160.117.201] helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1oqfkk-0001MS-5d; Thu, 03 Nov 2022 15:19:50 -0400 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Thu, 3 Nov 2022 20:19:34 +0100 Message-Id: <20221103191935.16336-6-ludo@gnu.org> X-Mailer: git-send-email 2.38.0 In-Reply-To: <20221103191935.16336-1-ludo@gnu.org> References: <20221103191935.16336-1-ludo@gnu.org> MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Sender: "Guix-patches" Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches * 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 ()[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* (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)