#!/usr/local/bin/perl5.8.0
###############################################################################
#                                                                             #
#  abusemail:  Automatically construct our standard "kill this a**hole        #
#              spammer" message to be sent to the appropriate abuse address.  #
#              The invoker still have to provide the abuse address in         #
#              question.  And the message is fed into an interactive mutt     #
#              session, so that we can verify that it looks sane and is       #
#              addressed to the correct person.                               #
#                                                                             #
#                                                                             #
#  Written 5 March 2003 by Greg Pratt <gp@panix.com>.                         #
#                                                                             #
#  Version 1.0.0:  Initial release.                                           #
#  (05-Mar-2003)                                                              #
#                                                                             #
#  Version 1.0.1:  Added code to truncate long subject lines, which should    #
#  (31-Dec-2003)   have been in the original release.  This prevents UCE      #
#                  reports with headers that are just as stupid-looking as    #
#                  the originals.                                             #
#  Version 1.0.2:  Added code to remove control characters from subject       #
#  (19-Jan-2004)   lines.  I thought mutt would encode them, but apparently   #
#                  it only does this for 0x80-0xFF.  What is anyone doing     #
#                  putting control characters in a mail header, anyway?       #
#                  (Oh, yeah.  People dumb enough to be spammers...)          #
#  Version 1.0.3:  Made header line matching case-insensitive after noticing  #
#  (09-Mar-2005)   some "Subject" lines weren't being picked up.  Normal      #
#                  e-mail software generates "Subject", but spam and other    #
#                  forgeries sometimes use all uppercase or lowercase.  This  #
#                  is syntactically legal, so our code needs to be able to    #
#                  handle this.                                               #
#  Version 1.0.4:  Added translations for Dutch, Greek, Russian, Korean,      #
#  (24-Sep-2005)   Japanese, Chinese (Simplified), Finnish, Swedish, and      #
#                  Polish.  Removed calls to Text::Wrap::wrap(), as it is     #
#                  clearly working with bytes, not characters.  (This can     #
#                  potentially break UTF multi-byte character strings!)       #
#                  Also put hard line wraps into the %warning_text strings    #
#                  so that the output still gets the proper line breaks.      #
#                                                                             #
###############################################################################
use strict ;
#use Text::Wrap ;
use Getopt::Std ;
use locale ;

my $tmpdir = "/var/tmp" ;
my $mutt = "/usr/local/bin/mutt" ;

my $max_subject_len = 80 ;

#$Text::Wrap::columns = 73 ;             # wrap our warning messages after 72 columns
#$Text::Wrap::huge = 'wrap' ;
#$Text::Wrap::unexpand = 0 ;             # do NOT turn spaces into tabs!

my $mailbox_atoms = '-A-Za-z0-9!#$%&\'*+\/=?^_`{|}~' ;
my $mailbox_dot_atoms = $mailbox_atoms . '.' ;

my %command_opts ;
my $interactive_flag ;
my @orig_message ;
my @orig_header ;
my $i ;                                 # generic index array
my @warning_block ;
my @message ;                           # the constructed message to send
my @languages ;
my $spammer_subject ;
my $spammer_from ;
my $tmpfile_path ;
my $recipient ;
my $deathcode ;

my %warning_text = (
    "en", "I received a message with the attached headers from a user of your\n"
            . "network.  WE DO NOT ACCEPT UNSOLICITED COMMERCIAL E-MAIL IN ANY "
            . "FORM.\nPlease take the necessary steps to terminate this user.",
    "es", "Recibí un mensaje con los jefes unidos de un usuario de su network. "
            . " NO\nACEPTAMOS E-MAIL COMERCIAL NO SOLICITADO EN NINGUNA FORMA. "
            . " Tome por\nfavor las medidas necesarias para terminar a este "
            . "usuario.",
    "pt", "Eu recebi uma mensagem com cabeçalhos anexados provenientes de um\n"
            . "usuário vinculado à sua rede.  NÓS NÃO ACEITAMOS MENSAGENS "
            . "ELETRÔNICAS\nCOMERCIAIS DE NENHUMA FORMA.  Por favor tome as "
            . "medidas necessárias para\ncancelar a conta deste usuário.",
    "br", "Eu recebi uma mensagem com cabeçalhos anexados provenientes de um\n"
            . "usuário vinculado à sua rede.  NÓS NÃO ACEITAMOS MENSAGENS "
            . "ELETRÔNICAS\nCOMERCIAIS DE NENHUMA FORMA.  Por favor tome as "
            . "medidas necessárias para\ncancelar a conta deste usuário.",
    "fr", "J'ai reçu d'un utilisateur de votre réseau un message comportant "
            . "les\nen-têtes joints ci-dessous.  NOUS N'ACCEPTONS AUCUN E-MAIL "
            . "COMMERCIAL\nNON SOLLICITÉ SOUS QUELQUE FORME QUE CE SOIT.  "
            . "Veuillez prendre les\nmesures nécessaires pour supprimer cet "
            . "utilisateur.",
    "de", "Ich empfing eine Anzeige mit den angebrachten Überschriften von "
            . "einem\nBenutzer Ihres Netzes.  WIR NEHMEN NICHT FREIWILLIGE "
            . "KOMMERZIELLE E-MAIL\nIN IRGENDEINER FORM An.  Unternehmen Sie "
            . "bitte die notwendigen Schritte,\num diesen Benutzer zu beenden.",
    "it", "Ho ricevuto un messaggio con le intestazioni fissate da un utente "
            . "della\nvostra rete.  NON ACCETTIAMO Il E-MAIL COMMERCIALE "
            . "UNSOLICITED In ALCUNA\nFORMA.  Prenda prego le misure "
            . "necessarie per terminare questo utente.",
    "fi", "Olen saanut viestin, jonka otsikkotiedot ovat alla, joltakin "
            . "verkkonne\nkäyttäjältä.  Emme ota vastaan ei-toivottua "
            . "kaupallista sähköpostia\nmissään muodossa.  Olkaa hyvä ja "
            . "sulkekaa käyttäjä verkostanne.",
    "se", "Jag har fått ett meddelande med \"headers\" enligt nedan från en "
            . "användare\ni ert nätverk.  Vi accepterar inte någon icke "
            . "begärd kommersiell e-post.\nVänligen stäng av användaren från "
            . "ert nätverk.",
    "nl", "Ik ontving een bericht met headers in bijlage van een gebruiker van "
            . "uw\nnetwerk.  WIJ KEUREN ONGEVRAAGDE COMMERCIËLE E-MAIL IN GEEN "
            . "VORM GOED.\nGelieve te treffen de noodzakelijke maatregelen om "
            . "deze gebruiker te\neindigen.",
    "pl", "Otrzymałem od użytkownika Waszej sieci wiadomość, której nagłówki "
            . "można\nznaleźć w załączniku.  NIE PRZYJMUJEMY POCZTY "
            . "ZAWIERAJĄCEJ NIEZAMAWIANE\nINFORMACJE HANDLOWE W JAKIEJKOLWIEK "
            . "FORMIE.  Proszę o podjęcie kroków\nmających na celu odłączenie "
            . "tego użytkownika.",
    "gr", "Έλαβα ένα μήνυμα με τις συνημμένες επιγραφές από έναν χρήστη του "
            . "δικτύου\nσας.  ΔΕΝ ΔΕΧΟΜΑΣΤΕ ΤΟ ΕΚΟΥΣΙΟ ΕΜΠΟΡΙΚΟ ΗΛΕΚΤΡΟΝΙΚΌ "
            . "ΤΑΧΥΔΡΟΜΕΊΟ ΜΕ\nΟΠΟΙΑΔΉΠΟΤΕ ΜΟΡΦΉ.  Παρακαλώ λάβετε τα "
            . "απαραίτητα μέτρα για να\nολοκληρώσετε αυτόν τον χρήστη.",
    "bg", "Получих съобщтение със следното заглавие от абонат на вашата "
            . "мрежа.\nНЕ ПРИЕМАМЕ МАСОВО ИЗПРАТЕНИ СЪОБЩТЕНИЯ В НИКАКЪВ "
            . "ВИД.  Моля вземете\nнеобходимите мерки незабавно да прекратите "
            . "достъпа на този ваш абонат\nдо вашата мрежа.",
    "ru", "Я получил сообщение с прикрепленными заголовками от потребителя "
            . "Вашей\nсети.  МЫ НЕ ПРИНИМАЕМ НЕЗАТРЕБОВАННОЙ E-MAIL РЕКЛАМЫ В "
            . "ЛЮБОЙ ФОРМЕ.\nПожалуйста, примите необходимые меры для "
            . "прекращения доступа потребителя\nчерез Вашу сеть.",
    "kr", "나는 너의 네트워크의 사용자에게서 붙인 우두머리에 메시지를 받았다. 우리는 어떤 "
            . "모양안에 자발적인 상업적인 전자 우편을 받아들이지\n않는다. 이 사용자를 종결하기 "
            . "위하여 필요한 단계를 거치십시요.",
    "jp", "私はあなたのネットワークのユーザーから付けられたヘッダーが付いているメッ"
            . "セージを受け取った。\n私達はあらゆる形態のおせっかいな商業電子メー"
            . "ルを受け入れない。\nこのユーザーを終えるために必要なステップを踏み"
            . "なさい。",
    "cn", "我收到了一则从您的网络的用户发来的消息（见附加信头）。\n"
            . "我们不接受任何形式不请自来的商业电子邮件。\n"
            . "请采取必要的步骤终止这名用户。\n"
    ) ;

