#!perl.exe
# Written by friends of Main.MartinCleaver, all credit to them.
# 19 Jan 2002
# 
# Installation:
#   1 Install WebServices.pl
#   2 Save this file as lib/MailIn.pm
#   3 Build a test harness
#   4 Write a mail dispatcher that picks up messages from your 
#     POP3 or Lotus Notes server and invokes a SOAP request to the send method with 
#     a SMTP Mime encoded mail as the single argument.
#
# Usage:
#   1 Call send(SMTP-message). Returns indication of whether it failed or not.
#   2 Call retry to retry failed items
#   3 Watch the MailRetryFolder and MailAppendedFolder

use strict;

use lib ( '.' );
use lib ( '../lib' );
use TWiki;

use CGI;

use Mail::Internet;
use Mail::Header;

package TWiki::MailIn;
# Credit to Timo, Mike and Mark.

################################################################################
##	Constants
################################################################################
use constant ERRORDIRECTORY		=> "$TWiki::dataDir/MailErrorFolder/";
use constant APPENDDIRECTORY		=> "$TWiki::dataDir/MailAppended/";
use constant RETRYDIRECTORY		=> "$TWiki::dataDir/MailRetryFolder/";
use constant EMAILSUFFIX		=> "\@uk.andersen.com";	#only used by getEmailAddress

use constant DEBUG => 1;								#this is the debug flag

################################################################################
##	Error / Message Constants
################################################################################
use constant NODIRERROR			=> "The retry directory does not exist";
use constant DIRLOCKERROR		=> "The retry directory is locked";
use constant RETRYDIRFAIL		=> "The Retry directory counld not be opened";
use constant TOPICLOCKERROR		=> "Topic locked - will retry";
use constant TOPICNOTEXIST		=> "topic does not exist";
use constant APPENDFAILERROR	=> "Failed to append";
use constant DENIEDACCESSERROR	=> "Access denied";
use constant INVALIDEMAILERROR	=> "Invalid email address";
use constant USERNAMEERROR		=> "Incorrect username";
use constant GUESTERROR			=> "Guest cannot append content";
use constant PERMISSIONERR		=> "incorrect access permissions";
use constant RETRYOK			=> "Retry successful";
use constant APPENDOK			=> "Content appended successfully";
use constant OK					=> "ok";

################################################################################
##	Global Variables
################################################################################
#my $userName;
my $TWikiTopicName;
my $TWikiWebName;
my @originalMailArray;


################################################################################
##	Name:				sendMail
##	Input Conditions:
##	Input Parameters:
##	Output Parameters:
##	Description:		Adds mail topic straight from email
##	Error Conditions:
################################################################################
sub send
{
    my @mailArray;
	#receive the incoming mail
	my ($class, $incomingString) = @_;

	#write it into the mail array
	@mailArray = split /\n/, $incomingString;

	#append the mail to the topic
	&processMail(@mailArray);
}

################################################################################
##	Name:				retry
##	Input Conditions:
##	Input Parameters:
##	Output Parameters:
##	Description:		Adds mail topic from the retry folder
##	Error Conditions:	1.No retry directory
##						2.Retry directory contains a lock file
##						3.Retry derectory could not be opened
##						4.Append failed
################################################################################
sub retry
{
	my @mailArray;
	my $lockfilename	= 'retry.lock';
	my $lockfile		= RETRYDIRECTORY.$lockfilename;
	my $numoffiles		= 0;
	my $successes		= 0;

	#check to see it the directory exists
	if (! -e RETRYDIRECTORY)
	{
		return NODIRERROR;
	}
	#check to see if the lockfile exists
	elsif (-e "$lockfile")
	{
		return DIRLOCKERROR;
	}
	else
	{
		#create the lock file
		open(LOCK, ">$lockfile");
		print LOCK "This is a lock file. Please do not delete $lockfile";
		close(LOCK);

		#get a list of all the filenames apart from . .. and the lockfile
		opendir (DIR, RETRYDIRECTORY) || { &writedebug("Failed $! at open retry dir") && return RETRYDIRFAIL};
		my @fileNames = grep { $_ ne '.' and $_ ne '..' and $_ ne "$lockfilename" } readdir (DIR);
		closedir(DIR);

		foreach my $fileName (@fileNames)
		{
		 	$numoffiles++;
		 	#open the file and read into an array
			if(open(FILE, RETRYDIRECTORY.$fileName))
			{
				while (<FILE>)
				{
				 	push @mailArray, $_;
				}
				close(FILE);

				#append the mail to the topic and if successfull remove file from folder
				if(&processMail(@mailArray) eq APPENDOK)
				{
					#	#delete the append files from the retry folder
					#	my $deleteFile = "$directory$fileName";
					#	$deleteFile =~ m/(.*)/;
					#	$deleteFile = $1;
					#	unlink "$deleteFile";
					$successes++;
				}
				else
				{
					&writedebug("Failed to process $fileName")
				}
			}
			else
			{
				&writedebug("Failed $! to open retry file $fileName")				
			}
			
			#blank the mailArray ready for the next file
			@mailArray = ();
			
		}
		#remove the lock file
		unlink "$lockfile";
		if(($numoffiles - $successes) == 0)
		{
			return RETRYOK;
		}
		else
		{
			return "retry partialy successful $successes out of $numoffiles files appended";
		}
	}
}

