##########################################################
## Castle Links						##
## Created: 06/17/1999					##
##########################################################
# By: Castellum.net					##
# WebSite: www.castellum.net				##
##########################################################
##########################################################
# (C)Copyright 1999 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		##
##########################################################


# Debug line, undo it only for script debugging/development
# purposes
#use CGI::Carp qw(fatalsToBrowser);

$version = 4.51;

sub InitGlobalVariables {
# Initializing (well, not really) the global variables.
# Not needed for the way this script runs.  But, it helps
# keep track of what is being used all over.
%setup = ();
%query = ();
%input = ();
%counts = ();
%descriptions = ();
%titles = ();
%addto = ();
@categories = ();
@links = ();
$category_options = "";
$setup_file = "clinks_setup.pl";
$header_hb_printed = 0;
$links_loaded = 0;
$version = "4.5";
$setup_loaded = 0;
$categories_loaded = 0;
$t_dir = "";
return 1;
}

sub CheckReferer {
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){
&Error($setup{'error_referer'});
exit;
}
}
}


sub Encode {
my($encoding) = @_;
$encoding =~ s/ /+/gi;
$encoding =~ s/([\%\{\}])/uc sprintf("%%%02x",ord($1))/eg;
return $encoding;
}

sub LoadLinks {
unless($links_loaded == 1){
open(LINKS, "$setup{'links_file'}")||&Error("Opening $setup{'links_file'}: $!");
if ($setup{'flock'} == 1){flock(LINKS,2);}
@links = <LINKS>;
if ($setup{'flock'} == 1){flock(LINKS,8);}
close(LINKS);
$links_loaded = 1;
}

return 1;
}

sub LoadAdminTemplate {
my($file) = @_;
open(TEMPLATE, "$file")||&Error("Opening $file: $!");
my $html = join('',<TEMPLATE>);
close(TEMPLATE);
$html =~ s/\$version/$version/gi;
$html =~ s/<!--CATEGORY OPTIONS-->/$category_options/gi;
return $html;
}

sub LoadTemplate {
my($file) = @_;
open(TEMPLATE, "$file")||&DieNice("Opening: $file -- $!");
my $template = join('',<TEMPLATE>);
close(TEMPLATE);
open(MASTER, "$t_dir/master.htm")||&DieNice("Openeing: $t_dir/master.htm");
my $html = join('',<MASTER>);
close(MASTER);
$html =~ s/!INSERT!/$template/gi;
$html =~ s/\$version/$version/gi;
$html =~ s/\$add_url/add\.cgi/gi;
$html =~ s/\$search_url/search\.cgi/gi;
$html =~ s/\$new_url/whatsnew\.cgi/gi;
$html =~ s/\$old_url/whatsold\.cgi/gi;
$html =~ s/\$random_url/random\.cgi/gi;
$html =~ s/<!--CATEGORY OPTIONS-->/$category_options/gi;
return $html;
}


sub WriteCategories {
open (CATS, ">$setup{'category_file'}")||&Error("Opening $setup{'category_file'}: $!");
if ($setup{'flock'} == 1){flock(CATS,2);}
foreach $categories (@categories){
my $desc = $descriptions{"$categories"};
my $count = $counts{"$categories"};
my $title = $titles{"$categories"};
my $addto = $addto{"$categories"};
if ($count =~ /^\w+$/){
print CATS "$title||$count||$categories||$addto||$desc\n";
}
}
if ($setup{'flock'} == 1){flock(CATS,8);}
close(CATS);
return 1;
}

sub LoadCategories {
if ($categories_loaded == 0){
open(CATS, "$setup{'category_file'}")||&Error("Opening $setup{'category_file'}: $!");
if ($setup{'flock'} == 1){flock(CATS,2);}
my @cats = <CATS>;
if ($setup{'flock'} == 1){flock(CATS,8);}
close(CATS);
foreach $cats (@cats){
chomp $cats;
my ($title,$count,$path,$addto,$desc) = split(/\|\|/,$cats);
push(@categories, $path);
$descriptions{"$path"} .= $desc;
$counts{"$path"} .= $count;
$titles{"$path"} .= $title;
$addto{"$path"} .= $addto;
}
@categories = sort @categories;
foreach $cat (@categories){
$category_options .= "<OPTION value=\"$cat\">$cat</OPTION>";
}
$categories_loaded = 1;
}
return 1;
}


