#!/usr/bin/perl -w
#########################################################
$progname = "odmrd v0.7";
$scriptname = "odmrd.pl";
#
# A RFC 2645 compliant ODMR server
# written in Perl (tested with 5.6.0)
#
# http://www.plonk.de/sw/odmr/
#
# (C) 2002 by Jakob Hirsch (odmrd@plonk.de)
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
# 
# [http://www.fsf.org/licenses/gpl.txt]
#
#
# Warning: operational but still in beta status!
# 
#########################################################

$SUPPRESS_WARNERR = 1;

###
# capture warnings and errors
if ( $SUPPRESS_WARNERR ) {
  $SIG{'__WARN__'} = sub { print "400 server error\r\n"; exit; };
  $SIG{'__DIE__'}  = sub { print "400 server error\r\n"; exit; };
}

use Unix::Syslog qw(:macros);  # Syslog macros
use Unix::Syslog qw(:subs);    # Syslog functions

# open log
openlog("odmrd", LOG_PID, LOG_MAIL);

# catch warnings and errors
if ( $SUPPRESS_WARNERR ) {
 $SIG{'__WARN__'} = sub { syslog(LOG_INFO, "warning: '$_[0]'"); &end_prog; };
 $SIG{'__DIE__'}  = sub { syslog(LOG_INFO, "error: '$_[0]'"); &end_prog; };
 $SIG{ALRM} = sub {
  syslog(LOG_INFO, "connection timed out");
  myprint("421 command timeout, closing connection\r\n");
  &end_prog; };
}

#
use MIME::Base64;
use Digest::HMAC_MD5 qw(hmac_md5_hex);
use Socket;

############################################################
# Programm settings

$spool = "/var/spool/odmr";
$hostname = "";		# emtpy means we resolve interface name
$debug = 1;
$timeout_cmd = 120; 	# 2min
$timeout_msg = 1800; 	# 30min
$max_invalid_cmds = 3;
$max_invalid_auth = 3;
$max_msg_age = 5; 	# in days
$bounce_msg_lines = 15;
$lockext = "..LCK";

# mysql
#$mysql_host = "localhost";
$mysql_host = "";	# defaults to the local socket
$mysql_user = "odmr";
$mysql_pass = "xxxxxxxx";
$mysql_db   = "odmr";
$acct_mysql = 0;	# activate accounting to db

############################################################
# You usually don't have to change anything below this line
############################################################
my $localsockaddr;
my $b_in = 0;
my $b_out = 0;

# flush outputs immediatly
$| = 1;

# get own hostname
if ( ! $hostname ) {
  if ( $localsockaddr = getsockname(STDIN) ) {
    (undef, $localaddr) = sockaddr_in($localsockaddr);
    $hostname = scalar gethostbyaddr($localaddr, AF_INET) or
      $hostname = inet_ntoa($localaddr);
  }
  else { $hostname = "localhost"; }
}

# get peer information
if ( $peer = getpeername(STDIN) ) {
  ($peerport, $peerip) = sockaddr_in($peer);
  $peername = scalar gethostbyaddr($peerip, AF_INET) or 
    $peername = inet_ntoa($peerip);
  syslog(LOG_INFO, "Connection to $progname from %s (%s:%i)", 
    $peername, inet_ntoa($peerip), $peerport);
}
else {
  $peerip = inet_aton("127.0.0.1");
  $peername = "console_user";
  syslog(LOG_INFO, "Connection to $progname from local"); 
}


# startup greeting
myprint("220 $hostname $progname ODMR service ready\r\n");

# initial state (sorry for global vars)
my $gothelo = 0;
$mails_waiting = 0;
$mails_sent = 0;
$invalid_cmds = 0;
$invalid_auth = 0;
my $user = "";

