#!/usr/bin/perl

require 5.004;

use strict;
use CGI::Carp qw(fatalsToBrowser);
use CGI;
use EdcomLib::SQL;
use EdcomLib::Auth;
use EdcomLib::EdcomLib;
use EdcomLib::Tables;
use EdcomLib::CGI;
use EdcomLib::Time;
use EdcomLib::Unique;
use EdcomLib::Msg;

$CGI::POST_MAX=1024 * 50;
$CGI::DISABLE_UPLOADS = 1;

my $q = new CGI;
my $s = new EdcomLib::SQL;
$s->connect(
	{'pass' => 'qudc79'}
);
my $auth = new EdcomLib::Auth;
my $time = new EdcomLib::Time;
my $cgi = new EdcomLib::CGI;
my $p = new EdcomLib::EdcomLib;
my $t = new EdcomLib::Tables;
my $msg = new EdcomLib::Msg;
my $u = new EdcomLib::Unique;

# This is our ref to an anonymous hash for EdcomLib::EdcomLib::parse() with
# values for tokens which share the same name as the hash's key

my $h = {};

# $aref is our SQL result array ref of hash refs
# $heb contains the post.pl template for either stories or message boards
# $postas is a ref to the actual UID of the posting user
# $template contains the message template for the current story dept or board

my ($aref,$heb,$postas) = undef;

# this should probably be a config table option instead

my $accept_tag = '<I> </I> <BR> <P> </P> <B> </B> <UL> </UL> <LI> <OL> </OL>'
		.'<A </A> <IMG </IMG> <BLOCKQUOTE> </BLOCKQUOTE> <PRE> </PRE>';

# we want to use the correct message template for our preview
# We also want the title of the story or board name for usage in the
# reply template itself.

my ($title,$template) = get_values();
$h->{'name'} = $title;				# so it actually gets parsed

# Current timestamp

my $timestamp = $time->now_to_dbdate();

# So parse() doesn't look for &topic and &message (which don't exist)

$h->{'topic'} = '';
$h->{'message'} = '';
$h->{'allowed_html'} = $cgi->fixhtmlout($accept_tag);
$h->{'login_anonymous_radio'} = '
<INPUT TYPE=radio NAME=postas VALUE=0 X> Anonymous Coward
';
$h->{'login_user_radio'} = '
<INPUT TYPE=radio NAME=postas VALUE=uid X> User
';

# Let the user know anonymous posting isn't allowed

if($t->fetchvalue('cs_noanon') eq '1') {
	$h->{'login_anonymous_radio'} =~ s/Anonymous Coward/Anonymous Posting Disabled/;
}

# Choose post template
# We MUST predefine $h->{'bid'} = '' if we're dealing with a story or
# $h->{'aid'} = '' if we're dealing with a message board.  If we do not
# then the value 'unable to find token...' will be used instead and
# both tests will return true.

if($q->param('bid') ne '') {
	$heb = $t->getheb('user_replyto_board');
	$h->{'aid'} = '';
}
elsif($q->param('aid') ne '') {
	$heb = $t->getheb('user_replyto');
	$h->{'bid'} = '';
}

# Loop through all of our FORM values and create HASH entries for them to be
# parsed by parse()
# Filter unacceptable HTML tags from the 'message' field and remove any
# HTML at all from the 'topic' field.  Escape unacceptable characters in
# the 'topic' field.

foreach $_ ($q->param) {
	$h->{$_} = $q->param($_);
	# we need to filter unacceptable tags!
	if($_ eq 'message') {
		$h->{$_} = filter_tags($h->{$_});
		$h->{$_} = http_to_aref($h->{$_});
	}
	if($_ eq 'topic') {
		$h->{$_} =~ s/(<[^>]*>)//gi;
		$h->{$_} = $cgi->fixhtmlout($h->{$_});
	}
}

# This is our mechanism to prevent double posts --
# We store a CID for the message when the form is first loaded and we carry that
# through each subsequent 'Preview' or 'Post' action.  We also insert this valid
# into the database if it is not yet available.  Later, when the user actually
# posts a message, there is already an entry in the database, so it is merely
# updated.  If the user misguidedly (or maliciously) attempts to submit the FORM
# more than once, it will simply update the existing record repeatedly.

