;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2014, 2015, 2024 宋文武 ;;; Copyright © 2014, 2015 Mark H Weaver ;;; Copyright © 2016 Andreas Enge ;;; Copyright © 2016 Florian Paul Schmidt ;;; Copyright © 2016, 2020 Kei Kebreau ;;; Copyright © 2017, 2019 Ricardo Wurmus ;;; Copyright © 2017 Petter ;;; Copyright © 2017 Nikita ;;; Copyright © 2018–2022 Tobias Geerinckx-Rice ;;; Copyright © 2019 Pkill -9 ;;; Copyright © 2019 L p R n d n ;;; Copyright © 2019 Ingo Ruhnke ;;; Copyright © 2020 Vincent Legoll ;;; Copyright © 2020 Jonathan Brielmaier ;;; Copyright © 2020, 2021, 2022 Michael Rohleder ;;; Copyright © 2021, 2022 Brendan Tildesley
aboutsummaryrefslogtreecommitdiff
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
;;; Copyright © 2017 Leo Famulari <leo@famulari.name>
;;; Copyright © 2017, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2019, 2020, 2023 Janneke Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2019, 2020 Miguel Ángel Arruga Vivas <rosen644835@gmail.com>
;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2020 Stefan <stefan-guix@vodafonemail.de>
;;; Copyright © 2022 Karl Hallsby <karl@hallsby.com>
;;; Copyright © 2022 Denis 'GNUtoo' Carikli <GNUtoo@cyberdimension.org>
;;; Copyright © 2024 Tomas Volf <~@wolfsden.cz>
;;;
;;; 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 bootloader grub)
  #:use-module (guix build union)
  #:use-module (guix records)
  #:use-module (guix store)
  #:use-module (guix utils)
  #:use-module (guix gexp)
  #:use-module (gnu artwork)
  #:use-module (gnu bootloader)
  #:use-module (gnu system uuid)
  #:use-module (gnu system file-systems)
  #:use-module (gnu system keyboard)
  #:use-module (gnu system locale)
  #:use-module (gnu packages bootloaders)
  #:autoload   (gnu packages gtk) (guile-cairo guile-rsvg)
  #:autoload   (gnu packages xorg) (xkeyboard-config)
  #:use-module (ice-9 match)
  #:use-module (ice-9 regex)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-2)
  #:export (grub-theme
            grub-theme?
            grub-theme-image
            grub-theme-resolution
            grub-theme-color-normal
            grub-theme-color-highlight
            grub-theme-gfxmode

            install-grub-efi-removable
            make-grub-efi-netboot-installer

            grub-bootloader
            grub-efi-bootloader
            grub-efi-removable-bootloader
            grub-efi32-bootloader
            grub-efi-netboot-bootloader
            grub-efi-netboot-removable-bootloader
            grub-mkrescue-bootloader
            grub-minimal-bootloader

            grub-configuration))

;;; Commentary:
;;;
;;; Configuration of GNU GRUB.
;;;
;;; Code:

(define* (normalize-file file mount-point store-directory-prefix)
  "Strip MOUNT-POINT and prepend STORE-DIRECTORY-PREFIX, if any, to FILE, a
G-expression or other lowerable object denoting a file name."

  (define (strip-mount-point mount-point file)
    (if mount-point
        (if (string=? mount-point "/")
            file
            #~(let ((file #$file))
                (if (string-prefix? #$mount-point file)
                    (substring #$file #$(string-length mount-point))
                    file)))
        file))

  (define (prepend-store-directory-prefix store-directory-prefix file)
    (if store-directory-prefix
        #~(string-append #$store-directory-prefix #$file)
        file))

  (prepend-store-directory-prefix store-directory-prefix
                                  (strip-mount-point mount-point file)))



(define-record-type* <grub-theme>
  ;; Default theme contributed by Felipe López.
  grub-theme make-grub-theme
  grub-theme?
  (image           grub-theme-image
                   (default (file-append %artwork-repository
                                         "/grub/GuixSD-fully-black-4-3.svg")))
  (resolution      grub-theme-resolution
                   (default '(1024 . 768)))
  (color-normal    grub-theme-color-normal
                   (default '((fg . light-gray) (bg . black))))
  (color-highlight grub-theme-color-highlight
                   (default '((fg . yellow) (bg . black))))
  (gfxmode         grub-theme-gfxmode
                   (default '("auto"))))          ;list of string


;;;
;;; Background image & themes.
;;;

(define (bootloader-theme config)
  "Return user defined theme in CONFIG if defined or a default theme
otherwise."
  (or (bootloader-configuration-theme config) (grub-theme)))

(define* (image->png image #:key width height)
  "Build a PNG of HEIGHT x WIDTH from IMAGE if its file suffix is \".svg\".
Otherwise the picture in IMAGE is just copied."
  (computed-file "grub-image.png"
                 (with-imported-modules '((gnu build svg))
                   (with-extensions (list guile-rsvg guile-cairo)
                     #~(if (string-suffix? ".svg" #+image)
                           (begin
                             (use-modules (gnu build svg))
                             (svg->png #+image #$output
                                       #:width #$width
                                       #:height #$height))
                           (copy-file #+image #$output))))))

(define* (grub-background-image config)
  "Return the GRUB background image defined in CONFIG or #f if none was found.
If the suffix of the image file is \".svg\", then it is converted into a PNG
file with the resolution provided in CONFIG."
  (let* ((theme (bootloader-theme config))
         (image (grub-theme-image theme)))
    (and image
         (match (grub-theme-resolution theme)
           (((? number? width) . (? number? height))
            (image->png image #:width width #:height height))
           (_ #f)))))

(define (grub-locale-directory grub)
  "Generate a directory with the locales from GRUB."
  (define builder
    #~(begin
        (use-modules (ice-9 ftw))
        (let ((locale (string-append #$grub "/share/locale"))
              (out    #$output))
          (mkdir out)
          (chdir out)
          (for-each (lambda (lang)
                      (let ((file (string-append locale "/" lang
                                                 "/LC_MESSAGES/grub.mo"))
                            (dest (string-append lang ".mo")))
                        (when (file-exists? file)
                          (copy-file file dest))))
                    (scandir locale)))))
  (computed-file "grub-locales" builder))

(define* (eye-candy config store-device store-mount-point
                    #:key store-directory-prefix port)
  "Return a gexp that writes to PORT (a port-valued gexp) the 'grub.cfg' part
concerned with graphics mode, background images, colors, and all that.
STORE-DEVICE designates the device holding the store, and STORE-MOUNT-POINT is
its mount point; these are used to determine where the background image and
fonts must be searched for.  STORE-DIRECTORY-PREFIX is a directory prefix to
prepend to any store file name."
  (define (setup-gfxterm config)
    (if (memq 'gfxterm (bootloader-configuration-terminal-outputs config))
        #~(format #f "
if loadfont unicode; then
  set gfxmode=~a
  insmod all_video
  insmod gfxterm
fi~%"
                  #$(string-join
                     (grub-theme-gfxmode (bootloader-theme config))
                     ";"))
        ""))

  (define (theme-colors type)
    (let* ((theme  (bootloader-theme config))
           (colors (type theme)))
      (string-append (symbol->string (assoc-ref colors 'fg)) "/"
                     (symbol->string (assoc-ref colors 'bg)))))

  (define image
    (normalize-file (grub-background-image config)
                    store-mount-point
                    store-directory-prefix))

  (and image
       #~(format #$port "
# Set 'root' to the partition that contains /gnu/store.
~a

~a
~a

insmod png
if background_image ~a; then
  set color_normal=~a
  set color_highlight=~a
else
  set menu_color_normal=cyan/blue
  set menu_color_highlight=white/blue
fi~%"
                 #$(grub-root-search store-device image)
                 #$(setup-gfxterm config)
                 #$(grub-setup-io config)

                 #$image
                 #$(theme-colors grub-theme-color-normal)
                 #$(theme-colors grub-theme-color-highlight))))


;;;
;;; Configuration file.
;;;

(define* (keyboard-layout-file layout
                               #:key
                               (grub grub))
  "Process the X keyboard layout description LAYOUT, a <keyboard-layout> record,
and return a file in the format for GRUB keymaps.  LAYOUT must be present in
the 'share/X11/xkb/symbols/' directory of 'xkeyboard-config'."
  (define builder
    (with-imported-modules '((guix build utils))
      #~(begin
          (use-modules (guix build utils))

          ;; 'grub-kbdcomp' passes all its arguments but '-o' to 'ckbcomp'
          ;; (from the 'console-setup' package).
          (invoke #+(file-append grub "/bin/grub-mklayout")
                  "-i" #+(keyboard-layout->console-keymap layout)
                  "-o" #$output))))

  (computed-file (string-append "grub-keymap."
                                (string-map (match-lambda
                                              (#\, #\-)
                                              (chr chr))
                                            (keyboard-layout-name layout)))
                 builder))

(define (grub-setup-io config)
  "Return GRUB commands to configure the input / output interfaces.  The result
is a string that can be inserted in grub.cfg."
  (let* ((symbols->string (lambda (list)
                           (string-join (map symbol->string list) " ")))
         (outputs (bootloader-configuration-terminal-outputs config))
         (inputs (bootloader-configuration-terminal-inputs config))
         (unit (bootloader-configuration-serial-unit config))
         (speed (bootloader-configuration-serial-speed config))

         ;; Respectively, GRUB_TERMINAL_OUTPUT and GRUB_TERMINAL_INPUT,
         ;; as documented in GRUB manual section "Simple Configuration
         ;; Handling".
         (valid-outputs '(console serial serial_0 serial_1 serial_2 serial_3
                          gfxterm vga_text mda_text morse spkmodem))
         (valid-inputs '(console serial serial_0 serial_1 serial_2 serial_3
                         at_keyboard usb_keyboard))

         (io (string-append
              ;; UNIT and SPEED are arguments to the same GRUB command
              ;; ("serial"), so we process them together.
              (if (or unit speed)
                  (string-append
                   "serial"
                   (if unit
                       ;; COM ports 1 through 4
                       (if (and (exact-integer? unit) (<= unit 3) (>= unit 0))
                           (string-append " --unit=" (number->string unit))
                           #f)
                       "")
                   (if speed
                       (if (exact-integer? speed)
                           (string-append " --speed=" (number->string speed))
                           #f)
                       "")
                   "\n")
                  "")
              (if (null? inputs)
                  ""
                  (string-append
                   "terminal_input "
                   (symbols->string
                    (map
                     (lambda (input)
                       (if (memq input valid-inputs) input #f)) inputs))
                   "\n"))
              "terminal_output "
              (symbols->string
               (map
                (lambda (output)
                  (if (memq output valid-outputs) output #f)) outputs)))))
    (format #f "~a" io)))

(define (grub-root-search device file)
  "Return the GRUB 'search' command to look for DEVICE, which contains FILE,
a gexp.  The result is a gexp that can be inserted in the grub.cfg-generation
code."
  ;; Usually FILE is a file name gexp like "/gnu/store/…-linux/vmlinuz", but
  ;; it can also be something like "(hd0,msdos1)/vmlinuz" in the case of
  ;; custom menu entries.  In the latter case, don't emit a 'search' command.
  (if (and (string? file) (not (string-prefix? "/" file)))
      ""
      (match device
        ;; Preferably refer to DEVICE by its UUID or label.  This is more
        ;; efficient and less ambiguous, see <http://bugs.gnu.org/22281>.
        ((? uuid? uuid)
         (format #f "search --fs-uuid --set ~a"
                 (uuid->string device)))
        ((? file-system-label? label)
         (format #f "search --label --set ~a"
                 (file-system-label->string label)))
        ((? (lambda (device)
              (and (string? device) (string-contains device ":/"))) nfs-uri)
         ;; If the device is an NFS share, then we assume that the expected
         ;; file on that device (e.g. the GRUB background image or the kernel)
         ;; has to be loaded over the network.  Otherwise we would need an
         ;; additional device information for some local disk to look for that
         ;; file, which we do not have.
         ;;
         ;; We explicitly set "root=(tftp)" here even though if grub.cfg
         ;; had been loaded via TFTP, Grub would have set "root=(tftp)"
         ;; automatically anyway.  The reason is if you have a system that
         ;; used to be on NFS but now is local, root would be set to local
         ;; disk.  If you then selected an older system generation that is
         ;; supposed to boot from network in the Grub boot menu, Grub still
         ;; wouldn't load those files from network otherwise.
         ;;
         ;; TFTP is preferred to HTTP because it is used more widely and
         ;; specified in standards more widely--especially BOOTP/DHCPv4
         ;; defines a TFTP server for DHCP option 66, but not HTTP.
         ;;
         ;; Note: DHCPv6 specifies option 59 to contain a boot-file-url,
         ;; which can contain a HTTP or TFTP URL.
         ;;
         ;; Note: It is assumed that the file paths are of a similar
         ;; setup on both the TFTP server and the NFS server (it is
         ;; not possible to search for files on TFTP).
         ;;
         ;; TODO: Allow HTTP.
         "set root=(tftp)")
        ((or #f (? string?))
         #~(format #f "search --file --set ~a" #$file)))))

(define* (make-grub-configuration grub config entries
                                  #:key
                                  (locale #f)
                                  (system (%current-system))
                                  (old-entries '())
                                  (store-crypto-devices '())
                                  store-directory-prefix)
  "Return the GRUB configuration file corresponding to CONFIG, a
<bootloader-configuration> object, and where the store is available at
STORE-FS, a <file-system> object.  OLD-ENTRIES is taken to be a list of menu
entries corresponding to old generations of the system.
STORE-CRYPTO-DEVICES contain the UUIDs of the encrypted units that must
be unlocked to access the store contents.
STORE-DIRECTORY-PREFIX may be used to specify a store prefix, as is required
when booting a root file system on a Btrfs subvolume."
  (define all-entries
    (append entries (bootloader-configuration-menu-entries config)))
  (define (menu-entry->gexp entry)
    (let ((label (menu-entry-label entry))
          (linux (menu-entry-linux entry))
          (device (menu-entry-device entry))
          (device-mount-point (menu-entry-device-mount-point entry))
          (multiboot-kernel (menu-entry-multiboot-kernel entry))
          (chain-loader (menu-entry-chain-loader entry)))
      (cond
       (linux
        (let ((arguments (menu-entry-linux-arguments entry))
              (linux (normalize-file linux
                                     device-mount-point
                                     store-directory-prefix))
              (initrd (normalize-file (menu-entry-initrd entry)
                                      device-mount-point
                                      store-directory-prefix))
              (extra-initrd (bootloader-configuration-extra-initrd config)))
          ;; Here DEVICE is the store and DEVICE-MOUNT-POINT is its mount point.
          ;; Use the right file names for LINUX and INITRD in case
          ;; DEVICE-MOUNT-POINT is not "/", meaning that the store is on a
          ;; separate partition.

          ;; When STORE-DIRECTORY-PREFIX is defined, prepend it the linux and
          ;; initrd paths, to allow booting from a Btrfs subvolume.
          #~(format port "menuentry ~s {
  ~a
  linux ~a ~a
  initrd ~a ~a
}~%"
                    #$label
                    #$(grub-root-search device linux)
                    #$linux (string-join (list #$@arguments))
                    (or #$extra-initrd "")
                    #$initrd)))
       (multiboot-kernel
        (let* ((kernel (menu-entry-multiboot-kernel entry))
               (arguments (menu-entry-multiboot-arguments entry))
               ;; Choose between device names as understood by Mach's built-in
               ;; IDE driver ("hdX") and those understood by rumpdisk ("wdX"
               ;; in the "noide" case).
               (disk (if (member "noide" arguments) "w" "h"))
               (modules (menu-entry-multiboot-modules entry))
               (root-index 1))          ; XXX EFI will need root-index 2
          #~(format port "
menuentry ~s {
  multiboot ~a root=part:~a:device:~ad0~a~a
}~%"
                    #$label
                    #$kernel
                    #$root-index
                    #$disk
                    (string-join (list #$@arguments) " " 'prefix)
                    (string-join (map string-join '#$modules)
                                 "\n  module " 'prefix))))
       (chain-loader
        #~(format port "
menuentry ~s {
  ~a
  chainloader ~a
}~%"
                  #$label
                  #$(grub-root-search device chain-loader)
                  #$chain-loader)))))

  (define (crypto-devices)
    (define (crypto-device->cryptomount dev)
      (if (uuid? dev)
          #~(format port "cryptomount -u ~a~%"
                    ;; cryptomount only accepts UUID without the hypen.
                    #$(string-delete #\- (uuid->string dev)))
          ;; Other type of devices aren't implemented.
          #~()))
    (let ((devices (map crypto-device->cryptomount store-crypto-devices))
          (modules #~(format port "insmod luks~%insmod luks2~%")))
      (if (null? devices)
          devices
          (cons modules devices))))

  (define (sugar)
    (let* ((entry (first all-entries))
           (device (menu-entry-device entry))
           (mount-point (menu-entry-device-mount-point entry)))
      (eye-candy config
                 device
                 mount-point
                 #:store-directory-prefix store-directory-prefix
                 #:port #~port)))

  (define locale-config
    (let* ((entry (first all-entries))
           (device (menu-entry-device entry))
           (mount-point (menu-entry-device-mount-point entry)))
      #~(let ((locale #$(and locale
                             (locale-definition-source
                              (locale-name->definition locale))))
              (locales #$(and locale
                              (normalize-file (grub-locale-directory grub)
                                              mount-point
                                              store-directory-prefix))))
          (when locale
            (format port "\
# Localization configuration.
~asearch --file --set ~a/en@quot.mo
set locale_dir=~a
set lang=~a~%"
                    ;; Skip the search if there is an image, as it has already
                    ;; been performed by eye-candy and traversing the store is
                    ;; an expensive operation.
                    #$(if (grub-theme-image (bootloader-theme config))
                          "# "
                          "")
                    locales
                    locales
                    locale)))))

  (define keyboard-layout-config
    (let* ((layout (bootloader-configuration-keyboard-layout config))
           (keymap* (and layout
                         (keyboard-layout-file layout #:grub grub)))
           (entry (first all-entries))
           (device (menu-entry-device entry))
           (mount-point (menu-entry-device-mount-point entry))
           (keymap (and keymap*
                        (normalize-file keymap* mount-point
                                        store-directory-prefix))))
      #~(when #$keymap
          (format port "\
insmod keylayouts
keymap ~a~%" #$keymap))))

  (define builder
    #~(call-with-output-file #$output
        (lambda (port)
          (format port
                  "# This file was generated from your Guix configuration.  Any changes
# will be lost upon reconfiguration.
")
          #$@(crypto-devices)
          #$(sugar)
          #$locale-config
          #$keyboard-layout-config
          (format port "
set default=~a
set timeout=~a~%"
                  #$(bootloader-configuration-default-entry config)
                  #$(bootloader-configuration-timeout config))
          #$@(map menu-entry->gexp all-entries)

          #$@(if (pair? old-entries)
                 #~((format port "
submenu \"GNU system, old configurations...\" {~%")
                    #$@(map menu-entry->gexp old-entries)
                    (format port "}~%"))
                 #~())
          (format port "
if [ \"${grub_platform}\" == efi ]; then
  menuentry \"Firmware setup\" {
    fwsetup
  }
fi~%"))))

  ;; Since this file is rather unique, there's no point in trying to
  ;; substitute it.
  (computed-file "grub.cfg" builder
                 #:options '(#:local-build? #t
                             #:substitutable? #f)))

(define (grub-configuration-file config . args)
  (let* ((bootloader (bootloader-configuration-bootloader config))
         (grub (bootloader-package bootloader)))
    (apply make-grub-configuration grub config args)))

(define (grub-efi-configuration-file . args)
  (apply make-grub-configuration grub-efi args))

(define grub-cfg "/boot/grub/grub.cfg")



;;;
;;; Install procedures.
;;;

(define install-grub
  #~(lambda (bootloader device mount-point)
      (let ((grub (string-append bootloader "/sbin/grub-install"))
            (install-dir (string-append mount-point "/boot")))
        ;; Install GRUB on DEVICE which is mounted at MOUNT-POINT. If DEVICE
        ;; is #f, then we populate the disk-image rooted at MOUNT-POINT.
        (if device
            (begin
              ;; Tell 'grub-install' that there might be a LUKS-encrypted
              ;; /boot or root partition.
              (setenv "GRUB_ENABLE_CRYPTODISK" "y")

              ;; Hide potentially confusing messages from the user, such as
              ;; "Installing for i386-pc platform."
              (invoke/quiet grub "--no-floppy" "--target=i386-pc"
                            "--boot-directory" install-dir
                            device))
            ;; When creating a disk-image, only install a font and GRUB modules.
            (let* ((fonts (string-append install-dir "/grub/fonts")))
              (mkdir-p fonts)
              (copy-file (string-append bootloader "/share/grub/unicode.pf2")
                         (string-append fonts "/unicode.pf2"))
              (copy-recursively (string-append bootloader "/lib/")
                                install-dir))))))

(define install-grub-disk-image
  #~(lambda (bootloader root-index image)
      ;; Install GRUB on the given IMAGE. The root partition index is
      ;; ROOT-INDEX.
      (let ((grub-mkimage
             (string-append bootloader "/bin/grub-mkimage"))
            (modules '("biosdisk" "part_msdos" "fat" "ext2"))
            (grub-bios-setup
             (string-append bootloader "/sbin/grub-bios-setup"))
            (root-device (format #f "hd0,msdos~a" root-index))
            (boot-img (string-append bootloader "/lib/grub/i386-pc/boot.img"))
            (device-map "device.map"))

        ;; Create a minimal, standalone GRUB image that will be written
        ;; directly in the MBR-GAP (space between the end of the MBR and the
        ;; first partition).
        (apply invoke grub-mkimage
               "-O" "i386-pc"
               "-o" "core.img"
               "-p" (format #f "(~a)/boot/grub" root-device)
               modules)

        ;; Create a device mapping file.
        (call-with-output-file device-map
          (lambda (port)
            (format port "(hd0) ~a~%" image)))

        ;; Copy the default boot.img, that will be written on the MBR sector
        ;; by GRUB-BIOS-SETUP.
        (copy-file boot-img "boot.img")

        ;; Install both the "boot.img" and the "core.img" files on the given
        ;; IMAGE. On boot, the MBR sector will execute the minimal GRUB
        ;; written in the MBR-GAP. GRUB configuration and missing modules will
        ;; be read from ROOT-DEVICE.
        (invoke grub-bios-setup
                "-m" device-map
                "-r" root-device
                "-d" "."
                image))))

(define install-grub-efi
  #~(lambda (bootloader efi-dir mount-point)
      ;; There is nothing useful to do when called in the context of a disk
      ;; image generation.
      (when efi-dir
        ;; Install GRUB onto the EFI partition mounted at EFI-DIR, for the
        ;; system whose root is mounted at MOUNT-POINT.
        (let ((grub-install (string-append bootloader "/sbin/grub-install"))
              (install-dir (string-append mount-point "/boot"))
              ;; When installing Guix, it's common to mount EFI-DIR below
              ;; MOUNT-POINT rather than /boot/efi on the live image.
              (target-esp (if (file-exists? (string-append mount-point efi-dir))
                              (string-append mount-point efi-dir)
                              efi-dir)))
          ;; Tell 'grub-install' that there might be a LUKS-encrypted /boot or
          ;; root partition.
          (setenv "GRUB_ENABLE_CRYPTODISK" "y")
          (invoke/quiet grub-install "--boot-directory" install-dir
                        "--bootloader-id=Guix"
                        "--efi-directory" target-esp)))))

(define install-grub-efi-removable
  #~(lambda (bootloader efi-dir mount-point)
      ;; NOTE: mount-point is /mnt in guix system init /etc/config.scm /mnt/point
      ;; NOTE: efi-dir comes from target list of booloader configuration
      ;; There is nothing useful to do when called in the context of a disk
      ;; image generation.
      (when efi-dir
        ;; Install GRUB onto the EFI partition mounted at EFI-DIR, for the
        ;; system whose root is mounted at MOUNT-POINT.
        (let ((grub-install (string-append bootloader "/sbin/grub-install"))
              (install-dir (string-append mount-point "/boot"))
              ;; When installing Guix, it's common to mount EFI-DIR below
              ;; MOUNT-POINT rather than /boot/efi on the live image.
              (target-esp (if (file-exists? (string-append mount-point efi-dir))
                              (string-append mount-point efi-dir)
                              efi-dir)))
          ;; Tell 'grub-install' that there might be a LUKS-encrypted /boot or
          ;; root partition.
          (setenv "GRUB_ENABLE_CRYPTODISK" "y")
          (invoke/quiet grub-install "--boot-directory" install-dir
                        "--removable"
                        ;; "--no-nvram"
                        "--bootloader-id=Guix"
                        "--efi-directory" target-esp)))))

(define install-grub-efi32
  #~(lambda (bootloader efi-dir mount-point)
      ;; There is nothing useful to do when called in the context of a disk
      ;; image generation.
      (when efi-dir
        ;; Install GRUB onto the EFI partition mounted at EFI-DIR, for the
        ;; system whose root is mounted at MOUNT-POINT.
        (let ((grub-install (string-append bootloader "/sbin/grub-install"))
              (install-dir (string-append mount-point "/boot"))
              ;; When installing Guix, it's common to mount EFI-DIR below
              ;; MOUNT-POINT rather than /boot/efi on the live image.
              (target-esp (if (file-exists? (string-append mount-point efi-dir))
                              (string-append mount-point efi-dir)
                              efi-dir)))
          ;; Tell 'grub-install' that there might be a LUKS-encrypted /boot or
          ;; root partition.
          (setenv "GRUB_ENABLE_CRYPTODISK" "y")
          (invoke/quiet grub-install "--boot-directory" install-dir
                        "--bootloader-id=Guix"
			(cond ((target-x86?) "--target=i386-efi")
                              ((target-arm?) "--target=arm-efi"))
                        "--efi-directory" target-esp)))))

(define* (make-grub-efi-netboot-installer grub-efi grub-cfg subdir)
  "Make a bootloader-installer for a grub-efi-netboot bootloader, which expects
its files in SUBDIR and its configuration file in GRUB-CFG.

As a grub-efi-netboot package is already pre-installed by 'grub-mknetdir', the
installer basically copies all files from the bootloader-package (or profile)
into the bootloader-target directory.

Additionally for network booting over TFTP, two relative symlinks to the store
and to the GRUB-CFG file are necessary.  Due to this a TFTP root directory must
not be located on a FAT file-system.

If the bootloader-target does not support symlinks, then it is assumed to be a
kind of EFI System Partition (ESP).  In this case an intermediate configuration
file is created with the help of GRUB-EFI to load the GRUB-CFG.

The installer is usable for any efi-bootloader-chain, which prepares the
bootloader-profile in a way ready for copying.

The installer does not manipulate the system's 'UEFI Boot Manager'.

The returned installer accepts the BOOTLOADER, TARGET and MOUNT-POINT
arguments.  Its job is to copy the BOOTLOADER, which must be a pre-installed
grub-efi-netboot package with a SUBDIR like efi/boot or efi/Guix, below the
directory TARGET for the system whose root is mounted at MOUNT-POINT.

MOUNT-POINT is the last argument in 'guix system init /etc/config.scm mnt/point'
or '/' for other 'guix system' commands.

Where TARGET comes from the targets argument given to the
bootloader-configuration in:

(operating-system
 (bootloader (bootloader-configuration
              (targets '(\"/boot/efi\"))
              …))
 …)

TARGET is required to be an absolute directory name, usually mounted via NFS,
and finally needs to be provided by a TFTP server as
the TFTP root directory.

Usually the installer will be used to prepare network booting over TFTP.  Then
GRUB will load tftp://server/SUBDIR/grub.cfg and this file will instruct it to
load more files from the store like tftp://server/gnu/store/…-linux…/Image.

To make this possible two symlinks are created.  The first symlink points
relatively form MOUNT-POINT/TARGET/SUBDIR/grub.cfg to
MOUNT-POINT/boot/grub/grub.cfg, and the second symlink points relatively from
MOUNT-POINT/TARGET/%store-prefix to MOUNT-POINT/%store-prefix.

It is important to note that these symlinks need to be relative, as the absolute
paths on the TFTP server side are unknown.

It is also important to note that both symlinks will point outside the TFTP root
directory and that the TARGET/%store-prefix symlink makes the whole store
accessible via TFTP.  Possibly the TFTP server must be configured to allow
accesses outside its TFTP root directory.  This all may need to be considered
for security aspects.  It is advised to disable any TFTP write access!

The installer can also be used to prepare booting from local storage, if the
underlying file-system, like FAT on an EFI System Partition (ESP), does not
support symlinks.  In this case the MOUNT-POINT/TARGET/SUBDIR/grub.cfg will be
created with the help of GRUB-EFI to load the /boot/grub/grub.cfg file.  A
symlink to the store is not needed in this case."
  (with-imported-modules '((guix build union))
    #~(lambda (bootloader target mount-point)
        ;; In context of a disk image creation TARGET will be #f and an
        ;; installer is expected to do necessary installations on MOUNT-POINT,
        ;; which will become the root file system.  If TARGET is #f, this
        ;; installer has nothing to do, as it only cares about the EFI System
        ;; Partition (ESP).
        (when target
          (use-modules ((guix build union) #:select (symlink-relative))
                       (ice-9 popen)
                       (ice-9 rdelim))
          (let* ((mount-point/target (string-append mount-point target "/"))
                 ;; When installing Guix, it is common to mount TARGET below
                 ;; MOUNT-POINT rather than the root directory.
                 (bootloader-target (if (file-exists? mount-point/target)
                                        mount-point/target
                                        target))
                 (store (string-append mount-point (%store-prefix)))
                 (store-link (string-append bootloader-target (%store-prefix)))
                 (grub-cfg (string-append mount-point #$grub-cfg))
                 (grub-cfg-link (string-append bootloader-target
                                               #$subdir "/"
                                               (basename grub-cfg))))
            ;; Copy the bootloader into the bootloader-target directory.
            ;; Should we beforehand recursively delete any existing file?
            (copy-recursively bootloader bootloader-target
                              #:follow-symlinks? #t
                              #:log (%make-void-port "w"))
            ;; For TFTP we need to install additional relative symlinks.
            ;; If we install on an EFI System Partition (ESP) or some other FAT
            ;; file-system, then symlinks cannot be created and are not needed.
            ;; Therefore we ignore exceptions when trying.
            ;; Prepare the symlink to the grub.cfg.
            (mkdir-p (dirname grub-cfg-link))
            (false-if-exception (delete-file grub-cfg-link))
            (if (unspecified?
                 (false-if-exception (symlink-relative grub-cfg grub-cfg-link)))
                ;; Symlinks are supported.
                (begin
                  ;; Prepare the symlink to the store.
                  (mkdir-p (dirname store-link))
                  (false-if-exception (delete-file store-link))
                  (symlink-relative store store-link))
                ;; Creating symlinks does not seem to be supported.  Probably
                ;; an ESP is used.  Add a script to search and load the actual
                ;; grub.cfg.
                (let* ((probe #$(file-append grub-efi "/sbin/grub-probe"))
                       (port (open-pipe* OPEN_READ probe "--target=fs_uuid"
                                         grub-cfg))
                       (search-root
                        (match (read-line port)
                          ((? eof-object?)
                           ;; There is no UUID available. As a fallback search
                           ;; everywhere for the grub.cfg.
                           (string-append "search --file --set " #$grub-cfg))
                          (fs-uuid
                           ;; The UUID to load the grub.cfg from is known.
                           (string-append "search --fs-uuid --set " fs-uuid))))
                       (load-grub-cfg (string-append "configfile " #$grub-cfg)))
                  (close-pipe port)
                  (with-output-to-file grub-cfg-link
                    (lambda ()
                      (display (string-join (list search-root
                                                  load-grub-cfg)
                                            "\n")))))))))))



;;;
;;; Bootloader definitions.
;;;
;;; For all these grub-bootloader variables the path to /boot/grub/grub.cfg
;;; is fixed.  Inheriting and overwriting the field 'configuration-file' will
;;; break 'guix system delete-generations', 'guix system switch-generation',
;;; and 'guix system roll-back'.

(define grub-bootloader
  (bootloader
   (name 'grub)
   (package grub)
   (installer install-grub)
   (disk-image-installer install-grub-disk-image)
   (configuration-file grub-cfg)
   (configuration-file-generator grub-configuration-file)))

(define grub-minimal-bootloader
  (bootloader
   (inherit grub-bootloader)
   (package grub-minimal)))

(define grub-efi-bootloader
  (bootloader
   (name 'grub-efi)
   (package grub-efi)
   (installer install-grub-efi)
   (disk-image-installer #f)
   (configuration-file grub-cfg)
   (configuration-file-generator grub-configuration-file)))

(define grub-efi-removable-bootloader
  (bootloader
   (inherit grub-efi-bootloader)
   (name 'grub-efi-removable-bootloader)
   (installer install-grub-efi-removable)))

(define grub-efi32-bootloader
  (bootloader
   (inherit grub-efi-bootloader)
   (installer install-grub-efi32)
   (name 'grub-efi32)
   (package grub-efi32)))

(define (make-grub-efi-netboot-bootloader name subdir)
  (bootloader
   (name name)
   (package (make-grub-efi-netboot (symbol->string name) subdir))
   (installer (make-grub-efi-netboot-installer grub-efi grub-cfg subdir))
   (disk-image-installer #f)
   (configuration-file grub-cfg)
   (configuration-file-generator grub-efi-configuration-file)))

(define grub-efi-netboot-bootloader
  (make-grub-efi-netboot-bootloader 'grub-efi-netboot-bootloader
                                    "efi/Guix"))

(define grub-efi-netboot-removable-bootloader
  (make-grub-efi-netboot-bootloader 'grub-efi-netboot-removable-bootloader
                                    "efi/boot"))

(define grub-mkrescue-bootloader
  (bootloader
   (inherit grub-efi-bootloader)
   (package grub-hybrid)))


;;;
;;; Compatibility macros.
;;;

(define-syntax grub-configuration
  (syntax-rules (grub)
                ((_ (grub package) fields ...)
                 (if (eq? package grub)
                     (bootloader-configuration
                      (bootloader grub-bootloader)
                      fields ...)
                   (bootloader-configuration
                    (bootloader grub-efi-bootloader)
                    fields ...)))
                ((_ fields ...)
                 (bootloader-configuration
                  (bootloader grub-bootloader)
                  fields ...))))

;;; grub.scm ends here
generated by cgit
sis "Xfce terminal emulator") (description "A lightweight and easy to use terminal emulator for Xfce. Features include a simple configuration interface, the ability to use multiple tabs with terminals within a single window, the possibility to have a pseudo-transparent terminal background, and a compact mode (where both the menubar and the window decorations are hidden) that helps you to save space on your desktop.") (license gpl2+))) (define-public xfce4-dict (package (name "xfce4-dict") (version "0.8.5") (source (origin (method url-fetch) (uri (string-append "https://archive.xfce.org/src/apps/" name "/" (version-major+minor version) "/" name "-" version ".tar.bz2")) (sha256 (base32 "06xa7987azyx6y4mkmg58qv7gsg66szmr8ly29l9l1v1xl5sp7i9")))) (build-system gnu-build-system) (native-inputs (list intltool pkg-config)) (inputs (list libxfce4ui xfce4-panel)) (home-page "https://www.xfce.org/") (synopsis "Dictionary of Xfce desktop") (description "Xfce4-dict allows you to search different kinds of dictionary services for words or phrases and shows you the result. Currently you can query a Dict server (RFC 2229), any online dictionary service by opening a web browser or search for words using the aspell/ispell program. xfce4-dict contains a stand-alone application called “xfce4-dict” and a panel plugin for the Xfce panel.") (license gpl2+))) (define-public xfdashboard (package (name "xfdashboard") (version "1.0.0") (source (origin (method url-fetch) (uri (string-append "https://archive.xfce.org/src/apps/" name "/" (version-major+minor version) "/" name "-" version ".tar.bz2")) (sha256 (base32 "19a8xz6zv039j2m595v4wld3x4inidc7idfkk0pp42ffwm1l6a55")))) (build-system gnu-build-system) (native-inputs (list intltool pkg-config `(,glib "bin"))) (inputs (list clutter garcon gtk+ libwnck libxcomposite libxdamage libxfce4util libxfce4ui libxinerama xfconf)) (home-page "https://www.xfce.org/") (synopsis "Gnome shell like dashboard for Xfce") (description "Xfdashboard provides a GNOME shell dashboard and MacOS Mission Control like interface for Xfce desktop. It can be configured to run with any keyboard shortcut, when executed it provides an overview of applications currently opened which let user to switch between different applications. Its search feature works like Xfce's app finder and makes it convenient to search for and start applications.") (license gpl2+))) (define-public xfce (package (name "xfce") (version (package-version xfce4-session)) (source #f) (build-system trivial-build-system) (arguments '(#:modules ((guix build union)) #:builder (begin (use-modules (ice-9 match) (guix build union)) (match %build-inputs (((names . directories) ...) (union-build (assoc-ref %outputs "out") directories) #t))))) (inputs (list exo garcon adwaita-icon-theme elementary-xfce-icon-theme greybird-gtk-theme hicolor-icon-theme mate-polkit-for-xfce mousepad ristretto shared-mime-info thunar thunar-volman tumbler xfce4-appfinder xfce4-notifyd ;for pop-up notifications xfce4-panel xfce4-power-manager xfce4-screenshooter xfce4-session xfce4-settings xfce4-taskmanager xfce4-terminal xfconf xfdesktop xfwm4 xfwm4-themes xkill ;; Panel plugins. xfce4-battery-plugin xfce4-clipman-plugin xfce4-pulseaudio-plugin xfce4-xkb-plugin)) (propagated-inputs ;; Default font that applications such as IceCat require. (list font-dejavu)) (native-search-paths ;; For finding panel and thunar plugins. (append (package-native-search-paths xfce4-panel) (package-native-search-paths thunar))) (home-page "https://www.xfce.org/") (synopsis "Desktop environment (meta-package)") (description "Xfce is a lightweight desktop environment. It aims to be fast and low on system resources, while still being visually appealing and user friendly.") (license gpl2+))) (define-public xfce4-power-manager (package (name "xfce4-power-manager") (version "4.18.3") (source (origin (method url-fetch) (uri (string-append "https://archive.xfce.org/src/xfce/" "xfce4-power-manager/" (version-major+minor version) "/" "xfce4-power-manager-" version ".tar.bz2")) (sha256 (base32 "1w445v3911cf7l6w5c0f84aphv8s579f8srnhjrhf3drd07xsy8d")))) (build-system gnu-build-system) (native-inputs (list pkg-config intltool)) (inputs (list libxrandr gtk+ upower libnotify libxfce4ui)) (home-page "https://www.xfce.org/") (synopsis "Xfce Power Manager") (description "This is a power manager for the Xfce desktop. It manages the power sources on the computer and the devices that can be controlled to reduce their power consumption (such as LCD brightness level, monitor sleep, CPU frequency scaling, etc). In addition, xfce4-power-manager provides a set of freedesktop-compliant DBus interfaces to inform other applications about current power level so that they can adjust their power consumption, and it provides the inhibit interface which allows applications to prevent automatic sleep.") (license gpl2+))) (define-public ristretto (package (name "ristretto") (version "0.13.1") (source (origin (method url-fetch) (uri (string-append "https://archive.xfce.org/src/apps/ristretto/" (version-major+minor version) "/" "ristretto-" version ".tar.bz2")) (sha256 (base32 "07kraf6k18f53vgx98hvrb20hcm5134m7c958w96fl142nzzy6np")))) (build-system gnu-build-system) (native-inputs (list intltool desktop-file-utils `(,glib "bin") ; for gdbus-codegen pkg-config)) (inputs (list gtk+ libexif libxfce4ui tumbler)) (home-page "https://docs.xfce.org/apps/ristretto/start") (synopsis "Fast and lightweight picture-viewer") (description "The Ristretto Image Viewer is an application that can be used to view, and scroll through images. It can be used to run a slideshow of images, open images with other applications like an image-editor or configure an image as the desktop wallpaper.") (license gpl2+))) (define-public xfce4-taskmanager (package (name "xfce4-taskmanager") (version "1.5.5") (source (origin (method url-fetch) (uri (string-append "https://archive.xfce.org/src/apps/" "xfce4-taskmanager/" (version-major+minor version) "/" "xfce4-taskmanager-" version ".tar.bz2")) (sha256 (base32 "1rcaalqv6sdsnc6ick8fifgkqcf2xiflw9yk5szqn2qs4jx02kzn")))) (build-system gnu-build-system) (native-inputs (list intltool pkg-config)) (inputs (list libwnck libxmu gtk+ libxfce4ui ;; FIXME: Remove libxext and libxt when libxmu propagates them. libxext libxt)) (home-page "https://goodies.xfce.org/projects/applications/xfce4-taskmanager") (synopsis "Easy to use task manager") (description "This is a task manager for the Xfce desktop. It displays the CPU and memory usage graphically, and it can display processes as a tree.") (license gpl2+))) (define-public orage (package (name "orage") (version "4.18.0") (source (origin (method url-fetch) (uri (string-append "https://archive.xfce.org/src/apps/" name "/" (version-major+minor version) "/" name "-" version ".tar.bz2")) (sha256 (base32 "1v5385hps6jgcw1ky9vl7w7iryp0rzxz6s4lx72rz8yg4sdv84v3")))) (build-system gnu-build-system) (native-inputs (list `(,glib "bin") ; for dbus-binding-tool intltool pkg-config)) (inputs (list dbus-glib gtk+-2 libical libnotify libxfce4ui popt xfce4-panel)) (home-page "https://www.xfce.org/projects/") (synopsis "Simple calendar application with reminders") (description "This is a simple calendar application for the Xfce desktop. Orage has alarms and uses the iCalendar format, making it compatible with many other calendar applications. It also includes a panel clock plugin and an international clock application capable of simultaneously showing clocks from several different time zones.") (license gpl2+))) (define-public xfce4-notifyd (package (name "xfce4-notifyd") (version "0.8.2") (source (origin (method url-fetch) (uri (string-append "https://archive.xfce.org/src/apps/" name "/" (version-major+minor version) "/" name "-" version ".tar.bz2")) (sha256 (base32 "115fy87lcn9scwx52kjs0g250q2d3r10sahl6l8l38fs13dqm8p3")))) (build-system glib-or-gtk-build-system) (arguments (list #:phases #~(modify-phases %standard-phases (add-before 'configure 'patch-configure (lambda _ (substitute* "configure" (("\\$PKG_CONFIG --variable=gdbus_codegen gio-2.0") "which gdbus-codegen") (("\\$PKG_CONFIG --variable=glib_compile_resources gio-2.0") "which glib-compile-resources") (("\\$PKG_CONFIG --variable=glib_genmarshal glib-2.0") "which glib-genmarshal"))))))) (native-inputs (list intltool pkg-config (list glib "bin") which)) (inputs (list libxfce4ui libnotify sqlite xfce4-panel)) (home-page "https://goodies.xfce.org/projects/applications/xfce4-notifyd") (synopsis "Show notification bubbles on Xfce") (description "The Xfce Notify Daemon (xfce4-notifyd for short) is a smallish program that implements the “server-side” portion of the Freedesktop desktop notifications specification. Applications that wish to pop up a notification bubble in a standard way can implicitly make use of xfce4-notifyd to do so by sending standard messages over D-Bus using the @code{org.freedesktop.Notifications} interface.") (license gpl2))) (define-public xfburn (package (name "xfburn") (version "0.7.0") (source (origin (method url-fetch) (uri (string-append "https://archive.xfce.org/src/apps/xfburn/" (version-major+minor version) "/" "xfburn-" version ".tar.bz2")) (sha256 (base32 "0i8zpgp4mj78pn2023pdhzb7552r3b52phzp2gjr6jq4kakhx5ms")))) (build-system gnu-build-system) (native-inputs (list intltool pkg-config)) (inputs (list exo gstreamer gst-plugins-base gst-plugins-good gst-plugins-ugly glib gtk+ libburn libisofs libxfce4ui)) (home-page "https://goodies.xfce.org/projects/applications/xfburn") (synopsis "GTK+ based CD, DVD and Blu-ray burning application") (description "Xfburn is a simple CD, DVD, and Blu-ray burning tool based on the libburnia libraries. It can blank CD/DVD/BD(-RW)s, burn and create iso images, audio CDs, as well as burn personal compositions of data to either CD/DVD/BD.") (license gpl2+))) (define-public mousepad (package (name "mousepad") (version "0.6.1") (source (origin (method url-fetch) (uri (string-append "https://archive.xfce.org/src/apps/mousepad/" (version-major+minor version) "/mousepad-" version ".tar.bz2")) (sha256 (base32 "0dpzzy03hlw6gljp7ywdi6np41r88p2nr7rypwzy6zdwqwv5832n")))) (build-system gnu-build-system) (arguments '(#:configure-flags '(;; Use the GSettings keyfile backend rather than ;; DConf. "--enable-keyfile-settings") #:phases (modify-phases %standard-phases (add-after 'install 'wrap-program (lambda* (#:key inputs outputs #:allow-other-keys) (let ((out (assoc-ref outputs "out")) (gtksourceview (assoc-ref inputs "gtksourceview"))) (wrap-program (string-append out "/bin/mousepad") ;; For language-specs. `("XDG_DATA_DIRS" ":" prefix (,(string-append gtksourceview "/share")))))))))) (native-inputs (list intltool `(,glib "bin") ; for glib-compile-schemas. pkg-config)) (inputs (list gtk+ gtksourceview-4 xfconf)) (home-page "https://git.xfce.org/apps/mousepad/") (synopsis "Simple text editor for Xfce") (description "Mousepad is a graphical text editor for Xfce based on Leafpad.") (license gpl2+))) (define-public xfce4-screenshooter (package (name "xfce4-screenshooter") (version "1.10.4") (source (origin (method url-fetch) (uri (string-append "https://archive.xfce.org/src/apps/" "xfce4-screenshooter/" (version-major+minor version) "/xfce4-screenshooter-" version ".tar.bz2")) (sha256 (base32 "1534h1a3a8b9pl20zpccaifrlsrbsihdcdjndn9nmqalgrl9kwd2")))) (build-system gnu-build-system) (native-inputs (list pkg-config intltool `(,glib "bin"))) ; glib-genmarshal (inputs (list exo libsoup-minimal-2 libxfce4ui xfce4-panel)) (home-page "https://goodies.xfce.org/projects/applications/xfce4-screenshooter") (synopsis "Xfce's application to take screenshots") (description "This application allows you to capture the entire screen, the active window or a selected region. You can set the delay that elapses before the screenshot is taken and the action that will be done with the screenshot. A plugin for the Xfce panel is also available.") (license gpl2+))) (define-public xfce4-screensaver (package (name "xfce4-screensaver") (version "4.18.2") (source (origin (method url-fetch) (uri (string-append "https://archive.xfce.org/src/apps/" "xfce4-screensaver/" (version-major+minor version) "/xfce4-screensaver-" version ".tar.bz2")) (sha256 (base32 "161bdsvkbknaf9fpz4b1r4amnm72hzfmx9c6krg2396k2k2d5z74")))) (build-system gnu-build-system) (arguments `(#:phases (modify-phases %standard-phases (add-after 'unpack 'fix-dbus-1-path (lambda* (#:key outputs #:allow-other-keys) (let* ((out (assoc-ref outputs "out")) (dbus-dir (string-append out "/share/dbus-1/services"))) (substitute* "configure" (("DBUS_SESSION_SERVICE_DIR=.*") (string-append "DBUS_SESSION_SERVICE_DIR=" dbus-dir))))))))) (native-inputs (list pkg-config intltool glib ; glib-compile-schemas `(,glib "bin"))) ; glib-compile-schemas (inputs (list dbus-glib linux-pam elogind garcon libxklavier libwnck libxscrnsaver xfconf)) (home-page "https://docs.xfce.org/apps/screensaver/start") (synopsis "Screensaver for the Xfce desktop") (description "Xfce Screensaver is a screen saver and locker that aims to have simple, sane, secure defaults and be well integrated with the Xfce desktop.") (license gpl2+))) (define-public xfce4-volumed-pulse (package (name "xfce4-volumed-pulse") (version "0.2.4") (source (origin (method url-fetch) (uri (string-append "https://archive.xfce.org/src/apps/" name "/" (version-major+minor version) "/" name "-" version ".tar.bz2")) (sha256 (base32 "0ql3hlciffjs981jp21hg6phrk25crh64yc01fm0l75k4vvf66d0")))) (build-system glib-or-gtk-build-system) (native-inputs (list intltool pkg-config)) (inputs (list xfconf libnotify pulseaudio keybinder-3.0 gtk+)) (home-page "https://goodies.xfce.org/projects/applications/xfce4-volumed") (synopsis "XFCE volume keys daemon") (description "This is a volume keys control daemon for Xfce Desktop environment. It controls the volume using multimedia keys. It also provides volume change notifications.") (license gpl3+))) (define-public xfce4-cpugraph-plugin (package (name "xfce4-cpugraph-plugin") (version "1.2.8") (source (origin (method url-fetch) (uri (string-append "https://archive.xfce.org/src/panel-plugins/" "xfce4-cpugraph-plugin/" (version-major+minor version) "/xfce4-cpugraph-plugin-" version ".tar.bz2")) (sha256 (base32 "1gylfmpn36cm1b1kz0x8smy5hixzlhmdg5i53cj5fzgk4773id5z")))) (build-system gnu-build-system) (native-inputs (list intltool pkg-config)) (inputs (list libxfce4ui xfce4-panel)) (home-page "https://goodies.xfce.org/projects/panel-plugins/xfce4-cpugraph-plugin") (synopsis "Display CPU load as a graph in the Xfce panel") (description "This panel plugin offers multiple display modes (LED, gradient, fire, etc…) to show the current CPU load of the system. Various appearance options, like colors or size, are customizable. On multi core or multi CPU systems, CPU Graph can either track and display all of them at once, or at the user's option only a specific core or CPU.") (license gpl2+))) (define-public xfce4-eyes-plugin (package (name "xfce4-eyes-plugin") (version "4.6.0") (source (origin (method url-fetch) (uri (string-append "https://archive.xfce.org/src/panel-plugins/" "xfce4-eyes-plugin/" (version-major+minor version) "/xfce4-eyes-plugin-" version ".tar.bz2")) (sha256 (base32 "092kmv2i0flg3zg622q0id70mz1kvlz27y12i5y3nfdsi1fz03xd")))) (build-system gnu-build-system) (native-inputs (list intltool pkg-config)) (inputs (list libxfce4ui xfce4-panel)) (home-page "https://goodies.xfce.org/projects/panel-plugins/xfce4-eyes-plugin") (synopsis "Display a pair of eyes for the Xfce panel") (description "Eyes is a toy Xfce panel plugin that adds eyes which watch your every step.") (license gpl2+))) (define-public xfce4-datetime-plugin (package (name "xfce4-datetime-plugin") (version "0.8.3") (source (origin (method url-fetch) (uri (string-append "https://archive.xfce.org/src/panel-plugins/" "xfce4-datetime-plugin/" (version-major+minor version) "/xfce4-datetime-plugin-" version ".tar.bz2")) (sha256 (base32 "1c00rj3h25g0g3ss5n07hp2ziis3rnjd5jr6firnhs2qzdwynbkb")))) (build-system gnu-build-system) (native-inputs (list intltool pkg-config)) (inputs (list libxfce4ui xfce4-panel)) (home-page "https://goodies.xfce.org/projects/panel-plugins/xfce4-datetime-plugin") (synopsis "Display date and time inside the Xfce panel") (description "This plugin shows the date and time in the panel, and a calendar appears when you left-click on it.") (license gpl2+))) (define-public xfce4-calculator-plugin (package (name "xfce4-calculator-plugin") (version "0.7.2") (source (origin (method url-fetch) (uri (string-append "https://archive.xfce.org/src/panel-plugins/" "xfce4-calculator-plugin/" (version-major+minor version) "/xfce4-calculator-plugin-" version ".tar.bz2")) (sha256 (base32 "12q2jh67w0m9vq94gf324xg9k3mji943rwgrddlc340sljz25xni")))) (build-system gnu-build-system) (native-inputs (list intltool pkg-config)) (inputs (list libxfce4ui xfce4-panel)) (home-page "https://goodies.xfce.org/projects/panel-plugins/xfce4-calculator-plugin") (synopsis "Calculator for the Xfce panel") (description "This plugin is a calculator for the Xfce4 panel. It supports common mathematical operators (+, -, *, /, ^) with usual precedence rules, and the following functions and common constants.") (license gpl2+))) (define-public xfce4-cpufreq-plugin (package (name "xfce4-cpufreq-plugin") (version "1.2.8") (source (origin (method url-fetch) (uri (string-append "https://archive.xfce.org/src/panel-plugins/" "xfce4-cpufreq-plugin/" (version-major+minor version) "/xfce4-cpufreq-plugin-" version ".tar.bz2")) (sha256 (base32 "1sbkjphrlyyqsmdggq2624qr45wkkrmvczpv04h5fpkjykcmir07")))) (build-system gnu-build-system) (native-inputs (list intltool pkg-config)) (inputs (list libxfce4ui xfce4-panel)) (home-page "https://goodies.xfce.org/projects/panel-plugins/xfce4-cpufreq-plugin") (synopsis "Xfce panel plugin for displaying CPU frequency") (description "This panel plugin shows information about the CPU governor and frequencies supported and used by your system.") (license gpl2+))) (define-public xfce4-diskperf-plugin (package (name "xfce4-diskperf-plugin") (version "2.7.0") (source (origin (method url-fetch) (uri (string-append "https://archive.xfce.org/src/panel-plugins/" "xfce4-diskperf-plugin/" (version-major+minor version) "/xfce4-diskperf-plugin-" version ".tar.bz2")) (sha256 (base32 "1jgcdwiaqs06l729vbj3kgv67iwimjp8gfy7ydzlvbx6859sc2ar")))) (build-system gnu-build-system) (native-inputs (list intltool pkg-config)) (inputs (list libxfce4ui xfce4-panel)) (home-page "https://goodies.xfce.org/projects/panel-plugins/xfce4-diskperf-plugin") (synopsis "Display disk performance in the Xfce panel") (description "This Xfce panel plugin displays instant disk/partition performance (bytes transferred per second).") (license gpl2+))) (define-public xfce4-fsguard-plugin (package (name "xfce4-fsguard-plugin") (version "1.1.3") (source (origin (method url-fetch) (uri (string-append "https://archive.xfce.org/src/panel-plugins/" "xfce4-fsguard-plugin/" (version-major+minor version) "/xfce4-fsguard-plugin-" version ".tar.bz2")) (sha256 (base32 "0n62dsc25ynv8kk5va50py88fi0lgggvl0gi1r6dd4i2fns8pvw4")))) (build-system gnu-build-system) (native-inputs (list intltool pkg-config)) (inputs (list libxfce4ui xfce4-panel)) (home-page "https://goodies.xfce.org/projects/panel-plugins/xfce4-fsguard-plugin") (synopsis "Xfce panel plugin to monitor free disk space") (description "The panel plugin checks free space on a chosen mount point frequently and displays a message when a limit is reached. There are two limits: a warning limit where only the icon changes, and an urgent limit that advise the user with a message. The icon button can be clicked to open the chosen mount point.") (license bsd-2))) (define-public xfce4-genmon-plugin (package (name "xfce4-genmon-plugin") (version "4.1.1") (source (origin (method url-fetch) (uri (string-append "https://archive.xfce.org/src/panel-plugins/" "xfce4-genmon-plugin/" (version-major+minor version) "/xfce4-genmon-plugin-" version ".tar.bz2")) (sha256 (base32 "0d81npcqnmkw2qaqa8c6igh9j5r4ivgb15zcjwxjkyhrzz89y4dj")))) (build-system gnu-build-system) (native-inputs (list intltool pkg-config)) (inputs (list libxfce4ui xfce4-panel)) (home-page "https://goodies.xfce.org/projects/panel-plugins/xfce4-genmon-plugin") (synopsis "Generic program output monitor for the Xfce panel") (description "This plugin cyclically spawns the indicated script/program, captures its output (stdout) and displays the resulting string into the panel. The string can also contain markup to displayed an image, a bar, a button and a personalized tooltip.") (license gpl2+))) (define-public xfce4-mailwatch-plugin (package (name "xfce4-mailwatch-plugin") (version "1.3.1") (source (origin (method url-fetch) (uri (string-append "https://archive.xfce.org/src/panel-plugins/" "xfce4-mailwatch-plugin/" (version-major+minor version) "/xfce4-mailwatch-plugin-" version ".tar.bz2")) (sha256 (base32 "0sh402c7v3sa9nqz8dd2gfn7ml01xbhir680ci46i9jczvln8j85")))) (build-system gnu-build-system) (native-inputs (list intltool pkg-config)) (inputs (list gtk+-2 libxfce4ui exo xfce4-panel)) (home-page "https://goodies.xfce.org/projects/panel-plugins/xfce4-mailwatch-plugin") (synopsis "Mail watch plugin for the Xfce panel") (description "The Xfce4 Mailwatch Plugin is a multi-protocol, multi-mailbox mail watcher. Currently, the protocols supported are: @itemize @item IMAP (SSL/TLS and cleartext, CRAM-MD5) @item POP3 (SSL/TLS and cleartext, CRAM-MD5) @item Mbox mail spool (local) @item Maildir mail spool (local) @item MH-Maildir mail spool (local) @item Google Mail (GMail) mailbox (remote) (requires gnutls) @end itemize") (license gpl2))) (define-public xfce4-mpc-plugin (package (name "xfce4-mpc-plugin") (version "0.5.3") (source (origin (method url-fetch) (uri (string-append "https://archive.xfce.org/src/panel-plugins/" "xfce4-mpc-plugin/" (version-major+minor version) "/xfce4-mpc-plugin-" version ".tar.bz2")) (sha256 (base32 "0kb6nz3md3cacl7ys6gz4h2qailr050wp28b7qy2v66d396znrq4")))) (build-system gnu-build-system) (native-inputs (list intltool pkg-config)) (inputs (list libxfce4ui xfce4-panel)) (home-page "https://goodies.xfce.org/projects/panel-plugins/xfce4-mpc-plugin") (synopsis "Music Player Daemon plugin for the Xfce panel") (description "This is a simple client plugin for Music Player Daemon. Features: @itemize @item send Play/Stop/Next/Previous command to MPD. @item uses media icons names from icon-naming-spec (at least nuvola, tango and rodent themes provides these icons) @item decrease/increase volume using the mouse wheel. @item show the current volume, status and title as a tooltip when hovering the mouse over the plugin. @item show a simple playlist window upon middle-click, permitting to select a track to play @item configurable MPD host/port/password. @item toggles repeat/random features + enable/disable MPD outputs in the right-click menu. @item launch configurable client (gmpc, xterm -e ncmpc,..) through right-click menu @item configurable markup for tooltip and playlist, using a gmpc-like markup @end itemize") (license isc))) (define-public xfce4-mount-plugin (package (name "xfce4-mount-plugin") (version "1.1.6") (source (origin (method url-fetch) (uri (string-append "https://archive.xfce.org/src/panel-plugins/" "xfce4-mount-plugin/" (version-major+minor version) "/xfce4-mount-plugin-" version ".tar.bz2")) (sha256 (base32 "0ca8j2smq20zydj0gbb20fkcisgzcswpnpz5h8laxb3ghr03frlg")))) (build-system gnu-build-system) (native-inputs (list intltool pkg-config)) (inputs (list libxfce4ui xfce4-panel)) (home-page "https://goodies.xfce.org/projects/panel-plugins/xfce4-mount-plugin") (synopsis "Mount/unmount plugin for the Xfce panel") (description "The plugin will display a list of items representing your various devices. If you click on an unmounted devices it will mount it and vice versa. There is a warning in case a device can't be mounted or when unmounting fails.") (license gpl2+))) (define-public xfce4-netload-plugin (package (name "xfce4-netload-plugin") (version "1.4.1") (source (origin (method url-fetch) (uri (string-append "https://archive.xfce.org/src/panel-plugins/" "xfce4-netload-plugin/" (version-major+minor version) "/xfce4-netload-plugin-" version ".tar.bz2")) (sha256 (base32 "0kmlrh29gn6yby8l1lgxp4211pjn3mrd2z0jzd5mh61fslx3mb4z")))) (build-system gnu-build-system) (native-inputs (list intltool pkg-config)) (inputs (list libxfce4ui xfce4-panel)) (home-page "https://goodies.xfce.org/projects/panel-plugins/xfce4-netload-plugin") (synopsis "Netload plugin for the Xfce Panel") (description "This plugin displays the current load of the network interfaces of your choice in the panel.") (license gpl2+))) (define-public xfce4-places-plugin (package (name "xfce4-places-plugin") (version "1.8.3") (source (origin (method url-fetch) (uri (string-append "https://archive.xfce.org/src/panel-plugins/" "xfce4-places-plugin/" (version-major+minor version) "/xfce4-places-plugin-" version ".tar.bz2")) (sha256 (base32 "0hy7c350x1p1grj517l1x0r8b4asbcv7sl3b5qnb0apj0dnhw7gi")))) (build-system gnu-build-system) (native-inputs (list intltool desktop-file-utils pkg-config)) (inputs (list gtk+-2 exo libxfce4ui xfce4-panel)) (home-page "https://goodies.xfce.org/projects/panel-plugins/xfce4-places-plugin") (synopsis "Gnome-like Places menu for the Xfce panel") (description "This plugin provides a menu with quick access to folders, documents, and removable media. The places plugin brings much of the functionality of GNOME's Places menu to Xfce. The plugin puts a simple button on the panel. Clicking on this button opens up a menu with the following: @itemize @item System-defined directories (home folder, trash, desktop, file system) @item Removable media (using thunar-vfs) @item User-defined bookmarks (reads @file{~/.gtk-bookmarks}) @item Search program launcher (optional) @item Recent documents submenu @end itemize") (license gpl2+))) (define-public xfce4-smartbookmark-plugin (package (name "xfce4-smartbookmark-plugin") (version "0.5.2") (source (origin (method url-fetch) (uri (string-append "https://archive.xfce.org/src/panel-plugins/" "xfce4-smartbookmark-plugin/" (version-major+minor version) "/xfce4-smartbookmark-plugin-" version ".tar.bz2")) (sha256 (base32 "1lyd64qc9w6qnpqjb5xk0mjq4l7riv6z7l9aws28clalb8prw9ra")))) (build-system gnu-build-system) (native-inputs (list intltool pkg-config)) (inputs (list libxfce4ui xfce4-panel)) (home-page "https://goodies.xfce.org/projects/panel-plugins/xfce4-smartbookmark-plugin") (synopsis "Perform custom searches in your browser from the Xfce panel") (description "This plugin allows you to send search requests directly to your browser, such that you can search through your favorite search engine or bug tracker right from the Xfce panel.") (license gpl2+))) (define-public xfce4-statusnotifier-plugin (package (name "xfce4-statusnotifier-plugin") (version "0.2.3") (source (origin (method url-fetch) (uri (string-append "https://archive.xfce.org/src/panel-plugins/" "xfce4-statusnotifier-plugin/" (version-major+minor version) "/xfce4-statusnotifier-plugin-" version ".tar.bz2")) (sha256 (base32 "1d2n56g12dhnjznrq7xvr6d3brpp0lmm080xmgjb7ybc1yygpxrc")))) (build-system gnu-build-system) (native-inputs (list intltool pkg-config `(,glib "bin"))) (inputs (list libxfce4ui libdbusmenu xfce4-panel)) (home-page "https://goodies.xfce.org/projects/panel-plugins/xfce4-statusnotifier-plugin") (synopsis "Xfce panel plugin for status notifier items") (description "This plugin provides a panel area for status notifier items (application indicators). Applications may use these items to display their status and interact with the user. This technology is a modern alternative to systray and follows the freedesktop.org specification.") (license gpl2+))) (define-public xfce4-stopwatch-plugin (package (name "xfce4-stopwatch-plugin") (version "0.5.0") (source (origin (method url-fetch) (uri (string-append "https://archive.xfce.org/src/panel-plugins/" "xfce4-stopwatch-plugin/" (version-major+minor version) "/xfce4-stopwatch-plugin-" version ".tar.bz2")) (sha256 (base32 "1q840298jzdqlhc9lw49q32xzdhnbzcgvv69qq5slkc704s5w6vw")))) (build-system gnu-build-system) (native-inputs (list intltool pkg-config)) (inputs (list libxfce4ui xfce4-panel)) (home-page "https://goodies.xfce.org/projects/panel-plugins/xfce4-stopwatch-plugin") (synopsis "Stopwatch plugin for the Xfce panel") (description "This Xfce panel plugin keeps track of elapsed time.") (license bsd-2))) (define-public xfce4-systemload-plugin (package (name "xfce4-systemload-plugin") (version "1.3.2") (source (origin (method url-fetch) (uri (string-append "https://archive.xfce.org/src/panel-plugins/" "xfce4-systemload-plugin/" (version-major+minor version) "/xfce4-systemload-plugin-" version ".tar.bz2")) (sha256 (base32 "0wmh09w5fnm9srbr6r4gpdima738szqcp3qbzb8kl18f0b1kyc5v")))) (build-system gnu-build-system) (native-inputs (list intltool pkg-config)) (inputs (list libgtop libxfce4ui xfce4-panel)) (home-page "https://goodies.xfce.org/projects/panel-plugins/xfce4-systemload-plugin") (synopsis "System load display plugin for the Xfce panel") (description "A system load plugin for the Xfce4 desktop environment. It displays the current CPU load, the memory in use, the swap space and the system uptime in the Xfce4 panel.") (license bsd-2))) (define-public xfce4-time-out-plugin (package (name "xfce4-time-out-plugin") (version "1.1.3") (source (origin (method url-fetch) (uri (string-append "https://archive.xfce.org/src/panel-plugins/" "xfce4-time-out-plugin/" (version-major+minor version) "/xfce4-time-out-plugin-" version ".tar.bz2")) (sha256 (base32 "1s4f4akj45bjhqhnfb8wim2snw52wrdym1yqpcccfpp9c5is672s")))) (build-system gnu-build-system) (native-inputs (list intltool pkg-config)) (inputs (list gtk+ libxfce4ui xfce4-panel)) (home-page "https://goodies.xfce.org/projects/panel-plugins/xfce4-time-out-plugin") (synopsis "Xfce panel plugin that encourages periodical breaks") (description "This plugin encourages to take periodical breaks from the computer every X minutes. During breaks it locks your screen. It optionally allows you to postpone breaks for a certain time.") (license gpl2+))) (define-public xfce4-timer-plugin (package (name "xfce4-timer-plugin") (version "1.7.2") (source (origin (method url-fetch) (uri (string-append "https://archive.xfce.org/src/panel-plugins/" "xfce4-timer-plugin/" (version-major+minor version) "/xfce4-timer-plugin-" version ".tar.bz2")) (sha256 (base32 "0zcbqpsyzzmbyv8cgd5wriqaigfpdcia6h1md0bfh1cmsg1biczy")))) (build-system gnu-build-system) (native-inputs (list intltool pkg-config)) (inputs (list libxfce4ui xfce4-panel)) (home-page "https://goodies.xfce.org/projects/panel-plugins/xfce4-timer-plugin") (synopsis "Simple countdown and alarm plugin for the Xfce panel") (description "This is a simple plugin that lets the user run an alarm at a specified time or at the end of a specified countdown period.") (license gpl2+))) (define-public xfce4-verve-plugin (package (name "xfce4-verve-plugin") (version "2.0.3") (source (origin (method url-fetch) (uri (string-append "https://archive.xfce.org/src/panel-plugins/" "xfce4-verve-plugin/" (version-major+minor version) "/xfce4-verve-plugin-" version ".tar.bz2")) (sha256 (base32 "17p0kxnzx4ks3rs281x5pvwksl1gh2mg7h7mkccjmkzr3cgi5gz1")))) (build-system gnu-build-system) (native-inputs (list intltool pkg-config)) (inputs (list libxfce4ui pcre2 xfce4-panel)) (home-page "https://goodies.xfce.org/projects/panel-plugins/xfce4-verve-plugin") (synopsis "Command line for the Xfce panel") (description "The Verve plugin provides a comfortable command line for the Xfce panel. It supports several features, such as: @itemize @item Opens URLs, e-mail addresses, directories, and programs @item Command history @item Auto-completion (including command history) @item Focus grabbing via D-BUS (so you can bind a shortcut to it) @item Custom input field width @end itemize") (license gpl2+))) (define-public xfce4-wavelan-plugin (package (name "xfce4-wavelan-plugin") (version "0.6.3") (source (origin (method url-fetch) (uri (string-append "https://archive.xfce.org/src/panel-plugins/" "xfce4-wavelan-plugin/" (version-major+minor version) "/xfce4-wavelan-plugin-" version ".tar.bz2")) (sha256 (base32 "0azpv0s3r4ag3gp0bsfvq0jgzycx6ivdsw5p0ga7425pdksw5h31")))) (build-system gnu-build-system) (native-inputs (list intltool pkg-config)) (inputs (list libxfce4ui xfce4-panel)) (home-page "https://goodies.xfce.org/projects/panel-plugins/xfce4-wavelan-plugin") (synopsis "Show stats from WLAN interface in Xfce panel") (description "This plugin is used to display stats from a wireless lan interface (signal state, signal quality, network name (SSID)).") (license bsd-2))) (define-public xfce4-weather-plugin (package (name "xfce4-weather-plugin") (version "0.11.1") (source (origin (method url-fetch) (uri (string-append "https://archive.xfce.org/src/panel-plugins/" "xfce4-weather-plugin/" (version-major+minor version) "/xfce4-weather-plugin-" version ".tar.bz2")) (sha256 (base32 "0fajhibacccfw0rl8741iz7qkqls4ynn9760j78rbp6wl3wlcld4")))) (build-system gnu-build-system) (native-inputs (list intltool pkg-config)) (inputs (list gtk+ libsoup-minimal-2 libxfce4ui libxml2 xfce4-panel)) (home-page "https://goodies.xfce.org/projects/panel-plugins/xfce4-weather-plugin") (synopsis "Show information about local weather in the Xfce panel") (description "This Xfce panel plugin shows information about your local weather in the panel, using forecast data provided by the @uref{https://met.no, Norwegian Meteorological Institute}.") (license gpl2+))) (define-public xfce4-dev-tools (package (name "xfce4-dev-tools") (version "4.18.1") (source (origin (method url-fetch) (uri (string-append "https://archive.xfce.org/src/xfce/" "xfce4-dev-tools/" (version-major+minor version) "/" "xfce4-dev-tools-" version ".tar.bz2")) (sha256 (base32 "10bnb8q7sj60ahzfwrb3av4ngr17wk1p6jsnfv0yn8l90kksnb41")))) (build-system gnu-build-system) (native-inputs (list pkg-config)) (inputs (list glib)) (home-page "https://docs.xfce.org/xfce/xfce4-dev-tools/") (synopsis "Xfce developer tools") (description "The Xfce development tools are a collection of tools and macros for Xfce developers and people that want to build Xfce from Git In addition it contains the Xfce developer's handbook.") (license gpl2+)))