alarm $timeout_cmd;
while (<STDIN>) {
  $b_in += length($_);
  s/[\r\n]//g;
  ### QUIT
  if    (/^quit$/i)	{ quit_rcvd(); }
  ### EHLO
  elsif (/^ehlo *.*$/i)	{
    syslog(LOG_INFO, "rcvd '$_'") if $debug; 
    if ( $gothelo )	{ myprint("503 duplicate EHLO\r\n"); }
    else { ehlo(); $gothelo = 1; }
  }
  ### AUTH <method>
  elsif (/^auth$/i) { print("504 no authentication method specified\r\n"); }
  elsif (/^auth .*$/i)	{
    $invalid_auth++;
    if ($invalid_auth > $max_invalid_auth) {
      myprint("421 too much authentication tries, closing connection\r\n"); 
      syslog(LOG_INFO, "421 too much authentication tries, closing connection");
      &end_prog;
    }
    if ($user) { myprint("503 already authenticated\r\n"); }
    else { 
      # open database connection
      use DBD::mysql;
      if (! $dbh) {
        $dbh = DBI->connect( "DBI:mysql:database=$mysql_db;host=$mysql_host",
          $mysql_user, $mysql_pass, { PrintError => 0, RaiseError => 0, AutoCommit => 1 });
        if ( ! $dbh ) { 
          myprint("454 Temporary authentication failure\r\n");
          syslog(LOG_INFO, "error connecting to db: '%s'", $DBI::errstr);
	  &end_prog;
        }
      }
      $user = auth($_, $dbh) if $dbh;
    }
  }
  ### ATRN [domains]
  elsif (/^atrn *.*$/i)	{
    if ($user) { atrn($user, $_, $dbh); }
    else { myprint("530 authentication required\r\n"); }
  }
  ### invalid command
  else			{
    $invalid_cmds++;
    if ($invalid_cmds > $max_invalid_cmds) {
      syslog(LOG_INFO, "too much invalid commands, closing connection");
      myprint("421 too much invalid commands, closing connection\r\n");
      &end_prog;
    }
    syslog(LOG_INFO, "rcvd '$_' (unknown command)") if $debug;
    myprint("502 unknown command '$_'\r\n");
  }
  alarm $timeout_cmd;
}
	
syslog(LOG_INFO, "Lost connection");
&end_prog;


#########################################################
#########################################################
sub ehlo
{
myprint("250-$hostname Hello ", $peername, " [", inet_ntoa($peerip), "]\r\n");
myprint("250-AUTH CRAM-MD5 LOGIN\r\n");
myprint("250 ATRN\r\n");
}

#########################################################
#########################################################
# -> "AUTH <data>", $dbh
# <- $user
sub auth
{
my $dbh = $_[1];
my $s = "";
my $user = ""; 
my ($resp, $chal, $pass);
my $authmethod = "";
my $authdata = "";
my $authrc = 1;

(undef, $authmethod, $authdata, undef) = split /[ ,]/, $_;
$authmethod = lc($authmethod);

if ( $authmethod eq "cram-md5" ) {
  # CRAM-MD5
  $chal = "<".rand(65536).".".$$.".".time."@".$hostname.">";
  $s = encode_base64($chal);
  chomp $s;
  myprint("334 $s\r\n");

  alarm $timeout_cmd;
  $s = <STDIN>; $b_in += length($s);
  $s =~ s/[\r\n]//g;
  if ( !($s) or $s eq "*" ) {
    myprint("501 authentication cancelled\r\n");
    return;
  }
  ($user, $resp) = split " ", decode_base64($s);
  #$s = pass($chal, $user, $resp, $dbh);
  my $sth = $dbh->prepare("SELECT pass FROM odmr_user WHERE user = '$user'");
  if ($sth->execute) {
    my $rv = $sth->rows;
    my $pass = $sth->fetchrow_array;
    $sth->finish;
    if (($rv == 1) and (hmac_md5_hex($chal, $pass) eq $resp)) { $authrc = 0; }
    else { $authrc = 1; }
  }
  else { $authrc = 2; }
}
elsif ( $authmethod eq "login" ) {
  # LOGIN
  $s = decode_base64($authdata);
  ($user, $pass) = split /\000/, $s;
  my $sth = $dbh->prepare("SELECT pass FROM odmr_user WHERE user = '$user'");
  if ($sth->execute) {
    my $rv = $sth->rows;
    my $password = $sth->fetchrow_array;
    $sth->finish;
    if (($rv == 1) and ($pass eq $password)) { $authrc = 0; }
    else { $authrc = 1; }
  }
  else { $authrc = 2; }
} 
else {
  myprint("504 unknown authentication method '$authmethod'\r\n");
  syslog(LOG_INFO, "unknown authentication method '%.30s'", $authmethod);
  $s = "";
}

# password is ok
if ( $authrc == 0 ) {
  # try to lock
  my $t = lock_user($user);
  if ($t)
  { 
    myprint("454 User locked by another connection\r\n");
    syslog(LOG_INFO, "'AUTH' ($user) locked by pid $t");
    $user = "";
  }
  # ok, go on
  else {
    myprint("235 authenticated $user\r\n");
    syslog(LOG_INFO, "rcvd 'AUTH' ($user)");
  }
}
# wrong password
elsif ( $authrc == 1 ) {
  myprint("535 authenticating '$user' failed\r\n");
  syslog(LOG_INFO, "'AUTH' ($user) failed");
  $user = "";
}
# db error
elsif ( $authrc == 2 ) {
  myprint("454 Temporary authentication failure\r\n");
  syslog(LOG_INFO, "'AUTH' ($user) failed, db error '%s'", $DBI::errstr);
  $user = "";
}

return $user;
}

