#!/bin/perl

use Socket;
$|=1;
require "/www/cgi-bin/links/admin/links.cfg";
require "$db_script_path/links.def";
require "$db_script_path/db_utils.pl";


##################################################################
# Report Dead Link 1.1
# deadlink.cgi
# (C)1999 Anthro TECH, L.L.C
#
# This script is modelled after the birdcast.cgi script available
# at Bignosebird.com. This script allows users to select an
# Error Message and send it along with the Link information.
#
# This script is used with LINKS2, which is located at
# http://www.gossamer-threads.com/
#
# If you have technical problems with this script, please send
# an email message to support@anthrotech.com or post your
# technical issue at the Gossamer Threads Forums, which is
# located at http://www.gossamer-threads.com/scripts/forum/
#
##################################################################


##################################################################
# birdcast.cgi Version 2.0
# updated May 2, 1999
# (C)1998, 1999 Bignosebird.com
# This software is FREEWARE! Do with it as you wish. It is yours
# to share and enjoy. Modify it, improve it, and have fun with it!
# It is distributed strictly as a learning aid and bignosebird.com
# disclaims all warranties- including but not limited to:
# fitness for a particular purpose, merchantability, loss of
# business, harm to your system, etc... ALWAYS BACK UP YOUR
# SYSTEM BEFORE INSTALLING ANY SCRIPT OR PROGRAM FROM ANY
# SOURCE!
##################################################################

##################################################################
# INSTRUCTIONS
#
# 1) Set up the proper configurations in next section of this
# file.
#
# 2) Make sure that you have the correct path to Perl in the
# first line of this script. Also change the /path/to/ in
# the first require line to the directory path where your
# links.cfg file is located.
#
# 3) Save this file as deadlink.cgi and put it in the directory
# where your links scripts are located.
#
# 4) Change the permissions of this file to 755 or rwxr-xr-x
#
# Translation:
#
# Owner = Read, Write, Execute
# Group = Read, Execute
# Everyone = Read, Execute
#
# 5) Create a blank html file for your logging file in the
# same directory where you have your links scripts. Change
# the permission of this file to 666 or rw-rw-rw-
#
# Translation:
#
# Owner = Read, Write
# Group = Read, Write
# Everyone = Read, Write
#
# 6) Add a link in your link.html file (For Templates:
#
# <a href="<%db_cgi_url%>/deadlink.cgi?ID=<%ID%>">Report Dead Link</a>
#
#
# For Non-Templates, use the following code:
#
# <a href="$db_cgi_url/deadlink.cgi?ID=$rec{'ID'}>Report Dead Link</a>
#
# For LINKS Template Users, please refer to the following file,
# which has two template files that you can add to this file:
#
# http://larp-welt.de/links_download/deadlink.zip
#
#
#
##################################################################

##################################################################
# CONFIGURATION NOTES
#
# $SCRIPT_NAME is the full URL of this script, including the
# http part, ie, "http://domainname.com/cgi-bin/birdcast.cgi";
#
# $SITE_NAME is the "name" of your web site.
# $SITE_URL is the URL of your site (highest level)
# $END_LINE is the very last line printed in the e-mail.
#
# $MAXNUM is the number of possible people a person can refer
# your URL to at one time. If you call the script using the
# GET method, then this is also the number of entry blanks
# created for recipient names and addresses.
#
# $SMTP_SERVER is the name of your e-mail gateway server, or
# SMTP host. On most systems, "localhost" will work just fine.
# If not, change "localhost" to whatever your ISP's SMTP
# server name is, ie, smtp.isp.net or mail.isp.net
# $SEND_MAIL is the full path to your server's sendmail program
# If you do not wish to use Sockets for some reason and need
# to use sendmail, uncomment the $SEND_MAIL line and comment
# the $SMTP_SERVER line.
# okaydomains is a list of domains from which you want to allow
# the script to be called from. Leave it commented to leave the
# script unrestricted. If you choose to use it, be sure to list
# your site URL with and without the www.
##################################################################
# Check Domains for Using This Script
# Type in all the domains that you want to access this script.
##################################################################

@referers = ('www.vietheart.com','vietheart.com');
&check_url;

