;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2021, 2022 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 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 . ;;; Commentary: ;;; ;;; This module contains procedures to interact with D-Bus via the 'dbus-send' ;;; command line utility. Before using any public procedure ;;; ;;; Code: (define-module (gnu build dbus-service) #:use-module (ice-9 match) #:use-module (srfi srfi-1) #:use-module (srfi srfi-19) #:use-module (srfi srfi-26) #:autoload (d-bus protocol connections) (d-bus-conn? d-bus-conn-flush d-bus-connect d-bus-disconnect d-bus-session-bus-address d-bus-system-bus-address) #:autoload (d-bus protocol messages) (MESSAGE_TYPE_METHOD_CALL d-bus-headers-ref d-bus-message-body d-bus-message-headers d-bus-read-message d-bus-write-message header-PATH header-DESTINATION header-INTERFACE header-MEMBER header-SIGNATURE make-d-bus-message) #:export (%dbus-query-timeout initialize-dbus-connection! %current-dbus-connection send-dbus call-dbus-method dbus-available-services dbus-service-available? with-retries)) (define %dbus-query-timeout 2) ;in seconds ;;; Use Fibers' sleep to enable cooperative scheduling in Shepherd >= 0.9.0, ;;; which is required at least for the Jami service. (define sleep* (lambda () ;delay execution (if (resolve-module '(fibers) #f) (module-ref (resolve-interface '(fibers)) 'sleep) (begin (format #f "fibers not available -- blocking 'sleep' in use") sleep)))) ;;; ;;; Utilities. ;;; (define-syntax-rule (with-retries n delay body ...) "Retry the code in BODY up to N times until it doesn't raise an exception nor return #f, else raise an error. A delay of DELAY seconds is inserted before each retry." (let loop ((attempts 0)) (catch #t (lambda () (let ((result (begin body ...))) (if (not result) (error "failed attempt" attempts) result))) (lambda args (if (< attempts n) (begin ((sleep*) delay) ;else wait and retry (loop (+ 1 attempts))) (error "maximum number of retry attempts reached" body ... args)))))) ;;; ;;; Low level wrappers above AC/D-Bus. ;;; ;; The active D-Bus connection (a parameter) used by the other procedures. (define %current-dbus-connection (make-parameter #f)) (define* (initialize-dbus-connection! #:key (address (or (d-bus-session-bus-address) (d-bus-system-bus-address)))) "Initialize the D-Bus connection. ADDRESS should be the address of the D-Bus session, e.g. \"unix:path=/var/run/dbus/system_bus_socket\", the default value if ADDRESS is not provided and DBUS_SESSION_BUS_ADDRESS is not set. Return the initialized D-Bus connection." ;; Clear current correction if already active. (when (d-bus-conn? (%current-dbus-connection)) (d-bus-disconnect (%current-dbus-connection))) (let ((connection (d-bus-connect addressTagDownloadAuthorAge v2.0.1browser-extension-2.0.1.tar.gz  browser-extension-2.0.1.zip  Wojtek Kosior2 years v2.0browser-extension-2.0.tar.gz  browser-extension-2.0.zip  Wojtek Kosior2 years v2.0-beta1browser-extension-2.0-beta1.tar.gz  browser-extension-2.0-beta1.zip  Wojtek Kosior2 years v1.0browser-extension-1.0.tar.gz  browser-extension-1.0.zip  Wojtek Kosior3 years v1.0-beta3browser-extension-1.0-beta3.tar.gz  browser-extension-1.0-beta3.zip  Wojtek Kosior3 years v1.0-beta2browser-extension-1.0-beta2.tar.gz  browser-extension-1.0-beta2.zip  Wojtek Kosior3 years v1.0-beta1browser-extension-1.0-beta1.tar.gz  browser-extension-1.0-beta1.zip  Wojtek Kosior3 years
generated by cgit
""))) '())) arguments))) (send-dbus message #:connection connection #:timeout timeout))) ;;; ;;; Higher-level, D-Bus procedures. ;;; (define (dbus-available-services) "Return the list of available (acquired) D-Bus services." (let ((names (vector->list (call-dbus-method "ListNames")))) ;; Remove entries such as ":1.7". (remove (cut string-prefix? ":" <>) names))) (define (dbus-service-available? service) "Predicate to check for the D-Bus SERVICE availability." (member service (dbus-available-services))) ;; Local Variables: ;; eval: (put 'with-retries 'scheme-indent-function 2) ;; End: