Revision: mange@freemail.hu--2005/emacs-jabber--cvs-head--0--patch-248
Creator: Magnus Henoch <mange@freemail.hu> Merge file transfer work Patches applied: * mange@freemail.hu--2005/emacs-jabber--file-transfer--0--base-0 tag of mange@freemail.hu--2005/emacs-jabber--cvs-head--0--patch-243 * mange@freemail.hu--2005/emacs-jabber--file-transfer--0--patch-1 Merge fsm * mange@freemail.hu--2005/emacs-jabber--file-transfer--0--patch-2 Commit initial file transfer work * mange@freemail.hu--2005/emacs-jabber--file-transfer--0--patch-3 Really ignore disco items without nodes * mange@freemail.hu--2005/emacs-jabber--file-transfer--0--patch-4 Remove debug output * mange@freemail.hu--2005/emacs-jabber--file-transfer--0--patch-5 Wait for all disco info results, in case we need many proxies * mange@freemail.hu--2005/emacs-jabber--file-transfer--0--patch-6 Move parentheses * mange@freemail.hu--2005/emacs-jabber--file-transfer--0--patch-7 Fix termination of file transfers * mange@freemail.hu--2005/emacs-jabber--file-transfer--0--patch-8 Merge from CVS HEAD * mange@freemail.hu--2005/emacs-jabber--file-transfer--0--patch-9 Fix stupid bug in jabber-socks5 * mange@freemail.hu--2005/emacs-jabber--file-transfer--0--patch-10 kill-all-local-variables after opening buffer for file being downloaded * mange@freemail.hu--2005/emacs-jabber--file-transfer--0--patch-11 Load file transfer code by default * mange@freemail.hu--2005/emacs-jabber--file-transfer--0--patch-12 Remove obsolete documentation. Update NEWS. * mange@freemail.hu--2005/emacs-jabber--fsm--0--base-0 tag of mange@freemail.hu--2005/emacs-jabber--cvs-head--0--patch-243 * mange@freemail.hu--2005/emacs-jabber--fsm--0--patch-1 Add fsm.el
This commit is contained in:
parent
15b148e570
commit
14ae208a95
3
NEWS
3
NEWS
|
@ -15,6 +15,9 @@ Viewing and publishing JEP-0153 avatars (vCard-based) is now
|
|||
supported.
|
||||
(Not documented yet)
|
||||
|
||||
** File transfer
|
||||
(Not documented yet)
|
||||
|
||||
* New features in jabber.el 0.7
|
||||
|
||||
** SSL connections possible
|
||||
|
|
|
@ -1,55 +0,0 @@
|
|||
-*- outline -*-
|
||||
* File transfer
|
||||
|
||||
This release of jabber.el contains some support for file transfer.
|
||||
Both sending and receiving files are supported. Since this feature
|
||||
needs more testing, it is not enabled by default. To enable it, add
|
||||
|
||||
(require 'jabber-ft-server)
|
||||
(require 'jabber-ft-client)
|
||||
(require 'jabber-socks5)
|
||||
|
||||
to your .emacs file. Please share your experiences - does it work for
|
||||
you? Can you suggest any improvements?
|
||||
|
||||
** Sending files
|
||||
|
||||
Sending files over Jabber normally requires the ability to listen on a
|
||||
network port. As of Emacs 21.3 and XEmacs 21.4, elisp programs can't
|
||||
do this, so you have to specify a JEP-0065 proxy. The variable
|
||||
jabber-socks5-proxies is a list of proxies to use.
|
||||
"proxy.jabber.cd.chalmers.se" is the only proxy I know of.
|
||||
|
||||
After you have specified one or more proxies, jabber.el needs to know
|
||||
their network addresses. Type M-x jabber-socks5-query-all-proxies,
|
||||
and watch the progress in the echo area. Note that you have to be
|
||||
connected when you do this, and that you have to do this every
|
||||
session.
|
||||
|
||||
To send a file, type M-x jabber-ft-send. You will be asked for which
|
||||
file to send, and whom to send it to. You have to specify a complete
|
||||
JID with resource, such as user@domain/resource - only user@domain
|
||||
will not work. To see the resources of your contacts, set
|
||||
jabber-show-resources to t and type M-x jabber-display-roster.
|
||||
|
||||
While the file is being sent, your Emacs will be locked up and you
|
||||
can't do anything else. Hopefully, this will be fixed some time.
|
||||
|
||||
** Receiving files
|
||||
|
||||
When someone tries to send a file to you, you will get a message
|
||||
either in the echo area or in a dialog box, asking you to confirm.
|
||||
You will also be asked for where to save the file.
|
||||
|
||||
Receiving a file should not cause any interruption to your work. If
|
||||
it does, please tell.
|
||||
|
||||
** Protocol details
|
||||
|
||||
See JEPs 95, 96 and 65.
|
||||
|
||||
SOCKS5 (JEP-0065) is the only stream method currently supported by
|
||||
jabber.el, in conflict with JEP-0096, which requires that In-Band
|
||||
Bytestreams be supported as well.
|
||||
|
||||
Range requests are not supported, neither in sending nor in receiving.
|
|
@ -0,0 +1,273 @@
|
|||
;;; fsm.el --- state machine library
|
||||
|
||||
;; Copyright (C) 2006 Magnus Henoch
|
||||
|
||||
;; Author: Magnus Henoch <mange@freemail.hu>
|
||||
;; Version: 0.1
|
||||
|
||||
;; This file is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation; either version 2, or (at your option)
|
||||
;; any later version.
|
||||
|
||||
;; This file is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs; see the file COPYING. If not, write to
|
||||
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
||||
;; Boston, MA 02110-1301, USA.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; fsm.el is an exercise in metaprogramming inspired by gen_fsm of
|
||||
;; Erlang/OTP. It aims to make asynchronous programming in Emacs Lisp
|
||||
;; easy and fun. By "asynchronous" I mean that long-lasting tasks
|
||||
;; don't interfer with normal editing.
|
||||
|
||||
;; Some people say that it would be nice if Emacs Lisp had threads
|
||||
;; and/or continuations. They are probably right, but there are few
|
||||
;; things that can't be made to run in the background using facilities
|
||||
;; already available: timers, filters and sentinels. As the code can
|
||||
;; become a bit messy when using such means, with callbacks everywhere
|
||||
;; and such things, it can be useful to structure the program as a
|
||||
;; state machine.
|
||||
|
||||
;; In this model, a state machine passes between different "states",
|
||||
;; which are actually only different event handler functions. The
|
||||
;; state machine receives "events" (from timers, filters, user
|
||||
;; requests, etc) and reacts to them, possibly entering another state,
|
||||
;; possibly returning a value.
|
||||
|
||||
;; The essential macros/functions are:
|
||||
;;
|
||||
;; define-state-machine - create start-FOO function
|
||||
;; define-state - event handler for each state (required)
|
||||
;; define-enter-state - called when entering a state (optional)
|
||||
;; fsm-send - send an event to a state machine
|
||||
;; fsm-call - send an event and wait for reply
|
||||
|
||||
;; fsm.el is similar to but different from Distel:
|
||||
;; <URL:http://fresh.homeunix.net/~luke/distel/>
|
||||
;; Emacs' tq library is a similar idea.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(eval-when-compile (require 'cl))
|
||||
|
||||
(defvar fsm-debug "*fsm-debug*"
|
||||
"Name of buffer for fsm debug messages.
|
||||
If nil, don't output debug messages.")
|
||||
|
||||
(defun fsm-debug-output (format &rest args)
|
||||
"Append debug output to buffer named by `fsm-debug'.
|
||||
FORMAT and ARGS are passed to `format'."
|
||||
(when fsm-debug
|
||||
(with-current-buffer (get-buffer-create fsm-debug)
|
||||
(save-excursion
|
||||
(goto-char (point-max))
|
||||
(insert (current-time-string) ": " (apply 'format format args) "\n")))))
|
||||
|
||||
(defmacro* define-state-machine (name &key start sleep)
|
||||
"Define a state machine class called NAME.
|
||||
A function called start-NAME is created, which uses the argument
|
||||
list and body specified in the :start argument. BODY should
|
||||
return a list of the form (STATE STATE-DATA [TIMEOUT]), where
|
||||
STATE is the initial state (defined by `define-state'),
|
||||
STATE-DATA is any object, and TIMEOUT is the number of seconds
|
||||
before a :timeout event will be sent to the state machine. BODY
|
||||
may refer to the instance being created through the dynamically
|
||||
bound variable `fsm'.
|
||||
|
||||
SLEEP-FUNCTION, if provided, takes one argument, the number of
|
||||
seconds to sleep while allowing events concerning this state
|
||||
machine to happen. There is probably no reason to change the
|
||||
default, which is accept-process-output with rearranged
|
||||
arguments.
|
||||
|
||||
\(fn NAME :start ((ARG ...) DOCSTRING BODY) [:sleep SLEEP-FUNCTION])"
|
||||
(let ((start-name (intern (concat "start-" (symbol-name name)))))
|
||||
(destructuring-bind (arglist docstring &body body) start
|
||||
(unless (stringp docstring)
|
||||
(error "Docstring is not a string"))
|
||||
`(progn
|
||||
(defun ,start-name ,arglist
|
||||
,docstring
|
||||
(fsm-debug-output "Starting %s" ',name)
|
||||
(let ((fsm (list :fsm ',name)))
|
||||
(destructuring-bind (state state-data &optional timeout)
|
||||
(progn ,@body)
|
||||
(nconc fsm (list :state nil :state-data nil
|
||||
:sleep ,(or sleep (lambda (secs) (accept-process-output nil secs)))
|
||||
:deferred nil))
|
||||
(fsm-update fsm state state-data timeout)
|
||||
fsm)))))))
|
||||
|
||||
(defmacro* define-state (fsm state-name arglist &body body)
|
||||
"Define a state called STATE-NAME in the state machine FSM.
|
||||
ARGLIST and BODY make a function that gets called when the state
|
||||
machine receives an event in this state. The arguments are:
|
||||
|
||||
FSM the state machine instance (treat it as opaque)
|
||||
STATE-DATA An object
|
||||
EVENT The occurred event, an object.
|
||||
CALLBACK A function of one argument that expects the response
|
||||
to this event, if any (often `ignore' is used)
|
||||
|
||||
If the event should return a response, the state machine should
|
||||
arrange to call CALLBACK at some point in the future (not necessarily
|
||||
in this handler).
|
||||
|
||||
The function should return a list of the form (NEW-STATE
|
||||
NEW-STATE-DATA TIMEOUT):
|
||||
|
||||
NEW-STATE The next state, a symbol
|
||||
NEW-STATE-DATA An object
|
||||
TIMEOUT A number: send timeout event after this many seconds
|
||||
nil: cancel existing timer
|
||||
:keep: let existing timer continue
|
||||
|
||||
Alternatively, the function may return the keyword :defer, in
|
||||
which case the event will be resent when the state machine enters
|
||||
another state."
|
||||
(let ((fn-name (intern (concat "fsm-" (symbol-name fsm) "-" (symbol-name state-name)))))
|
||||
`(defun ,fn-name ,arglist
|
||||
,@body)))
|
||||
|
||||
(defmacro* define-enter-state (fsm state-name arglist &body body)
|
||||
"Define a function to call when FSM enters the state STATE-NAME.
|
||||
ARGLIST and BODY make a function that gets called when the state
|
||||
machine enters this state. The arguments are:
|
||||
|
||||
FSM the state machine instance (treat it as opaque)
|
||||
STATE-DATA An object
|
||||
|
||||
The function should return a list of the form (NEW-STATE-DATA
|
||||
TIMEOUT):
|
||||
|
||||
NEW-STATE-DATA An object
|
||||
TIMEOUT A number: send timeout event after this many seconds
|
||||
nil: cancel existing timer
|
||||
:keep: let existing timer continue"
|
||||
(let ((fn-name (intern (concat "fsm-" (symbol-name fsm) "-enter-" (symbol-name state-name)))))
|
||||
`(defun ,fn-name ,arglist
|
||||
,@body)))
|
||||
|
||||
(defun fsm-start-timer (fsm secs)
|
||||
"Send a timeout event to FSM after SECS seconds.
|
||||
The timer is canceled if another event occurs before, unless the
|
||||
event handler explicitly asks to keep the timer."
|
||||
(fsm-stop-timer fsm)
|
||||
(setf (cddr fsm)
|
||||
(plist-put
|
||||
(cddr fsm)
|
||||
:timeout (run-with-timer secs
|
||||
nil
|
||||
#'fsm-send-sync fsm
|
||||
:timeout))))
|
||||
|
||||
(defun fsm-stop-timer (fsm)
|
||||
"Stop the timeout timer of FSM."
|
||||
(let ((timer (plist-get (cddr fsm) :timeout)))
|
||||
(when (timerp timer)
|
||||
(cancel-timer timer)
|
||||
(setf (cddr fsm) (plist-put (cddr fsm) :timeout nil)))))
|
||||
|
||||
(defun fsm-maybe-change-timer (fsm timeout)
|
||||
"Change the timer of FSM according to TIMEOUT."
|
||||
(cond
|
||||
((numberp timeout)
|
||||
(fsm-start-timer fsm timeout))
|
||||
((null timeout)
|
||||
(fsm-stop-timer fsm))
|
||||
;; :keep needs no timer change
|
||||
))
|
||||
|
||||
(defun fsm-send (fsm event &optional callback)
|
||||
"Send EVENT to FSM asynchronously.
|
||||
If the state machine generates a response, eventually call
|
||||
CALLBACK with the response as only argument."
|
||||
(run-with-timer 0.1 nil #'fsm-send-sync fsm event callback))
|
||||
|
||||
(defun fsm-update (fsm new-state new-state-data timeout)
|
||||
(let ((old-state (plist-get (cddr fsm) :state)))
|
||||
(plist-put (cddr fsm) :state new-state)
|
||||
(plist-put (cddr fsm) :state-data new-state-data)
|
||||
(fsm-maybe-change-timer fsm timeout)
|
||||
|
||||
;; On state change, call enter function and send deferred events
|
||||
;; again.
|
||||
(unless (eq old-state new-state)
|
||||
(fsm-debug-output "%s enters %s" (cadr fsm) new-state)
|
||||
(let ((enter-fn (intern (concat "fsm-" (symbol-name (cadr fsm)) "-enter-" (symbol-name new-state)))))
|
||||
(when (functionp enter-fn)
|
||||
(destructuring-bind (newer-state-data newer-timeout)
|
||||
(funcall enter-fn fsm new-state-data)
|
||||
(plist-put (cddr fsm) :state-data newer-state-data)
|
||||
(fsm-maybe-change-timer fsm newer-timeout))))
|
||||
|
||||
(let ((deferred (nreverse (plist-get (cddr fsm) :deferred))))
|
||||
(setf (cddr fsm)
|
||||
(plist-put (cddr fsm) :deferred nil))
|
||||
(dolist (event deferred)
|
||||
(apply 'fsm-send-sync fsm event))))))
|
||||
|
||||
(defun fsm-send-sync (fsm event &optional callback)
|
||||
"Send EVENT to FSM synchronously.
|
||||
If the state machine generates a response, eventually call
|
||||
CALLBACK with the response as only argument."
|
||||
(save-match-data
|
||||
(let* ((fsm-name (second fsm))
|
||||
(state (plist-get (cddr fsm) :state))
|
||||
(state-data (plist-get (cddr fsm) :state-data))
|
||||
(state-fn (intern (concat "fsm-" (symbol-name fsm-name)
|
||||
"-" (symbol-name state)))))
|
||||
(fsm-debug-output "Sent %S to %s in state %s" event fsm-name state)
|
||||
(let ((result (condition-case e
|
||||
(funcall state-fn fsm state-data event (or callback 'ignore))
|
||||
(error (cons :error-signaled e)))))
|
||||
;; Special case for deferring an event until next state change.
|
||||
(cond
|
||||
((eq result :defer)
|
||||
(let ((deferred (plist-get (cddr fsm) :deferred)))
|
||||
(plist-put (cddr fsm) :deferred (cons (list event callback) deferred))))
|
||||
((null result)
|
||||
(fsm-debug-output "Warning: event %S ignored in state %s" event state))
|
||||
((eq (car-safe result) :error-signaled)
|
||||
(fsm-debug-output "Error: %s" (error-message-string (cdr result))))
|
||||
(t
|
||||
(destructuring-bind (new-state new-state-data &optional timeout) result
|
||||
(fsm-update fsm new-state new-state-data timeout))))))))
|
||||
|
||||
(defun fsm-call (fsm event)
|
||||
"Send EVENT to FSM synchronously, and wait for a reply.
|
||||
Return the reply.
|
||||
`with-timeout' might be useful."
|
||||
(lexical-let (reply)
|
||||
(fsm-send-sync fsm event (lambda (r) (setq reply (list r))))
|
||||
(while (null reply)
|
||||
(fsm-sleep fsm 1))
|
||||
(car reply)))
|
||||
|
||||
(defun fsm-make-filter (fsm)
|
||||
"Return a filter function that sends events to FSM.
|
||||
Events sent are of the form (:filter PROCESS STRING)."
|
||||
(lexical-let ((fsm fsm))
|
||||
(lambda (process string)
|
||||
(fsm-send-sync fsm (list :filter process string)))))
|
||||
|
||||
(defun fsm-make-sentinel (fsm)
|
||||
"Return a sentinel function that sends events to FSM.
|
||||
Events sent are of the form (:sentinel PROCESS STRING)."
|
||||
(lexical-let ((fsm fsm))
|
||||
(lambda (process string)
|
||||
(fsm-send-sync fsm (list :sentinel process string)))))
|
||||
|
||||
(defun fsm-sleep (fsm secs)
|
||||
"Sleep up to SECS seconds in a way that lets FSM receive events."
|
||||
(funcall (plist-get (cddr fsm) :sleep) secs))
|
||||
|
||||
(provide 'fsm)
|
||||
;;; fsm.el ends here
|
|
@ -18,6 +18,8 @@
|
|||
;; along with this program; if not, write to the Free Software
|
||||
;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
||||
|
||||
(eval-when-compile (require 'cl))
|
||||
|
||||
(require 'jabber-si-client)
|
||||
(require 'jabber-util)
|
||||
|
||||
|
@ -44,16 +46,22 @@
|
|||
,@(when hash
|
||||
(list (cons 'hash hash))))
|
||||
(desc () ,desc))
|
||||
`(lambda (jid sid send-data-function)
|
||||
(jabber-ft-do-send jid sid send-data-function ,filename)))))
|
||||
(lexical-let ((filename filename))
|
||||
(lambda (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)
|
||||
(with-temp-buffer
|
||||
(insert-file-contents-literally filename)
|
||||
|
||||
;; Ever heard of buffering?
|
||||
(funcall send-data-function (buffer-string))
|
||||
(message "File transfer completed")))
|
||||
(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)
|
||||
|
||||
(provide 'jabber-ft-client)
|
||||
;;; arch-tag: fba686d5-37b5-4165-86c5-49b76fa0ea6e
|
||||
|
|
|
@ -33,7 +33,7 @@
|
|||
(add-to-list 'jabber-si-profiles
|
||||
(list "http://jabber.org/protocol/si/profile/file-transfer"
|
||||
'jabber-ft-accept
|
||||
'jabber-ft-data))
|
||||
'jabber-ft-server-connected))
|
||||
|
||||
(defun jabber-ft-accept (xml-data)
|
||||
"Receive IQ stanza containing file transfer request, ask user"
|
||||
|
@ -70,6 +70,7 @@
|
|||
(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,
|
||||
|
@ -85,6 +86,14 @@
|
|||
;; to support range, return something sensible here
|
||||
nil))
|
||||
|
||||
(defun jabber-ft-server-connected (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 (jid sid data)
|
||||
"Receive chunk of transferred file."
|
||||
(let ((buffer (cdr (assoc (list sid jid) jabber-ft-sessions))))
|
||||
|
@ -92,12 +101,15 @@
|
|||
;; 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)
|
||||
(message "%s downloaded" (file-name-nondirectory buffer-file-name))))))
|
||||
(message "%s downloaded" (file-name-nondirectory buffer-file-name))
|
||||
(kill-buffer buffer)
|
||||
nil))))
|
||||
|
||||
(provide 'jabber-ft-server)
|
||||
|
||||
|
|
|
@ -21,18 +21,14 @@
|
|||
(require 'jabber-iq)
|
||||
(require 'jabber-feature-neg)
|
||||
|
||||
(defvar jabber-si-client-methods nil
|
||||
"Supported SI stream methods for initiation.
|
||||
|
||||
Each entry is a list, containing:
|
||||
* The namespace URI of the stream method
|
||||
* A function taking three arguments: JID, SID and profile function to call")
|
||||
(require 'jabber-si-common)
|
||||
|
||||
(defun jabber-si-initiate (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 function to call upon success.
|
||||
PROFILE-FUNCTION is the \"connection established\" function.
|
||||
See `jabber-si-stream-methods'.
|
||||
MIME-TYPE is the MIME type to specify.
|
||||
Returns the SID."
|
||||
|
||||
|
@ -47,7 +43,7 @@ Returns the SID."
|
|||
(feature ((xmlns . "http://jabber.org/protocol/feature-neg"))
|
||||
,(jabber-fn-encode (list
|
||||
(cons "stream-method"
|
||||
(mapcar 'car jabber-si-client-methods)))
|
||||
(mapcar 'car jabber-si-stream-methods)))
|
||||
'request)))
|
||||
#'jabber-si-initiate-process (cons profile-function sid)
|
||||
;; XXX: use other function here?
|
||||
|
@ -64,7 +60,7 @@ Returns the SID."
|
|||
(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-client-methods)))
|
||||
(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 from sid profile-function))))
|
||||
|
|
|
@ -0,0 +1,61 @@
|
|||
;;; jabber-si-common.el --- stream initiation (JEP-0095)
|
||||
|
||||
;; Copyright (C) 2006 Magnus Henoch
|
||||
|
||||
;; Author: Magnus Henoch <mange@freemail.hu>
|
||||
|
||||
;; This file is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation; either version 2, or (at your option)
|
||||
;; any later version.
|
||||
|
||||
;; This file is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs; see the file COPYING. If not, write to
|
||||
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
||||
;; Boston, MA 02110-1301, USA.
|
||||
|
||||
(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.")
|
||||
|
||||
(provide 'jabber-si-common)
|
||||
;; arch-tag: 9e7a5c8a-bdde-11da-8030-000a95c2fcd0
|
||||
;;; jabber-si-common.el ends here
|
|
@ -23,6 +23,8 @@
|
|||
(require 'jabber-disco)
|
||||
(require 'jabber-feature-neg)
|
||||
|
||||
(require 'jabber-si-common)
|
||||
|
||||
(add-to-list 'jabber-advertised-features "http://jabber.org/protocol/si")
|
||||
|
||||
;; Now, stream methods push data to profiles. It could be the other
|
||||
|
@ -35,17 +37,7 @@ Each entry is a list, containing:
|
|||
* 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
|
||||
* Data function, taking JID of initiator, stream ID, and string
|
||||
containing received data in binary form; receives `nil' on EOF.
|
||||
Returns non-nil to keep connection; nil to close it.")
|
||||
|
||||
(defvar jabber-si-stream-methods nil
|
||||
"Supported SI stream methods.
|
||||
|
||||
Each entry is a list, containing:
|
||||
* The namespace URI of the stream method
|
||||
* Accept function, taking JID of initiator, stream ID, profile
|
||||
data function (as above), preparing to accept a request")
|
||||
* \"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))
|
||||
|
@ -79,12 +71,12 @@ Each entry is a list, containing:
|
|||
;; accept-function might throw a "forbidden" error
|
||||
;; on user cancel
|
||||
(profile-response (funcall profile-accept-function xml-data))
|
||||
(profile-data-function (nth 2 profile-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 1 stream-data)))
|
||||
(stream-accept-function (nth 2 stream-data)))
|
||||
;; prepare stream for the transfer
|
||||
(funcall stream-accept-function to si-id profile-data-function)
|
||||
(funcall stream-accept-function to si-id profile-connected-function)
|
||||
;; return result of feature negotiation of stream type
|
||||
(jabber-send-iq to "result"
|
||||
`(si ((xmlns . "http://jabber.org/protocol/si"))
|
||||
|
|
710
jabber-socks5.el
710
jabber-socks5.el
|
@ -23,7 +23,9 @@
|
|||
(require 'jabber-disco)
|
||||
(require 'jabber-si-server)
|
||||
(require 'jabber-si-client)
|
||||
(require 'jabber-newdisco)
|
||||
|
||||
(require 'fsm)
|
||||
(eval-when-compile (require 'cl))
|
||||
|
||||
(defvar jabber-socks5-pending-sessions nil
|
||||
|
@ -32,7 +34,7 @@
|
|||
Each entry is a list, containing:
|
||||
* Stream ID
|
||||
* Full JID of initiator
|
||||
* Profile data function, to be called when data is received")
|
||||
* State machine managing the session")
|
||||
|
||||
(defvar jabber-socks5-active-sessions nil
|
||||
"List of active sessions.
|
||||
|
@ -60,12 +62,9 @@ Values are \"streamhost\" XML nodes.")
|
|||
|
||||
(add-to-list 'jabber-si-stream-methods
|
||||
(list "http://jabber.org/protocol/bytestreams"
|
||||
'jabber-socks5-client-1
|
||||
'jabber-socks5-accept))
|
||||
|
||||
(add-to-list 'jabber-si-client-methods
|
||||
(list "http://jabber.org/protocol/bytestreams"
|
||||
'jabber-socks5-client-1))
|
||||
|
||||
(defun jabber-socks5-set-proxies (symbol value)
|
||||
"Set `jabber-socks5-proxies' and query proxies.
|
||||
This is the set function of `jabber-socks5-proxies-data'."
|
||||
|
@ -73,21 +72,23 @@ This is the set function of `jabber-socks5-proxies-data'."
|
|||
(when *jabber-connected*
|
||||
(jabber-socks5-query-all-proxies)))
|
||||
|
||||
(defun jabber-socks5-query-all-proxies ()
|
||||
"Ask all proxies in `jabber-socks5-proxies' for connection information."
|
||||
(defun jabber-socks5-query-all-proxies (&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)
|
||||
(setq jabber-socks5-proxies-data nil)
|
||||
(dolist (proxy jabber-socks5-proxies)
|
||||
(jabber-socks5-query-proxy proxy)))
|
||||
(jabber-socks5-query-proxy proxy callback)))
|
||||
|
||||
(defun jabber-socks5-query-proxy (jid)
|
||||
(defun jabber-socks5-query-proxy (jid &optional callback)
|
||||
"Query the SOCKS5 proxy specified by JID for IP and port number."
|
||||
(jabber-send-iq jid "get"
|
||||
'(query ((xmlns . "http://jabber.org/protocol/bytestreams")))
|
||||
#'jabber-socks5-process-proxy-response t
|
||||
#'jabber-socks5-process-proxy-response nil))
|
||||
#'jabber-socks5-process-proxy-response (list callback t)
|
||||
#'jabber-socks5-process-proxy-response (list callback nil)))
|
||||
|
||||
(defun jabber-socks5-process-proxy-response (xml-data successp)
|
||||
(defun jabber-socks5-process-proxy-response (xml-data closure-data)
|
||||
"Process response from proxy query."
|
||||
(let* ((query (jabber-iq-query xml-data))
|
||||
(from (jabber-xml-get-attribute xml-data 'from))
|
||||
|
@ -98,19 +99,171 @@ This is the set function of `jabber-socks5-proxies-data'."
|
|||
(setq jabber-socks5-proxies-data
|
||||
(delq existing-entry jabber-socks5-proxies-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))))
|
||||
(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)))))
|
||||
|
||||
(defun jabber-socks5-accept (jid sid profile-data-function)
|
||||
(define-state-machine jabber-socks5
|
||||
:start ((jid sid profile-function role)
|
||||
"Start JEP-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 :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 (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 profile-data-function)))
|
||||
(list sid jid (start-jabber-socks5 jid sid profile-function :target))))
|
||||
|
||||
(define-enter-state jabber-socks5 seek-proxies (fsm state-data)
|
||||
;; Look for items at the server.
|
||||
(jabber-disco-get-items jabber-server nil
|
||||
(lambda (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
|
||||
jid nil
|
||||
(lambda (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
|
||||
(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 :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 (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 30))
|
||||
|
||||
(add-to-list 'jabber-iq-set-xmlns-alist
|
||||
(cons "http://jabber.org/protocol/bytestreams" 'jabber-socks5-process))
|
||||
|
@ -123,194 +276,383 @@ This is the set function of `jabber-socks5-proxies-data'."
|
|||
(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))))
|
||||
(profile-data-function (nth 2 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))
|
||||
;; (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.
|
||||
)))
|
||||
;; ;; 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.
|
||||
;; )
|
||||
))
|
||||
|
||||
(defun jabber-socks5-connect (streamhost sid initiator target)
|
||||
"Attempt to connect to STREAMHOST, authenticating with SID, INITIATOR and TARGET.
|
||||
Return nil on error. Return connection object on success.
|
||||
(define-state jabber-socks5 initiate (fsm state-data event callback)
|
||||
(let* ((our-jid (concat jabber-username "@" jabber-server "/" jabber-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))
|
||||
|
||||
STREAMHOST has the form
|
||||
\(streamhost ((host . HOST)
|
||||
(port . PORT)))
|
||||
;; 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
|
||||
initiator-jid target-jid jid
|
||||
(plist-get state-data :sid) host port fsm))))
|
||||
|
||||
Zeroconf is not supported."
|
||||
(message "Attempting SOCKS5 connection to %s (%s->%s, %s)" streamhost initiator target sid)
|
||||
(condition-case e
|
||||
(let ((coding-system-for-read 'binary)
|
||||
(coding-system-for-write 'binary)
|
||||
(host (jabber-xml-get-attribute streamhost 'host))
|
||||
(port (string-to-number (jabber-xml-get-attribute streamhost 'port))))
|
||||
;; is this the best way to send binary network output?
|
||||
(let ((socks5-connection (open-network-stream "socks5" (generate-new-buffer-name "socks5") host port)))
|
||||
(with-current-buffer (process-buffer socks5-connection)
|
||||
;; version: 5. number of auth methods supported: 1.
|
||||
;; which one: no authentication.
|
||||
(process-send-string socks5-connection (string 5 1 0))
|
||||
;; wait for response
|
||||
(accept-process-output socks5-connection 15)
|
||||
;; should return:
|
||||
;; version: 5. auth method to use: none
|
||||
(unless (string= (buffer-substring 1 3) (string 5 0))
|
||||
(error "SOCKS5 authentication required"))
|
||||
(list 'wait-for-connection (plist-put state-data :iq-id (jabber-xml-get-attribute xml-data 'id)) 30))
|
||||
|
||||
;; send connect command
|
||||
(let ((hash (sha1-string (concat sid initiator target))))
|
||||
(process-send-string
|
||||
socks5-connection
|
||||
(concat (string 5 1 0 3 (length hash))
|
||||
hash
|
||||
(string 0 0))))
|
||||
((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
|
||||
initiator-jid target-jid jid
|
||||
(plist-get state-data :sid) host port fsm)))))
|
||||
|
||||
(accept-process-output socks5-connection 15)
|
||||
(unless (string= (buffer-substring 3 5) (string 5 0))
|
||||
(error "SOCKS5 failure"))
|
||||
(list 'wait-for-connection state-data 30))))))))
|
||||
|
||||
(message "SOCKS5 connection established")
|
||||
(define-state-machine jabber-socks5-connection
|
||||
:start
|
||||
((initiator-jid target-jid streamhost-jid sid host port socks5-fsm)
|
||||
"Connect to a single JEP-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 :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 :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)))))))
|
||||
|
||||
;; The information returned here is exactly the same that we sent...
|
||||
;; Not very exciting. Anyway, this part is done, we have a connection.
|
||||
(let* ((address-type (aref (buffer-substring 6 7) 0))
|
||||
(address-length (aref (buffer-substring 7 8) 0))
|
||||
(address (buffer-substring 8 (+ 8 address-length)))
|
||||
(address-port-string (buffer-substring (+ 8 address-length) (+ 8 address-length 2)))
|
||||
(address-port (+
|
||||
(* 256 (aref address-port-string 0))
|
||||
(* 1 (aref address-port-string 1)))))
|
||||
;;(message "Address type: %d\nAddress: %s\nPort: %d" address-type address address-port)
|
||||
(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)))))))
|
||||
|
||||
;; Delete all SOCKS5 data, leave room for the stream.
|
||||
(delete-region 1 (+ 8 address-length 2)))
|
||||
(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))
|
||||
|
||||
socks5-connection)))
|
||||
(error
|
||||
(message "SOCKS5 connection failed: %s" e)
|
||||
nil)))
|
||||
(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))))
|
||||
|
||||
(defun jabber-socks5-filter (connection data)
|
||||
"Pass data from connection to profile data function"
|
||||
(let* ((session (assq connection jabber-socks5-active-sessions))
|
||||
(sid (nth 1 session))
|
||||
(jid (nth 2 session))
|
||||
(profile-data-function (nth 3 session)))
|
||||
;; If the data function requests it, tear down the connection.
|
||||
(unless (funcall profile-data-function jid sid data)
|
||||
(jabber-socks5-sentinel connection nil))))
|
||||
((eq (car-safe event) :sentinel)
|
||||
(list 'fail state-data nil))))
|
||||
|
||||
(defun jabber-socks5-sentinel (process event-string)
|
||||
;; Connection terminated. Shuffle together the remaining data,
|
||||
;; and kill the buffer.
|
||||
(let* ((session (assq process jabber-socks5-active-sessions))
|
||||
(buffer (process-buffer process))
|
||||
(sid (nth 1 session))
|
||||
(jid (nth 2 session))
|
||||
(profile-data-function (nth 3 session)))
|
||||
(kill-buffer buffer)
|
||||
(delete-process process)
|
||||
(funcall profile-data-function jid sid nil)
|
||||
(setq jabber-socks5-active-sessions (delq session jabber-socks5-pending-sessions))))
|
||||
(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-string (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 :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
|
||||
streamhost-jid "set"
|
||||
`(query ((xmlns . "http://jabber.org/protocol/bytestreams")
|
||||
(sid . ,(plist-get state-data :sid)))
|
||||
(activate nil ,(plist-get state-data :jid)))
|
||||
(lambda (xml-data fsm) (fsm-send-sync fsm :activated)) fsm
|
||||
(lambda (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))
|
||||
(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
|
||||
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 ((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 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 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 ((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 jid sid (plist-get state-data :error))
|
||||
|
||||
(when iq-id
|
||||
(jabber-send-iq-error jid iq-id nil "cancel"
|
||||
'remote-server-not-found)))
|
||||
(list nil nil))
|
||||
|
||||
(defun jabber-socks5-client-1 (jid sid profile-function)
|
||||
"Negotiate a SOCKS5 connection with JID.
|
||||
This function simply sends a request; the response is handled elsewhere."
|
||||
;; TODO: start our own server if we can.
|
||||
(unless jabber-socks5-proxies
|
||||
(error "No proxies defined. Set `jabber-socks5-proxies'."))
|
||||
(unless jabber-socks5-proxies-data
|
||||
(error "No proxy data available. Run `jabber-socks5-query-all-proxies'."))
|
||||
This function simply starts a state machine."
|
||||
(add-to-list 'jabber-socks5-pending-sessions
|
||||
(list sid jid (start-jabber-socks5 jid sid profile-function :initiator))))
|
||||
|
||||
;; 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))))))
|
||||
;; (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))
|
||||
|
||||
(jabber-send-iq jid "set"
|
||||
`(query ((xmlns . "http://jabber.org/protocol/bytestreams")
|
||||
(sid . ,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)))))
|
||||
(cdr proxy)))
|
||||
jabber-socks5-proxies-data))
|
||||
(lexical-let ((jid jid) (sid sid) (profile-function profile-function))
|
||||
(lambda (xml-data closure-data)
|
||||
(jabber-socks5-client-2 xml-data jid sid profile-function))) nil
|
||||
;; TODO: error handling
|
||||
#'jabber-report-success "SOCKS5 negotiation"))
|
||||
;; ;; 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-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))
|
||||
;; (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.
|
||||
|
||||
;; 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)))))
|
||||
;; (funcall profile-function jid sid
|
||||
;; (lexical-let ((proxy-connection proxy-connection))
|
||||
;; (lambda (data)
|
||||
;; (process-send-string proxy-connection data)))))
|
||||
|
||||
(provide 'jabber-socks5)
|
||||
|
||||
|
|
|
@ -104,6 +104,10 @@
|
|||
(require 'jabber-vcard-avatars)
|
||||
(require 'jabber-autoaway)
|
||||
|
||||
(require 'jabber-ft-client)
|
||||
(require 'jabber-ft-server)
|
||||
(require 'jabber-socks5)
|
||||
|
||||
;; XXX: automate this some time
|
||||
(autoload 'jabber-export-roster "jabber-export"
|
||||
"Create buffer from which roster can be exported to a file."
|
||||
|
|
Loading…
Reference in New Issue