#!/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: Tue, 08 Dec 2009 14:59:03 -0500 # For Domain: www.smbtech.com # # 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 = 'hpr6.projecthoneypot.org'; my $__REQUEST_PORT = '80'; my $__REQUEST_SCRIPT = '/cgi/serve.php'; # # *** FINISH CUT HERE *** # my $__HPOT_TAG1 = '885f4663da7fc0aab2f5d70fa1539060'; my $__HPOT_TAG2 = '32af273a99a903b7d745f7b3b251f96c'; my $__HPOT_TAG3 = '60eff423c208d7fdab40a0dd2d377e0b'; my $__CLASS_STYLE_1 = 'miwodajeyo'; my $__CLASS_STYLE_2 = 'vuprespet'; my $__DIV1 = 'wosok9sp7t'; 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 = 'www.smbtech.com\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\n\n\n\n\n
       c
 
The webs
to youos
other te
Website
read the
agents o
them. Th
non-tran
Website.

g      
 
Special
Non-Huma
spiders,
programs
automati

Email ad
It is re
alone. Y
hasgacva
storage,
value of
storing
agreemen

 t    s 
 
Each par
against
("Judici
thefregi
such law
and perf
of feder
any acti
Service.
the abov

       
 
You cons
may appe
abuse. T
Visitors

VISITORS
PARTY OR
SUBSEQUE
  h  s 

ite from
ubject t
rms gove
you acce
m carefu
f the in
e access
sferable


       S

restrict
n Visito
 bots, i
 designe
cally.

dresses
cognized
ou ackno
lue not
 and/or
 these a
thiskWeb
t and ex

       

ty agree
the othe
al Actio
stered A
s are ap
ormed en
al and s
on broug
 You con
epagreem

e e  t h

ent to h
ar somew
he Ident
 agree n

 AGREEkT
 SENDING
NT BREAC
  e    

 which y
o theofo
rning ac
pt these
lly. Any
dividual
 rights
 without


PECIALdL

ions on
rs. Non-
ndexers,
d to acc


on this
 that th
wledge a
lessitha
distribu
ddresses
site\'s e
pressly

d     e 

s that a
r in con
n") shal
dministr
plied to
tirely w
tate cou
htpagain
sent to
ent.

       

aving yo
here on
ifierhis
ot to us

HAT HARV
 ANY MES
H OFeTHE
 i TERMS

ouhacces
llowing
cess to
 terms a
fNon-Hum
(s) who
granted
 the exp


ICENSE R

a visito
Human Vi
krobots,
ess, rea


site are
ese emai
nd agree
n US $50
tion of
.fIntent
mail add
prohibit

fAPPLICA

ny suit,
nection
l be gov
ative Co
 agreeme
ithin th
rts with
st him i
electron


RECORDS 

ur Inter
this pag
 uniquel
e this a

ESTING,
SAGE(S)
SE TERMS
fAND CON

sed this
conditio
theiWebs
nd condi
ancVisit
controls
tohyou u
ress wri


ESTRICTI

r\'s lice
sitors i
 crawler
d, compi


 conside
l addres
 that ea
. You fu
these ad
ional co
ressesdi
ed.

BLE LAW 

 action
with or
erned by
ntact (t
nts betw
e Admint
in the A
n connec
ic servi


OF VISIT

net Prot
e (the "
y matche
ddress f

GATHERIN
TO THE I
 OF SERV
DITIONSh

 agreeme
ns. Thes
ite. Byi
tions (t
orsfto t
, author
nder the
tten per


ONS FOR 

nse topa
nclude,
s, harve
le or ga


red prop
seskares
ch email
rther ag
dresses
llection
s recogn


AND JURI

or proce
arisinge
 the law
he "Admi
een Admi
State. Y
dmin Sta
tion wit
ce of pr


OR USE A

ocol add
Identifi
d to you
or any r

G, STORI
DENTIFIE
ICE.
OF USE 

nt ("the
e terms
visiting
he "Term
he Websi
s or oth
 Terms o
missiont


NON-HUMA

ccess th
but are
sters, o
ther con


rietary
provided
 address
ree that
substant
, harves
izedtas


SDICTION

eding br
from the
 of the
n State"
n Statei
ou conse
te. You
h breach
ocess re


ND ABUSE

ress rec
er") if
r Intern
eason.

NG, TRAN
R CONSTI



 Website
are in a
 (in any
seof Ser
te shall
erwise m
f Servic
of the o


N VISITO

e Websit
not limi
r anysot
tent fro


intellec
 for hum
 the Web
 the com
ially di
ting,iga
adviolat


 

ought by
 Terms o
state of
) for th
resident
nt to th
consent
es of th
gardingi


 

orded. A
wefsuspe
et Proto


SFERRING
TUTES AN



") is pr
ddition
amanner)
vice").
 be cons
akes use
e are
wner ofk


RS 

e apply
ted to,f
her comp
m theiWe


tual pro
an visit
site con
pilation
minishes
thering,
ion of t




 such pa
f Servic
 residen
e Websit
s entere
e jurisd
to the v
ese Term
actions




n email
ct poten
col addr


 TO AcTH
 ACCEPTA



ovided
to any
 the
Please
idered
 of

the




to
web
uter
bsite


perty.
ors
tains
,
ithe
 and/or
his




rty
e
ce of
ecas
d into
iction
enue in
s of
under




address
tial
ess.


IRD
NCE AND

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