8 # Content-Type: multipart/report; report-type=delivery-status; ~ Delivery Status Notification (DSN)
9 # doplňujeme hlavičku References,
10 # aby si je e-mailový klient mohl zařadit do vlákna pod zprávu, ke které doručenka patří.
12 # viz http://search.cpan.org/~dskoll/MIME-tools-5.502/lib/MIME/Entity.pm
13 # viz http://search.cpan.org/~dskoll/MIME-tools-5.502/lib/MIME/Head.pm
14 # viz http://search.cpan.org/~gbarr/libnet-1.21/Net/SMTP.pm
17 # Nastavení --------------------------------------------------------------------
18 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í
19 # ------------------------------------------------------------------------------
21 my $znacka = "X-DSN-Pridej-References"; # hlavička, kterou si poznačíme, že zpráva prošla tímto programem
22 my $stav = "chyba - nedefinovano"; # výchozí hodnota naší hlavičky
26 my $parser = new MIME::Parser;
27 $parser->output_to_core(1);
28 my $dorucenka = $parser->parse(\*STDIN);
31 # Kontrola, že se zpráva nezacyklila (chybí naše značka)
32 if ($dorucenka->head->count($znacka) == 0) {
34 # Podle hlavičky Delivered-To zjistíme, kam máme zprávu poslat zpátky
35 my $deliveredTo = $dorucenka->head->get("Delivered-To", 1); # [0] = adresa tohoto skriptu, [1] = předchozí adresa – původní příjemce doručenky
37 $deliveredTo =~ s/\s+$//; # zbavíme se přebytečného konce řádku
39 $dorucenka->head->delete("Delivered-To", 1); # aby si poštovní server nemyslel, že se zpráva zacyklila
41 # Pokud hlavička References chybí, doplníme ji
42 if ($dorucenka->head->count("References") == 0) {
44 # Zjistíme Message-ID původní zprávy
46 my @casti = $dorucenka->parts;
47 for my $cast (@casti) {
48 if ($cast->mime_type eq "text/rfc822-headers") {
49 my @radky = $cast->bodyhandle->as_lines;
50 for my $radek (@radky) {
51 if ($radek =~ /^Message-ID:\s*(<.*>)$/) {
58 # Nastavíme nalezené Message-ID do References hlavičky
61 $dorucenka->head->add("References", $messageID);
63 $stav = "chyba - Message-ID nenalezeno";
67 $stav = "hlavicka References uz byla nastavena drive";
70 $stav = "chyba - nevime, kam zpravu poslat zpet";
73 # Zpráva se zacyklila → pouze přidáme svoji značku
74 # a pošleme správci (nezměníme $komu)
75 $stav = "chyba - cyklus";
79 $stav .= " [pid=$$,uid=$>]"; # přidáme PID a UID
80 $dorucenka->head->add($znacka, $stav);
82 # Výpis (nepotřebujeme, jen pro ladění)
83 #$dorucenka->print(\*STDOUT);
84 #print "Pošleme komu: $komu\n";
86 # Odeslání přes SMTP (pro ostrý provoz):
87 my $smtp = Net::SMTP->new("localhost");
91 $dorucenka->print($smtp);