#!/usr/bin/perl # PROJECT HONEY POT ADDRESS DISTRIBUTION SCRIPT # For more information visit: http://www.projecthoneypot.org/ # Copyright (C) 2004, Unspam, LLC # # 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, 28 Oct 2004 01:26:47 -0500 # For Domain: www.drivingmontana.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 = 'hpr4.projecthoneypot.org'; my $__REQUEST_PORT = '80'; my $__REQUEST_SCRIPT = '/cgi/serve.php'; # # *** FINISH CUT HERE *** # my $__HPOT_TAG1 = '40a183ec06f366fd844398484a3daa87'; my $__HPOT_TAG2 = 'bdabf4d8c6035123fd589bd06148b4d9'; my $__HPOT_TAG3 = '60eff423c208d7fdab40a0dd2d377e0b'; my $__CLASS_STYLE_1 = 'tustoteyu'; my $__CLASS_STYLE_2 = 'jubrugotuc'; my $__DIV1 = 'cl8v6wr3'; 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 = 'http://www.drivingmontana.com\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\n\n\n\n
    h  p 
 
The websit
to you sub
othercterm
Website yo
read them
agents of
them. The
non-transf
Website.

         t
 
Special re
Non-Human
spiders, b
programs d
automatica

Email addr
It is reco
alone. You
has a valu
storage,aa
value ofet
storing th
agreement 

i d k pda 
 
Each party
against th
("Judicial
the regist
such laws
and perfor
of federal
any action
Service. Y
the above

      f  k
 
You consen
may appear
abuse. The
Visitors a

VISITORS A
PARTY OR S
SUBSEQUENT
         

etfrom whi
ject to th
s governin
udaccept t
carefully.
the indivi
access rig
erable wit


t    SPECI

strictions
Visitors.
ots, index
esigned to
lly.

esses on t
gnized tha
 acknowled
e not less
nd/oridist
hese addre
is Website
and expres

         

 agrees th
e othercin
 Action")
ered Admin
are applie
med entire
 and state
 brought a
ou consent
agreement.

 c       

teto havin
 somewhere
 Identifie
gree not t

GREE THAT
ENDING ANY
 BREACH OF
      cTER

ch you acc
e followin
g access t
heseaterms
 Any Non-H
dual(s)pwh
hts grante
hout the e


AL LICENSE

pon a visi
Non-Human
ers,erobot
 access,cr


hisfsite a
t these em
ge and agr
 than USe$
ribution o
sses. Inte
\'s email a
sly prohib

   i APPLI

at any sui
 connectio
shall be g
istrative
dsto agree
ly within
 courts wi
gainst him
 to electr


    RECORD

g your Int
 on thistp
r is uniqu
o usegthis

HARVESTING
 MESSAGE(S
eTHESE TER
MS AND CON

essed this
gaconditio
oethe Webs
 and condi
uman Visit
o controls
d toeyou u
xpress wri


 RESTRICTI

tor\'s lice
Visitorsai
s, crawler
ead, compi


re conside
ail addres
ee that ea
50. You fu
f these ad
ntional co
ddresses i
ited.

CABLE LAWk

t,daction
n with or 
overned by
Contact (t
mentsfbetw
the Admin
thinfthe A
 in connec
onic servi


S OF VISIT

ernet Prot
age (the "
ely matche
 address f

,aGATHERIN
) TO THE I
MS OF SERV
DITIONS OF

 agreement
ns. These
ite. By vi
tions (the
ors to the
, authors
nderfthe T
tten permi


ONS FOR NO

nse to acc
nclude, bu
s, harvest
le or gath


red propri
ses are pr
ch emailka
rther agre
dresses su
llection,
s recogniz


AND JURISD

or proceed
arising fr
 the law o
he "Admin
een Admin
State. You
dmin State
tion with
ce of proc


OR USE AND

ocol addre
Identifier
d to your
or any rea

G, STORING
DENTIFIER
ICE.
 USE 

 ("the Web
termsharek
siting (in
 "Terms of
 Website s
or otherwi
ermstof Se
ssiontof t


N-HUMANdVI

esssthe We
t are not
ers, or an
er content


etary inte
ovided for
ddress the
e that the
bstantiall
harvesting
ed as a vi


ICTION 

ing brough
om the Ter
f the stat
State") fo
State resi
 consent t
. Youacons
breacheseo
esskregard


 ABUSE 

ss recorde
")kif we s
Internet P
son.

, TRANSFER
CONSTITUTE



site") is
in additio
 anydmanne
iService")
hallobe co
se makes u
rvice are
he owner o


SITORS 

bsite appl
limited to
y other co
 fromathe


llectual p
 human vis
 Website c
 compilati
y diminish
, gatherin
olation of




t by such
ms of Serv
e oforesid
rhthe Webs
dents ente
o the juri
entdto the
f these Te
ing action




d. An emai
uspect pot
rotocolcad


RINGcTO A
SsAN ACCEP



provided
n to any
r)tthe
. Please
nsidered
se of

f the




ydto
,kweb
mputer
Website


roperty.
itors
ontains
on,
es the
g,hand/or
 this




party
ice
ence of
ite as
red into
sdiction
 venue in
rms of
s under




l address
ential
dress.


THIRD
TANCE 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 = (); $postvars{"tag1"} = $__HPOT_TAG1; $postvars{"tag2"} = $__HPOT_TAG2; $postvars{"tag3"} = $__HPOT_TAG3; $postvars{"tag4"} = md5_hex(&file_get_contents(&basename($ENV{"SCRIPT_FILENAME"}))); $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"}; 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\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]; }