lava-rpc: allow evaluation of function for API token

This makes it more useful to query the password when required because
the password store might not given us the password on bootup.

1 files changed, 36 insertions, 10 deletions

diff --git a/lava-rpc.el b/lava-rpc.el
index ad3f009..fa9b435 100644
--- a/lava-rpc.el
+++ b/lava-rpc.el
@@ -47,7 +47,8 @@
 
 (defvar lava-api-token
   nil
-  "The API token on the LAVA instance.")
+  "The API token on the LAVA instance.
+If the variable is a function pointer it is called at evaluation time.")
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; LAVA XML-RPC Calls
@@ -58,19 +59,27 @@
   "Default callback handler. Just echos response to the logs."
   (message "lava-xml-rpc-callback: got %s" response))
 
+;;; Create an auth header
+(defun lava-xml--make-auth-token ()
+  "Return a BASIC auth token for our RPC calls."
+  (concat "Basic "
+          (base64-encode-string
+           (concat lava-user-name ":"
+                   (if (functionp lava-api-token)
+                       (funcall lava-api-token)
+                     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'.
 The `CALLBACK' function is called with the response."
-  (let ((lava-xml-rpc-path (format "http://%s@%s/RPC2"
-                                   lava-user-name
-                                   lava-host))
-        (xml-rpc-request-extra-headers
-         `(("Authorization" .
-            ,(concat "Basic "
-                     (base64-encode-string
-                      (concat lava-user-name ":" lava-api-token)
-                      t))))))
+  (let* ((lava-xml-rpc-path
+          (format "http://%s@%s/RPC2"
+                  lava-user-name
+                  lava-host))
+         (xml-rpc-request-extra-headers
+          `(("Authorization" . ,(lava-xml--make-auth-token)))))
     (if params
         (xml-rpc-method-call-async
          callback lava-xml-rpc-path method params)
@@ -99,5 +108,22 @@ The `CALLBACK' function is called with the response."
   "Fetch the current device classes from LAVA."
   (lava-xml-rpc-call cb 'scheduler.all_device_types))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; LAVA URL Fetching
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun lava-rpc-fetch-url (url &optional callback cb-params)
+  "Fetch the `URL' from the current lava server.
+The URL should not contain the host information, it will be added by
+  this function."
+  (let ((lava-url
+         (format "http://%s@%s/%s"
+                 lava-user-name
+                 lava-host
+                 url))
+        (url-request-extra-headers
+         `(("Authorization" . ,(lava-xml--make-auth-token)))))
+    (url-retrieve lava-url callback cb-params)))
+
 (provide 'lava-rpc)
 ;;; lava-rpc.el ends here