franta-hg@21: #!/usr/bin/env perl franta-hg@21: franta-hg@21: use strict; franta-hg@21: use MIME::Parser; franta-hg@21: use Net::SMTP; franta-hg@21: franta-hg@21: # K doručenkám typu: franta-hg@21: # Content-Type: multipart/report; report-type=delivery-status; ~ Delivery Status Notification (DSN) franta-hg@21: # doplňujeme hlavičku References, franta-hg@21: # aby si je e-mailový klient mohl zařadit do vlákna pod zprávu, ke které doručenka patří. franta-hg@21: franta-hg@21: # viz http://search.cpan.org/~dskoll/MIME-tools-5.502/lib/MIME/Entity.pm franta-hg@21: # viz http://search.cpan.org/~dskoll/MIME-tools-5.502/lib/MIME/Head.pm franta-hg@23: # viz http://perldoc.perl.org/Net/SMTP.html franta-hg@21: franta-hg@24: # aptitude install libmime-tools-perl libmailtools-perl franta-hg@24: franta-hg@21: franta-hg@21: # Nastavení -------------------------------------------------------------------- franta-hg@21: my $komu = 'noreply@example.com'; # adresa správce – sem pošleme zprávy, pokud nevíme, kam je poslat (chybí Delivered-To), nebo máme podezření na zacyklení franta-hg@21: # ------------------------------------------------------------------------------ franta-hg@21: franta-hg@21: my $znacka = "X-DSN-Pridej-References"; # hlavička, kterou si poznačíme, že zpráva prošla tímto programem franta-hg@21: my $stav = "chyba - nedefinovano"; # výchozí hodnota naší hlavičky franta-hg@21: franta-hg@21: franta-hg@21: # Načteme zprávu franta-hg@21: my $parser = new MIME::Parser; franta-hg@21: $parser->output_to_core(1); franta-hg@21: my $dorucenka = $parser->parse(\*STDIN); franta-hg@21: franta-hg@21: franta-hg@21: # Kontrola, že se zpráva nezacyklila (chybí naše značka) franta-hg@21: if ($dorucenka->head->count($znacka) == 0) { franta-hg@21: franta-hg@21: # Podle hlavičky Delivered-To zjistíme, kam máme zprávu poslat zpátky franta-hg@21: my $deliveredTo = $dorucenka->head->get("Delivered-To", 1); # [0] = adresa tohoto skriptu, [1] = předchozí adresa – původní příjemce doručenky franta-hg@21: if ($deliveredTo) { franta-hg@21: $deliveredTo =~ s/\s+$//; # zbavíme se přebytečného konce řádku franta-hg@21: $komu = $deliveredTo; franta-hg@21: $dorucenka->head->delete("Delivered-To", 1); # aby si poštovní server nemyslel, že se zpráva zacyklila franta-hg@21: franta-hg@21: # Pokud hlavička References chybí, doplníme ji franta-hg@21: if ($dorucenka->head->count("References") == 0) { franta-hg@21: franta-hg@21: # Zjistíme Message-ID původní zprávy franta-hg@21: my $messageID; franta-hg@21: my @casti = $dorucenka->parts; franta-hg@21: for my $cast (@casti) { franta-hg@21: if ($cast->mime_type eq "text/rfc822-headers") { franta-hg@21: my @radky = $cast->bodyhandle->as_lines; franta-hg@21: for my $radek (@radky) { franta-hg@21: if ($radek =~ /^Message-ID:\s*(<.*>)$/) { franta-hg@21: $messageID = $1; franta-hg@21: } franta-hg@21: } franta-hg@21: } franta-hg@21: } franta-hg@21: franta-hg@21: # Nastavíme nalezené Message-ID do References hlavičky franta-hg@21: if ($messageID) { franta-hg@21: $stav = "ok"; franta-hg@21: $dorucenka->head->add("References", $messageID); franta-hg@21: } else { franta-hg@21: $stav = "chyba - Message-ID nenalezeno"; franta-hg@21: } franta-hg@21: } else { franta-hg@23: $stav = "ok - hlavicka References uz byla nastavena drive"; franta-hg@21: } franta-hg@21: } else { franta-hg@21: $stav = "chyba - nevime, kam zpravu poslat zpet"; franta-hg@21: } franta-hg@21: } else { franta-hg@23: $stav = "chyba - zprava se zacyklila"; franta-hg@21: } franta-hg@21: franta-hg@21: franta-hg@21: $stav .= " [pid=$$,uid=$>]"; # přidáme PID a UID franta-hg@21: $dorucenka->head->add($znacka, $stav); franta-hg@21: franta-hg@21: # Výpis (nepotřebujeme, jen pro ladění) franta-hg@21: #$dorucenka->print(\*STDOUT); franta-hg@21: #print "Pošleme komu: $komu\n"; franta-hg@21: franta-hg@21: # Odeslání přes SMTP (pro ostrý provoz): franta-hg@21: my $smtp = Net::SMTP->new("localhost"); franta-hg@21: $smtp->mail('<>'); franta-hg@21: $smtp->to($komu); franta-hg@21: $smtp->data(); franta-hg@21: $dorucenka->print($smtp); franta-hg@21: $smtp->dataend(); franta-hg@21: $smtp->quit; franta-hg@24: