#! /usr/bin/perl

require "getopts.pl";
require "msg.pl";
require "imap.pl";

&Getopts('bde:h:il:np:qrt:u:x');

$body = $opt_b;		# retrieve BODY[1] instead of RFC822.TEXT
$debug = $opt_d;	# debug mode
$efficiency = $opt_e;	# efficiency
$host = $opt_h;		# specify IMAP host (localhost)
$important = $opt_i; 	# flag retrieved messages as important
$limit = $opt_l;	# only retrieve messages smaller than specified value
$new = $opt_n;		# flag retrieved messages as new
$port = $opt_p;		# specify IMAP port (143)
$quiet = $opt_q;	# quiet mode
$remove = $opt_r;	# delete retrieved messages
$timeout = $opt_t;	# place timeout on reading lines
$user = $opt_u;		# use another name to login
$expunge = $opt_x;	# expunge regularly

$host = 'localhost' unless $host;
$port = 143 unless $port;
$user = getpwuid($>) unless $user;
$timeout = 0 unless $timeout;

$important = 1 if $new;		# flag as new implies flag as important

$efficiency = 10 unless $efficiency > 0;

$pid = 0;

&msg'level(2) if $debug;
&msg'level(0) if $quiet;

if (! defined($ENV{"HOME"}))
{
	&msg'error("HOME not set");
	exit 1;
}
$home = $ENV{"HOME"};

if (! open(RC, "$home/.imapsyncrc"))
{
	&msg'error("can not open ~/.imapsyncrc");
	exit 1;
}

$numboxes = 0;
while (chop($mbox = <RC>))
{
	if (! $mbox =~ /^\s*$/)
	{
		push(@mailboxes, $mbox);
		$numboxes++;
	}
}

close(RC);

&msg'msg("$numboxes mailbox: @mailboxes") if ($numboxes == 1);
&msg'msg("$numboxes mailboxes: @mailboxes") if ($numboxes != 1);

$totalmsgs = 0;
$totalmsgskips = 0;
$totalmsgerrors = 0;

if (! &imap'init(\&message, \&mailbox, \&exists, \&recent, \&expunge, \&flags,
					\&search, \&fetch))
{
	&msg'error("can not initialize");
	exit 1;
}