$h->{'msgid'} = getid() if $h->{'msgid'} eq '';

# Log the user into his account and setup user account and anonymous radio buttons
# $doheader will control whether or not we spit out a header based on whether or
# not we just outputted a Set-Cookie: header to the browser.

my $doheader = do_login_stuff();

# Let's get the parent comment's table row

my $parent_row = fetch_parent();

# Display a preview of the message we're replying to, if it exists

$h->{'preview_parent'} = '';
preview_parent($parent_row) if $parent_row;

# Create the standard "RE: some poster's topic" line for replies.
# If $h->{'topic'} isn't set by the user and the user is replying
# to an existing post (versus creating a new one), we'll call reply_topic().

$h->{'topic'} = reply_topic($parent_row) if ($parent_row and $h->{'topic'} eq '');

# Quote the message we're replying to if the user choose to utilize the
# quoting reply feature.
# Ideally we're going to either BLOCKQUOTE each paragraph or do the
# traditional greater-than-style

$h->{'message'} = reply_msg($parent_row) if (
	$q->param('q') eq '1' and $parent_row and $h->{'message'} eq ''
);

# Display a preview of the message being posted

preview();

if(post_is_okay() and user_can_post()) {

	# First, our message is going to need a thread ID
	# Let's fetch the ID of the current thread, if there is one.

	my $mytid = $q->param('tid');

	# If there wasn't a current thread ID, let's make a new one
	# (aka this is a brand new thread the user is starting)

	if($q->param('cid') eq '0' and $mytid eq '') {
		$mytid = $u->unique_tid();
	}

	# If this is not a top level post, but we're missing the thread ID then
	# we have a serious integrity problem.  Let's trying to get the proper
	# thread ID from the parent comment, if we can...
	# If we can't, we must abort.

	elsif($q->param('cid') ne '0' and $mytid eq '') {
		my $aref = undef;
		if($q->param('aid') ne '') {
			$aref = $s->sql(
				"SELECT tid FROM comments WHERE parent = ?",
				$q->param('cid')
			);
		}
		elsif($q->param('bid') ne '') {
			$aref = $s->sql(
				"SELECT tid FROM msgcomments WHERE parent = ?",
				$q->param('cid')
			);
		}
		if($aref and $aref->[0]->{'tid'} ne '') {
			$mytid = $aref->[0]->{'tid'};
		}
		else {
			$h->{'update_message'} = 'Posting failed do to an interal error.';
			return;
		}
	}

	# Our SQL return result
	# Different DBI drivers return differing result values
	# Some statements that return a reliable true value on success
	# in one database may not in another, but this'll be "good enough"

	my $r = 0;

	# for moderation - will depend on anon or account posting
	# Since any actual moderation doesn't exist yet, we'll assign all
	# messages a default of '0'.  If we ever add moderation, some kind of
	# routine will determine a user's default post score here.

	my $score = 0;

	# We'd like comment in the database to use line breaks, rather than hard returns
	# to signal new lines, since we won't have to do any regex replacements when
	# outputting comments this way.

	my $message = $h->{'message'};
	$message =~ s/\n/<BR>/g;
#	$message =~ s/\r/<BR>/g;

	# If the user's logged in and wants to post as himself, we're going to
	# append his signature to the end of his post.

	$message .= append_sig() if $postas ne '0';

	if($q->param('bid') ne '') {
		$r = $s->sql(
			"UPDATE msgcomments SET parent = ?, tid = ?, bid = ?, uid = ?,
			topic = ?, message = ?, score = ?, ts = ? WHERE cid = ?",
			$q->param('cid'),$mytid,$q->param('bid'),$postas,
			$h->{'topic'},$message,$score,$timestamp,$h->{'msgid'}
		);
		if($r and $q->param('cid') eq '0') {
			$s->sql(
				"INSERT INTO thread_updates VALUES(?,?)",
				$mytid,$timestamp
			);
			$s->sql(
				"INSERT INTO recent_threads VALUES(?,?,?,?)",
				$auth->fetchuseruid(),$mytid,$timestamp,'y'
			) if $auth->fetchuseruid();
		}
		else {
			$s->sql(
				"UPDATE thread_updates SET ts = ? WHERE tid = ?",
				$timestamp,$mytid
			);
			$s->sql(
				"UPDATE recent_threads SET ts = ? WHERE uid = ? AND tid = ?",
				$timestamp,$auth->fetchuseruid(),$mytid
			) if $auth->fetchuseruid();
		}
	}
	elsif($q->param('aid') ne '') {
		$r = $s->sql(
			"UPDATE comments SET parent = ?, tid = ?, aid = ?, uid = ?,
			topic = ?, message = ?, score = ?, ts = ? WHERE cid = ?",
			$q->param('cid'),$mytid,$q->param('aid'),$postas,
			$h->{'topic'},$message,$score,$timestamp,$h->{'msgid'}
		);
	}

	# If the post was to a story, update the story's touch column

	if( $r and $q->param('aid') ne '' ) {
		$s->sql(
			"UPDATE stories SET touch = ? WHERE aid = ?",
				$time->now_to_dbdate(),
				$q->param( 'aid' )
		);
	}

	# If we were successful, we want to tell the user and let him
	# see for himself.

	if($r) {
		if($postas ne '0' and $postas) {
			if($q->param('bid') ne '') {
				$msg->post_new($postas,$timestamp,'msgcomments',$h->{'msgid'});
			}
			elsif($q->param('aid') ne '') {
				$msg->post_new($postas,$timestamp,'comments',$h->{'msgid'});
			}
		}
		else {
			$msg->post_new($q->remote_host(),$timestamp);
		}
		$h->{'user_post_url'} = gotopost($h->{'msgid'},$mytid);
		if($q->param('bid') ne '') {
			$h->{'update_message'} = $p->parse($t->getblock('post_success_bid'),$h);
		}
		elsif($q->param('aid') ne '') {
			$h->{'update_message'} = $p->parse($t->getblock('post_success_aid'),$h);
		}
	}
	else {

		# Something went wrong.  We couldn't post.  Inform the user.

		$h->{'update_message'} = $t->getblock('post_fail');
	}
}

