| 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 | } |
|---|