Changeset b405ff6
- Timestamp:
- Nov 10, 2006, 12:57:08 PM (18 years ago)
- Branches:
- master, barnowl_perlaim, debian, release-1.10, release-1.4, release-1.5, release-1.6, release-1.7, release-1.8, release-1.9
- Children:
- d9f4a5c
- Parents:
- 9f183ff
- git-author:
- Nelson Elhage <nelhage@mit.edu> (11/10/06 12:56:50)
- git-committer:
- Nelson Elhage <nelhage@mit.edu> (11/10/06 12:57:08)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
perl/modules/jabber.pl
r9f183ff rb405ff6 1 # -*- mode: cperl; cperl-indent-level: 4; indent-tabs-mode: nil -*- 1 2 package owl_jabber; 2 3 use warnings; … … 26 27 our %vars; 27 28 28 sub onStart 29 { 30 if(eval{\&owl::queue_message}) 31 { 32 register_owl_commands(); 33 push @::onMainLoop, sub { owl_jabber::onMainLoop(@_) }; 34 push @::onGetBuddyList, sub { owl_jabber::onGetBuddyList(@_) }; 35 } 36 else 37 { 29 sub onStart { 30 if ( eval { \&owl::queue_message } ) { 31 register_owl_commands(); 32 push @::onMainLoop, sub { owl_jabber::onMainLoop(@_) }; 33 push @::onGetBuddyList, sub { owl_jabber::onGetBuddyList(@_) }; 34 } 35 else { 36 38 37 # Our owl doesn't support queue_message. Unfortunately, this 39 38 # means it probably *also* doesn't support owl::error. So just … … 44 43 push @::onStartSubs, sub { owl_jabber::onStart(@_) }; 45 44 46 sub onMainLoop 47 { 48 return if (!connected()); 49 50 foreach my $jid (keys %$connections) 51 { 52 my $client = \$connections->{$jid}->{client}; 53 54 my $status = $$client->Process(0); 55 if(!defined($status)) { 45 sub onMainLoop { 46 return if ( !connected() ); 47 48 foreach my $jid ( keys %$connections ) { 49 my $client = \$connections->{$jid}->{client}; 50 51 my $status = $$client->Process(0); 52 if ( !defined($status) ) { 56 53 owl::error("Jabber account $jid disconnected!"); 57 54 do_logout($jid); 58 55 } 59 if ($::shutdown) 60 { 61 do_logout($jid); 62 return; 63 } 64 } 65 } 66 67 sub blist_listBuddy 68 { 56 if ($::shutdown) { 57 do_logout($jid); 58 return; 59 } 60 } 61 } 62 63 sub blist_listBuddy { 69 64 my $roster = shift; 70 my $buddy = shift;65 my $buddy = shift; 71 66 my $blistStr .= " "; 72 my %jq = $$roster->query($buddy);67 my %jq = $$roster->query($buddy); 73 68 my $res = $$roster->resource($buddy); 74 69 75 70 $blistStr .= $jq{name} ? $jq{name} : $buddy->GetJID(); 76 77 if ($res) 78 { 79 my %rq = $$roster->resourceQuery($buddy, $res); 80 $blistStr .= " [".($rq{show} ? $rq{show} : 'online')."]"; 81 $blistStr .= " ".$rq{status} if $rq{status}; 82 $blistStr = boldify($blistStr); 83 } 84 else 85 { 86 $blistStr .= $jq{ask} ? " [pending]" : " [offline]"; 87 } 88 89 return $blistStr."\n"; 90 } 91 92 sub onGetBuddyList 93 { 71 72 if ($res) { 73 my %rq = $$roster->resourceQuery( $buddy, $res ); 74 $blistStr .= " [" . ( $rq{show} ? $rq{show} : 'online' ) . "]"; 75 $blistStr .= " " . $rq{status} if $rq{status}; 76 $blistStr = boldify($blistStr); 77 } 78 else { 79 $blistStr .= $jq{ask} ? " [pending]" : " [offline]"; 80 } 81 82 return $blistStr . "\n"; 83 } 84 85 sub onGetBuddyList { 94 86 my $blist = ""; 95 foreach my $jid (keys %{$connections}) 96 { 97 my $roster = \$connections->{$jid}->{roster}; 98 if ($$roster) 99 { 100 $blist .= "\n".boldify("Jabber Roster for $jid\n"); 101 102 foreach my $group ($$roster->groups()) 103 { 104 $blist .= " Group: $group\n"; 105 foreach my $buddy ($$roster->jids('group',$group)) 106 { 107 $blist .= blist_listBuddy($roster, $buddy); 108 } 109 } 110 111 my @unsorted = $$roster->jids('nogroup'); 112 if (@unsorted) 113 { 114 $blist .= " [unsorted]\n"; 115 foreach my $buddy (@unsorted) 116 { 117 $blist .= blist_listBuddy($roster, $buddy); 118 } 119 } 120 } 87 foreach my $jid ( keys %{$connections} ) { 88 my $roster = \$connections->{$jid}->{roster}; 89 if ($$roster) { 90 $blist .= "\n" . boldify("Jabber Roster for $jid\n"); 91 92 foreach my $group ( $$roster->groups() ) { 93 $blist .= " Group: $group\n"; 94 foreach my $buddy ( $$roster->jids( 'group', $group ) ) { 95 $blist .= blist_listBuddy( $roster, $buddy ); 96 } 97 } 98 99 my @unsorted = $$roster->jids('nogroup'); 100 if (@unsorted) { 101 $blist .= " [unsorted]\n"; 102 foreach my $buddy (@unsorted) { 103 $blist .= blist_listBuddy( $roster, $buddy ); 104 } 105 } 106 } 121 107 } 122 108 return $blist; … … 125 111 ################################################################################ 126 112 ### Owl Commands 127 sub register_owl_commands() 128 { 113 sub register_owl_commands() { 129 114 owl::new_command( 130 115 jabberlogin => \&cmd_login, … … 138 123 jwrite => \&cmd_jwrite, 139 124 { 140 summary 141 usage 125 summary => "Send a Jabber Message", 126 usage => "jwrite JID [-g] [-t thread] [-s subject]" 142 127 } 143 128 ); … … 145 130 jlist => \&cmd_jlist, 146 131 { 147 summary 148 usage 132 summary => "Show your Jabber roster.", 133 usage => "jlist" 149 134 } 150 135 ); … … 153 138 { 154 139 summary => "Jabber MUC related commands.", 155 description => "jmuc sends jabber commands related to muc.\n\n". 156 "The following commands are available\n\n". 157 "join {muc} Join a muc.\n\n". 158 "part [muc] Part a muc.". 159 " The muc is taken from the current message if not supplied.\n\n". 160 "invite {jid} [muc]\n\n". 161 " Invite {jid} to [muc].\n". 162 " The muc is taken from the current message if not supplied.\n\n", 163 usage => "jmuc {command} {args}" 164 } 165 ); 166 } 167 168 sub cmd_login 169 { 140 description => "jmuc sends jabber commands related to muc.\n\n" 141 . "The following commands are available\n\n" 142 . "join {muc} Join a muc.\n\n" 143 . "part [muc] Part a muc.\n" 144 . " The muc is taken from the current message if not supplied.\n\n" 145 . "invite {jid} [muc]\n" 146 . " Invite {jid} to [muc].\n" 147 . " The muc is taken from the current message if not supplied.\n\n" 148 . "configure [muc]\n" " Configure [muc].\n" 149 . " Necessary to initalize a new MUC", 150 usage => "jmuc {command} {args}" 151 } 152 ); 153 } 154 155 sub cmd_login { 170 156 my $cmd = shift; 171 157 my $jid = new Net::XMPP::JID; 172 158 $jid->SetJID(shift); 173 174 my $uid = $jid->GetUserID();159 160 my $uid = $jid->GetUserID(); 175 161 my $componentname = $jid->GetServer(); 176 my $resource = $jid->GetResource() || 'owl';162 my $resource = $jid->GetResource() || 'owl'; 177 163 $jid->SetResource($resource); 178 164 my $jidStr = $jid->GetJID('full'); 179 165 180 if ( !$uid || !$componentname)181 {182 owl::error("usage: $cmd {jid}");183 return; 184 } 185 186 if ($connections->{$jidStr})187 {188 owl::error("Already logged in as $jidStr."); 189 return; 190 }191 192 my ($server, $port) = getServerFromJID($jid);193 194 $connections->{$jidStr}->{client} = Net::Jabber::Client->new(debuglevel => owl::getvar('debug') eq 'on' ? 1 : 0,195 debugfile => 'jabber.log');166 if ( !$uid || !$componentname ) { 167 owl::error("usage: $cmd {jid}"); 168 return; 169 } 170 171 if ( $connections->{$jidStr} ) { 172 owl::error("Already logged in as $jidStr."); 173 return; 174 } 175 176 my ( $server, $port ) = getServerFromJID($jid); 177 178 $connections->{$jidStr}->{client} = Net::Jabber::Client->new( 179 debuglevel => owl::getvar('debug') eq 'on' ? 1 : 0, 180 debugfile => 'jabber.log' 181 ); 196 182 my $client = \$connections->{$jidStr}->{client}; 197 $connections->{$jidStr}->{roster} = $connections->{$jidStr}->{client}->Roster(); 183 $connections->{$jidStr}->{roster} = 184 $connections->{$jidStr}->{client}->Roster(); 198 185 199 186 #XXX Todo: Add more callbacks. 200 187 # MUC presence handlers 201 $$client->SetMessageCallBacks(chat => sub { owl_jabber::process_incoming_chat_message(@_) }, 202 error => sub { owl_jabber::process_incoming_error_message(@_) }, 203 groupchat => sub { owl_jabber::process_incoming_groupchat_message(@_) }, 204 headline => sub { owl_jabber::process_incoming_headline_message(@_) }, 205 normal => sub { owl_jabber::process_incoming_normal_message(@_) }); 206 207 $vars{jlogin_connhash} = {hostname => $server, 208 tls => 1, 209 port => $port, 210 componentname => $componentname}; 211 212 my $status = $$client->Connect(%{$vars{jlogin_connhash}}); 213 214 if (!$status) 215 { 216 delete $connections->{$jidStr}; 217 delete $vars{jlogin_connhash}; 218 owl::error("We failed to connect"); 219 return ""; 220 } 221 222 223 $vars{jlogin_authhash} = {username => $uid, resource => $resource, password => ''}; 224 my @result = $$client->AuthSend(%{$vars{jlogin_authhash}}); 225 if($result[0] ne 'ok') 226 { 227 if ($result[1] == 401) 228 { 229 $vars{jlogin_jid} = $jidStr; 230 delete $connections->{$jidStr}; 231 owl::start_password("Password for $jidStr: ", \&do_login_with_pw); 232 return ""; 233 } 234 owl::error("Error in connect: " . join(" ", $result[1..$#result])); 235 do_logout($jidStr); 236 delete $vars{jlogin_connhash}; 237 delete $vars{jlogin_authhash}; 188 $$client->SetMessageCallBacks( 189 chat => sub { owl_jabber::process_incoming_chat_message(@_) }, 190 error => sub { owl_jabber::process_incoming_error_message(@_) }, 191 groupchat => sub { owl_jabber::process_incoming_groupchat_message(@_) }, 192 headline => sub { owl_jabber::process_incoming_headline_message(@_) }, 193 normal => sub { owl_jabber::process_incoming_normal_message(@_) } 194 ); 195 196 $vars{jlogin_connhash} = { 197 hostname => $server, 198 tls => 1, 199 port => $port, 200 componentname => $componentname 201 }; 202 203 my $status = $$client->Connect( %{ $vars{jlogin_connhash} } ); 204 205 if ( !$status ) { 206 delete $connections->{$jidStr}; 207 delete $vars{jlogin_connhash}; 208 owl::error("We failed to connect"); 238 209 return ""; 239 210 } 211 212 $vars{jlogin_authhash} = 213 { username => $uid, resource => $resource, password => '' }; 214 my @result = $$client->AuthSend( %{ $vars{jlogin_authhash} } ); 215 if ( $result[0] ne 'ok' ) { 216 if ( $result[1] == 401 ) { 217 $vars{jlogin_jid} = $jidStr; 218 delete $connections->{$jidStr}; 219 owl::start_password( "Password for $jidStr: ", \&do_login_with_pw ); 220 return ""; 221 } 222 owl::error( 223 "Error in connect: " . join( " ", $result[ 1 .. $#result ] ) ); 224 do_logout($jidStr); 225 delete $vars{jlogin_connhash}; 226 delete $vars{jlogin_authhash}; 227 return ""; 228 } 240 229 $connections->{$jidStr}->{roster}->fetch(); 241 $$client->PresenceSend( priority => 1);230 $$client->PresenceSend( priority => 1 ); 242 231 queue_admin_msg("Connected to jabber as $jidStr"); 243 232 delete $vars{jlogin_connhash}; … … 246 235 } 247 236 248 sub do_login_with_pw 249 { 237 sub do_login_with_pw { 250 238 $vars{jlogin_authhash}->{password} = shift; 251 239 my $jidStr = delete $vars{jlogin_jid}; 252 if (!$jidStr) 253 { 254 owl::error("Got password but have no jid!"); 240 if ( !$jidStr ) { 241 owl::error("Got password but have no jid!"); 255 242 } 256 243 257 244 $connections->{$jidStr}->{client} = Net::Jabber::Client->new(); 258 245 my $client = \$connections->{$jidStr}->{client}; 259 $connections->{$jidStr}->{roster} = $connections->{$jidStr}->{client}->Roster(); 260 261 $$client->SetMessageCallBacks(chat => sub { owl_jabber::process_incoming_chat_message(@_) }, 262 error => sub { owl_jabber::process_incoming_error_message(@_) }, 263 groupchat => sub { owl_jabber::process_incoming_groupchat_message(@_) }, 264 headline => sub { owl_jabber::process_incoming_headline_message(@_) }, 265 normal => sub { owl_jabber::process_incoming_normal_message(@_) }); 266 267 my $status = $$client->Connect(%{$vars{jlogin_connhash}}); 268 if (!$status) 269 { 270 delete $connections->{$jidStr}; 271 delete $vars{jlogin_connhash}; 272 delete $vars{jlogin_authhash}; 273 owl::error("We failed to connect"); 274 return ""; 275 } 276 277 my @result = $$client->AuthSend(%{$vars{jlogin_authhash}}); 278 279 if($result[0] ne 'ok') 280 { 281 owl::error("Error in connect: " . join(" ", $result[1..$#result])); 282 do_logout($jidStr); 283 delete $vars{jlogin_connhash}; 284 delete $vars{jlogin_authhash}; 246 $connections->{$jidStr}->{roster} = 247 $connections->{$jidStr}->{client}->Roster(); 248 249 $$client->SetMessageCallBacks( 250 chat => sub { owl_jabber::process_incoming_chat_message(@_) }, 251 error => sub { owl_jabber::process_incoming_error_message(@_) }, 252 groupchat => sub { owl_jabber::process_incoming_groupchat_message(@_) }, 253 headline => sub { owl_jabber::process_incoming_headline_message(@_) }, 254 normal => sub { owl_jabber::process_incoming_normal_message(@_) } 255 ); 256 257 my $status = $$client->Connect( %{ $vars{jlogin_connhash} } ); 258 if ( !$status ) { 259 delete $connections->{$jidStr}; 260 delete $vars{jlogin_connhash}; 261 delete $vars{jlogin_authhash}; 262 owl::error("We failed to connect"); 285 263 return ""; 286 264 } 287 265 266 my @result = $$client->AuthSend( %{ $vars{jlogin_authhash} } ); 267 268 if ( $result[0] ne 'ok' ) { 269 owl::error( 270 "Error in connect: " . join( " ", $result[ 1 .. $#result ] ) ); 271 do_logout($jidStr); 272 delete $vars{jlogin_connhash}; 273 delete $vars{jlogin_authhash}; 274 return ""; 275 } 276 288 277 $connections->{$jidStr}->{roster}->fetch(); 289 $$client->PresenceSend( priority => 1);278 $$client->PresenceSend( priority => 1 ); 290 279 queue_admin_msg("Connected to jabber as $jidStr"); 291 280 delete $vars{jlogin_connhash}; … … 294 283 } 295 284 296 sub do_logout 297 { 285 sub do_logout { 298 286 my $jid = shift; 299 287 $connections->{$jid}->{client}->Disconnect(); … … 302 290 } 303 291 304 sub cmd_logout 305 { 292 sub cmd_logout { 293 306 294 # Logged into multiple accounts 307 if (connected() > 1) 295 if ( connected() > 1 ) { 296 297 # Logged into multiple accounts, no accout specified. 298 if ( !$_[1] ) { 299 my $errStr = 300 "You are logged into multiple accounts. Please specify an account to log out of.\n"; 301 foreach my $jid ( keys %$connections ) { 302 $errStr .= "\t$jid\n"; 303 } 304 queue_admin_msg($errStr); 305 } 306 307 # Logged into multiple accounts, account specified. 308 else { 309 if ( $_[1] eq '-a' ) #All accounts. 310 { 311 foreach my $jid ( keys %$connections ) { 312 do_logout($jid); 313 } 314 } 315 else #One account. 316 { 317 my $jid = resolveJID( $_[1] ); 318 do_logout($jid) if ( $jid ne '' ); 319 } 320 } 321 } 322 else # Only one account logged in. 308 323 { 309 # Logged into multiple accounts, no accout specified. 310 if (!$_[1]) 311 { 312 my $errStr = "You are logged into multiple accounts. Please specify an account to log out of.\n"; 313 foreach my $jid (keys %$connections) 314 { 315 $errStr .= "\t$jid\n"; 316 } 317 queue_admin_msg($errStr); 318 } 319 # Logged into multiple accounts, account specified. 320 else 321 { 322 if ($_[1] eq '-a') #All accounts. 323 { 324 foreach my $jid (keys %$connections) 325 { 326 do_logout($jid); 327 } 328 } 329 else #One account. 330 { 331 my $jid = resolveJID($_[1]); 332 do_logout($jid) if ($jid ne ''); 333 } 334 } 335 } 336 else # Only one account logged in. 337 { 338 339 do_logout((keys %$connections)[0]); 324 325 do_logout( ( keys %$connections )[0] ); 340 326 } 341 327 return ""; 342 328 } 343 329 344 sub cmd_jlist 345 { 346 if (!(scalar keys %$connections)) 347 { 348 owl::error("You are not logged in to Jabber."); 349 return; 350 } 351 owl::popless_ztext(onGetBuddyList()); 352 } 353 354 sub cmd_jwrite 355 { 356 if (!connected()) 357 { 358 owl::error("You are not logged in to Jabber."); 359 return; 360 } 361 362 my $jwrite_to = ""; 363 my $jwrite_from = ""; 364 my $jwrite_thread = ""; 330 sub cmd_jlist { 331 if ( !( scalar keys %$connections ) ) { 332 owl::error("You are not logged in to Jabber."); 333 return; 334 } 335 owl::popless_ztext( onGetBuddyList() ); 336 } 337 338 sub cmd_jwrite { 339 if ( !connected() ) { 340 owl::error("You are not logged in to Jabber."); 341 return; 342 } 343 344 my $jwrite_to = ""; 345 my $jwrite_from = ""; 346 my $jwrite_thread = ""; 365 347 my $jwrite_subject = ""; 366 my $jwrite_type = "chat";348 my $jwrite_type = "chat"; 367 349 368 350 my @args = @_; … … 370 352 local @ARGV = @_; 371 353 my $gc; 372 GetOptions('thread=s' => \$jwrite_thread, 373 'subject=s' => \$jwrite_subject, 374 'account=s' => \$jwrite_from, 375 'groupchat' => \$gc); 354 GetOptions( 355 'thread=s' => \$jwrite_thread, 356 'subject=s' => \$jwrite_subject, 357 'account=s' => \$jwrite_from, 358 'groupchat' => \$gc 359 ); 376 360 $jwrite_type = 'groupchat' if $gc; 377 361 378 if (scalar @ARGV != 1) 362 if ( scalar @ARGV != 1 ) { 363 owl::error( 364 "Usage: jwrite JID [-g] [-t thread] [-s 'subject'] [-a account]"); 365 return; 366 } 367 else { 368 $jwrite_to = shift @ARGV; 369 } 370 371 if ( !$jwrite_from ) { 372 if ( connected() == 1 ) { 373 $jwrite_from = ( keys %$connections )[0]; 374 } 375 else { 376 owl::error("Please specify an account with -a {jid}"); 377 return; 378 } 379 } 380 else { 381 $jwrite_from = resolveJID($jwrite_from); 382 return unless $jwrite_from; 383 } 384 385 $vars{jwrite} = { 386 to => $jwrite_to, 387 from => $jwrite_from, 388 subject => $jwrite_subject, 389 thread => $jwrite_thread, 390 type => $jwrite_type 391 }; 392 393 owl::message( 394 "Type your message below. End with a dot on a line by itself. ^C will quit." 395 ); 396 owl::start_edit_win( join( ' ', @args ), \&process_owl_jwrite ); 397 } 398 399 sub cmd_jmuc { 400 die "You are not logged in to Jabber" unless connected(); 401 my $ocmd = shift; 402 my $cmd = shift; 403 if ( !$cmd ) { 404 405 #XXX TODO: Write general usage for jmuc command. 406 return; 407 } 408 409 my %jmuc_commands = ( 410 join => \&jmuc_join, 411 part => \&jmuc_part, 412 invite => \&jmuc_invite, 413 configure => \&jmuc_configure 414 ); 415 my $func = $jmuc_commands{$cmd}; 416 if ( !$func ) { 417 owl::error("jmuc: Unknown command: $cmd"); 418 return; 419 } 420 379 421 { 380 owl::error("Usage: jwrite JID [-g] [-t thread] [-s 'subject'] [-a account]"); 381 return; 382 } 383 else 384 { 385 $jwrite_to = shift @ARGV; 386 } 387 388 if (!$jwrite_from) 389 { 390 if (connected() == 1) 391 { 392 $jwrite_from = (keys %$connections)[0]; 393 } 394 else 395 { 396 owl::error("Please specify an account with -a {jid}"); 397 return; 398 } 399 } 400 else 401 { 402 $jwrite_from = resolveJID($jwrite_from); 403 return unless $jwrite_from; 404 } 405 406 $vars{jwrite} = {to => $jwrite_to, 407 from => $jwrite_from, 408 subject => $jwrite_subject, 409 thread => $jwrite_thread, 410 type => $jwrite_type}; 411 412 owl::message("Type your message below. End with a dot on a line by itself. ^C will quit."); 413 owl::start_edit_win(join(' ', @args), \&process_owl_jwrite); 414 } 415 416 sub cmd_jmuc 417 { 418 die "You are not logged in to Jabber" unless connected(); 419 my $ocmd = shift; 420 my $cmd = shift; 421 if (!$cmd) 422 { 423 #XXX TODO: Write general usage for jmuc command. 424 return; 425 } 426 427 my %jmuc_commands = ( 428 join => \&jmuc_join, 429 part => \&jmuc_part, 430 invite => \&jmuc_invite, 431 configure => \&jmuc_configure 432 ); 433 my $func = $jmuc_commands{$cmd}; 434 if(!$func) { 435 owl::error("jmuc: Unknown command: $cmd"); 436 return; 437 } 438 439 { 440 local @ARGV = @_; 441 my $jid; 442 my $muc; 443 my $m = owl::getcurmsg(); 444 if ($m->is_jabber && $m->{jtype} eq 'groupchat') 445 { 446 $muc = $m->{room}; 447 $jid = $m->{to}; 448 } 449 450 my $getopt = Getopt::Long::Parser->new; 451 $getopt->configure('pass_through'); 452 $getopt->getoptions('account=s' => \$jid); 453 $jid ||= defaultJID(); 454 if($jid) { 455 $jid = resolveJID($jid); 456 return unless $jid; 457 } else { 458 owl::error('You must specify an account with -a {jid}'); 459 } 460 return $func->($jid, $muc, @ARGV); 461 } 422 local @ARGV = @_; 423 my $jid; 424 my $muc; 425 my $m = owl::getcurmsg(); 426 if ( $m->is_jabber && $m->{jtype} eq 'groupchat' ) { 427 $muc = $m->{room}; 428 $jid = $m->{to}; 429 } 430 431 my $getopt = Getopt::Long::Parser->new; 432 $getopt->configure('pass_through'); 433 $getopt->getoptions( 'account=s' => \$jid ); 434 $jid ||= defaultJID(); 435 if ($jid) { 436 $jid = resolveJID($jid); 437 return unless $jid; 438 } 439 else { 440 owl::error('You must specify an account with -a {jid}'); 441 } 442 return $func->( $jid, $muc, @ARGV ); 443 } 462 444 } 463 445 464 446 sub jmuc_join { 465 my ($jid, $muc, @args) = @_;466 467 468 GetOptions('password=s' => \$password);469 470 $muc = shift @ARGV or die("Usage: jmuc join {muc} [-p password] [-a account]"); 471 472 my $x = new XML::Stream::Node('x'); 473 $x->put_attrib(xmlns => 'http://jabber.org/protocol/muc');474 $x->add_child('history')->put_attrib(maxchars => '0');475 476 if ($password) 477 478 479 480 481 482 $presence->SetPresence(to => $muc);483 484 447 my ( $jid, $muc, @args ) = @_; 448 local @ARGV = @args; 449 my $password; 450 GetOptions( 'password=s' => \$password ); 451 452 $muc = shift @ARGV 453 or die("Usage: jmuc join {muc} [-p password] [-a account]"); 454 455 my $x = new XML::Stream::Node('x'); 456 $x->put_attrib( xmlns => 'http://jabber.org/protocol/muc' ); 457 $x->add_child('history')->put_attrib( maxchars => '0' ); 458 459 if ($password) { 460 $x->add_child('password')->add_cdata($password); 461 } 462 463 my $presence = new Net::Jabber::Presence; 464 $presence->SetPresence( to => $muc ); 465 $presence->AddX($x); 466 $connections->{$jid}->{client}->Send($presence); 485 467 } 486 468 487 469 sub jmuc_part { 488 my ($jid, $muc, @args) = @_; 489 490 $muc = shift @args if scalar @args; 491 die("Usage: jmuc part {muc} [-a account]") unless $muc; 492 493 $connections->{$jid}->{client}->PresenceSend(to => $muc, type => 'unavailable'); 494 queue_admin_msg("$jid has left $muc."); 495 } 496 497 sub jmuc_invite 498 { 499 my ($jid, $muc, @args) = @_; 500 501 my $invite_jid = shift @args; 502 $muc = shift @args if scalar @args; 503 504 die('Usage: jmuc invite {jid} [muc] [-a account]') unless $muc && $invite_jid; 505 506 my $x = new XML::Stream::Node('x'); 507 $x->put_attrib(xmlns => 'http://jabber.org/protocol/muc#user'); 508 $x->add_child('invite')->put_attrib(to => $invite_jid); 509 510 my $message = new Net::Jabber::Message; 511 $message->SetTo($muc); 512 $message->AddX($x); 513 $connections->{$jid}->{client}->Send($message); 514 queue_admin_msg("$jid has invited $invite_jid to $muc."); 470 my ( $jid, $muc, @args ) = @_; 471 472 $muc = shift @args if scalar @args; 473 die("Usage: jmuc part {muc} [-a account]") unless $muc; 474 475 $connections->{$jid}->{client} 476 ->PresenceSend( to => $muc, type => 'unavailable' ); 477 queue_admin_msg("$jid has left $muc."); 478 } 479 480 sub jmuc_invite { 481 my ( $jid, $muc, @args ) = @_; 482 483 my $invite_jid = shift @args; 484 $muc = shift @args if scalar @args; 485 486 die('Usage: jmuc invite {jid} [muc] [-a account]') 487 unless $muc && $invite_jid; 488 489 my $x = new XML::Stream::Node('x'); 490 $x->put_attrib( xmlns => 'http://jabber.org/protocol/muc#user' ); 491 $x->add_child('invite')->put_attrib( to => $invite_jid ); 492 493 my $message = new Net::Jabber::Message; 494 $message->SetTo($muc); 495 $message->AddX($x); 496 $connections->{$jid}->{client}->Send($message); 497 queue_admin_msg("$jid has invited $invite_jid to $muc."); 515 498 } 516 499 517 500 Net::Jabber::Namespaces::add_ns( 518 519 520 501 ns => "http://jabber.org/protocol/muc#owner", 502 tag => 'query', 503 ); 521 504 522 505 sub jmuc_configure { 523 my ($jid, $muc, @args) = @_; 524 $muc = shift @args if scalar @args; 525 die("Usage: jmuc configure [muc]") unless $muc; 526 my $iq = Net::Jabber::IQ->new(); 527 $iq->SetTo($muc); 528 $iq->SetType('set'); 529 my $query = $iq->NewQuery("http://jabber.org/protocol/muc#owner"); 530 my $x = $query->NewChild("jabber:x:data"); 531 $x->SetType('submit'); 532 533 $connections->{$jid}->{client}->Send($iq); 534 queue_admin_msg("Accepted default instant configuration for $muc"); 535 } 536 506 my ( $jid, $muc, @args ) = @_; 507 $muc = shift @args if scalar @args; 508 die("Usage: jmuc configure [muc]") unless $muc; 509 my $iq = Net::Jabber::IQ->new(); 510 $iq->SetTo($muc); 511 $iq->SetType('set'); 512 my $query = $iq->NewQuery("http://jabber.org/protocol/muc#owner"); 513 my $x = $query->NewChild("jabber:x:data"); 514 $x->SetType('submit'); 515 516 $connections->{$jid}->{client}->Send($iq); 517 queue_admin_msg("Accepted default instant configuration for $muc"); 518 } 537 519 538 520 ################################################################################ 539 521 ### Owl Callbacks 540 sub process_owl_jwrite 541 { 522 sub process_owl_jwrite { 542 523 my $body = shift; 543 524 544 525 my $j = new Net::XMPP::Message; 545 526 $body =~ s/\n\z//; 546 $j->SetMessage(to => $vars{jwrite}{to}, 547 from => $vars{jwrite}{from}, 548 type => $vars{jwrite}{type}, 549 body => $body 550 ); 551 $j->SetThread($vars{jwrite}{thread}) if ($vars{jwrite}{thread}); 552 $j->SetSubject($vars{jwrite}{subject}) if ($vars{jwrite}{subject}); 553 554 my $m = j2o($j, 'out'); 555 if ($vars{jwrite}{type} ne 'groupchat') 556 { 557 #XXX TODO: Check for displayoutgoing. 558 owl::queue_message($m); 559 } 560 $connections->{$vars{jwrite}{from}}->{client}->Send($j); 527 $j->SetMessage( 528 to => $vars{jwrite}{to}, 529 from => $vars{jwrite}{from}, 530 type => $vars{jwrite}{type}, 531 body => $body 532 ); 533 $j->SetThread( $vars{jwrite}{thread} ) if ( $vars{jwrite}{thread} ); 534 $j->SetSubject( $vars{jwrite}{subject} ) if ( $vars{jwrite}{subject} ); 535 536 my $m = j2o( $j, 'out' ); 537 if ( $vars{jwrite}{type} ne 'groupchat' ) { 538 539 #XXX TODO: Check for displayoutgoing. 540 owl::queue_message($m); 541 } 542 $connections->{ $vars{jwrite}{from} }->{client}->Send($j); 561 543 delete $vars{jwrite}; 562 544 } … … 564 546 ### XMPP Callbacks 565 547 566 sub process_incoming_chat_message 567 { 568 my ($session, $j) = @_; 569 owl::queue_message(j2o($j, 'in')); 570 } 571 572 sub process_incoming_error_message 573 { 574 my ($session, $j) = @_; 575 my %jhash = j2hash($j, 'in'); 548 sub process_incoming_chat_message { 549 my ( $session, $j ) = @_; 550 owl::queue_message( j2o( $j, 'in' ) ); 551 } 552 553 sub process_incoming_error_message { 554 my ( $session, $j ) = @_; 555 my %jhash = j2hash( $j, 'in' ); 576 556 $jhash{type} = 'admin'; 577 owl::queue_message( owl::Message->new(%jhash));578 } 579 580 sub process_incoming_groupchat_message 581 { 582 my ($session, $j) = @_; 557 owl::queue_message( owl::Message->new(%jhash) ); 558 } 559 560 sub process_incoming_groupchat_message { 561 my ( $session, $j ) = @_; 562 583 563 # HACK IN PROGRESS (ignoring delayed messages) 584 return if ($j->DefinedX('jabber:x:delay') && $j->GetX('jabber:x:delay')); 585 owl::queue_message(j2o($j, 'in')); 586 } 587 588 sub process_incoming_headline_message 589 { 590 my ($session, $j) = @_; 591 owl::queue_message(j2o($j, 'in')); 592 } 593 594 sub process_incoming_normal_message 595 { 596 my ($session, $j) = @_; 597 my %props = j2hash($j, 'in'); 564 return if ( $j->DefinedX('jabber:x:delay') && $j->GetX('jabber:x:delay') ); 565 owl::queue_message( j2o( $j, 'in' ) ); 566 } 567 568 sub process_incoming_headline_message { 569 my ( $session, $j ) = @_; 570 owl::queue_message( j2o( $j, 'in' ) ); 571 } 572 573 sub process_incoming_normal_message { 574 my ( $session, $j ) = @_; 575 my %props = j2hash( $j, 'in' ); 598 576 599 577 # XXX TODO: handle things such as MUC invites here. 600 578 601 # if ($j->HasX('http://jabber.org/protocol/muc#user')) 602 # { 603 # my $x = $j->GetX('http://jabber.org/protocol/muc#user'); 604 # if ($x->HasChild('invite')) 605 # { 606 # $props 607 # } 608 # } 609 # 610 owl::queue_message(owl::Message->new(%props)); 611 } 612 613 sub process_muc_presence 614 { 615 my ($session, $p) = @_; 616 return unless ($p->HasX('http://jabber.org/protocol/muc#user')); 617 618 } 619 579 # if ($j->HasX('http://jabber.org/protocol/muc#user')) 580 # { 581 # my $x = $j->GetX('http://jabber.org/protocol/muc#user'); 582 # if ($x->HasChild('invite')) 583 # { 584 # $props 585 # } 586 # } 587 # 588 owl::queue_message( owl::Message->new(%props) ); 589 } 590 591 sub process_muc_presence { 592 my ( $session, $p ) = @_; 593 return unless ( $p->HasX('http://jabber.org/protocol/muc#user') ); 594 595 } 620 596 621 597 ### Helper functions 622 598 623 sub j2hash 624 { 625 my $j = shift; 599 sub j2hash { 600 my $j = shift; 626 601 my $dir = shift; 627 602 628 my %props = (type => 'jabber', 629 direction => $dir); 603 my %props = ( 604 type => 'jabber', 605 direction => $dir 606 ); 630 607 631 608 my $jtype = $props{jtype} = $j->GetType(); 632 my $from 633 my $to 609 my $from = $j->GetFrom('jid'); 610 my $to = $j->GetTo('jid'); 634 611 635 612 $props{from} = $from->GetJID('full'); … … 638 615 $props{recipient} = $to->GetJID('base'); 639 616 $props{sender} = $from->GetJID('base'); 640 $props{subject} = $j->GetSubject() if ( $j->DefinedSubject());641 $props{thread} = $j->GetThread() if ( $j->DefinedThread());642 $props{body} = $j->GetBody() if ( $j->DefinedBody());643 $props{error} = $j->GetError() if ( $j->DefinedError());644 $props{error_code} = $j->GetErrorCode() if ( $j->DefinedErrorCode());617 $props{subject} = $j->GetSubject() if ( $j->DefinedSubject() ); 618 $props{thread} = $j->GetThread() if ( $j->DefinedThread() ); 619 $props{body} = $j->GetBody() if ( $j->DefinedBody() ); 620 $props{error} = $j->GetError() if ( $j->DefinedError() ); 621 $props{error_code} = $j->GetErrorCode() if ( $j->DefinedErrorCode() ); 645 622 $props{xml} = $j->GetXML(); 646 623 647 if ($jtype eq 'chat') 648 { 649 $props{replycmd} = "jwrite ".(($dir eq 'in') ? $props{from} : $props{to}); 650 $props{replycmd} .= " -a ".(($dir eq 'out') ? $props{from} : $props{to}); 651 $props{isprivate} = 1; 652 } 653 elsif ($jtype eq 'groupchat') 654 { 655 my $nick = $props{nick} = $from->GetResource(); 656 my $room = $props{room} = $from->GetJID('base'); 657 $props{replycmd} = "jwrite -g $room"; 658 $props{replycmd} .= " -a ".(($dir eq 'out') ? $props{from} : $props{to}); 659 660 $props{sender} = $nick || $room; 661 $props{recipient} = $room; 662 663 if ($props{subject} && !$props{body}) 664 { 665 $props{body} = '['.$nick." has set the topic to: ".$props{subject}."]" 666 } 667 } 668 elsif ($jtype eq 'normal') 669 { 670 $props{replycmd} = undef; 671 $props{isprivate} = 1; 672 } 673 elsif ($jtype eq 'headline') 674 { 675 $props{replycmd} = undef; 676 } 677 elsif ($jtype eq 'error') 678 { 679 $props{replycmd} = undef; 680 $props{body} = "Error ".$props{error_code}." sending to ".$props{from}."\n".$props{error}; 681 } 682 624 if ( $jtype eq 'chat' ) { 625 $props{replycmd} = 626 "jwrite " . ( ( $dir eq 'in' ) ? $props{from} : $props{to} ); 627 $props{replycmd} .= 628 " -a " . ( ( $dir eq 'out' ) ? $props{from} : $props{to} ); 629 $props{isprivate} = 1; 630 } 631 elsif ( $jtype eq 'groupchat' ) { 632 my $nick = $props{nick} = $from->GetResource(); 633 my $room = $props{room} = $from->GetJID('base'); 634 $props{replycmd} = "jwrite -g $room"; 635 $props{replycmd} .= 636 " -a " . ( ( $dir eq 'out' ) ? $props{from} : $props{to} ); 637 638 $props{sender} = $nick || $room; 639 $props{recipient} = $room; 640 641 if ( $props{subject} && !$props{body} ) { 642 $props{body} = 643 '[' . $nick . " has set the topic to: " . $props{subject} . "]"; 644 } 645 } 646 elsif ( $jtype eq 'normal' ) { 647 $props{replycmd} = undef; 648 $props{isprivate} = 1; 649 } 650 elsif ( $jtype eq 'headline' ) { 651 $props{replycmd} = undef; 652 } 653 elsif ( $jtype eq 'error' ) { 654 $props{replycmd} = undef; 655 $props{body} = "Error " 656 . $props{error_code} 657 . " sending to " 658 . $props{from} . "\n" 659 . $props{error}; 660 } 661 683 662 $props{replysendercmd} = $props{replycmd}; 684 663 return %props; 685 664 } 686 665 687 sub j2o 688 { 689 return owl::Message->new(j2hash(@_)); 690 } 691 692 sub queue_admin_msg 693 { 666 sub j2o { 667 return owl::Message->new( j2hash(@_) ); 668 } 669 670 sub queue_admin_msg { 694 671 my $err = shift; 695 my $m = owl::Message->new(type => 'admin', 696 direction => 'none', 697 body => $err); 672 my $m = owl::Message->new( 673 type => 'admin', 674 direction => 'none', 675 body => $err 676 ); 698 677 owl::queue_message($m); 699 678 } 700 679 701 sub boldify($) 702 { 680 sub boldify($) { 703 681 my $str = shift; 704 682 705 return '@b(' .$str.')' if ( $str !~ /\)/ );706 return '@b<' .$str.'>' if ( $str !~ /\>/ );707 return '@b{' .$str.'}' if ( $str !~ /\}/ );708 return '@b[' .$str.']' if ( $str !~ /\]/ );683 return '@b(' . $str . ')' if ( $str !~ /\)/ ); 684 return '@b<' . $str . '>' if ( $str !~ /\>/ ); 685 return '@b{' . $str . '}' if ( $str !~ /\}/ ); 686 return '@b[' . $str . ']' if ( $str !~ /\]/ ); 709 687 710 688 my $txt = "\@b($str"; 711 689 $txt =~ s/\)/\)\@b\[\)\]\@b\(/g; 712 return $txt.')'; 713 } 714 715 sub getServerFromJID 716 { 690 return $txt . ')'; 691 } 692 693 sub getServerFromJID { 717 694 my $jid = shift; 718 695 my $res = new Net::DNS::Resolver; 719 my $packet = $res->search('_xmpp-client._tcp.'.$jid->GetServer(), 'srv'); 720 721 if ($packet) # Got srv record. 696 my $packet = 697 $res->search( '_xmpp-client._tcp.' . $jid->GetServer(), 'srv' ); 698 699 if ($packet) # Got srv record. 722 700 { 723 my @answer = $packet->answer; 724 return $answer[0]{target}, 725 $answer[0]{port}; 701 my @answer = $packet->answer; 702 return $answer[0]{target}, $answer[0]{port}; 726 703 } 727 704 … … 729 706 } 730 707 731 sub connected 732 { 708 sub connected { 733 709 return scalar keys %$connections; 734 710 } 735 711 736 712 sub defaultJID { 737 return (keys %$connections)[0] if (connected() == 1); 738 return; 739 } 740 741 sub resolveJID 742 { 713 return ( keys %$connections )[0] if ( connected() == 1 ); 714 return; 715 } 716 717 sub resolveJID { 743 718 my $givenJidStr = shift; 744 my $givenJid = new Net::XMPP::JID;719 my $givenJid = new Net::XMPP::JID; 745 720 $givenJid->SetJID($givenJidStr); 746 721 747 722 # Account fully specified. 748 if ( $givenJid->GetResource())749 { 750 751 if (defined $connections->{$givenJidStr}) 752 { 753 return $givenJidStr; 754 } 755 else #Specified account doesn't exist 756 { 757 owl::error("Invalid account: $givenJidStr"); 758 759 } 723 if ( $givenJid->GetResource() ) { 724 725 # Specified account exists 726 if ( defined $connections->{$givenJidStr} ) { 727 return $givenJidStr; 728 } 729 else #Specified account doesn't exist 730 { 731 owl::error("Invalid account: $givenJidStr"); 732 } 733 } 734 760 735 # Disambiguate. 761 else 762 { 763 my $matchingJid = ""; 764 my $errStr = "Ambiguous account reference. Please specify a resource.\n"; 765 my $ambiguous = 0; 766 767 foreach my $jid (keys %$connections) 768 { 769 my $cJid = new Net::XMPP::JID; 770 $cJid->SetJID($jid); 771 if ($givenJidStr eq $cJid->GetJID('base')) 772 { 773 $ambiguous = 1 if ($matchingJid ne ""); 774 $matchingJid = $jid; 775 $errStr .= "\t$jid\n"; 776 } 777 } 778 # Need further disambiguation. 779 if ($ambiguous) 780 { 781 queue_admin_msg($errStr); 782 } 783 # Not one of ours. 784 elsif ($matchingJid eq "") 785 { 786 owl::error("Invalid account: $givenJidStr"); 787 } 788 # Log out this one. 789 else 790 { 791 return $matchingJid; 792 } 736 else { 737 my $matchingJid = ""; 738 my $errStr = 739 "Ambiguous account reference. Please specify a resource.\n"; 740 my $ambiguous = 0; 741 742 foreach my $jid ( keys %$connections ) { 743 my $cJid = new Net::XMPP::JID; 744 $cJid->SetJID($jid); 745 if ( $givenJidStr eq $cJid->GetJID('base') ) { 746 $ambiguous = 1 if ( $matchingJid ne "" ); 747 $matchingJid = $jid; 748 $errStr .= "\t$jid\n"; 749 } 750 } 751 752 # Need further disambiguation. 753 if ($ambiguous) { 754 queue_admin_msg($errStr); 755 } 756 757 # Not one of ours. 758 elsif ( $matchingJid eq "" ) { 759 owl::error("Invalid account: $givenJidStr"); 760 } 761 762 # Log out this one. 763 else { 764 return $matchingJid; 765 } 793 766 } 794 767 return "";
Note: See TracChangeset
for help on using the changeset viewer.