#!perl
# $Id: popsync,v 1.2 2010/11/07 21:13:55 feyrer Exp feyrer $
#
# sync local mbox to remote pop server
#
# Copyright 2007 Hubert Feyrer <hubert@feyrer.de>
# All rights reserved.
#

#use strict;

$remote  = "localhost"; # POP server
$port = "pop3";

$pop_login = "poptest";
$pop_passwd = "popper";

$mbox_file = "popsync.mbox";

$debug = 0;

###########################################################################
sub hfsend
{
	my ($a) = @_;
	print "-> $a" if $debug;
	print SOCK "$a";
}

###########################################################################
sub hfreceive {
	my ($line);
	$line = <SOCK>;
	print "<- $line" if $debug;
	return $line;
}

###########################################################################
# read mails from pop-server into %popmsgs,
# keys = pop IDs
#
sub get_popmsgs
{
	use Socket;
	use IO::Handle; # autoflush

	my($line, $port, $iaddr, $proto, $msgcount);
	my($popid, $popbytes, $msg, $id);

	$port = "pop3";
	if ($port =~ /\D/) { $port = getservbyname($port, 'tcp') }
	die "No port" unless $port;
	$iaddr   = inet_aton($remote)               || die "no host: $remote";
	$paddr   = sockaddr_in($port, $iaddr);

	$proto   = getprotobyname('tcp');
	socket(SOCK, PF_INET, SOCK_STREAM, $proto)  || die "socket: $!";
	connect(SOCK, $paddr)    || die "connect: $!";

	SOCK->autoflush(1);

	# +OK
		$line = hfreceive();
		if ($line !~ /^\+OK/) {
			die "not ready?";
		} else {
			print "Ready, set ...\n" if $debug;
		}

	# USER
		hfsend("USER $pop_login\n");
		$line = hfreceive();
		if ($line !~ /^\+OK/) {
			die "bad login";
		} else {
			print "USER OK\n" if $debug;
		}

	# PASS
		hfsend("PASS $pop_passwd\n");
		$line = hfreceive();
		if ($line !~ /^\+OK/) {
			die "bad password";
		} else {
			print "PASS OK\n" if $debug;
		}

	# LIST
		hfsend("LIST\n");
		$line = hfreceive();
		if ($line !~ /^\+OK/) {
			die "can't list?!";
		} else {
			print "LIST line OK\n" if $debug;
		}

		$msgcount = -1;
		$line = hfreceive();
		id:
		while ($line !~ /^-ERR/) {
			chomp($line);
			last id if $line =~ /^\./; # last id

			($popid, $popbytes) = split(/\s+/, $line);
			$popids{$popid} = $popbytes;
			$msgcount++;

			$line = hfreceive();
		}
		if ($debug) {
			print "There are $msgcount messages\n";
			print "IDs: ";
			foreach $id (sort keys %popids) { print "$id "; }
			print "\n";
		}

	# TOP
		foreach $id (sort keys %popids) {
			hfsend("TOP $id 0\n");

			$line = hfreceive();
			if ($line !~ /^\+OK/) {
				die "top failed";
			} else {
				print "TOP ok\n" if $debug;
			}

			# read until blank line (= end of header)
			$msg = "";
			$line = hfreceive();
			chomp($line);
			header:
			while ($line !~ /^\s*$/) {
				$msg .= "$line\n";

				$line = hfreceive();
				chomp($line);
			}

			# skip rest up to & including "." line
			print "skipping rest\n" if $debug;
			rest:
			while ($line !~ /^\./) {
				$line = hfreceive();
			}

			$popmsgs{$id} = $msg;
		}

	# QUIT
		hfsend("QUIT\n");
		$line = hfreceive();
		if ($line !~ /^\+OK/) {
			die "can't quit?!";
		} else {
			print "QUIT OK\n" if $debug;
		}

	# Besser auflassen? Renumbering der IDs? Locking?
	close (SOCK)            || die "close: $!";
}

###########################################################################
sub print_popmsgs {
	my($id, $imsg);

	foreach $id (sort keys %popmsgs) {
		print "pop msg #$id:\n";
		$imsg = $popmsgs{$id};
		$imsg =~ s/\n/\n> /g;
		$imsg =~ s/^/> /g;
		$imsg =~ s/> $//g;
		print "$imsg";
	}
}

###########################################################################
sub print_mboxmsgs {
	my($id, $imsg);

	foreach $id (sort keys %mboxmsgs) {
		print "mbox msg #$id:\n";
		$imsg = $mboxmsgs{$id};
		$imsg =~ s/\n/\n> /g;
		$imsg =~ s/^/> /g;
		$imsg =~ s/> $//g;
		print "$imsg";
	}
}

###########################################################################
sub get_mboxmsgs {
	my($os, $id, $key);

	$os = $/;
	$/ = "\nFrom ";

	$id = 0;
	open(MBOX, "$mbox_file") or die "can't read $mbox_file: $!\n";
	while(<MBOX>) {
		chomp;
		# From ueberall nur einmal, ganz vorn. Nur Header. Eiertanz
		s,^From ,,; s,^,$/,; s,^\n,,; s,\n\n.*,,;

		# Eigentlich muesste hier ein Hash o.ae. als Key verwendet
		# werden, der spaeter auch aus der POP-Mail generiert wird
		# und dann schnell gefunden werden kann. spaeter...
		$key = $id++;

		$mboxmsgs{$key} = $_;
	}
	close(MBOX);

	$/ = $os;
}

###########################################################################
# return some id (hash, msgid, ...) of the passed email message
# fills %msgcache: key=message, value=id
#
sub msgid {
	my ($msg) = $_[0];
	my($line, $msgid, $l);

	# If cached, return cached value
	if ( $msgcache{$msg} ) {
		$msgid = $msgcache{$msg};

	} else {
		# Not cached, calculate & cache

		$l = "";
		header:
		foreach $line (split(/\n/, $msg)) {
			chomp($line);
			if ($line =~ /^Message-Id:/i) {
				$l = $line;
				last header;
			}
		}

		die "no message-id header in $msg\n"
			if $l eq ""; # no message-id

		$l =~ /<([^>]*)>/;
		$msgid = $1;

		# Cache!
		$msgcache{$msg} = $msgid;

	}

	return $msgid;
}

###########################################################################
###########################################################################
###  M A I N
###########################################################################
###########################################################################

get_popmsgs();	#print_popmsgs() if $debug;
get_mboxmsgs();	#print_mboxmsgs() if $debug;

# Vergleich:
my($popid, $mboxid, $found);
foreach $popid (sort keys %popmsgs) {
	$popmsgid = msgid($popmsgs{$popid});
	print "pop msg #$popid, id = $popmsgid\n" if $debug;

	$found=0;
	mboxmsg:
	foreach $mboxid (sort keys %mboxmsgs) {
		$mboxmsgid = msgid($mboxmsgs{$mboxid});

		print "\tfound=$found, pop=<$popmsgid> <=> mbox=<$mboxmsgid>\n" if $debug;

		if ($mboxmsgid == $popmsgid) {
			$found = 1;
			last mboxmsg;
		}
	}
	if (! $found) {
		$imsg = $popmsgs{$popid};
		$imsg =~ s/\n/\n> /g;
		$imsg =~ s/^/> /g;
		$imsg =~ s/> $//g;
		print "Delete POP ID $popid:\n$imsg\n";

		#print "DELE $popid\n"; # POP command
	}
}