##################################################################
# Sendmail Routines (Select one of the following: SMTP or Sendmail
# DO NOT SELECT BOTH OR THE SCRIPT WILL NOT WORK!
# Just put a # character in front of the routine that you are
# not using.
# If you use SMTP, then make sure that you change localhost to
# your local SMTP server (host).
##################################################################
#
#require "Mailer.pm";
#$smtpserver="vietheart.com";
$mailprog = "/bin/sendmail";
#
#
###################################################################


##################################################################
# Configurations
# Change /path/to/ to the Absolute/Physical Path to your files.
##################################################################

# This is the script path to your deadlink.cgi file.
$SCRIPT_NAME="http://www.vietheart.com/cgi-bin/links/deadlink.cgi";

# This is the name of your site.
$SITE_NAME="VietHeart";

# This is your name.
$SITE_WEBMASTER="Thierry Tran";

# This is your title/position.
$SITE_POSITION="VietHeart Links Manager";

# Your site URL or web address.
$SITE_URL="http://www.vietheart.com/";

# This is your primary email address in signature.
$SITE_EMAIL="webman\@vietheart.com";

# This is the location of your log file. Make sure it is in html extension.
$LOGFILE="deadlink.html";

# This is your secondary email where the form is sent to.
$email="webman\@vietheart.com";

# This is your administrative email.
$admin_email="webman\@vietheart.com";

# This is the message for SMTP routines.

$msgtxt = "There is a problem with the following link:\n
----------------------------------------------------\n
ID: $rec{'ID'}\n
Site Name: $rec{'Title'}\n
Site URL: $rec{'URL'}\n
Error Message: $fields{'message'}\n
----------------------------------------------------\n
$SITE_NAME\n
$SITE_WEBMASTER\n
$SITE_POSITION\n
$SITE_URL\n
$SITE_EMAIL\n
----------------------------------------------\n\n
Environmental Variables for Tracking Purposes:\n\n
Remote Host: $ENV{REMOTE_HOST}\n
Remote Addr: $ENV{'REMOTE_ADDR'}\n
Referer: $ENV{'HTTP_REFERER'}\n
Submitted Using: $ENV{'HTTP_USER_AGENT'}";

# Do you want a header file?
# Set 1 for yes and 0 for no
$insertheader = 0;

# Do you want a footer file?
# Set 1 for yes and 0 for no
$insertfooter = 0;

# Directory of your header and footer files
# Do not include trailing slash
$insertpath = "/path/to/files";

# Header File.
# This can be either .htm or .txt.
$header = "header.txt";

# Footer File.
# This can be either .htm or .txt.
$footer = "footer.txt";


&decode_vars;%rec = &get_record($fields{'ID'});
if ($ENV{'REQUEST_METHOD'} ne "POST") {
&draw_request;
exit;
}
&do_log;
&process_mail;
&thank_you;

##################################################################
sub process_mail {

if ($mailprog ne "") {

open (MAIL, "$mailprog") &#0124; &#0124; &cgierr("unable to open mail program");
print MAIL "To: $email\n";
print MAIL "From: $admin_email\n";
print MAIL "Subject: Bad Link Found in $SITE_NAME\n";
print MAIL "There is a problem with the following link:\n\n";
print MAIL "----------------------------------------------------\n";
print MAIL "ID: $rec{'ID'}\n";
print MAIL "Site Name: $rec{'Title'}\n";
print MAIL "Site URL: $rec{'URL'}\n";
print MAIL "Error Message: $fields{'message'}\n";
print MAIL "----------------------------------------------------\n";
print MAIL "$SITE_NAME\n";
print MAIL "$SITE_WEBMASTER\n";
print MAIL "$SITE_POSITION\n";
print MAIL "$SITE_URL\n";
print MAIL "$SITE_EMAIL\n";
print MAIL "----------------------------------------------\n\n";
print MAIL "Environmental Variables for Tracking Purposes:\n\n";
print MAIL "Remote Host: $ENV{REMOTE_HOST}\n";
print MAIL "Remote Addr: $ENV{'REMOTE_ADDR'}\n";
print MAIL "Referer: $ENV{'HTTP_REFERER'}\n";
print MAIL "Submitted Using: $ENV{'HTTP_USER_AGENT'}\n";
close (MAIL);
}

if ($smtpserver ne "") {
my $mailer = new Mailer ( { smtp => '$smtpserver' } ) or die "Mail: $Mailer::error";
$mailer->send ( {
to => '$email',
from => '$admin_email',
subject => 'Bad Link found in $SITE_NAME',
msg => $msgtxt
} )
or die "Mail: $Mailer::error";
}
}

##################################################################
sub draw_request
{
print "Content-type: text/html\n\n";

#BNB SAYS! Here is the part that draws the page that asks the
#reader to enter e-mail addresses and names. Tailor it to meet
# your needs if necessary. DO NOT disturb the lines with
# __REQUEST__ on them.

print <<__REQUEST__;
<HTML>
<HEAD>
<TITLE>$SITE_NAME</TITLE>
<script language="JavaScript">

function Open(url, name) {
popupWin = window.open(url, name, 'width=625,height=250,directories=no,toolbar=no,resizable=yes,menubar=no,scrollbars=yes');
}

</script>

</HEAD>
<BODY BGCOLOR="#FFFFFF">

__REQUEST__

if ($insertheader eq "1") {
print &site_header;
}
else {
print qq| |;
}

print <<__REQUEST2__;

<CENTER>
<P>
<TABLE WIDTH=600 BGCOLOR="EEEEEE">
<TR>
<TD>
<FONT FACE="Arial" SIZE=3>
<b>Send Error Message</b>
</FONT>
<p>
<FONT FACE="Verdana" SIZE=2>
Thank you for taking the time to send us a message about <b>$rec{'Title'}</b>, which
has retired or moved. Just click on the <b>Send Problem</b> button and an
email message will be sent to $SITE_NAME Administrator. You can also select the
error message you received in your web browser when you tried to access
<b>$rec{'Title'}</b> in the drop-down menu before clicking on the
<b>Send Problem</b> button.
<p>
If you have a Java enabled browser and you have forget the error message,
<b><a href="javascript:Open('/cgi-bin/links/jump.cgi?ID=$rec{'ID'}')">click here</a></b> to view
the error message. If you do not have a Java enabled browser,
<b><a href="/cgi-bin/links/jump.cgi?ID=$rec{'ID'}">click here</a></b> to
view the error message.
<p>
If you browser does not support forms, please send a detailed message to
the $SITE_NAME Administrator at <a href="mailto:$admin_email">$admin_email</a>.
Be sure to include the following information in your message:
<ul>
<li> Title of Resource</li>
<li> Web Page or Email Address (URL or mailto)</li>
<li> Error Message you received when trying to access this link.</li>
</ul>
</FONT>
<P>
<FORM METHOD="POST" ACTION="$SCRIPT_NAME">
<INPUT TYPE="HIDDEN" NAME="call_by" VALUE=$ENV{'HTTP_REFERER'}>
<input type="HIDDEN" NAME="ID" VALUE="$rec{'ID'}">
<DIV ALIGN="CENTER"><CENTER>
<TABLE BORDER=0 CELLPADDING=1 CELLSPACING=0>
<TR>
<TD>
<SELECT NAME="message">
<OPTION VALUE="">Choose one of the following:</option>
<OPTION VALUE="404 Not Found">404 Not Found</option>
<OPTION VALUE="500 Internal Server Error">500 Internal Server Error</option>
<OPTION VALUE="Firewall Error">Firewall Error</option>
<OPTION VALUE="302 Site Moved Temporarily">302 Site Moved Temporarily</option>
<OPTION VALUE="300 Site Moved Permanently">300 Site Moved Permanently</option>
<OPTION VALUE="Unable to Connect">Unable to Connect</option>
</SELECT>
<INPUT TYPE="submit" VALUE="Send Problem">
</TD>
</TR>
</TABLE>
</DIV></CENTER>
</FORM>
</TD>
</TR>
</TABLE>

__REQUEST2__


if ($insertfooter eq "1") {
print &site_footer;
}
else {
print qq| |;
}

print <<__REQUEST3__;

</BODY>
</HTML>

__REQUEST3__


}

