$title

#!/usr/bin/perl ############################################################################## # Program: FreeLink.pl # Author: The Puppet Master # Created: 2/12/1999 # Purpose: A Free For All Links Script # # Copyright (C) 1999 The Puppet Master # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. # # http://www.gnu.org/copyleft/gpl.html # # NOTE: The above information MAY NOT be removed under any circumstances. # ############################################################################# # SYSTEM CONFIGURATION # # $basedir is the system path to the freelink directory where all freelink # files are kept. $basedir = '/usr/www/petlovers.com/htdocs/pet_links_now'; # $title is the title of your link page. $title = "Free For All Links!"; # $cgi_url is the url location of this script. $cgi_url = "/pet_links_now/freelinks.cgi"; # $cat_file is the location and name of the categories file. $cat_file = "sections.txt"; # $secfile is the location of the security number file used to prevent flooding $secfile = "secnum.txt"; # $denyfile is the location of the deny log file $denyfile = "denyfile.txt"; # Location and name of the link database. $linkdb = "linkdb"; # Location and name of the log file. $logfile = "log.txt"; # Email address of the administrator (That's You!) $sysmail = "kenn\@wagenheim.com"; # SMTP SERVER is the name of your servers SMTP server (ask your ISP) $SMTP_SERVER = ""; # $use_frames: set it to 1 if you are using this script inside of a frame, or # 0 if you are not. $use_frames = 0; # IF $use_frames is 1, enter the name of the frame displaying output. $frame_name = "Main"; # COLOR CONFIGURATIONS # # $cat_color is the font color to use for the catalog heading $cat_color = "BLACK"; # $bkcolor is the color of the background. $bkcolor = "WHITE"; # $text_color is the color of the text. $text_color = "BLACK"; # $link_color is the color of the link. $link_color = "BLUE"; # $vlink_color is the color of the visited link. $vlink_color = "PURPLE"; # $alink_color is the color of the active link. $alink_color = "TEAL"; # $title_color is the color of the title. $title_color = "ORANGE"; # YOU ARE DONE WITH MODIFICATINONS TO THE SCRIPT # ############################################################################# # DO NOT MODIFY ANYTHING BELOW THIS LINE UNLESS YOU KNOW WHAT YOU ARE DOING! ############################################################################# # Parse Form, Sendmail & Chkemail # Are Copyrighted by Matt Wright & Craig Patchett. $path = "/usr/www/petlovers.com/htdocs/pet_links_now"; require "$path/parsform.pl"; # Parse the form require "$path/sendmail.pl"; # Send Mail require "$path/chkemail.pl"; # Check for valid email address # Badword.cgi Copyright 1999 The Puppet Master require "$path/badword.pl"; # Check for Naughty Language! # Get ENV String and parse it. if ($ENV{'QUERY_STRING'} ne '') { $command = "$ENV{'QUERY_STRING'}"; } else { &parse_form; } # Print The Header. print "Content-type: text/html\n\n"; &header; #print "$title\n"; #print "\n"; if ($command eq 'addmylink') { &secnum; if(!open(CAT,"$basedir/$cat_file")) { print "Can't Open Catalog File(1) - Cause: $!"; exit; } @SECTION = ; close(CAT); $addr = $ENV{'REMOTE_ADDR'}; # print "

$title

\n"; print "

\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "

Site Name:
Site URL:
Description (50 Char.):
Category:
*Your Name:
*Email Address:
Type \"VERIFY_2012\" here:

* Your Name & Email Address Are For Our Records Only
Your IP Address: "; print "$addr

\n"; print "

\n"; print "

\n"; if ($use_frames eq '1') { print "Back To Links Page\n"; } else { print "Back To Links Page\n"; } print "

\n"; &footer; exit; } elsif ($FORM{'action'} eq 'process') { # Check the secnum file to prevent flooders &check_secnum; $addr = $ENV{'REMOTE_ADDR'}; if ($valid eq "0") { &deny; } # Check for missing fields &missing unless $FORM{'site'}; &missing unless $FORM{'url'}; &missing unless $FORM{'name'}; &missing unless $FORM{'email'}; # Check fields for bad words! $word = $FORM{'site'}; # SITE &badword($word); if ($badword eq "1") { &naughtyword; } $word = $FORM{'url'}; # URL &badword($word); if ($badword eq "1") { &naughtyword; } $word = $FORM{'desc'}; # Description &badword($word); if ($badword eq "1") { &naughtyword; } # Check myverify = VERIFY for real human submission. if($FORM{'myverify'} ne "VERIFY_2012") { &verifyemail; } # Check Email address for validity. if(!&email_check($FORM{'email'})) { &bademail; } # Check For Duplicates if(-e "$basedir/$linkdb") { open(DB,"$basedir/$linkdb") || die "Can't Open Database - Cause: Empty!"; @LINK = ; close(DB); foreach $link(@LINK) { ($lineno,$section,$site,$url,$desc) = (split(/\|\|/,$link)); if ($site eq $FORM{'site'} || $url eq $FORM{'url'}) { &duplicate; } } } # Add Entry To Log File &log; # Add to database. if(!open(DB,">>$basedir/$linkdb")) { print "Can't Open LinkDB(1) - Cause: $!"; exit; } print DB "$FORM{'section'}||$FORM{'site'}||$FORM{'url'}||$FORM{'desc'}\n"; close(DB); # Send Mail to SysAdmin $SUBJECT = "Addition To FreeLinks Page"; $CC = ""; $BCC = ""; $BODY = "Name: $FORM{'name'}\nEmail: $FORM{'email'}\nURL: $FORM{'url'}\nSite: $FORM{'site'}\nDescription: $FORM{'desc'}\nCategory: $FORM{'section'}\nADDR: $addr"; &send_email($SUBJECT,$FORM{'email'},$sysmail,$CC,$BCC,$BODY); } # Display link html file. #open(DB,"$basedir/$linkdb") || die "Can't Open Database - For Reading"; if(!open(DB,"$basedir/$linkdb")) { print "Can't Open LinkDB(2) - Cause: $!"; exit; } @LINK = ; close(DB); $count = 0; foreach $link(@LINK) { $count++; ($lineno,$section,$site,$url,$desc) = (split(/\|\|/,$link)); } #open(CATEGORY,"$basedir/$cat_file") || die "Can't Open Catalog File"; if(!open(CATEGORY,"$basedir/$cat_file")) { print "Can't Open Category(2) - Cause: $!"; exit; } @CAT = ; close(CATEGORY); #print "

$title

\n"; if ($use_frames eq '1') { print "There are $count links on this page... Go ahead and add a link.

\n"; } else { print "
There are $count links on this page... Go ahead and add a link.

\n"; } foreach $category(@CAT) { chop($category); $catshow = $category; $catshow =~ s/\_/ /g; $catshow=~ s/xx/\,/g; print "$catshow...

\n"; foreach $link(@LINK) { ($section,$site,$url,$desc) = (split(/\|\|/,$link)); print "

$site - $desc
$site - $desc

\n"; } print "

Invalid Verify

\n"; print "Be sure to enter VERIFY!

\n"; print "Please Use Your Browsers Back Button And Try Again!

\n"; exit; } sub bademail { print "

Invalid Email Address

\n"; print "The Email Address: $FORM{'email'} Is Of An Invalid Format.

\n"; print "Please Use Your Browsers Back Button And Try Again!

\n"; exit; } sub naughtyword { print "

You Should Be Ashamed Of Your Self!

\n"; print "Language Like That Is Not Allowed Here!\n"; exit; } sub missing { print "

Missing Fields

\n"; print "The Following Fields Are Required Before Your Site Can Be Submitted:

Site Name
Site URL
Your Name
Your Email Address

\n"; print "

Please Use Your Browsers Back Button And Try Again!\n"; exit; } sub duplicate { print "

Duplicate Entry

\n"; print "That Site/URL Already Exists.\n"; exit; } # Add to logfile sub log { if(!open(LOG,">>$basedir/$logfile")) { print "Can't Open Log File - Cause: $!"; } print LOG "SITE: $FORM{'site'}\n"; print LOG "URL: $FORM{'url'}\n"; print LOG "DESC: $FORM{'desc'}\n"; print LOG "CATEGORY: $FORM{'section'}\n"; print LOG "NAME: $FORM{'name'}\n"; print LOG "EMAIL: $FORM{'email'}\n"; print LOG "ADDR: $addr\n"; print LOG "================================================\n"; close(LOG); } sub secnum { srand(time ^ $$); $secnum = rand(time); if(!open(SECNUM,">$basedir/$secfile")) { print "Can't Open SECNUM File(1) - Cause: $!"; exit; } print SECNUM "$secnum"; close(SECNUM); } sub check_secnum { $valid = "0"; if(!open(SECNUM,"$basedir/$secfile")) { print "Can't Open SECNUM File(2) - Cause: $!"; exit; } $num = ; close(SECNUM); if($num eq $FORM{'secnum'}) { $valid = "1"; } } sub deny { if(!open(DENY,">>$basedir/$denyfile")) { print "Can't Open Deny File - Cause: $!"; exit; } print DENY "SITE: $FORM{'site'}\n"; print DENY "URL: $FORM{'url'}\n"; print DENY "DESC: $FORM{'desc'}\n"; print DENY "CATEGORY: $FORM{'section'}\n"; print DENY "NAME: $FORM{'name'}\n"; print DENY "EMAIL: $FORM{'email'}\n"; print DENY "REMOTE_ADDR: $addr\n"; print DENY "=================================================\n"; close(DENY); if ($use_frames eq '1') { print "Flooding Not Allowed!\n"; } else{ print "Flooding Not Allowed!\n"; } exit; } sub footer { open (footer, "footer"); @footer =