#!/usr/bin/perl -w
# slirc.pl: local Slack IRC gateway
-# Copyright (C) 2017 Daniel Beer <dlbeer@gmail.com>
+# Copyright (C) 2017-2019 Daniel Beer <dlbeer@gmail.com>
+# Amendments 2021 by Ralph Ronnquist <ralph.ronnquist@gmail.com>
#
# Permission to use, copy, modify, and/or distribute this software for any
# purpose with or without fee is hereby granted, provided that the above
# by Colin Watson <cjwatson@chiark.greenend.org.uk>. To use this feature
# with an IRC client supporting Unix domain connections, add the line
# "unix_socket=<path>" to the config file.
+#
+# Updated 2019-02-18:
+# - HTML entities are now escaped/unescaped properly
+# - Channel IDs are translated with the correct sigil
+# - You can now close accumulated group chats. This is mapped to
+# JOIN/PART (the behaviour of JOIN/PART for public channels is
+# unaffected)
+# - IRC-side PING checks are now more lenient, to work around bugs in
+# some IRC clients
+# - Added X commands for debug dumps and dynamically switching protocol
+# debug on/off
+#
+# Updated 2019-05-08 based on changes from Neia Finch to improve
+# support for bots.
+#
+# Updated 2021-08-30 for Slack API changes.
use strict;
use warnings;
use AnyEvent::WebSocket::Client;
use URI::Encode qw(uri_encode);
use Data::Dumper;
+use Time::localtime;
use Digest::SHA qw(sha256);
use JSON;
-my $VERSION = "20171127";
+my $VERSION = "20210830";
my $start_time = time();
my %config;
+$| = 1;
+
########################################################################
# 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 $self_id; # Slack ID of our own user, or undef
my %channels; # Slack ID -> channel hash ref
my %channels_by_name; # irc_lcase -> channel hash ref
for (;;) {
my $prop = "$name$i";
- return $prop unless !defined($hash->{irc_lcase($prop)});
+ return $prop unless defined($hash->{irc_lcase($prop)});
$i++;
}
}
sub rtm_apicall;
sub rtm_download;
sub rtm_destroy;
+sub rtm_update_join;
+sub rtm_update_part;
my %irc_clients;
}
my $line = join(' ', @arg);
- print "IRC $c->{Handle} SEND: $line\n";
+ print "IRC $c->{Handle} SEND: $line\n" if $config{debug_dump};
$c->{Handle}->push_write("$line\r\n");
}
}
}
+sub irc_send_motd {
+ my $c = shift;
+ my @banner =
+ (
+ ' _ _ _',
+ ' ___| (_)_ __ ___ _ __ | |',
+ '/ __| | | \'__/ __| | \'_ \| |',
+ '\__ \ | | | | (__ _| |_) | |',
+ '|___/_|_|_| \___(_) .__/|_|',
+ ' |_|',
+ 'slirc.pl, Copyright (C) 2017-2019 Daniel Beer <dlbeer@gmail.com>'
+ );
+
+ for my $x (@banner) {
+ irc_send_num $c, 372, [], $x;
+ }
+ irc_send_num $c, 376, [], "End of /MOTD command";
+}
+
sub irc_check_welcome {
my $c = shift;
return;
}
- irc_send_num $c, 001, [], "slirc.pl version $VERSION";
- irc_send_num $c, 002, [],
- "Copyright (C) 2017 Daniel Beer <dlbeer\@gmail.com>";
- irc_send_num $c, 003, [], `uptime`;
+ my $lt = localtime($start_time);
+
+ irc_send_num $c, 001, [], "slirc.pl IRC-to-Slack gateway";
+ irc_send_num $c, 002, [], "This is slirc.pl version $VERSION";
+ irc_send_num $c, 003, [], "Server started " . ctime($start_time);
+ irc_send_motd $c;
$c->{Ready} = 1;
my $user = $users{$self_id};
}
my %gateway_command = (
+ "debug_dump_state" => sub {
+ my $c = shift;
+ irc_gateway_notice $c, "Dumping debug state on stdout";
+ print Dumper({ "connected" => $connected,
+ "self_id", => $self_id,
+ "%channels" => \%channels,
+ "%channels_by_name" => \%channels_by_name,
+ "users" => \%users,
+ "users_by_name" => \%users_by_name,
+ "users_by_dmid" => \%users_by_dmid
+ });
+ },
+ "debug_dump" => sub {
+ my ($c, $arg) = @_;
+ $config{debug_dump} = $arg ? 1 : 0 if defined $arg;
+ irc_gateway_notice $c, "Protocol debug is " .
+ ($config{debug_dump} ? "on" : "off");
+ },
"newgroup" => sub {
my ($c, $name) = @_;
unless (defined($name)) {
"cat" => sub {
my ($c, $fileid) = @_;
unless (defined($fileid)) {
- irc_gateway_notice $c, "Syntax: catfile <fileid> <filename>";
+ irc_gateway_notice $c, "Syntax: cat <fileid> <filename>";
return;
}
},
"JOIN" => sub {
my ($c, $name) = @_;
+ print "JOIN $name\n";
return unless $c->{Ready};
return unless defined($name);
} elsif ($chan->{Members}->{$self_id}) {
# Already joined
} elsif ($chan->{Type} eq "G") {
- irc_send_num $c, 473, ["#$n"],
- "<channel> :Cannot join channel (+i)";
+ rtm_apicall "groups.open", { channel => $chan->{Id} };
+ irc_broadcast_join $self_id, $chan->{Id}
+ if rtm_update_join $self_id, $chan->{Id};
} else {
- rtm_apicall "channels.join", { channel => $chan->{Id} };
+ #rtm_apicall "channels.join", { channel => $chan->{Id} };
+ rtm_apicall "conversations.join", { channel => $chan->{Id} };
}
}
},
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} };
+ if ($chan->{Type} eq "G") {
+ rtm_apicall "groups.close", { channel => $chan->{Id} };
+ irc_broadcast_part $self_id, $chan->{Id}
+ if rtm_update_part $self_id, $chan->{Id};
+ } else {
+ #rtm_apicall "channels.leave", { channel => $chan->{Id} };
+ rtm_apicall "conersations.leave", { channel => $chan->{Id} };
+ }
}
}
},
$name = "*" unless defined($name);
irc_send_num $c, 315, [$name], "End of /WHO list";
},
+ "MOTD" => sub {
+ my $c = shift;
+ irc_send_motd $c;
+ },
"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;
+ $msg =~ s/&/&/g;
+ $msg =~ s/</</g;
+ $msg =~ s/>/>/g;
+ $msg =~ s/"/"/g;
+ $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 $translate = $text;
$translate =~ s/<@([^>]+)>/'<@' . irc_id_to_name($c, $1) . '>'/eg;
- $translate =~ s/<#([^>]+)>/'<@' . irc_id_to_chan($c, $1) . '>'/eg;
+ $translate =~ s/<#([^>]+)>/'<#' . irc_id_to_chan($c, $1) . '>'/eg;
+ $translate =~ s/</</g;
+ $translate =~ s/>/>/g;
+ $translate =~ s/"/"/g;
+ $translate =~ s/&/&/g;
for my $line (split(/\n/, $translate)) {
irc_send_from $c, $srcid, ["PRIVMSG", $dstname], "$prefix$line";
sub irc_ping {
my $c = shift;
- if (++$c->{PingCount} >= 2) {
+ if (++$c->{PingCount} >= 3) {
irc_disconnect $c, "Ping timeout";
return;
}
sub irc_line {
my ($c, $fh, $line, $eol) = @_;
- print "IRC $fh RECV: $line\n";
+ print "IRC $fh RECV: $line\n" if $config{debug_dump};
utf8::decode($line);
my ($method, $args, $cb) = @_;
my @encode;
- print "RTM APICALL $method ", Dumper($args);
+ print "RTM APICALL $method ", Dumper($args) if $config{debug_dump};
$args->{token} = $config{slack_token};
my $data = decode_json $body;
- print "RTM REPLY $method ", Dumper($data);
+ print "RTM REPLY $method ", Dumper($data) if $config{debug_dump};
unless ($data->{ok}) {
irc_broadcast_notice "API error: $data->{error}";
my $frame = shift;
$frame->{id} = $rtm_msg_id++;
- print "RTM SEND: ", Dumper($frame);
+ print "RTM SEND: ", Dumper($frame) if $config{debug_dump};
$rtm_con->send(encode_json $frame);
}
delete $users_by_name{irc_lcase($oldname)};
my $newname = irc_pick_name($c->{name}, \%users_by_name);
- $user->{Realname} = $c->{real_name};
+ $user->{Realname} = $c->{real_name} // $c->{name};
irc_broadcast_nick $c->{id}, $newname
if $oldname ne $newname;
$user->{Name} = $newname;
- $user->{Presence} = $c->{presence} || 'active';
+ $user->{Presence} = $c->{presence} // 'active';
$users_by_name{$newname} = $user;
} else {
my $name = irc_pick_name($c->{name}, \%users_by_name);
Id => $c->{id},
Name => $name,
Channels => {},
- Realname => $c->{real_name},
+ Realname => $c->{real_name} // $c->{name},
TxQueue => [],
- Presence => $c->{presence} || 'active'
+ Presence => $c->{presence} // 'active'
};
$users{$c->{id}} = $user;
sub rtm_update_channel {
my ($type, $c) = @_;
-
my $id = $c->{id};
- my $mhash = {};
- my $name = $c->{name};
- $name = "+$name" if $type eq "G";
+ rtm_apicall "conversations.members", { channel => $id }, sub {
- # Cross-reference users/channels
- foreach my $u (@{$c->{members}}) {
- rtm_record_unknown_uid $u;
- $mhash->{$u} = 1;
- $users{$u}->{Channels}->{$id} = 1;
- }
+ my $id = $c->{id};
+ my $data = shift;
+ my $mhash = {};
+ my $name = $c->{name};
- 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}
- };
+ $c->{members} = $data->{'members'};
- $channels{$c->{id}} = $chan;
- $channels_by_name{irc_lcase($name)} = $chan;
- }
+ $name = "+$name" if $type eq "G";
+
+ # Cross-reference users/channels
+ foreach my $u (@{$c->{members}}) {
+ rtm_record_unknown_uid $u;
+ # Filter ourselves out of the membership list if this is a
+ # closed group chat.
+ next if $type eq 'G' && $u eq $self_id && !$c->{is_open};
+ $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 {
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", {
+ rtm_apicall "conversations.mark", {
channel => $chid,
ts => $rtm_mark_queue{$chid}
};
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);
+ my $uid = $msg->{user} || $msg->{comment}->{user} || $msg->{bot_id};
+ my $text = $msg->{text} // '';
+
+ if (defined($msg->{attachments})) {
+ my $attext = join '\n', map {
+ ($_->{title} or "")
+ . " " . ($_->{text} or "")
+ . " " . ($_->{title_link} or "") } @{$msg->{attachments}};
+ $text .= "\n" unless length($text);
+ $text .= $attext;
+ }
if (defined($chan)) {
if ($subtype eq "channel_topic" or $subtype eq "group_topic") {
return if defined($rtm_client);
$rtm_client = AnyEvent::WebSocket::Client->new;
- print "WSS URL: $url\n";
+ print "WSS URL: $url\n" if $config{debug_dump};
$rtm_client->connect($url)->cb(sub {
$rtm_con = eval { shift->recv; };
if ($@) {
shift;
my $msg = decode_json shift->{body};
- print "RTM RECV: ", Dumper($msg);
+ print "RTM RECV: ", Dumper($msg) if $config{debug_dump};
irc_broadcast_notice "RTM error: $msg->{error}->{msg}"
if $msg->{error};
rtm_update_channel "C", $c unless $c->{is_archived};
}
+ foreach my $c (@{$data->{bots}}) {
+ rtm_update_user $c;
+ my $n = $c->{id};
+ }
+
foreach my $c (@{$data->{groups}}) {
rtm_update_channel "G", $c unless $c->{is_archived};
}