Context Navigation

source: perl/modules/Jabber/lib/BarnOwl/Module/Jabber.pm @ a484b3e

Visit:

release-1.6

Last change on this file since a484b3e was a484b3e, checked in by Nelson Elhage <nelhage@mit.edu>, 14 years ago
Jabber: Accept a -m argument to jwrite to set the message.
Property mode set to `100644`
File size: 44.8 KB

Line
1	use strict;
2	use warnings;
3
4	package BarnOwl::Module::Jabber;
5
6	=head1 NAME
7
8	BarnOwl::Module::Jabber
9
10	=head1 DESCRIPTION
11
12	This module implements Jabber support for barnowl.
13
14	=cut
15
16	use BarnOwl;
17	use BarnOwl::Hooks;
18	use BarnOwl::Message::Jabber;
19	use BarnOwl::Module::Jabber::Connection;
20	use BarnOwl::Module::Jabber::ConnectionManager;
21	use BarnOwl::Completion::Util qw(complete_flags);
22
23	use Authen::SASL qw(Perl);
24	use Net::Jabber;
25	use Net::Jabber::MUC;
26	use Net::DNS;
27	use Getopt::Long;
28	Getopt::Long::Configure(qw(no_getopt_compat prefix_pattern=-\|--));
29
30	use utf8;
31
32	our $VERSION = 0.1;
33
34	BEGIN {
35	if(eval {require IO::Socket::SSL;}) {
36	if($IO::Socket::SSL::VERSION eq "0.97") {
37	BarnOwl::error("You are using IO::Socket:SSL 0.97, which \n" .
38	"contains bugs causing it not to work with barnowl's\n" .
39	"Jabber support. We recommend updating to the latest\n" .
40	"IO::Socket::SSL from CPAN. \n");
41	die("Not loading Jabber.par\n");
42	}
43	}
44	}
45
46	no warnings 'redefine';
47
48	################################################################################
49	# owl perl jabber support
50	#
51	# XXX Todo:
52	# Rosters for MUCs
53	# More user feedback
54	# * joining MUC
55	# * parting MUC
56	# * presence (Roster and MUC)
57	# Implementing formatting and logging callbacks for C
58	# Appropriate callbacks for presence subscription messages.
59	#
60	################################################################################
61
62	our $conn;
63	$conn \|\|= BarnOwl::Module::Jabber::ConnectionManager->new;
64	our %vars;
65	our %completion_jids;
66
67	sub onStart {
68	if ( *BarnOwl::queue_message{CODE} ) {
69	register_owl_commands();
70	register_keybindings();
71	register_filters();
72	$BarnOwl::Hooks::getBuddyList->add("BarnOwl::Module::Jabber::onGetBuddyList");
73	$BarnOwl::Hooks::getQuickstart->add("BarnOwl::Module::Jabber::onGetQuickstart");
74	$vars{show} = '';
75	BarnOwl::new_variable_bool("jabber:show_offline_buddies",
76	{ default => 1,
77	summary => 'Show offline or pending buddies.'});
78	BarnOwl::new_variable_bool("jabber:show_logins",
79	{ default => 0,
80	summary => 'Show login/logout messages.'});
81	BarnOwl::new_variable_bool("jabber:spew",
82	{ default => 0,
83	summary => 'Display unrecognized Jabber messages.'});
84	BarnOwl::new_variable_int("jabber:auto_away_timeout",
85	{ default => 5,
86	summary => 'After minutes idle, auto away.',
87	});
88	BarnOwl::new_variable_int("jabber:auto_xa_timeout",
89	{ default => 15,
90	summary => 'After minutes idle, auto extended away.'
91	});
92	BarnOwl::new_variable_bool("jabber:reconnect",
93	{ default => 1,
94	summary => 'Auto-reconnect when disconnected from servers.'
95	});
96	# Force these. Reload can screw them up.
97	# Taken from Net::Jabber::Protocol.
98	$Net::XMPP::Protocol::NEWOBJECT{'iq'} = "Net::Jabber::IQ";
99	$Net::XMPP::Protocol::NEWOBJECT{'message'} = "Net::Jabber::Message";
100	$Net::XMPP::Protocol::NEWOBJECT{'presence'} = "Net::Jabber::Presence";
101	$Net::XMPP::Protocol::NEWOBJECT{'jid'} = "Net::Jabber::JID";
102	} else {
103	# Our owl doesn't support queue_message. Unfortunately, this
104	# means it probably also doesn't support BarnOwl::error. So just
105	# give up silently.
106	}
107	}
108
109	$BarnOwl::Hooks::startup->add("BarnOwl::Module::Jabber::onStart");
110
111	sub do_keep_alive_and_auto_away {
112	if ( !$conn->connected() ) {
113	# We don't need this timer any more.
114	delete $vars{keepAliveTimer};
115	return;
116	}
117
118	$vars{status_changed} = 0;
119	my $auto_away = BarnOwl::getvar('jabber:auto_away_timeout');
120	my $auto_xa = BarnOwl::getvar('jabber:auto_xa_timeout');
121	my $idletime = BarnOwl::getidletime();
122	if ($auto_xa != 0 && $idletime >= (60 * $auto_xa) && ($vars{show} eq 'away' \|\| $vars{show} eq '' )) {
123	$vars{show} = 'xa';
124	$vars{status} = 'Auto extended-away after '.$auto_xa.' minute'.($auto_xa == 1 ? '' : 's').' idle.';
125	$vars{status_changed} = 1;
126	} elsif ($auto_away != 0 && $idletime >= (60 * $auto_away) && $vars{show} eq '') {
127	$vars{show} = 'away';
128	$vars{status} = 'Auto away after '.$auto_away.' minute'.($auto_away == 1 ? '' : 's').' idle.';
129	$vars{status_changed} = 1;
130	} elsif ($idletime <= $vars{idletime} && $vars{show} ne '') {
131	$vars{show} = '';
132	$vars{status} = '';
133	$vars{status_changed} = 1;
134	}
135	$vars{idletime} = $idletime;
136
137	foreach my $jid ( $conn->getJIDs() ) {
138	next if $conn->jidActive($jid);
139	$conn->tryReconnect($jid);
140	}
141
142	foreach my $jid ( $conn->getJIDs() ) {
143	next unless $conn->jidActive($jid);
144
145	my $client = $conn->getConnectionFromJID($jid);
146	unless($client) {
147	$conn->removeConnection($jid);
148	BarnOwl::error("Connection for $jid undefined -- error in reload?");
149	}
150	my $status = $client->Process(0); # keep-alive
151	if ( !defined($status) ) {
152	$conn->scheduleReconnect($jid);
153	}
154	if ($::shutdown) {
155	do_logout($jid);
156	next;
157	}
158
159	if ($vars{status_changed}) {
160	my $p = new Net::Jabber::Presence;
161	$p->SetShow($vars{show}) if $vars{show};
162	$p->SetStatus($vars{status}) if $vars{status};
163	$client->Send($p);
164	}
165	}
166	}
167
168	our $showOffline = 0;
169
170	sub blist_listBuddy {
171	my $roster = shift;
172	my $buddy = shift;
173	my $blistStr .= " ";
174	my %jq = $roster->query($buddy);
175	my $res = $roster->resource($buddy);
176
177	my $name = $jq{name} \|\| $buddy->GetUserID();
178
179	$blistStr .= sprintf '%-15s %s', $name, $buddy->GetJID();
180	$completion_jids{$name} = 1;
181	$completion_jids{$buddy->GetJID()} = 1;
182
183	if ($res) {
184	my %rq = $roster->resourceQuery( $buddy, $res );
185	$blistStr .= " [" . ( $rq{show} ? $rq{show} : 'online' ) . "]";
186	$blistStr .= " " . $rq{status} if $rq{status};
187	$blistStr = BarnOwl::Style::boldify($blistStr) if $showOffline;
188	}
189	else {
190	return '' unless $showOffline;
191	if ($jq{ask}) {
192	$blistStr .= " [pending]";
193	}
194	elsif ($jq{subscription} eq 'none' \|\| $jq{subscription} eq 'from') {
195	$blistStr .= " [not subscribed]";
196	}
197	else {
198	$blistStr .= " [offline]";
199	}
200	}
201	return $blistStr . "\n";
202	}
203
204	# Sort, ignoring markup.
205	sub blistSort {
206	return uc(BarnOwl::ztext_stylestrip($a)) cmp uc(BarnOwl::ztext_stylestrip($b));
207	}
208
209	sub getSingleBuddyList {
210	my $jid = shift;
211	$jid = resolveConnectedJID($jid);
212	return "" unless $jid;
213	my $blist = "";
214	my $roster = $conn->getRosterFromJID($jid);
215	if ($roster) {
216	$blist .= BarnOwl::Style::boldify("Jabber roster for $jid\n");
217
218	my @gTexts = ();
219	foreach my $group ( $roster->groups() ) {
220	my @buddies = $roster->jids( 'group', $group );
221	my @bTexts = ();
222	foreach my $buddy ( @buddies ) {
223	push(@bTexts, blist_listBuddy( $roster, $buddy ));
224	}
225	push(@gTexts, " Group: $group\n".join('',sort blistSort @bTexts));
226	}
227	# Sort groups before adding ungrouped entries.
228	@gTexts = sort blistSort @gTexts;
229
230	my @unsorted = $roster->jids('nogroup');
231	if (@unsorted) {
232	my @bTexts = ();
233	foreach my $buddy (@unsorted) {
234	push(@bTexts, blist_listBuddy( $roster, $buddy ));
235	}
236	push(@gTexts, " [unsorted]\n".join('',sort blistSort @bTexts));
237	}
238	$blist .= join('', @gTexts);
239	}
240	return $blist;
241	}
242
243	sub onGetBuddyList {
244	$showOffline = BarnOwl::getvar('jabber:show_offline_buddies') eq 'on';
245	my $blist = "";
246	foreach my $jid ($conn->getJIDs()) {
247	$blist .= getSingleBuddyList($jid);
248	}
249	return $blist;
250	}
251
252	sub onGetQuickstart {
253	return <<'EOF'
254	@b(Jabber:)
255	Type ':jabberlogin @b(username@mit.edu)' to log in to Jabber. The command
256	':jroster sub @b(somebody@gmail.com)' will request that they let you message
257	them. Once you get a message saying you are subscribed, you can message
258	them by typing ':jwrite @b(somebody@gmail.com)' or just 'j @b(somebody)'.
259	EOF
260	}
261
262	################################################################################
263	### Owl Commands
264	sub register_owl_commands() {
265	BarnOwl::new_command(
266	jabberlogin => \&cmd_login,
267	{
268	summary => "Log in to Jabber",
269	usage => "jabberlogin <jid> [<password>]"
270	}
271	);
272	BarnOwl::new_command(
273	jabberlogout => \&cmd_logout,
274	{
275	summary => "Log out of Jabber",
276	usage => "jabberlogout [-A\|<jid>]",
277	description => "jabberlogout logs you out of Jabber.\n\n"
278	. "If you are connected to one account, no further arguments are necessary.\n\n"
279	. "-A Log out of all accounts.\n"
280	. "<jid> Which account to log out of.\n"
281	}
282	);
283	BarnOwl::new_command(
284	jwrite => \&cmd_jwrite,
285	{
286	summary => "Send a Jabber Message",
287	usage => "jwrite <jid> [-t <thread>] [-s <subject>] [-a <account>] [-m <message>]"
288	}
289	);
290	BarnOwl::new_command(
291	jaway => \&cmd_jaway,
292	{
293	summary => "Set Jabber away / presence information",
294	usage => "jaway [-s online\|dnd\|...] [<message>]"
295	}
296	);
297	BarnOwl::new_command(
298	jlist => \&cmd_jlist,
299	{
300	summary => "Show your Jabber roster.",
301	usage => "jlist"
302	}
303	);
304	BarnOwl::new_command(
305	jmuc => \&cmd_jmuc,
306	{
307	summary => "Jabber MUC related commands.",
308	description => "jmuc sends Jabber commands related to MUC.\n\n"
309	. "The following commands are available\n\n"
310	. "join <muc>[/<nick>]\n"
311	. " Join a MUC (with a given nickname, or otherwise your JID).\n\n"
312	. "part <muc> Part a MUC.\n"
313	. " The MUC is taken from the current message if not supplied.\n\n"
314	. "invite <jid> [<muc>]\n"
315	. " Invite <jid> to <muc>.\n"
316	. " The MUC is taken from the current message if not supplied.\n\n"
317	. "configure [<muc>]\n"
318	. " Configures a MUC.\n"
319	. " Necessary to initalize a new MUC.\n"
320	. " At present, only the default configuration is supported.\n"
321	. " The MUC is taken from the current message if not supplied.\n\n"
322	. "presence [<muc>]\n"
323	. " Shows the roster for <muc>.\n"
324	. " The MUC is taken from the current message if not supplied.\n\n"
325	. "presence -a\n"
326	. " Shows rosters for all MUCs you're participating in.\n\n",
327	usage => "jmuc <command> [<args>]"
328	}
329	);
330	BarnOwl::new_command(
331	jroster => \&cmd_jroster,
332	{
333	summary => "Jabber roster related commands.",
334	description => "jroster sends Jabber commands related to rosters.\n\n"
335	. "The following commands are available\n\n"
336	. "sub <jid> Subscribe to <jid>'s presence. (implicit add)\n\n"
337	. "add <jid> Adds <jid> to your roster.\n\n"
338	. "unsub <jid> Unsubscribe from <jid>'s presence.\n\n"
339	. "remove <jid> Removes <jid> from your roster. (implicit unsub)\n\n"
340	. "auth <jid> Authorizes <jid> to subscribe to your presence.\n\n"
341	. "deauth <jid> De-authorizes <jid>'s subscription to your presence.\n\n"
342	. "The following arguments are supported for all commands\n\n"
343	. "-a <jid> Specify which account to make the roster changes on.\n"
344	. " Required if you're signed into more than one account.\n\n"
345	. "The following arguments only work with the add and sub commands.\n\n"
346	. "-g <group> Add <jid> to group <group>.\n"
347	. " May be specified more than once, will not remove <jid> from any groups.\n\n"
348	. "-p Purge. Removes <jid> from all groups.\n"
349	. " May be combined with -g.\n\n"
350	. "-n <name> Sets <name> as <jid>'s short name.\n\n"
351	. "Note: Unless -n is used, you can specify multiple <jid> arguments.\n",
352	usage => "jroster <command> <args>"
353	}
354	);
355	}
356
357	sub register_keybindings {
358	BarnOwl::bindkey(qw(recv j command start-command), 'jwrite ');
359	}
360
361	sub register_filters {
362	BarnOwl::filter(qw(jabber type ^jabber$));
363	}
364
365	sub cmd_login {
366	my $cmd = shift;
367	my $jidStr = shift;
368	my $jid = new Net::Jabber::JID;
369	$jid->SetJID($jidStr);
370	my $password = '';
371	$password = shift if @_;
372
373	my $uid = $jid->GetUserID();
374	my $componentname = $jid->GetServer();
375	my $resource = $jid->GetResource();
376
377	if ($resource eq '') {
378	my $cjidStr = $conn->baseJIDExists($jidStr);
379	if ($cjidStr) {
380	BarnOwl::error("Already logged in as $cjidStr.");
381	return;
382	}
383	}
384
385	$resource \|\|= 'barnowl';
386	$jid->SetResource($resource);
387	$jidStr = $jid->GetJID('full');
388
389	if ( !$uid \|\| !$componentname ) {
390	BarnOwl::error("usage: $cmd JID");
391	return;
392	}
393
394	if ( $conn->jidActive($jidStr) ) {
395	BarnOwl::error("Already logged in as $jidStr.");
396	return;
397	} elsif ($conn->jidExists($jidStr)) {
398	return $conn->tryReconnect($jidStr, 1);
399	}
400
401	my ( $server, $port ) = getServerFromJID($jid);
402
403	$vars{jlogin_jid} = $jidStr;
404	$vars{jlogin_connhash} = {
405	hostname => $server,
406	tls => 1,
407	port => $port,
408	componentname => $componentname
409	};
410	$vars{jlogin_authhash} =
411	{ username => $uid,
412	resource => $resource,
413	};
414
415	return do_login($password);
416	}
417
418	sub do_login {
419	$vars{jlogin_password} = shift;
420	$vars{jlogin_authhash}->{password} = sub { return $vars{jlogin_password} \|\| '' };
421	my $jidStr = $vars{jlogin_jid};
422	if ( !$jidStr && $vars{jlogin_havepass}) {
423	BarnOwl::error("Got password but have no JID!");
424	}
425	else
426	{
427	my $client = $conn->addConnection($jidStr);
428
429	#XXX Todo: Add more callbacks.
430	# * MUC presence handlers
431	# We use the anonymous subrefs in order to have the correct behavior
432	# when we reload
433	$client->SetMessageCallBacks(
434	chat => sub { BarnOwl::Module::Jabber::process_incoming_chat_message(@_) },
435	error => sub { BarnOwl::Module::Jabber::process_incoming_error_message(@_) },
436	groupchat => sub { BarnOwl::Module::Jabber::process_incoming_groupchat_message(@_) },
437	headline => sub { BarnOwl::Module::Jabber::process_incoming_headline_message(@_) },
438	normal => sub { BarnOwl::Module::Jabber::process_incoming_normal_message(@_) }
439	);
440	$client->SetPresenceCallBacks(
441	available => sub { BarnOwl::Module::Jabber::process_presence_available(@_) },
442	unavailable => sub { BarnOwl::Module::Jabber::process_presence_available(@_) },
443	subscribe => sub { BarnOwl::Module::Jabber::process_presence_subscribe(@_) },
444	subscribed => sub { BarnOwl::Module::Jabber::process_presence_subscribed(@_) },
445	unsubscribe => sub { BarnOwl::Module::Jabber::process_presence_unsubscribe(@_) },
446	unsubscribed => sub { BarnOwl::Module::Jabber::process_presence_unsubscribed(@_) },
447	error => sub { BarnOwl::Module::Jabber::process_presence_error(@_) });
448
449	my $status = $client->Connect( %{ $vars{jlogin_connhash} } );
450	if ( !$status ) {
451	$conn->removeConnection($jidStr);
452	BarnOwl::error("We failed to connect.");
453	} else {
454	my @result = $client->AuthSend( %{ $vars{jlogin_authhash} } );
455
456	if ( !@result \|\| $result[0] ne 'ok' ) {
457	if ( !$vars{jlogin_havepass} && ( !@result \|\| $result[0] eq '401' \|\| $result[0] eq 'error') ) {
458	$vars{jlogin_havepass} = 1;
459	$conn->removeConnection($jidStr);
460	BarnOwl::start_password("Password for $jidStr: ", \&do_login );
461	return "";
462	}
463	$conn->removeConnection($jidStr);
464	BarnOwl::error( "Error in connect: " . join( " ", @result ) );
465	} else {
466	$conn->setAuth(
467	$jidStr,
468	{ %{ $vars{jlogin_authhash} },
469	password => $vars{jlogin_password}
470	}
471	);
472	$client->onConnect($conn, $jidStr);
473	}
474	}
475	}
476	delete $vars{jlogin_jid};
477	$vars{jlogin_password} =~ tr/\0-\377/x/ if $vars{jlogin_password};
478	delete $vars{jlogin_password};
479	delete $vars{jlogin_havepass};
480	delete $vars{jlogin_connhash};
481	delete $vars{jlogin_authhash};
482
483	return "";
484	}
485
486	sub do_logout {
487	my $jid = shift;
488	my $disconnected = $conn->removeConnection($jid);
489	queue_admin_msg("Jabber disconnected ($jid).") if $disconnected;
490	}
491
492	sub cmd_logout {
493	return "You are not logged into Jabber." unless ($conn->connected() > 0);
494	# Logged into multiple accounts
495	if ( $conn->connected() > 1 ) {
496	# Logged into multiple accounts, no accout specified.
497	if ( !$_[1] ) {
498	my $errStr =
499	"You are logged into multiple accounts. Please specify an account to log out of.\n";
500	foreach my $jid ( $conn->getJIDs() ) {
501	$errStr .= "\t$jid\n";
502	}
503	queue_admin_msg($errStr);
504	}
505	# Logged into multiple accounts, account specified.
506	else {
507	if ( $_[1] eq '-A' ) #All accounts.
508	{
509	foreach my $jid ( $conn->getJIDs() ) {
510	do_logout($jid);
511	}
512	}
513	else #One account.
514	{
515	my $jid = resolveConnectedJID( $_[1] );
516	do_logout($jid) if ( $jid ne '' );
517	}
518	}
519	}
520	else # Only one account logged in.
521	{
522	do_logout( ( $conn->getJIDs() )[0] );
523	}
524	return "";
525	}
526
527	sub cmd_jlist {
528	if ( !( scalar $conn->getJIDs() ) ) {
529	BarnOwl::error("You are not logged in to Jabber.");
530	return;
531	}
532	BarnOwl::popless_ztext( onGetBuddyList() );
533	}
534
535	sub cmd_jwrite {
536	if ( !$conn->connected() ) {
537	BarnOwl::error("You are not logged in to Jabber.");
538	return;
539	}
540
541	my $jwrite_to = "";
542	my $jwrite_from = "";
543	my $jwrite_sid = "";
544	my $jwrite_thread = "";
545	my $jwrite_subject = "";
546	my $jwrite_body;
547	my ($to, $from);
548	my $jwrite_type = "chat";
549
550	my @args = @_;
551	shift;
552	local @ARGV = @_;
553	my $gc;
554	GetOptions(
555	'thread=s' => \$jwrite_thread,
556	'subject=s' => \$jwrite_subject,
557	'account=s' => \$from,
558	'id=s' => \$jwrite_sid,
559	'message=s' => \$jwrite_body,
560	) or die("Usage: jwrite <jid> [-t <thread>] [-s <subject>] [-a <account>]\n");
561	$jwrite_type = 'groupchat' if $gc;
562
563	if ( scalar @ARGV != 1 ) {
564	BarnOwl::error(
565	"Usage: jwrite <jid> [-t <thread>] [-s <subject>] [-a <account>]");
566	return;
567	}
568	else {
569	$to = shift @ARGV;
570	}
571
572	my @candidates = guess_jwrite($from, $to);
573
574	unless(scalar @candidates) {
575	die("Unable to resolve JID $to");
576	}
577
578	@candidates = grep {defined $_->[0]} @candidates;
579
580	unless(scalar @candidates) {
581	if(!$from) {
582	die("You must specify an account with -a");
583	} else {
584	die("Unable to resolve account $from");
585	}
586	}
587
588
589	($jwrite_from, $jwrite_to, $jwrite_type) = @{$candidates[0]};
590
591	$vars{jwrite} = {
592	to => $jwrite_to,
593	from => $jwrite_from,
594	sid => $jwrite_sid,
595	subject => $jwrite_subject,
596	thread => $jwrite_thread,
597	type => $jwrite_type
598	};
599
600	if (defined($jwrite_body)) {
601	process_owl_jwrite($jwrite_body);
602	return;
603	}
604
605	if(scalar @candidates > 1) {
606	BarnOwl::message(
607	"Warning: Guessing account and/or destination JID"
608	);
609	} else {
610	BarnOwl::message(
611	"Type your message below. End with a dot on a line by itself. ^C will quit."
612	);
613	}
614
615	my @cmd = ('jwrite', $jwrite_to, '-a', $jwrite_from);
616	push @cmd, '-t', $jwrite_thread if $jwrite_thread;
617	push @cmd, '-s', $jwrite_subject if $jwrite_subject;
618
619	BarnOwl::start_edit_win(BarnOwl::quote(@cmd), \&process_owl_jwrite);
620	}
621
622	sub cmd_jmuc {
623	die "You are not logged in to Jabber" unless $conn->connected();
624	my $ocmd = shift;
625	my $cmd = shift;
626	if ( !$cmd ) {
627
628	#XXX TODO: Write general usage for jmuc command.
629	return;
630	}
631
632	my %jmuc_commands = (
633	join => \&jmuc_join,
634	part => \&jmuc_part,
635	invite => \&jmuc_invite,
636	configure => \&jmuc_configure,
637	presence => \&jmuc_presence
638	);
639	my $func = $jmuc_commands{$cmd};
640	if ( !$func ) {
641	BarnOwl::error("jmuc: Unknown command: $cmd");
642	return;
643	}
644
645	{
646	local @ARGV = @_;
647	my $jid;
648	my $muc;
649	my $m = BarnOwl::getcurmsg();
650	if ( $m && $m->is_jabber && $m->{jtype} eq 'groupchat' ) {
651	$muc = $m->{room};
652	$jid = $m->{to};
653	}
654
655	my $getopt = Getopt::Long::Parser->new;
656	$getopt->configure('pass_through', 'no_getopt_compat');
657	$getopt->getoptions( 'account=s' => \$jid );
658	$jid \|\|= defaultJID();
659	if ($jid) {
660	$jid = resolveConnectedJID($jid);
661	return unless $jid;
662	}
663	else {
664	BarnOwl::error('You must specify an account with -a <jid>');
665	}
666	return $func->( $jid, $muc, @ARGV );
667	}
668	}
669
670	sub jmuc_join {
671	my ( $jid, $muc, @args ) = @_;
672	local @ARGV = @args;
673	my $password;
674	GetOptions( 'password=s' => \$password );
675
676	$muc = shift @ARGV
677	or die("Usage: jmuc join <muc> [-p <password>] [-a <account>]");
678
679	die("Error: Must specify a fully-qualified MUC name (e.g. barnowl\@conference.mit.edu)\n")
680	unless $muc =~ /@/;
681	$muc = Net::Jabber::JID->new($muc);
682	$jid = Net::Jabber::JID->new($jid);
683	$muc->SetResource($jid->GetJID('full')) unless length $muc->GetResource();
684
685	$conn->getConnectionFromJID($jid)->MUCJoin(JID => $muc,
686	Password => $password,
687	History => {
688	MaxChars => 0
689	});
690	$completion_jids{$muc->GetJID('base')} = 1;
691	return;
692	}
693
694	sub jmuc_part {
695	my ( $jid, $muc, @args ) = @_;
696
697	$muc = shift @args if scalar @args;
698	die("Usage: jmuc part [<muc>] [-a <account>]") unless $muc;
699
700	if($conn->getConnectionFromJID($jid)->MUCLeave(JID => $muc)) {
701	queue_admin_msg("$jid has left $muc.");
702	} else {
703	die("Error: Not joined to $muc");
704	}
705	}
706
707	sub jmuc_invite {
708	my ( $jid, $muc, @args ) = @_;
709
710	my $invite_jid = shift @args;
711	$muc = shift @args if scalar @args;
712
713	die('Usage: jmuc invite <jid> [<muc>] [-a <account>]')
714	unless $muc && $invite_jid;
715
716	my $message = Net::Jabber::Message->new();
717	$message->SetTo($muc);
718	my $x = $message->NewChild('http://jabber.org/protocol/muc#user');
719	$x->AddInvite();
720	$x->GetInvite()->SetTo($invite_jid);
721	$conn->getConnectionFromJID($jid)->Send($message);
722	queue_admin_msg("$jid has invited $invite_jid to $muc.");
723	}
724
725	sub jmuc_configure {
726	my ( $jid, $muc, @args ) = @_;
727	$muc = shift @args if scalar @args;
728	die("Usage: jmuc configure [<muc>]") unless $muc;
729	my $iq = Net::Jabber::IQ->new();
730	$iq->SetTo($muc);
731	$iq->SetType('set');
732	my $query = $iq->NewQuery("http://jabber.org/protocol/muc#owner");
733	my $x = $query->NewChild("jabber:x:data");
734	$x->SetType('submit');
735
736	$conn->getConnectionFromJID($jid)->Send($iq);
737	queue_admin_msg("Accepted default instant configuration for $muc");
738	}
739
740	sub jmuc_presence_single {
741	my $m = shift;
742	my @jids = $m->Presence();
743
744	my $presence = "JIDs present in " . $m->BaseJID;
745	$completion_jids{$m->BaseJID} = 1;
746	if($m->Anonymous) {
747	$presence .= " [anonymous MUC]";
748	}
749	$presence .= "\n\t";
750	$presence .= join("\n\t", map {pp_jid($m, $_);} @jids) . "\n";
751	return $presence;
752	}
753
754	sub pp_jid {
755	my ($m, $jid) = @_;
756	my $nick = $jid->GetResource;
757	my $full = $m->GetFullJID($jid);
758	if($full && $full ne $nick) {
759	return "$nick ($full)";
760	} else {
761	return "$nick";
762	}
763	}
764
765	sub jmuc_presence {
766	my ( $jid, $muc, @args ) = @_;
767
768	$muc = shift @args if scalar @args;
769	die("Usage: jmuc presence [<muc>]") unless $muc;
770
771	if ($muc eq '-a') {
772	my $str = "";
773	foreach my $jid ($conn->getJIDs()) {
774	$str .= BarnOwl::Style::boldify("Conferences for $jid:\n");
775	my $connection = $conn->getConnectionFromJID($jid);
776	foreach my $muc ($connection->MUCs) {
777	$str .= jmuc_presence_single($muc)."\n";
778	}
779	}
780	BarnOwl::popless_ztext($str);
781	}
782	else {
783	my $m = $conn->getConnectionFromJID($jid)->FindMUC(jid => $muc);
784	die("No such muc: $muc") unless $m;
785	BarnOwl::popless_ztext(jmuc_presence_single($m));
786	}
787	}
788
789
790	#XXX TODO: Consider merging this with jmuc and selecting off the first two args.
791	sub cmd_jroster {
792	die "You are not logged in to Jabber" unless $conn->connected();
793	my $ocmd = shift;
794	my $cmd = shift;
795	if ( !$cmd ) {
796
797	#XXX TODO: Write general usage for jroster command.
798	return;
799	}
800
801	my %jroster_commands = (
802	sub => \&jroster_sub,
803	unsub => \&jroster_unsub,
804	add => \&jroster_add,
805	remove => \&jroster_remove,
806	auth => \&jroster_auth,
807	deauth => \&jroster_deauth
808	);
809	my $func = $jroster_commands{$cmd};
810	if ( !$func ) {
811	BarnOwl::error("jroster: Unknown command: $cmd");
812	return;
813	}
814
815	{
816	local @ARGV = @_;
817	my $jid;
818	my $name;
819	my @groups;
820	my $purgeGroups;
821	my $getopt = Getopt::Long::Parser->new;
822	$getopt->configure('pass_through', 'no_getopt_compat');
823	$getopt->getoptions(
824	'account=s' => \$jid,
825	'group=s' => \@groups,
826	'purgegroups' => \$purgeGroups,
827	'name=s' => \$name
828	);
829	$jid \|\|= defaultJID();
830	if ($jid) {
831	$jid = resolveConnectedJID($jid);
832	return unless $jid;
833	}
834	else {
835	BarnOwl::error('You must specify an account with -a <jid>');
836	}
837	return $func->( $jid, $name, \@groups, $purgeGroups, @ARGV );
838	}
839	}
840
841	sub cmd_jaway {
842	my $cmd = shift;
843	local @ARGV = @_;
844	my $getopt = Getopt::Long::Parser->new;
845	my ($jid, $show);
846	my $p = new Net::Jabber::Presence;
847
848	$getopt->configure('pass_through', 'no_getopt_compat');
849	$getopt->getoptions(
850	'account=s' => \$jid,
851	'show=s' => \$show
852	);
853	$jid \|\|= defaultJID();
854	if ($jid) {
855	$jid = resolveConnectedJID($jid);
856	return unless $jid;
857	}
858	else {
859	BarnOwl::error('You must specify an account with -a <jid>');
860	}
861
862	$p->SetShow($show eq "online" ? "" : $show) if $show;
863	$p->SetStatus(join(' ', @ARGV)) if @ARGV;
864	$conn->getConnectionFromJID($jid)->Send($p);
865	}
866
867
868	sub jroster_sub {
869	my $jid = shift;
870	my $name = shift;
871	my @groups = @{ shift() };
872	my $purgeGroups = shift;
873	my $baseJID = baseJID($jid);
874
875	my $roster = $conn->getRosterFromJID($jid);
876
877	# Adding lots of users with the same name is a bad idea.
878	$name = "" unless (1 == scalar(@ARGV));
879
880	my $p = new Net::Jabber::Presence;
881	$p->SetType('subscribe');
882
883	foreach my $to (@ARGV) {
884	jroster_add($jid, $name, \@groups, $purgeGroups, ($to)) unless ($roster->exists($to));
885
886	$p->SetTo($to);
887	$conn->getConnectionFromJID($jid)->Send($p);
888	queue_admin_msg("You ($baseJID) have requested a subscription to ($to)'s presence.");
889	}
890	}
891
892	sub jroster_unsub {
893	my $jid = shift;
894	my $name = shift;
895	my @groups = @{ shift() };
896	my $purgeGroups = shift;
897	my $baseJID = baseJID($jid);
898
899	my $p = new Net::Jabber::Presence;
900	$p->SetType('unsubscribe');
901	foreach my $to (@ARGV) {
902	$p->SetTo($to);
903	$conn->getConnectionFromJID($jid)->Send($p);
904	queue_admin_msg("You ($baseJID) have unsubscribed from ($to)'s presence.");
905	}
906	}
907
908	sub jroster_add {
909	my $jid = shift;
910	my $name = shift;
911	my @groups = @{ shift() };
912	my $purgeGroups = shift;
913	my $baseJID = baseJID($jid);
914
915	my $roster = $conn->getRosterFromJID($jid);
916
917	# Adding lots of users with the same name is a bad idea.
918	$name = "" unless (1 == scalar(@ARGV));
919
920	$completion_jids{$baseJID} = 1;
921	$completion_jids{$name} = 1 if $name;
922
923	foreach my $to (@ARGV) {
924	my %jq = $roster->query($to);
925	my $iq = new Net::Jabber::IQ;
926	$iq->SetType('set');
927	my $item = new XML::Stream::Node('item');
928	$iq->NewChild('jabber:iq:roster')->AddChild($item);
929
930	my %allGroups = ();
931
932	foreach my $g (@groups) {
933	$allGroups{$g} = $g;
934	}
935
936	unless ($purgeGroups) {
937	foreach my $g (@{$jq{groups}}) {
938	$allGroups{$g} = $g;
939	}
940	}
941
942	foreach my $g (keys %allGroups) {
943	$item->add_child('group')->add_cdata($g);
944	}
945
946	$item->put_attrib(jid => $to);
947	$item->put_attrib(name => $name) if $name;
948	$conn->getConnectionFromJID($jid)->Send($iq);
949	my $msg = "$baseJID: "
950	. ($name ? "$name ($to)" : "($to)")
951	. " is on your roster in the following groups: { "
952	. join(" , ", keys %allGroups)
953	. " }";
954	queue_admin_msg($msg);
955	}
956	}
957
958	sub jroster_remove {
959	my $jid = shift;
960	my $name = shift;
961	my @groups = @{ shift() };
962	my $purgeGroups = shift;
963	my $baseJID = baseJID($jid);
964
965	my $iq = new Net::Jabber::IQ;
966	$iq->SetType('set');
967	my $item = new XML::Stream::Node('item');
968	$iq->NewChild('jabber:iq:roster')->AddChild($item);
969	$item->put_attrib(subscription=> 'remove');
970	foreach my $to (@ARGV) {
971	$item->put_attrib(jid => $to);
972	$conn->getConnectionFromJID($jid)->Send($iq);
973	queue_admin_msg("You ($baseJID) have removed ($to) from your roster.");
974	}
975	}
976
977	sub jroster_auth {
978	my $jid = shift;
979	my $name = shift;
980	my @groups = @{ shift() };
981	my $purgeGroups = shift;
982	my $baseJID = baseJID($jid);
983
984	my $p = new Net::Jabber::Presence;
985	$p->SetType('subscribed');
986	foreach my $to (@ARGV) {
987	$p->SetTo($to);
988	$conn->getConnectionFromJID($jid)->Send($p);
989	queue_admin_msg("($to) has been subscribed to your ($baseJID) presence.");
990	}
991	}
992
993	sub jroster_deauth {
994	my $jid = shift;
995	my $name = shift;
996	my @groups = @{ shift() };
997	my $purgeGroups = shift;
998	my $baseJID = baseJID($jid);
999
1000	my $p = new Net::Jabber::Presence;
1001	$p->SetType('unsubscribed');
1002	foreach my $to (@ARGV) {
1003	$p->SetTo($to);
1004	$conn->getConnectionFromJID($jid)->Send($p);
1005	queue_admin_msg("($to) has been unsubscribed from your ($baseJID) presence.");
1006	}
1007	}
1008
1009	################################################################################
1010	### Owl Callbacks
1011	sub process_owl_jwrite {
1012	my $body = shift;
1013
1014	my $j = new Net::Jabber::Message;
1015	$body =~ s/\n\z//;
1016	$j->SetMessage(
1017	to => $vars{jwrite}{to},
1018	from => $vars{jwrite}{from},
1019	type => $vars{jwrite}{type},
1020	body => $body
1021	);
1022
1023	$j->SetThread( $vars{jwrite}{thread} ) if ( $vars{jwrite}{thread} );
1024	$j->SetSubject( $vars{jwrite}{subject} ) if ( $vars{jwrite}{subject} );
1025
1026	my $m = j2o( $j, { direction => 'out' } );
1027	if ( $vars{jwrite}{type} ne 'groupchat') {
1028	BarnOwl::queue_message($m);
1029	}
1030
1031	$j->RemoveFrom(); # Kludge to get around gtalk's random bits after the resource.
1032	if ($vars{jwrite}{sid} && $conn->sidExists( $vars{jwrite}{sid} )) {
1033	$conn->getConnectionFromSid($vars{jwrite}{sid})->Send($j);
1034	}
1035	else {
1036	$conn->getConnectionFromJID($vars{jwrite}{from})->Send($j);
1037	}
1038
1039	delete $vars{jwrite};
1040	BarnOwl::message(""); # Kludge to make the ``type your message...'' message go away
1041	}
1042
1043	### XMPP Callbacks
1044
1045	sub process_incoming_chat_message {
1046	my ( $sid, $j ) = @_;
1047	if ($j->DefinedBody() \|\| BarnOwl::getvar('jabber:spew') eq 'on') {
1048	BarnOwl::queue_message( j2o( $j, { direction => 'in',
1049	sid => $sid } ) );
1050	}
1051	}
1052
1053	sub process_incoming_error_message {
1054	my ( $sid, $j ) = @_;
1055	my %jhash = j2hash( $j, { direction => 'in',
1056	sid => $sid } );
1057	$jhash{type} = 'admin';
1058
1059	BarnOwl::queue_message( BarnOwl::Message->new(%jhash) );
1060	}
1061
1062	sub process_incoming_groupchat_message {
1063	my ( $sid, $j ) = @_;
1064
1065	# HACK IN PROGRESS (ignoring delayed messages)
1066	return if ( $j->DefinedX('jabber:x:delay') && $j->GetX('jabber:x:delay') );
1067	BarnOwl::queue_message( j2o( $j, { direction => 'in',
1068	sid => $sid } ) );
1069	}
1070
1071	sub process_incoming_headline_message {
1072	my ( $sid, $j ) = @_;
1073	BarnOwl::queue_message( j2o( $j, { direction => 'in',
1074	sid => $sid } ) );
1075	}
1076
1077	sub process_incoming_normal_message {
1078	my ( $sid, $j ) = @_;
1079	my %jhash = j2hash( $j, { direction => 'in',
1080	sid => $sid } );
1081
1082	# XXX TODO: handle things such as MUC invites here.
1083
1084	# if ($j->HasX('http://jabber.org/protocol/muc#user'))
1085	# {
1086	# my $x = $j->GetX('http://jabber.org/protocol/muc#user');
1087	# if ($x->HasChild('invite'))
1088	# {
1089	# $props
1090	# }
1091	# }
1092	#
1093	if ($j->DefinedBody() \|\| BarnOwl::getvar('jabber:spew') eq 'on') {
1094	BarnOwl::queue_message( BarnOwl::Message->new(%jhash) );
1095	}
1096	}
1097
1098	sub process_muc_presence {
1099	my ( $sid, $p ) = @_;
1100	return unless ( $p->HasX('http://jabber.org/protocol/muc#user') );
1101	}
1102
1103
1104	sub process_presence_available {
1105	my ( $sid, $p ) = @_;
1106	my $from = $p->GetFrom('jid')->GetJID('base');
1107	$completion_jids{$from} = 1;
1108	return unless (BarnOwl::getvar('jabber:show_logins') eq 'on');
1109	my $to = $p->GetTo();
1110	my $type = $p->GetType();
1111	my %props = (
1112	to => $to,
1113	from => $p->GetFrom(),
1114	recipient => $to,
1115	sender => $from,
1116	type => 'jabber',
1117	jtype => $p->GetType(),
1118	status => $p->GetStatus(),
1119	show => $p->GetShow(),
1120	xml => $p->GetXML(),
1121	direction => 'in');
1122
1123	if ($type eq '' \|\| $type eq 'available') {
1124	$props{body} = "$from is now online. ";
1125	$props{loginout} = 'login';
1126	}
1127	else {
1128	$props{body} = "$from is now offline. ";
1129	$props{loginout} = 'logout';
1130	}
1131	BarnOwl::queue_message(BarnOwl::Message->new(%props));
1132	}
1133
1134	sub process_presence_subscribe {
1135	my ( $sid, $p ) = @_;
1136	my $from = $p->GetFrom();
1137	my $to = $p->GetTo();
1138	my %props = (
1139	to => $to,
1140	from => $from,
1141	xml => $p->GetXML(),
1142	type => 'admin',
1143	adminheader => 'Jabber presence: subscribe',
1144	direction => 'in');
1145
1146	$props{body} = "Allow user ($from) to subscribe to your ($to) presence?\n" .
1147	"(Answer with the `yes' or `no' commands)";
1148	$props{yescommand} = BarnOwl::quote('jroster', 'auth', $from, '-a', $to);
1149	$props{nocommand} = BarnOwl::quote('jroster', 'deauth', $from, '-a', $to);
1150	$props{question} = "true";
1151	BarnOwl::queue_message(BarnOwl::Message->new(%props));
1152	}
1153
1154	sub process_presence_unsubscribe {
1155	my ( $sid, $p ) = @_;
1156	my $from = $p->GetFrom();
1157	my $to = $p->GetTo();
1158	my %props = (
1159	to => $to,
1160	from => $from,
1161	xml => $p->GetXML(),
1162	type => 'admin',
1163	adminheader => 'Jabber presence: unsubscribe',
1164	direction => 'in');
1165
1166	$props{body} = "The user ($from) has been unsubscribed from your ($to) presence.\n";
1167	BarnOwl::queue_message(BarnOwl::Message->new(%props));
1168
1169	# Find a connection to reply with.
1170	foreach my $jid ($conn->getJIDs()) {
1171	my $cJID = new Net::Jabber::JID;
1172	$cJID->SetJID($jid);
1173	if ($to eq $cJID->GetJID('base') \|\|
1174	$to eq $cJID->GetJID('full')) {
1175	my $reply = $p->Reply(type=>"unsubscribed");
1176	$conn->getConnectionFromJID($jid)->Send($reply);
1177	return;
1178	}
1179	}
1180	}
1181
1182	sub process_presence_subscribed {
1183	my ( $sid, $p ) = @_;
1184	queue_admin_msg("ignoring:".$p->GetXML()) if BarnOwl::getvar('jabber:spew') eq 'on';
1185	# RFC 3921 says we should respond to this with a "subscribe"
1186	# but this causes a flood of sub/sub'd presence packets with
1187	# some servers, so we won't. We may want to detect this condition
1188	# later, and have per-server settings.
1189	return;
1190	}
1191
1192	sub process_presence_unsubscribed {
1193	my ( $sid, $p ) = @_;
1194	queue_admin_msg("ignoring:".$p->GetXML()) if BarnOwl::getvar('jabber:spew') eq 'on';
1195	# RFC 3921 says we should respond to this with a "subscribe"
1196	# but this causes a flood of unsub/unsub'd presence packets with
1197	# some servers, so we won't. We may want to detect this condition
1198	# later, and have per-server settings.
1199	return;
1200	}
1201
1202	sub process_presence_error {
1203	my ( $sid, $p ) = @_;
1204	my $code = $p->GetErrorCode();
1205	my $error = $p->GetError();
1206	BarnOwl::error("Jabber: $code $error");
1207	}
1208
1209
1210	### Helper functions
1211
1212	sub j2hash {
1213	my $j = shift;
1214	my %props = (type => 'jabber',
1215	dir => 'none',
1216	%{$_[0]});
1217
1218	my $dir = $props{direction};
1219
1220	my $jtype = $props{jtype} = $j->GetType();
1221	my $from = $j->GetFrom('jid');
1222	my $to = $j->GetTo('jid');
1223
1224	$props{from} = $from->GetJID('full');
1225	$props{to} = $to->GetJID('full');
1226
1227	$props{recipient} = $to->GetJID('base');
1228	$props{sender} = $from->GetJID('base');
1229	$props{subject} = $j->GetSubject() if ( $j->DefinedSubject() );
1230	$props{thread} = $j->GetThread() if ( $j->DefinedThread() );
1231	if ( $j->DefinedBody() ) {
1232	$props{body} = $j->GetBody();
1233	$props{body} =~ s/\xEF\xBB\xBF//g; # Strip stray Byte-Order-Marks.
1234	}
1235	$props{error} = $j->GetError() if ( $j->DefinedError() );
1236	$props{error_code} = $j->GetErrorCode() if ( $j->DefinedErrorCode() );
1237	$props{xml} = $j->GetXML();
1238
1239	if ( $jtype eq 'groupchat' ) {
1240	my $nick = $props{nick} = $from->GetResource();
1241	my $room = $props{room} = $from->GetJID('base');
1242	$completion_jids{$room} = 1;
1243
1244	$props{sender} = $nick \|\| $room;
1245	$props{recipient} = $room;
1246
1247	if ( $props{subject} && !$props{body} ) {
1248	$props{body} =
1249	'[' . $nick . " has set the topic to: " . $props{subject} . "]";
1250	}
1251	}
1252	elsif ( $jtype eq 'headline' ) {
1253	;
1254	}
1255	elsif ( $jtype eq 'error' ) {
1256	$props{body} = "Error "
1257	. $props{error_code}
1258	. " sending to "
1259	. $props{from} . "\n"
1260	. $props{error};
1261	}
1262	else { # chat, or normal (default)
1263	$props{private} = 1;
1264
1265	my $connection;
1266	if ($dir eq 'in') {
1267	$connection = $conn->getConnectionFromSid($props{sid});
1268	}
1269	else {
1270	$connection = $conn->getConnectionFromJID($props{from});
1271	}
1272
1273	# Check to see if we're doing personals with someone in a muc.
1274	# If we are, show the full jid because the base jid is the room.
1275	if ($connection) {
1276	$props{sender} = $props{from}
1277	if ($connection->FindMUC(jid => $from));
1278	$props{recipient} = $props{to}
1279	if ($connection->FindMUC(jid => $to));
1280	}
1281
1282	# Populate completion.
1283	if ($dir eq 'in') {
1284	$completion_jids{ $props{sender} }= 1;
1285	}
1286	else {
1287	$completion_jids{ $props{recipient} } = 1;
1288	}
1289	}
1290
1291	return %props;
1292	}
1293
1294	sub j2o {
1295	return BarnOwl::Message->new( j2hash(@_) );
1296	}
1297
1298	sub queue_admin_msg {
1299	my $err = shift;
1300	BarnOwl::admin_message("Jabber", $err);
1301	}
1302
1303	sub getServerFromJID {
1304	my $jid = shift;
1305	my $res = new Net::DNS::Resolver;
1306	my $packet =
1307	$res->search( '_xmpp-client._tcp.' . $jid->GetServer(), 'srv' );
1308
1309	if ($packet) # Got srv record.
1310	{
1311	my @answer = $packet->answer;
1312	return $answer[0]{target}, $answer[0]{port};
1313	}
1314
1315	return $jid->GetServer(), 5222;
1316	}
1317
1318	sub defaultJID {
1319	return ( $conn->getJIDs() )[0] if ( $conn->connected() == 1 );
1320	return;
1321	}
1322
1323	sub baseJID {
1324	my $givenJIDStr = shift;
1325	my $givenJID = new Net::Jabber::JID;
1326	$givenJID->SetJID($givenJIDStr);
1327	return $givenJID->GetJID('base');
1328	}
1329
1330	sub resolveConnectedJID {
1331	my $givenJIDStr = shift;
1332	my $loose = shift \|\| 0;
1333	my $givenJID = new Net::Jabber::JID;
1334	$givenJID->SetJID($givenJIDStr);
1335
1336	# Account fully specified.
1337	if ( $givenJID->GetResource() ) {
1338	# Specified account exists
1339	return $givenJIDStr if ($conn->jidExists($givenJIDStr) );
1340	return resolveConnectedJID($givenJID->GetJID('base')) if $loose;
1341	die("Invalid account: $givenJIDStr");
1342	}
1343
1344	# Disambiguate.
1345	else {
1346	my $JIDMatchingJID = "";
1347	my $strMatchingJID = "";
1348	my $JIDMatches = "";
1349	my $strMatches = "";
1350	my $JIDAmbiguous = 0;
1351	my $strAmbiguous = 0;
1352
1353	foreach my $jid ( $conn->getJIDs() ) {
1354	my $cJID = new Net::Jabber::JID;
1355	$cJID->SetJID($jid);
1356	if ( $givenJIDStr eq $cJID->GetJID('base') ) {
1357	$JIDAmbiguous = 1 if ( $JIDMatchingJID ne "" );
1358	$JIDMatchingJID = $jid;
1359	$JIDMatches .= "\t$jid\n";
1360	}
1361	if ( $cJID->GetJID('base') =~ /$givenJIDStr/ ) {
1362	$strAmbiguous = 1 if ( $strMatchingJID ne "" );
1363	$strMatchingJID = $jid;
1364	$strMatches .= "\t$jid\n";
1365	}
1366	}
1367
1368	# Need further disambiguation.
1369	if ($JIDAmbiguous) {
1370	my $errStr =
1371	"Ambiguous account reference. Please specify a resource.\n";
1372	die($errStr.$JIDMatches);
1373	}
1374
1375	# It's this one.
1376	elsif ($JIDMatchingJID ne "") {
1377	return $JIDMatchingJID;
1378	}
1379
1380	# Further resolution by substring.
1381	elsif ($strAmbiguous) {
1382	my $errStr =
1383	"Ambiguous account reference. Please be more specific.\n";
1384	die($errStr.$strMatches);
1385	}
1386
1387	# It's this one, by substring.
1388	elsif ($strMatchingJID ne "") {
1389	return $strMatchingJID;
1390	}
1391
1392	# Not one of ours.
1393	else {
1394	die("Invalid account: $givenJIDStr");
1395	}
1396
1397	}
1398	return "";
1399	}
1400
1401	sub resolveDestJID {
1402	my ($to, $from) = @_;
1403	my $jid = Net::Jabber::JID->new($to);
1404
1405	my $roster = $conn->getRosterFromJID($from);
1406	my @jids = $roster->jids('all');
1407	for my $j (@jids) {
1408	if(($roster->query($j, 'name') \|\| $j->GetUserID()) eq $to) {
1409	return $j->GetJID('full');
1410	} elsif($j->GetJID('base') eq baseJID($to)) {
1411	return $jid->GetJID('full');
1412	}
1413	}
1414
1415	# If we found nothing being clever, check to see if our input was
1416	# sane enough to look like a jid with a UserID.
1417	return $jid->GetJID('full') if $jid->GetUserID();
1418	return undef;
1419	}
1420
1421	sub resolveType {
1422	my $to = shift;
1423	my $from = shift;
1424	return unless $from;
1425	my @mucs = $conn->getConnectionFromJID($from)->MUCs;
1426	if(grep {$_->BaseJID eq $to } @mucs) {
1427	return 'groupchat';
1428	} else {
1429	return 'chat';
1430	}
1431	}
1432
1433	sub guess_jwrite {
1434	# Heuristically guess what jids a jwrite was meant to be going to/from
1435	my ($from, $to) = (@_);
1436	my ($from_jid, $to_jid);
1437	my @matches;
1438	if($from) {
1439	$from_jid = resolveConnectedJID($from, 1);
1440	die("Unable to resolve account $from") unless $from_jid;
1441	$to_jid = resolveDestJID($to, $from_jid);
1442	push @matches, [$from_jid, $to_jid] if $to_jid;
1443	} else {
1444	for my $f ($conn->getJIDs) {
1445	$to_jid = resolveDestJID($to, $f);
1446	if(defined($to_jid)) {
1447	push @matches, [$f, $to_jid];
1448	}
1449	}
1450	if($to =~ /@/) {
1451	push @matches, [$_, $to]
1452	for ($conn->getJIDs);
1453	}
1454	}
1455
1456	for my $m (@matches) {
1457	my $type = resolveType($m->[1], $m->[0]);
1458	push @$m, $type;
1459	}
1460
1461	return @matches;
1462	}
1463
1464	################################################################################
1465	### Completion
1466
1467	sub complete_user_or_muc { return keys %completion_jids; }
1468	sub complete_account { return $conn->getJIDs(); }
1469
1470	sub complete_jwrite {
1471	my $ctx = shift;
1472	return complete_flags($ctx,
1473	[qw(-t -i -s)],
1474	{
1475	"-a" => \&complete_account,
1476	},
1477	\&complete_user_or_muc
1478	);
1479	}
1480
1481	BarnOwl::Completion::register_completer(jwrite => sub { BarnOwl::Module::Jabber::complete_jwrite(@_) });
1482
1483	1;

Note: See TracBrowser for help on using the repository browser.

Download in other formats: