#!/usr/bin/perl
#!/usr/bin/perl
#!/usr/bin/perl
##########################################################
## Castle Links						
## Created: 06/17/1999			
##########################################################
# By: Castle CGI										
# WebSite: www.castellum.net				
##########################################################
##########################################################
# (C)Copyright 1999-2001 Castellum.net, All rights reserved	
##########################################################
# DISCLAIMER:						
# THIS PROGRAM IS PROVIDED WITHOUT WARRANTIES OF ANY    
# KIND, WHETHER EXPRESSED OR IMPLIED.   THIS PROGRAM IS 
# PROVIDED WIThOUT WARRANTIES AS TO PERFORMANCE, OR  	
# MERCHANTABILITY OF THIS PROGRAM.			
# TERMS OF USE:						
# THIS SCRIPT MAY BE MODIFIED, BUT NOT REDISTRIBUTED IN	
# ANY WAY, SHAPE, OR FORM.  IN ANY CASE, COPYRIGHT AND  
# SCRIPT INFORMATION MUST BE KEPT IN PLACE		
##########################################################
use Fcntl qw(:DEFAULT :flock); 
*Error = \&DieNice;

##################################
## GET QUERY STRING INTO %query
##################################
my %query = ();
foreach my $pair (split(/&/,$ENV{'QUERY_STRING'})){
	my($name,$value) = split(/=/,$pair);
	$name =~ s/\+/ /g;
	$name =~ s/%(..)/chr(hex($1))/ge;
	$value =~ s/\+/ /g;
	$value =~ s/%(..)/chr(hex($1))/ge;
	$query{$name}.= $value;
}

##################################
## GET FORM INPUT INTO %input
##################################
my $in = undef;
my %input = ();
read(STDIN, $in, $ENV{'CONTENT_LENGTH'});
foreach my $pair (split(/&/,$in)){
	my($name,$value) = split(/=/,$pair);
	$name =~ s/\+/ /g;
	$value =~ s/\+/ /g;
	$name =~ s/%(..)/chr(hex($1))/ge;
	$value =~ s/%(..)/chr(hex($1))/ge; 
	if ($input{$name}){$input{$name}.= ",";}  
	$input{$name}.= $value 
}

##################################
## LOAD SETUP INTO LOCAL %setup ##
##################################
my %setup = ();
open(SETUP, "clinks_setup.pl")||&TrueDie("Opening clinks_setup.pl: $!");
while(<SETUP>){
	chomp;
	my($name,$value) = split(/=/);
	$setup{$name} .= $value;
}
close(SETUP);
my $t_dir = $setup{'template_dir'};


###################################
## LOAD CATEGORIES
###################################
my %categories = ();
my $category_options = '';
my %category_counts = ();

open(CATS, "$setup{'category_file'}")||&Error("Opening $setup{'category_file'}: $!");
if ($setup{'flock'} == 1){flock(CATS,LOCK_SH);}
while(<CATS>){
	chomp;
	my($title,$count,$path,$addto,$desc) = split(/\|\|/);
	$categories{$path} = $_;
	$category_counts{$path} = $count;
}
if ($setup{'flock'} == 1){flock(CATS,8);}
close(CATS);

foreach my $category (sort(keys %categories)){
	$category_options .= "<OPTION value=\"$category\">$category</OPTION>";
}

#################################
## DETERMINE TEMPLATE
#################################
my $file = 'thankyou.htm';
if ($query{'action'} ne 'add'){
	$file = 'add.htm'
}

###################################
## LOAD TEMPLATE
###################################
open(MASTER, "$t_dir/master.htm")||&DieNice("Openeing: $t_dir/master.htm $!");
my($temp1,$temp2) = split(/!INSERT!/,join('',<MASTER>));
close(MASTER);

open(TEMPLATE, "$t_dir/$file")||&DieNice("Opening: $t_dir/$file $!");
my $html = $temp1 . join('',<TEMPLATE>) . $temp2;
close(TEMPLATE);
$temp1 = undef;
$temp2 = undef;
	
my %vars = (
					'version'	=>		'4.51',
					'add_url'	=>		'add.cgi',
					'search_url'=>		'search.cgi',
					'new_url'	=>		'whatsnew.cgi',
					'old_url'	=>		'whatsold.cgi',
					'random_url'=>		'random.cgi',
);
$html =~ s/\$([vasnor]\w+)/$vars{$1}/g;
$html =~ s/<!--CATEGORY OPTIONS-->/$category_options/gi;
$html =~ s/<!--OPTIONS-->/$category_options/gi;

#################################
## DETERMINE ACTION
#################################
if ($query{'action'} ne 'add'){
	print "Content-type: text/html\n\n";
	print $html;
	exit;
}