print $q->header() if $doheader;

print $p->parse(
	$heb,
	$h
);

sub do_login_stuff {
	my $uid = \$postas;
	if($q->param('email') ne '' and $q->param('passwd') ne '') {
		if($auth->login($q->param('email'),$q->param('passwd'))) {

			# Our login succeeded

			$h->{'update_message'} = $t->getblock('post_login_success');

			# Set our script-wide user ID

			$$uid = $auth->fetchuseruid();

			# Setup our radio box FORM element for the user

			$h->{'login_user_radio'} =~ s/uid/$$uid/i;
			$h->{'login_user_radio'} =~ s/ X>/ CHECKED>/i;
			my $user = $auth->fetchuser();
			$h->{'login_user_radio'} =~ s/User/$user/i;

			# Setup our radio box FORM element for anonymous

			$h->{'login_anonymous_radio'} =~ s/ X>/ >/i;

			# Login was successful (conversely do not print a $q->header() )

			return 0;
		}
		else {

			# Our login attempt failed

			$h->{'update_message'} = $t->getblock('post_login_fail');

			# All posts will be with the anonymous user

			$$uid = '0';

			# Setup our radio box FORM element for the user

			$h->{'login_user_radio'} =~ s/uid/$$uid/i;
			$h->{'login_user_radio'} =~ s/ X>/>/i;
			$h->{'login_user_radio'} =~ s/User/You are not logged in/i;

			# Setup our radio box FORM element for anonymous

			$h->{'login_anonymous_radio'} =~ s/ X>/ CHECKED>/i;

			return 1;
		}
	}
	elsif(! $auth->auth()) {

		$h->{'update_message'} = $t->getblock('post_default_nologin');

		# No login attempt was made and the user is not cookied
		# Assume anonymous posting

		$$uid = '0';

		# Setup our radio box FORM element for the user

		$h->{'login_user_radio'} =~ s/uid/$$uid/i;
		$h->{'login_user_radio'} =~ s/ X>/>/i;
		$h->{'login_user_radio'} =~ s/User/You are not logged in/i;

		# Setup our radio box FORM element for anonymous

		$h->{'login_anonymous_radio'} =~ s/ X>/ CHECKED>/i;

		return 1;
	}
	else {

		# user didn't try to login just now and is already cookied
		# user may have chosen to post anonymously -- check

		if($q->param('postas') eq $auth->fetchuseruid()) {

			$h->{'update_message'} = $t->getblock('post_default_loggedin');

			$$uid = $auth->fetchuseruid();

			# Setup our radio box FORM element for the user

			$h->{'login_user_radio'} =~ s/uid/$$uid/i;
			$h->{'login_user_radio'} =~ s/ X>/ CHECKED>/i;
			my $user = $auth->fetchuser();
			$h->{'login_user_radio'} =~ s/User/$user/i;

			# Setup our radio box FORM element for anonymous

			$h->{'login_anonymous_radio'} =~ s/ X>/>/i;

			return 0;

		}
		elsif($q->param('postas') eq '0') {

			$h->{'update_message'} = $t->getblock('post_default_loggedin');

			$$uid = '0';

			# Setup our radio box FORM element for the user

			my $uid = $auth->fetchuseruid();
			$h->{'login_user_radio'} =~ s/uid/$uid/i;
			$h->{'login_user_radio'} =~ s/ X>/>/i;
			my $user = $auth->fetchuser();
			$h->{'login_user_radio'} =~ s/User/$user/i;

			# Setup our radio box FORM element for anonymous

			$h->{'login_anonymous_radio'} =~ s/ X>/ CHECKED>/i;

			return 0;
		}
		else {
			$$uid = $auth->fetchuseruid();

			# Setup our radio box FORM element for the user

			$h->{'login_user_radio'} =~ s/uid/$$uid/i;
			$h->{'login_user_radio'} =~ s/ X>/ CHECKED>/i;
			my $user = $auth->fetchuser();
			$h->{'login_user_radio'} =~ s/User/$user/i;

			# Setup our radio box FORM element for anonymous

			$h->{'login_anonymous_radio'} =~ s/ X>/>/i;

			$h->{'update_message'} = $t->getblock('post_default_loggedin');

			return 0;
		}
	}
}

