[Kolab-devel] hello, are you in there?

[Wenzel Peppmeyer]

Hi,

at my company we have some "quality" standards. One of them force us to 
setup a absence notice if we leave for some days. I do not and I know why.

Outlook has a nice way to set up such a automatic massage and every few 
weeks someone call me to switch it off, bcause it plays ping pong with 
some other automatic absence notice. Kolab + some windows client doesn't 
have such a mechanism and I was force to build one.

It works as a content_filter for postfix and is configured like a mail 
bot you might know from mailinglists. I will not give a detailed install 
description at this point. Why? Well, my mailserver is able to pump 100 
small mails per second. Your might too.

To prevent ping pong situations I have teached it to check for well 
known sender adresses and to not send more then one notice for 10 
minutes to one sender.

It would be nice if someone can have a look at this work in progress and 
tell me how stupid I am. ;) If you want to do so, you will need the 
following modules from CPAN and GNU/Debian packages.

apt-get install perl-modules

Mail::Sendmail
MIME::Parser
IO::Stringy
MLDBM
DB_File
Class::Date

mfg

Wenzel Peppmeyer

------------------------------- schnipp -----------------------------

#! /bin/sh

# /usr/local/bin/filter

INSPECT_DIR=/var/spool/filter
SENDMAIL='/kolab/sbin/sendmail -i'

EX_TEMPFAIL=75
EX_UNAVAILABLE=69

trap "rm -f in.$$" 0 1 2 3 15

cd $INSPECT_DIR || { echo $INSPECT_DIR does not exists; exit $EX_TEMPFAIL; }

cat >in.$$ || { echo Cannot save mail to file; exit $EX_TEMPFAIL; }

# filter $@ <in.$$ || { echo Message content rejected; exit 
$EX_UNAVAILABLE; }

/usr/local/bin/absence-reply-bot.pl $@ <in.$$ 2>>/var/spool/filter/error.log

$SENDMAIL "$@" <in.$$

exit $?

------------------------------- schnipp -----------------------------

#! /usr/bin/perl

# /usr/local/bin/absence-reply-config-bot.pl

# This script receives a message and strip the first 3 lines.
# Information who and when absence notices will send are
# gatherd form this 3 lines and stored in hash tie
# format of first 3 lines:
#   someone at some.where
#   20030820.1100-20030910.0000

# BEWARE there is a hardcoded domain check for the sender of the absence
# notice below.

use strict;
use DB_File;
use Mail::Sendmail;

# /var/log/absence-reply/ -- logfile path
# /var/lib/absence-reply/ -- data path

# logfile path
my $log_path = '/var/log/absence-reply';
# data path
my $data_path= '/var/lib/absence-reply';

# store message and info in DB

use MLDBM qw(DB_File Storable);

# Build hash tie for holding absence message and metadata.
# fields in t_sender:
#  sender -- RCPT for witch will send notice
#  as_of -- start date/time for reply
#  until -- end date/time for reply
#  subject -- subject of reply
#  message -- message to send
tie(my %t_sender, 'MLDBM', "$data_path/t_sender.db", O_CREAT|O_RDWR, 0600)
	or die "$!\n";

use MIME::Parser;

# Parse incomming Message and gather information.
my $parser = new MIME::Parser;
$parser->output_under("/tmp/");
my $entity = $parser->parse(\*STDIN);
my $header = $entity->head;
my $body = $entity->body_as_string;
my $sender = lc($header->get('From'));
my $subject = $header->get('Subject');

my $absence = exists $t_sender{$sender} ? $t_sender{$sender} : {};

my $back_message;
my $back_subject;

if( $body =~ 
m/([^@]*\@lcrgmbh.de)\n(\d{8,})\.(\d{4})-(\d{8,})\.(\d{4})\n\n(.*)/m ) {
	%$absence = ('sender', $1, 'as_of', "$2.$3", 'until', "$4.$5", 
'message', $6, 'subject', $subject);
	$back_message .= "auto reply for: $$absence{sender}\n";
	$back_message .= "subject: $$absence{subject}";
	$back_message .= "as of $$absence{as_of}\n";
	$back_message .= "until $$absence{until}\n";
	$back_subject .= "Auto reply for $$absence{sender} has been set.";

	$t_sender{$$absence{sender}} = $absence;
} elsif ($body =~ m/get\s+([^@]*\@lcrgmbh.de)/m ) {
	if ( exists $t_sender{$1} ){
		$absence = $t_sender{$1};
		
		$back_message .= "$$absence{sender}\n";
   	$back_message .= "$$absence{as_of}-$$absence{until}\n\n";
		$back_message .= "$$absence{message}";
   	$back_subject .= "$$absence{subject}";
	} else {
		$back_message .= "";
	  $back_subject .= "No auto reply for $1 has been set.";
	}
} else {
	$back_message .= "I can't get informations from top of body.\n";
	$back_message .= "Absence notice not set.\n";
	$back_subject .= "failed! Cant set absence notice.\n";
}

