Gossamer Forum
Home : General : Perl Programming :

Need Help....

Quote Reply
Need Help....
Hi. I am trying to write a script which tells you if your referer was from a valie list. I want to be able to put;

$referer = $ENV{HTTP_REFERER};
$refer_url = "http://www.somesite.com";

if ($referer ne "$refer_url") { &bad } else { &print_good };

The problem is the page refering it may be from something like http://www.somesite.com/main.html, which obviously won't work. Is there a way i can parse just the $ENV{HTTP_REFERER} value to be just the domain name?

Any helpis much appreciated.

(As you can tell i'm not much of a perl guru, just teaching myself!)

Thanks

Andy

Quote Reply
Re: Need Help.... In reply to
Try: if ($referer !~ /^$refer_url/) { &bad } else { &print_good };

- Mark


Astro-Boy!!
http://www.zip.com.au/~astroboy/
Quote Reply
Re: Need Help.... In reply to
Thanks mate, that worked great :)

Quote Reply
Re: Need Help.... In reply to
Actually, no it doesn't work. Now it lets you access &print_good even iff the referer is wrong!

Any help you can offer is much appreciated.....

Andy

Quote Reply
Re: Need Help.... In reply to
1) You need to create an array of "good" referal domains, like the following:

Code:

@good_urls = ('www.something.com','something.com','somethingelse.org');


2) Then you need to edit the codes you've written to be the following:

Code:

Use Socket;
my $remote_host = $ENV{'REMOTE_HOST'};
my $remote_address = $ENV{'REMOTE_ADDR'};
my $goodurls = $shortdom;
my $check_host = scalar(gethostbyaddr(inet_aton($remote_address), AF_INET));
my $shortdom = scalar(gethostbyaddr(inet_aton($remote_address), AF_INET));
$shortdom = $1 if ($shortdom =~ /.*\.([^.]*\.[^.]*)/);

foreach $goodurls (@good_urls) {
if ($shortdom =~ /$goodurls/i) {
&bad;
}
else {
&print_good;
}
}


Hope this helps.


Regards,

Eliot Lee
Quote Reply
Re: Need Help.... In reply to
Thanks, i'll try that ASAP!!!!

Quote Reply
Re: Need Help.... In reply to
I have tried it but now i just receive blank pages.

Any ideas?

Andy

P.S. Thanks for the help so far!

Quote Reply
Re: Need Help.... In reply to
You need to identify the MIME type with:

Code:

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


AT the top of the script....

Like the following:

Code:

Use Socket;
print "Content-type: text/html\n\n";
my $remote_host = $ENV{'REMOTE_HOST'};
my $remote_address = $ENV{'REMOTE_ADDR'};
my $goodurls = $shortdom;
my $check_host = scalar(gethostbyaddr(inet_aton($remote_address), AF_INET));
my $shortdom = scalar(gethostbyaddr(inet_aton($remote_address), AF_INET));
$shortdom = $1 if ($shortdom =~ /.*\.([^.]*\.[^.]*)/);
foreach $goodurls (@good_urls) {
if ($shortdom =~ /$goodurls/i) {
&bad;
}
else {
&print_good;
}
}


Or if you want to use mod_perl, you could simply use:

Code:

print $in->header();


Like the following:

Code:

use CGI();
use Socket;
use strict;
print $in->header();
my $remote_host = $ENV{'REMOTE_HOST'};
my $remote_address = $ENV{'REMOTE_ADDR'};
my $goodurls = $shortdom;
my $check_host = scalar(gethostbyaddr(inet_aton($remote_address), AF_INET));
my $shortdom = scalar(gethostbyaddr(inet_aton($remote_address), AF_INET));
$shortdom = $1 if ($shortdom =~ /.*\.([^.]*\.[^.]*)/);
foreach $goodurls (@good_urls) {
if ($shortdom =~ /$goodurls/i) {
&bad ($in);
}
else {
&print_good ($in);
}
}


Regards,

Eliot Lee
Quote Reply
Re: Need Help.... In reply to
I have tried that, but it still won't work. If you want complete the form at http://secure.clickbank.net/...&quer=&from= and see what i mean. Otherwise you could just look at the script at http://www.ace-installer.com/cgi-bin/purchase.cgi

Once again, thanks for your help

Andy

Quote Reply
Re: Need Help.... In reply to
Doesn't help to click on an executable CGI script...if you want us to help you, save the CGI script as a TEXT file and then post it in a publicly accessible directory in your WEB SERVER.

Good luck!

Regards,

Eliot Lee
Quote Reply
Re: Need Help.... In reply to
OK, heres the code;

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

#!/usr/bin/perl
print "Content-type: text/html \n\n";


# VARIABLES TO SET

$title = "Title of your site"; # This is the title of your site

$admin = "webmaster\@yoursite.com";
# This is the admin e-mail address in case of a problem with a purchase. # You need to put a \ in front of the @ sign

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

if ($ENV{'REQUEST_METHOD'} eq 'GET') {
$buffer = $ENV{'QUERY_STRING'};
}
else {
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
}

@pairs = split(/&/, $buffer);
foreach $pair (@pairs) {
($name, $value) = split(/\=/, $pair);
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$FORM{$name} = $value;
}
@good_urls = ('www.clickbank.com','clickbank.com');

$product = "$FORM{product}";
$download_location = "$FORM{location}";
$receiptno = "$FORM{cbreceipt}";
# if ($referer =~ /^$refer_url/) { &buy_bad } else { &print_buy_good };

Use Socket;
print "Content-type: text/html\n\n";
my $remote_host = $ENV{'REMOTE_HOST'};
my $remote_address = $ENV{'REMOTE_ADDR'};
my $goodurls = $shortdom;
my $check_host = scalar(gethostbyaddr(inet_aton($remote_address), AF_INET));
my $shortdom = scalar(gethostbyaddr(inet_aton($remote_address), AF_INET));
$shortdom = $1 if ($shortdom =~ /.*\.([^.]*\.[^.]*)/);

foreach $goodurls (@good_urls) {
if ($shortdom =~ /$goodurls/i) {
&buy_bad;
}
else {
&print_buy_good;
}
}



sub print_buy_good
{
print qq|
<HTML>

<HEAD>
<TITLE>$title > Thanks for buying </TITLE>
<META name="author" content"A.J.Newby">

<style type="text/css">

</style>
<style fprolloverstyle>A:hover {color: #FF0000}
</style>


</HEAD>

<BODY BGCOLOR="#FFFFFF" TEXT="#000000" LINK="#0000FF" VLINK="#0000FF">

<h2 align="center"><b>SORRY</b></h2>
<p align="center">It seems that you were not referred from a valid web page. If
you feel this is an error please contact us by email at; </p>
<p align="center"><a href="mailto:$admin">$admin</a> </p>



</BODY>
</HTML>
|; # Don't remove this.....

};


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

Quote Reply
Re: Need Help.... In reply to
PLEASE, someone help me.....