slirc.pl

   1 #!/usr/bin/perl -w
   2 # slirc.pl: local Slack IRC gateway
   3 # Copyright (C) 2017 Daniel Beer <dlbeer@gmail.com>
   4 #
   5 # Permission to use, copy, modify, and/or distribute this software for any
   6 # purpose with or without fee is hereby granted, provided that the above
   7 # copyright notice and this permission notice appear in all copies.
   8 #
   9 # THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
  10 # WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
  11 # MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
  12 # ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
  13 # WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
  14 # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
  15 # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  16 #
  17 # To run, create a configuration file with the following content:
  18 #
  19 #     slack_token=<legacy API token>
  20 #     password=<password of your choice>
  21 #     port=<port>
  22 #
  23 # Then run ./slirc.pl <config-file>. Connect to the chosen port on
  24 # 127.0.0.1 with your chosen password.
  25 #
  26 # Updated 2018-05-15 to add support for listening on Unix domain sockets
  27 # by Colin Watson <cjwatson@chiark.greenend.org.uk>. To use this feature
  28 # with an IRC client supporting Unix domain connections, add the line
  29 # "unix_socket=<path>" to the config file.
  30
  31 use strict;
  32 use warnings;
  33 use utf8;
  34
  35 use AnyEvent;
  36 use AnyEvent::HTTP;
  37 use AnyEvent::Socket;
  38 use AnyEvent::WebSocket::Client;
  39 use URI::Encode qw(uri_encode);
  40 use Data::Dumper;
  41 use Digest::SHA qw(sha256);
  42 use JSON;
  43
  44 my $VERSION = "20171127";
  45 my $start_time = time();
  46 my %config;
  47
  48 ########################################################################
  49 # Global chat state
  50 ########################################################################
  51
  52 my $connected;                  # Is the RTM connection ready?
  53 my $self_id;                    # Slack ID of our own user, or undef if not connected
  54
  55 my %channels;                   # Slack ID -> channel hash ref
  56 my %channels_by_name;           # irc_lcase -> channel hash ref
  57 # Properties:
  58 # - Id: Slack ID
  59 # - Members: Slack ID set
  60 # - Name: text (IRC name)
  61 # - Topic: text
  62
  63 my %users;                      # Slack ID -> user hash ref
  64 my %users_by_name;              # irc_lcase -> user hash ref
  65 my %users_by_dmid;              # Slack DMID -> user hash ref
  66 # Properties:
  67 # - Id: Slack ID
  68 # - Name: text (IRC name)
  69 # - Channels: Slack ID set
  70 # - Realname: text
  71 # - DMId: DM session ID (may be undefined, or blank if open in progress)
  72 # - TxQueue: messages awaiting transmission if no DM open
  73
  74 ########################################################################
  75 # IRC names
  76 ########################################################################
  77
  78 # Canonicalize an IRC name
  79 sub irc_lcase {
  80     my $name = lc(shift);
  81
  82     $name =~ s/\[/{/g;
  83     $name =~ s/]/}/g;
  84     $name =~ s/\|/\\/g;
  85     $name =~ s/\^/~/g;
  86
  87     return $name;
  88 }
  89
  90 # Compare two names
  91 sub irc_eq {
  92     my ($a, $b) = @_;
  93
  94     return irc_lcase($a) eq irc_lcase($b);
  95 }
  96
  97 # Choose an unused valid name with reference to the hash
  98 sub irc_pick_name {
  99     my ($name, $hash) = @_;
 100
 101     $name =~ s/[#,<>!\0\r\n: ]/_/g;
 102
 103     return $name if length($name) && irc_lcase($name) ne "x" &&
 104         !defined($hash->{irc_lcase($name)});
 105
 106     my $i = 1;
 107
 108     for (;;) {
 109         my $prop = "$name$i";
 110
 111         return $prop unless !defined($hash->{irc_lcase($prop)});
 112         $i++;
 113     }
 114 }
 115
 116 ########################################################################
 117 # IRC server
 118 ########################################################################
 119
 120 # Forward decls to RTM subsystem
 121 sub rtm_send;
 122 sub rtm_send_to_user;
 123 sub rtm_apicall;
 124 sub rtm_download;
 125 sub rtm_destroy;
 126
 127 my %irc_clients;
 128
 129 sub irc_send_args {
 130     my ($c, $source, $short, $long) = @_;
 131
 132     $source =~ s/[\t\r\n\0 ]//g;
 133     $source =~ s/^://g;
 134     my @arg = (":$source");
 135
 136     for my $a (@$short) {
 137         $a =~ s/[\t\r\n\0 ]//g;
 138         $a =~ s/^://g;
 139         utf8::encode($a);
 140         $a = "*" unless length($a);
 141         push @arg, $a;
 142     }
 143
 144     if (defined($long)) {
 145         $long =~ s/[\r\n\0]/ /g;
 146         utf8::encode($long);
 147         push @arg, ":$long";
 148     }
 149
 150     my $line = join(' ', @arg);
 151     print "IRC $c->{Handle} SEND: $line\n";
 152     $c->{Handle}->push_write("$line\r\n");
 153 }
 154
 155 sub irc_send_num {
 156     my ($c, $num, $short, $long) = @_;
 157     my $dst = $c->{Nick};
 158
 159     $dst = "*" unless defined($c->{Nick});
 160     irc_send_args $c, "localhost",
 161         [sprintf("%03d", $num), $dst, @$short], $long;
 162 }
 163
 164 sub irc_send_from {
 165     my ($c, $uid, $short, $long) = @_;
 166     my $user = $users{$uid};
 167     my $nick = $uid eq $self_id ? $c->{Nick} : $user->{Name};
 168
 169     irc_send_args $c, "$nick!$user->{Id}\@localhost", $short, $long;
 170 }
 171
 172 sub irc_disconnect {
 173     my ($c, $msg) = @_;
 174
 175     print "IRC $c->{Handle} DISCONNECT: $msg\n";
 176     delete $irc_clients{$c->{Handle}};
 177     $c->{Handle}->destroy;
 178 }
 179
 180 sub irc_disconnect_all {
 181     print "IRC: disconnect all\n";
 182     foreach my $k (keys %irc_clients) {
 183         $irc_clients{$k}->{Handle}->destroy;
 184     }
 185     %irc_clients = ();
 186 }
 187
 188 sub irc_send_names {
 189     my ($c, $chan) = @_;
 190     my $i = 0;
 191     my @ulist = keys %{$chan->{Members}};
 192
 193     while ($i < @ulist) {
 194         my $n = @ulist - $i;
 195         $n = 8 if $n > 8;
 196         my $chunk = join(' ', map {
 197             $_ eq $self_id ? $c->{Nick} : $users{$_}->{Name}
 198         } @ulist[$i .. ($i + $n - 1)]);
 199         irc_send_num $c, 353, ['@', "#$chan->{Name}"], $chunk;
 200         $i += $n;
 201     }
 202
 203     irc_send_num $c, 366, ["#$chan->{Name}"], "End of /NAMES list";
 204 }
 205
 206 sub irc_server_notice {
 207     my ($c, $msg) = @_;
 208     my $nick = $c->{Nick};
 209
 210     $nick = "*" unless defined($nick);
 211     irc_send_args $c, "localhost", ["NOTICE", $nick], $msg;
 212 }
 213
 214 sub irc_gateway_notice {
 215     my ($c, $msg) = @_;
 216     my $nick = $c->{Nick};
 217
 218     $nick = "*" unless defined($nick);
 219     irc_send_args $c, "X!X\@localhost", ["NOTICE", $nick], $msg;
 220 }
 221
 222 sub irc_notify_away {
 223     my $c = shift;
 224     my $user = $users{$self_id};
 225     my ($num, $msg);
 226
 227     if ($user->{Presence} eq 'away') {
 228         $num = 306;
 229         $msg = "You have been marked as being away";
 230     } else {
 231         $num = 305;
 232         $msg = "You are no longer marked as being away";
 233     }
 234
 235     irc_send_num $c, $num, [], $msg if $c->{Ready};
 236 }
 237
 238 sub irc_broadcast_away {
 239     for my $k (keys %irc_clients) {
 240         my $c = $irc_clients{$k};
 241         irc_notify_away $c if $c->{Ready};
 242     }
 243 }
 244
 245 sub irc_check_welcome {
 246     my $c = shift;
 247
 248     if (defined $c->{Nick} && defined $c->{User} &&
 249         (!$config{password} || defined $c->{Password}) &&
 250         !$c->{Authed}) {
 251         if (!$config{password} ||
 252             sha256($c->{Password}) eq sha256($config{password})) {
 253             $c->{Authed} = 1;
 254         } else {
 255             irc_server_notice $c, "Incorrect password";
 256             irc_disconnect $c, "Incorrect password";
 257             return;
 258         }
 259     }
 260
 261     return unless $c->{Authed} && !$c->{Ready} && $connected;
 262
 263     my $u = $users_by_name{irc_lcase($c->{Nick})};
 264     if (defined($u) && ($u->{Id} ne $self_id)) {
 265         irc_server_notice $c, "Nick already in use";
 266         irc_disconnect $c, "Nick already in use";
 267         return;
 268     }
 269
 270     irc_send_num $c, 001, [], "slirc.pl version $VERSION";
 271     irc_send_num $c, 002, [],
 272       "Copyright (C) 2017 Daniel Beer <dlbeer\@gmail.com>";
 273     irc_send_num $c, 003, [], `uptime`;
 274     $c->{Ready} = 1;
 275
 276     my $user = $users{$self_id};
 277
 278     for my $k (keys %{$user->{Channels}}) {
 279         my $chan = $channels{$k};
 280         irc_send_from $c, $self_id, ["JOIN", "#$chan->{Name}"];
 281         irc_send_num $c, 332, ["#$chan->{Name}"], $chan->{"Topic"};
 282         irc_send_names $c, $chan;
 283     }
 284
 285     irc_notify_away $c;
 286 }
 287
 288 sub irc_check_welcome_all {
 289     foreach my $k (keys %irc_clients) {
 290         irc_check_welcome $irc_clients{$k};
 291     }
 292 }
 293
 294 sub irc_broadcast_nick {
 295     my ($id, $newname) = @_;
 296     return if $id eq $self_id;
 297
 298     for my $k (keys %irc_clients) {
 299         my $c = $irc_clients{$k};
 300         irc_send_from $c, $id, ["NICK", $newname] if $c->{Ready};
 301     }
 302 }
 303
 304 sub irc_broadcast_join {
 305     my ($uid, $chid) = @_;
 306     my $chan = $channels{$chid};
 307
 308     for my $k (keys %irc_clients) {
 309         my $c = $irc_clients{$k};
 310         next unless $c->{Ready};
 311
 312         if ($uid eq $self_id) {
 313             irc_send_from $c, $self_id, ["JOIN", "#$chan->{Name}"];
 314             irc_send_num $c, 332, ["#$chan->{Name}"], $chan->{Topic};
 315             irc_send_names $c, $chan;
 316         } else {
 317             irc_send_from $c, $uid, ["JOIN", "#$chan->{Name}"];
 318         }
 319     }
 320 }
 321
 322 sub irc_broadcast_part {
 323     my ($uid, $chid) = @_;
 324     my $chan = $channels{$chid};
 325
 326     for my $k (keys %irc_clients) {
 327         my $c = $irc_clients{$k};
 328         next unless $c->{Ready};
 329         irc_send_from $c, $uid, ["PART", "#$chan->{Name}"];
 330     }
 331 }
 332
 333 sub irc_send_who {
 334     my ($c, $chname, $u) = @_;
 335
 336     my $user = $users{$u};
 337     my $nick = $u eq $self_id ? $c->{Nick} : $user->{Name};
 338     my $here = $user->{Presence} eq 'away' ? 'G' : 'H';
 339
 340     irc_send_num $c, 352, [$chname, $user->{Id}, "localhost", "localhost",
 341                            $nick, $here], "0 $user->{Realname}";
 342 }
 343
 344 sub irc_send_whois {
 345     my ($c, $uid) = @_;
 346     my $u = $users{$uid};
 347     my $nick = $uid eq $self_id ? $c->{Nick} : $u->{Name};
 348
 349     irc_send_num $c, 311,
 350         [$nick, $u->{Id}, "localhost", "*"], $u->{Realname};
 351     irc_send_num $c, 312, [$nick, "localhost"], "slirc.pl";
 352     my $clist = join(' ', map { "#" . $channels{$_}->{Name} }
 353                           keys %{$u->{Channels}});
 354     irc_send_num $c, 319, [$nick], $clist;
 355     irc_send_num $c, 301, [$nick], "away" if $u->{Presence} eq 'away';
 356 }
 357
 358 sub irc_invite_or_kick {
 359     my ($c, $action, $name, $chname) = @_;
 360
 361     $chname =~ s/^#//;
 362     my $chan = $channels_by_name{irc_lcase($chname)};
 363
 364     unless (defined $chan) {
 365         irc_send_num $c, 401, ["#$chname"], "No such nick/channel";
 366         return;
 367     }
 368
 369     my $what = $chan->{Type} eq "C" ? "channels" : "groups";
 370
 371     foreach (split(/,/, $name)) {
 372         my $user = $users_by_name{irc_lcase($_)};
 373
 374         if (defined $user) {
 375             rtm_apicall "$what.$action", { user => $user->{Id},
 376                                            channel => $chan->{Id} };
 377         } else {
 378             irc_send_num $c, 401, [$user], "No such nick/channel";
 379         }
 380     }
 381 }
 382
 383 my %gateway_command = (
 384     "newgroup" => sub {
 385         my ($c, $name) = @_;
 386         unless (defined($name)) {
 387             irc_gateway_notice $c, "Syntax: newgroup <name>";
 388             return;
 389         }
 390         $name =~ s/^#//;
 391         irc_gateway_notice $c, "Creating group $name";
 392         rtm_apicall "groups.create", { name => $name };
 393     },
 394     "newchan" => sub {
 395         my ($c, $name) = @_;
 396         unless (defined($name)) {
 397             irc_gateway_notice $c, "Syntax: newchan <name>";
 398             return;
 399         }
 400         $name =~ s/^#//;
 401         irc_gateway_notice $c, "Creating channel $name";
 402         rtm_apicall "channels.create", { name => $name };
 403     },
 404     "archive" => sub{
 405         my ($c, $name) = @_;
 406         unless (defined($name)) {
 407             irc_gateway_notice $c, "Syntax: archive <name>";
 408             return;
 409         }
 410         $name =~ s/^#//;
 411         my $g = $channels_by_name{irc_lcase($name)};
 412         my $what = $g->{Type} eq "C" ? "channels" : "groups";
 413         if (defined $g) {
 414             irc_gateway_notice $c, "Archiving $name";
 415             rtm_apicall "$what.archive", { channel => $g->{Id} };
 416         } else {
 417             irc_gateway_notice $c, "No such channel: $name";
 418         }
 419     },
 420     "close" => sub{
 421         my ($c, $name) = @_;
 422         unless (defined($name)) {
 423             irc_gateway_notice $c, "Syntax: close <name>";
 424             return;
 425         }
 426
 427         $name =~ s/^#//;
 428         my $g = $channels_by_name{irc_lcase($name)};
 429         my $what = $g->{Type} eq "C" ? "channels" : "groups";
 430         if (defined $g) {
 431             irc_gateway_notice $c, "Closing $name";
 432             rtm_apicall "$what.close", { channel => $g->{Id} };
 433         } else {
 434             irc_gateway_notice $c, "No such channel: $name";
 435         }
 436     },
 437     "cat" => sub {
 438         my ($c, $fileid) = @_;
 439         unless (defined($fileid)) {
 440             irc_gateway_notice $c, "Syntax: catfile <fileid> <filename>";
 441             return;
 442         }
 443
 444         rtm_apicall "files.info", { file => $fileid }, sub {
 445             my $data = shift;
 446             return unless defined $data;
 447
 448             my $body = $data->{content};
 449
 450             if (length($body) > 65536) {
 451                 irc_gateway_notice $c, "File too big";
 452             } else {
 453                 irc_gateway_notice $c, "---- BEGIN $fileid ----";
 454                 foreach (split(/\n/, $body)) {
 455                     irc_gateway_notice $c, "$_";
 456                 }
 457                 irc_gateway_notice $c, "---- END $fileid ----";
 458             }
 459         };
 460     },
 461     "disconnect" => sub {
 462         my ($c) = @_;
 463         irc_gateway_notice $c, "Disconnecting";
 464         rtm_destroy "User disconnection request";
 465     },
 466     "delim" => sub {
 467         my ($c, $nick) = @_;
 468         unless (defined($nick)) {
 469             irc_gateway_notice $c, "Syntax: delim <name>";
 470             return;
 471         }
 472         my $user;
 473
 474         if ($nick eq $c->{Nick}) {
 475             $user = $users{$self_id};
 476         } else {
 477             $user = $users_by_name{irc_lcase($nick)};
 478             $user = undef if $user->{Id} eq $self_id;
 479         }
 480
 481         unless (defined($user)) {
 482             irc_gateway_notice $c, "No such nick: $nick";
 483             return;
 484         }
 485
 486         unless (defined $user->{DMId}) {
 487             irc_gateway_notice $c, "DM already closed for $nick";
 488             return;
 489         }
 490
 491         irc_gateway_notice $c, "Closing DM for $nick";
 492         rtm_apicall "im.close", { channel => $user->{DMId} };
 493     },
 494 );
 495
 496 my %irc_command = (
 497     "NICK" => sub {
 498         my ($c, $newnick) = @_;
 499         return unless defined($newnick);
 500
 501         if (defined $c->{Nick}) {
 502             my $u = $users_by_name{irc_lcase($newnick)};
 503             if (defined($u) && ($u->{Id} ne $self_id)) {
 504                 irc_send_num $c, 433, [$newnick], "Nickname is already in use";
 505             } else {
 506                 irc_send_from $c, $self_id, ["NICK"], $newnick;
 507                 $c->{Nick} = $newnick;
 508             }
 509         } else {
 510             $c->{Nick} = $newnick;
 511             irc_check_welcome $c;
 512         }
 513     },
 514     "PASS" => sub {
 515         my ($c, $pass) = @_;
 516
 517         $c->{Password} = $pass;
 518         irc_check_welcome $c;
 519     },
 520     "USER" => sub {
 521         my ($c, @arg) = @_;
 522         return unless scalar(@arg) >= 4;
 523
 524         $c->{User} = $arg[0];
 525         $c->{Realname} = $arg[3];
 526         irc_check_welcome $c;
 527     },
 528     "AWAY" => sub {
 529         my ($c, $msg) = @_;
 530         return unless $c->{Ready};
 531         my $presence = defined $msg ? "away" : "auto";
 532         rtm_apicall "users.setPresence", { presence => $presence };
 533     },
 534     "PING" => sub {
 535         my ($c, $reply) = @_;
 536         $reply = "" unless defined($reply);
 537         irc_send_args $c, "localhost", ["PONG"], $reply;
 538     },
 539     "INVITE" => sub {
 540         my ($c, $name, $chname) = @_;
 541         return unless $c->{Ready};
 542         irc_invite_or_kick $c, "invite", $name, $chname;
 543     },
 544     "KICK" => sub {
 545         my ($c, $name, $chname) = @_;
 546         return unless $c->{Ready};
 547         irc_invite_or_kick $c, "kick", $name, $chname;
 548     },
 549     "JOIN" => sub {
 550         my ($c, $name) = @_;
 551         return unless $c->{Ready};
 552         return unless defined($name);
 553
 554         foreach my $n (split(/,/, $name)) {
 555             $n =~ s/^#//;
 556             my $chan = $channels_by_name{irc_lcase($n)};
 557             if (not defined $chan) {
 558                 irc_send_num $c, 401, ["#$n"], "No such nick/channel";
 559             } elsif ($chan->{Members}->{$self_id}) {
 560                 # Already joined
 561             } elsif ($chan->{Type} eq "G") {
 562                 irc_send_num $c, 473, ["#$n"],
 563                     "<channel> :Cannot join channel (+i)";
 564             } else {
 565                 rtm_apicall "channels.join", { channel => $chan->{Id} };
 566             }
 567         }
 568     },
 569     "MODE" => sub {
 570         my ($c, $arg, $what) = @_;
 571         return unless $c->{Ready};
 572         return unless defined($arg);
 573
 574         $what = $what || "";
 575
 576         if ($arg eq $c->{Nick}) {
 577             irc_send_num $c, 221, [], "+i";
 578         } elsif ($arg =~ /^#(.*)$/) {
 579             my $chan = $channels_by_name{$1};
 580
 581             if (defined $chan) {
 582                 if ($what eq "b") {
 583                     irc_send_num $c, 368, ["#$chan->{Name}"],
 584                         "End of channel ban list";
 585                 } else {
 586                     irc_send_num $c, 324,
 587                         ["#$chan->{Name}",
 588                          ($chan->{Type} eq "G" ? "+ip" : "+p")];
 589                     irc_send_num $c, 329,
 590                         ["#$chan->{Name}", $start_time];
 591                 }
 592             } else {
 593                 irc_send_num $c, 403, [$arg], "No such channel";
 594             }
 595         } else {
 596             irc_send_num $c, 403, [$arg], "No such channel";
 597         }
 598     },
 599     "TOPIC" => sub {
 600         my ($c, $name, $topic) = @_;
 601         return unless defined($name) && defined($topic);
 602         return unless $c->{Ready};
 603
 604         $name =~ s/^#//;
 605         my $chan = $channels_by_name{irc_lcase($name)};
 606         unless (defined($chan)) {
 607             irc_send_num $c, 401, ["#$name"], "No such nick/channel";
 608             return;
 609         }
 610
 611         my $what = $chan->{Type} eq "C" ? "channels" : "groups";
 612
 613         rtm_apicall "$what.setTopic", { channel => $chan->{Id},
 614                                         topic => $topic };
 615     },
 616     "PART" => sub {
 617         my ($c, $name) = @_;
 618         return unless $c->{Ready};
 619         return unless defined($name);
 620
 621         foreach my $n (split(/,/, $name)) {
 622             $n =~ s/^#//;
 623             my $chan = $channels_by_name{irc_lcase($n)};
 624             if (not defined($chan)) {
 625                 irc_send_num $c, 401, ["#$n"], "No such nick/channel";
 626             } elsif ($chan->{Members}->{$self_id}) {
 627                 my $what = $chan->{Type} eq "C" ? "channels" : "groups";
 628                 rtm_apicall "$what.leave", { channel => $chan->{Id} };
 629             }
 630         }
 631     },
 632     "LIST" => sub {
 633         my ($c, @arg) = @_;
 634         return unless $c->{Ready};
 635
 636         irc_send_num $c, 321, ["Channel"], "Users Name";
 637         foreach my $chid (keys %channels) {
 638             my $chan = $channels{$chid};
 639             my $n = keys %{$chan->{Members}};
 640
 641             irc_send_num $c, 322, ["#$chan->{Name}", $n], $chan->{Topic};
 642         }
 643         irc_send_num $c, 323, [], "End of /LIST";
 644     },
 645     "WHOIS" => sub {
 646         my ($c, $nicklist) = @_;
 647         return unless $c->{Ready};
 648         return unless defined($nicklist);
 649         my $some = 0;
 650
 651         for my $nick (split(/,/, $nicklist)) {
 652             if (irc_eq($nick, "x")) {
 653                 irc_send_num $c, 311,
 654                     ["X", "X", "localhost", "*"], "Gateway service";
 655                 irc_send_num $c, 312, ["X", "localhost"], "slirc.pl";
 656             } elsif (irc_eq($nick, $c->{Nick})) {
 657                 irc_send_whois $c, $self_id;
 658             } else {
 659                 my $user;
 660
 661                 if ($nick =~ /^.*!([^@]*)/) {
 662                     $user = $users{$1};
 663                 } else {
 664                     $user = $users_by_name{irc_lcase($nick)};
 665                     $user = undef if defined($user) && $user->{Id} eq $self_id;
 666                 }
 667
 668                 if (defined($user)) {
 669                     irc_send_whois $c, $user->{Id};
 670                 } else {
 671                     irc_send_num $c, 401, [$nick], "No such nick/channel";
 672                 }
 673             }
 674         }
 675
 676         irc_send_num $c, 318, [$nicklist], "End of /WHOIS list";
 677     },
 678     "NAMES" => sub {
 679         my ($c, $name) = @_;
 680         return unless $c->{Ready};
 681         return unless defined($name);
 682
 683         my $n = $name;
 684         $n =~ s/^#//;
 685         my $chan = $channels_by_name{irc_lcase($n)};
 686         unless (defined($chan)) {
 687             irc_send_num $c, 401, [$name], "No such nick/channel";
 688             return;
 689         }
 690
 691         irc_send_names $c, $chan;
 692     },
 693     "WHO" => sub {
 694         my ($c, $name) = @_;
 695         return unless $c->{Ready};
 696
 697         if (!defined($name)) {
 698             foreach my $u (keys %users) {
 699                 irc_send_who $c, "*", $u;
 700             }
 701             irc_send_num $c, 352, ["*", "X", "localhost", "localhost",
 702                                    "X", "H"], "0 Gateway service";
 703         } elsif (irc_eq($name, "X")) {
 704             irc_send_num $c, 352, ["*", "X", "localhost", "localhost",
 705                                    "X", "H"], "0 Gateway service";
 706         } elsif ($name =~ /^.*!([^@]*)/) {
 707             unless (exists $users{$1}) {
 708                 irc_send_num $c, 401, [$name], "No such nick/channel";
 709                 return;
 710             }
 711
 712             irc_send_who $c, $name, $1;
 713         } elsif ($name =~ /^#(.*)$/) {
 714             my $chan = $channels_by_name{irc_lcase($1)};
 715
 716             unless (defined($chan)) {
 717                 irc_send_num $c, 401, [$name], "No such nick/channel";
 718                 return;
 719             }
 720
 721             foreach my $u (keys %{$chan->{Members}}) {
 722                 irc_send_who $c, "#$chan->{Name}", $u;
 723             }
 724         } else {
 725             my $user = $users_by_name{irc_lcase($name)};
 726
 727             unless (defined($user)) {
 728                 irc_send_num $c, 401, [$name], "No such nick/channel";
 729                 return;
 730             }
 731
 732             irc_send_who $c, $name, $self_id;
 733         }
 734
 735         $name = "*" unless defined($name);
 736         irc_send_num $c, 315, [$name], "End of /WHO list";
 737     },
 738     "PRIVMSG" => sub {
 739         my ($c, $namelist, $msg) = @_;
 740         return unless $c->{Ready};
 741         return unless defined($namelist) && defined($msg);
 742
 743         $msg =~ s/<@([^>]+)>/'<@' . irc_name_to_id($c, $1) . '>'/eg;
 744         $msg =~ s/<#([^>]+)>/'<@' . irc_chan_to_id($c, $1) . '>'/eg;
 745
 746         foreach my $name (split(/,/, $namelist)) {
 747             if (irc_eq($name, "X")) {
 748                 my @args = split(/  */, $msg);
 749                 my $cmd = shift @args;
 750                 my $handler = $gateway_command{lc($cmd)};
 751
 752                 if (defined $handler) {
 753                     $handler->($c, @args);
 754                 } else {
 755                     irc_gateway_notice $c, "Unknown command: $cmd";
 756                 }
 757             } elsif ($name =~ /^#(.*)$/) {
 758                 my $chan = $channels_by_name{irc_lcase($1)};
 759
 760                 if (defined $chan) {
 761                     rtm_send {
 762                         type => "message", channel => $chan->{Id},
 763                         text => $msg };
 764                 } else {
 765                     irc_send_num $c, 401, [$name], "No such nick/channel";
 766                 }
 767             } elsif (irc_eq($name, $c->{Nick})) {
 768                 rtm_send_to_user $self_id, $msg;
 769             } else {
 770                 my $user = $users_by_name{irc_lcase($name)};
 771
 772                 if (defined $user) {
 773                     rtm_send_to_user $user->{Id}, $msg;
 774                 } else {
 775                     irc_send_num $c, 401, [$name], "No such nick/channel";
 776                 }
 777             }
 778         }
 779     },
 780     "PONG" => sub {
 781         shift->{PingCount} = 0;
 782     },
 783     "QUIT" => sub {
 784         my $c = shift;
 785         irc_disconnect $c, "QUIT";
 786     },
 787 );
 788
 789 sub irc_broadcast_notice {
 790     my ($msg) = @_;
 791
 792     print "NOTICE: $msg\n";
 793     foreach my $k (keys %irc_clients) {
 794         my $c = $irc_clients{$k};
 795         irc_server_notice $c, $msg if $c->{Authed};
 796     }
 797 }
 798
 799 sub irc_id_to_name {
 800     my ($c, $id) = @_;
 801     return $c->{Nick} if $id eq $self_id;
 802     my $u = $users{$id};
 803     return $u->{Name} if defined($u);
 804     return $id;
 805 }
 806
 807 sub irc_name_to_id {
 808     my ($c, $name) = @_;
 809     return $self_id if $name eq $c->{Nick};
 810     my $u = $users_by_name{$name};
 811     return $u->{Id} if defined($u);
 812     return $name;
 813 }
 814
 815 sub irc_id_to_chan {
 816     my ($c, $id) = @_;
 817     my $ch = $channels{$id};
 818     return $ch->{Name} if defined ($ch);
 819     return $id;
 820 }
 821
 822 sub irc_chan_to_id {
 823     my ($c, $chan) = @_;
 824     my $ch = $channels_by_name{$chan};
 825     return $ch->{Id} if defined($ch);
 826     return $chan;
 827 }
 828
 829 sub irc_do_message {
 830     my ($srcid, $dstname, $subtype, $text) = @_;
 831
 832     $text =~ s/\002//g;
 833     my $prefix = "";
 834     $prefix = "\002[$subtype]\002 " if defined($subtype);
 835
 836     for my $k (keys %irc_clients) {
 837         my $c = $irc_clients{$k};
 838         next unless $c->{Ready};
 839
 840         my $translate = $text;
 841         $translate =~ s/<@([^>]+)>/'<@' . irc_id_to_name($c, $1) . '>'/eg;
 842         $translate =~ s/<#([^>]+)>/'<@' . irc_id_to_chan($c, $1) . '>'/eg;
 843
 844         for my $line (split(/\n/, $translate)) {
 845             irc_send_from $c, $srcid, ["PRIVMSG", $dstname], "$prefix$line";
 846         }
 847     }
 848 }
 849
 850 sub irc_privmsg {
 851     my ($id, $subtype, $msg) = @_;
 852     irc_do_message $id, $users{$id}->{Name}, $subtype, $msg;
 853 }
 854
 855 sub irc_chanmsg {
 856     my ($id, $subtype, $chid, $msg) = @_;
 857     irc_do_message $id, "#$channels{$chid}->{Name}", $subtype, $msg;
 858 }
 859
 860 sub irc_topic_change {
 861     my ($id, $chid) = @_;
 862     my $chan = $channels{$chid};
 863
 864     foreach my $k (keys %irc_clients) {
 865         my $c = $irc_clients{$k};
 866
 867         irc_send_from $c, $id, ["TOPIC", "#$chan->{Name}"], $chan->{Topic}
 868             if $c->{Ready};
 869     }
 870 }
 871
 872 sub irc_ping {
 873     my $c = shift;
 874
 875     if (++$c->{PingCount} >= 2) {
 876         irc_disconnect $c, "Ping timeout";
 877         return;
 878     }
 879
 880     irc_send_args $c, "localhost", ["PING"], time();
 881     $c->{PingTimer} = AnyEvent->timer(after => 60, cb => sub { irc_ping($c); });
 882 }
 883
 884 sub irc_line {
 885     my ($c, $fh, $line, $eol) = @_;
 886
 887     print "IRC $fh RECV: $line\n";
 888
 889     utf8::decode($line);
 890
 891     my $smallargs = $line;
 892     my $bigarg = undef;
 893
 894     if ($line =~ /^(.*?) :(.*)$/) {
 895         $smallargs = $1;
 896         $bigarg = $2;
 897     }
 898
 899     my @words = split /  */, $smallargs;
 900     push @words, $bigarg if defined($bigarg);
 901
 902     if (scalar(@words)) {
 903         my $cmd = shift @words;
 904         my $handler = $irc_command{uc($cmd)};
 905
 906         $handler->($c, @words) if (defined($handler));
 907     }
 908
 909     $fh->push_read(line => sub { irc_line($c, @_) });
 910 }
 911
 912 sub irc_listen {
 913     print "Start IRC listener\n";
 914     my $listen_host = $config{unix_socket} ? "unix/" : "127.0.0.1";
 915     tcp_server $listen_host,
 916                ($config{unix_socket} || $config{port} || 6667), sub {
 917         my ($fd, $host, $port) = @_;
 918
 919         my $fh;
 920         $fh = new AnyEvent::Handle
 921           fh => $fd,
 922           on_error => sub {
 923               my ($fh, $fatal, $msg) = @_;
 924               irc_disconnect $irc_clients{$fh}, "error: $msg";
 925           },
 926           on_eof => sub {
 927               my $fh = shift;
 928               irc_disconnect $irc_clients{$fh}, "EOF";
 929           };
 930
 931         print "IRC $fh Got connection from $host:$port\n";
 932
 933         my $c = { Handle => $fh };
 934         $c->{PingTimer} = AnyEvent->timer(after => 30,
 935                 cb => sub { irc_ping $c; });
 936         $c->{PingCount} = 0;
 937         $irc_clients{$fh} = $c;
 938         $fh->push_read(line => sub { irc_line($c, @_) });
 939
 940         irc_server_notice $c, "Waiting for RTM connection" if not $connected;
 941     }, sub {
 942         chmod 0600, $config{unix_socket} if $config{unix_socket};
 943     }
 944 }
 945
 946 ########################################################################
 947 # RTM client
 948 ########################################################################
 949
 950 my $rtm_client;
 951 my $rtm_con;
 952 my $rtm_msg_id = 1;
 953 my %rtm_apicall_handles;
 954 my $rtm_cooldown_timer;
 955
 956 my %rtm_mark_queue;
 957 my $rtm_mark_timer;
 958
 959 my $rtm_ping_timer;
 960 my $rtm_ping_count;
 961
 962 sub rtm_apicall {
 963     my ($method, $args, $cb) = @_;
 964     my @encode;
 965
 966     print "RTM APICALL $method ", Dumper($args);
 967
 968     $args->{token} = $config{slack_token};
 969
 970     foreach my $k (keys %$args) {
 971         my $ek = uri_encode($k);
 972         my $ev = uri_encode($args->{$k});
 973
 974         push @encode, "$ek=$ev";
 975     }
 976
 977     my $x;
 978     $x = http_post "https://slack.com/api/$method", join('&', @encode),
 979         headers => {
 980             "Content-Type", "application/x-www-form-urlencoded"
 981         }, sub {
 982             my ($body, $hdr) = @_;
 983             delete $rtm_apicall_handles{$x};
 984
 985             unless ($hdr->{Status} =~ /^2/) {
 986                 irc_broadcast_notice
 987                   "API HTTP error: $method: $hdr->{Status} $hdr->{Reason}";
 988                 $cb->(undef) if defined($cb);
 989                 return;
 990             }
 991
 992             my $data = decode_json $body;
 993
 994             print "RTM REPLY $method ", Dumper($data);
 995
 996             unless ($data->{ok}) {
 997                 irc_broadcast_notice "API error: $data->{error}";
 998                 $cb->(undef) if defined($cb);
 999                 return;
1000             }
1001
1002             $cb->($data) if defined($cb);
1003         };
1004
1005     $rtm_apicall_handles{$x} = 1;
1006 }
1007
1008 sub rtm_send {
1009     my $frame = shift;
1010
1011     $frame->{id} = $rtm_msg_id++;
1012     print "RTM SEND: ", Dumper($frame);
1013     $rtm_con->send(encode_json $frame);
1014 }
1015
1016 sub rtm_update_join {
1017     my ($uid, $chid) = @_;
1018     my $chan = $channels{$chid};
1019     my $user = $users{$uid};
1020
1021     if (!$chan->{Members}->{$uid}) {
1022         $chan->{Members}->{$uid} = 1;
1023         $user->{Channels}->{$chid} = 1;
1024         return 1;
1025     }
1026
1027     return undef;
1028 }
1029
1030 sub rtm_update_part {
1031     my ($uid, $chid) = @_;
1032     my $chan = $channels{$chid};
1033     my $user = $users{$uid};
1034
1035     if ($chan->{Members}->{$uid}) {
1036         delete $channels{$chid}->{Members}->{$uid};
1037         delete $users{$uid}->{Channels}->{$chid};
1038         return 1;
1039     }
1040
1041     return undef;
1042 }
1043
1044 sub rtm_update_user {
1045     my $c = shift;
1046     my $user;
1047
1048     if (exists $users{$c->{id}}) {
1049         $user = $users{$c->{id}};
1050         my $oldname = $user->{Name};
1051         delete $users_by_name{irc_lcase($oldname)};
1052         my $newname = irc_pick_name($c->{name}, \%users_by_name);
1053
1054         $user->{Realname} = $c->{real_name};
1055
1056         irc_broadcast_nick $c->{id}, $newname
1057             if $oldname ne $newname;
1058
1059         $user->{Name} = $newname;
1060         $user->{Presence} = $c->{presence} || 'active';
1061         $users_by_name{$newname} = $user;
1062     } else {
1063         my $name = irc_pick_name($c->{name}, \%users_by_name);
1064         $user = {
1065             Id => $c->{id},
1066             Name => $name,
1067             Channels => {},
1068             Realname => $c->{real_name},
1069             TxQueue => [],
1070             Presence => $c->{presence} || 'active'
1071         };
1072
1073         $users{$c->{id}} = $user;
1074         $users_by_name{$name} = $user;
1075     }
1076
1077     $user->{Realname} = "" unless defined($user->{Realname});
1078 }
1079
1080 sub rtm_record_unknown_uid {
1081     my $uid = shift;
1082
1083     unless (exists $users{$uid}) {
1084         # Temporary name
1085         my $name = irc_pick_name($uid, \%users_by_name);
1086
1087         my $u = {
1088             Id => $uid,
1089             Name => $name,
1090             Channels => {},
1091             Realname => "",
1092             TxQueue => []
1093         };
1094
1095         $users{$uid} = $u;
1096         $users_by_name{irc_lcase($name)} = $u;
1097
1098         rtm_apicall "users.info", { user => $uid }, sub {
1099             my $data = shift;
1100
1101             rtm_update_user $data->{user} if defined $data;
1102         };
1103     }
1104 }
1105
1106 sub rtm_update_channel {
1107     my ($type, $c) = @_;
1108
1109     my $id = $c->{id};
1110     my $mhash = {};
1111     my $name = $c->{name};
1112
1113     $name = "+$name" if $type eq "G";
1114
1115     # Cross-reference users/channels
1116     foreach my $u (@{$c->{members}}) {
1117         rtm_record_unknown_uid $u;
1118         $mhash->{$u} = 1;
1119         $users{$u}->{Channels}->{$id} = 1;
1120     }
1121
1122     if (exists $channels{$id}) {
1123         my $chan = $channels{$id};
1124         $chan->{Members} = $mhash;
1125         $chan->{Topic} = $c->{topic}->{value};
1126         $chan->{Type} = $type;
1127     } else {
1128         my $name = irc_pick_name($name, \%channels_by_name);
1129         my $chan = {
1130             Id => $c->{id},
1131             Members => $mhash,
1132             Name => $name,
1133             Type => $type,
1134             Topic => $c->{topic}->{value}
1135         };
1136
1137         $channels{$c->{id}} = $chan;
1138         $channels_by_name{irc_lcase($name)} = $chan;
1139     }
1140 }
1141
1142 sub rtm_delete_channel {
1143     my $chid = shift;
1144     my $chan = $channels{$chid};
1145     return unless defined $chan;
1146
1147     foreach ($chan->{Members}) {
1148         my $user = $users{$_};
1149
1150         delete $user->{Channels}->{$chid};
1151     }
1152
1153     delete $channels_by_name{irc_lcase($chan->{Name})};
1154     delete $channels{$chid};
1155 }
1156
1157 sub rtm_mark_channel {
1158     my ($chid, $ts) = @_;
1159
1160     $rtm_mark_queue{$chid} = $ts;
1161
1162     unless (defined $rtm_mark_timer) {
1163         $rtm_mark_timer = AnyEvent->timer(after => 5, cb => sub {
1164             for my $chid (keys %rtm_mark_queue ) {
1165                 rtm_apicall "channels.mark", {
1166                     channel => $chid,
1167                     ts => $rtm_mark_queue{$chid}
1168                 };
1169             }
1170             %rtm_mark_queue = ();
1171             undef $rtm_mark_timer;
1172         });
1173     }
1174 }
1175
1176 my %rtm_command = (
1177     "presence_change" => sub {
1178         my $msg = shift;
1179         my $user = $users{$msg->{user}};
1180
1181         if (defined $user) {
1182             my $old = $user->{Presence};
1183             $user->{Presence} = $msg->{presence} if defined $user;
1184             irc_broadcast_away if
1185               $msg->{user} eq $self_id and $old ne $msg->{presence};
1186         }
1187     },
1188     "manual_presence_change" => sub {
1189         my $msg = shift;
1190         my $user = $users{$self_id};
1191         my $old = $user->{Presence};
1192
1193         $user->{Presence} = $msg->{presence};
1194         irc_broadcast_away if $old ne $msg->{presence};
1195     },
1196     "im_open" => sub {
1197         my $msg = shift;
1198         rtm_record_unknown_uid $msg->{user};
1199
1200         my $u = $users{$msg->{user}};
1201         $u->{DMId} = $msg->{channel};
1202         $users_by_dmid{$msg->{channel}} = $u;
1203
1204         foreach my $msg (@{$u->{TxQueue}}) {
1205             rtm_send { type => "message",
1206                 channel => $u->{DMId}, text => $msg };
1207         }
1208
1209         $u->{TxQueue} = [];
1210     },
1211     "im_close" => sub {
1212         my $msg = shift;
1213         my $u = $users_by_dmid{$msg->{channel}};
1214         return unless defined($u);
1215
1216         delete $u->{DMId};
1217         delete $users_by_dmid{$msg->{channel}};
1218     },
1219     "group_joined" => sub {
1220         my $msg = shift;
1221
1222         rtm_update_channel "G", $msg->{channel};
1223         irc_broadcast_join $self_id, $msg->{channel}->{id};
1224     },
1225     "group_left" => sub {
1226         my $msg = shift;
1227
1228         irc_broadcast_part $self_id, $msg->{channel}
1229           if rtm_update_part $self_id, $msg->{channel};
1230     },
1231     "group_archive" => sub {
1232         my $msg = shift;
1233
1234         irc_broadcast_part $self_id, $msg->{channel}
1235           if rtm_update_part $self_id, $msg->{channel};
1236         rtm_delete_channel $msg->{channel};
1237     },
1238     "channel_joined" => sub {
1239         my $msg = shift;
1240
1241         rtm_update_channel "C", $msg->{channel};
1242         irc_broadcast_join $self_id, $msg->{channel}->{id};
1243     },
1244     "channel_left" => sub {
1245         my $msg = shift;
1246
1247         irc_broadcast_part $self_id, $msg->{channel}
1248           if rtm_update_part $self_id, $msg->{channel};
1249     },
1250     "channel_archive" => sub {
1251         my $msg = shift;
1252
1253         irc_broadcast_part $self_id, $msg->{channel}
1254           if rtm_update_part $self_id, $msg->{channel};
1255         rtm_delete_channel $msg->{channel};
1256     },
1257     "member_joined_channel" => sub {
1258         my $msg = shift;
1259
1260         rtm_record_unknown_uid $msg->{user};
1261         irc_broadcast_join $msg->{user}, $msg->{channel}
1262           if rtm_update_join($msg->{user}, $msg->{channel});
1263     },
1264     "member_left_channel" => sub {
1265         my $msg = shift;
1266
1267         irc_broadcast_part $msg->{user}, $msg->{channel}
1268           if rtm_update_part($msg->{user}, $msg->{channel});
1269     },
1270     "pong" => sub {
1271         $rtm_ping_count = 0;
1272     },
1273     "message" => sub {
1274         my $msg = shift;
1275         my $chan = $channels{$msg->{channel}};
1276         my $subtype = $msg->{subtype} || "";
1277         my $uid = $msg->{user} || $msg->{comment}->{user};
1278         my $text = $msg->{text};
1279
1280         $text = "" unless defined($text);
1281
1282         if (defined($chan)) {
1283             if ($subtype eq "channel_topic" or $subtype eq "group_topic") {
1284                 $chan->{Topic} = $msg->{topic};
1285                 irc_topic_change $uid, $chan->{Id};
1286             } else {
1287                 irc_chanmsg $uid, $msg->{subtype}, $chan->{Id}, $text;
1288             }
1289             rtm_mark_channel $chan->{Id}, $msg->{ts};
1290         } else {
1291             irc_privmsg $uid, $msg->{subtype}, $text;
1292         }
1293
1294         if ($subtype eq "file_share") {
1295             my $fid = $msg->{file}->{id};
1296             rtm_apicall "files.info", { file => $fid }, sub {
1297                 my $data = shift;
1298                 return unless defined $data;
1299
1300                 my $body = $data->{content};
1301                 return unless length($body) <= 65536;
1302
1303                 if (defined $chan) {
1304                     irc_chanmsg $uid, ">$fid", $chan->{Id}, $body;
1305                 } else {
1306                     irc_privmsg $uid, ">$fid", $body;
1307                 }
1308             };
1309         }
1310     },
1311 );
1312
1313 sub rtm_send_to_user {
1314     my ($id, $msg) = @_;
1315     my $u = $users{$id};
1316
1317     if (defined($u->{DMId}) && length($u->{DMId})) {
1318         rtm_send { type => "message",
1319                 channel => $u->{DMId}, text => $msg };
1320         return;
1321     }
1322
1323     push @{$u->{TxQueue}}, $msg;
1324
1325     if (!defined($u->{DMId})) {
1326         rtm_apicall "im.open", { user => $u->{Id} }, sub {
1327             my $result = shift;
1328             unless (defined $result) {
1329                 delete $u->{DMId};
1330                 foreach my $m (@{$u->{TxQueue}}) {
1331                     irc_broadcast_notice "Failed to send to $u->{Name}: $m";
1332                 }
1333                 $u->{TxQueue} = [];
1334             }
1335         };
1336
1337         $u->{DMId} = "";
1338     }
1339 }
1340
1341 sub rtm_start;
1342
1343 sub rtm_cooldown {
1344     return if defined($rtm_cooldown_timer);
1345     print "Waiting before reinitiating RTM\n";
1346     $rtm_cooldown_timer = AnyEvent->timer(after => 5, cb => sub {
1347         undef $rtm_cooldown_timer;
1348         rtm_start;
1349     });
1350 };
1351
1352 sub rtm_destroy {
1353     my $msg = shift;
1354     return unless defined($rtm_con);
1355
1356     irc_broadcast_notice $msg;
1357
1358     $connected = 0;
1359     undef $self_id;
1360     %channels = ();
1361     %channels_by_name = ();
1362     %users = ();
1363     %users_by_name = ();
1364     %users_by_dmid = ();
1365
1366     %rtm_apicall_handles = (); # cancel outstanding requests
1367     %rtm_mark_queue = ();
1368     undef $rtm_mark_timer;
1369     undef $rtm_ping_timer;
1370     $rtm_con->close;
1371     undef $rtm_con;
1372     undef $rtm_client;
1373
1374     irc_disconnect_all;
1375     rtm_cooldown;
1376 }
1377
1378 sub rtm_ping {
1379     if (++$rtm_ping_count >= 2) {
1380         rtm_destroy "RTM ping timeout";
1381         return;
1382     }
1383
1384     rtm_send { type => "ping" };
1385     $rtm_ping_timer = AnyEvent->timer(after => 60, cb => \&rtm_ping);
1386 }
1387
1388 sub rtm_start_ws {
1389     my $url = shift;
1390
1391     return if defined($rtm_client);
1392     $rtm_client = AnyEvent::WebSocket::Client->new;
1393
1394     print "WSS URL: $url\n";
1395     $rtm_client->connect($url)->cb(sub {
1396         $rtm_con = eval { shift->recv; };
1397         if ($@) {
1398             irc_broadcast_notice "WSS connection failed: $@\n";
1399             undef $rtm_client;
1400             rtm_cooldown;
1401         }
1402
1403         print "WSS connected\n";
1404         $rtm_msg_id = 1;
1405         $rtm_ping_count = 0;
1406         $connected = 1;
1407         irc_check_welcome_all;
1408
1409         $rtm_ping_timer = AnyEvent->timer(after => 60, cb => \&rtm_ping);
1410
1411         $rtm_con->on(each_message => sub {
1412             eval {
1413                 shift;
1414                 my $msg = decode_json shift->{body};
1415
1416                 print "RTM RECV: ", Dumper($msg);
1417                 irc_broadcast_notice "RTM error: $msg->{error}->{msg}"
1418                     if $msg->{error};
1419
1420                 if (defined $msg->{type}) {
1421                     my $handler = $rtm_command{$msg->{type}};
1422                     $handler->($msg) if defined($handler);
1423                 }
1424             };
1425             print "Error in message handler: $@" if $@;
1426         });
1427
1428         $rtm_con->on(finish => sub {
1429             eval {
1430                 my ($con) = @_;
1431
1432                 if (defined $con->close_error) {
1433                     rtm_destroy "RTM connection error: $con->close_error";
1434                 } elsif (defined $con->close_reason) {
1435                     rtm_destroy "RTM connection closed: $con->close_reason";
1436                 } else {
1437                     rtm_destroy "RTM connection finished";
1438                 }
1439             };
1440             print "Error in finish handler: $@" if $@;
1441         });
1442     });
1443 };
1444
1445 sub rtm_start {
1446     print "Requesting RTM connection\n";
1447     rtm_apicall "rtm.start", {}, sub {
1448         my $data = shift;
1449
1450         unless (defined($data)) {
1451             rtm_cooldown;
1452             return;
1453         }
1454
1455         $self_id = $data->{self}->{id};
1456
1457         foreach my $c (@{$data->{users}}) {
1458             rtm_update_user $c;
1459         }
1460
1461         foreach my $c (@{$data->{ims}}) {
1462             my $u = $users{$c->{user}};
1463
1464             $u->{DMId} = $c->{id};
1465             $users_by_dmid{$c->{id}} = $u;
1466         }
1467
1468         foreach my $c (@{$data->{channels}}) {
1469             rtm_update_channel "C", $c unless $c->{is_archived};
1470         }
1471
1472         foreach my $c (@{$data->{groups}}) {
1473             rtm_update_channel "G", $c unless $c->{is_archived};
1474         }
1475
1476         rtm_start_ws $data->{url};
1477     };
1478 };
1479
1480 ########################################################################
1481 # RTM kick-off
1482 ########################################################################
1483
1484 my $cfgfile = shift || die "You must specify a config file";
1485 open(my $cfg, $cfgfile) || die "Can't open $cfgfile";
1486 foreach (<$cfg>) {
1487     chomp;
1488     $config{$1} = $2 if /^([-_0-9a-zA-Z]+)=(.*)$/;
1489 }
1490 close($cfg);
1491
1492 rtm_start;
1493 irc_listen;
1494 AnyEvent->condvar->recv;