diff --git a/jabber-carbons.el b/jabber-carbons.el deleted file mode 100644 index c90a4f8..0000000 --- a/jabber-carbons.el +++ /dev/null @@ -1,23 +0,0 @@ -(require 'jabber-iq) -(require 'jabber-xml) - -(defun jabber-carbon-success (jc xml-data context) - (when (equal "result" (jabber-xml-get-attribute xml-data 'type)) - (message "Carbons feature successfully enabled"))) - -(defun jabber-carbon-failure (jc xml-data context) - (message "Carbons feature could not be enabled: %S" xml-data)) - -(add-to-list 'jabber-jid-service-menu - (cons "Enable Carbons" 'jabber-enable-carbons)) -(defun jabber-enable-carbons (jc) - "Send request to enable XEP-0280 Message Carbons" - (interactive (list (jabber-read-account))) - (jabber-send-iq jc - nil - "set" - `(enable ((xmlns . "urn:xmpp:carbons:2"))) - #'jabber-carbon-success "Carbons feature enablement" - #'jabber-carbon-failure "Carbons feature enablement")) - -(provide 'jabber-carbons) diff --git a/jabber-chat.el b/jabber-chat.el index 95f12c2..9562c35 100644 --- a/jabber-chat.el +++ b/jabber-chat.el @@ -221,14 +221,9 @@ Either a string or a buffer is returned, so use `get-buffer' or (cons ?j (jabber-jid-user chat-with)) (cons ?r (or (jabber-jid-resource chat-with) ""))))) -(defun jabber-chat-create-buffer (jc chat-with incoming-message-p) +(defun jabber-chat-create-buffer (jc chat-with) "Prepare a buffer for chatting with CHAT-WITH. -This function is idempotent. -If INCOMING-MESSAGE-P is non-nil and history is handled by the -server (using XMPP XEP-0313 MAM, which is controlled via -`jabber-history-mam'), the first message from the archive request -is ignored as it is the same as the incoming message (this -prevents duplicate messages in the buffer)." +This function is idempotent." (with-current-buffer (get-buffer-create (jabber-chat-get-buffer chat-with)) (unless (eq major-mode 'jabber-chat-mode) (jabber-chat-mode jc #'jabber-chat-pp) @@ -239,16 +234,10 @@ prevents duplicate messages in the buffer)." (setq header-line-format jabber-chat-header-line-format) (make-local-variable 'jabber-chat-earliest-backlog) - (when jabber-history-mam - (make-local-variable 'jabber-mam-results) - (make-local-variable 'jabber-mam-done) - (make-local-variable 'jabber-mam-last-id) - (make-local-variable 'jabber-mam-lock)) ;; insert backlog (when (null jabber-chat-earliest-backlog) - (let ((backlog-entries (jabber-history-backlog chat-with nil - incoming-message-p))) + (let ((backlog-entries (jabber-history-backlog chat-with))) (if (null backlog-entries) (setq jabber-chat-earliest-backlog (jabber-float-time)) (setq jabber-chat-earliest-backlog @@ -306,58 +295,38 @@ prevents duplicate messages in the buffer)." (add-to-list 'jabber-message-chain 'jabber-process-chat) -(defun jabber-get-forwarded-message (xml-data) - (let* ((sent (car (jabber-xml-get-children xml-data 'sent))) - (forwarded (car (jabber-xml-get-children sent 'forwarded))) - (forwarded-message (car (jabber-xml-get-children forwarded 'message)))) - (when forwarded-message - forwarded-message))) - (defun jabber-process-chat (jc xml-data) "If XML-DATA is a one-to-one chat message, handle it as such." ;; For now, everything that is not a public MUC message is ;; potentially a 1to1 chat message. (when (not (jabber-muc-message-p xml-data)) ;; Note that we handle private MUC messages here. - (cl-destructuring-bind (xml-data chat-buffer) - (if (car (jabber-xml-get-children xml-data 'sent)) - (let* ((fwd-msg (jabber-get-forwarded-message xml-data)) - (to (jabber-xml-get-attribute fwd-msg 'to))) - (list fwd-msg - (jabber-chat-create-buffer jc to))) - (list xml-data nil)) - (let ((from (jabber-xml-get-attribute xml-data 'from)) - (error-p (jabber-xml-get-children xml-data 'error)) - (body-text (car (jabber-xml-node-children - (car (jabber-xml-get-children - xml-data 'body)))))) - ;; First check if we would output anything for this stanza. - (when (or error-p - (run-hook-with-args-until-success 'jabber-chat-printers - xml-data - :foreign :printp)) - ;; If so, create chat buffer, if necessary... - (with-current-buffer (if (jabber-muc-sender-p from) - (jabber-muc-private-create-buffer - jc - (jabber-jid-user from) - (jabber-jid-resource from)) - (or chat-buffer - (jabber-chat-create-buffer jc from))) - ;; ...add the message to the ewoc... - (let ((node (ewoc-enter-last jabber-chat-ewoc - (list (if error-p :error :foreign) - xml-data - :time - (current-time))))) - (jabber-maybe-print-rare-time node)) + (let ((from (jabber-xml-get-attribute xml-data 'from)) + (error-p (jabber-xml-get-children xml-data 'error)) + (body-text (car (jabber-xml-node-children + (car (jabber-xml-get-children + xml-data 'body)))))) + ;; First check if we would output anything for this stanza. + (when (or error-p + (run-hook-with-args-until-success 'jabber-chat-printers xml-data :foreign :printp)) + ;; If so, create chat buffer, if necessary... + (with-current-buffer (if (jabber-muc-sender-p from) + (jabber-muc-private-create-buffer + jc + (jabber-jid-user from) + (jabber-jid-resource from)) + (jabber-chat-create-buffer jc from)) + ;; ...add the message to the ewoc... + (let ((node + (ewoc-enter-last jabber-chat-ewoc (list (if error-p :error :foreign) xml-data :time (current-time))))) + (jabber-maybe-print-rare-time node)) - ;; ...and call alert hooks. - (dolist (hook '(jabber-message-hooks jabber-alert-message-hooks)) - (run-hook-with-args hook - from (current-buffer) body-text - (funcall jabber-alert-message-function - from (current-buffer) body-text))))))))) + ;; ...and call alert hooks. + (dolist (hook '(jabber-message-hooks jabber-alert-message-hooks)) + (run-hook-with-args hook + from (current-buffer) body-text + (funcall jabber-alert-message-function + from (current-buffer) body-text)))))))) (defun jabber-chat-send (jc body) "Send BODY through connection JC, and display it in chat buffer." @@ -691,7 +660,7 @@ Returns the chat buffer." (jabber-read-account nil jid))) (list account jid current-prefix-arg))) - (let ((buffer (jabber-chat-create-buffer jc jid nil))) + (let ((buffer (jabber-chat-create-buffer jc jid))) (if other-window (switch-to-buffer-other-window buffer) (switch-to-buffer buffer)))) diff --git a/jabber-history.el b/jabber-history.el index 9df6adb..a1e8250 100644 --- a/jabber-history.el +++ b/jabber-history.el @@ -33,17 +33,13 @@ (require 'jabber-core) (require 'jabber-util) -(require 'jabber-mam) (defgroup jabber-history nil "Customization options for Emacs Jabber history files." :group 'jabber) (defcustom jabber-history-enabled nil - "Non-nil means message logging is enabled. -When this variable and `jabber-history-mam' are both non-nil, -messages are logged to files but history requests are handled by -the MAM module (see `jabber-mam')." + "Non-nil means message logging is enabled." :type 'boolean :group 'jabber-history) @@ -53,12 +49,6 @@ Default is nil, cause MUC logging may be i/o-intensive." :type 'boolean :group 'jabber-history) -(defcustom jabber-history-mam nil - "Non-nil means message history is requested from the server. -Requires server support for XEP-0313 (Message Archive Management)." - :type 'boolean - :group 'jabber-history) - (defcustom jabber-history-dir (locate-user-emacs-file "jabber-history" ".emacs-jabber") "Base directory where per-contact history files are stored. @@ -200,33 +190,6 @@ in the message history.") (error (message "Unable to write history: %s" (error-message-string e))))))) -(defun jabber-history-query-wrapper (start-time - end-time - number - direction - jid - &optional skip-first-p) - "Get message history from file or server. -If using file history (`jabber-history-mam' is nil), the `jabber-history-query' -function is called, otherwise message history is requested from the server (XMPP -XEP-0313) via the `jabber-mam-query' function. - -When SKIP-FIRST-P is non-nil the last message (most recent) -returned by the request is dropped." - (if jabber-history-mam - (let* ((jc jabber-buffer-connection) - (jabber-chat-ewoc (ewoc-create #'jabber-chat-pp nil nil t)) - (jid-me (jabber-connection-bare-jid jc)) - (mam-messages - (jabber-mam-query jc jid-me jid start-time end-time - number direction))) - (if skip-first-p (nbutlast mam-messages 1) mam-messages)) - (let ((jid-regexp (concat "^" (regexp-quote - (jabber-jid-user jid)) "\\(/.*\\)?$")) - (history-file (jabber-history-filename jid))) - (jabber-history-query - start-time end-time number direction jid-regexp history-file)))) - (defun jabber-history-query (start-time end-time number @@ -311,25 +274,21 @@ of the log file." :group 'jabber :type 'integer) -(defun jabber-history-backlog (jid &optional before skip-first-p) +(defun jabber-history-backlog (jid &optional before) "Fetch context from previous chats with JID. Return a list of history entries (vectors), limited by `jabber-backlog-days' and `jabber-backlog-number'. If BEFORE is non-nil, it should be a float-time after which no entries will be fetched. `jabber-backlog-days' still -applies, though. -When SKIP-FIRST-P is non-nil and history is handled by the -server (XMPP MAM), the most recent message is skipped (this -prevents duplicates when a message is received and the archive is -interrogated)." - (jabber-history-query-wrapper +applies, though." + (jabber-history-query (and jabber-backlog-days (- (jabber-float-time) (* jabber-backlog-days 86400.0))) before jabber-backlog-number t ; both incoming and outgoing - jid - skip-first-p)) + (concat "^" (regexp-quote (jabber-jid-user jid)) "\\(/.*\\)?$") + (jabber-history-filename jid))) (defun jabber-history-move-to-per-user () "Migrate global history to per-user files." diff --git a/jabber-mam.el b/jabber-mam.el deleted file mode 100644 index 6089192..0000000 --- a/jabber-mam.el +++ /dev/null @@ -1,245 +0,0 @@ -;; jabber-mam.el - XEP-0313 Message Archive Management - -;; Copyright (C) 2017 - Thibault Marin - thibault.marin@gmx.com - -;; This file is a part of jabber.el. - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program; if not, write to the Free Software -;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - -;;; Commentary: - -;; Provides an interface to server message archives following XEP-0313 (message -;; archive management--MAM). To use, set `jabber-history-mam' to a non-nil -;; value. This requires server support for XEP-0313 -;; (http://xmpp.org/extensions/xep-0313.html) and proper configuration. In -;; particular, the archiving behavior can be configured to select which messages -;; are stored. User preferences can be set by server requests -;; (http://xmpp.org/extensions/xep-0313.html#prefs). - - -;;; Code: - -(require 'jabber-iq) - -(defcustom jabber-mam-namespace "urn:xmpp:mam:0" - "XMPP namespace for XEP-0313 request. -This can be determined by sending a request to the server as -described in http://xmpp.org/extensions/xep-0313.html#support." - :type 'string - :group 'jabber-history) - -(defvar jabber-mam-results nil - "Buffer receiving the archived messages from the server.") - -(defvar jabber-mam-done nil - "Flag raised when results paged over multiple sets have been processed.") - -(defvar jabber-mam-lock nil - "Synchronization variable to return MAM results synchronously.") - -(defun jabber-mam-make-base-query (jid jid-with) - "Build basic query requesting messages between JID and JID-WITH." - `(x ((xmlns . "jabber:x:data") - (type . "submit")) - (field ((var . "FORM_TYPE") - (type . "hidden")) - (value () ,jabber-mam-namespace)) - (field ((var . "id")) - (value () ,jid)) - (field ((var . "with")) - (value () ,jid-with)))) - -(defun jabber-mam-make-query (jid jid-with start-time end-time number after) - "Build request for server requesting archived messages. -Request messages between JID and JID-WITH between START-TIME and END-TIME -limiting to NUMBER results. AFTER is used when paging through multiple result -sets: it contains the ID (returned by the server) for the last message in each -result set." - (let* ((xxmlns (jabber-mam-make-base-query jid jid-with)) - (query `(query ((xmlns . ,jabber-mam-namespace))))) - (when start-time - (add-to-list 'xxmlns `(field ((var . "start")) - (value (), (jabber-encode-time start-time))) - t)) - (when end-time - ;; End time is offset by 1 second to avoid duplicate messages - (add-to-list 'xxmlns `(field ((var . "end")) - (value (), (jabber-encode-time - (- end-time 1)))) - t)) - (add-to-list 'query xxmlns t) - (when (or number after) - (let ((setxmlns '(set ((xmlns . "http://jabber.org/protocol/rsm"))))) - (when number - ;; Limit number of results - (add-to-list 'setxmlns `(max () ,(format "%d" number)) t) - (add-to-list 'setxmlns '(before ()) t)) - (when after - ;; Page through results (XMPP Result Set Management) - (add-to-list 'setxmlns `(after () ,after) t)) - (add-to-list 'query setxmlns t))) - query)) - -(defun jabber-mam-process-entry (mam-result) - "Extract message information from MAM-RESULT and add to results list. -The output message information is stored in `jabber-mam-results' -in the same format as the one used by the file archive. The -message is dropped if the function fails to fully extract the -message information (timestamp, from/to, body)." - (let* ((mam-fwd (car (jabber-xml-get-children mam-result 'forwarded))) - ;; Get tag - (mam-msg (when (jabber-xml-get-children mam-fwd 'message) - (car (jabber-xml-get-children mam-fwd 'message)))) - ;; Get timestamp - (mam-stamp (when (jabber-xml-get-children mam-fwd 'delay) - (jabber-xml-get-attribute - (car (jabber-xml-get-children mam-fwd 'delay)) 'stamp))) - ;; Get message body - (mam-msg-body - (when (and mam-msg (jabber-xml-get-children mam-msg 'body)) - (car (jabber-xml-get-children mam-msg 'body)))) - ;; Render message body - (mam-msg-body-txt - (when mam-msg-body - (substring (format "%s" (cdr (cdr mam-msg-body))) 1 -1))) - ;; Get tag - (mam-msg-from - (when mam-msg - (let ((mam-msg-from-t (jabber-jid-user (jabber-xml-get-attribute - mam-msg 'from)))) - (if (string= mam-msg-from-t mam-jid-me) "me" - mam-msg-from-t)))) - ;; Get tag - (mam-msg-to - (when mam-msg - (let ((mam-msg-to-t (jabber-jid-user (jabber-xml-get-attribute - mam-msg 'to)))) - (if (string= mam-msg-to-t mam-jid-me) "me" - mam-msg-to-t)))) - ;; Get message direction (from "me" or to "me") - (mam-msg-dir (cond ((string= mam-msg-from "me") "out") - ((string= mam-msg-to "me") "in") - (t "me")))) - (when (and mam-stamp mam-msg-dir mam-msg-from mam-msg-to mam-msg-body-txt) - ;; Push to results list - (push (vector - mam-stamp mam-msg-dir mam-msg-from mam-msg-to mam-msg-body-txt) - jabber-mam-results)))) - -(defun jabber-mam-process-fin (xml-data) - "Process final server response from XML-DATA and determine the next action. -This function handles the server response corresponding to the -end of a result set. If the tag is found, then no -subsequent query is required (`jabber-mam-done' is set to t). If -the result set is not complete, the tag is stored (in -`jabber-mam-last-id') and used to initialize a continuation -request. - -In both cases, the lock (`jabber-mam-lock') is released for the caller -\('jabber-mam-query') to continue." - (let* ((fin (jabber-xml-get-children xml-data 'fin)) - (complete (jabber-xml-get-attribute (car fin) 'complete)) - (set (jabber-xml-get-children (car fin) 'set)) - (last - (when set (jabber-xml-get-children (car set) 'last))) - (last-id (when last (cadr (cdr (car last)))))) - (if (and (or (not complete) (not (string= complete "true"))) last-id) - ;; Result set is not complete, next request should start with - ;; `last-id' - (setq jabber-mam-last-id last-id) - ;; Result set is complete - (setq jabber-mam-done t)) - ;; Release lock - (setq jabber-mam-lock t) - nil)) - -(add-to-list 'jabber-message-chain 'jabber-handle-incoming-mam-message) -(defun jabber-handle-incoming-mam-message (jc xml-data) - "Manage results from MAM request with connection JC and content XML-DATA. -The server returns message objects for each message using XMPP -Result Set Management. Paging through results is performed in the -`jabber-mam-query' function. Results are store in `jabber-mam-results'." - (cond ((jabber-xml-get-children xml-data 'result) - (let ((mam-jid-me (jabber-jid-user (jabber-xml-get-attribute - xml-data 'to))) - (mam-result (car (jabber-xml-get-children xml-data 'result)))) - (when (jabber-xml-get-children mam-result 'forwarded) - ;; Extract message information (direction, timestamp, body), push - ;; to results list - (jabber-mam-process-entry mam-result)))) - ((jabber-xml-get-children xml-data 'fin) - ;; End of set, determine if a subsequent query is required (if the - ;; result is not complete). - ;; Extract "complete" attribute from tag and id - (jabber-mam-process-fin xml-data)) - (t nil))) - -(defun jabber-mam-report-success (jc xml-data context) - "IQ callback reporting success or failure of the operation. -CONTEXT is a string describing the action. -\"CONTEXT succeeded\" or \"CONTEXT failed: REASON\" is displayed in -the echo area." - (let ((type (jabber-xml-get-attribute xml-data 'type))) - (message - (concat context - (if (string= type "result") - " succeeded" - (concat - " failed: " - (let ((the-error (jabber-iq-error xml-data))) - (if the-error - (jabber-parse-error the-error) - "No error message given")))))) - (when (not (string= type "result")) - (setq jabber-mam-done t - jabber-mam-lock t)))) - -(defun jabber-mam-query (jc jid-me jid-with start-time end-time number - direction) - "Build and send MAM query to server. -JC is jabber connection. Messages between users with JIDs JID-ME JID and -JID-WITH JID with timestamp between START-TIME and END-TIME are retrieved. The -set of results is limited to NUMBER messages. DIRECTION is either \"in\" or -\"out\", or t for no limit on direction (this parameter is currently ignored)." - ;; Initialize output and lock - (setq jabber-mam-results (list)) - (setq jabber-mam-done nil) - (setq jabber-mam-last-id nil) - (let ((number-left (if (integerp number) number nil))) - (while (not jabber-mam-done) - (let ((mam-query (jabber-mam-make-query - jid-me jid-with - start-time - end-time - number-left - jabber-mam-last-id))) - ;;(message "MAM request: [%s]" (jabber-sexp2xml mam-query)) - (setq jabber-mam-lock nil) - (jabber-send-iq jc nil "set" mam-query - #'jabber-mam-report-success "MAM request" - #'jabber-mam-report-success "MAM request") - ;; Wait for results - (while (not jabber-mam-lock) - (sit-for 1)) - ;; Update counter for remaining messages - (when (integerp number) - (setq number-left (- number (length jabber-mam-results))) - (setq jabber-mam-done (or jabber-mam-done - (<= number-left 0))))))) - ;;(message "MAM got %d messages" (length jabber-mam-results)) - (nreverse jabber-mam-results)) - -(provide 'jabber-mam) -;;; jabber-mam.el ends here diff --git a/jabber-presence.el b/jabber-presence.el index 20b94a4..5f4573d 100644 --- a/jabber-presence.el +++ b/jabber-presence.el @@ -236,7 +236,7 @@ CLOSURE-DATA should be 'initial if initial roster push, nil otherwise." (defun jabber-process-subscription-request (jc from presence-status) "process an incoming subscription request" - (with-current-buffer (jabber-chat-create-buffer jc from nil) + (with-current-buffer (jabber-chat-create-buffer jc from) (ewoc-enter-last jabber-chat-ewoc (list :subscription-request presence-status :time (current-time))) (dolist (hook '(jabber-presence-hooks jabber-alert-presence-hooks)) diff --git a/jabber-util.el b/jabber-util.el index 5090ab0..3e97d80 100644 --- a/jabber-util.el +++ b/jabber-util.el @@ -486,15 +486,10 @@ TIME is in a format accepted by `format-time-string'." (hour (string-to-number (substring time 11 13))) (minute (string-to-number (substring time 14 16))) (second (string-to-number (substring time 17 19))) - (timezone (if (eq (aref time 19) ?.) - ;; fractions are optional - (let ((timezone (cadr - (split-string (substring time 20) - "[-+Z]")))) - (if (string= "" timezone) - "Z" - timezone)) - (substring time 19)))) + ;; fractions are optional + (fraction (if (eq (aref time 19) ?.) + (string-to-number (substring time 20 23)))) + (timezone (substring time (if fraction 23 19)))) ;; timezone is either Z (UTC) or [+-]HH:MM (let ((timezone-seconds (if (string= timezone "Z") diff --git a/jabber.el b/jabber.el index e1c0717..607b726 100644 --- a/jabber.el +++ b/jabber.el @@ -143,7 +143,6 @@ configure a Google Talk account like this: (require 'jabber-autoaway) (require 'jabber-time) (require 'jabber-truncate) -(require 'jabber-carbons) (require 'jabber-ft-client) (require 'jabber-ft-server)