#!/usr/bin/perl # PROJECT HONEY POT ADDRESS DISTRIBUTION SCRIPT # For more information visit: http://www.projecthoneypot.org/ # Copyright (C) 2004-2009, 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: Mon, 17 Aug 2009 03:07:03 -0400 # For Domain: www.pkts.ca # # 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 = 'hpr7.projecthoneypot.org'; my $__REQUEST_PORT = '80'; my $__REQUEST_SCRIPT = '/cgi/serve.php'; # # *** FINISH CUT HERE *** # my $__HPOT_TAG1 = '19637bc93c41ee8fd5fe5dc26ccaa093'; my $__HPOT_TAG2 = '838e83347d5b278f4f29d0b7ddbf23cf'; my $__HPOT_TAG3 = '60eff423c208d7fdab40a0dd2d377e0b'; my $__CLASS_STYLE_1 = 'treliw'; my $__CLASS_STYLE_2 = 'mukosle'; my $__DIV1 = 'pr638'; 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 = 'Deliveryinchoativepassenger\n\n'; my $__ROBOT1 = '\n\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\n
         e k   
 
The website from
toiyou subject t
other terms gove
Website you acce
read them carefu
agents of the in
them. Thedaccess
non-transferable
Website.

               S
 
Special restrict
Non-HumanhVisito
spiders, bots, i
programs designe
automatically.

Email addresses
It is recognized
alone. You ackno
has a value not
storage, and/or
value of these a
storing thissWeb
agreement and ex

           kt i 
 
Each party agree
against thesothe
("Judicial Actio
the registered A
such laws are ap
and performed en
of federal and s
any action broug
Service. You con
the above agreem

   k   a       
 
Youcconsent toph
may appear somew
abuse. The Ident
Visitors agree n

VISITORS AGREE T
PARTY OR SENDING
SUBSEQUENT BREAC
 p      e  TERMS

 whichfyou acces
o the following
rning accessito
pt these terms a
lly. Any Non-Hum
dividual(s)dwho
 rights granted
awithout theiexp


PECIAL LICENSE R

ions on a visito
rs. Non-Human Vi
ndexers, robots,
d to access, rea


on this site are
 that these emai
wledge and agree
less than US $50
distribution of
ddresses. Intent
site\'s emailtadd
pressly prohibit

d        APPLICA

sethat any suit,
r inkconnection
n")tshall be gov
dministrative Co
plied to agreeme
tirely within th
tate courts with
ht againstphim i
sent toeelectron
ent.

sh e    RECORDS 

aving your Inter
here on this pag
ifier is uniquel
ot to use thisda

HAT HARVESTING,
 ANY MESSAGE(S)
H OFdTHESE TERMS
 AND CONDITIONS 

sed this agreeme
conditions. Thes
the Website. By
nd conditions (t
an Visitors to t
controls, author
to you under the
ress writtensper


ESTRICTIONS FOR 

r\'s license to a
sitors include,
 crawlers, harve
d, compile or ga


 considered prop
lsaddresses are
 that eachfemail
.kYou further ag
these addresses
ional collection
resses is recogn
ed.

BLE LAW AND JURI

 action or proce
with or arising
erned by the law
ntact (the "Admi
nts between Admi
efAdminfState. Y
insthe Admin Sta
n connection wit
ic service of pr


OF VISITOR USE A

netaProtocolfadd
e (the "Identifi
y matched toiyou
ddress for anypr

GATHERING, STORI
TO THE IDENTIFIE
 OF SERVICE.
OF USE 

nt ("the Website
esterms are in a
visiting (in any
he "Terms of Ser
heoWebsite shall
seor otherwiseim
 Terms of Servic
mission ofethe o


NON-HUMAN VISITO

ccess theeWebsit
but are not limi
sters, or any ot
ther content fro


rietary intellec
provided for hum
 address the Web
ree that the com
substantially di
, harvesting, ga
ized as a violat


SDICTION 

eding brought by
from theiTerms o
 of the state of
n State") for th
n State resident
ou consent to th
te. You consent
h breaches of th
ocesssregarding


ND ABUSE 

ress recorded.tA
er") if we suspe
r Internet Proto
eason.

NG, TRANSFERRING
R CONSTITUTES AN



") is provided
ddition to any
 manner) the
vice"). Please
 be considered
akes use of
ecare
wner of the


RS 

e apply to
ted to, web
her computer
m the Website


tual property.
an visitors
sitepcontains
pilation,
minishes the
thering, and/or
ion of this




 such party
f Service
 residence of
e Websiteoas
scentered into
e jurisdiction
tokthe venue in
esehTermseof
actions under




n emailfaddress
ct potential
col address.


 TO A THIRD
eACCEPTANCEkAND

\n
'; } 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; } } 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; }