#!/usr/bin/perl -w
use strict;
use Fcntl ':flock';  # import LOCK_* constants

use CGI;
use CGI::Carp qw/fatalsToBrowser /;
use CGI ':standard';
use POSIX qw(strftime);

my $megabyte = 1024 * 1024;  # bytes
my $max_mb   = 1;     # max no. of MB we will allow

$CGI::DISABLE_UPLOADS = 0;
# CGI module variable for en/disabling uploads (non-zero to disable)
$CGI::POST_MAX = $megabyte * $max_mb;
# CGI module variable for maximum upload size (bytes)

my $q = CGI->new();

#######  CONFIG  ########################
my $mail ='thoseguys@mysite.com';
my $news_directory='D:\\Inetpub\\theirsite.org\\alerts\\';
my $path_to_text= "$news_directory\\body.txt";
my $path_to_header="$news_directory\\index.shtml";
my $goodpass="news";
my $newspage_url = "http://www.theirsite.org/alerts/";
my $this_script_url="http://www.theirsite.org/cgi-bin/alerts.cgi";
my $max_break_count= 20; #maximum number of lines before making post into seperate page
my $default_mail="theirsite"; #used in post if no name is given
my $domain="theirsite.org";  #no www. please
### File Upload Config###
my $base_dir = "/";
my $base_dom = "http://www.theirsite.org/";
my $target_dir = "alerts/images/";
#########################################

#declare some vars
my ($time_words,$topic,$words,$pass,$name,$user,$edit,$edit_done);
my ($line_break_count,$seperate_page,$textcolor,$textface,$textsize,$topicsize);
my ($post_number,@updated_text,$plain_words,$upload_file,$image_link);
$/="\n\n\n";  #this is the delimiter for writing and rewriting the file


#Main routine
parse_form();
show_news();
get_time();

if ($pass ne $goodpass){
	bad_hacker_no_cookie();
}else {
	post_new_news();
}

mail_routine();
exit;


##</code><code>##


# Da subs
sub parse_form {
	my $sr;
	foreach my $str (qw(name words plain topic pass textcolor textface textsize topicsize edit)) {
    $sr->{$str} =$q->param($str);
}

	$name =~ s/\s/_/g;

	$plain_words=$words;
	$words =~ s/\r\n/<BR>/g;
	while ($words=~ /<br>/gi ) {$line_break_count++}  #used in fork below

	if ($q->param( "upload_file" )) { file_up(); }
	if ($edit eq "done") {
		send_edit_form();
	} elsif ($edit eq "yes") {                      #if params are undef
		make_edit_form();
	}
	if ($line_break_count > $max_break_count) {
		seperate_page()
	}
}

sub get_time {

	my ($hour,$suffix);

	$hour= strftime ("%H", localtime ());
	if ($hour >= 12) {
		$suffix="PM";
	} else {
		$suffix = "AM";
	}
	if ($hour > 12) {
		$hour -= 12;
	}

	$time_words= strftime (" at $hour:%M $suffix on %m\/%d\/%Y \n", localtime ());
	$time_words;
}

sub post_new_news {
	open (FH, "+< $path_to_text") or die "where's the damn file? : $!";
	flock (FH,LOCK_EX) or die "Couldn't flock: $!";
	my  @old_file = <FH>;
	seek FH, 0, 0;
	truncate (FH,0) or die "Can't truncate: $!";
	print FH qq|<b><font face=$textface color= #$textcolor size=$topicsize>\n
			::: $topic :::</b></font><br>\n
			<font face=$textface color= #$textcolor size=1>\n
			<div>posted by <a href="mailto:$name\@$domain"><font color=#0000FF>$name</font></a>\n
			$time_words.<p></div></font><p>\n
			<font face=$textface size=$textsize>&nbsp;&nbsp;$words</font><p>
			<img src="$image_link"><p>\n\n\n|;
	print FH @old_file;
	flock(FH,LOCK_UN);  #unlock the file
	close FH or die "close damn you : $!";
	print "Location: $newspage_url\n\n";
}


##</code><code>##

sub seperate_page {
	get_time();
	open (TOPHTML, "$path_to_header") or die "where's the html file? : $!";
	my  @html_file = <TOPHTML>;
	close TOPHTML;
	my $newhtml= strftime ("%m_%d_%Y", localtime ());
	open (NEWHTML, ">$news_directory\/$newhtml-$$.html") || die "Cannot create $newhtml ($!)";
	print NEWHTML @html_file;
	print NEWHTML qq|<b><font face=$textface color= #$textcolor size=$topicsize>\n
	 		    ::: $topic :::</b></font><br>\n
	 		    <font face=$textface color= #$textcolor size=1>\n
			    <div>posted by <a href="mailto:$name\@$domain"><font color=#0000FF>$name</font></a>\n
			    $time_words.<p></div></font><p>\n
			    <font face=$textface size=$textsize>&nbsp;&nbsp;$words</font>
			    </table></div></body></html> \n|;
	close NEWHTML;
	my $data    = $words;
	my $regex   = '.*?' . join('.*?', map { "<br>" } (1..8));
	my ($match) = $data =~ /($regex)/si;
	$words = "$match &nbsp;&nbsp;<a href=$newspage_url\/$newhtml-$$.html><font color=#0000FF>MORE&gt;&gt;</font></a></p>";
}


