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 HTTP::Tiny;
use HTTP::Request::Common;
use LWP::UserAgent;
use URI::Escape;
use Text::Unidecode;
use DBI;

open my $fh, '<', "/etc/hermod.json" or die "error opening configuration $!";
my $cfg = decode_json do { local $/; <$fh> };
$cfg->{nicks} = getalias($cfg);

open my $tail, "<", $cfg->{signal}->{infile} or die @_;
my $inode = (stat($cfg->{signal}->{infile}))[1];

open my $debug, ">>", $cfg->{signal}->{debug} if defined $cfg->{signal}->{debug};

# SEEK_END
seek($tail, 0, 2) or die @_;

# tailing signal infile and telegram downloads for stuff to send
for (;;) {
    sleep 1; # not to get too tight loop
    # check if logfiles haven't turned over below our feet
    if ($inode != (stat($cfg->{signal}->{infile}))[1]) {
        close $tail;
        $inode = (stat($cfg->{signal}->{infile}))[1];
        open($tail,$cfg->{signal}->{infile}) or next;
    } else {
        # SEEK_CUR
        seek($tail, 0, 1);
    }

    # send new messages to signal group
    my $telsend ='';
    while (my $line = <$tail>) {
        if ($line =~ /^FILE:/) {
            # send photo's, documents
            $line = substr $line,5;
            my ($file,$caption) = split / /, $line, 2; 
            qx( $cfg->{signal}->{cli} -u $cfg->{signal}->{phone} send -g $cfg->{signal}->{gid} -m "$caption" -a $cfg->{telegram}->{attachments}/$file );
        } else {
            $telsend .= $line."\n";
        }
    }
    if ($telsend) {
        open my $sc, "|-", $cfg->{signal}->{cli}, "-u", $cfg->{signal}->{phone}, "send", "-g", $cfg->{signal}->{gid};
        print $sc $telsend;
        close $sc;
    }

    # now poll the signal group for new messages
    my $json = JSON->new->allow_nonref;
    my @lines = qx( $cfg->{signal}->{cli} -u $cfg->{signal}->{phone} receive --json );
    for my $line (@lines) {
        print $debug $line if defined $cfg->{signal}->{debug};
        print $line; chomp $line;
        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 $text = (defined $datamsg->{message}) ? $datamsg->{message} : "";
        my $attach = (defined $datamsg->{attachments}) ? $datamsg->{attachments} : undef;

        # anonymize sender telephone
        my $anonsender = $sender;
        if (defined $cfg->{nicks}->{$sender}) {
            $anonsender = $cfg->{nicks}->{$sender};
        } else {
            $anonsender =~ s/.*(\d\d\d\d)$/Piraat-$1/;
            nickhelp($cfg,$sender,$anonsender);
            setalias($cfg,$sender,$anonsender);
        }

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

                # notify all chats
                open my $w, ">>", $cfg->{signal}->{infile} or die "Died opening file $cfg->{signal}->{infile}";
                print $w "$text";
                close $w;

                open $w, ">>", $cfg->{irc}->{infile} or die "Died opening irc infile $cfg->{signal}->{file}";
                print $w "[Sg] $text";
                close $w;

                my $URL = "https://api.telegram.org/bot$cfg->{telegram}->{token}/sendMessage?chat_id=$cfg->{telegram}->{chat_id}&text=";
                my $telmsg = uri_escape_utf8("[Sg] $text");
                my $response = HTTP::Tiny->new->get( "$URL$telmsg" );
                print "$response->{status} $response->{reason}\n";

                next;
            }
        }

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

        # relay to telegram
        my $telmsg;
        my $URL = "https://api.telegram.org/bot$cfg->{telegram}->{token}/sendMessage?chat_id=$cfg->{telegram}->{chat_id}&text=";
        eval { $telmsg = uri_escape("[Sg] $anonsender: $text"); };
        $telmsg = uri_escape_utf8("[Sg] $anonsender: $text") if $@;
        my $response = HTTP::Tiny->new->get( "$URL$telmsg" );
        print "$response->{status} $response->{reason}\n";

        # relay to IRC
        #$text = unidecode($text);
        my @lines = split /\n/, $text;
        open my $w, ">>", $cfg->{irc}->{infile} or die "Died opening irc infile $cfg->{irc}->{infile}";
        foreach my $line (@lines) {
            print $w "[Sg] $anonsender: $line\n" if $line;
        }
        close $w;

        # relay optional attachments
        foreach my $att (@$attach) {
            (my $ext = $att->{contentType}) =~ s#.*/##;
            my ($msg, $URL, $type);
            my $ua = LWP::UserAgent->new;
            rename "$cfg->{signal}->{attachments}/$att->{id}", "$cfg->{signal}->{attachments}/$att->{id}.$ext";
            if ($att->{contentType} =~ /image/) {
                $URL = "https://api.telegram.org/bot$cfg->{telegram}->{token}/sendPhoto";
                $type = 'photo';
                $msg = "[Sg] **$anonsender sends an image: $cfg->{signal}->{url}/$att->{id}.$ext\n";
            } else {
                $URL = "https://api.telegram.org/bot$cfg->{telegram}->{token}/sendDocument";
                $type = 'document';
                $msg = "[Sg] **$anonsender sends a document: $cfg->{signal}->{url}/$att->{id}.$ext\n";
            }
            $ua->post($URL, Content_Type => 'form-data',
                                 Content => { $type => ["$cfg->{signal}->{attachments}/$att->{id}.$ext"],
                                              chat_id => $cfg->{telegram}->{chat_id},
                                              caption => "[Sg $ext $type send by $anonsender]"},);
            open $w, ">>", $cfg->{irc}->{infile} or die "Died opening irc infile $cfg->{irc}->{infile}";
            print $w $msg;
            close $w;
        }
        close $w;
    }
}

sub getalias {
    my $cfg = shift;
    my $alias;
    my $dbh = DBI->connect("dbi:SQLite:dbname=$cfg->{signal}->{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 ($cfg,$phone,$nick) = @_;
    my $dbh = DBI->connect("dbi:SQLite:dbname=$cfg->{signal}->{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 ($cfg,$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 = qx( $cfg->{signal}->{cli} -u $cfg->{signal}->{phone} send -m "$text" $phone );
    print $debug $out if defined $cfg->{signal}->{debug};
}