signalpoller

#!/usr/bin/perl -w
#
# Signal Poller for Hermod Gateway Bot.
#
# Keeping a tail on the tosignal file for messages to send to signal.
# Polling the signal group for new messages. These are send to telegram 
# and irc
#
# 2019, Ruben de Groot

use strict;
use JSON;
use TOML;
use WWW::Curl::Easy;
use WWW::Curl::Form;
use URI::Escape;
use DBI;
use Capture::Tiny 'tee';
use Hermod;
use Encode qw(decode_utf8);

open my $fh, '<', "/etc/hermod.toml" or die "error opening configuration $!";
my ($cfg, $e) = from_toml do { local $/; <$fh> };
unless ($cfg) {
    die "Error parsing toml: $e";
}

unless (defined $cfg->{signal}->{phone} and defined $cfg->{signal}->{cli} and
        defined $cfg->{signal}->{gid}) {
    print "Please define signal->phone, signal->cli and signal->gidi\n";
    print "Press <Ctrl>-C to continue\n";
    sleep; exit;
}

my $sig = $cfg->{signal};
$sig->{nicks} = getalias($sig);
$ENV{JAVA_HOME} = $sig->{JAVA_HOME} if defined $sig->{JAVA_HOME};
open my $dbg, ">>", $sig->{debug} if defined $sig->{debug};
my $tel = $cfg->{telegram} if defined $cfg->{telegram};
my $irc = $cfg->{irc} if defined $cfg->{irc};
my $mat = $cfg->{matrix} if defined $cfg->{matrix};
my $mm = $cfg->{mattermost} if defined $cfg->{mattermost};
my $dis = $cfg->{discord} if defined $cfg->{discord};

# tailing signal infile and telegram downloads for stuff to send
open my $tail, "<", $sig->{infile} or die @_;
my $inode = (stat($sig->{infile}))[1];
# SEEK_END
seek($tail, 0, 2) or die @_;
for (;;) {
    sleep 1; # not to get too tight loop

    # check if logfiles haven't turned over below our feet
    if ($inode != (stat($sig->{infile}))[1]) {
        close $tail;
        $inode = (stat($sig->{infile}))[1];
        open($tail,$sig->{infile}) or next;
    } else {
        # SEEK_CUR
        seek($tail, 0, 1);
    }

    # send new messages to signal group
    my $msg ='';
    while (my $line = <$tail>) {

        if ($line =~ /^FILE!/) {

            # send photo's, documents
            $line = substr $line,5;
            my ($fileinfo,$caption) = split / /, $line, 2; 
            my ($url,$mime,$file) = split /!/, $fileinfo;
            my ($out, $err, $ret) = tee {
                system($sig->{cli},"-u",$sig->{phone},"send","-g",$sig->{gid},
                        "-m","$caption","-a","$file");
            };
            print $dbg $out, $err if defined $dbg;
            notify($err) if $err;
        } else {
            $msg .= $line;
        }
    }
    if ($msg) {

        my $text = '';
        $text .= decode_utf8($msg, Encode::FB_QUIET) while $msg;

        my ($out, $err, $ret) = tee {
            system($sig->{cli},"-u",$sig->{phone},"send","-g", $sig->{gid}, "-m", "$text");
        };
        print $dbg $out, $err if defined $dbg;
        notify($err) if $err;
    }

    # now poll the signal group for new messages
    my $json = JSON->new->allow_nonref;
    my ($out, $err, $ret) = tee {
        system($sig->{cli},"-u",$sig->{phone},"--output=json","receive");
    };
    print $dbg $out, $err if defined $dbg;
    notify($err) if $err;

    my @lines = split /\n/, $out;
    for my $line (@lines) {

        my $sav;
        print $dbg $line if defined $dbg;

        my $sigmsg = $json->decode($line);
        next unless defined $sigmsg->{envelope}->{dataMessage};
        $sigmsg = $sigmsg->{envelope};
        my $datamsg = $sigmsg->{dataMessage};

        my $sender = (defined $sigmsg->{source}) ? $sigmsg->{source} : "";
        my $group = (defined $datamsg->{groupInfo}->{groupId}) ? $datamsg->{groupInfo}->{groupId} : "";
        my $attach = (defined $datamsg->{attachments}) ? $datamsg->{attachments} : undef;

        my $msg = (defined $datamsg->{message}) ? $datamsg->{message} : "";
        my $text = ''; $sav = $msg;
        eval { $text .= decode_utf8($msg, Encode::FB_QUIET) while $msg; };
        $text = $sav if $@; # try undecoded string as last resort

        # is the message a quote
        my $quote = "";
        if (defined $datamsg->{quote}{text}) {
            my $qtext = $datamsg->{quote}{text}; chomp $qtext;
            $qtext = (length($qtext) > 100) ? "(reply to ". substr($qtext,0,100) ."...) " : "(reply to: $qtext) ";
            $sav = $qtext;
            eval { $quote .= decode_utf8($qtext, Encode::FB_QUIET) while $qtext; };
            $quote = $sav if $@; # try undecoded string as last resort
        }

        # anonymize sender telephone
        my $anonsender = $sender;
        if (defined $sig->{nicks}->{$sender}) {

            $anonsender = $sig->{nicks}->{$sender};
        } else {

            $anonsender =~ s/.*(\d\d\d\d)$/$cfg->{common}->{anon}-$1/;
            $sig->{nicks}->{$sender} = $anonsender;
            nickhelp($sig,$sender,$anonsender);
            setalias($sig,$sender,$anonsender);
        }

        # check for setnick command
        if ($text =~ /^!setnick/) {
            (my $nick = $text) =~ s/^!setnick.//s;
            if ($nick) {
                setalias($sig,$sender,$nick);
                $sig->{nicks}->{$sender} = $nick;
                $text = "$anonsender is now known as $nick\n";

                # notify the signal group
                open my $w, ">>", $sig->{infile} or die "Died opening file $sig->{infile}";
                print $w "$text";
                close $w;

                $text = "[sig] $text";

                # notify chats
                Hermod::relayToFile($text, $_) for $irc->{infile};
                Hermod::relay2mtx($text,$mat,$dbg) if defined $mat;
                Hermod::relay2mm($text,$mm,$dbg) if defined $mm;
                Hermod::relay2dis($text,$dis,$dbg) if defined $dis;
                Hermod::relay2tel($tel,$text) if defined $tel;

                next;
            }
        } elsif ($text =~ /^!users/) {

            # user list asked; relay command to hermod
            Hermod::relayToFile("CMD!SIG!users\n", $irc->{infile});
            next;
        }

        # only relay group messages with contents
        next unless $group eq $sig->{gid};
        next unless $text or $attach;

        # dry-run
        next if defined $sig->{dryrun} and $sig->{dryrun};

        # relay to all chats
        my $pre = "[sig] $anonsender: ";
        if ($text =~ /\S/) {

            Hermod::relay2tel($tel,"$pre$quote$text\n",$dbg) if defined $tel;
            Hermod::relay2irc("$quote$text\n",$irc,$pre,$dbg) if defined $irc;
            Hermod::relay2mm("$pre$quote$text\n",$mm,$dbg) if defined $mm;
            Hermod::relay2mtx("$pre$quote$text\n",$mat,$dbg) if defined $mat;
            Hermod::relay2dis("$pre$quote$text\n",$dis,$dbg) if defined $dis;
        }

        # relay optional attachments
        foreach my $att (@$attach) {
            (my $ext = $att->{contentType}) =~ s#.*/##;
            rename "$sig->{attachments}/$att->{id}", "$sig->{attachments}/$att->{id}.$ext";
            my $type = ($att->{contentType} =~ /image/) ? 'photo' : 'document';

            my $filemsg = "FILE!$sig->{url}/$att->{id}.$ext!$att->{contentType}!$sig->{attachments}/$att->{id}.$ext [sig] $type by $anonsender\n";
            my $msg = "[sig] **$anonsender sends a $type: $sig->{url}/$att->{id}.$ext\n";

            # relay to telegram
            Hermod::relayFile2tel($filemsg,$tel,$type,$dbg) if defined $tel;

            # relay to Mattermost
            Hermod::relayFile2mm($filemsg,$mm,$dbg) if defined $mm;

            # relay to matrix
            Hermod::relay2mtx($msg,$mat,$dbg) if defined $mat;

            # relay to discord
            Hermod::relay2dis($msg,$dis,$dbg) if defined $dis;

            # relay to irc
            Hermod::relayToFile($msg, $_, $dbg) for $irc->{infile};
        }
    }
}

