# FILE: em-reply.pl
# DESCRIPTION: Reply by e-mail
#-------------------------------------------------------------------------------
# DISCUS COPYRIGHT NOTICE
#
# Discus is copyright (c) 2002 by DiscusWare, LLC, all rights reserved.
# The use of Discus is governed by the Discus License Agreement which is
# available from the Discus WWW site at:
#    http://www.discusware.com/discus/license
#
# Pursuant to the Discus License Agreement, this copyright notice may not be
# removed or altered in any way.
#-------------------------------------------------------------------------------

use strict;
use vars qw($GLOBAL_OPTIONS $PARAMS $DCONF);

###
### reply_pipe_input
###
### For piping data into e-mail reply script
###

sub reply_pipe_input {
	error_message("Access Error", "This script cannot be accessed via the World Wide Web", 0, 1) if $ENV{'REQUEST_METHOD'} ne "";
	error_message("Access Error", "This script cannot be accessed via the World Wide Web", 0, 1) if $ENV{'REMOTE_ADDR'} ne "";
	my $buf = "\0" x 1024;
	my $text = "";
	if ($ARGV[0] eq "") {
		binmode STDIN;
		while (length($buf) == 1024) {
			read(STDIN, $buf, 1024);
			$text .= $buf;
		}
	}
	$text eq "" ? email_reply_pop3_handler() : email_reply_text_handler($text);
	program_exit(0);
}

###
### email_reply_pop3_handler
###
### Checks POP3 mailbox and then runs the handler
###

sub email_reply_pop3_handler {
	pop3_retrieve(@_);
	my $dir = join("/", $DCONF->{admin_dir}, "data", "pop3_in");
	opendir(DIR, $dir);
	my @dir = map {"$dir/$_"} grep {not /^\.\.?$/} readdir DIR;
	closedir(DIR);
	foreach my $file (@dir) {
		next if ! -f $file;
		my $tmp = $/; undef $/;
		open (FILE, "< $file");
		my $rf = <FILE>;
		close (FILE);
		$/ = $tmp;
		unlink $file;
		email_reply_text_handler($rf);
	}
}

###
### email_reply_text_handler
###
### Handles incoming messages, posting them as appropriate
###

