From: Ralph Ronnquist Date: Tue, 24 Aug 2021 22:57:50 +0000 (+1000) Subject: initial capture of slirc-20180515.pl X-Git-Url: https://git.rrq.au/?a=commitdiff_plain;h=285ef751ec9174e9175889acafc68b009b440855;p=rrq%2Fslirc.git initial capture of slirc-20180515.pl --- 285ef751ec9174e9175889acafc68b009b440855 diff --git a/notes.md b/notes.md new file mode 100644 index 0000000..3b5cc15 --- /dev/null +++ b/notes.md @@ -0,0 +1,46 @@ +I tried to get back to an IRC interface to Slack using Matrix, and it +had some problems. Thanks to Colin Watson’s comment on that post, I +tried Daniel Beer’s slirc, and so far it seems to be working pretty +well. + +Here’s what I did: + +Get a Slack legacy token which slirc will use to connect to Slack as +you. Follow the instructions given at that link, and you should end up +with a token that looks something like “abcd-123456768-ETC-ETC”. Keep +a note of it. + +Install the prerequisites for slirc, and download it: + +sudo cpan AnyEvent AnyEvent::HTTP AnyEvent::Socket AnyEvent::WebSocket::Client URI::Encode Data::Dumper JSON +mkdir slirc +cd slirc +wget -q 'https://www.dlbeer.co.nz/articles/slirc/slirc-20180515.pl' +chmod +x slirc-20180515.pl + +Create a file in the slirc directory you created above, called +rc.conf, and make it look like this: + +slack_token=abcd-123456768-ETC-ETC +password=somepassword +port=6667 + +Replace “abcd-123456768-ETC-ETC” with the Slack legacy token you noted +down earlier. + +Replace “somepassword” with something you’ve made up (not your Slack +password) – this is what you will type as the password in your IRC +client. + +Run slirc and leave it running: + +./slirc-20180515.pl rc.conf +(Make sure you are inside the slirc dir when you run that.) + +Start your IRC client (e.g. HexChat) and add a server with address +“localhost” and port 6667, with your slack username and the password +you added in the rc.conf (which you wrote instead of “somepassword”). + +This mostly works for me, except it has a tendency to open a load of +ad-hoc chats as channels, so I have to close them all to get a usable +list. diff --git a/slirc.pl b/slirc.pl new file mode 100755 index 0000000..c6fe88c --- /dev/null +++ b/slirc.pl @@ -0,0 +1,1494 @@ +#!/usr/bin/perl -w +# slirc.pl: local Slack IRC gateway +# Copyright (C) 2017 Daniel Beer +# +# Permission to use, copy, modify, and/or distribute this software for any +# purpose with or without fee is hereby granted, provided that the above +# copyright notice and this permission notice appear in all copies. +# +# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES +# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF +# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR +# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES +# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN +# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF +# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. +# +# To run, create a configuration file with the following content: +# +# slack_token= +# password= +# port= +# +# Then run ./slirc.pl . Connect to the chosen port on +# 127.0.0.1 with your chosen password. +# +# Updated 2018-05-15 to add support for listening on Unix domain sockets +# by Colin Watson . To use this feature +# with an IRC client supporting Unix domain connections, add the line +# "unix_socket=" to the config file. + +use strict; +use warnings; +use utf8; + +use AnyEvent; +use AnyEvent::HTTP; +use AnyEvent::Socket; +use AnyEvent::WebSocket::Client; +use URI::Encode qw(uri_encode); +use Data::Dumper; +use Digest::SHA qw(sha256); +use JSON; + +my $VERSION = "20171127"; +my $start_time = time(); +my %config; + +######################################################################## +# Global chat state +######################################################################## + +my $connected; # Is the RTM connection ready? +my $self_id; # Slack ID of our own user, or undef if not connected + +my %channels; # Slack ID -> channel hash ref +my %channels_by_name; # irc_lcase -> channel hash ref +# Properties: +# - Id: Slack ID +# - Members: Slack ID set +# - Name: text (IRC name) +# - Topic: text + +my %users; # Slack ID -> user hash ref +my %users_by_name; # irc_lcase -> user hash ref +my %users_by_dmid; # Slack DMID -> user hash ref +# Properties: +# - Id: Slack ID +# - Name: text (IRC name) +# - Channels: Slack ID set +# - Realname: text +# - DMId: DM session ID (may be undefined, or blank if open in progress) +# - TxQueue: messages awaiting transmission if no DM open + +######################################################################## +# IRC names +######################################################################## + +# Canonicalize an IRC name +sub irc_lcase { + my $name = lc(shift); + + $name =~ s/\[/{/g; + $name =~ s/]/}/g; + $name =~ s/\|/\\/g; + $name =~ s/\^/~/g; + + return $name; +} + +# Compare two names +sub irc_eq { + my ($a, $b) = @_; + + return irc_lcase($a) eq irc_lcase($b); +} + +# Choose an unused valid name with reference to the hash +sub irc_pick_name { + my ($name, $hash) = @_; + + $name =~ s/[#,<>!\0\r\n: ]/_/g; + + return $name if length($name) && irc_lcase($name) ne "x" && + !defined($hash->{irc_lcase($name)}); + + my $i = 1; + + for (;;) { + my $prop = "$name$i"; + + return $prop unless !defined($hash->{irc_lcase($prop)}); + $i++; + } +} + +######################################################################## +# IRC server +######################################################################## + +# Forward decls to RTM subsystem +sub rtm_send; +sub rtm_send_to_user; +sub rtm_apicall; +sub rtm_download; +sub rtm_destroy; + +my %irc_clients; + +sub irc_send_args { + my ($c, $source, $short, $long) = @_; + + $source =~ s/[\t\r\n\0 ]//g; + $source =~ s/^://g; + my @arg = (":$source"); + + for my $a (@$short) { + $a =~ s/[\t\r\n\0 ]//g; + $a =~ s/^://g; + utf8::encode($a); + $a = "*" unless length($a); + push @arg, $a; + } + + if (defined($long)) { + $long =~ s/[\r\n\0]/ /g; + utf8::encode($long); + push @arg, ":$long"; + } + + my $line = join(' ', @arg); + print "IRC $c->{Handle} SEND: $line\n"; + $c->{Handle}->push_write("$line\r\n"); +} + +sub irc_send_num { + my ($c, $num, $short, $long) = @_; + my $dst = $c->{Nick}; + + $dst = "*" unless defined($c->{Nick}); + irc_send_args $c, "localhost", + [sprintf("%03d", $num), $dst, @$short], $long; +} + +sub irc_send_from { + my ($c, $uid, $short, $long) = @_; + my $user = $users{$uid}; + my $nick = $uid eq $self_id ? $c->{Nick} : $user->{Name}; + + irc_send_args $c, "$nick!$user->{Id}\@localhost", $short, $long; +} + +sub irc_disconnect { + my ($c, $msg) = @_; + + print "IRC $c->{Handle} DISCONNECT: $msg\n"; + delete $irc_clients{$c->{Handle}}; + $c->{Handle}->destroy; +} + +sub irc_disconnect_all { + print "IRC: disconnect all\n"; + foreach my $k (keys %irc_clients) { + $irc_clients{$k}->{Handle}->destroy; + } + %irc_clients = (); +} + +sub irc_send_names { + my ($c, $chan) = @_; + my $i = 0; + my @ulist = keys %{$chan->{Members}}; + + while ($i < @ulist) { + my $n = @ulist - $i; + $n = 8 if $n > 8; + my $chunk = join(' ', map { + $_ eq $self_id ? $c->{Nick} : $users{$_}->{Name} + } @ulist[$i .. ($i + $n - 1)]); + irc_send_num $c, 353, ['@', "#$chan->{Name}"], $chunk; + $i += $n; + } + + irc_send_num $c, 366, ["#$chan->{Name}"], "End of /NAMES list"; +} + +sub irc_server_notice { + my ($c, $msg) = @_; + my $nick = $c->{Nick}; + + $nick = "*" unless defined($nick); + irc_send_args $c, "localhost", ["NOTICE", $nick], $msg; +} + +sub irc_gateway_notice { + my ($c, $msg) = @_; + my $nick = $c->{Nick}; + + $nick = "*" unless defined($nick); + irc_send_args $c, "X!X\@localhost", ["NOTICE", $nick], $msg; +} + +sub irc_notify_away { + my $c = shift; + my $user = $users{$self_id}; + my ($num, $msg); + + if ($user->{Presence} eq 'away') { + $num = 306; + $msg = "You have been marked as being away"; + } else { + $num = 305; + $msg = "You are no longer marked as being away"; + } + + irc_send_num $c, $num, [], $msg if $c->{Ready}; +} + +sub irc_broadcast_away { + for my $k (keys %irc_clients) { + my $c = $irc_clients{$k}; + irc_notify_away $c if $c->{Ready}; + } +} + +sub irc_check_welcome { + my $c = shift; + + if (defined $c->{Nick} && defined $c->{User} && + (!$config{password} || defined $c->{Password}) && + !$c->{Authed}) { + if (!$config{password} || + sha256($c->{Password}) eq sha256($config{password})) { + $c->{Authed} = 1; + } else { + irc_server_notice $c, "Incorrect password"; + irc_disconnect $c, "Incorrect password"; + return; + } + } + + return unless $c->{Authed} && !$c->{Ready} && $connected; + + my $u = $users_by_name{irc_lcase($c->{Nick})}; + if (defined($u) && ($u->{Id} ne $self_id)) { + irc_server_notice $c, "Nick already in use"; + irc_disconnect $c, "Nick already in use"; + return; + } + + irc_send_num $c, 001, [], "slirc.pl version $VERSION"; + irc_send_num $c, 002, [], + "Copyright (C) 2017 Daniel Beer "; + irc_send_num $c, 003, [], `uptime`; + $c->{Ready} = 1; + + my $user = $users{$self_id}; + + for my $k (keys %{$user->{Channels}}) { + my $chan = $channels{$k}; + irc_send_from $c, $self_id, ["JOIN", "#$chan->{Name}"]; + irc_send_num $c, 332, ["#$chan->{Name}"], $chan->{"Topic"}; + irc_send_names $c, $chan; + } + + irc_notify_away $c; +} + +sub irc_check_welcome_all { + foreach my $k (keys %irc_clients) { + irc_check_welcome $irc_clients{$k}; + } +} + +sub irc_broadcast_nick { + my ($id, $newname) = @_; + return if $id eq $self_id; + + for my $k (keys %irc_clients) { + my $c = $irc_clients{$k}; + irc_send_from $c, $id, ["NICK", $newname] if $c->{Ready}; + } +} + +sub irc_broadcast_join { + my ($uid, $chid) = @_; + my $chan = $channels{$chid}; + + for my $k (keys %irc_clients) { + my $c = $irc_clients{$k}; + next unless $c->{Ready}; + + if ($uid eq $self_id) { + irc_send_from $c, $self_id, ["JOIN", "#$chan->{Name}"]; + irc_send_num $c, 332, ["#$chan->{Name}"], $chan->{Topic}; + irc_send_names $c, $chan; + } else { + irc_send_from $c, $uid, ["JOIN", "#$chan->{Name}"]; + } + } +} + +sub irc_broadcast_part { + my ($uid, $chid) = @_; + my $chan = $channels{$chid}; + + for my $k (keys %irc_clients) { + my $c = $irc_clients{$k}; + next unless $c->{Ready}; + irc_send_from $c, $uid, ["PART", "#$chan->{Name}"]; + } +} + +sub irc_send_who { + my ($c, $chname, $u) = @_; + + my $user = $users{$u}; + my $nick = $u eq $self_id ? $c->{Nick} : $user->{Name}; + my $here = $user->{Presence} eq 'away' ? 'G' : 'H'; + + irc_send_num $c, 352, [$chname, $user->{Id}, "localhost", "localhost", + $nick, $here], "0 $user->{Realname}"; +} + +sub irc_send_whois { + my ($c, $uid) = @_; + my $u = $users{$uid}; + my $nick = $uid eq $self_id ? $c->{Nick} : $u->{Name}; + + irc_send_num $c, 311, + [$nick, $u->{Id}, "localhost", "*"], $u->{Realname}; + irc_send_num $c, 312, [$nick, "localhost"], "slirc.pl"; + my $clist = join(' ', map { "#" . $channels{$_}->{Name} } + keys %{$u->{Channels}}); + irc_send_num $c, 319, [$nick], $clist; + irc_send_num $c, 301, [$nick], "away" if $u->{Presence} eq 'away'; +} + +sub irc_invite_or_kick { + my ($c, $action, $name, $chname) = @_; + + $chname =~ s/^#//; + my $chan = $channels_by_name{irc_lcase($chname)}; + + unless (defined $chan) { + irc_send_num $c, 401, ["#$chname"], "No such nick/channel"; + return; + } + + my $what = $chan->{Type} eq "C" ? "channels" : "groups"; + + foreach (split(/,/, $name)) { + my $user = $users_by_name{irc_lcase($_)}; + + if (defined $user) { + rtm_apicall "$what.$action", { user => $user->{Id}, + channel => $chan->{Id} }; + } else { + irc_send_num $c, 401, [$user], "No such nick/channel"; + } + } +} + +my %gateway_command = ( + "newgroup" => sub { + my ($c, $name) = @_; + unless (defined($name)) { + irc_gateway_notice $c, "Syntax: newgroup "; + return; + } + $name =~ s/^#//; + irc_gateway_notice $c, "Creating group $name"; + rtm_apicall "groups.create", { name => $name }; + }, + "newchan" => sub { + my ($c, $name) = @_; + unless (defined($name)) { + irc_gateway_notice $c, "Syntax: newchan "; + return; + } + $name =~ s/^#//; + irc_gateway_notice $c, "Creating channel $name"; + rtm_apicall "channels.create", { name => $name }; + }, + "archive" => sub{ + my ($c, $name) = @_; + unless (defined($name)) { + irc_gateway_notice $c, "Syntax: archive "; + return; + } + $name =~ s/^#//; + my $g = $channels_by_name{irc_lcase($name)}; + my $what = $g->{Type} eq "C" ? "channels" : "groups"; + if (defined $g) { + irc_gateway_notice $c, "Archiving $name"; + rtm_apicall "$what.archive", { channel => $g->{Id} }; + } else { + irc_gateway_notice $c, "No such channel: $name"; + } + }, + "close" => sub{ + my ($c, $name) = @_; + unless (defined($name)) { + irc_gateway_notice $c, "Syntax: close "; + return; + } + + $name =~ s/^#//; + my $g = $channels_by_name{irc_lcase($name)}; + my $what = $g->{Type} eq "C" ? "channels" : "groups"; + if (defined $g) { + irc_gateway_notice $c, "Closing $name"; + rtm_apicall "$what.close", { channel => $g->{Id} }; + } else { + irc_gateway_notice $c, "No such channel: $name"; + } + }, + "cat" => sub { + my ($c, $fileid) = @_; + unless (defined($fileid)) { + irc_gateway_notice $c, "Syntax: catfile "; + return; + } + + rtm_apicall "files.info", { file => $fileid }, sub { + my $data = shift; + return unless defined $data; + + my $body = $data->{content}; + + if (length($body) > 65536) { + irc_gateway_notice $c, "File too big"; + } else { + irc_gateway_notice $c, "---- BEGIN $fileid ----"; + foreach (split(/\n/, $body)) { + irc_gateway_notice $c, "$_"; + } + irc_gateway_notice $c, "---- END $fileid ----"; + } + }; + }, + "disconnect" => sub { + my ($c) = @_; + irc_gateway_notice $c, "Disconnecting"; + rtm_destroy "User disconnection request"; + }, + "delim" => sub { + my ($c, $nick) = @_; + unless (defined($nick)) { + irc_gateway_notice $c, "Syntax: delim "; + return; + } + my $user; + + if ($nick eq $c->{Nick}) { + $user = $users{$self_id}; + } else { + $user = $users_by_name{irc_lcase($nick)}; + $user = undef if $user->{Id} eq $self_id; + } + + unless (defined($user)) { + irc_gateway_notice $c, "No such nick: $nick"; + return; + } + + unless (defined $user->{DMId}) { + irc_gateway_notice $c, "DM already closed for $nick"; + return; + } + + irc_gateway_notice $c, "Closing DM for $nick"; + rtm_apicall "im.close", { channel => $user->{DMId} }; + }, +); + +my %irc_command = ( + "NICK" => sub { + my ($c, $newnick) = @_; + return unless defined($newnick); + + if (defined $c->{Nick}) { + my $u = $users_by_name{irc_lcase($newnick)}; + if (defined($u) && ($u->{Id} ne $self_id)) { + irc_send_num $c, 433, [$newnick], "Nickname is already in use"; + } else { + irc_send_from $c, $self_id, ["NICK"], $newnick; + $c->{Nick} = $newnick; + } + } else { + $c->{Nick} = $newnick; + irc_check_welcome $c; + } + }, + "PASS" => sub { + my ($c, $pass) = @_; + + $c->{Password} = $pass; + irc_check_welcome $c; + }, + "USER" => sub { + my ($c, @arg) = @_; + return unless scalar(@arg) >= 4; + + $c->{User} = $arg[0]; + $c->{Realname} = $arg[3]; + irc_check_welcome $c; + }, + "AWAY" => sub { + my ($c, $msg) = @_; + return unless $c->{Ready}; + my $presence = defined $msg ? "away" : "auto"; + rtm_apicall "users.setPresence", { presence => $presence }; + }, + "PING" => sub { + my ($c, $reply) = @_; + $reply = "" unless defined($reply); + irc_send_args $c, "localhost", ["PONG"], $reply; + }, + "INVITE" => sub { + my ($c, $name, $chname) = @_; + return unless $c->{Ready}; + irc_invite_or_kick $c, "invite", $name, $chname; + }, + "KICK" => sub { + my ($c, $name, $chname) = @_; + return unless $c->{Ready}; + irc_invite_or_kick $c, "kick", $name, $chname; + }, + "JOIN" => sub { + my ($c, $name) = @_; + return unless $c->{Ready}; + return unless defined($name); + + foreach my $n (split(/,/, $name)) { + $n =~ s/^#//; + my $chan = $channels_by_name{irc_lcase($n)}; + if (not defined $chan) { + irc_send_num $c, 401, ["#$n"], "No such nick/channel"; + } elsif ($chan->{Members}->{$self_id}) { + # Already joined + } elsif ($chan->{Type} eq "G") { + irc_send_num $c, 473, ["#$n"], + " :Cannot join channel (+i)"; + } else { + rtm_apicall "channels.join", { channel => $chan->{Id} }; + } + } + }, + "MODE" => sub { + my ($c, $arg, $what) = @_; + return unless $c->{Ready}; + return unless defined($arg); + + $what = $what || ""; + + if ($arg eq $c->{Nick}) { + irc_send_num $c, 221, [], "+i"; + } elsif ($arg =~ /^#(.*)$/) { + my $chan = $channels_by_name{$1}; + + if (defined $chan) { + if ($what eq "b") { + irc_send_num $c, 368, ["#$chan->{Name}"], + "End of channel ban list"; + } else { + irc_send_num $c, 324, + ["#$chan->{Name}", + ($chan->{Type} eq "G" ? "+ip" : "+p")]; + irc_send_num $c, 329, + ["#$chan->{Name}", $start_time]; + } + } else { + irc_send_num $c, 403, [$arg], "No such channel"; + } + } else { + irc_send_num $c, 403, [$arg], "No such channel"; + } + }, + "TOPIC" => sub { + my ($c, $name, $topic) = @_; + return unless defined($name) && defined($topic); + return unless $c->{Ready}; + + $name =~ s/^#//; + my $chan = $channels_by_name{irc_lcase($name)}; + unless (defined($chan)) { + irc_send_num $c, 401, ["#$name"], "No such nick/channel"; + return; + } + + my $what = $chan->{Type} eq "C" ? "channels" : "groups"; + + rtm_apicall "$what.setTopic", { channel => $chan->{Id}, + topic => $topic }; + }, + "PART" => sub { + my ($c, $name) = @_; + return unless $c->{Ready}; + return unless defined($name); + + foreach my $n (split(/,/, $name)) { + $n =~ s/^#//; + my $chan = $channels_by_name{irc_lcase($n)}; + if (not defined($chan)) { + irc_send_num $c, 401, ["#$n"], "No such nick/channel"; + } elsif ($chan->{Members}->{$self_id}) { + my $what = $chan->{Type} eq "C" ? "channels" : "groups"; + rtm_apicall "$what.leave", { channel => $chan->{Id} }; + } + } + }, + "LIST" => sub { + my ($c, @arg) = @_; + return unless $c->{Ready}; + + irc_send_num $c, 321, ["Channel"], "Users Name"; + foreach my $chid (keys %channels) { + my $chan = $channels{$chid}; + my $n = keys %{$chan->{Members}}; + + irc_send_num $c, 322, ["#$chan->{Name}", $n], $chan->{Topic}; + } + irc_send_num $c, 323, [], "End of /LIST"; + }, + "WHOIS" => sub { + my ($c, $nicklist) = @_; + return unless $c->{Ready}; + return unless defined($nicklist); + my $some = 0; + + for my $nick (split(/,/, $nicklist)) { + if (irc_eq($nick, "x")) { + irc_send_num $c, 311, + ["X", "X", "localhost", "*"], "Gateway service"; + irc_send_num $c, 312, ["X", "localhost"], "slirc.pl"; + } elsif (irc_eq($nick, $c->{Nick})) { + irc_send_whois $c, $self_id; + } else { + my $user; + + if ($nick =~ /^.*!([^@]*)/) { + $user = $users{$1}; + } else { + $user = $users_by_name{irc_lcase($nick)}; + $user = undef if defined($user) && $user->{Id} eq $self_id; + } + + if (defined($user)) { + irc_send_whois $c, $user->{Id}; + } else { + irc_send_num $c, 401, [$nick], "No such nick/channel"; + } + } + } + + irc_send_num $c, 318, [$nicklist], "End of /WHOIS list"; + }, + "NAMES" => sub { + my ($c, $name) = @_; + return unless $c->{Ready}; + return unless defined($name); + + my $n = $name; + $n =~ s/^#//; + my $chan = $channels_by_name{irc_lcase($n)}; + unless (defined($chan)) { + irc_send_num $c, 401, [$name], "No such nick/channel"; + return; + } + + irc_send_names $c, $chan; + }, + "WHO" => sub { + my ($c, $name) = @_; + return unless $c->{Ready}; + + if (!defined($name)) { + foreach my $u (keys %users) { + irc_send_who $c, "*", $u; + } + irc_send_num $c, 352, ["*", "X", "localhost", "localhost", + "X", "H"], "0 Gateway service"; + } elsif (irc_eq($name, "X")) { + irc_send_num $c, 352, ["*", "X", "localhost", "localhost", + "X", "H"], "0 Gateway service"; + } elsif ($name =~ /^.*!([^@]*)/) { + unless (exists $users{$1}) { + irc_send_num $c, 401, [$name], "No such nick/channel"; + return; + } + + irc_send_who $c, $name, $1; + } elsif ($name =~ /^#(.*)$/) { + my $chan = $channels_by_name{irc_lcase($1)}; + + unless (defined($chan)) { + irc_send_num $c, 401, [$name], "No such nick/channel"; + return; + } + + foreach my $u (keys %{$chan->{Members}}) { + irc_send_who $c, "#$chan->{Name}", $u; + } + } else { + my $user = $users_by_name{irc_lcase($name)}; + + unless (defined($user)) { + irc_send_num $c, 401, [$name], "No such nick/channel"; + return; + } + + irc_send_who $c, $name, $self_id; + } + + $name = "*" unless defined($name); + irc_send_num $c, 315, [$name], "End of /WHO list"; + }, + "PRIVMSG" => sub { + my ($c, $namelist, $msg) = @_; + return unless $c->{Ready}; + return unless defined($namelist) && defined($msg); + + $msg =~ s/<@([^>]+)>/'<@' . irc_name_to_id($c, $1) . '>'/eg; + $msg =~ s/<#([^>]+)>/'<@' . irc_chan_to_id($c, $1) . '>'/eg; + + foreach my $name (split(/,/, $namelist)) { + if (irc_eq($name, "X")) { + my @args = split(/ */, $msg); + my $cmd = shift @args; + my $handler = $gateway_command{lc($cmd)}; + + if (defined $handler) { + $handler->($c, @args); + } else { + irc_gateway_notice $c, "Unknown command: $cmd"; + } + } elsif ($name =~ /^#(.*)$/) { + my $chan = $channels_by_name{irc_lcase($1)}; + + if (defined $chan) { + rtm_send { + type => "message", channel => $chan->{Id}, + text => $msg }; + } else { + irc_send_num $c, 401, [$name], "No such nick/channel"; + } + } elsif (irc_eq($name, $c->{Nick})) { + rtm_send_to_user $self_id, $msg; + } else { + my $user = $users_by_name{irc_lcase($name)}; + + if (defined $user) { + rtm_send_to_user $user->{Id}, $msg; + } else { + irc_send_num $c, 401, [$name], "No such nick/channel"; + } + } + } + }, + "PONG" => sub { + shift->{PingCount} = 0; + }, + "QUIT" => sub { + my $c = shift; + irc_disconnect $c, "QUIT"; + }, +); + +sub irc_broadcast_notice { + my ($msg) = @_; + + print "NOTICE: $msg\n"; + foreach my $k (keys %irc_clients) { + my $c = $irc_clients{$k}; + irc_server_notice $c, $msg if $c->{Authed}; + } +} + +sub irc_id_to_name { + my ($c, $id) = @_; + return $c->{Nick} if $id eq $self_id; + my $u = $users{$id}; + return $u->{Name} if defined($u); + return $id; +} + +sub irc_name_to_id { + my ($c, $name) = @_; + return $self_id if $name eq $c->{Nick}; + my $u = $users_by_name{$name}; + return $u->{Id} if defined($u); + return $name; +} + +sub irc_id_to_chan { + my ($c, $id) = @_; + my $ch = $channels{$id}; + return $ch->{Name} if defined ($ch); + return $id; +} + +sub irc_chan_to_id { + my ($c, $chan) = @_; + my $ch = $channels_by_name{$chan}; + return $ch->{Id} if defined($ch); + return $chan; +} + +sub irc_do_message { + my ($srcid, $dstname, $subtype, $text) = @_; + + $text =~ s/\002//g; + my $prefix = ""; + $prefix = "\002[$subtype]\002 " if defined($subtype); + + for my $k (keys %irc_clients) { + my $c = $irc_clients{$k}; + next unless $c->{Ready}; + + my $translate = $text; + $translate =~ s/<@([^>]+)>/'<@' . irc_id_to_name($c, $1) . '>'/eg; + $translate =~ s/<#([^>]+)>/'<@' . irc_id_to_chan($c, $1) . '>'/eg; + + for my $line (split(/\n/, $translate)) { + irc_send_from $c, $srcid, ["PRIVMSG", $dstname], "$prefix$line"; + } + } +} + +sub irc_privmsg { + my ($id, $subtype, $msg) = @_; + irc_do_message $id, $users{$id}->{Name}, $subtype, $msg; +} + +sub irc_chanmsg { + my ($id, $subtype, $chid, $msg) = @_; + irc_do_message $id, "#$channels{$chid}->{Name}", $subtype, $msg; +} + +sub irc_topic_change { + my ($id, $chid) = @_; + my $chan = $channels{$chid}; + + foreach my $k (keys %irc_clients) { + my $c = $irc_clients{$k}; + + irc_send_from $c, $id, ["TOPIC", "#$chan->{Name}"], $chan->{Topic} + if $c->{Ready}; + } +} + +sub irc_ping { + my $c = shift; + + if (++$c->{PingCount} >= 2) { + irc_disconnect $c, "Ping timeout"; + return; + } + + irc_send_args $c, "localhost", ["PING"], time(); + $c->{PingTimer} = AnyEvent->timer(after => 60, cb => sub { irc_ping($c); }); +} + +sub irc_line { + my ($c, $fh, $line, $eol) = @_; + + print "IRC $fh RECV: $line\n"; + + utf8::decode($line); + + my $smallargs = $line; + my $bigarg = undef; + + if ($line =~ /^(.*?) :(.*)$/) { + $smallargs = $1; + $bigarg = $2; + } + + my @words = split / */, $smallargs; + push @words, $bigarg if defined($bigarg); + + if (scalar(@words)) { + my $cmd = shift @words; + my $handler = $irc_command{uc($cmd)}; + + $handler->($c, @words) if (defined($handler)); + } + + $fh->push_read(line => sub { irc_line($c, @_) }); +} + +sub irc_listen { + print "Start IRC listener\n"; + my $listen_host = $config{unix_socket} ? "unix/" : "127.0.0.1"; + tcp_server $listen_host, + ($config{unix_socket} || $config{port} || 6667), sub { + my ($fd, $host, $port) = @_; + + my $fh; + $fh = new AnyEvent::Handle + fh => $fd, + on_error => sub { + my ($fh, $fatal, $msg) = @_; + irc_disconnect $irc_clients{$fh}, "error: $msg"; + }, + on_eof => sub { + my $fh = shift; + irc_disconnect $irc_clients{$fh}, "EOF"; + }; + + print "IRC $fh Got connection from $host:$port\n"; + + my $c = { Handle => $fh }; + $c->{PingTimer} = AnyEvent->timer(after => 30, + cb => sub { irc_ping $c; }); + $c->{PingCount} = 0; + $irc_clients{$fh} = $c; + $fh->push_read(line => sub { irc_line($c, @_) }); + + irc_server_notice $c, "Waiting for RTM connection" if not $connected; + }, sub { + chmod 0600, $config{unix_socket} if $config{unix_socket}; + } +} + +######################################################################## +# RTM client +######################################################################## + +my $rtm_client; +my $rtm_con; +my $rtm_msg_id = 1; +my %rtm_apicall_handles; +my $rtm_cooldown_timer; + +my %rtm_mark_queue; +my $rtm_mark_timer; + +my $rtm_ping_timer; +my $rtm_ping_count; + +sub rtm_apicall { + my ($method, $args, $cb) = @_; + my @encode; + + print "RTM APICALL $method ", Dumper($args); + + $args->{token} = $config{slack_token}; + + foreach my $k (keys %$args) { + my $ek = uri_encode($k); + my $ev = uri_encode($args->{$k}); + + push @encode, "$ek=$ev"; + } + + my $x; + $x = http_post "https://slack.com/api/$method", join('&', @encode), + headers => { + "Content-Type", "application/x-www-form-urlencoded" + }, sub { + my ($body, $hdr) = @_; + delete $rtm_apicall_handles{$x}; + + unless ($hdr->{Status} =~ /^2/) { + irc_broadcast_notice + "API HTTP error: $method: $hdr->{Status} $hdr->{Reason}"; + $cb->(undef) if defined($cb); + return; + } + + my $data = decode_json $body; + + print "RTM REPLY $method ", Dumper($data); + + unless ($data->{ok}) { + irc_broadcast_notice "API error: $data->{error}"; + $cb->(undef) if defined($cb); + return; + } + + $cb->($data) if defined($cb); + }; + + $rtm_apicall_handles{$x} = 1; +} + +sub rtm_send { + my $frame = shift; + + $frame->{id} = $rtm_msg_id++; + print "RTM SEND: ", Dumper($frame); + $rtm_con->send(encode_json $frame); +} + +sub rtm_update_join { + my ($uid, $chid) = @_; + my $chan = $channels{$chid}; + my $user = $users{$uid}; + + if (!$chan->{Members}->{$uid}) { + $chan->{Members}->{$uid} = 1; + $user->{Channels}->{$chid} = 1; + return 1; + } + + return undef; +} + +sub rtm_update_part { + my ($uid, $chid) = @_; + my $chan = $channels{$chid}; + my $user = $users{$uid}; + + if ($chan->{Members}->{$uid}) { + delete $channels{$chid}->{Members}->{$uid}; + delete $users{$uid}->{Channels}->{$chid}; + return 1; + } + + return undef; +} + +sub rtm_update_user { + my $c = shift; + my $user; + + if (exists $users{$c->{id}}) { + $user = $users{$c->{id}}; + my $oldname = $user->{Name}; + delete $users_by_name{irc_lcase($oldname)}; + my $newname = irc_pick_name($c->{name}, \%users_by_name); + + $user->{Realname} = $c->{real_name}; + + irc_broadcast_nick $c->{id}, $newname + if $oldname ne $newname; + + $user->{Name} = $newname; + $user->{Presence} = $c->{presence} || 'active'; + $users_by_name{$newname} = $user; + } else { + my $name = irc_pick_name($c->{name}, \%users_by_name); + $user = { + Id => $c->{id}, + Name => $name, + Channels => {}, + Realname => $c->{real_name}, + TxQueue => [], + Presence => $c->{presence} || 'active' + }; + + $users{$c->{id}} = $user; + $users_by_name{$name} = $user; + } + + $user->{Realname} = "" unless defined($user->{Realname}); +} + +sub rtm_record_unknown_uid { + my $uid = shift; + + unless (exists $users{$uid}) { + # Temporary name + my $name = irc_pick_name($uid, \%users_by_name); + + my $u = { + Id => $uid, + Name => $name, + Channels => {}, + Realname => "", + TxQueue => [] + }; + + $users{$uid} = $u; + $users_by_name{irc_lcase($name)} = $u; + + rtm_apicall "users.info", { user => $uid }, sub { + my $data = shift; + + rtm_update_user $data->{user} if defined $data; + }; + } +} + +sub rtm_update_channel { + my ($type, $c) = @_; + + my $id = $c->{id}; + my $mhash = {}; + my $name = $c->{name}; + + $name = "+$name" if $type eq "G"; + + # Cross-reference users/channels + foreach my $u (@{$c->{members}}) { + rtm_record_unknown_uid $u; + $mhash->{$u} = 1; + $users{$u}->{Channels}->{$id} = 1; + } + + if (exists $channels{$id}) { + my $chan = $channels{$id}; + $chan->{Members} = $mhash; + $chan->{Topic} = $c->{topic}->{value}; + $chan->{Type} = $type; + } else { + my $name = irc_pick_name($name, \%channels_by_name); + my $chan = { + Id => $c->{id}, + Members => $mhash, + Name => $name, + Type => $type, + Topic => $c->{topic}->{value} + }; + + $channels{$c->{id}} = $chan; + $channels_by_name{irc_lcase($name)} = $chan; + } +} + +sub rtm_delete_channel { + my $chid = shift; + my $chan = $channels{$chid}; + return unless defined $chan; + + foreach ($chan->{Members}) { + my $user = $users{$_}; + + delete $user->{Channels}->{$chid}; + } + + delete $channels_by_name{irc_lcase($chan->{Name})}; + delete $channels{$chid}; +} + +sub rtm_mark_channel { + my ($chid, $ts) = @_; + + $rtm_mark_queue{$chid} = $ts; + + unless (defined $rtm_mark_timer) { + $rtm_mark_timer = AnyEvent->timer(after => 5, cb => sub { + for my $chid (keys %rtm_mark_queue ) { + rtm_apicall "channels.mark", { + channel => $chid, + ts => $rtm_mark_queue{$chid} + }; + } + %rtm_mark_queue = (); + undef $rtm_mark_timer; + }); + } +} + +my %rtm_command = ( + "presence_change" => sub { + my $msg = shift; + my $user = $users{$msg->{user}}; + + if (defined $user) { + my $old = $user->{Presence}; + $user->{Presence} = $msg->{presence} if defined $user; + irc_broadcast_away if + $msg->{user} eq $self_id and $old ne $msg->{presence}; + } + }, + "manual_presence_change" => sub { + my $msg = shift; + my $user = $users{$self_id}; + my $old = $user->{Presence}; + + $user->{Presence} = $msg->{presence}; + irc_broadcast_away if $old ne $msg->{presence}; + }, + "im_open" => sub { + my $msg = shift; + rtm_record_unknown_uid $msg->{user}; + + my $u = $users{$msg->{user}}; + $u->{DMId} = $msg->{channel}; + $users_by_dmid{$msg->{channel}} = $u; + + foreach my $msg (@{$u->{TxQueue}}) { + rtm_send { type => "message", + channel => $u->{DMId}, text => $msg }; + } + + $u->{TxQueue} = []; + }, + "im_close" => sub { + my $msg = shift; + my $u = $users_by_dmid{$msg->{channel}}; + return unless defined($u); + + delete $u->{DMId}; + delete $users_by_dmid{$msg->{channel}}; + }, + "group_joined" => sub { + my $msg = shift; + + rtm_update_channel "G", $msg->{channel}; + irc_broadcast_join $self_id, $msg->{channel}->{id}; + }, + "group_left" => sub { + my $msg = shift; + + irc_broadcast_part $self_id, $msg->{channel} + if rtm_update_part $self_id, $msg->{channel}; + }, + "group_archive" => sub { + my $msg = shift; + + irc_broadcast_part $self_id, $msg->{channel} + if rtm_update_part $self_id, $msg->{channel}; + rtm_delete_channel $msg->{channel}; + }, + "channel_joined" => sub { + my $msg = shift; + + rtm_update_channel "C", $msg->{channel}; + irc_broadcast_join $self_id, $msg->{channel}->{id}; + }, + "channel_left" => sub { + my $msg = shift; + + irc_broadcast_part $self_id, $msg->{channel} + if rtm_update_part $self_id, $msg->{channel}; + }, + "channel_archive" => sub { + my $msg = shift; + + irc_broadcast_part $self_id, $msg->{channel} + if rtm_update_part $self_id, $msg->{channel}; + rtm_delete_channel $msg->{channel}; + }, + "member_joined_channel" => sub { + my $msg = shift; + + rtm_record_unknown_uid $msg->{user}; + irc_broadcast_join $msg->{user}, $msg->{channel} + if rtm_update_join($msg->{user}, $msg->{channel}); + }, + "member_left_channel" => sub { + my $msg = shift; + + irc_broadcast_part $msg->{user}, $msg->{channel} + if rtm_update_part($msg->{user}, $msg->{channel}); + }, + "pong" => sub { + $rtm_ping_count = 0; + }, + "message" => sub { + my $msg = shift; + my $chan = $channels{$msg->{channel}}; + my $subtype = $msg->{subtype} || ""; + my $uid = $msg->{user} || $msg->{comment}->{user}; + my $text = $msg->{text}; + + $text = "" unless defined($text); + + if (defined($chan)) { + if ($subtype eq "channel_topic" or $subtype eq "group_topic") { + $chan->{Topic} = $msg->{topic}; + irc_topic_change $uid, $chan->{Id}; + } else { + irc_chanmsg $uid, $msg->{subtype}, $chan->{Id}, $text; + } + rtm_mark_channel $chan->{Id}, $msg->{ts}; + } else { + irc_privmsg $uid, $msg->{subtype}, $text; + } + + if ($subtype eq "file_share") { + my $fid = $msg->{file}->{id}; + rtm_apicall "files.info", { file => $fid }, sub { + my $data = shift; + return unless defined $data; + + my $body = $data->{content}; + return unless length($body) <= 65536; + + if (defined $chan) { + irc_chanmsg $uid, ">$fid", $chan->{Id}, $body; + } else { + irc_privmsg $uid, ">$fid", $body; + } + }; + } + }, +); + +sub rtm_send_to_user { + my ($id, $msg) = @_; + my $u = $users{$id}; + + if (defined($u->{DMId}) && length($u->{DMId})) { + rtm_send { type => "message", + channel => $u->{DMId}, text => $msg }; + return; + } + + push @{$u->{TxQueue}}, $msg; + + if (!defined($u->{DMId})) { + rtm_apicall "im.open", { user => $u->{Id} }, sub { + my $result = shift; + unless (defined $result) { + delete $u->{DMId}; + foreach my $m (@{$u->{TxQueue}}) { + irc_broadcast_notice "Failed to send to $u->{Name}: $m"; + } + $u->{TxQueue} = []; + } + }; + + $u->{DMId} = ""; + } +} + +sub rtm_start; + +sub rtm_cooldown { + return if defined($rtm_cooldown_timer); + print "Waiting before reinitiating RTM\n"; + $rtm_cooldown_timer = AnyEvent->timer(after => 5, cb => sub { + undef $rtm_cooldown_timer; + rtm_start; + }); +}; + +sub rtm_destroy { + my $msg = shift; + return unless defined($rtm_con); + + irc_broadcast_notice $msg; + + $connected = 0; + undef $self_id; + %channels = (); + %channels_by_name = (); + %users = (); + %users_by_name = (); + %users_by_dmid = (); + + %rtm_apicall_handles = (); # cancel outstanding requests + %rtm_mark_queue = (); + undef $rtm_mark_timer; + undef $rtm_ping_timer; + $rtm_con->close; + undef $rtm_con; + undef $rtm_client; + + irc_disconnect_all; + rtm_cooldown; +} + +sub rtm_ping { + if (++$rtm_ping_count >= 2) { + rtm_destroy "RTM ping timeout"; + return; + } + + rtm_send { type => "ping" }; + $rtm_ping_timer = AnyEvent->timer(after => 60, cb => \&rtm_ping); +} + +sub rtm_start_ws { + my $url = shift; + + return if defined($rtm_client); + $rtm_client = AnyEvent::WebSocket::Client->new; + + print "WSS URL: $url\n"; + $rtm_client->connect($url)->cb(sub { + $rtm_con = eval { shift->recv; }; + if ($@) { + irc_broadcast_notice "WSS connection failed: $@\n"; + undef $rtm_client; + rtm_cooldown; + } + + print "WSS connected\n"; + $rtm_msg_id = 1; + $rtm_ping_count = 0; + $connected = 1; + irc_check_welcome_all; + + $rtm_ping_timer = AnyEvent->timer(after => 60, cb => \&rtm_ping); + + $rtm_con->on(each_message => sub { + eval { + shift; + my $msg = decode_json shift->{body}; + + print "RTM RECV: ", Dumper($msg); + irc_broadcast_notice "RTM error: $msg->{error}->{msg}" + if $msg->{error}; + + if (defined $msg->{type}) { + my $handler = $rtm_command{$msg->{type}}; + $handler->($msg) if defined($handler); + } + }; + print "Error in message handler: $@" if $@; + }); + + $rtm_con->on(finish => sub { + eval { + my ($con) = @_; + + if (defined $con->close_error) { + rtm_destroy "RTM connection error: $con->close_error"; + } elsif (defined $con->close_reason) { + rtm_destroy "RTM connection closed: $con->close_reason"; + } else { + rtm_destroy "RTM connection finished"; + } + }; + print "Error in finish handler: $@" if $@; + }); + }); +}; + +sub rtm_start { + print "Requesting RTM connection\n"; + rtm_apicall "rtm.start", {}, sub { + my $data = shift; + + unless (defined($data)) { + rtm_cooldown; + return; + } + + $self_id = $data->{self}->{id}; + + foreach my $c (@{$data->{users}}) { + rtm_update_user $c; + } + + foreach my $c (@{$data->{ims}}) { + my $u = $users{$c->{user}}; + + $u->{DMId} = $c->{id}; + $users_by_dmid{$c->{id}} = $u; + } + + foreach my $c (@{$data->{channels}}) { + rtm_update_channel "C", $c unless $c->{is_archived}; + } + + foreach my $c (@{$data->{groups}}) { + rtm_update_channel "G", $c unless $c->{is_archived}; + } + + rtm_start_ws $data->{url}; + }; +}; + +######################################################################## +# RTM kick-off +######################################################################## + +my $cfgfile = shift || die "You must specify a config file"; +open(my $cfg, $cfgfile) || die "Can't open $cfgfile"; +foreach (<$cfg>) { + chomp; + $config{$1} = $2 if /^([-_0-9a-zA-Z]+)=(.*)$/; +} +close($cfg); + +rtm_start; +irc_listen; +AnyEvent->condvar->recv;