#################################
## CHECK REFERRER
#################################
if ($setup{'disable_referrer'} == 0){
	my $found = 0;
	foreach $referers (split(/,/,$setup{'referers'})){
		if ($ENV{'HTTP_REFERER'} =~ /$referers/i){
			$found = 1;
			last;
		}
	}
	if ($found != 1){
		&DieNice($setup{'error_referer'});
		exit;
	}
}

#################################
## GET INPUT & CHECK IT
#################################
my $title = $input{'title'};
my $url = $input{'url'};
my $description = $input{'description'};
my $category = $input{'category'};
my $email = $input{'email'};

#$category =~ s/ /_/g;

if ($setup{'require_email'} == 1){
	if ($email !~ /^\w[\-\.\w]*\@[\-\.\w]+\.\w+$/i){&Error("$setup{'error_email'}");}
}

if ($category_counts{$category} !~ /^[0-9]+$/){&Error("$setup{'error_category'}");}
if ($setup{'require_description'} == 1){
	if ($description eq ""){&Error("$setup{'error_description'}");}
}
if ($title eq ""){&Error("$setup{'error_title'}");}
if ($url !~ /\w*.(\w\w\w|\w\w)/){&Error("$setup{'error_url'}");}
if ($url !~ /^(http|ftp|telnet|https):\/\//i){
	$url = "http://$url";
}
$url =~ s/\|//g;
$title =~ s/\|//g;
$description =~ s/\|//g;
$description =~ s/(\r\n|\n)/  /g;
if (length($title) > $setup{'max_title'}){&Error($setup{'error_longtitle'});}
if (length($description) > $setup{'max_description'}){&Error("$setup{'error_longdescription'}");}

if ($setup{'ban_html'} == 1){
	$title =~ s/</&lt;/g;
	$title =~ s/>/&gt;/g;
	$url =~ s/</&lt;/g;
	$url =~ s/>/&gt;/g;
	$description =~ s/</&lt;/g;
	$description =~ s/>/&gt;/g;
}

if ((split(/,/,$setup{'banned_urls'}))[0] ne ''){
	foreach $banned (split(/\[\]/, $setup{'banned_urls'})){
		if ($url =~ /$banned/i){&Error("$setup{'error_bannedurl'}");}
	}
}
if ((split(/,/,$setup{'banned_words'}))[0] ne ''){
	foreach $words (split(/,/,$setup{'banned_words'})){
		if ($title =~ /$words/i){&Error($setup{'error_bannedword'});}
		if ($description =~ /$words/i){&Error($setup{'error_bannedword'});}
	}
}

#################################
## GENERATE LINK ID & TIME
#################################
my $salt1 = substr(rand,2,1);
my $salt2 = substr(rand,2,1);
my $random1 = time;
$random1 = rand($random1);
$random1 = crypt($random1,"$salt1$salt2");
$random1 =~ s/\W//g;
my $date = time;

#################################
## CHECK FOR UNIQUE
#################################

if ($setup{'require_unique'} == 1){
	open(LINKS, "$setup{'links_file'}")||&DieNice("cOpening $setup{'links_file'}: $!");
	if ($setup{'flock'} == 1){flock(LINKS,LOCK_SH);}
	while(<LINKS>){
		chomp;
		my($ltitle,$ldescription,$lid,$lcat,$ldate,$lurl,$lemail) = split(/\|\|/);
		if ($lurl =~ /^$url$/i){&Error($setup{'error_duplicate'});}	
	}
	if ($setup{'flock'} == 1){flock(LINKS,8);}
	close(LINKS);
}

#################################
## ADD LINK TO DB
#################################


if ($setup{'link_order'} eq "down"){
	# Backticks to cp for file copy
	`cp $setup{'links_file'} data/$random1$date`;
	
	open(CP, "data/$random1$date")||&DieNice("Opening data/$random1$date: $!");

	sysopen(LINKS, "$setup{'links_file'}", O_WRONLY | O_CREAT)||&Error("Opening $setup{'links_file'}: $!");
   if ($flock == 1){flock(LINKS, LOCK_EX)||&Error("Couldn't flock: $!");}
	truncate(LINKS, 0);
  	print LINKS "$title||$description||$random1||$category||$date||$url||$email\n";
	while(<CP>){
		print LINKS;
	}
	if ($flock == 1){flock(LINKS, LOCK_UN);}
	close(LINKS);
	
	close(CP);
	unlink("data/$random1$date");
}else{
	open(LINKS,">>$setup{'links_file'}")||&Error("Opening $setup{'links_file'}: $!");
   if ($flock == 1){flock(LINKS, LOCK_EX)||&Error("Couldn't flock: $!");}
  	print LINKS "$title||$description||$random1||$category||$date||$url||$email\n";
	if ($flock == 1){flock(LINKS, LOCK_UN);}
	close(LINKS);
}