sub WriteSetup {
open(SETUP, ">$setup_file")||&Error("Opening $setup_file: $!");
if ($setup{'flock'} == 1){flock(SETUP,2);}
while (($key,$value) = each %setup){
print SETUP "$key=$value\n";
}
if ($setup{'flock'} == 1){flock(SETUP,8);}
close(SETUP);
return 1;
}

sub LoadSetup {
if ($setup_loaded == 0){
my($name,$value);
open(SETUP, "$setup_file")||&TrueDie("Opening $setup_file: $!");
my @in = <SETUP>;
close(SETUP);
foreach $in (@in){
chomp $in; 
($name,$value) = split(/=/,$in); 
$setup{"$name"}.= "$value";
}
$setup_loaded = 1;
}
$t_dir = $setup{'template_dir'};
return 1;
}

sub CheckAddress{
my($email_address)= @_;
if ($email_address =~ /^[A-Z0-9][_\-\.A-Z0-9]*\@\[?[\-\.A-Z0-9]+\.([A-Z]{2,3}|[0-9]{1,3})\]?$/i){
return 1;
}
else{return 0;}
}

sub PrintStandardHeader{
if ($header_hb_printed != 1){
print "Content-type: text/html\n\n"; #Print the header
print qq~<!--IMPORTANT
ClBvd2VyZWQgYnk6IENhc3RsZSBMaW5rcwooYylDb3B5cmlnaHQgMTk5OS0yMDAwIENhc3RlbGx1
bS5uZXQsIEFsbCBSaWdodHMgUmVzZXJ2ZWQKU2NyaXB0IEF2YWlsYWJsZSBBdCBodHRwOi8vd3d3
LmNhc3RlbGx1bS5uZXQK
-->
~;
$header_hb_printed = 1; #Set variable to 1, so we don't print it again
}
return 1;
}

sub GetFormInput {
my($name,$value,$in,@name_n_values);
if ($ENV{'REQUEST_METHOD'} eq "GET"){
	$in = $ENV{'QUERY_STRING'};
}elsif($ENV{'REQUEST_METHOD'} eq "POST"){
    read(STDIN, $in, $ENV{'CONTENT_LENGTH'});
}else{DieNice("Request Method wasn't found.");}
@name_n_values = split(/&/,$in);
foreach $nv (@name_n_values){
	($name,$value) = split(/=/,$nv);
	$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 
}
return %input;
}

sub GetQueryString {
my($full_query,@pairs,$name,$value,$pair);
$full_query = $ENV{'QUERY_STRING'};
$full_query =~ s/\+/ /g;
$full_query =~ s/%(..)/chr(hex($1))/ge;
@pairs = split(/&/,$full_query);
foreach $pair (@pairs){
($name,$value) = split(/=/,$pair);
$query{$name}.= $value;
}
}

sub Error {
my($error) = @_;
open(ERROR, "$t_dir/error.htm")||&TrueDie("Opening $setup{'template_dir'}/error.htm: $!");
my @template_error = <ERROR>;
close(ERROR);
my $all_html = join("",@template_error);
@template_error = ();
$all_html =~ s/\$error/$error/gi;
$all_html =~ s/\$version/$version/gi;
&PrintStandardHeader;
print $all_html;
exit;
}

sub TrueDie {
my($error) = @_; # Grab the error string that is being passed
&PrintStandardHeader; # Prints the standard header
# Print the html
print qq~
<html>
<head>
<title>Castle Links v$version</title>
</head>
<body bgcolor="#E9E9E9" link="#800000">
<h2 align="left">Fatal Error: $error</h2>
<p align="left">The script encountered a fatal error while trying to complete
your request. This is a system error and needs to be corrected by the website
administrator.&nbsp; Please contact them and give them the information above.</p>
<hr>
<h6 align="center">Powered By: <a href="http://www.castellum.net/cgi/clinks/">Castle
Links v$version</a><br>
©1999-2000 <a href="http://www.castellum.net">Castellum.net</a>, All Rights
Reserved<br>
Script available at <a href="http://www.castellum.net">http://www.castellum.net</a></h6>
<p align="center">&nbsp;</p>
</body>
</html>
~;
exit; #Exit
}

1;