aboutsummaryrefslogtreecommitdiff
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2019, 2020, 2023 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2015, 2016, 2019, 2021, 2023 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2020 Marius Bakke <mbakke@fastmail.com>
;;; Copyright © 2020 Vincent Legoll <vincent.legoll@gmail.com>
;;; Copyright © 2020, 2021, 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2020, 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;;
;;; 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
;;; GNU General Public License for more details.
;;;
;;; 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 packages gdb)
  #:use-module (gnu packages)
  #:use-module (gnu packages bash)
  #:use-module (gnu packages cross-base)
  #:use-module (gnu packages hurd)
  #:use-module (gnu packages ncurses)
  #:use-module (gnu packages readline)
  #:use-module (gnu packages dejagnu)
  #:use-module (gnu packages texinfo)
  #:use-module (gnu packages multiprecision)
  #:use-module (gnu packages xml)
  #:use-module (gnu packages guile)
  #:use-module (gnu packages pretty-print)
  #:use-module (gnu packages python)
  #:use-module (gnu packages pkg-config)
  #:use-module (guix download)
  #:use-module (guix gexp)
  #:use-module ((guix licenses) #:select (gpl3+))
  #:use-module (guix packages)
  #:use-module (guix utils)
  #:use-module (guix build-system gnu)
  #:use-module ((guix build utils) #:select (alist-replace))
  #:use-module (srfi srfi-1))

