#!/usr/bin/perl -Tw # drbot version 0.9 # by modulus schmodulus # Tue Jan 10 17:19:47 PST 2006 #TODO use perl switch module to parse arguments instead of using @ARGV use strict; use LWP; use HTTP::Cookies; $0="drbot.pl"; my $verbose=undef; &usage() if !defined $ARGV[0]; if ($ARGV[0] eq "-v"){ $verbose=1; } else { &usage(); } # create new cookie_jar object my $cookie_jar = HTTP::Cookies->new( file => 'cookies.dat', autosave => 1); # Create new user agent object my $ua = LWP::UserAgent->new; # allow POST requests to be redirectable push @{ $ua->requests_redirectable }, 'POST'; # set user agent type $ua->agent('Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1;)'); # set user agent cookies $ua->cookie_jar($cookie_jar); print "Logging into DR.." if defined $verbose; my $currpage=&drlogin(); print "Acquiring list of My Neighborhood.." if defined $verbose; &drinvestigate($currpage); sub drinvestigate{ my $html = $_[0]; my %id_name; my @investigate_links; # My Neighborhood if ($html =~ /(]*>My Neighborhood<\/a>)/g){ $html = $1; }; if ($html =~ /href=\"([^\"]*)\"/g){ $html = $1; }; my $targets = click_link($html); sleep 1 && print "." if defined $verbose; #baggerlip #My Profile #Assassin $targets =~ s/ ||\r||\n//g; # regex out playerids with their perspective names while ($targets =~ /([^<]*)<\/a>/g){ # populate associative array called %id_name (playerid to name) $id_name{$1}=$2; } # regex out "investigate" links #investigate while ($targets =~ /investigate<\/a>/g){ ## populate array with url from link push (@investigate_links,"\/$1"); } sleep 1 && print "SUCCESS!\n" if defined $verbose; # values for clicking on "investigate": #

Player is already investigated!

^M #

Investigation failed!

^M #

Investigation was successful!

^M print "Starting investigations:\n" if defined $verbose; for (@investigate_links){ my $targetid = 'UNKNOWN'; if ($_ =~ /Investigate.cfm\?TargetID=([^\&]*)\&DoItNow=Y/){ $targetid = $1; } if (click_link($_) =~ /

([^<]*)<\/h3><\/td><\/tr>/g) { logit("$1: PlayerID: $targetid PlayerName: $id_name{$targetid}"); } } } sub click_link{ my $desturl = $_[0]; my $req = HTTP::Request->new(GET => "http://www.drugrunners.net$desturl"); $req->content('PlayerID=2102280'); my $res = $ua->request($req); if ($res->is_success) { return $res->content; } else { print $res->status_line, "\n"; } } sub drlogin{ ##### Login to DR site ##### sleep 1 && print "." if defined $verbose; sleep 1 && print "." if defined $verbose; sleep 1 && print "." if defined $verbose; my $req_login = HTTP::Request->new(POST => 'http://www.drugrunners.net/PlayerLogin.cfm'); $req_login->content_type('application/x-www-form-urlencoded'); # pass player login/pass info $req_login->content('PlayerName=UserName&Password=Password&ban=Y&Submit= Log In '); my $resdologin = $ua->request($req_login); if ($resdologin->is_success) { print "SUCCESS!\n" if defined $verbose; return $resdologin->content; } else { return $resdologin->status_line, "\n"; } } sub get_date { my @days = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat'); my @months = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec'); my ($sec,$min,$hour,$mday,$mon,$year,$wday) = (localtime(time))[0,1,2,3,4,5,6]; my $time = sprintf("%02d\:%02d\:%02d",$hour,$min,$sec); $year += 1900; return "$months[$mon] $mday $time"; } sub logit{ my $text = $_[0]; my $date = get_date(); open (FH,">>dr_bot.log"); print FH "$date drbot.pl $text\n"; close (FH); print "$date drbot.pl $text\n" if defined $verbose; } sub usage{ print "\n Usage: $0 -v [verbose]\n\n"; exit; }