sub email_reply_text_handler {
	my ($text) = @_;
	my $DEBUG = 1;
	my $textnew = $text;
	$text =~ s/\r\n/\n/g; $text =~ s/\r/\n/g;
	my ($header_text, $body) = split(/\n\n/, $text, 2);
	my $headers = parse_mail_headers($header_text);
	my $hash = parse_mail_body($body);
	if ($DEBUG) {
		my $char = $DCONF->{'debug_email_reply_append'} ? ">>" : ">";
		open (DEBUGFILE, "$char $DCONF->{admin_dir}/data/debug-email-reply");
		print DEBUGFILE "--------------------------------------------------------------\n";
		print DEBUGFILE "Message received at ", scalar localtime(time), "\n";
		print DEBUGFILE "--------------------------------------------------------------\n";
		while ($textnew =~ /^(.{1,40})/s) {
			$textnew = $';
			my $x = $1;
			$x =~ s/(.)/sprintf("%02x", ord($1))/ges;
			print DEBUGFILE $x, "\n";
		}
		print DEBUGFILE "--------------------------------------------------------------\n";
		print DEBUGFILE "Headers:\n\n";
		print DEBUGFILE $header_text, "\n";
		print DEBUGFILE "-" x 60, "\n";
		print DEBUGFILE "Body:\n\n";
		print DEBUGFILE $body, "\n";
		print DEBUGFILE "-" x 60, "\n";
		print DEBUGFILE "Header List:\n";
		foreach my $k (keys(%{ $headers })) {
			print DEBUGFILE "$k -> '$headers->{$k}'\n";
		}
		print DEBUGFILE "-" x 60, "\n";
		print DEBUGFILE "Body List:\n";
		foreach my $k (keys(%{ $hash })) {
			if ($k eq "message") {
				print DEBUGFILE "$k -> length ", length($hash->{$k}), "\n";
			} else {
				print DEBUGFILE "$k -> '$hash->{$k}'\n";
			}
		}
		if (ref $hash->{'codes'} eq 'ARRAY') {
			print DEBUGFILE "Administer from here codes:\n";
			foreach my $z (@{ $hash->{'codes'} }) {
				print "Code =: $z\n";
			}
		}
		print DEBUGFILE "-" x 60, "\n";
		print DEBUGFILE "Message Text:\n";
		print DEBUGFILE "'$hash->{'message'}'\n";
		close (DEBUGFILE);
	}
	return undef if $headers->{'x-mailer'} =~ /^Discus/;
	my $frh = {};
	$frh->{username} = $hash->{username};
	$frh->{COOKIE}->{cpwd} = $hash->{password};
	$frh->{COOKIE}->{rpwd} = "xxxxxxxx";
	$frh->{password} = "adminlogin";
	$frh->{topic} = $hash->{topic};
	$frh->{page} = $hash->{page};
	$frh->{passwd} = "xxxxxxxx";
	if ($hash->{'topic'} eq "0") {
		dreq("authpass");
		my $result = check_password($frh->{username}, $frh->{password}, { type_required => 'moderator' }, $frh->{COOKIE});
		if ($result->[0]->{'user'} eq $DCONF->{superuser}) {
			dreq("mailer", "template");
			my $par = email_configuration_read();
			my $mm = {};
			$mm->{general}->{test} = 1;
			my $txt = templ_int("testmail", $mm);
			send_email_message({ to => $par->{test_email_address}, subject => read_language()->{EMAIL_NOTIFICATION_TEST_SUBJECT} }, $txt, $par);
		}
	} else {
		if ($DCONF->{pro}) {
			dreq("em-admin-PRO");
		}
		my $flag = $DCONF->{pro} ? email_perform_commands($hash, $headers, $frh) : 1;
		$flag *= $hash->{is_message};
		if ($flag) {
			dreq("posting");
			my %qp_headers = map { lc($_), 1 } ('quoted-printable', '8bit');
			if ($GLOBAL_OPTIONS->{always_quoted_printable} || defined $qp_headers{lc($headers->{'content-transfer-encoding'})}) {
				$hash->{message} =~ s/=(\s)/$1/g;
				$hash->{message} =~ s/=([A-F0-9][A-F0-9])/chr(hex($1))/gie;
			}
			$frh->{message} = $hash->{message}; ##remove_html($hash->{message});
			if ($frh->{message} =~ /\\\w+\{/) {
				$frh->{active_links} = 0;
			} else {
				$frh->{active_links} = 1;
				$frh->{message} = remove_html($hash->{message});
			}
			$frh->{html} = 0;
			$PARAMS->{no_exit} = sub {
				my ($errormsg) = @_;
				if ($headers->{from} =~ /([\w\+\-\.]+)\@([\w\+\-\.]+)/) {
					my $subst = {};
					my $addr = $&;
					dreq("mailer", "template");
					$errormsg =~ s%<h3>(.*?)</h3>%$1\n\n%gi;
					$errormsg = remove_html($errormsg);
					$subst->{general}->{failed} = $errormsg;
					$subst->{general}->{topic} = $frh->{topic};
					$subst->{general}->{page} = $frh->{page};
					my $text = templ_int("erfailed", $subst);
					send_email_message({ to => $addr, subject => uc(read_language()->{EMAIL_REPLY_FAILED}) }, $text);
				}
				program_exit(0);
			};
			my $pc = posting_control(undef, $frh);
			$PARAMS->{no_exit} = undef;;
			if ($pc eq "OK") {
				return 1;
			}
		}
	}
}

###
### parse_mail_body
###
### Determines parameters from the message
###

sub parse_mail_body {
	my ($text_in) = @_;
	my %out = {};
	my $toparrow = quotemeta '--\/--\/--\/--\/--\/--\/--\/--\/--\/--\/--\/--';
	my $botarrow = quotemeta '--/\--/\--/\--/\--/\--/\--/\--/\--/\--/\--/\--';
	if ($text_in =~ /$toparrow(.*?)$botarrow/s) {
		my ($beforemessage, $message, $aftermessage) = ($`, $1, $');
		$out{'sane'} = 1;
		$message =~ s/<br[^>]*>/\n/gi;  ## So HTML formatted messages can work
		$message = $1 if $message =~ /\n+(.*)\n+/s;  ## For newline after top arrow and before bottom arrow
		my @msgline = split(/\n/, $message);
		$out{'is_message'} = 1;
		$out{'is_message'} = 0 if $msgline[0] =~ /\[.*\]\s*$/ && scalar(@msgline) == 1;
		my @portions = split(/\n\n/, $message);
		foreach my $portion (@portions) {
			$portion =~ s/\s+/ /g;
		}
		$out{'message'} = join("\n\n", @portions);
		if ($DCONF->{pro}) {
			dreq("em-admin-PRO");
			$out{'codes'} = email_scan_for_commands($beforemessage, $aftermessage);
		}
		if ($aftermessage =~ m|/(\d+)/(\d+)/(\d+)/([^\s\/]+)/(\S+)\s*\n|) {
			$out{'topic'} = $1;
			$out{'page'} = $2;
			$out{'post'} = $3;
			$out{'username'} = $4;
			$out{'password'} = $5;
			$out{'password'} =~ s/<.*?>//g;
		}
	} elsif ($text_in =~ m|/0/0/0/([^\s\/]+)/(\S+)\s*\n|) {
		$out{'topic'} = '0';
		$out{'username'} = $1;
		$out{'password'} = $2;
		$out{'password'} =~ s/<.*?>//g;
	} elsif ($DCONF->{pro}) {
		dreq("em-admin-PRO");
		$out{'codes'} = email_scan_for_commands($text_in);
		if ($text_in =~ m|/(\d+)/(\d+)/(\d+)/([^\s\/]+)/(\S+)\s*\n|) {
			$out{'topic'} = $1;
			$out{'page'} = $2;
			$out{'post'} = $3;
			$out{'username'} = $4;
			$out{'password'} = $5;
			$out{'password'} =~ s/<.*?>//g;
		}
		$out{'is_message'} = 0;
	}
	return \%out;
}

###
### parse_mail_headers
###
### Reads mail headers and dumps them into an array
###

sub parse_mail_headers {
	my ($text) = @_;
	my @lines = split(/\n/, $text);
	my %out = {};
    foreach my $line (@lines) {
		if ($line =~ /([^:]+):\s*(.*\S)\s*$/) {
			my ($key, $val) = (case_lower($1), $2);
			$out{$key} = $val;
		}
	}
	return \%out;
}

###
### pop3_retrieve
###
### Retrieves appropriate messages from a POP3 mailbox, and deletes the
### messages it's retrieved.
###

sub pop3_retrieve {
	my ($param) = @_;
	my $pop3_user = defined $param->{user} ? $param->{user} : $GLOBAL_OPTIONS->{pop3_user};
	my $pop3_pass = defined $param->{pass} ? $param->{pass} : $GLOBAL_OPTIONS->{pop3_pass};
	my $pop3_host = defined $param->{host} ? $param->{host} : $GLOBAL_OPTIONS->{pop3_host};
	my $scan = defined $param->{scan} ? $param->{scan} : $GLOBAL_OPTIONS->{pop3_scan};
	my $addr = defined $param->{addr} ? $param->{addr} : $GLOBAL_OPTIONS->{pop3_addr};
	my $as_text = defined $param->{as_text} ? $param->{as_text} : 0;
	my $pop = eval '
		use Net::POP3;
		my $pop = Net::POP3->new($pop3_host, Timeout => 30);
		$pop; ';
	if (! defined $pop) {
		if ($@ ne "") {
			log_error("em-reply.pl", "pop3_retrieve", "Initialization of POP3 connect object failed on this error: $@");
		} else {
			log_error("em-reply.pl", "pop3_retrieve", "Could not connect to POP3 host '$pop3_host' (unknown reason; perhaps a timeout occurred)");
		}
		return 1;
	}
	my $msg_count = $pop->login($pop3_user, $pop3_pass);
	if (! defined $msg_count) {
		log_error("em-reply.pl", "pop3_retrieve", "Could not log in to POP3 host '$pop3_host' (username/password was probably incorrect)");
		$pop->quit();
		return 2;
	}
	$pop->quit() if $msg_count == 0;
	return 0 if $msg_count eq "0E0";
	return 2 if $msg_count == 0;
	my @result = ();
	if ($scan) {
		my $qaddr = quotemeta($addr);
		for (my $i = 1; $i <= $msg_count; $i++) {
			my $j = $pop->top($i, 0);
			next if ! grep(/^to:.*$qaddr/i, @{ $j });
			push @result, $i;
		}
	} else {
		@result = ( 1 .. $msg_count );
	}
	my $dir = join("/", $DCONF->{admin_dir}, "data", "pop3_in");
	if (! $as_text) {
		if (! -e $dir) {
			mkdir($dir, oct($DCONF->{perms0777})) || error_message("Directory Creation Error", "Could not create incoming POP3 directory");
			chmod(oct($DCONF->{perms0777}), $dir);
		}
	}
	my @out = ();
	my $uidl = {};
	$uidl = $pop->uidl() if ! $as_text;
	foreach my $msg_get (@result) {
		if (! $as_text) {
			$uidl->{$msg_get} =~ s%\W%%g;
			my $filename = join("/", $dir, $uidl->{$msg_get});
			my $tries = 0;
			while (-e $filename) {
				$filename .= int(rand(10));
				$tries++;
				error_message("File Creation Error", "Could not create a unique file name for incoming POP3 message $uidl->{$msg_get}", 0, 1) if $tries > 10;
			}
			my $u = $pop->get($msg_get);
			next if ref $u ne 'ARRAY';
			open (FH, "> $filename");
			print FH @{$u};
			close (FH);
			$pop->delete($msg_get);
			push @out, @{$u};
		} else {
			my $u = $pop->get($msg_get);
			push @out, @{$u} if ref $u eq 'ARRAY';
			$pop->delete($msg_get);
		}
	}
	$pop->quit();
	return \@out;
}

1;
