;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès ;;; Copyright © 2016 Christine Lemmer-Webber ;;; Copyright © 2016, 2017 Leo Famulari ;;; Copyright © 2017 Marius Bakke ;;; Copyright © 2020, 2022 Tobias Geerinckx-Rice ;;; Copyright © 2020 Mathieu Othacehe ;;; Copyright © 2022 Pavel Shlyak ;;; Copyright © 2022 Denis 'GNUtoo' Carikli ;;; Copyright © 2023 Efraim Flashner ;;; ;;; 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 th
aboutsummaryrefslogtreecommitdiff
blob: cd1a1767d820745592e5422b509c465d803db1cf (about) (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
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)))))
bootcfg bootcfg-location bootloader-package bootloader-installer (copy-closures? #t) (deduplicate? #t) references-graphs (register-closures? #t) system-directory make-device-nodes (wal-mode? #t) #:allow-other-keys) "Initialize the given ROOT directory. Use BOOTCFG and BOOTCFG-LOCATION to install the bootloader configuration. If COPY-CLOSURES? is true, copy all of REFERENCES-GRAPHS to the partition. If REGISTER-CLOSURES? is true, register REFERENCES-GRAPHS in the store. If DEDUPLICATE? is true, then also deduplicate files common to CLOSURES and the rest of the store when registering the closures. SYSTEM-DIRECTORY is the name of the directory of the 'system' derivation. Pass WAL-MODE? to register-closure." (define root-store (string-append root (%store-directory))) (define tmp-store ".tmp-store") (populate-root-file-system system-directory root) (when copy-closures? (populate-store references-graphs root #:deduplicate? deduplicate?)) ;; Populate /dev. (when make-device-nodes (make-device-nodes root)) (when register-closures? (unless copy-closures? ;; XXX: 'register-closure' wants to palpate the things it registers, so ;; create a symlink to the store. (rename-file root-store tmp-store) (symlink (%store-directory) root-store)) (for-each (lambda (closure) (register-closure root closure #:wal-mode? wal-mode?)) references-graphs) (unless copy-closures? (delete-file root-store) (rename-file tmp-store root-store))) ;; There's no point installing a bootloader if we do not populate the store. (when copy-closures? (when bootloader-installer (display "installing bootloader...\n") (bootloader-installer bootloader-package #f root)) (when bootcfg (install-boot-config bootcfg bootcfg-location root)))) (define* (make-iso9660-image xorriso grub-mkrescue-environment grub bootcfg system-directory root target #:key (volume-id "Guix_image") (volume-uuid #f) register-closures? (references-graphs '()) (compression? #t)) "Given a GRUB package, creates an iso image as TARGET, using BOOTCFG as GRUB configuration and OS-DRV as the stuff in it." (define grub-mkrescue (string-append grub "/bin/grub-mkrescue")) (define grub-mkrescue-sed.sh (string-append (getcwd) "/" "grub-mkrescue-sed.sh")) ;; Use a modified version of grub-mkrescue-sed.sh, see below. (copy-file (string-append xorriso "/bin/grub-mkrescue-sed.sh") grub-mkrescue-sed.sh) ;; Force grub-mkrescue-sed.sh to use the build directory instead of /tmp ;; that is read-only inside the build container. (substitute* grub-mkrescue-sed.sh (("/tmp/") (string-append (getcwd) "/")) (("MKRESCUE_SED_XORRISO_ARGS \\$x") (format #f "MKRESCUE_SED_XORRISO_ARGS $(echo $x | sed \"s|/tmp|~a|\")" (getcwd)))) ;; 'grub-mkrescue' calls out to mtools programs to create 'efi.img', a FAT ;; file system image, and mtools honors SOURCE_DATE_EPOCH for the mtime of ;; those files. The epoch for FAT is Jan. 1st 1980, not 1970, so choose ;; that. (setenv "SOURCE_DATE_EPOCH" (number->string (time-second (date->time-utc (make-date 0 0 0 0 1 1 1980 0))))) ;; Our patched 'grub-mkrescue' honors this environment variable and passes ;; it to 'mformat', which makes it the serial number of 'efi.img'. This ;; allows for deterministic builds. (setenv "GRUB_FAT_SERIAL_NUMBER" (number->string (if volume-uuid ;; On 32-bit systems the 2nd argument must be ;; lower than 2^32. (string-hash (iso9660-uuid->string volume-uuid) (- (expt 2 32) 1)) #x77777777) 16)) (setenv "MKRESCUE_SED_MODE" "original") (setenv "MKRESCUE_SED_XORRISO" (string-append xorriso "/bin/xorriso")) (setenv "MKRESCUE_SED_IN_EFI_NO_PT" "yes") (for-each (match-lambda ((name . value) (setenv name value))) grub-mkrescue-environment) (apply invoke grub-mkrescue (string-append "--xorriso=" grub-mkrescue-sed.sh) "-o" target (string-append "boot/grub/grub.cfg=" bootcfg) root "--" ;; Set all timestamps to 1. "-volume_date" "all_file_dates" "=1" `(,@(if compression? '(;; ‘zisofs’ compression reduces the total image size by ~60%. "-zisofs" "level=9:block_size=128k" ; highest compression ;; It's transparent to our Linux-Libre kernel but not to ;; GRUB. Don't compress the kernel, initrd, and other files ;; read by grub.cfg, as well as common already-compressed ;; file names. "-find" "/" "-type" "f" ;; XXX Even after "--" above, and despite documentation ;; claiming otherwise, "-or" is stolen by grub-mkrescue which ;; then chokes on it (as ‘-o …’) and dies. Don't use "-or". "-not" "-wholename" "/boot/*" "-not" "-wholename" "/System/*" "-not" "-name" "unicode.pf2" "-not" "-name" "bzImage" "-not" "-name" "*.gz" ; initrd & all man pages "-not" "-name" "*.png" ; includes grub-image.png "-exec" "set_filter" "--zisofs" "--") '()) "-volid" ,(string-upcase volume-id) ,@(if volume-uuid `("-volume_date" "uuid" ,(string-filter (lambda (value) (not (char=? #\- value))) (iso9660-uuid->string volume-uuid))) '()))))