;;; dbus-introspection.el --- Helper functions for D-Bus introspection
;;
;; Copyright (C) 2009, 2010 Jan Moringen
;;
;; Author: Jan Moringen
;; Keywords: dbus, ipc
;; Version: 0.1
;; X-RCS: $Id:$
;;
;; This Program 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.
;;
;; This Program 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 this program. If not, see .
;;; Commentary:
;;
;; Helper functions for the `dbus-proxy' library.
;;; History:
;;
;; 0.2 - Parsing of complex signatures
;;
;; 0.1 - Initial version
;;; Code:
;;
(require 'dbus)
;;; Error Conditions
;;
;; malformed-signature
(intern "malformed-signature")
(put 'malformed-signature 'error-conditions
'(error malformed-signature))
(put 'malformed-signature 'error-message
"Malformed signature signature")
;;;
;;
(defconst dbus-proxy-simple-type-codes
'((?b . :boolean)
(?y . :byte)
(?n . :int16)
(?q . :uint16)
(?i . :int32)
(?u . :uint32)
(?x . :int64)
(?t . :uint64)
(?d . :double)
(?s . :string)
(?o . :object-path)
(?g . :signature)
(?v . :variant))
"Mapping type indication characters to type keywords")
(defun dbus-proxy-parse-simple-type (string)
"Parse (a substring of) STRING as a simple type designator.
The returned value is of the form (TYPE CONSUMED) where the
number of consumed characters is always one. If STRING is not
recognized as starting with a simple type designator, a
`malformed-signature' error condition is signaled.
A list of recognized simple type designators is available in the
variable `dbus-proxy-simple-type-codes."
(let ((type (cdr (assoc (aref string 0)
dbus-proxy-simple-type-codes))))
(if type
(list type 1)
(signal 'malformed-signature
(list "Unknown simple type designator" string)))))
(defun dbus-proxy-parse-composite-type (string)
"Parse (a substring of) STRING as composite type designator.
A composite type is a simple type or one of struct, array or
dict-entry. The returned value is of the form (TYPE CONSUMED)
where the number of consumed characters is at least one but
potentially less than the length of STRING. TYPE is a list
starting with a type keyword:
\(SIMPLE\) for SIMPLE one of the cdrs in `dbus-proxy-simple-type-codes'
\(:struct (SUBSTYPE1 SUBTYPE2 ...)\)
\(:array SUBTYPE\)
\(:dict-entry (KEYTYPE VALUETYPE)\)"
(destructuring-bind (outer inner consumed)
(case (aref string 0)
;; Closing delimiters are consumed without generating
;; anything.
((?\) ?})
(list nil nil 1))
;; Struct type
((?r ?\()
(destructuring-bind (types consumed)
(dbus-proxy-parse-type-list (substring string 1))
(unless (= (aref string consumed) ?\)) ;; TODO check end of string
(signal 'malformed-signature
(list "struct misses closing parenthesis")))
`(:struct ,types ,consumed)))
;; Array type
(?a
`(:array ,@(dbus-proxy-parse-composite-type
(substring string 1))))
;; Dict entry type.
;;
;; From the D-Bus spec: The restrictions are: it occurs only as
;; an array element type; it has exactly two single complete
;; types inside the curly braces; the first single complete
;; type (the "key") must be a basic type rather than a
;; container type.
((?e ?{)
(destructuring-bind (types consumed)
(dbus-proxy-parse-type-list (substring string 1))
(unless (= (length types) 2)
(signal 'malformed-signature
(list "dict entry has to contain exactly two types")))
(unless (= (aref string consumed) ?}) ;; TODO check end of string
(signal 'malformed-signature
(list "dict entry misses closing curly brace")))
`(:dict-entry ,types ,consumed)))
(t
`(nil ,@(dbus-proxy-parse-simple-type string))))
;; Return the parsed type as a list of the form (TYPE CONSUMED).
(cond
(outer
(list (list outer inner) (1+ consumed)))
(inner
(list inner consumed))
(t
(list nil consumed)))))
(defun dbus-proxy-parse-type-list (string)
"Parse STRING as a list of type designators.
The returned value is of the form (TYPES CONSUMED). Where
consumed is equal to the length of STRING. TYPES is a list of
types
\(TYPE1 TYPE2 ...\)
where each element is of the form produced by
`dbus-proxy-parse-type-list'."
(let ((remaining string)
(all-consumed 0)
(all-types))
(catch 'early
(while (> (length remaining) 0)
(destructuring-bind (type consumed)
(dbus-proxy-parse-composite-type remaining)
(setq remaining (substring remaining consumed))
(incf all-consumed consumed)
(if type
(push type all-types)
(throw 'early nil)))))
(list (reverse all-types) all-consumed)))
;;; Predicates and accessors for dbus types.
;;
;; Argument introspection elements
(defsubst dbus-arg-p (element)
(eq (car-safe element) 'arg))
(defsubst dbus-arg-name (arg)
(cdr (assoc 'name (second arg))))
(defsubst dbus-arg-type (arg)
(cdr (assoc 'type (second arg))))
(defsubst dbus-arg-in-p (arg)
(string= (cdr (assoc 'direction (second arg))) "in"))
;; Property introspection elements
(defsubst dbus-property-p (element)
(eq (car-safe element) 'property))
(defsubst dbus-property-name (property)
(cdr (assoc 'name (second property))))
(defsubst dbus-property-type (property)
(cdr (assoc 'type (second property))))
(defsubst dbus-property-access (property)
(cdr (assoc 'access (second property))))
;; Method introspection elements
(defsubst dbus-method-p (element)
(eq (car-safe element) 'method))
(defsubst dbus-method-name (method)
(cdr (assoc 'name (second method))))
;; Signal introspection elements
(defsubst dbus-signal-p (element)
(eq (car-safe element) 'signal))
(defsubst dbus-signal-name (signal)
(cdr (assoc 'name (second signal))))
;; Interface introspection elements
(defsubst dbus-interface-name (interface)
(cdr (assoc 'name (second interface))))
(defsubst dbus-interface-elements (interface)
(cddr interface))
(defsubst dbus-interface-properties (interface)
(remove-if-not #'dbus-property-p (cddr interface)))
(defsubst dbus-interface-methods (interface)
(remove-if-not #'dbus-method-p (cddr interface)))
(defsubst dbus-interface-signals (interface)
(remove-if-not #'dbus-signal-p (cddr interface)))
(provide 'dbus-introspection)
;;; Unit Tests:
;;
(eval-when-compile
(when (require 'ert nil t)
(ert-deftest dbus-introspection-test-parse-simple-type-smoke ()
"Smoke test for the `dbus-proxy-parse-simple-type' function."
(dolist (case '(("u" (:uint32 1))
("ab" error)
("!" error)))
(destructuring-bind (input expected) case
(if (eq expected 'error)
(should-error
(dbus-proxy-parse-simple-type input)
:type 'error)
(should (equal
(dbus-proxy-parse-simple-type input)
expected)))))
)
(ert-deftest dbus-introspection-test-parse-composite-type-smoke ()
"Smoke test for the `dbus-proxy-parse-composite-type' function."
(dolist (case '(;; Simple
("i" (:int32 1))
("ii" (:int32 1))
("u" (:uint32 1))
("uu" (:uint32 1))
;; Struct
("(u)" ((:struct (:uint32)) 3))
("(v)" ((:struct (:variant)) 3))
("(ii)" ((:struct (:int32 :int32)) 4))
("(i(ii))" ((:struct (:int32 (:struct (:int32 :int32)))) 7))
("(ius)" ((:struct (:int32 :uint32 :string)) 5))
("(ii" error)
("ii)" (:int32 1))
;; Array
("au" ((:array :uint32) 2))
("ai" ((:array :int32) 2))
("av" ((:array :variant) 2))
("a(ii)" ((:array (:struct (:int32 :int32))) 5))
("aai" ((:array (:array :int32)) 3))
("aa" error)
;; Dict entry
("a{su}" ((:array (:dict-entry (:string :uint32))) 5))
("a{su}s" ((:array (:dict-entry (:string :uint32))) 5))
("a{suu}" error)
("a{su" error)
("a{s" error)
;; Random stuff
("!" error)))
(destructuring-bind (input expected) case
(if (eq expected 'error)
(should-error
(dbus-proxy-parse-composite-type input)
:type 'error)
(should (equal
(dbus-proxy-parse-composite-type input)
expected)))))
)
(ert-deftest dbus-introspection-test-parse-type-list-smoke ()
"Smoke test for the `dbus-proxy-parse-type-list' function."
(dolist (case '(;; Simple
("i" ((:int32) 1))
("ii" ((:int32 :int32) 2))
("u" ((:uint32) 1))
("uu" ((:uint32 :uint32) 2))
;; Struct
("(ii)" (((:struct (:int32 :int32))) 4))
("(i(ii))" (((:struct (:int32 (:struct (:int32 :int32))))) 7))
;("(ii" error)
;("ii)" error)
("(u)" (((:struct (:uint32))) 3))
("(v)" (((:struct (:variant))) 3))
("(ius)" (((:struct (:int32 :uint32 :string))) 5))
;; Array
("ai" (((:array :int32)) 2))
("a(ii)" (((:array (:struct (:int32 :int32)))) 5))
("aai" (((:array (:array :int32))) 3))
("aa" error)
("au" (((:array :uint32)) 2))
("av" (((:array :variant)) 2))
;; Dict entry
("a{su}" (((:array (:dict-entry (:string :uint32)))) 5))
("a{su}s" (((:array (:dict-entry (:string :uint32))) :string) 6))
("a{suu}" error)
("a{su" error)
("a{s" error)
;; Random stuff
("!" error)))
(destructuring-bind (input expected) case
(if (eq expected 'error)
(should-error
(dbus-proxy-parse-composite-type input)
:type 'error)
(should (equal
(dbus-proxy-parse-type-list input)
expected)))))
)
))
;;; dbus-introspection.el ends here