lava-rpc: make async and sync xml-rpc calls

This makes the simple job submission function synchronous which makes
the hoop jumping in org files less perverse.

3 files changed, 63 insertions, 23 deletions

diff --git a/lava-job-list-mode.el b/lava-job-list-mode.el
index 7af4400..63a7865 100644
--- a/lava-job-list-mode.el
+++ b/lava-job-list-mode.el
@@ -106,18 +106,19 @@ Letters do not insert themselves; instead, they are commands.
 (defun lava-job-status (jobid)
   "Request the job status of JOBID."
   (lexical-let ((jobid jobid))
-    (lava-xml-rpc-call #'(lambda (resp) (lava-update-job-status jobid resp))
-                       'scheduler.job_status
-                       jobid)))
+    (lava-xml-async-rpc-call #'(lambda (resp) (lava-update-job-status jobid resp))
+                             'scheduler.job_status
+                             jobid)))
+
 
 (defun lava-job-list-get-details (job)
   "Request the details of a job."
   (let* ((info-hash (lava-jobs-get-hash job))
          (job-id (gethash "job_id" info-hash)))
   (lexical-let ((j job-id))
-    (lava-xml-rpc-call #'(lambda (resp) (lava-update-job-status j resp))
-                       'scheduler.job_details
-                       j))))
+    (lava-xml-async-rpc-call #'(lambda (resp) (lava-update-job-status j resp))
+                             'scheduler.job_details
+                             j))))
 
 (defun lava-stop-polling-job (job)
   "Stop polling the given LAVA job."
diff --git a/lava-mode.el b/lava-mode.el
index 0ff03cc..a6f8529 100644
--- a/lava-mode.el
+++ b/lava-mode.el
@@ -135,15 +135,18 @@ bits are correctly tagged.")
 When called with the prefix `arg' keep results of the escaped elisp.
 If the prefix is specified twice don't send the json at all."
   (interactive "P")
-  (let ((expanded-buffer (lava-mode-expand-buffer)))
+  (let ((expanded-buffer (lava-mode-expand-buffer))
+        (response))
     (unless (and (number-or-marker-p arg) (> arg 4))
       (with-current-buffer expanded-buffer
-        (lava-rpc-submit-json-job
-         (buffer-substring-no-properties
-          (point-min) (point-max)))))
+        (setq response
+              (lava-rpc-submit-json-job
+               (buffer-substring-no-properties
+                (point-min) (point-max))))))
     (if arg
         (switch-to-buffer expanded-buffer)
-      (kill-buffer expanded-buffer))))
+      (kill-buffer expanded-buffer))
+    response))
 
 (defun lava-mode-expand-buffer ()
   "Expand the current buffer into a new one, expanding any embedded
diff --git a/lava-rpc.el b/lava-rpc.el
index a07a616..7c0fe1b 100644
--- a/lava-rpc.el
+++ b/lava-rpc.el
@@ -77,14 +77,23 @@ This is handy for debugging callbacks."
                      lava-api-token))
            t)))
 
-;;; Submit a XML-RPC call to LAVA
-(defun lava-xml-rpc-call (callback method &optional params)
-  "Make `METHOD' XML-RPC call to LAVA with `PARAMS'.
+(defun lava-xml-rpc-path ()
+  "Return the URL path for LAVA."
+  (format "http://%s@%s/RPC2"
+          lava-user-name
+          lava-host))
+
+;;; Submit XML-RPC calls to LAVA
+;;
+;; We provide asynchronous and synchronous methods. You should use the
+;; asynchronous methods for anything that might take some time with
+;; LAVA to avoid blocking Emacs. 
+;;
+
+(defun lava-xml-async-rpc-call (callback method &optional params)
+  "Make an asynchronous `METHOD' XML-RPC call to LAVA with `PARAMS'.
 The `CALLBACK' function is called with the response."
-  (let* ((lava-xml-rpc-path
-          (format "http://%s@%s/RPC2"
-                  lava-user-name
-                  lava-host))
+  (let* ((lava-xml-rpc-path (lava-xml-rpc-path))
          (xml-rpc-request-extra-headers
           `(("Authorization" . ,(lava-xml--make-auth-token)))))
     (if params
@@ -93,6 +102,17 @@ The `CALLBACK' function is called with the response."
       (xml-rpc-method-call-async
        callback lava-xml-rpc-path method))))
 
+(defun lava-xml-rpc-call (method &optional params)
+  "Make a synchronous `METHOD' XML-RPC call to LAVA with optional `PARAMS'."
+  (let* ((lava-xml-rpc-path (lava-xml-rpc-path))
+         (xml-rpc-request-extra-headers
+          `(("Authorization" . ,(lava-xml--make-auth-token)))))
+    (if params
+        (xml-rpc-method-call
+         lava-xml-rpc-path method params)
+      (xml-rpc-method-call
+       lava-xml-rpc-path method))))
+
 ;;; Handle the response and create initial alist.
 (defun lava-rpc--job-submitted (resp)
   "Handle the response `RESP' from a submitted job."
@@ -102,18 +122,34 @@ The `CALLBACK' function is called with the response."
     (puthash "job_status" "Submitted" hash)
     (puthash "updated" (current-time) hash)
     (setq lava-job-info
-          (cons `(,job . ,hash) lava-job-info))))
+          (cons `(,job . ,hash) lava-job-info))
+    job))
 
 ;;; Submit the current JSON file as a lava-job
 (defun lava-rpc-submit-json-job (json)
   "Submit a JSON job to LAVA instance."
-  (lava-xml-rpc-call 'lava-rpc--job-submitted
-                     'scheduler.submit_job
-                     json))
+  (lava-rpc--job-submitted
+   (lava-xml-rpc-call
+    'scheduler.submit_job
+    json)))
 
+;;; Device handling
 (defun lava-rpc-get-device-list (cb)
   "Fetch the current device classes from LAVA."
-  (lava-xml-rpc-call cb 'scheduler.all_device_types))
+  (lava-xml-async-rpc-call cb 'scheduler.all_device_types))
+
+;;; Stream handling
+(defun lava-rpc-make-stream (path description)
+  "Create a stream in LAVA."
+  (lava-xml-async-rpc-call
+   'lava-xml-rpc-callback
+   'dashboard.make_stream
+   `(("pathname" . ,path)
+     ("name" . ,description))))
+
+;; (lava-rpc-make-stream
+;;  "/anonymous/qemu-master"
+;;  "Build stream for the QEMU master branch builds")
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; LAVA URL Fetching