#!/usr/bin/perl
#Copyright (c) 2007, Zane C. Bowers
#All rights reserved.
#
#Redistribution and use in source and binary forms, with or without modification,
#are permitted provided that the following conditions are met:
#
#   * Redistributions of source code must retain the above copyright notice,
#    this list of conditions and the following disclaimer.
#   * Redistributions in binary form must reproduce the above copyright notice,
#    this list of conditions and the following disclaimer in the documentation
#    and/or other materials provided with the distribution.
#
#THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
#ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 
#WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
#IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
#INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 
#BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 
#DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
#LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
#OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
#THE POSSIBILITY OF SUCH DAMAGE.

#use POSIX ":sys_wait_h";
use IO::Select;
use IO::Socket;
use strict;
use warnings;
use Net::Server::Mail::ESMTP;
use Authen::Simple::PAM;
use Net::LDAP;
use Getopt::Std;
use Config::Tiny;
use Sys::Syslog;
use Net::SMTP::TLS;
#Net::SMTP_auth is being used because Net::SMTP::TLS does not support allowing auth types to be selected
use Net::SMTP_auth;
use File::Copy;
use Net::RBLClient;
use Mail::SpamAssassin;
use Net::LDAP::LDAPhash;
use IPC::Shareable (':lock');

#needs to be set to IGNORE to avoid zombies or exiting oddly and unexpectedly under FreeBSD
$SIG{CHLD} = 'IGNORE';
#$SIG{CHLD} = \&REAPER;
#my %children = ();   # keys are current child process IDs
#my $children = 0;    # current number of children
#print "pid=".$$."\n";
#sub REAPER {
#   $SIG{CHLD} = \&REAPER;
#   my $pid = wait;
#   $children--;
#   delete $children{$pid};
#   print "reaping child $pid\n"; 
#}

#print version
sub main::VERSION_MESSAGE {
	print "zms 1.7.0\n";
};

#exit after printing help or version
$Getopt::Std::STANDARD_HELP_VERSION="TRUE";

#print help
sub main::HELP_MESSAGE {
	print "\n".
		"-b <baseDN>  the base DN to be used\n".
		"-c <file>   config file to use\n".
		"-f   enable forking\n".
		"-i   do the IO on STDIN/STDOUT for with like inetd\n".
		"-h   print this\n".
		"-u <userDN>   the user DN to be used\n".
		"-U <user>   the user to setuid to\n".
		"-v   print the version info\n";
};

###############################################################################
#copyright info for &mwcqbinder
#
#old code writen while I was working at Midwest Connections Inc.
#
#Copyright (c) 2006, Midwest Connections Inc.
#All rights reserved.
#
#Redistribution and use in source and binary forms, with or without 
#modification, are permitted provided that the following conditions are met:
#
#    * Redistributions of source code must retain the above copyright notice,
#		this list of conditions and the following disclaimer.
#    * Redistributions in binary form must reproduce the above copyright notice,
#		this list of conditions and the following disclaimer in the documentation
#		and/or other materials provided with the distribution.
#    * Neither the name of the Midwest Connections Inc. nor the names of its
#		contributors may be used to endorse or promote products derived from
#		this software without specific prior written permission.
#
#THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
#AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
#IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
#ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE
#FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
#DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
#SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
#CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
#OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
#THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

#quickly binds to a LDAP server and returns it.
sub mwcqbinder{
	my $binder=$_[0];
	my $password=$_[1];
	my $server=$_[2];
	my $port=$_[3];
	my $errorMethode=$_[4];#0 continue and return error
						   #1 exit with error and be verbose
						   #2 exit with error and be quiet

	#sets the port if it is not defined
	if (!defined($port)){
		$port="389";
	};
	
	#sets the $errorMethode if it is not defined
	if (!defined($errorMethode)){
		$errorMethode="1";
	};
	
	my %ldapconnection=();
	
	#connect to the ldap server
	$ldapconnection{ldap} = Net::LDAP->new( $server ) or $ldapconnection{status}=0;
	#checks if the status is equal to 0.
	if (defined($ldapconnection{status}) && $ldapconnection{status} == 0){
		if ($errorMethode == 0){
			$ldapconnection{LONGerror}="Could not contact the server.";
###############################################################################
#old code commented out... this is not how this should return an error...
#			return 1;
#end of old code
###############################################################################
#my new code... not connected to Midwest Connectins Inc.
			$ldapconnection{status}=0;
			return %ldapconnection;
#end of new code
###############################################################################
		};
		if ($errorMethode == 1){
			print "Could not contact the server.\n".
				"server: ".$server."\nport: ".$port."\n";			
			exit 1;
		};
		if ($errorMethode == 2){		
			exit 1;
		};
	};

	$ldapconnection{bindMesg} = $ldapconnection{ldap}->bind( $binder, password=>$password, version=>3 );
	if ($ldapconnection{bindMesg}->code) { #check for a failed bind
		if ($errorMethode == 0){
			$ldapconnection{status}=0;
			$ldapconnection{LONGerror}="Could not bind to the server.";
			return %ldapconnection;
		};
		if ($errorMethode == 1){
			print "Could not bind to the server.\nserver: ".$server."\nport: ".$port.
			"\nbinder: ".$binder."\n";
			exit 1;
		};
		if ($errorMethode == 2){
			exit 1;
		};
	}
	
	$ldapconnection{status}=1;
	return %ldapconnection
};
###############################################################################
#end copy from old code writen when I was working at Midwest Connections Inc.
###############################################################################

#declared here to prevent errors with &validate_recpipient
my @local_domains;

#validates a recipient
sub validate_recipient{
	my($session, $recipient) = @_;

	my $domain;
	if($recipient =~ /@(.*)>\s*$/){
		$domain = $1;
	};

	if(not defined $domain){
		return(0, 513, 'Syntax error.');
	}elsif(not(grep $domain eq $_, @local_domains)){
		#returns false if user is not authenticated.
		if(!defined($session->{AUTH}->{username})){
			return(0, 554, "$recipient: Recipient address rejected: Relay access denied");
		};
	};
		return(1);
};

#checks auth
sub validate_auth{
	my ($session, $username, $password) = @_;

	my $pam = Authen::Simple::PAM->new(service=>"smtp");

	if ($pam->authenticate( $username, $password)) {
		return 1;
	}else{
		return 0;
	};

};

