#!/usr/bin/perl # PROJECT HONEY POT ADDRESS DISTRIBUTION SCRIPT # For more information visit: http://www.projecthoneypot.org/ # Copyright (C) 2004-2014, 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: Sun, 19 Oct 2014 00:20:02 -0700 # For Domain: www.horsfall.org # # 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 = '85a7921065b918863227386cb368f87d'; my $__HPOT_TAG2 = 'f45b1d4d40e7456fa18d8ecf28515a6c'; my $__HPOT_TAG3 = '60eff423c208d7fdab40a0dd2d377e0b'; my $__CLASS_STYLE_1 = 'watrup'; my $__CLASS_STYLE_2 = 'yesla'; my $__DIV1 = 'prun1cr9'; 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 = 'Manacle Importance www.horsfall.org\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\n\n
  c  f  ko     
 
The website from
to you subject t
other terms gove
Website you acce
read them carefu
agents of the in
them. Theoaccess
non-transferable
Website.

             a S
 
Special restrict
Non-Human Visito
spiders, bots, i
programssdesigne
automatically.

Email addressess
It is recognized
alone. You ackno
has a value not
storage, and/or
valuegof these a
storing this Web
agreement and ex

        p      
 
Each party agree
against the othe
("Judicial Actio
the registered A
such laws are ap
and performed en
ofifederal and s
any action broug
Service. You con
the above agreem

      t       gf
 
Youdconsent to h
may appear somew
abuse. The Ident
Visitors agree n

VISITORS AGREE T
PARTY OR SENDING
SUBSEQUENT BREAC
          aTERMS

 which youoacces
o the following
rning access to
pt these terms a
lly. Any Non-Hum
dividual(s) who
 rightspgrantede
 without the exp


PECIAL LICENSE R

ions onda visito
rs. Non-HumanhVi
ndexers, robots,
d to access, rea


on this site are
 that these emai
wledge andhagree
less than US $50
distribution of
ddresses. Intent
site\'s emailoadd
presslydprohibit

 e     c APPLICA

s that any suit,
r inhconnection
n") shall be gov
dministrative Co
plied to agreeme
tirely withinith
tate courts with
ht against him i
sent tocelectron
ent.

       tRECORDS 

avingtyour Inter
here on this pag
ifier is uniquel
ot to use this a

HAT HARVESTING,
 ANY MESSAGE(S)
H OFeTHESE TERMS
 AND CONDITIONSp

sed thiskagreeme
conditions. Thes
the Website. By
nd conditions (t
an Visitors to t
controls, author
to you under the
ress written per


ESTRICTIONS FOR 

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


kconsidered prop
l addresses arei
tthat each email
. You further ag
these addressesa
ionalecollection
resses isirecogn
ed.

BLE LAW AND JURI

 action or proce
with orsarisinge
erned by theolaw
ntacta(the "Admi
nts between Admi
e Admin State. Y
in the Admin Sta
n connection wit
ic servicedof pr


OF VISITOR USE A

net Protocol add
e (the "Identifi
y matched to you
ddress for any r

GATHERING, STORI
TO THE IDENTIFIE
 OF SERVICE.
OF USE 

nt ("thehWebsite
esterms are in a
visiting (in any
he "Terms of Ser
hedWebsite shall
s or otherwise m
 Terms of Servic
mission of the o


NON-HUMAN VISITO

ccess the Websit
butoare notilimi
sters, oroany ot
therhcontent fro


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


SDICTION 

eding brought by
from the Terms o
 ofethe state of
n State") for th
n State resident
ouhconsent to th
te. You consent
hhbreaches of th
ocess regardinga


ND ABUSE 

ress recorded. A
er") ifdwe suspe
r Internet Proto
eason.

NG,pTRANSFERRING
R CONSTITUTES AN



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


RS 

e applyhto
ted to, web
her computer
m the Website


tual property.
an visitors
site contains
pilation,
minishescthe
thering, and/or
ion of this




 suchaparty
fdService
 residence of
e Website as
s entered into
e jurisdiction
to the venuehin
ese Terms of
actions under




n email address
ct potential
colkaddress.


 TO A THIRD
tACCEPTANCE 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; }