sub file_up {
	local $| = 1;
	my ($bytesread,$buffer,$file);
	my $directory = $base_dir . $target_dir;
	my $fh = $q->upload('upload_file');
	my $filename = $q->param('upload_file');
	$filename =~ s/[^A-Za-z0-9\.\_]//g;
	$filename =~ s/windows//i;
	$filename =~ s/desktop//i;

	open(OUTF, '>' . $directory . $filename);
	while ($bytesread = read($fh, $buffer, 1024)) {
    	print(OUTF $buffer);
	}
	close(OUTF);

	if (!$file && $q->cgi_error) {
	    print($q->header(-status=>$q->cgi_error));
	    exit 0;
	}


	$image_link = $base_dom . $target_dir . $filename;
	$image_link;
}






sub bad_hacker_no_cookie {
	print "Content-type: text/html\n\n";
     print "<HTML> \n";
     print "<body bgcolor=000000 text=99CCCC> \n";
     print "<CENTER><H1><font face=Arial>!Unauthorized Access!\n";
     print "<BR>";
     print "<font color = red>Hey bub, stop messin' with my News Page!\n";
     print "<BR>You are at IP address $user !";
     print "</H1></CENTER></font></body>";
}
sub mail_routine {
	if ($pass ne $goodpass) {
		open  MAIL,"|mail $mail" or die "mail problem : $!";
	     print MAIL "$user tried to get in using $pass for a password.\n";
	     print MAIL "They wanted to add $plain_words.";
	     close MAIL;
	 } else {
	 	open  MAIL,"|mail $mail" or die "mail problem : $!";
	     print MAIL "$user changed the news to: $plain_words.\n";
	     close MAIL;
	 }
}
sub show_news { #This sub produces the current news page
	if ($topic eq "" && $words eq "") {
		open (FTXT, "$path_to_text") or die "where's the text file? : $! is looking for $path_to_text";
		my  @text_file = <FTXT>;
		open (FHTML, "$path_to_header") or die "where's the html file? : $!";
		my  @html_file = <FHTML>;
		print "Content-type: text/html\n\n";
		print @html_file;
		print @text_file;
		print "</table></div></body></html> \n";
		exit;
	} else {
		return;
	}
}

sub send_edit_form {
   my %FORM = $q->Vars('post_number');
   my $post_number = $q->param('post_number');
   my $start = $q->param('post_number');
   $pass = $q->param('pass');
   if ($pass eq $goodpass) {
   	while ($post_number > 0) {
		if ( $q->param("box$post_number") ) {   # ignore deleted
		$_= $q->param("box$post_number");
		s/&quot;/"/g;
		s/&#039;/'/g;
		unshift @updated_text, $_;                 # keep the rest
		}
	$post_number--;
	}
	# now update file
	open(FH,">$path_to_text") || die $!;
	print FH join "\n\n\n", @updated_text;
	close(FH);
	print "Location: $newspage_url\n\n";
	exit;
 } else {
	bad_hacker_no_cookie();
	}
}



sub make_edit_form {
	open (FH, "$path_to_text") or die "where's the damn file? : $!";
	print header;
	print qq|<HTML>
			<BODY><center><form method="post" action="$this_script_url">\n
			<TABLE width=600><TR bgcolor=#000066><TD colspan=2 align=center>
			<font color=#ffffff><h2>Edit Your Posts</h2><br><font color=red>
			<h3>Uncheck Items To Delete Them</font></font><p>
			<font color="white"><b>Password:</b></font><input type="password" name="pass">
			<input type=submit name=Submit value="Delete Unchecked Posts">
			<p></TD><TR><TD>|;
	while (<FH>) {
		next if /^\n+$/;                  #ignore lines which contains only newlines
		$post_number++;
		chomp;
		s/"/&quot;/g;
		s/'/&#039;/g;
		print qq|Save This Post? \n
			<input type=checkbox name="box$post_number" value=" $_ " checked><p>
  			$_<hr>\n<p>\n<br><br><br>\n|;
  	}
  	close FH;
  	print qq|</TD></TR><TR bgcolor="#333333"><TD align="center" colspan="2">\n
  		<input type="hidden" name="post_number" value="$post_number">
  		<input type="hidden" name="edit" value="done">
  		<font color="#333333"><b>Password:</b></font></TD>
  		</form></center></table></body></html>|;
	exit;
}