No reason not to open wpoison.pl in a text editor and modify the commands to
appropriate CF ones.
The advantage is that it generates email addr4esses that do not step on any
existing domains, which would be a bad idea.
I would really like to see the working solution in CF.
here is the script: It requires a word file, which I can send you off list if
you want.
#!/usr/bin/perl -w
# wpoison.pl - Version 1.8p
#
# For usage instructions see http://www.monkeys.com/wpoison/
#
# Original idea by Ronald F. Guilmette <[EMAIL PROTECTED]>
# Code implemented by Ronald F. Guilmette <[EMAIL PROTECTED]>
#
# Copyright (c) 2000,2001 Ronald F. Guilmette; All rights reserved.
#
# Redistribution and use in source form ONLY, with or without modification,
# is permitted provided that the following conditions are met:
#
# 1. Redistributions of source code must retain the above copyright
# notice, this list of conditions and the following disclaimer.
# 2. All advertising materials mentioning features or use of this software
# must display the following acknowledgement:
# This product includes software developed by Ronald F. Guilmette.
# 3. Neither the name of Ronald F. Guilmette nor the names of other con-
# tributors to this software may be used to endorse or promote products
# derived from this software without specific prior written permission.
# 4. Either a copy of, or a link to the official Wpoison logo graphic (which
# may be found at http://www.monkeys.com/wpoison/logo.gif) must be
# included in, and clearly and legibly visible on the home page of any
# web site which uses, employs, includes, or makes reference to this
# software or any derivative or modified version thereof. Also, the
# official Wpoison logo itself must be include in an HTML hyperlink
# so that any usser clicking on any part of the logo image will be
# directed/linked to the Wpoison home page at:
#
# http://www.monkeys.com/wpoison/
#
# In order to satisfy this requirement, you may simply include the
# following HTML code somewhere (anywhere) on your web site home page:
#
# <A HREF=""> # <IMG SRC=""> # </A>
#
# Disclaimer
# ----------
#
# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
# SUCH DAMAGE.
use strict;
use FileHandle;
use POSIX;
use vars qw($pname $tmp_words_file $num_cached_randwords @randwords
@tl_domains_1 @tl_domains_2);
$pname="wpoison";
$tmp_words_file = "/tmp/wpoison.words";
$num_cached_randwords = 4096;
my $creation_time;
my $age_in_seconds;
my $email_addr;
my $num_addresses;
my $num_links;
my $script_name = getenv ("SCRIPT_NAME") || $0;
@tl_domains_1 = (
"com", "com", "com", "com",
"net", "net", "net",
"org", "org",
"edu", "edu",
"gov",
"mil",
"int");
@tl_domains_2 = (
"uk", "su",
"af", "al", "dz", "as", "ad", "ao", "ai", "aq", "ag", "ar", "am", "aw", "au",
"at", "az", "bs", "bh", "bd", "bb", "by", "be", "bz", "bj", "bm", "bt", "bo",
"ba", "bw", "bv", "br", "io", "bn", "bg", "bf", "bi", "kh", "cm", "ca", "cv",
"ky", "cf", "td", "cl", "cn", "cx", "cc", "co", "km", "cg", "ck", "cr", "ci",
"hr", "cu", "cy", "cz", "dk", "dj", "dm", "do", "tp", "ec", "eg", "sv", "gq",
"er", "ee", "et", "fk", "fo", "fj", "fi", "fr", "fx", "gf", "pf", "tf", "ga",
"gm", "ge", "de", "gh", "gi", "gr", "gl", "gd", "gp", "gu", "gt", "gn", "gw",
"gy", "ht", "hm", "hn", "hk", "hu", "is", "in", "id", "ir", "iq", "ie", "il",
"it", "jm", "jp", "jo", "kz", "ke", "ki", "kp", "kr", "kw", "kg", "la", "lv",
"lb", "ls", "lr", "ly", "li", "lt", "lu", "mo", "mk", "mg", "mw", "my", "mv",
"ml", "mt", "mh", "mq", "mr", "mu", "yt", "mx", "fm", "md", "mc", "mn", "ms",
"ma", "mz", "mm", "na", "nr", "np", "nl", "an", "nc", "nz", "ni", "ne", "ng",
"nu", "nf", "mp", "no", "om", "pk", "pw", "pa", "pg", "py", "pe", "ph", "pn",
"pl", "pt", "pr", "qa", "re", "ro", "ru", "rw", "kn", "lc", "vc", "ws", "sm",
"st", "sa", "sn", "sc", "sl", "sg", "sk", "si", "sb", "so", "za", "gs", "es",
"lk", "sh", "pm", "sd", "sr", "sj", "sz", "se", "ch", "sy", "tw", "tj", "tz",
"th", "tg", "tk", "to", "tt", "tn", "tr", "tm", "tc", "tv", "ug", "ua", "ae",
"gb", "us", "um", "uy", "uz", "vu", "va", "ve", "vn", "vg", "vi", "wf", "eh",
"ye", "yu", "zr", "zm", "zw");
sub
death
{
my ($message) = @_;
print STDOUT ("Content-Type: text/html\n",
"\n",
"<HTML>\n",
"<HEAD><TITLE>WPOISON - Unexpected Error</TITLE></HEAD>\n",
"<BODY BGCOLOR=\"white\" TEXT=\"#c00000\"><BIG><BIG>\n");
print "$pname: $message\n";
print ("</BIG></BIG></BODY>\n</HTML>\n");
exit 0;
}
sub
gen_new_random_words_list
{
my $dictfile;
my $total_words;
my @words;
my %already_taken;
if (-f $tmp_words_file) {
if (not unlink ($tmp_words_file)) {
death ("Error unlinking file \`$tmp_words_file\': $!");
}
}
if ( -f "/usr/dict/words") {
$dictfile = "/usr/dict/words";
} elsif (-f "/usr/share/dict/words") {
$dictfile = "/usr/share/dict/words"
} elsif (-f "words") {
$dictfile = "words";
} else {
death ("Cannot find dictionary file!");
}
death ("Error opening dictionary file \`$dictfile\': $!")
unless (open (DICTFILE, "<$dictfile"));
$total_words = 0;
while (<DICTFILE>) {
chop;
push @words, $_;
$total_words++;
}
close DICTFILE;
death ("Error opening tmp words file \`$tmp_words_file\': $!")
unless (open (RWORDS, ">$tmp_words_file"));
# We will now pick $num_cached_randwords words at random
srand;
for (1..$num_cached_randwords) {
try_again:
my $rand_index = int (rand $total_words);
goto try_again if (defined $already_taken{$rand_index});
$already_taken{$rand_index} = 1;
print RWORDS "$words[$rand_index]\n";
}
close RWORDS;
}
sub
read_random_words
{
death ("Error opening tmp words file \`$tmp_words_file\': $!")
unless (open (RWORDS, "<$tmp_words_file"));
chop(@randwords = <RWORDS>);
close RWORDS;
}
sub
random_word
{
my $word_index;
$word_index = int (rand $num_cached_randwords);
return $randwords[$word_index];
}
sub
gen_random_words
{
my ($min_words, $max_words) = @_;
my $num_words;
my $word_index;
my $i;
$num_words = $min_words + (rand ($max_words - $min_words));
for $i (1..$num_words) {
$word_index = int (rand $num_cached_randwords);
print $randwords[$word_index];
print " " if ($i < $num_words);
}
}
sub
gen_random_color
{
my $red_code = int (rand 256);
my $green_code = int (rand 256);
my $blue_code = int (rand 256);
printf "#%02x%02x%02x", $red_code, $green_code, $blue_code;
}
sub
random_letter
{
return chr (unpack ("%c", 'a') + int (rand 26));
}
sub
random_domain
{
my $rindex;
if (int (rand 4) == 0) {
$rindex = int (rand ($#tl_domains_2 + 1));
return $tl_domains_2[$rindex];
} else {
$rindex = int (rand ($#tl_domains_1 + 1));
return $tl_domains_1[$rindex];
}
}
autoflush STDOUT 1;
if (not -r $tmp_words_file) {
gen_new_random_words_list ();
} else {
$creation_time = (stat $tmp_words_file)[9];
$age_in_seconds = time - $creation_time;
gen_new_random_words_list () if ($age_in_seconds > (30 * 60));
}
read_random_words ();
print STDOUT ("Content-Type: text/html\n",
"\n",
"<HTML>\n",
"<HEAD>\n",
"<TITLE>");
gen_random_words (2, 6);
print STDOUT ("</TITLE>\n",
"<META NAME=\"ROBOTS\" CONTENT=\"NOINDEX, NOFOLLOW\">\n",
"</HEAD>\n",
"<BODY BGCOLOR=\"");
gen_random_color ();
print ("\" TEXT=\"");
gen_random_color ();
print ("\" LINK=\"");
gen_random_color ();
print ("\" VLINK=\"");
gen_random_color ();
print ("\">\n", "<BIG>\n");
gen_random_words (10, 30);
print ("<P>\n");
$num_addresses = 2 + int (rand 16);
for (1..$num_addresses) {
$email_addr = random_word ();
$email_addr .= "@";
if (int (rand 4) == 0) {
$email_addr .= random_word () . ".";
}
$email_addr .= random_word () . random_letter () . "." . random_domain ();
print "<A HREF=""> }
print ("<P>\n");
gen_random_words (2, 20);
print ("<P>\n");
$num_links = 1 + int (rand 16);
for (1..$num_links) {
print "<A HREF=""> print $script_name;
print "/";
print (random_word ());
print ("\">");
gen_random_words (1, 9);
print ("</A><BR>\n");
}
print ("<P>\n");
gen_random_words (2, 20);
# Sleep for four seconds when finishing each page to avoid server overload.
sleep (4);
print ("</BIG>\n</BODY>\n</HTML>\n");
exit 0;
======================================
Stop spam on your domain, use our gateway!
http://www.clickdoug.com/mailfilter.cfm
For hosting solutions http://www.clickdoug.com
Featuring Win2003 Enterprise, RedHat Linux, CFMX 6.1 and PHP
======================================
If you are not satisfied with my service, my job isn't done!
----- Original Message -----
From: "Les Mizzell" <[EMAIL PROTECTED]>
To: "CF-Talk" <[EMAIL PROTECTED]>
Sent: Monday, December 15, 2003 9:29 PM
Subject: Re: Random Dynamically Named Page and matching link?
| Doug White wrote:
|
| > Google for "wpoisen" It is a perl script that I have on my web pages as a
| > hidden link. It does what you are trying to do,
|
| Would be cool, except that I can't run PERL on the server in question -
| so a Cold Fusion version is needed!
|
| I'm not too good with PERL, but it might be fun to see if I could
| reverse engineer it, if you or the author doesn't mind....
|
|
| --
| Les Mizzell
| -------------------------
| “Mihi placent, O Pincerna!
| Virent ova! Viret perna!
| Dapem posthac non arcebo.
| Gratum tibi me praebebo.”
|
[Todays Threads] [This Message] [Subscription] [Fast Unsubscribe] [User Settings]
){kind=link}