################################################################################
##	Name:				processMail
##	Input Conditions:
##	Input Parameters:	mail array from calling subroutine
##	Output Parameters:	error or succes string
##	Description:		Processes the mail to be added to the topic
##	Error Conditions:	1.Topic locked
##						2.Failed to append content
##						3.Access denied
################################################################################
sub processMail
{
	my @mailArray = @_;
	@originalMailArray = @mailArray;
	my $incomingMail = new Mail::Internet \@mailArray;
	close(MESS);

  	#extract the relevant fields from the mail message
	my ( $fromAddress, $subject, $bodyContent ) = &extractContent( $incomingMail );
	&writedebug( "mailArray is \n@mailArray\n");

	#process the subject field
	$subject = &processSubjectField( $subject );

	#get webname and topic name from fully qualified webname
	($TWikiWebName, $TWikiTopicName) = &TWiki::Store::getWebTopic( $subject );

    #create login name from email address
    my $loginName = deriveLoginNameFromEmailAddress($fromAddress);

	#perform initialisation so that other TWiki modules may be used.
	&initialise($loginName, $subject);

	#perform the checks on the user and the topic
	my $userOrTopicError = &validateAbilityToWriteToTopic($loginName, $TWikiWebName, $TWikiTopicName);
	&writedebug("\nCHECKS = $userOrTopicError\n");
	if ($userOrTopicError eq OK)
	{
		#check to see if the topic is locked
		my $topiclock = &checkTopicLock($subject);

		if ($topiclock eq TOPICLOCKERROR)
		{
			return TOPICLOCKERROR;
		}
		else
		{
			#append the content to the topic
			my $error = &appendContent($fromAddress, $bodyContent);

    		if ($error)
			{
    			&writeToDir('could not append', ERRORDIRECTORY, $subject);
	 			return APPENDFAILERROR;
			}
			else
			{
				&writeToDir('append', APPENDDIRECTORY, $subject);
				return APPENDOK;
 			}
		}
	}
	else
	{
		&writeToDir($userOrTopicError, ERRORDIRECTORY, $subject);
		&writedebug("Topic Invalid or user not valid");
		return DENIEDACCESSERROR;
	}
}

################################################################################
##	Name:				deriveLoginNameFromEmailAddress
##	Input Conditions:
##	Input Parameters:
##	Output Parameters:	error string if topic locked
##	Description:		Checks whether the topic that content is being added to
##						is locked.  Moves content to retry directory if the
##						is locked.
##	Error Conditions:	1.The topic is locked
################################################################################
sub deriveLoginNameFromEmailAddress
{
    my ($fromAddress) = @_;
    $fromAddress =~ m/(.*)@.*/;
    return lc $1
}


################################################################################
##	Name:				checkTopicLock
##	Input Conditions:
##	Input Parameters:
##	Output Parameters:	error string if topic locked
##	Description:		Checks whether the topic that content is being added to
##						is locked.  Moves content to retry directory if the
##						is locked.
##	Error Conditions:	1.The topic is locked
################################################################################
sub checkTopicLock
{
	my ($subject) = @_;
	my $breakLock = "0";  #test scalar used to show that the lock can be broken
	my ( $lockUser, $lockTime ) = &TWiki::Store::topicIsLockedBy( $TWikiWebName, $TWikiTopicName );
	&writedebug("The lock user is $lockUser");
	if (($lockUser) && (!$breakLock))
	{
		#put the content in the retry folder
		&writeToDir('Retry', RETRYDIRECTORY, $subject);
		return TOPICLOCKERROR;
	}
	else
	{
		return;
	}
}

