信息来源：
http://downlode.org/perl/spamtrap/复制内容到剪贴板
代码:
#!/usr/bin/perl
use warnings;
use strict;
########
#
# Spam Trap 1.3.3
# Copyright Earle Martin 2003.
# [url]http://downlode.org/perl/spamtrap/[/url]
#
# This work is licensed under the Creative Commons Attribution-ShareAlike
# License. To view a copy of this license, visit
# [url]http://creativecommons.org/licenses/by-sa/1.0/[/url] or send a letter to Creative
# Commons, 559 Nathan Abbott Way, Stanford, California 94305, USA.
#
# DISCLAIMER
# This code comes with no warranty, implied or otherwise. If using it you do
# so at your own risk.
#
########
########
# Configuration Section - this means you!
# Where's your words file? E.g. "/usr/share/dict/words" if you have a
# system-wide one (the location of this varies in different UNIX/Linux
# flavours, so don't take that path for granted), or something like
# 'words.txt' if you have a list called 'words.txt' in the same directory as
# the script. See the Spam Trap home page for information on obtaining
# interesting word lists.
my $wordlist = 'wordlists/default';
# Do you want to use a separate list of names for the email addresses?
# If so, where is it?
my $usenames = 1; # 1 for yes, 0 for no
my $namelist = 'wordlists/names';
# You shouldn't have to edit anything below this point.
#
########
########
# Script Setup
use CGI;
use HTML::Entities;
my $cgi = CGI->new();
# Get the name of this script.
my $script = (split('/', $0))[-1];
my (@words, @names, $breadcrumbs, $cumulative, $firstname, $lastname);
my $url = $cgi->url(-path_info => 0);
# Get any 'directories' passed to the script.
my $env = $cgi->path_info() || '';
my @letters = ('a'..'z', '-');
my @punct = ('.', '.', '.', '.', '!', ':', ' -');
my @initials = ('A'..'Z');
# It's a big ol' world.
my @domains = qw/ ad ae af ag ai al am an ao aq ar as at au aw az ba bb bd be
bf bg bh bi bj bm bn bo br bs bt bv bw by bz ca cc cf cd cg ch ci ck cl cm cn
co cs cu cv cx cy cz de dj dk dm do dz ec eg eh er es et fi fj fk fm fo fr fx
ga gb gd ge gf gh gi gl gm gn gov gp gq gr gs gt gu gw gy hk hm hn hr ht hu id
ie il in int io iq ir is it jm jo jp ke kg kh ki km kn kp kr kw ky kz la lb lc
li lk lr ls lt lu lv ly ma mc md mg mh mil mk ml mm mn mo mp mq mr ms mt mu mv
mw mx my mz na nc ne net nf ng ni nl no np nr nt nu nz om org pa pe pf pg ph
pk pl pm pn pr pt pw py qa re ro ru rw sa sb sc sd se sg sh si sj sk sl sm sn
so sr st su sv sy sz tc td tf tg th tj tk tm tn to tp tr tt tv tw tz ua ug uk
um us uy uz va vc ve vg vi vn vu wf ws ye yt yu za zm zr zw /;
# Things to chuck in occasionally.
my @optionals = ( '.com', '', '.net', '', '.org', '', '.gov', '', '.co' );
#
########
########
# Time to get busy. Here we go:
&load_words;
&load_names if $usenames == 1;
my $pagetitle = get_title();
&start_html($pagetitle);
print construct_breadcrumbs();
print "<h1>$pagetitle</h1>\n";
for (0..int(rand(10)))
{
&construct_paragraph;
# Only make email addresses some of the time.
my $random = int(rand(2)) +1;
&construct_email_list if $random == 1;
}
# Wait for a bit so this script won't thrash its own server to death.
sleep 2;
&end_html;
# Boom! We're done.
########
########
# Script Subroutines
# In a fake subdirectory? If so, make a title for the page from the "current" one.
sub get_title
{
my $title;
# Title follows final slash in URL if in "subdir".
if ($env =~ /(.*)\/(.*)$/) {
$title = $2;
}
else {
for (1..int(rand(5))) {
$title .= random_word() . " ";
}
}
$title;
}
# Build the fake navigation at the top of the page from what was given in the URL.
sub construct_breadcrumbs
{
my @fakedirs = split('/', $env);
my $crumbs = qq%<a href="$url">Home</a>%;
foreach my $fake (@fakedirs) {
if ($fake) {
$cumulative .= "/";
$cumulative .= $fake;
$crumbs .= qq% / <a href="$url$cumulative">$fake</a>%;
}
}
$crumbs .= "</a>\n<hr>";
$crumbs;
}
# Generate a paragraph of random words with some links thrown in.
sub construct_paragraph
{
print "<p>\n";
for (0..int(rand(10))) {
print construct_sentence();
}
print "\n</p>\n";
}
# Generate a 'sentence'.
sub construct_sentence
{
my $phrase = random_word() . " ";
# Pick a bunch of words. Throw in links from time to time.
for (0..int(rand(10))) {
if (int(rand(8)) == 1) {
$phrase .= construct_link();
}
else {
$phrase .= random_word() . " ";
}
}
# Capitalise the sentence.
$phrase = ucfirst($phrase);
# Punctuate that sucka.
$phrase =~ s/ $/$punct[int(rand(7))] /;
return $phrase;
}
# Generate a link back to this script - not that spambots will realise.
sub construct_link
{
my $linkphrase = random_word() . " ";
for (1..int(rand(5))) {
$linkphrase .= random_word() . " ";
}
# Strip trailing space in link phrase.
$linkphrase =~ s/ $//;
my $esc_phrase = $linkphrase;
$esc_phrase =~ s/ /%20/g;
my $link = qq%<a href="$url$env/$esc_phrase">$linkphrase</a> %;
$link;
}
sub construct_email_list
{
# Generate a list of fake email addresses.
print "<ul>\n";
for (0..int(rand(5))) {
print "\t<li>" . construct_email() . "</li>\n";
}
print "</ul>\n";
}
# Generate a plausible email address.
sub construct_email
{
my $suffix = '';
# Random length suffix.
my $num = int(rand(8)) + 2;
# Make the suffix out of a random word and some gibberish.
$suffix = random_word() . ".";
for (1..$num) {
$suffix = $suffix . $letters[int(rand(27))];
}
# Fix invalid sequences.
$suffix =~ s/^-//; # Leading "-"
$suffix =~ s/\-$//; # Trailing "-"
$suffix =~ s{\.\.}{\.}g; # ".."
$suffix =~ s{-\.}{\.}g; # "-."
$suffix =~ s{\.-}{\.}g; # ".-"
$suffix =~ s{--}{-}g; # "--"
# Pick a country, any country.
my $domain = $domains[int(rand(250))];
# Maybe throw in a ".gov" or something for good measure.
my $optional = $optionals[int(rand(9))];
# Use a separate name list?
$usenames == 1 ? &generate_name_names() : &generate_name_words();
my $random = int(rand($#initials * 5));
my $initial = '';
# Insert a random middle initial about 1/5 of the time.
$initial = $initials[$random] if $random <= $#initials;
$initial .= '. ' if $initial;
my $fakename = "$firstname $initial $lastname";
# Build a mailto link.
my $nameclean = $firstname;
$nameclean =~ s/\'//;
$nameclean = lc($nameclean);
my $address = $nameclean . "\@$suffix";
$address .= $optional if $optional;
$address .= ".$domain";
my $email = "$fakename <<a href=\"mailto:$address\">$address</a>>";
$email;
}
sub load_words
{
# Fill up an array with words.
open (WORDS, $wordlist) or die "Error: $!";
while (<WORDS>) {
chomp;
push (@words, $_);
}
}
# Pick a random word.
sub random_word
{
# Common words, from the Google stop word list.
my @stopwords = qw(I a about an are as at be by for from how in is it of
on or that the this to was what when where who will with the);
# About 1/5 words should be a common word.
# Patch suggested by Han-Kwang Nienhuys.
my $word;
if ((my $random = int(rand($#stopwords * 5))) <= $#stopwords) {
$word = $stopwords[$random];
} else {
$word = $words[rand($#words)];
}
# My words file has loads of possessives
# for some reason. Bollocks to that.
$word =~ s/'s//;
# Pass through HTML::Entities to encode accented letters and so on.
encode_entities($word);
}
# Fill up an array with names.
sub load_names
{
open (NAMES, $namelist) or die "Error: $!";
while (<NAMES>) {
chomp;
push (@names, $_);
}
}
# Pick a random name.
sub random_name
{
my $name = $names[rand($#names)];
# Pass through HTML::Entities to encode accented letters and so on.
encode_entities($name);
}
# Generate a two-part name using the default word list.
sub generate_name_words
{
$firstname = ucfirst(random_word());
$lastname = ucfirst(random_word());
}
# Generate a two-part name using a separate name list.
sub generate_name_names
{
$firstname = ucfirst(random_name());
$lastname = ucfirst(random_name());
}
# Boring HTML bits.
sub start_html
{
my $title = shift;
print <<HTML;
Content-type: text/html
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head>
<meta name="robots" content="noindex,nofollow">
<title>$title</title>
</head>
<body>
HTML
}
sub end_html
{
print <<HTML;
</body>
</html>
HTML
}
