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@21: # viz http://search.cpan.org/~gbarr/libnet-1.21/Net/SMTP.pm
franta-hg@21: 
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: 			
franta-hg@21: 		} else {
franta-hg@21: 			$stav = "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@21: 	# Zpráva se zacyklila → pouze přidáme svoji značku
franta-hg@21: 	# a pošleme správci (nezměníme $komu)
franta-hg@21: 	$stav = "chyba - cyklus";
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;