sub getalias {
    my $sig = shift;
    my $alias;
    my $dbh = DBI->connect("dbi:SQLite:dbname=$sig->{db}", "", "", { RaiseError => 1 }, ) or die $DBI::errstr;
    my $obj = $dbh->prepare("select * from alias");
    $obj->execute() or die $DBI::errstr;

    while (my $row = $obj->fetchrow_hashref()) {
        $alias->{$row->{phone}} = $row->{nick};
    }
    return $alias;
}

sub setalias {
    my ($sig,$phone,$nick) = @_;
    my $dbh = DBI->connect("dbi:SQLite:dbname=$sig->{db}", "", "", { RaiseError => 1 }, ) or die $DBI::errstr;
    $dbh->do("insert or replace into alias (phone,nick) values (?,?)", undef, $phone, $nick) or die $DBI::errstr;
    $dbh->disconnect();
}

sub nickhelp {
    my ($sig,$phone,$nick) = @_;
    my $text = 'You do not have a nickname set. You are now known as '.$nick;
    $text .= '. To change this, simply type !setnick yournickname on a new line in the group or in a private message to me.';
    my ($out, $err, $ret) = tee {
        system($sig->{cli},"-u",$sig->{phone},"send","-m","$text",$phone);
    };
    print $dbg $out, $err if defined $dbg;
    notify($err) if $err;
}

sub notify {
    my $err = shift;
    my $msg = '';
    my $hostname = qx( hostname ); chomp $hostname;

    # filters here
    if ($err =~ /Failed to send \(some\) messages:/) {
        while ($err =~ /Untrusted Identity for "(\+[\d]+)"/g) {
            unless (defined $sig->{unreg}->{$1}) {
                $sig->{unreg}->{$1} = 1;
                $msg .= " $1";
            }
        }
        $msg = "Untrusted users: $msg\n" if $msg;
    } else {
        $msg = $err;
    }

    # notify daily on errors
    return if defined $sig->{errors}->{$msg} and $sig->{errors}->{$msg} > time - 86400;
    $sig->{errors}->{$msg} = time;

    qx( $cfg->{common}->{notify} "Signalpoller on $hostname: $msg" ) if defined $cfg->{common}->{notify} and $msg;
}