From d169906b768213dd51bf6891fff79bcf16bb1d54 Mon Sep 17 00:00:00 2001
From: defanor <defanor@uberspace.net>
Date: Sun, 26 Sep 2021 10:14:01 +0300
Subject: Add xmpp-http-upload into xmpp.el

---
 emacs/xml_interface.c | 16 ++++++++++++++++
 emacs/xmpp.el         | 13 ++++++++++++-
 src/rexmpp.c          |  1 +
 3 files changed, 29 insertions(+), 1 deletion(-)

diff --git a/emacs/xml_interface.c b/emacs/xml_interface.c
index 92e8c5f..110e96f 100644
--- a/emacs/xml_interface.c
+++ b/emacs/xml_interface.c
@@ -74,6 +74,17 @@ xmlNodePtr req_block (xmlNodePtr req) {
   return read_response();
 }
 
+void on_http_upload (rexmpp_t *s, void *cb_data, const char *url) {
+  char *fpath = cb_data;
+  xmlNodePtr payload = xmlNewNode(NULL, "http-upload");
+  xmlNewProp(payload, "path", fpath);
+  if (url != NULL) {
+    xmlNewProp(payload, "url", url);
+  }
+  free(fpath);
+  request(payload);
+}
+
 void req_process (rexmpp_t *s,
                   xmlNodePtr elem)
 {
@@ -151,6 +162,11 @@ void req_process (rexmpp_t *s,
       free(jid);
     }
   }
+  if (rexmpp_xml_match(child, NULL, "http-upload")) {
+    char *in = xmlNodeGetContent(child);
+    rexmpp_http_upload_path(s, NULL, in, NULL, on_http_upload, strdup(in));
+    free(in);
+  }
   print_xml(rep);
   xmlFreeNode(rep);
   return;
diff --git a/emacs/xmpp.el b/emacs/xmpp.el
index f61393b..516b0fd 100644
--- a/emacs/xmpp.el
+++ b/emacs/xmpp.el
@@ -385,7 +385,14 @@ its printing--which doesn't handle namespaces--can be used too."
                  (xmpp-proc-write '((response nil "0")) proc)))
          (`(xml-out nil ,xml-out)
           (progn (xmpp-process-output proc xml-out)
-                 (xmpp-proc-write '((response nil "0")) proc)))))
+                 (xmpp-proc-write '((response nil "0")) proc)))
+         (`(http-upload ,prop)
+          (let ((path (cdr (assq 'path prop)))
+                (url (cdr (assq 'url prop))))
+            (if url
+                (progn (kill-new url)
+                       (message "Uploaded %s to %s" path url))
+              (message "Failed to upload %s" path))))))
       ('log
        (with-current-buffer log-buf
          (goto-char (point-max))
@@ -417,6 +424,10 @@ its printing--which doesn't handle namespaces--can be used too."
 (defun xmpp-with-name (jid cb &optional proc)
   (xmpp-request `(get-name nil ,jid) cb proc))
 
+(defun xmpp-http-upload (path &optional proc)
+  (interactive "fFile path: ")
+  (xmpp-request `(http-upload nil ,path) nil proc))
+
 (defun xmpp-stop (&optional proc)
   (interactive)
   (xmpp-request '(stop) nil proc))
diff --git a/src/rexmpp.c b/src/rexmpp.c
index d1bf073..c2e472f 100644
--- a/src/rexmpp.c
+++ b/src/rexmpp.c
@@ -2453,6 +2453,7 @@ rexmpp_err_t rexmpp_run (rexmpp_t *s, fd_set *read_fds, fd_set *write_fds) {
       CURL *e = cmsg->easy_handle;
       struct rexmpp_http_upload_task *task;
       curl_easy_getinfo(e, CURLINFO_PRIVATE, &task);
+      rexmpp_log(s, LOG_DEBUG, "%s upload is finished", task->fname);
       rexmpp_upload_task_finish(task);
       curl_multi_remove_handle(s->curl_multi, e);
       curl_easy_cleanup(e);
-- 
cgit v1.2.3