#Gets the out going server information.
sub get_outgoing_server_info{
	my ($session) = @_;
	
	#the hash that will hold the info returned
	my %outgoing_server_info;
	
	#set the status to error
	$outgoing_server_info{status}="0";
	
	#the user that this will bind ass
#	my $LDAPuser="uid=".$session->{AUTH}->{username}.",".$session->{zmsConfig}->{userBaseDN};
	
	#the base DN that zmsAccount enteries will be looked for in
	my $baseDN="ou=zms,ou=.config,ou=".$session->{AUTH}->{username}.",".$session->{zmsConfig}->{homeOU};
	
	#binds to the server... do not exit on error here
	my %ldapconnection=mwcqbinder($session->{zmsConfig}->{userDN}, $session->{zmsConfig}->{password}, $session->{zmsConfig}->{LDAPserver},
		$session->{zmsConfig}->{LDAPport}, "0");
	
	#return if a connection could not be established
	if ($ldapconnection{status}=="0"){
		$outgoing_server_info{error}="could not bind to server to look up out going server info";
		return %outgoing_server_info;
	}
	
	my $mesg = $ldapconnection{ldap}->search(scope=>"sub",base=>$baseDN,
		filter=>"(objectClass=zmsAccount)");
	
	#makes the hash of the returned results
	my %LDAPhash=LDAPhash($mesg);

	#get a list of found DNs
	my @DNs=keys(%LDAPhash);
	
	#get the sender address
	my $sender = $session->get_sender();
	
	#removes < and any thing before it
	$sender =~ s/.*<//;
	
	#removes > and any thing after it
	$sender =~ s/>.*//;
	
	#a array of attributes to migrate
	my @migrate=("zmsServerPassword", "zmsServerPort", "zmsServerAuthMethode",
		"zmsServerUsername", "zmsServerTimeout", "zmsServerUseStarttls");
	
	my $DNs_int="0";
	while(defined($DNs[$DNs_int])){
		my $zmsFromRegexp_int="0";
		while(defined($LDAPhash{$DNs[$DNs_int]}{ldap}{zmsFromRegexp}[$zmsFromRegexp_int])){
			my $test=$sender;
			
			$test =~ s/$LDAPhash{$DNs[$DNs_int]}{ldap}{zmsFromRegexp}[$zmsFromRegexp_int]//;

			#if the regexp removes the entire sender, use this entry
			if ($test eq ""){

				#only one that needs defined
				if (defined($LDAPhash{$DNs[$DNs_int]}{ldap}{zmsServerHostname}[0])){
					$outgoing_server_info{zmsServerHostname}=$LDAPhash{$DNs[$DNs_int]}{ldap}{zmsServerHostname}[0];
				}else{
					$outgoing_server_info{error}="No server found for this account.";
					return %outgoing_server_info;
				};

				#migrate all found attributes
				my $migrate_int="0";
				while(defined($migrate[$migrate_int])){
					if (defined($LDAPhash{$DNs[$DNs_int]}{ldap}{$migrate[$migrate_int]}[0])){
						$outgoing_server_info{$migrate[$migrate_int]}=
							$LDAPhash{$DNs[$DNs_int]}{ldap}{$migrate[$migrate_int]}[0];
					};
					
					$migrate_int++;
				};
				
				#sets the server port if not given
				if(!defined($outgoing_server_info{zmsServerPort})){
					$outgoing_server_info{zmsServerPort}="25";
				};
				
				#sets the server timeout if not given
				#it is set low given this is not currently forking
				if(!defined($outgoing_server_info{zmsServerTimeoout})){
					$outgoing_server_info{zmsServerTimeout}="10";
				};
				
				#if no AUTH methode is listed, default to PLAIN
				if(!defined($outgoing_server_info{zmsServerAuthMethode})){
					$outgoing_server_info{zmsServerAuthMethode}="PLAIN";
				};

				#if no STARTTLS value is defined, default to TRUE
				if (!defined($outgoing_server_info{zmsServerUseStarttls})){
					$outgoing_server_info{zmsServerUseStarttls}="TRUE";
				}else{
					$outgoing_server_info{zmsServerUseStarttls}=uc($outgoing_server_info{zmsServerUseStarttls});
				};
				
				#sets the status to success 
				$outgoing_server_info{status}="1";
				return %outgoing_server_info;
				
			};
			
			$zmsFromRegexp_int++;
		};

		$DNs_int++;
	};
	
	#if we are here, it means that it did not find it a matching out going account
	$outgoing_server_info{error}="No matching from addresses found.";
	return %outgoing_server_info;
};

#checks if all recipients are local
#$session is the session variable generated by Net::Server::Mail
sub all_local{
	my ($session)=@_;
	
	#get recipients
	my @recipients = $session->get_recipients();
	#used for intering through the list
	my $recpients_int=0;
	while (defined($recipients[$recpients_int])){
		my $recipient=$recipients[$recpients_int];
		$recipient=~s/^.*<//;
		$recipient=~s/>.*$//;
		my @recpient_split=split(/@/, $recipient);
		my $recpient_split_len=@recpient_split - 1;
		if (!defined($session->{zmsConfig}{local_domains}{$recpient_split[$recpient_split_len]})){
			return(0, $recpient_split[$recpient_split_len]);
		};

		$recpients_int++;
	};
	
	#return that it is fine
	return(1,"")
};

sub queue_message{
	my($session, $data) = @_;
	
	#gets the sender
	$session->{sender}= $session->get_sender();
	my @recipients = $session->get_recipients();

	($session->{all_local}, my $fail_recipient)=all_local($session);
	openlog("zms", "nofatal,nowait,pid", "mail");

	#Log peer and sender info.
	syslog("info", $session->{id}." - Sender=".$session->{sender}.
			"  PeerHost=".$session->{PeerHost}.
			"  PeerPort=".$session->{PeerPort});

	#checks the RBL
	if($session->{zmsConfig}->{zmsRBLcheck} eq "TRUE"){
		my ($rbl_result, @RBL_list)=rbl_check($session);

		#returns failed if it is found in a RBL
		if($rbl_result){
			#log a unsuccessful RBL check
			syslog("info", $session->{id}." - RBL check failed. RBLs="
						.join(",", @RBL_list)." maxhits=".$session->{zmsConfig}->{zmsRBLmaxhits});

			#return on a failed RBL check
			return(0, 554, 'Error: RBl check failed. RBLs='.join(",", @RBL_list));
		};
		
		#log successful RBL check info
		syslog("info", $session->{id}." - RBL succeeded. RBLs=".
					join(",", @{$session->{zmsConfig}->{RBLs}})
					." maxhits=".$session->{zmsConfig}->{zmsRBLmaxhits});
	};

	#if first recpient is not defined, assume none are.
	if(!defined($recipients[0])){
		syslog("info", $session->{id}." - No recipients.");
		closelog;
		return(0, 554, 'Error: no valid recipients')
	}else{
		syslog("info", $session->{id}." - Recipients=".join(",", @recipients));
	};

	#handle a unathenticated session 
	if (!defined($session->{AUTH}->{username})){
		if ($session->{all_local} eq "1"){
			#checks the RBL
			if($session->{zmsConfig}->{zmsRBLatUnAuthedQueueStart} eq "TRUE"){
				my ($rbl_result, @RBL_list)=rbl_check($session);

				#returns failed if it is found in a RBL
				if($rbl_result){
					#log a unsuccessful RBL check
					syslog("info", $session->{id}." - Unauthed RBL check failed. RBLs="
						.join(",", @RBL_list)." maxhits=".$session->{zmsConfig}->{zmsRBLmaxhits});

					#return on a failed RBL check
					return(0, 554, 'Error: RBl check failed. RBLs='.join(",", @RBL_list));
				};
				#log successful RBL check info
				syslog("info", $session->{id}." - Unauthed RBL succeeded. RBLs=".
					join(",", @{$session->{zmsConfig}->{RBLs}})
					." maxhits=".$session->{zmsConfig}->{zmsRBLmaxhits});
			};
			if ($session->{zmsConfig}->{zmsUnAuthedQueueType} eq "zmsspooldir") {
				return (queue_zmsspooldir($session, $data));
			};
			if ($session->{zmsConfig}->{zmsUnAuthedQueueType} eq "deny") {
				return (queue_deny($session, $data));
			};
			if ($session->{zmsConfig}->{zmsUnAuthedQueueType} eq "unauthedProxy") {
				return (queue_unauthedProxy($session, $data));
			};
			syslog("info", $session->{id}." - No queue type located for this message. ".
				   "zmsUnAuthedQueueType='".$session->{zmsConfig}->{zmsUnAuthedQueueType}."'");
			closelog;
			return(0, 554, 'Queue error. Please see "'.$session->{id}.'" in the logs for more information.');
		}else{
			syslog("info", $session->{id}." - Unauthed with no local recipients.");
			closelog;
			return(0, 554, 'Error: Unauthed with no local recipients.');
		};
	};

	#refuse the data unless a user is authenticated...
	if (!$session->{AUTH}->{username} eq ""){
		syslog("info", $session->{id}." - user=".$session->{AUTH}->{username});
		if($session->{zmsConfig}->{zmsRBLatAuthedQueueStart} eq "TRUE"){
			my ($rbl_result, @RBL_list)=rbl_check($session);

			#returns failed if it is found in a RBL
			if($rbl_result){
				#log a unsuccessful RBL check
				syslog("info", $session->{id}." - Authed RBL check failed. RBLs="
					.join(",", @RBL_list)." maxhits=".$session->{zmsConfig}->{zmsRBLmaxhits});

				#return on a failed RBL check
				return(0, 554, 'Error: RBl check failed. RBLs='.join(",", @RBL_list));
			};
			#log successful RBL check info
			syslog("info", $session->{id}." - Authed RBL succeeded. RBLs=".
				join(",", @{$session->{zmsConfig}->{RBLs}})
				." maxhits=".$session->{zmsConfig}->{zmsRBLmaxhits});
		};
	
		my %outgoing_server_info=&get_outgoing_server_info($session);

		if ($outgoing_server_info{status} == "0"){
			my ($sender_verify, $sender_error)=sender_verify($session);
			if($sender_verify){
				if ($session->{zmsConfig}->{zmsAuthedQueueType} eq "zmsspooldir") {
					return (queue_zmsspooldir($session, $data));
				};
				if ($session->{zmsConfig}->{zmsAuthedQueueType} eq "deny") {
					return (queue_deny($session, $data));
				};
			}else{
				syslog("info", $session->{id}.' - Sender verify failed. '.$sender_error);
				closelog;
				return(0, 554, 'Error: Sender verify failed. '.$sender_error)
			};
			if ($session->{zmsConfig}->{zmsUnAuthedQueueType} eq "unauthedProxy") {
				return (queue_unauthedProxy($session, $data));
			};
			syslog("info", $session->{id}." - No queue type located for this message. ".
				   "zmsUnAuthedQueueType='".$session->{zmsConfig}->{zmsUnAuthedQueueType}."'");
			closelog;
			return(0, 554, 'Queue error. Please see "'.$session->{id}.'" in the logs for more information.');
		}else{
			return (queue_user_remote_message($session, $data));
		};

	};

	syslog("info", $session->{id}." - No queue type located for this message.");
	closelog;
	return(0, 554, 'Queue error. Please see "'.$session->{id}.'" in the logs for more information.');
};

