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