#!/usr/bin/perl -w # wpoison.pl - Version 1.7p # # For usage instructions see http://www.monkeys.com/wpoison/ # # Original idea by Ronald F. Guilmette # Code implemented by Ronald F. Guilmette # # 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: # # # # # # 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; my $pname = "wpoison"; my $creation_time; my $age_in_seconds; my $email_addr; my $num_addresses; my $num_links; my $tmp_words_file = "/tmp/wpoison.words"; my $num_cached_randwords = 4096; my $script_name = getenv ("SCRIPT_NAME"); my @randwords; my @tl_domains_1 = ( "com", "com", "com", "com", "net", "net", "net", "org", "org", "edu", "edu", "gov", "mil", "int"); my @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", "\n", "WPOISON - Unexpected Error\n", "\n"); print "$pname: $message\n"; print ("\n\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 () { 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 = 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")); while () { chop; push @randwords, $_; } close RWORDS; } sub random_word { my $word_index; $word_index = 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 = rand $num_cached_randwords; print $randwords[$word_index]; print " " if ($i < $num_words); } } sub gen_random_color { my $red_code = rand 256; my $green_code = rand 256; my $blue_code = rand 256; printf "#%02x%02x%02x", $red_code, $green_code, $blue_code; } sub random_letter { return chr (unpack ("%c", 'a') + rand 26); } sub random_domain { my $rindex; if ((rand 4) == 0) { $rindex = rand ($#tl_domains_2 + 1); return $tl_domains_2[$rindex]; } else { $rindex = 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", "\n", "\n", ""); gen_random_words (2, 6); print STDOUT ("\n", "\n", "\n", "\n", "\n"); gen_random_words (10, 30); print ("

\n"); $num_addresses = 2 + rand 16; for (1..$num_addresses) { $email_addr = random_word (); $email_addr .= "@"; if ((rand 4) == 0) { $email_addr .= random_word () . "."; } $email_addr .= random_word () . random_letter () . "." . random_domain (); print "$email_addr
\n"; } print ("

\n"); gen_random_words (2, 20); print ("

\n"); $num_links = 1 + rand 16; for (1..$num_links) { print ""); gen_random_words (1, 9); print ("
\n"); } print ("

\n"); gen_random_words (2, 20); # Sleep for four seconds when finishing each page to avoid server overload. sleep (4); print ("\n\n\n"); exit 0;