sub queue_user_remote_message{
	my($session, $data) = @_;

	#gets the sender
	my @recipients = $session->get_recipients();
	
	openlog("zms", "nofatal,nowait,pid", "mail");

	syslog("info", $session->{id}." - Starting queue_user_remote_message delivery.");

	my %outgoing_server_info=&get_outgoing_server_info($session);

	if ($outgoing_server_info{status} == "0"){
		syslog("info", $session->{id}." - failed because of fetching outgoing server info... "
			.$outgoing_server_info{error});
		closelog;
		return(0, 554, 'Error: '.$outgoing_server_info{error});
	};

	my $smtp;
	if ($outgoing_server_info{zmsServerUseStarttls} eq "FALSE"){
		$smtp = Net::SMTP_auth->new($outgoing_server_info{zmsServerHostname}.":".
			$outgoing_server_info{zmsServerPort},
			Timeout => $outgoing_server_info{zmsServerTimeout}
			);
	}else{
		$smtp = Net::SMTP::TLS->new($outgoing_server_info{zmsServerHostname}.":".
			$outgoing_server_info{zmsServerPort},
			Timeout => $outgoing_server_info{zmsServerTimeout}, 
			User => $outgoing_server_info{zmsServerUsername},
			Password => $outgoing_server_info{zmsServerPassword},
			NoTLS => "True"
			);
	};
			
	if (!$smtp){
		syslog("info", $session->{id}." - failed to send due to timing out at "
			.$outgoing_server_info{zmsServerTimeout}.
			 "when connecting to ".$outgoing_server_info{zmsServerHostname}.":".
			$outgoing_server_info{zmsServerPort});
		closelog;
		return(0, 554, "Error: could not connect to server, ".
			$outgoing_server_info{zmsServerHostname}.".");
	};

	if ($outgoing_server_info{zmsServerUseStarttls} ne "TRUE"){
		if (!$smtp->auth($outgoing_server_info{zmsServerAuthMethode},
			$outgoing_server_info{zmsServerUsername},
			$outgoing_server_info{zmsServerPassword})
			){
				syslog("info", $session->{id}." - going through "
						.$outgoing_server_info{zmsServerHostname}.":".
						$outgoing_server_info{zmsServerPort}." using ".
						$outgoing_server_info{zmsServerUsername}." failed to authenticate.");
				closelog;				
				return(0, 554, 'Error: could not auth with out going server, '.
					$outgoing_server_info{zmsServerHostname}.".");
			};
	};

	#sends the sender info to the out going server
	if(!$smtp->mail($session->{sender})){
		syslog("info", $session->{id}.", going through "
						.$outgoing_server_info{zmsServerHostname}.":".
						$outgoing_server_info{zmsServerPort}." using ".
						$outgoing_server_info{zmsServerUsername}
						." failed with sending sender to outgoing server.");
		closelog;				
		return(0, 554, 'Error: sending sender, '.$session->{sender}.',with out going server, '.
			$outgoing_server_info{zmsServerHostname}.".");
	};

	#sends a list of recipients 
	if(!$smtp->recipient(@recipients)){
		syslog("info", $session->{id}." - Sending through ".
						$outgoing_server_info{zmsServerHostname}.":".
						$outgoing_server_info{zmsServerPort}." using ".
						$outgoing_server_info{zmsServerUsername}.
						"failed with sending recipients to outgoing server.");
		closelog;
		return(0, 554, 'Error: sending recipients to out going server');
	};

	#initialize, send DATA, end sending DATA
	if (!$smtp->data()){
		syslog("info", $session->{id}." - Sending through "
						.$outgoing_server_info{zmsServerHostname}.":".
						$outgoing_server_info{zmsServerPort}." using ".
						$outgoing_server_info{zmsServerUsername}.
						" failed to initialize DATA session with outgoing server.");
		closelog;
		return(0, 554, 'Error: initializing DATA session');
	};
	if (!$smtp->datasend($$data)){
		syslog("info", $session->{id}." - Sending through "
						.$outgoing_server_info{zmsServerHostname}.":".
						$outgoing_server_info{zmsServerPort}." using ".
						$outgoing_server_info{zmsServerUsername}
						." failed to send DATA to outgoing server.");
		closelog;
		return(0, 554, 'Error: sending DATA');
	};
	if(!$smtp->dataend()){
		syslog("info", $session->{id}." - Sending through "
						.$outgoing_server_info{zmsServerHostname}.":".
						$outgoing_server_info{zmsServerPort}." using ".
						$outgoing_server_info{zmsServerUsername}.
						"Message from ".$session->{sender}.", ".$session->{AUTH}->{username}." failed to end DATA with outgoing server.");
		closelog;
		return(0, 554, 'Error: ending DATA session');
	};

	#quits the SMTP session
	$smtp->quit;

	syslog("info", $session->{id}." - Sending through ".$outgoing_server_info{zmsServerHostname}.":".
		$outgoing_server_info{zmsServerPort}." using ".
		$outgoing_server_info{zmsServerUsername}." succeeded.");
	closelog;

	return(1, 250, "message queued");
}

#verify the sender
sub sender_verify{
	my ($session)= @_;
	
	#verify it if the type is real
	if ($session->{zmsConfig}->{zmsDomainAddressType} eq "real"){
		return(real_sender_verify($session));
	};
	
	#if we get here, we have not located a verify methode
	return(0, "Could not find verify methode.");
};