`echo absence-reply-config-bot: date +"%Y%m%d.%H%M%S" > $log_path/log.txt`;

# sending status for absence back to sender;

my %mail = (To => "$sender", From => 'no-reply at lcrgmbh.de',
            Subject => "$back_subject", Message => "$back_message" );
sendmail( %mail);

------------------------------- schnipp -----------------------------

#! /usr/bin/perl -w

# /usr/local/bin/absence-reply-bot.pl

# This bot replies to incomming mail with a stored message.
# It makes some checks to not send to mailing lists or
# play ping pong with MS Exchange.

use strict;

use DB_File;
use MLDBM qw(DB_File Storable);
use MIME::Parser;
use Mail::Sendmail;
use Class::Date qw(date);

# $Class::Date::DATE_FORMAT = "%Y%m%d%H%M%S";

my @saved_argv = @ARGV;

my $log_path = '/var/log/absence-reply';
my $data_path = '/var/lib/absence-reply';

tie(my %t_sender, 'MLDBM', "$data_path/t_sender.db", O_RDONLY)
	or die "$!\n";
	
tie(my %t_feeded_address, 'MLDBM', "$data_path/t_feeded_address.db", 
O_CREAT|O_RDWR, 0600)
	or die "$!\n";
	
# fetch mail from STDIN
	
my $parser = new MIME::Parser;
$parser->output_under('/tmp/');
my $entity = $parser->parse(\*STDIN);

my $sender = $entity->head->get('Reply-To') || $entity->head->get('From');
chomp($sender);
my $recipient = $entity->head->get('To');
chomp($recipient);

print STDERR $entity->head->get('From'), $entity->head->get('Sender'), "\n";

if( $recipient =~ m/<(\S+@\S+)>/ ){
   $recipient = "$1";
}

if ( $sender =~ 
m/(no-reply|noreply|postmaster|nobody|mailer-daemon|root)\@*./i ) {
	# We got an email from a daemon. Replys will loop or went to /dev/null.
	# So we dont do some.
	
	# If we do nothing, we don't send.
	
} elsif ( ($entity->head->get('From') && $entity->head->get('Sender')) 
&& ( $entity->head->get('From') ne $entity->head->get('Sender') ) ) {
	# We habe a From and a Sender header field and these are not equal.
	# We will not reply.
	# See RFC 822 4.4.1 and 4.4.2 for details.
	# I have seen a lot of mail from mailing lists behave that way.
	
} elsif ( exists $t_feeded_address{$sender . $recipient} && date( 
$t_feeded_address{$sender . $recipient} ) + '10m' > date("now") ) {
	# We want to check for Exchange Servers that play ping pong with us
	# or users that don't know what "Reply-To: no-reply@*" means.
	# Outgoing Replys are stored by e-mail address and checked for
	# sending more then one mail per 10 minutes.
	
#	print STDERR "10 minute block\n";
} elsif ( exists $t_sender{$recipient} ){
     # RCPT is in absence table.

     my $absence = $t_sender{$recipient};
	
     my $now = `date +"%Y%m%d.%H%M"`;
	
     if( $$absence{as_of} lt $now and $now lt $$absence{until} ){
         # We have an absence entry and we are in time window.

         my %mail = ( 'To' => $sender,
         						 'From' => $recipient,
         						 'Reply-To' => 'no-reply at lcrgmbh.de',
	                   'Subject' => $$absence{subject},
	                   'Sender' => 'absence-reply-bot at lcrgmbh.de',
	                   'Foo' => 'Bar',
	                   'Message' => $$absence{message}
	                 );
         sendmail( %mail );

         # Store timestamp for ping pong check.
         $t_feeded_address{$sender . $recipient} = "". date("now");
     }
}

$parser->filer->purge();

# We don't want collect address until the volume is full.
foreach my $key (keys %t_feeded_address){
	if ( date( $t_feeded_address{$key} ) + '10m' < date("now")){
		delete( $t_feeded_address{ $key } );
	}
}