#!/usr/bin/perl -w
#
# poczter.pl ver 0.1
#
# Na potrzeby kt.linuxnews.pl napisał Jakub Jankowski <shasta@toxcorp.com>
# Code released under GNU GPLv2 or later.
#
# Prerequisites: perl -MCPAN -e shell; install MIME::Tools
#
# Użycie: cat plik_z_pocztą | ./poczter.pl [katalog]
#         ewentualnie przez procmail (patrz regułka niżej)
#
# Changes:
#  0.1 - initial release
#
#
# Regułka do procmaila:
# 
# :0 c
# * !^FROM_DAEMON
# * X-BeenThere:.*kt@linuxnews\.pl
# | /ścieżka/do/poczter.pl /ścieżka/do/parent/dir/odcinków
#

use strict;
use MIME::Parser;
use POSIX qw(strftime);

my $VERSION = "0.1";

# katalog 'domowy' pobierz z linii poleceń...
my $ktdir = shift;
# ... lub użyj domyślnego:
$ktdir = "$ENV{HOME}/programming/perl/kt" unless defined $ktdir;

# utnij kończące '/' ze ścieżki
$ktdir =~ s/([\/]+)$//;

# plik z logiem działalności skryptu
my $logfile = "$ENV{HOME}/.poczter.log";

# spróbuj otworzyć do zapisu log. jeśli się nie uda, ustaw $havelog na 0;
my $havelog = 1;
local *LOG;
open(LOG, ">>$logfile") or $havelog = 0;

# spróbuj ustawić nazwę hosta
my $hostname = undef;
if (-e "/bin/hostname" && -X "/bin/hostname") {
	$hostname = `/bin/hostname`;
	$hostname =~ s/^\b(.+)\b[\n]*/$1/;
} else {
	$hostname = "localhost";
}

# void plog($string)
# logowanie do pliku
# musi mieć otwarty do zapisu deskryptor LOG
sub plog ($) {
	return unless $havelog;
	my $now_string = strftime("%b %e %H:%M:%S", localtime(time));
	printf(LOG "%s %s poczter: %s\n", $now_string, $hostname, $_[0]);
}

# int valid_dir($dir)
# sprawdza, czy do $dir będzie można pisać
# jeśli katalog nie istnieje, próbuje go utworzyć. Jeśli się nie da - kończy skrypt
# jeśli do katalogu nie da się pisać -- kończy skrypt.
sub valid_dir ($) {
	if (! -d $_[0]) {
		mkdir($_[0]) or plog("Nie mogę utworzyć katalogu $_[0] - $!");
		exit(1);
	}
	if (! -w $_[0]) {
		plog("Nie mam praw zapisu do katalogu $_[0]");
		exit(1);
	}
	return 1;
}

# void print_header()
# startuje log.
sub print_header () {
	plog("---------------------------------------------------------");
	plog("poczter.pl ver. $VERSION starting");
}