#########################################################
#########################################################
# -> $user
# <- 0 (ok) or pid of locking process
sub lock_user
{
my $user = $_[0];
my $rc = 0;
my $t;
my $lockfile = $spool."/".$user.$lockext;

# check if lockfile exists
if (-f $lockfile)
{
  # read lockfile
  if ( ! open(LOCK, $lockfile) )
  {
    myprint("454 temporary server error\r\n");
    syslog(LOG_INFO, "Fatal: Could not open lockfile $lockfile for reading");
    $user="";
    &end_prog;
  }
  else
  {
    if ( !($rc = <LOCK>)) { $rc = ""};
    close LOCK;

    # check if pid is alive and odmr
    if ( $rc && open(PROC, "/proc/$rc/stat") )
    {
      (undef, $t, undef) = split " ", readline(PROC);
      close(PROC);
      if ($t ne  "($scriptname)")
      {
        syslog(LOG_INFO, "pid $rc $t is not $scriptname, removing lockfile $lockfile");
        unlock_user($user);
        $rc = 0;
      }
    }
    else
    {
      syslog(LOG_INFO, "pid $rc is dead, removing lockfile $lockfile");
      unlock_user($user);
      $rc = 0;
    }
  }
}

if ($rc == 0)
{
  # write lockfile
  if ( open(LOCK, ">".$lockfile) )
  {
    # write pid into lockfile
    print LOCK $$;
    close LOCK;
  }
  else 
  {
    syslog(LOG_INFO, "Could not create $lockfile");
    $rc = "LOCK_FAILURE";
  }
}

return $rc;
}

#########################################################
#########################################################
# -> $user
# <- 1 (ok), 0 (error)
sub unlock_user
{
my ($user) = @_;
my $rc = 1;
my $unlinkrc;
my $lockfile = $spool."/".$user.$lockext;

$unlinkrc = unlink($lockfile);

if ( $unlinkrc == 1 ) { $rc = 1; }
else { syslog(LOG_INFO, "could not remove lockfile $lockfile ($unlinkrc)"); $rc = 0; }

return $rc;
}

#########################################################
#########################################################
# -> $chal, $user, $resp, $dbh
# <- 0/1
sub pass
{
my $chal = $_[0];
my $user = $_[1];
my $resp = $_[2];
my $dbh  = $_[3];
my $rc = 0;

my $sth = $dbh->prepare("SELECT pass FROM odmr_user WHERE user = '$user'");
if ($sth->execute) {
  my $rv = $sth->rows;
  my $pass = $sth->fetchrow_array;
  $sth->finish;
  
  if ( $rv == 1 and hmac_md5_hex($chal, $pass) eq $resp ) { $rc = 0; } 
  else { $rc = 1; }
}
else { $rc = 2; }

return $rc;
}

