telegramhook

#!/usr/bin/perl -w
#
# Webhook for Hermod Telegram Gateway Bot. The hook can be set by the command:
#
# curl -F "url=https://webserver/cgi-bin/telehook" https://api.telegram.org/bot$TOKEN/setWebhook
#
# messages are filtered a little and then relayed to other channels
#
# 2019, Ruben de Groot

use strict;
use CGI::Fast qw/:standard/;
use JSON;
use TOML;
use Text::Unidecode;
use DBI;
use Hermod;

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->{telegram}->{token} and defined $cfg->{telegram}->{chat_id}) {
    print CGI->header(-type => 'application/json');
    print '{"ok": false, "status": 500, "error": "token or chat_id undefined"}'."\n\n";
    exit;
}
my $tel = $cfg->{telegram};
open my $dbg, ">>:utf8", $tel->{debug} if defined $tel->{debug};

my $irc = $cfg->{irc} if defined $cfg->{irc};
my $mat = $cfg->{matrix} if defined $cfg->{matrix};
my $sig = $cfg->{signal} if defined $cfg->{signal};
my $mm = $cfg->{mattermost} if defined $cfg->{mattermost};
my $dis = $cfg->{discord} if defined $cfg->{discord};

while (my $cgi = CGI::Fast->new) {
    my $body = (defined $cgi->param('POSTDATA')) ? $cgi->param('POSTDATA') : '{}';
    my $dj = decode_json( $body );
    
    print $dbg "$body\n" if defined $dbg;
    
    # check type of msg and chat_id
    if (defined $dj->{message}->{chat}->{id} and $dj->{message}->{chat}->{id} == $tel->{chat_id}) {

        my ($fline,$ircfline);
        my $msg = $dj->{message};
        my $user_id = (defined $msg->{from}->{id} and $msg->{from}->{id} =~ /^\d+$/) ?
            $dj->{'message'}->{'from'}->{id} : 0;
        my $text = (defined $msg->{text}) ? $msg->{text} : "";
        my $first = (defined $msg->{from}->{first_name}) ? $msg->{from}->{first_name} : "";
        my $last = (defined $msg->{from}->{last_name}) ? $msg->{from}->{last_name} : "";
        my $caption = (defined $msg->{caption}) ? $msg->{caption} : "";
        
        # look for photo's and documents
        my ($type,$doc,$mime);
        if (defined $msg->{photo}) {
            $doc = @{$msg->{photo}}[-1];
            $type = 'photo';
            $mime = 'image';
        }
        foreach my $t ('voice', 'audio', 'document', 'video') { 
            if (defined $msg->{$t}) {
                $doc = $msg->{$t};
                $type = $t;
            }
        }
        
        if (defined $doc->{file_id}) {

            # download the file
            my $response = qx( curl -s "https://api.telegram.org/bot$tel->{token}/getFile?file_id=$doc->{file_id}" );
            print $dbg "$response\n" if defined $dbg;
            eval {
                my $djfile = decode_json( $response );
                my $path = $djfile->{result}->{file_path};
                (my $file = $path) =~ s#.*/##;
                (my $ext = $file) =~ s#.*\.##;

                # hack mime-type
                $ext = "jpeg" if $ext =~ /^jpg/i;
                $mime = (defined $doc->{mime_type}) ? $doc->{mime_type} : "$mime/$ext";

                my $name = (defined $doc->{file_name}) ? $doc->{file_name} : $file;
                qx( wget -O $tel->{attachments}/$file https://api.telegram.org/file/bot$tel->{token}/$path >/dev/null 2>&1 );
                if ($? == 0) {

                    $fline = "FILE!$tel->{url}!$mime!$tel->{attachments}/$file [tel] $first $last";
                    $fline .= ": $caption" if $caption;
                    $ircfline = "** sends $type: $tel->{url}/$file";
                    $ircfline .= " with caption: $caption" if $caption;
                } else {
                    print $dbg "Error getting $type $name $file\n" if defined $dbg;
                }
            };
        }

        # is the message a poll?
        if (defined $msg->{poll}) {

            my $p = $msg->{poll};
            $text .= "\n" if $text;
            $text .= "Poll: $p->{question}\n";
            my $i;
            for my $o (@{$p->{options}}) {
                $text .= ++$i.") $o->{text}\n";
            }
        }

        # is the message a sticker?
        if (defined $msg->{sticker}) {
            my $sticknam = (defined $msg->{sticker}->{set_name}) ? $msg->{sticker}->{set_name} : '';
            $text .= "\n" if $text;
            $text .= "sends a $sticknam sticker ";
            $text .= $msg->{sticker}->{emoji} if defined $msg->{sticker}->{emoji};
        }
        
        # is the message a reply?
        $text = "(reply to: $msg->{reply_to_message}->{text}) \n" . $text if defined $msg->{reply_to_message} and
            $msg->{reply_to_message}->{text};

        # is the message a forward?
        if (defined $msg->{forward_from_chat}->{id} or defined $msg->{forward_from}->{id}) {
            my $forw_id = (defined $msg->{forward_from}->{id}) ? $msg->{forward_from}->{id} :
                $msg->{forward_from_chat}->{id};

            my $title = (defined $msg->{forward_from}->{title}) ? $msg->{forward_from}->{title} :
                (defined $msg->{forward_from_chat}->{title}) ? $msg->{forward_from_chat}->{title} :
                (defined $msg->{forward_from}->{first_name}) ? $msg->{forward_from}->{first_name} :
                (defined $msg->{forward_from_chat}->{first_name}) ? $msg->{forward_from_chat}->{first_name} : "Forward";
            $title = $msg->{forward_from_chat}->{first_name} unless $title;

            $text = "[Fwd from $title]: ";
            $text .= ($msg->{text}) ? "$msg->{text}\n" : "\n";
            if ($ircfline) {
                $ircfline =~ s/\*\* sends //;
            }
        }

        # is the message a channel post?
        
        # look for new chat members
        if (defined $msg->{new_chat_members}) {
            my $members = '';
            foreach my $m (@{$msg->{new_chat_members}}) {
                $members .= ', ' if $members;
                $members .= "$m->{first_name}";
                $members .= " $m->{last_name}" if $m->{last_name};
            }
            $text = "[tel] $members joined the chat\n";

            # relay to all chats
            Hermod::relay2irc($text,$irc,"",$dbg);
            Hermod::relay2mtx($text,$mat,$dbg);
            Hermod::relay2mm($text,$mm,$dbg);
            Hermod::relay2dis($text,$dis,$dbg);
            Hermod::relayToFile($text,$sig->{infile},$dbg) if defined $sig->{infile};
            ok("New member(s): $members\n");
            next;
        }
        
        # look for leaving chat members
        if (defined $msg->{left_chat_member}->{id}) {
            $text = "[tel] $msg->{left_chat_member}->{first_name} left the chat\n";

            # relay to all chats
            Hermod::relay2irc($text,$irc,"",$dbg);
            Hermod::relay2mtx($text,$mat,$dbg);
            Hermod::relay2mm($text,$mm,$dbg);
            Hermod::relay2dis($text,$dis,$dbg);
            Hermod::relayToFile($text,$sig->{infile},$dbg) if defined $sig->{infile};
            ok("Leaving member: $msg->{left_chat_member}->{first_name}\n");
            next;
        }

        # optional append file link url
        my $ftext = ($ircfline) ? "$text $ircfline" : $text;
        my $pre = ($text =~ /^[`!]/) ? "" : "[tel] $first $last: ";

        Hermod::relay2irc("$ftext\n",$irc,$pre,$dbg);
        Hermod::relay2mtx("$pre$ftext\n",$mat,$dbg);
        Hermod::relay2dis("$pre$ftext\n",$dis,$dbg);

        # for signal, mattermost we skip document, photo links as they are uploaded
        if ($text !~ /\*\* sends /) {
            Hermod::relayToFile("$pre$text\n",$sig->{infile},$dbg) if $text !~ /\*\* sends /;
            Hermod::relay2mm("$pre$text\n",$mm,$dbg) if $text !~ /\*\* sends /;
        }

        # print file line to signal for uploading. same for mattermost when there is a token
        if ($fline) {

            Hermod::relayToFile("$fline\n",$sig->{infile},$dbg);
            (defined $mm->{bearer}) ?
                Hermod::relayFile2mm($fline,$mm,$dbg) :
                Hermod::relay2mm("$pre$ftext",$mm,$dbg);
        }
    }
    ok();
}

sub ok {
    my $msg = shift;
    print $dbg $msg if defined $msg and defined $dbg;
    print CGI->header(-type => 'application/json');
    print '{"ok": true, "status": 200}'."\n\n";
}