#!/usr/bin/perl # PROJECT HONEY POT ADDRESS DISTRIBUTION SCRIPT # For more information visit: http://www.projecthoneypot.org/ # Copyright (C) 2004-2010, Unspam Technologies, Inc. # # 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 # # If you choose to modify or redistribute the software, you must # completely disconnect it from the Project Honey Pot Service, as # specified under the Terms of Service Use. These terms are available # here: # # http://www.projecthoneypot.org/terms_of_service_use.php # # The required modification to disconnect the software from the # Project Honey Pot Service is explained in the comments below. To find the # instructions, search for: *** DISCONNECT INSTRUCTIONS *** # # Generated On: Thu, 23 Dec 2010 07:33:02 -0800 # For Domain: www.castlevaniadungeon.net # # use strict; use Digest::MD5 qw(md5_hex); # *** DISCONNECT INSTRUCTIONS *** # # You are free to modify or redistribute this software. However, if # you do so you must disconnect it from the Project Honey Pot Service. # To do this, you must delete the lines of code below located between the # *** START CUT HERE *** and *** FINISH CUT HERE *** comments. Under the # Terms of Service Use that you agreed to before downloading this software, # you may not recreate the deleted lines or modify this software to access # or otherwise connect to any Project Honey Pot server. # # *** START CUT HERE *** # my $__REQUEST_HOST = 'hpr3.projecthoneypot.org'; my $__REQUEST_PORT = '80'; my $__REQUEST_SCRIPT = '/cgi/serve.php'; # # *** FINISH CUT HERE *** # my $__HPOT_TAG1 = 'e11953f6c42987bed7574f4485c38c68'; my $__HPOT_TAG2 = '5658e835391bb9666f23482ac3f3bc2d'; my $__HPOT_TAG3 = '60eff423c208d7fdab40a0dd2d377e0b'; my $__CLASS_STYLE_1 = 'writrepepr'; my $__CLASS_STYLE_2 = 'docheruce'; my $__DIV1 = 'k994n4z4sp5'; my $__VANITY_L1 = 'MEMBER OF PROJECT HONEY POT'; my $__VANITY_L2 = 'Spam Harvester Protection Network'; my $__VANITY_L3 = 'provided by Unspam'; my $__DOC_TYPE1 = '\n'; my $__HEAD1 = '\n\n'; my $__HEAD2 = 'barrelchested www.castlevaniadungeon.net mousy heap\n\n'; my $__ROBOT1 = '\n\n'; my $__NOCOLLECT1 = '\n'; my $__TOP1 = '\n
\n'; my $__EMAIL1A = ''; my $__EMAIL1C = ''; my $__EMAIL2A = ''; my $__EMAIL2C = ''; my $__EMAIL3A = ''; my $__EMAIL3C = ''; my $__EMAIL4A = ''; my $__EMAIL4C = ''; my $__EMAIL5A = ''; my $__EMAIL5C = '..'; my $__EMAIL6A = ''; my $__EMAIL6C = ''; my $__EMAIL7A = ''; my $__EMAIL7C = ''; my $__EMAIL8A = ''; my $__EMAIL9A = '
'; my $__EMAIL9C = '

'; my $__EMAIL10A = ''; my $__LEGAL1 = ''; my $__LEGAL2 = '\n'; my $__STYLE1 = '\n'; my $__VANITY1 = '
@'.$__VANITY_L1.'
'.$__VANITY_L2.'
'.$__VANITY_L3.'
\n'; my $__BOTTOM1 = '
\n\n\n'; sub getLegalContent() { return '\n\n\n\n\n\n
   d         d     
 
Theiwebsite from whi
to you subject to th
other terms governin
Website you accept t
read them carefully.
agents of the indivi
them. The accessirig
non-transferable wit
Website.

         d    gSPECI
 
Special restrictions
Non-Human Visitors.
spiders, bots, index
programs designed to
automatically.

Email addresses on t
It is recogphantom itchynizeditha
alone. You acknowled
has a value not less
storage,hand/or dist
value of these addre
storingothis Websalternative blossom portraitite
agreemeingrown pretentiousnt and expres

      de  kgg      c
 
Each party agrees th
againsmisst the otheoutline resolvent live orientation misfitr in
("Judicial Action")
thesregistered Admin
such laws are applie
andhperformed entire
of federal and state
any actionkbrought a
Service. You consent
theaabove agreement.

   g     p         
 
Youaconsent to havin
may ahypothetical guy team contradictoryppear somewhere
abuse. The Identifie
Visitors agree not t

VISITORSfAGREEcTHAT
PARTYeOborder approval testamentRkSENDING Aunwilling housebroken successful congruentNY
SUBSEQUENT BREACH OF
       TERMS AND CON