#########################################################
#########################################################
# -> $user, "atrn <domains>", $dbh
sub atrn
{
my $user = $_[0];
my @domains = split /[ ,]/, $_[1];
shift @domains;
my $dbh = $_[2];

my @domnot = ();
my $unlinked;
my $s;
my $msg;

if ( $#domains == -1 ) {
  syslog(LOG_INFO, "rcvd 'ATRN' (all domains)");
  my $domain_ref = $dbh->selectcol_arrayref("SELECT domain FROM odmr_domains WHERE user = '$user'");
  @domains = @{$domain_ref};
  if ( $#domains == -1 ) { syslog(LOG_INFO, "No domains in db!?"); }
  #syslog(LOG_INFO, "Domains: %s", join(' ', @domains)) if $debug;
}
else { 
  syslog(LOG_INFO,"rcvd 'ATRN %s'", join(',', @domains)); 
  foreach (@domains) {
    $sth = $dbh->prepare("SELECT domain FROM odmr_domains WHERE user = '$user' AND domain = '$_'");
    if ( ! $sth ) {
      myprint("451 temporary server error\r\n");
      syslog(LOG_INFO, "db err '%s'", $DBI::err);
      &end_prog;
    }
    $sth->execute;
    if ( $sth->rows == 0 ) { 
      push(@domnot, $_);
    }
    #elsif ( $debug ) { syslog(LOG_INFO, "Domain '$_' accepted"); }
    $sth->finish;
  }
}
#close db-connection
#my $rc  = $dbh->disconnect;

my $no_mail_waiting = 1;

if ( @domnot ) {
	syslog(LOG_INFO,"error: not authorized for '%s'!", join(',', @domnot));
	print "450 ATRN request for ".join(',', @domnot)." refused\r\n";
}
else {
  foreach $dom (@domains) {
    my $dir = $spool."/".$dom."/";
    opendir(DIR, $dir) || next;
    my @msgs = readdir(DIR);
    foreach $msg (@msgs) {
      next if $msg =~ /^\..*$/;		# skip . and ..
      $mails_waiting++;			# count messages
      if ($no_mail_waiting) {		# start ATRN
        $no_mail_waiting = 0;
        # inital smtp dialogue
        myprint("250 ok, turnaround now\r\n");
        alarm $timeout_cmd;
	$s = <STDIN>; $b_in += length($s);
        while (substr($s, 0, 4) eq "220-") { 
          alarm $timeout_cmd;
          $s = <STDIN>; $b_in += length($s);
        }
        if (substr($s, 0, 3) ne "220") {
	  $s =~ s/[\r\n]//g;
          syslog(LOG_INFO, "rcvd '$s' (on turnaround)");
          quit_smtp();
        }  
        myprint("HELO $hostname\r\n");
        if (substr(<STDIN>, 0, 3) ne "250") {
          $b_in += length($_);
          $s =~ s/[\r\n]//g;
          syslog(LOG_INFO, "rcvd '$s' (on HELO)");
          quit_smtp();
        }
      }

      # send mail
      my $send_smtp_rc;
      $send_smtp_rc = send_smtp($dir, $msg);
      if ($send_smtp_rc == 1) {
        $mails_sent++;
        $unlinked = unlink($dir.$msg); 
        if ($unlinked != 1) { syslog(LOG_INFO, "warning: unlink ${dir}${msg} = $unlinked"); }
      }
      else { syslog(LOG_INFO, "message delivery failed ($send_smtp_rc)"); }

      # "RSET"
      myprint("RSET\r\n");
      alarm $timeout_cmd;
      if (substr(<STDIN>, 0, 3) ne "250") {
        $s =~ s/[\r\n]//g;
        syslog(LOG_INFO, "rcvd '$s' (on RSET)");
        quit_smtp(); 
      }
      #$b_in += length($_);
    }
    closedir(DIR);
  }
}

if ($no_mail_waiting) { 
  myprint("453 no mail waiting\r\n");
  syslog(LOG_INFO,"no mail waiting");
  alarm $timeout_msg;
  while(<STDIN>) {
    $b_in += length($_);
    s/[\r\n]//g;
    if    (/^quit$/i)       { quit_rcvd(); }
    if    (/^atrn$/i)       { myprint("453 no mail waiting, please quit!\r\n"); }
    else                    {
      $invalid_cmds++;
      if ($invalid_cmds > $max_invalid_cmds) {
        syslog(LOG_INFO, "too much invalid commands, closing connection");
        myprint("421 too much invalid commands, closing connection\r\n");
        &end_prog;
      }
      else {
        syslog(LOG_INFO, "rcvd '$_' (unknown command)") if $debug;
        myprint("502 unrecognised command '$_'\r\n");
      }
    }
    alarm $timeout_cmd;
  }
}

quit_smtp();
}

#########################################################
#########################################################
# -> $dir.$msg
# <- $rc ( 0: failed; 1: ok; 2: error in msg )
sub send_smtp
{
my ($s, $t, $m, $i);
my $rc = 1;
my $recipients = 0;
my $valid_recipients = 0;
my %temp_rejected_recipients = ();
my %perm_rejected_recipients = ();
my $state = "mail";
my $dir = $_[0];
my $msg = $_[1];
my $file = $dir.$msg;
my $sender = "";
my $err_msg = "";
my $msg_age = int(-M $file);

if (! open(MSG, $file)) { 
	syslog(LOG_INFO, "error: could not open $file");
	return 0;
}
else { syslog(LOG_INFO, "sending $file"); }

## envelope

# MAIL FROM
$m = <MSG>;
if ( $m =~ /^MAIL FROM:.*$/i ) {
  # MAIL FROM:
  myprint($m);

  # extract sender (for bounces)
  $m =~ s/[\r\n]//g; # "MAIL TO"-line
  (undef, $sender) = split (':', $m);
  $sender =~ s/[<>]//g;
 
  alarm $timeout_cmd;
  $s = <STDIN>; $b_in += length($s);
  if ($s =~ /^250/) { $state = "rcpt"; }
  else {
    # Sender rejected
    $s =~ s/[\r\n]//g; # response
    syslog(LOG_INFO, "smtp error: rcvd '$s' on $m");
    if ($s =~ /^5/) {
      $err_msg = "A message that you sent could not be delivered. The remote server rejected \n";
      $err_msg .= "your sender address ('$sender').\n";
      $err_msg .= "Communication excerpt:\n\n";
      $err_msg .= $m."\n".$s."\n\n";
    }
    elsif ($msg_age >= $max_msg_age) {
      $err_msg = "A message that you sent could not be delivered for $msg_age days.\n";
      $err_msg .= "Communication excerpt:\n\n";
      $err_msg .= $m."\n".$s."\n\n";
    }
    else { $rc = 0; }
  }
}
else {
  # not MAIL FROM
  $rc = 2;
  $m =~ s/[\r\n]//g;
  syslog(LOG_INFO, "msg error: '$m' should start 'MAIL FROM:'");
}

# RCPT TO
if ($state eq "rcpt") {
  while ($m = <MSG>) {
    # last recipient?
    last if ( $m =~ /DATA/i);
    if ( $m =~ /^RCPT TO:.*$/i ) {
      # RCPT TO:
      $recipients++;
      myprint($m);
      alarm $timeout_cmd;
      $s = <STDIN>; $b_in += length($s);
      if ($s =~ /^250/) { $valid_recipients++; }
      else {
        # RCPT was rejected
        $m =~ s/[\r\n]//g; # "RCPT TO"-line
        $s =~ s/[\r\n]//g; # response
        syslog(LOG_INFO, "smtp error: rcvd '$s' on $m");
        # extract recipient and put into %xxxx_rejected_recipients
	(undef, $t) = split (':', $m);
	$t =~ s/[<>]//g;   # recipient
        if (($s =~ /^5/) || $msg_age >= $max_msg_age  ) { $perm_rejected_recipients{$t} = $s; }
        else { $temp_rejected_recipients{$t} = $s; }
      }
    }
    else {
      # not RCPT TO
      $rc = 2;
      $m =~ s/[\r\n]//g;
      syslog(LOG_INFO, "msg error: '$m' should start 'RCPT TO:'");
    }
  }
  if ($valid_recipients != 0 && $rc == 1 ) { $state = "data"; }
}

# DATA
if ($state eq "data") {
  myprint("DATA\r\n");
  alarm $timeout_cmd;
  $s = <STDIN>; $b_in += length($s);
  if ($s =~ /^354/) { $state = "msg"; }
  else {
    $s =~ s/[\r\n]//g;
    syslog(LOG_INFO,"smtp error: rcvd '$s' on DATA");
    if ($s =~ /^5/) {
      $err_msg = "A message that you sent could not be delivered. This is a permanent error.\n";
      $err_msg .= "Communication excerpt:\n\n";
      $err_msg .= $m."\n".$s."\n\n";
    }
    elsif ($msg_age >= $max_msg_age) {
      $err_msg = "A message that you sent could not be delivered for $msg_age days.\n";
      $err_msg .= "Last communication excerpt:\n\n";
      $err_msg .= $m."\n".$s."\n\n";
    }
    else { $rc = 0; }
  }
}

# message
if ($state eq "msg") {
  alarm $timeout_msg;
  # sending message (buffered)
  $| = 0;
  # don't use myprint to speed up things a little
  while ( <MSG> ) { print $_; $b_out += length($_); }
  $| = 1;

  # check if message was accepted
  alarm $timeout_cmd;
  $s = <STDIN>; $b_in += length($s);
  if ($s =~ /^250/) { }
  else {
    $s =~ s/[\r\n]//g;
    syslog(LOG_INFO,"smtp error: rcvd '$s' on terminating dot");
    if ($s =~ /^5/) {
      $err_msg = "A message that you sent could not be delivered. This is a permanent error.\n";
      $err_msg .= "Communication excerpt:\n\n";
      $err_msg .= $m."\n".$s."\n\n";
      $remove_msg = 1;
    }
    elsif ($msg_age >= $max_msg_age) {
      $err_msg = "A message that you sent could not be delivered for $msg_age days.\n";
      $err_msg .= "Last communication excerpt:\n\n";
      $err_msg .= $m."\n".$s."\n\n";
      $remove_msg = 1;
    }
    else { $rc = 0; }
  }    
}

# rejected recipients
if ( $rc == 1 && (%perm_rejected_recipients || %temp_rejected_recipients) ) {
  if ( $valid_recipients || %perm_rejected_recipients ) {
    # write new message for tempory rejected recipients (ugly but functional)
    if ( %temp_rejected_recipients ) {
      # skip envelope
      seek(MSG, 0, 0);
      $m = "";
      while ( $m ne "DATA" ) {
        $m = <MSG>;
        $m =~ s/[\r\n]//g;
      }

      # put message into a new file
      my $newfile = $msg;
      $newfile =~ s/\..*//;
      $newfile = $dir.$newfile;
      $newfile .= ".".time().".$$";
      if (! open(NEWMSG, ">$newfile") ) {
        syslog(LOG_INFO, "error: could not write $newfile" );
        $rc = 0;
      }
      else {
        syslog(LOG_INFO, "writing $newfile for temporarily rejected recipients %s", 
          join(", ", keys %temp_rejected_recipients) );

        print NEWMSG "MAIL FROM:<$sender>\r\n";
        foreach (keys %temp_rejected_recipients)
          { print NEWMSG "RCPT TO:<$_>\r\n"; }
        print NEWMSG "DATA\r\n";
        while (<MSG>) { print NEWMSG $_; }
        close(NEWMSG);
      }
    }
  }
  else {
    syslog(LOG_INFO, "all $recipients recipients were temporarily rejected");
    if ($msg_age < $max_msg_age) { $rc = 0; }
  }

  # bounce for permanent rejected recipients
  if ( %perm_rejected_recipients ) {
    $err_msg = "A message that you sent could not be delivered to one or more of its\n";
    $err_msg .= "recipients. This is a permanent error. The following address(es) failed:\n\n";
    foreach $s (keys %perm_rejected_recipients) 
      { $err_msg .= "  ".$s."\n    ".$perm_rejected_recipients{$s}."\n"; }
  }
}

if ($err_msg) { bounce_msg($sender, $err_msg); }

close(MSG);
return $rc;
}

#########################################################
#########################################################
# -> $sender, $err_msg
# <- $rc ( 0: failed; 1: ok )
sub bounce_msg
{
my $sender = $_[0];
my $err_msg  = $_[1];
my $m;

syslog(LOG_INFO, "bouncing mail from $sender");

seek(MSG, 0, 0);
# skip envelope
$m = "";
while ( $m ne "DATA" ) {
  $m = <MSG>;
  $m =~ s/[\r\n]//g;
}

open(BOUNCE, "|sendmail -f '<>' '$sender'");
print BOUNCE "From: Mail Delivery System <Mailer-Daemon>\n";
print BOUNCE "To: $sender\n";
print BOUNCE "Subject: Mail delivery failed: returning message to sender\n";
print BOUNCE $err_msg;
print BOUNCE "\n------ This is a copy of the message, including all the headers. ------\n\n";

# header
while ( $m && !eof(MSG)) {
  $m = <MSG>;
  $m =~ s/[\r\n]//g;
  print BOUNCE $m."\n";
}
# top of message (first $bounce_msg_lines lines)
for ($i=0; $i<$bounce_msg_lines && ! eof(MSG); $i++) {
  $m = <MSG>;
  $m =~ s/[\r\n]//g;
  print BOUNCE $m."\n";
}

close(BOUNCE);

return 1;
}

#########################################################
#########################################################
sub quit_rcvd
{
myprint("221 have a nice day\r\n");
syslog(LOG_INFO, "rcvd 'QUIT', %i/%i mails sent, %i/%i bytes sent/rcvd", 
  $mails_sent, $mails_waiting, $b_out, $b_in);
&end_prog;
}

###
sub quit_smtp
{
myprint("QUIT\r\n");
alarm $timeout_cmd;
if (substr(<STDIN>, 0, 3) ne "221") { $b_in += length($_); myprint("sorry, could not quit\r\n"); }
syslog(LOG_INFO, "sent 'QUIT', %i/%i mails sent, %i/%i bytes sent/rcvd",
  $mails_sent, $mails_waiting, $b_out, $b_in);
&end_prog;
}

###
sub end_prog
{
if ($user) {
  if ( $acct_mysql and mysql_acct($user, $b_in, $b_out) )
    { syslog(LOG_INFO, "could not account to database: user $user, sent $b_out, rcvd $b_in"); }
  unlock_user($user);
}
closelog();
$dbh->disconnect if $dbh;
exit;
}

###
sub myprint
{
foreach (@_) {
  $b_out += length($_);
  print $_;
}
}

###
sub mysql_acct
{
my ( $user, $b_in, $b_out ) = @_;
my $sth;

my ( undef, undef, undef, $mday, $mon, $year, undef ) = localtime(time);
$mon++;
$year += 1900;
my $date = sprintf "%.4i%.2i%.2i", $year, $mon, $mday;

$sth = $dbh->prepare("SELECT b_in, b_out FROM odmr_acct WHERE user = '$user' AND date = '$date'");
return 1 if ! $sth->execute;

my $rows = $sth->rows;
if ($rows == 0) {
  # no data for today
  $sth = $dbh->prepare("INSERT INTO odmr_acct (user, date, b_in, b_out) VALUES ('$user', '$date', '$b_in', '$b_out')");
  return 1 if ! $sth->execute;
}
elsif ($rows == 1) {
  # update accounting data for today
  my ($b_in_old, $b_out_old) = $sth->fetchrow_array;
  $b_in += $b_in_old; $b_out += $b_out_old;
  $sth = $dbh->prepare("UPDATE odmr_acct SET b_in = '$b_in', b_out = '$b_out' WHERE user = '$user' AND date = '$date'");
  return 1 if ! $sth->execute;
}
else {
  syslog(LOG_INFO, "Warning! $rows entries of '$user' for '$date'!");
  return 1;
}

return 0;
}