#!/usr/bin/perl
#               -------------
#                   Links
#               -------------
#               Links Manager
#
#        File: jump.cgi
#  Description: Increments the number of hits for the specified link, 
#              and sends the user off to the appropriate page.
#      Author: Alex Krohn
#       Email: alex@gossamer-threads.com
#         Web: http://www.gossamer-threads.com/
#     Version: 2.0
#
# (c) 1998 Gossamer Threads Inc. 
#
# This script is not freeware! Please read the README for full details
# on registration and terms of use. 
#
#  Jump.cgi MOD'd for the "Deadline Auto Report"
#      Author: Martin Smallridge
#       Email: mods@websnail.net
#         Web: http://www.websnail.org/script/404-report.html
#        Date: 18th July 2000
#
# =====================================================================
#
#   Form Input: 
#      '$db_key'   = key number     # Send as form input the key name and key value
#                                     # of the link you want to go to.
#
#   Setup:
#      Make sure the require statement below points to the config file. 

# Required Librariers
# --------------------------------------------------------

## MOD Deadlink-ws 01S
use LWP::Simple;
## MOD Deadlink-ws 01E

eval {
    ($0 =~ m,(.*)/[^/]+,)   && unshift (@INC, "$1");    # Get the script location: UNIX /
    ($0 =~ m,(.*)\\[^\\]+,) && unshift (@INC, "$1");    # Get the script location: Windows \

    require "admin/links.cfg";            # Change this to full path to links.cfg if you have problems.
    require "$db_lib_path/db_utils.pl";
    require "$db_lib_path/links.def";
};
if ($@) {
    print "Content-type: text/plain\n\n";
    print "Error including libraries: $@\n";
    print "Make sure they exist, permissions are set properly, and paths are set correctly.";
}

# ========================================================

eval { &main; };                         # Trap any fatal errors so the program hopefully 
if ($@) { &cgierr("fatal error: $@"); }  # never produces that nasty 500 server error page.
exit;   # There are only two exit calls in the script, here and in in &cgierr. 

sub main {
# --------------------------------------------------------
    my %in = &parse_form(); 
    my ($delim, $time); 
    $id    = $in{$db_key};  
    $delim = quotemeta($db_delim);
    $time  = time();
    
    if ($id eq "random") {
        my ($count, $rand, $find);      

# Pull out the total number of links.       
        open  (COUNT, "<$db_hits_path/index.count") or &error ("unable to open index count file: $db_hits_path/index.count. Reason: $!");
        $count = int <COUNT>;
        close COUNT;

# Get the random line from the url lookup database.     
        srand;
        $find = 0; $rand = int (rand ($count + 0.5)); ($rand == $count) and ($rand--);
        open (URL, "<$db_url_name") or &error ("unable to open url database: $db_url_name. Reason: $!");
        while (<URL>) {         
            $find++ == $rand  or next;
            /\d+$delim(.+)/o  or next;
            $goto = $1;
            last;
        }
        close URL;
        $goto or &error ("Can't find random line: $rand.");
    }
    elsif (exists $in{$db_key}) {
# Make sure this is a valid looking id. 
        ($id =~ /^\d+$/)  or &error ("Invalid id: $id");

# Let's get the URL.
        open (URL, "<$db_url_name") or &error ("unable to open url database: $db_url_name. Reason: $!");
        while (<URL>) {         
            (/^$id$delim(.+)/o) or next;
            chomp ($goto = $1); 
            last;
        }
        close URL;
        $goto or &error ("Can't find link id: $id");

# Bump the counter one.
        if (open (HIT, "<$db_hits_path/$id")) {
            my ($count, $old_time, @IP, $ip, $visited);         
            chomp ($count    = <HIT>);
            chomp ($old_time = <HIT>);
            chomp (@IP       = <HIT>);
            (($time - $old_time) > 21600) and (@IP = ());
            foreach $ip (@IP) {         
                $ip eq $ENV{'REMOTE_ADDR'} and ($visited++ and last);
            }
            if (!$visited) {
                push (@IP, $ENV{'REMOTE_ADDR'});
                $count = $count + 1;            
                open (HIT, ">$db_hits_path/$id") or &error ("Can't open for output counter file. Reason: $!");
                if ($db_use_flock) {
		   flock (HIT, 2) or &error ("Can't get file lock. Reason: $!");
		}
                local $" = "\n";
                print HIT "$count\n$time\n@IP";
                close HIT;
            }
        }
        else {
            open (HIT, ">$db_hits_path/$id") or &error ("Can't increment counter file. Reason: $!");        
            print HIT "1\n$time\n$ENV{'REMOTE_ADDR'}";
            close HIT;      
        }
    }
    else {
        &error ("No link specified!");
    }
    
# Now let's send the user to the url..
## MOD Deadlink 02S
    if ($goto) {
      if((!head($goto)) or (!get($goto))) {
		&reportlink;
		print "Location: $build_root_url/404.html \n\n";
      }
      else {
 	print "Location: $goto \n\n";
      }
    }
    else {
      &error ("Record not found ($in{$db_key})");
    }
}

sub reportlink {
	open (LINK, "$db_lib_path/data/deadlink.txt");
	@link = <LINK>;
	close (LINK);

	$found = 0;
	foreach $line(@link) {
		if ($line =~ /$goto/i) {
			$found = 1;
		}
	}

	if ($found == 0) {
		open (LINK, ">>$db_lib_path/data/deadlink.txt");
		print LINK "$goto\n";
		close (LINK);
		&emailadmin;
	}
}

sub emailadmin {
# --------------------------------------------------------
# Sends an email to the admin, letting him know that there is
# a new link waiting to be validated. No error checking as we don't
# want users to see the informative &cgierr output. 

# Check to make sure that there is an admin email address defined.
    $db_admin_email or &cgierr("Admin Email Address Not Defined in config file!");
    my $to      = $db_admin_email;
    my $from    = $db_admin_email;
    my $subject = "Dead Link Found: $goto\n";
    my $msg     = qq|
The following link produced an error when clicked:

             ID:  $id
            URL:  $goto
 
    |;

# Then mail it away!    
    require "$db_lib_path/Mailer.pm";
    my $mailer = new Mailer ( { smtp => $db_smtp_server, 
                                sendmail => $db_mail_path, 
                                from => $from, 
                                subject => $subject,
                                to => $to,
                                msg => $msg,
                                log => $db_mailer_log
                            } ) or return;
    $mailer->send or return;
}
## MOD Deadlink 02E

sub error {
# ------------------------------------------
#
    print "Content-type: text/plain\n\n";
    print "Error: $_[0]\n";
    exit;
}