# Pull the comment being replied to (if any) from the database so its fields
# can be displayed to the user while he comments on it.

sub fetch_parent {
	my $aref = undef;
	if($q->param('bid') ne '') {
		$aref = $s->sql(
			"SELECT cid,parent,bid,uid,topic,message,score,ts FROM msgcomments
			WHERE cid = ?", $q->param('cid')
		);
	}
	elsif($q->param('aid') ne '') {
		$aref = $s->sql(
			"SELECT cid,parent,aid,uid,topic,message,score,ts FROM comments
			WHERE cid = ?", $q->param('cid')
		);
	}
	else {
		return undef;
	}
	return $aref->[0];
}

# Quote the message the user is replying to

sub reply_msg {
	my $href = shift;
	my $message = $href->{'message'};

	$message = "<I>$message<\/I>";

	return $message;

	# This doesn't work for replies to messages that used reply w/ quote

	use Text::Wrap qw(fill $columns);
	$columns = 60;

	# We're stripping all HTML tags since they just complicate things
	# The most important part of most messages is going to be the raw text
	# itself, so we're going to quote that and dump the formatting.

	$message =~ s/<A\s+HREF=.*>(.*)<\/A>/$1/g;
	$message =~ s/<BR>>/\n\n>/g;
	$message =~ s/<BR>/\n/g;
	$message =~ s/<P>/\n\n/g;
	$message =~ s/(<[^>]*>)//g;


	# Use Text::Wrap::fill to split the message into columns of length $columns
	# Use the initial and subsequent indentation fields to insert ">"
	# It might also be possible to use <I> and later insert </I> to close it

	$message = fill(">",">",$message);

	$message =~ s/\n/<BR>/g;
#	$message =~ s/<BR>>/><BR>>/g;

	return $message;
}