(define-public gdb/pinned
  ;; This is the fixed version that packages depend on.  Update it rarely
  ;; enough to avoid massive rebuilds.
  (package
    (name "gdb")
    (version "12.1")
    (source (origin
              (method url-fetch)
              (uri (string-append "mirror://gnu/gdb/gdb-"
                                  version ".tar.xz"))
              (sha256
               (base32
                "1vczsqcbh5y0gx7qrclpna0qzx26sk7lra6y8qzxam1biyzr65qf"))))
    (build-system gnu-build-system)
    (outputs '("out" "debug"))
    (arguments
     (list
      #:tests? #f                       ;FIXME: 217 unexpected failures
      #:out-of-source? #t
      #:modules `((srfi srfi-1)
                  ,@%default-gnu-modules)
      #:configure-flags (if (target-hurd64?)
                            #~'("--enable-targets=i586-pc-gnu,x86_64-pc-gnu")
                            #~'())
      #:phases #~(modify-phases %standard-phases
                   (add-after 'unpack 'patch-paths
                     (lambda* (#:key inputs #:allow-other-keys)
                       (let ((sh (string-append (assoc-ref inputs "bash")
                                                "/bin/sh")))
                         (substitute* '("gdb/ser-pipe.c"
                                        "gdbsupport/pathstuff.cc")
                           (("\"/bin/sh\"")
                            (format #f "~s" sh))))))
                   (add-after 'configure 'post-configure
                     (lambda _
                       (for-each patch-makefile-SHELL
                                 (find-files "." "Makefile\\.in"))))
                   (add-after 'install 'remove-libs-already-in-binutils
                     (lambda* (#:key native-inputs inputs outputs
                               #:allow-other-keys)
                       ;; Like Binutils, GDB installs libbfd, libopcodes, etc.
                       ;; However, this leads to collisions when both are
                       ;; installed, and really is none of its business,
                       ;; conceptually.  So remove them.
                       (let* ((binutils (or (assoc-ref inputs "binutils")
                                            (assoc-ref native-inputs "binutils")))
                              (out      (assoc-ref outputs "out"))
                              (files1   (with-directory-excursion binutils
                                          (append (find-files "lib")
                                                  (find-files "include"))))
                              (files2   (with-directory-excursion out
                                          (append (find-files "lib")
                                                  (find-files "include"))))
                              (common   (lset-intersection string=?
                                                           files1 files2)))
                         (with-directory-excursion out
                           (for-each delete-file common))))))))
    (inputs
     `(("bash" ,bash)
       ("expat" ,expat)
       ("mpfr" ,mpfr)
       ("gmp" ,gmp)
       ("readline" ,readline)
       ("ncurses" ,ncurses)
       ("guile" ,guile-3.0)
       ("python-wrapper" ,python-wrapper)
       ("source-highlight" ,source-highlight)

       ;; Allow use of XML-formatted syscall information.  This enables 'catch
       ;; syscall' and similar commands.
       ("libxml2" ,libxml2)

       ;; The Hurd needs -lshouldbeinlibc.
       ,@(if (target-hurd?)
             `(("hurd" ,hurd))
             '())))
    (native-inputs
     `(("texinfo" ,texinfo)
       ("dejagnu" ,dejagnu)
       ("pkg-config" ,pkg-config)
       ,@(if (target-hurd?)
             ;; When cross-compiling from x86_64-linux, make sure to use a
             ;; 32-bit MiG because we assume target i586-pc-gnu.
             `(("mig" ,(if (%current-target-system)
                           (cross-mig (%current-target-system))
                           mig)))
             '())))
    ;; TODO: Add support for the GDB_DEBUG_FILE_DIRECTORY environment
    ;; variable in GDB itself instead of relying on some glue code in
    ;; the Guix-provided .gdbinit file.
    (native-search-paths (list (search-path-specification
                                (variable "GDB_DEBUG_FILE_DIRECTORY")
                                (files '("lib/debug")))))
    (home-page "https://www.gnu.org/software/gdb/")
    (synopsis "The GNU debugger")
    (description
     "GDB is the GNU debugger.  With it, you can monitor what a program is
doing while it runs or what it was doing just before a crash.  It allows you
to specify the runtime conditions, to define breakpoints, and to change how
the program is running to try to fix bugs.  It can be used to debug programs
written in C, C++, Ada, Objective-C, Pascal and more.")
    (properties `((hidden? . #t)))
    (license gpl3+)))

(define-public gdb-14
  (package
    (inherit gdb/pinned)
    (version "14.2")
    (source (origin
              (method url-fetch)
              (uri (string-append "mirror://gnu/gdb/gdb-"
                                  version ".tar.xz"))
              (sha256
               (base32
                "0wkprsjyyh204fdjlkaz20k847l88i9y8m9zqsv15vcd3l3dhk9d"))))
    (properties '())))

(define-public gdb-15
  (package
    (inherit gdb-14)
    (version "15.2")
    (source (origin
              (method url-fetch)
              (uri (string-append "mirror://gnu/gdb/gdb-"
                                  version ".tar.xz"))
              (patches (search-patches "gdb-hurd64.patch"))
              (sha256
               (base32
                "0k9i8mizg4hby020k53kqmc835pajh9c8d5klv5s1ddm6p6hqdc3"))))))

(define-public gdb
  ;; The "default" version.
  gdb-14)

(define-public gdb-multiarch
  (package/inherit gdb-14
    (name "gdb-multiarch")
    (arguments
     (substitute-keyword-arguments (package-arguments gdb-14)
       ((#:configure-flags flags '())
        #~(cons* "--enable-targets=all"
                 "--enable-multilib"
                 "--enable-interwork"
                 "--enable-languages=c,c++"
                 "--disable-nls"
                 #$flags))))
    (synopsis "The GNU debugger (with all architectures enabled)")))

(define-public gdb-minimal
  (package/inherit gdb-14
    (name "gdb-minimal")
    (inputs (fold alist-delete (package-inputs gdb)
                  '("libxml2" "ncurses" "python-wrapper" "source-highlight")))))

(define-public gdb-minimal-15
  (package/inherit gdb-15
    (name "gdb-minimal")
    (inputs (fold alist-delete (package-inputs gdb-15)
                  '("libxml2" "ncurses" "python-wrapper" "source-highlight")))))

(define-public avr-gdb
  (package/inherit gdb-14
    (name "avr-gdb")
    (arguments
     (substitute-keyword-arguments (package-arguments gdb-14)
       ((#:configure-flags flags '())
        #~(cons* "--target=avr"
                 "--disable-nls"
                 "--enable-languages=c,c++"
                 "--with-system-readline"
                 "--enable-source-highlight"
                 #$flags))))
    (synopsis "The GNU Debugger for AVR")
    (description
     "GDB is the GNU debugger.  With it, you can monitor what a program is
doing while it runs or what it was doing just before a crash.  It allows you
to specify the runtime conditions, to define breakpoints, and to change how
the program is running to try to fix bugs.

This variant of GDB can be used to debug programs written for the AVR
microcontroller architecture.")))
1> for the initial report. (service cow-store-service-type 'mooooh!)) (define (/etc/configuration-files _) "Return a list of tuples representing configuration templates to add to /etc." (define directory (computed-file "configuration-templates" (with-imported-modules '((guix build utils)) #~(begin (mkdir #$output) (for-each (lambda (file target) (copy-file file (string-append #$output "/" target))) '(#$(local-file "examples/bare-bones.tmpl") #$(local-file "examples/beaglebone-black.tmpl") #$(local-file "examples/desktop.tmpl") #$(local-file "examples/lightweight-desktop.tmpl")) '("bare-bones.scm" "beaglebone-black.scm" "desktop.scm" "lightweight-desktop.scm")) #t)))) `(("configuration" ,directory))) (define configuration-template-service-type (service-type (name 'configuration-template) (extensions (list (service-extension etc-service-type /etc/configuration-files))) (description "Install the operating system configuration file templates under @file{/etc/configuration}."))) (define %configuration-template-service (service configuration-template-service-type #t)) (define %nscd-minimal-caches ;; Minimal in-memory caching policy for nscd. (list (nscd-cache (database 'hosts) (positive-time-to-live (* 3600 12)) ;; Do not cache lookup failures at all since they are ;; quite likely (for instance when someone tries to ping a ;; host before networking is functional.) (negative-time-to-live 0) (persistent? #f) (max-database-size (* 5 (expt 2 20)))))) ;5 MiB ;; These define a service to load the uvesafb kernel module with the ;; appropriate options. The GUI installer needs it when the machine does not ;; support Kernel Mode Setting. Otherwise kmscon is missing /dev/fb0. (define (uvesafb-shepherd-service _) (define modprobe (program-file "modprobe-wrapper" #~(begin ;; Use a wrapper because shepherd 0.9.3 won't let us ;; pass environment variables to the child process: ;; <https://issues.guix.gnu.org/60106>. (setenv "LINUX_MODULE_DIRECTORY" "/run/booted-system/kernel/lib/modules") (apply execl #$(file-append kmod "/bin/modprobe") "modprobe" (cdr (command-line)))))) (list (shepherd-service (documentation "Load the uvesafb kernel module if needed.") (provision '(maybe-uvesafb)) (requirement '(file-systems)) (start #~(lambda () (or (file-exists? "/dev/fb0") (invoke #+modprobe "uvesafb" (string-append "v86d=" #$v86d "/sbin/v86d") "mode_option=1024x768")))) (respawn? #f) (one-shot? #t)))) (define uvesafb-service-type (service-type (name 'uvesafb) (extensions (list (service-extension shepherd-root-service-type uvesafb-shepherd-service))) (description "Load the @code{uvesafb} kernel module with the right options.") (default-value #t))) (define* (%installation-services #:key (system (or (and=> (%current-target-system) platform-target->system) (%current-system)))) ;; List of services of the installation system. (let ((motd (plain-file "motd" " \x1b[1;37mWelcome to the installation of GNU Guix!\x1b[0m \x1b[2m\ Using this shell, you can carry out the installation process \"manually.\" Access documentation at any time by pressing Alt-F2.\x1b[0m "))) (define (normal-tty tty) (service mingetty-service-type (mingetty-configuration (tty tty) (auto-login "root") (login-pause? #t)))) (define bare-bones-os (load "examples/bare-bones.tmpl")) (append ;; Generic services (list (service virtual-terminal-service-type) (service kmscon-service-type (kmscon-configuration (virtual-terminal "tty1") (login-program (installer-program)))) (service login-service-type (login-configuration (motd motd))) ;; Documentation. The manual is in UTF-8, but ;; 'console-font-service' sets up Unicode support and loads a font ;; with all the useful glyphs like em dash and quotation marks. (service documentation-service-type "tty2") ;; Documentation add-on. %configuration-template-service ;; A bunch of 'root' ttys. (normal-tty "tty3") (normal-tty "tty4") (normal-tty "tty5") (normal-tty "tty6") ;; The usual services. (service syslog-service-type) ;; Use the Avahi daemon to discover substitute servers on the local ;; network. It can be faster than fetching from remote servers. (service avahi-service-type) ;; The build daemon. (service guix-service-type (guix-configuration ;; Register the default substitute server key(s) as ;; trusted to allow the installation process to use ;; substitutes by default. (authorize-key? #t) ;; Install and run the current Guix rather than an older ;; snapshot. (guix (current-guix)))) ;; Start udev so that useful device nodes are available. ;; Use device-mapper rules for cryptsetup & co; enable the CRDA for ;; regulations-compliant WiFi access. (service udev-service-type (udev-configuration (rules (list lvm2 crda)))) ;; Add the 'cow-store' service, which users have to start manually ;; since it takes the installation directory as an argument. (cow-store-service) ;; Install Unicode support and a suitable font. (service console-font-service-type (map (match-lambda ("tty2" ;; Use a font that contains characters such as ;; curly quotes as found in the manual. '("tty2" . "LatGrkCyr-8x16")) (tty ;; Use a font that doesn't have more than 256 ;; glyphs so that we can use colors with varying ;; brightness levels (see note in setfont(8)). `(,tty . "lat9u-16"))) '("tty1" "tty2" "tty3" "tty4" "tty5" "tty6"))) ;; To facilitate copy/paste. (service gpm-service-type) ;; Add an SSH server to facilitate remote installs. (service openssh-service-type (openssh-configuration (port-number 22) (permit-root-login #t) ;; The root account is passwordless, so make sure ;; a password is set before allowing logins. (allow-empty-passwords? #f) (password-authentication? #t) ;; Don't start it upfront. (%auto-start? #f))) ;; Since this is running on a USB stick with a overlayfs as the root ;; file system, use an appropriate cache configuration. (service nscd-service-type (nscd-configuration (caches %nscd-minimal-caches))) ;; Having /bin/sh is a good idea. In particular it allows Tramp ;; connections to this system to work. (service special-files-service-type `(("/bin/sh" ,(file-append bash "/bin/sh")))) ;; Loopback device, needed by OpenSSH notably. (service static-networking-service-type (list %loopback-static-networking)) (service wpa-supplicant-service-type) (service dbus-root-service-type) (service connman-service-type (connman-configuration (disable-vpn? #t))) ;; Keep a reference to BARE-BONES-OS to make sure it can be ;; installed without downloading/building anything. Also keep the ;; things needed by 'profile-derivation' to minimize the amount of ;; download. (service gc-root-service-type (append (list bare-bones-os (libc-utf8-locales-for-target system) texinfo guile-3.0) %default-locale-libcs))) ;; Specific system services ;; Machines without Kernel Mode Setting (those with many old and ;; current AMD GPUs, SiS GPUs, ...) need uvesafb to show the GUI ;; installer. Some may also need a kernel parameter like nomodeset ;; or vga=793, but we leave that for the user to specify in GRUB. `(,@(if (supported-package? v86d system) (list (service uvesafb-service-type)) '()))))) (define %issue ;; Greeting. " \x1b[1;37mThis is an installation image of the GNU system. Welcome.\x1b[0m \x1b[1;33mUse Alt-F2 for documentation.\x1b[0m ") (define %installer-disk-utilities ;; A well-rounded set of packages for interacting with disks, partitions and ;; file systems, included with the Guix installation image. (list parted gptfdisk ddrescue ;; Use the static LVM2 because it's already pulled in by the installer. lvm2-static ;; We used to provide fdisk from GNU fdisk, but as of version 2.0.0a ;; it pulls Guile 1.8, which takes unreasonable space; furthermore ;; util-linux's fdisk is already available, in %base-packages-linux. cryptsetup mdadm dosfstools btrfs-progs e2fsprogs f2fs-tools jfsutils xfsprogs)) (define installation-os ;; The operating system used on installation images for USB sticks etc. (operating-system (host-name "gnu") (timezone "Europe/Paris") (locale "en_US.utf8") (name-service-switch %mdns-host-lookup-nss) (bootloader (bootloader-configuration (bootloader grub-bootloader) (targets '("/dev/sda")))) (label (string-append "GNU Guix installation " (or (getenv "GUIX_DISPLAYED_VERSION") (package-version guix)))) ;; XXX: The AMD Radeon driver is reportedly broken, which makes kmscon ;; non-functional: ;; <https://lists.gnu.org/archive/html/guix-devel/2019-03/msg00441.html>. ;; Thus, blacklist it. (kernel-arguments '("quiet" "modprobe.blacklist=radeon,amdgpu")) (file-systems ;; Note: the disk image build code overrides this root file system with ;; the appropriate one. (append %base-live-file-systems ;; XXX: This should be %BASE-FILE-SYSTEMS but we don't need ;; elogind's cgroup file systems. (list %pseudo-terminal-file-system %shared-memory-file-system %efivars-file-system %immutable-store))) (users (list (user-account (name "guest") (group "users") (supplementary-groups '("wheel")) ; allow use of sudo (password "") (comment "Guest of GNU")))) (issue %issue) (services (%installation-services)) ;; We don't need setuid programs, except for 'passwd', which can be handy ;; if one is to allow remote SSH login to the machine being installed. (privileged-programs (list (privileged-program (program (file-append shadow "/bin/passwd")) (setuid? #t)))) (pam-services ;; Explicitly allow for empty passwords. (base-pam-services #:allow-empty-passwords? #t)) (packages (append (list glibc ; for 'tzselect' & co. fontconfig font-dejavu font-gnu-unifont grub) ; mostly so xrefs to its manual work %installer-disk-utilities %base-packages)))) (define* (os-with-u-boot os board #:key (bootloader-target "/dev/mmcblk0") (triplet "arm-linux-gnueabihf")) "Given OS, amend it with the u-boot bootloader for BOARD, installed to BOOTLOADER-TARGET (a drive), compiled for TRIPLET. If you want a serial console, make sure to specify one in your operating-system's kernel-arguments (\"console=ttyS0\" or similar)." (operating-system (inherit os) (bootloader (bootloader-configuration (bootloader (bootloader (inherit u-boot-bootloader) (package (make-u-boot-package board triplet)))) (targets (list bootloader-target)))))) (define* (embedded-installation-os bootloader bootloader-target tty #:key (extra-modules '())) "Return an installation os for embedded systems. The initrd gets the extra modules EXTRA-MODULES. A getty is provided on TTY. The bootloader BOOTLOADER is installed to BOOTLOADER-TARGET." (operating-system (inherit installation-os) (bootloader (bootloader-configuration (bootloader bootloader) (targets (list bootloader-target)))) (kernel linux-libre) (kernel-arguments (cons (string-append "console=" tty) (operating-system-user-kernel-arguments installation-os))) (initrd-modules (append extra-modules %base-initrd-modules)))) (define beaglebone-black-installation-os (embedded-installation-os u-boot-beaglebone-black-bootloader "/dev/sda" "ttyO0" #:extra-modules ;; This module is required to mount the sd card. '("omap_hsmmc"))) (define a20-olinuxino-lime-installation-os (embedded-installation-os u-boot-a20-olinuxino-lime-bootloader "/dev/mmcblk0" ; SD card storage "ttyS0")) (define a20-olinuxino-lime2-emmc-installation-os (embedded-installation-os u-boot-a20-olinuxino-lime2-bootloader "/dev/mmcblk1" ; eMMC storage "ttyS0")) (define a20-olinuxino-micro-installation-os (embedded-installation-os u-boot-a20-olinuxino-micro-bootloader "/dev/mmcblk0" ; SD card storage "ttyS0")) (define bananapi-m2-ultra-installation-os (embedded-installation-os u-boot-bananapi-m2-ultra-bootloader "/dev/mmcblk1" ; eMMC storage "ttyS0")) (define firefly-rk3399-installation-os (embedded-installation-os u-boot-firefly-rk3399-bootloader "/dev/mmcblk0" ; SD card/eMMC (SD priority) storage "ttyS2")) ; UART2 connected on the Pi2 bus (define mx6cuboxi-installation-os (embedded-installation-os u-boot-mx6cuboxi-bootloader "/dev/mmcblk0" ; SD card storage "ttymxc0")) (define novena-installation-os (embedded-installation-os u-boot-novena-bootloader "/dev/mmcblk1" ; SD card storage "ttymxc1")) (define nintendo-nes-classic-edition-installation-os (embedded-installation-os u-boot-nintendo-nes-classic-edition-bootloader "/dev/mmcblk0" ; SD card (solder it yourself) "ttyS0")) (define orangepi-r1-plus-lts-rk3328-installation-os (embedded-installation-os u-boot-orangepi-r1-plus-lts-rk3328-bootloader "/dev/mmcblk0" ; SD card storage "ttyS0")) (define pine64-plus-installation-os (embedded-installation-os u-boot-pine64-plus-bootloader "/dev/mmcblk0" ; SD card storage "ttyS0")) (define pinebook-installation-os (embedded-installation-os u-boot-pinebook-bootloader "/dev/mmcblk0" ; SD card storage "ttyS0")) (define rock64-installation-os (embedded-installation-os u-boot-rock64-rk3328-bootloader "/dev/mmcblk0" ; SD card/eMMC (SD priority) storage "ttyS2")) ; UART2 connected on the Pi2 bus (define rockpro64-installation-os (embedded-installation-os u-boot-rockpro64-rk3399-bootloader "/dev/mmcblk0" ; SD card/eMMC (SD priority) storage "ttyS2")) ; UART2 connected on the Pi2 bus (define rk3399-puma-installation-os (embedded-installation-os u-boot-puma-rk3399-bootloader "/dev/mmcblk0" ; SD card storage "ttyS0")) (define wandboard-installation-os (embedded-installation-os u-boot-wandboard-bootloader "/dev/mmcblk0" ; SD card storage "ttymxc0")) ;; Return the default os here so 'guix system' can consume it directly. installation-os ;;; install.scm ends here