;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès ;;; Copyright © 2014, 2019 Andreas Enge ;;; Copyright © 2012 Nikita Karetnikov ;;; Copyright © 2014, 2015, 2016, 2018 Mark H Weaver ;;; Copyright © 2014 Alex Kost ;;; Copyright © 2014, 2015 Manolis Fragkiskos Ragkousis ;;; Copyright © 2016, 2017, 2019, 2020, 2021 Efraim Flashner ;;; Copyright © 2016, 2020 Jan (janneke) Nieuwenhuizen ;;; Copyright © 2016, 2018 Alex Vong ;;; Copyright © 2017 Rene Saavedra ;;; Copyright © 2017, 2020 Mathieu Othacehe ;;; Copyright © 2017, 2018, 2020 Marius Bakke ;;; Copyright © 2017 Eric Bavier ;;; Copyright © 2018 Tobias Geerinckx-Rice ;;; Copyright © 2018, 2019 Ricardo Wurmus ;;; Copyright © 2020 Vitaliy Shatrov ;;; Copyright © 2020 Chris Marusich ;;; Copyright © 2021 Leo Le Bouter ;;; Copyright © 2021 Maxime Devos ;;; Copyright © 2021 Guillaume Le Vaillant ;;; Copyright © 2021 Maxim Cournoyer ;;; ;;; 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 ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2024 Dariqq <dariqq@posteo.net> ;;; Copyright © 2024 Ian Eure <ian@retrospec.tv> ;;; ;;; 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 services pm) #:use-module (srfi srfi-1) #:use-module (ice-9 match) #:use-module (guix gexp) #:use-module (guix packages) #:use-module (guix records) #:use-module (gnu packages admin) #:use-module (gnu packages freedesktop) #:use-module (gnu packages linux) #:use-module (gnu services) #:use-module (gnu services base) #:use-module (gnu services configuration) #:use-module (gnu services dbus) #:use-module (gnu services shepherd) #:use-module (gnu system shadow) #:export (power-profiles-daemon-service-type power-profiles-daemon-configuration tlp-service-type tlp-configuration thermald-configuration thermald-service-type powertop-configuration powertop-service-type)) ;;; ;;; power-profiles-daemon ;;; (define-configuration/no-serialization power-profiles-daemon-configuration (power-profiles-daemon (file-like power-profiles-daemon) "The power-profiles-daemon package.")) (define (power-profiles-daemon-shepherd-service config) (match-record config <power-profiles-daemon-configuration> (power-profiles-daemon) (list (shepherd-service (provision '(power-profiles-daemon)) (requirement '(user-processes dbus-system)) (documentation "Run the Power Profiles Daemon.") (start #~(make-forkexec-constructor (list #$(file-append power-profiles-daemon "/libexec/power-profiles-daemon")))) (stop #~(make-kill-destructor)))))) (define %power-profiles-daemon-activation #~(begin (use-modules (guix build utils)) (mkdir-p "/var/lib/power-profiles-daemon"))) (define power-profiles-daemon-service-type (let ((config->package (compose list power-profiles-daemon-configuration-power-profiles-daemon))) (service-type (name 'power-profiles-daemon) (extensions (list (service-extension shepherd-root-service-type power-profiles-daemon-shepherd-service) (service-extension dbus-root-service-type config->package) (service-extension polkit-service-type config->package) (service-extension profile-service-type config->package) (service-extension activation-service-type (const %power-profiles-daemon-activation)))) (default-value (power-profiles-daemon-configuration)) (description "Run the Power Profiles Daemon")))) ;;; ;;; tlp ;;; (define (uglify-field-name field-name) (let ((str (symbol->string field-name))) (string-join (string-split (string-upcase (if (string-suffix? "?" str) (substring str 0 (1- (string-length str))) str)) #\-) "_"))) (define (serialize-field field-name val) (format #t "~a=~a\n" (uglify-field-name field-name) val)) (define (serialize-boolean field-name val) (serialize-field field-name (if val "1" "0"))) (define-maybe boolean) (define (serialize-string field-name val) (serialize-field field-name val)) (define-maybe string) (define (space-separated-string-list? val) (and (list? val) (and-map (lambda (x) (and (string? x) (not (string-index x #\space)))) val))) (define (serialize-space-separated-string-list field-name val) (serialize-field field-name (format #f "~s" (string-join val " ")))) (define-maybe space-separated-string-list) (define (non-negative-integer? val) (and (exact-integer? val) (not (negative? val)))) (define (serialize-non-negative-integer field-name val) (serialize-field field-name val)) (define-maybe non-negative-integer) (define (on-off-boolean? val) (boolean? val)) (define (serialize-on-off-boolean field-name val) (serialize-field field-name (if val "on" "off"))) (define-maybe on-off-boolean) (define (y-n-boolean? val) (boolean? val)) (define (serialize-y-n-boolean field-name val) (serialize-field field-name (if val "Y" "N"))) (define-configuration tlp-configuration (tlp (file-like tlp) "The TLP package.") (tlp-enable? (boolean #t) "Set to true if you wish to enable TLP.") (tlp-default-mode (string "AC") "Default mode when no power supply can be detected. Alternatives are AC and BAT.") (disk-idle-secs-on-ac (non-negative-integer 0) "Number of seconds Linux kernel has to wait after the disk goes idle, before syncing on AC.") (disk-idle-secs-on-bat (non-negative-integer 2) "Same as @code{disk-idle-ac} but on BAT mode.") (max-lost-work-secs-on-ac (non-negative-integer 15) "Dirty pages flushing periodicity, expressed in seconds.") (max-lost-work-secs-on-bat (non-negative-integer 60) "Same as @code{max-lost-work-secs-on-ac} but on BAT mode.") (cpu-scaling-governor-on-ac maybe-space-separated-string-list "CPU frequency scaling governor on AC mode. With intel_pstate driver, alternatives are powersave and performance. With acpi-cpufreq driver, alternatives are ondemand, powersave, performance and conservative.") (cpu-scaling-governor-on-bat maybe-space-separated-string-list "Same as @code{cpu-scaling-governor-on-ac} but on BAT mode.") (cpu-scaling-min-freq-on-ac maybe-non-negative-integer "Set the min available frequency for the scaling governor on AC.") (cpu-scaling-max-freq-on-ac maybe-non-negative-integer "Set the max available frequency for the scaling governor on AC.") (cpu-scaling-min-freq-on-bat maybe-non-negative-integer "Set the min available frequency for the scaling governor on BAT.") (cpu-scaling-max-freq-on-bat maybe-non-negative-integer "Set the max available frequency for the scaling governor on BAT.") (cpu-min-perf-on-ac maybe-non-negative-integer "Limit the min P-state to control the power dissipation of the CPU, in AC mode. Values are stated as a percentage of the available performance.") (cpu-max-perf-on-ac maybe-non-negative-integer "Limit the max P-state to control the power dissipation of the CPU, in AC mode. Values are stated as a percentage of the available performance.") (cpu-min-perf-on-bat maybe-non-negative-integer "Same as @code{cpu-min-perf-on-ac} on BAT mode.") (cpu-max-perf-on-bat maybe-non-negative-integer "Same as @code{cpu-max-perf-on-ac} on BAT mode.") (cpu-boost-on-ac? maybe-boolean "Enable CPU turbo boost feature on AC mode.") (cpu-boost-on-bat? maybe-boolean "Same as @code{cpu-boost-on-ac?} on BAT mode.") (sched-powersave-on-ac? (boolean #f) "Allow Linux kernel to minimize the number of CPU cores/hyper-threads used under light load conditions.") (sched-powersave-on-bat? (boolean #t) "Same as @code{sched-powersave-on-ac?} but on BAT mode.") (nmi-watchdog? (boolean #f) "Enable Linux kernel NMI watchdog.") (phc-controls maybe-string "For Linux kernels with PHC patch applied, change CPU voltages. An example value would be @samp{\"F:V F:V F:V F:V\"}.") (energy-perf-policy-on-ac (string "performance") "Set CPU performance versus energy saving policy on AC. Alternatives are performance, normal, powersave.") (energy-perf-policy-on-bat (string "powersave") "Same as @code{energy-perf-policy-ac} but on BAT mode.") (disks-devices (space-separated-string-list '("sda")) "Hard disk devices.") (disk-apm-level-on-ac (space-separated-string-list '("254" "254")) "Hard disk advanced power management level.") (disk-apm-level-on-bat (space-separated-string-list '("128" "128")) "Same as @code{disk-apm-bat} but on BAT mode.") (disk-spindown-timeout-on-ac maybe-space-separated-string-list "Hard disk spin down timeout. One value has to be specified for each declared hard disk.") (disk-spindown-timeout-on-bat maybe-space-separated-string-list "Same as @code{disk-spindown-timeout-on-ac} but on BAT mode.") (disk-iosched maybe-space-separated-string-list "Select IO scheduler for disk devices. One value has to be specified for each declared hard disk. Example alternatives are cfq, deadline and noop.") (sata-linkpwr-on-ac (string "max_performance") "SATA aggressive link power management (ALPM) level. Alternatives are min_power, medium_power, max_performance.") (sata-linkpwr-on-bat (string "min_power") "Same as @code{sata-linkpwr-ac} but on BAT mode.") (sata-linkpwr-blacklist maybe-string "Exclude specified SATA host devices for link power management.") (ahci-runtime-pm-on-ac? maybe-on-off-boolean "Enable Runtime Power Management for AHCI controller and disks on AC mode.") (ahci-runtime-pm-on-bat? maybe-on-off-boolean "Same as @code{ahci-runtime-pm-on-ac} on BAT mode.") (ahci-runtime-pm-timeout (non-negative-integer 15) "Seconds of inactivity before disk is suspended.") (pcie-aspm-on-ac (string "performance") "PCI Express Active State Power Management level. Alternatives are default, performance, powersave.") (pcie-aspm-on-bat (string "powersave") "Same as @code{pcie-aspm-ac} but on BAT mode.") (start-charge-thresh-bat0 maybe-non-negative-integer "Percentage when battery 0 should begin charging.") (stop-charge-thresh-bat0 maybe-non-negative-integer "Percentage when battery 0 should stop charging.") (start-charge-thresh-bat1 maybe-non-negative-integer "Percentage when battery 1 should begin charging.") (stop-charge-thresh-bat1 maybe-non-negative-integer "Percentage when battery 1 should stop charging.") (radeon-power-profile-on-ac (string "high") "Radeon graphics clock speed level. Alternatives are low, mid, high, auto, default.") (radeon-power-profile-on-bat (string "low") "Same as @code{radeon-power-ac} but on BAT mode.") (radeon-dpm-state-on-ac (string "performance") "Radeon dynamic power management method (DPM). Alternatives are battery, performance.") (radeon-dpm-state-on-bat (string "battery") "Same as @code{radeon-dpm-state-ac} but on BAT mode.") (radeon-dpm-perf-level-on-ac (string "auto") "Radeon DPM performance level. Alternatives are auto, low, high.") (radeon-dpm-perf-level-on-bat (string "auto") "Same as @code{radeon-dpm-perf-ac} but on BAT mode.") (wifi-pwr-on-ac? (on-off-boolean #f) "Wifi power saving mode.") (wifi-pwr-on-bat? (on-off-boolean #t) "Same as @code{wifi-power-ac?} but on BAT mode.") (wol-disable? (y-n-boolean #t) "Disable wake on LAN.") (sound-power-save-on-ac (non-negative-integer 0) "Timeout duration in seconds before activating audio power saving on Intel HDA and AC97 devices. A value of 0 disables power saving.") (sound-power-save-on-bat (non-negative-integer 1) "Same as @code{sound-powersave-ac} but on BAT mode.") (sound-power-save-controller? (y-n-boolean #t) "Disable controller in powersaving mode on Intel HDA devices.") (bay-poweroff-on-bat? (boolean #f) "Enable optical drive in UltraBay/MediaBay on BAT mode. Drive can be powered on again by releasing (and reinserting) the eject lever or by pressing the disc eject button on newer models.") (bay-device (string "sr0") "Name of the optical drive device to power off.") (runtime-pm-on-ac (string "on") "Runtime Power Management for PCI(e) bus devices. Alternatives are on and auto.") (runtime-pm-on-bat (string "auto") "Same as @code{runtime-pm-ac} but on BAT mode.") (runtime-pm-all? (boolean #t) "Runtime Power Management for all PCI(e) bus devices, except blacklisted ones.") (runtime-pm-blacklist maybe-space-separated-string-list "Exclude specified PCI(e) device addresses from Runtime Power Management.") (runtime-pm-driver-blacklist (space-separated-string-list '("radeon" "nouveau")) "Exclude PCI(e) devices assigned to the specified drivers from Runtime Power Management.") (usb-autosuspend? (boolean #t) "Enable USB autosuspend feature.") (usb-blacklist maybe-string "Exclude specified devices from USB autosuspend.") (usb-blacklist-wwan? (boolean #t) "Exclude WWAN devices from USB autosuspend.") (usb-whitelist maybe-string "Include specified devices into USB autosuspend, even if they are already excluded by the driver or via @code{usb-blacklist-wwan?}.") (usb-autosuspend-disable-on-shutdown? maybe-boolean "Enable USB autosuspend before shutdown.") (restore-device-state-on-startup? (boolean #f) "Restore radio device state (bluetooth, wifi, wwan) from previous shutdown on system startup.")) (define (tlp-shepherd-service config) (let* ((tlp-bin (file-append (tlp-configuration-tlp config) "/bin/tlp")) (tlp-action (lambda args #~(lambda _ (zero? (system* #$tlp-bin #$@args)))))) (list (shepherd-service (documentation "Run TLP script.") (provision '(tlp)) (requirement '(user-processes)) (start (tlp-action "init" "start")) (stop (tlp-action "init" "stop")))))) (define (tlp-activation config) (let* ((config-str (with-output-to-string (lambda () (serialize-configuration config tlp-configuration-fields)))) (config-file (plain-file "tlp" config-str))) (with-imported-modules '((guix build utils)) #~(begin (use-modules (guix build utils)) (copy-file #$config-file "/etc/tlp.conf"))))) (define tlp-service-type (service-type (name 'tlp) (extensions (list (service-extension shepherd-root-service-type tlp-shepherd-service) (service-extension udev-service-type (compose list tlp-configuration-tlp)) (service-extension activation-service-type tlp-activation))) (default-value (tlp-configuration)) (description "Run TLP, a power management tool."))) (define (generate-tlp-documentation) (generate-documentation `((tlp-configuration ,tlp-configuration-fields)) 'tlp-configuration)) ;;; ;;; thermald ;;; ;;; This service implements cpu scaling. Helps prevent overheating! (define-record-type* <thermald-configuration> thermald-configuration make-thermald-configuration thermald-configuration? (adaptive? thermald-adaptive? ;boolean (default #f)) (ignore-cpuid-check? thermald-ignore-cpuid-check? ;boolean (default #f)) (thermald thermald-thermald ;file-like (default thermald))) (define (thermald-shepherd-service config) (list (shepherd-service (provision '(thermald)) (documentation "Run thermald cpu frequency scaling.") (start #~(make-forkexec-constructor '(#$(file-append (thermald-thermald config) "/sbin/thermald") "--no-daemon" #$@(if (thermald-adaptive? config) '("--adaptive") '()) #$@(if (thermald-ignore-cpuid-check? config) '("--ignore-cpuid-check") '())))) (stop #~(make-kill-destructor))))) (define thermald-service-type (service-type (name 'thermald) (extensions (list (service-extension shepherd-root-service-type thermald-shepherd-service))) (default-value (thermald-configuration)) (description "Run thermald, a CPU frequency scaling service that helps prevent overheating."))) ;;; ;;; powertop ;;; ;;; Calls `powertop --auto-tune' to reduce energy consumption. (define-configuration powertop-configuration (powertop (package powertop) "PowerTOP package to use.")) (define powertop-shepherd-service (match-lambda (($ <powertop-configuration> powertop) (shepherd-service (documentation "Tune kernel power settings at boot.") (provision '(powertop powertop-auto-tune)) (requirement '(user-processes)) (one-shot? #t) (start #~(lambda _ (zero? (system* #$(file-append powertop "/sbin/powertop") "--auto-tune")))))))) (define powertop-service-type (service-type (name 'powertop) (extensions (list (service-extension shepherd-root-service-type (compose list powertop-shepherd-service)))) (compose concatenate) (default-value (powertop-configuration)) (description "Tune power-related kernel parameters to reduce energy consumption."))) .2.1") (source (origin (method url-fetch) (uri (string-append "mirror://gnu/make/make-" version ".tar.bz2")) (sha256 (base32 "12f5zzyq2w56g95nni65hc0g5p7154033y2f3qmjvd016szn5qnn")))) (arguments `(#:configure-flags '("CFLAGS=-D__alloca=alloca -D__stat=stat") #:phases (modify-phases %standard-phases (add-before 'build 'set-default-shell (lambda* (#:key inputs #:allow-other-keys) ;; Change the default shell from /bin/sh. (let ((bash (assoc-ref inputs "bash"))) (substitute* "job.c" (("default_shell =.*$") (format #f "default_shell = \"~a/bin/sh\";\n" bash))))))))))) (define-public binutils (package (name "binutils") (version "2.37") (source (origin (method url-fetch) (uri (string-append "mirror://gnu/binutils/binutils-" version ".tar.bz2")) (sha256 (base32 "1m3b2rdfv1dmdpd0bzg1hy7i8a2qng53szc6livyi3nh6101mz37")) (patches (search-patches "binutils-loongson-workaround.patch" "binutils-2.37-file-descriptor-leak.patch")))) (build-system gnu-build-system) ;; TODO: Add dependency on zlib + those for Gold. (arguments `(#:configure-flags '(;; Add `-static-libgcc' to not retain a dependency ;; on GCC when bootstrapping. "LDFLAGS=-static-libgcc" ;; Turn on --enable-new-dtags by default to make the ;; linker set RUNPATH instead of RPATH on binaries. ;; This is important because RUNPATH can be overriden ;; using LD_LIBRARY_PATH at runtime. "--enable-new-dtags" ;; Don't search under /usr/lib & co. "--with-lib-path=/no-ld-lib-path" ;; Install BFD. It ends up in a hidden directory, ;; but it's here. "--enable-install-libbfd" ;; Make sure 'ar' and 'ranlib' produce archives in a ;; deterministic fashion. "--enable-deterministic-archives"))) (synopsis "Binary utilities: bfd gas gprof ld") (description "GNU Binutils is a collection of tools for working with binary files. Perhaps the most notable are \"ld\", a linker, and \"as\", an assembler. Other tools include programs to display binary profiling information, list the strings in a binary file, and utilities for working with archives. The \"bfd\" library for working with executable and object formats is also included.") (license gpl3+) (home-page "https://www.gnu.org/software/binutils/"))) ;; FIXME: ath9k-firmware-htc-binutils.patch do not apply on 2.34 because of a ;; big refactoring of xtensa-modules.c (commit 567607c11fbf7105 upstream). ;; Keep this version around until the patch is updated. (define-public binutils-2.33 (package (inherit binutils) (version "2.33.1") (source (origin (inherit (package-source binutils)) (uri (string-append "mirror://gnu/binutils/binutils-" version ".tar.bz2")) (sha256 (base32 "1cmd0riv37bqy9mwbg6n3523qgr8b3bbm5kwj19sjrasl4yq9d0c")))) (arguments (substitute-keyword-arguments (package-arguments binutils) ((#:make-flags _ ''()) ''()))) (properties '()))) (define-public binutils-gold (package/inherit binutils (name "binutils-gold") (arguments `(#:phases (modify-phases %standard-phases (add-after 'patch-source-shebangs 'patch-more-shebangs (lambda _ (substitute* "gold/Makefile.in" (("/bin/sh") (which "sh")))))) ,@(substitute-keyword-arguments (package-arguments binutils) ; Upstream is aware of unrelocatable test failures on arm*. ((#:tests? _ #f) (if (any (cute string-prefix? <> (or (%current-target-system) (%current-system))) '("i686" "x86_64")) '#t '#f)) ((#:configure-flags flags) `(cons* "--enable-gold=default" (delete "LDFLAGS=-static-libgcc" ,flags)))))) (native-inputs `(("bc" ,bc))) (inputs `(("gcc:lib" ,(canonical-package gcc) "lib"))))) (define* (make-ld-wrapper name #:key (target (const #f)) binutils (linker "ld") (guile (canonical-package guile-3.0)) (bash (canonical-package bash)) (guile-for-build guile)) "Return a package called NAME that contains a wrapper for the 'ld' program of BINUTILS, which adds '-rpath' flags to the actual 'ld' command line. The wrapper uses GUILE and BASH. TARGET must be a one-argument procedure that, given a system type, returns a cross-compilation target triplet or #f. When the result is not #f, make a wrapper for the cross-linker for that target, called 'TARGET-ld'. To use a different linker than the default \"ld\", such as \"ld.gold\" the linker name can be provided via the LINKER argument." ;; Note: #:system->target-triplet is a procedure so that the evaluation of ;; its result can be delayed until the 'arguments' field is evaluated, thus ;; in a context where '%current-system' is accurate. (package (name name) (version "0") (source #f) (build-system trivial-build-system) (inputs `(("binutils" ,binutils) ("guile" ,guile) ("bash" ,bash) ("wrapper" ,(search-path %load-path "gnu/packages/ld-wrapper.in")))) (arguments (let ((target (target (%current-system)))) `(#:guile ,guile-for-build #:modules ((guix build utils)) #:builder (begin (use-modules (guix build utils) (system base compile)) (let* ((out (assoc-ref %outputs "out")) (bin (string-append out "/bin")) (ld ,(if target `(string-append bin "/" ,target "-" ,linker) `(string-append bin "/" ,linker))) (go (string-append ld ".go"))) (setvbuf (current-output-port) (cond-expand (guile-2.0 _IOLBF) (else 'line))) (format #t "building ~s/bin/ld wrapper in ~s~%" (assoc-ref %build-inputs "binutils") out) (mkdir-p bin) (copy-file (assoc-ref %build-inputs "wrapper") ld) (substitute* ld (("@SELF@") ld) (("@GUILE@") (string-append (assoc-ref %build-inputs "guile") "/bin/guile")) (("@BASH@") (string-append (assoc-ref %build-inputs "bash") "/bin/bash")) (("@LD@") (string-append (assoc-ref %build-inputs "binutils") ,(if target (string-append "/bin/" target "-" linker) (string-append "/bin/" linker))))) (chmod ld #o555) (compile-file ld #:output-file go)))))) (synopsis "The linker wrapper") (description "The linker wrapper (or @code{ld-wrapper}) wraps the linker to add any missing @code{-rpath} flags, and to detect any misuse of libraries outside of the store.") (home-page "https://www.gnu.org/software/guix//") (license gpl3+))) (define-public glibc ;; This is the GNU C Library, used on GNU/Linux and GNU/Hurd. Prior to ;; version 2.28, GNU/Hurd used a different glibc branch. (package (name "glibc") (version "2.33") (source (origin (method url-fetch) (uri (string-append "mirror://gnu/glibc/glibc-" version ".tar.xz")) (sha256 (base32 "1zvp0qdfbdyqrzydz18d9zg3n5ygy8ps7cmny1bvsp8h1q05c99f")) (patches (search-patches "glibc-ldd-powerpc.patch" "glibc-ldd-x86_64.patch" "glibc-dl-cache.patch" "glibc-versioned-locpath.patch" "glibc-allow-kernel-2.6.32.patch" "glibc-reinstate-prlimit64-fallback.patch" "glibc-supported-locales.patch" "glibc-cross-objdump.patch" "glibc-cross-objcopy.patch" ;must come 2nd "glibc-hurd-clock_t_centiseconds.patch" "glibc-hurd-clock_gettime_monotonic.patch" "glibc-hurd-mach-print.patch" "glibc-hurd-gettyent.patch")))) (build-system gnu-build-system) ;; Glibc's refers to , for instance, so glibc ;; users should automatically pull Linux headers as well. On GNU/Hurd, ;; libc provides , which includes a bunch of Hurd and Mach headers, ;; so both should be propagated. (propagated-inputs (if (hurd-target?) `(("hurd-core-headers" ,hurd-core-headers)) `(("kernel-headers" ,linux-libre-headers)))) (outputs '("out" "debug" "static")) ;9 MiB of .a files (arguments `(#:out-of-source? #t ;; The libraries have an empty RUNPATH, but some, such as the versioned ;; libraries (libdl-2.24.so, etc.) have ld.so marked as NEEDED. Since ;; these libraries are always going to be found anyway, just skip ;; RUNPATH checks. #:validate-runpath? #f #:modules ((ice-9 ftw) (srfi srfi-26) (guix build utils) (guix build gnu-build-system)) #:configure-flags (list "--sysconfdir=/etc" ;; Installing a locale archive with all the locales is to ;; expensive (~100 MiB), so we rely on users to install the ;; locales they really want. ;; ;; Set the default locale path. In practice, $LOCPATH may be ;; defined to point whatever locales users want. However, setuid ;; binaries don't honor $LOCPATH, so they'll instead look into ;; $libc_cv_complocaledir; we choose /run/current-system/locale/X.Y, ;; with the idea that it is going to be populated by the sysadmin. ;; The "X.Y" sub-directory is because locale data formats are ;; incompatible across libc versions; see ;; . ;; ;; `--localedir' is not honored, so work around it. ;; See . (string-append "libc_cv_complocaledir=/run/current-system/locale/" ,(version-major+minor version)) (string-append "--with-headers=" (assoc-ref ,(if (%current-target-system) '%build-target-inputs '%build-inputs) "kernel-headers") "/include") ;; This is the default for most architectures as of GNU libc 2.26, ;; but we specify it explicitly for clarity and consistency. See ;; "kernel-features.h" in the GNU libc for details. "--enable-kernel=3.2.0" ;; Use our Bash instead of /bin/sh. (string-append "BASH_SHELL=" (assoc-ref %build-inputs "bash") "/bin/bash") ;; On GNU/Hurd we get discarded-qualifiers warnings for ;; 'device_write_inband' among other things. Ignore them. ,@(if (hurd-target?) '("--disable-werror") '())) #:tests? #f ; XXX #:phases (modify-phases %standard-phases (add-before 'configure 'pre-configure (lambda* (#:key inputs native-inputs outputs #:allow-other-keys) (let* ((out (assoc-ref outputs "out")) (bin (string-append out "/bin")) ;; FIXME: Normally we would look it up only in INPUTS ;; but cross-base uses it as a native input. (bash (or (assoc-ref inputs "static-bash") (assoc-ref native-inputs "static-bash")))) ;; Install the rpc data base file under `$out/etc/rpc'. (substitute* "inet/Makefile" (("^\\$\\(inst_sysconfdir\\)/rpc(.*)$" _ suffix) (string-append out "/etc/rpc" suffix "\n")) (("^install-others =.*$") (string-append "install-others = " out "/etc/rpc\n"))) (substitute* "Makeconfig" ;; According to ;; , ;; linking against libgcc_s is not needed with GCC ;; 4.7.1. ((" -lgcc_s") "")) ;; Tell the ld.so cache code where the store is. (substitute* "elf/dl-cache.c" (("@STORE_DIRECTORY@") (string-append "\"" (%store-directory) "\""))) ;; Have `system' use that Bash. (substitute* "sysdeps/posix/system.c" (("#define[[:blank:]]+SHELL_PATH.*$") (format #f "#define SHELL_PATH \"~a/bin/bash\"\n" bash))) ;; Same for `popen'. (substitute* "libio/iopopen.c" (("/bin/sh") (string-append bash "/bin/sh"))) ;; Same for the shell used by the 'exec' functions for ;; scripts that lack a shebang. (substitute* (find-files "." "^paths\\.h$") (("#define[[:blank:]]+_PATH_BSHELL[[:blank:]].*$") (string-append "#define _PATH_BSHELL \"" bash "/bin/sh\"\n"))) ;; Make sure we don't retain a reference to the ;; bootstrap Perl. (substitute* "malloc/mtrace.pl" (("^#!.*") ;; The shebang can be omitted, because there's the ;; "bilingual" eval/exec magic at the top of the file. "") (("exec @PERL@") "exec perl"))))) (add-after 'install 'move-static-libs (lambda* (#:key outputs #:allow-other-keys) ;; Move static libraries to the "static" output. (define (static-library? file) ;; Return true if FILE is a static library. The ;; "_nonshared.a" files are referred to by libc.so, ;; libpthread.so, etc., which are in fact linker ;; scripts. (and (string-suffix? ".a" file) (not (string-contains file "_nonshared")))) (define (linker-script? file) ;; Guess whether FILE, a ".a" file, is actually a ;; linker script. (and (not (ar-file? file)) (not (elf-file? file)))) (let* ((out (assoc-ref outputs "out")) (lib (string-append out "/lib")) (files (scandir lib static-library?)) (static (assoc-ref outputs "static")) (slib (string-append static "/lib"))) (mkdir-p slib) (for-each (lambda (base) (rename-file (string-append lib "/" base) (string-append slib "/" base))) files) ;; Usually libm.a is a linker script so we need to ;; change the file names in there to refer to STATIC ;; instead of OUT. (for-each (lambda (ld-script) (substitute* ld-script ((out) static))) (filter linker-script? (map (cut string-append slib "/" <>) files)))))) ,@(if (hurd-target?) '((add-after 'install 'augment-libc.so (lambda* (#:key outputs #:allow-other-keys) (let* ((out (assoc-ref outputs "out"))) (substitute* (string-append out "/lib/libc.so") (("/[^ ]+/lib/libc.so.0.3") (string-append out "/lib/libc.so.0.3" " libmachuser.so libhurduser.so"))))))) '())))) (inputs `(("static-bash" ,static-bash))) ;; To build the manual, we need Texinfo and Perl. Gettext is needed to ;; install the message catalogs, with 'msgfmt'. (native-inputs `(("texinfo" ,texinfo) ("perl" ,perl) ("bison" ,bison) ("gettext" ,gettext-minimal) ("python" ,python-minimal) ,@(if (hurd-target?) `(("mig" ,mig) ("perl" ,perl)) '()))) (native-search-paths ;; Search path for packages that provide locale data. This is useful ;; primarily in build environments. Use 'GUIX_LOCPATH' rather than ;; 'LOCPATH' to avoid interference with the host system's libc on foreign ;; distros. (list (search-path-specification (variable "GUIX_LOCPATH") (files '("lib/locale"))))) (synopsis "The GNU C Library") (description "Any Unix-like operating system needs a C library: the library which defines the \"system calls\" and other basic facilities such as open, malloc, printf, exit... The GNU C library is used as the C library in the GNU system and most systems with the Linux kernel.") (license lgpl2.0+) (home-page "https://www.gnu.org/software/libc/"))) ;; Below are old libc versions, which we use mostly to build locale data in ;; the old format (which the new libc cannot cope with.) (define-public glibc-2.31 (package (inherit glibc) (version "2.31") (source (origin (inherit (package-source glibc)) (uri (string-append "mirror://gnu/glibc/glibc-" version ".tar.xz")) (sha256 (base32 "05zxkyz9bv3j9h0xyid1rhvh3klhsmrpkf3bcs6frvlgyr2gwilj")) (patches (search-patches "glibc-skip-c++.patch" "glibc-ldd-powerpc.patch" "glibc-ldd-x86_64.patch" "glibc-dl-cache.patch" "glibc-hidden-visibility-ldconfig.patch" "glibc-versioned-locpath.patch" "glibc-allow-kernel-2.6.32.patch" "glibc-reinstate-prlimit64-fallback.patch" "glibc-supported-locales.patch" "glibc-hurd-clock_t_centiseconds.patch" "glibc-2.31-hurd-clock_gettime_monotonic.patch" "glibc-hurd-signal-sa-siginfo.patch" "glibc-hurd-mach-print.patch" "glibc-hurd-gettyent.patch")))) (arguments (substitute-keyword-arguments (package-arguments glibc) ((#:phases phases) `(modify-phases ,phases (add-before 'configure 'set-etc-rpc-installation-directory (lambda* (#:key outputs #:allow-other-keys) ;; Install the rpc data base file under `$out/etc/rpc'. (let ((out (assoc-ref outputs "out"))) (substitute* "sunrpc/Makefile" (("^\\$\\(inst_sysconfdir\\)/rpc(.*)$" _ suffix) (string-append out "/etc/rpc" suffix "\n")) (("^install-others =.*$") (string-append "install-others = " out "/etc/rpc\n")))))))))))) (define-public glibc-2.30 (package (inherit glibc-2.31) (version "2.30") (native-inputs ;; This fails with a build error in libc-tls.c when using GCC 10. Use an ;; older compiler. (modify-inputs (package-native-inputs glibc) (prepend gcc-8))) (source (origin (inherit (package-source glibc)) (uri (string-append "mirror://gnu/glibc/glibc-" version ".tar.xz")) (sha256 (base32 "1bxqpg91d02qnaz837a5kamm0f43pr1il4r9pknygywsar713i72")) (patches (search-patches "glibc-skip-c++.patch" "glibc-ldd-x86_64.patch" "glibc-CVE-2019-19126.patch" "glibc-hidden-visibility-ldconfig.patch" "glibc-versioned-locpath.patch" "glibc-allow-kernel-2.6.32.patch" "glibc-reinstate-prlimit64-fallback.patch" "glibc-2.29-supported-locales.patch")))))) (define-public glibc-2.29 (package (inherit glibc-2.30) (version "2.29") (source (origin (inherit (package-source glibc)) (uri (string-append "mirror://gnu/glibc/glibc-" version ".tar.xz")) (sha256 (base32 "0jzh58728flfh939a8k9pi1zdyalfzlxmwra7k0rzji5gvavivpk")) (patches (search-patches "glibc-skip-c++.patch" "glibc-ldd-x86_64.patch" "glibc-CVE-2019-7309.patch" "glibc-CVE-2019-9169.patch" "glibc-2.29-git-updates.patch" "glibc-hidden-visibility-ldconfig.patch" "glibc-versioned-locpath.patch" "glibc-allow-kernel-2.6.32.patch" "glibc-reinstate-prlimit64-fallback.patch" "glibc-2.29-supported-locales.patch")))))) (define-public (make-gcc-libc base-gcc libc) "Return a GCC that targets LIBC." (package (inherit base-gcc) (name (string-append (package-name base-gcc) "-" (package-name libc) "-" (package-version libc))) (arguments (ensure-keyword-arguments (package-arguments base-gcc) '(#:implicit-inputs? #f))) (native-inputs `(,@(package-native-inputs base-gcc) ,@(append (fold alist-delete (%final-inputs) '("libc" "libc:static"))) ("libc" ,libc) ("libc:static" ,libc "static"))))) (define-public (make-glibc-locales glibc) (package (inherit glibc) (name "glibc-locales") (source (origin (inherit (package-source glibc)) ;; The patch for glibc 2.28 and earlier replaces the same ;; content, but the context in the patch is different ;; enough to fail to merge. (patches (cons (search-patch (if (version>=? (package-version glibc) "2.29") "glibc-locales.patch" "glibc-locales-2.28.patch")) (origin-patches (package-source glibc)))))) (synopsis "All the locales supported by the GNU C Library") (description "This package provides all the locales supported by the GNU C Library, more than 400 in total. To use them set the @code{LOCPATH} environment variable to the @code{share/locale} sub-directory of this package.") (outputs '("out")) ;110+ MiB (native-search-paths '()) (arguments (let ((args `(#:tests? #f #:strip-binaries? #f ,@(package-arguments glibc)))) (substitute-keyword-arguments args ((#:modules modules '((guix build utils) (guix build gnu-build-system))) `((srfi srfi-11) (gnu build locale) ,@modules)) ((#:imported-modules modules '()) `((gnu build locale) ,@%gnu-build-system-modules)) ((#:phases phases) `(modify-phases ,phases (replace 'build (lambda _ (invoke "make" "localedata/install-locales" "-j" (number->string (parallel-job-count))))) (add-after 'build 'symlink-normalized-codesets (lambda* (#:key outputs #:allow-other-keys) ;; The above phase does not install locales with names using ;; the "normalized codeset." Thus, create symlinks like: ;; en_US.utf8 -> en_US.UTF-8 (define (locale-directory? file stat) (and (file-is-directory? file) (string-index (basename file) #\_) (string-rindex (basename file) #\.))) (let* ((out (assoc-ref outputs "out")) (locales (find-files out locale-directory? #:directories? #t))) (for-each (lambda (directory) (let*-values (((base) (basename directory)) ((name codeset) (locale->name+codeset base)) ((normalized) (normalize-codeset codeset))) (unless (string=? codeset normalized) (symlink base (string-append (dirname directory) "/" name "." normalized))))) locales)))) (delete 'install) (delete 'move-static-libs))) ((#:configure-flags flags) `(append ,flags ;; Use $(libdir)/locale/X.Y as is the case by default. (list (string-append "libc_cv_complocaledir=" (assoc-ref %outputs "out") "/lib/locale/" ,(version-major+minor (package-version glibc))))))))))) (define %default-utf8-locales ;; These are the locales commonly used for tests---e.g., in Guile's i18n ;; tests. '("de_DE" "el_GR" "en_US" "fr_FR" "tr_TR")) (define*-public (make-glibc-utf8-locales glibc #:key (locales %default-utf8-locales) (name "glibc-utf8-locales")) (define default-locales? (equal? locales %default-utf8-locales)) (package (name name) (version (package-version glibc)) (source #f) (build-system trivial-build-system) (arguments `(#:modules ((guix build utils)) #:builder (begin (use-modules (guix build utils)) (let* ((libc (assoc-ref %build-inputs "glibc")) (gzip (assoc-ref %build-inputs "gzip")) (out (assoc-ref %outputs "out")) (localedir (string-append out "/lib/locale/" ,(version-major+minor version)))) ;; 'localedef' needs 'gzip'. (setenv "PATH" (string-append libc "/bin:" gzip "/bin")) (mkdir-p localedir) (for-each (lambda (locale) (define file ;; Use the "normalized codeset" by ;; default--e.g., "en_US.utf8". (string-append localedir "/" locale ".utf8")) (invoke "localedef" "--no-archive" "--prefix" localedir "-i" locale "-f" "UTF-8" file) ;; For backward compatibility with Guix ;; <= 0.8.3, add "xx_YY.UTF-8". (symlink (string-append locale ".utf8") (string-append localedir "/" locale ".UTF-8"))) ',locales) #t)))) (native-inputs (list glibc gzip)) (synopsis (if default-locales? (P_ "Small sample of UTF-8 locales") (P_ "Customized sample of UTF-8 locales"))) (description (if default-locales? (P_ "This package provides a small sample of UTF-8 locales mostly useful in test environments.") (format #f (P_ "This package provides the following UTF-8 locales: @itemize ~{@item ~a~%~} @end itemize~%") locales))) (home-page (package-home-page glibc)) (license (package-license glibc)))) (define-public glibc-locales (make-glibc-locales glibc)) (define-public glibc-utf8-locales (make-glibc-utf8-locales glibc)) ;; Packages provided to ease use of binaries linked against the previous libc. (define-public glibc-locales-2.29 (package (inherit (make-glibc-locales glibc-2.29)) (name "glibc-locales-2.29"))) (define-public glibc-utf8-locales-2.29 (package (inherit (make-glibc-utf8-locales glibc-2.29)) (name "glibc-utf8-locales-2.29"))) (define-public which (package (name "which") (version "2.21") (source (origin (method url-fetch) (uri (string-append "mirror://gnu/which/which-" version ".tar.gz")) (sha256 (base32 "1bgafvy3ypbhhfznwjv1lxmd6mci3x1byilnnkc7gcr486wlb8pl")))) (build-system gnu-build-system) (home-page "https://gnu.org/software/which/") (synopsis "Find full path of shell commands") (description "The which program finds the location of executables in PATH, with a variety of options. It is an alternative to the shell \"type\" built-in command.") (license gpl3+))) ; some files are under GPLv2+ (define-public glibc/hurd-headers (package (inherit glibc) (name "glibc-hurd-headers") (outputs '("out")) (propagated-inputs (list gnumach-headers hurd-headers)) (native-inputs (modify-inputs (package-native-inputs glibc) (prepend (if (%current-target-system) ;; XXX: When targeting i586-pc-gnu, we need a 32-bit MiG, ;; hence this hack. (package (inherit mig) (arguments `(#:system "i686-linux"))) mig)))) (arguments (substitute-keyword-arguments (package-arguments glibc) ;; We just pass the flags really needed to build the headers. ((#:configure-flags _) `(list "--enable-add-ons" "--host=i586-pc-gnu")) ((#:phases _) '(modify-phases %standard-phases (replace 'install (lambda* (#:key outputs #:allow-other-keys) (invoke "make" "install-headers") ;; Make an empty stubs.h to work around not being able to ;; produce a valid stubs.h and causing the build to fail. See ;; . (let ((out (assoc-ref outputs "out"))) (close-port (open-output-file (string-append out "/include/gnu/stubs.h")))))) (delete 'build))))))) ; nothing to build (define-public tzdata (package (name "tzdata") ;; This package should be kept in sync with python-pytz in (gnu packages ;; time). (version "2021e") (source (origin (method url-fetch) (uri (string-append "https://data.iana.org/time-zones/releases/tzdata" version ".tar.gz")) (sha256 (base32 "1cdjdcxl0s9xf0dg1z64kh7llm80byxqlzrkkjzcdlyh6yvl5v07")))) (build-system gnu-build-system) (arguments (list #:tests? #f ;; This consists purely of (architecture-independent) data, so ;; ‘cross-compilation’ is pointless here! (The binaries zic, ;; dump, and tzselect are deleted in the post-install phase.) #:target #f #:make-flags #~(let ((out #$output) (tmp (getenv "TMPDIR"))) (list (string-append "TOPDIR=" out) (string-append "TZDIR=" out "/share/zoneinfo") (string-append "TZDEFAULT=" out "/share/zoneinfo/localtime") ;; Likewise for the C library routines. (string-append "LIBDIR=" tmp "/lib") (string-append "MANDIR=" tmp "/man") ;; XXX: tzdata 2020b changed the on-disk format ;; of the time zone files from 'fat' to 'slim'. ;; Many packages (particularly evolution-data-server) ;; can not yet handle the latter, so we stick with ;; 'fat' for now. #$@(if (version>=? (package-version this-package) "2020b") '("CPPFLAGS=-DZIC_BLOAT_DEFAULT='\"fat\"'") '()) "AWK=awk" "CC=gcc")) #:modules '((guix build utils) (guix build gnu-build-system) (srfi srfi-1)) #:phases #~(modify-phases %standard-phases (replace 'unpack (lambda* (#:key source inputs #:allow-other-keys) (invoke "tar" "xvf" source) (invoke "tar" "xvf" #$(match (package-inputs this-package) (((_ tzcode)) tzcode))))) (add-after 'install 'post-install (lambda* (#:key outputs #:allow-other-keys) ;; Move data in the right place. (let ((out (assoc-ref outputs "out"))) ;; Discard zic, dump, and tzselect, already ;; provided by glibc. (delete-file-recursively (string-append out "/usr")) (symlink (string-append out "/share/zoneinfo") (string-append out "/share/zoneinfo/posix")) (delete-file-recursively (string-append out "/share/zoneinfo-posix")) (copy-recursively (string-append out "/share/zoneinfo-leaps") (string-append out "/share/zoneinfo/right")) (delete-file-recursively (string-append out "/share/zoneinfo-leaps"))))) (delete 'configure)))) (inputs (list (origin (method url-fetch) (uri (string-append "https://data.iana.org/time-zones/releases/tzcode" version ".tar.gz")) (sha256 (base32 "0x8pcfmjvxk29yfh8bklchv2f0vpl4yih0gc4wyx292l78wncijq"))))) (home-page "https://www.iana.org/time-zones") (synopsis "Database of current and historical time zones") (description "The Time Zone Database (often called tz or zoneinfo) contains code and data that represent the history of local time for many representative locations around the globe. It is updated periodically to reflect changes made by political bodies to time zone boundaries, UTC offsets, and daylight-saving rules.") (license public-domain))) ;;; A "fixed" version of tzdata, which is used in the test suites of glib and R ;;; and a few other places. We can update this whenever we are able to rebuild ;;; thousands of packages (for example, in a core-updates rebuild). This package ;;; will typically be obsolete and should never be referred to by a built ;;; package. ;;; ;;; Please make this a hidden-package if it is different from the primary tzdata ;;; package. (define-public tzdata-for-tests tzdata) (define-public libiconv (package (name "libiconv") (version "1.15") (source (origin (method url-fetch) (uri (string-append "mirror://gnu/libiconv/libiconv-" version ".tar.gz")) (sha256 (base32 "0y1ij745r4p48mxq84rax40p10ln7fc7m243p8k8sia519i3dxfc")) (modules '((guix build utils))) (snippet ;; Work around "declared gets" error on glibc systems (fixed by ;; Gnulib commit 66712c23388e93e5c518ebc8515140fa0c807348.) '(substitute* "srclib/stdio.in.h" (("^#undef gets") "") (("^_GL_WARN_ON_USE \\(gets.*") ""))))) (build-system gnu-build-system) (synopsis "Character set conversion library") (description "libiconv provides an implementation of the iconv function for systems that lack it. iconv is used to convert between character encodings in a program. It supports a wide variety of different encodings.") (home-page "https://www.gnu.org/software/libiconv/") (license lgpl3+))) (define* (libiconv-if-needed #:optional (target (%current-target-system))) "Return either a libiconv package specification to include in a dependency list for platforms that have an incomplete libc, or the empty list. If a package needs iconv ,@(libiconv-if-needed) should be added." ;; POSIX C libraries provide iconv. Platforms with an incomplete libc ;; without iconv, such as MinGW, must return the then clause. (if (target-mingw? target) `(("libiconv" ,libiconv)) '())) (define-public (canonical-package package) ;; Avoid circular dependency by lazily resolving 'commencement'. (let* ((iface (resolve-interface '(gnu packages commencement))) (proc (module-ref iface 'canonical-package))) (proc package))) (define-public (%final-inputs) "Return the list of \"final inputs\"." ;; Avoid circular dependency by lazily resolving 'commencement'. (let ((iface (resolve-interface '(gnu packages commencement)))) (module-ref iface '%final-inputs))) ;;; base.scm ends here