# The goal if this routine is to attempt to prevent (along with some additional
# tables and logic) users with and without accounts from abusing the system
# by posting extremely rapidly.  Right now, extremely rapid is hardcoded at
# 2 messages a minute for users with accounts and a message every five minutes
# for anonymous cowards.  Whether or not post-blackout-periods actually deter
# any kind of abusive or trolling activity is left as an exercise to the reader.
# This functionality can be turned off in the configuration section of the
# administration system.

sub user_can_post {

	# Commenting abuse protection (ie: posting blackout periods)
	# has been disabled, so anything goes.

	if($t->fetchvalue('cs_stop_abuse') eq '0') { return 1; }

	# The user is trying to post anonymously when anonymous posting
	# is forbidden.  That's unacceptable.

	if($postas eq '0' and $t->fetchvalue('cs_noanon') eq '1') { return 0; }

	# See if the user can post based on either his uid if logged in or
	# his IP if he's posting annoymously.

	if($postas ne '0' and ! $msg->post_check($postas)) {
		$h->{'update_message'} = $t->getblock('post_timeout');
		return 0;
	}
	elsif(! $msg->post_check_anon($q->remote_host())) {
		$h->{'update_message'} = $t->getblock('post_timeout');
		return 0;
	}

	# Everything looks okay, the user can proceed with posting!

	return 1;
}

sub post_is_okay {
	if($q->param('submit') !~ m/post/i) {
		return 0;
	}
#	elsif($t->fetchvalue('cs_noanon') eq '1' and $q->param('postas') eq 'no') {
#		$h->{'update_message'} = $t->getblock('post_no_anon');
#		return 0;
#	}
#	elsif($q->param('postas') eq '') {
#		$h->{'update_message'} = $t->getblock('post_no_acct');
#		return 0;
#	}
	elsif(! defined $h->{'topic'} or $h->{'topic'} eq '') {
		$h->{'update_message'} = $t->getblock('post_no_topic');
		return 0;
	}
	elsif(! defined $h->{'message'} or $h->{'message'} eq '') {
		$h->{'update_message'} = $t->getblock('post_no_msg');
		return 0;
	}
	else { return 1; }
}

# Create a link to the user's new post so he can go to it if he wants
# This is really messy because the target id and script name differ
# depending on whether we're posting to a story or a message board.

sub gotopost {
	my $myid = shift;
	my $mytid = shift;
	my $gotourl = '';
	if($q->param('cid') eq '0') {
		$gotourl = $t->fetchvalue('lib_cgiwebpath');
		if($q->param('bid') ne '') {
			$gotourl .= "/msgboard.pl?bid=".$q->param('bid');
		}
		elsif($q->param('aid') ne '') {
			$gotourl .= "/comments.pl?aid=".$q->param('aid');
		}
		$gotourl .= "&tid=$mytid&cid=$myid&parent=0";
	}
	else {
		$gotourl = $t->fetchvalue('lib_cgiwebpath');
		if($q->param('bid') ne '') {
			$gotourl .= "/msgboard.pl?bid=".$q->param('bid');
		}
		elsif($q->param('aid') ne '') {
			$gotourl .= "/comments.pl?aid=".$q->param('aid');
		}
		$gotourl .= "&tid=".$mytid."&parent=".$q->param('cid')
	}
	$gotourl .= "&sort=".$cgi->getsafe($q->param('sort'))
		."&view=".$cgi->getsafe($q->param('view'))
		."&date=".$cgi->getsafe($q->param('date'))
		.'#'.$myid;
	return $gotourl;
}

sub filter_tags {
	my $value = shift;
	my @markup = $value =~ m/(<[^>]*>)/g;
	foreach my $tag (@markup) {
		if($accept_tag !~ m/$tag/i
			and $tag !~ m/<a href/i
			and $tag !~ m/<img src/i
		) {
			$value =~ s/$tag//ig;
		}
	}
#	$value =~ s/\n/<BR>/gi; # hard returns => <BR>
	return $value;
}

