;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2021, 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

;;; 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 (</td></tr></table>
<table class='tabs'><tr><td>
<a href='/guix/about/'>about</a><a href='/guix/'>summary</a><a href='/guix/refs/?id=1c17b444c67fd2a89a5ebebb22f7de7279180a71'>refs</a><a href='/guix/log/gnu/installer/newt/welcome.scm'>log</a><a href='/guix/tree/gnu/installer/newt/welcome.scm?id=1c17b444c67fd2a89a5ebebb22f7de7279180a71'>tree</a><a class='active' href='/guix/commit/gnu/installer/newt/welcome.scm?id=1c17b444c67fd2a89a5ebebb22f7de7279180a71'>commit</a><a href='/guix/diff/gnu/installer/newt/welcome.scm?id=1c17b444c67fd2a89a5ebebb22f7de7279180a71'>diff</a></td><td class='form'><form class='right' method='get' action='/guix/log/gnu/installer/newt/welcome.scm'>
<input type='hidden' name='id' value='1c17b444c67fd2a89a5ebebb22f7de7279180a71'/><select name='qt'>
<option value='grep'>log msg</option>
<option value='author'>author</option>
<option value='committer'>committer</option>
<option value='range'>range</option>
</select>
<input class='txt' type='search' size='10' name='q' value=''/>
<input type='submit' value='search'/>
</form>
</td></tr></table>
<div class='path'>path: <a href='/guix/commit/?id=1c17b444c67fd2a89a5ebebb22f7de7279180a71'>root</a>/<a href='/guix/commit/gnu?id=1c17b444c67fd2a89a5ebebb22f7de7279180a71'>gnu</a>/<a href='/guix/commit/gnu/installer?id=1c17b444c67fd2a89a5ebebb22f7de7279180a71'>installer</a>/<a href='/guix/commit/gnu/installer/newt?id=1c17b444c67fd2a89a5ebebb22f7de7279180a71'>newt</a>/<a href='/guix/commit/gnu/installer/newt/welcome.scm?id=1c17b444c67fd2a89a5ebebb22f7de7279180a71'>welcome.scm</a></div><div class='content'><div class='cgit-panel'><b>diff options</b><form method='get'><input type='hidden' name='id' value='1c17b444c67fd2a89a5ebebb22f7de7279180a71'/><table><tr><td colspan='2'/></tr><tr><td class='label'>context:</td><td class='ctrl'><select name='context' onchange='this.form.submit();'><option value='1'>1</option><option value='2'>2</option><option value='3' selected='selected'>3</option><option value='4'>4</option><option value='5'>5</option><option value='6'>6</option><option value='7'>7</option><option value='8'>8</option><option value='9'>9</option><option value='10'>10</option><option value='15'>15</option><option value='20'>20</option><option value='25'>25</option><option value='30'>30</option><option value='35'>35</option><option value='40'>40</option></select></td></tr><tr><td class='label'>space:</td><td class='ctrl'><select name='ignorews' onchange='this.form.submit();'><option value='0' selected='selected'>include</option><option value='1'>ignore</option></select></td></tr><tr><td class='label'>mode:</td><td class='ctrl'><select name='dt' onchange='this.form.submit();'><option value='0' selected='selected'>unified</option><option value='1'>ssdiff</option><option value='2'>stat only</option></select></td></tr><tr><td/><td class='ctrl'><noscript><input type='submit' value='reload'/></noscript></td></tr></table></form></div><table summary='commit info' class='commit-info'>
<tr><th>author</th><td>Nicolas Goaziou &lt;mail@nicolasgoaziou.fr&gt;</td><td class='right'>2024-01-21 23:57:37 +0100</td></tr>
<tr><th>committer</th><td>Nicolas Goaziou &lt;mail@nicolasgoaziou.fr&gt;</td><td class='right'>2024-01-22 00:20:55 +0100</td></tr>
<tr><th>commit</th><td colspan='2' class='oid'><a href='/guix/commit/gnu/installer/newt/welcome.scm?id=1c17b444c67fd2a89a5ebebb22f7de7279180a71'>1c17b444c67fd2a89a5ebebb22f7de7279180a71</a> (<a href='/guix/patch/gnu/installer/newt/welcome.scm?id=1c17b444c67fd2a89a5ebebb22f7de7279180a71'>patch</a>)</td></tr>
<tr><th>tree</th><td colspan='2' class='oid'><a href='/guix/tree/?id=1c17b444c67fd2a89a5ebebb22f7de7279180a71'>546fffc47618554ca0d09f126f76e74af4e2cee7</a> /<a href='/guix/tree/gnu/installer/newt/welcome.scm?id=1c17b444c67fd2a89a5ebebb22f7de7279180a71'>gnu/installer/newt/welcome.scm</a></td></tr>
<tr><th>parent</th><td colspan='2' class='oid'><a href='/guix/commit/gnu/installer/newt/welcome.scm?id=396d84071fc8b3cb317f85457d3ae51c094953de'>396d84071fc8b3cb317f85457d3ae51c094953de</a> (<a href='/guix/diff/gnu/installer/newt/welcome.scm?id=1c17b444c67fd2a89a5ebebb22f7de7279180a71&amp;id2=396d84071fc8b3cb317f85457d3ae51c094953de'>diff</a>)</td></tr><tr><th>download</th><td colspan='2' class='oid'><a href='/guix/snapshot/guix-1c17b444c67fd2a89a5ebebb22f7de7279180a71.tar.gz'>guix-1c17b444c67fd2a89a5ebebb22f7de7279180a71.tar.gz</a><br/><a href='/guix/snapshot/guix-1c17b444c67fd2a89a5ebebb22f7de7279180a71.zip'>guix-1c17b444c67fd2a89a5ebebb22f7de7279180a71.zip</a><br/></td></tr></table>
<div class='commit-subject'>gnu: emacs-org-re-reveal: Update to 3.25.1.</div><div class='commit-msg'>* gnu/packages/emacs-xyz.scm (emacs-org-re-reveal): Update to 3.25.1.

Change-Id: I79a195184b5d2ad842e4738862086c0b595b967c
</div><div class='diffstat-header'><a href='/guix/diff/?id=1c17b444c67fd2a89a5ebebb22f7de7279180a71'>Diffstat</a> (limited to 'gnu/installer/newt/welcome.scm')</div><table summary='diffstat' class='diffstat'></table><div class='diffstat-summary'>0 files changed, 0 insertions, 0 deletions</div><table summary='diff' class='diff'><tr><td></td></tr></table></div> <!-- class=content -->
                         <div class=footer>generated by
                             <a href="https://git.zx2c4.com/cgit/about/">
                                 cgit
                             </a>
                         </div>
                        </div> <!-- id=cgit -->
</body>
</html>
signature type from ARGUMENT."
  ;; XXX: avoid ..1 when using vectors due to a bug (?) in (ice-9 match).
  (match argument
    ((? boolean?) "b")
    ((? string?) "s")
    (#((? string?) (? string?) ...) "as")
    (#(((? string?) . (? string?))
       ((? string?) . (? string?)) ...) "a{ss}")
    (_ (error 'dbus "no rule to infer type from argument" argument))))

(define* (call-dbus-method method
                           #:key
                           (path "/org/freedesktop/DBus")
                           (destination "org.freedesktop.DBus")
                           (interface "org.freedesktop.DBus")
                           (connection (%current-dbus-connection))
                           arguments
                           timeout)
  "Call the D-Bus method specified by METHOD, PATH, DESTINATION and INTERFACE.
The currently active D-Bus CONNECTION is used unless explicitly provided.
Method arguments may be provided via ARGUMENTS sent as the message body.
TIMEOUT limit the maximum time to allow for the reply.  Return the body of the
reply."
  (let ((message (make-d-bus-message
                  MESSAGE_TYPE_METHOD_CALL 0 #f '()
                  `#(,(header-PATH        path)
                     ,(header-DESTINATION destination)
                     ,(header-INTERFACE   interface)
                     ,(header-MEMBER      method)
                     ,@(if arguments
                           (list (header-SIGNATURE
                                  (string-join
                                   (map argument->signature-type arguments)
                                   "")))
                           '()))
                  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: