From 69d6122858f036958323c50f81423389b0f91d69 Mon Sep 17 00:00:00 2001 From: wgreenhouse Date: Tue, 16 Mar 2021 20:16:52 -0400 Subject: [PATCH] Deprecate XEP-0065, XEP-0095, and XEP-0096 support. --- deprecated.org | 1160 ++++++++++++++++++++++++++++++++++++++++++++++++ jabber.el | 954 --------------------------------------- jabber.org | 1152 ----------------------------------------------- 3 files changed, 1160 insertions(+), 2106 deletions(-) create mode 100644 deprecated.org diff --git a/deprecated.org b/deprecated.org new file mode 100644 index 0000000..1182785 --- /dev/null +++ b/deprecated.org @@ -0,0 +1,1160 @@ +#+TITLE: Deprecated Features +#+TODO: TODO WIP EXTEND CLEANUP FIXME REVIEW | +#+PROPERTY: header-args :tangle yes + +Anything listed here is no longer maintained, will not be tangled and compiled at build time, and may lose compatibility with existing features. + +Here there be dragons. + +*** Stream Initiation (SI) ([[https://xmpp.org/extensions/xep-0095.html][XEP-0095]]) :xep_deprecated: +**** common +:PROPERTIES: +:file: jabber-si-common.el +:END: + +***** jabber-si-stream-methods :variable: +#+BEGIN_SRC emacs-lisp +(defvar jabber-si-stream-methods nil + "Supported SI stream methods. + +Each entry is a list, containing: + * The namespace URI of the stream method + * Active initiation function + * Passive initiation function + +The active initiation function should initiate the connection, +while the passive initiation function should wait for an incoming +connection. Both functions take the same arguments: + + * JID of peer + * SID + * \"connection established\" function + +The \"connection established\" function should be called when the +stream has been established and data can be transferred. It is part +of the profile, and takes the following arguments: + + * JID of peer + * SID + * Either: + - \"send data\" function, with one string argument + - an error message, when connection failed + +It returns an \"incoming data\" function. + +The \"incoming data\" function should be called when data arrives on +the stream. It takes these arguments: + + * JID of peer + * SID + * A string containing the received data, or nil on EOF + +If it returns nil, the stream should be closed.") + +#+END_SRC +**** client +:PROPERTIES: +:file: jabber-si-client.el +:END: + +***** jabber-si-initiate :function: +#+BEGIN_SRC emacs-lisp +(defun jabber-si-initiate (jc jid profile-namespace profile-data profile-function &optional mime-type) + "Try to initiate a stream to JID. +PROFILE-NAMESPACE is, well, the namespace of the profile to use. +PROFILE-DATA is the XML data to send within the SI request. +PROFILE-FUNCTION is the \"connection established\" function. +See `jabber-si-stream-methods'. +MIME-TYPE is the MIME type to specify. +Returns the SID." + + (let ((sid (apply 'format "emacs-sid-%d.%d.%d" (current-time)))) + (jabber-send-iq jc jid "set" + `(si ((xmlns . "http://jabber.org/protocol/si") + (id . ,sid) + ,(if mime-type + (cons 'mime-type mime-type)) + (profile . ,profile-namespace)) + ,profile-data + (feature ((xmlns . "http://jabber.org/protocol/feature-neg")) + ,(jabber-fn-encode (list + (cons "stream-method" + (mapcar 'car jabber-si-stream-methods))) + 'request))) + #'jabber-si-initiate-process (cons profile-function sid) + ;; XXX: use other function here? + #'jabber-report-success "Stream initiation") + sid)) + +#+END_SRC +***** jabber-si-initiate-process :function: +#+BEGIN_SRC emacs-lisp +(defun jabber-si-initiate-process (jc xml-data closure-data) + "Act on response to our SI query." + + (let* ((profile-function (car closure-data)) + (sid (cdr closure-data)) + (from (jabber-xml-get-attribute xml-data 'from)) + (query (jabber-iq-query xml-data)) + (feature-node (car (jabber-xml-get-children query 'feature))) + (feature-alist (jabber-fn-parse feature-node 'response)) + (chosen-method (cadr (assoc "stream-method" feature-alist))) + (method-data (assoc chosen-method jabber-si-stream-methods))) + ;; Our work is done. Hand it over to the stream method. + (let ((stream-negotiate (nth 1 method-data))) + (funcall stream-negotiate jc from sid profile-function)))) + +#+END_SRC +**** server +:PROPERTIES: +:file: jabber-si-server.el +:END: + +#+BEGIN_SRC emacs-lisp +(jabber-disco-advertise-feature "http://jabber.org/protocol/si") + +#+END_SRC +***** jabber-si-profiles :variable: +Now, stream methods push data to profiles. It could be the other way around; not sure which is better. + +#+BEGIN_SRC emacs-lisp +(defvar jabber-si-profiles nil + "Supported SI profiles. + +Each entry is a list, containing: + * The namespace URI of the profile + * Accept function, taking entire IQ stanza, and signalling a 'forbidden' + error if request is declined; returning an XML node to return in + response, or nil of none needed + * \"Connection established\" function. See `jabber-si-stream-methods'.") + +#+END_SRC +***** jabber-si-process :function: +#+BEGIN_SRC emacs-lisp +(add-to-list 'jabber-iq-set-xmlns-alist + (cons "http://jabber.org/protocol/si" 'jabber-si-process)) +(defun jabber-si-process (jc xml-data) + + (let* ((to (jabber-xml-get-attribute xml-data 'from)) + (id (jabber-xml-get-attribute xml-data 'id)) + (query (jabber-iq-query xml-data)) + (profile (jabber-xml-get-attribute query 'profile)) + (si-id (jabber-xml-get-attribute query 'id)) + (feature (car (jabber-xml-get-children query 'feature)))) + (message "Receiving SI with profile '%s'" profile) + + (let (stream-method + ;; Find profile + (profile-data (assoc profile jabber-si-profiles))) + ;; Now, feature negotiation for stream type (errors + ;; don't match XEP-0095, so convert) + (condition-case err + (setq stream-method (jabber-fn-intersection + (jabber-fn-parse feature 'request) + (list (cons "stream-method" (mapcar 'car jabber-si-stream-methods))))) + (jabber-error + (jabber-signal-error "cancel" 'bad-request nil + '((no-valid-streams ((xmlns . "http://jabber.org/protocol/si"))))))) + (unless profile-data + ;; profile not understood + (jabber-signal-error "cancel" 'bad-request nil + '((bad-profile ((xmlns . "http://jabber.org/protocol/si")))))) + (let* ((profile-accept-function (nth 1 profile-data)) + ;; accept-function might throw a "forbidden" error + ;; on user cancel + (profile-response (funcall profile-accept-function jc xml-data)) + (profile-connected-function (nth 2 profile-data)) + (stream-method-id (nth 1 (assoc "stream-method" stream-method))) + (stream-data (assoc stream-method-id jabber-si-stream-methods)) + (stream-accept-function (nth 2 stream-data))) + ;; prepare stream for the transfer + (funcall stream-accept-function jc to si-id profile-connected-function) + ;; return result of feature negotiation of stream type + (jabber-send-iq jc to "result" + `(si ((xmlns . "http://jabber.org/protocol/si")) + ,@profile-response + (feature ((xmlns . "http://jabber.org/protocol/feature-neg")) + ,(jabber-fn-encode stream-method 'response))) + nil nil nil nil + id) + )))) + +#+END_SRC +*** SI File Transfer ([[https://xmpp.org/extensions/xep-0096.html][XEP-0096]]) :xep_deprecated: +**** common +:PROPERTIES: +:file: jabber-ft-common.el +:END: + +***** jabber-ft-md5sum-program :custom:variable: +#+BEGIN_SRC emacs-lisp +(defcustom jabber-ft-md5sum-program (or (when (executable-find "md5") + (list (executable-find "md5") "-n")) + (when (executable-find "md5sum") + (list (executable-find "md5sum")))) + "The program to use to calculate MD5 sums of files. +The first item should be the name of the program, and the remaing +items the arguments. The file name is appended as the last +argument." + :type '(repeat string) + :group 'jabber) + +#+END_SRC +***** jabber-ft-get-md5 :function: +#+BEGIN_SRC emacs-lisp +(defun jabber-ft-get-md5 (file-name) + "Get MD5 sum of FILE-NAME, and return as hex string. +Return nil if no MD5 summing program is available." + (when jabber-ft-md5sum-program + (with-temp-buffer + (apply 'call-process (car jabber-ft-md5sum-program) nil t nil + (append (cdr jabber-ft-md5sum-program) (list file-name))) + ;; Output is "hexsum filename" + (goto-char (point-min)) + (forward-word 1) + (buffer-substring (point-min) (point))))) + +#+END_SRC +**** client +:PROPERTIES: +:file: jabber-ft-client.el +:END: + +#+BEGIN_SRC emacs-lisp +(eval-when-compile (require 'cl)) + +#+END_SRC +***** jabber-ft-send :command: +#+BEGIN_SRC emacs-lisp +(defun jabber-ft-send (jc jid filename desc) + "Attempt to send FILENAME to JID." + (interactive (list (jabber-read-account) + (jabber-read-jid-completing "Send file to: " nil nil nil 'full t) + (read-file-name "Send which file: " nil nil t) + (jabber-read-with-input-method "Description (optional): "))) + (if (zerop (length desc)) (setq desc nil)) + (setq filename (expand-file-name filename)) + (access-file filename "Couldn't open file") + + (let* ((attributes (file-attributes filename)) + (size (nth 7 attributes)) + (date (nth 5 attributes)) + (hash (jabber-ft-get-md5 filename))) + (jabber-si-initiate jc jid "http://jabber.org/protocol/si/profile/file-transfer" + `(file ((xmlns . "http://jabber.org/protocol/si/profile/file-transfer") + (name . ,(file-name-nondirectory filename)) + (size . ,size) + (date . ,(jabber-encode-time date)) + ,@(when hash + (list (cons 'hash hash)))) + (desc () ,desc)) + (lexical-let ((filename filename)) + (lambda (jc jid sid send-data-function) + (jabber-ft-do-send + jid sid send-data-function filename)))))) + +#+END_SRC +***** jabber-ft-do-send :function: +#+BEGIN_SRC emacs-lisp +(defun jabber-ft-do-send (jid sid send-data-function filename) + (if (stringp send-data-function) + (message "File sending failed: %s" send-data-function) + (with-temp-buffer + (insert-file-contents-literally filename) + + ;; Ever heard of buffering? + (funcall send-data-function (buffer-string)) + (message "File transfer completed"))) + ;; File transfer is monodirectional, so ignore received data. + #'ignore) + +#+END_SRC +**** server +:PROPERTIES: +:file: jabber-ft-server.el +:END: + +***** jabber-ft-sessions :variable: +#+BEGIN_SRC emacs-lisp +(defvar jabber-ft-sessions nil + "Alist, where keys are (sid jid), and values are buffers of the files.") + +#+END_SRC +***** jabber-ft-size :variable: +#+BEGIN_SRC emacs-lisp +(defvar jabber-ft-size nil + "Size of the file that is being downloaded") + +#+END_SRC +***** jabber-ft-md5-hash :variable: +#+BEGIN_SRC emacs-lisp +(defvar jabber-ft-md5-hash nil + "MD5 hash of the file that is being downloaded") + +#+END_SRC + +#+BEGIN_SRC emacs-lisp +(jabber-disco-advertise-feature "http://jabber.org/protocol/si/profile/file-transfer") + +#+END_SRC + +#+BEGIN_SRC emacs-lisp +(add-to-list 'jabber-si-profiles + (list "http://jabber.org/protocol/si/profile/file-transfer" + 'jabber-ft-accept + 'jabber-ft-server-connected)) + +#+END_SRC +***** jabber-ft-accept :function: +#+BEGIN_SRC emacs-lisp +(defun jabber-ft-accept (jc xml-data) + "Receive IQ stanza containing file transfer request, ask user" + (let* ((from (jabber-xml-get-attribute xml-data 'from)) + (query (jabber-iq-query xml-data)) + (si-id (jabber-xml-get-attribute query 'id)) + ;; TODO: check namespace + (file (car (jabber-xml-get-children query 'file))) + (name (jabber-xml-get-attribute file 'name)) + (size (jabber-xml-get-attribute file 'size)) + (date (jabber-xml-get-attribute file 'date)) + (md5-hash (jabber-xml-get-attribute file 'hash)) + (desc (car (jabber-xml-node-children + (car (jabber-xml-get-children file 'desc))))) + (range (car (jabber-xml-get-children file 'range)))) + (unless (and name size) + ;; both name and size must be present + (jabber-signal-error "modify" 'bad-request)) + + (let ((question (format + "%s is sending you the file %s (%s bytes).%s Accept? " + (jabber-jid-displayname from) + name + size + (if (not (zerop (length desc))) + (concat " Description: '" desc "'") + "")))) + (unless (yes-or-no-p question) + (jabber-signal-error "cancel" 'forbidden))) + + ;; default is to save with given name, in current directory. + ;; maybe that's bad; maybe should be customizable. + (let* ((file-name (read-file-name "Download to: " nil nil nil name)) + (buffer (create-file-buffer file-name))) + (message "Starting download of %s..." (file-name-nondirectory file-name)) + (with-current-buffer buffer + (kill-all-local-variables) + (setq buffer-file-coding-system 'binary) + ;; For Emacs, switch buffer to unibyte _before_ anything goes into it, + ;; otherwise binary files are corrupted. For XEmacs, it isn't needed, + ;; and it also doesn't have set-buffer-multibyte. + (if (fboundp 'set-buffer-multibyte) + (set-buffer-multibyte nil)) + (set-visited-file-name file-name t) + (set (make-local-variable 'jabber-ft-size) + (string-to-number size)) + (set (make-local-variable 'jabber-ft-md5-hash) + md5-hash)) + (add-to-list 'jabber-ft-sessions + (cons (list si-id from) buffer))) + + ;; to support range, return something sensible here + nil)) + +#+END_SRC +***** jabber-ft-server-connected :function: +#+BEGIN_SRC emacs-lisp +(defun jabber-ft-server-connected (jc jid sid send-data-function) + ;; We don't really care about the send-data-function. But if it's + ;; a string, it means that we have no connection. + (if (stringp send-data-function) + (message "File receiving failed: %s" send-data-function) + ;; On success, we just return our data receiving function. + 'jabber-ft-data)) + +#+END_SRC +***** jabber-ft-data :function: +#+BEGIN_SRC emacs-lisp +(defun jabber-ft-data (jc jid sid data) + "Receive chunk of transferred file." + (let ((buffer (cdr (assoc (list sid jid) jabber-ft-sessions)))) + (with-current-buffer buffer + ;; If data is nil, there is no more data. + ;; But maybe the remote entity doesn't close the stream - + ;; then we have to keep track of file size to know when to stop. + ;; Return value is whether to keep connection open. + (when data + (insert data)) + (if (and data (< (buffer-size) jabber-ft-size)) + t + (basic-save-buffer) + (if (and jabber-ft-md5-hash + (let ((file-hash (jabber-ft-get-md5 buffer-file-name))) + (and file-hash + (not (string= file-hash jabber-ft-md5-hash))))) + ;; hash mismatch! + (progn + (message "%s downloaded - CHECKSUM MISMATCH!" + (file-name-nondirectory buffer-file-name)) + (sleep-for 5)) + ;; all is fine + (message "%s downloaded" (file-name-nondirectory buffer-file-name))) + (kill-buffer buffer) + nil)))) + +#+END_SRC +*** SOCKS5 Bytestreams ([[https://xmpp.org/extensions/xep-0065.html][XEP-0065]]) +:PROPERTIES: +:file: jabber-socks5.el +:END: + +#+BEGIN_SRC emacs-lisp +(eval-when-compile (require 'cl)) + +#+END_SRC +**** jabber-socks5-pending-sessions :variable: +#+BEGIN_SRC emacs-lisp +(defvar jabber-socks5-pending-sessions nil + "List of pending sessions. + +Each entry is a list, containing: + * Stream ID + * Full JID of initiator + * State machine managing the session") + +#+END_SRC +**** jabber-socks5-active-sessions :variable: +#+BEGIN_SRC emacs-lisp +(defvar jabber-socks5-active-sessions nil + "List of active sessions. + +Each entry is a list, containing: + * Network connection + * Stream ID + * Full JID of initiator + * Profile data function") + +#+END_SRC +**** jabber-socks5-proxies :custom:variable: +#+BEGIN_SRC emacs-lisp +(defcustom jabber-socks5-proxies nil + "JIDs of XEP-0065 proxies to use for file transfer. +Put preferred ones first." + :type '(repeat string) + :group 'jabber +; :set 'jabber-socks5-set-proxies) + ) + +#+END_SRC +**** jabber-socks5-proxies-data :variable: +#+BEGIN_SRC emacs-lisp +(defvar jabber-socks5-proxies-data nil + "Alist containing information about proxies. +Keys of the alist are strings, the JIDs of the proxies. +Values are \"streamhost\" XML nodes.") + +#+END_SRC + +#+BEGIN_SRC emacs-lisp +(jabber-disco-advertise-feature "http://jabber.org/protocol/bytestreams") + +#+END_SRC + +#+BEGIN_SRC emacs-lisp +(add-to-list 'jabber-si-stream-methods + (list "http://jabber.org/protocol/bytestreams" + 'jabber-socks5-client-1 + 'jabber-socks5-accept)) + +#+END_SRC +**** jabber-socks5-set-proxies :function: +#+BEGIN_SRC emacs-lisp +(defun jabber-socks5-set-proxies (symbol value) + "Set `jabber-socks5-proxies' and query proxies. +This is the set function of `jabber-socks5-proxies-data'." + (set-default symbol value) + (when jabber-connections + (jabber-socks5-query-all-proxies))) + +#+END_SRC +**** jabber-socks5-query-all-proxies :command: +#+BEGIN_SRC emacs-lisp +(defun jabber-socks5-query-all-proxies (jc &optional callback) + "Ask all proxies in `jabber-socks5-proxies' for connection information. +If CALLBACK is non-nil, call it with no arguments when all +proxies have answered." + (interactive (list (jabber-read-account))) + (setq jabber-socks5-proxies-data nil) + (dolist (proxy jabber-socks5-proxies) + (jabber-socks5-query-proxy jc proxy callback))) + +#+END_SRC +**** jabber-socks5-query-proxy :function: +#+BEGIN_SRC emacs-lisp +(defun jabber-socks5-query-proxy (jc jid &optional callback) + "Query the SOCKS5 proxy specified by JID for IP and port number." + (jabber-send-iq jc jid "get" + '(query ((xmlns . "http://jabber.org/protocol/bytestreams"))) + #'jabber-socks5-process-proxy-response (list callback t) + #'jabber-socks5-process-proxy-response (list callback nil))) + +#+END_SRC +**** jabber-socks5-process-proxy-response :function: +#+BEGIN_SRC emacs-lisp +(defun jabber-socks5-process-proxy-response (jc xml-data closure-data) + "Process response from proxy query." + (let* ((query (jabber-iq-query xml-data)) + (from (jabber-xml-get-attribute xml-data 'from)) + (streamhosts (jabber-xml-get-children query 'streamhost))) + + (let ((existing-entry (assoc from jabber-socks5-proxies-data))) + (when existing-entry + (setq jabber-socks5-proxies-data + (delq existing-entry jabber-socks5-proxies-data)))) + + (destructuring-bind (callback successp) closure-data + (when successp + (setq jabber-socks5-proxies-data + (cons (cons from streamhosts) + jabber-socks5-proxies-data))) + (message "%s from %s. %d of %d proxies have answered." + (if successp "Response" "Error") from + (length jabber-socks5-proxies-data) (length jabber-socks5-proxies)) + (when (and callback (= (length jabber-socks5-proxies-data) (length jabber-socks5-proxies))) + (funcall callback))))) + +#+END_SRC + +#+BEGIN_SRC emacs-lisp +(define-state-machine jabber-socks5 + :start ((jc jid sid profile-function role) + "Start XEP-0065 bytestream with JID. +SID is the session ID used. +PROFILE-FUNCTION is the function to call upon success. See `jabber-si-stream-methods'. +ROLE is either :initiator or :target. The initiator sends an IQ +set; the target waits for one." + (let ((new-state-data (list :jc jc + :jid jid + :sid sid + :profile-function profile-function + :role role)) + (new-state + ;; We want information about proxies; it might be needed in + ;; various situations. + (cond + ((null jabber-socks5-proxies) + ;; We know no proxy addresses. Try to find them by disco. + 'seek-proxies) + ((null jabber-socks5-proxies-data) + ;; We need to query the proxies for addresses. + 'query-proxies) + ;; So, we have our proxies. + (t + 'initiate)))) + (list new-state new-state-data nil)))) + +#+END_SRC +**** jabber-socks5-accept :function: +#+BEGIN_SRC emacs-lisp +(defun jabber-socks5-accept (jc jid sid profile-function) + "Remember that we are waiting for connection from JID, with stream id SID" + ;; asking the user for permission is done in the profile + (add-to-list 'jabber-socks5-pending-sessions + (list sid jid (start-jabber-socks5 jc jid sid profile-function :target)))) + +#+END_SRC + +#+BEGIN_SRC emacs-lisp +(define-enter-state jabber-socks5 seek-proxies (fsm state-data) + ;; Look for items at the server. + (let* ((jc (plist-get state-data :jc)) + (server (jabber-jid-server (jabber-connection-jid jc)))) + (jabber-disco-get-items jc + server + nil + (lambda (jc fsm result) + (fsm-send-sync fsm (cons :items result))) + fsm)) + ;; Spend no more than five seconds looking for a proxy. + (list state-data 5)) + +#+END_SRC + +#+BEGIN_SRC emacs-lisp +(define-state jabber-socks5 seek-proxies (fsm state-data event callback) + "Collect disco results, looking for a bytestreams proxy." + ;; We put the number of outstanding requests as :remaining-info in + ;; the state-data plist. + (cond + ;; We're not ready to handle the IQ stanza yet + ((eq (car-safe event) :iq) + :defer) + + ;; Got list of items at the server. + ((eq (car-safe event) :items) + (dolist (entry (cdr event)) + ;; Each entry is ["name" "jid" "node"]. We send a disco info + ;; request to everything without a node. + (when (null (aref entry 2)) + (lexical-let ((jid (aref entry 1))) + (jabber-disco-get-info + (plist-get state-data :jc) + jid nil + (lambda (jc fsm result) + (fsm-send-sync fsm (list :info jid result))) + fsm)))) + ;; Remember number of requests sent. But if none, we just go on. + (if (cdr event) + (list 'seek-proxies (plist-put state-data :remaining-info (length (cdr event))) :keep) + (list 'initiate state-data nil))) + + ;; Got disco info from an item at the server. + ((eq (car-safe event) :info) + (fsm-debug-output "got disco event") + ;; Count the response. + (plist-put state-data :remaining-info (1- (plist-get state-data :remaining-info))) + (unless (eq (first (third event)) 'error) + (let ((identities (first (third event)))) + ;; Is it a bytestream proxy? + (when (dolist (identity identities) + (when (and (string= (aref identity 1) "proxy") + (string= (aref identity 2) "bytestreams")) + (return t))) + ;; Yes, it is. Add it to the list. + (push (second event) jabber-socks5-proxies)))) + + ;; Wait for more responses, if any are to be expected. + (if (zerop (plist-get state-data :remaining-info)) + ;; No more... go on to querying the proxies. + (list 'query-proxies state-data nil) + ;; We expect more responses... + (list 'seek-proxies state-data :keep))) + + ((eq event :timeout) + ;; We can't wait anymore... + (list 'query-proxies state-data nil)))) + +#+END_SRC + +#+BEGIN_SRC emacs-lisp +(define-enter-state jabber-socks5 query-proxies (fsm state-data) + (jabber-socks5-query-all-proxies + (plist-get state-data :jc) + (lexical-let ((fsm fsm)) + (lambda () (fsm-send-sync fsm :proxies)))) + (list state-data 5)) + +#+END_SRC + +#+BEGIN_SRC emacs-lisp +(define-state jabber-socks5 query-proxies (fsm state-data event callback) + "Query proxies in `jabber-socks5-proxies'." + (cond + ;; Can't handle the iq stanza yet... + ((eq (car-safe event) :iq) + :defer) + + ((eq (car-safe event) :info) + ;; stray event... do nothing + (list 'query-proxies state-data :keep)) + + ;; Got response/error from all proxies, or timeout + ((memq event '(:proxies :timeout)) + (list 'initiate state-data nil)))) + +#+END_SRC + +#+BEGIN_SRC emacs-lisp +(define-enter-state jabber-socks5 initiate (fsm state-data) + ;; Sort the alist jabber-socks5-proxies-data such that the + ;; keys are in the same order as in jabber-socks5-proxies. + (setq jabber-socks5-proxies-data + (sort jabber-socks5-proxies-data + #'(lambda (a b) + (> (length (member (car a) jabber-socks5-proxies)) + (length (member (car b) jabber-socks5-proxies)))))) + + ;; If we're the initiator, send initiation stanza. + (when (eq (plist-get state-data :role) :initiator) + ;; This is where initiation of server sockets would go + + (jabber-send-iq + (plist-get state-data :jc) + (plist-get state-data :jid) "set" + `(query ((xmlns . "http://jabber.org/protocol/bytestreams") + (sid . ,(plist-get state-data :sid))) + ,@(mapcar + #'(lambda (proxy) + (mapcar + #'(lambda (streamhost) + (list 'streamhost + (list (cons 'jid (jabber-xml-get-attribute streamhost 'jid)) + (cons 'host (jabber-xml-get-attribute streamhost 'host)) + (cons 'port (jabber-xml-get-attribute streamhost 'port))) + ;; (proxy ((xmlns . "http://affinix.com/jabber/stream"))) + )) + (cdr proxy))) + jabber-socks5-proxies-data) + ;; (fast ((xmlns . "http://affinix.com/jabber/stream"))) + ) + (lexical-let ((fsm fsm)) + (lambda (jc xml-data closure-data) + (fsm-send-sync fsm (list :iq xml-data)))) + nil + ;; TODO: error handling + #'jabber-report-success "SOCKS5 negotiation")) + + ;; If we're the target, we just wait for an incoming stanza. + (list state-data nil)) + +#+END_SRC +**** jabber-socks5-process :function: +#+BEGIN_SRC emacs-lisp +(add-to-list 'jabber-iq-set-xmlns-alist + (cons "http://jabber.org/protocol/bytestreams" 'jabber-socks5-process)) +(defun jabber-socks5-process (jc xml-data) + "Accept IQ get for SOCKS5 bytestream" + (let* ((jid (jabber-xml-get-attribute xml-data 'from)) + (id (jabber-xml-get-attribute xml-data 'id)) + (query (jabber-iq-query xml-data)) + (sid (jabber-xml-get-attribute query 'sid)) + (session (dolist (pending-session jabber-socks5-pending-sessions) + (when (and (equal sid (nth 0 pending-session)) + (equal jid (nth 1 pending-session))) + (return pending-session))))) + ;; check that we really are expecting this session + (unless session + (jabber-signal-error "auth" 'not-acceptable)) + + (setq jabber-socks5-pending-sessions (delq session jabber-socks5-pending-sessions)) + (fsm-send-sync (nth 2 session) (list :iq xml-data)) + + ;; find streamhost to connect to +;; (let* ((streamhosts (jabber-xml-get-children query 'streamhost)) +;; (streamhost (dolist (streamhost streamhosts) +;; (let ((connection (jabber-socks5-connect streamhost sid jid (concat jabber-username "@" jabber-server "/" jabber-resource)))) +;; (when connection +;; ;; We select the first streamhost that we are able to connect to. +;; (push (list connection sid jid profile-data-function) +;; jabber-socks5-active-sessions) +;; ;; Now set the filter, for the rest of the output +;; (set-process-filter connection #'jabber-socks5-filter) +;; (set-process-sentinel connection #'jabber-socks5-sentinel) +;; (return streamhost)))))) +;; (unless streamhost +;; (jabber-signal-error "cancel" 'item-not-found)) + +;; ;; tell initiator which streamhost we use +;; (jabber-send-iq jid "result" +;; `(query ((xmlns . "http://jabber.org/protocol/bytestreams")) +;; (streamhost-used ((jid . ,(jabber-xml-get-attribute streamhost 'jid))))) +;; nil nil nil nil id) +;; ;; now, as data is sent, it will be passed to the profile. +;; ) + )) + +#+END_SRC + +#+BEGIN_SRC emacs-lisp +(define-state jabber-socks5 initiate (fsm state-data event callback) + (let* ((jc (plist-get state-data :jc)) + (jc-data (fsm-get-state-data jc)) + (our-jid (concat (plist-get jc-data :username) "@" + (plist-get jc-data :server) "/" + (plist-get jc-data :resource))) + (their-jid (plist-get state-data :jid)) + (initiator-jid (if (eq (plist-get state-data :role) :initiator) our-jid their-jid)) + (target-jid (if (eq (plist-get state-data :role) :initiator) their-jid our-jid))) + (cond + ;; Stray event... + ((memq (car-safe event) '(:proxy :info)) + (list 'initiate state-data :keep)) + + ;; Incoming IQ + ((eq (car-safe event) :iq) + (let ((xml-data (second event))) + ;; This is either type "set" (with a list of streamhosts to + ;; use), or a "result" (indicating the streamhost finally used + ;; by the other party). + (cond + ((string= (jabber-xml-get-attribute xml-data 'type) "set") + ;; A "set" makes sense if we're the initiator and offered + ;; Psi's "fast mode". We don't yet, though, so this is only + ;; for target. + (dolist (streamhost (jabber-xml-get-children (jabber-iq-query xml-data) 'streamhost)) + (jabber-xml-let-attributes + (jid host port) streamhost + ;; This is where we would attempt to support zeroconf + (when (and jid host port) + (start-jabber-socks5-connection + jc initiator-jid target-jid jid + (plist-get state-data :sid) host port fsm)))) + + (list 'wait-for-connection (plist-put state-data :iq-id (jabber-xml-get-attribute xml-data 'id)) 30)) + + ((string= (jabber-xml-get-attribute xml-data 'type) "result") + ;; The other party has decided what streamhost to use. + (let* ((proxy-used (jabber-xml-get-attribute (jabber-xml-path xml-data '(query streamhost-used)) 'jid)) + ;; If JID is our own JID, we have probably already detected + ;; what connection to use. But that is a later problem... + (streamhosts (cdr (assoc proxy-used jabber-socks5-proxies-data)))) + ;; Try to connect to all addresses of this proxy... + (dolist (streamhost streamhosts) + (jabber-xml-let-attributes + (jid host port) streamhost + (when (and jid host port) + (start-jabber-socks5-connection + jc initiator-jid target-jid jid + (plist-get state-data :sid) host port fsm))))) + + (list 'wait-for-connection state-data 30)))))))) + +#+END_SRC + +#+BEGIN_SRC emacs-lisp +(define-state-machine jabber-socks5-connection + :start + ((jc initiator-jid target-jid streamhost-jid sid host port socks5-fsm) + "Connect to a single XEP-0065 streamhost." + (let ((coding-system-for-read 'binary) + (coding-system-for-write 'binary)) + ;; make-network-process, which we really want, for asynchronous + ;; connection and such, was introduced in Emacs 22. + (if (fboundp 'make-network-process) + (let ((connection + (make-network-process + :name "socks5" + :buffer nil + :host host + :service (string-to-number port) + :nowait t + :filter (fsm-make-filter fsm) + :sentinel (fsm-make-sentinel fsm)))) + (list 'wait-for-connection + (list :jc jc + :connection connection + :initiator-jid initiator-jid + :target-jid target-jid + :streamhost-jid streamhost-jid + :sid sid + :socks5-fsm socks5-fsm) + 30)) + ;; So we open a stream, and wait for the connection to succeed. + (condition-case nil + (let ((connection + (open-network-stream "socks5" nil + host (string-to-number port)))) + (set-process-filter connection (fsm-make-filter fsm)) + (set-process-sentinel connection (fsm-make-sentinel fsm)) + (list 'authenticate + (list :jc jc + :connection connection + :initiator-jid initiator-jid + :target-jid target-jid + :streamhost-jid streamhost-jid + :sid sid + :socks5-fsm socks5-fsm) + nil)) + (error (list 'fail '() nil))))))) + +#+END_SRC + +#+BEGIN_SRC emacs-lisp +(define-state jabber-socks5-connection wait-for-connection + (fsm state-data event callback) + (cond + ((eq (car-safe event) :sentinel) + (let ((string (third event))) + (cond + ;; Connection succeeded + ((string= (substring string 0 4) "open") + (list 'authenticate state-data nil)) + ;; Connection failed + (t + (list 'fail state-data nil))))))) + +#+END_SRC + +#+BEGIN_SRC emacs-lisp +(define-enter-state jabber-socks5-connection authenticate + (fsm state-data) + "Send authenticate command." + ;; version: 5. number of auth methods supported: 1. + ;; which one: no authentication. + (process-send-string (plist-get state-data :connection) (string 5 1 0)) + (list state-data 30)) + +#+END_SRC + +#+BEGIN_SRC emacs-lisp +(define-state jabber-socks5-connection authenticate + (fsm state-data event callback) + "Receive response to authenticate command." + (cond + ((eq (car-safe event) :filter) + (let ((string (third event))) + ;; should return: + ;; version: 5. auth method to use: none + (if (string= string (string 5 0)) + ;; Authenticated. Send connect command. + (list 'connect state-data nil) + ;; Authentication failed... + (delete-process (second event)) + (list 'fail state-data nil)))) + + ((eq (car-safe event) :sentinel) + (list 'fail state-data nil)))) + +#+END_SRC + +#+BEGIN_SRC emacs-lisp +(define-enter-state jabber-socks5-connection connect (fsm state-data) + "Send connect command." + (let* ((sid (plist-get state-data :sid)) + (initiator (plist-get state-data :initiator-jid)) + (target (plist-get state-data :target-jid)) + (hash (sha1 (concat sid initiator target)))) + (process-send-string + (plist-get state-data :connection) + (concat (string 5 1 0 3 (length hash)) + hash + (string 0 0))) + (list state-data 30))) + +#+END_SRC + +#+BEGIN_SRC emacs-lisp +(define-state jabber-socks5-connection connect + (fsm state-data event callback) + "Receive response to connect command." + (cond + ((eq (car-safe event) :filter) + (let ((string (third event))) + (if (string= (substring string 0 2) (string 5 0)) + ;; connection established + (progn + (fsm-send (plist-get state-data :socks5-fsm) + (list :connected + (plist-get state-data :connection) + (plist-get state-data :streamhost-jid))) + ;; Our work is done + (list 'done nil)) + (list 'fail state-data nil)))) + ((eq (car-safe event) :sentinel) + (list 'fail state-data nil)))) + +#+END_SRC + +#+BEGIN_SRC emacs-lisp +(define-state jabber-socks5-connection done + (fsm state-data event callback) + ;; ignore all events + (list 'done nil nil)) + +#+END_SRC + +#+BEGIN_SRC emacs-lisp +(define-enter-state jabber-socks5-connection fail (fsm state-data) + ;; Notify parent fsm about failure + (fsm-send (plist-get state-data :socks5-fsm) + :not-connected) + (list nil nil)) + +#+END_SRC + +#+BEGIN_SRC emacs-lisp +(define-state jabber-socks5-connection fail + (fsm state-data event callback) + ;; ignore all events + (list 'fail nil nil)) + +#+END_SRC + +#+BEGIN_SRC emacs-lisp +(define-state jabber-socks5 wait-for-connection + (fsm state-data event callback) + (cond + ((eq (car-safe event) :connected) + (destructuring-bind (ignored connection streamhost-jid) event + (setq state-data (plist-put state-data :connection connection)) + ;; If we are expected to tell which streamhost we chose, do so. + (let ((iq-id (plist-get state-data :iq-id))) + (when iq-id + (jabber-send-iq + (plist-get state-data :jc) + (plist-get state-data :jid) "result" + `(query ((xmlns . "http://jabber.org/protocol/bytestreams")) + (streamhost-used ((jid . ,streamhost-jid)))) + nil nil nil nil + iq-id))) + + ;; If we are the initiator, we should activate the bytestream. + (if (eq (plist-get state-data :role) :initiator) + (progn + (jabber-send-iq + (plist-get state-data :jc) + streamhost-jid "set" + `(query ((xmlns . "http://jabber.org/protocol/bytestreams") + (sid . ,(plist-get state-data :sid))) + (activate nil ,(plist-get state-data :jid))) + (lambda (jc xml-data fsm) (fsm-send-sync fsm :activated)) fsm + (lambda (jc xml-data fsm) (fsm-send-sync fsm :activation-failed)) fsm) + (list 'wait-for-activation state-data 10)) + ;; Otherwise, we just let the data flow. + (list 'stream-activated state-data nil)))) + + ((eq event :not-connected) + ;; If we were counting the streamhosts, we would know when there + ;; are no more chances left. + (list 'wait-for-connection state-data :keep)) + + ((eq event :timeout) + (list 'fail (plist-put state-data :error "Timeout when connecting to streamhosts") nil)))) + +#+END_SRC + +#+BEGIN_SRC emacs-lisp +(define-state jabber-socks5 wait-for-activation + (fsm state-data event callback) + (cond + ((eq event :activated) + (list 'stream-activated state-data nil)) + ((eq event :activation-failed) + (list 'fail (plist-put state-data :error "Proxy activation failed") nil)) + + ;; Stray events from earlier state + ((eq (car-safe event) :connected) + ;; We just close the connection + (delete-process (second event)) + (list 'wait-for-activation state-data :keep)) + ((eq event :not-connected) + (list 'wait-for-activation state-data :keep)))) + +#+END_SRC + +#+BEGIN_SRC emacs-lisp +(define-enter-state jabber-socks5 stream-activated + (fsm state-data) + (let ((connection (plist-get state-data :connection)) + (jc (plist-get state-data :jc)) + (jid (plist-get state-data :jid)) + (sid (plist-get state-data :sid)) + (profile-function (plist-get state-data :profile-function))) + (set-process-filter connection (fsm-make-filter fsm)) + (set-process-sentinel connection (fsm-make-sentinel fsm)) + ;; Call the profile function, passing the data send function, and + ;; receiving the data receiving function. Put the data receiving + ;; function in the plist. + (list (plist-put state-data + :profile-data-function + (funcall profile-function + jc jid sid + (lexical-let ((fsm fsm)) + (lambda (data) + (fsm-send fsm (list :send data)))))) + nil))) + + +(define-state jabber-socks5 stream-activated + (fsm state-data event callback) + (let ((jc (plist-get state-data :jc)) + (connection (plist-get state-data :connection)) + (profile-data-function (plist-get state-data :profile-data-function)) + (sid (plist-get state-data :sid)) + (jid (plist-get state-data :jid))) + (cond + ((eq (car-safe event) :send) + (process-send-string connection (second event)) + (list 'stream-activated state-data nil)) + + ((eq (car-safe event) :filter) + ;; Pass data from connection to profile data function + ;; If the data function requests it, tear down the connection. + (unless (funcall profile-data-function jc jid sid (third event)) + (fsm-send fsm (list :sentinel (second event) "shutdown"))) + + (list 'stream-activated state-data nil)) + + ((eq (car-safe event) :sentinel) + ;; Connection terminated. Shuffle together the remaining data, + ;; and kill the buffer. + (delete-process (second event)) + (funcall profile-data-function jc jid sid nil) + (list 'closed nil nil)) + + ;; Stray events from earlier state + ((eq (car-safe event) :connected) + ;; We just close the connection + (delete-process (second event)) + (list 'stream-activated state-data nil)) + ((eq event :not-connected) + (list 'stream-activated state-data nil))))) + +#+END_SRC + +#+BEGIN_SRC emacs-lisp +(define-enter-state jabber-socks5 fail (fsm state-data) + "Tell our caller that we failed." + (let ((jc (plist-get state-data :jc)) + (jid (plist-get state-data :jid)) + (sid (plist-get state-data :sid)) + (profile-function (plist-get state-data :profile-function)) + (iq-id (plist-get state-data :iq-id))) + (funcall profile-function jc jid sid (plist-get state-data :error)) + + (when iq-id + (jabber-send-iq-error jc jid iq-id nil "cancel" + 'remote-server-not-found))) + (list nil nil)) + +#+END_SRC +**** jabber-socks5-client-1 :function: +#+BEGIN_SRC emacs-lisp +(defun jabber-socks5-client-1 (jc jid sid profile-function) + "Negotiate a SOCKS5 connection with JID. +This function simply starts a state machine." + (add-to-list 'jabber-socks5-pending-sessions + (list sid jid (start-jabber-socks5 jc jid sid profile-function :initiator)))) + +#+END_SRC +**** +jabber-socks5-client-2+ :function: +#+BEGIN_SRC emacs-lisp +;; (defun jabber-socks5-client-2 (xml-data jid sid profile-function) +;; "Contact has selected a streamhost to use. Connect to the proxy." +;; (let* ((query (jabber-iq-query xml-data)) +;; (streamhost-used (car (jabber-xml-get-children query 'streamhost-used))) +;; (proxy-used (jabber-xml-get-attribute streamhost-used 'jid)) +;; connection) +;; (let ((streamhosts-left (cdr (assoc proxy-used jabber-socks5-proxies-data)))) +;; (while (and streamhosts-left (not connection)) +;; (setq connection +;; (jabber-socks5-connect (car streamhosts-left) +;; sid +;; (concat jabber-username "@" jabber-server "/" jabber-resource) +;; jid)) +;; (setq streamhosts-left (cdr streamhosts-left)))) +;; (unless connection +;; (error "Couldn't connect to proxy %s" proxy-used)) + +;; ;; Activation is only needed for proxies. +;; (jabber-send-iq proxy-used "set" +;; `(query ((xmlns . "http://jabber.org/protocol/bytestreams") +;; (sid . ,sid)) +;; (activate () ,jid)) +;; (lexical-let ((jid jid) (sid sid) (profile-function profile-function) +;; (connection connection)) +;; (lambda (xml-data closure-data) +;; (jabber-socks5-client-3 xml-data jid sid profile-function connection))) nil +;; ;; TODO: report error to contact? +;; #'jabber-report-success "Proxy activation"))) + +;; (defun jabber-socks5-client-3 (xml-data jid sid profile-function proxy-connection) +;; "Proxy is activated. Start the transfer." +;; ;; The response from the proxy does not contain any interesting +;; ;; information, beyond success confirmation. + +;; (funcall profile-function jid sid +;; (lexical-let ((proxy-connection proxy-connection)) +;; (lambda (data) +;; (process-send-string proxy-connection data))))) + +#+END_SRC diff --git a/jabber.el b/jabber.el index 9499b85..023c3e5 100644 --- a/jabber.el +++ b/jabber.el @@ -11764,960 +11764,6 @@ get it, and then it just gets deleted." #'jabber-carbon-success "Carbons feature enablement" #'jabber-carbon-failure "Carbons feature enablement")) -(defvar jabber-si-stream-methods nil - "Supported SI stream methods. - -Each entry is a list, containing: - * The namespace URI of the stream method - * Active initiation function - * Passive initiation function - -The active initiation function should initiate the connection, -while the passive initiation function should wait for an incoming -connection. Both functions take the same arguments: - - * JID of peer - * SID - * \"connection established\" function - -The \"connection established\" function should be called when the -stream has been established and data can be transferred. It is part -of the profile, and takes the following arguments: - - * JID of peer - * SID - * Either: - - \"send data\" function, with one string argument - - an error message, when connection failed - -It returns an \"incoming data\" function. - -The \"incoming data\" function should be called when data arrives on -the stream. It takes these arguments: - - * JID of peer - * SID - * A string containing the received data, or nil on EOF - -If it returns nil, the stream should be closed.") - -(defun jabber-si-initiate (jc jid profile-namespace profile-data profile-function &optional mime-type) - "Try to initiate a stream to JID. -PROFILE-NAMESPACE is, well, the namespace of the profile to use. -PROFILE-DATA is the XML data to send within the SI request. -PROFILE-FUNCTION is the \"connection established\" function. -See `jabber-si-stream-methods'. -MIME-TYPE is the MIME type to specify. -Returns the SID." - - (let ((sid (apply 'format "emacs-sid-%d.%d.%d" (current-time)))) - (jabber-send-iq jc jid "set" - `(si ((xmlns . "http://jabber.org/protocol/si") - (id . ,sid) - ,(if mime-type - (cons 'mime-type mime-type)) - (profile . ,profile-namespace)) - ,profile-data - (feature ((xmlns . "http://jabber.org/protocol/feature-neg")) - ,(jabber-fn-encode (list - (cons "stream-method" - (mapcar 'car jabber-si-stream-methods))) - 'request))) - #'jabber-si-initiate-process (cons profile-function sid) - ;; XXX: use other function here? - #'jabber-report-success "Stream initiation") - sid)) - -(defun jabber-si-initiate-process (jc xml-data closure-data) - "Act on response to our SI query." - - (let* ((profile-function (car closure-data)) - (sid (cdr closure-data)) - (from (jabber-xml-get-attribute xml-data 'from)) - (query (jabber-iq-query xml-data)) - (feature-node (car (jabber-xml-get-children query 'feature))) - (feature-alist (jabber-fn-parse feature-node 'response)) - (chosen-method (cadr (assoc "stream-method" feature-alist))) - (method-data (assoc chosen-method jabber-si-stream-methods))) - ;; Our work is done. Hand it over to the stream method. - (let ((stream-negotiate (nth 1 method-data))) - (funcall stream-negotiate jc from sid profile-function)))) - -(jabber-disco-advertise-feature "http://jabber.org/protocol/si") - -(defvar jabber-si-profiles nil - "Supported SI profiles. - -Each entry is a list, containing: - * The namespace URI of the profile - * Accept function, taking entire IQ stanza, and signalling a 'forbidden' - error if request is declined; returning an XML node to return in - response, or nil of none needed - * \"Connection established\" function. See `jabber-si-stream-methods'.") - -(add-to-list 'jabber-iq-set-xmlns-alist - (cons "http://jabber.org/protocol/si" 'jabber-si-process)) -(defun jabber-si-process (jc xml-data) - - (let* ((to (jabber-xml-get-attribute xml-data 'from)) - (id (jabber-xml-get-attribute xml-data 'id)) - (query (jabber-iq-query xml-data)) - (profile (jabber-xml-get-attribute query 'profile)) - (si-id (jabber-xml-get-attribute query 'id)) - (feature (car (jabber-xml-get-children query 'feature)))) - (message "Receiving SI with profile '%s'" profile) - - (let (stream-method - ;; Find profile - (profile-data (assoc profile jabber-si-profiles))) - ;; Now, feature negotiation for stream type (errors - ;; don't match XEP-0095, so convert) - (condition-case err - (setq stream-method (jabber-fn-intersection - (jabber-fn-parse feature 'request) - (list (cons "stream-method" (mapcar 'car jabber-si-stream-methods))))) - (jabber-error - (jabber-signal-error "cancel" 'bad-request nil - '((no-valid-streams ((xmlns . "http://jabber.org/protocol/si"))))))) - (unless profile-data - ;; profile not understood - (jabber-signal-error "cancel" 'bad-request nil - '((bad-profile ((xmlns . "http://jabber.org/protocol/si")))))) - (let* ((profile-accept-function (nth 1 profile-data)) - ;; accept-function might throw a "forbidden" error - ;; on user cancel - (profile-response (funcall profile-accept-function jc xml-data)) - (profile-connected-function (nth 2 profile-data)) - (stream-method-id (nth 1 (assoc "stream-method" stream-method))) - (stream-data (assoc stream-method-id jabber-si-stream-methods)) - (stream-accept-function (nth 2 stream-data))) - ;; prepare stream for the transfer - (funcall stream-accept-function jc to si-id profile-connected-function) - ;; return result of feature negotiation of stream type - (jabber-send-iq jc to "result" - `(si ((xmlns . "http://jabber.org/protocol/si")) - ,@profile-response - (feature ((xmlns . "http://jabber.org/protocol/feature-neg")) - ,(jabber-fn-encode stream-method 'response))) - nil nil nil nil - id) - )))) - -(defcustom jabber-ft-md5sum-program (or (when (executable-find "md5") - (list (executable-find "md5") "-n")) - (when (executable-find "md5sum") - (list (executable-find "md5sum")))) - "The program to use to calculate MD5 sums of files. -The first item should be the name of the program, and the remaing -items the arguments. The file name is appended as the last -argument." - :type '(repeat string) - :group 'jabber) - -(defun jabber-ft-get-md5 (file-name) - "Get MD5 sum of FILE-NAME, and return as hex string. -Return nil if no MD5 summing program is available." - (when jabber-ft-md5sum-program - (with-temp-buffer - (apply 'call-process (car jabber-ft-md5sum-program) nil t nil - (append (cdr jabber-ft-md5sum-program) (list file-name))) - ;; Output is "hexsum filename" - (goto-char (point-min)) - (forward-word 1) - (buffer-substring (point-min) (point))))) - -(eval-when-compile (require 'cl)) - -(defun jabber-ft-send (jc jid filename desc) - "Attempt to send FILENAME to JID." - (interactive (list (jabber-read-account) - (jabber-read-jid-completing "Send file to: " nil nil nil 'full t) - (read-file-name "Send which file: " nil nil t) - (jabber-read-with-input-method "Description (optional): "))) - (if (zerop (length desc)) (setq desc nil)) - (setq filename (expand-file-name filename)) - (access-file filename "Couldn't open file") - - (let* ((attributes (file-attributes filename)) - (size (nth 7 attributes)) - (date (nth 5 attributes)) - (hash (jabber-ft-get-md5 filename))) - (jabber-si-initiate jc jid "http://jabber.org/protocol/si/profile/file-transfer" - `(file ((xmlns . "http://jabber.org/protocol/si/profile/file-transfer") - (name . ,(file-name-nondirectory filename)) - (size . ,size) - (date . ,(jabber-encode-time date)) - ,@(when hash - (list (cons 'hash hash)))) - (desc () ,desc)) - (lexical-let ((filename filename)) - (lambda (jc jid sid send-data-function) - (jabber-ft-do-send - jid sid send-data-function filename)))))) - -(defun jabber-ft-do-send (jid sid send-data-function filename) - (if (stringp send-data-function) - (message "File sending failed: %s" send-data-function) - (with-temp-buffer - (insert-file-contents-literally filename) - - ;; Ever heard of buffering? - (funcall send-data-function (buffer-string)) - (message "File transfer completed"))) - ;; File transfer is monodirectional, so ignore received data. - #'ignore) - -(defvar jabber-ft-sessions nil - "Alist, where keys are (sid jid), and values are buffers of the files.") - -(defvar jabber-ft-size nil - "Size of the file that is being downloaded") - -(defvar jabber-ft-md5-hash nil - "MD5 hash of the file that is being downloaded") - -(jabber-disco-advertise-feature "http://jabber.org/protocol/si/profile/file-transfer") - -(add-to-list 'jabber-si-profiles - (list "http://jabber.org/protocol/si/profile/file-transfer" - 'jabber-ft-accept - 'jabber-ft-server-connected)) - -(defun jabber-ft-accept (jc xml-data) - "Receive IQ stanza containing file transfer request, ask user" - (let* ((from (jabber-xml-get-attribute xml-data 'from)) - (query (jabber-iq-query xml-data)) - (si-id (jabber-xml-get-attribute query 'id)) - ;; TODO: check namespace - (file (car (jabber-xml-get-children query 'file))) - (name (jabber-xml-get-attribute file 'name)) - (size (jabber-xml-get-attribute file 'size)) - (date (jabber-xml-get-attribute file 'date)) - (md5-hash (jabber-xml-get-attribute file 'hash)) - (desc (car (jabber-xml-node-children - (car (jabber-xml-get-children file 'desc))))) - (range (car (jabber-xml-get-children file 'range)))) - (unless (and name size) - ;; both name and size must be present - (jabber-signal-error "modify" 'bad-request)) - - (let ((question (format - "%s is sending you the file %s (%s bytes).%s Accept? " - (jabber-jid-displayname from) - name - size - (if (not (zerop (length desc))) - (concat " Description: '" desc "'") - "")))) - (unless (yes-or-no-p question) - (jabber-signal-error "cancel" 'forbidden))) - - ;; default is to save with given name, in current directory. - ;; maybe that's bad; maybe should be customizable. - (let* ((file-name (read-file-name "Download to: " nil nil nil name)) - (buffer (create-file-buffer file-name))) - (message "Starting download of %s..." (file-name-nondirectory file-name)) - (with-current-buffer buffer - (kill-all-local-variables) - (setq buffer-file-coding-system 'binary) - ;; For Emacs, switch buffer to unibyte _before_ anything goes into it, - ;; otherwise binary files are corrupted. For XEmacs, it isn't needed, - ;; and it also doesn't have set-buffer-multibyte. - (if (fboundp 'set-buffer-multibyte) - (set-buffer-multibyte nil)) - (set-visited-file-name file-name t) - (set (make-local-variable 'jabber-ft-size) - (string-to-number size)) - (set (make-local-variable 'jabber-ft-md5-hash) - md5-hash)) - (add-to-list 'jabber-ft-sessions - (cons (list si-id from) buffer))) - - ;; to support range, return something sensible here - nil)) - -(defun jabber-ft-server-connected (jc jid sid send-data-function) - ;; We don't really care about the send-data-function. But if it's - ;; a string, it means that we have no connection. - (if (stringp send-data-function) - (message "File receiving failed: %s" send-data-function) - ;; On success, we just return our data receiving function. - 'jabber-ft-data)) - -(defun jabber-ft-data (jc jid sid data) - "Receive chunk of transferred file." - (let ((buffer (cdr (assoc (list sid jid) jabber-ft-sessions)))) - (with-current-buffer buffer - ;; If data is nil, there is no more data. - ;; But maybe the remote entity doesn't close the stream - - ;; then we have to keep track of file size to know when to stop. - ;; Return value is whether to keep connection open. - (when data - (insert data)) - (if (and data (< (buffer-size) jabber-ft-size)) - t - (basic-save-buffer) - (if (and jabber-ft-md5-hash - (let ((file-hash (jabber-ft-get-md5 buffer-file-name))) - (and file-hash - (not (string= file-hash jabber-ft-md5-hash))))) - ;; hash mismatch! - (progn - (message "%s downloaded - CHECKSUM MISMATCH!" - (file-name-nondirectory buffer-file-name)) - (sleep-for 5)) - ;; all is fine - (message "%s downloaded" (file-name-nondirectory buffer-file-name))) - (kill-buffer buffer) - nil)))) - -(eval-when-compile (require 'cl)) - -(defvar jabber-socks5-pending-sessions nil - "List of pending sessions. - -Each entry is a list, containing: - * Stream ID - * Full JID of initiator - * State machine managing the session") - -(defvar jabber-socks5-active-sessions nil - "List of active sessions. - -Each entry is a list, containing: - * Network connection - * Stream ID - * Full JID of initiator - * Profile data function") - -(defcustom jabber-socks5-proxies nil - "JIDs of XEP-0065 proxies to use for file transfer. -Put preferred ones first." - :type '(repeat string) - :group 'jabber -; :set 'jabber-socks5-set-proxies) - ) - -(defvar jabber-socks5-proxies-data nil - "Alist containing information about proxies. -Keys of the alist are strings, the JIDs of the proxies. -Values are \"streamhost\" XML nodes.") - -(jabber-disco-advertise-feature "http://jabber.org/protocol/bytestreams") - -(add-to-list 'jabber-si-stream-methods - (list "http://jabber.org/protocol/bytestreams" - 'jabber-socks5-client-1 - 'jabber-socks5-accept)) - -(defun jabber-socks5-set-proxies (symbol value) - "Set `jabber-socks5-proxies' and query proxies. -This is the set function of `jabber-socks5-proxies-data'." - (set-default symbol value) - (when jabber-connections - (jabber-socks5-query-all-proxies))) - -(defun jabber-socks5-query-all-proxies (jc &optional callback) - "Ask all proxies in `jabber-socks5-proxies' for connection information. -If CALLBACK is non-nil, call it with no arguments when all -proxies have answered." - (interactive (list (jabber-read-account))) - (setq jabber-socks5-proxies-data nil) - (dolist (proxy jabber-socks5-proxies) - (jabber-socks5-query-proxy jc proxy callback))) - -(defun jabber-socks5-query-proxy (jc jid &optional callback) - "Query the SOCKS5 proxy specified by JID for IP and port number." - (jabber-send-iq jc jid "get" - '(query ((xmlns . "http://jabber.org/protocol/bytestreams"))) - #'jabber-socks5-process-proxy-response (list callback t) - #'jabber-socks5-process-proxy-response (list callback nil))) - -(defun jabber-socks5-process-proxy-response (jc xml-data closure-data) - "Process response from proxy query." - (let* ((query (jabber-iq-query xml-data)) - (from (jabber-xml-get-attribute xml-data 'from)) - (streamhosts (jabber-xml-get-children query 'streamhost))) - - (let ((existing-entry (assoc from jabber-socks5-proxies-data))) - (when existing-entry - (setq jabber-socks5-proxies-data - (delq existing-entry jabber-socks5-proxies-data)))) - - (destructuring-bind (callback successp) closure-data - (when successp - (setq jabber-socks5-proxies-data - (cons (cons from streamhosts) - jabber-socks5-proxies-data))) - (message "%s from %s. %d of %d proxies have answered." - (if successp "Response" "Error") from - (length jabber-socks5-proxies-data) (length jabber-socks5-proxies)) - (when (and callback (= (length jabber-socks5-proxies-data) (length jabber-socks5-proxies))) - (funcall callback))))) - -(define-state-machine jabber-socks5 - :start ((jc jid sid profile-function role) - "Start XEP-0065 bytestream with JID. -SID is the session ID used. -PROFILE-FUNCTION is the function to call upon success. See `jabber-si-stream-methods'. -ROLE is either :initiator or :target. The initiator sends an IQ -set; the target waits for one." - (let ((new-state-data (list :jc jc - :jid jid - :sid sid - :profile-function profile-function - :role role)) - (new-state - ;; We want information about proxies; it might be needed in - ;; various situations. - (cond - ((null jabber-socks5-proxies) - ;; We know no proxy addresses. Try to find them by disco. - 'seek-proxies) - ((null jabber-socks5-proxies-data) - ;; We need to query the proxies for addresses. - 'query-proxies) - ;; So, we have our proxies. - (t - 'initiate)))) - (list new-state new-state-data nil)))) - -(defun jabber-socks5-accept (jc jid sid profile-function) - "Remember that we are waiting for connection from JID, with stream id SID" - ;; asking the user for permission is done in the profile - (add-to-list 'jabber-socks5-pending-sessions - (list sid jid (start-jabber-socks5 jc jid sid profile-function :target)))) - -(define-enter-state jabber-socks5 seek-proxies (fsm state-data) - ;; Look for items at the server. - (let* ((jc (plist-get state-data :jc)) - (server (jabber-jid-server (jabber-connection-jid jc)))) - (jabber-disco-get-items jc - server - nil - (lambda (jc fsm result) - (fsm-send-sync fsm (cons :items result))) - fsm)) - ;; Spend no more than five seconds looking for a proxy. - (list state-data 5)) - -(define-state jabber-socks5 seek-proxies (fsm state-data event callback) - "Collect disco results, looking for a bytestreams proxy." - ;; We put the number of outstanding requests as :remaining-info in - ;; the state-data plist. - (cond - ;; We're not ready to handle the IQ stanza yet - ((eq (car-safe event) :iq) - :defer) - - ;; Got list of items at the server. - ((eq (car-safe event) :items) - (dolist (entry (cdr event)) - ;; Each entry is ["name" "jid" "node"]. We send a disco info - ;; request to everything without a node. - (when (null (aref entry 2)) - (lexical-let ((jid (aref entry 1))) - (jabber-disco-get-info - (plist-get state-data :jc) - jid nil - (lambda (jc fsm result) - (fsm-send-sync fsm (list :info jid result))) - fsm)))) - ;; Remember number of requests sent. But if none, we just go on. - (if (cdr event) - (list 'seek-proxies (plist-put state-data :remaining-info (length (cdr event))) :keep) - (list 'initiate state-data nil))) - - ;; Got disco info from an item at the server. - ((eq (car-safe event) :info) - (fsm-debug-output "got disco event") - ;; Count the response. - (plist-put state-data :remaining-info (1- (plist-get state-data :remaining-info))) - (unless (eq (first (third event)) 'error) - (let ((identities (first (third event)))) - ;; Is it a bytestream proxy? - (when (dolist (identity identities) - (when (and (string= (aref identity 1) "proxy") - (string= (aref identity 2) "bytestreams")) - (return t))) - ;; Yes, it is. Add it to the list. - (push (second event) jabber-socks5-proxies)))) - - ;; Wait for more responses, if any are to be expected. - (if (zerop (plist-get state-data :remaining-info)) - ;; No more... go on to querying the proxies. - (list 'query-proxies state-data nil) - ;; We expect more responses... - (list 'seek-proxies state-data :keep))) - - ((eq event :timeout) - ;; We can't wait anymore... - (list 'query-proxies state-data nil)))) - -(define-enter-state jabber-socks5 query-proxies (fsm state-data) - (jabber-socks5-query-all-proxies - (plist-get state-data :jc) - (lexical-let ((fsm fsm)) - (lambda () (fsm-send-sync fsm :proxies)))) - (list state-data 5)) - -(define-state jabber-socks5 query-proxies (fsm state-data event callback) - "Query proxies in `jabber-socks5-proxies'." - (cond - ;; Can't handle the iq stanza yet... - ((eq (car-safe event) :iq) - :defer) - - ((eq (car-safe event) :info) - ;; stray event... do nothing - (list 'query-proxies state-data :keep)) - - ;; Got response/error from all proxies, or timeout - ((memq event '(:proxies :timeout)) - (list 'initiate state-data nil)))) - -(define-enter-state jabber-socks5 initiate (fsm state-data) - ;; Sort the alist jabber-socks5-proxies-data such that the - ;; keys are in the same order as in jabber-socks5-proxies. - (setq jabber-socks5-proxies-data - (sort jabber-socks5-proxies-data - #'(lambda (a b) - (> (length (member (car a) jabber-socks5-proxies)) - (length (member (car b) jabber-socks5-proxies)))))) - - ;; If we're the initiator, send initiation stanza. - (when (eq (plist-get state-data :role) :initiator) - ;; This is where initiation of server sockets would go - - (jabber-send-iq - (plist-get state-data :jc) - (plist-get state-data :jid) "set" - `(query ((xmlns . "http://jabber.org/protocol/bytestreams") - (sid . ,(plist-get state-data :sid))) - ,@(mapcar - #'(lambda (proxy) - (mapcar - #'(lambda (streamhost) - (list 'streamhost - (list (cons 'jid (jabber-xml-get-attribute streamhost 'jid)) - (cons 'host (jabber-xml-get-attribute streamhost 'host)) - (cons 'port (jabber-xml-get-attribute streamhost 'port))) - ;; (proxy ((xmlns . "http://affinix.com/jabber/stream"))) - )) - (cdr proxy))) - jabber-socks5-proxies-data) - ;; (fast ((xmlns . "http://affinix.com/jabber/stream"))) - ) - (lexical-let ((fsm fsm)) - (lambda (jc xml-data closure-data) - (fsm-send-sync fsm (list :iq xml-data)))) - nil - ;; TODO: error handling - #'jabber-report-success "SOCKS5 negotiation")) - - ;; If we're the target, we just wait for an incoming stanza. - (list state-data nil)) - -(add-to-list 'jabber-iq-set-xmlns-alist - (cons "http://jabber.org/protocol/bytestreams" 'jabber-socks5-process)) -(defun jabber-socks5-process (jc xml-data) - "Accept IQ get for SOCKS5 bytestream" - (let* ((jid (jabber-xml-get-attribute xml-data 'from)) - (id (jabber-xml-get-attribute xml-data 'id)) - (query (jabber-iq-query xml-data)) - (sid (jabber-xml-get-attribute query 'sid)) - (session (dolist (pending-session jabber-socks5-pending-sessions) - (when (and (equal sid (nth 0 pending-session)) - (equal jid (nth 1 pending-session))) - (return pending-session))))) - ;; check that we really are expecting this session - (unless session - (jabber-signal-error "auth" 'not-acceptable)) - - (setq jabber-socks5-pending-sessions (delq session jabber-socks5-pending-sessions)) - (fsm-send-sync (nth 2 session) (list :iq xml-data)) - - ;; find streamhost to connect to -;; (let* ((streamhosts (jabber-xml-get-children query 'streamhost)) -;; (streamhost (dolist (streamhost streamhosts) -;; (let ((connection (jabber-socks5-connect streamhost sid jid (concat jabber-username "@" jabber-server "/" jabber-resource)))) -;; (when connection -;; ;; We select the first streamhost that we are able to connect to. -;; (push (list connection sid jid profile-data-function) -;; jabber-socks5-active-sessions) -;; ;; Now set the filter, for the rest of the output -;; (set-process-filter connection #'jabber-socks5-filter) -;; (set-process-sentinel connection #'jabber-socks5-sentinel) -;; (return streamhost)))))) -;; (unless streamhost -;; (jabber-signal-error "cancel" 'item-not-found)) - -;; ;; tell initiator which streamhost we use -;; (jabber-send-iq jid "result" -;; `(query ((xmlns . "http://jabber.org/protocol/bytestreams")) -;; (streamhost-used ((jid . ,(jabber-xml-get-attribute streamhost 'jid))))) -;; nil nil nil nil id) -;; ;; now, as data is sent, it will be passed to the profile. -;; ) - )) - -(define-state jabber-socks5 initiate (fsm state-data event callback) - (let* ((jc (plist-get state-data :jc)) - (jc-data (fsm-get-state-data jc)) - (our-jid (concat (plist-get jc-data :username) "@" - (plist-get jc-data :server) "/" - (plist-get jc-data :resource))) - (their-jid (plist-get state-data :jid)) - (initiator-jid (if (eq (plist-get state-data :role) :initiator) our-jid their-jid)) - (target-jid (if (eq (plist-get state-data :role) :initiator) their-jid our-jid))) - (cond - ;; Stray event... - ((memq (car-safe event) '(:proxy :info)) - (list 'initiate state-data :keep)) - - ;; Incoming IQ - ((eq (car-safe event) :iq) - (let ((xml-data (second event))) - ;; This is either type "set" (with a list of streamhosts to - ;; use), or a "result" (indicating the streamhost finally used - ;; by the other party). - (cond - ((string= (jabber-xml-get-attribute xml-data 'type) "set") - ;; A "set" makes sense if we're the initiator and offered - ;; Psi's "fast mode". We don't yet, though, so this is only - ;; for target. - (dolist (streamhost (jabber-xml-get-children (jabber-iq-query xml-data) 'streamhost)) - (jabber-xml-let-attributes - (jid host port) streamhost - ;; This is where we would attempt to support zeroconf - (when (and jid host port) - (start-jabber-socks5-connection - jc initiator-jid target-jid jid - (plist-get state-data :sid) host port fsm)))) - - (list 'wait-for-connection (plist-put state-data :iq-id (jabber-xml-get-attribute xml-data 'id)) 30)) - - ((string= (jabber-xml-get-attribute xml-data 'type) "result") - ;; The other party has decided what streamhost to use. - (let* ((proxy-used (jabber-xml-get-attribute (jabber-xml-path xml-data '(query streamhost-used)) 'jid)) - ;; If JID is our own JID, we have probably already detected - ;; what connection to use. But that is a later problem... - (streamhosts (cdr (assoc proxy-used jabber-socks5-proxies-data)))) - ;; Try to connect to all addresses of this proxy... - (dolist (streamhost streamhosts) - (jabber-xml-let-attributes - (jid host port) streamhost - (when (and jid host port) - (start-jabber-socks5-connection - jc initiator-jid target-jid jid - (plist-get state-data :sid) host port fsm))))) - - (list 'wait-for-connection state-data 30)))))))) - -(define-state-machine jabber-socks5-connection - :start - ((jc initiator-jid target-jid streamhost-jid sid host port socks5-fsm) - "Connect to a single XEP-0065 streamhost." - (let ((coding-system-for-read 'binary) - (coding-system-for-write 'binary)) - ;; make-network-process, which we really want, for asynchronous - ;; connection and such, was introduced in Emacs 22. - (if (fboundp 'make-network-process) - (let ((connection - (make-network-process - :name "socks5" - :buffer nil - :host host - :service (string-to-number port) - :nowait t - :filter (fsm-make-filter fsm) - :sentinel (fsm-make-sentinel fsm)))) - (list 'wait-for-connection - (list :jc jc - :connection connection - :initiator-jid initiator-jid - :target-jid target-jid - :streamhost-jid streamhost-jid - :sid sid - :socks5-fsm socks5-fsm) - 30)) - ;; So we open a stream, and wait for the connection to succeed. - (condition-case nil - (let ((connection - (open-network-stream "socks5" nil - host (string-to-number port)))) - (set-process-filter connection (fsm-make-filter fsm)) - (set-process-sentinel connection (fsm-make-sentinel fsm)) - (list 'authenticate - (list :jc jc - :connection connection - :initiator-jid initiator-jid - :target-jid target-jid - :streamhost-jid streamhost-jid - :sid sid - :socks5-fsm socks5-fsm) - nil)) - (error (list 'fail '() nil))))))) - -(define-state jabber-socks5-connection wait-for-connection - (fsm state-data event callback) - (cond - ((eq (car-safe event) :sentinel) - (let ((string (third event))) - (cond - ;; Connection succeeded - ((string= (substring string 0 4) "open") - (list 'authenticate state-data nil)) - ;; Connection failed - (t - (list 'fail state-data nil))))))) - -(define-enter-state jabber-socks5-connection authenticate - (fsm state-data) - "Send authenticate command." - ;; version: 5. number of auth methods supported: 1. - ;; which one: no authentication. - (process-send-string (plist-get state-data :connection) (string 5 1 0)) - (list state-data 30)) - -(define-state jabber-socks5-connection authenticate - (fsm state-data event callback) - "Receive response to authenticate command." - (cond - ((eq (car-safe event) :filter) - (let ((string (third event))) - ;; should return: - ;; version: 5. auth method to use: none - (if (string= string (string 5 0)) - ;; Authenticated. Send connect command. - (list 'connect state-data nil) - ;; Authentication failed... - (delete-process (second event)) - (list 'fail state-data nil)))) - - ((eq (car-safe event) :sentinel) - (list 'fail state-data nil)))) - -(define-enter-state jabber-socks5-connection connect (fsm state-data) - "Send connect command." - (let* ((sid (plist-get state-data :sid)) - (initiator (plist-get state-data :initiator-jid)) - (target (plist-get state-data :target-jid)) - (hash (sha1 (concat sid initiator target)))) - (process-send-string - (plist-get state-data :connection) - (concat (string 5 1 0 3 (length hash)) - hash - (string 0 0))) - (list state-data 30))) - -(define-state jabber-socks5-connection connect - (fsm state-data event callback) - "Receive response to connect command." - (cond - ((eq (car-safe event) :filter) - (let ((string (third event))) - (if (string= (substring string 0 2) (string 5 0)) - ;; connection established - (progn - (fsm-send (plist-get state-data :socks5-fsm) - (list :connected - (plist-get state-data :connection) - (plist-get state-data :streamhost-jid))) - ;; Our work is done - (list 'done nil)) - (list 'fail state-data nil)))) - ((eq (car-safe event) :sentinel) - (list 'fail state-data nil)))) - -(define-state jabber-socks5-connection done - (fsm state-data event callback) - ;; ignore all events - (list 'done nil nil)) - -(define-enter-state jabber-socks5-connection fail (fsm state-data) - ;; Notify parent fsm about failure - (fsm-send (plist-get state-data :socks5-fsm) - :not-connected) - (list nil nil)) - -(define-state jabber-socks5-connection fail - (fsm state-data event callback) - ;; ignore all events - (list 'fail nil nil)) - -(define-state jabber-socks5 wait-for-connection - (fsm state-data event callback) - (cond - ((eq (car-safe event) :connected) - (destructuring-bind (ignored connection streamhost-jid) event - (setq state-data (plist-put state-data :connection connection)) - ;; If we are expected to tell which streamhost we chose, do so. - (let ((iq-id (plist-get state-data :iq-id))) - (when iq-id - (jabber-send-iq - (plist-get state-data :jc) - (plist-get state-data :jid) "result" - `(query ((xmlns . "http://jabber.org/protocol/bytestreams")) - (streamhost-used ((jid . ,streamhost-jid)))) - nil nil nil nil - iq-id))) - - ;; If we are the initiator, we should activate the bytestream. - (if (eq (plist-get state-data :role) :initiator) - (progn - (jabber-send-iq - (plist-get state-data :jc) - streamhost-jid "set" - `(query ((xmlns . "http://jabber.org/protocol/bytestreams") - (sid . ,(plist-get state-data :sid))) - (activate nil ,(plist-get state-data :jid))) - (lambda (jc xml-data fsm) (fsm-send-sync fsm :activated)) fsm - (lambda (jc xml-data fsm) (fsm-send-sync fsm :activation-failed)) fsm) - (list 'wait-for-activation state-data 10)) - ;; Otherwise, we just let the data flow. - (list 'stream-activated state-data nil)))) - - ((eq event :not-connected) - ;; If we were counting the streamhosts, we would know when there - ;; are no more chances left. - (list 'wait-for-connection state-data :keep)) - - ((eq event :timeout) - (list 'fail (plist-put state-data :error "Timeout when connecting to streamhosts") nil)))) - -(define-state jabber-socks5 wait-for-activation - (fsm state-data event callback) - (cond - ((eq event :activated) - (list 'stream-activated state-data nil)) - ((eq event :activation-failed) - (list 'fail (plist-put state-data :error "Proxy activation failed") nil)) - - ;; Stray events from earlier state - ((eq (car-safe event) :connected) - ;; We just close the connection - (delete-process (second event)) - (list 'wait-for-activation state-data :keep)) - ((eq event :not-connected) - (list 'wait-for-activation state-data :keep)))) - -(define-enter-state jabber-socks5 stream-activated - (fsm state-data) - (let ((connection (plist-get state-data :connection)) - (jc (plist-get state-data :jc)) - (jid (plist-get state-data :jid)) - (sid (plist-get state-data :sid)) - (profile-function (plist-get state-data :profile-function))) - (set-process-filter connection (fsm-make-filter fsm)) - (set-process-sentinel connection (fsm-make-sentinel fsm)) - ;; Call the profile function, passing the data send function, and - ;; receiving the data receiving function. Put the data receiving - ;; function in the plist. - (list (plist-put state-data - :profile-data-function - (funcall profile-function - jc jid sid - (lexical-let ((fsm fsm)) - (lambda (data) - (fsm-send fsm (list :send data)))))) - nil))) - - -(define-state jabber-socks5 stream-activated - (fsm state-data event callback) - (let ((jc (plist-get state-data :jc)) - (connection (plist-get state-data :connection)) - (profile-data-function (plist-get state-data :profile-data-function)) - (sid (plist-get state-data :sid)) - (jid (plist-get state-data :jid))) - (cond - ((eq (car-safe event) :send) - (process-send-string connection (second event)) - (list 'stream-activated state-data nil)) - - ((eq (car-safe event) :filter) - ;; Pass data from connection to profile data function - ;; If the data function requests it, tear down the connection. - (unless (funcall profile-data-function jc jid sid (third event)) - (fsm-send fsm (list :sentinel (second event) "shutdown"))) - - (list 'stream-activated state-data nil)) - - ((eq (car-safe event) :sentinel) - ;; Connection terminated. Shuffle together the remaining data, - ;; and kill the buffer. - (delete-process (second event)) - (funcall profile-data-function jc jid sid nil) - (list 'closed nil nil)) - - ;; Stray events from earlier state - ((eq (car-safe event) :connected) - ;; We just close the connection - (delete-process (second event)) - (list 'stream-activated state-data nil)) - ((eq event :not-connected) - (list 'stream-activated state-data nil))))) - -(define-enter-state jabber-socks5 fail (fsm state-data) - "Tell our caller that we failed." - (let ((jc (plist-get state-data :jc)) - (jid (plist-get state-data :jid)) - (sid (plist-get state-data :sid)) - (profile-function (plist-get state-data :profile-function)) - (iq-id (plist-get state-data :iq-id))) - (funcall profile-function jc jid sid (plist-get state-data :error)) - - (when iq-id - (jabber-send-iq-error jc jid iq-id nil "cancel" - 'remote-server-not-found))) - (list nil nil)) - -(defun jabber-socks5-client-1 (jc jid sid profile-function) - "Negotiate a SOCKS5 connection with JID. -This function simply starts a state machine." - (add-to-list 'jabber-socks5-pending-sessions - (list sid jid (start-jabber-socks5 jc jid sid profile-function :initiator)))) - -;; (defun jabber-socks5-client-2 (xml-data jid sid profile-function) -;; "Contact has selected a streamhost to use. Connect to the proxy." -;; (let* ((query (jabber-iq-query xml-data)) -;; (streamhost-used (car (jabber-xml-get-children query 'streamhost-used))) -;; (proxy-used (jabber-xml-get-attribute streamhost-used 'jid)) -;; connection) -;; (let ((streamhosts-left (cdr (assoc proxy-used jabber-socks5-proxies-data)))) -;; (while (and streamhosts-left (not connection)) -;; (setq connection -;; (jabber-socks5-connect (car streamhosts-left) -;; sid -;; (concat jabber-username "@" jabber-server "/" jabber-resource) -;; jid)) -;; (setq streamhosts-left (cdr streamhosts-left)))) -;; (unless connection -;; (error "Couldn't connect to proxy %s" proxy-used)) - -;; ;; Activation is only needed for proxies. -;; (jabber-send-iq proxy-used "set" -;; `(query ((xmlns . "http://jabber.org/protocol/bytestreams") -;; (sid . ,sid)) -;; (activate () ,jid)) -;; (lexical-let ((jid jid) (sid sid) (profile-function profile-function) -;; (connection connection)) -;; (lambda (xml-data closure-data) -;; (jabber-socks5-client-3 xml-data jid sid profile-function connection))) nil -;; ;; TODO: report error to contact? -;; #'jabber-report-success "Proxy activation"))) - -;; (defun jabber-socks5-client-3 (xml-data jid sid profile-function proxy-connection) -;; "Proxy is activated. Start the transfer." -;; ;; The response from the proxy does not contain any interesting -;; ;; information, beyond success confirmation. - -;; (funcall profile-function jid sid -;; (lexical-let ((proxy-connection proxy-connection)) -;; (lambda (data) -;; (process-send-string proxy-connection data))))) - (eval-when-compile (require 'cl)) ;;;###autoload (eval-after-load "jabber-disco" diff --git a/jabber.org b/jabber.org index 852e3e4..6eccc75 100644 --- a/jabber.org +++ b/jabber.org @@ -14842,1158 +14842,6 @@ get it, and then it just gets deleted." #'jabber-carbon-success "Carbons feature enablement" #'jabber-carbon-failure "Carbons feature enablement")) -#+END_SRC -*** Stream Initiation (SI) ([[https://xmpp.org/extensions/xep-0095.html][XEP-0095]]) :xep_deprecated: -**** common -:PROPERTIES: -:file: jabber-si-common.el -:END: - -***** jabber-si-stream-methods :variable: -#+BEGIN_SRC emacs-lisp -(defvar jabber-si-stream-methods nil - "Supported SI stream methods. - -Each entry is a list, containing: - * The namespace URI of the stream method - * Active initiation function - * Passive initiation function - -The active initiation function should initiate the connection, -while the passive initiation function should wait for an incoming -connection. Both functions take the same arguments: - - * JID of peer - * SID - * \"connection established\" function - -The \"connection established\" function should be called when the -stream has been established and data can be transferred. It is part -of the profile, and takes the following arguments: - - * JID of peer - * SID - * Either: - - \"send data\" function, with one string argument - - an error message, when connection failed - -It returns an \"incoming data\" function. - -The \"incoming data\" function should be called when data arrives on -the stream. It takes these arguments: - - * JID of peer - * SID - * A string containing the received data, or nil on EOF - -If it returns nil, the stream should be closed.") - -#+END_SRC -**** client -:PROPERTIES: -:file: jabber-si-client.el -:END: - -***** jabber-si-initiate :function: -#+BEGIN_SRC emacs-lisp -(defun jabber-si-initiate (jc jid profile-namespace profile-data profile-function &optional mime-type) - "Try to initiate a stream to JID. -PROFILE-NAMESPACE is, well, the namespace of the profile to use. -PROFILE-DATA is the XML data to send within the SI request. -PROFILE-FUNCTION is the \"connection established\" function. -See `jabber-si-stream-methods'. -MIME-TYPE is the MIME type to specify. -Returns the SID." - - (let ((sid (apply 'format "emacs-sid-%d.%d.%d" (current-time)))) - (jabber-send-iq jc jid "set" - `(si ((xmlns . "http://jabber.org/protocol/si") - (id . ,sid) - ,(if mime-type - (cons 'mime-type mime-type)) - (profile . ,profile-namespace)) - ,profile-data - (feature ((xmlns . "http://jabber.org/protocol/feature-neg")) - ,(jabber-fn-encode (list - (cons "stream-method" - (mapcar 'car jabber-si-stream-methods))) - 'request))) - #'jabber-si-initiate-process (cons profile-function sid) - ;; XXX: use other function here? - #'jabber-report-success "Stream initiation") - sid)) - -#+END_SRC -***** jabber-si-initiate-process :function: -#+BEGIN_SRC emacs-lisp -(defun jabber-si-initiate-process (jc xml-data closure-data) - "Act on response to our SI query." - - (let* ((profile-function (car closure-data)) - (sid (cdr closure-data)) - (from (jabber-xml-get-attribute xml-data 'from)) - (query (jabber-iq-query xml-data)) - (feature-node (car (jabber-xml-get-children query 'feature))) - (feature-alist (jabber-fn-parse feature-node 'response)) - (chosen-method (cadr (assoc "stream-method" feature-alist))) - (method-data (assoc chosen-method jabber-si-stream-methods))) - ;; Our work is done. Hand it over to the stream method. - (let ((stream-negotiate (nth 1 method-data))) - (funcall stream-negotiate jc from sid profile-function)))) - -#+END_SRC -**** server -:PROPERTIES: -:file: jabber-si-server.el -:END: - -#+BEGIN_SRC emacs-lisp -(jabber-disco-advertise-feature "http://jabber.org/protocol/si") - -#+END_SRC -***** jabber-si-profiles :variable: -Now, stream methods push data to profiles. It could be the other way around; not sure which is better. - -#+BEGIN_SRC emacs-lisp -(defvar jabber-si-profiles nil - "Supported SI profiles. - -Each entry is a list, containing: - * The namespace URI of the profile - * Accept function, taking entire IQ stanza, and signalling a 'forbidden' - error if request is declined; returning an XML node to return in - response, or nil of none needed - * \"Connection established\" function. See `jabber-si-stream-methods'.") - -#+END_SRC -***** jabber-si-process :function: -#+BEGIN_SRC emacs-lisp -(add-to-list 'jabber-iq-set-xmlns-alist - (cons "http://jabber.org/protocol/si" 'jabber-si-process)) -(defun jabber-si-process (jc xml-data) - - (let* ((to (jabber-xml-get-attribute xml-data 'from)) - (id (jabber-xml-get-attribute xml-data 'id)) - (query (jabber-iq-query xml-data)) - (profile (jabber-xml-get-attribute query 'profile)) - (si-id (jabber-xml-get-attribute query 'id)) - (feature (car (jabber-xml-get-children query 'feature)))) - (message "Receiving SI with profile '%s'" profile) - - (let (stream-method - ;; Find profile - (profile-data (assoc profile jabber-si-profiles))) - ;; Now, feature negotiation for stream type (errors - ;; don't match XEP-0095, so convert) - (condition-case err - (setq stream-method (jabber-fn-intersection - (jabber-fn-parse feature 'request) - (list (cons "stream-method" (mapcar 'car jabber-si-stream-methods))))) - (jabber-error - (jabber-signal-error "cancel" 'bad-request nil - '((no-valid-streams ((xmlns . "http://jabber.org/protocol/si"))))))) - (unless profile-data - ;; profile not understood - (jabber-signal-error "cancel" 'bad-request nil - '((bad-profile ((xmlns . "http://jabber.org/protocol/si")))))) - (let* ((profile-accept-function (nth 1 profile-data)) - ;; accept-function might throw a "forbidden" error - ;; on user cancel - (profile-response (funcall profile-accept-function jc xml-data)) - (profile-connected-function (nth 2 profile-data)) - (stream-method-id (nth 1 (assoc "stream-method" stream-method))) - (stream-data (assoc stream-method-id jabber-si-stream-methods)) - (stream-accept-function (nth 2 stream-data))) - ;; prepare stream for the transfer - (funcall stream-accept-function jc to si-id profile-connected-function) - ;; return result of feature negotiation of stream type - (jabber-send-iq jc to "result" - `(si ((xmlns . "http://jabber.org/protocol/si")) - ,@profile-response - (feature ((xmlns . "http://jabber.org/protocol/feature-neg")) - ,(jabber-fn-encode stream-method 'response))) - nil nil nil nil - id) - )))) - -#+END_SRC -*** SI File Transfer ([[https://xmpp.org/extensions/xep-0096.html][XEP-0096]]) :xep_deprecated: -**** common -:PROPERTIES: -:file: jabber-ft-common.el -:END: - -***** jabber-ft-md5sum-program :custom:variable: -#+BEGIN_SRC emacs-lisp -(defcustom jabber-ft-md5sum-program (or (when (executable-find "md5") - (list (executable-find "md5") "-n")) - (when (executable-find "md5sum") - (list (executable-find "md5sum")))) - "The program to use to calculate MD5 sums of files. -The first item should be the name of the program, and the remaing -items the arguments. The file name is appended as the last -argument." - :type '(repeat string) - :group 'jabber) - -#+END_SRC -***** jabber-ft-get-md5 :function: -#+BEGIN_SRC emacs-lisp -(defun jabber-ft-get-md5 (file-name) - "Get MD5 sum of FILE-NAME, and return as hex string. -Return nil if no MD5 summing program is available." - (when jabber-ft-md5sum-program - (with-temp-buffer - (apply 'call-process (car jabber-ft-md5sum-program) nil t nil - (append (cdr jabber-ft-md5sum-program) (list file-name))) - ;; Output is "hexsum filename" - (goto-char (point-min)) - (forward-word 1) - (buffer-substring (point-min) (point))))) - -#+END_SRC -**** client -:PROPERTIES: -:file: jabber-ft-client.el -:END: - -#+BEGIN_SRC emacs-lisp -(eval-when-compile (require 'cl)) - -#+END_SRC -***** jabber-ft-send :command: -#+BEGIN_SRC emacs-lisp -(defun jabber-ft-send (jc jid filename desc) - "Attempt to send FILENAME to JID." - (interactive (list (jabber-read-account) - (jabber-read-jid-completing "Send file to: " nil nil nil 'full t) - (read-file-name "Send which file: " nil nil t) - (jabber-read-with-input-method "Description (optional): "))) - (if (zerop (length desc)) (setq desc nil)) - (setq filename (expand-file-name filename)) - (access-file filename "Couldn't open file") - - (let* ((attributes (file-attributes filename)) - (size (nth 7 attributes)) - (date (nth 5 attributes)) - (hash (jabber-ft-get-md5 filename))) - (jabber-si-initiate jc jid "http://jabber.org/protocol/si/profile/file-transfer" - `(file ((xmlns . "http://jabber.org/protocol/si/profile/file-transfer") - (name . ,(file-name-nondirectory filename)) - (size . ,size) - (date . ,(jabber-encode-time date)) - ,@(when hash - (list (cons 'hash hash)))) - (desc () ,desc)) - (lexical-let ((filename filename)) - (lambda (jc jid sid send-data-function) - (jabber-ft-do-send - jid sid send-data-function filename)))))) - -#+END_SRC -***** jabber-ft-do-send :function: -#+BEGIN_SRC emacs-lisp -(defun jabber-ft-do-send (jid sid send-data-function filename) - (if (stringp send-data-function) - (message "File sending failed: %s" send-data-function) - (with-temp-buffer - (insert-file-contents-literally filename) - - ;; Ever heard of buffering? - (funcall send-data-function (buffer-string)) - (message "File transfer completed"))) - ;; File transfer is monodirectional, so ignore received data. - #'ignore) - -#+END_SRC -**** server -:PROPERTIES: -:file: jabber-ft-server.el -:END: - -***** jabber-ft-sessions :variable: -#+BEGIN_SRC emacs-lisp -(defvar jabber-ft-sessions nil - "Alist, where keys are (sid jid), and values are buffers of the files.") - -#+END_SRC -***** jabber-ft-size :variable: -#+BEGIN_SRC emacs-lisp -(defvar jabber-ft-size nil - "Size of the file that is being downloaded") - -#+END_SRC -***** jabber-ft-md5-hash :variable: -#+BEGIN_SRC emacs-lisp -(defvar jabber-ft-md5-hash nil - "MD5 hash of the file that is being downloaded") - -#+END_SRC - -#+BEGIN_SRC emacs-lisp -(jabber-disco-advertise-feature "http://jabber.org/protocol/si/profile/file-transfer") - -#+END_SRC - -#+BEGIN_SRC emacs-lisp -(add-to-list 'jabber-si-profiles - (list "http://jabber.org/protocol/si/profile/file-transfer" - 'jabber-ft-accept - 'jabber-ft-server-connected)) - -#+END_SRC -***** jabber-ft-accept :function: -#+BEGIN_SRC emacs-lisp -(defun jabber-ft-accept (jc xml-data) - "Receive IQ stanza containing file transfer request, ask user" - (let* ((from (jabber-xml-get-attribute xml-data 'from)) - (query (jabber-iq-query xml-data)) - (si-id (jabber-xml-get-attribute query 'id)) - ;; TODO: check namespace - (file (car (jabber-xml-get-children query 'file))) - (name (jabber-xml-get-attribute file 'name)) - (size (jabber-xml-get-attribute file 'size)) - (date (jabber-xml-get-attribute file 'date)) - (md5-hash (jabber-xml-get-attribute file 'hash)) - (desc (car (jabber-xml-node-children - (car (jabber-xml-get-children file 'desc))))) - (range (car (jabber-xml-get-children file 'range)))) - (unless (and name size) - ;; both name and size must be present - (jabber-signal-error "modify" 'bad-request)) - - (let ((question (format - "%s is sending you the file %s (%s bytes).%s Accept? " - (jabber-jid-displayname from) - name - size - (if (not (zerop (length desc))) - (concat " Description: '" desc "'") - "")))) - (unless (yes-or-no-p question) - (jabber-signal-error "cancel" 'forbidden))) - - ;; default is to save with given name, in current directory. - ;; maybe that's bad; maybe should be customizable. - (let* ((file-name (read-file-name "Download to: " nil nil nil name)) - (buffer (create-file-buffer file-name))) - (message "Starting download of %s..." (file-name-nondirectory file-name)) - (with-current-buffer buffer - (kill-all-local-variables) - (setq buffer-file-coding-system 'binary) - ;; For Emacs, switch buffer to unibyte _before_ anything goes into it, - ;; otherwise binary files are corrupted. For XEmacs, it isn't needed, - ;; and it also doesn't have set-buffer-multibyte. - (if (fboundp 'set-buffer-multibyte) - (set-buffer-multibyte nil)) - (set-visited-file-name file-name t) - (set (make-local-variable 'jabber-ft-size) - (string-to-number size)) - (set (make-local-variable 'jabber-ft-md5-hash) - md5-hash)) - (add-to-list 'jabber-ft-sessions - (cons (list si-id from) buffer))) - - ;; to support range, return something sensible here - nil)) - -#+END_SRC -***** jabber-ft-server-connected :function: -#+BEGIN_SRC emacs-lisp -(defun jabber-ft-server-connected (jc jid sid send-data-function) - ;; We don't really care about the send-data-function. But if it's - ;; a string, it means that we have no connection. - (if (stringp send-data-function) - (message "File receiving failed: %s" send-data-function) - ;; On success, we just return our data receiving function. - 'jabber-ft-data)) - -#+END_SRC -***** jabber-ft-data :function: -#+BEGIN_SRC emacs-lisp -(defun jabber-ft-data (jc jid sid data) - "Receive chunk of transferred file." - (let ((buffer (cdr (assoc (list sid jid) jabber-ft-sessions)))) - (with-current-buffer buffer - ;; If data is nil, there is no more data. - ;; But maybe the remote entity doesn't close the stream - - ;; then we have to keep track of file size to know when to stop. - ;; Return value is whether to keep connection open. - (when data - (insert data)) - (if (and data (< (buffer-size) jabber-ft-size)) - t - (basic-save-buffer) - (if (and jabber-ft-md5-hash - (let ((file-hash (jabber-ft-get-md5 buffer-file-name))) - (and file-hash - (not (string= file-hash jabber-ft-md5-hash))))) - ;; hash mismatch! - (progn - (message "%s downloaded - CHECKSUM MISMATCH!" - (file-name-nondirectory buffer-file-name)) - (sleep-for 5)) - ;; all is fine - (message "%s downloaded" (file-name-nondirectory buffer-file-name))) - (kill-buffer buffer) - nil)))) - -#+END_SRC -*** SOCKS5 Bytestreams ([[https://xmpp.org/extensions/xep-0065.html][XEP-0065]]) -:PROPERTIES: -:file: jabber-socks5.el -:END: - -#+BEGIN_SRC emacs-lisp -(eval-when-compile (require 'cl)) - -#+END_SRC -**** jabber-socks5-pending-sessions :variable: -#+BEGIN_SRC emacs-lisp -(defvar jabber-socks5-pending-sessions nil - "List of pending sessions. - -Each entry is a list, containing: - * Stream ID - * Full JID of initiator - * State machine managing the session") - -#+END_SRC -**** jabber-socks5-active-sessions :variable: -#+BEGIN_SRC emacs-lisp -(defvar jabber-socks5-active-sessions nil - "List of active sessions. - -Each entry is a list, containing: - * Network connection - * Stream ID - * Full JID of initiator - * Profile data function") - -#+END_SRC -**** jabber-socks5-proxies :custom:variable: -#+BEGIN_SRC emacs-lisp -(defcustom jabber-socks5-proxies nil - "JIDs of XEP-0065 proxies to use for file transfer. -Put preferred ones first." - :type '(repeat string) - :group 'jabber -; :set 'jabber-socks5-set-proxies) - ) - -#+END_SRC -**** jabber-socks5-proxies-data :variable: -#+BEGIN_SRC emacs-lisp -(defvar jabber-socks5-proxies-data nil - "Alist containing information about proxies. -Keys of the alist are strings, the JIDs of the proxies. -Values are \"streamhost\" XML nodes.") - -#+END_SRC - -#+BEGIN_SRC emacs-lisp -(jabber-disco-advertise-feature "http://jabber.org/protocol/bytestreams") - -#+END_SRC - -#+BEGIN_SRC emacs-lisp -(add-to-list 'jabber-si-stream-methods - (list "http://jabber.org/protocol/bytestreams" - 'jabber-socks5-client-1 - 'jabber-socks5-accept)) - -#+END_SRC -**** jabber-socks5-set-proxies :function: -#+BEGIN_SRC emacs-lisp -(defun jabber-socks5-set-proxies (symbol value) - "Set `jabber-socks5-proxies' and query proxies. -This is the set function of `jabber-socks5-proxies-data'." - (set-default symbol value) - (when jabber-connections - (jabber-socks5-query-all-proxies))) - -#+END_SRC -**** jabber-socks5-query-all-proxies :command: -#+BEGIN_SRC emacs-lisp -(defun jabber-socks5-query-all-proxies (jc &optional callback) - "Ask all proxies in `jabber-socks5-proxies' for connection information. -If CALLBACK is non-nil, call it with no arguments when all -proxies have answered." - (interactive (list (jabber-read-account))) - (setq jabber-socks5-proxies-data nil) - (dolist (proxy jabber-socks5-proxies) - (jabber-socks5-query-proxy jc proxy callback))) - -#+END_SRC -**** jabber-socks5-query-proxy :function: -#+BEGIN_SRC emacs-lisp -(defun jabber-socks5-query-proxy (jc jid &optional callback) - "Query the SOCKS5 proxy specified by JID for IP and port number." - (jabber-send-iq jc jid "get" - '(query ((xmlns . "http://jabber.org/protocol/bytestreams"))) - #'jabber-socks5-process-proxy-response (list callback t) - #'jabber-socks5-process-proxy-response (list callback nil))) - -#+END_SRC -**** jabber-socks5-process-proxy-response :function: -#+BEGIN_SRC emacs-lisp -(defun jabber-socks5-process-proxy-response (jc xml-data closure-data) - "Process response from proxy query." - (let* ((query (jabber-iq-query xml-data)) - (from (jabber-xml-get-attribute xml-data 'from)) - (streamhosts (jabber-xml-get-children query 'streamhost))) - - (let ((existing-entry (assoc from jabber-socks5-proxies-data))) - (when existing-entry - (setq jabber-socks5-proxies-data - (delq existing-entry jabber-socks5-proxies-data)))) - - (destructuring-bind (callback successp) closure-data - (when successp - (setq jabber-socks5-proxies-data - (cons (cons from streamhosts) - jabber-socks5-proxies-data))) - (message "%s from %s. %d of %d proxies have answered." - (if successp "Response" "Error") from - (length jabber-socks5-proxies-data) (length jabber-socks5-proxies)) - (when (and callback (= (length jabber-socks5-proxies-data) (length jabber-socks5-proxies))) - (funcall callback))))) - -#+END_SRC - -#+BEGIN_SRC emacs-lisp -(define-state-machine jabber-socks5 - :start ((jc jid sid profile-function role) - "Start XEP-0065 bytestream with JID. -SID is the session ID used. -PROFILE-FUNCTION is the function to call upon success. See `jabber-si-stream-methods'. -ROLE is either :initiator or :target. The initiator sends an IQ -set; the target waits for one." - (let ((new-state-data (list :jc jc - :jid jid - :sid sid - :profile-function profile-function - :role role)) - (new-state - ;; We want information about proxies; it might be needed in - ;; various situations. - (cond - ((null jabber-socks5-proxies) - ;; We know no proxy addresses. Try to find them by disco. - 'seek-proxies) - ((null jabber-socks5-proxies-data) - ;; We need to query the proxies for addresses. - 'query-proxies) - ;; So, we have our proxies. - (t - 'initiate)))) - (list new-state new-state-data nil)))) - -#+END_SRC -**** jabber-socks5-accept :function: -#+BEGIN_SRC emacs-lisp -(defun jabber-socks5-accept (jc jid sid profile-function) - "Remember that we are waiting for connection from JID, with stream id SID" - ;; asking the user for permission is done in the profile - (add-to-list 'jabber-socks5-pending-sessions - (list sid jid (start-jabber-socks5 jc jid sid profile-function :target)))) - -#+END_SRC - -#+BEGIN_SRC emacs-lisp -(define-enter-state jabber-socks5 seek-proxies (fsm state-data) - ;; Look for items at the server. - (let* ((jc (plist-get state-data :jc)) - (server (jabber-jid-server (jabber-connection-jid jc)))) - (jabber-disco-get-items jc - server - nil - (lambda (jc fsm result) - (fsm-send-sync fsm (cons :items result))) - fsm)) - ;; Spend no more than five seconds looking for a proxy. - (list state-data 5)) - -#+END_SRC - -#+BEGIN_SRC emacs-lisp -(define-state jabber-socks5 seek-proxies (fsm state-data event callback) - "Collect disco results, looking for a bytestreams proxy." - ;; We put the number of outstanding requests as :remaining-info in - ;; the state-data plist. - (cond - ;; We're not ready to handle the IQ stanza yet - ((eq (car-safe event) :iq) - :defer) - - ;; Got list of items at the server. - ((eq (car-safe event) :items) - (dolist (entry (cdr event)) - ;; Each entry is ["name" "jid" "node"]. We send a disco info - ;; request to everything without a node. - (when (null (aref entry 2)) - (lexical-let ((jid (aref entry 1))) - (jabber-disco-get-info - (plist-get state-data :jc) - jid nil - (lambda (jc fsm result) - (fsm-send-sync fsm (list :info jid result))) - fsm)))) - ;; Remember number of requests sent. But if none, we just go on. - (if (cdr event) - (list 'seek-proxies (plist-put state-data :remaining-info (length (cdr event))) :keep) - (list 'initiate state-data nil))) - - ;; Got disco info from an item at the server. - ((eq (car-safe event) :info) - (fsm-debug-output "got disco event") - ;; Count the response. - (plist-put state-data :remaining-info (1- (plist-get state-data :remaining-info))) - (unless (eq (first (third event)) 'error) - (let ((identities (first (third event)))) - ;; Is it a bytestream proxy? - (when (dolist (identity identities) - (when (and (string= (aref identity 1) "proxy") - (string= (aref identity 2) "bytestreams")) - (return t))) - ;; Yes, it is. Add it to the list. - (push (second event) jabber-socks5-proxies)))) - - ;; Wait for more responses, if any are to be expected. - (if (zerop (plist-get state-data :remaining-info)) - ;; No more... go on to querying the proxies. - (list 'query-proxies state-data nil) - ;; We expect more responses... - (list 'seek-proxies state-data :keep))) - - ((eq event :timeout) - ;; We can't wait anymore... - (list 'query-proxies state-data nil)))) - -#+END_SRC - -#+BEGIN_SRC emacs-lisp -(define-enter-state jabber-socks5 query-proxies (fsm state-data) - (jabber-socks5-query-all-proxies - (plist-get state-data :jc) - (lexical-let ((fsm fsm)) - (lambda () (fsm-send-sync fsm :proxies)))) - (list state-data 5)) - -#+END_SRC - -#+BEGIN_SRC emacs-lisp -(define-state jabber-socks5 query-proxies (fsm state-data event callback) - "Query proxies in `jabber-socks5-proxies'." - (cond - ;; Can't handle the iq stanza yet... - ((eq (car-safe event) :iq) - :defer) - - ((eq (car-safe event) :info) - ;; stray event... do nothing - (list 'query-proxies state-data :keep)) - - ;; Got response/error from all proxies, or timeout - ((memq event '(:proxies :timeout)) - (list 'initiate state-data nil)))) - -#+END_SRC - -#+BEGIN_SRC emacs-lisp -(define-enter-state jabber-socks5 initiate (fsm state-data) - ;; Sort the alist jabber-socks5-proxies-data such that the - ;; keys are in the same order as in jabber-socks5-proxies. - (setq jabber-socks5-proxies-data - (sort jabber-socks5-proxies-data - #'(lambda (a b) - (> (length (member (car a) jabber-socks5-proxies)) - (length (member (car b) jabber-socks5-proxies)))))) - - ;; If we're the initiator, send initiation stanza. - (when (eq (plist-get state-data :role) :initiator) - ;; This is where initiation of server sockets would go - - (jabber-send-iq - (plist-get state-data :jc) - (plist-get state-data :jid) "set" - `(query ((xmlns . "http://jabber.org/protocol/bytestreams") - (sid . ,(plist-get state-data :sid))) - ,@(mapcar - #'(lambda (proxy) - (mapcar - #'(lambda (streamhost) - (list 'streamhost - (list (cons 'jid (jabber-xml-get-attribute streamhost 'jid)) - (cons 'host (jabber-xml-get-attribute streamhost 'host)) - (cons 'port (jabber-xml-get-attribute streamhost 'port))) - ;; (proxy ((xmlns . "http://affinix.com/jabber/stream"))) - )) - (cdr proxy))) - jabber-socks5-proxies-data) - ;; (fast ((xmlns . "http://affinix.com/jabber/stream"))) - ) - (lexical-let ((fsm fsm)) - (lambda (jc xml-data closure-data) - (fsm-send-sync fsm (list :iq xml-data)))) - nil - ;; TODO: error handling - #'jabber-report-success "SOCKS5 negotiation")) - - ;; If we're the target, we just wait for an incoming stanza. - (list state-data nil)) - -#+END_SRC -**** jabber-socks5-process :function: -#+BEGIN_SRC emacs-lisp -(add-to-list 'jabber-iq-set-xmlns-alist - (cons "http://jabber.org/protocol/bytestreams" 'jabber-socks5-process)) -(defun jabber-socks5-process (jc xml-data) - "Accept IQ get for SOCKS5 bytestream" - (let* ((jid (jabber-xml-get-attribute xml-data 'from)) - (id (jabber-xml-get-attribute xml-data 'id)) - (query (jabber-iq-query xml-data)) - (sid (jabber-xml-get-attribute query 'sid)) - (session (dolist (pending-session jabber-socks5-pending-sessions) - (when (and (equal sid (nth 0 pending-session)) - (equal jid (nth 1 pending-session))) - (return pending-session))))) - ;; check that we really are expecting this session - (unless session - (jabber-signal-error "auth" 'not-acceptable)) - - (setq jabber-socks5-pending-sessions (delq session jabber-socks5-pending-sessions)) - (fsm-send-sync (nth 2 session) (list :iq xml-data)) - - ;; find streamhost to connect to -;; (let* ((streamhosts (jabber-xml-get-children query 'streamhost)) -;; (streamhost (dolist (streamhost streamhosts) -;; (let ((connection (jabber-socks5-connect streamhost sid jid (concat jabber-username "@" jabber-server "/" jabber-resource)))) -;; (when connection -;; ;; We select the first streamhost that we are able to connect to. -;; (push (list connection sid jid profile-data-function) -;; jabber-socks5-active-sessions) -;; ;; Now set the filter, for the rest of the output -;; (set-process-filter connection #'jabber-socks5-filter) -;; (set-process-sentinel connection #'jabber-socks5-sentinel) -;; (return streamhost)))))) -;; (unless streamhost -;; (jabber-signal-error "cancel" 'item-not-found)) - -;; ;; tell initiator which streamhost we use -;; (jabber-send-iq jid "result" -;; `(query ((xmlns . "http://jabber.org/protocol/bytestreams")) -;; (streamhost-used ((jid . ,(jabber-xml-get-attribute streamhost 'jid))))) -;; nil nil nil nil id) -;; ;; now, as data is sent, it will be passed to the profile. -;; ) - )) - -#+END_SRC - -#+BEGIN_SRC emacs-lisp -(define-state jabber-socks5 initiate (fsm state-data event callback) - (let* ((jc (plist-get state-data :jc)) - (jc-data (fsm-get-state-data jc)) - (our-jid (concat (plist-get jc-data :username) "@" - (plist-get jc-data :server) "/" - (plist-get jc-data :resource))) - (their-jid (plist-get state-data :jid)) - (initiator-jid (if (eq (plist-get state-data :role) :initiator) our-jid their-jid)) - (target-jid (if (eq (plist-get state-data :role) :initiator) their-jid our-jid))) - (cond - ;; Stray event... - ((memq (car-safe event) '(:proxy :info)) - (list 'initiate state-data :keep)) - - ;; Incoming IQ - ((eq (car-safe event) :iq) - (let ((xml-data (second event))) - ;; This is either type "set" (with a list of streamhosts to - ;; use), or a "result" (indicating the streamhost finally used - ;; by the other party). - (cond - ((string= (jabber-xml-get-attribute xml-data 'type) "set") - ;; A "set" makes sense if we're the initiator and offered - ;; Psi's "fast mode". We don't yet, though, so this is only - ;; for target. - (dolist (streamhost (jabber-xml-get-children (jabber-iq-query xml-data) 'streamhost)) - (jabber-xml-let-attributes - (jid host port) streamhost - ;; This is where we would attempt to support zeroconf - (when (and jid host port) - (start-jabber-socks5-connection - jc initiator-jid target-jid jid - (plist-get state-data :sid) host port fsm)))) - - (list 'wait-for-connection (plist-put state-data :iq-id (jabber-xml-get-attribute xml-data 'id)) 30)) - - ((string= (jabber-xml-get-attribute xml-data 'type) "result") - ;; The other party has decided what streamhost to use. - (let* ((proxy-used (jabber-xml-get-attribute (jabber-xml-path xml-data '(query streamhost-used)) 'jid)) - ;; If JID is our own JID, we have probably already detected - ;; what connection to use. But that is a later problem... - (streamhosts (cdr (assoc proxy-used jabber-socks5-proxies-data)))) - ;; Try to connect to all addresses of this proxy... - (dolist (streamhost streamhosts) - (jabber-xml-let-attributes - (jid host port) streamhost - (when (and jid host port) - (start-jabber-socks5-connection - jc initiator-jid target-jid jid - (plist-get state-data :sid) host port fsm))))) - - (list 'wait-for-connection state-data 30)))))))) - -#+END_SRC - -#+BEGIN_SRC emacs-lisp -(define-state-machine jabber-socks5-connection - :start - ((jc initiator-jid target-jid streamhost-jid sid host port socks5-fsm) - "Connect to a single XEP-0065 streamhost." - (let ((coding-system-for-read 'binary) - (coding-system-for-write 'binary)) - ;; make-network-process, which we really want, for asynchronous - ;; connection and such, was introduced in Emacs 22. - (if (fboundp 'make-network-process) - (let ((connection - (make-network-process - :name "socks5" - :buffer nil - :host host - :service (string-to-number port) - :nowait t - :filter (fsm-make-filter fsm) - :sentinel (fsm-make-sentinel fsm)))) - (list 'wait-for-connection - (list :jc jc - :connection connection - :initiator-jid initiator-jid - :target-jid target-jid - :streamhost-jid streamhost-jid - :sid sid - :socks5-fsm socks5-fsm) - 30)) - ;; So we open a stream, and wait for the connection to succeed. - (condition-case nil - (let ((connection - (open-network-stream "socks5" nil - host (string-to-number port)))) - (set-process-filter connection (fsm-make-filter fsm)) - (set-process-sentinel connection (fsm-make-sentinel fsm)) - (list 'authenticate - (list :jc jc - :connection connection - :initiator-jid initiator-jid - :target-jid target-jid - :streamhost-jid streamhost-jid - :sid sid - :socks5-fsm socks5-fsm) - nil)) - (error (list 'fail '() nil))))))) - -#+END_SRC - -#+BEGIN_SRC emacs-lisp -(define-state jabber-socks5-connection wait-for-connection - (fsm state-data event callback) - (cond - ((eq (car-safe event) :sentinel) - (let ((string (third event))) - (cond - ;; Connection succeeded - ((string= (substring string 0 4) "open") - (list 'authenticate state-data nil)) - ;; Connection failed - (t - (list 'fail state-data nil))))))) - -#+END_SRC - -#+BEGIN_SRC emacs-lisp -(define-enter-state jabber-socks5-connection authenticate - (fsm state-data) - "Send authenticate command." - ;; version: 5. number of auth methods supported: 1. - ;; which one: no authentication. - (process-send-string (plist-get state-data :connection) (string 5 1 0)) - (list state-data 30)) - -#+END_SRC - -#+BEGIN_SRC emacs-lisp -(define-state jabber-socks5-connection authenticate - (fsm state-data event callback) - "Receive response to authenticate command." - (cond - ((eq (car-safe event) :filter) - (let ((string (third event))) - ;; should return: - ;; version: 5. auth method to use: none - (if (string= string (string 5 0)) - ;; Authenticated. Send connect command. - (list 'connect state-data nil) - ;; Authentication failed... - (delete-process (second event)) - (list 'fail state-data nil)))) - - ((eq (car-safe event) :sentinel) - (list 'fail state-data nil)))) - -#+END_SRC - -#+BEGIN_SRC emacs-lisp -(define-enter-state jabber-socks5-connection connect (fsm state-data) - "Send connect command." - (let* ((sid (plist-get state-data :sid)) - (initiator (plist-get state-data :initiator-jid)) - (target (plist-get state-data :target-jid)) - (hash (sha1 (concat sid initiator target)))) - (process-send-string - (plist-get state-data :connection) - (concat (string 5 1 0 3 (length hash)) - hash - (string 0 0))) - (list state-data 30))) - -#+END_SRC - -#+BEGIN_SRC emacs-lisp -(define-state jabber-socks5-connection connect - (fsm state-data event callback) - "Receive response to connect command." - (cond - ((eq (car-safe event) :filter) - (let ((string (third event))) - (if (string= (substring string 0 2) (string 5 0)) - ;; connection established - (progn - (fsm-send (plist-get state-data :socks5-fsm) - (list :connected - (plist-get state-data :connection) - (plist-get state-data :streamhost-jid))) - ;; Our work is done - (list 'done nil)) - (list 'fail state-data nil)))) - ((eq (car-safe event) :sentinel) - (list 'fail state-data nil)))) - -#+END_SRC - -#+BEGIN_SRC emacs-lisp -(define-state jabber-socks5-connection done - (fsm state-data event callback) - ;; ignore all events - (list 'done nil nil)) - -#+END_SRC - -#+BEGIN_SRC emacs-lisp -(define-enter-state jabber-socks5-connection fail (fsm state-data) - ;; Notify parent fsm about failure - (fsm-send (plist-get state-data :socks5-fsm) - :not-connected) - (list nil nil)) - -#+END_SRC - -#+BEGIN_SRC emacs-lisp -(define-state jabber-socks5-connection fail - (fsm state-data event callback) - ;; ignore all events - (list 'fail nil nil)) - -#+END_SRC - -#+BEGIN_SRC emacs-lisp -(define-state jabber-socks5 wait-for-connection - (fsm state-data event callback) - (cond - ((eq (car-safe event) :connected) - (destructuring-bind (ignored connection streamhost-jid) event - (setq state-data (plist-put state-data :connection connection)) - ;; If we are expected to tell which streamhost we chose, do so. - (let ((iq-id (plist-get state-data :iq-id))) - (when iq-id - (jabber-send-iq - (plist-get state-data :jc) - (plist-get state-data :jid) "result" - `(query ((xmlns . "http://jabber.org/protocol/bytestreams")) - (streamhost-used ((jid . ,streamhost-jid)))) - nil nil nil nil - iq-id))) - - ;; If we are the initiator, we should activate the bytestream. - (if (eq (plist-get state-data :role) :initiator) - (progn - (jabber-send-iq - (plist-get state-data :jc) - streamhost-jid "set" - `(query ((xmlns . "http://jabber.org/protocol/bytestreams") - (sid . ,(plist-get state-data :sid))) - (activate nil ,(plist-get state-data :jid))) - (lambda (jc xml-data fsm) (fsm-send-sync fsm :activated)) fsm - (lambda (jc xml-data fsm) (fsm-send-sync fsm :activation-failed)) fsm) - (list 'wait-for-activation state-data 10)) - ;; Otherwise, we just let the data flow. - (list 'stream-activated state-data nil)))) - - ((eq event :not-connected) - ;; If we were counting the streamhosts, we would know when there - ;; are no more chances left. - (list 'wait-for-connection state-data :keep)) - - ((eq event :timeout) - (list 'fail (plist-put state-data :error "Timeout when connecting to streamhosts") nil)))) - -#+END_SRC - -#+BEGIN_SRC emacs-lisp -(define-state jabber-socks5 wait-for-activation - (fsm state-data event callback) - (cond - ((eq event :activated) - (list 'stream-activated state-data nil)) - ((eq event :activation-failed) - (list 'fail (plist-put state-data :error "Proxy activation failed") nil)) - - ;; Stray events from earlier state - ((eq (car-safe event) :connected) - ;; We just close the connection - (delete-process (second event)) - (list 'wait-for-activation state-data :keep)) - ((eq event :not-connected) - (list 'wait-for-activation state-data :keep)))) - -#+END_SRC - -#+BEGIN_SRC emacs-lisp -(define-enter-state jabber-socks5 stream-activated - (fsm state-data) - (let ((connection (plist-get state-data :connection)) - (jc (plist-get state-data :jc)) - (jid (plist-get state-data :jid)) - (sid (plist-get state-data :sid)) - (profile-function (plist-get state-data :profile-function))) - (set-process-filter connection (fsm-make-filter fsm)) - (set-process-sentinel connection (fsm-make-sentinel fsm)) - ;; Call the profile function, passing the data send function, and - ;; receiving the data receiving function. Put the data receiving - ;; function in the plist. - (list (plist-put state-data - :profile-data-function - (funcall profile-function - jc jid sid - (lexical-let ((fsm fsm)) - (lambda (data) - (fsm-send fsm (list :send data)))))) - nil))) - - -(define-state jabber-socks5 stream-activated - (fsm state-data event callback) - (let ((jc (plist-get state-data :jc)) - (connection (plist-get state-data :connection)) - (profile-data-function (plist-get state-data :profile-data-function)) - (sid (plist-get state-data :sid)) - (jid (plist-get state-data :jid))) - (cond - ((eq (car-safe event) :send) - (process-send-string connection (second event)) - (list 'stream-activated state-data nil)) - - ((eq (car-safe event) :filter) - ;; Pass data from connection to profile data function - ;; If the data function requests it, tear down the connection. - (unless (funcall profile-data-function jc jid sid (third event)) - (fsm-send fsm (list :sentinel (second event) "shutdown"))) - - (list 'stream-activated state-data nil)) - - ((eq (car-safe event) :sentinel) - ;; Connection terminated. Shuffle together the remaining data, - ;; and kill the buffer. - (delete-process (second event)) - (funcall profile-data-function jc jid sid nil) - (list 'closed nil nil)) - - ;; Stray events from earlier state - ((eq (car-safe event) :connected) - ;; We just close the connection - (delete-process (second event)) - (list 'stream-activated state-data nil)) - ((eq event :not-connected) - (list 'stream-activated state-data nil))))) - -#+END_SRC - -#+BEGIN_SRC emacs-lisp -(define-enter-state jabber-socks5 fail (fsm state-data) - "Tell our caller that we failed." - (let ((jc (plist-get state-data :jc)) - (jid (plist-get state-data :jid)) - (sid (plist-get state-data :sid)) - (profile-function (plist-get state-data :profile-function)) - (iq-id (plist-get state-data :iq-id))) - (funcall profile-function jc jid sid (plist-get state-data :error)) - - (when iq-id - (jabber-send-iq-error jc jid iq-id nil "cancel" - 'remote-server-not-found))) - (list nil nil)) - -#+END_SRC -**** jabber-socks5-client-1 :function: -#+BEGIN_SRC emacs-lisp -(defun jabber-socks5-client-1 (jc jid sid profile-function) - "Negotiate a SOCKS5 connection with JID. -This function simply starts a state machine." - (add-to-list 'jabber-socks5-pending-sessions - (list sid jid (start-jabber-socks5 jc jid sid profile-function :initiator)))) - -#+END_SRC -**** +jabber-socks5-client-2+ :function: -#+BEGIN_SRC emacs-lisp -;; (defun jabber-socks5-client-2 (xml-data jid sid profile-function) -;; "Contact has selected a streamhost to use. Connect to the proxy." -;; (let* ((query (jabber-iq-query xml-data)) -;; (streamhost-used (car (jabber-xml-get-children query 'streamhost-used))) -;; (proxy-used (jabber-xml-get-attribute streamhost-used 'jid)) -;; connection) -;; (let ((streamhosts-left (cdr (assoc proxy-used jabber-socks5-proxies-data)))) -;; (while (and streamhosts-left (not connection)) -;; (setq connection -;; (jabber-socks5-connect (car streamhosts-left) -;; sid -;; (concat jabber-username "@" jabber-server "/" jabber-resource) -;; jid)) -;; (setq streamhosts-left (cdr streamhosts-left)))) -;; (unless connection -;; (error "Couldn't connect to proxy %s" proxy-used)) - -;; ;; Activation is only needed for proxies. -;; (jabber-send-iq proxy-used "set" -;; `(query ((xmlns . "http://jabber.org/protocol/bytestreams") -;; (sid . ,sid)) -;; (activate () ,jid)) -;; (lexical-let ((jid jid) (sid sid) (profile-function profile-function) -;; (connection connection)) -;; (lambda (xml-data closure-data) -;; (jabber-socks5-client-3 xml-data jid sid profile-function connection))) nil -;; ;; TODO: report error to contact? -;; #'jabber-report-success "Proxy activation"))) - -;; (defun jabber-socks5-client-3 (xml-data jid sid profile-function proxy-connection) -;; "Proxy is activated. Start the transfer." -;; ;; The response from the proxy does not contain any interesting -;; ;; information, beyond success confirmation. - -;; (funcall profile-function jid sid -;; (lexical-let ((proxy-connection proxy-connection)) -;; (lambda (data) -;; (process-send-string proxy-connection data))))) - #+END_SRC *** In-Band Real Time Text (RTT) ([[https://xmpp.org/extensions/xep-0301.html][XEP-0301]]) :PROPERTIES: