#!/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;
