#!/usr/bin/perl # $ # $ (Cougalinks version 3.7) # $ # $ Firstly I would like to thank you for using cougalinks, if you have given any # $ tips or even more importantly bug tips ;) I would like to thank you ! Cougalinks # $ has received a lot of praise over the last few years and I am glad to see so # $ many people profiting from its use. # $ # $ This code is distributed in the hope that is will be useful but WITHOUT ANY # $ WARRANTY. ALL WARRANTIES, EXPRESSED OR IMPLIED ARE HEREBY DISCLAMED. This includes # $ but isn't limited to warranties of MERCHANTABILITY or FITNESS FOR A PARTICULAR # $ PURPOSE. The RESELLING of this code is STRICTLY PROHIBITED. # $ # $ $Revision: 3.7 # $ $Author: Paul Williams # $ $Email: paul@rainbow.nwnet.co.uk # $ $URL: http://www.cougasoft.org/ # $ $Created: 21/11/1996 13:06 # $ $Last Modified: 01/04/2000 18:14 # $ # $ Copyright 1996, 1997, 1998, 1999, 2000 Cougasoft. All rights reserved. # $ # $ If you only want this script to be executed from your server, keep this as # $ 1, if you want to be able to post information from any website then set it # $ to zero or comment it out. $HTTPCHECK = 1; # # $-------------------------------------------------------------------------------------------- # # M A I N P R O G R A M # # $-------------------------------------------------------------------------------------------- # $VERSION = sprintf("%d.%02d", q$Revision: 3.51 $ =~ /(\d+)\.(\d+)/); unless ( ($pref = &preferences("data/cl-pref.pref", 28) ) == 1 || ($pref2 = &preferences("cl-pref.pref", 28) ) == 1) { $dir = ($^O ne 'MSWin32') ? `pwd` : `chdir`; print "Content-type: text/html\n\n"; print qq| Cougalinks Startup Error. Preference Startup Error

Script Executed From: $dir

Cougalinks ${VERSION} URL $ENV{SCRIPT_NAME} had the following error:

$pref
$pref2.


Cougalinks $VERSION Written by Paul Williams <paul\@rainbow.nwnet.co.uk> |; exit; } # # $-------------------------------------------------------------------------------------------- # # S O R T F O R M I N P U T # # $-------------------------------------------------------------------------------------------- # if ($ENV{'CONTENT_LENGTH'}) { read(STDIN, $input, $ENV{'CONTENT_LENGTH'}); @pairs = split(/&/, $input); foreach $pair (@pairs) { ($name, $value) = split(/=/, $pair); $value =~ tr/+/ /; $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; $value =~ s/<([^>]|\n)*>//g if ($PREF{'html'}); if ($name =~ s/^_([ru]+)//) { $option = $1; if ($option =~ /r/ && !$value) { &missing("$name"); } elsif ($option =~ /u/ && $value !~ /^\w.*:\/\/[\w\W]+\.[\w\W]+$/) { ¬ify("Internal Data Error", "There is a problem with your URL.", 1); } } $INPUT{$name} = $value; } } # # $-------------------------------------------------------------------------------------------- # # A C T I O N = D I R E C T # # $-------------------------------------------------------------------------------------------- # if ($ENV{'QUERY_STRING'} =~ /direct=(.*)/i) { &openf("DATABASE", "+>>$PREF{'data'}"); seek DATABASE, 0, 0; @results = ; seek DATABASE, 0, 0; truncate DATABASE, 0; foreach (@results) { ($name, $url, $date, $description, $click, $category, $show, $ip) = split('\|DI\|'); if ($url eq $1) { $click++; $ip = $ip ne "\n" ? $ip : "255.255.255.255"; print DATABASE "$name|DI|$url|DI|$date|DI|$description|DI|$click|DI|$category|DI|1|DI|$ip|DI|\n"; } else { print DATABASE "$_"; } } close(DATABASE); # $ We have credited the account (me thinks) so now we have to redirect the # $ web surfer to the disired location ($1 still holds that information) print "Location: $1\n\n"; } # # $-------------------------------------------------------------------------------------------- # # A C T I O N = R A N D O M # # $-------------------------------------------------------------------------------------------- # # $ Surfer would like a random link, I don't want to debit the url with a click # $ because the surfer hasn't purposly asked for the link, evil... well yeah, lazy # $ ... well yeah. good example for randomizing an array. elsif ($ENV{'QUERY_STRING'} eq 'action=random') { &openf("DATABASE", "$PREF{'data'}"); seek DATABASE, 0, 0; @results = ; close(DATABASE); $buf = $results[rand($#results)]; ($name, $url, $date, $description, $click, $category, $show, $ip) = split('\|DI\|', $buf); print "Location: $url\n\n"; } # # $-------------------------------------------------------------------------------------------- # # A C T I O N = S U B M I T - U R L # # $-------------------------------------------------------------------------------------------- # elsif ($ENV{'QUERY_STRING'} eq 'action=submit-url') { #>: Please check the commented code at the top of this script about this. ¬ify("500 Internal Server Error", "[BAD HTTP_REFERER]", 2) if !$ENV{'CONTENT_LENGTH'} || ($HTTPCHECK && $ENV{'HTTP_REFERER'} !~ /^http:\/\/$ENV{'HTTP_HOST'}$ENV{'SCRIPT_NAME'}/); (@longwords) = split(/\s+/, $INPUT{'DESCRIPTION'}); $INPUT{'DESCRIPTION'} = ""; foreach (@longwords) { $INPUT{'DESCRIPTION'} .= "$_ " unless ($PREF{'checkbigword'} && length > 30); $i++; } ¬ify("501 Data Server Error", "Please use around $PREF{'MAXWORDS'} words, you have used $i", 1) if ($PREF{'MAXWORDS'} && $i >= $PREF{'MAXWORDS'}); &openf("DATABASE", "$PREF{'data'}"); while () { ¬ify("501 Data Server Error", "That URL has already been added.", 1) if (/$INPUT{'URL'}/); ¬ify("501 Data Server Error", "I am afraid you can only post one link.", 2) if ($PREF{REPEATPOSTER} == 0 and /\|DI\|$ENV{'REMOTE_ADDR'}/); } close(DATABASE); # $ Open the file which containts the words we want to disallow, you must # $ edit this file by hand, at the moment I'm not allowing it to be edited by # $ the administration but it might be a feature in a newer version. if ($PREF{'disallow'}) { &openf("DISALLOW", "$PREF{'disallowfile'}"); while () { chop; ¬ify("501 Data Server Error", "Your information contains a disallowed word [$_]", 1) if ($INPUT{'DESCRIPTION'} =~ /$_/i || $INPUT{'NAME'} =~ /$_/i); } close(DISALLOW); } &addcougalink(); if ($PREF{'confirmation'} || $PREF{'CONFIRMLINK'}) { &top_html("Success !"); &nframe("[Thank you for adding a link]

" . (!$PREF{'CONFIRMLINK'} ? "Please click h e r e to view the link." : "Link will be added when administration verifies it.
Please click h e r e to view the links.") ); &bottom(1); } else { print "Location: $ENV{'SCRIPT_NAME'}?action=newlink\n\n"; } } # # $-------------------------------------------------------------------------------------------- # # A C T I O N = A D D - U R L # # $-------------------------------------------------------------------------------------------- # elsif ($ENV{'QUERY_STRING'} eq "action=add-url") { foreach ( split(',', $PREF{'CATEGORY'}) ) { $categories .= "