if (! &imap'open($host, $port))
{
	&msg'error("can not make connection");
	exit 1;
}

$tag = &imap'login($user);
($match, $result, $message) = &imap'loop($tag,$timeout);
if ($result ne "OK")
{
	&msg'error("$message");
	&imap'close();
	exit 1;
}

MAILBOX:
foreach $mbox (@mailboxes)
{
	&msg'msg("scanning mailbox $mbox");

	$tag = &imap'select($mbox);
	($match, $result, $message) = &imap'loop($tag,$timeout);
	if ($result ne "OK")
	{
		&msg'error("$message");
		next MAILBOX;
	}
	&msg'msg("$mailbox{$mbox}->{'exists'} messages, $mailbox{$mbox}->{'recent'} recent");

	# if ($mailbox{$mbox}->{'recent'} == 0)
	# {
	# 	&msg'msg("skipping mailbox");
	# 	next MAILBOX;
	# }

	$tag = &imap'search("UNSEEN");

	# reset some variables in the meantime
	$msgs = 0;
	$msgskips = 0;
	$msgerrors = 0;

	($match, $result, $message) = &imap'loop($tag,$timeout);
	if ($result ne "OK")
	{
		&msg'error("$message");
		&imap'close();
		exit 1;
	}

	@seqlist = split(' ', $mailbox{$mbox}->{'search'});
	$seqcount = $#seqlist + 1;
	$seqoffset = 0;

FETCH:
	while ($seqcount - $seqoffset > 0)
	{
		if ($seqcount - $seqoffset < $efficiency)
		{
			$seqrange = $seqcount - $seqoffset;
		}
		else
		{
			$seqrange = $efficiency;
		}

		@sequence = @seqlist[$seqoffset..($seqoffset+$seqrange-1)];
		$sequence = join(',', @sequence);

		$seqoffset = $seqoffset+$seqrange;

		$tag = &imap'fetch("$sequence", "ALL");
		($match, $result, $message) = &imap'loop($tag,$timeout);
		if ($result ne "OK")
		{
			&msg'error("$message");
			&imap'close();
			exit 1;
		}
		foreach $i (0..$#sequence)
		{
			$size = $message{@sequence[$i]}->{'size'};
			if ($size && $limit > 0 && $size > $limit)
			{
				&msg'warn("skipping message @sequence[$i], $size bytes long");
				@sequence[$i] = '';
				$msgskips++;
			}
			else
			{
				&msg'msg("retrieving message @sequence[$i], $size bytes long");
				$msgs++;
			}
		}
		$sequence = join(' ', @sequence);
		$sequence =~ s/^\s*(.*)\s*$/$1/;
		@sequence = split(/\s+/, $sequence);
		$sequence = join(',', @sequence);

		if (length($sequence) > 0)
		{
			if ($body)
			{
				$fetch = "(RFC822.HEADER BODY[1])";
			}
			else
			{
				$fetch = "(RFC822.HEADER RFC822.TEXT)";
			}
			$tag = &imap'fetch("$sequence", "$fetch");
			($match, $result, $message) = &imap'loop($tag,$timeout);
			if ($result ne "OK")
			{
				&msg'error("$message");
				&imap'close();
				exit 1;
			}

			# wait for child process if it is still running
			if ($pid)
			{
				waitpid($pid, 0);
			}

			unless($pid = fork())
			{
				foreach $i (0..$#sequence)
				{
# Linux: change this to: open(FORMAIL, "| deliver -A <username>")
					if (! open(FORMAIL, "| formail -Ys procmail"))
					{
						&msg'error("can not pipe to formail");
						&imap'close();
						exit 1;
					}
					print FORMAIL $message{@sequence[$i]}->{'header'};
					if ($body)
					{
						print FORMAIL $message{@sequence[$i]}->{'body'};
					}
					else
					{
						print FORMAIL $message{@sequence[$i]}->{'text'};
					}
					if (! close(FORMAIL) || $?)
					{
						&msg'error("formail failed");
						&imap'close();
						exit 1;
					}
				}
				exit 0;
			}

			if ($remove || $important)
			{
				$flags = "\\DELETED" if ($remove);
				$flags = "\\FLAGGED" if ($important);
				$tag = &imap'store("$sequence", "+FLAGS", "($flags)");
				($match, $result, $message) = &imap'loop($tag,$timeout);
				if ($result ne "OK")
				{
					&msg'error("$message");
					&imap'close();
					exit 1;
				}
				if ($new)
				{
					$tag = &imap'store("$sequence", "-FLAGS", "(\\SEEN)");
					($match, $result, $message) = &imap'loop($tag,$timeout);
					if ($result ne "OK")
					{
						&msg'error("$message");
						&imap'close();
						exit 1;
					}
				}
			}

			# expunge messages
			if ($remove && $expunge)
			{
				$tag = &imap'expunge();
				($match, $result, $message) = &imap'loop($tag,$timeout);
				if ($result ne "OK")
				{
					&msg'error("$message");
					&imap'close();
					exit 1;
				}

				# determine message sequence again that is still UNSEEN
				# it was changed c.q. shifted by the expunge
				$tag = &imap'search("UNSEEN");
				($match, $result, $message) = &imap'loop($tag,$timeout);
				if ($result ne "OK")
				{
					&msg'error("$message");
					&imap'close();
					exit 1;
				}

				@seqlist = split(' ', $mailbox{$mbox}->{'search'});
				$seqcount = $#seqlist + 1;
				$seqoffset = $msgskips;
			}
		}

		undef %message;
	}

	# expunge messages if not already done earlier by regular expunge mode
	if ($remove && $expunge != 1)
	{
		$tag = &imap'expunge();
		($match, $result, $message) = &imap'loop($tag,$timeout);
		if ($result ne "OK")
		{
			&msg'error("$message");
			&imap'close();
			exit 1;
		}
	}

	if ($msgs + $msgskips + $msgerrors > 0)
	{
		&msg'msg("$msgs retrieved, $msgskips skipped, $msgerrors errors");
		$totalmsgs += $msgs;
		$totalmsgskips += $msgskips;
		$totalmsgerrors += $msgerrors;
	}
}

$tag = &imap'logout();
($match, $result, $message) = &imap'loop($tag,$timeout);
if ($result ne "OK")
{
	&msg'error("$message");
	&imap'close();
	exit 1;
}

&imap'close();

&msg'msg("total: $totalmsgs retrieved, $totalmsgskips skipped, $totalmsgerrors errors");

# wait for child process if it is still running
if ($pid)
{
	waitpid($pid, 0);
}

exit 0;



sub message
{
local($tag, $result, $message) = @_;

	&msg'debug("message $tag $result $message");

	if ($tag eq "*")
	{
		MESSAGE:
		{
		$result =~ /OK/i && do
			{
				&msg'msg("$message");
				last MESSAGE;
			};
		$result =~ /NO/i && do
			{
				&msg'warn("$message");
				last MESSAGE;
			};
		$result =~ /BAD/i && do
			{
				&msg'error("$message");
				last MESSAGE;
			};
		}
	}
}

sub mailbox
{
local($tag, $data) = @_; 

	&msg'debug("mailbox $tag $data");
}

sub exists
{
local($tag, $result) = @_;

	&msg'debug("exists $tag $result");

	$mailbox{$mbox}->{'exists'} = $result;
}

sub recent
{
local($tag, $result) = @_; 

	&msg'debug("recent $tag $result");

	$mailbox{$mbox}->{'recent'} = $result;
}

sub expunge
{
local($tag, $result) = @_; 

	&msg'debug("expunge $tag $result");

	$mailbox{$mbox}->{'expunge'} = $result;
}

sub fetch
{
local($tag, $result, $data) = @_; 

	&msg'debug("fetch $tag $result");

	if ($data =~ /RFC822\.SIZE\s+([0-9]+)/im)
	{
		$message{$result}->{'size'} = $1;
	}
	if ($data =~ /RFC822\.HEADER\s+\{([0-9]+)\}\015\012/im)
	{
		$message{$result}->{'header'} = substr($', 0, $1);
	}
	if ($data =~ /RFC822\.TEXT\s+\{([0-9]+)\}\015\012/im)
	{
		$message{$result}->{'text'} = substr($', 0, $1);
	}
	if ($data =~ /BODY\[1\]\s+\{([0-9]+)\}\015\012/im)
	{
		$message{$result}->{'body'} = substr($', 0, $1);
	}
}

sub flags
{
local($tag, $data) = @_; 

	&msg'debug("flags $tag $data");

	$mailbox{$mbox}->{'flags'} = $data;
}

sub search
{
local($tag, $data) = @_; 

	&msg'debug("search $tag $data");

	$mailbox{$mbox}->{'search'} = $data;
}