################################################################################
##	Name:				appendContent
##	Input Conditions:
##	Input Parameters:
##	Output Parameters:	Succes or Failure value set by saveTopic()
##	Description:		Appends the submitted content to the appropriate web
##	Error Conditions:	1.Content can not be appended
################################################################################
sub appendContent
{
	my ($fromAddress, $bodyContent) = @_;
	#lock the topic
	&TWiki::Store::lockTopicNew( $TWikiWebName, $TWikiTopicName );

	#check for invalid characters
	$bodyContent = &TWiki::decodeSpecialChars( $bodyContent );

	#append the new text to the old text
	my ( $meta, $tmp ) = &TWiki::Store::readTopic( $TWikiWebName, $TWikiTopicName );
	my $newText = $tmp."\n\n".$bodyContent;

	#indicate that the content was added by email and include email address
	my $finalText = $newText."(Contributed by email (".$fromAddress."))\n\n";

	#save the topic
	my $error = &TWiki::Store::saveTopic( $TWikiWebName, $TWikiTopicName, $finalText, $meta, "", 1, 0 );
	return $error;
}

################################################################################
##	Name:				extractContent
##	Input Conditions:	@mailArray must have content for this to work. 
##	Input Parameters:
##	Output Parameters:	from subject and body held in separate variables
##	Description:		Extracts the content of the email
##	Error Conditions:
################################################################################
sub extractContent
{
	my $tempMailMessage = $_[0];

	#create a temporary mail header
	my $tempMailHeader = $tempMailMessage->head();
	my $headerHash = $tempMailHeader->header_hashref();
	chomp $headerHash->{$_}[0] foreach keys(%{$headerHash});
	#get the subject field
	my $tempSubject = $headerHash->{Subject}[0];
	#get the 'from' filed
	my $tempFrom = $headerHash->{From}[0];
	#get the message body - returns a reference to the body.
	my $bodyRef = $tempMailMessage->body();
	#dereference the reference
	my @line = @$bodyRef;
	my $tempBody = "";
	foreach (@line) 
	{
		#add them all together into one string
		$tempBody = $tempBody.$_;
	}

	return ( $tempFrom, $tempSubject, $tempBody );
}


################################################################################
##	Name:				processSubjectField
##	Input Conditions:
##	Input Parameters:	$subject
##	Output Parameters:	$tempSubjectField
##	Description:		Removes Re: from beginning of email subject field
##	Error Conditions:
################################################################################
sub processSubjectField
{
	my $subject = $_[0];

	#remove Re: from the beginning
	$subject =~ s/^Re: *//;
	return $subject;
}

################################################################################
##	Name:				initialise
##	Input Conditions:
##	Input Parameters:
##	Output Parameters:
##	Description:		Used to initialise the TWiki session
##	Error Conditions:
################################################################################
sub initialise
{
	my ($userName, $subject) = @_; 
	
	my $query;
	my $theUrl;
	my $thePathInfo;
	my $theRemoteUser;
	#amend the environment variables
	$ENV{URL} = '';
	$ENV{REMOTE_USER} = $userName;
	$ENV{PATH_INFO} = "/bin/script.pl/$TWikiWebName/$TWikiTopicName";
	#create a new CGI object & extract useful info
	#read in the parameters from a file
	my $state;
	open($state, "state.txt");
	$query = new CGI($state);
	close($state);
	$theUrl = $query->url();
	$thePathInfo = $query->path_info();
	$theRemoteUser = $query->remote_user();
	&writedebug("Variables before initialisation $thePathInfo, $theRemoteUser, $subject, $theUrl, $query");

	#call initialise so we can use other TWiki modules
	my( $topic, $webName, $dummy, $theUserName ) = &TWiki::initialize( $thePathInfo, $theRemoteUser, $subject, $theUrl, $query );
    	$dummy = "";  # to suppress warning
	&writedebug("variables returned from init $topic, $webName, $dummy, $theUserName");
	#$userName = $theUserName;
	my $wikiUserName = &TWiki::userToWikiName( $theUserName );
	&writedebug("The wikiUserName is '$wikiUserName'\n");
}


################################################################################
##	Name:				validateAbilityToWriteToTopic
##	Input Conditions:
##	Input Parameters:
##	Output Parameters:
##	Description:		Performs checks on email address, topic and
##						accessibility.  Returns error status
##	Error Conditions:	1.Invalid user
##						2.Guest trying to append content
##						3.The topic does not exist
##						4.Incorrect permissions
################################################################################
sub validateAbilityToWriteToTopic
{
	my ($userName, $TWikiWebName, $TWikiTopicName) = @_;
	#check that the user is a valid user
	&writedebug("The username is $userName");
	my $wikiUserName = &TWiki::userToWikiName( $userName );
	&writedebug("The username is $wikiUserName");
	my $wikiName = &TWiki::userToWikiName( $userName, 1 );
	&writedebug("$wikiUserName   $wikiName");
	#check that the wikiName is a wikiName
	if( ! &TWiki::isWikiName( $wikiName )) 
	{
		return USERNAMEERROR;
	}
	#guests are not allowed to append content using email
	if ($wikiName eq 'TWikiGuest') 
	{
		return GUESTERROR;
	}
	#check that the topic exists
	if (! &TWiki::Store::topicExists( $TWikiWebName, $TWikiTopicName )) 
	{
		return TOPICNOTEXIST;
	}
	#read the topic text and meta data
	my ( $meta, $topicText ) = &TWiki::Store::readTopic( $TWikiWebName, $TWikiTopicName );
	#check the access permission
	if( ! &TWiki::Access::checkAccessPermission( "change", $wikiUserName, $topicText, $TWikiTopicName, $TWikiWebName ) ) 
	{
		return PERMISSIONERR;
	}
	#if there are no errors, return 'ok'
	return OK;
}

