1 | package owl_jabber; |
---|
2 | use Authen::SASL qw(Perl); |
---|
3 | use Net::Jabber; |
---|
4 | ################################################################################ |
---|
5 | # owl perl jabber support |
---|
6 | # |
---|
7 | # Todo: |
---|
8 | # Connect command. |
---|
9 | # |
---|
10 | ################################################################################ |
---|
11 | |
---|
12 | our $client; |
---|
13 | our $jid; |
---|
14 | |
---|
15 | sub onStart |
---|
16 | { |
---|
17 | if(eval{\&owl::queue_message}) |
---|
18 | { |
---|
19 | register_owl_commands(); |
---|
20 | } |
---|
21 | else |
---|
22 | { |
---|
23 | # Our owl doesn't support queue_message. Unfortunately, this |
---|
24 | # means it probably *also* doesn't support owl::error. So just |
---|
25 | # give up silently. |
---|
26 | } |
---|
27 | } |
---|
28 | push @::onStartSubs, \&onStart; |
---|
29 | |
---|
30 | sub onMainLoop |
---|
31 | { |
---|
32 | return if ($client == undef); |
---|
33 | |
---|
34 | my $status = $client->Process(0); |
---|
35 | if ($status == 0 # No data received |
---|
36 | || $status == 1) # Data received |
---|
37 | { |
---|
38 | } |
---|
39 | else #Error |
---|
40 | { |
---|
41 | queue_admin_msg("Jabber disconnected."); |
---|
42 | $client = undef; |
---|
43 | return; |
---|
44 | } |
---|
45 | |
---|
46 | if ($::shutdown) |
---|
47 | { |
---|
48 | $client->Disconnect(); |
---|
49 | $client = undef; |
---|
50 | return; |
---|
51 | } |
---|
52 | } |
---|
53 | push @::onMainLoop, \&onMainLoop; |
---|
54 | |
---|
55 | ################################################################################ |
---|
56 | ### Owl Commands |
---|
57 | sub register_owl_commands() |
---|
58 | { |
---|
59 | owl::new_command( |
---|
60 | jabberlogin => \&cmd_login, |
---|
61 | { summary => "Log into jabber", } |
---|
62 | ); |
---|
63 | owl::new_command( |
---|
64 | jabberlogout => \&cmd_logout, |
---|
65 | { summary => "Log out of jabber" } |
---|
66 | ); |
---|
67 | owl::new_command( |
---|
68 | jwrite => \&cmd_jwrite, |
---|
69 | { |
---|
70 | summary => "Send a Jabber Message", |
---|
71 | usage => "jwrite JID [-t thread]" |
---|
72 | } |
---|
73 | ); |
---|
74 | owl::new_command( |
---|
75 | jchat => \&cmd_jwrite_gc, |
---|
76 | { |
---|
77 | summary => "Send a Jabber Message", |
---|
78 | usage => "jchat [room]@[server]" |
---|
79 | } |
---|
80 | ); |
---|
81 | owl::new_command( |
---|
82 | jjoin => \&cmd_join_gc, |
---|
83 | { |
---|
84 | summary => "Joins a jabber groupchat.", |
---|
85 | usage => "jjoin [room]@[server]/[nick]" |
---|
86 | } |
---|
87 | ); |
---|
88 | owl::new_command( |
---|
89 | jpart => \&cmd_part_gc, |
---|
90 | { |
---|
91 | summary => "Parts a jabber groupchat.", |
---|
92 | usage => "jpart [room]@[server]/[nick]" |
---|
93 | } |
---|
94 | ); |
---|
95 | } |
---|
96 | |
---|
97 | sub cmd_login |
---|
98 | { |
---|
99 | if ($client != undef) |
---|
100 | { |
---|
101 | queue_admin_msg("Already logged in."); |
---|
102 | return; |
---|
103 | } |
---|
104 | |
---|
105 | # These strings should not be hard-coded here. |
---|
106 | $client = Net::Jabber::Client->new(); |
---|
107 | $client->SetMessageCallBacks(chat => sub { owl_jabber::process_incoming_chat_message(@_) }, |
---|
108 | error => sub { owl_jabber::process_incoming_error_message(@_) }, |
---|
109 | groupchat => sub { owl_jabber::process_incoming_groupchat_message(@_) }, |
---|
110 | headline => sub { owl_jabber::process_incoming_headline_message(@_) }, |
---|
111 | normal => sub { owl_jabber::process_incoming_normal_message(@_) }); |
---|
112 | my $status = $client->Connect(hostname => 'jabber.mit.edu', |
---|
113 | tls => 1, |
---|
114 | port => 5222, |
---|
115 | componentname => 'mit.edu'); |
---|
116 | |
---|
117 | if (!$status) |
---|
118 | { |
---|
119 | owl::error("We failed to connect"); |
---|
120 | return; |
---|
121 | } |
---|
122 | |
---|
123 | my @result = $client->AuthSend(username => $ENV{USER}, resource => 'owl', password => ''); |
---|
124 | if($result[0] ne 'ok') { |
---|
125 | owl::error("Error in connect: " . join(" ", $result[1..$#result])); |
---|
126 | $client->Disconnect(); |
---|
127 | $client = undef; |
---|
128 | return; |
---|
129 | } |
---|
130 | |
---|
131 | $jid = new Net::Jabber::JID; |
---|
132 | $jid->SetJID(userid => $ENV{USER}, |
---|
133 | server => ($client->{SERVER}->{componentname} || |
---|
134 | $client->{SERVER}->{hostname}), |
---|
135 | resource => 'owl'); |
---|
136 | |
---|
137 | $client->PresenceSend(priority => 1); |
---|
138 | queue_admin_msg("Connected to jabber as ".$jid->GetJID('full')); |
---|
139 | |
---|
140 | return ""; |
---|
141 | } |
---|
142 | |
---|
143 | sub cmd_logout |
---|
144 | { |
---|
145 | if ($client) |
---|
146 | { |
---|
147 | $client->Disconnect(); |
---|
148 | $client = undef; |
---|
149 | queue_admin_msg("Jabber disconnected."); |
---|
150 | } |
---|
151 | return ""; |
---|
152 | } |
---|
153 | |
---|
154 | our $jwrite_to; |
---|
155 | our $jwrite_thread; |
---|
156 | our $jwrite_subject; |
---|
157 | our $jwrite_type; |
---|
158 | sub cmd_jwrite |
---|
159 | { |
---|
160 | if (!$client) |
---|
161 | { |
---|
162 | # Error here |
---|
163 | return; |
---|
164 | } |
---|
165 | |
---|
166 | $jwrite_to = ""; |
---|
167 | $jwrite_thread = ""; |
---|
168 | $jwrite_subject = ""; |
---|
169 | $jwrite_type = "chat"; |
---|
170 | my @args = @_; |
---|
171 | my $argsLen = @args; |
---|
172 | |
---|
173 | JW_ARG: for (my $i = 1; $i < $argsLen; $i++) |
---|
174 | { |
---|
175 | $args[$i] =~ /^-t$/ && ($jwrite_thread = $args[++$i] && next JW_ARG); |
---|
176 | $args[$i] =~ /^-s$/ && ($jwrite_subject = $args[++$i] && next JW_ARG); |
---|
177 | if ($jwrite_to ne '') |
---|
178 | { |
---|
179 | # Too many To's |
---|
180 | $jwrite_to = ''; |
---|
181 | last; |
---|
182 | } |
---|
183 | if ($jwrite_to) |
---|
184 | { |
---|
185 | $jwrite_to == ''; |
---|
186 | last; |
---|
187 | } |
---|
188 | $jwrite_to = $args[$i]; |
---|
189 | } |
---|
190 | |
---|
191 | if(!$jwrite_to) { |
---|
192 | owl::error("Usage: jwrite JID [-t thread] [-s 'subject']"); |
---|
193 | return; |
---|
194 | } |
---|
195 | |
---|
196 | owl::message("Type your message below. End with a dot on a line by itself. ^C will quit."); |
---|
197 | owl::start_edit_win(join(' ', @args), \&process_owl_jwrite); |
---|
198 | } |
---|
199 | |
---|
200 | sub cmd_join_gc |
---|
201 | { |
---|
202 | if (!$client) |
---|
203 | { |
---|
204 | # Error here |
---|
205 | return; |
---|
206 | } |
---|
207 | if(!$_[1]) |
---|
208 | { |
---|
209 | owl::error("Usage: jchat [room]@[server]/[nick]"); |
---|
210 | return; |
---|
211 | } |
---|
212 | |
---|
213 | my $x = new XML::Stream::Node('x'); |
---|
214 | $x->put_attrib(xmlns => 'http://jabber.org/protocol/muc'); |
---|
215 | $x->add_child('history')->put_attrib(maxchars => '0'); |
---|
216 | |
---|
217 | |
---|
218 | my $presence = new Net::Jabber::Presence; |
---|
219 | $presence->SetPresence(to => $_[1]); |
---|
220 | $presence->AddX($x); |
---|
221 | |
---|
222 | $client->Send($presence); |
---|
223 | return ""; |
---|
224 | } |
---|
225 | |
---|
226 | sub cmd_part_gc |
---|
227 | { |
---|
228 | if (!$client) |
---|
229 | { |
---|
230 | # Error here |
---|
231 | return; |
---|
232 | } |
---|
233 | if(!$_[1]) |
---|
234 | { |
---|
235 | owl::error("Usage: jchat [room]@[server]/[nick]"); |
---|
236 | return; |
---|
237 | } |
---|
238 | |
---|
239 | $client->PresenceSend(to=>$_[1], type=>'unavailable'); |
---|
240 | return ""; |
---|
241 | } |
---|
242 | |
---|
243 | sub cmd_jwrite_gc |
---|
244 | { |
---|
245 | if (!$client) |
---|
246 | { |
---|
247 | # Error here |
---|
248 | return; |
---|
249 | } |
---|
250 | |
---|
251 | $jwrite_to = $_[1]; |
---|
252 | $jwrite_thread = ""; |
---|
253 | $jwrite_subject = ""; |
---|
254 | $jwrite_type = "groupchat"; |
---|
255 | my @args = @_; |
---|
256 | my $argsLen = @args; |
---|
257 | |
---|
258 | owl::message("Type your message below. End with a dot on a line by itself. ^C will quit."); |
---|
259 | owl::start_edit_win(join(' ', @args), \&process_owl_jwrite); |
---|
260 | } |
---|
261 | |
---|
262 | ################################################################################ |
---|
263 | ### Owl Callbacks |
---|
264 | sub process_owl_jwrite |
---|
265 | { |
---|
266 | my $body = shift; |
---|
267 | |
---|
268 | my $j = new Net::XMPP::Message; |
---|
269 | $body =~ s/\n\z//; |
---|
270 | $j->SetMessage(to => $jwrite_to, |
---|
271 | from => $jid->GetJID('full'), |
---|
272 | type => $jwrite_type, |
---|
273 | body => $body |
---|
274 | ); |
---|
275 | $j->SetThread($jwrite_thread) if ($jwrite_thread); |
---|
276 | $j->SetSubject($jwrite_subject) if ($jwrite_subject); |
---|
277 | |
---|
278 | my $m = j2o($j, 'out'); |
---|
279 | if ($jwrite_type ne 'groupchat') |
---|
280 | { |
---|
281 | #XXX TODO: Check for displayoutgoing. |
---|
282 | owl::queue_message($m); |
---|
283 | } |
---|
284 | $client->Send($j); |
---|
285 | } |
---|
286 | |
---|
287 | ### XMPP Callbacks |
---|
288 | |
---|
289 | sub process_incoming_chat_message |
---|
290 | { |
---|
291 | my ($session, $j) = @_; |
---|
292 | owl::queue_message(j2o($j, 'in')); |
---|
293 | } |
---|
294 | |
---|
295 | sub process_incoming_error_message |
---|
296 | { |
---|
297 | my ($session, $j) = @_; |
---|
298 | queue_admin_msg("Error ".$j->GetErrorCode()." sending to ".$j->GetFrom('jid')->GetJID('base')); |
---|
299 | } |
---|
300 | |
---|
301 | sub process_incoming_groupchat_message |
---|
302 | { |
---|
303 | my ($session, $j) = @_; |
---|
304 | # HACK IN PROGRESS (ignoring delayed messages) |
---|
305 | return if ($j->DefinedX('jabber:x:delay') && $j->GetX('jabber:x:delay')); |
---|
306 | owl::queue_message(j2o($j, 'in')); |
---|
307 | } |
---|
308 | |
---|
309 | sub process_incoming_headline_message |
---|
310 | { |
---|
311 | my ($session, $j) = @_; |
---|
312 | owl::queue_message(j2o($j, 'in')); |
---|
313 | } |
---|
314 | |
---|
315 | sub process_incoming_normal_message |
---|
316 | { |
---|
317 | my ($session, $j) = @_; |
---|
318 | owl::queue_message(j2o($j, 'in')); |
---|
319 | } |
---|
320 | |
---|
321 | |
---|
322 | ### Helper functions |
---|
323 | |
---|
324 | sub j2o |
---|
325 | { |
---|
326 | my $j = shift; |
---|
327 | my $dir = shift; |
---|
328 | |
---|
329 | my %props = (type => 'jabber', |
---|
330 | direction => $dir); |
---|
331 | |
---|
332 | |
---|
333 | $props{replycmd} = "jwrite"; |
---|
334 | |
---|
335 | $props{jtype} = $j->GetType(); |
---|
336 | $props{jtype} =~ /^(?:headline|error)$/ && {$props{replycmd} = undef}; |
---|
337 | $props{jtype} =~ /^groupchat$/ && {$props{replycmd} = "jchat"}; |
---|
338 | |
---|
339 | $props{isprivate} = $props{jtype} =~ /^(?:normal|chat)$/; |
---|
340 | |
---|
341 | my $reply_to; |
---|
342 | if ($j->DefinedTo()) |
---|
343 | { |
---|
344 | my $jid = $j->GetTo('jid'); |
---|
345 | $props{recipient} = $jid->GetJID('base'); |
---|
346 | $props{to_jid} = $jid->GetJID('full'); |
---|
347 | if ($dir eq 'out') |
---|
348 | { |
---|
349 | $reply_to = $props{to_jid}; |
---|
350 | $props{jtype} =~ /^groupchat$/ && {$reply_to = $jid->GetJID('base')}; |
---|
351 | } |
---|
352 | } |
---|
353 | if ($j->DefinedFrom()) |
---|
354 | { |
---|
355 | my $jid = $j->GetFrom('jid'); |
---|
356 | $props{sender} = $jid->GetJID('base'); |
---|
357 | $props{from_jid} = $jid->GetJID('full'); |
---|
358 | $reply_to = $props{from_jid} if ($dir eq 'in'); |
---|
359 | if ($dir eq 'in') |
---|
360 | { |
---|
361 | $reply_to = $props{from_jid}; |
---|
362 | $props{jtype} =~ /^groupchat$/ && {$reply_to = $jid->GetJID('base')}; |
---|
363 | } |
---|
364 | } |
---|
365 | |
---|
366 | $props{subject} = $j->GetSubject() if ($j->DefinedSubject()); |
---|
367 | $props{body} = $j->GetBody() if ($j->DefinedBody()); |
---|
368 | # if ($j->DefinedThread()) |
---|
369 | # { |
---|
370 | # $props{thread} = $j->GetThread() if ($j->DefinedThread()); |
---|
371 | # $props{replycmd} .= " -t $props{thread}"; |
---|
372 | # } |
---|
373 | $props{error} = $j->GetError() if ($j->DefinedError()); |
---|
374 | $props{error_code} = $j->GetErrorCode() if ($j->DefinedErrorCode()); |
---|
375 | $props{replycmd} .= " $reply_to"; |
---|
376 | $props{replysendercmd} = $props{replycmd}; |
---|
377 | |
---|
378 | return owl::Message->new(%props); |
---|
379 | } |
---|
380 | |
---|
381 | sub queue_admin_msg |
---|
382 | { |
---|
383 | my $err = shift; |
---|
384 | my $m = owl::Message->new(type => 'admin', |
---|
385 | direction => 'none', |
---|
386 | body => $err); |
---|
387 | owl::queue_message($m); |
---|
388 | } |
---|