about
aboutsummaryrefslogtreecommitdiff
path: root/tests/guix-repl.sh
diff options
context:
space:
mode:
authorStefan <stefan-guix@vodafonemail.de>2021-01-11 21:32:47 +0100
committerLudovic Courtès <ludo@gnu.org>2021-01-14 17:15:18 +0100
commit795db9d2199200e69d0acc7ffad4546a75679f95 (patch)
tree79ba8c3b3466b65d9385ee2e156806ff1c1fc791 /tests/guix-repl.sh
parent4f38e0e47b4f20d5fa034ec7cde836858cfc7963 (diff)
downloadguix-795db9d2199200e69d0acc7ffad4546a75679f95.tar.gz
guix-795db9d2199200e69d0acc7ffad4546a75679f95.zip
gnu: qemu: Fix ioctl(…, SIOCGIFCONF, …) for emulated 64 bit architectures.
* gnu/packages/virtualization.scm (qemu): Add a snippet to fix a bug in the do_ioctl_ifconf() function of qemu to make ioctl(…, SIOCGIFCONF, …) work for emulated 64 bit architectures. The sizeof(struct ifreq) is 40 for 64 bit and 32 for 32 bit architectures. This structure contains a union of other structures, of which struct ifmap is the biggest for 64 bit architectures. Calling ioctl(…, SIOCGIFCONF, …) fills a struct sockaddr of that union, and do_ioctl_ifconf() only considered that struct sockaddr for the size of the union, which has the same size as struct ifmap on 32 bit architectures. So do_ioctl_ifconf() assumed a wrong size of 32 for struct ifreq instead of the correct size of 40 on 64 bit architectures. The fix makes do_ioctl_ifconf() handle struct ifmap as the biggest part of the union, treating struct ifreq with the correct size. This fixes (@ (guix build syscalls) network-interface-names) when used in emulated 64 bit architectures. Signed-off-by: Ludovic Courtès <ludo@gnu.org>
Diffstat (limited to 'tests/guix-repl.sh')
0 files changed, 0 insertions, 0 deletions
)))))) (define (menu-entry->sexp entry) "Return ENTRY serialized as an sexp." (define (device->sexp device) (match device ((? uuid? uuid) `(uuid ,(uuid-type uuid) ,(uuid->string uuid))) ((? file-system-label? label) `(label ,(file-system-label->string label))) (_ device))) (match entry (($ <menu-entry> label device mount-point (? identity linux) linux-arguments (? identity initrd) #f () () #f) `(menu-entry (version 0) (label ,label) (device ,(device->sexp device)) (device-mount-point ,mount-point) (linux ,linux) (linux-arguments ,linux-arguments) (initrd ,initrd))) (($ <menu-entry> label device mount-point #f () #f (? identity multiboot-kernel) multiboot-arguments multiboot-modules #f) `(menu-entry (version 0) (label ,label) (device ,(device->sexp device)) (device-mount-point ,mount-point) (multiboot-kernel ,multiboot-kernel) (multiboot-arguments ,multiboot-arguments) (multiboot-modules ,multiboot-modules))) (($ <menu-entry> label device mount-point #f () #f #f () () (? identity chain-loader)) `(menu-entry (version 0) (label ,label) (device ,(device->sexp device)) (device-mount-point ,mount-point) (chain-loader ,chain-loader))) (_ (report-menu-entry-error entry)))) (define (sexp->menu-entry sexp) "Turn SEXP, an sexp as returned by 'menu-entry->sexp', into a <menu-entry> record." (define (sexp->device device-sexp) (match device-sexp (('uuid type uuid-string) (uuid uuid-string type)) (('label label) (file-system-label label)) (_ device-sexp))) (match sexp (('menu-entry ('version 0) ('label label) ('device device) ('device-mount-point mount-point) ('linux linux) ('linux-arguments linux-arguments) ('initrd initrd) _ ...) (menu-entry (label label) (device (sexp->device device)) (device-mount-point mount-point) (linux linux) (linux-arguments linux-arguments) (initrd initrd))) (('menu-entry ('version 0) ('label label) ('device device) ('device-mount-point mount-point) ('multiboot-kernel multiboot-kernel) ('multiboot-arguments multiboot-arguments) ('multiboot-modules multiboot-modules) _ ...) (menu-entry (label label) (device (sexp->device device)) (device-mount-point mount-point) (multiboot-kernel multiboot-kernel) (multiboot-arguments multiboot-arguments) (multiboot-modules multiboot-modules))) (('menu-entry ('version 0) ('label label) ('device device) ('device-mount-point mount-point) ('chain-loader chain-loader) _ ...) (menu-entry (label label) (device (sexp->device device)) (device-mount-point mount-point) (chain-loader chain-loader))))) ;;; ;;; Bootloader record. ;;; ;; The <bootloader> record contains fields expressing how the bootloader ;; should be installed. Every bootloader in gnu/bootloader/ directory ;; has to be described by this record. (define-record-type* <bootloader> bootloader make-bootloader bootloader? (name bootloader-name) (package bootloader-package) (installer bootloader-installer) (disk-image-installer bootloader-disk-image-installer (default #f)) (configuration-file bootloader-configuration-file) (configuration-file-generator bootloader-configuration-file-generator)) ;;; ;;; Bootloader configuration record. ;;; ;; The <bootloader-configuration> record contains bootloader independant ;; configuration used to fill bootloader configuration file. (define-with-syntax-properties (warn-target-field-deprecation (value properties)) (when value (warning (source-properties->location properties) (G_ "the 'target' field is deprecated, please use 'targets' \ instead~%"))) value) (define-record-type* <bootloader-configuration> bootloader-configuration make-bootloader-configuration bootloader-configuration? (bootloader bootloader-configuration-bootloader) ;<bootloader> (targets %bootloader-configuration-targets (default #f)) ;list of strings (target %bootloader-configuration-target ;deprecated (default #f) (sanitize warn-target-field-deprecation)) (menu-entries bootloader-configuration-menu-entries (default '())) ;list of <menu-entry> (default-entry bootloader-configuration-default-entry (default 0)) ;integer (timeout bootloader-configuration-timeout (default 5)) ;seconds as integer (keyboard-layout bootloader-configuration-keyboard-layout (default #f)) ;<keyboard-layout> | #f (theme bootloader-configuration-theme (default #f)) ;bootloader-specific theme (terminal-outputs bootloader-configuration-terminal-outputs (default '(gfxterm))) ;list of symbols (terminal-inputs bootloader-configuration-terminal-inputs (default '())) ;list of symbols (serial-unit bootloader-configuration-serial-unit (default #f)) ;integer | #f (serial-speed bootloader-configuration-serial-speed (default #f)) ;integer | #f (device-tree-support? bootloader-configuration-device-tree-support? (default #t)) ;boolean (extra-initrd bootloader-configuration-extra-initrd (default #f))) ;string | #f (define-deprecated (bootloader-configuration-target config) bootloader-configuration-targets (%bootloader-configuration-target config)) (define (bootloader-configuration-targets config) (or (%bootloader-configuration-targets config) ;; TODO: Remove after the deprecated 'target' field is removed. (list (%bootloader-configuration-target config)) ;; XXX: At least the GRUB installer (see (gnu bootloader grub)) has this ;; peculiar behavior of installing fonts and GRUB modules when DEVICE is #f, ;; hence the default value of '(#f) rather than '(). (list #f))) ;;; ;;; Bootloaders. ;;; (define (bootloader-modules) "Return the list of bootloader modules." (all-modules (map (lambda (entry) `(,entry . "gnu/bootloader")) %load-path) #:warn warn-about-load-error)) (define %bootloaders ;; The list of publically-known bootloaders. (delay (fold-module-public-variables (lambda (obj result) (if (bootloader? obj) (cons obj result) result)) '() (bootloader-modules)))) (define (lookup-bootloader-by-name name) "Return the bootloader called NAME." (or (find (lambda (bootloader) (eq? name (bootloader-name bootloader))) (force %bootloaders)) (leave (G_ "~a: no such bootloader~%") name))) (define (efi-bootloader-profile packages files hooks) "Creates a profile from the lists of PACKAGES and FILES from the store. This profile is meant to be used by the bootloader-installer. FILES is a list of file or directory names from the store, which will be symlinked into the profile. If a directory name ends with '/', then the directory content instead of the directory itself will be symlinked into the profile. FILES may contain file like objects produced by procedures like plain-file, local-file, etc., or package contents produced with file-append. HOOKS lists additional hook functions to modify the profile." (define* (efi-bootloader-profile-hook manifest #:optional system) (define build (with-imported-modules '((guix build utils)) #~(begin (use-modules ((guix build utils) #:select (mkdir-p strip-store-file-name)) ((ice-9 ftw) #:select (scandir)) ((srfi srfi-1) #:select (append-map every remove)) ((srfi srfi-26) #:select (cut))) (define (symlink-to file directory transform) "Creates a symlink to FILE named (TRANSFORM FILE) in DIRECTORY." (symlink file (string-append directory "/" (transform file)))) (define (directory-content directory) "Creates a list of absolute path names inside DIRECTORY." (map (lambda (name) (string-append directory name)) (or (scandir directory (lambda (name) (not (member name '("." ".."))))) '()))) (define name-ends-with-/? (cut string-suffix? "/" <>)) (define (name-is-store-entry? name) "Return #t if NAME is a direct store entry and nothing inside." (not (string-index (strip-store-file-name name) #\/))) (let* ((files '#$files) (directories (filter name-ends-with-/? files)) (names-from-directories (append-map (lambda (directory) (directory-content directory)) directories)) (names (append names-from-directories (remove name-ends-with-/? files)))) (mkdir-p #$output) (if (every file-exists? names) (begin (for-each (lambda (name) (symlink-to name #$output (if (name-is-store-entry? name) strip-store-file-name basename))) names) #t) #f))))) (gexp->derivation "efi-bootloader-profile" build #:system system #:local-build? #t #:substitutable? #f #:properties `((type . profile-hook) (hook . efi-bootloader-profile-hook)))) (profile (content (packages->manifest packages)) (name "efi-bootloader-profile") (hooks (cons efi-bootloader-profile-hook hooks)) (locales? #f) (allow-collisions? #f) (relative-symlinks? #f))) (define* (efi-bootloader-chain final-bootloader #:key (packages '()) (files '()) (hooks '()) installer disk-image-installer) "Define a chain of bootloaders with the FINAL-BOOTLOADER, optional PACKAGES, and optional directories and files from the store given in the list of FILES. The package of the FINAL-BOOTLOADER and all PACKAGES and FILES will be placed in an efi-bootloader-profile, which will be passed to the INSTALLER. FILES may contain file-like objects produced by procedures like plain-file, local-file, etc., or package contents produced with file-append. If a directory name in FILES ends with '/', then the directory content instead of the directory itself will be symlinked into the efi-bootloader-profile. The procedures in the HOOKS list can be used to further modify the bootloader profile. It is possible to pass a single function instead of a list. If the INSTALLER argument is used, then this gexp procedure will be called to install the efi-bootloader-profile. Otherwise the installer of the FINAL-BOOTLOADER will be called. If the DISK-IMAGE-INSTALLER is used, then this gexp procedure will be called to install the efi-bootloader-profile into a disk image. Otherwise the disk-image-installer of the FINAL-BOOTLOADER will be called." (bootloader (inherit final-bootloader) (name "efi-bootloader-chain") (package (efi-bootloader-profile (cons (bootloader-package final-bootloader) packages) files (if (list? hooks) hooks (list hooks)))) (installer (or installer (bootloader-installer final-bootloader))) (disk-image-installer (or disk-image-installer (bootloader-disk-image-installer final-bootloader)))))