From 8ea8f1976626d8d06f10106363fd7790cf38618a Mon Sep 17 00:00:00 2001 From: Ralph Ronnquist Date: Tue, 16 May 2023 23:30:55 +1000 Subject: [PATCH] added --- Makefile | 17 ++ dbus-api.lsp | 645 ++++++++++++++++++++++++++++++++++++++++ lsp-dbus-connection.lsp | 82 +++++ lsp-dbus-events.lsp | 81 +++++ lsp-dbus-marshal.lsp | 221 ++++++++++++++ lsp-dbus.a.8.adoc | 246 +++++++++++++++ 6 files changed, 1292 insertions(+) create mode 100644 Makefile create mode 100644 dbus-api.lsp create mode 100644 lsp-dbus-connection.lsp create mode 100644 lsp-dbus-events.lsp create mode 100644 lsp-dbus-marshal.lsp create mode 100644 lsp-dbus.a.8.adoc diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..add2b60 --- /dev/null +++ b/Makefile @@ -0,0 +1,17 @@ +# Create the newlisp library dbus.lsplib + +ARCHIVES = lsp-dbus.a + +DOCS = ${ARCHIVES:=.8.adoc} + +default: ${ARCHIVES} ${DOCS} + +%: %.adoc + asciidoctor -b manpage $< + +clean: + rm -f ${ARCHIVES} ${DOCS} + +lsp-dbus.a: lsp-dbus-connection.lsp lsp-dbus.lsp lsp-dbus-marshal.lsp +lsp-dbus.a: lsp-dbus-events.lsp + ar rc $@ $^ diff --git a/dbus-api.lsp b/dbus-api.lsp new file mode 100644 index 0000000..0acd546 --- /dev/null +++ b/dbus-api.lsp @@ -0,0 +1,645 @@ +;; This newlisp "module" sets up a dbus API adapter +;; +;; dbus is an object oriented interprocess commmunications framework +;; based on utual object proxying. This end holds some objects that +;; remote ends can access and invoke methods on, and remote ends hold +;; objects that this pocess can access and invoke methods on. +;; +;; https://dbus.freedesktop.org/doc/dbus-specification.html +;; https://dbus.freedesktop.org/doc/dbus-api-design.html +;; [C API] https://dbus.freedesktop.org/doc/api/html/ +;; + +; Require the FOOP context +(unless (context? MAIN:FOOP) (load "foop.lsp")) + +################################################################# +;; This newlisp module implements dbus socket connection +;; + +(context 'MAIN:DbusConnection) +(FOOP path socket name serial) + +(define (DbusConnection:DbusConnection PATH) + (list (context) PATH -1 nil 0)) + +;; Increment the serial and return it. +(define (serial++) + (!serial (+ 1 (%serial)))) + +;; (open-socket) +; Internal utility method to re-open the %path socket and set the +; %socket field. +(define (open-socket) + (when (>= (%socket)) + (close (%socket)) + (!socket -1)) + (!socket (net-connect (%path)))) + +;** Commands from client to server +; AUTH [mechanism] [initial-response] +; CANCEL +; BEGIN +; DATA +; ERROR [human-readable error explanation] +; NEGOTIATE_UNIX_FD + +;** Commands from server to client +; REJECTED +; OK +; DATA +; ERROR [human-readable error explanation] +; AGREE_UNIX_FD + +(define (read-message) + (let ((BUFFER "") (RESULT "")) + (while (and RESULT (net-select (%socket) "r" 1000)) + (if (net-receive (%socket) BUFFER 8192) + (extend RESULT BUFFER) + (begin + (setf RESULT nil) + (die 1 "dbus socket closed")) + )) + RESULT)) + +;; (handshake MSG PAT) +; Perform a socket handshake sending MSG and return the result, or if +; PAT not nil, then return (regex PAT RESULT 0), +(define (handshake MSG PAT) + (let ((RESULT "")) + (net-send (%socket) MSG) + (setf RESULT (read-message)) + (if PAT (regex PAT RESULT 0) RESULT))) + +(constant + 'AUTHFMT "AUTH EXTERNAL %s\r\n" + 'AUTHACK "OK (\\S+)\r\n" + 'KEEPFMT "NEGOTIATE_UNIX_FD\r\n" + 'KEEPACK "AGREE_UNIX_FD\r\n" + ) + +;; (initialize USER) +; Perform socket initialization sequence and return the name, or nil. +(define (initialize (USER (env "USER"))) + (when (and (>= (open-socket)) + (net-send (%socket) (char 0)) + (handshake (format AUTHFMT (char2hex USER)) AUTHACK) + (!name $1) + (handshake KEEPFMT KEEPACK)) + (handshake "BEGIN\r\n") + (%name))) + +(define (cancel) + (handshake "CANCEL\r\n" "(.*)")) + +################################################################# +;; The DbusInterface context is used for modelling DBus interfaces. +;; +;; It includes in particular the :use method for installing a +;; DbusInterface FOOP object as a constant named by the interface. +;; E.g. (:use (DbusInterface "org.freedesktop.DBus.ObjectManager") +;; installes the constant ObjectManager with a DbusInterface FOOP +;; object modelling that interface. +;; +;; The :m method is used to construct a fullly qualified method name. +;; E.g. (:m ObjectManager "GetManagedObjects()") assuming the prior +;; :use installation of ObjectManager results in the fully qualified +;; name string +;; "org.freedesktop.DBus.ObjectManager.GetManagedObjects()" +;; +(context 'MAIN:DbusInterface) +(FOOP name members) + +;; FOOP constructor; remember the interface name +(define (DbusInterface:DbusInterface NAME (MEMBERS '())) + (list (context) NAME MEMBERS)) + +;; Utility method to expand a member with the interface prefix. When +;; the MEMBER is given without "(", then it is duly looked up in the +;; MEMBERS list of the DbusInterface, and it thus gets expanded with +;; parameter signature. +(define (m MEMBER) + (unless (find "(" MEMBER) + (if (ref (string MEMBER "(") (%members) (fn (x y) (starts-with y x)) true) + (setf MEMBER ((parse $it ":") 0)))) + (string (%name) "." MEMBER)) + +;; Install this interface into the context of the caller +(define (use) + (let ((IF (when (regex "([^.]+)$" (%name) 0) $1)) + (CC (prefix (first (or (1 (history)) '(MAIN)))))) + (letex ((S (sym $1 CC)) (V (self))) + (begin (context CC) (constant 'S 'V))))) + +;; Declare additional members for this interface +(define (has) + (dolist (MEMBER (args)) + (unless (member MEMBER (%members)) + (!members (push MEMBER (%members) -1))))) + +################################################################# +(context 'MAIN:Dbus) + +;; Declaring the FOOP object +(FOOP path name bus) + +;; "The FOOP Constructor". Creates an object for a given path. +(define (Dbus:Dbus PATH (NAME (replace "/" (1 PATH) ".")) (BUS 'SYSTEM-BUS)) + (list (context) PATH NAME BUS)) + +;; Method to clone a proxy for a given path/object. +(define (new-path PATH) + (list (context) PATH (%name) (%bus))) + +;; Update the connection serial and return it +(define (connection++) + (case (%bus) + (SYSTEM-BUS (:serial++ SYSTEM-BUS)) + (true 0))) + +; marshalling functions and signal handling framework +;; This newlisp "module" implements dbus marshalling +; +; The newlisp representation is a simplified form using lists for +; structs and arrays. + +;; (expand-signature S) +; Expland a signature string into a nested list to correspond to the +; newlisp list representation. +;; Basic dbus types are basic newlisp types, including strings. Arrays +;; and structs are sublists; the expanded signature marks array +;; sublists with an initial "a", otherwise it's a struct sublist. +; +; Ex: "yi" = ("y" "i") +; Ex: "y(ai)" = ("y" (("a" "i"))) +; Ex: "a(yi)" = (("a" ("y" "i"))) +; Ex: "yyyyuua(yv)" = ("y" "y" "y" "y" "u" "u" ("a" ("y" "v"))) +(define (expand-signature S) + (setf S (replace "{" (replace "}" (copy S) ")") "(")) + (let ((STACK '()) (CUR '()) (A 0)) + (dolist (X (explode S)) + (case X + (")" (setf X CUR) (setf CUR (pop STACK))) + ("(" (push CUR STACK) (setf CUR '())) + (true true)) + (when (and (!= X "a") (!= X "(")) + (while (and CUR (= "a" (last CUR))) + (setf X (list (last CUR) X)) + (setf CUR (chop CUR)))) + (when (!= "(" X) + (push X CUR -1))) + (if (null? CUR) '() CUR))) + +;; Align AT to an I multiple and pad DATA with as many NUL bytes at +;; front, then increment AT past it all. +(define (pack-align DATA (I (length DATA))) + (let ((PAD (dup "\000" (% (- I (% AT I)) I)))) + (setf DATA (extend PAD DATA)) + (inc AT (length DATA)) + DATA)) + +;; Pack data from DATA according to signature. The DATA is a nested +;; list where container types are sub lists. Variant types also appear +;; as pairs of signature and value. +(define (pack-data SIGN DATA) + (let ((AT 0)) (pack-data-struct (expand-signature SIGN) DATA))) + +;; Pack a newlisp data element according to marshalling type The +;; newlisp data is integer, double, string or list (for container and +;; variant elements). +(constant + 'FMTMAP ; mapping dbus type code to byte size and newlisp code + '( ("y" 1 "b") ; BYTE (unsigned 8-bit integer) + ("b" 4 "lu") ; BOOLEAN (0 is FALSE, 1 is TRUE, else invalid) + ("n" 2 "d") ; INT16 (signed 16-bit integer) + ("q" 2 "u") ; UINT16 (unsigned 16-bit integer) + ("i" 4 "ld") ; INT32 (signed 32-bit integer) + ("u" 4 "lu") ; UINT32 (unsigned 32-bit integer) + ("x" 8 "Ld") ; INT64 (signed 64-bit integer) + ("t" 8 "Lu") ; UINT64 (unsigned 64-bit integer) + ("d" 8 "lf") ; DOUBLE (64-bit float) + ("h" 4 "lu") ; UINT32 (unix file descriptor) + ("a" ? ?) ; ARRAY = UINT32 byte-length, items + ("s" ? ?) ; STRING = length + data + NUL + ("o" ? ?) ; OBJECT_PATH = BYTE length + data + NUL + ("g" ? ?) ; SIGNATURE = BYTE length + data + NUL + ("(" ? ?) ; STRUCT begin in signature = (8-align) + data + (")" 0 ?) ; STRUCT end in signature + ("v" ? ?) ; VARIANT = signature + data + ("{" ? ?) ; DICT_ENTRY begin + ("}" ? ?) ; DICT_ENTRY end + ("r" ? ?) ; reserved STRUCT in bindings? + ("e" ? ?) ; reserved DICT_ENTRY in bindings ? + ("m" ? ?) ; reserved 'maybe' + ("*" ? ?) ; reserved 'single complete type' + ("?" ? ?) ; reserved 'basic type' + ("@" ? ?) ; reserved + ("&" ? ?) ; reserved + ("^" ? ?) ; reserved + ) + ) + +(define (pack-data-item ES DATA) + (if (list? ES) (pack-data-struct ES DATA) + (= ES "s") (pack-data-string ES DATA) + (= ES "o") (pack-data-string ES DATA) + (= ES "g") (pack-data-signature ES DATA) + (= ES "v") (apply pack-data-variant DATA) + (if (lookup ES FMTMAP) (pack-align (pack $it DATA))))) + +(define (pack-data-variant ES DATA) + (extend (pack-align (pack "bbb" 1 (char ES) 0) 1) + (pack-data-item ES DATA))) + +;; pack types "s" and "o" +(define (pack-data-string ES DATA) + (pack-align (pack (format "lus%db" (length DATA)) (length DATA) DATA 0) 4)) + +;; pack type "g" +(define (pack-data-signature ES DATA) + (pack-align (pack (format "bs%db" (length DATA)) (length DATA) DATA 0) 1)) + +;; Pack an array. DATA elements marshalled by repeating ES, preceded +;; by the array length in bytes as aligned UINT32. +(define (pack-data-array ES DATA) + (let ((PAD (pack-align "" 4)) + (X (inc AT 4)) ; start index of array bytes + (DATA (apply extend (map (curry pack-data-item ES) DATA)))) + (extend PAD (pack "lu" (- AT X)) DATA))) + +;; Pack a struct. ES and DATA elements marshalled pairwise in order +;; following an initial8-byte alignment. +(define (pack-data-struct ES DATA) + (if (= "a" (ES 0)) (pack-data-array (ES 1) DATA) + (apply extend (cons (pack-align "" 8) + (map pack-data-item ES DATA))))) + +;;########## unpacking + +;; Advance AT to an I multiple. +(define (align-AT I) + (inc AT (% (- I (% AT I)) I))) + +;; Advance AT to an I multiple and unpack (by newlisp format) at that +;; position in DATA. Then advance AT further past that unpacking but +;; return the unpacked value. +(define (unpack-align I FMT) + ##(println (list 'unpack-align I FMT AT (length DATA))) + (align-AT I) + ((fn (X) X) ((unpack FMT (AT DATA)) 0) (inc AT I))) + +;; Unpack a string or object path. The format is "lu" (UINT32) with +;; the string length, then "s%db" with that string length and followed +;; by a NUL byte. +(define (unpack-data-string ES (N (unpack-align 4 "lu"))) + ((fn (X) X) ((unpack (string "s" N) (AT DATA)) 0) (inc AT (+ 1 N)))) + +;; Unpack a signature string. The format is "b" (BYTE) with the string +;; length, then "s%db" with that string length and followed by a NUL +;; byte. I.e. the same as unpack-data-string but with the string +;; length in a BYTE rather than an UINT32. +(define (unpack-data-signature ES) + (unpack-data-string ES (unpack-align 1 "b"))) + +;; Unpack a variant item. This consists of "bbb" where the middle +;; character is the type character for the data, preceded by a 1 byte +;; and followed by a NUL byte. The subsequent data is unpacked +;; according to that type character. +(define (unpack-data-variant) + (unpack-data-item ((expand-signature (unpack-data-signature "g")) 0))) + +;; Unpack the ES type item from (AT DATA), optionally with +;; pre-alignment, and increment AT past the padding and item. +(define (unpack-data-item ES) + ##(println (list 'unpack-data-item ES AT (length DATA))) + (if (list? ES) (unpack-data-struct ES) + (= ES "s") (unpack-data-string ES) + (= ES "o") (unpack-data-string ES) + (= ES "g") (unpack-data-signature ES) + (= ES "v") (unpack-data-variant) + (if (assoc ES FMTMAP) (unpack-align ($it -2) ($it -1))))) + +;; Unpack array with ES elements. The array begins with an UINT32 +;; field telling how many bytes to unpack, followed by the array +;; elements. +(define (unpack-data-array ES) + (let ((A AT) (N (+ (unpack-align 4 "u") AT)) (OUT '())) + (when (and (list? ES) (!= "a" (ES 0))) (align-AT 8)) + (while (< AT N) + ##(println "---next " (list AT N)) + (push (unpack-data-item ES) OUT -1)) + OUT)) + +;; Unpack a structure or array with ES fields. +(define (unpack-data-struct ES) + ##(println (list 'unpack-data-struct ES AT)) + (if (= "a" (ES 0)) (unpack-data-array (ES 1)) + (begin (align-AT 8) (map unpack-data-item ES)))) + +;; Unpack from a DATA string according to signature SIGN This returns +;; a pair (unpacked pos) of unpacked data and how much data is +;; consumed. +(define (unpack-data SIGN DATA (AT 0)) + ##(println (format "*** unpack-data %s %d %d" SIGN (length DATA) AT)) + (list (unpack-data-item (expand-signature SIGN)) AT)) + +;; Unpack all dbus messages in the given DATA block. Each message +;; consists of head and body. The head has signature "yyyyuua(yv)" +;; where the array is an alist of key-value pairs, optionally +;; including the 'SIGNATURE key with the signature for the body; if +;; omitted, then the body is empty. +;; +;; The function returns the header list of key-value pairs optionally +;; extended with the pair ("" body). +(define (unpack-messages DATA) + (let ((AT 0) (OUT '()) (M nil) (D nil) (S nil)) + (while (and (< (+ AT 7) (length DATA)) + (setf M (unpack-data "yyyyuua(yv)" DATA AT))) + (setf AT (M 1)) + ##(println "message head " (M 0)) + ##(println (list 'remains AT (length DATA))) + (setf M (M 0 -1)) ; Drop all but the headers then map to symbol keys + (dotimes (i (length M)) + (setf (M i 0) (MESSAGE-HEADERS (M i 0) 0))) + ##(println "mapped headers " M) + ;; Add the body, if any, keyed by "". + (setf S (if (lookup 'SIGNATURE M) $it "")) + ##(println (list 'sign S)) + (when (and (!= S "") (setf D (unpack-data S DATA AT))) + (setf AT (D 1)) + (extend M (list (list "" (D 0))))) + ;; Collate message and move to the next portion in DATA + (push M OUT -1) + ##(println (list 'ending AT (length DATA))) + ;;(align-AT 4) + ##(println (list 'aligned AT (length DATA))) + (setf DATA (AT DATA)) + (setf AT 0) + ) + OUT )) + +################################################################# +;; This newlisp module implements dbus socket send-receive together +;; with signal receive. (This file should be loaded into the Dbus +;; context) +;; +;; The REPL loop is re-mastered by means of a prompt-event function +;; that firstly handles any pending dbus messages, and secondly +;; net-select on both the dbus socket and stdin. +;; +;; Stdin is handled with priority. +;; +;; Dbus messages are read and added to the pending list. +;; +;; Handlers are set up as functions (fn (data msg) ..) identified by +;; "dbus callback key" consisting of path, interface, method and +;; signature separated by ":". For example: +;; +;; "/org/freedesktop/DBus:org.freedesktop.DBus.NameAcquired(s)" +;; +;; would identify the handler for the NameAcquired(string) method of +;; the interface "org.freedesktop.DBus" of the path +;; "/org/freedesktop/DBus" of the client. That particular callback is +;; a s.c. signal sent by the dbus framework implementation in reaction +;; to the initial Hello call, i.e. the s.c. invocation of +;; +;; "/org/freedesktop/DBus:org.freedesktop.DBus.Hello()" +;; + +;; Return the callback key for a message MSG +(define (message-key MSG) + (string (lookup 'PATH MSG) ":" (lookup 'INTERFACE MSG) "." + (lookup 'MEMBER MSG) "(" (lookup 'SIGNATURE MSG) ")" )) + +;; This is the table of handlers, keyed by path:interface:method:signature +(define RECV:RECV nil) + +;; Utility function to install a handler for a given key, +(define (handler KEY HANDLER) + (RECV (string (%path) ":" KEY) HANDLER)) + +;; This is the list of Dbus messages still to handle. +(setf pending '()) + +(define (no-handler KEY MSG) + (write-line 2 (format "** No handler %s for:\n%s" KEY (string MSG)))) + +(define (process-message MSG) + (let ((KEY (message-key MSG))) + (if (RECV KEY) ($it (lookup "" MSG)) + (no-handler KEY MSG)))) + +;; Process all messages currently pending +(define (process-all-pending) + (while (if (pop pending) (process-message $it)))) + +;; The main-loop is intended as a prompt-handler so as to deal with +;; asyncronous events +(define (main-loop S) + (let ((FDS (list 0 (:%socket SYSTEM-BUS))) (FD nil)) + (write 2 (string "> ")) + (while (or pending (not (member 0 (net-select FDS "r" -1)))) + (if (pop pending) (process-message $it) + (if (unpack-messages (or (:read-message SYSTEM-BUS) "")) + (extend pending $it)) + )) + "main-loop: ")) + +(define (human-msg MSG) + (human-bytes (unpack (dup "b" (length MSG)) MSG))) + +;; Send message, then keep reading messages until there is a reply +(define (send-recv-message MSG) + ;;(die nil (list 'send-recv-message (human-msg MSG))) + (net-send (:%socket SYSTEM-BUS) MSG) + (let ((REPLY nil)) + (while (nil? REPLY) + (dolist (M (unpack-messages (:read-message SYSTEM-BUS))) + (if (lookup 'REPLY_SERIAL M) (setf REPLY M) + (push M pending -1)))) + REPLY)) + + +;; ==================== +;; Dbus symbols + +(constant + 'PROTOCOL-VERSION '(1 1) + 'MESSAGE-TYPES '(INVALID METHOD_CALL METHOD_RETURN ERROR SIGNAL) + 'MESSAGE-FLAGS '(NO_REPLY_EXPECTED + NO_AUTO_START + ALLOW_INTERACTIVE_AUTHORIZATION) + ;; Message headers: [code] => (name type) + 'MESSAGE-HEADERS '((INVALID ) + (PATH "o") + (INTERFACE "s") + (MEMBER "s") + (ERROR_NAME "s") + (REPLY_SERIAL "i") + (DESTINATION "s") + (SENDER "s") + (SIGNATURE "g") + (UNIX_FDS "i") + ) + ) + +;; Map message type symbol to dbus type code (i.e. the list index) +(define (message-type-code TYPE) + (or (find TYPE MESSAGE-TYPES =) 0)) + +;; Map flag symbol F to its dbus "bit code" +(define (flag F) + (if (find F MESSAGE-FLAGS) (pow 2 $it) 0)) + +;; Return the dbus flags code from FLAGS; if it is a number thent tha +;; is returned as is; if FLAGS is a list of message flag symbols then +;; combine their codes by bit-OR. Anything else yields 0. +(define (message-flags FLAGS) + (if (number? FLAGS) FLAGS + (list? FLAGS) + (apply | (map flag FLAGS)) + 0)) + +;; (message-header (NAME VALUE)) +; Translate header into its marshalling data. The name is mapped to +; its header code and associated value type. This gets translated into +; the marshalling data form of (code (type value)) +(define (message-header HDR) + (when (list? HDR) + (if (find (list (HDR 0) '*) MESSAGE-HEADERS match) + (list $it (list (MESSAGE-HEADERS $it -1) (HDR 1)))))) + +;; Join the excess string arguments N-byte alignment successively +(define (pad-join N) + (let ((OUT "")) + (dolist (S (args)) + (let ((PAD (dup "\000" (% (- N (% (length OUT) N)) N)))) + (extend OUT PAD S))) + OUT)) + +;; Return a marshalled message string appended by the marshalled body +(define (message TYPE FLAGS HDRS BODY) + (pad-join 8 + (pack-data "yyyyuua(yv)" + (list (char "l") + (message-type-code TYPE) + (message-flags FLAGS) + (PROTOCOL-VERSION 0) ; Major version code + (length BODY) + (connection++) + (clean null? (map message-header HDRS)))) + BODY )) + +;; (:invoke OBJ METHOD ARGS FLAGS) +; Perform a METHOD_CALL on the (self) object +;; The given METHOD has format "INTERFACE.NAME(SIGNATURE)" with the +;; "INTERFACE." bit optional. The function returns the list of headers +;; of the reply message extended with reply value as a faked header +;; named "". +;; +;; This function calls send-recv-message which also polls for signals +;; until a reply is given, but any such signals are stocked up as +;; pending for later processing on demand. +(define (invoke METHOD ARGS (FLAGS 0)) + (when (regex "((.+):)?((.+)\\.)?([^(]+)\\((.*)\\)$" METHOD 0) + (let ((PATH $2) (INTERFACE $4) (MEMBER $5) (SIGNATURE $6)) + ;;(println (list 'invoke (%name) INTERFACE MEMBER SIGNATURE)) + (if (message 'METHOD_CALL FLAGS + (list nil ; (if SELF-NAME (list 'SENDER SELF-NAME)) + (list 'DESTINATION (%name)) + (list 'PATH (if (empty? PATH) (%path) PATH)) + (if (empty? INTERFACE) nil + (list 'INTERFACE INTERFACE)) + (list 'MEMBER MEMBER) + (if (empty? SIGNATURE) nil + (list 'SIGNATURE SIGNATURE)) + ) + (if (empty? SIGNATURE) "" + (pack-data SIGNATURE ARGS))) + (send-recv-message $it) + nil + )))) + +;; Context variables and framework registration +(setf + SYSTEM-BUS (MAIN:DbusConnection "/run/dbus/system_bus_socket") + APPID (:initialize SYSTEM-BUS) + ROOT (Dbus "/org/freedesktop/DBus") + DBus (DbusInterface "org.freedesktop.DBus") + APPNAME (if (:invoke ROOT (:m DBus "Hello()")) + ($it -1 -1 -1)) + ) + +;; Installation of some framework notification handlers + +;; Helper method to notify +(define (signal-trace ARGS) + (die nil "** Got:" KEY ARGS )) + +(:handler ROOT (:m DBus "NameAcquired(s)") signal-trace) +(:handler ROOT (:m DBus "NameLost(s)") signal-trace) +(:handler ROOT (:m DBus "NameOwnerChanged(sss)") signal-trace) + + ; Process notifications that came with the registration handshake +(process-all-pending) + +;; Set up the Dbus event loop as prompt-event handler +(prompt-event Dbus:main-loop) + +;;###################################################################### +;; +;; Standard interfaces + +(context MAIN) + +(:use (DbusInterface "org.freedesktop.DBus.Peer" + '( "Ping():" + "GetMachineId():s" + ))) + +(:use (DbusInterface "org.freedesktop.DBus.ObjectManager" + '( "GetManagedObjects():a(oa(sa(sv)))" + ))) + +(:use (DbusInterface "org.freedesktop.DBus.Introspectable" + ' Introspectable "Introspect():s" ; (xml data) + )) +; https://dbus.freedesktop.org/doc/dbus-specification.html#introspection-format + +(:use (DbusInterface "org.freedesktop.DBus.Properties" + '( "Get(ss):v" + "Set(ssv):" + "GetAll(s):a(sv)" + "PropertiesChanged(sa(sv)as):" ; signal ? + ))) + +(:use (DbusInterface "org.freedesktop.DBus" + '( "Hello():s" + "RequestName(su):u" + "ReleaseName(s):u" + "ListQueuedOwners (s):as" + "ListNames():as" + "ListActivatableNames():as" + "NameHasOwner(s):b" + "NameOwnerChanged(sss):" ; -- signal + "NameLost(s):" ; -- signal + "NameAcquired(s):" ; -- signal + "ActivatableServicesChanged():" ; -- signal + "StartServiceByName(s,u):u" + "UpdateActivationEnvironment(a(ss)):" + "GetNameOwner(s):s" + "GetConnectionUnixUser(s):u" + "GetConnectionUnixProcessID(s):u" + "GetConnectionCredentials(s):a(sv)" + "GetAdtAuditSessionData(s):ay" + "GetConnectionSELinuxSecurityContext(s):ay" + "AddMatch(s):" + "RemoveMatch(s):" + "GetId():s" + "Monitoring.BecomeMonitor(asu):" + ))) + +;eg AddMatch argument: +;"type='signal',sender='org.example.App2',path_namespace='/org/example/App2'" + +"lsp-dbus.lsp" diff --git a/lsp-dbus-connection.lsp b/lsp-dbus-connection.lsp new file mode 100644 index 0000000..73e9672 --- /dev/null +++ b/lsp-dbus-connection.lsp @@ -0,0 +1,82 @@ +;; This newlisp module implements dbus socket connection +;; + +; Require the FOOP context +(unless (context? MAIN:FOOP) (load "foop.lsp")) + +(context 'MAIN:DbusConnection) +(FOOP path socket name serial) + +(define (DbusConnection:DbusConnection PATH) + (list (context) PATH -1 nil 0)) + +;; Increment the serial and return it. +(define (serial++) + (!serial (+ 1 (%serial)))) + +;; (open-socket) +; Internal utility method to re-open the %path socket and set the +; %socket field. +(define (open-socket) + (when (>= (%socket)) + (close (%socket)) + (!socket -1)) + (!socket (net-connect (%path)))) + +;** Commands from client to server +; AUTH [mechanism] [initial-response] +; CANCEL +; BEGIN +; DATA +; ERROR [human-readable error explanation] +; NEGOTIATE_UNIX_FD + +;** Commands from server to client +; REJECTED +; OK +; DATA +; ERROR [human-readable error explanation] +; AGREE_UNIX_FD + +(define (read-message) + (let ((BUFFER "") (RESULT "")) + (while (and RESULT (net-select (%socket) "r" 1000)) + (if (net-receive (%socket) BUFFER 8192) + (extend RESULT BUFFER) + (begin + (setf RESULT nil) + (die 1 "dbus socket closed")) + )) + RESULT)) + +;; (handshake MSG PAT) +; Perform a socket handshake sending MSG and return the result, or if +; PAT not nil, then return (regex PAT RESULT 0), +(define (handshake MSG PAT) + (let ((RESULT "")) + (net-send (%socket) MSG) + (setf RESULT (read-message)) + (if PAT (regex PAT RESULT 0) RESULT))) + +(constant + 'AUTHFMT "AUTH EXTERNAL %s\r\n" + 'AUTHACK "OK (\\S+)\r\n" + 'KEEPFMT "NEGOTIATE_UNIX_FD\r\n" + 'KEEPACK "AGREE_UNIX_FD\r\n" + ) + +;; (initialize USER) +; Perform socket initialization sequence and return the name, or nil. +(define (initialize (USER (env "USER"))) + (when (and (>= (open-socket)) + (net-send (%socket) (char 0)) + (handshake (format AUTHFMT (char2hex USER)) AUTHACK) + (!name $1) + (handshake KEEPFMT KEEPACK)) + (handshake "BEGIN\r\n") + (%name))) + +(define (cancel) + (handshake "CANCEL\r\n" "(.*)")) + +"lsp-dbus-connection.lsp" diff --git a/lsp-dbus-events.lsp b/lsp-dbus-events.lsp new file mode 100644 index 0000000..634ab07 --- /dev/null +++ b/lsp-dbus-events.lsp @@ -0,0 +1,81 @@ +;; This newlisp module implements dbus socket send-receive together +;; with signal receive. (This file should be loaded into the Dbus +;; context) +;; +;; The REPL loop is re-mastered by means of a prompt-event function +;; that firstly handles any pending dbus messages, and secondly +;; net-select on both the dbus socket and stdin. +;; +;; Stdin is handled with priority. +;; +;; Dbus messages are read and added to the pending list. +;; +;; Handlers are set up as functions (fn (data msg) ..) identified by +;; "dbus callback key" consisting of path, interface, method and +;; signature separated by ":". For example: +;; +;; "/org/freedesktop/DBus:org.freedesktop.DBus.NameAcquired(s)" +;; +;; would identify the handler for the NameAcquired(string) method of +;; the interface "org.freedesktop.DBus" of the path +;; "/org/freedesktop/DBus" of the client. That particular callback is +;; a s.c. signal sent by the dbus framework implementation in reaction +;; to the initial Hello call, i.e. the s.c. invocation of +;; +;; "/org/freedesktop/DBus:org.freedesktop.DBus.Hello()" +;; + +;; Return the callback key for a message MSG +(define (message-key MSG) + (string (lookup 'PATH MSG) ":" (lookup 'INTERFACE MSG) "." + (lookup 'MEMBER MSG) "(" (lookup 'SIGNATURE MSG) ")" )) + +;; This is the table of handlers, keyed by path:interface:method:signature +(define RECV:RECV nil) + +;; Utility function to install a handler for a given key, +(define (handler KEY HANDLER) + (RECV (string (%path) ":" KEY) HANDLER)) + +;; This is the list of Dbus messages still to handle. +(setf pending '()) + +(define (no-handler KEY MSG) + (write-line 2 (format "** No handler %s for:\n%s" KEY (string MSG)))) + +(define (process-message MSG) + (let ((KEY (message-key MSG))) + (if (RECV KEY) ($it (lookup "" MSG)) + (no-handler KEY MSG)))) + +;; Process all messages currently pending +(define (process-all-pending) + (while (if (pop pending) (process-message $it)))) + +;; The main-loop is intended as a prompt-handler so as to deal with +;; asyncronous events +(define (main-loop S) + (let ((FDS (list 0 (:%socket SYSTEM-BUS))) (FD nil)) + (write 2 (string "> ")) + (while (or pending (not (member 0 (net-select FDS "r" -1)))) + (if (pop pending) (process-message $it) + (if (unpack-messages (or (:read-message SYSTEM-BUS) "")) + (extend pending $it)) + )) + "main-loop: ")) + +(define (human-msg MSG) + (human-bytes (unpack (dup "b" (length MSG)) MSG))) + +;; Send message, then keep reading messages until there is a reply +(define (send-recv-message MSG) + ;;(die nil (list 'send-recv-message (human-msg MSG))) + (net-send (:%socket SYSTEM-BUS) MSG) + (let ((REPLY nil)) + (while (nil? REPLY) + (dolist (M (unpack-messages (:read-message SYSTEM-BUS))) + (if (lookup 'REPLY_SERIAL M) (setf REPLY M) + (push M pending -1)))) + REPLY)) + +"lsp-dbus-events.lsp" diff --git a/lsp-dbus-marshal.lsp b/lsp-dbus-marshal.lsp new file mode 100644 index 0000000..26da795 --- /dev/null +++ b/lsp-dbus-marshal.lsp @@ -0,0 +1,221 @@ +;; This newlisp "module" implements dbus marshalling +; +; The newlisp representation is a simplified form using lists for +; structs and arrays. + +;; (expand-signature S) +; Expland a signature string into a nested list to correspond to the +; newlisp list representation. +;; Basic dbus types are basic newlisp types, including strings. Arrays +;; and structs are sublists; the expanded signature marks array +;; sublists with an initial "a", otherwise it's a struct sublist. +; +; Ex: "yi" = ("y" "i") +; Ex: "y(ai)" = ("y" (("a" "i"))) +; Ex: "a(yi)" = (("a" ("y" "i"))) +; Ex: "yyyyuua(yv)" = ("y" "y" "y" "y" "u" "u" ("a" ("y" "v"))) +(define (expand-signature S) + (setf S (replace "{" (replace "}" (copy S) ")") "(")) + (let ((STACK '()) (CUR '()) (A 0)) + (dolist (X (explode S)) + (case X + (")" (setf X CUR) (setf CUR (pop STACK))) + ("(" (push CUR STACK) (setf CUR '())) + (true true)) + (when (and (!= X "a") (!= X "(")) + (while (and CUR (= "a" (last CUR))) + (setf X (list (last CUR) X)) + (setf CUR (chop CUR)))) + (when (!= "(" X) + (push X CUR -1))) + (if (null? CUR) '() CUR))) + +;; Align AT to an I multiple and pad DATA with as many NUL bytes at +;; front, then increment AT past it all. +(define (pack-align DATA (I (length DATA))) + (let ((PAD (dup "\000" (% (- I (% AT I)) I)))) + (setf DATA (extend PAD DATA)) + (inc AT (length DATA)) + DATA)) + +;; Pack data from DATA according to signature. The DATA is a nested +;; list where container types are sub lists. Variant types also appear +;; as pairs of signature and value. +(define (pack-data SIGN DATA) + (let ((AT 0)) (pack-data-struct (expand-signature SIGN) DATA))) + +;; Pack a newlisp data element according to marshalling type The +;; newlisp data is integer, double, string or list (for container and +;; variant elements). +(constant + 'FMTMAP ; mapping dbus type code to byte size and newlisp code + '( ("y" 1 "b") ; BYTE (unsigned 8-bit integer) + ("b" 4 "lu") ; BOOLEAN (0 is FALSE, 1 is TRUE, else invalid) + ("n" 2 "d") ; INT16 (signed 16-bit integer) + ("q" 2 "u") ; UINT16 (unsigned 16-bit integer) + ("i" 4 "ld") ; INT32 (signed 32-bit integer) + ("u" 4 "lu") ; UINT32 (unsigned 32-bit integer) + ("x" 8 "Ld") ; INT64 (signed 64-bit integer) + ("t" 8 "Lu") ; UINT64 (unsigned 64-bit integer) + ("d" 8 "lf") ; DOUBLE (64-bit float) + ("h" 4 "lu") ; UINT32 (unix file descriptor) + ("a" ? ?) ; ARRAY = UINT32 byte-length, items + ("s" ? ?) ; STRING = length + data + NUL + ("o" ? ?) ; OBJECT_PATH = BYTE length + data + NUL + ("g" ? ?) ; SIGNATURE = BYTE length + data + NUL + ("(" ? ?) ; STRUCT begin in signature = (8-align) + data + (")" 0 ?) ; STRUCT end in signature + ("v" ? ?) ; VARIANT = signature + data + ("{" ? ?) ; DICT_ENTRY begin + ("}" ? ?) ; DICT_ENTRY end + ("r" ? ?) ; reserved STRUCT in bindings? + ("e" ? ?) ; reserved DICT_ENTRY in bindings ? + ("m" ? ?) ; reserved 'maybe' + ("*" ? ?) ; reserved 'single complete type' + ("?" ? ?) ; reserved 'basic type' + ("@" ? ?) ; reserved + ("&" ? ?) ; reserved + ("^" ? ?) ; reserved + ) + ) + +(define (pack-data-item ES DATA) + (if (list? ES) (pack-data-struct ES DATA) + (= ES "s") (pack-data-string ES DATA) + (= ES "o") (pack-data-string ES DATA) + (= ES "g") (pack-data-signature ES DATA) + (= ES "v") (apply pack-data-variant DATA) + (if (lookup ES FMTMAP) (pack-align (pack $it DATA))))) + +(define (pack-data-variant ES DATA) + (extend (pack-align (pack "bbb" 1 (char ES) 0) 1) + (pack-data-item ES DATA))) + +;; pack types "s" and "o" +(define (pack-data-string ES DATA) + (pack-align (pack (format "lus%db" (length DATA)) (length DATA) DATA 0) 4)) + +;; pack type "g" +(define (pack-data-signature ES DATA) + (pack-align (pack (format "bs%db" (length DATA)) (length DATA) DATA 0) 1)) + +;; Pack an array. DATA elements marshalled by repeating ES, preceded +;; by the array length in bytes as aligned UINT32. +(define (pack-data-array ES DATA) + (let ((PAD (pack-align "" 4)) + (X (inc AT 4)) ; start index of array bytes + (DATA (apply extend (map (curry pack-data-item ES) DATA)))) + (extend PAD (pack "lu" (- AT X)) DATA))) + +;; Pack a struct. ES and DATA elements marshalled pairwise in order +;; following an initial8-byte alignment. +(define (pack-data-struct ES DATA) + (if (= "a" (ES 0)) (pack-data-array (ES 1) DATA) + (apply extend (cons (pack-align "" 8) + (map pack-data-item ES DATA))))) + +;;########## unpacking + +;; Advance AT to an I multiple. +(define (align-AT I) + (inc AT (% (- I (% AT I)) I))) + +;; Advance AT to an I multiple and unpack (by newlisp format) at that +;; position in DATA. Then advance AT further past that unpacking but +;; return the unpacked value. +(define (unpack-align I FMT) + ##(println (list 'unpack-align I FMT AT (length DATA))) + (align-AT I) + (prog1 ((unpack FMT (AT DATA)) 0) (inc AT I))) + +;; Unpack a string or object path. The format is "lu" (UINT32) with +;; the string length, then "s%db" with that string length and followed +;; by a NUL byte. +(define (unpack-data-string ES (N (unpack-align 4 "lu"))) + (prog1 ((unpack (string "s" N) (AT DATA)) 0) (inc AT (+ 1 N)))) + +;; Unpack a signature string. The format is "b" (BYTE) with the string +;; length, then "s%db" with that string length and followed by a NUL +;; byte. I.e. the same as unpack-data-string but with the string +;; length in a BYTE rather than an UINT32. +(define (unpack-data-signature ES) + (unpack-data-string ES (unpack-align 1 "b"))) + +;; Unpack a variant item. This consists of "bbb" where the middle +;; character is the type character for the data, preceded by a 1 byte +;; and followed by a NUL byte. The subsequent data is unpacked +;; according to that type character. +(define (unpack-data-variant) + (unpack-data-item ((expand-signature (unpack-data-signature "g")) 0))) + +;; Unpack the ES type item from (AT DATA), optionally with +;; pre-alignment, and increment AT past the padding and item. +(define (unpack-data-item ES) + ##(println (list 'unpack-data-item ES AT (length DATA))) + (if (list? ES) (unpack-data-struct ES) + (= ES "s") (unpack-data-string ES) + (= ES "o") (unpack-data-string ES) + (= ES "g") (unpack-data-signature ES) + (= ES "v") (unpack-data-variant) + (if (assoc ES FMTMAP) (unpack-align ($it -2) ($it -1))))) + +;; Unpack array with ES elements. The array begins with an UINT32 +;; field telling how many bytes to unpack, followed by the array +;; elements. +(define (unpack-data-array ES) + (let ((A AT) (N (+ (unpack-align 4 "u") AT)) (OUT '())) + (when (and (list? ES) (!= "a" (ES 0))) (align-AT 8)) + (while (< AT N) + ##(println "---next " (list AT N)) + (push (unpack-data-item ES) OUT -1)) + OUT)) + +;; Unpack a structure or array with ES fields. +(define (unpack-data-struct ES) + ##(println (list 'unpack-data-struct ES AT)) + (if (= "a" (ES 0)) (unpack-data-array (ES 1)) + (begin (align-AT 8) (map unpack-data-item ES)))) + +;; Unpack from a DATA string according to signature SIGN This returns +;; a pair (unpacked pos) of unpacked data and how much data is +;; consumed. +(define (unpack-data SIGN DATA (AT 0)) + ##(println (format "*** unpack-data %s %d %d" SIGN (length DATA) AT)) + (list (unpack-data-item (expand-signature SIGN)) AT)) + +;; Unpack all dbus messages in the given DATA block. Each message +;; consists of head and body. The head has signature "yyyyuua(yv)" +;; where the array is an alist of key-value pairs, optionally +;; including the 'SIGNATURE key with the signature for the body; if +;; omitted, then the body is empty. +;; +;; The function returns the header list of key-value pairs optionally +;; extended with the pair ("" body). +(define (unpack-messages DATA) + (let ((AT 0) (OUT '()) (M nil) (D nil) (S nil)) + (while (and (< (+ AT 7) (length DATA)) + (setf M (unpack-data "yyyyuua(yv)" DATA AT))) + (setf AT (M 1)) + ##(println "message head " (M 0)) + ##(println (list 'remains AT (length DATA))) + (setf M (M 0 -1)) ; Drop all but the headers then map to symbol keys + (dotimes (i (length M)) + (setf (M i 0) (MESSAGE-HEADERS (M i 0) 0))) + ##(println "mapped headers " M) + ;; Add the body, if any, keyed by "". + (setf S (if (lookup 'SIGNATURE M) $it "")) + ##(println (list 'sign S)) + (when (and (!= S "") (setf D (unpack-data S DATA AT))) + (setf AT (D 1)) + (extend M (list (list "" (D 0))))) + ;; Collate message and move to the next portion in DATA + (push M OUT -1) + ##(println (list 'ending AT (length DATA))) + ;;(align-AT 4) + ##(println (list 'aligned AT (length DATA))) + (setf DATA (AT DATA)) + (setf AT 0) + ) + OUT )) + +"lsp-dbus-marshal.lsp" diff --git a/lsp-dbus.a.8.adoc b/lsp-dbus.a.8.adoc new file mode 100644 index 0000000..c840c5d --- /dev/null +++ b/lsp-dbus.a.8.adoc @@ -0,0 +1,246 @@ += lsp-dbus.a(8) +:doctype: manpage +:revdate: {sys:date "+%Y-%m-%d %H:%M:%S"} +:BC: *:* + +== NAME + +lsp-dbus.a - Dbus API for newlisp. + +== SYNOPSIS + +.With packnl +packnl _main.lsp_ *-A lsp-misc.a* *-A lsp-dbus.a* + + +.With incore.lsp +(load "incore.lsp") + +(archive "lsp-misc.a") + +(archive "lsp-utils.a") + +(load "lsp-dbus.lsp") + +== DESCRIPTION + +*lsp-dbus.a* implements a newlisp API for Dbus. The module includes a +context _DbusConnection_ that implements the connection/authorization +level and a context _Dbus_ that implements the "object +modelling"/messaging level. + +The source software is divided into a couple of different source files +that are packed together into an _ar_ archive. + +Note that *lsp-dbus.a* depends on _FOOP_ and _prog1_ from *lsp-misc.a*. + +=== lsp-dbus API + +(*load* "lsp-dbus.lsp"):: + +The main file, *lsp-dbus.lsp*, includes connection setup (see +*:initialize* below) and client registration (i.e. issuing the dbus +"Hello():s" message as part of its loading. Currently it connects on +the system bus (only). It also installs the funcion _main-loop_ as +_prompt-event_ function for processing any unsolicited messages from +dbus (so called "signals"). + +==== The Dbus Context + +(*Dbus* _PATH_ [_DESTINATION_]):: + +The _Dbus_ context is used for identifying remote "objects" with the +given _PATH_ and _DESTINATION_ (aka bus name). The resulting _FOOP_ +object provides a proxying channel for invoking methods targeting the +given path on the given bus-name application. When omitted, the +_DESTINATION_ string is obtained from the _PATH_ string following the +convention of chopping the initial "/" and replacing remaining "/" +with ".". ++ +==== +Note that a term like _(Dbus "/org/freedesktop/DBus")_ defines an +identifer for, or pointer to, a remote "dbus object", and it is here +referred to as _PROXY_. The _PATH_ part serves as the object +identifier for dbus while the _DESTINATION_ part is an identfier for +the application that we expect holds the actual "dbus object" for the +given _PATH_. This particular term identifies object path +"/org/freedesktop/DBus" held by the application named +"org.freedesktop.DBus", which belongs to the dbus framewok. + +There is however no central arbitration for paths in dbus. It all +relies on application developers documenting which paths their +applications service and access, and then client applications rely on +using the destination tags for directing their messages to the +intended applications. +==== + +(*:new-path* _PROXY_ _PATH_):: + +The _:new-path_ method clones the FOOP object to dentify the given +_PATH_ for the same destination. + +(*:invoke* _PROXY_ _METHOD_ _ARGUMENTS_ _FLAGS_):: + +The _:invoke_ method performs a Dbus _METHOD_CALL_ handshake for the +gven _PROXY_ using the given _METHOD_, _ARGUMENTS_ and message +_FLAGS_. The function sends a dbus message and then polls for debus +messages until the reply message has arrived. any and all other +messages recevied meanwhile are added to the _pending_ list. ++ +The _METHOD_ is given as a string composed as path, interface, name +and signature ++ +==== +_path:interface.name(signature)_ +==== ++ +The _path:_ component including the colon is optional and taken from +the _PROXY_ by default. The _interface._ component incuding the period +is also optional as per dbus documentation: a method call without +explicit interface results in that the method name is looked up across +all interfaces of the destination path. ++ +The _SIGNATURE_ is the dbus style signature as a character sequence, +where y, b, n, q, i, u, x, t, d and h indicate the basic types BYTE, +BOOLEAN, INT16, UINT16, INT32, UINT32, INT64, UINT64, DOUBLE and FD +respectivly (both BOOLEAN and FD are also UINT32); a indicates +"array"; s, o and g indicate strings of various restrictions; +parentheses and curly braces wrap "struct" signatures, and v indicates +a pair of a data item preceded by its signature. Refer to dbus +documentation for further details. ++ +The given _ARGUMENTS_ is a list structure that must correspond to the +given signature. All number and string values are mapped naturally +into the indicated signatures while arrays, struct and variant +elements should occur as lists: an array is formed from the list of +elements, as is a struct. A variant typed element must occur as the +list of signature and data. See also the MARSHALLING section below. ++ +The optional _FLAGS_ argument is given either a bit mask (number) or a +list of the _Dbus_ context symbols _NO_REPLY_EXPECTED_, +_NO_AUTO_START_ and _ALLOW_INTERACTIVE_AUTHORIZATION_. Each of these +correspond to a bit position in the _FLAGS_ mask and they are combined +with bit-OR. Refer to dbus documentation for further details. ++ +.Some :invoke usage examples +---- +(:invoke Dbus:ROOT "RequestName(su)" '("my.client" 0)) + +(:invoke Dbus:ROOT "GetNameOwner(s)" '("org.bluez" 0)) + +(setf BT (Dbus "/" "org.bluez")) +(:invoke BT "GetManagedObjects()") +(Dbus:process-pending) +---- ++ +Note "org.bluez" here provides the "GetManagedObjects()" method of +interface "org.freedesktop.ObjectManager" unambiguously on the root +path, "/", rather than its bus name path "/org/bluez". ++ +While this process is waiting for the _METHOD_CALL_ reply it may +receive signal messsages from _dbus_. These will be added to the list +of "pending callbacks" that is processed via the _process-all-pending_ +function, either via an explicit call following the handshake or +"automagically" as part of the _main-loop_ function that gets +installed as as _prompt-event_ function. ++ +.Return value: +[caption=""] +==== +The return value of *:invoke* is the METHOD_REPLY message reduced into +an association list of the headers (with the _Dbus_ header symbols as +keys) extended with the method return value as a list wrapped into a +final association that is keyed by the empty string. + +In other words, the template for using *:invoke* may look like the +following: +---- +(if (:invoke ...) ($it -1 -1 -1)) +---- +==== + +(*Dbus:process-all-pending*):: + +The _process-all-pending_ function processes all pending signal +messages by invoking their associated handler functions. + +(*prompt-event Dbus:main-loop*):: + +The _main-loop_ function is set up as _prompt-event_ function for a +combined _net-select_ on both stdin and the dbus socket as well as to +process all pending signal messages. Any input from dbus, which are +signal messages, are added to the pending list, which also is +processed one message at a time until empty. ++ +Note that newlisp uses readline for input but that this is not +activated in _main-loop_. Therefore line editing is not available +immediately. However the operator may use ^D to leave the main-loop +and enter the "normal" command line input state for a single line +input (with line editing), or an initial newline for multi-line input +that is "submitted" by means of two newlines. + +(*:handler* _OBJ_ _KEY_ _HANDLER_):: + +This function registers a handler callback for a key that is a string +composed as "path:interface.member(signature)". The handler function +takes a single argument, which is the list of unmarshalled actual call +arguments. + +==== The DbusConnection Context + +(*DbusConnection* _PATH):: + +The _DbusConnection_ context is a FOOP implementation intended for the +dbus socket connection. Each _(DbusConnection PATH)_ is intended to be +like a real object that contains state, namely the opened socket file +descriptor, the connection name given to it by DBus on connection and +and the messaging serial. + +(*:serial++* _OBJECT_):: + +This method increments the serial of the given object. + +(*:open-socket* _OBJECT_):: + +This method opens the path and assignes the socket file descriptor of +the given object. Before that though, if the socket file descriptor is +non-negative then that file descriptor is closed before opening the +object's path. + +(*:read-message* _OBJECT_):: + +This method reads the next message by reading data from the socket +successively while there's something to read within a millisecond. + +(*:handshake* _OBJECT_ _MESSAGE_ [_PATTERN_]):: + +This method performs a "raw" text-based handshake on the connection, +which means to send the given message and then read and return the +response message. If a _PATTERN_ is given, then the response must +match the pattern (assigning the automatic variables $1 etc according +to the pattern). The method returns nil if the given pattern is not +matched. Note that this method is used only during connection setup +and dbus communication uses its own marshalling subsequently. + +(*:initialize* _OBJECT_ [_USER_]):: + +This method performs the connection set up including the very first +newline and the subsequent AUTH handshake. It ends with the connection +in "BEGIN" mode and returns the received connection name. + +=== MARSHALLING + +dbus documentation uses the terms "marshalling" and "unmarshalling" +for the translations of data from/to program data to/from dbus message +bytes. The data in newlisp mapped straight-forwardly with the special +note that both "struct" and "array" are held as lists in newlisp. To +that end, the data for the variant type signature must be wrapped into +an extra list of the format _(signature value)_ with explcit dbus +signature string. However, such wrapping does not take place upon +unmarshalling. + + +== SEE ALSO + +*newlisp*, *packnl*, *incore.lsp* + +== AUTHOR + +Ralph Ronnquist -- 2.39.2