sub main {
	print_header();

	# sprawdź poprawność katalogu
	exit(1) unless valid_dir($ktdir);

	my $parser = new MIME::Parser;

	# opcje
	$parser->decode_headers(1);
	$parser->output_dir("/tmp");

	# parsuj to co dostaniesz na stdin
	my $ent = $parser->parse(\*STDIN);

	# pobierz nagłówki 'from', 'subject' oraz 'message-id'
	my $from = $ent->head->get('from');
	my $subject = $ent->head->get('subject');
	my $msgid = $ent->head->get('message-id');

	# utnij im \n
	chomp($from) if defined $from;
	chomp($subject) if defined $subject;
	chomp($msgid) if defined $msgid;

	# pomiń wiadomości, które nie mają nagłówka Subject:
	if (!defined $subject) {
		plog("Wiadomość nie posiada nagłówka 'Subject', pomijam");
		return 0;
	}

	# zaloguj nagłówki 'from', 'subject' i 'message-id'
	plog("Nadawca: " . ((defined $from && $from ne "") ? $from : "NIEZNANY!"));
	plog("Temat: " . ((defined $subject && $subject ne "") ? $subject : "NIEZNANY!"));
	plog("Message-ID: " . ((defined $msgid && $msgid ne "") ? $msgid : "NIEZNANE!"));

	# pomiń wiadomości, których temat nie zawiera czegoś w rodzaju
	# `[kt] [S]', `[kt] [T]' lub `[kt] [K]'
	if ($subject !~ /\[kt\][\ ]*\[[kts]\]/i) {
		plog("Wiadomość nie zawiera odpowiedniego tematu -- pomijam");
		return 0;
	}

	# sprawdź typ wiadomości
	# jeżeli multipart, to przeszukuj załączniki
	if ($ent->effective_type =~ /m|multipart\/|i/) {
		plog("Wiadomość typu " . $ent->effective_type . " -- skanowanie załączników...");

		for (my $i = 0; $i < $ent->parts; $i++) {
			# wyszukuj tylko załączników plain lub octet-stream
			next unless $ent->parts($i)->effective_type =~ /plain|octet-stream/i;

			# wyszukuj tylko załączników z nagłówkiem Content-Disposition
			my $header = $ent->parts($i)->head->get('Content-Disposition');
			next unless defined $header;

			# sprawdź czy nagłówek Content-Disposition posiada atrybut filename
			my ($gotfile) = $header =~ /filename\=[\"]{0,1}([0-9a-zA-Z-_\.]+)[\"]{0,1}/i;
			if (!defined $gotfile) {
				plog("Załącznik $1: Błędny format nagłówków, pomijam");
				next;
			}

			plog("Załącznik $i: Wykryto plik: $gotfile");

			# wytnij wszystkie slashe z nazwy pliku
			$gotfile =~ s/[\/]+//g;

			# parsowanie nazwy pliku
			my ($issue, $section, $other, $exten) = $gotfile =~ /([0-9]{3})[\-\_]([0-9]{1,2})(.*)[\.](xml|txt)/i;
			if (!defined $issue || !defined $section || !defined $other || !defined $exten) {
				plog("Załącznik $i: Nazwa pliku nie sugeruje niczego użytecznego, pomijam"); 
				next;
			}

			plog("Załącznik $i: Nazwa pliku wygląda obiecująco -- będę zapisywał");

			# sprawdzenie, czy nie nadpiszemy przypadkiem jakiegoś pliku
			my $filename = "$issue/$issue-$section.$exten";
			# XXX/XXX-YY.EXT
			if (-e "$ktdir/$filename") {
				plog("Załącznik $i: Plik $ktdir/$filename istnieje");
				$filename = "$issue/$issue-$section$other.$exten"
			}
			# XXX/XXX-YY-OTHER.EXT
			if (-e "$ktdir/$filename") {
				plog("Załącznik $i: Plik $ktdir/$filename istnieje") unless ($other eq '');
				$filename = "$issue/$issue-$section-" . time . ".$exten";
			}
			# XXX/XXX-YY-UNIXTIME.EXT
			if (-e "$ktdir/$filename") {
				plog("Załącznik $i: Plik $ktdir/$filename istnieje, poddaję się");
				next;
			}

			plog("Załącznik $i: Zapis załącznika do $ktdir/$filename");

			# jeżeli uda się otworzyć załącznik...
			if (my $io = $ent->parts($i)->open("r")) {
				local *OUT;
				# i uda się otworzyć do zapisu plik wynikowy ...
				if (open(OUT, ">$ktdir/$filename")) {
					# ... zapisz załącznik
					while (defined($_ = $io->getline)) {
						print(OUT $_);
					}
					close(OUT);
					plog("Załącznik $i: Zapisano");
				} else {
					plog("Załącznik $i: Nie mogę otworzyć $ktdir/$filename do zapisu: $!");
				}
				$io->close;
			}

			# przetwarzaj kolejny załącznik...
			next;
		}
	} else {
		# wiadomość NIE jest typu multipart
		plog("Wiadomość typu " . $ent->effective_type . " -- pomijam");
	}

	plog("Czyszczenie plików tymczasowych");
	$parser->filer->purge;

	return 0;
}

main();

# jeśli udało się otworzyć log -- zamnknij go teraz
close(LOG) if $havelog;

# zakończ skrypt
exit(0);