1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
|
;; jabber-core.el - core functions
;; Copyright (C) 2002, 2003, 2004 - tom berger - object@intelectronica.net
;; Copyright (C) 2003, 2004 - Magnus Henoch - mange@freemail.hu
;; 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-util)
(require 'jabber-logon)
(defvar *jabber-connection* nil
"the process that does the actual connection")
(defvar *jabber-roster* nil
"the roster list")
(defvar jabber-jid-obarray (make-vector 127 0)
"obarray for keeping JIDs")
(defvar *jabber-connected* nil
"boolean - are we connected")
(defvar *xmlq* ""
"a string with all the incoming xml that is waiting to be parsed")
(defvar jabber-register-p nil
"Register a new account in this session?")
(defvar jabber-session-id nil
"id of the current session")
(defvar jabber-register-p nil
"Is account registration occurring in this session?")
(defvar jabber-call-on-connection nil
"Function to be called on connection.
This is set by `jabber-connect' on each call, and later picked up in
`jabber-filter'.")
(defvar jabber-message-chain nil
"Incoming messages are sent to these functions, in order.")
(defvar jabber-iq-chain nil
"Incoming infoqueries are sent to these functions, in order.")
(defvar jabber-presence-chain nil
"Incoming presence notifications are sent to these functions, in order.")
(defgroup jabber-core nil "customize core functionality"
:group 'jabber)
(defcustom jabber-disconnect-hook nil
"*Hooks run just before disconnecting"
:type 'hook
:group 'jabber-core)
(defcustom jabber-lost-connection-hook nil
"*Hooks run when connection is lost"
:type 'hook
:group 'jabber-core)
(defun jabber-connect (&optional registerp)
"connect to the jabber server and start a jabber xml stream
With prefix argument, register a new account."
(interactive "P")
(if *jabber-connected*
(message "Already connected")
(setq *xmlq* "")
(jabber-clear-roster)
(let ((coding-system-for-read 'utf-8)
(coding-system-for-write 'utf-8))
(setq *jabber-connection* (open-network-stream "jabber"
"*-jabber-*"
(or jabber-network-server jabber-server)
jabber-port)))
(set-process-filter *jabber-connection* #'jabber-filter)
(set-process-sentinel *jabber-connection* #'jabber-sentinel)
(setq jabber-register-p registerp)
(setq jabber-call-on-connection (if registerp
#'(lambda () (jabber-get-register jabber-server))
#'(lambda () (jabber-get-auth jabber-server))))
(process-send-string *jabber-connection*
(concat "<?xml version='1.0'?><stream:stream to='"
jabber-server
"' xmlns='jabber:client' xmlns:stream='http://etherx.jabber.org/streams'>"))
;; Next thing happening is the server sending its own <stream:stream> start tag.
;; That is handled in jabber-filter.
(setq *jabber-connected* t)))
(defun jabber-disconnect ()
"disconnect from the jabber server and re-initialise the jabber package variables"
(interactive)
(when (eq (process-status *jabber-connection*) 'open)
(run-hooks 'jabber-disconnect-hook)
(process-send-string *jabber-connection* "</stream:stream>")
;; let the server close the stream
(unless (accept-process-output *jabber-connection* 3)
(delete-process *jabber-connection*)))
(kill-buffer (process-buffer *jabber-connection*))
(jabber-clear-roster)
(setq *xmlq* "")
(setq *jabber-connected* nil)
(setq *jabber-active-groupchats* nil)
(setq jabber-session-id nil)
(if (interactive-p)
(message "Disconnected from Jabber server")))
(defun jabber-sentinel (process event)
"alert user about lost connection"
(beep)
(run-hooks 'jabber-lost-connection-hook)
(message "Jabber connection lost: `%s'" event)
(jabber-disconnect))
(defun jabber-filter (process string)
"the filter function for the jabber process"
(cond
((string-match "</stream:stream>" string)
(jabber-disconnect))
((string-match "<stream:stream" string)
(setq jabber-session-id
(progn (string-match "id='\\([A-Za-z0-9]+\\)'" string)
(match-string 1 string)))
;; Now proceed with logon.
(funcall jabber-call-on-connection))
(t
(if (active-minibuffer-window)
(run-with-idle-timer 0.01 nil #'jabber-filter process string)
(with-temp-buffer
(setq *xmlq* (concat *xmlq* string))
(if (string-match " \\w+=''" *xmlq*)
(setq *xmlq* (replace-match "" nil nil *xmlq*)))
(catch 'jabber-no-tag
(while (string-match "<\\([a-zA-Z0-9\:]+\\)\\s-" *xmlq*)
(if (or (string-match (concat "<" (match-string 1 *xmlq*) "[^<>]*?/>") *xmlq*)
(string-match (concat "<" (match-string 1 *xmlq*) ".*?>[^\0]+?</" (match-string 1 *xmlq*) ">") *xmlq*))
(progn
(insert (match-string 0 *xmlq*))
(goto-char (point-min))
(setq *xmlq* (substring *xmlq* (match-end 0)))
(let ((xml-data (xml-parse-region (point-min)
(point-max))))
(if xml-data
(progn
(if jabber-debug-log-xml
(with-current-buffer (get-buffer-create "*-jabber-xml-log-*")
(save-excursion
(goto-char (point-max))
(insert (format "receive %S\n\n" (car xml-data))))))
(jabber-process-input (car xml-data)))))
(erase-buffer))
(throw 'jabber-no-tag t)))))))))
(defun jabber-process-input (xml-data)
"process an incoming parsed tag"
(let* ((tag (jabber-xml-node-name xml-data))
(functions (eval (cdr (assq tag '((iq . jabber-iq-chain)
(presence . jabber-presence-chain)
(message . jabber-message-chain)))))))
(dolist (f functions)
(funcall f xml-data))))
(defun jabber-clear-roster ()
"Clean up the roster."
;; This is made complicated by the fact that the JIDs are symbols with properties.
(mapatoms #'(lambda (x)
(unintern x jabber-jid-obarray))
jabber-jid-obarray)
(setq *jabber-roster* nil))
(defun jabber-send-sexp (sexp)
"send the xml corresponding to SEXP to the jabber server"
(if jabber-debug-log-xml
(with-current-buffer (get-buffer-create "*-jabber-xml-log-*")
(save-excursion
(goto-char (point-max))
(insert (format "sending %S\n\n" sexp)))))
(process-send-string *jabber-connection* (jabber-sexp2xml sexp)))
(provide 'jabber-core)
;;; arch-tag: 9d273ce6-c45a-447b-abf3-21d3ce73a51a
|