#############################
## UPDATE CATEGORY COUNTS  
#############################
my @category = split(/\//,$category);
shift(@category);
while (@category[0] ne ""){
	my $catup = join("/",@category);
	my $temp_num = $category_counts{"/$catup"};
	$category_counts{"/$catup"} = $temp_num +1;
	my $last = pop(@category);
}

#############################
## WRITE CATEGORIES OUT
#############################

sysopen(CATS, $setup{'category_file'}, O_WRONLY | O_CREAT)||&Error("Opening $setup{'links_file'}: $!");
if ($flock == 1){flock(CATS, LOCK_EX)||&Error("Couldn't flock: $!");}
truncate(CATS, 0);
foreach my $category (keys %categories){
	my($title,$count,$path,$addto,$desc) = split(/\|\|/,$categories{$category});
	$count = $category_counts{$category};
	if ($count =~ /^\w+$/){
		print CATS "$title||$count||$path||$addto||$desc\n";
	}
}
if ($setup{'flock'} == 1){flock(CATS,LOCK_UN);}
close(CATS);


#############################
## SEND THANK YOU
#############################
if ($setup{'send_thankyou'} == 1 && $email =~ /^\w[\-\.\w]*\@[\-\.\w]+\.\w+$/){
	open(EMAIL, "$setup{'addition_email'}")||&Error("Couldn't open $setup{'addition_email'}: $!");
	my $from_name = <EMAIL>;
	my $from_email = <EMAIL>;
	chomp $from_name;
	chomp $from_email;
	my $subject = <EMAIL>;
	my $message = join('',<EMAIL>);
	close(EMAIL);

	$subject =~ s/\$link_title/$title/gi;
	$subject =~ s/\$link_url/$url/gi;
	$subject =~ s/\$link_description/$description/gi;
	$subject =~ s/\$link_email/$email/gi;
	$subject =~ s/\$link_category/$category/gi;

	$message =~ s/\$link_title/$title/gi;
	$message =~ s/\$link_url/$url/gi;
	$message =~ s/\$link_description/$description/gi;
	$message =~ s/\$link_email/$email/gi;
	$message =~ s/\$version/4.51/gi;
	$message =~ s/\$link_category/$category/gi;

	open(MAIL,"|$setup{'sendmail'} -t")||&Error("Sendmail Failure: $!");
	print MAIL "To: $email\n";
	print MAIL "From: $from_name <$from_email>\n";
	print MAIL "Subject: $subject\n\n";
	print MAIL "$message\n\n";
	close(MAIL);
}

#############################
## SEND ADDED NOTICE
#############################

if ($setup{'send_notice'} == 1 && $setup{'admin_email'} =~ /^\w[\-\.\w]*\@[\-\.\w]+\.\w+$/){
	open(MAIL,"|$setup{'sendmail'} -t")||&Error("Sendmail Failure: $!");
	print MAIL "To: $setup{'admin_email'} <$setup{'admin_email'}>\n";
	print MAIL "From: Castle Links <$setup{'admin_email'}>\n";
	print MAIL "Subject: Link added to database\n\n";
	print MAIL qq~
	You are getting this email because you selected "Send Notice" in the 
	Script Setup section of the Castle Links Administrative script.
	
	A link has been added to your database.
	
	Category: $category
	Email: $email
	Title: $title
	URL: $url
	Description:
	$description
	
	
	Best regards,
	Castle Links v4.51
	~;
	close(MAIL);
}


##############################
## PRINT HEADER & HTML
##############################
print "Content-type: text/html\n\n";
print '<!--';
print 'ClBvd2VyZWQgYnk6IENhc3RsZSBMaW5rcwooYylDb3B5cmlnaHQgMTk5OS0yMDAwIENhc3RlbGx1';
print 'bS5uZXQsIEFsbCBSaWdodHMgUmVzZXJ2ZWQKU2NyaXB0IEF2YWlsYWJsZSBBdCBodHRwOi8vd3d3';
print 'LmNhc3RlbGx1bS5uZXQK';
print '-->';

$html =~ s/\$title/$title/gi;
$html =~ s/\$url/$url/gi;
$html =~ s/\$description/$description/gi;
$html =~ s/\$category/$category/gi;
$html =~ s/\$email/$email/gi;

print $html;




##############################
## DIE SUB-ROUTINE
##############################

sub DieNice {
	my $error = shift;
	print "Content-type: text/html\n\n";
	print qq~
<html>
<head>
<title>Castle Links v$version</title>
</head>
<body bgcolor="#E9E9E9" link="#800000">
<h2 align="left">Error: $error</h2>
<p align="left">The script encountered an error while trying to complete your request.  If
this is an error on your part, please press the back button and correct it.</p>
<hr>
<h6 align="center">Powered By: <a href="http://www.castellum.net/cgi/clinks/">Castle
Links</a><br>
©1999-2001 <a href="http://www.castle-cgi.com">Castle CGI</a>, All Rights
Reserved<br>
Script available at <a href="http://www.castle-cgi.com">http://www.castle-cgi.com</a></h6>
<p align="center">&nbsp;</p>
</body>
</html>
~;
exit;

}


1;