#!/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 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;

#needs to be set to IGNORE to avoid zombies or exiting oddly and unexpectedly under FreeBSD
$SIG{CHLD} = 'IGNORE';

#print version
sub main::VERSION_MESSAGE {
	print "zms 1.5.1\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($LDAPuser, $session->{AUTH}->{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=zLDAPhash($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);
	$session->{id}=$$."-".time();
	openlog("zms", "nofatal,nowait,pid", "mail");

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

	#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{
		my $recipient_int=0;
		my $recipient_string="";
		while(defined($recipients[$recipient_int])){
			$recipient_string=$recipient_string.$recipients[$recipient_int].",";
			$recipient_int++;
		};
		syslog("info", $session->{id}." - Recipients=".$recipient_string);
	};



	#handle a unathenticated session 
	if (!defined($session->{AUTH}->{username})){
		if ($session->{all_local} eq "1"){
			return (queue_local($session, $data));
		}else{
			syslog("info", $session->{id}." - Unauthed with no local recipients.");
			closelog;
			return(0, 554, 'Error: Unauthed with no local recipients.');
		};
	};

	syslog("info", $session->{id}." - user=".$session->{AUTH}->{username});

	#refuse the data unless a user is authenticated...
	if (!$session->{AUTH}->{username} eq ""){
		return (queue_user_remote_message($session, $data));
	};

	syslog("info", $session->{id}." - No queue type located for this message.");
	closelog;
	return(0, 554, 'Error: No queue type located for this message.')
};

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");
}

sub queue_local{
	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});
	};

};

#makes a hash out of a returned LDAP search
sub  zLDAPhash {
	my $mesg = $_[0]; #the object returned from a LDAP search

	#used for holding the data, before returning it
	my %data;

	#builds it
	my $entryinter=0;
	my $max = $mesg->count;
	for ( $entryinter = 0 ; $entryinter < $max ; $entryinter++ ){
		my $entry = $mesg->entry ( $entryinter );
		$data{$entry->dn}={ldap=>{dn=>$entry->dn},internal=>{changed=>0}};
		#builds a hash of attributes
		foreach my $attr ( $entry->attributes ) {
			$data{$entry->dn}{ldap}{$attr}=[];

			#builds the array of values for the attribute
			my $valueinter=0;
			my @attributes=$entry->get_value($attr);
			while (defined($attributes[$valueinter])){
				$data{$entry->dn}{ldap}{$attr}[$valueinter]=$attributes[$valueinter];
				$valueinter++;
			};
        };
	};

	return %data;
};

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");
	
	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=zLDAPhash($mesg);
	
	$mesg=$ldapconnection{ldap}->unbind;

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

	#sets the zmsServerPort if now set...
	if(!defined($config{zmsSpooldir})){
		$config{zmsSpoolDir}="/var/spool/zms";
	};

	#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++;
	};
	
	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=zLDAPhash($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;
};

#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++;
};

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

if (!defined($config{inetd})){
	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);

		if (defined($config{forking})){
			my $child;
			die "Can't fork: $!" unless defined ($child = fork());
			
			if ($child == 0){#child
				#close the listening socket
				$listen_socket->close;			
				$esmtp->process();
				$conn->close();
				
				#exit 0;		
			}else{#parent
				#close the connection... passed to chicd
				$conn->close();
			};
		}else{
#			$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
supported.

=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 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 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.

=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. This allows
them to store data in it in a manner.

	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 VERSION

1.5.1

=head1 CHANGELOG

=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) 2007, 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
#-----------------------------------------------------------