1 ;; This newlisp module implements dbus socket connection
4 ; Require the FOOP context
5 (unless (context? MAIN:FOOP) (load "foop.lsp"))
7 (context 'MAIN:DbusConnection)
8 (FOOP path socket name serial)
10 (define (DbusConnection:DbusConnection PATH)
11 (list (context) PATH -1 nil 0))
13 ;; Increment the serial and return it.
15 (!serial (+ 1 (%serial))))
18 ; Internal utility method to re-open the %path socket and set the
24 (!socket (net-connect (%path))))
26 ;** Commands from client to server
27 ; AUTH [mechanism] [initial-response]
30 ; DATA <data in hex encoding>
31 ; ERROR [human-readable error explanation]
34 ;** Commands from server to client
35 ; REJECTED <space-separated list of mechanism names>
37 ; DATA <data in hex encoding>
38 ; ERROR [human-readable error explanation]
41 (define (read-message)
42 (let ((BUFFER "") (RESULT ""))
43 (while (and RESULT (net-select (%socket) "r" 1000))
44 (if (net-receive (%socket) BUFFER 8192)
45 (extend RESULT BUFFER)
48 (die 1 "dbus socket closed"))
52 ;; (handshake MSG PAT)
53 ; Perform a socket handshake sending MSG and return the result, or if
54 ; PAT not nil, then return (regex PAT RESULT 0),
55 (define (handshake MSG PAT)
57 (net-send (%socket) MSG)
58 (setf RESULT (read-message))
59 (if PAT (regex PAT RESULT 0) RESULT)))
62 'AUTHFMT "AUTH EXTERNAL %s\r\n"
63 'AUTHACK "OK (\\S+)\r\n"
64 'KEEPFMT "NEGOTIATE_UNIX_FD\r\n"
65 'KEEPACK "AGREE_UNIX_FD\r\n"
69 ; Perform socket initialization sequence and return the name, or nil.
70 (define (initialize (USER (env "USER")))
71 (when (and (>= (open-socket))
72 (net-send (%socket) (char 0))
73 (handshake (format AUTHFMT (char2hex USER)) AUTHACK)
75 (handshake KEEPFMT KEEPACK))
76 (handshake "BEGIN\r\n")
80 (handshake "CANCEL\r\n" "(.*)"))
82 "lsp-dbus-connection.lsp"