wgreenhouse
/
emacs-jabber
1
0
Fork 1
Code Issues Pull Requests Projects Releases Wiki Activity

Revision: mange@freemail.hu--2005/emacs-jabber--cvs-head--0--patch-529 

Creator:  Magnus Henoch <mange@freemail.hu>

Implement `virtual' connection type, for introspective testing
This commit is contained in:
Magnus Henoch 2008-06-17 14:47:01 +00:00 committed by Kirill A. Korinskiy
parent 6c4a595f8a
commit c4d1beb1af
2 changed files with 29 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
jabber-conn.el
View File

@ -75,7 +75,8 @@ nil means prefer gnutls but fall back to openssl.
(defvar jabber-connect-methods
'((network jabber-network-connect jabber-network-send)
(starttls jabber-starttls-connect jabber-ssl-send)
(ssl jabber-ssl-connect jabber-ssl-send))
(ssl jabber-ssl-connect jabber-ssl-send)
(virtual jabber-virtual-connect jabber-virtual-send))
"Alist of connection methods and functions.
First item is the symbol naming the method.
Second item is the connect function.
@ -229,5 +230,22 @@ Return non-nil on success, nil on failure."
((eq (car xml-data) 'failure)
nil)))
(defvar *jabber-virtual-server-function* nil
"Function to use for sending stanzas on a virtual connection.
The function should accept two arguments, the connection object
and a string that the connection wants to send.")
(defun jabber-virtual-connect (fsm server network-server port)
"Connect to a virtual \"server\".
Use `*jabber-virtual-server-function*' as send function."
(unless (functionp *jabber-virtual-server-function*)
(error "No virtual server function specified"))
;; We pass the fsm itself as "connection object", as that is what a
;; virtual server needs to send stanzas.
(fsm-send fsm (list :connected fsm)))
(defun jabber-virtual-send (connection string)
(funcall *jabber-virtual-server-function* connection string))
(provide 'jabber-conn)
;; arch-tag: f95ec240-8cd3-11d9-9dbf-000a95c2fcd0

19
jabber-core.el
View File

@ -313,16 +313,17 @@ With double prefix argument, specify more connection details."
(:connected
(let ((connection (cadr event))
(registerp (plist-get state-data :registerp)))
;; TLS connections leave data in the process buffer, which
;; the XML parser will choke on.
(with-current-buffer (process-buffer connection)
(erase-buffer))
(setq state-data (plist-put state-data :connection connection))
(set-process-filter connection (fsm-make-filter fsm))
(set-process-sentinel connection (fsm-make-sentinel fsm))
(when (processp connection)
;; TLS connections leave data in the process buffer, which
;; the XML parser will choke on.
(with-current-buffer (process-buffer connection)
(erase-buffer))
(set-process-filter connection (fsm-make-filter fsm))
(set-process-sentinel connection (fsm-make-sentinel fsm)))
(list :connected state-data)))
@ -990,8 +991,8 @@ Return an fsm result list if it is."
"")
">
")))
(jabber-send-string jc stream-header)
(jabber-log-xml jc "sending" stream-header)))
(jabber-log-xml jc "sending" stream-header)
(jabber-send-string jc stream-header)))
(defun jabber-send-string (jc string)
"Send STRING to the connection JC."