#!/usr/bin/env perl

use strict;

use MIME::Parser;

use Net::SMTP;

# K doručenkám typu:

#	Content-Type: multipart/report; report-type=delivery-status; ~ Delivery Status Notification (DSN)

# doplňujeme hlavičku References, 

# aby si je e-mailový klient mohl zařadit do vlákna pod zprávu, ke které doručenka patří.

# viz http://search.cpan.org/~dskoll/MIME-tools-5.502/lib/MIME/Entity.pm

# viz http://search.cpan.org/~dskoll/MIME-tools-5.502/lib/MIME/Head.pm

# viz http://search.cpan.org/~gbarr/libnet-1.21/Net/SMTP.pm

# Nastavení --------------------------------------------------------------------

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í

# ------------------------------------------------------------------------------

my $znacka = "X-DSN-Pridej-References"; # hlavička, kterou si poznačíme, že zpráva prošla tímto programem

my $stav = "chyba - nedefinovano"; # výchozí hodnota naší hlavičky

# Načteme zprávu

my $parser = new MIME::Parser;

$parser->output_to_core(1);

my $dorucenka = $parser->parse(\*STDIN);

# Kontrola, že se zpráva nezacyklila (chybí naše značka)

if ($dorucenka->head->count($znacka) == 0) {

	# Podle hlavičky Delivered-To zjistíme, kam máme zprávu poslat zpátky	

	my $deliveredTo = $dorucenka->head->get("Delivered-To", 1); # [0] = adresa tohoto skriptu, [1] = předchozí adresa – původní příjemce doručenky 

	if ($deliveredTo) {

		$deliveredTo =~ s/\s+$//; # zbavíme se přebytečného konce řádku

		$komu = $deliveredTo;

		$dorucenka->head->delete("Delivered-To", 1); # aby si poštovní server nemyslel, že se zpráva zacyklila 

		# Pokud hlavička References chybí, doplníme ji

		if ($dorucenka->head->count("References") == 0) {

			# Zjistíme Message-ID původní zprávy

			my $messageID;

			my @casti = $dorucenka->parts;

			for my $cast (@casti) {

				if ($cast->mime_type eq "text/rfc822-headers") {

					my @radky = $cast->bodyhandle->as_lines;

					for my $radek (@radky) {

						if ($radek =~ /^Message-ID:\s*(<.*>)$/) {

							$messageID = $1;

						}

					}

				}			

			}		

			# Nastavíme nalezené Message-ID do References hlavičky

			if ($messageID) {

				$stav = "ok";

				$dorucenka->head->add("References", $messageID);

			} else {

				$stav = "chyba - Message-ID nenalezeno";

			}

		} else {

			$stav = "hlavicka References uz byla nastavena drive";

		}		

	} else {

		$stav = "chyba - nevime, kam zpravu poslat zpet";

	}	

} else {

	# Zpráva se zacyklila → pouze přidáme svoji značku

	# a pošleme správci (nezměníme $komu)

	$stav = "chyba - cyklus";

}

$stav .= " [pid=$$,uid=$>]"; # přidáme PID a UID

$dorucenka->head->add($znacka, $stav);

# Výpis (nepotřebujeme, jen pro ladění)

#$dorucenka->print(\*STDOUT);

#print "Pošleme komu: $komu\n";

# Odeslání přes SMTP (pro ostrý provoz):

my $smtp = Net::SMTP->new("localhost");

$smtp->mail('<>');

$smtp->to($komu);

$smtp->data();

$dorucenka->print($smtp);

$smtp->dataend();

$smtp->quit;