#! /usr/bin/perl

# Copyright (C) 2004-2005 Lars Eggert <lars.eggert@gmx.net>
# All rights reserved.
#                                                                
# Redistribution and use in source and binary forms are permitted
# provided that the above copyright notice and this paragraph are
# duplicated in all such forms and that any documentation,
# advertising materials, and other materials related to such
# distribution and use acknowledge that the software was developed
# by the author. The name of the author may not be used to endorse
# or promote products derived from this software without specific
# prior written permission.
# 
# THIS SOFTWARE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
# PURPOSE.

# $Id: imapfilter.pl,v 1.8 2005/10/05 09:34:26 eggert Exp $

use warnings;
use strict;

use IO::Socket::SSL;
use IO::Select;
use Net::hostent;
use POSIX;
use Getopt::Long;
use FindBin;


# these need to be perl regexps matching the IMAP folders to omit
my @omit = ("Calendar", "Contacts", "Journal", "Sync Issues",
			"Tasks", "Notes", "Outbox");

STDOUT->autoflush(1);
STDERR->autoflush(1);

# Process options
my %opt = ( );
if (GetOptions(\%opt, "help", "verbose") == 0 or $opt{h}) { 
  print <<STOP;

Usage: $FindBin::Script [-help] [-verbose]

Where: -help              print this message
       -verbose           do not become a daemon and be more verbose
       
STOP
  exit;
}

# Daemonize!
sub daemon () {
    sub _fork {
        if (defined (my $pid = fork)) { return $pid; }
        else { die "cannot fork: $!"; }
    }
    
    # fork and exit parent
    if (_fork) { exit 0; }
    
    # detach ourselves from the terminal
    POSIX::setsid or die "cannot detach from controlling terminal";
    
    # prevent possibility of acquiring a controlling terminal
    $SIG{'HUP'} = 'IGNORE';
    if (_fork) { exit 0; }
    
    # change working directory
    chdir "/";
    
    # clear file creation mask
    umask 0;
    
    # close open file descriptors
    foreach my $i (0..POSIX::sysconf(&POSIX::_SC_OPEN_MAX)) { POSIX::close $i; }
    
    # Reopen stderr, stdout, stdin to /dev/null
    open STDIN,  "+>/dev/null";
    open STDOUT, "| /usr/bin/logger -p user.notice";
    open STDERR, "+>&STDOUT";
    STDOUT->autoflush(1);
    STDERR->autoflush(1);
}

my $client = "localhost:1143"; # 143 = imap - use different port
my $server = "mail.krkeegan.com:993";
my (%mua, %imap);
#KRK#daemon unless $opt{verbose};
my $inbound = new IO::Socket::INET(LocalHost => $client,
                                   Listen => 50,
                                   ReuseAddr => 1);
die "cannot open proxy socket on $client - not root?" unless $inbound;
print "$FindBin::Script listening on $client\n" if $opt{verbose};

my $select = IO::Select->new($inbound);
while (1) {
    my @ready = $select->can_read(10);
    foreach my $fd (@ready) {

        # a MUA is opening a new connection to us, open relay to server
        if ($fd == $inbound) {
            my $new_mua = $inbound->accept;
            print "$FindBin::Script connected to MUA\n" if $opt{verbose};                
            my $new_imap;
            if ($server =~ /:993/) {
 	        	$new_imap = new IO::Socket::SSL($server);
 	        } else {
 	        	$new_imap = new IO::Socket::INET($server);
			} 	        
            unless (defined $new_imap) {
                $new_mua->close;
                print "$FindBin::Script cannot connect to $server\n" if $opt{verbose};                
            } else {
                $select->add($new_mua, $new_imap);          
                $mua{$new_mua} = $new_imap;
                $imap{$new_imap} = $new_mua;
                print "$FindBin::Script connected to $server\n" if $opt{verbose};                
            }
        }
            
        # the IMAP server is sending something to the MUA, filter and relay
        if ($fd and exists $imap{$fd}) {
			my $data;
            while(1) {
                $fd->blocking(0);
				my $new_data;
                my $result = sysread $fd, $new_data, 16384;
                if (not defined $result) {
                    last if not defined $data;

					foreach my $pattern (@omit) {
	                    $data =~ s/^\* LIST (\([^)]*\))? "[^"]" "?$pattern[^\r\n]*"?\r\n//gm;
                    }
					$imap{$fd}->blocking(1);
					my $r = syswrite $imap{$fd}, $data;
					if ($opt{verbose} and $r != length $data) {
	         	       print "$FindBin::Script only wrote $r/". length $data ." bytes to $server\n";                
					}
					last;
					
                } elsif ($result > 0) {
                    $data .= $new_data;

                } elsif ($result == 0) {
                    # EOF, close the connections
                    $select->remove($fd, $imap{$fd});
                    $imap{$fd}->close;
                    delete $imap{$fd};
                    $fd->close;
                    $fd = undef; 
	                print "$FindBin::Script closed connection with $server\n" if $opt{verbose};                
                    last;
                }
            }
        }
            
        # the MUA is sending something to the IMAP server, just relay
        if ($fd and exists $mua{$fd}) {
            while (1) {
                $fd->blocking(0);
                my $result = sysread $fd, $_, 16384;
                if (not defined $result) {
                    last;
                } elsif ($result > 0) {
                    $mua{$fd}->blocking(1);
                    my $r = syswrite $mua{$fd}, $_;
					if ($opt{verbose} and $r != length $_) {
	         	       print "$FindBin::Script only wrote $r/". length $_ ." bytes to MUA\n";                
					}
                } elsif ($result == 0) {
                    # EOF, close the connections
                    $select->remove($fd, $mua{$fd});
                    $mua{$fd}->close;
                    delete $mua{$fd};
                    $fd->close;
                    $fd = undef; 
	                print "$FindBin::Script closed connection with MUA\n" if $opt{verbose};                
                    last;
                }
            }
        }        
    }
}
$inbound->close;
die "$FindBin::Script terminated (should never happen)";