#
#  Figure out the command line flags and parameter(s) first.
#
%command_opts = () ;                        # clear out the hash first
getopts('il:', \%command_opts) ;
if ($command_opts{l}) {
    @languages = split /,/, $command_opts{l} ;
}
$interactive_flag = $command_opts{i} == 1 ? 1 : 0 ;

if ($#ARGV != 0) {                  # better be exactly 1 command line arg left
    print "Usage: $0 [-i] [-l lang1[,lang2,...]] recipient\n" ;
    exit 1 ;
}
$recipient = $ARGV[0] ;

#
#  Read in the header -- everything until a blank line.
#

@orig_message = <STDIN> ;

#
#  First pass: get rid of newline characters for each line of @orig_message
#  (which contains the original spam), expand all tabs, and remove trailing
#  whitespace.  This pass is just to clean up the text, and do so for the
#  whole message (header and body).
#
foreach (@orig_message) {
    chomp ;                             # munch of newline and expand tabs
    1 while $_ =~ s/\t+/' ' x (length($&) * 8 - length($`) % 8)/e;
    s/\s+$// ;                          # zap trailing whitespace
}

#
#  Second pass: Look only at the header.  Remove lines that shouldn't be
#  there (things added by the MDA or a MUA), and trap the subject line for later use.
#
$spammer_subject = "UCE: [no subject]" ;               # safe defaults
$spammer_from = "[an illegal user]" ;
for ($i = 0 ; ($i < $#orig_message) && (@orig_message[$i] ne "") ; $i++) {
    if ($orig_message[$i] =~ /^From /) {
        splice @orig_message, $i--, 1 ;
    }
    if ($orig_message[$i] =~ /^Content-Length: /i) {
        splice @orig_message, $i--, 1 ;
    }
    if ($orig_message[$i] =~ /^Lines: /i) {
        splice @orig_message, $i--, 1 ;
    }
    if ($orig_message[$i] =~ /^Status: /i) {
        splice @orig_message, $i--, 1 ;
    }
    if ($orig_message[$i] =~ /^Subject: *(.+)/i) {
        $spammer_subject = "UCE: $1" ;
        $spammer_subject =~ s/          +.+$// ;
        $spammer_subject =~ s/([\x00-\x1f\x7f])//g ;    # zap all ctrl chars
        $spammer_subject = substr $spammer_subject, 0, $max_subject_len ;
    }
    if ($orig_message[$i] =~ /^From: *(.+)/i) {
        $spammer_from = $1 ;
        if ($spammer_from =~ /"([${mailbox_atoms}]+)" +<([${mailbox_dot_atoms}]+@[${mailbox_dot_atoms}]+)>/) {
            $spammer_from = "$1 <$2>" ;
        }
    }
}

#@warning_block = split / *\n/, wrap("", "", $warning_text{en}) ;
@warning_block = $warning_text{en} ;
foreach (@languages) {
    if ($warning_text{$_}) {
#        push @warning_block, ("", split / *\n/, wrap("", "", $warning_text{$_})) ;
        push @warning_block, "" ;
        push @warning_block, $warning_text{$_} ;
    }
}

#
#  Finally, let's put it alll together: the warning message(s), a separator
#  indicating the beginning of the forwarded text, the message itself, the
#  closing separator, and the signature file (if available).
#
push @message, @warning_block ;
push @message, ("", "----- Forwarded message from " . $spammer_from . " -----", "") ;
push @message, @orig_message ;
for ($i = $#message; $i >= 0 && $message[$i] =~ /^$/; $i--) {
    pop @message ;
}
push @message, ('', '----- End forwarded message -----') ;

#
#  If ~/.signature exists, tack on a signature file
#
if (open(SIGFILE, "< $ENV{HOME}/.signature")) {
    push @message, ("", "", "--") ;
    while (<SIGFILE>) {
        chomp ;
        push @message, $_ ;
    }
    close SIGFILE ;
}

#
#  Pass this off to $mailer
#

if ($interactive_flag) {
    $tmpfile_path = $tmpdir . "/abusemail." . time . "." . $$ . "."
            . $ENV{LOGNAME} . ".tmp" ;
    open(TMPFILE, ">", $tmpfile_path) or
            die "unable to create temp file $tmpfile_path: $!" ;
    foreach (@message) {
        print TMPFILE "$_\n" ;
    }
    close TMPFILE ;
    system($mutt, "-i", $tmpfile_path,
            "-e", "unset hdrs", "-e", "set encode_from", "-b", $ENV{LOGNAME}, "-s", $spammer_subject, $recipient) ;
    unlink $tmpfile_path or die "unable to delete temp file $tmpfile_path: $!" ;
}
else {
    open(MAILER, "|-", $mutt, "-e", "unset hdrs", "-e", "set encode_from", "-b", $ENV{LOGNAME}, "-s", $spammer_subject, $recipient) or die "unable to fork mutt: $!" ;
    foreach (@message) {
        print MAILER "$_\n" ;
    }
    close MAILER ;
}