#!/usr/bin/perl
# Welcome to the www.dtp-aus.com LnkinLite scripts. VERSION 2.71 Feb. 2000 #
# IMPORTANT INFORMATION THAT MUST BE READ IF YOU WISH TO USE THESE SCRIPTS #
##############################################################################
# The script "LNKINLTE.CGI" was written (c) by Ron F Woolley, Melbourne #
# Australia. Copyright 1998'99. This script can be altered for personal use, #
# EXCEPT THAT: #
# ALL COPYRIGHT NOTICES must remain in the code, visible on all output pages,#
# AND ALL of the header notices MUST REMAIN intact as is, #
# AND using the script without first reading the README.HTM, is prohibited. #
# #
# Australian copyright is recognised/supported in over 130 countries... #
# per the Berne Convention (including USA!) #
# #
# The scripts and associated files REMAIN the property of Ron F Woolley. #
# NO PROFIT what so ever is to be gained from users of these scripts for #
# installation of these scripts, except that a reasonable minimal charge #
# for installation MAY be allowed. Supply, per installation, is directly #
# from dtp-aus.com ONLY. Remote hosting of this programs resources is #
# strictly not allowed. #
# #
# Ron Woolley, the author, MUST be notified via the addresses/URLs below #
# if any gain is to be made for the installation of these scripts. #
# #
##############################################################################
# NOTE: If you use these files, you do so entirely at your own risk, and #
# take on full responsibility for the consequences of using the described #
# files. You must first agree that Ron Woolley / HostingNet, the only #
# permitted supplier of this and/or accompanying files is exempt from any #
# responsibility for all or any resulting problems, losses or costs caused #
# by your using these or any associated files. If you disagree with ANY of #
# the included requirements, you must IMMEDIATELY DESTROY ALL FILES. #
##############################################################################
# This program script is free to use Copyright notices must remain #
##############################################################################
# These program scripts are free-to-use, but if you use them, a donation to #
# the author would be appreciated and help in continuing support for #
# LnkinLite and the creation of other scripts for users of the internet. #
# An on-line Visa / MasterCard payment cart is available for support #
# donations and low cost program installations. #
##############################################################################
# Support Information is available at: #
# http://www.dtp-aus.com/cgiscript/scrpthlp.htm #
# Files from: #
# http://www.dtp-aus.com/cgiscript/LnkinLte.shtml #
# #
# THESE FILES can only be obtained via the above web addresses, and MUST #
# NOT BE PASSED ON TO OTHERS in any form by any means what so ever. #
# This does not contradict any other statements above. #
# End user ONLY obtains the files via above #
##############################################################################
#--------- ALTER THESE VARIABLES ONLY! -----------------------------#
$the_url = "http://www.afenet.com/go/to.cgi";
@referers = ('www.afenet.com','afenet.com','afenetcom.powweb.com');
$records = "/home/afenet/cgi-bin/lnkinlte/lnkinlte.dta";
$edit_subs = "/home/afenet/cgi-bin/lnkinlte/edits.pl";
$webmsta = "rob\@afenet.com";
$myword = "n4732";
$admwrd_pth = "/home/afenet/cgi-bin/lnkinlte/lnkinlte.pw";
#--- DO NOT MAKE ANY CHANGES BELOW THIS LINE. ----------------------#
$| = 1;
&check_method;
@pairs = split(/&/, $query_string);
foreach $pair (@pairs) {
($name, $value) = split(/=/, $pair);
$value =~ tr/+/ /;
$name =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$value =~ s/~!/ ~!/g;
$name =~ s/~!/ ~!/g;
$value =~ s///g;
$name =~ s///g;
$name =~ s/(\0|`)//mg;
$value =~ s/(\0|`)//mg;
$FORM{$name} = $value;
}
if ($FORM{'l'} || $FORM{'t'}) {&do_link;}
elsif ($FORM{'p'} eq $myword) {require "$edit_subs"; &do_list;}
elsif ($FORM{'v'} eq $myword && $FORM{'get'}) {require "$edit_subs"; &do_get;}
elsif ($FORM{'e'} eq $myword) {require "$edit_subs"; &do_ed;}
else {&showErr("ERROR $FORM{'e'} Unknown Call or Password");}
exit;
sub do_link {
if (length($query_string) > 200) {&showErr("ERROR Request Too Long");}
if (!open (COUNT, "+<$records")) {&showErr("ERROR Data File READ Error");}
eval"flock(COUNT,2)";
@lns = ;
$cnts = 0; $nofind = 0;
foreach $ln (@lns){
if ($ln =~ /^($FORM{'l'}|$FORM{'t'})\|/) {
@TL = split(/\|/,$ln);
&check_ref if $TL[0] =~ /^\./;
$the_link = $TL[1];
if ($FORM{'l'}) {
$TL[2]++;
$lns[$cnts] = "$TL[0]|$TL[1]|$TL[2]\n";
seek(COUNT,0,0);
print COUNT @lns;
}
$nofind = 1;
last;
} $cnts++; }
eval"flock(COUNT,8)";
close(COUNT);
if (!$nofind) {&showErr("ERROR Could Not Find the requested link");}
if ($the_link =~ /[a-z]/i) {print "Location: $the_link\n\n";}
else {&showErr("ERROR The link you requested cannot be found");}
exit;
}
sub check_ref {
$crf = 0;
if ($ENV{'HTTP_REFERER'}) {
foreach $referer (@referers) {
if ($ENV{'HTTP_REFERER'} =~ m|\Ahttps?://$referer|i) {
$crf = 1;
last;
} } }
if ($crf eq 0) {&showErr('Bad Referrer Remote Access Denied');}
}
sub check_method {
local($request_method) = $ENV{'REQUEST_METHOD'};
if ($request_method eq 'GET') {$query_string = $ENV{'QUERY_STRING'};}
elsif ($request_method eq 'POST') {read(STDIN,$query_string, $ENV{'CONTENT_LENGTH'});}
else {&showErr("ERROR bad request - not accepted");}
return
}
sub showErr {
print "Content-type: text/html\n\n";
print <LnkinLite Response