From c4d1beb1af3bcdbe01a12b83131b7043dc2f9283 Mon Sep 17 00:00:00 2001 From: Magnus Henoch Date: Tue, 17 Jun 2008 14:47:01 +0000 Subject: [PATCH] Revision: mange@freemail.hu--2005/emacs-jabber--cvs-head--0--patch-529 Creator: Magnus Henoch Implement `virtual' connection type, for introspective testing --- jabber-conn.el | 20 +++++++++++++++++++- jabber-core.el | 19 ++++++++++--------- 2 files changed, 29 insertions(+), 10 deletions(-) diff --git a/jabber-conn.el b/jabber-conn.el index 409403b..80b1cca 100644 --- a/jabber-conn.el +++ b/jabber-conn.el @@ -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 diff --git a/jabber-core.el b/jabber-core.el index fc39c08..5e27138 100644 --- a/jabber-core.el +++ b/jabber-core.el @@ -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."