#!/usr/local/bin/perl
#
# fakelist.pl - generate a random list of real-looking bogus email
# addresses in the form of an HTML mailing list page.
#
# this version generates addresses of the form -
# [word]@[word][letter][word][letter].[ext]
# where each word is a chosen randomly for /usr/dict/words and must
# be at least 4 charactes long. That should make it very unlikely
# to ever hit a real domain.
# -- as suggested by Zoli Fekete
#
# seed random number generator
srand($$|time);
# how many addresses to give at a time
# I like to use a variable number of addreses
$numadds = 100+int(rand(100));
# set this to 1 if you want spiders to keep coming back to grab
# your list again and again, set to 0 to not generate links
$addlinks = 1;
# start the HTML output. (Feel free to rename your "mailing list".)
print "Content-type: text/html\n\n";
print <<"EndHTML";
The Buckaroo Banzai Mailing List
The Buckaroo Banzai Mailing List
This mailing list is for the use of Blue Blaze Irregulars only. Please
do not use it for any other purposes.
EndHTML
#
# This is the original code that grabs the whole dictionary for words.
# It is too memory abusive for a shared server. Do not use it.
#
#if (open(DICT,"/usr/dict/words")) {
# @words = ;
# close(DICT);
#}
#
# This is my replacement that should reduce memory and load issues.
# The word list is much smaller and randomized against the alphabet
# Tony Awtrey - tony@awtrey.com
#
@alphaset = (a..z);
for $i (0..1000) {
for $j (0..(rand(4)+3)) {
$word = $word . @alphaset[rand(25)];
}
push(@words,$word);
$word = '';
}
chomp @words;
if ($addlinks) {
print "- Links to other mailing lists:\n";
for $i (0..3) {
$text=&getword;
$link = "/lists/$text.html";
$link =~ s/[\s\n\r]+//g;
print "
- $text\n";
}
print "
\n";
}
@tails = ( ".com",".org",".net",".edu" );
undef @list;
for $i (0..$numadds) {
$user = &getword;
$user =~ tr/A-Z/a-z/; $name = $user;
substr($name,0,1) =~ tr/a-z/A-Z/;
$name = "John $name";
$domain = &getword.&getletter.&getword.&getletter;
$domain .= $tails[int(rand($#tails+1))];
$email = "$user\@$domain"; $email =~ tr/A-Z/a-z/;
push @list,"$name $email\n";
}
$|=1;
print "\n";
foreach $l (sort @list) {
print $l;
# uncomment this line if you want it to feed the list out s-l-o-w-l-y
# sleep 2;
}
print <<"EndHTML";
EndHTML
# get a random word of at least 4 characters
sub getword {
my $word = "";
while (length($word) < 4) {
$word = $words[int(rand($#words+1))];
}
return $word;
}
# get a random letter
sub getletter {
my $list = "abcdefghijklmnopqrstuvwxyz0123456789";
return substr($list,int(rand(length($list))),1);
}