# There is a bug in this sub where it fails to check for things like
# <IMG SRC=http://foo.com/> or http://bar.com/ where bar is on the end
# of the very last line of a post.

sub http_to_aref {
	my $value = shift;

	my @http = (
		$value =~ m#(?<!<A HREF=")(http://.*)(?=\s)#gi,
		$value =~ m#(?<!<A HREF=")(http://.*)$#gi,
	);

	foreach my $http (@http) {
		next if $value =~ m#<A HREF="$http#gi;
		next if $value =~ m#SRC="$http#gi;
		$value =~ s/\Q$http\E/<A HREF="$http">link<\/A>/g;
	}
	return $value;
}

# We have to install a place holder in the database, so this won't get
# used while the user composes his message
# We'll update this entry instead of deleting it and doing another INSERT

sub getid {
	my $myid = $u->unique_cid();
	if($q->param('bid') ne '') {
		$s->sql(
			"INSERT INTO msgcomments VALUES(?,?,?,?,?,?,?,?,?)",
			$myid,'0','0','0','0','.','.',0,$time->now_to_dbdate()
		);
	}
	elsif($q->param('aid') ne '') {
		$s->sql(
			"INSERT INTO comments VALUES(?,?,?,?,?,?,?,?,?)",
			$myid,'0','0','0','0','.','.',0,$time->now_to_dbdate()
		);
	}
	return $myid;
}

sub get_values {
	if($q->param('bid') ne '') {
		my $aref = $s->sql(
			"SELECT name,description,layout_t,msg_t FROM msgboards WHERE bid = ?",
			$q->param('bid')
		);
		return $aref->[0]->{'name'},$aref->[0]->{'msg_t'};
	}
	elsif($q->param('aid') ne '') {
		my $aref = $s->sql(
			"SELECT title,comment_t FROM stories,dept WHERE
				aid = ? AND dept.did = stories.did",
			$q->param('aid')
		);
		return $aref->[0]->{'title'},$aref->[0]->{'comment_t'};
	}
}

sub preview {

	# Set the poster's UID so the preview is correct

	$h->{'uid'} = $postas;

	# Set the timestamp

	$h->{'ts'} = $timestamp;

	# convert hard returns to line breaks for proper viewing in text/html

	if($q->param('submit') =~ m/preview/i or $q->param('submit') =~ m/post/i) {

		# Append the user's sig to his post preview

		my $oldmsg = $h->{'message'};
		$h->{'message'} .= append_sig();
		$h->{'message'} =~ s/\n/<BR>/gi; # hard returns => <BR>

		$h->{'preview'} = $p->parse(
			$t->getheb($template),
			$h
		);

		# Restore the original message without the sig.
		# We don't want it getting added a million times for each preview the
		# user does and it'll just get in the way of the actual post.

		$h->{'message'} = $oldmsg;
	}
	else {
		$h->{'preview'} = '';
	}
}

sub preview_parent {
	my $href = shift;

	$h->{'preview_parent'} = '';

	$h->{'preview_parent'} = $p->parse(
		$t->getheb($template),
		$href
	);
}

sub reply_topic {
	my $href = shift;

	# If the message we're replying to already contains RE: (reply)
	# then we needn't add it again.
	# Otherwise, we'll prepend RE: to the beginning of the topic line

	if($href->{'topic'} !~ m/RE:/i) {
		return "RE: $href->{'topic'}";
 	}
	else {
		return $href->{'topic'};
	}
}

# Append the user's signature to the end of his post.
# Ideally, this should have already been cleaned of illegal HTML tags
# in profile.pl, so we should be able to append it without worry.

sub append_sig {
	my $aref = $s->sql(
		"SELECT uid,signature FROM userinfo WHERE uid = ?",
		$auth->fetchuseruid()
	);
	if($aref->[0]->{'signature'} ne '') {
		$aref->[0]->{'signature'} =~ s/\n/<BR>/gi; # <BR> => hard return
		return "<BR><BR>---<BR><BR>$aref->[0]->{'signature'}";
	}
	return '';
}