2004-04-07 20:03:51 +00:00
|
|
|
;; jabber-socks5.el - SOCKS5 bytestreams by JEP-0065
|
|
|
|
|
2007-04-28 14:34:57 +00:00
|
|
|
;; Copyright (C) 2003, 2004, 2007 - Magnus Henoch - mange@freemail.hu
|
2004-04-07 20:03:51 +00:00
|
|
|
;; Copyright (C) 2002, 2003, 2004 - tom berger - object@intelectronica.net
|
|
|
|
|
|
|
|
;; This file is a part of jabber.el.
|
|
|
|
|
|
|
|
;; This program is free software; you can redistribute it and/or modify
|
|
|
|
;; it under the terms of the GNU General Public License as published by
|
|
|
|
;; the Free Software Foundation; either version 2 of the License, or
|
|
|
|
;; (at your option) any later version.
|
|
|
|
|
|
|
|
;; This program is distributed in the hope that it will be useful,
|
|
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
|
;; GNU General Public License for more details.
|
|
|
|
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
|
|
|
;; along with this program; if not, write to the Free Software
|
|
|
|
;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
|
|
|
|
|
|
|
(require 'jabber-iq)
|
|
|
|
(require 'jabber-disco)
|
|
|
|
(require 'jabber-si-server)
|
2004-06-09 20:44:10 +00:00
|
|
|
(require 'jabber-si-client)
|
2006-07-15 12:15:50 +00:00
|
|
|
(require 'jabber-newdisco)
|
2004-04-07 20:03:51 +00:00
|
|
|
|
2006-07-15 12:15:50 +00:00
|
|
|
(require 'fsm)
|
2006-01-12 15:27:09 +00:00
|
|
|
(eval-when-compile (require 'cl))
|
|
|
|
|
2004-04-07 20:03:51 +00:00
|
|
|
(defvar jabber-socks5-pending-sessions nil
|
|
|
|
"List of pending sessions.
|
|
|
|
|
|
|
|
Each entry is a list, containing:
|
|
|
|
* Stream ID
|
2004-04-30 21:13:57 +00:00
|
|
|
* Full JID of initiator
|
2006-07-15 12:15:50 +00:00
|
|
|
* State machine managing the session")
|
2004-04-07 20:03:51 +00:00
|
|
|
|
2004-04-11 21:01:59 +00:00
|
|
|
(defvar jabber-socks5-active-sessions nil
|
|
|
|
"List of active sessions.
|
|
|
|
|
2004-05-01 16:00:21 +00:00
|
|
|
Each entry is a list, containing:
|
|
|
|
* Network connection
|
|
|
|
* Stream ID
|
|
|
|
* Full JID of initiator
|
|
|
|
* Profile data function")
|
2004-04-11 21:01:59 +00:00
|
|
|
|
2004-06-09 20:44:10 +00:00
|
|
|
(defcustom jabber-socks5-proxies nil
|
2004-06-23 16:54:43 +00:00
|
|
|
"JIDs of JEP-0065 proxies to use for file transfer.
|
|
|
|
Put preferred ones first."
|
2004-06-09 20:44:10 +00:00
|
|
|
: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.")
|
|
|
|
|
2004-04-07 20:03:51 +00:00
|
|
|
(add-to-list 'jabber-advertised-features "http://jabber.org/protocol/bytestreams")
|
|
|
|
|
|
|
|
(add-to-list 'jabber-si-stream-methods
|
2004-04-11 21:01:59 +00:00
|
|
|
(list "http://jabber.org/protocol/bytestreams"
|
2006-07-15 12:15:50 +00:00
|
|
|
'jabber-socks5-client-1
|
2004-05-01 16:00:21 +00:00
|
|
|
'jabber-socks5-accept))
|
2004-04-07 20:03:51 +00:00
|
|
|
|
2004-06-09 20:44:10 +00:00
|
|
|
(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-connected*
|
|
|
|
(jabber-socks5-query-all-proxies)))
|
|
|
|
|
2007-02-07 13:49:38 +00:00
|
|
|
(defun jabber-socks5-query-all-proxies (jc &optional callback)
|
2006-07-15 12:15:50 +00:00
|
|
|
"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."
|
2007-02-07 13:49:38 +00:00
|
|
|
(interactive (list (jabber-read-account)))
|
2004-06-09 20:44:10 +00:00
|
|
|
(setq jabber-socks5-proxies-data nil)
|
|
|
|
(dolist (proxy jabber-socks5-proxies)
|
2007-02-07 13:49:38 +00:00
|
|
|
(jabber-socks5-query-proxy jc proxy callback)))
|
2004-06-09 20:44:10 +00:00
|
|
|
|
2007-02-07 13:49:38 +00:00
|
|
|
(defun jabber-socks5-query-proxy (jc jid &optional callback)
|
2004-06-09 20:44:10 +00:00
|
|
|
"Query the SOCKS5 proxy specified by JID for IP and port number."
|
2007-02-07 13:49:38 +00:00
|
|
|
(jabber-send-iq jc jid "get"
|
2004-06-09 20:44:10 +00:00
|
|
|
'(query ((xmlns . "http://jabber.org/protocol/bytestreams")))
|
2006-07-15 12:15:50 +00:00
|
|
|
#'jabber-socks5-process-proxy-response (list callback t)
|
|
|
|
#'jabber-socks5-process-proxy-response (list callback nil)))
|
2004-06-09 20:44:10 +00:00
|
|
|
|
2007-02-07 13:49:38 +00:00
|
|
|
(defun jabber-socks5-process-proxy-response (jc xml-data closure-data)
|
2004-06-09 20:44:10 +00:00
|
|
|
"Process response from proxy query."
|
|
|
|
(let* ((query (jabber-iq-query xml-data))
|
|
|
|
(from (jabber-xml-get-attribute xml-data 'from))
|
2004-06-23 16:54:43 +00:00
|
|
|
(streamhosts (jabber-xml-get-children query 'streamhost)))
|
2004-06-09 20:44:10 +00:00
|
|
|
|
|
|
|
(let ((existing-entry (assoc from jabber-socks5-proxies-data)))
|
|
|
|
(when existing-entry
|
|
|
|
(setq jabber-socks5-proxies-data
|
|
|
|
(delq existing-entry jabber-socks5-proxies-data))))
|
|
|
|
|
2006-07-15 12:15:50 +00:00
|
|
|
(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
|
2007-02-07 13:49:38 +00:00
|
|
|
:start ((jc jid sid profile-function role)
|
2006-07-15 12:15:50 +00:00
|
|
|
"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."
|
2007-02-07 13:49:38 +00:00
|
|
|
(let ((new-state-data (list :jc jc
|
|
|
|
:jid jid
|
2006-07-15 12:15:50 +00:00
|
|
|
: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))))
|
|
|
|
|
2007-02-08 15:08:01 +00:00
|
|
|
(defun jabber-socks5-accept (jc jid sid profile-function)
|
2004-04-07 20:03:51 +00:00
|
|
|
"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
|
2007-02-08 15:08:01 +00:00
|
|
|
(list sid jid (start-jabber-socks5 jc jid sid profile-function :target))))
|
2006-07-15 12:15:50 +00:00
|
|
|
|
|
|
|
(define-enter-state jabber-socks5 seek-proxies (fsm state-data)
|
|
|
|
;; Look for items at the server.
|
2007-12-09 00:55:18 +00:00
|
|
|
(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))
|
2006-07-15 12:15:50 +00:00
|
|
|
;; 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
|
2007-02-07 13:49:38 +00:00
|
|
|
(plist-get state-data :jc)
|
2006-07-15 12:15:50 +00:00
|
|
|
jid nil
|
2007-02-07 13:49:38 +00:00
|
|
|
(lambda (jc fsm result)
|
2006-07-15 12:15:50 +00:00
|
|
|
(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
|
2007-02-07 13:49:38 +00:00
|
|
|
(plist-get state-data :jc)
|
|
|
|
(lexical-let ((fsm fsm))
|
|
|
|
(lambda () (fsm-send-sync fsm :proxies))))
|
2006-07-15 12:15:50 +00:00
|
|
|
(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
|
2007-02-07 13:49:38 +00:00
|
|
|
(plist-get state-data :jc)
|
2006-07-15 12:15:50 +00:00
|
|
|
(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))
|
2007-02-07 13:49:38 +00:00
|
|
|
(lambda (jc xml-data closure-data)
|
2006-07-15 12:15:50 +00:00
|
|
|
(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.
|
2007-04-28 14:34:57 +00:00
|
|
|
(list state-data nil))
|
2004-04-07 20:03:51 +00:00
|
|
|
|
|
|
|
(add-to-list 'jabber-iq-set-xmlns-alist
|
|
|
|
(cons "http://jabber.org/protocol/bytestreams" 'jabber-socks5-process))
|
2007-02-07 13:49:38 +00:00
|
|
|
(defun jabber-socks5-process (jc xml-data)
|
2004-04-07 20:03:51 +00:00
|
|
|
"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))
|
2004-04-30 21:13:57 +00:00
|
|
|
(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)))
|
2006-07-15 12:15:50 +00:00
|
|
|
(return pending-session)))))
|
2004-04-30 21:13:57 +00:00
|
|
|
;; check that we really are expecting this session
|
|
|
|
(unless session
|
2004-04-11 21:01:59 +00:00
|
|
|
(jabber-signal-error "auth" 'not-acceptable))
|
2004-04-07 20:03:51 +00:00
|
|
|
|
2004-04-30 21:13:57 +00:00
|
|
|
(setq jabber-socks5-pending-sessions (delq session jabber-socks5-pending-sessions))
|
2006-07-15 12:15:50 +00:00
|
|
|
(fsm-send-sync (nth 2 session) (list :iq xml-data))
|
|
|
|
|
2004-04-30 21:13:57 +00:00
|
|
|
;; find streamhost to connect to
|
2006-07-15 12:15:50 +00:00
|
|
|
;; (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))
|
2004-04-11 21:01:59 +00:00
|
|
|
|
2006-07-15 12:15:50 +00:00
|
|
|
;; ;; 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)
|
2007-02-07 13:49:38 +00:00
|
|
|
(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)))
|
2006-07-15 12:15:50 +00:00
|
|
|
(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
|
2007-02-08 15:08:01 +00:00
|
|
|
jc initiator-jid target-jid jid
|
2006-07-15 12:15:50 +00:00
|
|
|
(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
|
2007-02-08 15:08:01 +00:00
|
|
|
jc initiator-jid target-jid jid
|
2006-07-15 12:15:50 +00:00
|
|
|
(plist-get state-data :sid) host port fsm)))))
|
|
|
|
|
|
|
|
(list 'wait-for-connection state-data 30))))))))
|
|
|
|
|
|
|
|
(define-state-machine jabber-socks5-connection
|
|
|
|
:start
|
2007-02-08 15:08:01 +00:00
|
|
|
((jc initiator-jid target-jid streamhost-jid sid host port socks5-fsm)
|
2006-07-15 12:15:50 +00:00
|
|
|
"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
|
2007-02-08 15:08:01 +00:00
|
|
|
(list :jc jc
|
|
|
|
:connection connection
|
2006-07-15 12:15:50 +00:00
|
|
|
: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
|
2007-02-08 15:08:01 +00:00
|
|
|
(list :jc jc
|
|
|
|
:connection connection
|
2006-07-15 12:15:50 +00:00
|
|
|
: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-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
|
2007-02-07 13:49:38 +00:00
|
|
|
(plist-get state-data :jc)
|
2006-07-15 12:15:50 +00:00
|
|
|
(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
|
2007-02-07 13:49:38 +00:00
|
|
|
(plist-get state-data :jc)
|
2006-07-15 12:15:50 +00:00
|
|
|
streamhost-jid "set"
|
|
|
|
`(query ((xmlns . "http://jabber.org/protocol/bytestreams")
|
|
|
|
(sid . ,(plist-get state-data :sid)))
|
|
|
|
(activate nil ,(plist-get state-data :jid)))
|
2007-02-07 13:49:38 +00:00
|
|
|
(lambda (jc xml-data fsm) (fsm-send-sync fsm :activated)) fsm
|
|
|
|
(lambda (jc xml-data fsm) (fsm-send-sync fsm :activation-failed)) fsm)
|
2006-07-15 12:15:50 +00:00
|
|
|
(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))
|
2007-02-07 13:49:38 +00:00
|
|
|
(jc (plist-get state-data :jc))
|
2006-07-15 12:15:50 +00:00
|
|
|
(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
|
2007-02-07 13:49:38 +00:00
|
|
|
jc jid sid
|
2006-07-15 12:15:50 +00:00
|
|
|
(lexical-let ((fsm fsm))
|
|
|
|
(lambda (data)
|
|
|
|
(fsm-send fsm (list :send data))))))
|
|
|
|
nil)))
|
|
|
|
|
|
|
|
|
|
|
|
(define-state jabber-socks5 stream-activated
|
|
|
|
(fsm state-data event callback)
|
2007-02-08 15:08:01 +00:00
|
|
|
(let ((jc (plist-get state-data :jc))
|
|
|
|
(connection (plist-get state-data :connection))
|
2006-07-15 12:15:50 +00:00
|
|
|
(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.
|
2007-02-08 15:08:01 +00:00
|
|
|
(unless (funcall profile-data-function jc jid sid (third event))
|
2006-07-15 12:15:50 +00:00
|
|
|
(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))
|
2007-02-08 15:08:01 +00:00
|
|
|
(funcall profile-data-function jc jid sid nil)
|
2006-07-15 12:15:50 +00:00
|
|
|
(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."
|
2007-02-07 13:49:38 +00:00
|
|
|
(let ((jc (plist-get state-data :jc))
|
|
|
|
(jid (plist-get state-data :jid))
|
2006-07-15 12:15:50 +00:00
|
|
|
(sid (plist-get state-data :sid))
|
|
|
|
(profile-function (plist-get state-data :profile-function))
|
|
|
|
(iq-id (plist-get state-data :iq-id)))
|
2007-02-07 13:49:38 +00:00
|
|
|
(funcall profile-function jc jid sid (plist-get state-data :error))
|
2006-07-15 12:15:50 +00:00
|
|
|
|
|
|
|
(when iq-id
|
2007-02-07 13:49:38 +00:00
|
|
|
(jabber-send-iq-error jc jid iq-id nil "cancel"
|
2006-07-15 12:15:50 +00:00
|
|
|
'remote-server-not-found)))
|
|
|
|
(list nil nil))
|
2004-04-30 21:13:57 +00:00
|
|
|
|
2007-02-07 13:49:38 +00:00
|
|
|
(defun jabber-socks5-client-1 (jc jid sid profile-function)
|
2004-06-09 20:44:10 +00:00
|
|
|
"Negotiate a SOCKS5 connection with JID.
|
2006-07-15 12:15:50 +00:00
|
|
|
This function simply starts a state machine."
|
|
|
|
(add-to-list 'jabber-socks5-pending-sessions
|
2007-02-07 13:49:38 +00:00
|
|
|
(list sid jid (start-jabber-socks5 jc jid sid profile-function :initiator))))
|
2006-07-15 12:15:50 +00:00
|
|
|
|
|
|
|
;; (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)))))
|
2004-06-09 20:44:10 +00:00
|
|
|
|
2004-04-07 20:03:51 +00:00
|
|
|
(provide 'jabber-socks5)
|
2004-04-15 23:15:21 +00:00
|
|
|
|
|
|
|
;;; arch-tag: 9e70dfea-2522-40c6-a79f-302c8fb82ac5
|