chcyou accessed this
e followiorgan bandng conditio
g access to the Webs
hese terms and conpermeable museumdi
 Aevent reputation abnormal aid calfncoherent illnessy Non-Human Visit
dual(s) who cogeographical sacred portrait decollete bucolicntrols
htsegragastropod alcoholic parsimoniousnted to you u
hout thehexpress wri


AL LICENSE RESTRICTI

aon a visitor\'s lice
Non-Human Visitors i
ers, robots, crawler
 access,sread, compi


his site are conside
t thesesemail addres
ge and agree that ea
 than US $50. You fu
ribution of these ad
sses. Intentkangaroos charter plain arco stemwindingional co
\'s email addrcoffee county naval sanityesses i
sly prohibited.

    oAPPLICABLE LAW 

aarrayt anytsuijail comedy breakaway almighty bombingt, action
 connection with ort
shall bheadline angry ingrowne governed by
istrative Contactcentre rare (t
d to agreements betw
ly within thchampaign childishe Admin
 courts withinathe A
gainst him in connec
 to electronic servi


    RECORDtrucks dance intent cab battleS OF VISIT

g your InternetfProt
 on texclusive nasty result hotheadedhis page (the "
r is uniquely matche
o use this address f

HARVESTING, GATHERIN
 MESSAGE(S)hounds TO THE I
 THESE TERMS OF SERV
DITIONS OF USE 

eagreembonfire xanaduentf("the Web
ns. These terms are
ite. By visiting (in
tions (theh"Terms of
ors to the Website s
, authors or otherwi
nder the Terms of Se
tten permission oshot courtiersf t


ONS FOR NON-HUMAN VI

nse to access the We
nclude, buteare not
s, hdutyarvesters, or an
le or gadeparture apatheticther content


red proprietary inte
ses are provided for
chtemail address the
rther agree that the
dresses substantiall
llection, harvesting
s recognized asingular repulsive insect irrationals a vi


AND JURISDICTION 

or proceeding brough
arising from the Ter
 the law of the stat
he "Admin State") fo
een Admin State resi
State. You consent t
dmin State. You cons
tion with breachwakeful progressive husky nounses o
ce of process regard


OR USE AND ABUSE 

ocol address recordediagnostic
Identifier") if we s
d to your Internet P
or any reason.

G, STORING, TRANSFER
DENTIFIER CONSTITUTE
ICE.


site") is pjam encouragement subaltern supervision intensiverovided
in addition tosany
 any manner) the
 Service"). Please
hall be considered
shysterical harmonious anxious commerciale makes usegof
rvice aabolition forgetful velocity nomadic wellbalancedre
he owner of the


SITORS 

bsite apply to
limitedtto, web
y other computer
 from the Website


llectual property.
 human visitors
 Website contains
 compilation,
y diminishes the
, gathering, and/or
olation of this




tobypsuchiparty
ms of Service
e of residenceeof
r the Website as
dents entered into
o thedjurisdiction
entitocthetvenue in
fgthese Terms of
ing actions under




d. An email address
usemergency worthless cloud relevant animalpect potential
rotocol address.


RING TO A THIRD
S AN Aworker multistageCCEPTANCE AND

\n
'; } #!/usr/bin/perl sub formatHTML { my $s = $_[0]; $s =~ s/\\n/\n/g; return $s; } sub getDocType { return formatHTML($__DOC_TYPE1); } sub getHeadHTML { return formatHTML($__HEAD1); } sub getRobotHTML { return formatHTML($__ROBOT1); } sub getNoCollectHTML { return formatHTML($__NOCOLLECT1); } sub getHeadHTML2 { return formatHTML($__HEAD2); } sub getTopHTML { return formatHTML($__TOP1); } sub getEmailHTML { my $method=$_[0]; my $m=$_[1]; if ($method eq "0" || !$method) { return ""; } elsif ($method eq "1") { return formatHTML($__EMAIL1A.$m.$__EMAIL1B.$m.$__EMAIL1C); } elsif ($method eq "2") { return formatHTML($__EMAIL2A.$m.$__EMAIL2B.$m.$__EMAIL2C); } elsif ($method eq "3") { return formatHTML($__EMAIL3A.$m.$__EMAIL3B.$m.$__EMAIL3C); } elsif ($method eq "4") { return formatHTML($__EMAIL4A.$m.$__EMAIL4B.$m.$__EMAIL4C); } elsif ($method eq "5") { return formatHTML($__EMAIL5A.$m.$__EMAIL5B); } elsif ($method eq "6") { return formatHTML($__EMAIL6A.$m.$__EMAIL6B.$m.$__EMAIL6C); } elsif ($method eq "7") { return formatHTML($__EMAIL7A.$m.$__EMAIL7B.$m.$__EMAIL7C); } elsif ($method eq "8") { return formatHTML($__EMAIL8A.$m.$__EMAIL8B.$m.$__EMAIL8C); } elsif ($method eq "9") { return formatHTML($__EMAIL9A.$m.$__EMAIL9B.$m.$__EMAIL9C); } return formatHTML($__EMAIL9A.$m.$__EMAIL9B.$m.$__EMAIL9C); } sub getLegalHTML { my $legal_text = &getLegalContent; return formatHTML($__LEGAL1.($legal_text).$__LEGAL2); } sub getStyleHTML { return formatHTML($__STYLE1); } sub getVanityHTML { return formatHTML($__VANITY1); } sub getBottomHTML { return formatHTML($__BOTTOM1); } sub performRequest { my $request = $_[0]; my $response = ""; my $head = ""; $head .= "POST ".$__REQUEST_SCRIPT." HTTP/1.1\r\n"; $head .= "Host: ".$__REQUEST_HOST."\r\n"; $head .= "User-Agent: PHPot ".$__HPOT_TAG2."\r\n"; $head .= "Content-Type: application/x-www-form-urlencoded\r\n"; $head .= "Content-Length: ".length($request)."\r\n"; $head .= "Connection: close\r\n\r\n"; use Socket; socket(SH, PF_INET, SOCK_STREAM, getprotobyname('tcp')) || die $!; my $sin = sockaddr_in($__REQUEST_PORT,inet_aton($__REQUEST_HOST)); connect(SH,$sin) || die "\n
Unable to contact the server...
\n"; syswrite(SH, $head, length($head)); syswrite(SH, $request, length($request)); my $line; while ($line = ) { $response .= $line; } close(SH); return $response; } sub prepareRequest { my %postvars = (); my $buffer; my @pairs; my $pair; my $name; my $value; $postvars{"tag1"} = $__HPOT_TAG1; $postvars{"tag2"} = $__HPOT_TAG2; $postvars{"tag3"} = $__HPOT_TAG3; if ($ENV{"SCRIPT_FILENAME"}) { $postvars{"tag4"} = md5_hex(&file_get_contents(&basename($ENV{"SCRIPT_FILENAME"}))); } elsif($ENV{"PATH_TRANSLATED"}) { $postvars{"tag4"} = md5_hex(&file_get_contents(&basename($ENV{"PATH_TRANSLATED"}))); } else { $postvars{"tag4"} = md5_hex(&file_get_contents(&basename($ENV{"X_TOMCAT_SCRIPT_PATH"}))); } $postvars{"ip"} = $ENV{"REMOTE_ADDR"}; $postvars{"svrn"} = $ENV{"SERVER_NAME"}; $postvars{"svp"} = $ENV{"SERVER_PORT"}; $postvars{"svip"} = $ENV{"SERVER_ADDR"}; $postvars{"rquri"} = $ENV{"REQUEST_URI"}; $postvars{"sn"} = $ENV{"SCRIPT_NAME"}; $postvars{"sn"} =~ s/ /%20/g; $postvars{"ref"} = $ENV{"HTTP_REFERER"}; $postvars{"uagnt"} = $ENV{"HTTP_USER_AGENT"}; $ENV{'REQUEST_METHOD'} =~ tr/a-z/A-Z/; if ($ENV{'REQUEST_METHOD'} eq "POST" && $ENV{'CONTENT_LENGTH'} > 0 && defined($ENV{'CONTENT_TYPE'})) { read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); if ($ENV{'CONTENT_TYPE'} =~ /multipart\/form-data; boundary=\"?([^\";,]+)\"?/) { my $boundary = "--".$1; my @multipart = split(/(${boundary}(--)?[\r\n]+)/,$buffer); trim(@multipart); foreach my $part (@multipart) { if ($part =~ /Content-Disposition: form-data; name="([^"]+)"?\r?\n\r?\n(.+)/s) { $name = $1; $value = trim($2); $postvars{"post|$name"} = $value; if (defined($postvars{"has_post"})) { $postvars{"has_post"}++; } else { $postvars{"has_post"} = 1; } } } } elsif ($ENV{'CONTENT_TYPE'} =~ /x-www-form-urlencoded/) { @pairs = split(/&/, $buffer); $postvars{"has_post"} = @pairs; foreach $pair (@pairs) { ($name, $value) = split(/=/, $pair); $value =~ tr/+/ /; $value =~ s/%(..)/pack("C", hex($1))/eg; $postvars{"post|$name"} = $value; } } } $ENV{'REQUEST_METHOD'} =~ tr/a-z/A-Z/; if ($ENV{'REQUEST_METHOD'} eq "GET" && $ENV{'QUERY_STRING'}) { $buffer = $ENV{'QUERY_STRING'}; @pairs = split(/&/, $buffer); $postvars{"has_get"} = @pairs; foreach $pair (@pairs) { ($name, $value) = split(/=/, $pair); $value =~ tr/+/ /; $value =~ s/%(..)/pack("C", hex($1))/eg; $postvars{"get|$name"} = $value; } } my $header_count = 0; foreach my $key (keys %ENV) { if (($key =~ /^HTTP/) && ($key !~ /^HTTP_COOKIE/)) { $postvars{"header|$key"} = $ENV{$key}; $header_count++; } } $postvars{"has_header"} = $header_count; return %postvars; } sub transcribeResponse { my $response = $_[0]; my %settings = (); my @directives = (); my @arr = split("\n",$response); my $isParam = 0; my $i = 0; foreach my $v (@arr) { if ($v eq "") { $isParam = 0; } if ($isParam) { my @pieces = split("=",$v,2); $settings{$pieces[0]} = &urldecode($pieces[1]); } if ($v eq "") { $isParam = 1; } } if ($settings{"directives"}) { @directives = split(",",$settings{"directives"}); } return \(@directives,%settings); } print "Content-Type: text/html\n"; print "Cache-Control: no-cache\n\n"; my $response = ""; my $request = ""; my %post = prepareRequest(); foreach my $k (keys %post) { $request .= "&$k=".&urlencode(&stripslashes($post{$k})); } $request = substr($request,1); $response = performRequest($request); if ($response == "-1") { exit(); } my ($directives_ref,$settings_ref) = transcribeResponse($response); my @directives = @$directives_ref; my %settings = %$settings_ref; my $email = $settings{"email"}; my $emailmethod = $settings{"emailmethod"}; if ($directives[0] eq "1") { print getDocType(); } if ($settings{"injDocType"}) { print $settings{"injDocTypeMsg"}; } if ($directives[1] eq "1") { print getHeadHTML(); } if ($settings{"injHead1HTML"}) { print $settings{"injHead1HTMLMsg"}; } if ($directives[8] eq "1") { print getRobotHTML(); } if ($settings{"injRobotHTML"}) { print $settings{"injRobotHTMLMsg"}; } if ($directives[9] eq "1") { print getNoCollectHTML(); } if ($settings{"injNoCollectHTML"}) { print $settings{"injNoCollectHTMLMsg"}; } if ($directives[1] eq "1") { print $settings{"injHead2HTMLMsg"}; } if ($settings{"injHead2HTML"}) { print $settings{"injHead2HTMLMsg"}; } if ($directives[2] eq "1") { print getTopHTML(); } if ($settings{"injTopHTML"}) { print $settings{"injTopHTMLMsg"}; } if ($settings{"actMsgOn"}) { print $settings{"actMsg"}; } if ($settings{"errMsgOn"}) { print $settings{"errMsg"}; } if ($settings{"customMsgOn"}) { print $settings{"customMsg"}; } if ($directives[3] eq "1") { print getLegalHTML(); } if ($settings{"injLegalHTML"}) { print $settings{"injLegalHTMLMsg"}; } if ($settings{"altLegalOn"}) { print $settings{"altLegalMsg"}; } if ($directives[4] eq "1") { print getEmailHTML($emailmethod,$email); } if ($settings{"injEmailHTML"}) { print $settings{"injEmailHTMLMsg"}; } if ($directives[5] eq "1") { print getStyleHTML(); } if ($settings{"injStyleHTML"}) { print $settings{"injStyleHTMLMsg"}; } if ($directives[6] eq "1") { print getVanityHTML(); } if ($settings{"injVanityHTML"}) { print $settings{"injVanityHTMLMsg"}; } if ($settings{"altVanityOn"}) { print $settings{"altVanityMsg"}; } if ($directives[7] eq "1") { print getBottomHTML(); } if ($settings{"injBottomHTML"}) { print $settings{"injBottomHTMLMsg"}; } #################### PERL <-> PHP functions ################ sub file_get_contents { open(FILE, "< $_[0]") or die "can't open $_[0]: $!"; undef $/; my $whole_file = ; # 'slurp' mode $whole_file =~ s/^#![a-zA-Z0-9\/\\\:\.\-\_\~ ]*[\n\r;]//; close(FILE); return $whole_file; } sub basename { return $_[0]; } sub urldecode { my $theURL = $_[0]; $theURL =~ tr/+/ /; $theURL =~ s/%([a-fA-F0-9]{2,2})/chr(hex($1))/eg; $theURL =~ s///g; return $theURL; } sub urlencode { my $theURL = $_[0]; $theURL =~ s/([\W])/"%" . uc(sprintf("%2.2x",ord($1)))/eg; return $theURL; } sub stripslashes { return $_[0]; } sub trim { my $string = shift; for ($string) { s/^\s+//; s/\s+$//; } return $string; }