2 # slirc.pl: local Slack IRC gateway
3 # Copyright (C) 2017-2019 Daniel Beer <dlbeer@gmail.com>
4 # Amendments 2021 by Ralph Ronnquist <ralph.ronnquist@gmail.com>
6 # Permission to use, copy, modify, and/or distribute this software for any
7 # purpose with or without fee is hereby granted, provided that the above
8 # copyright notice and this permission notice appear in all copies.
10 # THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
11 # WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
12 # MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
13 # ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
14 # WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
15 # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
16 # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
18 # To run, create a configuration file with the following content:
20 # slack_token=<legacy API token>
21 # password=<password of your choice>
24 # Then run ./slirc.pl <config-file>. Connect to the chosen port on
25 # 127.0.0.1 with your chosen password.
27 # Updated 2018-05-15 to add support for listening on Unix domain sockets
28 # by Colin Watson <cjwatson@chiark.greenend.org.uk>. To use this feature
29 # with an IRC client supporting Unix domain connections, add the line
30 # "unix_socket=<path>" to the config file.
33 # - HTML entities are now escaped/unescaped properly
34 # - Channel IDs are translated with the correct sigil
35 # - You can now close accumulated group chats. This is mapped to
36 # JOIN/PART (the behaviour of JOIN/PART for public channels is
38 # - IRC-side PING checks are now more lenient, to work around bugs in
40 # - Added X commands for debug dumps and dynamically switching protocol
43 # Updated 2019-05-08 based on changes from Neia Finch to improve
46 # Updated 2021-08-30 for Slack API changes.
55 use AnyEvent::WebSocket::Client;
56 use URI::Encode qw(uri_encode);
59 use Digest::SHA qw(sha256);
62 my $VERSION = "20210830";
63 my $start_time = time();
68 ########################################################################
70 ########################################################################
72 my $connected; # Is the RTM connection ready?
73 my $self_id; # Slack ID of our own user, or undef
75 my %channels; # Slack ID -> channel hash ref
76 my %channels_by_name; # irc_lcase -> channel hash ref
79 # - Members: Slack ID set
80 # - Name: text (IRC name)
83 my %users; # Slack ID -> user hash ref
84 my %users_by_name; # irc_lcase -> user hash ref
85 my %users_by_dmid; # Slack DMID -> user hash ref
88 # - Name: text (IRC name)
89 # - Channels: Slack ID set
91 # - DMId: DM session ID (may be undefined, or blank if open in progress)
92 # - TxQueue: messages awaiting transmission if no DM open
94 ########################################################################
96 ########################################################################
98 # Canonicalize an IRC name
100 my $name = lc(shift);
114 return irc_lcase($a) eq irc_lcase($b);
117 # Choose an unused valid name with reference to the hash
119 my ($name, $hash) = @_;
121 $name =~ s/[#,<>!\0\r\n: ]/_/g;
123 return $name if length($name) && irc_lcase($name) ne "x" &&
124 !defined($hash->{irc_lcase($name)});
129 my $prop = "$name$i";
131 return $prop unless defined($hash->{irc_lcase($prop)});
136 ########################################################################
138 ########################################################################
140 # Forward decls to RTM subsystem
142 sub rtm_send_to_user;
152 my ($c, $source, $short, $long) = @_;
154 $source =~ s/[\t\r\n\0 ]//g;
156 my @arg = (":$source");
158 for my $a (@$short) {
159 $a =~ s/[\t\r\n\0 ]//g;
162 $a = "*" unless length($a);
166 if (defined($long)) {
167 $long =~ s/[\r\n\0]/ /g;
172 my $line = join(' ', @arg);
173 print "IRC $c->{Handle} SEND: $line\n" if $config{debug_dump};
174 $c->{Handle}->push_write("$line\r\n");
178 my ($c, $num, $short, $long) = @_;
179 my $dst = $c->{Nick};
181 $dst = "*" unless defined($c->{Nick});
182 irc_send_args $c, "localhost",
183 [sprintf("%03d", $num), $dst, @$short], $long;
187 my ($c, $uid, $short, $long) = @_;
188 my $user = $users{$uid};
189 my $nick = $uid eq $self_id ? $c->{Nick} : $user->{Name};
191 irc_send_args $c, "$nick!$user->{Id}\@localhost", $short, $long;
197 print "IRC $c->{Handle} DISCONNECT: $msg\n";
198 delete $irc_clients{$c->{Handle}};
199 $c->{Handle}->destroy;
202 sub irc_disconnect_all {
203 print "IRC: disconnect all\n";
204 foreach my $k (keys %irc_clients) {
205 $irc_clients{$k}->{Handle}->destroy;
213 my @ulist = keys %{$chan->{Members}};
215 while ($i < @ulist) {
218 my $chunk = join(' ', map {
219 $_ eq $self_id ? $c->{Nick} : $users{$_}->{Name}
220 } @ulist[$i .. ($i + $n - 1)]);
221 irc_send_num $c, 353, ['@', "#$chan->{Name}"], $chunk;
225 irc_send_num $c, 366, ["#$chan->{Name}"], "End of /NAMES list";
228 sub irc_server_notice {
230 my $nick = $c->{Nick};
232 $nick = "*" unless defined($nick);
233 irc_send_args $c, "localhost", ["NOTICE", $nick], $msg;
236 sub irc_gateway_notice {
238 my $nick = $c->{Nick};
240 $nick = "*" unless defined($nick);
241 irc_send_args $c, "X!X\@localhost", ["NOTICE", $nick], $msg;
244 sub irc_notify_away {
246 my $user = $users{$self_id};
249 if ($user->{Presence} eq 'away') {
251 $msg = "You have been marked as being away";
254 $msg = "You are no longer marked as being away";
257 irc_send_num $c, $num, [], $msg if $c->{Ready};
260 sub irc_broadcast_away {
261 for my $k (keys %irc_clients) {
262 my $c = $irc_clients{$k};
263 irc_notify_away $c if $c->{Ready};
272 ' ___| (_)_ __ ___ _ __ | |',
273 '/ __| | | \'__/ __| | \'_ \| |',
274 '\__ \ | | | | (__ _| |_) | |',
275 '|___/_|_|_| \___(_) .__/|_|',
277 'slirc.pl, Copyright (C) 2017-2019 Daniel Beer <dlbeer@gmail.com>'
280 for my $x (@banner) {
281 irc_send_num $c, 372, [], $x;
283 irc_send_num $c, 376, [], "End of /MOTD command";
286 sub irc_check_welcome {
289 if (defined $c->{Nick} && defined $c->{User} &&
290 (!$config{password} || defined $c->{Password}) &&
292 if (!$config{password} ||
293 sha256($c->{Password}) eq sha256($config{password})) {
296 irc_server_notice $c, "Incorrect password";
297 irc_disconnect $c, "Incorrect password";
302 return unless $c->{Authed} && !$c->{Ready} && $connected;
304 my $u = $users_by_name{irc_lcase($c->{Nick})};
305 if (defined($u) && ($u->{Id} ne $self_id)) {
306 irc_server_notice $c, "Nick already in use";
307 irc_disconnect $c, "Nick already in use";
311 my $lt = localtime($start_time);
313 irc_send_num $c, 001, [], "slirc.pl IRC-to-Slack gateway";
314 irc_send_num $c, 002, [], "This is slirc.pl version $VERSION";
315 irc_send_num $c, 003, [], "Server started " . ctime($start_time);
319 my $user = $users{$self_id};
321 for my $k (keys %{$user->{Channels}}) {
322 my $chan = $channels{$k};
323 irc_send_from $c, $self_id, ["JOIN", "#$chan->{Name}"];
324 irc_send_num $c, 332, ["#$chan->{Name}"], $chan->{"Topic"};
325 irc_send_names $c, $chan;
331 sub irc_check_welcome_all {
332 foreach my $k (keys %irc_clients) {
333 irc_check_welcome $irc_clients{$k};
337 sub irc_broadcast_nick {
338 my ($id, $newname) = @_;
339 return if $id eq $self_id;
341 for my $k (keys %irc_clients) {
342 my $c = $irc_clients{$k};
343 irc_send_from $c, $id, ["NICK", $newname] if $c->{Ready};
347 sub irc_broadcast_join {
348 my ($uid, $chid) = @_;
349 my $chan = $channels{$chid};
351 for my $k (keys %irc_clients) {
352 my $c = $irc_clients{$k};
353 next unless $c->{Ready};
355 if ($uid eq $self_id) {
356 irc_send_from $c, $self_id, ["JOIN", "#$chan->{Name}"];
357 irc_send_num $c, 332, ["#$chan->{Name}"], $chan->{Topic};
358 irc_send_names $c, $chan;
360 irc_send_from $c, $uid, ["JOIN", "#$chan->{Name}"];
365 sub irc_broadcast_part {
366 my ($uid, $chid) = @_;
367 my $chan = $channels{$chid};
369 for my $k (keys %irc_clients) {
370 my $c = $irc_clients{$k};
371 next unless $c->{Ready};
372 irc_send_from $c, $uid, ["PART", "#$chan->{Name}"];
377 my ($c, $chname, $u) = @_;
379 my $user = $users{$u};
380 my $nick = $u eq $self_id ? $c->{Nick} : $user->{Name};
381 my $here = $user->{Presence} eq 'away' ? 'G' : 'H';
383 irc_send_num $c, 352, [$chname, $user->{Id}, "localhost", "localhost",
384 $nick, $here], "0 $user->{Realname}";
389 my $u = $users{$uid};
390 my $nick = $uid eq $self_id ? $c->{Nick} : $u->{Name};
392 irc_send_num $c, 311,
393 [$nick, $u->{Id}, "localhost", "*"], $u->{Realname};
394 irc_send_num $c, 312, [$nick, "localhost"], "slirc.pl";
395 my $clist = join(' ', map { "#" . $channels{$_}->{Name} }
396 keys %{$u->{Channels}});
397 irc_send_num $c, 319, [$nick], $clist;
398 irc_send_num $c, 301, [$nick], "away" if $u->{Presence} eq 'away';
401 sub irc_invite_or_kick {
402 my ($c, $action, $name, $chname) = @_;
405 my $chan = $channels_by_name{irc_lcase($chname)};
407 unless (defined $chan) {
408 irc_send_num $c, 401, ["#$chname"], "No such nick/channel";
412 my $what = $chan->{Type} eq "C" ? "channels" : "groups";
414 foreach (split(/,/, $name)) {
415 my $user = $users_by_name{irc_lcase($_)};
418 rtm_apicall "$what.$action", { user => $user->{Id},
419 channel => $chan->{Id} };
421 irc_send_num $c, 401, [$user], "No such nick/channel";
426 my %gateway_command = (
427 "debug_dump_state" => sub {
429 irc_gateway_notice $c, "Dumping debug state on stdout";
430 print Dumper({ "connected" => $connected,
431 "self_id", => $self_id,
432 "%channels" => \%channels,
433 "%channels_by_name" => \%channels_by_name,
435 "users_by_name" => \%users_by_name,
436 "users_by_dmid" => \%users_by_dmid
439 "debug_dump" => sub {
441 $config{debug_dump} = $arg ? 1 : 0 if defined $arg;
442 irc_gateway_notice $c, "Protocol debug is " .
443 ($config{debug_dump} ? "on" : "off");
447 unless (defined($name)) {
448 irc_gateway_notice $c, "Syntax: newgroup <name>";
452 irc_gateway_notice $c, "Creating group $name";
453 rtm_apicall "groups.create", { name => $name };
457 unless (defined($name)) {
458 irc_gateway_notice $c, "Syntax: newchan <name>";
462 irc_gateway_notice $c, "Creating channel $name";
463 rtm_apicall "channels.create", { name => $name };
467 unless (defined($name)) {
468 irc_gateway_notice $c, "Syntax: archive <name>";
472 my $g = $channels_by_name{irc_lcase($name)};
473 my $what = $g->{Type} eq "C" ? "channels" : "groups";
475 irc_gateway_notice $c, "Archiving $name";
476 rtm_apicall "$what.archive", { channel => $g->{Id} };
478 irc_gateway_notice $c, "No such channel: $name";
483 unless (defined($name)) {
484 irc_gateway_notice $c, "Syntax: close <name>";
489 my $g = $channels_by_name{irc_lcase($name)};
490 my $what = $g->{Type} eq "C" ? "channels" : "groups";
492 irc_gateway_notice $c, "Closing $name";
493 rtm_apicall "$what.close", { channel => $g->{Id} };
495 irc_gateway_notice $c, "No such channel: $name";
499 my ($c, $fileid) = @_;
500 unless (defined($fileid)) {
501 irc_gateway_notice $c, "Syntax: cat <fileid> <filename>";
505 rtm_apicall "files.info", { file => $fileid }, sub {
507 return unless defined $data;
509 my $body = $data->{content};
511 if (length($body) > 65536) {
512 irc_gateway_notice $c, "File too big";
514 irc_gateway_notice $c, "---- BEGIN $fileid ----";
515 foreach (split(/\n/, $body)) {
516 irc_gateway_notice $c, "$_";
518 irc_gateway_notice $c, "---- END $fileid ----";
522 "disconnect" => sub {
524 irc_gateway_notice $c, "Disconnecting";
525 rtm_destroy "User disconnection request";
529 unless (defined($nick)) {
530 irc_gateway_notice $c, "Syntax: delim <name>";
535 if ($nick eq $c->{Nick}) {
536 $user = $users{$self_id};
538 $user = $users_by_name{irc_lcase($nick)};
539 $user = undef if $user->{Id} eq $self_id;
542 unless (defined($user)) {
543 irc_gateway_notice $c, "No such nick: $nick";
547 unless (defined $user->{DMId}) {
548 irc_gateway_notice $c, "DM already closed for $nick";
552 irc_gateway_notice $c, "Closing DM for $nick";
553 rtm_apicall "im.close", { channel => $user->{DMId} };
559 my ($c, $newnick) = @_;
560 return unless defined($newnick);
562 if (defined $c->{Nick}) {
563 my $u = $users_by_name{irc_lcase($newnick)};
564 if (defined($u) && ($u->{Id} ne $self_id)) {
565 irc_send_num $c, 433, [$newnick], "Nickname is already in use";
567 irc_send_from $c, $self_id, ["NICK"], $newnick;
568 $c->{Nick} = $newnick;
571 $c->{Nick} = $newnick;
572 irc_check_welcome $c;
578 $c->{Password} = $pass;
579 irc_check_welcome $c;
583 return unless scalar(@arg) >= 4;
585 $c->{User} = $arg[0];
586 $c->{Realname} = $arg[3];
587 irc_check_welcome $c;
591 return unless $c->{Ready};
592 my $presence = defined $msg ? "away" : "auto";
593 rtm_apicall "users.setPresence", { presence => $presence };
596 my ($c, $reply) = @_;
597 $reply = "" unless defined($reply);
598 irc_send_args $c, "localhost", ["PONG"], $reply;
601 my ($c, $name, $chname) = @_;
602 return unless $c->{Ready};
603 irc_invite_or_kick $c, "invite", $name, $chname;
606 my ($c, $name, $chname) = @_;
607 return unless $c->{Ready};
608 irc_invite_or_kick $c, "kick", $name, $chname;
612 print "JOIN $name\n";
613 return unless $c->{Ready};
614 return unless defined($name);
616 foreach my $n (split(/,/, $name)) {
618 my $chan = $channels_by_name{irc_lcase($n)};
619 if (not defined $chan) {
620 irc_send_num $c, 401, ["#$n"], "No such nick/channel";
621 } elsif ($chan->{Members}->{$self_id}) {
623 } elsif ($chan->{Type} eq "G") {
624 rtm_apicall "groups.open", { channel => $chan->{Id} };
625 irc_broadcast_join $self_id, $chan->{Id}
626 if rtm_update_join $self_id, $chan->{Id};
628 #rtm_apicall "channels.join", { channel => $chan->{Id} };
629 rtm_apicall "conversations.join", { channel => $chan->{Id} };
634 my ($c, $arg, $what) = @_;
635 return unless $c->{Ready};
636 return unless defined($arg);
640 if ($arg eq $c->{Nick}) {
641 irc_send_num $c, 221, [], "+i";
642 } elsif ($arg =~ /^#(.*)$/) {
643 my $chan = $channels_by_name{$1};
647 irc_send_num $c, 368, ["#$chan->{Name}"],
648 "End of channel ban list";
650 irc_send_num $c, 324,
652 ($chan->{Type} eq "G" ? "+ip" : "+p")];
653 irc_send_num $c, 329,
654 ["#$chan->{Name}", $start_time];
657 irc_send_num $c, 403, [$arg], "No such channel";
660 irc_send_num $c, 403, [$arg], "No such channel";
664 my ($c, $name, $topic) = @_;
665 return unless defined($name) && defined($topic);
666 return unless $c->{Ready};
669 my $chan = $channels_by_name{irc_lcase($name)};
670 unless (defined($chan)) {
671 irc_send_num $c, 401, ["#$name"], "No such nick/channel";
675 my $what = $chan->{Type} eq "C" ? "channels" : "groups";
677 rtm_apicall "$what.setTopic", { channel => $chan->{Id},
682 return unless $c->{Ready};
683 return unless defined($name);
685 foreach my $n (split(/,/, $name)) {
687 my $chan = $channels_by_name{irc_lcase($n)};
688 if (not defined($chan)) {
689 irc_send_num $c, 401, ["#$n"], "No such nick/channel";
690 } elsif ($chan->{Members}->{$self_id}) {
691 if ($chan->{Type} eq "G") {
692 rtm_apicall "groups.close", { channel => $chan->{Id} };
693 irc_broadcast_part $self_id, $chan->{Id}
694 if rtm_update_part $self_id, $chan->{Id};
696 #rtm_apicall "channels.leave", { channel => $chan->{Id} };
697 rtm_apicall "conersations.leave", { channel => $chan->{Id} };
704 return unless $c->{Ready};
706 irc_send_num $c, 321, ["Channel"], "Users Name";
707 foreach my $chid (keys %channels) {
708 my $chan = $channels{$chid};
709 my $n = keys %{$chan->{Members}};
711 irc_send_num $c, 322, ["#$chan->{Name}", $n], $chan->{Topic};
713 irc_send_num $c, 323, [], "End of /LIST";
716 my ($c, $nicklist) = @_;
717 return unless $c->{Ready};
718 return unless defined($nicklist);
721 for my $nick (split(/,/, $nicklist)) {
722 if (irc_eq($nick, "x")) {
723 irc_send_num $c, 311,
724 ["X", "X", "localhost", "*"], "Gateway service";
725 irc_send_num $c, 312, ["X", "localhost"], "slirc.pl";
726 } elsif (irc_eq($nick, $c->{Nick})) {
727 irc_send_whois $c, $self_id;
731 if ($nick =~ /^.*!([^@]*)/) {
734 $user = $users_by_name{irc_lcase($nick)};
735 $user = undef if defined($user) && $user->{Id} eq $self_id;
738 if (defined($user)) {
739 irc_send_whois $c, $user->{Id};
741 irc_send_num $c, 401, [$nick], "No such nick/channel";
746 irc_send_num $c, 318, [$nicklist], "End of /WHOIS list";
750 return unless $c->{Ready};
751 return unless defined($name);
755 my $chan = $channels_by_name{irc_lcase($n)};
756 unless (defined($chan)) {
757 irc_send_num $c, 401, [$name], "No such nick/channel";
761 irc_send_names $c, $chan;
765 return unless $c->{Ready};
767 if (!defined($name)) {
768 foreach my $u (keys %users) {
769 irc_send_who $c, "*", $u;
771 irc_send_num $c, 352, ["*", "X", "localhost", "localhost",
772 "X", "H"], "0 Gateway service";
773 } elsif (irc_eq($name, "X")) {
774 irc_send_num $c, 352, ["*", "X", "localhost", "localhost",
775 "X", "H"], "0 Gateway service";
776 } elsif ($name =~ /^.*!([^@]*)/) {
777 unless (exists $users{$1}) {
778 irc_send_num $c, 401, [$name], "No such nick/channel";
782 irc_send_who $c, $name, $1;
783 } elsif ($name =~ /^#(.*)$/) {
784 my $chan = $channels_by_name{irc_lcase($1)};
786 unless (defined($chan)) {
787 irc_send_num $c, 401, [$name], "No such nick/channel";
791 foreach my $u (keys %{$chan->{Members}}) {
792 irc_send_who $c, "#$chan->{Name}", $u;
795 my $user = $users_by_name{irc_lcase($name)};
797 unless (defined($user)) {
798 irc_send_num $c, 401, [$name], "No such nick/channel";
802 irc_send_who $c, $name, $self_id;
805 $name = "*" unless defined($name);
806 irc_send_num $c, 315, [$name], "End of /WHO list";
813 my ($c, $namelist, $msg) = @_;
814 return unless $c->{Ready};
815 return unless defined($namelist) && defined($msg);
820 $msg =~ s/"/"/g;
821 $msg =~ s/<@([^>]+)>/'<@' . irc_name_to_id($c, $1) . '>'/eg;
822 $msg =~ s/<#([^>]+)>/'<#' . irc_chan_to_id($c, $1) . '>'/eg;
824 foreach my $name (split(/,/, $namelist)) {
825 if (irc_eq($name, "X")) {
826 my @args = split(/ */, $msg);
827 my $cmd = shift @args;
828 my $handler = $gateway_command{lc($cmd)};
830 if (defined $handler) {
831 $handler->($c, @args);
833 irc_gateway_notice $c, "Unknown command: $cmd";
835 } elsif ($name =~ /^#(.*)$/) {
836 my $chan = $channels_by_name{irc_lcase($1)};
840 type => "message", channel => $chan->{Id},
843 irc_send_num $c, 401, [$name], "No such nick/channel";
845 } elsif (irc_eq($name, $c->{Nick})) {
846 rtm_send_to_user $self_id, $msg;
848 my $user = $users_by_name{irc_lcase($name)};
851 rtm_send_to_user $user->{Id}, $msg;
853 irc_send_num $c, 401, [$name], "No such nick/channel";
859 shift->{PingCount} = 0;
863 irc_disconnect $c, "QUIT";
867 sub irc_broadcast_notice {
870 print "NOTICE: $msg\n";
871 foreach my $k (keys %irc_clients) {
872 my $c = $irc_clients{$k};
873 irc_server_notice $c, $msg if $c->{Authed};
879 return $c->{Nick} if $id eq $self_id;
881 return $u->{Name} if defined($u);
887 return $self_id if $name eq $c->{Nick};
888 my $u = $users_by_name{$name};
889 return $u->{Id} if defined($u);
895 my $ch = $channels{$id};
896 return $ch->{Name} if defined ($ch);
902 my $ch = $channels_by_name{$chan};
903 return $ch->{Id} if defined($ch);
908 my ($srcid, $dstname, $subtype, $text) = @_;
912 $prefix = "\002[$subtype]\002 " if defined($subtype);
914 for my $k (keys %irc_clients) {
915 my $c = $irc_clients{$k};
916 next unless $c->{Ready};
918 my $translate = $text;
919 $translate =~ s/<@([^>]+)>/'<@' . irc_id_to_name($c, $1) . '>'/eg;
920 $translate =~ s/<#([^>]+)>/'<#' . irc_id_to_chan($c, $1) . '>'/eg;
921 $translate =~ s/</</g;
922 $translate =~ s/>/>/g;
923 $translate =~ s/"/"/g;
924 $translate =~ s/&/&/g;
926 for my $line (split(/\n/, $translate)) {
927 irc_send_from $c, $srcid, ["PRIVMSG", $dstname], "$prefix$line";
933 my ($id, $subtype, $msg) = @_;
934 irc_do_message $id, $users{$id}->{Name}, $subtype, $msg;
938 my ($id, $subtype, $chid, $msg) = @_;
939 irc_do_message $id, "#$channels{$chid}->{Name}", $subtype, $msg;
942 sub irc_topic_change {
943 my ($id, $chid) = @_;
944 my $chan = $channels{$chid};
946 foreach my $k (keys %irc_clients) {
947 my $c = $irc_clients{$k};
949 irc_send_from $c, $id, ["TOPIC", "#$chan->{Name}"], $chan->{Topic}
957 if (++$c->{PingCount} >= 3) {
958 irc_disconnect $c, "Ping timeout";
962 irc_send_args $c, "localhost", ["PING"], time();
963 $c->{PingTimer} = AnyEvent->timer(after => 60, cb => sub { irc_ping($c); });
967 my ($c, $fh, $line, $eol) = @_;
969 print "IRC $fh RECV: $line\n" if $config{debug_dump};
973 my $smallargs = $line;
976 if ($line =~ /^(.*?) :(.*)$/) {
981 my @words = split / */, $smallargs;
982 push @words, $bigarg if defined($bigarg);
984 if (scalar(@words)) {
985 my $cmd = shift @words;
986 my $handler = $irc_command{uc($cmd)};
988 $handler->($c, @words) if (defined($handler));
991 $fh->push_read(line => sub { irc_line($c, @_) });
995 print "Start IRC listener\n";
996 my $listen_host = $config{unix_socket} ? "unix/" : "127.0.0.1";
997 tcp_server $listen_host,
998 ($config{unix_socket} || $config{port} || 6667), sub {
999 my ($fd, $host, $port) = @_;
1002 $fh = new AnyEvent::Handle
1005 my ($fh, $fatal, $msg) = @_;
1006 irc_disconnect $irc_clients{$fh}, "error: $msg";
1010 irc_disconnect $irc_clients{$fh}, "EOF";
1013 print "IRC $fh Got connection from $host:$port\n";
1015 my $c = { Handle => $fh };
1016 $c->{PingTimer} = AnyEvent->timer(after => 30,
1017 cb => sub { irc_ping $c; });
1018 $c->{PingCount} = 0;
1019 $irc_clients{$fh} = $c;
1020 $fh->push_read(line => sub { irc_line($c, @_) });
1022 irc_server_notice $c, "Waiting for RTM connection" if not $connected;
1024 chmod 0600, $config{unix_socket} if $config{unix_socket};
1028 ########################################################################
1030 ########################################################################
1035 my %rtm_apicall_handles;
1036 my $rtm_cooldown_timer;
1045 my ($method, $args, $cb) = @_;
1048 print "RTM APICALL $method ", Dumper($args) if $config{debug_dump};
1050 $args->{token} = $config{slack_token};
1052 foreach my $k (keys %$args) {
1053 my $ek = uri_encode($k);
1054 my $ev = uri_encode($args->{$k});
1056 push @encode, "$ek=$ev";
1060 $x = http_post "https://slack.com/api/$method", join('&', @encode),
1062 "Content-Type", "application/x-www-form-urlencoded"
1064 my ($body, $hdr) = @_;
1065 delete $rtm_apicall_handles{$x};
1067 unless ($hdr->{Status} =~ /^2/) {
1068 irc_broadcast_notice
1069 "API HTTP error: $method: $hdr->{Status} $hdr->{Reason}";
1070 $cb->(undef) if defined($cb);
1074 my $data = decode_json $body;
1076 print "RTM REPLY $method ", Dumper($data) if $config{debug_dump};
1078 unless ($data->{ok}) {
1079 irc_broadcast_notice "API error: $data->{error}";
1080 $cb->(undef) if defined($cb);
1084 $cb->($data) if defined($cb);
1087 $rtm_apicall_handles{$x} = 1;
1093 $frame->{id} = $rtm_msg_id++;
1094 print "RTM SEND: ", Dumper($frame) if $config{debug_dump};
1095 $rtm_con->send(encode_json $frame);
1098 sub rtm_update_join {
1099 my ($uid, $chid) = @_;
1100 my $chan = $channels{$chid};
1101 my $user = $users{$uid};
1103 if (!$chan->{Members}->{$uid}) {
1104 $chan->{Members}->{$uid} = 1;
1105 $user->{Channels}->{$chid} = 1;
1112 sub rtm_update_part {
1113 my ($uid, $chid) = @_;
1114 my $chan = $channels{$chid};
1115 my $user = $users{$uid};
1117 if ($chan->{Members}->{$uid}) {
1118 delete $channels{$chid}->{Members}->{$uid};
1119 delete $users{$uid}->{Channels}->{$chid};
1126 sub rtm_update_user {
1130 if (exists $users{$c->{id}}) {
1131 $user = $users{$c->{id}};
1132 my $oldname = $user->{Name};
1133 delete $users_by_name{irc_lcase($oldname)};
1134 my $newname = irc_pick_name($c->{name}, \%users_by_name);
1136 $user->{Realname} = $c->{real_name} // $c->{name};
1138 irc_broadcast_nick $c->{id}, $newname
1139 if $oldname ne $newname;
1141 $user->{Name} = $newname;
1142 $user->{Presence} = $c->{presence} // 'active';
1143 $users_by_name{$newname} = $user;
1145 my $name = irc_pick_name($c->{name}, \%users_by_name);
1150 Realname => $c->{real_name} // $c->{name},
1152 Presence => $c->{presence} // 'active'
1155 $users{$c->{id}} = $user;
1156 $users_by_name{$name} = $user;
1159 $user->{Realname} = "" unless defined($user->{Realname});
1162 sub rtm_record_unknown_uid {
1165 unless (exists $users{$uid}) {
1167 my $name = irc_pick_name($uid, \%users_by_name);
1178 $users_by_name{irc_lcase($name)} = $u;
1180 rtm_apicall "users.info", { user => $uid }, sub {
1183 rtm_update_user $data->{user} if defined $data;
1188 sub rtm_update_channel {
1189 my ($type, $c) = @_;
1192 rtm_apicall "conversations.members", { channel => $id }, sub {
1197 my $name = $c->{name};
1199 $c->{members} = $data->{'members'};
1201 $name = "+$name" if $type eq "G";
1203 # Cross-reference users/channels
1204 foreach my $u (@{$c->{members}}) {
1205 rtm_record_unknown_uid $u;
1206 # Filter ourselves out of the membership list if this is a
1207 # closed group chat.
1208 next if $type eq 'G' && $u eq $self_id && !$c->{is_open};
1210 $users{$u}->{Channels}->{$id} = 1;
1213 if (exists $channels{$id}) {
1214 my $chan = $channels{$id};
1215 $chan->{Members} = $mhash;
1216 $chan->{Topic} = $c->{topic}->{value};
1217 $chan->{Type} = $type;
1219 my $name = irc_pick_name($name, \%channels_by_name);
1225 Topic => $c->{topic}->{value}
1228 $channels{$c->{id}} = $chan;
1229 $channels_by_name{irc_lcase($name)} = $chan;
1234 sub rtm_delete_channel {
1236 my $chan = $channels{$chid};
1237 return unless defined $chan;
1239 foreach ($chan->{Members}) {
1240 my $user = $users{$_};
1242 delete $user->{Channels}->{$chid};
1245 delete $channels_by_name{irc_lcase($chan->{Name})};
1246 delete $channels{$chid};
1249 sub rtm_mark_channel {
1250 my ($chid, $ts) = @_;
1252 $rtm_mark_queue{$chid} = $ts;
1254 unless (defined $rtm_mark_timer) {
1255 $rtm_mark_timer = AnyEvent->timer(after => 5, cb => sub {
1256 for my $chid (keys %rtm_mark_queue ) {
1257 rtm_apicall "conversations.mark", {
1259 ts => $rtm_mark_queue{$chid}
1262 %rtm_mark_queue = ();
1263 undef $rtm_mark_timer;
1269 "presence_change" => sub {
1271 my $user = $users{$msg->{user}};
1273 if (defined $user) {
1274 my $old = $user->{Presence};
1275 $user->{Presence} = $msg->{presence} if defined $user;
1276 irc_broadcast_away if
1277 $msg->{user} eq $self_id and $old ne $msg->{presence};
1280 "manual_presence_change" => sub {
1282 my $user = $users{$self_id};
1283 my $old = $user->{Presence};
1285 $user->{Presence} = $msg->{presence};
1286 irc_broadcast_away if $old ne $msg->{presence};
1290 rtm_record_unknown_uid $msg->{user};
1292 my $u = $users{$msg->{user}};
1293 $u->{DMId} = $msg->{channel};
1294 $users_by_dmid{$msg->{channel}} = $u;
1296 foreach my $msg (@{$u->{TxQueue}}) {
1297 rtm_send { type => "message",
1298 channel => $u->{DMId}, text => $msg };
1305 my $u = $users_by_dmid{$msg->{channel}};
1306 return unless defined($u);
1309 delete $users_by_dmid{$msg->{channel}};
1311 "group_joined" => sub {
1314 rtm_update_channel "G", $msg->{channel};
1315 irc_broadcast_join $self_id, $msg->{channel}->{id};
1317 "group_left" => sub {
1320 irc_broadcast_part $self_id, $msg->{channel}
1321 if rtm_update_part $self_id, $msg->{channel};
1323 "group_archive" => sub {
1326 irc_broadcast_part $self_id, $msg->{channel}
1327 if rtm_update_part $self_id, $msg->{channel};
1328 rtm_delete_channel $msg->{channel};
1330 "channel_joined" => sub {
1333 rtm_update_channel "C", $msg->{channel};
1334 irc_broadcast_join $self_id, $msg->{channel}->{id};
1336 "channel_left" => sub {
1339 irc_broadcast_part $self_id, $msg->{channel}
1340 if rtm_update_part $self_id, $msg->{channel};
1342 "channel_archive" => sub {
1345 irc_broadcast_part $self_id, $msg->{channel}
1346 if rtm_update_part $self_id, $msg->{channel};
1347 rtm_delete_channel $msg->{channel};
1349 "member_joined_channel" => sub {
1352 rtm_record_unknown_uid $msg->{user};
1353 irc_broadcast_join $msg->{user}, $msg->{channel}
1354 if rtm_update_join($msg->{user}, $msg->{channel});
1356 "member_left_channel" => sub {
1359 irc_broadcast_part $msg->{user}, $msg->{channel}
1360 if rtm_update_part($msg->{user}, $msg->{channel});
1363 $rtm_ping_count = 0;
1367 my $chan = $channels{$msg->{channel}};
1368 my $subtype = $msg->{subtype} || "";
1369 my $uid = $msg->{user} || $msg->{comment}->{user} || $msg->{bot_id};
1370 my $text = $msg->{text} // '';
1372 if (defined($msg->{attachments})) {
1373 my $attext = join '\n', map {
1375 . " " . ($_->{text} or "")
1376 . " " . ($_->{title_link} or "") } @{$msg->{attachments}};
1377 $text .= "\n" unless length($text);
1381 if (defined($chan)) {
1382 if ($subtype eq "channel_topic" or $subtype eq "group_topic") {
1383 $chan->{Topic} = $msg->{topic};
1384 irc_topic_change $uid, $chan->{Id};
1386 irc_chanmsg $uid, $msg->{subtype}, $chan->{Id}, $text;
1388 rtm_mark_channel $chan->{Id}, $msg->{ts};
1390 irc_privmsg $uid, $msg->{subtype}, $text;
1393 if ($subtype eq "file_share") {
1394 my $fid = $msg->{file}->{id};
1395 rtm_apicall "files.info", { file => $fid }, sub {
1397 return unless defined $data;
1399 my $body = $data->{content};
1400 return unless length($body) <= 65536;
1402 if (defined $chan) {
1403 irc_chanmsg $uid, ">$fid", $chan->{Id}, $body;
1405 irc_privmsg $uid, ">$fid", $body;
1412 sub rtm_send_to_user {
1413 my ($id, $msg) = @_;
1414 my $u = $users{$id};
1416 if (defined($u->{DMId}) && length($u->{DMId})) {
1417 rtm_send { type => "message",
1418 channel => $u->{DMId}, text => $msg };
1422 push @{$u->{TxQueue}}, $msg;
1424 if (!defined($u->{DMId})) {
1425 rtm_apicall "im.open", { user => $u->{Id} }, sub {
1427 unless (defined $result) {
1429 foreach my $m (@{$u->{TxQueue}}) {
1430 irc_broadcast_notice "Failed to send to $u->{Name}: $m";
1443 return if defined($rtm_cooldown_timer);
1444 print "Waiting before reinitiating RTM\n";
1445 $rtm_cooldown_timer = AnyEvent->timer(after => 5, cb => sub {
1446 undef $rtm_cooldown_timer;
1453 return unless defined($rtm_con);
1455 irc_broadcast_notice $msg;
1460 %channels_by_name = ();
1462 %users_by_name = ();
1463 %users_by_dmid = ();
1465 %rtm_apicall_handles = (); # cancel outstanding requests
1466 %rtm_mark_queue = ();
1467 undef $rtm_mark_timer;
1468 undef $rtm_ping_timer;
1478 if (++$rtm_ping_count >= 2) {
1479 rtm_destroy "RTM ping timeout";
1483 rtm_send { type => "ping" };
1484 $rtm_ping_timer = AnyEvent->timer(after => 60, cb => \&rtm_ping);
1490 return if defined($rtm_client);
1491 $rtm_client = AnyEvent::WebSocket::Client->new;
1493 print "WSS URL: $url\n" if $config{debug_dump};
1494 $rtm_client->connect($url)->cb(sub {
1495 $rtm_con = eval { shift->recv; };
1497 irc_broadcast_notice "WSS connection failed: $@\n";
1502 print "WSS connected\n";
1504 $rtm_ping_count = 0;
1506 irc_check_welcome_all;
1508 $rtm_ping_timer = AnyEvent->timer(after => 60, cb => \&rtm_ping);
1510 $rtm_con->on(each_message => sub {
1513 my $msg = decode_json shift->{body};
1515 print "RTM RECV: ", Dumper($msg) if $config{debug_dump};
1516 irc_broadcast_notice "RTM error: $msg->{error}->{msg}"
1519 if (defined $msg->{type}) {
1520 my $handler = $rtm_command{$msg->{type}};
1521 $handler->($msg) if defined($handler);
1524 print "Error in message handler: $@" if $@;
1527 $rtm_con->on(finish => sub {
1531 if (defined $con->close_error) {
1532 rtm_destroy "RTM connection error: $con->close_error";
1533 } elsif (defined $con->close_reason) {
1534 rtm_destroy "RTM connection closed: $con->close_reason";
1536 rtm_destroy "RTM connection finished";
1539 print "Error in finish handler: $@" if $@;
1545 print "Requesting RTM connection\n";
1546 rtm_apicall "rtm.start", {}, sub {
1549 unless (defined($data)) {
1554 $self_id = $data->{self}->{id};
1556 foreach my $c (@{$data->{users}}) {
1560 foreach my $c (@{$data->{ims}}) {
1561 my $u = $users{$c->{user}};
1563 $u->{DMId} = $c->{id};
1564 $users_by_dmid{$c->{id}} = $u;
1567 foreach my $c (@{$data->{channels}}) {
1568 rtm_update_channel "C", $c unless $c->{is_archived};
1571 foreach my $c (@{$data->{bots}}) {
1576 foreach my $c (@{$data->{groups}}) {
1577 rtm_update_channel "G", $c unless $c->{is_archived};
1580 rtm_start_ws $data->{url};
1584 ########################################################################
1586 ########################################################################
1588 my $cfgfile = shift || die "You must specify a config file";
1589 open(my $cfg, $cfgfile) || die "Can't open $cfgfile";
1592 $config{$1} = $2 if /^([-_0-9a-zA-Z]+)=(.*)$/;
1598 AnyEvent->condvar->recv;