################################################################################
##	Name:				writeToDir
##	Input Conditions:
##	Input Parameters:	type of write to perform and write location
##	Output Parameters:
##	Description:		Writes a file to a directory
##	Error Conditions:
################################################################################
sub writeToDir
{
	my $tempError = $_[0];
	my $writeDir  = $_[1];
	my $subject   = $_[2];

	#check to see if the directory exists, if not create it
	if (! -e $writeDir)
	{
		umask( 0 );
		mkdir( $writeDir, 0777 );
	}

	
    #create a file using the subject title and check to see it exists

    #get all the files from the directory
    opendir(IMD, "$writeDir");
    my @fileNames = readdir(IMD);
    close(IMD);

    #initialise highest version
	my $highestversion = 0;
    my $fileName;
    #loop through the files in the directory to see if they contain 'clipboard'
    foreach $fileName (@fileNames)
    {
  		unless ( ($fileName eq ".") || ($fileName eq "..") )
  		{
   			if ($fileName=~ m/$subject(.*)\.txt/)
   			{
   				if ($1 >= $highestversion) {$highestversion = $1};
   			}
  		}
	}
    #create new version number
    my $newversion = $highestversion+1;
    my $newFilename;
	$newFilename = "$subject$newversion.txt";
	my $pathname = "$writeDir$newFilename";
	$pathname =~ m/(.*)/;
	$pathname = $1;

	&writedebug("about to write to '$pathname'\n");
	open (WRITEFILE, ">$pathname") || { &writedebug("Failed $! at file open") && return };
	print WRITEFILE "\n@originalMailArray\n";
	close (WRITEFILE);
	return;
}

################################################################################
##	Name:				storeAppendedMail
##	Input Conditions:
##	Input Parameters:
##	Output Parameters:
##	Description:		NO LONGER USED
##	Error Conditions:
################################################################################
sub storeAppendedMail
{
#	&writeToDir('append',APPENDDIRECTORY);  #ADDED BY MARK - use this for backward compatability


### USE writeToDir() INSTEAD ###
#
#	my $appendDir;
#
#	$appendDir = "$TWiki::dataDir/MailAppended/";
#
#	if (! -e $appendDir)
#	{
#		umask( 0 );
#       	mkdir( $appendDir, 0777 );
#   	}
#    #get all the files from the directory
#    opendir(IMD, "$appendDir");
#    my @fileNames = readdir(IMD);
#    close(IMD);
#    #initialise highest version
#	my $highestversion = 0;
#    my $fileName;
#    #loop through the files in the directory to see if they contain 'clipboard'
#    foreach $fileName (@fileNames)
#    {
#  		unless ( ($fileName eq ".") || ($fileName eq "..") )
#  		{
#   			if ($fileName=~ m/$subject(.*)\.txt/)
#   			{
#   				if ($1 >= $highestversion) {$highestversion = $1};
#   			}
#  		}
#	}
#	#create new version number
#	my $newversion = $highestversion+1;
#	my $newFilename;
#	if ($newversion >= 1)
#	{
#		$newFilename = "$subject$newversion.txt";
#	}
#	else
#	{	#this bit is redundant ML
#		$newFilename = "$subject.txt";
#	}
#
#	#$appendDir = "d:/twiki-install/data/MailAppended/";
#	#$newFilename = "ATappendtest.TestTopic".$newversion.".txt";
#
#	my $pathname = "$appendDir$newFilename";
#	$pathname =~ m/(.*)/;
#	$pathname = $1;
#
#	&writedebug("about to write to '$pathname'\n");
#	open (APPENDFILE, ">$pathname") || { &writedebug("Failed $! at file open") && return };
#	print APPENDFILE "\n@originalMailArray\n";
#	close (APPENDFILE);
#	return;
}

################################################################################
##	Name:				writedebug
##	Input Conditions:
##	Input Parameters:
##	Output Parameters:
##	Description:		Writes debug messages to the debug file
##	Error Conditions:
################################################################################
sub writedebug
{
	if(DEBUG)
	{
		my $debugLine = $_[0];
		open(DB, ">>webservicedebug.txt") or die "I have died $!";
		print DB "$debugLine\n";
		close(DB);
	}
}

1;