#verify a send for a domain that has it's settings set to real
sub real_sender_verify{
	my($session) = @_;

	#get the sender and get the stuff only between <>
	my $sender=$session->{sender};
	$sender=~s/^.*<//;
	$sender=~s/>.*$//;

	#split it at every @ for later use
	my @sender_split=split(/@/, $sender);

	#return if domain does not exist
	if (!defined($session->{zmsConfig}{local_domains}{$sender_split[$#sender_split]})){
		return(0, "Sender's domain is not local.");
	};

	#this puts the part before he last @ together.
	#BTW this is done for paranioa purposes...
	#this nasty bit can be remove when I implement multi @ check
	my $last=$#sender_split - 1;
	my $user=join("@", @sender_split[0 .. $last]);
	
	#get user info
	my ($name,$passwd,$uid,$gid,
       $quota,$comment,$gcos,$dir,$shell,$expire) = getpwnam($user);

	#return if user does not exist
	if(!defined($name)){
		return(0, "Recipient does not exist.");
	};

	#return that it is fine
	return(1,"")
};

sub queue_authedProxy{
	my($session, $data) = @_;

	openlog("zms", "nofatal,nowait,pid", "mail");

	my @recipients = $session->get_recipients();

	syslog("info", $session->{id}." - Starting queue_usauthedProxy.");
	
	my $smtp = Net::SMTP_auth->new($session->{zmsConfig}->{zmsQueueProxyHost}.":".
								   $session->{zmsConfig}->{zmsQueueProxyPort});

	if (!$smtp->auth($session->{zmsConfig}->{zmsQueueProxyAuthMethode},
					 $session->{Auth}->{username}, $session->{Auth}->{password})){
		syslog("info", $session->{id}." - Authed proxying through '".
			   $session->{zmsConfig}->{zmsQueueProxyHost}.":".
			   $session->{zmsConfig}->{zmsQueueProxyPort}.
			   "' failed when authenticating. user='".
			   $session->{Auth}->{username}."'");
		closelog;
		return(0, 421, "Error: Please see '".$session->{id}."' in the logs.");
	};

	#sends the sender to the local server
	if(!$smtp->mail($session->{sender})){
		syslog("info", $session->{id}." - Unauthed proxying through '".
			   $session->{zmsConfig}->{zmsQueueProxyHost}.":".
			   $session->{zmsConfig}->{zmsQueueProxyPort}.
			   "' failed when sending sender.");
		closelog;
		return(0, 421, "Error: Please see '".$session->{id}."' in the logs.");
	};

	#sends the recipients
	if(!$smtp->recipient(@recipients)){
		syslog("info", $session->{id}." - Unauthed proxying through '".
			   $session->{zmsConfig}->{zmsQueueProxyHost}.":".
			   $session->{zmsConfig}->{zmsQueueProxyPort}.
			   "' failed when transmitting recipients.");
		closelog;
		return(0, 421, "Error: Please see '".$session->{id}."' in the logs.");
	};

	#initialize, send DATA, end sending DATA
	if (!$smtp->data()){
		syslog("info", $session->{id}." - Unauthed proxying through '".
			   $session->{zmsConfig}->{zmsQueueProxyHost}.":".
			   $session->{zmsConfig}->{zmsQueueProxyPort}.
			   "' failed when trying to start data session.");
		closelog;
		return(0, 421, "Error: Please see '".$session->{id}."' in the logs.");		
	};
	if (!$smtp->datasend($$data)){
		syslog("info", $session->{id}." - Unauthed proxying through '".
			   $session->{zmsConfig}->{zmsQueueProxyHost}.":".
			   $session->{zmsConfig}->{zmsQueueProxyPort}.
			   "' failed when sending data.");
		closelog;
		return(0, 421, "Error: Please see '".$session->{id}."' in the logs.");		
	};
	if (!$smtp->datasend()){
		syslog("info", $session->{id}." - Unauthed proxying through '".
			   $session->{zmsConfig}->{zmsQueueProxyHost}.":".
			   $session->{zmsConfig}->{zmsQueueProxyPort}.
			   "' failed when sending data.");
		closelog;
		return(0, 421, "Error: Please see '".$session->{id}."' in the logs.");		
	};

	#quits the SMTP session
	$smtp->quit;

	syslog("info", $session->{id}." - Unauthed proxying through '".
		   $session->{zmsConfig}->{zmsQueueProxyHost}.":".
		   $session->{zmsConfig}->{zmsQueueProxyPort}.
		   "' succeeded.");
	closelog;

	return(1, 250, "Message queued as '".$session->{id}."'");
};

sub queue_deny{
	my($session, $data) = @_;

	openlog("zms", "nofatal,nowait,pid", "mail");

	syslog("info", $session->{id}." - Successfully queued using the deny queue.");
	closelog;

	return(0, 554, 'Queue denied.');
};

sub queue_unauthedProxy{
	my($session, $data) = @_;

	openlog("zms", "nofatal,nowait,pid", "mail");

	my @recipients = $session->get_recipients();

	syslog("info", $session->{id}." - Starting queue_usauthedProxy.");
	
	my $smtp = Net::SMTP_auth->new($session->{zmsConfig}->{zmsQueueProxyHost}.":".
								   $session->{zmsConfig}->{zmsQueueProxyPort});

	#sends the sender to the local server
	if(!$smtp->mail($session->{sender})){
		syslog("info", $session->{id}." - Unauthed proxying through '".
			   $session->{zmsConfig}->{zmsQueueProxyHost}.":".
			   $session->{zmsConfig}->{zmsQueueProxyPort}.
			   "' failed when sending sender.");
		closelog;
		return(0, 421, "Error: Please see '".$session->{id}."' in the logs.");
	};

	#sends the recipients
	if(!$smtp->recipient(@recipients)){
		syslog("info", $session->{id}." - Unauthed proxying through '".
			   $session->{zmsConfig}->{zmsQueueProxyHost}.":".
			   $session->{zmsConfig}->{zmsQueueProxyPort}.
			   "' failed when transmitting recipients.");
		closelog;
		return(0, 421, "Error: Please see '".$session->{id}."' in the logs.");
	};

	#initialize, send DATA, end sending DATA
	if (!$smtp->data()){
		syslog("info", $session->{id}." - Unauthed proxying through '".
			   $session->{zmsConfig}->{zmsQueueProxyHost}.":".
			   $session->{zmsConfig}->{zmsQueueProxyPort}.
			   "' failed when trying to start data session.");
		closelog;
		return(0, 421, "Error: Please see '".$session->{id}."' in the logs.");		
	};
	if (!$smtp->datasend($$data)){
		syslog("info", $session->{id}." - Unauthed proxying through '".
			   $session->{zmsConfig}->{zmsQueueProxyHost}.":".
			   $session->{zmsConfig}->{zmsQueueProxyPort}.
			   "' failed when sending data.");
		closelog;
		return(0, 421, "Error: Please see '".$session->{id}."' in the logs.");		
	};
	if (!$smtp->datasend()){
		syslog("info", $session->{id}." - Unauthed proxying through '".
			   $session->{zmsConfig}->{zmsQueueProxyHost}.":".
			   $session->{zmsConfig}->{zmsQueueProxyPort}.
			   "' failed when sending data.");
		closelog;
		return(0, 421, "Error: Please see '".$session->{id}."' in the logs.");		
	};

	#quits the SMTP session
	$smtp->quit;

	syslog("info", $session->{id}." - Unauthed proxying through '".
		   $session->{zmsConfig}->{zmsQueueProxyHost}.":".
		   $session->{zmsConfig}->{zmsQueueProxyPort}.
		   "' succeeded.");
	closelog;

	return(1, 250, "Message queued as '".$session->{id}."'");
};

sub queue_zmsspooldir{
	my($session, $data) = @_;

	#gets the recipients
	my @recipients = $session->get_recipients();

	openlog("zms", "nofatal,nowait,pid", "mail");

	my $messageDir=$session->{zmsConfig}->{zmsSpoolDir}."/tmp/".$session->{id};
	
	if(!mkdir($messageDir)){
		syslog("info", $session->{id}." - Could not make ".$messageDir);
		closelog;
		return(0, 554, 'Error: Message queue error.');
	};

	if(!open(RECIPIENTS,">",$messageDir."/recipients")){
		syslog("info", $session->{id}." - Could open ".$messageDir."/recipients");
		closelog;
		return(0, 554, 'Error: Message queue error.');
	}else{
		my $recipients_int=0;
		while(defined($recipients[$recipients_int])){
			print RECIPIENTS $recipients[$recipients_int]."\n";
			$recipients_int++;
		};
		close(RECIPIENTS);
	};

	if(!open(DATA,">",$messageDir."/data")){
		syslog("info", $session->{id}." - Could open ".$messageDir."/DATA");
		closelog;
		return(0, 554, 'Error: Message queue error.');
	}else{
		print DATA $$data;
		close(DATA);
	};

	if(!open(INFO,">",$messageDir."/info")){
		syslog("info", $session->{id}." - Could open ".$messageDir."/INFO");
		closelog;
		return(0, 554, 'Error: Message queue error.');
	}else{
		if(defined($session->{AUTH}->{username})){
			print INFO "AUTHusername=".$session->{AUTH}->{username}."\n";
		};
		print INFO "sender=".$session->{sender}."\n".
					"PeerHost=".$session->{PeerHost}."\n".
					"PeerPort=".$session->{PeerPort}."\n";
		close(INFO);
	};

	if(!move($messageDir, $session->{zmsConfig}->{zmsSpoolDir}.'/cur/'.$session->{id})){
		syslog("info", $session->{id}." - Could open ".$messageDir."/INFO");
		closelog;
		return(0, 554, 'Error: Message queue error.');
	}else{
		syslog("info", $session->{id}." - queued into ".$session->{zmsConfig}->{zmsSpoolDir}.'/cur/'.$session->{id});
		closelog;
		return(1, 250, 'Queued as '.$session->{id});
	};

};

sub generateConfig{
	my $config_file=$_[0];
	
	my %config;

	#puts file back in
	$config{file}=$config_file;

	my $ini = Config::Tiny->new();

	#reads the config file	
	$ini = Config::Tiny->read($config_file);
	
	$config{LDAPport}="389";

	#get the user it is running as
	$config{user}=syscall(24);
	
	#autoconfig if baseDN is given... these will be redefined later if asked to...
	if(defined($ini->{_}->{baseDN})){
		$config{baseDN}=$ini->{_}->{baseDN};
		$config{userDN}="uid=".$config{user}.",ou=users,".$ini->{_}->{baseDN};
		$config{userBaseDN}="ou=users,".$ini->{_}->{baseDN};
		$config{homeOU}="ou=home,".$ini->{_}->{baseDN};
		$config{serverOU}="ou=zms,ou=.config,ou=,".$config{user}.",ou=home,".$ini->{_}->{baseDN};
	};
	
	#values to migrate if defined... over ride auto defined from baseDN
	my @migrate=("userDN", "homeOU", "userBaseDN","serverOU", "zmsServerPort", "password", "LDAPserver",
				"LDAPport", "zmsSpoolDir", "zmsRBLcheck", "zmsRBLtimeout", "zmsRBLmaxtime", 
				"zmsRBLmaxhits", "zmsRBLbeforeSMTPsession", "zmsRBLatAuthedQueueStart",
				"zmsRBLatUnAuthedQueueStart", "zmsDomainAddressType", "zmsMaxClients",
				"zmsMaxClientsPerIP", "zmsSAatUnAuthedQueueStart", "zmsSAatAuthedQueueStart",
				"zmsUnAuthedQueueType", "zmsAuthedQueueType", "zmsQueueProxyHost",
				 "zmsQueueProxyPort", "zmsQueueProxyAuthMethode");

	my $int=0; #used for running through migrate
	
	#migrate the values
	while(defined($migrate[$int])){
		if (defined($ini->{_}->{$migrate[$int]})){
			$config{$migrate[$int]}=$ini->{_}->{$migrate[$int]};
		};
		$int++;
	}; 

	my %config_ldap_hash;
	#connect to the LDAP server or exit and issue error
	my %ldapconnection=mwcqbinder($config{userDN}, $config{password}, $config{LDAPserver}, 
									$config{LDAPport});

	#search for the config
	my $mesg = $ldapconnection{ldap}->search(scope=>"sub",base=>$config{serverOU},
										filter=>"(objectClass=zmsServer)");

	#makes the hash of the returned results
	my %LDAPhash=LDAPhash($mesg);
	
	$mesg=$ldapconnection{ldap}->unbind;

	#get a list of found DNs
	my @DNs=keys(%LDAPhash);

	#runs through each DN adding every zmsDomain found in each DN to %local_domains_hash
	my $DNs_int="0";
	while(defined($DNs[$DNs_int])){
		my $domains_int=0;
		$config{local_domains}={};
		while(defined($LDAPhash{$DNs[$DNs_int]}{ldap}{zmsDomain}[$domains_int])){
			$config{local_domains}{$LDAPhash{$DNs[$DNs_int]}{ldap}{zmsDomain}[$domains_int]}=
				$LDAPhash{$DNs[$DNs_int]}{ldap}{zmsDomain}[$domains_int];
			$domains_int++
		};

		$DNs_int++;
	};
	
	#runs through adding each RBL to the RBL check list
	$DNs_int="0";
	while(defined($DNs[$DNs_int])){
		my $rbl_int=0;
		$config{RBLs}=[];
		while(defined($LDAPhash{$DNs[$DNs_int]}{ldap}{zmsRBL}[$rbl_int])){
			$config{RBLs}[$rbl_int]=$LDAPhash{$DNs[$DNs_int]}{ldap}{zmsRBL}[$rbl_int];
			$rbl_int++
		};
	
		$DNs_int++;
	};

	@migrate=("zmsServerPort", "LDAPserver", "zmsSpoolDir", "zmsRBLcheck",
			  "zmsRBLtimeout", "zmsRBLmaxtime", "zmsRBLmaxhits", "zmsRBLbeforeSMTPsession",
			  "zmsRBLatAuthedQueueStart", "zmsRBLatUnAuthedQueueStart", "zmsDomainAddressType",
			  "zmsMaxClients", "zmsMaxClientsPerIP", "zmsSAatUnAuthedQueueStart",
			  "zmsSAatAuthedQueueStart", "zmsUnAuthedQueueType", "zmsAuthedQueueType",
			  "zmsQueueProxyHost", "zmsQueueProxyPort", "zmsQueueProxyAuthMethode");

	#migrate the stuff from the first DN
	$int=0;
	while(defined($migrate[$int])){
		if(defined($LDAPhash{$DNs[0]}{ldap}{$migrate[$int]}[0])){
			$config{$migrate[$int]}=$LDAPhash{$DNs[0]}{ldap}{$migrate[$int]}[0];
		};
		
		$int++;
	};

	#sets the default proxy host to use if not defined
	if (!defined($config{zmsQueueProxyHost})) {
		$config{zmsQueueProxyHost}="127.0.0.1";
	};

	#sets the default the port to use on the proxy host
	if (!defined($config{zmsQueueProxyPort})) {
		$config{zmsQueueProxyPort}="25";
	};

	#sets the zmsServerPort if now set...
	if(!defined($config{zmsServerPort})){
		$config{zmsServerPort}="2525";
	};

	if(!defined($config{zmsMaxClients})){
		$config{zmsMaxClients}="50";
	};

	if(!defined($config{zmsMaxClientsPerIP})){
		$config{zmsMaxClientsPerIP}="10";
	};

	#run SA on message for the unauthed queue
	if (!defined($config{zmsSAatUnAuthedQueueStart})) {
		$config{zmsSAatUnAuthedQueueStart}="TRUE";
	};

	#run SA on message for the authed queue
	if (!defined($config{zmsSAatAuthedQueueStart})) {
		$config{zmsSAatAuthedQueueStart}="TRUE";
	};

	if (!defined($config{zmsQueueProxyAuthMethode})) {
		$config{zmsQueueProxyAuthMethode}="PLAIN";
	}

	#sets zmsRBLbeforeSMTPsession to true if not defined
	if(!defined($config{zmsRBLbeforeSMTPsession})){
		$config{zmsRBLbeforeSMTPsession}="FALSE";
	};

	if (!defined($config{zmsRBLatUnAuthedQueueStart})) {
		$config{zmsRBLatUnAuthedQueueStart}="FALSE";
	};

	#sets zmsRBLbeforeSMTPsession to true if not defined
	if(!defined($config{zmsRBLbeforeSMTPsession})){
		$config{zmsRBLbeforeSMTPsession}="";
	};

	#sets the unauthed queue type to deny if it is not defined
	if (!defined($config{zmsUnAuthedQueueType})) {
		$config{zmsUnAuthedQueueType}="deny";
	};

	#sets the authed queue type to deny if it is not defined
	if (!defined($config{zmsAuthedQueueType})) {
		$config{zmsAuthedQueueType}="deny";
	};

	#sets zmsRBLbeforeSMTPsession to true if not defined
	if(!defined($config{zmsRBLatAuthedQueueStart})){
		$config{zmsRBLatAuthedQueueStart}="FALSE";
	};

	#don't enable RBL checking by default as if it is most likely turned on, 
	#the needed stuff is not configured then...
	if(!defined($config{zmsRBLcheck})){
		$config{zmsRBLcheck}="FALSE";
	};
	
	#set the default max time for the RBL check to 5 seconds
	if(!defined($config{zmsRBLmaxtime})){
		$config{zmsRBLmaxtime}="5";
	};

	if (!defined($config{zmsRBLmaxhits})) {
		$config{zmsRBLmaxhits}='1';
	}

	#set the default time out for any RBL DNS query to 1 second 
	if(!defined($config{zmsRBLtimeout})){
		$config{zmsRBLtimeout}="1";
	};

	#sets the zmsServerPort if now set...
	if(!defined($config{zmsSpooldir})){
		$config{zmsSpoolDir}="/var/spool/zms";
	};
	
	#sets the default zmsDomainAddressType if none is set
	if(!defined($config{zmsDomainAddressType})){
		$config{zmsDomainAddressType}="real";
	};
	
	if(!defined($config{password})){
		print "No password for connecting to the LDAP server. Anonmous binds not supported for security reasons.\n";
		exit 1;
	};	
	
	return %config;
};

sub get_local_domains{
	my %config = @_;
	
	my %local_domains_hash;

	#connect to the LDAP server or exit and issue error
	my %ldapconnection=mwcqbinder($config{userDN}, $config{password}, $config{LDAPserver}, $config{LDAPport});

	my $mesg = $ldapconnection{ldap}->search(scope=>"sub",base=>$config{serverOU},filter=>"(objectClass=zmsServer)");
	
	#makes the hash of the returned results
	my %LDAPhash=LDAPhash($mesg);
	
	$mesg=$ldapconnection{ldap}->unbind;
	
	#get a list of found DNs
	my @DNs=keys(%LDAPhash);

	#runs through each DN adding every zmsDomain found in each DN to %local_domains_hash
	my $DNs_int="0";
	while(defined($DNs[$DNs_int])){
		my $zmsDomain_int="0";
		while(defined($LDAPhash{$DNs[$DNs_int]}{ldap}{zmsDomain}[$zmsDomain_int])){
			$local_domains_hash{$LDAPhash{$DNs[$DNs_int]}{ldap}{zmsDomain}[$zmsDomain_int]}=
				$LDAPhash{$DNs[$DNs_int]}{ldap}{zmsDomain}[$zmsDomain_int];
			
			$zmsDomain_int++;
		};
		
		$DNs_int++;
	};	
	
	#converts the domains hash to a array
	my @local_domains_array=keys(%local_domains_hash);

	return @local_domains_array;
};

#checks the specified RBLs for a IP#.
sub rbl_check{
	my($session) = @_;

    my $rbl = Net::RBLClient->new(lists=>[$session->{zmsConfig}->{RBLs}], 
    							max_hits=>$session->{zmsConfig}->{zmsRBLmaxhits},
    							timeout=>$session->{zmsConfig}->{zmsRBLtimeout},
    							max_time=>$session->{zmsConfig}->{zmsRBLmaxtime});
    
    $rbl->lookup($session->{PeerHost});
	
	my @listed_by = $rbl->listed_by;
	my $result=0;
	
	my $rbls=$#listed_by + 1;
	
	if ($session->{zmsConfig}->{zmsRBLmaxhits} >= $rbls){
		$result=1;
	};
	
	return ($result, @listed_by);
};

#checks the specified RBLs for a IP#.
#returns a perl bolean...
#false=spam
#true=not spam
sub SAcheck{
	my($session, $data) = @_;

	my $result;
	
	my $spamtest = Mail::SpamAssassin->new();
	my $mail = $spamtest->parse($data);
	
	my $status = $spamtest->check($mail);

	if ($status->is_spam()){
		return 0;
	};

	return (1);
};

#change to a user
sub setuser{
	my $user=$_[0];
	
	 my ($name,$passwd,$uid,$gid,$quota,$comment,$gcos,$dir,$shell,$expire)=getpwnam($user);
	 
	 syscall(23, $uid);
	 
	 my $newuid=syscall(25);

	 if ($newuid != $uid){
		print 'Coult not setuid to '.$name.', '.$uid.".\n";
	 	exit 1;
	 };
};

my %config;

my %opts;
getopts("b:c:hfis:u:U:v", \%opts);

#get which config file to use
if(!defined($opts{c})){
	$config{file}="/usr/local/etc/zms.conf"
}else{
	$config{file}=$opts{c};
};

if (defined($opts{h})){
	&main::VERSION_MESSAGE;
	&main::HELP_MESSAGE;
	exit;
};

if (defined($opts{v})){
	&main::VERSION_MESSAGE;
	exit;
};

if (defined($opts{U})){
	setuser($opts{U});
};

#exits if the file does not exist
if (! -f $config{file}){
	print $config{file}." does not exist\n";
	exit 1;
}else{
	%config=generateConfig($config{file});
};

#allows the baseDN to be overriden
if (defined($opts{b})){
	$config{baseDN}=$opts{b};
};

#allows the userDN to be overriden
if (defined($opts{u})){
	$config{userDN}=$opts{u};
};

#allows the userDN to be overriden
if (defined($opts{s})){
	$config{serverDN}=$opts{s};
};

#enables forking if needed
if (defined($opts{f})){
	$config{forking}="on";
};

#enables it to run from inetd
if (defined($opts{i})){
	$config{inetd}="on";
}

#get the local domains that the server handles mail for
@local_domains=&get_local_domains(%config);

#adds the domains to the config
my $local_domains_int=0;
while (defined($local_domains[$local_domains_int])){
	$config{local_domains}{$local_domains[$local_domains_int]}="";
	$local_domains_int++;
};

if (!defined($config{inetd})){

	my $listen_socket = new IO::Socket::INET(Listen => 1, LocalPort => $config{zmsServerPort}, Reuse => 1);

	#we set this up here as otherwise it would be in the loop
	my $glue="zmsd";
	my %shared=(IPs=>{}, clients=>"0");
	my %serverOptions = (
		create => 'yes',
		exclusive => 0,
		mode => 0640,
		destroy => 'yes',
		);
	my %clientOptions = (
			create => 0,
			exclusive => 0,
			mode => 0640,
			destroy => 0,
     	);
	tie %shared, 'IPC::Shareable', $glue, { %serverOptions } or die "zms: IPC::Shareable tie failed.\n";

	while(my $conn = $listen_socket->accept){
		
		my $esmtp = new Net::Server::Mail::ESMTP(socket => $conn);
		$esmtp->register('Net::Server::Mail::ESMTP::AUTH');
		$esmtp->register('Net::Server::Mail::ESMTP::8BITMIME');
		$esmtp->register('Net::Server::Mail::ESMTP::PIPELINING');
		$esmtp->{zmsConfig}={%config};
		$esmtp->{PeerHost}=$conn->peerhost();
		$esmtp->{PeerPort}=$conn->peerport();
		$esmtp->{SockHost}=$conn->sockhost();
		$esmtp->{SockPort}=$conn->sockport();
		$esmtp->set_callback(AUTH => \&validate_auth);
		$esmtp->set_callback(RCPT => \&validate_recipient);
		$esmtp->set_callback(DATA => \&queue_message);

		$esmtp->{id}=$$."-".time().-rand(369);
		$esmtp->{id}=~s/\..*$//;

		if (defined($config{forking})){
			my $notmaxed=1;
			
			if(defined($shared{IPs}{$esmtp->{PeerHost}})){
				if($shared{IPs}{$esmtp->{PeerHost}} >= $config{zmsMaxClientsPerIP}){
					$notmaxed=0;
					$conn->send("421 Please try again later.\n");
					$conn->close;
					openlog("zms", "nofatal,nowait,pid", "mail");
					syslog("info", "Max clients per IP reached for ".$esmtp->{PeerHost}.".");
				};
			};

			if($notmaxed){
				(tied %shared)->shlock;
				$shared{clients}++;
				if(!defined($shared{IPs}{$esmtp->{PeerHost}})){
					$shared{IPs}{$esmtp->{PeerHost}}="1";
				}else{
					$shared{IPs}{$esmtp->{PeerHost}}++;
				};
				(tied %shared)->shunlock;

				my $child;
				die "Can't fork: $!" unless defined ($child = fork());

				if ($child == 0){#child
					my $process=1;
					
					#checks the RBL
					if($esmtp->{zmsConfig}->{zmsRBLbeforeSMTPsession} eq "TRUE"){
						openlog("zms", "nofatal,nowait,pid", "mail");
						my ($rbl_result, @RBL_list)=rbl_check($esmtp);
						
						#returns failed if it is found in a RBL
						if($rbl_result){
							#log a unsuccessful RBL check
							syslog("info", "pre SMTP session RBL check failed. RBLs="
								   .join(",", @RBL_list)." maxhits=".$esmtp->{zmsConfig}->{zmsRBLmaxhits});
							
							$conn->send("500 Client is in RBL. RBLs=".join(",", @RBL_list)."\n");
							$conn->close;
							$process=0;
						}else{
							#log successful RBL check info
							syslog("info", "pre SMTP session RBL succeeded. RBLs=".
								   join(",", @{$esmtp->{zmsConfig}->{RBLs}})
								   ." maxhits=".$esmtp->{zmsConfig}->{zmsRBLmaxhits});
						};
					};
					if($process){
						$esmtp->process();
						$conn->close();
					};

					#updates the shared information
					my %clientShared;
					tie %clientShared, 'IPC::Shareable', $glue, { %clientOptions } or die "zms: IPC::Shareable tie failed.\n";
					(tied %clientShared)->shlock;#locks it so nothing else makes any changes
					$clientShared{clients}--;
					$clientShared{IPs}{$esmtp->{PeerHost}}--;
					if($clientShared{IPs}{$esmtp->{PeerHost}} eq "0"){
						delete($clientShared{IPs}{$esmtp->{PeerHost}});
					};
					(tied %shared)->shunlock;

					exit 0;
				}else{#parent
					#close the connection... passed to chicd
					$conn->close();
				};
			};
		}else{
			my $notmaxed=1;
			
			if(defined($shared{IPs}{$esmtp->{PeerHost}})){
				if($shared{IPs}{$esmtp->{PeerHost}} >= $config{zmsMaxClientsPerIP}){
					$notmaxed=0;
					$conn->send("421 Please try again later.\n");
					$conn->close;
					openlog("zms", "nofatal,nowait,pid", "mail");
					syslog("info", "Max clients per IP reached for ".$esmtp->{PeerHost}.".");
				};
			};
			
			if($notmaxed){
				my $process=1;
									
				#checks the RBL
				if($esmtp->{zmsConfig}->{zmsRBLbeforeSMTPsession} eq "TRUE"){
					openlog("zms", "nofatal,nowait,pid", "mail");
					my ($rbl_result, @RBL_list)=rbl_check($esmtp);

					#returns failed if it is found in a RBL
					if($rbl_result){
						#log a unsuccessful RBL check
						syslog("info", "pre SMTP session RBL check failed. RBLs="
							.join(",", @RBL_list)." maxhits=".$esmtp->{zmsConfig}->{zmsRBLmaxhits});

						$conn->send("500 Client is in RBL. RBLs=".join(",", @RBL_list)."\n");
						$conn->close;
						$process=0;
					}else{
						#log successful RBL check info
						syslog("info", "pre SMTP session RBL succeeded. RBLs=".
								join(",", @{$esmtp->{zmsConfig}->{RBLs}})
								." maxhits=".$esmtp->{zmsConfig}->{zmsRBLmaxhits});
					};
				};
				if($process){
					$esmtp->process();
					$conn->close();
				};
			};
		};

	};
}else{
	my $esmtp = new Net::Server::Mail::ESMTP();
	$esmtp->register('Net::Server::Mail::ESMTP::AUTH');
	$esmtp->register('Net::Server::Mail::ESMTP::8BITMIME');
	$esmtp->register('Net::Server::Mail::ESMTP::PIPELINING');
	$esmtp->{zmsConfig}={%config};
	$esmtp->set_callback(AUTH => \&validate_auth);
	$esmtp->set_callback(RCPT => \&validate_recipient);
	$esmtp->set_callback(DATA => \&queue_message);
	$esmtp->process();
};

#-----------------------------------------------------------
# POD documentation section
#-----------------------------------------------------------
=pod

=head1 NAME

zms - A specialized mail gateway system for using user specified SMTP server.

=head1 SYNOPSIS

zms [B<-c> <config file>] [B<-f>] [B<-i>] [B<-b> <baseDN>]

=head1 FLAGS

=item -b <baseDN>

The specified DN is used for the base DN and overrides the config file.

=item -c <config file>

The config file to use. Defaults to /usr/local/etc/zms.conf.

=item -i

Enable STDIN/STDOUT mode. Use this for wth inetd.

=item -f

Enables forking on new messages so it can process more than one.

=item -s <serverDN>

The specified DN is used for the server DN and overrides the config file.

=item -u <userDN>

The specified DN is used for the user DN and overrides the config file.

=item -U <user>

Set the UID to this user before continueing. This is done before reading the config file.

=head1 CONFIG FILE

The default is /usr/local/etc/zmc.conf. It is in VARIABLE=VALUE format.

=item LDAPserver

This is the LDAP server to use.

=item LDAPport

Which port to try to connect to for accessing the LDAP server.

=item password

The password to bind to the server file.

=item baseDN

The base DN used for autoconf if desired.

=item userDN

The DN to do a simple bind as for connecting up to the LDAP server for the
server to use. Defaults to uid=$ENV{USER},ou=users,$baseDN.

=item serverOU

The OU that contains zmsServer enteries under it. Defaults to
ou=zms,ou=.config,ou=$ENV{USER},ou=home,$baseDN.

=item userBaseDN

The base DN to try for using when creating the string for the user bind. The
default is ou=users,$baseDN. When a user authenticates and sends the message,
zms will try to bind as that user. It will use uid=$user,$userBaseDN.

=item homeOU

This is the OU that contains users home OUs. Defaults to ou=home,$baseDN. zms will
check in ou=zms,ou=.config,ou=$user,$homeOU for zmsAccount enteries.

=head1 ZMSACCOUNT

A LDAP entry of the objectClass zmsAccount may have cn, zmsServerHostname,
zmsserverPort, zmsServerUsername, zmsServerPassword, zmsServerAuthMethode,
and zmsFromRegexp.

Unless otherwise specified, only the first attribute of each type is used.

Sending through a out going server with out SMTP authentication is not currently
broken.

=item cn

This is just used for assigning a name to the entry.

=item zmsServerHostname

This is the hostname for the out going server.

=item zmsServerPort

This is the port to connect to on the out going server. The defualt
is 25.

=item zmsServerUsername

This is the username to use for when authenticating to the server.

=item zmsServerPassword

The password to use when authenticating to the remote server.

=item zmsServerAuthMethode

The methode to use when authenticating. The default is PLAIN.

=item zmsFromRegexp

This is the regexp used for checking if out going server this entry is
for should be used. There may be more than one of these attributes in
a entry.

=item zmsServerUseStarttls

A bolean setting for wether or not to use STARTTLS when sending mail.

=head1 EXAMPLE ZMSACCOUNT ENTRY

	dn: cn=moose@foo.bar,ou=zms,ou=.config,ou=toad,ou=home,dc=bufo
	objectClass: zmsAccount
	cn: moose@foo.bar
	zmsServerHostname: mail.foo.bar
	zmsServerPort: 25
	zmsServerUsername: moose
	zmsServerPassord: moosetime
	zmsServerAuthMethode: LOGIN
	zmsServerUseStarttls: FALSE
	zmsFromRegexp: ^moose@foo.bar$

=head1 ZMSSERVER

The objectClass zmsServer may have the attributes cn, zmsDomain, zmsSpoolDir,
and zmsServerPort. Only zmsDomain is currently required. This is the servers
local domain.

=item cn

Used for naming a entry.

=item zmsAuthedQueueType

The queue type to use for a authed message. The default is "deny".

=item zmsDomain

This is a local domain for the email server. Not currently used, but is needed.
Generally this should be the hostname of the machine zms is running on currently.

=item zmsDomainAddressType

This is the mapping type to use for each domain.

=item zmsMaxClients

The maximum number of clients supported in forking mode. The default is '50'.

=item zmsMaxClientsPerIP

The maximum number of clients, for a single IP, supported in forking mode. The default is '10'.

=item zmsQueueProxyHost

This is the host to use any of the queue types are set to 'unauthedProxy' or 'authedProxy'.

=item zmsQueueProxyAuthMethode

This is the authentication methode to use for the proxy. The default is 'PLAIN'.

=item zmsQueueProxyPort

This is the port to use any of the queue types are set to 'unauthedProxy' or 'authedProxy'.

=item zmsRBL

This defines a RBL to use. Only one RBL per line.

=item zmsRBLbeforeSMTPsession

If set to 'TRUE', check and make sure the sender is not in a RBL.

=item zmsRBLatAuthedQueueStart

If set to 'TRUE', check and make sure the sender is not in a RBL at the start of the
authed queue start.

=item zmsRBLatUnAuthedQueueStart

If set to 'TRUE', check and make sure the sender is not in a RBL at the start of the
unauthed queue start.

=item zmsRBLcheck

If set to 'TRUE', check and make sure the sender is not in a RBL the start of queue start.
This is the equivalent of setting 'zmsRBLatUnAuthedQueueStart' and 'zmsRBLatAuthedQueueStart'
to 'TRUE'.

=item zmsRBLtimeout

If defined, this represents the time to wait for each RBL to finish checking. The value
is in seconds. If not defined it defaults to '1'.

=item zmsRBLmaxtime

This is the time maximum time to wait for all RBL checks to complete. The value is in seconds.
If note defined it defaults to '5'.

=item zmsRBLmaxhits

This is the maximum number of RBLs can be matched before it is denied. The default is '1'.

=item zmsSAatAuthedQueueStart

If set to 'TRUE', checks the message using SA before the authed queue.

=item zmsSAatUnAuthedQueueStart

If set to 'TRUE', checks the message using SA before the unauthed queue.

=item zmsSpooldir

This is the dir used for spoolings. Currently zms just sends it before reporting
it as a success to the client.

=item zmsServerPort

This is the port that the server should run on. Will be implemented in the next
beta release.

=item zmsUnAuthedQueueType

The queue type to use for a unauthed message. The default is "deny".

=head1 EXAMPLE ZMSSERVER ENTRY

	dn: cn=bufo,ou=zms,ou=.config,ou=smtpd,ou=home,dc=bufo
	cn: bufo
	zmsDomain: bufo
	zmsServerPort: 25

=head1 HOMEOU INFO

The homeOU revolves around the idea of having a homeOU for LDAP users. The
access rules below allows user access to and then the user smtpd access to
the user's zconf settings.

	access to dn.regex="^(.+,)?ou=zms,ou=.config,ou=([^,]+),ou=home,dc=bufo$"
   		by dn.exact,expand="uid=$2,ou=users,dc=bufo" write
   		by dn.exact,expand="uid=$2,ou=users,dc=bufo" write
   		by * none

	access to dn.regex="^(.+,)?ou=([^,]+),ou=home,dc=bufo$"
   		by dn.exact,expand="uid=$2,ou=users,dc=bufo" write
   		by * none

=head1 LDAP SCHEMA

zms.schema may be found at http://vvelox.net/src/ldap/zms.schema

=head1 USING FROM INETD

In inetd.conf put something like this

	smtp	stream  tcp     nowait	smtpd	/usr/local/bin/zms	zms -i

=head1 ZMS MESSAGE ID

It is made of up three peices seperated by a -. The first peice is the PID
of the process doing the queueing. The second is the current unix time. The
third is a random number between 0 and 369. 

=head1 QUEUE TYPES

=head2 deny

The returns '554 Queue denied.' and the message is not queued.

=head2 zmsspooldir

This delivers it to the ZMS spool directory specified by 'zmsSpoolDir'.

=head2 unauthedProxy

Tries to deliver it to another SMTP server. The host and port are specified by
'zmsQueueProxyHost' and 'zmsQueueProxyPort' respectively.

=head2 authedProxy

Tries to deliver it to another SMTP server. The host and port are specified by
'zmsQueueProxyHost' and 'zmsQueueProxyPort' respectively. The same username and
password that were used for authenticating with ZMS. The authentication methode
is not duplicated and 'zmsQueueProxyAuthMethode' is used for it.

=head1 ZMS QUEUE STRUCTURE

The zms spool directory contains two directories. These two are 'tmp' and 'cur'. A
message is first creatd in the tmp directory and then moved to the cur directory.

Adding a message is done by first creating a directory named the same as that message's
ID. Then three files a created. Those are named 'data', 'recipients', and 'info'. The
recipient file contains a message recipient per line. The data file contains the entire
data from the data part of the SMP session. The info file contains variables in variablevalue
format.

Queue running is currently not handled by zms, but by zms-qr, which is still I am currently
working on writing.

=head2 info variables

=head3 sender

This is the address from which this message is being sent.

=head3 PeerHost

The remote host that sent the message.

=head3 PeerPort

The remote port it was sent from.

=head3 AUTHusername

The user name used if this message came from a authenticated SMTP session.

=head1 VERSION

1.7.0

=head1 CHANGELOG

=item 1.7.0 - 2008-06-17

authedqueue added.

=item 1.6.0 - 2008-06-17

Non-forking mode fixed.

Queue typing added.

deny queue added.

zmsmailspool queue added.

unauthedProxy queue added.

RBL checking added.

Max clients per IP support added.

Max clients support added.

Misc. code cleanup.

Updated documentation.

=item 1.5.1 - 2008-01-29

Corrent a small bug in regards to setting the sender.

=item 1.5.0 - 2008-01-28

Local queueing now works. 

Now accepts mail if it is to a local domain, with out it being authed.

Implemented message ID system.

Put in more verbose and useful syslog stuff.

=item 1.3.0 - 2008-01-06

Pulls server port from LDAP as well as the spool directory in preparation for supporting local delivery.

=item 1.3.0 - 2007-08-27

Now forks.

=item 1.2.1 - 2007-08-12

Fix some documentation errors.

Fix --help and --version as well.

=item 1.2.0 - 2007-08-12

Add in support for logging using syslog.

=item 1.1.0 - 2007-08-12

Added support for using with INETD and the like.

=item 1.0.0 - 2007-08-10

Initial public release.

=head1 AUTHOR

Zane C. Bowers <vvelox@vvelox.net>

=head1 COPYRIGHT

Copyright (c) 2008, Zame C. Bowers <vvelox@vvelox.net>

All rights reserved.

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:

    * Redistributions of source code must retain the above copyright notice,
     this list of conditions and the following disclaimer.
    * Redistributions in binary form must reproduce the above copyright
     notice, this list of conditions and the following disclaimer in the
     documentation and/or other materials provided with the distribution.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS` OR
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

=head1 SCRIPT CATEGORIES

Mail

=head1 OSNAMES

unix

=head1 README

zms - A specialized mail system for using user specified SMTP server.

=cut
#-----------------------------------------------------------
# End of POD documentation
#-----------------------------------------------------------