#!/usr/local/bin/perl ############################################################################ # Spam-X version 3.0, A sophisticated and very mean spambot tarpit. # # See http://www.lindstromconsulting.com/ for more information. # # # # Copyright (C) 2003 Nathan W. Lindstrom # # # # If you use this script on your web site, please put a link to # # http://www.lindstromconsulting.com/ somewhere on your web site. Thanks! # # # # This program is free software; you can redistribute it and/or modify # # it under the terms of the GNU General Public License as published by # # the Free Software Foundation; either version 2 of the License, or # # (at your option) any later version. # # # # This program is distributed in the hope that it will be useful, # # but WITHOUT ANY WARRANTY; without even the implied warranty of # # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # # GNU General Public License for more details. # # # # You should have received a copy of the GNU General Public License # # along with this program; if not, write to the Free Software # # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA # # You can also view it online at http://www.gnu.org/licenses/gpl.html # ############################################################################ use IO::Handle; # Allows us to use "autoflush STDOUT;" $http_user_agent = $ENV { 'HTTP_USER_AGENT' }; # Get the User-Agent of visitor $referer = $ENV { 'HTTP_REFERER' }; # Find out who called us $programpath = $programname = reverse ($0); # Load up our full path and name in reverse $programpath =~ s/^[^\/]*\///; # Strip off our full name and trailing slash $programname =~ s/\/.*//; # Strip off our full path, leaving our name... $programname =~ s/lp\.//; # ...without the ".pl" extension $programpath = reverse ($programpath); # Reverse the string to normal $programname = reverse ($programname); # Reverse the string to normal check_referer (); # Make sure we're authorized to respond check_for_robot (); # Don't flood search engine crawlers or robots flood_spambot (); # Flood visiting spambot with mailto: links ################################################################################################# sub check_referer { my $refokay = 0; if (open (REFERER, "$programpath/$programname.domains")) { flock (REFERER, 1); while () { chomp (); if ($referer =~ /$_/) { $refokay = 1 } } close (REFERER); unless ($refokay == 1) { print ("Location: http://www.lindstromconsulting.com/software.html\n\n"); exit; } } else { die ("Could not open domains list $programpath/$programname.domains\n"); } } ################################################################################################# sub check_for_robot { if (open (ROBOTS, "$programpath/$programname.robots")) { flock (ROBOTS, 1); while () { chomp (); if ($http_user_agent =~ /$_/) { print ("Content-Type: text/html; charset=ISO-8859-1\n\n"); print ("\n"); print ("\n"); print ("\n"); print ("\n"); print ("\n"); print ("\n\n"); print ("\n"); print ("

This is Spam-X, available from here.

\n"); print ("\n"); print ("\n"); close (ROBOTS); exit (0); } } close (ROBOTS); } else { die ("Could not open robots list $programpath/$programname.robots\n"); } } ################################################################################################# sub flood_spambot { if (open (DICTIONARY, "$programpath/$programname.dictionary")) { flock (DICTIONARY, 1); while () { chomp (); $wordlist[($#wordlist + 1)] = $_; } close (DICTIONARY); } else { die ("Could not open dictionary word list $programpath/$programname.dictionary\n"); } print ("Content-Type: text/html; charset=ISO-8859-1\n\n"); print ("\n"); print ("\n"); print ("\n"); print ("\n"); print ("\n"); print ("\n\n"); print ("\n"); print ("

"); autoflush STDOUT; my @chars = ("a" .. "z", "0" .. "9", "-"); my @nextline = (" ", ", ", ". ", "; ", "--", "/", ".
", ".

", ".

"); # Full list of ICANN-approved TLDs my @zones = ("aero", "biz", "com", "coop", "edu", "gov", "info", "int", "mil", "museum", "name", "net", "org", "pro"); for (my $i = 0; $i <= (rand (time())%1024); $i++) { my $limit = (rand time())%32; my $username = join("", @chars[ map { rand (@chars) } ( 0 .. $limit )]); my $domain = join("", @chars[ map { rand (@chars) } ( 0 .. $limit )]); my $zone = $zones[(rand (time())%$#zones)]; print (""); print ("$wordlist[(rand (time())%($#wordlist + 1))] $wordlist[(rand (time())%($#wordlist + 1))] "); print ("$username\@$domain.$zone "); print ("$wordlist[(rand (time())%($#wordlist + 1))] $wordlist[(rand (time())%($#wordlist + 1))]"); print ("$nextline[(rand (time())%($#nextline + 1))]"); autoflush STDOUT; sleep 1; } print ("

\n"); print ("

"); print ("$wordlist[(rand (time())%($#wordlist + 1))]."); print ("

\n"); print ("\n"); print ("\n"); }