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