;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2014 David Thompson ;;; Copyright © 2016 David Craven ;;; Copyright © 2019, 2020 Ludovic Courtès ;;; Copyright © 2020 Martin Becze ;;; ;;; 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 . (define-module (test-crate) #:use-module (guix import crate) #:use-module (guix base32) #:use-module (guix build-system cargo) #:use-module (gcrypt hash) #:use-module (guix tests) #:use-module (gnu packages) #:use-module (ice-9 iconv) #:use-module (ice-9 match) #:use-module (srfi srfi-64)) ;; crate versions and dependencies used here ;; foo-0.8.1 ;; foo-1.0.0 ;; foo-1.0.3 ;; leaf-alice 0.7.5 ;; ;; root-1.0.0 ;; root-1.0.4 ;; intermediate-a 1.0.42 ;; intermeidate-b ^1.0.0 ;; leaf-alice ^0.7 ;; leaf-bob ^3 ;; ;; intermediate-a-1.0.40 ;; intermediate-a-1.0.42 ;; intermediate-a-1.1.0-alpha.1 ;; intermediate-a 1.2.3 ;; leaf-alice 0.7.5 ;; leaf-bob ^3 ;; ;; intermediate-b-1.2.3 ;; leaf-bob 3.0.1 ;; ;; leaf-alice-0.7.3 ;; leaf-alice-0.7.5 ;; ;; leaf-bob-3.0.1 (define test-foo-crate "{ \"crate\": { \"max_version\": \"1.0.3\", \"name\": \"foo\", \"description\": \"summary\", \"homepage\": \"http://example.com\", \"repository\": \"http://example;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2014-2022 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2015 Andy Wingo <wingo@igalia.com> ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2016 Sou Bunnbu <iyzsong@gmail.com> ;;; Copyright © 2017, 2020, 2022, 2023 Maxim Cournoyer <maxim.cournoyer@gmail.com> ;;; Copyright © 2017 Nikita <nikita@n0.is> ;;; Copyright © 2017, 2019 Hartmut Goebel <h.goebel@crazy-compilers.com> ;;; Copyright © 2018, 2020, 2022 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2018, 2023 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2017, 2019 Christopher Baines <mail@cbaines.net> ;;; Copyright © 2019 Tim Gesthuizen <tim.gesthuizen@yahoo.de> ;;; Copyright © 2019 David Wilson <david@daviwil.com> ;;; Copyright © 2020, 2024 Tobias Geerinckx-Rice <me@tobias.gr> ;;; Copyright © 2020 Reza Alizadeh Majd <r.majd@pantherx.org> ;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re> ;;; Copyright © 2021, 2022 muradm <mail@muradm.net> ;;; Copyright © 2023 Bruno Victal <mirai@makinata.eu> ;;; Copyright © 2023 Zheng Junjie <873216071@qq.com> ;;; ;;; This file is part of GNU Guix. ;;; ;;; GNU Guix is free software; you can redistribute it and/or modify it ;;; under the terms of the GNU General Public License as published by ;;; the Free Software Foundation; either version 3 of the License, or (at ;;; your option) any later version. ;;; ;;; GNU Guix is distributed in the hope that it will be useful, but ;;; WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;; GNU General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (gnu services desktop) #:use-module (gnu services) #:use-module (gnu services shepherd) #:use-module (gnu services base) #:use-module (gnu services configuration) #:use-module (gnu services dbus) #:use-module (gnu services avahi) #:use-module (gnu services xorg) #:use-module (gnu services networking) #:use-module (gnu services sound) #:use-module ((gnu system file-systems) #:select (%control-groups %elogind-file-systems file-system)) #:autoload (gnu services sddm) (sddm-service-type) #:use-module (gnu system) #:use-module (gnu system privilege) #:use-module (gnu system shadow) #:use-module (gnu system uuid) #:use-module (gnu system pam) #:use-module (gnu packages glib) #:use-module (gnu packages admin) #:use-module (gnu packages cups) #:use-module (gnu packages freedesktop) #:use-module (gnu packages gnome) #:use-module (gnu packages kde) #:use-module (gnu packages kde-frameworks) #:use-module (gnu packages kde-plasma) #:use-module (gnu packages pulseaudio) #:use-module (gnu packages xfce) #:use-module (gnu packages avahi) #:use-module (gnu packages xdisorg) #:use-module (gnu packages scanner) #:use-module (gnu packages suckless) #:use-module (gnu packages sugar) #:use-module (gnu packages linux) #:use-module (gnu packages libusb) #:use-module (gnu packages lxqt) #:use-module (gnu packages mate) #:use-module (gnu packages nfs) #:use-module (gnu packages enlightenment) #:use-module (guix deprecation) #:use-module (guix records) #:use-module (guix packages) #:use-module (guix store) #:use-module (guix ui) #:use-module (guix utils) #:use-module (guix gexp) #:use-module (guix modules) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (ice-9 format) #:use-module (ice-9 match) #:export (<upower-configuration> upower-configuration upower-configuration? upower-configuration-upower upower-configuration-watts-up-pro? upower-configuration-poll-batteries? upower-configuration-ignore-lid? upower-configuration-use-percentage-for-policy? upower-configuration-percentage-low upower-configuration-percentage-critical upower-configuration-percentage-action upower-configuration-time-low upower-configuration-time-critical upower-configuration-time-action upower-configuration-critical-power-action upower-service-type udisks-configuration udisks-configuration? udisks-service ; deprecated udisks-service-type gvfs-configuration gvfs-configuration? gvfs-service-type colord-service-type geoclue-application geoclue-configuration geoclue-configuration? %standard-geoclue-applications geoclue-service ; deprecated geoclue-service-type bluetooth-service-type bluetooth-configuration bluetooth-configuration? bluetooth-service ; deprecated elogind-configuration elogind-configuration? elogind-service ; deprecated elogind-service-type %gdm-file-system gdm-file-system-service %fontconfig-file-system fontconfig-file-system-service accountsservice-service-type accountsservice-service ; deprecated cups-pk-helper-service-type sane-service-type gnome-desktop-configuration gnome-desktop-configuration? gnome-desktop-configuration-core-services gnome-desktop-configuration-shell gnome-desktop-configuration-utilities gnome-desktop-configuration-extra-packages gnome-desktop-configuration-udev-ignorelist gnome-desktop-service gnome-desktop-service-type mate-desktop-configuration mate-desktop-configuration? mate-desktop-service mate-desktop-service-type lxqt-desktop-configuration lxqt-desktop-configuration? lxqt-desktop-service-type sugar-desktop-configuration sugar-desktop-configuration? sugar-desktop-service-type plasma-desktop-configuration plasma-desktop-configuration? plasma-desktop-service-type xfce-desktop-configuration xfce-desktop-configuration? xfce-desktop-service xfce-desktop-service-type x11-socket-directory-service ;deprecated x11-socket-directory-service-type enlightenment-desktop-configuration enlightenment-desktop-configuration? enlightenment-desktop-service-type inputattach-configuration inputattach-configuration? inputattach-service-type polkit-wheel-service gnome-keyring-configuration gnome-keyring-configuration? gnome-keyring-service-type seatd-configuration seatd-service-type %desktop-services)) ;;; Commentary: ;;; ;;; This module contains service definitions for a "desktop" environment. ;;; ;;; Code: ;;; ;;; Helpers. ;;; (define (bool value) (if value "true\n" "false\n")) (define (package-direct-input-selector tree) "Return a procedure that selects TREE from the inputs of PACKAGE. If TREE is a list, it recursively searches it until it locates the last item of TREE." (lambda (package) (let loop ((tree (if (pair? tree) tree (list tree))) (package package)) (if (null? tree) package (loop (cdr tree) (car (assoc-ref (package-direct-inputs package) (car tree)))))))) ;;; ;;; Upower D-Bus service. ;;; (define-record-type* <upower-configuration> upower-configuration make-upower-configuration upower-configuration? (upower upower-configuration-upower (default upower)) (watts-up-pro? upower-configuration-watts-up-pro? (default #f)) (poll-batteries? upower-configuration-poll-batteries? (default #t)) (ignore-lid? upower-configuration-ignore-lid? (default #f)) (use-percentage-for-policy? upower-configuration-use-percentage-for-policy? (default #t)) (percentage-low upower-configuration-percentage-low (default 20)) (percentage-critical upower-configuration-percentage-critical (default 5)) (percentage-action upower-configuration-percentage-action (default 2)) (time-low upower-configuration-time-low (default 1200)) (time-critical upower-configuration-time-critical (default 300)) (time-action upower-configuration-time-action (default 120)) (critical-power-action upower-configuration-critical-power-action (default 'hybrid-sleep))) (define* upower-configuration-file ;; Return an upower-daemon configuration file. (match-lambda (($ <upower-configuration> upower watts-up-pro? poll-batteries? ignore-lid? use-percentage-for-policy? percentage-low percentage-critical percentage-action time-low time-critical time-action critical-power-action) (plain-file "UPower.conf" (string-append "[UPower]\n" "EnableWattsUpPro=" (bool watts-up-pro?) "NoPollBatteries=" (bool (not poll-batteries?)) "IgnoreLid=" (bool ignore-lid?) "UsePercentageForPolicy=" (bool use-percentage-for-policy?) "PercentageLow=" (number->string percentage-low) "\n" "PercentageCritical=" (number->string percentage-critical) "\n" "PercentageAction=" (number->string percentage-action) "\n" "TimeLow=" (number->string time-low) "\n" "TimeCritical=" (number->string time-critical) "\n" "TimeAction=" (number->string time-action) "\n" "CriticalPowerAction=" (match critical-power-action ('hybrid-sleep "HybridSleep") ('hibernate "Hibernate") ('power-off "PowerOff")) "\n"))))) (define %upower-activation #~(begin (use-modules (guix build utils)) (mkdir-p "/var/lib/upower"))) (define (upower-dbus-service config) (list (wrapped-dbus-service (upower-configuration-upower config) "libexec/upowerd" `(("UPOWER_CONF_FILE_NAME" ,(upower-configuration-file config)))))) (define (upower-shepherd-service config) "Return a shepherd service for UPower with CONFIG." (let ((upower (upower-configuration-upower config)) (config (upower-configuration-file config))) (list (shepherd-service (documentation "Run the UPower power and battery monitor.") (provision '(upower-daemon)) (requirement '(dbus-system udev)) (start #~(make-forkexec-constructor (list (string-append #$upower "/libexec/upowerd")) #:environment-variables (list (string-append "UPOWER_CONF_FILE_NAME=" #$config)))) (stop #~(make-kill-destructor)) (actions (list (shepherd-configuration-action config))))))) (define upower-service-type (let ((upower-package (compose list upower-configuration-upower))) (service-type (name 'upower) (description "Run @command{upowerd}}, a system-wide monitor for power consumption and battery levels, with the given configuration settings. It implements the @code{org.freedesktop.UPower} D-Bus interface, and is notably used by GNOME.") (extensions (list (service-extension dbus-root-service-type upower-dbus-service) (service-extension shepherd-root-service-type upower-shepherd-service) (service-extension activation-service-type (const %upower-activation)) (service-extension udev-service-type upower-package) ;; Make the 'upower' command visible. (service-extension profile-service-type upower-package))) (default-value (upower-configuration))))) ;;; ;;; GeoClue D-Bus service. ;;; (define* (geoclue-application name #:key (allowed? #t) system? (users '())) "Configure default GeoClue access permissions for an application. NAME is the Desktop ID of the application, without the .desktop part. If ALLOWED? is true, the application will have access to location information by default. The boolean SYSTEM? value indicates that an application is a system component or not. Finally USERS is a list of UIDs of all users for which this application is allowed location info access. An empty users list means all users are allowed." (string-append "[" name "]\n" "allowed=" (bool allowed?) "system=" (bool system?) "users=" (string-join users ";") "\n")) (define %standard-geoclue-applications (list (geoclue-application "gnome-datetime-panel" #:system? #t) (geoclue-application "epiphany" #:system? #f) (geoclue-application "firefox" #:system? #f))) ;; TODO: Use define-configuration and export accessors. (define-record-type* <geoclue-configuration> geoclue-configuration make-geoclue-configuration geoclue-configuration? (geoclue geoclue-configuration-geoclue (default geoclue)) (whitelist geoclue-configuration-whitelist (default '())) (wifi-geolocation-url geoclue-configuration-wifi-geolocation-url ;; Mozilla geolocation service: (default "https://location.services.mozilla.com/v1/geolocate?key=geoclue")) (submit-data? geoclue-configuration-submit-data? (default #f)) (wifi-submission-url geoclue-configuration-wifi-submission-url (default "https://location.services.mozilla.com/v1/submit?key=geoclue")) (submission-nick geoclue-configuration-submission-nick (default "geoclue")) (applications geoclue-configuration-applications (default %standard-geoclue-applications))) (define* (geoclue-configuration-file config) "Return a geoclue configuration file." (plain-file "geoclue.conf" (string-append "[agent]\n" "whitelist=" (string-join (geoclue-configuration-whitelist config) ";") "\n" "[wifi]\n" "url=" (geoclue-configuration-wifi-geolocation-url config) "\n" "submit-data=" (bool (geoclue-configuration-submit-data? config)) "submission-url=" (geoclue-configuration-wifi-submission-url config) "\n" "submission-nick=" (geoclue-configuration-submission-nick config) "\n" (string-join (geoclue-configuration-applications config) "\n")))) (define (geoclue-dbus-service config) (list (wrapped-dbus-service (geoclue-configuration-geoclue config) "libexec/geoclue" `(("GEOCLUE_CONFIG_FILE" ,(geoclue-configuration-file config)))))) (define %geoclue-accounts (list (user-group (name "geoclue") (system? #t)) (user-account (name "geoclue") (group "geoclue") (system? #t) (comment "GeoClue daemon user") (home-directory "/var/empty") (shell "/run/current-system/profile/sbin/nologin")))) (define geoclue-service-type (service-type (name 'geoclue) (extensions (list (service-extension dbus-root-service-type geoclue-dbus-service) (service-extension account-service-type (const %geoclue-accounts)))) (description "Run the @command{geoclue} location service. This service provides a D-Bus interface to allow applications to request access to a user's physical location, and optionally to add information to online location databases.") (default-value (geoclue-configuration)))) (define-deprecated (geoclue-service #:key (geoclue geoclue) (whitelist '()) (wifi-geolocation-url ;; Mozilla geolocation service: "https://location.services.mozilla.com/v1/geolocate?key=geoclue") (submit-data? #f) (wifi-submission-url "https://location.services.mozilla.com/v1/submit?key=geoclue") (submission-nick "geoclue") (applications %standard-geoclue-applications)) geoclue-service-type "Return a service that runs the @command{geoclue} location service. This service provides a D-Bus interface to allow applications to request access to a user's physical location, and optionally to add information to online location databases. By default, only the GNOME date-time panel and the Icecat and Epiphany web browsers are able to ask for the user's location, and in the case of Icecat and Epiphany, both will ask the user for permission first. See @uref{https://wiki.freedesktop.org/www/Software/GeoClue/, the geoclue web site} for more information." (service geoclue-service-type (geoclue-configuration (geoclue geoclue) (whitelist whitelist) (wifi-geolocation-url wifi-geolocation-url) (submit-data? submit-data?) (wifi-submission-url wifi-submission-url) (submission-nick submission-nick) (applications applications)))) ;;; ;;; Bluetooth. ;;; (define-record-type* <bluetooth-configuration> bluetooth-configuration make-bluetooth-configuration bluetooth-configuration? (bluez bluetooth-configuration-bluez (default bluez)) ;;; [General] (name bluetooth-configuration-name (default "BlueZ")) (class bluetooth-configuration-class (default #x000000)) (discoverable-timeout bluetooth-configuration-discoverable-