Switch from XML-RPC to D-Bus

next.asd

@@ -18,13 +18,12 @@
                :cl-markup
                :cl-css
                :bordeaux-threads
-               :s-xml-rpc
                :unix-opts
                :trivial-clipboard
-               :find-port
                :log4cl
                :closer-mop
-               :ironclad)
+               :ironclad
+               :dbus)
   :components ((:module "source"
                 :components
                 (;; Core Functionality

source/base.lisp

@@ -30,14 +30,8 @@ Set to '-' to read standard input instead."))
                  (opts:arg-parser-failed #'handle-malformed-cli-arg))
     (opts:get-opts)))
 
-;; TODO: This is rather low level and should probably not be a command.
-;; We can safely remove it once we can EVAL within Next.
-(define-command server-methods-inspect ()
-  "List the XML-RPC methods supported by the platform port."
-  (echo (minibuffer *interface*) (cl-strings:join
-                      (sort (%%list-methods *interface*) #'string<)
-                      :separator "
-")))
+;; TODO: Find a way to list/introspect available platform port methods from a
+;; running Next.
 
 (define-command kill ()
   "Quit Next."
@@ -69,19 +63,26 @@ Set to '-' to read standard input instead."))
            (format t "Bye!~&")
            (uiop:quit)))))
 
+(defun ping-platform-port (&optional (bus-type (dbus:session-server-addresses)))
+  (dbus:with-open-bus (bus bus-type)
+    (member +platform-port-name+ (dbus:list-names bus)
+            :test #'string=)))
+
 (defmethod initialize-port ((interface remote-interface))
+  ;; TODO: With D-Bus we can "watch" a connection.  Is this implemented in the
+  ;; CL library?  Else we could bind initialize-port to a D-Bus notification.
   (let* ((port-running nil)
          (max-seconds-to-wait 5.0)
          (max-attemps (/ max-seconds-to-wait (platform-port-poll-interval interface))))
     (loop while (not port-running)
           repeat max-attemps do
       (handler-case
           (progn
-            (when (%%list-methods interface)
+            (when (ping-platform-port)
               (setf port-running t)))
         (error (c)
           (log:debug "Could not communicate with port: ~a" c)
-          (log:info "Polling platform port '~a'...~%" (platform-port-socket interface))
+          (log:info "Polling platform port...~%" )
           (sleep (platform-port-poll-interval interface))
           (setf port-running nil))))
     (when port-running
@@ -129,9 +130,9 @@ If FILE is \"-\", read from the standard input."
   (load-lisp-file init-file))
 
 (defun start (&key (with-platform-port-p nil))
-  ;; Randomness should be seeded as early as possible to avoid generating deterministic tokens.
+  ;; Randomness should be seeded as early as possible to avoid generating
+  ;; deterministic tokens.
   (setf *random-state* (make-random-state t))
-
   (when (getf *options* :init-file)
     (setf *init-file-path* (getf *options* :init-file)))
   (load-lisp-file *init-file-path*)

source/global.lisp

@@ -20,6 +20,14 @@ when multiple interfaces are supported.")
   "The port that Swank will open a new server on (default Emacs SLIME port
 is 4005, default set to 4006 in Next to avoid collisions).")
 
+(defparameter +platform-port-name+ "engineer.atlas.next.platform")
+(defparameter +platform-port-object+ "/engineer/atlas/next/platform")
+(defparameter +platform-port-interface+ +platform-port-name+)
+
+(defparameter +core-name+ "engineer.atlas.next.core")
+(defparameter +core-object+ "/engineer/atlas/next/core") ; TODO: Rename +core-object-path+
+(defparameter +core-interface+ +core-name+)
+
 (defparameter +version+
   (let ((version (asdf/component:component-version (asdf:find-system :next)))
         (directory (asdf:system-source-directory :next)))

source/keymap.lisp

@@ -19,10 +19,16 @@
   (let ((key (mapcar #'serialize-key-chord key-chords)))
     (gethash key map)))
 
-(define-endpoint |push.input.event| (key-code key-string modifiers x y low-level-data sender)
   "Add a new key chord to the interface key-chord-stack.
 For example, it may add C-M-s or C-x to a stack which will be consumed by
-`|consume.key.sequence|'."
+`consume-key-sequence'."
+(dbus:define-dbus-method (core-object push-input-event)
+    ((key-code :int32) (key-string :string) (modifiers (:array :string))
+     (x :double) (y :double)
+     (low-level-data :int32) (sender :string))
+    ()
+  (:interface +core-interface+)
+  (:name "push_input_event")
   (let ((key-chord (make-key-chord
                     :key-code key-code
                     :key-string key-string
@@ -41,7 +47,7 @@ For example, it may add C-M-s or C-x to a stack which will be consumed by
           (%%generate-input-event *interface*
                                   (gethash sender (windows *interface*))
                                   key-chord))))
-  t)
+  (values))
 
 ;; TODO: If we move the global mode to root-mode, how do we make sure which one has priority?
 ;; What about reserving a prefix key for application mode and root mode?
@@ -71,7 +77,9 @@ For example, it may add C-M-s or C-x to a stack which will be consumed by
 ;; event callback in the platform port.  This has been deprecated in favour of
 ;; event generation, but we keep it around in case the new approach happens to
 ;; be not satisfying.
-(define-endpoint |consume.key.sequence| (sender)
+(dbus:define-dbus-object (core-object consume-key-sequence)
+  ((sender :string))
+  ()
   (consume-key-sequence sender))
 |#
 

source/port.lisp

@@ -12,9 +12,8 @@
          :documentation "Full path to the executable.
 It can also be a function that takes NAME as argument and returns the path as a
 string.")
-   (args :initarg :args :initform #'default-args
-         :documentation "List of strings passed as argument to the executable.
-It can also be a function of no argument, returning a list of strings.")
+   (args :initarg :args :initform nil
+         :documentation "List of strings passed as argument to the executable.")
    (log-file :initarg :log-file :initform #'derive-logfile-from-name
              :documentation "Log file for the platform port.
 It can also be a function that takes NAME as argument and returns the log file
@@ -50,18 +49,6 @@ as a string.")
                       (merge-pathnames ".local/share/" (format nil "~a/" (uiop:getenv "HOME"))))))
     (merge-pathnames (format nil "next/~a.log" name) xdg-data)))
 
-(defun default-args ()
-  "Derive platform port arguments dynamically at runtime.
-This is useful if, for instance, the socket gets changed after startup."
-  ;; TODO: Make sure that it works if platform port is started manually.
-  (unless (find-port:port-open-p (getf (platform-port-socket *interface*) :port))
-    (let ((new-port (find-port:find-port)))
-      (format *error-output* "Platform port socket ~a seems busy, trying ~a instead.~%"
-              (getf (platform-port-socket *interface*) :port) new-port)
-      (setf (getf (platform-port-socket *interface*) :port) new-port)))
-  (list "--port" (write-to-string (getf (platform-port-socket *interface*) :port))
-        "--core-socket" (format nil "http://localhost:~a/RPC2" (core-port *interface*))))
-
 (defmethod run-loop ((port port))
   (uiop:wait-process (running-process port)))
 
@@ -74,12 +61,10 @@ This is useful if, for instance, the socket gets changed after startup."
     (log:info "Platform port arguments: ~a" port-args)
     (log:info "Platform port log file: ~a" port-log-file)
     (ensure-directories-exist (directory-namestring port-log-file))
-    (setf (uiop:getenv "NEXT_RPC_AUTH_TOKEN") (interface-auth *interface*))
     (setf (running-process port)
           (uiop:launch-program (cons port-path port-args)
                                :output port-log-file
-                               :error-output :output))
-    (setf (uiop:getenv "NEXT_RPC_AUTH_TOKEN") "")))
+                               :error-output :output))))
 
 (defmethod kill-program ((port port))
   (uiop:run-program