##################################################################
# NOTHING TO MESS WITH BEYOND THIS POINT!!!!
##################################################################

sub decode_vars
{
if ( $ENV{'REQUEST_METHOD'} eq "GET")
{
$temp=$ENV{'QUERY_STRING'};
}
else
{
read(STDIN,$temp,$ENV{'CONTENT_LENGTH'});
}
@pairs=split(/&/,$temp);
foreach $item(@pairs)
{
($key,$content)=split(/=/,$item,2);
$content=~tr/+/ /;
$content=~s/%(..)/pack("c",hex($1))/ge;
$content=~s/\012//gs;
$content=~s/\015/ /gs;
$fields{$key}=$content;
}
if ($fields{'call_by'} eq "")
{
$JUMP_TO = $ENV{'HTTP_REFERER'};
}
else
{
$JUMP_TO = $fields{'call_by'};
}
}

##################################################################

sub do_log {

# Logs the responses into the .html log file.

(-e $LOGFILE) ?
open (ZL,">>$LOGFILE") :
open (ZL,">$LOGFILE");
$date=localtime(time);
$logline="$date\|$JUMP_TO\|$rec{'ID'}\|\n";
print ZL $logline;
close(ZL);

}

###################################################################
sub thank_you {

#BNB SAYS! Here is the part that draws the page that asks the
#reader to enter e-mail addresses and names. Tailor it to meet
# your needs if necessary. DO NOT disturb the lines with
# __REQUEST__ on them.

print "Content-type: text/html\n\n";

print <<__REQUEST__;

<HTML>
<HEAD>
<TITLE>$SITE_NAME</TITLE>
</HEAD>
<BODY BGCOLOR="#FFFFFF">

__REQUEST__

if ($insertheader eq "1") {
print &site_header;
}
else {
print qq| |;
}


print <<__REQUEST2__;

<P>
<CENTER>
<TABLE WIDTH=600 CELLPADDING="2" CELLSPACING="0" BORDER="0">
<TR>
<TD>
<FONT FACE="Arial" SIZE=3>
<b>Thank you</b>
<p>
<FONT FACE="Verdana" SIZE=2>
Thank you for letting us know about the broken/dead link you
found. The following email message has been successfully sent to the
$SITE_NAME Administrator:
<p>
There is a problem with the following link:<br>
----------------------------------------------------<br>
<b>ID:</b> $rec{'ID'}<br>
<b>Site Name:</b> $rec{'Title'}<br>
<b>Site URL:</b> $rec{'URL'}<br>

__REQUEST2__

if ($fields{'message'} ne "") {
print "<b>Error Message:</b> $fields{'message'}<br>";
}
else {
print "<b>Error Message:</b> No Error Message Provided<br>";
}

print <<__REQUEST3__;

----------------------------------------------------
<P>
<b>Go back to <a href="$JUMP_TO">$JUMP_TO</a></b>.
</FONT>
</TD></TR></TABLE></CENTER>

__REQUEST3__


if ($insertfooter eq "1") {
print &site_footer;
}
else {
print qq| |;
}


print <<__REQUEST4__;

</BODY>
</HTML>

__REQUEST4__

}

sub site_header {
# -----------------------------------
# This is a list of patterns to the appropriate shtml page to load.

open (INC, "$insertpath/$header") or return "Can't find include file: $header";
return join ("", <INC> );
}

sub site_footer {
# -----------------------------------
# This is a list of patterns to the appropriate shtml page to load.

open (INC, "$insertpath/$footer") or return "Can't find include file: $footer";
return join ("", <INC> );
}

###################################################################
sub check_url {

# Localize the check_referer flag which determines if user is valid. #

local($check_referer) = 0;

# If a referring URL was specified, for each valid referer, make sure #
# that a valid referring URL was passed to Dead Link Form. #

if ($ENV{'HTTP_REFERER'}) {
foreach $referer (@referers) {
if ($ENV{'HTTP_REFERER'} =~ m|https?://([^/]*)$referer|i) {
$check_referer = 1;
last;
}
}
}
else {
$check_referer = 1;
}

# If the HTTP_REFERER was invalid, send back an error. #
if ($check_referer != 1) { &error('bad_referer') }
}